Merge of branches/full-expr-4:

- Csyntax, Csem: source C language has side-effects within expressions,
  performs implicit casts, and has nondeterministic reduction semantics
  for expressions
- Cstrategy: deterministic red. sem. for the above
- Clight: the previous source C language, with pure expressions.
  Added: temporary variables + implicit casts.
- New pass SimplExpr to pull side-effects out of expressions
  (previously done in untrusted Caml code in cparser/)
- Csharpminor: added temporary variables to match Clight.
- Cminorgen: adapted, removed cast optimization (moved to back-end)
- CastOptim: RTL-level optimization of casts
- cparser: transformations Bitfields, StructByValue and StructAssign
  now work on non-simplified expressions
- Added pretty-printers for several intermediate languages,
  and matching -dxxx command-line flags.



git-svn-id: https://yquem.inria.fr/compcert/svn/compcert/trunk@1467 fca1b0fc-160b-0410-b1d3-a4f43f01ea2e

19 files changed, 10763 insertions, 5551 deletions

diff --git a/cfrontend/C2Clight.ml b/cfrontend/C2Clight.ml
index 035840b..f62099a 100644
--- a/cfrontend/C2Clight.ml
+++ b/cfrontend/C2Clight.ml
@@ -7,6 +7,7 @@ open Cparser.Builtins
 
 open Camlcoq
 open AST
+open Values
 open Csyntax
 
 (** Record the declarations of global variables and associate them
@@ -286,62 +287,96 @@ let rec convertTypList env = function
   | [] -> Tnil
   | t1 :: tl -> Tcons(convertTyp env t1, convertTypList env tl)
 
+let rec projFunType env ty =
+  match Cutil.unroll env ty with
+  | TFun(res, args, vararg, attr) -> Some(res, vararg)
+  | TPtr(ty', attr) -> projFunType env ty'
+  | _ -> None
+
+(* Handling of volatile *)
+
+let is_volatile_access env e =
+  List.mem C.AVolatile (Cutil.attributes_of_type env e.etyp)
+  && Cutil.is_lvalue env e
+
+let volatile_fun_suffix_type ty =
+  match ty with
+  | Tint(I8, Unsigned) -> ("int8unsigned", ty)
+  | Tint(I8, Signed) -> ("int8signed", ty)
+  | Tint(I16, Unsigned) -> ("int16unsigned", ty)
+  | Tint(I16, Signed) -> ("int16signed", ty)
+  | Tint(I32, _) -> ("int32", Tint(I32, Signed))
+  | Tfloat F32 -> ("float32", ty)
+  | Tfloat F64 -> ("float64", ty)
+  | Tpointer _ | Tarray _ | Tfunction _ | Tcomp_ptr _ ->
+      ("pointer", Tpointer Tvoid)
+  | _ ->
+      unsupported "operation on volatile struct or union"; ("", Tvoid)
+
+let volatile_read_fun ty =
+  let (suffix, ty') = volatile_fun_suffix_type ty in
+  let funty = Tfunction(Tcons(Tpointer Tvoid, Tnil), ty') in
+  Evalof(Evar(intern_string ("__builtin_volatile_read_" ^ suffix), funty), funty)
+
+let volatile_write_fun ty =
+  let (suffix, ty') = volatile_fun_suffix_type ty in
+  let funty = Tfunction(Tcons(Tpointer Tvoid, Tcons(ty', Tnil)), Tvoid) in
+  Evalof(Evar(intern_string ("__builtin_volatile_write_" ^ suffix), funty), funty)
+
 (** Expressions *)
 
-let ezero = Expr(Econst_int(coqint_of_camlint 0l), Tint(I32, Signed))
+let ezero = Eval(Vint(coqint_of_camlint 0l), Tint(I32, Signed))
 
 let rec convertExpr env e =
   let ty = convertTyp env e.etyp in
   match e.edesc with
+  | C.EVar _
+  | C.EUnop((C.Oderef|C.Odot _|C.Oarrow _), _)
+  | C.EBinop(C.Oindex, _, _, _) ->
+      let l = convertLvalue env e in
+      if is_volatile_access env e then
+        Ecall(volatile_read_fun (typeof l),
+              Econs(Eaddrof(l, Tpointer(typeof l)), Enil),
+              ty)
+      else
+        Evalof(l, ty)
+
   | C.EConst(C.CInt(i, _, _)) ->
-      Expr(Econst_int(convertInt i), ty)
+      Eval(Vint(convertInt i), ty)
   | C.EConst(C.CFloat(f, _, _)) ->
-      Expr(Econst_float f, ty)
+      Eval(Vfloat(f), ty)
   | C.EConst(C.CStr s) ->
-      Expr(Evar(name_for_string_literal env s), typeStringLiteral s)
+      let ty = typeStringLiteral s in
+      Evalof(Evar(name_for_string_literal env s, ty), ty)
   | C.EConst(C.CWStr s) ->
       unsupported "wide string literal"; ezero
   | C.EConst(C.CEnum(id, i)) ->
-      Expr(Econst_int(convertInt i), ty)
-
+      Eval(Vint(convertInt i), ty)
   | C.ESizeof ty1 ->
-      Expr(Esizeof(convertTyp env ty1), ty)
-  | C.EVar id ->
-      Expr(Evar(intern_string id.name), ty)
+      Esizeof(convertTyp env ty1, ty)
 
-  | C.EUnop(C.Oderef, e1) ->
-      Expr(Ederef(convertExpr env e1), ty)
-  | C.EUnop(C.Oaddrof, e1) ->
-      Expr(Eaddrof(convertExpr env e1), ty)
-  | C.EUnop(C.Odot id, e1) ->
-      Expr(Efield(convertExpr env e1, intern_string id), ty)
-  | C.EUnop(C.Oarrow id, e1) ->
-      let e1' = convertExpr env e1 in
-      let ty1 =
-        match typeof e1' with
-        | Tpointer t -> t
-        | _ -> error ("wrong type for ->" ^ id ^ " access"); Tvoid in
-      Expr(Efield(Expr(Ederef(convertExpr env e1), ty1),
-                  intern_string id), ty)
+  | C.EUnop(C.Ominus, e1) ->
+      Eunop(Oneg, convertExpr env e1, ty)
   | C.EUnop(C.Oplus, e1) ->
       convertExpr env e1
-  | C.EUnop(C.Ominus, e1) ->
-      Expr(Eunop(Oneg, convertExpr env e1), ty)
   | C.EUnop(C.Olognot, e1) ->
-      Expr(Eunop(Onotbool, convertExpr env e1), ty)
+      Eunop(Onotbool, convertExpr env e1, ty)
   | C.EUnop(C.Onot, e1) ->
-      Expr(Eunop(Onotint, convertExpr env e1), ty)
-  | C.EUnop(_, _) ->
-      unsupported "pre/post increment/decrement operator"; ezero
-
-  | C.EBinop(C.Oindex, e1, e2, _) ->
-      Expr(Ederef(Expr(Ebinop(Oadd, convertExpr env e1, convertExpr env e2),
-                       Tpointer ty)), ty)
-  | C.EBinop(C.Ologand, e1, e2, _) ->
-      Expr(Eandbool(convertExpr env e1, convertExpr env e2), ty)
-  | C.EBinop(C.Ologor, e1, e2, _) ->
-      Expr(Eorbool(convertExpr env e1, convertExpr env e2), ty)
-  | C.EBinop(op, e1, e2, _) ->
+      Eunop(Onotint, convertExpr env e1, ty)
+  | C.EUnop(C.Oaddrof, e1) ->
+      Eaddrof(convertLvalue env e1, ty)
+  | C.EUnop(C.Opreincr, e1) ->
+      coq_Epreincr Incr (convertLvalue env e1) ty
+  | C.EUnop(C.Opredecr, e1) ->
+      coq_Epreincr Decr (convertLvalue env e1) ty
+  | C.EUnop(C.Opostincr, e1) ->
+      Epostincr(Incr, convertLvalue env e1, ty)
+  | C.EUnop(C.Opostdecr, e1) ->
+      Epostincr(Decr, convertLvalue env e1, ty)
+
+  | C.EBinop((C.Oadd|C.Osub|C.Omul|C.Odiv|C.Omod|C.Oand|C.Oor|C.Oxor|
+              C.Oshl|C.Oshr|C.Oeq|C.One|C.Olt|C.Ogt|C.Ole|C.Oge) as op,
+             e1, e2, _) ->
       let op' =
         match op with
         | C.Oadd -> Oadd
@@ -360,121 +395,106 @@ let rec convertExpr env e =
         | C.Ogt  -> Ogt
         | C.Ole  -> Ole
         | C.Oge  -> Oge
-        | C.Ocomma -> unsupported "sequence operator"; Oadd
-        | _ -> unsupported "assignment operator"; Oadd in
-      Expr(Ebinop(op', convertExpr env e1, convertExpr env e2), ty)
+        | _ -> assert false in
+      Ebinop(op', convertExpr env e1, convertExpr env e2, ty)
+  | C.EBinop(C.Oassign, e1, e2, _) ->
+      let e1' = convertLvalue env e1 in
+      let e2' = convertExpr env e2 in
+      if Cutil.is_composite_type env e1.etyp then
+        unsupported "assignment between structs or between unions";
+      if is_volatile_access env e1 then
+        Ecall(volatile_write_fun (typeof e1'),
+              Econs(Eaddrof(e1', Tpointer(typeof e1')), Econs(e2', Enil)),
+              Tvoid)   (* typing issue here *)
+      else
+        Eassign(e1', e2', ty)
+  | C.EBinop((C.Oadd_assign|C.Osub_assign|C.Omul_assign|C.Odiv_assign|
+              C.Omod_assign|C.Oand_assign|C.Oor_assign|C.Oxor_assign|
+              C.Oshl_assign|C.Oshr_assign) as op,
+             e1, e2, tyres) ->
+      let tyres = convertTyp env tyres in
+      let op' =
+        match op with
+        | C.Oadd_assign -> Oadd
+        | C.Osub_assign -> Osub
+        | C.Omul_assign -> Omul
+        | C.Odiv_assign -> Odiv
+        | C.Omod_assign -> Omod
+        | C.Oand_assign -> Oand
+        | C.Oor_assign  -> Oor
+        | C.Oxor_assign -> Oxor
+        | C.Oshl_assign -> Oshl
+        | C.Oshr_assign -> Oshr
+        | _ -> assert false in
+      let e1' = convertLvalue env e1 in
+      let e2' = convertExpr env e2 in
+      if is_volatile_access env e1 then
+        (error "assign-op to volatile not supported"; ezero)
+      else
+        Eassignop(op', e1', e2', tyres, ty)
+  | C.EBinop(C.Ocomma, e1, e2, _) ->
+      Ecomma(convertExpr env e1, convertExpr env e2, ty)
+  | C.EBinop(C.Ologand, e1, e2, _) ->
+      coq_Eseqand (convertExpr env e1) (convertExpr env e2) ty
+  | C.EBinop(C.Ologor, e1, e2, _) ->
+      coq_Eseqor (convertExpr env e1) (convertExpr env e2) ty
+
   | C.EConditional(e1, e2, e3) ->
-      Expr(Econdition(convertExpr env e1, convertExpr env e2, convertExpr env e3), ty)
+      Econdition(convertExpr env e1, convertExpr env e2, convertExpr env e3, ty)
   | C.ECast(ty1, e1) ->
-      Expr(Ecast(convertTyp env ty1, convertExpr env e1), ty)
-  | C.ECall _ ->
-      unsupported "function call within expression"; ezero
-
-(* Function calls *)
-
-let rec projFunType env ty =
-  match Cutil.unroll env ty with
-  | TFun(res, args, vararg, attr) -> Some(res, vararg)
-  | TPtr(ty', attr) -> projFunType env ty'
-  | _ -> None
-
-let convertFuncall env lhs fn args =
-  match projFunType env fn.etyp with
-  | None ->
-      error "wrong type for function part of a call"; Sskip
-  | Some(res, false) ->
-      (* Non-variadic function *)
-      Scall(lhs, convertExpr env fn, List.map (convertExpr env) args)
-  | Some(res, true) ->
-      (* Variadic function: generate a call to a stub function with
-         the appropriate number and types of arguments.  Works only if
-         the function expression e is a global variable. *)
-      let fun_name =
-        match fn with
-        | {edesc = C.EVar id} when !Clflags.option_fvararg_calls ->
-            (*warning "emulating call to variadic function"; *)
-            id.name
-        | _ ->
-            unsupported "call to variadic function";
-            "<error>" in
-      let targs = convertTypList env (List.map (fun e -> e.etyp) args) in
-      let tres = convertTyp env res in
-      let (stub_fun_name, stub_fun_typ) =
-        register_stub_function fun_name tres targs in
-      Scall(lhs,
-            Expr(Evar(intern_string stub_fun_name), stub_fun_typ),
-            List.map (convertExpr env) args)
-
-(* Handling of volatile *)
-
-let is_volatile_access env e =
-  List.mem C.AVolatile (Cutil.attributes_of_type env e.etyp)
-  && Cutil.is_lvalue env e
-
-let volatile_fun_suffix_type ty =
-  match ty with
-  | Tint(I8, Unsigned) -> ("int8unsigned", ty)
-  | Tint(I8, Signed) -> ("int8signed", ty)
-  | Tint(I16, Unsigned) -> ("int16unsigned", ty)
-  | Tint(I16, Signed) -> ("int16signed", ty)
-  | Tint(I32, _) -> ("int32", Tint(I32, Signed))
-  | Tfloat F32 -> ("float32", ty)
-  | Tfloat F64 -> ("float64", ty)
-  | Tpointer _ | Tarray _ | Tfunction _ | Tcomp_ptr _ ->
-      ("pointer", Tpointer Tvoid)
-  | _ ->
-      unsupported "operation on volatile struct or union"; ("", Tvoid)
-
-let volatile_read_fun ty =
-  let (suffix, ty') = volatile_fun_suffix_type ty in
-  Expr(Evar(intern_string ("__builtin_volatile_read_" ^ suffix)),
-       Tfunction(Tcons(Tpointer Tvoid, Tnil), ty'))
-
-let volatile_write_fun ty =
-  let (suffix, ty') = volatile_fun_suffix_type ty in
-  Expr(Evar(intern_string ("__builtin_volatile_write_" ^ suffix)),
-       Tfunction(Tcons(Tpointer Tvoid, Tcons(ty', Tnil)), Tvoid))
-
-(* Toplevel expression, argument of an Sdo *)
-
-let convertTopExpr env e =
-  match e.edesc with
-  | C.EBinop(C.Oassign, lhs, {edesc = C.ECall(fn, args)}, _) ->
-      convertFuncall env (Some (convertExpr env lhs)) fn args
-(****
-      (* Recognize __builtin_fabs and turn it into Clight operator *)
-      begin match fn, args with
-      | {edesc = C.EVar {name = "__builtin_fabs"}}, [arg1] ->
-          Sassign(convertExpr env lhs, 
-                  Expr(Eunop(Ofabs, convertExpr env arg1), Tfloat F64))
-      | _ ->
-          convertFuncall env (Some (convertExpr env lhs)) fn args
-      end
-*****)
-  | C.EBinop(C.Oassign, lhs, rhs, _) ->
-      if Cutil.is_composite_type env lhs.etyp then
-        unsupported "assignment between structs or between unions";
-      let lhs' = convertExpr env lhs
-      and rhs' = convertExpr env rhs in
-      begin match (is_volatile_access env lhs, is_volatile_access env rhs) with
-      | true, true ->                   (* should not happen *)
-          unsupported "volatile-to-volatile assignment";
-          Sskip
-      | false, true ->                  (* volatile read *)
-          Scall(Some lhs',
-                volatile_read_fun (typeof rhs'),
-                [ Expr (Eaddrof rhs', Tpointer (typeof rhs')) ])
-      | true, false ->                  (* volatile write *)
-          Scall(None,
-                volatile_write_fun (typeof lhs'),
-                [ Expr(Eaddrof lhs', Tpointer (typeof lhs')); rhs' ])
-      | false, false ->                 (* regular assignment *)
-          Sassign(convertExpr env lhs, convertExpr env rhs)
-      end
+      Ecast(convertExpr env e1, convertTyp env ty1)
   | C.ECall(fn, args) ->
-      convertFuncall env None fn args
+      match projFunType env fn.etyp with
+      | None ->
+          error "wrong type for function part of a call"; ezero
+      | Some(res, false) ->
+          (* Non-variadic function *)
+          Ecall(convertExpr env fn, convertExprList env args, ty)
+      | Some(res, true) ->
+          (* Variadic function: generate a call to a stub function with
+             the appropriate number and types of arguments.  Works only if
+             the function expression e is a global variable. *)
+          let fun_name =
+            match fn with
+            | {edesc = C.EVar id} when !Clflags.option_fvararg_calls ->
+                (*warning "emulating call to variadic function"; *)
+                id.name
+            | _ ->
+                unsupported "call to variadic function";
+                "<error>" in
+          let targs = convertTypList env (List.map (fun e -> e.etyp) args) in
+          let tres = convertTyp env res in
+          let (stub_fun_name, stub_fun_typ) =
+            register_stub_function fun_name tres targs in
+          Ecall(Evalof(Evar(intern_string stub_fun_name, stub_fun_typ),
+                       stub_fun_typ),
+                convertExprList env args, ty)
+
+and convertLvalue env e =
+  let ty = convertTyp env e.etyp in
+  match e.edesc with
+  | C.EVar id ->
+      Evar(intern_string id.name, ty)
+  | C.EUnop(C.Oderef, e1) ->
+      Ederef(convertExpr env e1, ty)
+  | C.EUnop(C.Odot id, e1) ->
+      Efield(convertLvalue env e1, intern_string id, ty)
+  | C.EUnop(C.Oarrow id, e1) ->
+      let e1' = convertExpr env e1 in
+      let ty1 =
+        match typeof e1' with
+        | Tpointer t -> t
+        | _ -> error ("wrong type for ->" ^ id ^ " access"); Tvoid in
+      Efield(Ederef(e1', ty1), intern_string id, ty)
+  | C.EBinop(C.Oindex, e1, e2, _) ->
+      coq_Eindex (convertExpr env e1) (convertExpr env e2) ty
   | _ ->
-      unsupported "illegal toplevel expression"; Sskip
+      error "illegal l-value"; ezero
+
+and convertExprList env el =
+  match el with
+  | [] -> Enil
+  | e1 :: el' -> Econs(convertExpr env e1, convertExprList env el')
 
 (* Separate the cases of a switch statement body *)
 
@@ -514,7 +534,7 @@ let rec convertStmt env s =
   | C.Sskip ->
       Sskip
   | C.Sdo e ->
-      convertTopExpr env e
+      Sdo(convertExpr env e)
   | C.Sseq(s1, s2) ->
       Ssequence(convertStmt env s1, convertStmt env s2)
   | C.Sif(e, s1, s2) ->
@@ -699,6 +719,7 @@ let convertInit env ty init =
       | Some(C.CEnum _) ->
           error "enum tag after constant folding"
       | None ->
+          Format.printf "%a@." Cprint.exp (0, e);
           error "initializer is not a compile-time constant"
       end
   | Init_array il ->
diff --git a/cfrontend/Clight.v b/cfrontend/Clight.v
new file mode 100644
index 0000000..4cc97ab
--- /dev/null
+++ b/cfrontend/Clight.v
@@ -0,0 +1,623 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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 GNU General Public License as published by  *)
+(*  the Free Software Foundation, either version 2 of the License, or  *)
+(*  (at your option) any later version.  This file is also distributed *)
+(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** The Clight language: a simplified version of Compcert C where all
+  expressions are pure and assignments and function calls are
+  statements, not expressions. *)
+
+Require Import Coqlib.
+Require Import Errors.
+Require Import Maps.
+Require Import Integers.
+Require Import Floats.
+Require Import Values.
+Require Import AST.
+Require Import Memory.
+Require Import Events.
+Require Import Globalenvs.
+Require Import Smallstep.
+Require Import Csyntax.
+Require Import Csem.
+
+(** * Abstract syntax *)
+
+
+(** ** Expressions *)
+
+(** Clight expressions correspond to the "pure" subset of C expressions.
+  The main omissions are string literals and assignment operators
+  ([=], [+=], [++], etc).  In Clight, assignment is a statement,
+  not an expression.  Additionally, an expression can also refer to
+  temporary variables, which are a separate class of local variables
+  that do not reside in memory and whose address cannot be taken.
+
+  As in Compcert C, all expressions are annotated with their types,
+  as needed to resolve operator overloading and type-dependent behaviors. *)
+
+Inductive expr : Type :=
+  | Econst_int: int -> type -> expr       (**r integer literal *)
+  | Econst_float: float -> type -> expr   (**r float literal *)
+  | Evar: ident -> type -> expr           (**r variable *)
+  | Etempvar: ident -> type -> expr       (**r temporary variable *)
+  | Ederef: expr -> type -> expr          (**r pointer dereference (unary [*]) *)
+  | Eaddrof: expr -> type -> expr         (**r address-of operator ([&]) *)
+  | Eunop: unary_operation -> expr -> type -> expr  (**r unary operation *)
+  | Ebinop: binary_operation -> expr -> expr -> type -> expr (**r binary operation *)
+  | Ecast: expr -> type -> expr   (**r type cast ([(ty) e]) *)
+  | Econdition: expr -> expr -> expr -> type -> expr (**r conditional ([e1 ? e2 : e3]) *)
+  | Esizeof: type -> type -> expr         (**r size of a type *)
+  | Efield: expr -> ident -> type -> expr. (**r access to a member of a struct or union *)
+
+(** Extract the type part of a type-annotated Clight expression. *)
+
+Definition typeof (e: expr) : type :=
+  match e with
+  | Econst_int _ ty => ty
+  | Econst_float _ ty => ty
+  | Evar _ ty => ty
+  | Etempvar _ ty => ty
+  | Ederef _ ty => ty
+  | Eaddrof _ ty => ty
+  | Eunop _ _ ty => ty
+  | Ebinop _ _ _ ty => ty
+  | Ecast _ ty => ty
+  | Econdition _ _ _ ty => ty
+  | Esizeof _ ty => ty
+  | Efield _ _ ty => ty
+  end.
+
+(** ** Statements *)
+
+(** Clight statements are similar to those of Compcert C, with the addition
+  of assigment (of a rvalue to a lvalue), assignment to a temporary,
+  and function call (with assignment of the result to a temporary).
+  The [for] loop is slightly simplified: there is no initial statement. *)
+
+Definition label := ident.
+
+Inductive statement : Type :=
+  | Sskip : statement                   (**r do nothing *)
+  | Sassign : expr -> expr -> statement (**r assignment [lvalue = rvalue] *)
+  | Sset : ident -> expr -> statement   (**r assignment [tempvar = rvalue] *)
+  | Scall: option ident -> expr -> list expr -> statement (**r function call *)
+  | Ssequence : statement -> statement -> statement  (**r sequence *)
+  | Sifthenelse : expr  -> statement -> statement -> statement (**r conditional *)
+  | Swhile : expr -> statement -> statement   (**r [while] loop *)
+  | Sdowhile : expr -> statement -> statement (**r [do] loop *)
+  | Sfor': expr -> statement -> statement -> statement (**r [for] loop *)
+  | Sbreak : statement                      (**r [break] statement *)
+  | Scontinue : statement                   (**r [continue] statement *)
+  | Sreturn : option expr -> statement      (**r [return] statement *)
+  | Sswitch : expr -> labeled_statements -> statement  (**r [switch] statement *)
+  | Slabel : label -> statement -> statement
+  | Sgoto : label -> statement
+
+with labeled_statements : Type :=            (**r cases of a [switch] *)
+  | LSdefault: statement -> labeled_statements
+  | LScase: int -> statement -> labeled_statements -> labeled_statements.
+
+(** The full [for] loop is a derived form. *)
+
+Definition Sfor (s1: statement) (e2: expr) (s3 s4: statement) :=
+  Ssequence s1 (Sfor' e2 s3 s4).
+
+(** ** Functions *)
+
+(** A function definition is composed of its return type ([fn_return]),
+  the names and types of its parameters ([fn_params]), the names
+  and types of its local variables ([fn_vars]), and the body of the
+  function (a statement, [fn_body]). *)
+
+Record function : Type := mkfunction {
+  fn_return: type;
+  fn_params: list (ident * type);
+  fn_vars: list (ident * type);
+  fn_temps: list (ident * type);
+  fn_body: statement
+}.
+
+Definition var_names (vars: list(ident * type)) : list ident :=
+  List.map (@fst ident type) vars.
+
+(** Functions can either be defined ([Internal]) or declared as
+  external functions ([External]). *)
+
+Inductive fundef : Type :=
+  | Internal: function -> fundef
+  | External: external_function -> typelist -> type -> fundef.
+
+(** ** Programs *)
+
+(** A program is a collection of named functions, plus a collection
+  of named global variables, carrying their types and optional initialization 
+  data.  See module [AST] for more details. *)
+
+Definition program : Type := AST.program fundef type.
+
+(** * Operations over types *)
+
+(** The type of a function definition. *)
+
+Definition type_of_function (f: function) : type :=
+  Tfunction (type_of_params (fn_params f)) (fn_return f).
+
+Definition type_of_fundef (f: fundef) : type :=
+  match f with
+  | Internal fd => type_of_function fd
+  | External id args res => Tfunction args res
+  end.
+
+(** * Operational semantics *)
+
+(** The semantics uses two environments.  The global environment
+  maps names of functions and global variables to memory block references,
+  and function pointers to their definitions.  (See module [Globalenvs].) *)
+
+Definition genv := Genv.t fundef type.
+
+(** The local environment maps local variables to block references
+  and types.  The current value of the variable is stored in the associated memory
+  block. *)
+
+Definition env := PTree.t (block * type). (* map variable -> location & type *)
+
+Definition empty_env: env := (PTree.empty (block * type)).
+
+(** The temporary environment maps local temporaries to values. *)
+
+Definition temp_env := PTree.t val.
+
+
+(** Selection of the appropriate case of a [switch], given the value [n]
+  of the selector expression. *)
+
+Fixpoint select_switch (n: int) (sl: labeled_statements)
+                       {struct sl}: labeled_statements :=
+  match sl with
+  | LSdefault _ => sl
+  | LScase c s sl' => if Int.eq c n then sl else select_switch n sl'
+  end.
+
+(** Turn a labeled statement into a sequence *)
+
+Fixpoint seq_of_labeled_statement (sl: labeled_statements) : statement :=
+  match sl with
+  | LSdefault s => s
+  | LScase c s sl' => Ssequence s (seq_of_labeled_statement sl')
+  end.
+
+Section SEMANTICS.
+
+Variable ge: genv.
+
+(** [type_of_global b] returns the type of the global variable or function
+  at address [b]. *)
+
+Definition type_of_global (b: block) : option type :=
+  match Genv.find_var_info ge b with
+  | Some gv => Some gv.(gvar_info)
+  | None =>
+      match Genv.find_funct_ptr ge b with
+      | Some fd => Some(type_of_fundef fd)
+      | None => None
+      end
+  end.
+
+(** ** Evaluation of expressions *)
+
+Section EXPR.
+
+Variable e: env.
+Variable le: temp_env.
+Variable m: mem.
+
+(** [eval_expr ge e m a v] defines the evaluation of expression [a]
+  in r-value position.  [v] is the value of the expression.
+  [e] is the current environment and [m] is the current memory state. *)
+
+Inductive eval_expr: expr -> val -> Prop :=
+  | eval_Econst_int:   forall i ty,
+      eval_expr (Econst_int i ty) (Vint i)
+  | eval_Econst_float:   forall f ty,
+      eval_expr (Econst_float f ty) (Vfloat f)
+  | eval_Etempvar:  forall id ty v,
+      le!id = Some v ->
+      eval_expr (Etempvar id ty) v
+  | eval_Eaddrof: forall a ty loc ofs,
+      eval_lvalue a loc ofs ->
+      eval_expr (Eaddrof a ty) (Vptr loc ofs)
+  | eval_Esizeof: forall ty' ty,
+      eval_expr (Esizeof ty' ty) (Vint (Int.repr (sizeof ty')))
+  | eval_Eunop:  forall op a ty v1 v,
+      eval_expr a v1 ->
+      sem_unary_operation op v1 (typeof a) = Some v ->
+      eval_expr (Eunop op a ty) v
+  | eval_Ebinop: forall op a1 a2 ty v1 v2 v,
+      eval_expr a1 v1 ->
+      eval_expr a2 v2 ->
+      sem_binary_operation op v1 (typeof a1) v2 (typeof a2) m = Some v ->
+      eval_expr (Ebinop op a1 a2 ty) v
+  | eval_Econdition_true: forall a1 a2 a3 ty v1 v2,
+      eval_expr a1 v1 ->
+      is_true v1 (typeof a1) ->
+      eval_expr a2 v2 ->
+      eval_expr (Econdition a1 a2 a3 ty) v2
+  | eval_Econdition_false: forall a1 a2 a3 ty v1 v3,
+      eval_expr a1 v1 ->
+      is_false v1 (typeof a1) ->
+      eval_expr a3 v3 ->
+      eval_expr (Econdition a1 a2 a3 ty) v3
+  | eval_Ecast:   forall a ty v1 v,
+      eval_expr a v1 ->
+      cast v1 (typeof a) ty v ->
+      eval_expr (Ecast a ty) v
+  | eval_Elvalue: forall a loc ofs v,
+      eval_lvalue a loc ofs ->
+      load_value_of_type (typeof a) m loc ofs = Some v ->
+      eval_expr a v
+
+(** [eval_lvalue ge e m a b ofs] defines the evaluation of expression [a]
+  in l-value position.  The result is the memory location [b, ofs]
+  that contains the value of the expression [a]. *)
+
+with eval_lvalue: expr -> block -> int -> Prop :=
+  | eval_Evar_local:   forall id l ty,
+      e!id = Some(l, ty) ->
+      eval_lvalue (Evar id ty) l Int.zero
+  | eval_Evar_global: forall id l ty,
+      e!id = None ->
+      Genv.find_symbol ge id = Some l ->
+      type_of_global l = Some ty ->
+      eval_lvalue (Evar id ty) l Int.zero
+  | eval_Ederef: forall a ty l ofs,
+      eval_expr a (Vptr l ofs) ->
+      eval_lvalue (Ederef a ty) l ofs
+ | eval_Efield_struct:   forall a i ty l ofs id fList delta,
+      eval_lvalue a l ofs ->
+      typeof a = Tstruct id fList ->
+      field_offset i fList = OK delta ->
+      eval_lvalue (Efield a i ty) l (Int.add ofs (Int.repr delta))
+ | eval_Efield_union:   forall a i ty l ofs id fList,
+      eval_lvalue a l ofs ->
+      typeof a = Tunion id fList ->
+      eval_lvalue (Efield a i ty) l ofs.
+
+Scheme eval_expr_ind2 := Minimality for eval_expr Sort Prop
+  with eval_lvalue_ind2 := Minimality for eval_lvalue Sort Prop.
+Combined Scheme eval_expr_lvalue_ind from eval_expr_ind2, eval_lvalue_ind2.
+
+(** [eval_exprlist ge e m al tyl vl] evaluates a list of r-value
+  expressions [al], cast their values to the types given in [tyl],
+  and produces the list of cast values [vl].  It is used to
+  evaluate the arguments of function calls. *)
+
+Inductive eval_exprlist: list expr -> typelist -> list val -> Prop :=
+  | eval_Enil:
+      eval_exprlist nil Tnil nil
+  | eval_Econs:   forall a bl ty tyl v1 v2 vl,
+      eval_expr a v1 ->
+      cast v1 (typeof a) ty v2 ->
+      eval_exprlist bl tyl vl ->
+      eval_exprlist (a :: bl) (Tcons ty tyl) (v2 :: vl).
+
+End EXPR.
+
+(** ** Transition semantics for statements and functions *)
+
+(** Continuations *)
+
+Inductive cont: Type :=
+  | Kstop: cont
+  | Kseq: statement -> cont -> cont
+       (**r [Kseq s2 k] = after [s1] in [s1;s2] *)
+  | Kwhile: expr -> statement -> cont -> cont
+       (**r [Kwhile e s k] = after [s] in [while (e) s] *)
+  | Kdowhile: expr -> statement -> cont -> cont
+       (**r [Kdowhile e s k] = after [s] in [do s while (e)] *)
+  | Kfor2: expr -> statement -> statement -> cont -> cont
+       (**r [Kfor2 e2 e3 s k] = after [s] in [for'(e2;e3) s] *)
+  | Kfor3: expr -> statement -> statement -> cont -> cont
+       (**r [Kfor3 e2 e3 s k] = after [e3] in [for'(e2;e3) s] *)
+  | Kswitch: cont -> cont
+       (**r catches [break] statements arising out of [switch] *)
+  | Kcall: option ident ->                  (**r where to store result *)
+           function ->                      (**r calling function *)
+           env ->                           (**r local env of calling function *)
+           temp_env ->                      (**r temporary env of calling function *)
+           cont -> cont.
+
+(** Pop continuation until a call or stop *)
+
+Fixpoint call_cont (k: cont) : cont :=
+  match k with
+  | Kseq s k => call_cont k
+  | Kwhile e s k => call_cont k
+  | Kdowhile e s k => call_cont k
+  | Kfor2 e2 e3 s k => call_cont k
+  | Kfor3 e2 e3 s k => call_cont k
+  | Kswitch k => call_cont k
+  | _ => k
+  end.
+
+Definition is_call_cont (k: cont) : Prop :=
+  match k with
+  | Kstop => True
+  | Kcall _ _ _ _ _ => True
+  | _ => False
+  end.
+
+(** States *)
+
+Inductive state: Type :=
+  | State
+      (f: function)
+      (s: statement)
+      (k: cont)
+      (e: env)
+      (le: temp_env)
+      (m: mem) : state
+  | Callstate
+      (fd: fundef)
+      (args: list val)
+      (k: cont)
+      (m: mem) : state
+  | Returnstate
+      (res: val)
+      (k: cont)
+      (m: mem) : state.
+                 
+(** Find the statement and manufacture the continuation 
+  corresponding to a label *)
+
+Fixpoint find_label (lbl: label) (s: statement) (k: cont) 
+                    {struct s}: option (statement * cont) :=
+  match s with
+  | Ssequence 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
+  | Swhile a s1 =>
+      find_label lbl s1 (Kwhile a s1 k)
+  | Sdowhile a s1 =>
+      find_label lbl s1 (Kdowhile a s1 k)
+  | Sfor' a2 a3 s1 =>
+      match find_label lbl s1 (Kfor2 a2 a3 s1 k) with
+      | Some sk => Some sk
+      | None => find_label lbl a3 (Kfor3 a2 a3 s1 k)
+      end
+  | Sswitch e sl =>
+      find_label_ls lbl sl (Kswitch k)
+  | Slabel lbl' s' =>
+      if ident_eq lbl lbl' then Some(s', k) else find_label lbl s' k
+  | _ => None
+  end
+
+with find_label_ls (lbl: label) (sl: labeled_statements) (k: cont) 
+                    {struct sl}: option (statement * cont) :=
+  match sl with
+  | LSdefault s => find_label lbl s k
+  | LScase _ s sl' =>
+      match find_label lbl s (Kseq (seq_of_labeled_statement sl') k) with
+      | Some sk => Some sk
+      | None => find_label_ls lbl sl' k
+      end
+  end.
+
+(** Transition relation *)
+
+Inductive step: state -> trace -> state -> Prop :=
+
+  | step_assign:   forall f a1 a2 k e le m loc ofs v2 v m',
+      eval_lvalue e le m a1 loc ofs ->
+      eval_expr e le m a2 v2 ->
+      cast v2 (typeof a2) (typeof a1) v ->
+      store_value_of_type (typeof a1) m loc ofs v = Some m' ->
+      step (State f (Sassign a1 a2) k e le m)
+        E0 (State f Sskip k e le m')
+
+  | step_set:   forall f id a k e le m v,
+      eval_expr e le m a v ->
+      step (State f (Sset id a) k e le m)
+        E0 (State f Sskip k e (PTree.set id v le) m)
+
+  | step_call:   forall f optid a al k e le m tyargs tyres vf vargs fd,
+      typeof a = Tfunction tyargs tyres ->
+      eval_expr e le m a vf ->
+      eval_exprlist e le m al tyargs vargs ->
+      Genv.find_funct ge vf = Some fd ->
+      type_of_fundef fd = typeof a ->
+      step (State f (Scall optid a al) k e le m)
+        E0 (Callstate fd vargs (Kcall optid f e le k) m)
+
+  | step_seq:  forall f s1 s2 k e le m,
+      step (State f (Ssequence s1 s2) k e le m)
+        E0 (State f s1 (Kseq s2 k) e le m)
+  | step_skip_seq: forall f s k e le m,
+      step (State f Sskip (Kseq s k) e le m)
+        E0 (State f s k e le m)
+  | step_continue_seq: forall f s k e le m,
+      step (State f Scontinue (Kseq s k) e le m)
+        E0 (State f Scontinue k e le m)
+  | step_break_seq: forall f s k e le m,
+      step (State f Sbreak (Kseq s k) e le m)
+        E0 (State f Sbreak k e le m)
+
+  | step_ifthenelse_true:  forall f a s1 s2 k e le m v1,
+      eval_expr e le m a v1 ->
+      is_true v1 (typeof a) ->
+      step (State f (Sifthenelse a s1 s2) k e le m)
+        E0 (State f s1 k e le m)
+  | step_ifthenelse_false: forall f a s1 s2 k e le m v1,
+      eval_expr e le m a v1 ->
+      is_false v1 (typeof a) ->
+      step (State f (Sifthenelse a s1 s2) k e le m)
+        E0 (State f s2 k e le m)
+
+  | step_while_false: forall f a s k e le m v,
+      eval_expr e le m a v ->
+      is_false v (typeof a) ->
+      step (State f (Swhile a s) k e le m)
+        E0 (State f Sskip k e le m)
+  | step_while_true: forall f a s k e le m v,
+      eval_expr e le m a v ->
+      is_true v (typeof a) ->
+      step (State f (Swhile a s) k e le m)
+        E0 (State f s (Kwhile a s k) e le m)
+  | step_skip_or_continue_while: forall f x a s k e le m,
+      x = Sskip \/ x = Scontinue ->
+      step (State f x (Kwhile a s k) e le m)
+        E0 (State f (Swhile a s) k e le m)
+  | step_break_while: forall f a s k e le m,
+      step (State f Sbreak (Kwhile a s k) e le m)
+        E0 (State f Sskip k e le m)
+
+  | step_dowhile: forall f a s k e le m,
+      step (State f (Sdowhile a s) k e le m)
+        E0 (State f s (Kdowhile a s k) e le m)
+  | step_skip_or_continue_dowhile_false: forall f x a s k e le m v,
+      x = Sskip \/ x = Scontinue ->
+      eval_expr e le m a v ->
+      is_false v (typeof a) ->
+      step (State f x (Kdowhile a s k) e le m)
+        E0 (State f Sskip k e le m)
+  | step_skip_or_continue_dowhile_true: forall f x a s k e le m v,
+      x = Sskip \/ x = Scontinue ->
+      eval_expr e le m a v ->
+      is_true v (typeof a) ->
+      step (State f x (Kdowhile a s k) e le m)
+        E0 (State f (Sdowhile a s) k e le m)
+  | step_break_dowhile: forall f a s k e le m,
+      step (State f Sbreak (Kdowhile a s k) e le m)
+        E0 (State f Sskip k e le m)
+
+  | step_for_false: forall f a2 a3 s k e le m v,
+      eval_expr e le m a2 v ->
+      is_false v (typeof a2) ->
+      step (State f (Sfor' a2 a3 s) k e le m)
+        E0 (State f Sskip k e le m)
+  | step_for_true: forall f a2 a3 s k e le m v,
+      eval_expr e le m a2 v ->
+      is_true v (typeof a2) ->
+      step (State f (Sfor' a2 a3 s) k e le m)
+        E0 (State f s (Kfor2 a2 a3 s k) e le m)
+  | step_skip_or_continue_for2: forall f x a2 a3 s k e le m,
+      x = Sskip \/ x = Scontinue ->
+      step (State f x (Kfor2 a2 a3 s k) e le m)
+        E0 (State f a3 (Kfor3 a2 a3 s k) e le m)
+  | step_break_for2: forall f a2 a3 s k e le m,
+      step (State f Sbreak (Kfor2 a2 a3 s k) e le m)
+        E0 (State f Sskip k e le m)
+  | step_skip_for3: forall f a2 a3 s k e le m,
+      step (State f Sskip (Kfor3 a2 a3 s k) e le m)
+        E0 (State f (Sfor' a2 a3 s) k e le m)
+  | step_break_for3: forall f a2 a3 s k e le m,
+      step (State f Sbreak (Kfor3 a2 a3 s k) e le m)
+        E0 (State f Sskip k e le m)
+
+  | step_return_0: forall f k e le m m',
+      f.(fn_return) = Tvoid ->
+      Mem.free_list m (blocks_of_env e) = Some m' ->
+      step (State f (Sreturn None) k e le m)
+        E0 (Returnstate Vundef (call_cont k) m')
+  | step_return_1: forall f a k e le m v v' m',
+      eval_expr e le m a v ->
+      cast v (typeof a) f.(fn_return) v' ->
+      Mem.free_list m (blocks_of_env e) = Some m' ->
+      step (State f (Sreturn (Some a)) k e le m)
+        E0 (Returnstate v' (call_cont k) m')
+  | step_skip_call: forall f k e le m m',
+      is_call_cont k ->
+      f.(fn_return) = Tvoid ->
+      Mem.free_list m (blocks_of_env e) = Some m' ->
+      step (State f Sskip k e le m)
+        E0 (Returnstate Vundef k m')
+
+  | step_switch: forall f a sl k e le m n,
+      eval_expr e le m a (Vint n) ->
+      step (State f (Sswitch a sl) k e le m)
+        E0 (State f (seq_of_labeled_statement (select_switch n sl)) (Kswitch k) e le m)
+  | step_skip_break_switch: forall f x k e le m,
+      x = Sskip \/ x = Sbreak ->
+      step (State f x (Kswitch k) e le m)
+        E0 (State f Sskip k e le m)
+  | step_continue_switch: forall f k e le m,
+      step (State f Scontinue (Kswitch k) e le m)
+        E0 (State f Scontinue k e le m)
+
+  | step_label: forall f lbl s k e le m,
+      step (State f (Slabel lbl s) k e le m)
+        E0 (State f s k e le m)
+
+  | step_goto: forall f lbl k e le m s' k',
+      find_label lbl f.(fn_body) (call_cont k) = Some (s', k') ->
+      step (State f (Sgoto lbl) k e le m)
+        E0 (State f s' k' e le m)
+
+  | step_internal_function: forall f vargs k m e m1 m2,
+      list_norepet (var_names f.(fn_params) ++ var_names f.(fn_vars)) ->
+      alloc_variables empty_env m (f.(fn_params) ++ f.(fn_vars)) e m1 ->
+      bind_parameters e m1 f.(fn_params) vargs m2 ->
+      step (Callstate (Internal f) vargs k m)
+        E0 (State f f.(fn_body) k e (PTree.empty val) m2)
+
+  | step_external_function: forall ef targs tres vargs k m vres t m',
+      external_call ef  ge vargs m t vres m' ->
+      step (Callstate (External ef targs tres) vargs k m)
+         t (Returnstate vres k m')
+
+  | step_returnstate_none: forall v f e le k m,
+      step (Returnstate v (Kcall None f e le k) m)
+        E0 (State f Sskip k e le m)
+  | step_returnstate_some: forall v id f e le k m,
+      step (Returnstate v (Kcall (Some id) f e le k) m)
+        E0 (State f Sskip k e (PTree.set id v le) m).
+
+End SEMANTICS.
+
+(** * Whole-program semantics *)
+
+(** 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 ->
+      type_of_fundef f = Tfunction Tnil (Tint I32 Signed) ->
+      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.
+
+(** Execution of a whole program: [exec_program p beh]
+  holds if the application of [p]'s main function to no arguments
+  in the initial memory state for [p] has [beh] as observable
+  behavior. *)
+
+Definition exec_program (p: program) (beh: program_behavior) : Prop :=
+  program_behaves step (initial_state p) final_state (Genv.globalenv p) beh.
diff --git a/cfrontend/Cminorgen.v b/cfrontend/Cminorgen.v
index e60de3d..22c3a5a 100644
--- a/cfrontend/Cminorgen.v
+++ b/cfrontend/Cminorgen.v
@@ -48,6 +48,9 @@ Open Local Scope error_monad_scope.
   of Cminor.
 *)
 
+Definition for_var (id: ident) : ident := xO id.
+Definition for_temp (id: ident) : ident := xI id.
+
 (** Compile-time information attached to each Csharpminor
   variable: global variables, local variables, function parameters.
   [Var_local] denotes a scalar local variable whose address is not
@@ -66,128 +69,7 @@ Inductive var_info: Type :=
 
 Definition compilenv := PMap.t var_info.
 
-(** Infer the type or memory chunk of the result of an expression. *)
-
-Definition chunktype_const (c: Csharpminor.constant) :=
-  match c with
-  | Csharpminor.Ointconst n =>
-      if Int.ltu n (Int.repr 256) then Mint8unsigned 
-      else if Int.ltu n (Int.repr 65536) then Mint16unsigned
-      else Mint32
-  | Csharpminor.Ofloatconst n => Mfloat64
-  end.
-
-Definition chunktype_unop (op: unary_operation) :=
-  match op with
-  | Ocast8unsigned => Mint8unsigned
-  | Ocast8signed => Mint8signed
-  | Ocast16unsigned => Mint16unsigned
-  | Ocast16signed => Mint16signed
-  | Onegint => Mint32
-  | Onotbool => Mint8unsigned
-  | Onotint => Mint32
-  | Onegf => Mfloat64
-  | Oabsf => Mfloat64
-  | Osingleoffloat => Mfloat32
-  | Ointoffloat => Mint32
-  | Ointuoffloat => Mint32
-  | Ofloatofint => Mfloat64
-  | Ofloatofintu => Mfloat64
-  end.
-
-Definition chunktype_logical_op (chunk1 chunk2: memory_chunk) :=
-  match chunk1, chunk2 with
-  | Mint8unsigned, Mint8unsigned => Mint8unsigned
-  | Mint8unsigned, Mint16unsigned => Mint16unsigned
-  | Mint16unsigned, Mint8unsigned => Mint16unsigned
-  | Mint16unsigned, Mint16unsigned => Mint16unsigned
-  | _, _ => Mint32
-  end.
-
-Definition chunktype_binop (op: binary_operation) (chunk1 chunk2: memory_chunk) :=
-  match op with
-  | Oadd => Mint32
-  | Osub => Mint32
-  | Omul => Mint32
-  | Odiv => Mint32
-  | Odivu => Mint32
-  | Omod => Mint32
-  | Omodu => Mint32
-  | Oand => chunktype_logical_op chunk1 chunk2
-  | Oor => chunktype_logical_op chunk1 chunk2
-  | Oxor => chunktype_logical_op chunk1 chunk2
-  | Oshl => Mint32
-  | Oshr => Mint32
-  | Oshru => Mint32
-  | Oaddf => Mfloat64
-  | Osubf => Mfloat64
-  | Omulf => Mfloat64
-  | Odivf => Mfloat64
-  | Ocmp c => Mint8unsigned
-  | Ocmpu c => Mint8unsigned
-  | Ocmpf c => Mint8unsigned
-  end.
-
-Definition chunktype_compat (src dst: memory_chunk) : bool :=
-  match src, dst with
-  | Mint8unsigned, (Mint8unsigned|Mint16unsigned|Mint16signed|Mint32) => true
-  | Mint8signed, (Mint8signed|Mint16signed|Mint32) => true
-  | Mint16unsigned, (Mint16unsigned|Mint32) => true
-  | Mint16signed, (Mint16signed|Mint32) => true
-  | Mint32, Mint32 => true
-  | Mfloat32, (Mfloat32|Mfloat64) => true
-  | Mfloat64, Mfloat64 => true
-  | _, _ => false
-  end.
-
-Definition chunk_for_type (ty: typ) : memory_chunk :=
-  match ty with Tint => Mint32 | Tfloat => Mfloat64 end.
-
-Definition chunktype_merge (c1 c2: memory_chunk) : res memory_chunk :=
-  if chunktype_compat c1 c2 then
-    OK c2
-  else if chunktype_compat c2 c1 then
-    OK c1
-  else if typ_eq (type_of_chunk c1) (type_of_chunk c2) then
-    OK (chunk_for_type (type_of_chunk c1))
-  else
-    Error(msg "Cminorgen: chunktype_merge").
-
-Fixpoint chunktype_expr (cenv: compilenv) (e: Csharpminor.expr)
-                        {struct e}: res memory_chunk :=
-  match e with
-  | Csharpminor.Evar id =>
-      match cenv!!id with
-      | Var_local chunk => OK chunk
-      | Var_stack_scalar chunk ofs => OK chunk
-      | Var_global_scalar chunk => OK chunk
-      | _ => Error(msg "Cminorgen.chunktype_expr")
-      end
-  | Csharpminor.Eaddrof id =>
-      OK Mint32
-  | Csharpminor.Econst cst =>
-      OK (chunktype_const cst)
-  | Csharpminor.Eunop op e1 =>
-      OK (chunktype_unop op)
-  | Csharpminor.Ebinop op e1 e2 =>
-      do chunk1 <- chunktype_expr cenv e1;
-      do chunk2 <- chunktype_expr cenv e2;
-      OK (chunktype_binop op chunk1 chunk2)
-  | Csharpminor.Eload chunk e =>
-      OK chunk
-  | Csharpminor.Econdition e1 e2 e3 =>
-      do chunk2 <- chunktype_expr cenv e2;
-      do chunk3 <- chunktype_expr cenv e3;
-      chunktype_merge chunk2 chunk3
-  end.
-
-Definition type_expr  (cenv: compilenv) (e: Csharpminor.expr): res typ :=
-  do c <- chunktype_expr cenv e; OK(type_of_chunk c).
-
-Definition type_exprlist (cenv: compilenv) (el: list Csharpminor.expr):
-                                                       res (list typ) :=
-  mmap (type_expr cenv) el.
-
+(*****
 (** [make_cast chunk e] returns a Cminor expression that normalizes
   the value of Cminor expression [e] as prescribed by the memory chunk
   [chunk].  For instance, 8-bit sign extension is performed if
@@ -203,6 +85,7 @@ Definition make_cast (chunk: memory_chunk) (e: expr): expr :=
   | Mfloat32 => Eunop Osingleoffloat e
   | Mfloat64 => e
   end.
+**********)
 
 (** When the translation of an expression is stored in memory,
   a cast at the toplevel of the expression can be redundant
@@ -233,24 +116,12 @@ Definition make_stackaddr (ofs: Z): expr :=
 Definition make_globaladdr (id: ident): expr :=
   Econst (Oaddrsymbol id Int.zero).
 
-(** Auxiliary to remove useless conversions. *)
-
-Definition unop_is_cast (op: unary_operation) : option memory_chunk :=
-  match op with
-  | Ocast8unsigned => Some Mint8unsigned
-  | Ocast8signed => Some Mint8signed
-  | Ocast16unsigned => Some Mint16unsigned
-  | Ocast16signed => Some Mint16signed
-  | Osingleoffloat => Some Mfloat32
-  | _ => None
-  end.
-
 (** Generation of a Cminor expression for reading a Csharpminor variable. *)
 
 Definition var_get (cenv: compilenv) (id: ident): res expr :=
   match PMap.get id cenv with
   | Var_local chunk =>
-      OK(Evar id)
+      OK(Evar (for_var id))
   | Var_stack_scalar chunk ofs =>
       OK(Eload chunk (make_stackaddr ofs))
   | Var_global_scalar chunk =>
@@ -271,45 +142,33 @@ Definition var_addr (cenv: compilenv) (id: ident): res expr :=
   end.
 
 (** Generation of a Cminor statement performing an assignment to
-  a variable.  [rhs_chunk] is the inferred chunk type for the
-  right-hand side.  If the variable was allocated to a Cminor variable,
-  a cast may need to be inserted to normalize the value of the r.h.s.,
-  as per Csharpminor's semantics. *)
+  a variable.  The value being assigned is normalized according to
+  its chunk type, as guaranteed by C#minor semantics. *)
 
 Definition var_set (cenv: compilenv)
-                   (id: ident) (rhs: expr) (rhs_chunk: memory_chunk): res stmt :=
+                   (id: ident) (rhs: expr): res stmt :=
   match PMap.get id cenv with
   | Var_local chunk =>
-      if chunktype_compat rhs_chunk chunk then
-        OK(Sassign id rhs)
-      else if typ_eq (type_of_chunk chunk) (type_of_chunk rhs_chunk) then
-        OK(Sassign id (make_cast chunk rhs))
-      else
-        Error(msg "Cminorgen.var_set.1")
+      OK(Sassign (for_var id) rhs)
   | Var_stack_scalar chunk ofs =>
       OK(make_store chunk (make_stackaddr ofs) rhs)
   | Var_global_scalar chunk =>
       OK(make_store chunk (make_globaladdr id) rhs)
   | _ =>
-      Error(msg "Cminorgen.var_set.2")
+      Error(msg "Cminorgen.var_set")
   end.
 
-(** A variant of [var_set] used for initializing function parameters
-  and storing the return values of function calls.  The value to
-  be stored already resides in the Cminor variable called [id].
-  Moreover, its chunk type is not known, only its int-or-float type. *)
+(** A variant of [var_set] used for initializing function parameters.
+  The value to be stored already resides in the Cminor variable called [id]. *)
 
-Definition var_set_self (cenv: compilenv) (id: ident) (ty: typ): res stmt :=
+Definition var_set_self (cenv: compilenv) (id: ident) (ty: typ) (k: stmt): res stmt :=
   match PMap.get id cenv with
   | Var_local chunk =>
-      if typ_eq (type_of_chunk chunk) ty then
-        OK(Sassign id (make_cast chunk (Evar id)))
-      else
-        Error(msg "Cminorgen.var_set_self.1")
+      OK k
   | Var_stack_scalar chunk ofs =>
-      OK(make_store chunk (make_stackaddr ofs) (Evar id))
+      OK (Sseq (make_store chunk (make_stackaddr ofs) (Evar (for_var id))) k)
   | Var_global_scalar chunk =>
-      OK(make_store chunk (make_globaladdr id) (Evar id))
+      OK (Sseq (make_store chunk (make_globaladdr id) (Evar (for_var id))) k)
   | _ =>
       Error(msg "Cminorgen.var_set_self.2")
   end.
@@ -329,19 +188,13 @@ Fixpoint transl_expr (cenv: compilenv) (e: Csharpminor.expr)
                      {struct e}: res expr :=
   match e with
   | Csharpminor.Evar id => var_get cenv id
+  | Csharpminor.Etempvar id => OK (Evar (for_temp id))
   | Csharpminor.Eaddrof id => var_addr cenv id
   | Csharpminor.Econst cst =>
       OK (Econst (transl_constant cst))
   | Csharpminor.Eunop op e1 =>
       do te1 <- transl_expr cenv e1;
-      match unop_is_cast op with
-      | None => OK (Eunop op te1)
-      | Some chunk =>
-          do chunk1 <- chunktype_expr cenv e1;
-          if chunktype_compat chunk1 chunk
-          then OK te1
-          else OK (Eunop op te1)
-      end
+      OK (Eunop op te1)
   | Csharpminor.Ebinop op e1 e2 =>
       do te1 <- transl_expr cenv e1;
       do te2 <- transl_expr cenv e2;
@@ -425,28 +278,19 @@ Fixpoint transl_stmt (ret: option typ) (cenv: compilenv)
   | Csharpminor.Sskip =>
       OK Sskip
   | Csharpminor.Sassign id e =>
-      do chunk <- chunktype_expr cenv e;
       do te <- transl_expr cenv e;
-      var_set cenv id te chunk
+      var_set cenv id te
+  | Csharpminor.Sset id e =>
+      do te <- transl_expr cenv e;
+      OK (Sassign (for_temp id) te)
   | Csharpminor.Sstore chunk e1 e2 =>
       do te1 <- transl_expr cenv e1;
       do te2 <- transl_expr cenv e2;
       OK (make_store chunk te1 te2)
-  | Csharpminor.Scall None sig e el =>
-      do te <- transl_expr cenv e;
-      do tel <- transl_exprlist cenv el;
-      do tyl <- type_exprlist cenv el;
-      if list_eq_dec typ_eq tyl sig.(sig_args)
-      then OK (Scall None sig te tel)
-      else Error(msg "Cminorgen.transl_stmt(call0)")
-  | Csharpminor.Scall (Some id) sig e el =>
+  | Csharpminor.Scall optid sig e el =>
       do te <- transl_expr cenv e;
       do tel <- transl_exprlist cenv el;
-      do tyl <- type_exprlist cenv el;
-      do s <- var_set_self cenv id (proj_sig_res sig);
-      if list_eq_dec typ_eq tyl sig.(sig_args)
-      then OK (Sseq (Scall (Some id) sig te tel) s)
-      else Error(msg "Cminorgen.transl_stmt(call1)")
+      OK (Scall (option_map for_temp optid) sig te tel)
   | Csharpminor.Sseq s1 s2 =>
       do ts1 <- transl_stmt ret cenv xenv s1;
       do ts2 <- transl_stmt ret cenv xenv s2;
@@ -473,10 +317,7 @@ Fixpoint transl_stmt (ret: option typ) (cenv: compilenv)
       OK (Sreturn None)
   | Csharpminor.Sreturn (Some e) =>
       do te <- transl_expr cenv e;
-      do ty <- type_expr cenv e;
-      if typ_eq ty (typ_of_opttyp ret)
-      then OK (Sreturn (Some te))
-      else Error(msg "Cminorgen.transl_stmt(return)")
+      OK (Sreturn (Some te))
   | Csharpminor.Slabel lbl s =>
       do ts <- transl_stmt ret cenv xenv s; OK (Slabel lbl ts)
   | Csharpminor.Sgoto lbl =>
@@ -503,6 +344,7 @@ Module Identset := FSetAVL.Make(OrderedPositive).
 Fixpoint addr_taken_expr (e: Csharpminor.expr): Identset.t :=
   match e with
   | Csharpminor.Evar id => Identset.empty
+  | Csharpminor.Etempvar id => Identset.empty
   | Csharpminor.Eaddrof id => Identset.add id Identset.empty
   | Csharpminor.Econst cst => Identset.empty
   | Csharpminor.Eunop op e1 => addr_taken_expr e1
@@ -525,6 +367,7 @@ Fixpoint addr_taken_stmt (s: Csharpminor.stmt): Identset.t :=
   match s with
   | Csharpminor.Sskip => Identset.empty
   | Csharpminor.Sassign id e => addr_taken_expr e
+  | Csharpminor.Sset id e => addr_taken_expr e
   | Csharpminor.Sstore chunk e1 e2 =>
       Identset.union (addr_taken_expr e1) (addr_taken_expr e2)
   | Csharpminor.Scall optid sig e el =>
@@ -601,8 +444,11 @@ Definition build_compilenv
 Definition assign_global_variable
      (ce: compilenv) (info: ident * globvar var_kind) : compilenv :=
   match info with
-  | (id, mkglobvar (Vscalar chunk) _ _ _ ) => PMap.set id (Var_global_scalar chunk) ce
-  | (id, mkglobvar (Varray _) _ _ _) => PMap.set id Var_global_array ce
+  | (id, mkglobvar vk _ _ _) =>
+      PMap.set id (match vk with Vscalar chunk => Var_global_scalar chunk
+                               | Varray _ => Var_global_array
+                   end)
+               ce
   end.
 
 Definition build_global_compilenv (p: Csharpminor.program) : compilenv :=
@@ -619,45 +465,10 @@ Fixpoint store_parameters
   match params with
   | nil => OK Sskip
   | (id, chunk) :: rem =>
-      do s1 <- var_set_self cenv id (type_of_chunk chunk);
-      do s2 <- store_parameters cenv rem;
-      OK (Sseq s1 s2)
+      do s <- store_parameters cenv rem;
+      var_set_self cenv id (type_of_chunk chunk) s
   end.
 
-(** The local variables of the generated Cminor function
-  must include all local variables of the C#minor function
-  (to help the proof in [Cminorgenproof] go through). 
-  We must also add the destinations [x] of calls [x = f(args)],
-  because some of these [x] can be global variables and therefore
-  not part of the C#minor local variables. *)
-
-Fixpoint call_dest (s: stmt) : Identset.t :=
-  match s with
-  | Sskip => Identset.empty
-  | Sassign x e => Identset.empty
-  | Sstore chunk e1 e2 => Identset.empty
-  | Scall None sg e el => Identset.empty
-  | Scall (Some x) sg e el => Identset.singleton x
-  | Stailcall sg e el => Identset.empty
-  | Sseq s1 s2 => Identset.union (call_dest s1) (call_dest s2)
-  | Sifthenelse e s1 s2 => Identset.union (call_dest s1) (call_dest s2)
-  | Sloop s1 => call_dest s1
-  | Sblock s1 => call_dest s1
-  | Sexit n => Identset.empty
-  | Sswitch e cases dfl => Identset.empty
-  | Sreturn opte => Identset.empty
-  | Slabel lbl s1 => call_dest s1
-  | Sgoto lbl => Identset.empty
-  end.
-
-Definition identset_removelist (l: list ident) (s: Identset.t) : Identset.t :=
-  List.fold_right Identset.remove s l.
-
-Definition make_vars (params: list ident) (vars: list ident)
-                     (body: Cminor.stmt) : list ident :=
-  vars ++ 
-  Identset.elements (identset_removelist (params ++ vars) (call_dest body)).
-
 (** Translation of a Csharpminor function.  We must check that the
   required Cminor stack block is no bigger than [Int.max_signed],
   otherwise address computations within the stack block could
@@ -669,10 +480,9 @@ Definition transl_funbody
     do sparams <- store_parameters cenv f.(Csharpminor.fn_params);
        OK (mkfunction
               (Csharpminor.fn_sig f)
-              (Csharpminor.fn_params_names f)
-              (make_vars (Csharpminor.fn_params_names f)
-                         (Csharpminor.fn_vars_names f)
-                         (Sseq sparams tbody))
+              (List.map for_var (Csharpminor.fn_params_names f))
+              (List.map for_var (Csharpminor.fn_vars_names f) ++
+               List.map for_temp (Csharpminor.fn_temps f))
               stacksize
               (Sseq sparams tbody)).
 
diff --git a/cfrontend/Cminorgenproof.v b/cfrontend/Cminorgenproof.v
index bb7d95a..e28228a 100644
--- a/cfrontend/Cminorgenproof.v
+++ b/cfrontend/Cminorgenproof.v
@@ -40,8 +40,6 @@ Variable prog: Csharpminor.program.
 Variable tprog: program.
 Hypothesis TRANSL: transl_program prog = OK tprog.
 Let ge : Csharpminor.genv := Genv.globalenv prog.
-Let gvare : gvarenv := global_var_env prog.
-Let gve := (ge, gvare).
 Let gce : compilenv := build_global_compilenv prog.
 Let tge: genv := Genv.globalenv tprog.
 
@@ -83,35 +81,42 @@ Proof.
   intro. inv H. reflexivity.
 Qed.
 
-Definition global_compilenv_match (ce: compilenv) (gv: gvarenv) : Prop :=
+Definition global_compilenv_match (ce: compilenv) (ge: Csharpminor.genv) : Prop :=
   forall id,
   match ce!!id with
-  | Var_global_scalar chunk => gv!id = Some (Vscalar chunk)
+  | Var_global_scalar chunk =>
+      forall b gv, Genv.find_symbol ge id = Some b ->
+                   Genv.find_var_info ge b = Some gv ->
+                   gv.(gvar_info) = Vscalar chunk
   | Var_global_array => True
   | _ => False
   end.
 
 Lemma global_compilenv_charact:
-  global_compilenv_match gce gvare.
-Proof.
-  set (mkgve := fun gv (vars: list (ident * globvar var_kind)) =>
-         List.fold_left
-          (fun gve x => match x with (id, v) => PTree.set id v.(gvar_info) gve end)
-          vars gv).
-  assert (forall vars gv ce,
-            global_compilenv_match ce gv ->
-            global_compilenv_match (List.fold_left assign_global_variable vars ce)
-                                   (mkgve gv vars)).
-  induction vars; simpl; intros.
-  auto.
-  apply IHvars. intro id1. unfold assign_global_variable.
-  destruct a as [id2 lv2]. destruct lv2. destruct gvar_info; simpl; rewrite PMap.gsspec; rewrite PTree.gsspec.
-  case (peq id1 id2); intro. auto. apply H. 
-  case (peq id1 id2); intro. auto. apply H.
-
-  change gvare with (mkgve (PTree.empty var_kind) prog.(prog_vars)).
-  unfold gce, build_global_compilenv. apply H. 
-  intro. rewrite PMap.gi. auto.
+  global_compilenv_match gce ge.
+Proof.
+  assert (A: forall ge, global_compilenv_match (PMap.init Var_global_array) ge).
+    intros; red; intros. rewrite PMap.gi. auto.
+  assert (B: forall ce ge v,
+             global_compilenv_match ce ge ->
+             global_compilenv_match (assign_global_variable ce v)
+                                    (Genv.add_variable ge v)).
+  intros; red; intros. destruct v as [id1 [info1 init1 ro1 vo1]].
+  unfold assign_global_variable, Genv.find_symbol, Genv.find_var_info; simpl.
+  rewrite PMap.gsspec. destruct (peq id id1). subst id.
+  destruct info1; auto. 
+  rewrite PTree.gss. intros. inv H0. rewrite ZMap.gss in H1. inv H1. auto. 
+  generalize (H id). destruct (ce!!id); auto.
+  rewrite PTree.gso; auto. intros. rewrite ZMap.gso in H2. eapply H0; eauto.
+  exploit Genv.genv_symb_range; eauto. unfold block, ZIndexed.t; omega.
+  assert (C: forall vl ce ge,
+             global_compilenv_match ce ge ->
+             global_compilenv_match (fold_left assign_global_variable vl ce)
+                                    (Genv.add_variables ge vl)).
+  induction vl; simpl; intros. auto. apply IHvl. apply B. auto.
+
+  unfold gce, build_global_compilenv, ge, Genv.globalenv.
+  apply C. apply A.
 Qed.
 
 (** * Derived properties of memory operations *)
@@ -192,182 +197,6 @@ Proof.
   eapply Mem.nextblock_store; eauto.
 Qed.
 
-(** * Normalized values and operations over memory chunks *)
-
-(** A value is normalized with respect to a memory chunk if it is
-  invariant under the cast (truncation, sign extension) corresponding to
-  the chunk. *)
-
-Definition val_normalized (v: val) (chunk: memory_chunk) : Prop :=
-  Val.load_result chunk v = v.
-
-Lemma val_normalized_has_type:
-  forall chunk v, val_normalized v chunk -> Val.has_type v (type_of_chunk chunk).
-Proof.
-  intros until v; unfold val_normalized, Val.load_result.
-  destruct chunk; destruct v; intro EQ; try (inv EQ); simpl; exact I.
-Qed.
-
-Lemma val_has_type_normalized:
-  forall ty v, Val.has_type v ty -> val_normalized v (chunk_for_type ty).
-Proof.
-  unfold Val.has_type, val_normalized; intros; destruct ty; destruct v;
-  contradiction || reflexivity.
-Qed.
-
-Lemma chunktype_compat_correct:
-  forall src dst v,
-  chunktype_compat src dst = true ->
-  val_normalized v src -> val_normalized v dst.
-Proof.
-  unfold val_normalized; intros. rewrite <- H0.
-  assert (A: 0 < 8 < Z_of_nat Int.wordsize). compute; auto.
-  assert (B: 0 < 16 < Z_of_nat Int.wordsize). compute; auto.
-  assert (C: 8 <= 16 < Z_of_nat Int.wordsize). omega.
-  destruct src; destruct dst; simpl in H; try discriminate; auto;
-  destruct v; simpl; auto.
-  rewrite Int.sign_ext_idem; auto.
-  rewrite Int.sign_ext_widen; auto. 
-  rewrite Int.zero_ext_idem; auto.
-  rewrite Int.sign_zero_ext_widen; auto.
-  rewrite Int.zero_ext_widen; auto.
-  rewrite Int.sign_ext_widen; auto. omega.
-  rewrite Int.zero_ext_idem; auto.
-  rewrite Float.singleoffloat_idem; auto.
-Qed.
-
-Remark int_zero_ext_small:
-  forall x n,
-  0 <= Int.unsigned x < two_p n ->
-  Int.zero_ext n x = x.
-Proof.
-  intros. unfold Int.zero_ext. rewrite Zmod_small; auto. apply Int.repr_unsigned. 
-Qed.
-
-Lemma chunktype_const_correct:
-  forall c v,
-  Csharpminor.eval_constant c = Some v ->
-  val_normalized v (chunktype_const c).
-Proof.
-  unfold Csharpminor.eval_constant; intros. 
-  destruct c; inv H; unfold val_normalized; simpl.
-  case_eq (Int.ltu i (Int.repr 256)); intros.
-  simpl. decEq. apply int_zero_ext_small. exact (Int.ltu_inv _ _ H).
-  case_eq (Int.ltu i (Int.repr 65536)); intros.
-  simpl. decEq. apply int_zero_ext_small. exact (Int.ltu_inv _ _ H0). 
-  simpl; auto.
-  auto.
-Qed.
-
-Lemma chunktype_unop_correct:
-  forall op v1 v,
-  Csharpminor.eval_unop op v1 = Some v ->
-  val_normalized v (chunktype_unop op).
-Proof.
-  intros; destruct op; simpl in *; unfold val_normalized.
-  inv H. destruct v1; simpl; auto. rewrite Int.zero_ext_idem; auto. compute; auto.
-  inv H. destruct v1; simpl; auto. rewrite Int.sign_ext_idem; auto. compute; auto.
-  inv H. destruct v1; simpl; auto. rewrite Int.zero_ext_idem; auto. compute; auto.
-  inv H. destruct v1; simpl; auto. rewrite Int.sign_ext_idem; auto. compute; auto.
-  destruct v1; inv H; auto.
-  destruct v1; inv H. destruct (Int.eq i Int.zero); auto. reflexivity.
-  destruct v1; inv H; auto.
-  destruct v1; inv H; auto.
-  destruct v1; inv H; auto.
-  inv H. destruct v1; simpl; auto. rewrite Float.singleoffloat_idem; auto.
-  destruct v1; inv H; auto.
-  destruct v1; inv H; auto.
-  destruct v1; inv H; auto.
-  destruct v1; inv H; auto.
-Qed.
-
-Lemma chunktype_logical_op_correct:
-  forall (logop: int -> int -> int)
-         (DISTR: forall a b c, logop (Int.and a c) (Int.and b c) =
-                               Int.and (logop a b) c)
-         n1 c1 n2 c2,
-  val_normalized (Vint n1) c1 -> val_normalized (Vint n2) c2 ->
-  val_normalized (Vint (logop n1 n2)) (chunktype_logical_op c1 c2).
-Proof.
-  intros. set (c := chunktype_logical_op c1 c2).
-  assert (val_normalized (Vint n1) c /\ val_normalized (Vint n2) c).
-    unfold c, chunktype_logical_op. 
-    destruct c1; destruct c2; split; try (auto; unfold val_normalized; reflexivity).
-    apply chunktype_compat_correct with Mint8unsigned; auto.
-    apply chunktype_compat_correct with Mint8unsigned; auto.
-  destruct H1. 
-  assert (c = Mint8unsigned \/ c = Mint16unsigned \/ c = Mint32).
-    unfold c. destruct c1; auto; destruct c2; auto.
-  destruct H3 as [A | [A | A]]; rewrite A in *.
-  unfold val_normalized in *. simpl in *.
-  assert (0 < 8 < Z_of_nat Int.wordsize). compute; auto.
-  rewrite Int.zero_ext_and in *; auto.
-  set (m := Int.repr (two_p 8 - 1)) in *.
-  rewrite <- DISTR. congruence.
-  unfold val_normalized in *. simpl in *.
-  assert (0 < 16 < Z_of_nat Int.wordsize). compute; auto.
-  rewrite Int.zero_ext_and in *; auto.
-  set (m := Int.repr (two_p 16 - 1)) in *.
-  rewrite <- DISTR. congruence.
-  red. auto.
-Qed.
-
-Lemma chunktype_binop_correct:
-  forall op v1 v2 c1 c2 m v,
-  Csharpminor.eval_binop op v1 v2 m = Some v ->
-  val_normalized v1 c1 -> val_normalized v2 c2 ->
-  val_normalized v (chunktype_binop op c1 c2).
-Proof.
-  intros; destruct op; simpl in *; unfold val_normalized;
-  destruct v1; destruct v2; try (inv H; reflexivity).
-  destruct (eq_block b b0); inv H; auto.
-  destruct (Int.eq i0 Int.zero); inv H; auto.
-  destruct (Int.eq i0 Int.zero); inv H; auto.
-  destruct (Int.eq i0 Int.zero); inv H; auto.
-  destruct (Int.eq i0 Int.zero); inv H; auto.
-  inv H. apply chunktype_logical_op_correct; auto. 
-  intros. repeat rewrite Int.and_assoc. decEq. 
-  rewrite (Int.and_commut b c). rewrite <- Int.and_assoc. rewrite Int.and_idem. auto.
-  inv H. apply chunktype_logical_op_correct; auto. 
-  intros. rewrite (Int.and_commut a c). rewrite (Int.and_commut b c).
-  rewrite <- Int.and_or_distrib. apply Int.and_commut.
-  inv H. apply chunktype_logical_op_correct; auto. 
-  intros. rewrite (Int.and_commut a c). rewrite (Int.and_commut b c).
-  rewrite <- Int.and_xor_distrib. apply Int.and_commut.
-  destruct (Int.ltu i0 Int.iwordsize); inv H; auto.
-  destruct (Int.ltu i0 Int.iwordsize); inv H; auto.
-  destruct (Int.ltu i0 Int.iwordsize); inv H; auto.
-  inv H; destruct (Int.cmp c i i0); reflexivity.
-  unfold eval_compare_null in H. destruct (Int.eq i Int.zero).
-  destruct c; inv H; auto. inv H.
-  unfold eval_compare_null in H. destruct (Int.eq i0 Int.zero).
-  destruct c; inv H; auto. inv H.
-  destruct (Mem.valid_pointer m b (Int.signed i) &&
-            Mem.valid_pointer m b0 (Int.signed i0)).
-  destruct (eq_block b b0); inv H. destruct (Int.cmp c i i0); auto.
-  destruct c; inv H3; auto. inv H.
-  inv H. destruct (Int.cmpu c i i0); auto.
-  inv H. destruct (Float.cmp c f f0); auto.
-Qed.
-
-Lemma chunktype_merge_correct:
-  forall c1 c2 c v,
-  chunktype_merge c1 c2 = OK c ->
-  val_normalized v c1 \/ val_normalized v c2 ->
-  val_normalized v c.
-Proof.
-  intros until v. unfold chunktype_merge. 
-  case_eq (chunktype_compat c1 c2).
-  intros. inv H0. destruct H1. eapply chunktype_compat_correct; eauto. auto.
-  case_eq (chunktype_compat c2 c1).
-  intros. inv H1. destruct H2. auto. eapply chunktype_compat_correct; eauto.
-  intros. destruct (typ_eq (type_of_chunk c1) (type_of_chunk c2)); inv H1.
-  apply val_has_type_normalized. destruct H2. 
-  apply val_normalized_has_type. auto.
-  rewrite e. apply val_normalized_has_type. auto.
-Qed.
-
-
 (** * Correspondence between Csharpminor's and Cminor's environments and memory states *)
 
 (** In Csharpminor, every variable is stored in a separate memory block.
@@ -407,7 +236,7 @@ Inductive match_var (f: meminj) (id: ident)
       PTree.get id e = Some (b, Vscalar chunk) ->
       Mem.load chunk m b 0 = Some v ->
       f b = None ->
-      PTree.get id te = Some v' ->
+      PTree.get (for_var id) te = Some v' ->
       val_inject f v v' ->
       match_var f id e m te sp (Var_local chunk)
   | match_var_stack_scalar:
@@ -423,7 +252,9 @@ Inductive match_var (f: meminj) (id: ident)
   | match_var_global_scalar:
       forall chunk,
       PTree.get id e = None ->
-      PTree.get id gvare = Some (Vscalar chunk) ->
+      (forall b gv, Genv.find_symbol ge id = Some b ->
+                    Genv.find_var_info ge b = Some gv ->
+                    gvar_info gv = Vscalar chunk) ->
       match_var f id e m te sp (Var_global_scalar chunk)
   | match_var_global_array:
       PTree.get id e = None ->
@@ -434,7 +265,8 @@ Inductive match_var (f: meminj) (id: ident)
   of addresses for the blocks referenced from [te]. *)
 
 Record match_env (f: meminj) (cenv: compilenv)
-                 (e: Csharpminor.env) (m: mem) (te: env) (sp: block)
+                 (e: Csharpminor.env) (le: Csharpminor.temp_env) (m: mem)
+                 (te: env) (sp: block)
                  (lo hi: Z) : Prop :=
   mk_match_env {
 
@@ -443,6 +275,11 @@ Record match_env (f: meminj) (cenv: compilenv)
     me_vars:
       forall id, match_var f id e m te sp (PMap.get id cenv);
 
+(** Temporaries match *)
+    me_temps:
+      forall id v, le!id = Some v ->
+      exists v', te!(for_temp id) = Some v' /\ val_inject f v v';
+
 (** [lo, hi] is a proper interval. *)
     me_low_high:
       lo <= hi;
@@ -490,11 +327,11 @@ Ltac geninv x :=
   let H := fresh in (generalize x; intro H; inv H).
 
 Lemma match_env_store_mapped:
-  forall f cenv e m1 m2 te sp lo hi chunk b ofs v,
+  forall f cenv e le m1 m2 te sp lo hi chunk b ofs v,
   f b <> None ->
   Mem.store chunk m1 b ofs v = Some m2 ->
-  match_env f cenv e m1 te sp lo hi ->
-  match_env f cenv e m2 te sp lo hi.
+  match_env f cenv e le m1 te sp lo hi ->
+  match_env f cenv e le m2 te sp lo hi.
 Proof.
   intros; inv H1; constructor; auto.
   (* vars *)
@@ -507,17 +344,24 @@ Qed.
 
 (** Preservation by assignment to a Csharpminor variable that is 
   translated to a Cminor local variable.  The value being assigned
-  must be normalized with respect to the memory chunk of the variable,
-  in the following sense. *)
+  must be normalized with respect to the memory chunk of the variable. *)
+
+Remark val_normalized_has_type:
+  forall v chunk,
+  val_normalized v chunk -> Val.has_type v (type_of_chunk chunk).
+Proof.
+  intros. red in H. rewrite <- H. 
+  destruct chunk; destruct v; exact I.
+Qed.
 
 Lemma match_env_store_local:
-  forall f cenv e m1 m2 te sp lo hi id b chunk v tv,
+  forall f cenv e le m1 m2 te sp lo hi id b chunk v tv,
   e!id = Some(b, Vscalar chunk) ->
-  Val.has_type v (type_of_chunk chunk) ->
-  val_inject f (Val.load_result chunk v) tv ->
+  val_normalized v chunk ->
+  val_inject f v tv ->
   Mem.store chunk m1 b 0 v = Some m2 ->
-  match_env f cenv e m1 te sp lo hi ->
-  match_env f cenv e m2 (PTree.set id tv te) sp lo hi.
+  match_env f cenv e le m1 te sp lo hi ->
+  match_env f cenv e le m2 (PTree.set (for_var id) tv te) sp lo hi.
 Proof.
   intros. inv H3. constructor; auto.
   (* vars *)
@@ -529,13 +373,13 @@ Proof.
     assert (b0 = b) by congruence. subst.
     assert (chunk0 = chunk) by congruence. subst.
     econstructor. eauto. 
-    eapply Mem.load_store_same; eauto. auto. 
+    eapply Mem.load_store_same; eauto. apply val_normalized_has_type; auto. auto. 
     rewrite PTree.gss. reflexivity.
-    auto.
+    red in H0. rewrite H0. auto. 
     (* a different variable *)
     econstructor; eauto.
     rewrite <- H6. eapply Mem.load_store_other; eauto. 
-    rewrite PTree.gso; auto.
+    rewrite PTree.gso; auto. unfold for_var; congruence.
   (* var_stack_scalar *)
   econstructor; eauto.
   (* var_stack_array *)
@@ -544,22 +388,52 @@ Proof.
   econstructor; eauto.
   (* var_global_array *)
   econstructor; eauto.
+  (* temps *)
+  intros. rewrite PTree.gso. auto. unfold for_temp, for_var; congruence. 
   (* bounds *)
   intros. rewrite (Mem.bounds_store _ _ _ _ _ _ H2). eauto. 
 Qed.
 
+(** Preservation by assignment to a Csharpminor temporary and the
+  corresponding Cminor local variable. *)
+
+Lemma match_env_set_temp:
+  forall f cenv e le m te sp lo hi id v tv,
+  val_inject f v tv ->
+  match_env f cenv e le m te sp lo hi ->
+  match_env f cenv e (PTree.set id v le) m (PTree.set (for_temp id) tv te) sp lo hi.
+Proof.
+  intros. inv H0. constructor; auto.
+  (* vars *)
+  intros. geninv (me_vars0 id0).
+  (* var_local *)
+  econstructor; eauto. rewrite PTree.gso. auto. unfold for_var, for_temp; congruence.
+  (* var_stack_scalar *)
+  econstructor; eauto.
+  (* var_stack_array *)
+  econstructor; eauto.
+  (* var_global_scalar *)
+  econstructor; eauto.
+  (* var_global_array *)
+  econstructor; eauto.
+  (* temps *)
+  intros. rewrite PTree.gsspec in H0. destruct (peq id0 id). 
+  inv H0. exists tv; split; auto. apply PTree.gss.
+  rewrite PTree.gso. eauto. unfold for_temp; congruence.
+Qed.
+
 (** The [match_env] relation is preserved by any memory operation
   that preserves sizes and loads from blocks in the [lo, hi] range. *)
 
 Lemma match_env_invariant:
-  forall f cenv e m1 m2 te sp lo hi,
+  forall f cenv e le m1 m2 te sp lo hi,
   (forall b ofs chunk v, 
      lo <= b < hi -> Mem.load chunk m1 b ofs = Some v ->
      Mem.load chunk m2 b ofs = Some v) ->
   (forall b,
      lo <= b < hi -> Mem.bounds m2 b = Mem.bounds m1 b) ->
-  match_env f cenv e m1 te sp lo hi ->
-  match_env f cenv e m2 te sp lo hi.
+  match_env f cenv e le m1 te sp lo hi ->
+  match_env f cenv e le m2 te sp lo hi.
 Proof.
   intros. inv H1. constructor; eauto.
   (* vars *)
@@ -571,14 +445,15 @@ Qed.
 (** [match_env] is insensitive to the Cminor values of stack-allocated data. *)
 
 Lemma match_env_extensional:
-  forall f cenv e m te1 sp lo hi te2,
-  match_env f cenv e m te1 sp lo hi ->
-  (forall id chunk, cenv!!id = Var_local chunk -> te2!id = te1!id) ->
-  match_env f cenv e m te2 sp lo hi.
+  forall f cenv e le m te1 sp lo hi te2,
+  match_env f cenv e le m te1 sp lo hi ->
+  (forall id chunk, cenv!!id = Var_local chunk -> te2!(for_var id) = te1!(for_var id)) ->
+  (forall id v, le!id = Some v -> te2!(for_temp id) = te1!(for_temp id)) ->
+  match_env f cenv e le m te2 sp lo hi.
 Proof.
   intros. inv H; econstructor; eauto.
-  intros. geninv (me_vars0 id); econstructor; eauto.
-  rewrite <- H5. eauto. 
+  intros. geninv (me_vars0 id); econstructor; eauto. rewrite <- H6. eauto.
+  intros. rewrite (H1 _ _ H). auto. 
 Qed.
 
 (** [match_env] and allocations *)
@@ -592,15 +467,15 @@ Inductive alloc_condition: var_info -> var_kind -> block -> option (block * Z) -
       alloc_condition (Var_stack_array pos) (Varray sz) sp (Some(sp, pos)).
 
 Lemma match_env_alloc_same:
-  forall f1 cenv e m1 te sp lo lv m2 b f2 id info tv,
-  match_env f1 cenv e m1 te sp lo (Mem.nextblock m1) ->
+  forall f1 cenv e le m1 te sp lo lv m2 b f2 id info tv,
+  match_env f1 cenv e le m1 te sp lo (Mem.nextblock m1) ->
   Mem.alloc m1 0 (sizeof lv) = (m2, b) ->
   inject_incr f1 f2 ->
   alloc_condition info lv sp (f2 b) ->
   (forall b', b' <> b -> f2 b' = f1 b') ->
-  te!id = Some tv ->
+  te!(for_var id) = Some tv ->
   e!id = None ->
-  match_env f2 (PMap.set id info cenv) (PTree.set id (b, lv) e) m2 te sp lo (Mem.nextblock m2).
+  match_env f2 (PMap.set id info cenv) (PTree.set id (b, lv) e) le m2 te sp lo (Mem.nextblock m2).
 Proof.
   intros until tv.
   intros ME ALLOC INCR ACOND OTHER TE E.
@@ -638,6 +513,9 @@ Proof.
   rewrite PTree.gso; auto. auto. 
     (* global array *)
   rewrite PTree.gso; auto.
+(* temps *)
+  intros. exploit me_temps0; eauto. intros [v' [A B]]. 
+  exists v'; split; auto. eapply val_inject_incr; eauto.
 (* low high *)
   exploit Mem.nextblock_alloc; eauto. unfold block in *; omega.
 (* bounded *)
@@ -675,14 +553,14 @@ Proof.
 Qed.
 
 Lemma match_env_alloc_other:
-  forall f1 cenv e m1 te sp lo hi sz m2 b f2,
-  match_env f1 cenv e m1 te sp lo hi ->
+  forall f1 cenv e le m1 te sp lo hi sz m2 b f2,
+  match_env f1 cenv e le m1 te sp lo hi ->
   Mem.alloc m1 0 sz = (m2, b) ->
   inject_incr f1 f2 ->
   (forall b', b' <> b -> f2 b' = f1 b') ->
   hi <= b ->
   match f2 b with None => True | Some(b',ofs) => sp < b' end ->
-  match_env f2 cenv e m2 te sp lo hi.
+  match_env f2 cenv e le m2 te sp lo hi.
 Proof.
   intros until f2; intros ME ALLOC INCR OTHER BOUND TBOUND.
   inv ME.
@@ -703,6 +581,9 @@ Proof.
   auto. auto. 
     (* global array *)
   auto.
+(* temps *)
+  intros. exploit me_temps0; eauto. intros [v' [A B]]. 
+  exists v'; split; auto. eapply val_inject_incr; eauto.
 (* inv *)
   intros. rewrite OTHER in H. eauto. 
   red; intro; subst b0. rewrite H in TBOUND. omegaContradiction.
@@ -740,14 +621,14 @@ Proof.
 Qed.
 
 Lemma match_env_external_call:
-  forall f1 cenv e m1 te sp lo hi m2 f2 m1',
-  match_env f1 cenv e m1 te sp lo hi ->
+  forall f1 cenv e le m1 te sp lo hi m2 f2 m1',
+  match_env f1 cenv e le m1 te sp lo hi ->
   mem_unchanged_on (loc_unmapped f1) m1 m2 ->
   inject_incr f1 f2 ->
   inject_separated f1 f2 m1 m1' ->
   (forall b, Mem.valid_block m1 b -> Mem.bounds m2 b = Mem.bounds m1 b) ->
   hi <= Mem.nextblock m1 -> sp < Mem.nextblock m1' ->
-  match_env f2 cenv e m2 te sp lo hi.
+  match_env f2 cenv e le m2 te sp lo hi.
 Proof.
   intros until m1'. intros ME UNCHANGED INCR SEPARATED BOUNDS VALID VALID'.
   destruct UNCHANGED as [UNCHANGED1 UNCHANGED2].
@@ -761,6 +642,9 @@ Proof.
     rewrite <- H3. eapply inject_incr_separated_same; eauto.
     red. exploit me_bounded0; eauto. omega. 
     eauto. eauto.
+(* temps *)
+  intros. exploit me_temps0; eauto. intros [v' [A B]]. 
+  exists v'; split; auto. eapply val_inject_incr; eauto.
 (* inv *)
   intros. apply me_inv0 with delta. eapply inject_incr_separated_same'; eauto.
 (* incr *)
@@ -785,6 +669,7 @@ Inductive frame : Type :=
   Frame(cenv: compilenv)
        (tf: Cminor.function)
        (e: Csharpminor.env)
+       (le: Csharpminor.temp_env)
        (te: Cminor.env)
        (sp: block)
        (lo hi: Z).
@@ -827,13 +712,13 @@ Inductive match_callstack (f: meminj) (m: mem) (tm: mem):
       hi <= bound -> hi <= tbound ->
       match_callstack f m tm nil bound tbound 
   | mcs_cons:
-      forall cenv tf e te sp lo hi cs bound tbound
+      forall cenv tf e le te sp lo hi cs bound tbound
         (BOUND: hi <= bound)
         (TBOUND: sp < tbound)
-        (MENV: match_env f cenv e m te sp lo hi)
+        (MENV: match_env f cenv e le m te sp lo hi)
         (PERM: padding_freeable f m tm sp tf.(fn_stackspace))
         (MCS: match_callstack f m tm cs lo sp),
-      match_callstack f m tm (Frame cenv tf e te sp lo hi :: cs) bound tbound.
+      match_callstack f m tm (Frame cenv tf e le te sp lo hi :: cs) bound tbound.
 
 (** [match_callstack] implies [match_globalenvs]. *)
 
@@ -849,9 +734,9 @@ Qed.
     generalize those for [match_env]. *)
 
 Lemma padding_freeable_invariant:
-  forall f1 m1 tm1 sp sz cenv e te lo hi f2 m2 tm2,
+  forall f1 m1 tm1 sp sz cenv e le te lo hi f2 m2 tm2,
   padding_freeable f1 m1 tm1 sp sz ->
-  match_env f1 cenv e m1 te sp lo hi ->
+  match_env f1 cenv e le m1 te sp lo hi ->
   (forall ofs, Mem.perm tm1 sp ofs Freeable -> Mem.perm tm2 sp ofs Freeable) ->
   (forall b, b < hi -> Mem.bounds m2 b = Mem.bounds m1 b) ->
   (forall b, b < hi -> f2 b = f1 b) ->
@@ -903,10 +788,10 @@ Lemma match_callstack_invariant:
   forall f m tm cs bound tbound,
   match_callstack f m tm cs bound tbound ->
   forall m' tm',
-  (forall cenv e te sp lo hi,
+  (forall cenv e le te sp lo hi,
     hi <= bound ->
-    match_env f cenv e m te sp lo hi ->
-    match_env f cenv e m' te sp lo hi) ->
+    match_env f cenv e le m te sp lo hi ->
+    match_env f cenv e le m' te sp lo hi) ->
   (forall b,
     b < bound -> Mem.bounds m' b = Mem.bounds m b) ->
   (forall b ofs p,
@@ -925,13 +810,13 @@ Proof.
 Qed.
 
 Lemma match_callstack_store_local:
-  forall f cenv e te sp lo hi cs bound tbound m1 m2 tm tf id b chunk v tv,
+  forall f cenv e le te sp lo hi cs bound tbound m1 m2 tm tf id b chunk v tv,
   e!id = Some(b, Vscalar chunk) ->
-  Val.has_type v (type_of_chunk chunk) ->
-  val_inject f (Val.load_result chunk v) tv ->
+  val_normalized v chunk ->
+  val_inject f v tv ->
   Mem.store chunk m1 b 0 v = Some m2 ->
-  match_callstack f m1 tm (Frame cenv tf e te sp lo hi :: cs) bound tbound ->
-  match_callstack f m2 tm (Frame cenv tf e (PTree.set id tv te) sp lo hi :: cs) bound tbound.
+  match_callstack f m1 tm (Frame cenv tf e le te sp lo hi :: cs) bound tbound ->
+  match_callstack f m2 tm (Frame cenv tf e le (PTree.set (for_var id) tv te) sp lo hi :: cs) bound tbound.
 Proof.
   intros. inv H3. constructor; auto.
   eapply match_env_store_local; eauto.
@@ -951,19 +836,34 @@ Qed.
   takes place on the Cminor side. *)
 
 Lemma match_callstack_store_local_unchanged:
-  forall f cenv e te sp lo hi cs bound tbound m1 m2 id b chunk v tv tf tm,
+  forall f cenv e le te sp lo hi cs bound tbound m1 m2 id b chunk v tv tf tm,
   e!id = Some(b, Vscalar chunk) ->
-  Val.has_type v (type_of_chunk chunk) ->
-  val_inject f (Val.load_result chunk v) tv ->
+  val_normalized v chunk ->
+  val_inject f v tv ->
   Mem.store chunk m1 b 0 v = Some m2 ->
-  te!id = Some tv ->
-  match_callstack f m1 tm (Frame cenv tf e te sp lo hi :: cs) bound tbound ->
-  match_callstack f m2 tm (Frame cenv tf e te sp lo hi :: cs) bound tbound.
+  te!(for_var id) = Some tv ->
+  match_callstack f m1 tm (Frame cenv tf e le te sp lo hi :: cs) bound tbound ->
+  match_callstack f m2 tm (Frame cenv tf e le te sp lo hi :: cs) bound tbound.
 Proof.
+Opaque for_var.
   intros. exploit match_callstack_store_local; eauto. intro MCS.
   inv MCS. constructor; auto. eapply match_env_extensional; eauto. 
-  intros. rewrite PTree.gsspec. 
-  case (peq id0 id); intros. congruence. auto.
+  intros. rewrite PTree.gsspec.
+Transparent for_var.
+  case (peq (for_var id0) (for_var id)); intros.
+  unfold for_var in e0. congruence.
+  auto.
+  intros. rewrite PTree.gso; auto. unfold for_temp, for_var; congruence.
+Qed.
+
+Lemma match_callstack_set_temp:
+  forall f cenv e le te sp lo hi cs bound tbound m tm tf id v tv,
+  val_inject f v tv ->
+  match_callstack f m tm (Frame cenv tf e le te sp lo hi :: cs) bound tbound ->
+  match_callstack f m tm (Frame cenv tf e (PTree.set id v le) (PTree.set (for_temp id) tv te) sp lo hi :: cs) bound tbound.
+Proof.
+  intros. inv H0. constructor; auto.
+  eapply match_env_set_temp; eauto. 
 Qed.
 
 Lemma match_callstack_incr_bound:
@@ -1018,10 +918,10 @@ Qed.
 *)
 
 Lemma match_callstack_freelist:
-  forall f cenv tf e te sp lo hi cs m m' tm,
+  forall f cenv tf e le te sp lo hi cs m m' tm,
   Mem.inject f m tm ->
   Mem.free_list m (blocks_of_env e) = Some m' ->
-  match_callstack f m tm (Frame cenv tf e te sp lo hi :: cs) (Mem.nextblock m) (Mem.nextblock tm) ->
+  match_callstack f m tm (Frame cenv tf e le te sp lo hi :: cs) (Mem.nextblock m) (Mem.nextblock tm) ->
   exists tm',
   Mem.free tm sp 0 tf.(fn_stackspace) = Some tm'
   /\ match_callstack f m' tm' cs (Mem.nextblock m') (Mem.nextblock tm')
@@ -1091,18 +991,18 @@ Proof.
 Qed.
 
 Lemma match_callstack_alloc_left:
-  forall f1 m1 tm cenv tf e te sp lo cs lv m2 b f2 info id tv,
+  forall f1 m1 tm cenv tf e le te sp lo cs lv m2 b f2 info id tv,
   match_callstack f1 m1 tm
-    (Frame cenv tf e te sp lo (Mem.nextblock m1) :: cs)
+    (Frame cenv tf e le te sp lo (Mem.nextblock m1) :: cs)
     (Mem.nextblock m1) (Mem.nextblock tm) ->
   Mem.alloc m1 0 (sizeof lv) = (m2, b) ->
   inject_incr f1 f2 ->
   alloc_condition info lv sp (f2 b) ->
   (forall b', b' <> b -> f2 b' = f1 b') ->
-  te!id = Some tv ->
+  te!(for_var id) = Some tv ->
   e!id = None ->
   match_callstack f2 m2 tm
-    (Frame (PMap.set id info cenv) tf (PTree.set id (b, lv) e) te sp lo (Mem.nextblock m2) :: cs)
+    (Frame (PMap.set id info cenv) tf (PTree.set id (b, lv) e) le te sp lo (Mem.nextblock m2) :: cs)
     (Mem.nextblock m2) (Mem.nextblock tm).
 Proof.
   intros until tv; intros MCS ALLOC INCR ACOND OTHER TE E.
@@ -1126,7 +1026,7 @@ Lemma match_callstack_alloc_right:
   Mem.alloc tm 0 tf.(fn_stackspace) = (tm', sp) ->
   Mem.inject f m tm ->
   match_callstack f m tm'
-    (Frame gce tf empty_env te sp (Mem.nextblock m) (Mem.nextblock m) :: cs)
+    (Frame gce tf empty_env empty_temp_env te sp (Mem.nextblock m) (Mem.nextblock m) :: cs)
     (Mem.nextblock m) (Mem.nextblock tm').
 Proof.
   intros.
@@ -1139,7 +1039,9 @@ Proof.
   intros. generalize (global_compilenv_charact id); intro. 
   destruct (gce!!id); try contradiction. 
   constructor. apply PTree.gempty. auto.
-  constructor. apply PTree.gempty. 
+  constructor. apply PTree.gempty.
+(* temps *)
+  intros. rewrite PTree.gempty in H2. congruence.  
 (* low high *)
   omega.
 (* bounded *)
@@ -1171,8 +1073,8 @@ Definition is_reachable (f: meminj) (m: mem) (sp: block) (ofs: Z) : Prop :=
   /\ Mem.low_bound m b + delta <= ofs < Mem.high_bound m b + delta.
 
 Lemma is_reachable_dec:
-  forall f cenv e m te sp lo hi ofs,
-  match_env f cenv e m te sp lo hi ->
+  forall f cenv e le m te sp lo hi ofs,
+  match_env f cenv e le m te sp lo hi ->
   {is_reachable f m sp ofs} + {~is_reachable f m sp ofs}.
 Proof.
   intros.
@@ -1233,7 +1135,7 @@ Proof.
   eapply match_env_external_call; eauto. omega. omega. 
   (* padding-freeable *)
   red; intros.
-  destruct (is_reachable_dec _ _ _ _ _ _ _ _ ofs MENV).
+  destruct (is_reachable_dec _ _ _ _ _ _ _ _ _ ofs MENV).
   destruct i as [b [delta [A B]]].
   right; exists b; exists delta; split.
   apply INCR; auto. rewrite BOUNDS. auto. 
@@ -1270,77 +1172,6 @@ Proof.
   intros. symmetry. eapply IMAGE; eauto. 
 Qed.
 
-(** * Soundness of chunk and type inference. *)
-
-Lemma load_normalized:
-  forall chunk m b ofs v,
-  Mem.load chunk m b ofs = Some v -> val_normalized v chunk.
-Proof.
-  intros. 
-  exploit Mem.load_type; eauto. intro TY.
-  exploit Mem.load_cast; eauto. intro CST.
-  red. destruct chunk; destruct v; simpl in *; auto; contradiction.
-Qed.
-
-Lemma chunktype_expr_correct:
-  forall f m tm cenv tf e te sp lo hi cs bound tbound,
-  match_callstack f m tm (Frame cenv tf e te sp lo hi :: cs) bound tbound ->
-  forall a v,
-  Csharpminor.eval_expr gve e m a v ->
-  forall chunk (CTE: chunktype_expr cenv a = OK chunk),
-  val_normalized v chunk.
-Proof.
-  intros until tbound; intro MCS. induction 1; intros; try (monadInv CTE).
-(* var *)
-  assert (chunk0 = chunk).
-    unfold chunktype_expr in CTE. 
-    inv MCS. inv MENV. generalize (me_vars0 id); intro MV.
-    inv MV; rewrite <- H1 in CTE; monadInv CTE; inv H; try congruence.
-    unfold gve in H6. simpl in H6. congruence.
-  subst chunk0.
-  inv H; exploit load_normalized; eauto. unfold val_normalized; auto.
-(* const *)
-  eapply chunktype_const_correct; eauto.
-(* unop *)
-  eapply chunktype_unop_correct; eauto.
-(* binop *)
-  eapply chunktype_binop_correct; eauto.
-(* load *)
-  destruct v1; simpl in H0; try discriminate. 
-  eapply load_normalized; eauto.
-(* cond *)
-  eapply chunktype_merge_correct; eauto. 
-  destruct vb1; eauto.
-Qed.
-
-Lemma type_expr_correct:
-  forall f m tm cenv tf e te sp lo hi cs bound tbound,
-  match_callstack f m tm (Frame cenv tf e te sp lo hi :: cs) bound tbound ->
-  forall a v ty,
-  Csharpminor.eval_expr gve e m a v ->
-  type_expr cenv a = OK ty ->
-  Val.has_type v ty.
-Proof.
-  intros. monadInv H1. apply val_normalized_has_type. 
-  eapply chunktype_expr_correct; eauto.
-Qed.
-
-Lemma type_exprlist_correct:
-  forall f m tm cenv tf e te sp lo hi cs bound tbound,
-  match_callstack f m tm (Frame cenv tf e te sp lo hi :: cs) bound tbound ->
-  forall al vl tyl,
-  Csharpminor.eval_exprlist gve e m al vl ->
-  type_exprlist cenv al = OK tyl ->
-  Val.has_type_list vl tyl.
-Proof.
-  intros. monadInv H1. 
-  generalize al vl H0 tyl H2. induction 1; intros.
-  inv H3. simpl. auto.
-  inv H5. simpl. split.
-  eapply type_expr_correct; eauto.
-  auto.
-Qed.
-
 (** * Correctness of Cminor construction functions *)
 
 Remark val_inject_val_of_bool:
@@ -1503,41 +1334,6 @@ Proof.
   inv H0; try discriminate; inv H1; inv H; TrivialOp.
 Qed.
 
-(** Correctness of [make_cast].  Note that the resulting Cminor value is
-  normalized according to the given memory chunk. *)
-
-Lemma make_cast_correct:
-  forall f sp te tm a v tv chunk,
-  eval_expr tge sp te tm a tv ->
-  val_inject f v tv ->
-  exists tv',
-     eval_expr tge sp te tm (make_cast chunk a) tv'
-  /\ val_inject f (Val.load_result chunk v) tv'.
-Proof.
-  intros. destruct chunk; simpl make_cast.
-
-  exists (Val.sign_ext 8 tv). 
-  split. eauto with evalexpr. inversion H0; simpl; constructor.
-
-  exists (Val.zero_ext 8 tv). 
-  split. eauto with evalexpr. inversion H0; simpl; constructor.
-
-  exists (Val.sign_ext 16 tv). 
-  split. eauto with evalexpr. inversion H0; simpl; constructor.
-
-  exists (Val.zero_ext 16 tv). 
-  split. eauto with evalexpr. inversion H0; simpl; constructor.
-
-  exists tv.
-  split. auto. inversion H0; simpl; econstructor; eauto.
-
-  exists (Val.singleoffloat tv). 
-  split. eauto with evalexpr. inversion H0; simpl; constructor.
-
-  exists tv.
-  split. auto. inversion H0; simpl; econstructor; eauto.
-Qed.
-
 Lemma make_stackaddr_correct:
   forall sp te tm ofs,
   eval_expr tge (Vptr sp Int.zero) te tm
@@ -1558,14 +1354,6 @@ Proof.
   eapply eval_Econst. simpl. rewrite H. auto.
 Qed.
 
-Lemma unop_is_cast_correct:
-  forall op chunk v,
-  unop_is_cast op = Some chunk ->
-  Csharpminor.eval_unop op v = Some (Val.load_result chunk v).
-Proof.
-  intros. destruct op; simpl in H; inv H; reflexivity.
-Qed.
-
 (** Correctness of [make_store]. *)
 
 Inductive val_content_inject (f: meminj): memory_chunk -> val -> val -> Prop :=
@@ -1663,11 +1451,11 @@ Qed.
   and [var_set]. *)
 
 Lemma var_get_correct:
-  forall cenv id a f tf e te sp lo hi m cs tm b chunk v,
+  forall cenv id a f tf e le te sp lo hi m cs tm b chunk v,
   var_get cenv id = OK a ->
-  match_callstack f m tm (Frame cenv tf e te sp lo hi :: cs) (Mem.nextblock m) (Mem.nextblock tm) ->
+  match_callstack f m tm (Frame cenv tf e le te sp lo hi :: cs) (Mem.nextblock m) (Mem.nextblock tm) ->
   Mem.inject f m tm ->
-  eval_var_ref gve e id b chunk ->
+  eval_var_ref ge e id b chunk ->
   Mem.load chunk m b 0 = Some v ->
   exists tv,
     eval_expr tge (Vptr sp Int.zero) te tm a tv /\
@@ -1692,7 +1480,7 @@ Proof.
   (* var_global_scalar *)
   simpl in *.
   exploit match_callstack_match_globalenvs; eauto. intros [bnd MG]. inv MG.
-  assert (chunk0 = chunk). congruence. subst chunk0.
+  assert (chunk0 = chunk). exploit H7; eauto. congruence. subst chunk0.
   assert (val_inject f (Vptr b Int.zero) (Vptr b Int.zero)).
     econstructor; eauto. 
   exploit Mem.loadv_inject; eauto. simpl. eauto.   
@@ -1704,10 +1492,10 @@ Proof.
 Qed.
 
 Lemma var_addr_correct:
-  forall cenv id a f tf e te sp lo hi m cs tm b,
-  match_callstack f m tm (Frame cenv tf e te sp lo hi :: cs) (Mem.nextblock m) (Mem.nextblock tm) ->
+  forall cenv id a f tf e le te sp lo hi m cs tm b,
+  match_callstack f m tm (Frame cenv tf e le te sp lo hi :: cs) (Mem.nextblock m) (Mem.nextblock tm) ->
   var_addr cenv id = OK a ->
-  eval_var_addr gve e id b ->
+  eval_var_addr ge e id b ->
   exists tv,
     eval_expr tge (Vptr sp Int.zero) te tm a tv /\
     val_inject f (Vptr b Int.zero) tv.
@@ -1735,51 +1523,35 @@ Proof.
 Qed.
 
 Lemma var_set_correct:
-  forall cenv id rhs rhs_chunk a f tf e te sp lo hi m cs tm tv v m' fn k,
-  var_set cenv id rhs rhs_chunk = OK a ->
-  match_callstack f m tm (Frame cenv tf e te sp lo hi :: cs) (Mem.nextblock m) (Mem.nextblock tm) ->
+  forall cenv id rhs a f tf e le te sp lo hi m cs tm tv v m' fn k,
+  var_set cenv id rhs = OK a ->
+  match_callstack f m tm (Frame cenv tf e le te sp lo hi :: cs) (Mem.nextblock m) (Mem.nextblock tm) ->
   eval_expr tge (Vptr sp Int.zero) te tm rhs tv ->
   val_inject f v tv ->
   Mem.inject f m tm ->
-  exec_assign gve e m id v m' ->
-  val_normalized v rhs_chunk ->
+  exec_assign ge e m id v m' ->
   exists te', exists tm',
     step tge (State fn a k (Vptr sp Int.zero) te tm)
           E0 (State fn Sskip k (Vptr sp Int.zero) te' tm') /\
     Mem.inject f m' tm' /\
-    match_callstack f m' tm' (Frame cenv tf e te' sp lo hi :: cs) (Mem.nextblock m') (Mem.nextblock tm') /\
-    (forall id', id' <> id -> te'!id' = te!id').
+    match_callstack f m' tm' (Frame cenv tf e le te' sp lo hi :: cs) (Mem.nextblock m') (Mem.nextblock tm') /\
+    (forall id', id' <> for_var id -> te'!id' = te!id').
 Proof.
   intros until k. 
-  intros VS MCS EVAL VINJ MINJ ASG VNORM.
+  intros VS MCS EVAL VINJ MINJ ASG.
   unfold var_set in VS. inv ASG. 
   assert (NEXTBLOCK: Mem.nextblock m' = Mem.nextblock m).
     eapply Mem.nextblock_store; eauto.
   assert (MV: match_var f id e m te sp cenv!!id).
     inv MCS. inv MENV. auto. 
-  inv MV; rewrite <- H1 in VS; inv VS; inv H; try congruence.
+  revert VS; inv MV; intro VS; inv VS; inv H; try congruence.
   (* var_local *)
   assert (b0 = b) by congruence. subst b0.
   assert (chunk0 = chunk) by congruence. subst chunk0.
-  generalize H8; clear H8. case_eq (chunktype_compat rhs_chunk chunk).
-    (* compatible chunks *)
-  intros CCOMPAT EQ; inv EQ.
-  exploit chunktype_compat_correct; eauto. intro VNORM'.
-  exists (PTree.set id tv te); exists tm.
-  split. eapply step_assign. eauto. 
-  split. eapply Mem.store_unmapped_inject; eauto. 
-  split. rewrite NEXTBLOCK. eapply match_callstack_store_local; eauto.
-  eapply val_normalized_has_type; eauto. red in VNORM'. congruence. 
-  intros. apply PTree.gso; auto.
-    (* incompatible chunks but same type *)
-  intros. destruct (typ_eq (type_of_chunk chunk) (type_of_chunk rhs_chunk)); inv H8.
-  exploit make_cast_correct; eauto.  
-  intros [tv' [EVAL' INJ']].
-  exists (PTree.set id tv' te); exists tm.
+  exists (PTree.set (for_var id) tv te); exists tm.
   split. eapply step_assign. eauto. 
   split. eapply Mem.store_unmapped_inject; eauto. 
   split. rewrite NEXTBLOCK. eapply match_callstack_store_local; eauto.
-  rewrite e0. eapply val_normalized_has_type; eauto. 
   intros. apply PTree.gso; auto.
   (* var_stack_scalar *)
   assert (b0 = b) by congruence. subst b0.
@@ -1796,7 +1568,7 @@ Proof.
   auto.
   (* var_global_scalar *)
   simpl in *.
-  assert (chunk0 = chunk) by congruence. subst chunk0.  
+  assert (chunk0 = chunk). exploit H4; eauto. congruence. subst chunk0.  
   assert (Mem.storev chunk m (Vptr b Int.zero) v = Some m'). assumption.
   exploit match_callstack_match_globalenvs; eauto. intros [bnd MG]. inv MG.
   exploit make_store_correct.
@@ -1811,56 +1583,122 @@ Proof.
 Qed.
 
 Lemma match_callstack_extensional:
-  forall f cenv tf e te1 te2 sp lo hi cs bound tbound m tm,
-  (forall id chunk, cenv!!id = Var_local chunk -> te2!id = te1!id) ->
-  match_callstack f m tm (Frame cenv tf e te1 sp lo hi :: cs) bound tbound ->
-  match_callstack f m tm (Frame cenv tf e te2 sp lo hi :: cs) bound tbound.
+  forall f cenv tf e le te1 te2 sp lo hi cs bound tbound m tm,
+  (forall id chunk, cenv!!id = Var_local chunk -> te2!(for_var id) = te1!(for_var id)) ->
+  (forall id v, le!id = Some v -> te2!(for_temp id) = te1!(for_temp id)) ->
+  match_callstack f m tm (Frame cenv tf e le te1 sp lo hi :: cs) bound tbound ->
+  match_callstack f m tm (Frame cenv tf e le te2 sp lo hi :: cs) bound tbound.
 Proof.
-  intros. inv H0. constructor; auto. 
+  intros. inv H1. constructor; auto. 
   apply match_env_extensional with te1; auto.
 Qed.
 
 Lemma var_set_self_correct:
-  forall cenv id ty a f tf e te sp lo hi m cs tm tv te' v m' fn k,
-  var_set_self cenv id ty = OK a ->
-  match_callstack f m tm (Frame cenv tf e te sp lo hi :: cs) (Mem.nextblock m) (Mem.nextblock tm) ->
+  forall cenv id ty s a f tf e le te sp lo hi m cs tm tv v m' fn k,
+  var_set_self cenv id ty s = OK a ->
+  match_callstack f m tm (Frame cenv tf e le te sp lo hi :: cs) (Mem.nextblock m) (Mem.nextblock tm) ->
+  val_inject f v tv ->
+  Mem.inject f m tm ->
+  exec_assign ge e m id v m' ->
+  te!(for_var id) = Some tv ->
+  exists tm',
+    star step tge (State fn a k (Vptr sp Int.zero) te tm)
+               E0 (State fn s k (Vptr sp Int.zero) te tm') /\
+    Mem.inject f m' tm' /\
+    match_callstack f m' tm' (Frame cenv tf e le te sp lo hi :: cs) (Mem.nextblock m') (Mem.nextblock tm').
+Proof.
+  intros until k. 
+  intros VS MCS VINJ MINJ ASG VAL.
+  unfold var_set_self in VS. inv ASG. 
+  assert (NEXTBLOCK: Mem.nextblock m' = Mem.nextblock m).
+    eapply Mem.nextblock_store; eauto.
+  assert (MV: match_var f id e m te sp cenv!!id).
+    inv MCS. inv MENV. auto.
+  assert (EVAR: eval_expr tge (Vptr sp Int.zero) te tm (Evar (for_var id)) tv).
+    constructor. auto.
+  revert VS; inv MV; intro VS; inv VS; inv H; try congruence.
+  (* var_local *)
+  assert (b0 = b) by congruence. subst b0.
+  assert (chunk0 = chunk) by congruence. subst chunk0.
+  exists tm.
+  split. apply star_refl. 
+  split. eapply Mem.store_unmapped_inject; eauto. 
+  rewrite NEXTBLOCK. 
+  apply match_callstack_extensional with (PTree.set (for_var id) tv te).
+  intros. repeat rewrite PTree.gsspec.
+  destruct (peq (for_var id0) (for_var id)). congruence. auto.
+  intros. rewrite PTree.gso; auto. unfold for_temp, for_var; congruence.
+  eapply match_callstack_store_local; eauto.
+  (* var_stack_scalar *)
+  assert (b0 = b) by congruence. subst b0.
+  assert (chunk0 = chunk) by congruence. subst chunk0.
+  assert (Mem.storev chunk m (Vptr b Int.zero) v = Some m'). assumption.
+  exploit make_store_correct.
+    eapply make_stackaddr_correct.
+    eauto. eauto. eauto. eauto. eauto. 
+  intros [tm' [tvrhs' [EVAL' [STORE' MEMINJ]]]].
+  exists tm'.
+  split. eapply star_three. constructor. eauto. constructor. traceEq.
+  split. auto.
+  rewrite NEXTBLOCK. rewrite (nextblock_storev _ _ _ _ _ STORE'). 
+  eapply match_callstack_storev_mapped; eauto.
+  (* var_global_scalar *)
+  simpl in *.
+  assert (chunk0 = chunk). exploit H4; eauto. congruence. subst chunk0.  
+  assert (Mem.storev chunk m (Vptr b Int.zero) v = Some m'). assumption.
+  exploit match_callstack_match_globalenvs; eauto. intros [bnd MG]. inv MG.
+  exploit make_store_correct.
+    eapply make_globaladdr_correct; eauto.
+    rewrite symbols_preserved; eauto. eauto. eauto. eauto. eauto. eauto.
+  intros [tm' [tvrhs' [EVAL' [STORE' MEMINJ]]]].
+  exists tm'.
+  split. eapply star_three. constructor. eauto. constructor. traceEq.
+  split. auto. 
+  rewrite NEXTBLOCK. rewrite (nextblock_storev _ _ _ _ _ STORE'). 
+  eapply match_callstack_store_mapped; eauto.
+Qed.
+
+(*
+Lemma var_set_self_correct:
+  forall cenv id ty s a f tf e le te sp lo hi m cs tm tv te' v m' fn k,
+  var_set_self cenv id ty s = OK a ->
+  match_callstack f m tm (Frame cenv tf e le te sp lo hi :: cs) (Mem.nextblock m) (Mem.nextblock tm) ->
   val_inject f v tv ->
   Mem.inject f m tm ->
-  exec_assign gve e m id v m' ->
-  Val.has_type v ty ->
-  te'!id = Some tv ->
-  (forall i, i <> id -> te'!i = te!i) ->
+  exec_assign ge e m id v m' ->
+  te'!(for_var id) = Some tv ->
+  (forall i, i <> for_var id -> te'!i = te!i) ->
   exists te'', exists tm',
-    step tge (State fn a k (Vptr sp Int.zero) te' tm)
-          E0 (State fn Sskip k (Vptr sp Int.zero) te'' tm') /\
+    star step tge (State fn a k (Vptr sp Int.zero) te' tm)
+               E0 (State fn s k (Vptr sp Int.zero) te'' tm') /\
     Mem.inject f m' tm' /\
-    match_callstack f m' tm' (Frame cenv tf e te'' sp lo hi :: cs) (Mem.nextblock m') (Mem.nextblock tm') /\
-    (forall id', id' <> id -> te''!id' = te'!id').
+    match_callstack f m' tm' (Frame cenv tf e le te'' sp lo hi :: cs) (Mem.nextblock m') (Mem.nextblock tm') /\
+    (forall id', id' <> for_var id -> te''!id' = te'!id').
 Proof.
   intros until k. 
-  intros VS MCS VINJ MINJ ASG VTY VAL OTHERS.
+  intros VS MCS VINJ MINJ ASG VAL OTHERS.
   unfold var_set_self in VS. inv ASG. 
   assert (NEXTBLOCK: Mem.nextblock m' = Mem.nextblock m).
     eapply Mem.nextblock_store; eauto.
   assert (MV: match_var f id e m te sp cenv!!id).
     inv MCS. inv MENV. auto.
-  assert (EVAR: eval_expr tge (Vptr sp Int.zero) te' tm (Evar id) tv).
+  assert (EVAR: eval_expr tge (Vptr sp Int.zero) te' tm (Evar (for_var id)) tv).
     constructor. auto.
-  inv MV; rewrite <- H1 in VS; inv VS; inv H; try congruence.
+  revert VS; inv MV; intro VS; inv VS; inv H; try congruence.
   (* var_local *)
   assert (b0 = b) by congruence. subst b0.
   assert (chunk0 = chunk) by congruence. subst chunk0.
-  destruct (typ_eq (type_of_chunk chunk) ty); inv H8.
-  exploit make_cast_correct; eauto.  
-  intros [tv' [EVAL' INJ']].
-  exists (PTree.set id tv' te'); exists tm.
-  split. eapply step_assign. eauto. 
+  exists te'; exists tm.
+  split. apply star_refl. 
   split. eapply Mem.store_unmapped_inject; eauto. 
   split. rewrite NEXTBLOCK. 
-  apply match_callstack_extensional with (PTree.set id tv' te).
-  intros. repeat rewrite PTree.gsspec. destruct (peq id0 id); auto. 
+  apply match_callstack_extensional with (PTree.set (for_var id) tv te).
+  intros. repeat rewrite PTree.gsspec.
+  destruct (peq (for_var id0) (for_var id)). congruence. auto.
+  intros. assert (for_temp id0 <> for_var id). unfold for_temp, for_var; congruence.
+  rewrite PTree.gso; auto. 
   eapply match_callstack_store_local; eauto.
-  intros; apply PTree.gso; auto.
+  intros. auto. 
   (* var_stack_scalar *)
   assert (b0 = b) by congruence. subst b0.
   assert (chunk0 = chunk) by congruence. subst chunk0.
@@ -1870,15 +1708,17 @@ Proof.
     eauto. eauto. eauto. eauto. eauto. 
   intros [tm' [tvrhs' [EVAL' [STORE' MEMINJ]]]].
   exists te'; exists tm'.
-  split. eauto. split. auto.  
+  split. eapply star_three. constructor. eauto. constructor. traceEq.
+  split. auto.
   split. rewrite NEXTBLOCK. rewrite (nextblock_storev _ _ _ _ _ STORE'). 
   apply match_callstack_extensional with te.
-  intros. apply OTHERS. congruence.
+  intros. apply OTHERS. unfold for_var; congruence.
+  intros. apply OTHERS. unfold for_var, for_temp; congruence.
   eapply match_callstack_storev_mapped; eauto.
   auto.
   (* var_global_scalar *)
   simpl in *.
-  assert (chunk0 = chunk) by congruence. subst chunk0.  
+  assert (chunk0 = chunk). exploit H4; eauto. congruence. subst chunk0.  
   assert (Mem.storev chunk m (Vptr b Int.zero) v = Some m'). assumption.
   exploit match_callstack_match_globalenvs; eauto. intros [bnd MG]. inv MG.
   exploit make_store_correct.
@@ -1886,13 +1726,16 @@ Proof.
     rewrite symbols_preserved; eauto. eauto. eauto. eauto. eauto. eauto.
   intros [tm' [tvrhs' [EVAL' [STORE' MEMINJ]]]].
   exists te'; exists tm'.
-  split. eauto. split. auto. 
+  split. eapply star_three. constructor. eauto. constructor. traceEq.
+  split. auto. 
   split. rewrite NEXTBLOCK. rewrite (nextblock_storev _ _ _ _ _ STORE'). 
   apply match_callstack_extensional with te.
-  intros. apply OTHERS. congruence.
+  intros. apply OTHERS. unfold for_var; congruence.
+  intros. apply OTHERS. unfold for_var, for_temp; congruence.
   eapply match_callstack_store_mapped; eauto.
   auto.
 Qed.
+*)
 
 (** * Correctness of stack allocation of local variables *)
 
@@ -1983,7 +1826,7 @@ Proof.
 Qed.
 
 Lemma match_callstack_alloc_variable:
-  forall atk id lv cenv sz cenv' sz' tm sp e tf m m' b te lo cs f tv,
+  forall atk id lv cenv sz cenv' sz' tm sp e tf m m' b te le lo cs f tv,
   assign_variable atk (id, lv) (cenv, sz) = (cenv', sz') ->
   Mem.valid_block tm sp ->
   Mem.bounds tm sp = (0, tf.(fn_stackspace)) ->
@@ -1991,18 +1834,18 @@ Lemma match_callstack_alloc_variable:
   tf.(fn_stackspace) <= Int.max_signed ->
   Mem.alloc m 0 (sizeof lv) = (m', b) ->
   match_callstack f m tm 
-                  (Frame cenv tf e te sp lo (Mem.nextblock m) :: cs)
+                  (Frame cenv tf e le te sp lo (Mem.nextblock m) :: cs)
                   (Mem.nextblock m) (Mem.nextblock tm) ->
   Mem.inject f m tm ->
   0 <= sz -> sz' <= tf.(fn_stackspace) ->
   (forall b delta, f b = Some(sp, delta) -> Mem.high_bound m b + delta <= sz) ->
   e!id = None ->
-  te!id = Some tv ->
+  te!(for_var id) = Some tv ->
   exists f',
      inject_incr f f'
   /\ Mem.inject f' m' tm
   /\ match_callstack f' m' tm
-                     (Frame cenv' tf (PTree.set id (b, lv) e) te sp lo (Mem.nextblock m') :: cs)
+                     (Frame cenv' tf (PTree.set id (b, lv) e) le te sp lo (Mem.nextblock m') :: cs)
                      (Mem.nextblock m') (Mem.nextblock tm)
   /\ (forall b delta,
       f' b = Some(sp, delta) -> Mem.high_bound m' b + delta <= sz').
@@ -2076,7 +1919,7 @@ Proof.
 Qed.
 
 Lemma match_callstack_alloc_variables_rec:
-  forall tm sp cenv' tf te lo cs atk,
+  forall tm sp cenv' tf le te lo cs atk,
   Mem.valid_block tm sp ->
   Mem.bounds tm sp = (0, tf.(fn_stackspace)) ->
   Mem.range_perm tm sp 0 tf.(fn_stackspace) Freeable ->
@@ -2086,20 +1929,20 @@ Lemma match_callstack_alloc_variables_rec:
   forall f cenv sz,
   assign_variables atk vars (cenv, sz) = (cenv', tf.(fn_stackspace)) ->
   match_callstack f m tm 
-                  (Frame cenv tf e te sp lo (Mem.nextblock m) :: cs)
+                  (Frame cenv tf e le te sp lo (Mem.nextblock m) :: cs)
                   (Mem.nextblock m) (Mem.nextblock tm) ->
   Mem.inject f m tm ->
   0 <= sz ->
   (forall b delta,
      f b = Some(sp, delta) -> Mem.high_bound m b + delta <= sz) ->
-  (forall id lv, In (id, lv) vars -> te!id <> None) ->
+  (forall id lv, In (id, lv) vars -> te!(for_var id) <> None) ->
   list_norepet (List.map (@fst ident var_kind) vars) ->
   (forall id lv, In (id, lv) vars -> e!id = None) ->
   exists f',
      inject_incr f f'
   /\ Mem.inject f' m' tm
   /\ match_callstack f' m' tm
-                     (Frame cenv' tf e' te sp lo (Mem.nextblock m') :: cs)
+                     (Frame cenv' tf e' le te sp lo (Mem.nextblock m') :: cs)
                      (Mem.nextblock m') (Mem.nextblock tm).
 Proof.
   intros until atk. intros VALID BOUNDS PERM NOOV.
@@ -2113,11 +1956,11 @@ Proof.
   with (assign_variables atk vars (assign_variable atk (id, lv) (cenv, sz))).
   caseEq (assign_variable atk (id, lv) (cenv, sz)).
   intros cenv1 sz1 ASV1 ASVS MATCH MINJ SZPOS BOUND DEFINED NOREPET UNDEFINED.
-  assert (DEFINED1: forall id0 lv0, In (id0, lv0) vars -> te!id0 <> None).
+  assert (DEFINED1: forall id0 lv0, In (id0, lv0) vars -> te!(for_var id0) <> None).
     intros. eapply DEFINED. simpl. right. eauto.
-  assert (exists tv, te!id = Some tv).
-    assert (te!id <> None). eapply DEFINED. simpl; left; auto.
-    destruct (te!id). exists v; auto. congruence.
+  assert (exists tv, te!(for_var id) = Some tv).
+    assert (te!(for_var id) <> None). eapply DEFINED. simpl; left; auto.
+    destruct (te!(for_var id)). exists v; auto. congruence.
   destruct H1 as [tv TEID].
   assert (sz1 <= fn_stackspace tf). eapply assign_variables_incr; eauto. 
   exploit match_callstack_alloc_variable; eauto with coqlib.
@@ -2171,7 +2014,7 @@ Qed.
   of Csharpminor local variables and of the Cminor stack data block. *)
 
 Lemma match_callstack_alloc_variables:
-  forall fn cenv tf m e m' tm tm' sp f cs targs body,
+  forall fn cenv tf m e m' tm tm' sp f cs targs,
   build_compilenv gce fn = (cenv, tf.(fn_stackspace)) ->
   tf.(fn_stackspace) <= Int.max_signed ->
   list_norepet (fn_params_names fn ++ fn_vars_names fn) ->
@@ -2179,13 +2022,15 @@ Lemma match_callstack_alloc_variables:
   Mem.alloc tm 0 tf.(fn_stackspace) = (tm', sp) ->
   match_callstack f m tm cs (Mem.nextblock m) (Mem.nextblock tm) ->
   Mem.inject f m tm ->
-  let tvars := make_vars (fn_params_names fn) (fn_vars_names fn) body in
-  let te := set_locals tvars (set_params targs (fn_params_names fn)) in
+  let tparams := List.map for_var (fn_params_names fn) in
+  let tvars := List.map for_var (fn_vars_names fn) in
+  let ttemps := List.map for_temp (Csharpminor.fn_temps fn) in
+  let te := set_locals (tvars ++ ttemps) (set_params targs tparams) in
   exists f',
      inject_incr f f'
   /\ Mem.inject f' m' tm'
   /\ match_callstack f' m' tm'
-                     (Frame cenv tf e te sp (Mem.nextblock m) (Mem.nextblock m') :: cs)
+                     (Frame cenv tf e empty_temp_env te sp (Mem.nextblock m) (Mem.nextblock m') :: cs)
                      (Mem.nextblock m') (Mem.nextblock tm').
 Proof.
   intros. 
@@ -2200,8 +2045,8 @@ Proof.
   intros. unfold te. apply set_locals_params_defined.
   elim (in_app_or _ _ _ H6); intros.
   elim (list_in_map_inv _ _ _ H7). intros x [A B].
-  apply in_or_app; left. inversion A. apply List.in_map. auto.
-  apply in_or_app; right. unfold tvars, make_vars. apply in_or_app; left. 
+  apply in_or_app; left. unfold tparams. apply List.in_map. inversion A. apply List.in_map. auto.
+  apply in_or_app; right. apply in_or_app; left. unfold tvars. apply List.in_map. 
   change id with (fst (id, lv)). apply List.in_map; auto.
   (* norepet *)
   unfold fn_variables. 
@@ -2221,9 +2066,9 @@ Inductive vars_vals_match (f:meminj):
       vars_vals_match f nil nil te
   | vars_vals_cons:
       forall te id chunk vars v vals tv,
-      te!id = Some tv ->
+      te!(for_var id) = Some tv ->
       val_inject f v tv ->
-      Val.has_type v (type_of_chunk chunk) ->
+      val_normalized v chunk ->
       vars_vals_match f vars vals te ->
       vars_vals_match f ((id, chunk) :: vars) (v :: vals) te.
 
@@ -2231,7 +2076,7 @@ Lemma vars_vals_match_extensional:
   forall f vars vals te,
   vars_vals_match f vars vals te ->
   forall te',
-  (forall id lv, In (id, lv) vars -> te'!id = te!id) ->
+  (forall id lv, In (id, lv) vars -> te'!(for_var id) = te!(for_var id)) ->
   vars_vals_match f vars vals te'.
 Proof.
   induction 1; intros.
@@ -2242,24 +2087,24 @@ Proof.
 Qed.
 
 Lemma store_parameters_correct:
-  forall e m1 params vl m2,
+  forall e le te m1 params vl m2,
   bind_parameters e m1 params vl m2 ->
-  forall s f te1 cenv tf sp lo hi cs tm1 fn k,
-  vars_vals_match f params vl te1 ->
+  forall s f cenv tf sp lo hi cs tm1 fn k,
+  vars_vals_match f params vl te ->
   list_norepet (List.map param_name params) ->
   Mem.inject f m1 tm1 ->
-  match_callstack f m1 tm1 (Frame cenv tf e te1 sp lo hi :: cs) (Mem.nextblock m1) (Mem.nextblock tm1) ->
+  match_callstack f m1 tm1 (Frame cenv tf e le te sp lo hi :: cs) (Mem.nextblock m1) (Mem.nextblock tm1) ->
   store_parameters cenv params = OK s ->
-  exists te2, exists tm2,
-     star step tge (State fn s k (Vptr sp Int.zero) te1 tm1)
-                E0 (State fn Sskip k (Vptr sp Int.zero) te2 tm2)
+  exists tm2,
+     star step tge (State fn s k (Vptr sp Int.zero) te tm1)
+                E0 (State fn Sskip k (Vptr sp Int.zero) te tm2)
   /\ Mem.inject f m2 tm2
-  /\ match_callstack f m2 tm2 (Frame cenv tf e te2 sp lo hi :: cs) (Mem.nextblock m2) (Mem.nextblock tm2).
+  /\ match_callstack f m2 tm2 (Frame cenv tf e le te sp lo hi :: cs) (Mem.nextblock m2) (Mem.nextblock tm2).
 Proof.
   induction 1.
   (* base case *)
   intros; simpl. monadInv H3.
-  exists te1; exists tm1. split. constructor. tauto.
+  exists tm1. split. constructor. tauto.
   (* inductive case *)
   intros until k.  intros VVM NOREPET MINJ MATCH STOREP.
   monadInv STOREP.
@@ -2267,18 +2112,11 @@ Proof.
   inv NOREPET.
   exploit var_set_self_correct; eauto.
     econstructor; eauto. econstructor; eauto.
-  intros [te2 [tm2 [EXEC1 [MINJ1 [MATCH1 UNCHANGED1]]]]].
-  assert (vars_vals_match f params vl te2).
-    apply vars_vals_match_extensional with te1; auto.
-    intros. apply UNCHANGED1. red; intro; subst id0.
-    elim H4. change id with (param_name (id, lv)). apply List.in_map. auto.
+  intros [tm2 [EXEC1 [MINJ1 MATCH1]]].
   exploit IHbind_parameters; eauto.
-  intros [te3 [tm3 [EXEC2 [MINJ2 MATCH2]]]].
-  exists te3; exists tm3.
-  split. eapply star_left. constructor. 
-    eapply star_left. eexact EXEC1.
-    eapply star_left. constructor. eexact EXEC2.
-    reflexivity. reflexivity. reflexivity.
+  intros [tm3 [EXEC2 [MINJ2 MATCH2]]].
+  exists tm3.
+  split. eapply star_trans; eauto. 
   auto.
 Qed.
 
@@ -2286,87 +2124,67 @@ Lemma vars_vals_match_holds_1:
   forall f params args targs,
   list_norepet (List.map param_name params) ->
   val_list_inject f args targs ->
-  Val.has_type_list args (List.map type_of_chunk (List.map param_chunk params)) ->
+  list_forall2 val_normalized args (List.map param_chunk params) ->
   vars_vals_match f params args
-    (set_params targs (List.map (@fst ident memory_chunk) params)).
+    (set_params targs (List.map for_var (List.map param_name params))).
 Proof.
+Opaque for_var.
   induction params; simpl; intros.
-  destruct args; simpl in H1; try contradiction. inv H0.
-  constructor.
-  destruct args; simpl in H1; try contradiction. destruct H1. inv H0. inv H.
+  inv H1. constructor.
+  inv H. inv H1. inv H0. 
   destruct a as [id chunk]; simpl in *. econstructor.
   rewrite PTree.gss. reflexivity. 
   auto. auto.
   apply vars_vals_match_extensional
-  with (set_params vl' (map param_name params)).
+  with (set_params vl' (map for_var (map param_name params))).
   eapply IHparams; eauto. 
-  intros. simpl. apply PTree.gso. red; intro; subst id0.
+Transparent for_var.
+  intros. apply PTree.gso. unfold for_var; red; intros. inv H0. 
   elim H4. change id with (param_name (id, lv)). apply List.in_map; auto.
 Qed.
 
-Lemma vars_vals_match_holds:
-  forall f params args targs,
-  list_norepet (List.map param_name params) ->
-  val_list_inject f args targs ->
-  Val.has_type_list args (List.map type_of_chunk (List.map param_chunk params)) ->
-  forall vars,
-  list_norepet (vars ++ List.map param_name params) ->
-  vars_vals_match f params args
-    (set_locals vars (set_params targs (List.map param_name params))).
-Proof.
-  induction vars; simpl; intros.
-  eapply vars_vals_match_holds_1; eauto.
-  inv H2.
-  eapply vars_vals_match_extensional; eauto.
-  intros. apply PTree.gso. red; intro; subst id; elim H5.
-  apply in_or_app. right. change a with (param_name (a, lv)). apply List.in_map; auto.
-Qed.
-
-Remark identset_removelist_charact:
-  forall l s x, Identset.In x (identset_removelist l s) <-> Identset.In x s /\ ~In x l.
+Lemma vars_vals_match_holds_2:
+  forall f params args e,
+  vars_vals_match f params args e ->
+  forall vl,
+  (forall id1 id2, In id1 (List.map param_name params) -> In id2 vl -> for_var id1 <> id2) ->
+  vars_vals_match f params args (set_locals vl e).
 Proof.
-  induction l; simpl; intros. tauto.
-  split; intros.
-  exploit Identset.remove_3; eauto. rewrite IHl. intros [P Q].  
-  split. auto. intuition. elim (Identset.remove_1 H1 H).
-  destruct H as [P Q]. apply Identset.remove_2. tauto. rewrite IHl. tauto.
+  induction vl; simpl; intros.
+  auto.
+  apply vars_vals_match_extensional with (set_locals vl e); auto. 
+  intros. apply PTree.gso. apply H0. 
+  change id with (param_name (id, lv)). apply List.in_map. auto.
+  auto.
 Qed.
 
-Remark InA_In:
-  forall (A: Type) (x: A) (l: list A),
-  InA (fun (x y: A) => x = y) x l <-> In x l.
+Lemma vars_vals_match_holds:
+  forall f params args targs vars temps,
+  list_norepet (List.map param_name params ++ vars) ->
+  val_list_inject f args targs ->
+  list_forall2 val_normalized args (List.map param_chunk params) ->
+  vars_vals_match f params args
+    (set_locals (List.map for_var vars ++ List.map for_temp temps)
+      (set_params targs (List.map for_var (List.map param_name params)))).
 Proof.
-  intros. rewrite InA_alt. split; intros. destruct H as [y [P Q]]. congruence. exists x; auto. 
+  intros. rewrite list_norepet_app in H. destruct H as [A [B C]].
+  apply vars_vals_match_holds_2; auto. apply vars_vals_match_holds_1; auto.
+  intros.
+  destruct (in_app_or _ _ _ H2).
+  exploit list_in_map_inv. eexact H3. intros [x2 [J K]].
+  subst. assert (id1 <> x2). apply C; auto. unfold for_var; congruence.
+  exploit list_in_map_inv. eexact H3. intros [x2 [J K]].
+  subst id2. unfold for_var, for_temp; congruence.
 Qed.
 
-Remark NoDupA_norepet:
-  forall (A: Type) (l: list A),
-  NoDupA (fun (x y: A) => x = y) l -> list_norepet l.
+Remark bind_parameters_normalized:
+  forall e m params args m',
+  bind_parameters e m params args m' ->
+  list_forall2 val_normalized args (List.map param_chunk params).
 Proof.
-  induction 1. constructor. constructor; auto. red; intros; elim H.
-  rewrite InA_In. auto.
-Qed.
-
-Lemma make_vars_norepet:
-  forall fn body,
-  list_norepet (fn_params_names fn ++ fn_vars_names fn) ->
-  list_norepet (make_vars (fn_params_names fn) (fn_vars_names fn) body
-                ++ fn_params_names fn).
-Proof.
-  intros. rewrite list_norepet_app in H. destruct H as [A [B C]]. 
-  rewrite list_norepet_app. split.
-  unfold make_vars. rewrite list_norepet_app. split. auto. 
-  split. apply NoDupA_norepet. apply Identset.elements_3w.
-  red; intros. red; intros; subst y. rewrite <- InA_In in H0. 
-  exploit Identset.elements_2. eexact H0.
-  rewrite identset_removelist_charact. intros [P Q]. elim Q. 
-  apply in_or_app. auto. 
-  split. auto. 
-  red; intros. unfold make_vars in H. destruct (in_app_or _ _ _ H).
-  apply sym_not_equal. apply C; auto.
-  rewrite <- InA_In in H1. exploit Identset.elements_2. eexact H1. 
-  rewrite identset_removelist_charact. intros [P Q]. 
-  red; intros; elim Q. apply in_or_app. left; congruence. 
+  induction 1; simpl.
+  constructor.
+  constructor; auto.
 Qed.
 
 (** The main result in this section: the behaviour of function entry
@@ -2376,7 +2194,7 @@ Qed.
   and initialize the blocks corresponding to function parameters). *)
 
 Lemma function_entry_ok:
-  forall fn m e m1 vargs m2 f cs tm cenv tf tm1 sp tvargs body s fn' k,
+  forall fn m e m1 vargs m2 f cs tm cenv tf tm1 sp tvargs s fn' k,
   list_norepet (fn_params_names fn ++ fn_vars_names fn) ->
   alloc_variables empty_env m (fn_variables fn) e m1 ->
   bind_parameters e m1 fn.(Csharpminor.fn_params) vargs m2 ->
@@ -2384,36 +2202,37 @@ Lemma function_entry_ok:
   build_compilenv gce fn = (cenv, tf.(fn_stackspace)) ->
   tf.(fn_stackspace) <= Int.max_signed ->
   Mem.alloc tm 0 tf.(fn_stackspace) = (tm1, sp) ->
-  let vars :=
-    make_vars (fn_params_names fn) (fn_vars_names fn) body in
-  let te :=
-    set_locals vars (set_params tvargs (fn_params_names fn)) in
+  let tparams := List.map for_var (fn_params_names fn) in
+  let tvars := List.map for_var (fn_vars_names fn) in
+  let ttemps := List.map for_temp (Csharpminor.fn_temps fn) in
+  let te := set_locals (tvars ++ ttemps) (set_params tvargs tparams) in
   val_list_inject f vargs tvargs ->
-  Val.has_type_list vargs (Csharpminor.fn_sig fn).(sig_args) ->
   Mem.inject f m tm ->
   store_parameters cenv fn.(Csharpminor.fn_params) = OK s ->
-  exists f2, exists te2, exists tm2,
+  exists f2, exists tm2,
      star step tge (State fn' s k (Vptr sp Int.zero) te tm1)
-                E0 (State fn' Sskip k (Vptr sp Int.zero) te2 tm2)
+                E0 (State fn' Sskip k (Vptr sp Int.zero) te tm2)
   /\ Mem.inject f2 m2 tm2
   /\ inject_incr f f2
   /\ match_callstack f2 m2 tm2
-       (Frame cenv tf e te2 sp (Mem.nextblock m) (Mem.nextblock m1) :: cs)
+       (Frame cenv tf e empty_temp_env te sp (Mem.nextblock m) (Mem.nextblock m1) :: cs)
        (Mem.nextblock m2) (Mem.nextblock tm2).
 Proof.
   intros.
   exploit match_callstack_alloc_variables; eauto.
   intros [f1 [INCR1 [MINJ1 MATCH1]]].
   exploit vars_vals_match_holds.
-    eapply list_norepet_append_left. eexact H.  
+    eexact H. 
     apply val_list_inject_incr with f. eauto. eauto.
-    auto. eapply make_vars_norepet. auto. 
+    eapply bind_parameters_normalized; eauto.
+  instantiate (1 := Csharpminor.fn_temps fn). 
+  fold tvars. fold ttemps. fold (fn_params_names fn). fold tparams. fold te.   
   intro VVM.
   exploit store_parameters_correct.
     eauto. eauto. eapply list_norepet_append_left; eauto.
-    eexact MINJ1. fold (fn_params_names fn). eexact MATCH1. eauto.
-  intros [te2 [tm2 [EXEC [MINJ2 MATCH2]]]].
-  exists f1; exists te2; exists tm2. eauto.
+    eexact MINJ1. eexact MATCH1. eauto.
+  intros [tm2 [EXEC [MINJ2 MATCH2]]].
+  exists f1; exists tm2. eauto. 
 Qed.
 
 (** * Semantic preservation for the translation *)
@@ -2450,13 +2269,13 @@ Proof.
 Qed.
 
 Lemma transl_expr_correct:
-  forall f m tm cenv tf e te sp lo hi cs
+  forall f m tm cenv tf e le te sp lo hi cs
     (MINJ: Mem.inject f m tm)
     (MATCH: match_callstack f m tm
-             (Frame cenv tf e te sp lo hi :: cs)
+             (Frame cenv tf e le te sp lo hi :: cs)
              (Mem.nextblock m) (Mem.nextblock tm)),
   forall a v,
-  Csharpminor.eval_expr gve e m a v ->
+  Csharpminor.eval_expr ge e le m a v ->
   forall ta
     (TR: transl_expr cenv a = OK ta),
   exists tv,
@@ -2466,6 +2285,9 @@ Proof.
   induction 3; intros; simpl in TR; try (monadInv TR).
   (* Evar *)
   eapply var_get_correct; eauto.
+  (* Etempvar *)
+  inv MATCH. inv MENV. exploit me_temps0; eauto. intros [tv [A B]]. 
+  exists tv; split; auto. constructor; auto.
   (* Eaddrof *)
   eapply var_addr_correct; eauto.
   (* Econst *)
@@ -2474,16 +2296,6 @@ Proof.
   (* Eunop *)
   exploit IHeval_expr; eauto. intros [tv1 [EVAL1 INJ1]].
   exploit eval_unop_compat; eauto. intros [tv [EVAL INJ]].
-  revert EQ0. case_eq (unop_is_cast op); intros; monadInv EQ0.
-  revert EQ2. case_eq (chunktype_compat x0 m0); intros; monadInv EQ2.
-  exploit unop_is_cast_correct; eauto. instantiate (1 := v1); intros.
-  assert (val_normalized v1 m0). 
-    eapply chunktype_compat_correct; eauto. 
-    eapply chunktype_expr_correct; eauto.
-  red in H4.
-  assert (v = v1) by congruence. subst v. 
-  exists tv1; auto.
-  exists tv; split. econstructor; eauto. auto.
   exists tv; split. econstructor; eauto. auto.
   (* Ebinop *)
   exploit IHeval_expr1; eauto. intros [tv1 [EVAL1 INJ1]].
@@ -2505,13 +2317,13 @@ Proof.
 Qed.
 
 Lemma transl_exprlist_correct:
-  forall f m tm cenv tf e te sp lo hi cs
+  forall f m tm cenv tf e le te sp lo hi cs
     (MINJ: Mem.inject f m tm)
     (MATCH: match_callstack f m tm
-             (Frame cenv tf e te sp lo hi :: cs)
+             (Frame cenv tf e le te sp lo hi :: cs)
              (Mem.nextblock m) (Mem.nextblock tm)),
   forall a v,
-  Csharpminor.eval_exprlist gve e m a v ->
+  Csharpminor.eval_exprlist ge e le m a v ->
   forall ta
     (TR: transl_exprlist cenv a = OK ta),
   exists tv,
@@ -2545,44 +2357,36 @@ Inductive match_cont: Csharpminor.cont -> Cminor.cont -> option typ -> compilenv
   | match_Kblock2: forall k tk ty cenv xenv cs,
       match_cont k tk ty cenv xenv cs ->
       match_cont k (Kblock tk) ty cenv (false :: xenv) cs
-  | match_Kcall_none: forall fn e k tfn sp te tk ty cenv xenv lo hi cs sz cenv',
+  | match_Kcall: forall optid fn e le k tfn sp te tk ty cenv xenv lo hi cs sz cenv',
       transl_funbody cenv sz fn = OK tfn ->
       match_cont k tk fn.(fn_return) cenv xenv cs ->
-      match_cont (Csharpminor.Kcall None fn e k)
-                 (Kcall None tfn (Vptr sp Int.zero) te tk)
+      match_cont (Csharpminor.Kcall optid fn e le k)
+                 (Kcall (option_map for_temp optid) tfn (Vptr sp Int.zero) te tk)
                  ty cenv' nil
-                 (Frame cenv tfn e te sp lo hi :: cs)
-  | match_Kcall_some: forall id fn e k tfn s sp te tk ty cenv xenv lo hi cs sz cenv',
-      transl_funbody cenv sz fn = OK tfn ->
-      var_set_self cenv id (typ_of_opttyp ty) = OK s ->
-      match_cont k tk fn.(fn_return) cenv xenv cs ->
-      match_cont (Csharpminor.Kcall (Some id) fn e k)
-                 (Kcall (Some id) tfn (Vptr sp Int.zero) te (Kseq s tk))
-                 ty cenv' nil
-                 (Frame cenv tfn e te sp lo hi :: cs).
+                 (Frame cenv tfn e le te sp lo hi :: cs).
 
 Inductive match_states: Csharpminor.state -> Cminor.state -> Prop :=
   | match_state:
-      forall fn s k e m tfn ts tk sp te tm cenv xenv f lo hi cs sz
+      forall fn s k e le m tfn ts tk sp te tm cenv xenv f lo hi cs sz
       (TRF: transl_funbody cenv sz fn = OK tfn)
       (TR: transl_stmt fn.(fn_return) cenv xenv s = OK ts)
       (MINJ: Mem.inject f m tm)
       (MCS: match_callstack f m tm
-               (Frame cenv tfn e te sp lo hi :: cs)
+               (Frame cenv tfn e le te sp lo hi :: cs)
                (Mem.nextblock m) (Mem.nextblock tm))
       (MK: match_cont k tk fn.(fn_return) cenv xenv cs),
-      match_states (Csharpminor.State fn s k e m)
+      match_states (Csharpminor.State fn s k e le m)
                    (State tfn ts tk (Vptr sp Int.zero) te tm)
   | match_state_seq:
-      forall fn s1 s2 k e m tfn ts1 tk sp te tm cenv xenv f lo hi cs sz
+      forall fn s1 s2 k e le m tfn ts1 tk sp te tm cenv xenv f lo hi cs sz
       (TRF: transl_funbody cenv sz fn = OK tfn)
       (TR: transl_stmt fn.(fn_return) cenv xenv s1 = OK ts1)
       (MINJ: Mem.inject f m tm)
       (MCS: match_callstack f m tm
-               (Frame cenv tfn e te sp lo hi :: cs)
+               (Frame cenv tfn e le te sp lo hi :: cs)
                (Mem.nextblock m) (Mem.nextblock tm))
       (MK: match_cont (Csharpminor.Kseq s2 k) tk fn.(fn_return) cenv xenv cs),
-      match_states (Csharpminor.State fn (Csharpminor.Sseq s1 s2) k e m)
+      match_states (Csharpminor.State fn (Csharpminor.Sseq s1 s2) k e le m)
                    (State tfn ts1 tk (Vptr sp Int.zero) te tm)
   | match_callstate:
       forall fd args k m tfd targs tk tm f cs cenv
@@ -2591,8 +2395,7 @@ Inductive match_states: Csharpminor.state -> Cminor.state -> Prop :=
       (MCS: match_callstack f m tm cs (Mem.nextblock m) (Mem.nextblock tm))
       (MK: match_cont k tk (Csharpminor.funsig fd).(sig_res) cenv nil cs)
       (ISCC: Csharpminor.is_call_cont k)
-      (ARGSINJ: val_list_inject f args targs)
-      (ARGSTY: Val.has_type_list args (Csharpminor.funsig fd).(sig_args)),
+      (ARGSINJ: val_list_inject f args targs),
       match_states (Csharpminor.Callstate fd args k m)
                    (Callstate tfd targs tk tm)
   | match_returnstate:
@@ -2600,8 +2403,7 @@ Inductive match_states: Csharpminor.state -> Cminor.state -> Prop :=
       (MINJ: Mem.inject f m tm)
       (MCS: match_callstack f m tm cs (Mem.nextblock m) (Mem.nextblock tm))
       (MK: match_cont k tk ty cenv nil cs)
-      (RESINJ: val_inject f v tv)
-      (RESTY: Val.has_type v (typ_of_opttyp ty)),
+      (RESINJ: val_inject f v tv),
       match_states (Csharpminor.Returnstate v k m)
                    (Returnstate tv tk tm).
 
@@ -2643,7 +2445,6 @@ Proof.
   intros [tk' [A B]]. exists tk'; split.
   eapply star_left; eauto. constructor. traceEq. auto.
   econstructor; split. apply star_refl. split. exact I. econstructor; eauto.
-  econstructor; split. apply star_refl. split. exact I. econstructor; eauto.
 Qed.
 
 (** Properties of [switch] compilation *)
@@ -2744,18 +2545,18 @@ Proof.
 Qed.
 
 Lemma switch_match_states:
-  forall fn k e m tfn ts tk sp te tm cenv xenv f lo hi cs sz ls body tk'
+  forall fn k e le m tfn ts tk sp te tm cenv xenv f lo hi cs sz ls body tk'
     (TRF: transl_funbody cenv sz fn = OK tfn)
     (TR: transl_lblstmt (fn_return fn) cenv (switch_env ls xenv) ls body = OK ts)
     (MINJ: Mem.inject f m tm)
     (MCS: match_callstack f m tm
-               (Frame cenv tfn e te sp lo hi :: cs)
+               (Frame cenv tfn e le te sp lo hi :: cs)
                (Mem.nextblock m) (Mem.nextblock tm))
     (MK: match_cont k tk (fn_return fn) cenv xenv cs)
     (TK: transl_lblstmt_cont (fn_return fn) cenv xenv ls tk tk'),
   exists S,
   plus step tge (State tfn (Sexit O) tk' (Vptr sp Int.zero) te tm) E0 S
-  /\ match_states (Csharpminor.State fn (seq_of_lbl_stmt ls) k e m) S.
+  /\ match_states (Csharpminor.State fn (seq_of_lbl_stmt ls) k e le m) S.
 Proof.
   intros. destruct ls; simpl.
   inv TK. econstructor; split. 
@@ -2777,24 +2578,21 @@ Variable cenv: compilenv.
 Variable cs: callstack.
 
 Remark find_label_var_set:
-  forall id e chunk s k,
-  var_set cenv id e chunk = OK s ->
+  forall id e s k,
+  var_set cenv id e = OK s ->
   find_label lbl s k = None.
 Proof.
   intros. unfold var_set in H.
   destruct (cenv!!id); try (monadInv H; reflexivity).
-  destruct (chunktype_compat chunk m). inv H; auto. 
-  destruct (typ_eq (type_of_chunk m) (type_of_chunk chunk)); inv H; auto.
 Qed.
 
 Remark find_label_var_set_self:
-  forall id ty s k,
-  var_set_self cenv id ty = OK s ->
-  find_label lbl s k = None.
+  forall id ty s0 s k,
+  var_set_self cenv id ty s0 = OK s ->
+  find_label lbl s k = find_label lbl s0 k.
 Proof.
   intros. unfold var_set_self in H.
   destruct (cenv!!id); try (monadInv H; reflexivity).
-  destruct (typ_eq (type_of_chunk m) ty0); inv H; reflexivity.
 Qed.
 
 Lemma transl_lblstmt_find_label_context:
@@ -2842,12 +2640,6 @@ Proof.
   intros. destruct s; try (monadInv H); simpl; auto.
   (* assign *)
   eapply find_label_var_set; eauto.
-  (* call *)
-  destruct o; monadInv H; simpl; auto.
-  destruct (list_eq_dec typ_eq x1 (sig_args s)); monadInv EQ4.
-  simpl. eapply find_label_var_set_self; eauto.
-  destruct (list_eq_dec typ_eq x1 (sig_args s)); monadInv EQ3.
-  simpl; eauto.
   (* seq *)
   exploit (transl_find_label s1). eauto. eapply match_Kseq. eexact EQ1. eauto.  
   destruct (Csharpminor.find_label lbl s1 (Csharpminor.Kseq s2 k)) as [[s' k'] | ].
@@ -2869,7 +2661,6 @@ Proof.
   eapply transl_lblstmt_find_label. eauto. eauto. eauto. reflexivity.  
   (* return *)
   destruct o; monadInv H; auto.
-  destruct (typ_eq x0 (typ_of_opttyp ty)); monadInv EQ2; auto.
   (* label *)
   destruct (ident_eq lbl l).
   exists x; exists tk; exists xenv; auto.
@@ -2899,7 +2690,7 @@ Proof.
   induction vars; intros.
   monadInv H. auto.
   simpl in H. destruct a as [id lv]. monadInv H.
-  simpl. rewrite (find_label_var_set_self id (type_of_chunk lv)); auto.
+  transitivity (find_label lbl x k). eapply find_label_var_set_self; eauto. eauto.
 Qed.
 
 End FIND_LABEL.
@@ -2930,12 +2721,12 @@ Fixpoint seq_left_depth (s: Csharpminor.stmt) : nat :=
 
 Definition measure (S: Csharpminor.state) : nat :=
   match S with
-  | Csharpminor.State fn s k e m => seq_left_depth s
+  | Csharpminor.State fn s k e le m => seq_left_depth s
   | _ => O
   end.
 
 Lemma transl_step_correct:
-  forall S1 t S2, Csharpminor.step gve S1 t S2 ->
+  forall S1 t S2, Csharpminor.step ge S1 t S2 ->
   forall T1, match_states S1 T1 ->
   (exists T2, plus step tge T1 t T2 /\ match_states S2 T2)
   \/ (measure S2 < measure S1 /\ t = E0 /\ match_states S2 T1)%nat.
@@ -2970,16 +2761,24 @@ Proof.
   econstructor; split.
   eapply plus_right. eexact A. apply step_skip_call. auto.
   rewrite (sig_preserved_body _ _ _ _ TRF). auto. eauto. traceEq.
-  econstructor; eauto. exact I.
+  econstructor; eauto.
 
 (* assign *)
   monadInv TR. 
   exploit transl_expr_correct; eauto. intros [tv [EVAL VINJ]].
-  exploit var_set_correct; eauto. eapply chunktype_expr_correct; eauto.
+  exploit var_set_correct; eauto. 
   intros [te' [tm' [EXEC [MINJ' [MCS' OTHER]]]]].
   left; econstructor; split.
   apply plus_one. eexact EXEC.
+  econstructor; eauto.
+
+(* set *)
+  monadInv TR.
+  exploit transl_expr_correct; eauto. intros [tv [EVAL VINJ]].
+  left; econstructor; split.
+  apply plus_one. econstructor; eauto. 
   econstructor; eauto. 
+  eapply match_callstack_set_temp; eauto. 
 
 (* store *)
   monadInv TR.
@@ -2999,31 +2798,8 @@ Proof.
 
 (* call *)
   simpl in H1. exploit functions_translated; eauto. intros [tfd [FIND TRANS]].
-  simpl in TR. destruct optid; monadInv TR.
-(* with return value *)
-  destruct (list_eq_dec typ_eq x1 (sig_args (Csharpminor.funsig fd))); monadInv EQ4.
-  exploit transl_expr_correct; eauto.
-  intros [tvf [EVAL1 VINJ1]].
-  assert (tvf = vf).
-    exploit match_callstack_match_globalenvs; eauto. intros [bnd MG].
-    eapply val_inject_function_pointer; eauto.
-  subst tvf.
-  exploit transl_exprlist_correct; eauto.
-  intros [tvargs [EVAL2 VINJ2]].
-  left; econstructor; split.
-  eapply plus_left. constructor. apply star_one. 
-  eapply step_call; eauto.
-  apply sig_preserved; eauto.
-  traceEq.
-  econstructor; eauto.
-  eapply match_Kcall_some with (cenv' := cenv); eauto.
-  red; auto.
-  eapply type_exprlist_correct; eauto.
-  
-(* without return value *)
-  destruct (list_eq_dec typ_eq x1 (sig_args (Csharpminor.funsig fd))); monadInv EQ3.
-  exploit transl_expr_correct; eauto.
-  intros [tvf [EVAL1 VINJ1]].
+  monadInv TR.
+  exploit transl_expr_correct; eauto. intros [tvf [EVAL1 VINJ1]].
   assert (tvf = vf).
     exploit match_callstack_match_globalenvs; eauto. intros [bnd MG].
     eapply val_inject_function_pointer; eauto.
@@ -3031,13 +2807,11 @@ Proof.
   exploit transl_exprlist_correct; eauto.
   intros [tvargs [EVAL2 VINJ2]].
   left; econstructor; split.
-  apply plus_one. 
-  eapply step_call; eauto.
+  apply plus_one. eapply step_call; eauto.
   apply sig_preserved; eauto.
   econstructor; eauto.
-  eapply match_Kcall_none with (cenv' := cenv); eauto.
+  eapply match_Kcall with (cenv' := cenv); eauto.
   red; auto.
-  eapply type_exprlist_correct; eauto.
 
 (* seq *)
   monadInv TR. 
@@ -3126,14 +2900,12 @@ Proof.
   simpl; auto.
 
 (* return some *)
-  monadInv TR. destruct (typ_eq x0 (typ_of_opttyp (fn_return f))); monadInv EQ2.
-  left. 
+  monadInv TR. left. 
   exploit transl_expr_correct; eauto. intros [tv [EVAL VINJ]].
   exploit match_callstack_freelist; eauto. intros [tm' [A [B C]]].
   econstructor; split.
   apply plus_one. eapply step_return_1. eauto. eauto. 
   econstructor; eauto. eapply match_call_cont; eauto.
-  eapply type_expr_correct; eauto.
 
 (* label *)
   monadInv TR.
@@ -3155,12 +2927,15 @@ Proof.
   destruct (zle sz Int.max_signed); try congruence.
   intro TRBODY.
   generalize TRBODY; intro TMP. monadInv TMP.
-  set (tf := mkfunction (Csharpminor.fn_sig f) (fn_params_names f)
-              (make_vars (fn_params_names f) (fn_vars_names f) (Sseq x1 x0))
-              sz (Sseq x1 x0)) in *.
+  set (tf := mkfunction (Csharpminor.fn_sig f) 
+                        (List.map for_var (fn_params_names f))
+                        (List.map for_var (fn_vars_names f)
+                         ++ List.map for_temp (Csharpminor.fn_temps f))
+                        sz
+                        (Sseq x1 x0)) in *.
   caseEq (Mem.alloc tm 0 (fn_stackspace tf)). intros tm' sp ALLOC'.
   exploit function_entry_ok; eauto; simpl; auto.  
-  intros [f2 [te2 [tm2 [EXEC [MINJ2 [IINCR MCS2]]]]]].
+  intros [f2 [tm2 [EXEC [MINJ2 [IINCR MCS2]]]]].
   left; econstructor; split.
   eapply plus_left. constructor; simpl; eauto. 
   simpl. eapply star_left. constructor.
@@ -3189,25 +2964,13 @@ Proof.
   omega. omega.
   eapply external_call_nextblock_incr; eauto.
   eapply external_call_nextblock_incr; eauto.
-  simpl. change (Val.has_type vres (proj_sig_res (ef_sig ef))). 
-  eapply external_call_well_typed; eauto.
 
-(* return *)
-  inv MK; inv H.
-  (* no argument *)
+(* return none *)
+  inv MK. simpl.
   left; econstructor; split.
   apply plus_one. econstructor; eauto. 
-  simpl. econstructor; eauto. 
-  (* one argument *)
-  exploit var_set_self_correct. eauto. eauto. eauto. eauto. eauto. eauto.
-  instantiate (1 := PTree.set id tv te). apply PTree.gss. 
-  intros; apply PTree.gso; auto.
-  intros [te' [tm' [A [B [C D]]]]].
-  left; econstructor; split.
-  eapply plus_left. econstructor. simpl. eapply star_left. econstructor.
-  eapply star_one. eexact A.
-  reflexivity. traceEq.
-  econstructor; eauto.
+  unfold set_optvar. destruct optid; simpl option_map; econstructor; eauto.
+  eapply match_callstack_set_temp; eauto. 
 Qed.
 
 Lemma match_globalenvs_init:
@@ -3244,7 +3007,7 @@ Proof.
   eapply Genv.initmem_inject; eauto.
   apply mcs_nil with (Mem.nextblock m0). apply match_globalenvs_init; auto. omega. omega.
   instantiate (1 := gce). constructor.
-  red; auto. constructor. rewrite H2; simpl; auto. 
+  red; auto. constructor. 
 Qed.
 
 Lemma transl_final_states:
diff --git a/cfrontend/Csem.v b/cfrontend/Csem.v
index 212c2ad..2858e64 100644
--- a/cfrontend/Csem.v
+++ b/cfrontend/Csem.v
@@ -30,6 +30,67 @@ Require Import Smallstep.
 
 (** * Semantics of type-dependent operations *)
 
+(** Semantics of casts.  [cast v1 t1 t2 v2] holds if value [v1],
+  viewed with static type [t1], can be cast to type [t2],
+  resulting in value [v2].  *)
+
+Definition cast_int_int (sz: intsize) (sg: signedness) (i: int) : int :=
+  match sz, sg with
+  | I8, Signed => Int.sign_ext 8 i
+  | I8, Unsigned => Int.zero_ext 8 i
+  | I16, Signed => Int.sign_ext 16 i
+  | I16, Unsigned => Int.zero_ext 16 i 
+  | I32, _ => i
+  end.
+
+Definition cast_int_float (si : signedness) (i: int) : float :=
+  match si with
+  | Signed => Float.floatofint i
+  | Unsigned => Float.floatofintu i
+  end.
+
+Definition cast_float_int (si : signedness) (f: float) : int :=
+  match si with
+  | Signed => Float.intoffloat f
+  | Unsigned => Float.intuoffloat f
+  end.
+
+Definition cast_float_float (sz: floatsize) (f: float) : float :=
+  match sz with
+  | F32 => Float.singleoffloat f
+  | F64 => f
+  end.
+
+Inductive neutral_for_cast: type -> Prop :=
+  | nfc_int: forall sg,
+      neutral_for_cast (Tint I32 sg)
+  | nfc_ptr: forall ty,
+      neutral_for_cast (Tpointer ty)
+  | nfc_array: forall ty sz,
+      neutral_for_cast (Tarray ty sz)
+  | nfc_fun: forall targs tres,
+      neutral_for_cast (Tfunction targs tres).
+
+Inductive cast : val -> type -> type -> val -> Prop :=
+  | cast_ii:   forall i sz2 sz1 si1 si2,            (**r int to int  *)
+      cast (Vint i) (Tint sz1 si1) (Tint sz2 si2)
+           (Vint (cast_int_int sz2 si2 i))
+  | cast_fi:   forall f sz1 sz2 si2,                (**r float to int *)
+      cast (Vfloat f) (Tfloat sz1) (Tint sz2 si2)
+           (Vint (cast_int_int sz2 si2 (cast_float_int si2 f)))
+  | cast_if:   forall i sz1 sz2 si1,                (**r int to float  *)
+      cast (Vint i) (Tint sz1 si1) (Tfloat sz2)
+          (Vfloat (cast_float_float sz2 (cast_int_float si1 i)))
+  | cast_ff:   forall f sz1 sz2,                    (**r float to float *)
+      cast (Vfloat f) (Tfloat sz1) (Tfloat sz2)
+           (Vfloat (cast_float_float sz2 f))
+  | cast_nn_p: forall b ofs t1 t2, (**r no change in data representation *)
+      neutral_for_cast t1 -> neutral_for_cast t2 ->
+      cast (Vptr b ofs) t1 t2 (Vptr b ofs)
+  | cast_nn_i: forall n t1 t2,     (**r no change in data representation *)
+      neutral_for_cast t1 -> neutral_for_cast t2 ->
+      cast (Vint n) t1 t2 (Vint n).
+
 (** Interpretation of values as truth values.
   Non-zero integers, non-zero floats and non-null pointers are
   considered as true.  The integer zero (which also represents
@@ -59,6 +120,7 @@ Inductive is_true: val -> type -> Prop :=
       Float.cmp Ceq f Float.zero = false ->
       is_true (Vfloat f) (Tfloat sz).
 
+(*
 Inductive bool_of_val : val -> type -> val -> Prop :=
   | bool_of_val_true:   forall v ty, 
          is_true v ty -> 
@@ -66,67 +128,69 @@ Inductive bool_of_val : val -> type -> val -> Prop :=
   | bool_of_val_false:   forall v ty,
         is_false v ty ->
         bool_of_val v ty Vfalse.
+*)
 
 (** The following [sem_] functions compute the result of an operator
   application.  Since operators are overloaded, the result depends
   both on the static types of the arguments and on their run-time values.
-  Unlike in C, automatic conversions between integers and floats
-  are not performed.  For instance, [e1 + e2] is undefined if [e1]
-  is a float and [e2] an integer.  The Clight producer must have explicitly
-  promoted [e2] to a float. *)
+  For binary operations, the "usual binary conversions", adapted to a 32-bit
+  platform, state that:
+- If both arguments are of integer type, an integer operation is performed.
+  For operations that behave differently at unsigned and signed types
+  (e.g. division, modulus, comparisons), the unsigned operation is selected
+  if at least one of the arguments is of type "unsigned int 32", otherwise
+  the signed operation is performed.
+- If both arguments are of float type, a float operation is performed.
+  We choose to perform all float arithmetic in double precision,
+  even if both arguments are single-precision floats.
+- If one argument has integer type and the other has float type,
+  we convert the integer argument to float, then perform the float operation.
+ *)
 
 Function sem_neg (v: val) (ty: type) : option val :=
-  match ty with
-  | Tint _ _ =>
+  match classify_neg ty with
+  | neg_case_i sg =>
       match v with
       | Vint n => Some (Vint (Int.neg n))
       | _ => None
       end
-  | Tfloat _ =>
+  | neg_case_f =>
       match v with
       | Vfloat f => Some (Vfloat (Float.neg f))
       | _ => None
       end
-  | _ => None
-  end.
-
-Function sem_notint (v: val) : option val :=
-  match v with
-  | Vint n => Some (Vint (Int.xor n Int.mone))
-  | _ => None
+  | neg_default => None
   end.
 
-Function sem_notbool (v: val) (ty: type) : option val :=
-  match typeconv ty with
-  | Tint _ _ =>
+Function sem_notint (v: val) (ty: type): option val :=
+  match classify_notint ty with
+  | notint_case_i sg =>
       match v with
-      | Vint n => Some (Val.of_bool (Int.eq n Int.zero))
-      | Vptr _ _ => Some Vfalse
+      | Vint n => Some (Vint (Int.xor n Int.mone))
       | _ => None
       end
-  | Tpointer _ =>
+  | notint_default => None
+  end.
+
+Function sem_notbool (v: val) (ty: type) : option val :=
+  match classify_bool ty with
+  | bool_case_ip =>
       match v with
       | Vint n => Some (Val.of_bool (Int.eq n Int.zero))
       | Vptr _ _ => Some Vfalse
       | _ => None
       end
-  | Tfloat _ =>
+  | bool_case_f =>
       match v with
       | Vfloat f => Some (Val.of_bool (Float.cmp Ceq f Float.zero))
       | _ => None
       end
-  | _ => None
-  end.
-
-Function sem_fabs (v: val) : option val :=
-  match v with
-  | Vfloat f => Some (Vfloat (Float.abs f))
-  | _ => None
+  | bool_default => None
   end.
 
 Function sem_add (v1:val) (t1:type) (v2: val) (t2:type) : option val :=
   match classify_add t1 t2 with 
-  | add_case_ii =>                      (**r integer addition *)
+  | add_case_ii sg =>                   (**r integer addition *)
       match v1, v2 with
       | Vint n1, Vint n2 => Some (Vint (Int.add n1 n2))
       | _,  _ => None
@@ -136,6 +200,16 @@ Function sem_add (v1:val) (t1:type) (v2: val) (t2:type) : option val :=
       | Vfloat n1, Vfloat n2 => Some (Vfloat (Float.add n1 n2))
       | _,  _ => None
       end
+  | add_case_if sg =>                   (**r int plus float *)
+      match v1, v2 with
+      | Vint n1, Vfloat n2 => Some (Vfloat (Float.add (cast_int_float sg n1) n2))
+      | _, _ => None
+      end
+  | add_case_fi sg =>                   (**r float plus int *)
+      match v1, v2 with
+      | Vfloat n1, Vint n2 => Some (Vfloat (Float.add n1 (cast_int_float sg n2)))
+      | _, _ => None
+      end
   | add_case_pi ty =>                   (**r pointer plus integer *)
       match v1,v2 with
       | Vptr b1 ofs1, Vint n2 => 
@@ -153,7 +227,7 @@ end.
 
 Function sem_sub (v1:val) (t1:type) (v2: val) (t2:type) : option val :=
   match classify_sub t1 t2 with
-  | sub_case_ii =>               (**r integer subtraction *)
+  | sub_case_ii sg =>            (**r integer subtraction *)
       match v1,v2 with
       | Vint n1, Vint n2 => Some (Vint (Int.sub n1 n2))
       | _,  _ => None
@@ -163,6 +237,16 @@ Function sem_sub (v1:val) (t1:type) (v2: val) (t2:type) : option val :=
       | Vfloat f1, Vfloat f2 => Some (Vfloat(Float.sub f1 f2))
       | _,  _ => None
       end
+  | sub_case_if sg =>            (**r int minus float *)
+      match v1, v2 with
+      | Vint n1, Vfloat n2 => Some (Vfloat (Float.sub (cast_int_float sg n1) n2))
+      | _, _ => None
+      end
+  | sub_case_fi sg =>            (**r float minus int *)
+      match v1, v2 with
+      | Vfloat n1, Vint n2 => Some (Vfloat (Float.sub n1 (cast_int_float sg n2)))
+      | _, _ => None
+      end
   | sub_case_pi ty =>            (**r pointer minus integer *)
       match v1,v2 with
       | Vptr b1 ofs1, Vint n2 => 
@@ -183,7 +267,7 @@ Function sem_sub (v1:val) (t1:type) (v2: val) (t2:type) : option val :=
  
 Function sem_mul (v1:val) (t1:type) (v2: val) (t2:type) : option val :=
  match classify_mul t1 t2 with
-  | mul_case_ii =>
+  | mul_case_ii sg =>
       match v1,v2 with
       | Vint n1, Vint n2 => Some (Vint (Int.mul n1 n2))
       | _,  _ => None
@@ -193,19 +277,29 @@ Function sem_mul (v1:val) (t1:type) (v2: val) (t2:type) : option val :=
       | Vfloat f1, Vfloat f2 => Some (Vfloat (Float.mul f1 f2))
       | _,  _ => None
       end
+  | mul_case_if sg =>
+      match v1, v2 with
+      | Vint n1, Vfloat n2 => Some (Vfloat (Float.mul (cast_int_float sg n1) n2))
+      | _, _ => None
+      end
+  | mul_case_fi sg =>
+      match v1, v2 with
+      | Vfloat n1, Vint n2 => Some (Vfloat (Float.mul n1 (cast_int_float sg n2)))
+      | _, _ => None
+      end
   | mul_default =>
       None
 end.
 
 Function sem_div (v1:val) (t1:type) (v2: val) (t2:type) : option val :=
    match classify_div t1 t2 with
-  | div_case_I32unsi =>
+  | div_case_ii Unsigned =>
       match v1,v2 with
       | Vint n1, Vint n2 =>
           if Int.eq n2 Int.zero then None else Some (Vint (Int.divu n1 n2))
       | _,_ => None
       end
-  | div_case_ii =>
+  | div_case_ii Signed =>
       match v1,v2 with
        | Vint n1, Vint n2 =>
           if Int.eq n2 Int.zero then None else Some (Vint(Int.divs n1 n2))
@@ -216,68 +310,94 @@ Function sem_div (v1:val) (t1:type) (v2: val) (t2:type) : option val :=
       | Vfloat f1, Vfloat f2 => Some (Vfloat(Float.div f1 f2))
       | _,  _ => None
       end 
+  | div_case_if sg =>
+      match v1, v2 with
+      | Vint n1, Vfloat n2 => Some (Vfloat (Float.div (cast_int_float sg n1) n2))
+      | _, _ => None
+      end
+  | div_case_fi sg =>
+      match v1, v2 with
+      | Vfloat n1, Vint n2 => Some (Vfloat (Float.div n1 (cast_int_float sg n2)))
+      | _, _ => None
+      end
   | div_default =>
       None
 end.
 
 Function sem_mod (v1:val) (t1:type) (v2: val) (t2:type) : option val :=
-  match classify_mod t1 t2 with
-  | mod_case_I32unsi =>
+  match classify_binint t1 t2 with
+  | binint_case_ii Unsigned =>
       match v1, v2 with
       | Vint n1, Vint n2 =>
           if Int.eq n2 Int.zero then None else Some (Vint (Int.modu n1 n2))
       | _, _ => None
       end
-  | mod_case_ii =>
+  | binint_case_ii Signed =>
       match v1,v2 with
       | Vint n1, Vint n2 =>
           if Int.eq n2 Int.zero then None else Some (Vint (Int.mods n1 n2))
       | _, _ => None
       end
-  | mod_default =>
+  | binint_default =>
       None
   end.
 
-Function sem_and (v1 v2: val) : option val :=
-  match v1, v2 with
-  | Vint n1, Vint n2 => Some (Vint(Int.and n1 n2))
-  | _, _ => None
-  end .
-
-Function sem_or (v1 v2: val) : option val :=
-  match v1, v2 with
-  | Vint n1, Vint n2 => Some (Vint(Int.or n1 n2))
-  | _, _ => None
-  end. 
-
-Function sem_xor (v1 v2: val): option val :=
-  match v1, v2 with
-  | Vint n1, Vint n2 => Some (Vint(Int.xor n1 n2))
-  | _, _ => None
+Function sem_and (v1:val) (t1:type) (v2: val) (t2:type) : option val :=
+  match classify_binint t1 t2 with
+  | binint_case_ii sg =>
+      match v1, v2 with
+      | Vint n1, Vint n2 => Some (Vint(Int.and n1 n2))
+      | _, _ => None
+      end
+  | binint_default => None
+  end.
+
+Function sem_or (v1:val) (t1:type) (v2: val) (t2:type) : option val :=
+  match classify_binint t1 t2 with
+  | binint_case_ii sg =>
+      match v1, v2 with
+      | Vint n1, Vint n2 => Some (Vint(Int.or n1 n2))
+      | _, _ => None
+      end
+  | binint_default => None
+  end.
+
+Function sem_xor (v1:val) (t1:type) (v2: val) (t2:type) : option val :=
+  match classify_binint t1 t2 with
+  | binint_case_ii sg =>
+      match v1, v2 with
+      | Vint n1, Vint n2 => Some (Vint(Int.xor n1 n2))
+      | _, _ => None
+      end
+  | binint_default => None
   end.
 
-Function sem_shl (v1 v2: val): option val :=
-  match v1, v2 with
-  | Vint n1, Vint n2 =>
-     if Int.ltu n2 Int.iwordsize then Some (Vint(Int.shl n1 n2)) else None
-  | _, _ => None
+Function sem_shl (v1:val) (t1:type) (v2: val) (t2:type) : option val :=
+  match classify_shift t1 t2 with
+  | shift_case_ii sg =>
+      match v1, v2 with
+      | Vint n1, Vint n2 =>
+         if Int.ltu n2 Int.iwordsize then Some (Vint(Int.shl n1 n2)) else None
+      | _, _ => None
+      end
+  | shift_default => None
   end.
 
 Function sem_shr (v1: val) (t1: type) (v2: val) (t2: type): option val :=
-  match classify_shr t1 t2 with 
-  | shr_case_I32unsi => 
+  match classify_shift t1 t2 with 
+  | shift_case_ii Unsigned =>
       match v1,v2 with 
       | Vint n1, Vint n2 =>
           if Int.ltu n2 Int.iwordsize then Some (Vint (Int.shru n1 n2)) else None
       | _,_ => None
       end
-   | shr_case_ii => 
+   | shift_case_ii Signed =>
       match v1,v2 with
       | Vint n1,  Vint n2 =>
           if Int.ltu n2 Int.iwordsize then Some (Vint (Int.shr n1 n2)) else None
       | _,  _ => None
       end
-   | shr_default=>
+   | shift_default =>
       None
    end.
 
@@ -292,7 +412,7 @@ Function sem_cmp (c:comparison)
                   (v1: val) (t1: type) (v2: val) (t2: type)
                   (m: mem): option val :=
   match classify_cmp t1 t2 with
-  | cmp_case_I32unsi =>
+  | cmp_case_iiu =>
       match v1,v2 with
       | Vint n1, Vint n2 => Some (Val.of_bool (Int.cmpu c n1 n2))
       | _,  _ => None
@@ -318,6 +438,16 @@ Function sem_cmp (c:comparison)
       | Vfloat f1, Vfloat f2 => Some (Val.of_bool (Float.cmp c f1 f2))  
       | _,  _ => None
       end
+  | cmp_case_if sg =>
+      match v1, v2 with
+      | Vint n1, Vfloat n2 => Some (Val.of_bool (Float.cmp c (cast_int_float sg n1) n2))
+      | _, _ => None
+      end
+  | cmp_case_fi sg =>
+      match v1, v2 with
+      | Vfloat n1, Vint n2 => Some (Val.of_bool (Float.cmp c n1 (cast_int_float sg n2)))
+      | _, _ => None
+      end
   | cmp_default => None
   end.
 
@@ -325,9 +455,8 @@ Definition sem_unary_operation
             (op: unary_operation) (v: val) (ty: type): option val :=
   match op with
   | Onotbool => sem_notbool v ty
-  | Onotint => sem_notint v
+  | Onotint => sem_notint v ty
   | Oneg => sem_neg v ty
-  | Ofabs => sem_fabs v
   end.
 
 Definition sem_binary_operation
@@ -340,10 +469,10 @@ Definition sem_binary_operation
   | Omul => sem_mul v1 t1 v2 t2
   | Omod => sem_mod v1 t1 v2 t2
   | Odiv => sem_div v1 t1 v2 t2 
-  | Oand => sem_and v1 v2  
-  | Oor  => sem_or v1 v2 
-  | Oxor  => sem_xor v1 v2 
-  | Oshl => sem_shl v1 v2 
+  | Oand => sem_and v1 t1 v2 t2
+  | Oor  => sem_or v1 t1 v2 t2
+  | Oxor  => sem_xor v1 t1 v2 t2
+  | Oshl => sem_shl v1 t1 v2 t2
   | Oshr  => sem_shr v1 t1 v2 t2   
   | Oeq => sem_cmp Ceq v1 t1 v2 t2 m
   | One => sem_cmp Cne v1 t1 v2 t2 m
@@ -353,67 +482,12 @@ Definition sem_binary_operation
   | Oge => sem_cmp Cge v1 t1 v2 t2 m
   end.
 
-(** Semantic of casts.  [cast v1 t1 t2 v2] holds if value [v1],
-  viewed with static type [t1], can be cast to type [t2],
-  resulting in value [v2].  *)
-
-Definition cast_int_int (sz: intsize) (sg: signedness) (i: int) : int :=
-  match sz, sg with
-  | I8, Signed => Int.sign_ext 8 i
-  | I8, Unsigned => Int.zero_ext 8 i
-  | I16, Signed => Int.sign_ext 16 i
-  | I16, Unsigned => Int.zero_ext 16 i 
-  | I32, _ => i
-  end.
-
-Definition cast_int_float (si : signedness) (i: int) : float :=
-  match si with
-  | Signed => Float.floatofint i
-  | Unsigned => Float.floatofintu i
-  end.
-
-Definition cast_float_int (si : signedness) (f: float) : int :=
-  match si with
-  | Signed => Float.intoffloat f
-  | Unsigned => Float.intuoffloat f
-  end.
-
-Definition cast_float_float (sz: floatsize) (f: float) : float :=
-  match sz with
-  | F32 => Float.singleoffloat f
-  | F64 => f
+Definition sem_incrdecr (id: incr_or_decr) (v: val) (ty: type) :=
+  match id with
+  | Incr => sem_add v ty (Vint Int.one) (Tint I32 Signed)
+  | Decr => sem_sub v ty (Vint Int.one) (Tint I32 Signed)
   end.
 
-Inductive neutral_for_cast: type -> Prop :=
-  | nfc_int: forall sg,
-      neutral_for_cast (Tint I32 sg)
-  | nfc_ptr: forall ty,
-      neutral_for_cast (Tpointer ty)
-  | nfc_array: forall ty sz,
-      neutral_for_cast (Tarray ty sz)
-  | nfc_fun: forall targs tres,
-      neutral_for_cast (Tfunction targs tres).
-
-Inductive cast : val -> type -> type -> val -> Prop :=
-  | cast_ii:   forall i sz2 sz1 si1 si2,            (**r int to int  *)
-      cast (Vint i) (Tint sz1 si1) (Tint sz2 si2)
-           (Vint (cast_int_int sz2 si2 i))
-  | cast_fi:   forall f sz1 sz2 si2,                (**r float to int *)
-      cast (Vfloat f) (Tfloat sz1) (Tint sz2 si2)
-           (Vint (cast_int_int sz2 si2 (cast_float_int si2 f)))
-  | cast_if:   forall i sz1 sz2 si1,                (**r int to float  *)
-      cast (Vint i) (Tint sz1 si1) (Tfloat sz2)
-          (Vfloat (cast_float_float sz2 (cast_int_float si1 i)))
-  | cast_ff:   forall f sz1 sz2,                    (**r float to float *)
-      cast (Vfloat f) (Tfloat sz1) (Tfloat sz2)
-           (Vfloat (cast_float_float sz2 f))
-  | cast_nn_p: forall b ofs t1 t2, (**r no change in data representation *)
-      neutral_for_cast t1 -> neutral_for_cast t2 ->
-      cast (Vptr b ofs) t1 t2 (Vptr b ofs)
-  | cast_nn_i: forall n t1 t2,     (**r no change in data representation *)
-      neutral_for_cast t1 -> neutral_for_cast t2 ->
-      cast (Vint n) t1 t2 (Vint n).
-
 (** * Operational semantics *)
 
 (** The semantics uses two environments.  The global environment
@@ -422,7 +496,7 @@ Inductive cast : val -> type -> type -> val -> Prop :=
 
 Definition genv := Genv.t fundef type.
 
-(** The local environment maps local variables to block references.
+(** The local environment maps local variables to block references and types.
   The current value of the variable is stored in the associated memory
   block. *)
 
@@ -522,180 +596,328 @@ Section SEMANTICS.
 
 Variable ge: genv.
 
-(** ** Evaluation of expressions *)
+(** [type_of_global b] returns the type of the global variable or function
+  at address [b]. *)
+
+Definition type_of_global (b: block) : option type :=
+  match Genv.find_var_info ge b with
+  | Some gv => Some gv.(gvar_info)
+  | None =>
+      match Genv.find_funct_ptr ge b with
+      | Some fd => Some(type_of_fundef fd)
+      | None => None
+      end
+  end.
+
+(** ** Reduction semantics for expressions *)
 
 Section EXPR.
 
 Variable e: env.
-Variable m: mem.
-
-(** [eval_expr ge e m a v] defines the evaluation of expression [a]
-  in r-value position.  [v] is the value of the expression.
-  [e] is the current environment and [m] is the current memory state. *)
-
-Inductive eval_expr: expr -> val -> Prop :=
-  | eval_Econst_int:   forall i ty,
-      eval_expr (Expr (Econst_int i) ty) (Vint i)
-  | eval_Econst_float:   forall f ty,
-      eval_expr (Expr (Econst_float f) ty) (Vfloat f)
-  | eval_Elvalue: forall a ty loc ofs v,
-      eval_lvalue (Expr a ty) loc ofs ->
-      load_value_of_type ty m loc ofs = Some v ->
-      eval_expr (Expr a ty) v
-  | eval_Eaddrof: forall a ty loc ofs,
-      eval_lvalue a loc ofs ->
-      eval_expr (Expr (Eaddrof a) ty) (Vptr loc ofs)
-  | eval_Esizeof: forall ty' ty,
-      eval_expr (Expr (Esizeof ty') ty) (Vint (Int.repr (sizeof ty')))
-  | eval_Eunop:  forall op a ty v1 v,
-      eval_expr a v1 ->
-      sem_unary_operation op v1 (typeof a) = Some v ->
-      eval_expr (Expr (Eunop op a) ty) v
-  | eval_Ebinop: forall op a1 a2 ty v1 v2 v,
-      eval_expr a1 v1 ->
-      eval_expr a2 v2 ->
-      sem_binary_operation op v1 (typeof a1) v2 (typeof a2) m = Some v ->
-      eval_expr (Expr (Ebinop op a1 a2) ty) v
-  | eval_Econdition_true: forall a1 a2 a3 ty v1 v2,
-      eval_expr a1 v1 ->
-      is_true v1 (typeof a1) ->
-      eval_expr a2 v2 ->
-      eval_expr (Expr (Econdition a1 a2 a3) ty) v2
-  | eval_Econdition_false: forall a1 a2 a3 ty v1 v3,
-      eval_expr a1 v1 ->
-      is_false v1 (typeof a1) ->
-      eval_expr a3 v3 ->
-      eval_expr (Expr (Econdition a1 a2 a3) ty) v3
-  | eval_Eorbool_1: forall a1 a2 ty v1,
-      eval_expr a1 v1 ->
-      is_true v1 (typeof a1) ->
-      eval_expr (Expr (Eorbool a1 a2) ty) Vtrue
-  | eval_Eorbool_2: forall a1 a2 ty v1 v2 v,
-      eval_expr a1 v1 ->
-      is_false v1 (typeof a1) -> 
-      eval_expr a2 v2 ->
-      bool_of_val v2 (typeof a2) v ->
-      eval_expr (Expr (Eorbool a1 a2) ty) v
-  | eval_Eandbool_1: forall a1 a2 ty v1,
-      eval_expr a1 v1 ->
-      is_false v1 (typeof a1) ->
-      eval_expr (Expr (Eandbool a1 a2) ty) Vfalse
-  | eval_Eandbool_2: forall a1 a2 ty v1 v2 v,
-      eval_expr a1 v1 ->
-      is_true v1 (typeof a1) -> 
-      eval_expr a2 v2 ->
-      bool_of_val v2 (typeof a2) v ->
-      eval_expr (Expr (Eandbool a1 a2) ty) v
-  | eval_Ecast:   forall a ty ty' v1 v,
-      eval_expr a v1 ->
-      cast v1 (typeof a) ty v ->
-      eval_expr (Expr (Ecast ty a) ty') v
-
-(** [eval_lvalue ge e m a b ofs] defines the evaluation of expression [a]
-  in l-value position.  The result is the memory location [b, ofs]
-  that contains the value of the expression [a]. *)
-
-with eval_lvalue: expr -> block -> int -> Prop :=
-  | eval_Evar_local:   forall id l ty,
-      e!id = Some(l, ty) ->
-      eval_lvalue (Expr (Evar id) ty) l Int.zero
-  | eval_Evar_global: forall id l ty,
-      e!id = None ->
-      Genv.find_symbol ge id = Some l ->
-      eval_lvalue (Expr (Evar id) ty) l Int.zero
-  | eval_Ederef: forall a ty l ofs,
-      eval_expr a (Vptr l ofs) ->
-      eval_lvalue (Expr (Ederef a) ty) l ofs
- | eval_Efield_struct:   forall a i ty l ofs id fList delta,
-      eval_lvalue a l ofs ->
-      typeof a = Tstruct id fList ->
-      field_offset i fList = OK delta ->
-      eval_lvalue (Expr (Efield a i) ty) l (Int.add ofs (Int.repr delta))
- | eval_Efield_union:   forall a i ty l ofs id fList,
-      eval_lvalue a l ofs ->
-      typeof a = Tunion id fList ->
-      eval_lvalue (Expr (Efield a i) ty) l ofs.
-
-Scheme eval_expr_ind2 := Minimality for eval_expr Sort Prop
-  with eval_lvalue_ind2 := Minimality for eval_lvalue Sort Prop.
-
-(** [eval_exprlist ge e m al vl] evaluates a list of r-value
-  expressions [al] to their values [vl]. *)
-
-Inductive eval_exprlist: list expr -> list val -> Prop :=
-  | eval_Enil:
-      eval_exprlist nil nil
-  | eval_Econs:   forall a bl v vl,
-      eval_expr a v ->
-      eval_exprlist bl vl ->
-      eval_exprlist (a :: bl) (v :: vl).
-
-End EXPR.
-
-(** ** Transition semantics for statements and functions *)
-
-(** Continuations *)
+
+(** The semantics of expressions follows the popular Wright-Felleisen style.
+  It is a small-step semantics that reduces one redex at a time.
+  We first define head reductions (at the top of an expression, then
+  use reduction contexts to define reduction within an expression. *)
+
+(** Head reduction for l-values. *)
+
+Inductive lred: expr -> mem -> expr -> mem -> Prop :=
+  | red_var_local: forall x ty m b,
+      e!x = Some(b, ty) ->
+      lred (Evar x ty) m
+           (Eloc b Int.zero ty) m
+  | red_var_global: forall x ty m b,
+      e!x = None ->
+      Genv.find_symbol ge x = Some b ->
+      type_of_global b = Some ty ->
+      lred (Evar x ty) m
+           (Eloc b Int.zero ty) m
+  | red_deref: forall b ofs ty1 ty m,
+      lred (Ederef (Eval (Vptr b ofs) ty1) ty) m
+           (Eloc b ofs ty) m
+  | red_field_struct: forall b ofs id fList f ty m delta,
+      field_offset f fList = OK delta ->
+      lred (Efield (Eloc b ofs (Tstruct id fList)) f ty) m
+           (Eloc b (Int.add ofs (Int.repr delta)) ty) m
+  | red_field_union: forall b ofs id fList f ty m,
+      lred (Efield (Eloc b ofs (Tunion id fList)) f ty) m
+           (Eloc b ofs ty) m.
+
+(** Head reductions for r-values *)
+
+Inductive rred: expr -> mem -> expr -> mem -> Prop :=
+  | red_rvalof: forall b ofs ty m v,
+      load_value_of_type ty m b ofs = Some v ->
+      rred (Evalof (Eloc b ofs ty) ty) m
+           (Eval v ty) m
+  | red_addrof: forall b ofs ty1 ty m,
+      rred (Eaddrof (Eloc b ofs ty1) ty) m
+           (Eval (Vptr b ofs) ty) m
+  | red_unop: forall op v1 ty1 ty m v,
+      sem_unary_operation op v1 ty1 = Some v ->
+      rred (Eunop op (Eval v1 ty1) ty) m
+           (Eval v ty) m
+  | red_binop: forall op v1 ty1 v2 ty2 ty m v,
+      sem_binary_operation op v1 ty1 v2 ty2 m = Some v ->
+      rred (Ebinop op (Eval v1 ty1) (Eval v2 ty2) ty) m
+           (Eval v ty) m
+  | red_cast: forall ty v1 ty1 m v,
+      cast v1 ty1 ty v ->
+      rred (Ecast (Eval v1 ty1) ty) m
+           (Eval v ty) m
+  | red_condition_true: forall v1 ty1 r1 r2 ty m,
+      is_true v1 ty1 -> typeof r1 = ty ->
+      rred (Econdition (Eval v1 ty1) r1 r2 ty) m
+           (Eparen r1 ty) m
+  | red_condition_false: forall v1 ty1 r1 r2 ty m,
+      is_false v1 ty1 -> typeof r2 = ty ->
+      rred (Econdition (Eval v1 ty1) r1 r2 ty) m
+           (Eparen r2 ty) m
+  | red_sizeof: forall ty1 ty m,
+      rred (Esizeof ty1 ty) m
+           (Eval (Vint (Int.repr (sizeof ty1))) ty) m
+  | red_assign: forall b ofs ty1 v2 ty2 m v m',
+      cast v2 ty2 ty1 v ->
+      store_value_of_type ty1 m b ofs v = Some m' ->
+      rred (Eassign (Eloc b ofs ty1) (Eval v2 ty2) ty1) m
+           (Eval v ty1) m'
+  | red_assignop: forall op b ofs ty1 v2 ty2 tyres m v1 v v' m',
+      load_value_of_type ty1 m b ofs = Some v1 ->
+      sem_binary_operation op v1 ty1 v2 ty2 m = Some v ->
+      cast v tyres ty1 v' ->
+      store_value_of_type ty1 m b ofs v' = Some m' ->
+      rred (Eassignop op (Eloc b ofs ty1) (Eval v2 ty2) tyres ty1) m
+           (Eval v' ty1) m'
+  | red_postincr: forall id b ofs ty m v1 v2 v3 m',
+      load_value_of_type ty m b ofs = Some v1 ->
+      sem_incrdecr id v1 ty = Some v2 ->
+      cast v2 (typeconv ty) ty v3 ->
+      store_value_of_type ty m b ofs v3 = Some m' ->
+      rred (Epostincr id (Eloc b ofs ty) ty) m
+           (Eval v1 ty) m'
+  | red_comma: forall v ty1 r2 ty m,
+      typeof r2 = ty ->
+      rred (Ecomma (Eval v ty1) r2 ty) m
+           r2 m
+  | red_paren: forall r ty m,
+      typeof r = ty ->
+      rred (Eparen r ty) m
+           r m.
+
+(** Head reduction for function calls.
+    (More exactly, identification of function calls that can reduce.) *)
+
+Inductive cast_arguments: exprlist -> typelist -> list val -> Prop :=
+  | cast_args_nil:
+      cast_arguments Enil Tnil nil
+  | cast_args_cons: forall v ty el targ1 targs v1 vl,
+      cast v ty targ1 v1 -> cast_arguments el targs vl ->
+      cast_arguments (Econs (Eval v ty) el) (Tcons targ1 targs) (v1 :: vl).
+
+Inductive callred: expr -> fundef -> list val -> type -> Prop :=
+  | red_Ecall: forall vf tyargs tyres el ty fd vargs,
+      Genv.find_funct ge vf = Some fd ->
+      cast_arguments el tyargs vargs ->
+      type_of_fundef fd = Tfunction tyargs tyres ->
+      callred (Ecall (Eval vf (Tfunction tyargs tyres)) el ty)
+              fd vargs ty.
+
+(** Reduction contexts.  In accordance with C's nondeterministic semantics,
+  we allow reduction both to the left and to the right of a binary operator.
+  To enforce C's notion of sequence point, reductions within a conditional
+  [a ? b : c] can only take place in [a], not in [b] nor [c];
+  and reductions within a sequence [a, b] can only take place in [a], not in [b].
+
+  Reduction contexts are represented by functions [C] from expressions to expressions,
+  suitably constrained by the [context from to C] predicate below.
+  Contexts are "kinded" with respect to l-values and r-values:
+  [from] is the kind of the hole in the context and [to] is the kind of
+  the term resulting from filling the hole.
+*)
+
+Inductive kind : Type := LV | RV.
+
+Inductive context: kind -> kind -> (expr -> expr) -> Prop :=
+  | ctx_top: forall k,
+      context k k (fun x => x)
+  | ctx_deref: forall k C ty,
+      context k RV C -> context k LV (fun x => Ederef (C x) ty)
+  | ctx_field: forall k C f ty,
+      context k LV C -> context k LV (fun x => Efield (C x) f ty)
+  | ctx_rvalof: forall k C ty,
+      context k LV C -> context k RV (fun x => Evalof (C x) ty)
+  | ctx_addrof: forall k C ty,
+      context k LV C -> context k RV (fun x => Eaddrof (C x) ty)
+  | ctx_unop: forall k C op ty,
+      context k RV C -> context k RV (fun x => Eunop op (C x) ty)
+  | ctx_binop_left: forall k C op e2 ty,
+      context k RV C -> context k RV (fun x => Ebinop op (C x) e2 ty)
+  | ctx_binop_right: forall k C op e1 ty,
+      context k RV C -> context k RV (fun x => Ebinop op e1 (C x) ty)
+  | ctx_cast: forall k C ty,
+      context k RV C -> context k RV (fun x => Ecast (C x) ty)
+  | ctx_condition: forall k C r2 r3 ty,
+      context k RV C -> context k RV (fun x => Econdition (C x) r2 r3 ty)
+  | ctx_assign_left: forall k C e2 ty,
+      context k LV C -> context k RV (fun x => Eassign (C x) e2 ty)
+  | ctx_assign_right: forall k C e1 ty,
+      context k RV C -> context k RV (fun x => Eassign e1 (C x) ty)
+  | ctx_assignop_left: forall k C op e2 tyres ty,
+      context k LV C -> context k RV (fun x => Eassignop op (C x) e2 tyres ty)
+  | ctx_assignop_right: forall k C op e1 tyres ty,
+      context k RV C -> context k RV (fun x => Eassignop op e1 (C x) tyres ty)
+  | ctx_postincr: forall k C id ty,
+      context k LV C -> context k RV (fun x => Epostincr id (C x) ty)
+  | ctx_call_left: forall k C el ty,
+      context k RV C -> context k RV (fun x => Ecall (C x) el ty)
+  | ctx_call_right: forall k C e1 ty,
+      contextlist k C -> context k RV (fun x => Ecall e1 (C x) ty)
+  | ctx_comma: forall k C e2 ty,
+      context k RV C -> context k RV (fun x => Ecomma (C x) e2 ty)
+  | ctx_paren: forall k C ty,
+      context k RV C -> context k RV (fun x => Eparen (C x) ty)
+
+with contextlist: kind -> (expr -> exprlist) -> Prop :=
+  | ctx_list_head: forall k C el,
+      context k RV C -> contextlist k (fun x => Econs (C x) el)
+  | ctx_list_tail: forall k C e1,
+      contextlist k C -> contextlist k (fun x => Econs e1 (C x)).
+
+(** In a nondeterministic semantics, expressions can go wrong according
+  to one reduction order while being defined according to another.
+  Consider for instance [(x = 1) + (10 / x)] where [x] is initially [0].
+  This expression goes wrong if evaluated right-to-left, but is defined
+  if evaluated left-to-right.  Since our compiler is going to pick one
+  particular evaluation order, we must make sure that all orders are safe,
+  i.e. never evaluate a subexpression that goes wrong.
+
+  Being safe is a stronger requirement than just not getting stuck during
+  reductions.  Consider [f() + (10 / x)], where [f()] does not terminate.
+  This expression is never stuck because the evaluation of [f()] can make
+  infinitely many transitions.  Yet it contains a subexpression [10 / x]
+  that can go wrong if [x = 0], and the compiler may choose to evaluate
+  [10 / x] first, before calling [f()].  
+
+  Therefore, we must make sure that not only an expression cannot get stuck,
+  but none of its subexpressions can either.  We say that a subexpression
+  is not immediately stuck if it is a value (of the appropriate kind)
+  or it can reduce (at head or within). *)
+
+Inductive not_imm_stuck: kind -> expr -> mem -> Prop :=
+  | not_stuck_val: forall v ty m,
+      not_imm_stuck RV (Eval v ty) m
+  | not_stuck_loc: forall b ofs ty m,
+      not_imm_stuck LV (Eloc b ofs ty) m
+  | not_stuck_lred: forall to C e m e' m',
+      lred e m e' m' ->
+      context LV to C ->
+      not_imm_stuck to (C e) m
+  | not_stuck_rred: forall to C e m e' m',
+      rred e m e' m' ->
+      context RV to C ->
+      not_imm_stuck to (C e) m
+  | not_stuck_callred: forall to C e m fd args ty,
+      callred e fd args ty ->
+      context RV to C ->
+      not_imm_stuck to (C e) m.
+
+(* An expression is not stuck if none of the potential redexes contained within
+   is immediately stuck. *)
+
+Definition not_stuck (e: expr) (m: mem) : Prop :=
+  forall k C e' , 
+  context k RV C -> e = C e' -> not_imm_stuck k e' m.
+
+End EXPR. 
+
+(** ** Transition semantics. *)
+
+(** Continuations describe the computations that remain to be performed
+    after the statement or expression under consideration has
+    evaluated completely. *)
 
 Inductive cont: Type :=
   | Kstop: cont
-  | Kseq: statement -> cont -> cont
-       (**r [Kseq s2 k] = after [s1] in [s1;s2] *)
-  | Kwhile: expr -> statement -> cont -> cont
-       (**r [Kwhile e s k] = after [s] in [while (e) s] *)
-  | Kdowhile: expr -> statement -> cont -> cont
-       (**r [Kdowhile e s k] = after [s] in [do s while (e)] *)
-  | Kfor2: expr -> statement -> statement -> cont -> cont
-       (**r [Kfor2 e2 e3 s k] = after [s] in [for(e1;e2;e3) s] *)
-  | Kfor3: expr -> statement -> statement -> cont -> cont
-       (**r [Kfor3 e2 e3 s k] = after [e3] in [for(e1;e2;e3) s] *)
-  | Kswitch: cont -> cont
-       (**r catches [break] statements arising out of [switch] *)
-  | Kcall: option (block * int * type) ->   (**r where to store result *)
-           function ->                      (**r calling function *)
-           env ->                           (**r local env of calling function *)
+  | Kdo: cont -> cont       (**r [Kdo k] = after [x] in [x;] *)
+  | Kseq: statement -> cont -> cont    (**r [Kseq s2 k] = after [s1] in [s1;s2] *)
+  | Kifthenelse: statement -> statement -> cont -> cont     (**r [Kifthenelse s1 s2 k] = after [x] in [if (x) { s1 } else { s2 }] *)
+  | Kwhile1: expr -> statement -> cont -> cont      (**r [Kwhile1 x s k] = after [x] in [while(x) s] *)
+  | Kwhile2: expr -> statement -> cont -> cont      (**r [Kwhile x s k] = after [s] in [while (x) s] *)
+  | Kdowhile1: expr -> statement -> cont -> cont    (**r [Kdowhile1 x s k] = after [s] in [do s while (x)] *)
+  | Kdowhile2: expr -> statement -> cont -> cont    (**r [Kdowhile2 x s k] = after [x] in [do s while (x)] *)
+  | Kfor2: expr -> statement -> statement -> cont -> cont   (**r [Kfor2 e2 e3 s k] = after [e2] in [for(e1;e2;e3) s] *)
+  | Kfor3: expr -> statement -> statement -> cont -> cont   (**r [Kfor3 e2 e3 s k] = after [s] in [for(e1;e2;e3) s] *)
+  | Kfor4: expr -> statement -> statement -> cont -> cont   (**r [Kfor3 e2 e3 s k] = after [e3] in [for(e1;e2;e3) s] *)
+  | Kswitch1: labeled_statements -> cont -> cont     (**r [Kswitch1 ls k] = after [e] in [switch(e) { ls }] *)
+  | Kswitch2: cont -> cont       (**r catches [break] statements arising out of [switch] *)
+  | Kreturn: cont -> cont        (**r [Kreturn k] = after [e] in [return e;] *)
+  | Kcall: function ->           (**r calling function *)
+           env ->                (**r local env of calling function *)
+           (expr -> expr) ->     (**r context of the call *)
+           type ->               (**r type of call expression *)
            cont -> cont.
 
 (** Pop continuation until a call or stop *)
 
 Fixpoint call_cont (k: cont) : cont :=
   match k with
+  | Kstop => k
+  | Kdo k => k
   | Kseq s k => call_cont k
-  | Kwhile e s k => call_cont k
-  | Kdowhile e s k => call_cont k
+  | Kifthenelse s1 s2 k => call_cont k
+  | Kwhile1 e s k => call_cont k
+  | Kwhile2 e s k => call_cont k
+  | Kdowhile1 e s k => call_cont k
+  | Kdowhile2 e s k => call_cont k
   | Kfor2 e2 e3 s k => call_cont k
   | Kfor3 e2 e3 s k => call_cont k
-  | Kswitch k => call_cont k
-  | _ => k
+  | Kfor4 e2 e3 s k => call_cont k
+  | Kswitch1 ls k => call_cont k
+  | Kswitch2 k => call_cont k
+  | Kreturn k => call_cont k
+  | Kcall _ _ _ _ _ => k
   end.
 
 Definition is_call_cont (k: cont) : Prop :=
   match k with
   | Kstop => True
-  | Kcall _ _ _ _ => True
+  | Kcall _ _ _ _ _ => True
   | _ => False
   end.
 
-(** States *)
+(** Execution states of the program are grouped in 4 classes corresponding
+  to the part of the program we are currently executing.  It can be
+  a statement ([State]), an expression ([ExprState]), a transition
+  from a calling function to a called function ([Callstate]), or
+  the symmetrical transition from a function back to its caller
+  ([Returnstate]). *)
 
 Inductive state: Type :=
-  | State
+  | State                               (**r execution of a statement *)
       (f: function)
       (s: statement)
       (k: cont)
       (e: env)
       (m: mem) : state
-  | Callstate
+  | ExprState                           (**r reduction of an expression *)
+      (f: function)
+      (r: expr)
+      (k: cont)
+      (e: env)
+      (m: mem) : state
+  | Callstate                           (**r calling a function *)
       (fd: fundef)
       (args: list val)
       (k: cont)
       (m: mem) : state
-  | Returnstate
+  | Returnstate                         (**r returning from a function *)
       (res: val)
       (k: cont)
       (m: mem) : state.
                  
 (** Find the statement and manufacture the continuation 
-  corresponding to a label *)
+  corresponding to a label. *)
 
 Fixpoint find_label (lbl: label) (s: statement) (k: cont) 
                     {struct s}: option (statement * cont) :=
@@ -711,20 +933,20 @@ Fixpoint find_label (lbl: label) (s: statement) (k: cont)
       | None => find_label lbl s2 k
       end
   | Swhile a s1 =>
-      find_label lbl s1 (Kwhile a s1 k)
+      find_label lbl s1 (Kwhile2 a s1 k)
   | Sdowhile a s1 =>
-      find_label lbl s1 (Kdowhile a s1 k)
+      find_label lbl s1 (Kdowhile1 a s1 k)
   | Sfor a1 a2 a3 s1 =>
       match find_label lbl a1 (Kseq (Sfor Sskip a2 a3 s1) k) with
       | Some sk => Some sk
       | None =>
-          match find_label lbl s1 (Kfor2 a2 a3 s1 k) with
+          match find_label lbl s1 (Kfor3 a2 a3 s1 k) with
           | Some sk => Some sk
-          | None => find_label lbl a3 (Kfor3 a2 a3 s1 k)
+          | None => find_label lbl a3 (Kfor4 a2 a3 s1 k)
           end
       end
   | Sswitch e sl =>
-      find_label_ls lbl sl (Kswitch k)
+      find_label_ls lbl sl (Kswitch2 k)
   | Slabel lbl' s' =>
       if ident_eq lbl lbl' then Some(s', k) else find_label lbl s' k
   | _ => None
@@ -741,481 +963,196 @@ with find_label_ls (lbl: label) (sl: labeled_statements) (k: cont)
       end
   end.
 
-(** Transition relation *)
-
-Inductive step: state -> trace -> state -> Prop :=
-
-  | step_assign:   forall f a1 a2 k e m loc ofs v2 m',
-      eval_lvalue e m a1 loc ofs ->
-      eval_expr e m a2 v2 ->
-      store_value_of_type (typeof a1) m loc ofs v2 = Some m' ->
-      step (State f (Sassign a1 a2) k e m)
-        E0 (State f Sskip k e m')
-
-  | step_call_none:   forall f a al k e m vf vargs fd,
-      eval_expr e m a vf ->
-      eval_exprlist e m al vargs ->
-      Genv.find_funct ge vf = Some fd ->
-      type_of_fundef fd = typeof a ->
-      step (State f (Scall None a al) k e m)
-        E0 (Callstate fd vargs (Kcall None f e k) m)
-
-  | step_call_some:   forall f lhs a al k e m loc ofs vf vargs fd,
-      eval_lvalue e m lhs loc ofs ->
-      eval_expr e m a vf ->
-      eval_exprlist e m al vargs ->
-      Genv.find_funct ge vf = Some fd ->
-      type_of_fundef fd = typeof a ->
-      step (State f (Scall (Some lhs) a al) k e m)
-        E0 (Callstate fd vargs (Kcall (Some(loc, ofs, typeof lhs)) f e k) m)
+(** We separate the transition rules in two groups:
+- one group that deals with reductions over expressions;
+- the other group that deals with everything else: statements, function calls, etc.
+
+This makes it easy to express different reduction strategies for expressions:
+the second group of rules can be reused as is. *)
+
+Inductive estep: state -> trace -> state -> Prop :=
+
+  | step_lred: forall C f a k e m a' m',
+      lred e a m a' m' ->
+      not_stuck e (C a) m ->
+      context LV RV C ->
+      estep (ExprState f (C a) k e m)
+         E0 (ExprState f (C a') k e m')
+
+  | step_rred: forall C f a k e m a' m',
+      rred a m a' m' ->
+      not_stuck e (C a) m ->
+      context RV RV C ->
+      estep (ExprState f (C a) k e m)
+         E0 (ExprState f (C a') k e m')
+
+  | step_call: forall C f a k e m fd vargs ty,
+      callred a fd vargs ty ->
+      not_stuck e (C a) m ->
+      context RV RV C ->
+      estep (ExprState f (C a) k e m)
+         E0 (Callstate fd vargs (Kcall f e C ty k) m).
+
+Inductive sstep: state -> trace -> state -> Prop :=
+
+  | step_do_1: forall f x k e m,
+      sstep (State f (Sdo x) k e m)
+        E0 (ExprState f x (Kdo k) e m)
+  | step_do_2: forall f v ty k e m,
+      sstep (ExprState f (Eval v ty) (Kdo k) e m)
+        E0 (State f Sskip k e m)
 
   | step_seq:  forall f s1 s2 k e m,
-      step (State f (Ssequence s1 s2) k e m)
+      sstep (State f (Ssequence s1 s2) k e m)
         E0 (State f s1 (Kseq s2 k) e m)
   | step_skip_seq: forall f s k e m,
-      step (State f Sskip (Kseq s k) e m)
+      sstep (State f Sskip (Kseq s k) e m)
         E0 (State f s k e m)
   | step_continue_seq: forall f s k e m,
-      step (State f Scontinue (Kseq s k) e m)
+      sstep (State f Scontinue (Kseq s k) e m)
         E0 (State f Scontinue k e m)
   | step_break_seq: forall f s k e m,
-      step (State f Sbreak (Kseq s k) e m)
+      sstep (State f Sbreak (Kseq s k) e m)
         E0 (State f Sbreak k e m)
 
-  | step_ifthenelse_true:  forall f a s1 s2 k e m v1,
-      eval_expr e m a v1 ->
-      is_true v1 (typeof a) ->
-      step (State f (Sifthenelse a s1 s2) k e m)
+  | step_ifthenelse: forall f a s1 s2 k e m,
+      sstep (State f (Sifthenelse a s1 s2) k e m)
+        E0 (ExprState f a (Kifthenelse s1 s2 k) e m)
+  | step_ifthenelse_true:  forall f v ty s1 s2 k e m,
+      is_true v ty ->
+      sstep (ExprState f (Eval v ty) (Kifthenelse s1 s2 k) e m)
         E0 (State f s1 k e m)
-  | step_ifthenelse_false: forall f a s1 s2 k e m v1,
-      eval_expr e m a v1 ->
-      is_false v1 (typeof a) ->
-      step (State f (Sifthenelse a s1 s2) k e m)
+  | step_ifthenelse_false: forall f v ty s1 s2 k e m,
+      is_false v ty ->
+      sstep (ExprState f (Eval v ty) (Kifthenelse s1 s2 k) e m)
         E0 (State f s2 k e m)
 
-  | step_while_false: forall f a s k e m v,
-      eval_expr e m a v ->
-      is_false v (typeof a) ->
-      step (State f (Swhile a s) k e m)
+  | step_while: forall f x s k e m,
+      sstep (State f (Swhile x s) k e m)
+        E0 (ExprState f x (Kwhile1 x s k) e m)
+  | step_while_false: forall f v ty x s k e m,
+      is_false v ty ->
+      sstep (ExprState f (Eval v ty) (Kwhile1 x s k) e m)
         E0 (State f Sskip k e m)
-  | step_while_true: forall f a s k e m v,
-      eval_expr e m a v ->
-      is_true v (typeof a) ->
-      step (State f (Swhile a s) k e m)
-        E0 (State f s (Kwhile a s k) e m)
-  | step_skip_or_continue_while: forall f x a s k e m,
-      x = Sskip \/ x = Scontinue ->
-      step (State f x (Kwhile a s k) e m)
-        E0 (State f (Swhile a s) k e m)
-  | step_break_while: forall f a s k e m,
-      step (State f Sbreak (Kwhile a s k) e m)
+  | step_while_true: forall f v ty x s k e m ,
+      is_true v ty ->
+      sstep (ExprState f (Eval v ty) (Kwhile1 x s k) e m)
+        E0 (State f s (Kwhile2 x s k) e m)
+  | step_skip_or_continue_while: forall f s0 x s k e m,
+      s0 = Sskip \/ s0 = Scontinue ->
+      sstep (State f s0 (Kwhile2 x s k) e m)
+        E0 (State f (Swhile x s) k e m)
+  | step_break_while: forall f x s k e m,
+      sstep (State f Sbreak (Kwhile2 x s k) e m)
         E0 (State f Sskip k e m)
 
   | step_dowhile: forall f a s k e m,
-      step (State f (Sdowhile a s) k e m)
-        E0 (State f s (Kdowhile a s k) e m)
-  | step_skip_or_continue_dowhile_false: forall f x a s k e m v,
-      x = Sskip \/ x = Scontinue ->
-      eval_expr e m a v ->
-      is_false v (typeof a) ->
-      step (State f x (Kdowhile a s k) e m)
+      sstep (State f (Sdowhile a s) k e m)
+        E0 (State f s (Kdowhile1 a s k) e m)
+  | step_skip_or_continue_dowhile: forall f s0 x s k e m,
+      s0 = Sskip \/ s0 = Scontinue ->
+      sstep (State f s0 (Kdowhile1 x s k) e m)
+        E0 (ExprState f x (Kdowhile2 x s k) e m)
+  | step_dowhile_false: forall f v ty x s k e m,
+      is_false v ty ->
+      sstep (ExprState f (Eval v ty) (Kdowhile2 x s k) e m)
         E0 (State f Sskip k e m)
-  | step_skip_or_continue_dowhile_true: forall f x a s k e m v,
-      x = Sskip \/ x = Scontinue ->
-      eval_expr e m a v ->
-      is_true v (typeof a) ->
-      step (State f x (Kdowhile a s k) e m)
-        E0 (State f (Sdowhile a s) k e m)
+  | step_dowhile_true: forall f v ty x s k e m,
+      is_true v ty ->
+      sstep (ExprState f (Eval v ty) (Kdowhile2 x s k) e m)
+        E0 (State f (Sdowhile x s) k e m)
   | step_break_dowhile: forall f a s k e m,
-      step (State f Sbreak (Kdowhile a s k) e m)
+      sstep (State f Sbreak (Kdowhile1 a s k) e m)
         E0 (State f Sskip k e m)
 
   | step_for_start: forall f a1 a2 a3 s k e m,
       a1 <> Sskip ->
-      step (State f (Sfor a1 a2 a3 s) k e m)
+      sstep (State f (Sfor a1 a2 a3 s) k e m)
         E0 (State f a1 (Kseq (Sfor Sskip a2 a3 s) k) e m)
-  | step_for_false: forall f a2 a3 s k e m v,
-      eval_expr e m a2 v ->
-      is_false v (typeof a2) ->
-      step (State f (Sfor Sskip a2 a3 s) k e m)
+  | step_for: forall f a2 a3 s k e m,
+      sstep (State f (Sfor Sskip a2 a3 s) k e m)
+        E0 (ExprState f a2 (Kfor2 a2 a3 s k) e m)
+  | step_for_false: forall f v ty a2 a3 s k e m,
+      is_false v ty ->
+      sstep (ExprState f (Eval v ty) (Kfor2 a2 a3 s k) e m)
         E0 (State f Sskip k e m)
-  | step_for_true: forall f a2 a3 s k e m v,
-      eval_expr e m a2 v ->
-      is_true v (typeof a2) ->
-      step (State f (Sfor Sskip a2 a3 s) k e m)
-        E0 (State f s (Kfor2 a2 a3 s k) e m)
-  | step_skip_or_continue_for2: forall f x a2 a3 s k e m,
+  | step_for_true: forall f v ty a2 a3 s k e m,
+      is_true v ty ->
+      sstep (ExprState f (Eval v ty) (Kfor2 a2 a3 s k) e m)
+        E0 (State f s (Kfor3 a2 a3 s k) e m)
+  | step_skip_or_continue_for3: forall f x a2 a3 s k e m,
       x = Sskip \/ x = Scontinue ->
-      step (State f x (Kfor2 a2 a3 s k) e m)
-        E0 (State f a3 (Kfor3 a2 a3 s k) e m)
-  | step_break_for2: forall f a2 a3 s k e m,
-      step (State f Sbreak (Kfor2 a2 a3 s k) e m)
+      sstep (State f x (Kfor3 a2 a3 s k) e m)
+        E0 (State f a3 (Kfor4 a2 a3 s k) e m)
+  | step_break_for3: forall f a2 a3 s k e m,
+      sstep (State f Sbreak (Kfor3 a2 a3 s k) e m)
         E0 (State f Sskip k e m)
-  | step_skip_for3: forall f a2 a3 s k e m,
-      step (State f Sskip (Kfor3 a2 a3 s k) e m)
+  | step_skip_for4: forall f a2 a3 s k e m,
+      sstep (State f Sskip (Kfor4 a2 a3 s k) e m)
         E0 (State f (Sfor Sskip a2 a3 s) k e m)
 
   | step_return_0: forall f k e m m',
       f.(fn_return) = Tvoid ->
       Mem.free_list m (blocks_of_env e) = Some m' ->
-      step (State f (Sreturn None) k e m)
+      sstep (State f (Sreturn None) k e m)
         E0 (Returnstate Vundef (call_cont k) m')
-  | step_return_1: forall f a k e m v m',
+  | step_return_1: forall f x k e m,
       f.(fn_return) <> Tvoid ->
-      eval_expr e m a v ->
+      sstep (State f (Sreturn (Some x)) k e m)
+        E0 (ExprState f x (Kreturn k) e  m)
+  | step_return_2:  forall f v1 ty k e m v2 m',
+      cast v1 ty f.(fn_return) v2 ->
       Mem.free_list m (blocks_of_env e) = Some m' ->
-      step (State f (Sreturn (Some a)) k e m)
-        E0 (Returnstate v (call_cont k) m')
+      sstep (ExprState f (Eval v1 ty) (Kreturn k) e m)
+        E0 (Returnstate v2 (call_cont k) m')
   | step_skip_call: forall f k e m m',
       is_call_cont k ->
       f.(fn_return) = Tvoid ->
       Mem.free_list m (blocks_of_env e) = Some m' ->
-      step (State f Sskip k e m)
+      sstep (State f Sskip k e m)
         E0 (Returnstate Vundef k m')
 
-  | step_switch: forall f a sl k e m n,
-      eval_expr e m a (Vint n) ->
-      step (State f (Sswitch a sl) k e m)
-        E0 (State f (seq_of_labeled_statement (select_switch n sl)) (Kswitch k) e m)
+  | step_switch: forall f x sl k e m,
+      sstep (State f (Sswitch x sl) k e m)
+        E0 (ExprState f x (Kswitch1 sl k) e m)
+  | step_expr_switch: forall f n ty sl k e m,
+      sstep (ExprState f (Eval (Vint n) ty) (Kswitch1 sl k) e m)
+        E0 (State f (seq_of_labeled_statement (select_switch n sl)) (Kswitch2 k) e m)
   | step_skip_break_switch: forall f x k e m,
       x = Sskip \/ x = Sbreak ->
-      step (State f x (Kswitch k) e m)
+      sstep (State f x (Kswitch2 k) e m)
         E0 (State f Sskip k e m)
   | step_continue_switch: forall f k e m,
-      step (State f Scontinue (Kswitch k) e m)
+      sstep (State f Scontinue (Kswitch2 k) e m)
         E0 (State f Scontinue k e m)
 
   | step_label: forall f lbl s k e m,
-      step (State f (Slabel lbl s) k e m)
+      sstep (State f (Slabel lbl s) k e m)
         E0 (State f s k e m)
 
   | step_goto: forall f lbl k e m s' k',
       find_label lbl f.(fn_body) (call_cont k) = Some (s', k') ->
-      step (State f (Sgoto lbl) k e m)
+      sstep (State f (Sgoto lbl) k e m)
         E0 (State f s' k' e m)
 
   | step_internal_function: forall f vargs k m e m1 m2,
+      list_norepet (var_names (fn_params f) ++ var_names (fn_vars f)) ->
       alloc_variables empty_env m (f.(fn_params) ++ f.(fn_vars)) e m1 ->
       bind_parameters e m1 f.(fn_params) vargs m2 ->
-      step (Callstate (Internal f) vargs k m)
+      sstep (Callstate (Internal f) vargs k m)
         E0 (State f f.(fn_body) k e m2)
 
   | step_external_function: forall ef targs tres vargs k m vres t m',
       external_call ef  ge vargs m t vres m' ->
-      step (Callstate (External ef targs tres) vargs k m)
+      sstep (Callstate (External ef targs tres) vargs k m)
          t (Returnstate vres k m')
 
-  | step_returnstate_0: forall v f e k m,
-      step (Returnstate v (Kcall None f e k) m)
-        E0 (State f Sskip k e m)
-
-  | step_returnstate_1: forall v f e k m m' loc ofs ty,
-      store_value_of_type ty m loc ofs v = Some m' ->
-      step (Returnstate v (Kcall (Some(loc, ofs, ty)) f e k) m)
-        E0 (State f Sskip k e m').
-
-(** * Alternate big-step semantics *)
-
-(** ** Big-step semantics for terminating statements and functions *)
+  | step_returnstate: forall v f e C ty k m,
+      sstep (Returnstate v (Kcall f e C ty k) m)
+        E0 (ExprState f (C (Eval v ty)) k e m).
 
-(** The execution of a statement produces an ``outcome'', indicating
-  how the execution terminated: either normally or prematurely
-  through the execution of a [break], [continue] or [return] statement. *)
-
-Inductive outcome: Type :=
-   | Out_break: outcome                 (**r terminated by [break] *)
-   | Out_continue: outcome              (**r terminated by [continue] *)
-   | Out_normal: outcome                (**r terminated normally *)
-   | Out_return: option val -> outcome. (**r terminated by [return] *)
-
-Inductive out_normal_or_continue : outcome -> Prop :=
-  | Out_normal_or_continue_N: out_normal_or_continue Out_normal
-  | Out_normal_or_continue_C: out_normal_or_continue Out_continue.
-
-Inductive out_break_or_return : outcome -> outcome -> Prop :=
-  | Out_break_or_return_B: out_break_or_return Out_break Out_normal
-  | Out_break_or_return_R: forall ov,
-      out_break_or_return (Out_return ov) (Out_return ov).
-
-Definition outcome_switch (out: outcome) : outcome :=
-  match out with
-  | Out_break => Out_normal
-  | o => o
-  end.
-
-Definition outcome_result_value (out: outcome) (t: type) (v: val) : Prop :=
-  match out, t with
-  | Out_normal, Tvoid => v = Vundef
-  | Out_return None, Tvoid => v = Vundef
-  | Out_return (Some v'), ty => ty <> Tvoid /\ v'=v
-  | _, _ => False
-  end. 
-
-(** [exec_stmt ge e m1 s t m2 out] describes the execution of 
-  the statement [s].  [out] is the outcome for this execution.
-  [m1] is the initial memory state, [m2] the final memory state.
-  [t] is the trace of input/output events performed during this
-  evaluation. *)
-
-Inductive exec_stmt: env -> mem -> statement -> trace -> mem -> outcome -> Prop :=
-  | exec_Sskip:   forall e m,
-      exec_stmt e m Sskip
-               E0 m Out_normal
-  | exec_Sassign:   forall e m a1 a2 loc ofs v2 m',
-      eval_lvalue e m a1 loc ofs ->
-      eval_expr e m a2 v2 ->
-      store_value_of_type (typeof a1) m loc ofs v2 = Some m' ->
-      exec_stmt e m (Sassign a1 a2)
-               E0 m' Out_normal
-  | exec_Scall_none:   forall e m a al vf vargs f t m' vres,
-      eval_expr e m a vf ->
-      eval_exprlist e m al vargs ->
-      Genv.find_funct ge vf = Some f ->
-      type_of_fundef f = typeof a ->
-      eval_funcall m f vargs t m' vres ->
-      exec_stmt e m (Scall None a al)
-                t m' Out_normal
-  | exec_Scall_some:   forall e m lhs a al loc ofs vf vargs f t m' vres m'',
-      eval_lvalue e m lhs loc ofs ->
-      eval_expr e m a vf ->
-      eval_exprlist e m al vargs ->
-      Genv.find_funct ge vf = Some f ->
-      type_of_fundef f = typeof a ->
-      eval_funcall m f vargs t m' vres ->
-      store_value_of_type (typeof lhs) m' loc ofs vres = Some m'' ->
-      exec_stmt e m (Scall (Some lhs) a al)
-                t m'' Out_normal
-  | exec_Sseq_1:   forall e m s1 s2 t1 m1 t2 m2 out,
-      exec_stmt e m s1 t1 m1 Out_normal ->
-      exec_stmt e m1 s2 t2 m2 out ->
-      exec_stmt e m (Ssequence s1 s2)
-                (t1 ** t2) m2 out
-  | exec_Sseq_2:   forall e m s1 s2 t1 m1 out,
-      exec_stmt e m s1 t1 m1 out ->
-      out <> Out_normal ->
-      exec_stmt e m (Ssequence s1 s2)
-                t1 m1 out
-  | exec_Sifthenelse_true: forall e m a s1 s2 v1 t m' out,
-      eval_expr e m a v1 ->
-      is_true v1 (typeof a) ->
-      exec_stmt e m s1 t m' out ->
-      exec_stmt e m (Sifthenelse a s1 s2)
-                t m' out
-  | exec_Sifthenelse_false: forall e m a s1 s2 v1 t m' out,
-      eval_expr e m a v1 ->
-      is_false v1 (typeof a) ->
-      exec_stmt e m s2 t m' out ->
-      exec_stmt e m (Sifthenelse a s1 s2)
-                t m' out
-  | exec_Sreturn_none:   forall e m,
-      exec_stmt e m (Sreturn None)
-               E0 m (Out_return None)
-  | exec_Sreturn_some: forall e m a v,
-      eval_expr e m a v ->
-      exec_stmt e m (Sreturn (Some a))
-               E0 m (Out_return (Some v))
-  | exec_Sbreak:   forall e m,
-      exec_stmt e m Sbreak
-               E0 m Out_break
-  | exec_Scontinue:   forall e m,
-      exec_stmt e m Scontinue
-               E0 m Out_continue
-  | exec_Swhile_false: forall e m a s v,
-      eval_expr e m a v ->
-      is_false v (typeof a) ->
-      exec_stmt e m (Swhile a s)
-               E0 m Out_normal
-  | exec_Swhile_stop: forall e m a v s t m' out' out,
-      eval_expr e m a v ->
-      is_true v (typeof a) ->
-      exec_stmt e m s t m' out' ->
-      out_break_or_return out' out ->
-      exec_stmt e m (Swhile a s)
-                t m' out
-  | exec_Swhile_loop: forall e m a s v t1 m1 out1 t2 m2 out,
-      eval_expr e m a v ->
-      is_true v (typeof a) ->
-      exec_stmt e m s t1 m1 out1 ->
-      out_normal_or_continue out1 ->
-      exec_stmt e m1 (Swhile a s) t2 m2 out ->
-      exec_stmt e m (Swhile a s)
-                (t1 ** t2) m2 out
-  | exec_Sdowhile_false: forall e m s a t m1 out1 v,
-      exec_stmt e m s t m1 out1 ->
-      out_normal_or_continue out1 ->
-      eval_expr e m1 a v ->
-      is_false v (typeof a) ->
-      exec_stmt e m (Sdowhile a s)
-                t m1 Out_normal
-  | exec_Sdowhile_stop: forall e m s a t m1 out1 out,
-      exec_stmt e m s t m1 out1 ->
-      out_break_or_return out1 out ->
-      exec_stmt e m (Sdowhile a s)
-                t m1 out
-  | exec_Sdowhile_loop: forall e m s a m1 m2 t1 t2 out out1 v,
-      exec_stmt e m s t1 m1 out1 ->
-      out_normal_or_continue out1 ->
-      eval_expr e m1 a v ->
-      is_true v (typeof a) ->
-      exec_stmt e m1 (Sdowhile a s) t2 m2 out ->
-      exec_stmt e m (Sdowhile a s) 
-                (t1 ** t2) m2 out
-  | exec_Sfor_start: forall e m s a1 a2 a3 out m1 m2 t1 t2,
-      a1 <> Sskip ->
-      exec_stmt e m a1 t1 m1 Out_normal ->
-      exec_stmt e m1 (Sfor Sskip a2 a3 s) t2 m2 out ->
-      exec_stmt e m (Sfor a1 a2 a3 s) 
-                (t1 ** t2) m2 out
-  | exec_Sfor_false: forall e m s a2 a3 v,
-      eval_expr e m a2 v ->
-      is_false v (typeof a2) ->
-      exec_stmt e m (Sfor Sskip a2 a3 s)
-               E0 m Out_normal
-  | exec_Sfor_stop: forall e m s a2 a3 v m1 t out1 out,
-      eval_expr e m a2 v ->
-      is_true v (typeof a2) ->
-      exec_stmt e m s t m1 out1 ->
-      out_break_or_return out1 out ->
-      exec_stmt e m (Sfor Sskip a2 a3 s)
-                t m1 out
-  | exec_Sfor_loop: forall e m s a2 a3 v m1 m2 m3 t1 t2 t3 out1 out,
-      eval_expr e m a2 v ->
-      is_true v (typeof a2) ->
-      exec_stmt e m s t1 m1 out1 ->
-      out_normal_or_continue out1 ->
-      exec_stmt e m1 a3 t2 m2 Out_normal ->
-      exec_stmt e m2 (Sfor Sskip a2 a3 s) t3 m3 out ->
-      exec_stmt e m (Sfor Sskip a2 a3 s)
-                (t1 ** t2 ** t3) m3 out
-  | exec_Sswitch:   forall e m a t n sl m1 out,
-      eval_expr e m a (Vint n) ->
-      exec_stmt e m (seq_of_labeled_statement (select_switch n sl)) t m1 out ->
-      exec_stmt e m (Sswitch a sl)
-                t m1 (outcome_switch out)
-
-(** [eval_funcall m1 fd args t m2 res] describes the invocation of
-  function [fd] with arguments [args].  [res] is the value returned
-  by the call.  *)
-
-with eval_funcall: mem -> fundef -> list val -> trace -> mem -> val -> Prop :=
-  | eval_funcall_internal: forall m f vargs t e m1 m2 m3 out vres m4,
-      alloc_variables empty_env m (f.(fn_params) ++ f.(fn_vars)) e m1 ->
-      bind_parameters e m1 f.(fn_params) vargs m2 ->
-      exec_stmt e m2 f.(fn_body) t m3 out ->
-      outcome_result_value out f.(fn_return) vres ->
-      Mem.free_list m3 (blocks_of_env e) = Some m4 ->
-      eval_funcall m (Internal f) vargs t m4 vres
-  | eval_funcall_external: forall m ef targs tres vargs t vres m',
-      external_call ef ge vargs m t vres m' ->
-      eval_funcall m (External ef targs tres) vargs t m' vres.
-
-Scheme exec_stmt_ind2 := Minimality for exec_stmt Sort Prop
-  with eval_funcall_ind2 := Minimality for eval_funcall Sort Prop.
-
-(** ** Big-step semantics for diverging statements and functions *)
-
-(** Coinductive semantics for divergence.
-  [execinf_stmt ge e m s t] holds if the execution of statement [s]
-  diverges, i.e. loops infinitely.  [t] is the possibly infinite
-  trace of observable events performed during the execution. *)
-
-CoInductive execinf_stmt: env -> mem -> statement -> traceinf -> Prop :=
-  | execinf_Scall_none:   forall e m a al vf vargs f t,
-      eval_expr e m a vf ->
-      eval_exprlist e m al vargs ->
-      Genv.find_funct ge vf = Some f ->
-      type_of_fundef f = typeof a ->
-      evalinf_funcall m f vargs t ->
-      execinf_stmt e m (Scall None a al) t
-  | execinf_Scall_some:   forall e m lhs a al loc ofs vf vargs f t,
-      eval_lvalue e m lhs loc ofs ->
-      eval_expr e m a vf ->
-      eval_exprlist e m al vargs ->
-      Genv.find_funct ge vf = Some f ->
-      type_of_fundef f = typeof a ->
-      evalinf_funcall m f vargs t ->
-      execinf_stmt e m (Scall (Some lhs) a al) t
-  | execinf_Sseq_1:   forall e m s1 s2 t,
-      execinf_stmt e m s1 t ->
-      execinf_stmt e m (Ssequence s1 s2) t
-  | execinf_Sseq_2:   forall e m s1 s2 t1 m1 t2,
-      exec_stmt e m s1 t1 m1 Out_normal ->
-      execinf_stmt e m1 s2 t2 ->
-      execinf_stmt e m (Ssequence s1 s2) (t1 *** t2)
-  | execinf_Sifthenelse_true: forall e m a s1 s2 v1 t,
-      eval_expr e m a v1 ->
-      is_true v1 (typeof a) ->
-      execinf_stmt e m s1 t ->
-      execinf_stmt e m (Sifthenelse a s1 s2) t
-  | execinf_Sifthenelse_false: forall e m a s1 s2 v1 t,
-      eval_expr e m a v1 ->
-      is_false v1 (typeof a) ->
-      execinf_stmt e m s2 t ->
-      execinf_stmt e m (Sifthenelse a s1 s2) t
-  | execinf_Swhile_body: forall e m a v s t,
-      eval_expr e m a v ->
-      is_true v (typeof a) ->
-      execinf_stmt e m s t ->
-      execinf_stmt e m (Swhile a s) t
-  | execinf_Swhile_loop: forall e m a s v t1 m1 out1 t2,
-      eval_expr e m a v ->
-      is_true v (typeof a) ->
-      exec_stmt e m s t1 m1 out1 ->
-      out_normal_or_continue out1 ->
-      execinf_stmt e m1 (Swhile a s) t2 ->
-      execinf_stmt e m (Swhile a s) (t1 *** t2)
-  | execinf_Sdowhile_body: forall e m s a t,
-      execinf_stmt e m s t ->
-      execinf_stmt e m (Sdowhile a s) t
-  | execinf_Sdowhile_loop: forall e m s a m1 t1 t2 out1 v,
-      exec_stmt e m s t1 m1 out1 ->
-      out_normal_or_continue out1 ->
-      eval_expr e m1 a v ->
-      is_true v (typeof a) ->
-      execinf_stmt e m1 (Sdowhile a s) t2 ->
-      execinf_stmt e m (Sdowhile a s) (t1 *** t2)
-  | execinf_Sfor_start_1: forall e m s a1 a2 a3 t,
-      execinf_stmt e m a1 t ->
-      execinf_stmt e m (Sfor a1 a2 a3 s) t
-  | execinf_Sfor_start_2: forall e m s a1 a2 a3 m1 t1 t2,
-      a1 <> Sskip ->
-      exec_stmt e m a1 t1 m1 Out_normal ->
-      execinf_stmt e m1 (Sfor Sskip a2 a3 s) t2 ->
-      execinf_stmt e m (Sfor a1 a2 a3 s) (t1 *** t2)
-  | execinf_Sfor_body: forall e m s a2 a3 v t,
-      eval_expr e m a2 v ->
-      is_true v (typeof a2) ->
-      execinf_stmt e m s t ->
-      execinf_stmt e m (Sfor Sskip a2 a3 s) t
-  | execinf_Sfor_next: forall e m s a2 a3 v m1 t1 t2 out1,
-      eval_expr e m a2 v ->
-      is_true v (typeof a2) ->
-      exec_stmt e m s t1 m1 out1 ->
-      out_normal_or_continue out1 ->
-      execinf_stmt e m1 a3 t2 ->
-      execinf_stmt e m (Sfor Sskip a2 a3 s) (t1 *** t2)
-  | execinf_Sfor_loop: forall e m s a2 a3 v m1 m2 t1 t2 t3 out1,
-      eval_expr e m a2 v ->
-      is_true v (typeof a2) ->
-      exec_stmt e m s t1 m1 out1 ->
-      out_normal_or_continue out1 ->
-      exec_stmt e m1 a3 t2 m2 Out_normal ->
-      execinf_stmt e m2 (Sfor Sskip a2 a3 s) t3 ->
-      execinf_stmt e m (Sfor Sskip a2 a3 s) (t1 *** t2 *** t3)
-  | execinf_Sswitch:   forall e m a t n sl,
-      eval_expr e m a (Vint n) ->
-      execinf_stmt e m (seq_of_labeled_statement (select_switch n sl)) t ->
-      execinf_stmt e m (Sswitch a sl) t
-
-(** [evalinf_funcall ge m fd args t] holds if the invocation of function
-    [fd] on arguments [args] diverges, with observable trace [t]. *)
-
-with evalinf_funcall: mem -> fundef -> list val -> traceinf -> Prop :=
-  | evalinf_funcall_internal: forall m f vargs t e m1 m2,
-      alloc_variables empty_env m (f.(fn_params) ++ f.(fn_vars)) e m1 ->
-      bind_parameters e m1 f.(fn_params) vargs m2 ->
-      execinf_stmt e m2 f.(fn_body) t ->
-      evalinf_funcall m (Internal f) vargs t.
+Definition step (S: state) (t: trace) (S': state) : Prop :=
+  estep S t S' \/ sstep S t S'.
 
 End SEMANTICS.
 
@@ -1232,6 +1169,7 @@ Inductive initial_state (p: program): state -> Prop :=
       Genv.init_mem p = Some m0 ->
       Genv.find_symbol ge p.(prog_main) = Some b ->
       Genv.find_funct_ptr ge b = Some f ->
+      type_of_fundef f = Tfunction Tnil (Tint I32 Signed) ->
       initial_state p (Callstate f nil Kstop m0).
 
 (** A final state is a [Returnstate] with an empty continuation. *)
@@ -1248,500 +1186,3 @@ Inductive final_state: state -> int -> Prop :=
 Definition exec_program (p: program) (beh: program_behavior) : Prop :=
   program_behaves step (initial_state p) final_state (Genv.globalenv p) beh.
 
-(** Big-step execution of a whole program.  *)
-
-Inductive bigstep_program_terminates (p: program): trace -> int -> Prop :=
-  | bigstep_program_terminates_intro: forall b f m0 m1 t r,
-      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 ->
-      eval_funcall ge m0 f nil t m1 (Vint r) ->
-      bigstep_program_terminates p t r.
-
-Inductive bigstep_program_diverges (p: program): traceinf -> Prop :=
-  | bigstep_program_diverges_intro: forall b f m0 t,
-      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 ->
-      evalinf_funcall ge m0 f nil t ->
-      bigstep_program_diverges p t.
-
-(** * Implication from big-step semantics to transition semantics *)
-
-Section BIGSTEP_TO_TRANSITIONS.
-
-Variable prog: program.
-Let ge : genv := Genv.globalenv prog.
-
-Definition exec_stmt_eval_funcall_ind
-  (PS: env -> mem -> statement -> trace -> mem -> outcome -> Prop)
-  (PF: mem -> fundef -> list val -> trace -> mem -> val -> Prop) :=
-  fun a b c d e f g h i j k l m n o p q r s t u v w x y =>
-  conj (exec_stmt_ind2 ge PS PF a b c d e f g h i j k l m n o p q r s t u v w x y)
-       (eval_funcall_ind2 ge PS PF a b c d e f g h i j k l m n o p q r s t u v w x y).
-
-Inductive outcome_state_match
-       (e: env) (m: mem) (f: function) (k: cont): outcome -> state -> Prop :=
-  | osm_normal:
-      outcome_state_match e m f k Out_normal (State f Sskip k e m)
-  | osm_break:
-      outcome_state_match e m f k Out_break (State f Sbreak k e m)
-  | osm_continue:
-      outcome_state_match e m f k Out_continue (State f Scontinue k e m)
-  | osm_return_none: forall k',
-      call_cont k' = call_cont k ->
-      outcome_state_match e m f k 
-        (Out_return None) (State f (Sreturn None) k' e m)
-  | osm_return_some: forall a v k',
-      call_cont k' = call_cont k ->
-      eval_expr ge e m a v ->
-      outcome_state_match e m f k
-        (Out_return (Some v)) (State f (Sreturn (Some a)) k' e m).
-
-Lemma is_call_cont_call_cont:
-  forall k, is_call_cont k -> call_cont k = k.
-Proof.
-  destruct k; simpl; intros; contradiction || auto.
-Qed.
-
-Lemma exec_stmt_eval_funcall_steps:
-  (forall e m s t m' out,
-   exec_stmt ge e m s t m' out ->
-   forall f k, exists S,
-   star step ge (State f s k e m) t S
-   /\ outcome_state_match e m' f k out S)
-/\
-  (forall m fd args t m' res,
-   eval_funcall ge m fd args t m' res ->
-   forall k,
-   is_call_cont k ->
-   star step ge (Callstate fd args k m) t (Returnstate res k m')).
-Proof.
-  apply exec_stmt_eval_funcall_ind; intros.
-
-(* skip *)
-  econstructor; split. apply star_refl. constructor.
-
-(* assign *)
-  econstructor; split. apply star_one. econstructor; eauto. constructor.
-
-(* call none *)
-  econstructor; split.
-  eapply star_left. econstructor; eauto. 
-  eapply star_right. apply H4. simpl; auto. econstructor. reflexivity. traceEq.
-  constructor.
-
-(* call some *)
-  econstructor; split.
-  eapply star_left. econstructor; eauto. 
-  eapply star_right. apply H5. simpl; auto. econstructor; eauto. reflexivity. traceEq.
-  constructor.
-
-(* sequence 2 *)
-  destruct (H0 f (Kseq s2 k)) as [S1 [A1 B1]]. inv B1.
-  destruct (H2 f k) as [S2 [A2 B2]]. 
-  econstructor; split.
-  eapply star_left. econstructor.
-  eapply star_trans. eexact A1. 
-  eapply star_left. constructor. eexact A2.
-  reflexivity. reflexivity. traceEq.
-  auto.
-
-(* sequence 1 *)
-  destruct (H0 f (Kseq s2 k)) as [S1 [A1 B1]].
-  set (S2 :=
-    match out with
-    | Out_break => State f Sbreak k e m1
-    | Out_continue => State f Scontinue k e m1
-    | _ => S1
-    end).
-  exists S2; split.
-  eapply star_left. econstructor.
-  eapply star_trans. eexact A1.
-  unfold S2; inv B1.
-    congruence.
-    apply star_one. apply step_break_seq.
-    apply star_one. apply step_continue_seq.
-    apply star_refl.
-    apply star_refl.
-  reflexivity. traceEq.
-  unfold S2; inv B1; congruence || econstructor; eauto.
-
-(* ifthenelse true *)
-  destruct (H2 f k) as [S1 [A1 B1]].
-  exists S1; split.
-  eapply star_left. eapply step_ifthenelse_true; eauto. eexact A1. traceEq.
-  auto.
-
-(* ifthenelse false *)
-  destruct (H2 f k) as [S1 [A1 B1]].
-  exists S1; split.
-  eapply star_left. eapply step_ifthenelse_false; eauto. eexact A1. traceEq.
-  auto.
-
-(* return none *)
-  econstructor; split. apply star_refl. constructor. auto.
-
-(* return some *)
-  econstructor; split. apply star_refl. econstructor; eauto.
-
-(* break *)
-  econstructor; split. apply star_refl. constructor.
-
-(* continue *)
-  econstructor; split. apply star_refl. constructor.
-
-(* while false *)
-  econstructor; split.
-  apply star_one. eapply step_while_false; eauto. 
-  constructor.
-
-(* while stop *)
-  destruct (H2 f (Kwhile a s k)) as [S1 [A1 B1]].
-  set (S2 :=
-    match out' with
-    | Out_break => State f Sskip k e m'
-    | _ => S1
-    end).
-  exists S2; split.
-  eapply star_left. eapply step_while_true; eauto. 
-  eapply star_trans. eexact A1.
-  unfold S2. inversion H3; subst.
-  inv B1. apply star_one. constructor.    
-  apply star_refl.
-  reflexivity. traceEq.
-  unfold S2. inversion H3; subst. constructor. inv B1; econstructor; eauto.
-
-(* while loop *)
-  destruct (H2 f (Kwhile a s k)) as [S1 [A1 B1]].
-  destruct (H5 f k) as [S2 [A2 B2]].
-  exists S2; split.
-  eapply star_left. eapply step_while_true; eauto.
-  eapply star_trans. eexact A1.
-  eapply star_left.
-  inv H3; inv B1; apply step_skip_or_continue_while; auto.
-  eexact A2.
-  reflexivity. reflexivity. traceEq.
-  auto.
-
-(* dowhile false *)
-  destruct (H0 f (Kdowhile a s k)) as [S1 [A1 B1]].
-  exists (State f Sskip k e m1); split.
-  eapply star_left. constructor. 
-  eapply star_right. eexact A1.
-  inv H1; inv B1; eapply step_skip_or_continue_dowhile_false; eauto.
-  reflexivity. traceEq. 
-  constructor.
-
-(* dowhile stop *)
-  destruct (H0 f (Kdowhile a s k)) as [S1 [A1 B1]].
-  set (S2 :=
-    match out1 with
-    | Out_break => State f Sskip k e m1
-    | _ => S1
-    end).
-  exists S2; split.
-  eapply star_left. apply step_dowhile. 
-  eapply star_trans. eexact A1.
-  unfold S2. inversion H1; subst.
-  inv B1. apply star_one. constructor.
-  apply star_refl.
-  reflexivity. traceEq.
-  unfold S2. inversion H1; subst. constructor. inv B1; econstructor; eauto.
-
-(* dowhile loop *)
-  destruct (H0 f (Kdowhile a s k)) as [S1 [A1 B1]].
-  destruct (H5 f k) as [S2 [A2 B2]].
-  exists S2; split.
-  eapply star_left. apply step_dowhile. 
-  eapply star_trans. eexact A1.
-  eapply star_left.
-  inv H1; inv B1; eapply step_skip_or_continue_dowhile_true; eauto.
-  eexact A2.
-  reflexivity. reflexivity. traceEq.
-  auto.
-
-(* for start *)
-  destruct (H1 f (Kseq (Sfor Sskip a2 a3 s) k)) as [S1 [A1 B1]]. inv B1.
-  destruct (H3 f k) as [S2 [A2 B2]].
-  exists S2; split.
-  eapply star_left. apply step_for_start; auto.   
-  eapply star_trans. eexact A1.
-  eapply star_left. constructor. eexact A2.
-  reflexivity. reflexivity. traceEq.
-  auto.
-
-(* for false *)
-  econstructor; split.
-  eapply star_one. eapply step_for_false; eauto. 
-  constructor.
-
-(* for stop *)
-  destruct (H2 f (Kfor2 a2 a3 s k)) as [S1 [A1 B1]].
-  set (S2 :=
-    match out1 with
-    | Out_break => State f Sskip k e m1
-    | _ => S1
-    end).
-  exists S2; split.
-  eapply star_left. eapply step_for_true; eauto. 
-  eapply star_trans. eexact A1.
-  unfold S2. inversion H3; subst.
-  inv B1. apply star_one. constructor. 
-  apply star_refl.
-  reflexivity. traceEq.
-  unfold S2. inversion H3; subst. constructor. inv B1; econstructor; eauto.
-
-(* for loop *)
-  destruct (H2 f (Kfor2 a2 a3 s k)) as [S1 [A1 B1]].
-  destruct (H5 f (Kfor3 a2 a3 s k)) as [S2 [A2 B2]]. inv B2.
-  destruct (H7 f k) as [S3 [A3 B3]].
-  exists S3; split.
-  eapply star_left. eapply step_for_true; eauto. 
-  eapply star_trans. eexact A1.
-  eapply star_trans with (s2 := State f a3 (Kfor3 a2 a3 s k) e m1).
-  inv H3; inv B1.
-  apply star_one. constructor. auto. 
-  apply star_one. constructor. auto. 
-  eapply star_trans. eexact A2. 
-  eapply star_left. constructor.
-  eexact A3.
-  reflexivity. reflexivity. reflexivity. reflexivity. traceEq.
-  auto.
-
-(* switch *)
-  destruct (H1 f (Kswitch k)) as [S1 [A1 B1]].
-  set (S2 :=
-    match out with
-    | Out_normal => State f Sskip k e m1
-    | Out_break => State f Sskip k e m1
-    | Out_continue => State f Scontinue k e m1
-    | _ => S1
-    end).
-  exists S2; split.
-  eapply star_left. eapply step_switch; eauto. 
-  eapply star_trans. eexact A1. 
-  unfold S2; inv B1.
-    apply star_one. constructor. auto. 
-    apply star_one. constructor. auto. 
-    apply star_one. constructor. 
-    apply star_refl.
-    apply star_refl.
-  reflexivity. traceEq.
-  unfold S2. inv B1; simpl; econstructor; eauto.
-
-(* call internal *)
-  destruct (H2 f k) as [S1 [A1 B1]].
-  eapply star_left. eapply step_internal_function; eauto.
-  eapply star_right. eexact A1. 
-  inv B1; simpl in H3; try contradiction.
-  (* Out_normal *)
-  assert (fn_return f = Tvoid /\ vres = Vundef).
-    destruct (fn_return f); auto || contradiction.
-  destruct H6. subst vres. apply step_skip_call; auto.
-  (* Out_return None *)
-  assert (fn_return f = Tvoid /\ vres = Vundef).
-    destruct (fn_return f); auto || contradiction.
-  destruct H7. subst vres.
-  rewrite <- (is_call_cont_call_cont k H5). rewrite <- H6.
-  apply step_return_0; auto.
-  (* Out_return Some *)
-  destruct H3. subst vres.
-  rewrite <- (is_call_cont_call_cont k H5). rewrite <- H6.
-  eapply step_return_1; eauto.
-  reflexivity. traceEq.
-
-(* call external *)
-  apply star_one. apply step_external_function; auto. 
-Qed.
-
-Lemma exec_stmt_steps:
-   forall e m s t m' out,
-   exec_stmt ge e m s t m' out ->
-   forall f k, exists S,
-   star step ge (State f s k e m) t S
-   /\ outcome_state_match e m' f k out S.
-Proof (proj1 exec_stmt_eval_funcall_steps).
-
-Lemma eval_funcall_steps:
-   forall m fd args t m' res,
-   eval_funcall ge m fd args t m' res ->
-   forall k,
-   is_call_cont k ->
-   star step ge (Callstate fd args k m) t (Returnstate res k m').
-Proof (proj2 exec_stmt_eval_funcall_steps).
-
-Definition order (x y: unit) := False.
-
-Lemma evalinf_funcall_forever:
-  forall m fd args T k,
-  evalinf_funcall ge m fd args T ->
-  forever_N step order ge tt (Callstate fd args k m) T.
-Proof.
-  cofix CIH_FUN.
-  assert (forall e m s T f k,
-          execinf_stmt ge e m s T ->
-          forever_N step order ge tt (State f s k e m) T).
-  cofix CIH_STMT.
-  intros. inv H.
-
-(* call none *)
-  eapply forever_N_plus.
-  apply plus_one. eapply step_call_none; eauto. 
-  apply CIH_FUN. eauto. traceEq.
-(* call some *)
-  eapply forever_N_plus.
-  apply plus_one. eapply step_call_some; eauto. 
-  apply CIH_FUN. eauto. traceEq.
-
-(* seq 1 *)
-  eapply forever_N_plus.
-  apply plus_one. econstructor.
-  apply CIH_STMT; eauto. traceEq.
-(* seq 2 *)
-  destruct (exec_stmt_steps _ _ _ _ _ _ H0 f (Kseq s2 k)) as [S1 [A1 B1]].
-  inv B1.
-  eapply forever_N_plus.
-  eapply plus_left. constructor. eapply star_trans. eexact A1. 
-  apply star_one. constructor. reflexivity. reflexivity.
-  apply CIH_STMT; eauto. traceEq.
-
-(* ifthenelse true *)
-  eapply forever_N_plus.
-  apply plus_one. eapply step_ifthenelse_true; eauto. 
-  apply CIH_STMT; eauto. traceEq.
-(* ifthenelse false *)
-  eapply forever_N_plus.
-  apply plus_one. eapply step_ifthenelse_false; eauto. 
-  apply CIH_STMT; eauto. traceEq.
-
-(* while body *)
-  eapply forever_N_plus.
-  eapply plus_one. eapply step_while_true; eauto.
-  apply CIH_STMT; eauto. traceEq.
-(* while loop *)
-  destruct (exec_stmt_steps _ _ _ _ _ _ H2 f (Kwhile a s0 k)) as [S1 [A1 B1]].
-  eapply forever_N_plus with (s2 := State f (Swhile a s0) k e m1).
-  eapply plus_left. eapply step_while_true; eauto.
-  eapply star_right. eexact A1.
-  inv H3; inv B1; apply step_skip_or_continue_while; auto. 
-  reflexivity. reflexivity.
-  apply CIH_STMT; eauto. traceEq.
-
-(* dowhile body *)
-  eapply forever_N_plus.
-  eapply plus_one. eapply step_dowhile.
-  apply CIH_STMT; eauto.
-  traceEq.
-
-(* dowhile loop *)
-  destruct (exec_stmt_steps _ _ _ _ _ _ H0 f (Kdowhile a s0 k)) as [S1 [A1 B1]].
-  eapply forever_N_plus with (s2 := State f (Sdowhile a s0) k e m1).
-  eapply plus_left. eapply step_dowhile. 
-  eapply star_right. eexact A1.
-  inv H1; inv B1; eapply step_skip_or_continue_dowhile_true; eauto. 
-  reflexivity. reflexivity.
-  apply CIH_STMT. eauto. 
-  traceEq.
-
-(* for start 1 *)
-  assert (a1 <> Sskip). red; intros; subst. inv H0.
-  eapply forever_N_plus.
-  eapply plus_one. apply step_for_start; auto. 
-  apply CIH_STMT; eauto.
-  traceEq.
-
-(* for start 2 *)
-  destruct (exec_stmt_steps _ _ _ _ _ _ H1 f (Kseq (Sfor Sskip a2 a3 s0) k)) as [S1 [A1 B1]].
-  inv B1.
-  eapply forever_N_plus.
-  eapply plus_left. eapply step_for_start; eauto. 
-  eapply star_right. eexact A1.
-  apply step_skip_seq. 
-  reflexivity. reflexivity.
-  apply CIH_STMT; eauto.
-  traceEq.
-
-(* for body *)
-  eapply forever_N_plus.
-  apply plus_one. eapply step_for_true; eauto. 
-  apply CIH_STMT; eauto.
-  traceEq.
-
-(* for next *)
-  destruct (exec_stmt_steps _ _ _ _ _ _ H2 f (Kfor2 a2 a3 s0 k)) as [S1 [A1 B1]].
-  eapply forever_N_plus.
-  eapply plus_left. eapply step_for_true; eauto.
-  eapply star_trans. eexact A1.
-  apply star_one.
-  inv H3; inv B1; apply step_skip_or_continue_for2; auto.
-  reflexivity. reflexivity. 
-  apply CIH_STMT; eauto.
-  traceEq.
-
-(* for body *)
-  destruct (exec_stmt_steps _ _ _ _ _ _ H2 f (Kfor2 a2 a3 s0 k)) as [S1 [A1 B1]].
-  destruct (exec_stmt_steps _ _ _ _ _ _ H4 f (Kfor3 a2 a3 s0 k)) as [S2 [A2 B2]].
-  inv B2.
-  eapply forever_N_plus.
-  eapply plus_left. eapply step_for_true; eauto. 
-  eapply star_trans. eexact A1.
-  eapply star_left. inv H3; inv B1; apply step_skip_or_continue_for2; auto.
-  eapply star_right. eexact A2. 
-  constructor. 
-  reflexivity. reflexivity. reflexivity. reflexivity.  
-  apply CIH_STMT; eauto.
-  traceEq.
-
-(* switch *)
-  eapply forever_N_plus.
-  eapply plus_one. eapply step_switch; eauto.
-  apply CIH_STMT; eauto.
-  traceEq.
-
-(* call internal *)
-  intros. inv H0.
-  eapply forever_N_plus.
-  eapply plus_one. econstructor; eauto. 
-  apply H; eauto.
-  traceEq.
-Qed.
-
-Theorem bigstep_program_terminates_exec:
-  forall t r, bigstep_program_terminates prog t r -> exec_program prog (Terminates t r).
-Proof.
-  intros. inv H. 
-  econstructor.
-  econstructor. eauto. eauto. eauto.
-  apply eval_funcall_steps. eauto. red; auto. 
-  econstructor.
-Qed.
-
-Theorem bigstep_program_diverges_exec:
-  forall T, bigstep_program_diverges prog T ->
-  exec_program prog (Reacts T) \/
-  exists t, exec_program prog (Diverges t) /\ traceinf_prefix t T.
-Proof.
-  intros. inv H.
-  set (st := Callstate f nil Kstop m0).
-  assert (forever step ge0 st T). 
-    eapply forever_N_forever with (order := order).
-    red; intros. constructor; intros. red in H. elim H.
-    eapply evalinf_funcall_forever; eauto. 
-  destruct (forever_silent_or_reactive _ _ _ _ _ _ H)
-  as [A | [t [s' [T' [B [C D]]]]]]. 
-  left. econstructor. econstructor; eauto. eauto.
-  right. exists t. split.
-  econstructor. econstructor; eauto. eauto. auto. 
-  subst T. rewrite <- (E0_right t) at 1. apply traceinf_prefix_app. constructor.
-Qed.
-
-End BIGSTEP_TO_TRANSITIONS.
-
-
-
-
-
-  
diff --git a/cfrontend/Csharpminor.v b/cfrontend/Csharpminor.v
index 558ae1c..1a362e3 100644
--- a/cfrontend/Csharpminor.v
+++ b/cfrontend/Csharpminor.v
@@ -46,6 +46,7 @@ Definition binary_operation : Type := Cminor.binary_operation.
 
 Inductive expr : Type :=
   | Evar : ident -> expr                (**r reading a scalar variable  *)
+  | Etempvar : ident -> expr            (**r reading a temporary variable *)
   | Eaddrof : ident -> expr             (**r taking the address of a variable *)
   | Econst : constant -> expr           (**r constants *)
   | Eunop : unary_operation -> expr -> expr  (**r unary operation *)
@@ -64,6 +65,7 @@ Definition label := ident.
 Inductive stmt : Type :=
   | Sskip: stmt
   | Sassign : ident -> expr -> stmt
+  | Sset : ident -> expr -> stmt
   | Sstore : memory_chunk -> expr -> expr -> stmt
   | Scall : option ident -> signature -> expr -> list expr -> stmt
   | Sseq: stmt -> stmt -> stmt
@@ -109,6 +111,7 @@ Record function : Type := mkfunction {
   fn_return: option typ;
   fn_params: list (ident * memory_chunk);
   fn_vars: list (ident * var_kind);
+  fn_temps: list ident;
   fn_body: stmt
 }.
 
@@ -137,17 +140,21 @@ Definition fn_vars_names (f: function) := List.map variable_name f.(fn_vars).
 
 (** * Operational semantics *)
 
-(** Three kinds of evaluation environments are involved:
-- [genv]: global environments, define symbols and functions;
-- [gvarenv]: map global variables to variable informations (type [var_kind]);
+(** Three evaluation environments are involved:
+- [genv]: global environments, map symbols and functions to memory blocks,
+    and maps symbols to variable informations (type [var_kind])
 - [env]: local environments, map local variables 
-    to memory blocks and variable informations.
+    to pairs (memory block, variable information)
+- [temp_env]: local environments, map temporary variables to
+    their current values.
 *)
 
 Definition genv := Genv.t fundef var_kind.
-Definition gvarenv := PTree.t var_kind.
 Definition env := PTree.t (block * var_kind).
+Definition temp_env := PTree.t val.
+
 Definition empty_env : env := PTree.empty (block * var_kind).
+Definition empty_temp_env : temp_env := PTree.empty val.
 
 (** Continuations *)
 
@@ -155,7 +162,7 @@ Inductive cont: Type :=
   | Kstop: cont                         (**r stop program execution *)
   | Kseq: stmt -> cont -> cont          (**r execute stmt, then cont *)
   | Kblock: cont -> cont                (**r exit a block, then do cont *)
-  | Kcall: option ident -> function -> env -> cont -> cont.
+  | Kcall: option ident -> function -> env -> temp_env -> cont -> cont.
                                         (**r return to caller *)
 
 (** States *)
@@ -166,6 +173,7 @@ Inductive state: Type :=
              (s: stmt)                  (**r statement under consideration *)
              (k: cont)                  (**r its continuation -- what to do next *)
              (e: env)                   (**r current local environment *)
+             (le: temp_env)             (**r current temporary environment *)
              (m: mem),                  (**r current memory state *)
       state
   | Callstate:                  (**r Invocation of a function *)
@@ -192,7 +200,7 @@ Fixpoint call_cont (k: cont) : cont :=
 Definition is_call_cont (k: cont) : Prop :=
   match k with
   | Kstop => True
-  | Kcall _ _ _ _ => True
+  | Kcall _ _ _ _ _ => True
   | _ => False
   end.
 
@@ -298,6 +306,9 @@ Definition blocks_of_env (e: env) : list (block * Z * Z) :=
   of the corresponding argument is stored into the memory block
   bound to the parameter. *)
 
+Definition val_normalized (v: val) (chunk: memory_chunk) : Prop :=
+  Val.load_result chunk v = v.
+
 Inductive bind_parameters: env ->
                            mem -> list (ident * memory_chunk) -> list val ->
                            mem -> Prop :=
@@ -307,15 +318,14 @@ Inductive bind_parameters: env ->
   | bind_parameters_cons:
       forall e m id chunk params v1 vl b m1 m2,
       PTree.get id e = Some (b, Vscalar chunk) ->
+      val_normalized v1 chunk ->
       Mem.store chunk m b 0 v1 = Some m1 ->
       bind_parameters e m1 params vl m2 ->
       bind_parameters e m ((id, chunk) :: params) (v1 :: vl) m2.
 
 Section RELSEM.
 
-Variable globenv : genv * gvarenv.
-Let ge := fst globenv.
-Let gvare := snd globenv.
+Variable ge: genv.
 
 (* Evaluation of the address of a variable: 
    [eval_var_addr prg ge e id b] states that variable [id] 
@@ -343,10 +353,11 @@ Inductive eval_var_ref: env -> ident -> block -> memory_chunk -> Prop :=
       PTree.get id e = Some (b, Vscalar chunk) ->
       eval_var_ref e id b chunk
   | eval_var_ref_global:
-      forall e id b chunk,
+      forall e id b gv chunk,
       PTree.get id e = None ->
       Genv.find_symbol ge id = Some b ->
-      PTree.get id gvare = Some (Vscalar chunk) ->
+      Genv.find_var_info ge b = Some gv ->
+      gvar_info gv = Vscalar chunk ->
       eval_var_ref e id b chunk.
 
 (** Evaluation of an expression: [eval_expr prg e m a v] states
@@ -356,6 +367,7 @@ Inductive eval_var_ref: env -> ident -> block -> memory_chunk -> Prop :=
 Section EVAL_EXPR.
 
 Variable e: env.
+Variable le: temp_env.
 Variable m: mem.
 
 Inductive eval_expr: expr -> val -> Prop :=
@@ -363,6 +375,9 @@ Inductive eval_expr: expr -> val -> Prop :=
       eval_var_ref e id b chunk ->
       Mem.load chunk m b 0 = Some v ->
       eval_expr (Evar id) v
+  | eval_Etempvar: forall id v,
+      le!id = Some v ->
+      eval_expr (Etempvar id) v
   | eval_Eaddrof: forall id b,
       eval_var_addr e id b ->
       eval_expr (Eaddrof id) (Vptr b Int.zero)
@@ -407,123 +422,130 @@ End EVAL_EXPR.
 Inductive exec_assign: env -> mem -> ident -> val -> mem -> Prop :=
   exec_assign_intro: forall e m id v b chunk m',
     eval_var_ref e id b chunk ->
+    val_normalized v chunk ->
     Mem.store chunk m b 0 v = Some m' ->
     exec_assign e m id v m'.
 
+(*
 Inductive exec_opt_assign: env -> mem -> option ident -> val -> mem -> Prop :=
   | exec_assign_none: forall e m v,
       exec_opt_assign e m None v m
   | exec_assign_some: forall e m id v m',
       exec_assign e m id v m' ->
       exec_opt_assign e m (Some id) v m'.
+*)
 
 (** One step of execution *)
 
 Inductive step: state -> trace -> state -> Prop :=
 
-  | step_skip_seq: forall f s k e m,
-      step (State f Sskip (Kseq s k) e m)
-        E0 (State f s k e m)
-  | step_skip_block: forall f k e m,
-      step (State f Sskip (Kblock k) e m)
-        E0 (State f Sskip k e m)
-  | step_skip_call: forall f k e m m',
+  | step_skip_seq: forall f s k e le m,
+      step (State f Sskip (Kseq s k) e le m)
+        E0 (State f s k e le m)
+  | step_skip_block: forall f k e le m,
+      step (State f Sskip (Kblock k) e le m)
+        E0 (State f Sskip k e le m)
+  | step_skip_call: forall f k e le m m',
       is_call_cont k ->
       f.(fn_return) = None ->
       Mem.free_list m (blocks_of_env e) = Some m' ->
-      step (State f Sskip k e m)
+      step (State f Sskip k e le m)
         E0 (Returnstate Vundef k m')
 
-  | step_assign: forall f id a k e m m' v,
-      eval_expr e m a v ->
+  | step_assign: forall f id a k e le m m' v,
+      eval_expr e le m a v ->
       exec_assign e m id v m' ->
-      step (State f (Sassign id a) k e m)
-        E0 (State f Sskip k e m')
+      step (State f (Sassign id a) k e le m)
+        E0 (State f Sskip k e le m')
+
+  | step_set: forall f id a k e le m v,
+      eval_expr e le m a v ->
+      step (State f (Sset id a) k e le m)
+        E0 (State f Sskip k e (PTree.set id v le) m)
 
-  | step_store: forall f chunk addr a k e m vaddr v m',
-      eval_expr e m addr vaddr ->
-      eval_expr e m a v ->
+  | step_store: forall f chunk addr a k e le m vaddr v m',
+      eval_expr e le m addr vaddr ->
+      eval_expr e le m a v ->
       Mem.storev chunk m vaddr v = Some m' ->
-      step (State f (Sstore chunk addr a) k e m)
-        E0 (State f Sskip k e m')
+      step (State f (Sstore chunk addr a) k e le m)
+        E0 (State f Sskip k e le m')
 
-  | step_call: forall f optid sig a bl k e m vf vargs fd,
-      eval_expr e m a vf ->
-      eval_exprlist e m bl vargs ->
+  | step_call: forall f optid sig a bl k e le m vf vargs fd,
+      eval_expr e le m a vf ->
+      eval_exprlist e le m bl vargs ->
       Genv.find_funct ge vf = Some fd ->
       funsig fd = sig ->
-      step (State f (Scall optid sig a bl) k e m)
-        E0 (Callstate fd vargs (Kcall optid f e k) m)
+      step (State f (Scall optid sig a bl) k e le m)
+        E0 (Callstate fd vargs (Kcall optid f e le k) m)
 
-  | step_seq: forall f s1 s2 k e m,
-      step (State f (Sseq s1 s2) k e m)
-        E0 (State f s1 (Kseq s2 k) e m)
+  | step_seq: forall f s1 s2 k e le m,
+      step (State f (Sseq s1 s2) k e le m)
+        E0 (State f s1 (Kseq s2 k) e le m)
 
-  | step_ifthenelse: forall f a s1 s2 k e m v b,
-      eval_expr e m a v ->
+  | step_ifthenelse: forall f a s1 s2 k e le m v b,
+      eval_expr e le m a v ->
       Val.bool_of_val v b ->
-      step (State f (Sifthenelse a s1 s2) k e m)
-        E0 (State f (if b then s1 else s2) k e m)
-
-  | step_loop: forall f s k e m,
-      step (State f (Sloop s) k e m)
-        E0 (State f s (Kseq (Sloop s) k) e m)
-
-  | step_block: forall f s k e m,
-      step (State f (Sblock s) k e m)
-        E0 (State f s (Kblock k) e m)
-
-  | step_exit_seq: forall f n s k e m,
-      step (State f (Sexit n) (Kseq s k) e m)
-        E0 (State f (Sexit n) k e m)
-  | step_exit_block_0: forall f k e m,
-      step (State f (Sexit O) (Kblock k) e m)
-        E0 (State f Sskip k e m)
-  | step_exit_block_S: forall f n k e m,
-      step (State f (Sexit (S n)) (Kblock k) e m)
-        E0 (State f (Sexit n) k e m)
-
-  | step_switch: forall f a cases k e m n,
-      eval_expr e m a (Vint n) ->
-      step (State f (Sswitch a cases) k e m)
-        E0 (State f (seq_of_lbl_stmt (select_switch n cases)) k e m)
-
-  | step_return_0: forall f k e m m',
+      step (State f (Sifthenelse a s1 s2) k e le m)
+        E0 (State f (if b then s1 else s2) k e le m)
+
+  | step_loop: forall f s k e le m,
+      step (State f (Sloop s) k e le m)
+        E0 (State f s (Kseq (Sloop s) k) e le m)
+
+  | step_block: forall f s k e le m,
+      step (State f (Sblock s) k e le m)
+        E0 (State f s (Kblock k) e le m)
+
+  | step_exit_seq: forall f n s k e le m,
+      step (State f (Sexit n) (Kseq s k) e le m)
+        E0 (State f (Sexit n) k e le m)
+  | step_exit_block_0: forall f k e le m,
+      step (State f (Sexit O) (Kblock k) e le m)
+        E0 (State f Sskip k e le m)
+  | step_exit_block_S: forall f n k e le m,
+      step (State f (Sexit (S n)) (Kblock k) e le m)
+        E0 (State f (Sexit n) k e le m)
+
+  | step_switch: forall f a cases k e le m n,
+      eval_expr e le m a (Vint n) ->
+      step (State f (Sswitch a cases) k e le m)
+        E0 (State f (seq_of_lbl_stmt (select_switch n cases)) k e le m)
+
+  | step_return_0: forall f k e le m m',
       f.(fn_return) = None ->
       Mem.free_list m (blocks_of_env e) = Some m' ->
-      step (State f (Sreturn None) k e m)
+      step (State f (Sreturn None) k e le m)
         E0 (Returnstate Vundef (call_cont k) m')
-  | step_return_1: forall f a k e m v m',
+  | step_return_1: forall f a k e le m v m',
       f.(fn_return) <> None ->
-      eval_expr e m a v ->
+      eval_expr e le m a v ->
       Mem.free_list m (blocks_of_env e) = Some m' ->
-      step (State f (Sreturn (Some a)) k e m)
+      step (State f (Sreturn (Some a)) k e le m)
         E0 (Returnstate v (call_cont k) m')
-  | step_label: forall f lbl s k e m,
-      step (State f (Slabel lbl s) k e m)
-        E0 (State f s k e m)
+  | step_label: forall f lbl s k e le m,
+      step (State f (Slabel lbl s) k e le m)
+        E0 (State f s k e le m)
 
-  | step_goto: forall f lbl k e m s' k',
+  | step_goto: forall f lbl k e le m s' k',
       find_label lbl f.(fn_body) (call_cont k) = Some(s', k') ->
-      step (State f (Sgoto lbl) k e m)
-        E0 (State f s' k' e m)
+      step (State f (Sgoto lbl) k e le m)
+        E0 (State f s' k' e le m)
 
   | step_internal_function: forall f vargs k m m1 m2 e,
       list_norepet (fn_params_names f ++ fn_vars_names f) ->
       alloc_variables empty_env m (fn_variables f) e m1 ->
       bind_parameters e m1 f.(fn_params) vargs m2 ->
       step (Callstate (Internal f) vargs k m)
-        E0 (State f f.(fn_body) k e m2)
+        E0 (State f f.(fn_body) k e empty_temp_env m2)
 
   | 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 e k m m',
-      exec_opt_assign e m optid v m' ->
-      step (Returnstate v (Kcall optid f e k) m)
-        E0 (State f Sskip k e m').
+  | step_return: forall v optid f e le k m,
+      step (Returnstate v (Kcall optid f e le k) m)
+        E0 (State f Sskip k e (Cminor.set_optvar optid v le) m).
 
 End RELSEM.
 
@@ -552,13 +574,8 @@ Inductive final_state: state -> int -> Prop :=
   in the initial memory state for [p] has [beh] as observable
   behavior. *)
 
-Definition global_var_env (p: program): gvarenv :=
-  List.fold_left
-    (fun gve x => match x with (id, v) => PTree.set id (gvar_info v) gve end)
-    p.(prog_vars) (PTree.empty var_kind).
-
 Definition exec_program (p: program) (beh: program_behavior) : Prop :=
   program_behaves step (initial_state p) final_state 
-                  (Genv.globalenv p, global_var_env p) beh.
+                  (Genv.globalenv p) beh.
 
 
diff --git a/cfrontend/Cshmgen.v b/cfrontend/Cshmgen.v
index 56bef55..a54bfcb 100644
--- a/cfrontend/Cshmgen.v
+++ b/cfrontend/Cshmgen.v
@@ -26,6 +26,7 @@ Require Import Integers.
 Require Import Floats.
 Require Import AST.
 Require Import Csyntax.
+Require Import Clight.
 Require Import Cminor.
 Require Import Csharpminor.
 
@@ -105,28 +106,28 @@ Definition make_boolean (e: expr) (ty: type) :=
   end.
 
 Definition make_neg (e: expr) (ty: type) :=
-  match ty with
-  | Tint _ _ => OK (Eunop Onegint e)
-  | Tfloat _ => OK (Eunop Onegf e)
+  match classify_neg ty with
+  | neg_case_i _ => OK (Eunop Onegint e)
+  | neg_case_f => OK (Eunop Onegf e)
   | _ => Error (msg "Cshmgen.make_neg")
   end.
 
 Definition make_notbool (e: expr) (ty: type) :=
-  match typeconv ty with
-  | Tfloat _ => Ebinop (Ocmpf Ceq) e (make_floatconst Float.zero)
-  | _ => Eunop Onotbool e
+  match classify_bool ty with
+  | bool_case_ip => OK (Eunop Onotbool e)
+  | bool_case_f => OK (Ebinop (Ocmpf Ceq) e (make_floatconst Float.zero))
+  | _ => Error (msg "Cshmgen.make_notbool")
   end.
 
 Definition make_notint (e: expr) (ty: type) :=
   Eunop Onotint e.
 
-Definition make_fabs (e: expr) (ty: type) :=
-  Eunop Oabsf e.
-
 Definition make_add (e1: expr) (ty1: type) (e2: expr) (ty2: type) :=
   match classify_add ty1 ty2 with
-  | add_case_ii => OK (Ebinop Oadd e1 e2)
+  | add_case_ii _ => OK (Ebinop Oadd e1 e2)
   | add_case_ff => OK (Ebinop Oaddf e1 e2)
+  | add_case_if sg => OK (Ebinop Oaddf (make_floatofint e1 sg) e2)
+  | add_case_fi sg => OK (Ebinop Oaddf e1 (make_floatofint e2 sg))
   | add_case_pi ty =>
       let n := make_intconst (Int.repr (Csyntax.sizeof ty)) in
       OK (Ebinop Oadd e1 (Ebinop Omul n e2))
@@ -138,8 +139,10 @@ Definition make_add (e1: expr) (ty1: type) (e2: expr) (ty2: type) :=
 
 Definition make_sub (e1: expr) (ty1: type) (e2: expr) (ty2: type) :=
   match classify_sub ty1 ty2 with
-  | sub_case_ii => OK (Ebinop Osub e1 e2)
+  | sub_case_ii _ => OK (Ebinop Osub e1 e2)
   | sub_case_ff => OK (Ebinop Osubf e1 e2)
+  | sub_case_if sg => OK (Ebinop Osubf (make_floatofint e1 sg) e2)
+  | sub_case_fi sg => OK (Ebinop Osubf e1 (make_floatofint e2 sg))
   | sub_case_pi ty =>
       let n := make_intconst (Int.repr (Csyntax.sizeof ty)) in
       OK (Ebinop Osub e1 (Ebinop Omul n e2))
@@ -151,23 +154,27 @@ Definition make_sub (e1: expr) (ty1: type) (e2: expr) (ty2: type) :=
 
 Definition make_mul (e1: expr) (ty1: type) (e2: expr) (ty2: type) :=
   match classify_mul ty1 ty2 with
-  | mul_case_ii => OK (Ebinop Omul e1 e2)
+  | mul_case_ii _ => OK (Ebinop Omul e1 e2)
   | mul_case_ff => OK (Ebinop Omulf e1 e2)
+  | mul_case_if sg => OK (Ebinop Omulf (make_floatofint e1 sg) e2)
+  | mul_case_fi sg => OK (Ebinop Omulf e1 (make_floatofint e2 sg))
   | mul_default => Error (msg "Cshmgen.make_mul")
   end.
 
 Definition make_div (e1: expr) (ty1: type) (e2: expr) (ty2: type) :=
   match classify_div ty1 ty2 with
-  | div_case_I32unsi => OK (Ebinop Odivu e1 e2)
-  | div_case_ii => OK (Ebinop Odiv e1 e2)
+  | div_case_ii Unsigned => OK (Ebinop Odivu e1 e2)
+  | div_case_ii Signed => OK (Ebinop Odiv e1 e2)
   | div_case_ff => OK (Ebinop Odivf e1 e2)
+  | div_case_if sg => OK (Ebinop Odivf (make_floatofint e1 sg) e2)
+  | div_case_fi sg => OK (Ebinop Odivf e1 (make_floatofint e2 sg))
   | div_default => Error (msg "Cshmgen.make_div")
   end.
 
 Definition make_mod (e1: expr) (ty1: type) (e2: expr) (ty2: type) :=
-  match classify_mod ty1 ty2 with
-  | mod_case_I32unsi => OK (Ebinop Omodu e1 e2)
-  | mod_case_ii=> OK (Ebinop Omod e1 e2)
+  match classify_binint ty1 ty2 with
+  | binint_case_ii Unsigned => OK (Ebinop Omodu e1 e2)
+  | binint_case_ii Signed => OK (Ebinop Omod e1 e2)
   | mod_default => Error (msg "Cshmgen.make_mod")
   end.
 
@@ -184,38 +191,22 @@ Definition make_shl (e1: expr) (ty1: type) (e2: expr) (ty2: type) :=
   OK(Ebinop Oshl e1 e2).
 
 Definition make_shr (e1: expr) (ty1: type) (e2: expr) (ty2: type) :=
-  match classify_shr ty1 ty2 with
-  | shr_case_I32unsi => OK (Ebinop Oshru e1 e2)
-  | shr_case_ii=> OK (Ebinop Oshr e1 e2)
+  match classify_shift ty1 ty2 with
+  | shift_case_ii Unsigned => OK (Ebinop Oshru e1 e2)
+  | shift_case_ii Signed => OK (Ebinop Oshr e1 e2)
   | shr_default => Error (msg "Cshmgen.make_shr")
   end.
 
 Definition make_cmp (c: comparison) (e1: expr) (ty1: type) (e2: expr) (ty2: type) :=
   match classify_cmp ty1 ty2 with
-  | cmp_case_I32unsi => OK (Ebinop (Ocmpu c) e1 e2)
+  | cmp_case_iiu => OK (Ebinop (Ocmpu c) e1 e2)
   | cmp_case_ipip => OK (Ebinop (Ocmp c) e1 e2)
   | cmp_case_ff => OK (Ebinop (Ocmpf c) e1 e2)
+  | cmp_case_if sg => OK (Ebinop (Ocmpf c) (make_floatofint e1 sg) e2)
+  | cmp_case_fi sg => OK (Ebinop (Ocmpf c) e1 (make_floatofint e2 sg))
   | cmp_default => Error (msg "Cshmgen.make_cmp")
   end.
 
-Definition make_andbool (e1: expr) (ty1: type) (e2: expr) (ty2: type) :=
-  Econdition
-    (make_boolean e1 ty1)
-    (Econdition
-       (make_boolean e2 ty2)
-       (make_intconst Int.one)
-       (make_intconst Int.zero))
-    (make_intconst Int.zero).
-
-Definition make_orbool (e1: expr) (ty1: type) (e2: expr) (ty2: type) :=
-  Econdition
-    (make_boolean e1 ty1)
-    (make_intconst Int.one)
-    (Econdition
-       (make_boolean e2 ty2)
-       (make_intconst Int.one)
-       (make_intconst Int.zero)).
-
 (** [make_cast from to e] applies to [e] the numeric conversions needed
    to transform a result of type [from] to a result of type [to].
    It is decomposed in two functions:
@@ -271,9 +262,9 @@ Definition make_store (addr: expr) (ty: type) (rhs: expr) :=
 
 (** Determine if a C expression is a variable *)
 
-Definition is_variable (e: Csyntax.expr) : option ident :=
+Definition is_variable (e: Clight.expr) : option ident :=
   match e with
-  | Expr (Csyntax.Evar id) _ => Some id
+  | Clight.Evar id _ => Some id
   | _ => None
   end.
 
@@ -301,26 +292,13 @@ Definition var_set (id: ident) (ty: type) (rhs: expr) :=
   | _ => Error (MSG "Cshmgen.var_set " :: CTX id :: nil)
   end.
 
-(** Auxiliary for translating call statements *)
-
-Definition transl_lhs_call (opta: option Csyntax.expr) : res (option ident) :=
-  match opta with
-  | None => OK None
-  | Some a =>
-      match is_variable a with
-      | None => Error (msg "LHS of function call is not a variable")
-      | Some id => OK (Some id)
-      end
-  end.
-
 (** ** Translation of operators *)
 
 Definition transl_unop (op: Csyntax.unary_operation) (a: expr) (ta: type) : res expr :=
   match op with
-  | Csyntax.Onotbool => OK(make_notbool a ta)
+  | Csyntax.Onotbool => make_notbool a ta
   | Csyntax.Onotint => OK(make_notint a ta)
   | Csyntax.Oneg => make_neg a ta
-  | Csyntax.Ofabs => OK(make_fabs a ta)
   end.
 
 Definition transl_binop (op: Csyntax.binary_operation)
@@ -349,55 +327,41 @@ Definition transl_binop (op: Csyntax.binary_operation)
 
 (** [transl_expr a] returns the Csharpminor code that computes the value
    of expression [a]. The computation is performed in the error monad
-   (see module [Errors]) to enable error reporting.
-
-   Most cases are self-explanatory.  We outline the non-obvious cases:
-<<
-   a && b    --->    a ? (b ? 1 : 0) : 0
-
-   a || b    --->    a ? 1 : (b ? 1 : 0)
->>
-*)
+   (see module [Errors]) to enable error reporting. *)
 
-Fixpoint transl_expr (a: Csyntax.expr) {struct a} : res expr :=
+Fixpoint transl_expr (a: Clight.expr) {struct a} : res expr :=
   match a with
-  | Expr (Csyntax.Econst_int n) _ =>
+  | Clight.Econst_int n _ =>
       OK(make_intconst n)
-  | Expr (Csyntax.Econst_float n) _ =>
+  | Clight.Econst_float n _ =>
       OK(make_floatconst n)
-  | Expr (Csyntax.Evar id) ty =>
+  | Clight.Evar id ty =>
       var_get id ty
-  | Expr (Csyntax.Ederef b) _ =>
+  | Clight.Etempvar id ty =>
+      OK(Etempvar id)
+  | Clight.Ederef b _ =>
       do tb <- transl_expr b;
       make_load tb (typeof a)
-  | Expr (Csyntax.Eaddrof b) _ =>
+  | Clight.Eaddrof b _ =>
       transl_lvalue b
-  | Expr (Csyntax.Eunop op b) _ =>
+  | Clight.Eunop op b _ =>
       do tb <- transl_expr b;
       transl_unop op tb (typeof b)
-  | Expr (Csyntax.Ebinop op b c) _ =>
+  | Clight.Ebinop op b c _ =>
       do tb <- transl_expr b;
       do tc <- transl_expr c;
       transl_binop op tb (typeof b) tc (typeof c)
-  | Expr (Csyntax.Ecast ty b) _ =>
+  | Clight.Ecast b ty =>
       do tb <- transl_expr b;
       OK (make_cast (typeof b) ty tb)
-  | Expr (Csyntax.Econdition b c d) _ =>
+  | Clight.Econdition b c d _ =>
       do tb <- transl_expr b;
       do tc <- transl_expr c;
       do td <- transl_expr d;
       OK(Econdition (make_boolean tb (typeof b)) tc td)
-  | Expr (Csyntax.Eandbool b c) _ =>
-      do tb <- transl_expr b;
-      do tc <- transl_expr c;
-      OK(make_andbool tb (typeof b) tc (typeof c))
-  | Expr (Csyntax.Eorbool b c) _ =>
-      do tb <- transl_expr b;
-      do tc <- transl_expr c;
-      OK(make_orbool tb (typeof b) tc (typeof c))
-  | Expr (Csyntax.Esizeof ty) _ =>
+  | Clight.Esizeof ty _ =>
       OK(make_intconst (Int.repr (Csyntax.sizeof ty)))
-  | Expr (Csyntax.Efield b i) ty => 
+  | Clight.Efield b i ty => 
       match typeof b with
       | Tstruct _ fld =>
           do tb <- transl_lvalue b;
@@ -418,13 +382,13 @@ Fixpoint transl_expr (a: Csyntax.expr) {struct a} : res expr :=
    where the value of [a] is stored.
 *)
 
-with transl_lvalue (a: Csyntax.expr) {struct a} : res expr :=
+with transl_lvalue (a: Clight.expr) {struct a} : res expr :=
   match a with
-  | Expr (Csyntax.Evar id) _ =>
+  | Clight.Evar id _ =>
       OK (Eaddrof id)
-  | Expr (Csyntax.Ederef b) _ =>
+  | Clight.Ederef b _ =>
       transl_expr b
-  | Expr (Csyntax.Efield b i) ty => 
+  | Clight.Efield b i ty => 
       match typeof b with
       | Tstruct _ fld =>
           do tb <- transl_lvalue b;
@@ -439,17 +403,21 @@ with transl_lvalue (a: Csyntax.expr) {struct a} : res expr :=
       Error(msg "Cshmgen.transl_lvalue")
   end.
 
-(** [transl_exprlist al] returns a list of Csharpminor expressions
-   that compute the values of the list [al] of Csyntax expressions.
+(** [transl_exprlist al tyl] returns a list of Csharpminor expressions
+   that compute the values of the list [al] of Csyntax expressions,
+   casted to the corresponding types in [tyl].
    Used for function applications. *)
 
-Fixpoint transl_exprlist (al: list Csyntax.expr): res (list expr) :=
-  match al with
-  | nil => OK nil
-  | a1 :: a2 =>
+Fixpoint transl_exprlist (al: list Clight.expr) (tyl: typelist)
+                         {struct al}: res (list expr) :=
+  match al, tyl with
+  | nil, Tnil => OK nil
+  | a1 :: a2, Tcons ty1 ty2 =>
       do ta1 <- transl_expr a1;
-      do ta2 <- transl_exprlist a2;
-      OK (ta1 :: ta2)
+      do ta2 <- transl_exprlist a2 ty2;
+      OK (make_cast (typeof a1) ty1 ta1 :: ta2)
+  | _, _ =>
+      Error(msg "Cshmgen.transl_exprlist: arity mismatch")
   end.
 
 (** * Translation of statements *)
@@ -459,7 +427,7 @@ Fixpoint transl_exprlist (al: list Csyntax.expr): res (list expr) :=
    an [exit 0] is performed.  If [e] evaluates to true, the generated
    statement continues in sequence. *)
 
-Definition exit_if_false (e: Csyntax.expr) : res stmt :=
+Definition exit_if_false (e: Clight.expr) : res stmt :=
   do te <- transl_expr e;
   OK(Sifthenelse
         (make_boolean te (typeof e))
@@ -497,8 +465,7 @@ do s; while (e1);   --->     block {
                              }
                              // break in s branches here
 
-for (e1;e2;e3) s;   --->     e1;
-                             block {
+for (;e2;e3) s;   --->       block {
                                loop {
                                  if (!e2) exit 0;
                                  block { s }
@@ -510,93 +477,84 @@ for (e1;e2;e3) s;   --->     e1;
 >>
 *)
 
-Definition is_Sskip:
-  forall (s: Csyntax.statement), {s = Csyntax.Sskip} + {s <> Csyntax.Sskip}.
-Proof.
-  destruct s; ((left; reflexivity) || (right; congruence)).
-Qed.
-
-Fixpoint transl_statement (nbrk ncnt: nat) (s: Csyntax.statement) {struct s} : res stmt :=
+Fixpoint transl_statement (tyret: type) (nbrk ncnt: nat)
+                          (s: Clight.statement) {struct s} : res stmt :=
   match s with
-  | Csyntax.Sskip =>
+  | Clight.Sskip =>
       OK Sskip
-  | Csyntax.Sassign b c =>
+  | Clight.Sassign b c =>
       match is_variable b with
       | Some id =>
           do tc <- transl_expr c;
-          var_set id (typeof b) tc
+          var_set id (typeof b) (make_cast (typeof c) (typeof b) tc)
       | None =>
           do tb <- transl_lvalue b;
           do tc <- transl_expr c;
-          make_store tb (typeof b) tc
+          make_store tb (typeof b) (make_cast (typeof c) (typeof b) tc)
       end 
-  | Csyntax.Scall opta b cl =>
+  | Clight.Sset x b =>
+      do tb <- transl_expr b;
+      OK(Sset x tb)
+  | Clight.Scall x b cl =>
       match classify_fun (typeof b) with
       | fun_case_f args res =>
-          do optid <- transl_lhs_call opta;
           do tb <- transl_expr b;
-          do tcl <- transl_exprlist cl;
-          OK(Scall optid (signature_of_type args res) tb tcl)
+          do tcl <- transl_exprlist cl args;
+          OK(Scall x (signature_of_type args res) tb tcl)
       | _ => Error(msg "Cshmgen.transl_stmt(call)")
       end
-  | Csyntax.Ssequence s1 s2 =>
-      do ts1 <- transl_statement nbrk ncnt s1;
-      do ts2 <- transl_statement nbrk ncnt s2;
+  | Clight.Ssequence s1 s2 =>
+      do ts1 <- transl_statement tyret nbrk ncnt s1;
+      do ts2 <- transl_statement tyret nbrk ncnt s2;
       OK (Sseq ts1 ts2)
-  | Csyntax.Sifthenelse e s1 s2 =>
+  | Clight.Sifthenelse e s1 s2 =>
       do te <- transl_expr e;
-      do ts1 <- transl_statement nbrk ncnt s1;
-      do ts2 <- transl_statement nbrk ncnt s2;
+      do ts1 <- transl_statement tyret nbrk ncnt s1;
+      do ts2 <- transl_statement tyret nbrk ncnt s2;
       OK (Sifthenelse (make_boolean te (typeof e)) ts1 ts2)
-  | Csyntax.Swhile e s1 =>
+  | Clight.Swhile e s1 =>
       do te <- exit_if_false e;
-      do ts1 <- transl_statement 1%nat 0%nat s1;
+      do ts1 <- transl_statement tyret 1%nat 0%nat s1;
       OK (Sblock (Sloop (Sseq te (Sblock ts1))))
-  | Csyntax.Sdowhile e s1 =>
+  | Clight.Sdowhile e s1 =>
       do te <- exit_if_false e;
-      do ts1 <- transl_statement 1%nat 0%nat s1;
+      do ts1 <- transl_statement tyret 1%nat 0%nat s1;
       OK (Sblock (Sloop (Sseq (Sblock ts1) te)))
-  | Csyntax.Sfor e1 e2 e3 s1 =>
-      if is_Sskip e1 then
-       (do te2 <- exit_if_false e2;
-        do te3 <- transl_statement nbrk ncnt e3;
-        do ts1 <- transl_statement 1%nat 0%nat s1;
-        OK (Sblock (Sloop (Sseq te2 (Sseq (Sblock ts1) te3)))))
-      else
-       (do te1 <- transl_statement nbrk ncnt e1;
-        do te2 <- exit_if_false e2;
-        do te3 <- transl_statement nbrk ncnt e3;
-        do ts1 <- transl_statement 1%nat 0%nat s1;
-        OK (Sseq te1 (Sblock (Sloop (Sseq te2 (Sseq (Sblock ts1) te3))))))
-  | Csyntax.Sbreak =>
+  | Clight.Sfor' e2 e3 s1 =>
+      do te2 <- exit_if_false e2;
+      do te3 <- transl_statement tyret 0%nat (S ncnt) e3;
+      do ts1 <- transl_statement tyret 1%nat 0%nat s1;
+      OK (Sblock (Sloop (Sseq te2 (Sseq (Sblock ts1) te3))))
+  | Clight.Sbreak =>
       OK (Sexit nbrk)
-  | Csyntax.Scontinue =>
+  | Clight.Scontinue =>
       OK (Sexit ncnt)
-  | Csyntax.Sreturn (Some e) =>
+  | Clight.Sreturn (Some e) =>
       do te <- transl_expr e;
-      OK (Sreturn (Some te))
-  | Csyntax.Sreturn None =>
+      OK (Sreturn (Some (make_cast (typeof e) tyret te)))
+  | Clight.Sreturn None =>
       OK (Sreturn None)
-  | Csyntax.Sswitch a sl =>
+  | Clight.Sswitch a sl =>
       do ta <- transl_expr a;
-      do tsl <- transl_lbl_stmt 0%nat (S ncnt) sl;
+      do tsl <- transl_lbl_stmt tyret 0%nat (S ncnt) sl;
       OK (Sblock (Sswitch ta tsl))
-  | Csyntax.Slabel lbl s =>
-      do ts <- transl_statement nbrk ncnt s;
+  | Clight.Slabel lbl s =>
+      do ts <- transl_statement tyret nbrk ncnt s;
       OK (Slabel lbl ts)
-  | Csyntax.Sgoto lbl =>
+  | Clight.Sgoto lbl =>
       OK (Sgoto lbl)
   end
 
-with transl_lbl_stmt (nbrk ncnt: nat) (sl: Csyntax.labeled_statements)
+with transl_lbl_stmt (tyret: type) (nbrk ncnt: nat)
+                     (sl: Clight.labeled_statements)
                      {struct sl}: res lbl_stmt :=
   match sl with
-  | Csyntax.LSdefault s =>
-      do ts <- transl_statement nbrk ncnt s;
+  | Clight.LSdefault s =>
+      do ts <- transl_statement tyret nbrk ncnt s;
       OK (LSdefault ts)
-  | Csyntax.LScase n s sl' =>
-      do ts <- transl_statement nbrk ncnt s;
-      do tsl' <- transl_lbl_stmt nbrk ncnt sl';
+  | Clight.LScase n s sl' =>
+      do ts <- transl_statement tyret nbrk ncnt s;
+      do tsl' <- transl_lbl_stmt tyret nbrk ncnt sl';
       OK (LScase n ts tsl')
   end.
 
@@ -610,23 +568,37 @@ Definition transl_params (l: list (ident * type)) :=
 Definition transl_vars (l: list (ident * type)) :=
    AST.map_partial prefix_var_name var_kind_of_type l.
 
-Definition transl_function (f: Csyntax.function) : res function :=
-  do tparams <- transl_params (Csyntax.fn_params f);
-  do tvars <- transl_vars (Csyntax.fn_vars f);
-  do tbody <- transl_statement 1%nat 0%nat (Csyntax.fn_body f);
-  OK (mkfunction (opttyp_of_type (Csyntax.fn_return f)) tparams tvars tbody).
+Definition transl_function (f: Clight.function) : res function :=
+  do tparams <- transl_params (Clight.fn_params f);
+  do tvars <- transl_vars (Clight.fn_vars f);
+  do tbody <- transl_statement f.(Clight.fn_return) 1%nat 0%nat (Clight.fn_body f);
+  OK (mkfunction 
+       (opttyp_of_type (Clight.fn_return f))
+       tparams
+       tvars
+       (List.map (@fst ident type) f.(Clight.fn_temps))
+       tbody).
+
+Definition list_typ_eq:
+  forall (l1 l2: list typ), {l1=l2} + {l1<>l2}.
+Proof.
+  generalize typ_eq; intro. decide equality. 
+Qed.
 
-Definition transl_fundef (f: Csyntax.fundef) : res fundef :=
+Definition transl_fundef (f: Clight.fundef) : res fundef :=
   match f with
-  | Csyntax.Internal g => 
+  | Clight.Internal g => 
       do tg <- transl_function g; OK(AST.Internal tg)
-  | Csyntax.External ef args res =>
-      OK(AST.External ef)
+  | Clight.External ef args res =>
+      if list_typ_eq ef.(ef_sig).(sig_args) (typlist_of_typelist args)
+      && opt_typ_eq ef.(ef_sig).(sig_res) (opttyp_of_type res)
+      then OK(AST.External ef)
+      else Error(msg "Cshmgen.transl_fundef: wrong external signature")
   end.
 
 (** ** Translation of programs *)
 
 Definition transl_globvar (ty: type) := var_kind_of_type ty.
 
-Definition transl_program (p: Csyntax.program) : res program :=
+Definition transl_program (p: Clight.program) : res program :=
   transform_partial_program2 transl_fundef transl_globvar p.
diff --git a/cfrontend/Cshmgenproof.v b/cfrontend/Cshmgenproof.v
new file mode 100644
index 0000000..02fab6f
--- /dev/null
+++ b/cfrontend/Cshmgenproof.v
@@ -0,0 +1,1869 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** * Correctness of the translation from Clight to C#minor. *)
+
+Require Import Coqlib.
+Require Import Errors.
+Require Import Maps.
+Require Import Integers.
+Require Import Floats.
+Require Import AST.
+Require Import Values.
+Require Import Events.
+Require Import Memory.
+Require Import Globalenvs.
+Require Import Smallstep.
+Require Import Csyntax.
+Require Import Csem.
+Require Import Clight.
+Require Import Cminor.
+Require Import Csharpminor.
+Require Import Cshmgen.
+
+(** * Properties of operations over types *)
+
+Remark type_of_chunk_of_type:
+  forall ty chunk,
+  chunk_of_type ty = OK chunk ->
+  type_of_chunk chunk = typ_of_type ty.
+Proof.
+  intros. unfold chunk_of_type in H. destruct ty; simpl in H; try monadInv H.
+  destruct i; destruct s; monadInv H; reflexivity.
+  destruct f; monadInv H; reflexivity.
+  reflexivity. reflexivity. 
+Qed.
+
+Remark transl_params_types:
+  forall p tp,
+  transl_params p = OK tp ->
+  map type_of_chunk (map param_chunk tp) = typlist_of_typelist (type_of_params p).
+Proof.
+  induction p; simpl; intros. 
+  inv H. auto.
+  destruct a as [id ty]. generalize H; clear H. case_eq (chunk_of_type ty); intros.
+  monadInv H0. simpl. f_equal; auto. apply type_of_chunk_of_type; auto.
+  inv H0.
+Qed.
+
+Lemma transl_fundef_sig1:
+  forall f tf args res,
+  transl_fundef f = OK tf ->
+  classify_fun (type_of_fundef f) = fun_case_f args res ->
+  funsig tf = signature_of_type args res.
+Proof.
+  intros. destruct f; simpl in *. 
+  monadInv H. monadInv EQ. simpl. inversion H0.    
+  unfold fn_sig; simpl. unfold signature_of_type. f_equal. 
+  apply transl_params_types; auto.
+  destruct (list_typ_eq (sig_args (ef_sig e)) (typlist_of_typelist t)); simpl in H.
+  destruct (opt_typ_eq (sig_res (ef_sig e)) (opttyp_of_type t0)); simpl in H.
+  inv H. simpl. destruct (ef_sig e); simpl in *. inv H0.
+  unfold signature_of_type. auto.
+  congruence.
+  congruence.
+Qed.
+
+Lemma transl_fundef_sig2:
+  forall f tf args res,
+  transl_fundef f = OK tf ->
+  type_of_fundef f = Tfunction args res ->
+  funsig tf = signature_of_type args res.
+Proof.
+  intros. eapply transl_fundef_sig1; eauto.
+  rewrite H0; reflexivity.
+Qed.
+
+Lemma var_kind_by_value:
+  forall ty chunk,
+  access_mode ty = By_value chunk ->
+  var_kind_of_type ty = OK(Vscalar chunk).
+Proof.
+  intros ty chunk; destruct ty; simpl; try congruence.
+  destruct i; try congruence; destruct s; congruence.
+  destruct f; congruence.
+Qed.
+
+Lemma sizeof_var_kind_of_type:
+  forall ty vk,
+  var_kind_of_type ty = OK vk ->
+  Csharpminor.sizeof vk = Csyntax.sizeof ty.
+Proof.
+  intros ty vk.
+  assert (sizeof (Varray (Csyntax.sizeof ty)) = Csyntax.sizeof ty).
+    simpl. rewrite Zmax_spec. apply zlt_false. 
+    generalize (Csyntax.sizeof_pos ty). omega.
+  destruct ty; try (destruct i; try destruct s); try (destruct f); 
+  simpl; intro EQ; inversion EQ; subst vk; auto.
+Qed.
+
+Remark cast_int_int_normalized:
+  forall sz si chunk n,
+  access_mode (Tint sz si) = By_value chunk ->
+  val_normalized (Vint (cast_int_int sz si n)) chunk.
+Proof.
+  unfold access_mode, cast_int_int, val_normalized; intros. destruct sz.
+  destruct si; inv H; simpl.
+  rewrite Int.sign_ext_idem; auto. compute; auto.
+  rewrite Int.zero_ext_idem; auto. compute; auto.
+  destruct si; inv H; simpl.
+  rewrite Int.sign_ext_idem; auto. compute; auto.
+  rewrite Int.zero_ext_idem; auto. compute; auto.
+  inv H. auto.
+Qed.
+
+Remark cast_float_float_normalized:
+  forall sz chunk n,
+  access_mode (Tfloat sz) = By_value chunk ->
+  val_normalized (Vfloat (cast_float_float sz n)) chunk.
+Proof.
+  unfold access_mode, cast_float_float, val_normalized; intros. 
+  destruct sz; inv H; simpl.
+  rewrite Float.singleoffloat_idem. auto.
+  auto.
+Qed.
+
+Remark neutral_for_cast_chunk:
+  forall ty chunk,
+  neutral_for_cast ty -> access_mode ty = By_value chunk -> chunk = Mint32.
+Proof.
+  induction 1; simpl; intros; inv H; auto.
+Qed.
+
+Lemma cast_result_normalized:
+  forall chunk v1 ty1 ty2 v2,
+  cast v1 ty1 ty2 v2 ->
+  access_mode ty2 = By_value chunk ->
+  val_normalized v2 chunk.
+Proof.
+  induction 1; intros; simpl.
+  apply cast_int_int_normalized; auto.
+  apply cast_int_int_normalized; auto.
+  apply cast_float_float_normalized; auto.
+  apply cast_float_float_normalized; auto.
+  rewrite (neutral_for_cast_chunk _ _ H0 H1). red; auto.
+  rewrite (neutral_for_cast_chunk _ _ H0 H1). red; auto.
+Qed.
+
+Definition val_casted (v: val) (ty: type) : Prop :=
+  exists v0, exists ty0, cast v0 ty0 ty v.
+
+Lemma val_casted_normalized:
+  forall v ty chunk,
+  val_casted v ty -> access_mode ty = By_value chunk -> val_normalized v chunk.
+Proof.
+  intros. destruct H as [v0 [ty0 CAST]]. eapply cast_result_normalized; eauto.
+Qed.
+
+Fixpoint val_casted_list (vl: list val) (tyl: typelist) {struct vl}: Prop :=
+  match vl, tyl with
+  | nil, Tnil => True
+  | v1 :: vl', Tcons ty1 tyl' => val_casted v1 ty1 /\ val_casted_list vl' tyl'
+  | _, _ => False
+  end.
+
+Lemma eval_exprlist_casted:
+  forall ge e le m al tyl vl,
+  Clight.eval_exprlist ge e le m al tyl vl ->
+  val_casted_list vl tyl.
+Proof.
+  induction 1; simpl.
+  auto.
+  split. exists v1; exists (typeof a); auto. eauto.
+Qed.
+
+(** * Properties of the translation functions *)
+
+Lemma map_partial_names:
+  forall (A B: Type) (f: A -> res B)
+         (l: list (ident * A)) (tl: list (ident * B)),
+  map_partial prefix_var_name f l = OK tl ->
+  List.map (@fst ident B) tl = List.map (@fst ident A) l.
+Proof.
+  induction l; simpl.
+  intros. inversion H. reflexivity.
+  intro tl. destruct a as [id x]. destruct (f x); try congruence.
+  caseEq (map_partial prefix_var_name f l); simpl; intros; try congruence.
+  inv H0. simpl. decEq. auto.
+Qed.
+   
+Lemma map_partial_append:
+  forall (A B: Type) (f: A -> res B)
+         (l1 l2: list (ident * A)) (tl1 tl2: list (ident * B)),
+  map_partial prefix_var_name f l1 = OK tl1 ->
+  map_partial prefix_var_name f l2 = OK tl2 ->
+  map_partial prefix_var_name f (l1 ++ l2) = OK (tl1 ++ tl2).
+Proof.
+  induction l1; intros until tl2; simpl.
+  intros. inversion H. simpl; auto.
+  destruct a as [id x]. destruct (f x); try congruence.
+  caseEq (map_partial prefix_var_name f l1); simpl; intros; try congruence.
+  inv H0. rewrite (IHl1 _ _ _ H H1). auto.
+Qed.
+ 
+Lemma transl_params_names:
+  forall vars tvars,
+  transl_params vars = OK tvars ->
+  List.map param_name tvars = var_names vars.
+Proof.
+  exact (map_partial_names _ _ chunk_of_type).
+Qed.
+
+Lemma transl_vars_names:
+  forall vars tvars,
+  transl_vars vars = OK tvars ->
+  List.map variable_name tvars = var_names vars.
+Proof.
+  exact (map_partial_names _ _ var_kind_of_type).
+Qed.
+
+Lemma transl_names_norepet:
+  forall params vars sg tparams tvars temps body,
+  list_norepet (var_names params ++ var_names vars) ->
+  transl_params params = OK tparams ->
+  transl_vars vars = OK tvars ->
+  let f := Csharpminor.mkfunction sg tparams tvars temps body in
+  list_norepet (fn_params_names f ++ fn_vars_names f).
+Proof.
+  intros. unfold fn_params_names, fn_vars_names, f. simpl.
+  rewrite (transl_params_names _ _ H0).
+  rewrite (transl_vars_names _ _ H1).
+  auto.
+Qed.
+
+Lemma transl_vars_append:
+  forall l1 l2 tl1 tl2,
+  transl_vars l1 = OK tl1 -> transl_vars l2 = OK tl2 ->
+  transl_vars (l1 ++ l2) = OK (tl1 ++ tl2).
+Proof.
+  exact (map_partial_append _ _ var_kind_of_type).
+Qed.
+
+Lemma transl_params_vars:
+  forall params tparams,
+  transl_params params = OK tparams ->
+  transl_vars params =
+  OK (List.map (fun id_chunk => (fst id_chunk, Vscalar (snd id_chunk))) tparams).
+Proof.
+  induction params; intro tparams; simpl.
+  intros. inversion H. reflexivity.
+  destruct a as [id x]. 
+  unfold chunk_of_type. caseEq (access_mode x); try congruence.
+  intros chunk AM. 
+  caseEq (transl_params params); simpl; intros; try congruence.
+  inv H0. 
+  rewrite (var_kind_by_value _ _ AM). 
+  rewrite (IHparams _ H). reflexivity.
+Qed.
+
+Lemma transl_fn_variables:
+  forall params vars sg tparams tvars temps body,
+  transl_params params = OK tparams ->
+  transl_vars vars = OK tvars ->
+  let f := Csharpminor.mkfunction sg tparams tvars temps body in
+  transl_vars (params ++ vars) = OK (fn_variables f).
+Proof.
+  intros. 
+  generalize (transl_params_vars _ _ H); intro.
+  rewrite (transl_vars_append _ _ _ _ H1 H0).
+  reflexivity.
+Qed.
+
+(** Transformation of expressions and statements. *)
+
+Lemma is_variable_correct:
+  forall a id,
+  is_variable a = Some id ->
+  a = Clight.Evar id (typeof a).
+Proof.
+  intros until id. unfold is_variable; destruct a; intros; try discriminate.
+  simpl. congruence.
+Qed.
+
+Lemma transl_expr_lvalue:
+  forall ge e le m a loc ofs ta,
+  Clight.eval_lvalue ge e le m a loc ofs ->
+  transl_expr a = OK ta ->
+  (exists id, exists ty, a = Clight.Evar id ty /\ var_get id ty = OK ta) \/
+  (exists tb, transl_lvalue a = OK tb /\
+              make_load tb (typeof a) = OK ta).
+Proof.
+  intros. inversion H; subst; clear H; simpl in H0.
+  left; exists id; exists ty; auto.
+  left; exists id; exists ty; auto.
+  monadInv H0. right. exists x; split; auto.
+  rewrite H2 in H0. monadInv H0. right.  
+  exists (Ebinop Oadd x (make_intconst (Int.repr x0))). split; auto.
+  simpl. rewrite H2. rewrite EQ. rewrite EQ1. auto.
+  rewrite H2 in H0. monadInv H0. right.
+  exists x; split; auto. 
+  simpl. rewrite H2. auto.
+Qed.
+
+(** Properties of labeled statements *)
+
+Lemma transl_lbl_stmt_1:
+  forall tyret nbrk ncnt n sl tsl,
+  transl_lbl_stmt tyret nbrk ncnt sl = OK tsl ->
+  transl_lbl_stmt tyret nbrk ncnt (Clight.select_switch n sl) = OK (select_switch n tsl).
+Proof.
+  induction sl; intros.
+  monadInv H. simpl. rewrite EQ. auto.
+  generalize H; intro TR. monadInv TR. simpl. 
+  destruct (Int.eq i n). auto. auto. 
+Qed.
+
+Lemma transl_lbl_stmt_2:
+  forall tyret nbrk ncnt sl tsl,
+  transl_lbl_stmt tyret nbrk ncnt sl = OK tsl ->
+  transl_statement tyret nbrk ncnt (seq_of_labeled_statement sl) = OK (seq_of_lbl_stmt tsl).
+Proof.
+  induction sl; intros.
+  monadInv H. simpl. auto.
+  monadInv H. simpl. rewrite EQ; simpl. rewrite (IHsl _ EQ1). simpl. auto.
+Qed.
+
+(** * Correctness of Csharpminor construction functions *)
+
+Section CONSTRUCTORS.
+
+Variable ge: genv.
+
+Lemma make_intconst_correct:
+  forall n e le m,
+  eval_expr ge e le m (make_intconst n) (Vint n).
+Proof.
+  intros. unfold make_intconst. econstructor. reflexivity. 
+Qed.
+
+Lemma make_floatconst_correct:
+  forall n e le m,
+  eval_expr ge e le m (make_floatconst n) (Vfloat n).
+Proof.
+  intros. unfold make_floatconst. econstructor. reflexivity. 
+Qed.
+
+Lemma make_floatofint_correct:
+  forall a n sg e le m,
+  eval_expr ge e le m a (Vint n) ->
+  eval_expr ge e le m (make_floatofint a sg) (Vfloat(cast_int_float sg n)).
+Proof.
+  intros. unfold make_floatofint, cast_int_float. 
+  destruct sg; econstructor; eauto. 
+Qed.
+
+Hint Resolve make_intconst_correct make_floatconst_correct
+             make_floatofint_correct
+             eval_Eunop eval_Ebinop: cshm.
+Hint Extern 2 (@eq trace _ _) => traceEq: cshm.
+
+Remark Vtrue_is_true: Val.is_true Vtrue.
+Proof.
+  simpl. apply Int.one_not_zero.
+Qed.
+
+Remark Vfalse_is_false: Val.is_false Vfalse.
+Proof.
+  simpl. auto.
+Qed.
+
+Lemma make_boolean_correct_true:
+ forall e le m a v ty,
+  eval_expr ge e le m a v ->
+  is_true v ty ->
+  exists vb,
+    eval_expr ge e le m (make_boolean a ty) vb
+    /\ Val.is_true vb.
+Proof.
+  intros until ty; intros EXEC VTRUE.
+  destruct ty; simpl;
+  try (exists v; intuition; inversion VTRUE; simpl; auto; fail).
+  exists Vtrue; split.
+  eapply eval_Ebinop; eauto with cshm. 
+  inversion VTRUE; simpl.
+  rewrite Float.cmp_ne_eq. rewrite H1. auto.
+  apply Vtrue_is_true.
+Qed.
+
+Lemma make_boolean_correct_false:
+ forall e le m a v ty,
+  eval_expr ge e le m a v ->
+  is_false v ty ->
+  exists vb,
+    eval_expr ge e le m (make_boolean a ty) vb
+    /\ Val.is_false vb.
+Proof.
+  intros until ty; intros EXEC VFALSE.
+  destruct ty; simpl;
+  try (exists v; intuition; inversion VFALSE; simpl; auto; fail).
+  exists Vfalse; split.
+  eapply eval_Ebinop; eauto with cshm. 
+  inversion VFALSE; simpl.
+  rewrite Float.cmp_ne_eq. rewrite H1. auto.
+  apply Vfalse_is_false.
+Qed.
+
+Lemma make_neg_correct:
+  forall a tya c va v e le m,
+  sem_neg va tya = Some v ->
+  make_neg a tya = OK c ->  
+  eval_expr ge e le m a va ->
+  eval_expr ge e le m c v.
+Proof.
+  intros until m; intro SEM. unfold make_neg. 
+  functional inversion SEM; intros.
+  rewrite H0 in H4. inv H4. eapply eval_Eunop; eauto with cshm.
+  rewrite H0 in H4. inv H4. eauto with cshm.
+Qed.
+
+Lemma make_notbool_correct:
+  forall a tya c va v e le m,
+  sem_notbool va tya = Some v ->
+  make_notbool a tya = OK c ->  
+  eval_expr ge e le m a va ->
+  eval_expr ge e le m c v.
+Proof.
+  intros until m; intro SEM. unfold make_notbool. 
+  functional inversion SEM; intros; rewrite H0 in H4; inversion H4; simpl;
+  eauto with cshm.
+Qed.
+
+Lemma make_notint_correct:
+  forall a tya c va v e le m,
+  sem_notint va tya = Some v ->
+  make_notint a tya = c ->  
+  eval_expr ge e le m a va ->
+  eval_expr ge e le m c v.
+Proof.
+  intros until m; intro SEM. unfold make_notint. 
+  functional inversion SEM; intros. subst. eauto with cshm. 
+Qed.
+
+Definition binary_constructor_correct
+    (make: expr -> type -> expr -> type -> res expr)
+    (sem: val -> type -> val -> type -> option val): Prop :=
+  forall a tya b tyb c va vb v e le m,
+  sem va tya vb tyb = Some v ->
+  make a tya b tyb = OK c ->  
+  eval_expr ge e le m a va ->
+  eval_expr ge e le m b vb ->
+  eval_expr ge e le m c v.
+
+(*
+Definition binary_constructor_correct'
+    (make: expr -> type -> expr -> type -> res expr)
+    (sem: val -> val -> option val): Prop :=
+  forall a tya b tyb c va vb v e le m,
+  sem va vb = Some v ->
+  make a tya b tyb = OK c ->  
+  eval_expr ge e le m a va ->
+  eval_expr ge e le m b vb ->
+  eval_expr ge e le m c v.
+*)
+
+Lemma make_add_correct: binary_constructor_correct make_add sem_add.
+Proof.
+  red; intros until m. intro SEM. unfold make_add. 
+  functional inversion SEM; rewrite H0; intros;
+  inversion H7; eauto with cshm. 
+  eapply eval_Ebinop. eauto. 
+  eapply eval_Ebinop. eauto with cshm. eauto.
+  simpl. reflexivity. reflexivity. 
+  eapply eval_Ebinop. eauto. 
+  eapply eval_Ebinop. eauto with cshm. eauto. 
+  simpl. reflexivity. simpl. reflexivity.
+Qed.
+
+Lemma make_sub_correct: binary_constructor_correct make_sub sem_sub.
+Proof.
+  red; intros until m. intro SEM. unfold make_sub. 
+  functional inversion SEM; rewrite H0; intros;
+  inversion H7; eauto with cshm. 
+  eapply eval_Ebinop. eauto. 
+  eapply eval_Ebinop. eauto with cshm. eauto.
+  simpl. reflexivity. reflexivity. 
+  inversion H9. eapply eval_Ebinop. 
+  eapply eval_Ebinop; eauto. 
+  simpl. unfold eq_block; rewrite H3. reflexivity.
+  eauto with cshm. simpl. rewrite H8. reflexivity.
+Qed.
+
+Lemma make_mul_correct: binary_constructor_correct make_mul sem_mul.
+Proof.
+  red; intros until m. intro SEM. unfold make_mul. 
+  functional inversion SEM; rewrite H0; intros;
+  inversion H7; eauto with cshm. 
+Qed.
+
+Lemma make_div_correct: binary_constructor_correct make_div sem_div.
+Proof.
+  red; intros until m. intro SEM. unfold make_div. 
+  functional inversion SEM; rewrite H0; intros.
+  inversion H8. eapply eval_Ebinop; eauto with cshm. 
+  simpl. rewrite H7; auto.
+  inversion H8. eapply eval_Ebinop; eauto with cshm. 
+  simpl. rewrite H7; auto.
+  inversion H7; eauto with cshm. 
+  inversion H7; eauto with cshm. 
+  inversion H7; eauto with cshm. 
+Qed.
+
+Lemma make_mod_correct: binary_constructor_correct make_mod sem_mod.
+  red; intros until m. intro SEM. unfold make_mod. 
+  functional inversion SEM; rewrite H0; intros.
+  inversion H8. eapply eval_Ebinop; eauto with cshm. 
+  simpl. rewrite H7; auto.
+  inversion H8. eapply eval_Ebinop; eauto with cshm. 
+  simpl. rewrite H7; auto.
+Qed.
+
+Lemma make_and_correct: binary_constructor_correct make_and sem_and.
+Proof.
+  red; intros until m. intro SEM. unfold make_and. 
+  functional inversion SEM. intros. inversion H7. 
+  eauto with cshm. 
+Qed.
+
+Lemma make_or_correct: binary_constructor_correct make_or sem_or.
+Proof.
+  red; intros until m. intro SEM. unfold make_or. 
+  functional inversion SEM. intros. inversion H7. 
+  eauto with cshm. 
+Qed.
+
+Lemma make_xor_correct: binary_constructor_correct make_xor sem_xor.
+Proof.
+  red; intros until m. intro SEM. unfold make_xor. 
+  functional inversion SEM. intros. inversion H7. 
+  eauto with cshm. 
+Qed.
+
+Lemma make_shl_correct: binary_constructor_correct make_shl sem_shl.
+Proof.
+  red; intros until m. intro SEM. unfold make_shl. 
+  functional inversion SEM. intros. inversion H8. 
+  eapply eval_Ebinop; eauto with cshm. 
+  simpl. rewrite H7. auto.
+Qed.
+
+Lemma make_shr_correct: binary_constructor_correct make_shr sem_shr.
+Proof.
+  red; intros until m. intro SEM. unfold make_shr. 
+  functional inversion SEM; intros; rewrite H0 in H8; inversion H8.
+  eapply eval_Ebinop; eauto with cshm.
+  simpl; rewrite H7; auto.
+  eapply eval_Ebinop; eauto with cshm.
+  simpl; rewrite H7; auto.
+Qed.
+
+Lemma make_cmp_correct:
+  forall cmp a tya b tyb c va vb v e le m,
+  sem_cmp cmp va tya vb tyb m = Some v ->
+  make_cmp cmp a tya b tyb = OK c ->  
+  eval_expr ge e le m a va ->
+  eval_expr ge e le m b vb ->
+  eval_expr ge e le m c v.
+Proof.
+  intros until m. intro SEM. unfold make_cmp.
+  functional inversion SEM; rewrite H0; intros.
+  (* iiu *) 
+  inversion H8. eauto with cshm.
+  (* ipip int int *)
+  inversion H8. eauto with cshm.
+  (* ipip ptr ptr *)
+  inversion H10. eapply eval_Ebinop; eauto with cshm.
+  simpl. rewrite H3. unfold eq_block. rewrite H9. auto.
+  inversion H10. eapply eval_Ebinop; eauto with cshm.
+  simpl. rewrite H3. unfold eq_block. rewrite H9. auto.
+  (* ipip ptr int *)
+  inversion H9. eapply eval_Ebinop; eauto with cshm.
+  simpl. unfold eval_compare_null. rewrite H8. auto.
+  (* ipip int ptr *)
+  inversion H9. eapply eval_Ebinop; eauto with cshm.
+  simpl. unfold eval_compare_null. rewrite H8. auto.
+  (* ff *)
+  inversion H8. eauto with cshm.
+  (* if *)
+  inversion H8. eauto with cshm.
+  (* fi *)
+  inversion H8. eauto with cshm.
+Qed.
+
+Lemma transl_unop_correct:
+  forall op a tya c va v e le m, 
+  transl_unop op a tya = OK c ->
+  sem_unary_operation op va tya = Some v ->
+  eval_expr ge e le m a va ->
+  eval_expr ge e le m c v.
+Proof.
+  intros. destruct op; simpl in *.
+  eapply make_notbool_correct; eauto. 
+  eapply make_notint_correct with (tya := tya); eauto. congruence.
+  eapply make_neg_correct; eauto.
+Qed.
+
+Lemma transl_binop_correct:
+  forall op a tya b tyb c va vb v e le m,
+  transl_binop op a tya b tyb = OK c ->  
+  sem_binary_operation op va tya vb tyb m = Some v ->
+  eval_expr ge e le m a va ->
+  eval_expr ge e le m b vb ->
+  eval_expr ge e le m c v.
+Proof.
+  intros. destruct op; simpl in *.
+  eapply make_add_correct; eauto.
+  eapply make_sub_correct; eauto.
+  eapply make_mul_correct; eauto.
+  eapply make_div_correct; eauto.
+  eapply make_mod_correct; eauto.
+  eapply make_and_correct; eauto.
+  eapply make_or_correct; eauto.
+  eapply make_xor_correct; eauto.
+  eapply make_shl_correct; eauto.
+  eapply make_shr_correct; eauto.
+  eapply make_cmp_correct; eauto.
+  eapply make_cmp_correct; eauto.
+  eapply make_cmp_correct; eauto.
+  eapply make_cmp_correct; eauto.
+  eapply make_cmp_correct; eauto.
+  eapply make_cmp_correct; eauto.
+Qed. 
+
+Lemma make_cast_correct:
+  forall e le m a v ty1 ty2 v',
+   eval_expr ge e le m a v ->
+   cast v ty1 ty2 v' ->
+   eval_expr ge e le m (make_cast ty1 ty2 a) v'.
+Proof.
+  unfold make_cast, make_cast1, make_cast2.
+  intros until v'; intros EVAL CAST.
+  inversion CAST; clear CAST; subst.
+  (* cast_int_int *)
+    destruct sz2; destruct si2; repeat econstructor; eauto with cshm.
+  (* cast_float_int *)
+    destruct sz2; destruct si2; unfold make_intoffloat; repeat econstructor; eauto with cshm; simpl; auto.
+  (* cast_int_float *)
+    destruct sz2; destruct si1; unfold make_floatofint; repeat econstructor; eauto with cshm; simpl; auto.
+  (* cast_float_float *)
+    destruct sz2; repeat econstructor; eauto with cshm.
+  (* neutral, ptr *)
+   inversion H0; auto; inversion H; auto.
+  (* neutral, int *)
+   inversion H0; auto; inversion H; auto.
+Qed.
+
+Lemma make_load_correct:
+  forall addr ty code b ofs v e le m,
+  make_load addr ty = OK code ->
+  eval_expr ge e le m addr (Vptr b ofs) ->
+  load_value_of_type ty m b ofs = Some v ->
+  eval_expr ge e le m code v.
+Proof.
+  unfold make_load, load_value_of_type.
+  intros until m; intros MKLOAD EVEXP LDVAL.
+  destruct (access_mode ty); inversion MKLOAD.
+  (* access_mode ty = By_value m *)
+  apply eval_Eload with (Vptr b ofs); auto.
+  (* access_mode ty = By_reference *)
+  subst code. inversion LDVAL. auto.
+Qed.
+
+Lemma make_store_correct:
+  forall addr ty rhs code e le m b ofs v m' f k,
+  make_store addr ty rhs = OK code ->
+  eval_expr ge e le m addr (Vptr b ofs) ->
+  eval_expr ge e le m rhs v ->
+  store_value_of_type ty m b ofs v = Some m' ->
+  step ge (State f code k e le m) E0 (State f Sskip k e le m').
+Proof.
+  unfold make_store, store_value_of_type.
+  intros until k; intros MKSTORE EV1 EV2 STVAL.
+  destruct (access_mode ty); inversion MKSTORE.
+  (* access_mode ty = By_value m *)
+  eapply step_store; eauto. 
+Qed.
+
+End CONSTRUCTORS.
+
+(** * Basic preservation invariants *)
+
+Section CORRECTNESS.
+
+Variable prog: Clight.program.
+Variable tprog: Csharpminor.program.
+Hypothesis TRANSL: transl_program prog = OK tprog.
+
+Let ge := Genv.globalenv prog.
+Let tge := Genv.globalenv tprog.
+
+Lemma symbols_preserved:
+  forall s, Genv.find_symbol tge s = Genv.find_symbol ge s.
+Proof (Genv.find_symbol_transf_partial2 transl_fundef transl_globvar _ TRANSL).
+
+Lemma functions_translated:
+  forall v f,
+  Genv.find_funct ge v = Some f ->
+  exists tf, Genv.find_funct tge v = Some tf /\ transl_fundef f = OK tf.
+Proof (Genv.find_funct_transf_partial2 transl_fundef transl_globvar _ TRANSL).
+
+Lemma function_ptr_translated:
+  forall b f,
+  Genv.find_funct_ptr ge b = Some f ->
+  exists tf, Genv.find_funct_ptr tge b = Some tf /\ transl_fundef f = OK tf.
+Proof (Genv.find_funct_ptr_transf_partial2 transl_fundef transl_globvar _ TRANSL).
+
+Lemma var_info_translated:
+  forall b v,
+  Genv.find_var_info ge b = Some v ->
+  exists tv, Genv.find_var_info tge b = Some tv /\ transf_globvar transl_globvar v = OK tv.
+Proof (Genv.find_var_info_transf_partial2 transl_fundef transl_globvar _ TRANSL).
+
+(** * Matching between environments *)
+
+(** In this section, we define a matching relation between
+  a Clight local environment and a Csharpminor local environment. *)
+
+Record match_env (e: Clight.env) (te: Csharpminor.env) : Prop :=
+  mk_match_env {
+    me_local:
+      forall id b ty,
+      e!id = Some (b, ty) ->
+      exists vk, var_kind_of_type ty = OK vk /\ te!id = Some (b, vk);
+    me_local_inv:
+      forall id b vk,
+      te!id = Some (b, vk) -> exists ty, e!id = Some(b, ty)
+  }.
+
+Lemma match_env_globals:
+  forall e te id l ty,
+  match_env e te ->
+  e!id = None ->
+  Genv.find_symbol ge id = Some l ->
+  type_of_global ge l = Some ty ->
+  te!id = None /\
+  (forall chunk, access_mode ty = By_value chunk ->
+   exists gv, Genv.find_var_info tge l = Some gv /\ gvar_info gv = Vscalar chunk).
+Proof.
+  intros.
+  case_eq (te!id). intros [b' vk] EQ. 
+  exploit me_local_inv; eauto. intros [ty' EQ']. congruence.
+  intros. split; auto; intros.
+  revert H2; unfold type_of_global. 
+  case_eq (Genv.find_var_info ge l). intros. inv H5. 
+  exploit var_info_translated; eauto. intros [gv [A B]]. monadInv B. unfold transl_globvar in EQ. 
+  econstructor; split. eauto. simpl. 
+  exploit var_kind_by_value; eauto. congruence.
+  intros. destruct (Genv.find_funct_ptr ge l); intros; inv H5. 
+  destruct f; simpl in H4; discriminate.
+Qed.
+
+Lemma match_env_same_blocks:
+  forall e te,
+  match_env e te ->
+  blocks_of_env te = Csem.blocks_of_env e.
+Proof.
+  intros.
+  set (R := fun (x: (block * type)) (y: (block * var_kind)) =>
+         match x, y with
+         | (b1, ty), (b2, vk) => b2 = b1 /\ var_kind_of_type ty = OK vk
+         end).
+  assert (list_forall2 
+            (fun i_x i_y => fst i_x = fst i_y /\ R (snd i_x) (snd i_y))
+            (PTree.elements e) (PTree.elements te)).
+  apply PTree.elements_canonical_order.
+  intros id [b ty] GET. exploit me_local; eauto. intros [vk [A B]].
+  exists (b, vk); split; auto. red. auto.
+  intros id [b vk] GET. 
+  exploit me_local_inv; eauto. intros [ty A]. 
+  exploit me_local; eauto. intros [vk' [B C]]. 
+  assert (vk' = vk) by congruence. subst vk'.
+  exists (b, ty); split; auto. red. auto.
+
+  unfold blocks_of_env, Csem.blocks_of_env.
+  generalize H0. induction 1. auto. 
+  simpl. f_equal; auto.
+  unfold block_of_binding, Csem.block_of_binding. 
+  destruct a1 as [id1 [blk1 ty1]]. destruct b1 as [id2 [blk2 vk2]].
+  simpl in *. destruct H1 as [A [B C]]. subst blk2 id2. f_equal.
+  apply sizeof_var_kind_of_type. auto. 
+Qed.
+
+Lemma match_env_free_blocks:
+  forall e te m m',
+  match_env e te ->
+  Mem.free_list m (Csem.blocks_of_env e) = Some m' ->
+  Mem.free_list m (blocks_of_env te) = Some m'.
+Proof.
+  intros. rewrite (match_env_same_blocks _ _ H). auto.
+Qed.
+
+Lemma match_env_empty:
+  match_env Clight.empty_env Csharpminor.empty_env.
+Proof.
+  unfold Clight.empty_env, Csharpminor.empty_env.
+  constructor.
+  intros until b. repeat rewrite PTree.gempty. congruence.
+  intros until vk. rewrite PTree.gempty. congruence.
+Qed.
+
+(** The following lemmas establish the [match_env] invariant at
+  the beginning of a function invocation, after allocation of
+  local variables and initialization of the parameters. *)
+
+Lemma match_env_alloc_variables:
+  forall e1 m1 vars e2 m2,
+  Csem.alloc_variables e1 m1 vars e2 m2 ->
+  forall te1 tvars,
+  match_env e1 te1 ->
+  transl_vars vars = OK tvars ->
+  exists te2,
+  Csharpminor.alloc_variables te1 m1 tvars te2 m2
+  /\ match_env e2 te2.
+Proof.
+  induction 1; intros.
+  monadInv H0. 
+  exists te1; split. constructor. auto.
+  generalize H2. simpl. 
+  caseEq (var_kind_of_type ty); simpl; [intros vk VK | congruence].
+  caseEq (transl_vars vars); simpl; [intros tvrs TVARS | congruence].
+  intro EQ; inversion EQ; subst tvars; clear EQ.
+  set (te2 := PTree.set id (b1, vk) te1).
+  assert (match_env (PTree.set id (b1, ty) e) te2).
+    inversion H1. unfold te2. constructor.
+    (* me_local *)
+    intros until ty0. simpl. repeat rewrite PTree.gsspec.
+    destruct (peq id0 id); intros.
+    inv H3. exists vk; intuition.
+    auto.
+    (* me_local_inv *)
+    intros until vk0. repeat rewrite PTree.gsspec. 
+    destruct (peq id0 id); intros. exists ty; congruence. eauto. 
+  destruct (IHalloc_variables _ _ H3 TVARS) as [te3 [ALLOC MENV]]. 
+  exists te3; split.
+  econstructor; eauto.
+  rewrite (sizeof_var_kind_of_type _ _ VK). eauto. 
+  auto. 
+Qed. 
+
+Lemma bind_parameters_match:
+  forall e m1 vars vals m2,
+  Csem.bind_parameters e m1 vars vals m2 ->
+  forall te tvars,
+  val_casted_list vals (type_of_params vars) ->
+  match_env e te ->
+  transl_params vars = OK tvars ->
+  Csharpminor.bind_parameters te m1 tvars vals m2.
+Proof.
+  induction 1; intros.
+(* base case *)
+  monadInv H1. constructor.
+(* inductive case *)
+  simpl in H2. destruct H2.
+  revert H4; simpl.
+  caseEq (chunk_of_type ty); simpl; [intros chunk CHK | congruence].
+  caseEq (transl_params params); simpl; [intros tparams TPARAMS | congruence].
+  intro EQ; inversion EQ; clear EQ; subst tvars.
+  generalize CHK. unfold chunk_of_type. 
+  caseEq (access_mode ty); intros; try discriminate.
+  inversion CHK0; clear CHK0; subst m0.
+  unfold store_value_of_type in H0. rewrite H4 in H0.
+  apply bind_parameters_cons with b m1. 
+  exploit me_local; eauto. intros [vk [A B]].
+  exploit var_kind_by_value; eauto. congruence.
+  eapply val_casted_normalized; eauto.
+  assumption.
+  apply IHbind_parameters; auto.
+Qed.
+
+(* ** Correctness of variable accessors *)
+
+(** Correctness of the code generated by [var_get]. *)
+
+Lemma var_get_correct:
+  forall e le m id ty loc ofs v code te,
+  Clight.eval_lvalue ge e le m (Clight.Evar id ty) loc ofs ->
+  load_value_of_type ty m loc ofs = Some v ->
+  var_get id ty = OK code ->
+  match_env e te ->
+  eval_expr tge te le m code v.
+Proof.
+  intros. revert H0 H1. unfold load_value_of_type, var_get. 
+  case_eq (access_mode ty).
+  (* access mode By_value *)
+  intros chunk ACC LOAD EQ. inv EQ.
+  inv H.
+    (* local variable *)
+    exploit me_local; eauto. intros [vk [A B]].
+    assert (vk = Vscalar chunk).
+    exploit var_kind_by_value; eauto. congruence.
+    subst vk.
+    eapply eval_Evar. 
+    eapply eval_var_ref_local. eauto. assumption. 
+    (* global variable *)
+    exploit match_env_globals; eauto. intros [A B].
+    exploit B; eauto. intros [gv [C D]].
+    eapply eval_Evar. 
+    eapply eval_var_ref_global. auto.
+    rewrite symbols_preserved. eauto.
+    eauto. eauto. 
+    assumption. 
+  (* access mode By_reference *)
+  intros ACC EQ1 EQ2. inv EQ1; inv EQ2; inv H.
+    (* local variable *)
+    exploit me_local; eauto. intros [vk [A B]].
+    eapply eval_Eaddrof.
+    eapply eval_var_addr_local. eauto. 
+    (* global variable *)
+    exploit match_env_globals; eauto. intros [A B].
+    eapply eval_Eaddrof.
+    eapply eval_var_addr_global. auto. 
+    rewrite symbols_preserved. eauto.
+  (* access mode By_nothing *)
+  congruence.
+Qed.
+
+(** Correctness of the code generated by [var_set]. *)
+
+Lemma var_set_correct:
+  forall e le m id ty loc ofs v m' code te rhs f k, 
+  Clight.eval_lvalue ge e le m (Clight.Evar id ty) loc ofs ->
+  val_casted v ty ->
+  store_value_of_type ty m loc ofs v = Some m' ->
+  var_set id ty rhs = OK code ->
+  match_env e te ->
+  eval_expr tge te le m rhs v ->
+  step tge (State f code k te le m) E0 (State f Sskip k te le m').
+Proof.
+  intros. revert H1 H2. unfold store_value_of_type, var_set.
+  caseEq (access_mode ty).
+  (* access mode By_value *)
+  intros chunk ACC STORE EQ. inv EQ. 
+  inv H.
+    (* local variable *)
+    exploit me_local; eauto. intros [vk [A B]].
+    assert (vk = Vscalar chunk).
+      exploit var_kind_by_value; eauto. congruence.
+    subst vk.
+    eapply step_assign. eauto.
+    econstructor. eapply eval_var_ref_local. eauto.
+    eapply val_casted_normalized; eauto. assumption. 
+    (* global variable *)
+    exploit match_env_globals; eauto. intros [A B].
+    exploit B; eauto. intros [gv [C D]].
+    eapply step_assign. eauto.
+    econstructor. eapply eval_var_ref_global. auto.
+    rewrite symbols_preserved. eauto.
+    eauto. eauto.
+    eapply val_casted_normalized; eauto. assumption. 
+  (* access mode By_reference *)
+  congruence.
+  (* access mode By_nothing *)
+  congruence.
+Qed.
+
+(****************************
+Lemma call_dest_correct:
+  forall e m lhs loc ofs optid te,
+  Csem.eval_lvalue ge e m lhs loc ofs ->
+  transl_lhs_call (Some lhs) = OK optid ->
+  match_env e te ->
+  exists id,
+     optid = Some id
+  /\ ofs = Int.zero
+  /\ match access_mode (typeof lhs) with
+     | By_value chunk => eval_var_ref tge te id loc chunk
+     | _ => True
+     end.
+Proof.
+  intros. revert H0. simpl. caseEq (is_variable lhs); try congruence.
+  intros id ISV EQ. inv EQ. 
+  exploit is_variable_correct; eauto. intro EQ.
+  rewrite EQ in H. clear EQ.
+  exists id. split; auto.
+  inv H.
+(* local variable *)
+  split. auto. 
+  exploit me_local; eauto. intros [vk [A B]].
+  case_eq (access_mode (typeof lhs)); intros; auto.
+  assert (vk = Vscalar m0).
+    exploit var_kind_by_value; eauto. congruence.
+  subst vk. apply eval_var_ref_local; auto.
+(* global variable *)
+  split. auto.
+  exploit match_env_globals; eauto. intros [A B].
+  case_eq (access_mode (typeof lhs)); intros; auto.
+  exploit B; eauto. intros [gv [C D]].
+  eapply eval_var_ref_global; eauto.
+  rewrite symbols_preserved. auto.
+Qed.
+
+Lemma set_call_dest_correct:
+  forall ty m loc v m' e te id,
+  store_value_of_type ty m loc Int.zero v = Some m' ->
+  match access_mode ty with
+  | By_value chunk => eval_var_ref tge te id loc chunk
+  | _ => True
+  end ->
+  match_env e te ->
+  exec_opt_assign tge te m (Some id) v m'.
+Proof.
+  intros. generalize H. unfold store_value_of_type. case_eq (access_mode ty); intros; try congruence.
+  rewrite H2 in H0. 
+  constructor. econstructor. eauto. auto.
+Qed.
+**************************)
+
+(** * Proof of semantic preservation *)
+
+(** ** Semantic preservation for expressions *)
+
+(** The proof of semantic preservation for the translation of expressions
+  relies on simulation diagrams of the following form:
+<<
+         e, le, m, a ------------------- te, le, m, ta
+            |                                |
+            |                                |
+            |                                |
+            v                                v
+         e, le, m, v ------------------- te, le, m, v
+>>
+  Left: evaluation of r-value expression [a] in Clight.
+  Right: evaluation of its translation [ta] in Csharpminor.
+  Top (precondition): matching between environments [e], [te], 
+    plus well-typedness of expression [a].
+  Bottom (postcondition): the result values [v] 
+    are identical in both evaluations.
+
+  We state these diagrams as the following properties, parameterized
+  by the Clight evaluation. *)
+
+Section EXPR.
+
+Variable e: Clight.env.
+Variable le: temp_env.
+Variable m: mem.
+Variable te: Csharpminor.env.
+Hypothesis MENV: match_env e te.
+
+Lemma transl_expr_lvalue_correct:
+  (forall a v,
+   Clight.eval_expr ge e le m a v ->
+   forall ta (TR: transl_expr a = OK ta) ,
+   Csharpminor.eval_expr tge te le m ta v)
+/\(forall a b ofs,
+   Clight.eval_lvalue ge e le m a b ofs ->
+   forall ta (TR: transl_lvalue a = OK ta),
+   Csharpminor.eval_expr tge te le m ta (Vptr b ofs)).
+Proof.
+  apply eval_expr_lvalue_ind; intros; try (monadInv TR).
+(* const int *)
+  apply make_intconst_correct.
+(* const float *)
+  apply make_floatconst_correct.
+(* temp var *)
+  constructor; auto.
+(* addrof *)
+  simpl in TR. auto. 
+(* sizeof *)
+  constructor; auto.
+(* unop *)
+  eapply transl_unop_correct; eauto.
+(* binop *)
+  eapply transl_binop_correct; eauto.
+(* condition true *)
+  exploit make_boolean_correct_true. eapply H0; eauto. eauto.
+  intros [vb [EVAL ISTRUE]].
+  eapply eval_Econdition; eauto. apply Val.bool_of_true_val; eauto.
+  simpl. eauto. 
+(* condition false *)
+  exploit make_boolean_correct_false. eapply H0; eauto. eauto.
+  intros [vb [EVAL ISFALSE]].
+  eapply eval_Econdition; eauto. apply Val.bool_of_false_val; eauto.
+  simpl. eauto.
+(* cast *)
+  eapply make_cast_correct; eauto.
+(* rvalue out of lvalue *)
+  exploit transl_expr_lvalue; eauto. 
+  intros [[id [ty [EQ VARGET]]] | [tb [TRLVAL MKLOAD]]].
+  (* Case a is a variable *)
+  subst a. eapply var_get_correct; eauto.
+  (* Case a is another lvalue *)
+  eapply make_load_correct; eauto.
+(* var local *)
+  exploit (me_local _ _ MENV); eauto.
+  intros [vk [A B]].
+  econstructor. eapply eval_var_addr_local. eauto.
+(* var global *)
+  exploit match_env_globals; eauto. intros [A B].
+  econstructor. eapply eval_var_addr_global. eauto. 
+  rewrite symbols_preserved. auto.
+(* deref *)
+  simpl in TR. eauto. 
+(* field struct *)
+  simpl in TR. rewrite H1 in TR. monadInv TR.
+  eapply eval_Ebinop; eauto.
+  apply make_intconst_correct. 
+  simpl. congruence.
+(* field union *)
+  simpl in TR. rewrite H1 in TR. eauto.
+Qed.
+
+Lemma transl_expr_correct:
+   forall a v,
+   Clight.eval_expr ge e le m a v ->
+   forall ta, transl_expr a = OK ta ->
+   Csharpminor.eval_expr tge te le m ta v.
+Proof (proj1 transl_expr_lvalue_correct).
+
+Lemma transl_lvalue_correct:
+   forall a b ofs,
+   Clight.eval_lvalue ge e le m a b ofs ->
+   forall ta, transl_lvalue a = OK ta ->
+   Csharpminor.eval_expr tge te le m ta (Vptr b ofs).
+Proof (proj2 transl_expr_lvalue_correct).
+
+Lemma transl_exprlist_correct:
+  forall al tyl vl,
+  Clight.eval_exprlist ge e le m al tyl vl ->
+  forall tal, transl_exprlist al tyl = OK tal ->
+  Csharpminor.eval_exprlist tge te le m tal vl.
+Proof.
+  induction 1; intros.
+  monadInv H. constructor.
+  monadInv H2. constructor. 
+  eapply make_cast_correct. eapply transl_expr_correct; eauto. auto. 
+  eauto.
+Qed.
+
+End EXPR.
+
+Lemma exit_if_false_true:
+  forall a ts e le m v te f tk,
+  exit_if_false a = OK ts ->
+  Clight.eval_expr ge e le m a v ->
+  is_true v (typeof a) ->
+  match_env e te ->
+  step tge (State f ts tk te le m) E0 (State f Sskip tk te le m).
+Proof.
+  intros. monadInv H.
+  exploit make_boolean_correct_true.
+    eapply (transl_expr_correct _ _ _ _ H2 _ _ H0); eauto.
+    eauto.
+  intros [vb [EVAL ISTRUE]].
+  change Sskip with (if true then Sskip else Sexit 0).
+  eapply step_ifthenelse; eauto. 
+  apply Val.bool_of_true_val; eauto.  
+Qed.
+ 
+Lemma exit_if_false_false:
+  forall a ts e le m v te f tk,
+  exit_if_false a = OK ts ->
+  Clight.eval_expr ge e le m a v ->
+  is_false v (typeof a) ->
+  match_env e te ->
+  step tge (State f ts tk te le m) E0 (State f (Sexit 0) tk te le m).
+Proof.
+  intros. monadInv H.
+  exploit make_boolean_correct_false.
+    eapply (transl_expr_correct _ _ _ _ H2 _ _ H0); eauto.
+    eauto.
+  intros [vb [EVAL ISFALSE]].
+  change (Sexit 0) with (if false then Sskip else Sexit 0).
+  eapply step_ifthenelse; eauto. 
+  apply Val.bool_of_false_val; eauto. 
+Qed.
+
+(** ** Semantic preservation for statements *)
+
+(** The simulation diagram for the translation of statements and functions
+  is a "plus" diagram of the form
+<<
+           I
+     S1 ------- R1
+     |          | 
+   t |        + | t
+     v          v  
+     S2 ------- R2
+           I                         I
+>>
+
+The invariant [I] is the [match_states] predicate that we now define.
+*)
+
+Inductive match_transl: stmt -> cont -> stmt -> cont -> Prop :=
+  | match_transl_0: forall ts tk,
+      match_transl ts tk ts tk
+  | match_transl_1: forall ts tk,
+      match_transl (Sblock ts) tk ts (Kblock tk).
+
+Lemma match_transl_step:
+  forall ts tk ts' tk' f te le m,
+  match_transl (Sblock ts) tk ts' tk' ->
+  star step tge (State f ts' tk' te le m) E0 (State f ts (Kblock tk) te le m).
+Proof.
+  intros. inv H. 
+  apply star_one. constructor. 
+  apply star_refl.
+Qed.
+
+Inductive match_cont: type -> nat -> nat -> Clight.cont -> Csharpminor.cont -> Prop :=
+  | match_Kstop: forall tyret nbrk ncnt,
+      match_cont tyret nbrk ncnt Clight.Kstop Kstop
+  | match_Kseq: forall tyret nbrk ncnt s k ts tk,
+      transl_statement tyret nbrk ncnt s = OK ts ->
+      match_cont tyret nbrk ncnt k tk ->
+      match_cont tyret nbrk ncnt
+                 (Clight.Kseq s k)
+                 (Kseq ts tk)
+  | match_Kwhile: forall tyret nbrk ncnt a s k ta ts tk,
+      exit_if_false a = OK ta ->
+      transl_statement tyret 1%nat 0%nat s = OK ts ->
+      match_cont tyret nbrk ncnt k tk ->
+      match_cont tyret 1%nat 0%nat
+                 (Clight.Kwhile a s k) 
+                 (Kblock (Kseq (Sloop (Sseq ta (Sblock ts))) (Kblock tk)))
+  | match_Kdowhile: forall tyret nbrk ncnt a s k ta ts tk,
+      exit_if_false a = OK ta ->
+      transl_statement tyret 1%nat 0%nat s = OK ts ->
+      match_cont tyret nbrk ncnt k tk ->
+      match_cont tyret 1%nat 0%nat
+                 (Clight.Kdowhile a s k) 
+                 (Kblock (Kseq ta (Kseq (Sloop (Sseq (Sblock ts) ta)) (Kblock tk))))
+  | match_Kfor2: forall tyret nbrk ncnt a2 a3 s k ta2 ta3 ts tk,
+      exit_if_false a2 = OK ta2 ->
+      transl_statement tyret 0%nat (S ncnt) a3 = OK ta3 ->
+      transl_statement tyret 1%nat 0%nat s = OK ts ->
+      match_cont tyret nbrk ncnt k tk ->
+      match_cont tyret 1%nat 0%nat
+                 (Clight.Kfor2 a2 a3 s k)
+                 (Kblock (Kseq ta3 (Kseq (Sloop (Sseq ta2 (Sseq (Sblock ts) ta3))) (Kblock tk))))
+  | match_Kfor3: forall tyret nbrk ncnt a2 a3 s k ta2 ta3 ts tk,
+      exit_if_false a2 = OK ta2 ->
+      transl_statement tyret 0%nat (S ncnt) a3 = OK ta3 ->
+      transl_statement tyret 1%nat 0%nat s = OK ts ->
+      match_cont tyret nbrk ncnt k tk ->
+      match_cont tyret 0%nat (S ncnt)
+                 (Clight.Kfor3 a2 a3 s k)
+                 (Kseq (Sloop (Sseq ta2 (Sseq (Sblock ts) ta3))) (Kblock tk))
+  | match_Kswitch: forall tyret nbrk ncnt k tk,
+      match_cont tyret nbrk ncnt k tk ->
+      match_cont tyret 0%nat (S ncnt)
+                 (Clight.Kswitch k)
+                 (Kblock tk)
+  | match_Kcall_some: forall tyret nbrk ncnt nbrk' ncnt' f e k id tf te le tk,
+      transl_function f = OK tf ->
+      match_env e te ->
+      match_cont (Clight.fn_return f) nbrk' ncnt' k tk ->
+      match_cont tyret nbrk ncnt 
+                 (Clight.Kcall id f e le k)
+                 (Kcall id tf te le tk).
+
+Inductive match_states: Clight.state -> Csharpminor.state -> Prop :=
+  | match_state:
+      forall f nbrk ncnt s k e le m tf ts tk te ts' tk'
+          (TRF: transl_function f = OK tf)
+          (TR: transl_statement (Clight.fn_return f) nbrk ncnt s = OK ts)
+          (MTR: match_transl ts tk ts' tk')
+          (MENV: match_env e te)
+          (MK: match_cont (Clight.fn_return f) nbrk ncnt k tk),
+      match_states (Clight.State f s k e le m)
+                   (State tf ts' tk' te le m)
+  | match_callstate:
+      forall fd args k m tfd tk targs tres
+          (TR: transl_fundef fd = OK tfd)
+          (MK: match_cont Tvoid 0%nat 0%nat k tk)
+          (ISCC: Clight.is_call_cont k)
+          (TY: type_of_fundef fd = Tfunction targs tres)
+          (VCAST: val_casted_list args targs),
+      match_states (Clight.Callstate fd args k m)
+                   (Callstate tfd args tk m)
+  | match_returnstate:
+      forall res k m tk 
+          (MK: match_cont Tvoid 0%nat 0%nat k tk),
+      match_states (Clight.Returnstate res k m)
+                   (Returnstate res tk m).
+
+Remark match_states_skip:
+  forall f e le te nbrk ncnt k tf tk m,
+  transl_function f = OK tf ->
+  match_env e te ->
+  match_cont (Clight.fn_return f) nbrk ncnt k tk ->
+  match_states (Clight.State f Clight.Sskip k e le m) (State tf Sskip tk te le m).
+Proof.
+  intros. econstructor; eauto. simpl; reflexivity. constructor. 
+Qed.
+
+(** Commutation between label resolution and compilation *)
+
+Section FIND_LABEL.
+Variable lbl: label.
+Variable tyret: type.
+
+Remark exit_if_false_no_label:
+  forall a s, exit_if_false a = OK s -> forall k, find_label lbl s k = None.
+Proof.
+  intros. unfold exit_if_false in H. monadInv H. simpl. auto.
+Qed.
+  
+Lemma transl_find_label:
+  forall s nbrk ncnt k ts tk
+  (TR: transl_statement tyret nbrk ncnt s = OK ts)
+  (MC: match_cont tyret nbrk ncnt k tk),
+  match Clight.find_label lbl s k with
+  | None => find_label lbl ts tk = None
+  | Some (s', k') =>
+      exists ts', exists tk', exists nbrk', exists ncnt',
+      find_label lbl ts tk = Some (ts', tk')
+      /\ transl_statement tyret nbrk' ncnt' s' = OK ts'
+      /\ match_cont tyret nbrk' ncnt' k' tk'
+  end
+
+with transl_find_label_ls:
+  forall ls nbrk ncnt k tls tk
+  (TR: transl_lbl_stmt tyret nbrk ncnt ls = OK tls)
+  (MC: match_cont tyret nbrk ncnt k tk),
+  match Clight.find_label_ls lbl ls k with
+  | None => find_label_ls lbl tls tk = None
+  | Some (s', k') =>
+      exists ts', exists tk', exists nbrk', exists ncnt',
+      find_label_ls lbl tls tk = Some (ts', tk')
+      /\ transl_statement tyret nbrk' ncnt' s' = OK ts'
+      /\ match_cont tyret nbrk' ncnt' k' tk'
+  end.
+
+Proof.
+  intro s; case s; intros; try (monadInv TR); simpl.
+(* skip *)
+  auto.
+(* assign *)
+  simpl in TR. destruct (is_variable e); monadInv TR.
+  unfold var_set in EQ0. destruct (access_mode (typeof e)); inv EQ0. auto.
+  unfold make_store in EQ2. destruct (access_mode (typeof e)); inv EQ2. auto.
+(* set *)
+  auto.
+(* call *)
+  simpl in TR. destruct (classify_fun (typeof e)); monadInv TR. auto.
+(* seq *)
+  exploit (transl_find_label s0 nbrk ncnt (Clight.Kseq s1 k)); eauto. constructor; eauto. 
+  destruct (Clight.find_label lbl s0 (Clight.Kseq s1 k)) as [[s' k'] | ].
+  intros [ts' [tk' [nbrk' [ncnt' [A [B C]]]]]].
+  rewrite A. exists ts'; exists tk'; exists nbrk'; exists ncnt'; auto.
+  intro. rewrite H. eapply transl_find_label; eauto.
+(* ifthenelse *)
+  exploit (transl_find_label s0); eauto. 
+  destruct (Clight.find_label lbl s0 k) as [[s' k'] | ].
+  intros [ts' [tk' [nbrk' [ncnt' [A [B C]]]]]].
+  rewrite A. exists ts'; exists tk'; exists nbrk'; exists ncnt'; auto.
+  intro. rewrite H. eapply transl_find_label; eauto.
+(* while *)
+  rewrite (exit_if_false_no_label _ _ EQ).
+  eapply transl_find_label; eauto. econstructor; eauto.
+(* dowhile *)
+  exploit (transl_find_label s0 1%nat 0%nat (Clight.Kdowhile e s0 k)); eauto. econstructor; eauto.
+  destruct (Clight.find_label lbl s0 (Kdowhile e s0 k)) as [[s' k'] | ].
+  intros [ts' [tk' [nbrk' [ncnt' [A [B C]]]]]].
+  rewrite A. exists ts'; exists tk'; exists nbrk'; exists ncnt'; auto.
+  intro. rewrite H. eapply exit_if_false_no_label; eauto.
+(* for *)
+  rewrite (exit_if_false_no_label _ _ EQ). 
+  exploit (transl_find_label s1 1%nat 0%nat (Kfor2 e s0 s1 k)); eauto. econstructor; eauto.
+  destruct (Clight.find_label lbl s1 (Kfor2 e s0 s1 k)) as [[s' k'] | ].
+  intros [ts' [tk' [nbrk' [ncnt' [A [B C]]]]]].
+  rewrite A. exists ts'; exists tk'; exists nbrk'; exists ncnt'; auto.
+  intro. rewrite H.
+  eapply transl_find_label; eauto. econstructor; eauto.
+(* break *)
+  auto.
+(* continue *)
+  auto.
+(* return *)
+  simpl in TR. destruct o; monadInv TR. auto. auto. 
+(* switch *)
+  eapply transl_find_label_ls with (k := Clight.Kswitch k); eauto. econstructor; eauto. 
+(* label *)
+  destruct (ident_eq lbl l). 
+  exists x; exists tk; exists nbrk; exists ncnt; auto.
+  eapply transl_find_label; eauto.
+(* goto *)
+  auto.
+
+  intro ls; case ls; intros; monadInv TR; simpl.
+(* default *)
+  eapply transl_find_label; eauto.
+(* case *)
+  exploit (transl_find_label s nbrk ncnt (Clight.Kseq (seq_of_labeled_statement l) k)); eauto. 
+  econstructor; eauto. apply transl_lbl_stmt_2; eauto.
+  destruct (Clight.find_label lbl s (Clight.Kseq (seq_of_labeled_statement l) k)) as [[s' k'] | ].
+  intros [ts' [tk' [nbrk' [ncnt' [A [B C]]]]]].
+  rewrite A. exists ts'; exists tk'; exists nbrk'; exists ncnt'; auto.
+  intro. rewrite H.
+  eapply transl_find_label_ls; eauto.
+Qed.
+
+End FIND_LABEL.
+
+(** Properties of call continuations *)
+
+Lemma match_cont_call_cont:
+  forall tyret' nbrk' ncnt' tyret nbrk ncnt k tk,
+  match_cont tyret nbrk ncnt k tk ->
+  match_cont tyret' nbrk' ncnt' (Clight.call_cont k) (call_cont tk).
+Proof.
+  induction 1; simpl; auto.
+  constructor.
+  econstructor; eauto. 
+Qed.
+
+Lemma match_cont_is_call_cont:
+  forall tyret nbrk ncnt k tk tyret' nbrk' ncnt',
+  match_cont tyret nbrk ncnt k tk ->
+  Clight.is_call_cont k ->
+  match_cont tyret' nbrk' ncnt' k tk /\ is_call_cont tk.
+Proof.
+  intros. inv H; simpl in H0; try contradiction; simpl.
+  split; auto; constructor.
+  split; auto; econstructor; eauto.
+Qed.
+
+(** The simulation proof *)
+
+Lemma transl_step:
+  forall S1 t S2, Clight.step ge S1 t S2 ->
+  forall T1, match_states S1 T1 ->
+  exists T2, plus step tge T1 t T2 /\ match_states S2 T2.
+Proof.
+  induction 1; intros T1 MST; inv MST.
+
+(* assign *)
+  revert TR. simpl. case_eq (is_variable a1); intros; monadInv TR. 
+  exploit is_variable_correct; eauto. intro EQ1. rewrite EQ1 in H.
+  assert (ts' = ts /\ tk' = tk).
+    inversion MTR. auto. 
+    subst ts. unfold var_set in EQ0. destruct (access_mode (typeof a1)); congruence.
+  destruct H4; subst ts' tk'.
+  econstructor; split.
+  apply plus_one. eapply var_set_correct; eauto. exists v2; exists (typeof a2); auto.
+  eapply make_cast_correct; eauto. eapply transl_expr_correct; eauto.
+  eapply match_states_skip; eauto.
+
+  assert (ts' = ts /\ tk' = tk).
+    inversion MTR. auto. 
+    subst ts. unfold make_store in EQ2. destruct (access_mode (typeof a1)); congruence.
+  destruct H4; subst ts' tk'.
+  econstructor; split.
+  apply plus_one. eapply make_store_correct; eauto.
+  exploit transl_lvalue_correct; eauto.
+  eapply make_cast_correct; eauto. eapply transl_expr_correct; eauto.
+  eapply match_states_skip; eauto.
+
+(* set *)
+  monadInv TR. inv MTR. econstructor; split.
+  apply plus_one. econstructor. eapply transl_expr_correct; eauto. 
+  eapply match_states_skip; eauto.
+
+(* call *)
+  revert TR. simpl. case_eq (classify_fun (typeof a)); try congruence.
+  intros targs tres CF TR. monadInv TR. inv MTR. 
+  exploit functions_translated; eauto. intros [tfd [FIND TFD]].
+  rewrite H in CF. simpl in CF. inv CF.
+  econstructor; split.
+  apply plus_one. econstructor; eauto. 
+  exploit transl_expr_correct; eauto.
+  exploit transl_exprlist_correct; eauto.
+  eapply transl_fundef_sig1; eauto.
+  rewrite H3. rewrite H. auto.
+  econstructor; eauto.  
+  econstructor; eauto.
+  simpl. auto.
+  rewrite H3; rewrite H; eauto. 
+  eapply eval_exprlist_casted; eauto. 
+
+(* seq *)
+  monadInv TR. inv MTR.
+  econstructor; split.
+  apply plus_one. constructor. 
+  econstructor; eauto. constructor. 
+  econstructor; eauto.
+
+(* skip seq *)
+  monadInv TR. inv MTR. inv MK.
+  econstructor; split.
+  apply plus_one. apply step_skip_seq. 
+  econstructor; eauto. constructor.
+
+(* continue seq *)
+  monadInv TR. inv MTR. inv MK.
+  econstructor; split.
+  apply plus_one. constructor. 
+  econstructor; eauto. simpl. reflexivity. constructor.
+
+(* break seq *)
+  monadInv TR. inv MTR. inv MK.
+  econstructor; split.
+  apply plus_one. constructor. 
+  econstructor; eauto. simpl. reflexivity. constructor.
+
+(* ifthenelse true *)
+  monadInv TR. inv MTR.
+  exploit make_boolean_correct_true; eauto. 
+  exploit transl_expr_correct; eauto.
+  intros [v [A B]].
+  econstructor; split.
+  apply plus_one. apply step_ifthenelse with (v := v) (b := true). 
+  auto. apply Val.bool_of_true_val. auto.
+  econstructor; eauto. constructor.
+
+(* ifthenelse false *)
+  monadInv TR. inv MTR.
+  exploit make_boolean_correct_false; eauto. 
+  exploit transl_expr_correct; eauto.
+  intros [v [A B]].
+  econstructor; split.
+  apply plus_one. apply step_ifthenelse with (v := v) (b := false). 
+  auto. apply Val.bool_of_false_val. auto.
+  econstructor; eauto. constructor.
+
+(* while false *)
+  monadInv TR.
+  econstructor; split.
+  eapply star_plus_trans. eapply match_transl_step; eauto. 
+  eapply plus_left. constructor. 
+  eapply star_left. constructor.
+  eapply star_left. eapply exit_if_false_false; eauto.
+  eapply star_left. constructor. 
+  eapply star_left. constructor.
+  apply star_one. constructor.
+  reflexivity. reflexivity. reflexivity. reflexivity. reflexivity. traceEq.
+  eapply match_states_skip; eauto.
+
+(* while true *)
+  monadInv TR.
+  econstructor; split.
+  eapply star_plus_trans. eapply match_transl_step; eauto. 
+  eapply plus_left. constructor.
+  eapply star_left. constructor.
+  eapply star_left. eapply exit_if_false_true; eauto.
+  eapply star_left. constructor.
+  apply star_one. constructor.
+  reflexivity. reflexivity. reflexivity. reflexivity. traceEq.
+  econstructor; eauto. constructor. 
+  econstructor; eauto.
+
+(* skip or continue while *)
+  assert ((ts' = Sskip \/ ts' = Sexit ncnt) /\ tk' = tk).
+    destruct H; subst x; monadInv TR; inv MTR; auto.
+  destruct H0. inv MK.
+  econstructor; split.
+  eapply plus_left.
+  destruct H0; subst ts'; constructor. 
+  apply star_one. constructor. traceEq.
+  econstructor; eauto.
+  simpl. rewrite H8; simpl. rewrite H10; simpl. reflexivity.
+  constructor.
+
+(* break while *)
+  monadInv TR. inv MTR. inv MK.
+  econstructor; split.
+  eapply plus_left. constructor.
+  eapply star_left. constructor.
+  apply star_one. constructor.
+  reflexivity. traceEq.
+  eapply match_states_skip; eauto.
+
+(* dowhile *)
+  monadInv TR.
+  econstructor; split.
+  eapply star_plus_trans. eapply match_transl_step; eauto. 
+  eapply plus_left. constructor.
+  eapply star_left. constructor.
+  apply star_one. constructor.
+  reflexivity. reflexivity. traceEq.
+  econstructor; eauto. constructor.
+  econstructor; eauto.
+
+(* skip or continue dowhile false *)
+  assert ((ts' = Sskip \/ ts' = Sexit ncnt) /\ tk' = tk).
+    destruct H; subst x; monadInv TR; inv MTR; auto.
+  destruct H2. inv MK.
+  econstructor; split.
+  eapply plus_left. destruct H2; subst ts'; constructor.
+  eapply star_left. constructor.
+  eapply star_left. eapply exit_if_false_false; eauto.
+  eapply star_left. constructor.
+  apply star_one. constructor.
+  reflexivity. reflexivity. reflexivity. traceEq.
+  eapply match_states_skip; eauto.
+
+(* skip or continue dowhile true *)
+  assert ((ts' = Sskip \/ ts' = Sexit ncnt) /\ tk' = tk).
+    destruct H; subst x; monadInv TR; inv MTR; auto.
+  destruct H2. inv MK.
+  econstructor; split.
+  eapply plus_left. destruct H2; subst ts'; constructor.
+  eapply star_left. constructor.
+  eapply star_left. eapply exit_if_false_true; eauto.
+  apply star_one. constructor.
+  reflexivity. reflexivity. traceEq.
+  econstructor; eauto.
+  simpl. rewrite H10; simpl. rewrite H12; simpl. reflexivity. constructor.
+
+(* break dowhile *)
+  monadInv TR. inv MTR. inv MK.
+  econstructor; split.
+  eapply plus_left. constructor.
+  eapply star_left. constructor.
+  eapply star_left. constructor.
+  apply star_one. constructor.
+  reflexivity. reflexivity. traceEq.
+  eapply match_states_skip; eauto.
+
+(* for false *)
+  monadInv TR.
+  econstructor; split.
+  eapply star_plus_trans. eapply match_transl_step; eauto.
+  eapply plus_left. constructor.
+  eapply star_left. constructor.
+  eapply star_left. eapply exit_if_false_false; eauto.
+  eapply star_left. constructor. 
+  eapply star_left. constructor.
+  apply star_one. constructor.
+  reflexivity. reflexivity. reflexivity. reflexivity. reflexivity. reflexivity.
+  eapply match_states_skip; eauto.
+
+(* for true *)
+   monadInv TR.
+  econstructor; split.
+  eapply star_plus_trans. eapply match_transl_step; eauto.
+  eapply plus_left. constructor.
+  eapply star_left. constructor.
+  eapply star_left. eapply exit_if_false_true; eauto.
+  eapply star_left. constructor. 
+  eapply star_left. constructor.
+  apply star_one. constructor.
+  reflexivity. reflexivity. reflexivity. reflexivity. reflexivity. reflexivity.
+  econstructor; eauto. constructor.
+  econstructor; eauto. 
+
+(* skip or continue for2 *)
+  assert ((ts' = Sskip \/ ts' = Sexit ncnt) /\ tk' = tk).
+    destruct H; subst x; monadInv TR; inv MTR; auto.
+  destruct H0. inv MK.
+  econstructor; split.
+  eapply plus_left. destruct H0; subst ts'; constructor.
+  apply star_one. constructor. reflexivity. 
+  econstructor; eauto. constructor. 
+  econstructor; eauto.
+
+(* break for2 *) 
+  monadInv TR. inv MTR. inv MK.
+  econstructor; split.
+  eapply plus_left. constructor.
+  eapply star_left. constructor.
+  eapply star_left. constructor.
+  apply star_one. constructor.
+  reflexivity. reflexivity. traceEq.
+  eapply match_states_skip; eauto.
+
+(* skip for3 *)
+  monadInv TR. inv MTR. inv MK.
+  econstructor; split.
+  apply plus_one. constructor.
+  econstructor; eauto.
+  simpl. rewrite H6; simpl. rewrite H8; simpl. rewrite H9; simpl. reflexivity.
+  constructor.
+
+(* break for3 *)
+  monadInv TR. inv MTR. inv MK.
+  econstructor; split.
+  eapply plus_left. constructor. apply star_one. constructor. 
+  econstructor; eauto.
+  eapply match_states_skip; eauto.
+
+(* return none *)
+  monadInv TR. inv MTR. 
+  econstructor; split.
+  apply plus_one. constructor. monadInv TRF. simpl. rewrite H. auto.
+  eapply match_env_free_blocks; eauto. 
+  econstructor; eauto.
+  eapply match_cont_call_cont. eauto. 
+
+(* return some *)
+  monadInv TR. inv MTR. 
+  econstructor; split.
+  apply plus_one. constructor. monadInv TRF. simpl.
+  unfold opttyp_of_type. destruct (Clight.fn_return f); try congruence.
+  inv H0. inv H3. inv H3. 
+  eapply make_cast_correct. eapply transl_expr_correct; eauto. eauto.
+  eapply match_env_free_blocks; eauto.
+  econstructor; eauto.
+  eapply match_cont_call_cont. eauto. 
+
+(* skip call *)
+  monadInv TR. inv MTR.
+  exploit match_cont_is_call_cont; eauto. intros [A B].
+  econstructor; split.
+  apply plus_one. apply step_skip_call. auto.
+  monadInv TRF. simpl. rewrite H0. auto.
+  eapply match_env_free_blocks; eauto.
+  constructor. eauto.
+
+(* switch *)
+  monadInv TR.
+  exploit transl_expr_correct; eauto. intro EV.
+  econstructor; split.
+  eapply star_plus_trans. eapply match_transl_step; eauto.
+  apply plus_one. econstructor. eauto. traceEq. 
+  econstructor; eauto.
+  apply transl_lbl_stmt_2. apply transl_lbl_stmt_1. eauto. 
+  constructor.
+  econstructor. eauto.
+
+(* skip or break switch *)
+  assert ((ts' = Sskip \/ ts' = Sexit nbrk) /\ tk' = tk).
+    destruct H; subst x; monadInv TR; inv MTR; auto.
+  destruct H0. inv MK.
+  econstructor; split.
+  apply plus_one. destruct H0; subst ts'; constructor.
+  eapply match_states_skip; eauto.
+
+
+(* continue switch *)
+  monadInv TR. inv MTR. inv MK.
+  econstructor; split.
+  apply plus_one. constructor. 
+  econstructor; eauto. simpl. reflexivity. constructor.
+
+(* label *)
+  monadInv TR. inv MTR. 
+  econstructor; split.
+  apply plus_one. constructor. 
+  econstructor; eauto. constructor.
+
+(* goto *)
+  monadInv TR. inv MTR.
+  generalize TRF. unfold transl_function. intro TRF'. monadInv TRF'.
+  exploit (transl_find_label lbl). eexact EQ0. eapply match_cont_call_cont. eauto.
+  rewrite H. 
+  intros [ts' [tk'' [nbrk' [ncnt' [A [B C]]]]]].
+  econstructor; split.
+  apply plus_one. constructor. simpl. eexact A. 
+  econstructor; eauto. constructor.
+
+(* internal function *)
+  monadInv TR. monadInv EQ.
+  exploit match_cont_is_call_cont; eauto. intros [A B].
+  exploit match_env_alloc_variables; eauto. 
+  apply match_env_empty. 
+  apply transl_fn_variables. eauto. eauto. 
+  intros [te1 [C D]].
+  econstructor; split.
+  apply plus_one. econstructor.
+  eapply transl_names_norepet; eauto. 
+  eexact C. eapply bind_parameters_match; eauto.
+  simpl in TY. unfold type_of_function in TY. congruence.
+  econstructor; eauto.
+  unfold transl_function. rewrite EQ0; simpl. rewrite EQ; simpl. rewrite EQ1; auto. 
+  constructor.
+
+(* external function *)
+  simpl in TR. 
+  destruct (list_typ_eq (sig_args (ef_sig ef)) (typlist_of_typelist targs) &&
+            opt_typ_eq (sig_res (ef_sig ef)) (opttyp_of_type tres));
+  monadInv TR. 
+  exploit match_cont_is_call_cont; eauto. intros [A B].
+  econstructor; split.
+  apply plus_one. constructor. eauto. 
+  eapply external_call_symbols_preserved_2; eauto.
+  exact symbols_preserved.
+  eexact (Genv.find_var_info_transf_partial2 transl_fundef transl_globvar _ TRANSL).
+  eexact (Genv.find_var_info_rev_transf_partial2 transl_fundef transl_globvar _ TRANSL).
+  econstructor; eauto.
+
+(* returnstate *)
+  inv MK. 
+  econstructor; split.
+  apply plus_one. constructor.
+  econstructor; eauto. simpl; reflexivity. constructor.
+  inv MK. 
+  econstructor; split.
+  apply plus_one. constructor.
+  econstructor; eauto. simpl; reflexivity. constructor.
+Qed.
+
+Lemma transl_initial_states:
+  forall S t S', Clight.initial_state prog S -> Clight.step ge S t S' ->
+  exists R, initial_state tprog R /\ match_states S R.
+Proof.
+  intros. inv H.
+  exploit function_ptr_translated; eauto. intros [tf [A B]].
+  assert (C: Genv.find_symbol tge (prog_main tprog) = Some b).
+    rewrite symbols_preserved. replace (prog_main tprog) with (prog_main prog).
+    exact H2. symmetry. unfold transl_program in TRANSL. 
+    eapply transform_partial_program2_main; eauto.
+  assert (funsig tf = signature_of_type Tnil (Tint I32 Signed)).
+    eapply transl_fundef_sig2; eauto. 
+  econstructor; split.
+  econstructor; eauto. eapply Genv.init_mem_transf_partial2; eauto. 
+  econstructor; eauto. constructor; auto. exact I. red; auto.
+Qed.
+
+Lemma transl_final_states:
+  forall S R r,
+  match_states S R -> Clight.final_state S r -> final_state R r.
+Proof.
+  intros. inv H0. inv H. inv MK. constructor.
+Qed.
+
+Theorem transl_program_correct:
+  forall (beh: program_behavior),
+  not_wrong beh -> Clight.exec_program prog beh ->
+  Csharpminor.exec_program tprog beh.
+Proof.
+  set (order := fun (S1 S2: Clight.state) => False).
+  assert (WF: well_founded order).
+  unfold order; red. intros. constructor; intros. contradiction.
+  assert (transl_step':
+     forall S1 t S2, Clight.step ge S1 t S2 ->
+     forall T1, match_states S1 T1 ->
+     exists T2,
+      (plus step tge T1 t T2 \/ star step tge T1 t T2 /\ order S2 S1)
+      /\ match_states S2 T2).
+  intros. exploit transl_step; eauto. intros [T2 [A B]].
+  exists T2; split. auto. auto.
+  intros. inv H0.
+(* Terminates *)
+  assert (exists t1, exists s1, Clight.step (Genv.globalenv prog) s t1 s1).
+  inv H3. inv H2. inv H1. exists t1; exists s2; auto.
+  destruct H0 as [t1 [s1 ST]].
+  exploit transl_initial_states; eauto. intros [R [A B]].
+  exploit simulation_star_star; eauto. intros [R' [C D]]. 
+  econstructor; eauto. eapply transl_final_states; eauto.
+(* Diverges *)
+  assert (exists t1, exists s1, Clight.step (Genv.globalenv prog) s t1 s1).
+  inv H2. inv H3. exists E0; exists s2; auto. exists t1; exists s2; auto.
+  destruct H0 as [t1 [s1 ST]].
+  exploit transl_initial_states; eauto. intros [R [A B]].
+  exploit simulation_star_star; eauto. intros [R' [C D]]. 
+  econstructor; eauto. eapply simulation_star_forever_silent; eauto.
+(* Reacts *)
+  assert (exists t1, exists s1, Clight.step (Genv.globalenv prog) s t1 s1).
+  inv H2. inv H0. congruence. exists t1; exists s0; auto.
+  destruct H0 as [t1 [s1 ST]].
+  exploit transl_initial_states; eauto. intros [R [A B]].
+  exploit simulation_star_forever_reactive; eauto.
+  intro C.
+  econstructor; eauto.
+(* Goes wrong *)
+  contradiction. contradiction.
+Qed.
+
+End CORRECTNESS.
diff --git a/cfrontend/Cshmgenproof1.v b/cfrontend/Cshmgenproof1.v
deleted file mode 100644
index 73a3824..0000000
--- a/cfrontend/Cshmgenproof1.v
+++ /dev/null
@@ -1,292 +0,0 @@
-(* *********************************************************************)
-(*                                                                     *)
-(*              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.     *)
-(*                                                                     *)
-(* *********************************************************************)
-
-(** * Correctness of the C front end, part 1: syntactic properties *)
-
-Require Import Coqlib.
-Require Import Errors.
-Require Import Maps.
-Require Import Integers.
-Require Import Floats.
-Require Import AST.
-Require Import Values.
-Require Import Events.
-Require Import Memory.
-Require Import Globalenvs.
-Require Import Csyntax.
-Require Import Csem.
-Require Import Ctyping.
-Require Import Cminor.
-Require Import Csharpminor.
-Require Import Cshmgen.
-
-(** * Properties of operations over types *)
-
-Remark type_of_chunk_of_type:
-  forall ty chunk,
-  chunk_of_type ty = OK chunk ->
-  type_of_chunk chunk = typ_of_type ty.
-Proof.
-  intros. unfold chunk_of_type in H. destruct ty; simpl in H; try monadInv H.
-  destruct i; destruct s; monadInv H; reflexivity.
-  destruct f; monadInv H; reflexivity.
-  reflexivity. reflexivity. 
-Qed.
-
-Remark transl_params_types:
-  forall p tp,
-  transl_params p = OK tp ->
-  map type_of_chunk (map param_chunk tp) = typlist_of_typelist (type_of_params p).
-Proof.
-  induction p; simpl; intros. 
-  inv H. auto.
-  destruct a as [id ty]. generalize H; clear H. case_eq (chunk_of_type ty); intros.
-  monadInv H0. simpl. f_equal; auto. apply type_of_chunk_of_type; auto.
-  inv H0.
-Qed.
-
-Lemma transl_fundef_sig1:
-  forall tenv f tf args res,
-  wt_fundef tenv f ->
-  transl_fundef f = OK tf ->
-  classify_fun (type_of_fundef f) = fun_case_f args res ->
-  funsig tf = signature_of_type args res.
-Proof.
-  intros. inv H; monadInv H0.
-  monadInv EQ. simpl.  
-  simpl in H1. inversion H1.
-  unfold fn_sig; simpl. unfold signature_of_type. f_equal. 
-  apply transl_params_types; auto.
-  simpl. simpl in H1. inv H1. destruct (ef_sig ef); simpl in *. 
-  unfold signature_of_type. congruence.
-Qed.
-
-Lemma transl_fundef_sig2:
-  forall tenv f tf args res,
-  wt_fundef tenv f ->
-  transl_fundef f = OK tf ->
-  type_of_fundef f = Tfunction args res ->
-  funsig tf = signature_of_type args res.
-Proof.
-  intros. eapply transl_fundef_sig1; eauto.
-  rewrite H1; reflexivity.
-Qed.
-
-Lemma var_kind_by_value:
-  forall ty chunk,
-  access_mode ty = By_value chunk ->
-  var_kind_of_type ty = OK(Vscalar chunk).
-Proof.
-  intros ty chunk; destruct ty; simpl; try congruence.
-  destruct i; try congruence; destruct s; congruence.
-  destruct f; congruence.
-Qed.
-
-Lemma sizeof_var_kind_of_type:
-  forall ty vk,
-  var_kind_of_type ty = OK vk ->
-  Csharpminor.sizeof vk = Csyntax.sizeof ty.
-Proof.
-  intros ty vk.
-  assert (sizeof (Varray (Csyntax.sizeof ty)) = Csyntax.sizeof ty).
-    simpl. rewrite Zmax_spec. apply zlt_false. 
-    generalize (Csyntax.sizeof_pos ty). omega.
-  destruct ty; try (destruct i; try destruct s); try (destruct f); 
-  simpl; intro EQ; inversion EQ; subst vk; auto.
-Qed.
-
-(** * Properties of the translation functions *)
-
-Lemma map_partial_names:
-  forall (A B: Type) (f: A -> res B)
-         (l: list (ident * A)) (tl: list (ident * B)),
-  map_partial prefix_var_name f l = OK tl ->
-  List.map (@fst ident B) tl = List.map (@fst ident A) l.
-Proof.
-  induction l; simpl.
-  intros. inversion H. reflexivity.
-  intro tl. destruct a as [id x]. destruct (f x); try congruence.
-  caseEq (map_partial prefix_var_name f l); simpl; intros; try congruence.
-  inv H0. simpl. decEq. auto.
-Qed.
-   
-Lemma map_partial_append:
-  forall (A B: Type) (f: A -> res B)
-         (l1 l2: list (ident * A)) (tl1 tl2: list (ident * B)),
-  map_partial prefix_var_name f l1 = OK tl1 ->
-  map_partial prefix_var_name f l2 = OK tl2 ->
-  map_partial prefix_var_name f (l1 ++ l2) = OK (tl1 ++ tl2).
-Proof.
-  induction l1; intros until tl2; simpl.
-  intros. inversion H. simpl; auto.
-  destruct a as [id x]. destruct (f x); try congruence.
-  caseEq (map_partial prefix_var_name f l1); simpl; intros; try congruence.
-  inv H0. rewrite (IHl1 _ _ _ H H1). auto.
-Qed.
- 
-Lemma transl_params_names:
-  forall vars tvars,
-  transl_params vars = OK tvars ->
-  List.map param_name tvars = Ctyping.var_names vars.
-Proof.
-  exact (map_partial_names _ _ chunk_of_type).
-Qed.
-
-Lemma transl_vars_names:
-  forall vars tvars,
-  transl_vars vars = OK tvars ->
-  List.map variable_name tvars = Ctyping.var_names vars.
-Proof.
-  exact (map_partial_names _ _ var_kind_of_type).
-Qed.
-
-Lemma transl_names_norepet:
-  forall params vars sg tparams tvars body,
-  list_norepet (var_names params ++ var_names vars) ->
-  transl_params params = OK tparams ->
-  transl_vars vars = OK tvars ->
-  let f := Csharpminor.mkfunction sg tparams tvars body in
-  list_norepet (fn_params_names f ++ fn_vars_names f).
-Proof.
-  intros. unfold fn_params_names, fn_vars_names, f. simpl.
-  rewrite (transl_params_names _ _ H0).
-  rewrite (transl_vars_names _ _ H1).
-  auto.
-Qed.
-
-Lemma transl_vars_append:
-  forall l1 l2 tl1 tl2,
-  transl_vars l1 = OK tl1 -> transl_vars l2 = OK tl2 ->
-  transl_vars (l1 ++ l2) = OK (tl1 ++ tl2).
-Proof.
-  exact (map_partial_append _ _ var_kind_of_type).
-Qed.
-
-Lemma transl_params_vars:
-  forall params tparams,
-  transl_params params = OK tparams ->
-  transl_vars params =
-  OK (List.map (fun id_chunk => (fst id_chunk, Vscalar (snd id_chunk))) tparams).
-Proof.
-  induction params; intro tparams; simpl.
-  intros. inversion H. reflexivity.
-  destruct a as [id x]. 
-  unfold chunk_of_type. caseEq (access_mode x); try congruence.
-  intros chunk AM. 
-  caseEq (transl_params params); simpl; intros; try congruence.
-  inv H0. 
-  rewrite (var_kind_by_value _ _ AM). 
-  rewrite (IHparams _ H). reflexivity.
-Qed.
-
-Lemma transl_fn_variables:
-  forall params vars sg tparams tvars body,
-  transl_params params = OK tparams ->
-  transl_vars vars = OK tvars ->
-  let f := Csharpminor.mkfunction sg tparams tvars body in
-  transl_vars (params ++ vars) = OK (fn_variables f).
-Proof.
-  intros. 
-  generalize (transl_params_vars _ _ H); intro.
-  rewrite (transl_vars_append _ _ _ _ H1 H0).
-  reflexivity.
-Qed.
-
-(** Transformation of expressions and statements. *)
-
-Lemma is_variable_correct:
-  forall a id,
-  is_variable a = Some id ->
-  a = Csyntax.Expr (Csyntax.Evar id) (typeof a).
-Proof.
-  intros until id. destruct a as [ad aty]; simpl. 
-  destruct ad; intros; try discriminate.
-  congruence.
-Qed.
-
-Lemma transl_expr_lvalue:
-  forall ge e m a ty loc ofs ta,
-  Csem.eval_lvalue ge e m (Expr a ty) loc ofs ->
-  transl_expr (Expr a ty) = OK ta ->
-  (exists id, a = Csyntax.Evar id /\ var_get id ty = OK ta) \/
-  (exists tb, transl_lvalue (Expr a ty) = OK tb /\
-              make_load tb ty = OK ta).
-Proof.
-  intros. inversion H; subst; clear H; simpl in H0.
-  left; exists id; auto.
-  left; exists id; auto.
-  monadInv H0. right. exists x; split; auto.
-  rewrite H4 in H0. monadInv H0. right.  
-  exists (Ebinop Oadd x (make_intconst (Int.repr x0))). split; auto.
-  simpl. rewrite H4. rewrite EQ. rewrite EQ1. auto.
-  rewrite H6 in H0. monadInv H0. right.
-  exists x; split; auto. 
-  simpl. rewrite H6. auto.
-Qed.
-
-Lemma is_Sskip_true:
-  forall (A: Type) (a b: A),
-  (if is_Sskip Csyntax.Sskip then a else b) = a.
-Proof.
-  intros. destruct (is_Sskip Csyntax.Sskip); congruence.
-Qed.
-
-Lemma is_Sskip_false:
-  forall (A: Type) (a b: A) s,
-  s <> Csyntax.Sskip ->
-  (if is_Sskip s then a else b) = b.
-Proof.
-  intros. destruct (is_Sskip s); congruence.
-Qed.
-
-(** Properties of labeled statements *)
-
-Lemma transl_lbl_stmt_1:
-  forall nbrk ncnt n sl tsl,
-  transl_lbl_stmt nbrk ncnt sl = OK tsl ->
-  transl_lbl_stmt nbrk ncnt (Csem.select_switch n sl) = OK (select_switch n tsl).
-Proof.
-  induction sl; intros.
-  monadInv H. simpl. rewrite EQ. auto.
-  generalize H; intro TR. monadInv TR. simpl. 
-  destruct (Int.eq i n). auto. auto. 
-Qed.
-
-Lemma transl_lbl_stmt_2:
-  forall nbrk ncnt sl tsl,
-  transl_lbl_stmt nbrk ncnt sl = OK tsl ->
-  transl_statement nbrk ncnt (seq_of_labeled_statement sl) = OK (seq_of_lbl_stmt tsl).
-Proof.
-  induction sl; intros.
-  monadInv H. simpl. auto.
-  monadInv H. simpl. rewrite EQ; simpl. rewrite (IHsl _ EQ1). simpl. auto.
-Qed.
-
-Lemma wt_select_switch:
-  forall n tyenv sl,
-  wt_lblstmts tyenv sl ->
-  wt_lblstmts tyenv (Csem.select_switch n sl).
-Proof.
-  induction 1; simpl.
-  constructor; auto.
-  destruct (Int.eq n0 n). constructor; auto. auto.
-Qed.
-
-Lemma wt_seq_of_labeled_statement:
-  forall tyenv sl,
-  wt_lblstmts tyenv sl ->
-  wt_stmt tyenv (seq_of_labeled_statement sl).
-Proof.
-  induction 1; simpl.
-  auto.
-  constructor; auto.
-Qed.
diff --git a/cfrontend/Cshmgenproof2.v b/cfrontend/Cshmgenproof2.v
deleted file mode 100644
index e58570b..0000000
--- a/cfrontend/Cshmgenproof2.v
+++ /dev/null
@@ -1,394 +0,0 @@
-(* *********************************************************************)
-(*                                                                     *)
-(*              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.     *)
-(*                                                                     *)
-(* *********************************************************************)
-
-(** * Correctness of the C front end, part 2: Csharpminor construction functions *)
-
-Require Import Coqlib.
-Require Import Errors.
-Require Import Maps.
-Require Import Integers.
-Require Import Floats.
-Require Import AST.
-Require Import Values.
-Require Import Events.
-Require Import Memory.
-Require Import Globalenvs.
-Require Import Csyntax.
-Require Import Csem.
-Require Import Ctyping.
-Require Import Cminor.
-Require Import Csharpminor.
-Require Import Cshmgen.
-Require Import Cshmgenproof1.
-
-Section CONSTRUCTORS.
-
-Variable globenv : genv * gvarenv.
-Let ge := fst globenv.
-
-(** * Correctness of Csharpminor construction functions *)
-
-Lemma make_intconst_correct:
-  forall n e m,
-  eval_expr globenv e m (make_intconst n) (Vint n).
-Proof.
-  intros. unfold make_intconst. econstructor. reflexivity. 
-Qed.
-
-Lemma make_floatconst_correct:
-  forall n e m,
-  eval_expr globenv e m (make_floatconst n) (Vfloat n).
-Proof.
-  intros. unfold make_floatconst. econstructor. reflexivity. 
-Qed.
-
-Hint Resolve make_intconst_correct make_floatconst_correct
-             eval_Eunop eval_Ebinop: cshm.
-Hint Extern 2 (@eq trace _ _) => traceEq: cshm.
-
-Remark Vtrue_is_true: Val.is_true Vtrue.
-Proof.
-  simpl. apply Int.one_not_zero.
-Qed.
-
-Remark Vfalse_is_false: Val.is_false Vfalse.
-Proof.
-  simpl. auto.
-Qed.
-
-Lemma make_boolean_correct_true:
- forall e m a v ty,
-  eval_expr globenv e m a v ->
-  is_true v ty ->
-  exists vb,
-    eval_expr globenv e m (make_boolean a ty) vb
-    /\ Val.is_true vb.
-Proof.
-  intros until ty; intros EXEC VTRUE.
-  destruct ty; simpl;
-  try (exists v; intuition; inversion VTRUE; simpl; auto; fail).
-  exists Vtrue; split.
-  eapply eval_Ebinop; eauto with cshm. 
-  inversion VTRUE; simpl.
-  rewrite Float.cmp_ne_eq. rewrite H1. auto.
-  apply Vtrue_is_true.
-Qed.
-
-Lemma make_boolean_correct_false:
- forall e m a v ty,
-  eval_expr globenv e m a v ->
-  is_false v ty ->
-  exists vb,
-    eval_expr globenv e m (make_boolean a ty) vb
-    /\ Val.is_false vb.
-Proof.
-  intros until ty; intros EXEC VFALSE.
-  destruct ty; simpl;
-  try (exists v; intuition; inversion VFALSE; simpl; auto; fail).
-  exists Vfalse; split.
-  eapply eval_Ebinop; eauto with cshm. 
-  inversion VFALSE; simpl.
-  rewrite Float.cmp_ne_eq. rewrite H1. auto.
-  apply Vfalse_is_false.
-Qed.
-
-Lemma make_neg_correct:
-  forall a tya c va v e m,
-  sem_neg va tya = Some v ->
-  make_neg a tya = OK c ->  
-  eval_expr globenv e m a va ->
-  eval_expr globenv e m c v.
-Proof.
-  intros until m; intro SEM. unfold make_neg. 
-  functional inversion SEM; intros.
-  inversion H4. eapply eval_Eunop; eauto with cshm.
-  inversion H4. eauto with cshm.
-Qed.
-
-Lemma make_notbool_correct:
-  forall a tya c va v e m,
-  sem_notbool va tya = Some v ->
-  make_notbool a tya = c ->  
-  eval_expr globenv e m a va ->
-  eval_expr globenv e m c v.
-Proof.
-  intros until m; intro SEM. unfold make_notbool. 
-  functional inversion SEM; intros; rewrite H0 in H4; inversion H4; simpl;
-  eauto with cshm.
-Qed.
-
-Lemma make_notint_correct:
-  forall a tya c va v e m,
-  sem_notint va = Some v ->
-  make_notint a tya = c ->  
-  eval_expr globenv e m a va ->
-  eval_expr globenv e m c v.
-Proof.
-  intros until m; intro SEM. unfold make_notint. 
-  functional inversion SEM; intros. 
-  inversion H2; eauto with cshm.
-Qed.
-
-Lemma make_fabs_correct:
-  forall a tya c va v e m,
-  sem_fabs va = Some v ->
-  make_fabs a tya = c ->  
-  eval_expr globenv e m a va ->
-  eval_expr globenv e m c v.
-Proof.
-  intros until m; intro SEM. unfold make_fabs. 
-  functional inversion SEM; intros. 
-  inversion H2; eauto with cshm.
-Qed.
-
-Definition binary_constructor_correct
-    (make: expr -> type -> expr -> type -> res expr)
-    (sem: val -> type -> val -> type -> option val): Prop :=
-  forall a tya b tyb c va vb v e m,
-  sem va tya vb tyb = Some v ->
-  make a tya b tyb = OK c ->  
-  eval_expr globenv e m a va ->
-  eval_expr globenv e m b vb ->
-  eval_expr globenv e m c v.
-
-Definition binary_constructor_correct'
-    (make: expr -> type -> expr -> type -> res expr)
-    (sem: val -> val -> option val): Prop :=
-  forall a tya b tyb c va vb v e m,
-  sem va vb = Some v ->
-  make a tya b tyb = OK c ->  
-  eval_expr globenv e m a va ->
-  eval_expr globenv e m b vb ->
-  eval_expr globenv e m c v.
-
-Lemma make_add_correct: binary_constructor_correct make_add sem_add.
-Proof.
-  red; intros until m. intro SEM. unfold make_add. 
-  functional inversion SEM; rewrite H0; intros.
-  inversion H7. eauto with cshm. 
-  inversion H7. eauto with cshm.
-  inversion H7. 
-  eapply eval_Ebinop. eauto. 
-  eapply eval_Ebinop. eauto with cshm. eauto.
-  simpl. reflexivity. reflexivity. 
-  inversion H7. 
-  eapply eval_Ebinop. eauto. 
-  eapply eval_Ebinop. eauto with cshm. eauto. 
-  simpl. reflexivity. simpl. reflexivity.
-Qed.
-
-Lemma make_sub_correct: binary_constructor_correct make_sub sem_sub.
-Proof.
-  red; intros until m. intro SEM. unfold make_sub. 
-  functional inversion SEM; rewrite H0; intros;
-  inversion H7; eauto with cshm. 
-  eapply eval_Ebinop. eauto. 
-  eapply eval_Ebinop. eauto with cshm. eauto.
-  simpl. reflexivity. reflexivity. 
-  inversion H9. eapply eval_Ebinop. 
-  eapply eval_Ebinop; eauto. 
-  simpl. unfold eq_block; rewrite H3. reflexivity.
-  eauto with cshm. simpl. rewrite H8. reflexivity.
-Qed.
-
-Lemma make_mul_correct: binary_constructor_correct make_mul sem_mul.
-Proof.
-  red; intros until m. intro SEM. unfold make_mul. 
-  functional inversion SEM; rewrite H0; intros;
-  inversion H7; eauto with cshm. 
-Qed.
-
-Lemma make_div_correct: binary_constructor_correct make_div sem_div.
-Proof.
-  red; intros until m. intro SEM. unfold make_div. 
-  functional inversion SEM; rewrite H0; intros.
-  inversion H8. eapply eval_Ebinop; eauto with cshm. 
-  simpl. rewrite H7; auto.
-  inversion H8. eapply eval_Ebinop; eauto with cshm. 
-  simpl. rewrite H7; auto.
-  inversion H7; eauto with cshm. 
-Qed.
-
-Lemma make_mod_correct: binary_constructor_correct make_mod sem_mod.
-  red; intros until m. intro SEM. unfold make_mod. 
-  functional inversion SEM; rewrite H0; intros.
-  inversion H8. eapply eval_Ebinop; eauto with cshm. 
-  simpl. rewrite H7; auto.
-  inversion H8. eapply eval_Ebinop; eauto with cshm. 
-  simpl. rewrite H7; auto.
-Qed.
-
-Lemma make_and_correct: binary_constructor_correct' make_and sem_and.
-Proof.
-  red; intros until m. intro SEM. unfold make_and. 
-  functional inversion SEM. intros. inversion H4. 
-  eauto with cshm. 
-Qed.
-
-Lemma make_or_correct: binary_constructor_correct' make_or sem_or.
-Proof.
-  red; intros until m. intro SEM. unfold make_or. 
-  functional inversion SEM. intros. inversion H4. 
-  eauto with cshm. 
-Qed.
-
-Lemma make_xor_correct: binary_constructor_correct' make_xor sem_xor.
-Proof.
-  red; intros until m. intro SEM. unfold make_xor. 
-  functional inversion SEM. intros. inversion H4. 
-  eauto with cshm. 
-Qed.
-
-Lemma make_shl_correct: binary_constructor_correct' make_shl sem_shl.
-Proof.
-  red; intros until m. intro SEM. unfold make_shl. 
-  functional inversion SEM. intros. inversion H5. 
-  eapply eval_Ebinop; eauto with cshm. 
-  simpl. rewrite H4. auto.
-Qed.
-
-Lemma make_shr_correct: binary_constructor_correct make_shr sem_shr.
-Proof.
-  red; intros until m. intro SEM. unfold make_shr. 
-  functional inversion SEM; intros; rewrite H0 in H8; inversion H8.
-  eapply eval_Ebinop; eauto with cshm.
-  simpl; rewrite H7; auto.
-  eapply eval_Ebinop; eauto with cshm.
-  simpl; rewrite H7; auto.
-Qed.
-
-Lemma make_cmp_correct:
-  forall cmp a tya b tyb c va vb v e m,
-  sem_cmp cmp va tya vb tyb m = Some v ->
-  make_cmp cmp a tya b tyb = OK c ->  
-  eval_expr globenv e m a va ->
-  eval_expr globenv e m b vb ->
-  eval_expr globenv e m c v.
-Proof.
-  intros until m. intro SEM. unfold make_cmp.
-  functional inversion SEM; rewrite H0; intros.
-  (* I32unsi *) 
-  inversion H8. eauto with cshm.
-  (* ipip int int *)
-  inversion H8. eauto with cshm.
-  (* ipip ptr ptr *)
-  inversion H10. eapply eval_Ebinop; eauto with cshm.
-  simpl. rewrite H3. unfold eq_block. rewrite H9. auto.
-  inversion H10. eapply eval_Ebinop; eauto with cshm.
-  simpl. rewrite H3. unfold eq_block. rewrite H9. auto.
-  (* ipip ptr int *)
-  inversion H9. eapply eval_Ebinop; eauto with cshm.
-  simpl. unfold eval_compare_null. rewrite H8. auto.
-  (* ipip int ptr *)
-  inversion H9. eapply eval_Ebinop; eauto with cshm.
-  simpl. unfold eval_compare_null. rewrite H8. auto.
-  (* ff *)
-  inversion H8. eauto with cshm.
-Qed.
-
-Lemma transl_unop_correct:
-  forall op a tya c va v e m, 
-  transl_unop op a tya = OK c ->
-  sem_unary_operation op va tya = Some v ->
-  eval_expr globenv e m a va ->
-  eval_expr globenv e m c v.
-Proof.
-  intros. destruct op; simpl in *.
-  eapply make_notbool_correct; eauto. congruence.
-  eapply make_notint_correct with (tya := tya); eauto. congruence.
-  eapply make_neg_correct; eauto.
-  eapply make_fabs_correct with (tya := tya); eauto. congruence.
-Qed.
-
-Lemma transl_binop_correct:
-  forall op a tya b tyb c va vb v e m,
-  transl_binop op a tya b tyb = OK c ->  
-  sem_binary_operation op va tya vb tyb m = Some v ->
-  eval_expr globenv e m a va ->
-  eval_expr globenv e m b vb ->
-  eval_expr globenv e m c v.
-Proof.
-  intros. destruct op; simpl in *.
-  eapply make_add_correct; eauto.
-  eapply make_sub_correct; eauto.
-  eapply make_mul_correct; eauto.
-  eapply make_div_correct; eauto.
-  eapply make_mod_correct; eauto.
-  eapply make_and_correct; eauto.
-  eapply make_or_correct; eauto.
-  eapply make_xor_correct; eauto.
-  eapply make_shl_correct; eauto.
-  eapply make_shr_correct; eauto.
-  eapply make_cmp_correct; eauto.
-  eapply make_cmp_correct; eauto.
-  eapply make_cmp_correct; eauto.
-  eapply make_cmp_correct; eauto.
-  eapply make_cmp_correct; eauto.
-  eapply make_cmp_correct; eauto.
-Qed. 
-
-Lemma make_cast_correct:
-  forall e m a v ty1 ty2 v',
-   eval_expr globenv e m a v ->
-   cast v ty1 ty2 v' ->
-   eval_expr globenv e m (make_cast ty1 ty2 a) v'.
-Proof.
-  unfold make_cast, make_cast1, make_cast2.
-  intros until v'; intros EVAL CAST.
-  inversion CAST; clear CAST; subst.
-  (* cast_int_int *)
-    destruct sz2; destruct si2; repeat econstructor; eauto with cshm.
-  (* cast_float_int *)
-    destruct sz2; destruct si2; unfold make_intoffloat; repeat econstructor; eauto with cshm; simpl; auto.
-  (* cast_int_float *)
-    destruct sz2; destruct si1; unfold make_floatofint; repeat econstructor; eauto with cshm; simpl; auto.
-  (* cast_float_float *)
-    destruct sz2; repeat econstructor; eauto with cshm.
-  (* neutral, ptr *)
-   inversion H0; auto; inversion H; auto.
-  (* neutral, int *)
-   inversion H0; auto; inversion H; auto.
-Qed.
-
-Lemma make_load_correct:
-  forall addr ty code b ofs v e m,
-  make_load addr ty = OK code ->
-  eval_expr globenv e m addr (Vptr b ofs) ->
-  load_value_of_type ty m b ofs = Some v ->
-  eval_expr globenv e m code v.
-Proof.
-  unfold make_load, load_value_of_type.
-  intros until m; intros MKLOAD EVEXP LDVAL.
-  destruct (access_mode ty); inversion MKLOAD.
-  (* access_mode ty = By_value m *)
-  apply eval_Eload with (Vptr b ofs); auto.
-  (* access_mode ty = By_reference *)
-  subst code. inversion LDVAL. auto.
-Qed.
-
-Lemma make_store_correct:
-  forall addr ty rhs code e m b ofs v m' f k,
-  make_store addr ty rhs = OK code ->
-  eval_expr globenv e m addr (Vptr b ofs) ->
-  eval_expr globenv e m rhs v ->
-  store_value_of_type ty m b ofs v = Some m' ->
-  step globenv (State f code k e m) E0 (State f Sskip k e m').
-Proof.
-  unfold make_store, store_value_of_type.
-  intros until k; intros MKSTORE EV1 EV2 STVAL.
-  destruct (access_mode ty); inversion MKSTORE.
-  (* access_mode ty = By_value m *)
-  eapply step_store; eauto. 
-Qed.
-
-End CONSTRUCTORS.
-
diff --git a/cfrontend/Cshmgenproof3.v b/cfrontend/Cshmgenproof3.v
deleted file mode 100644
index 0e9e5b1..0000000
--- a/cfrontend/Cshmgenproof3.v
+++ /dev/null
@@ -1,1667 +0,0 @@
-(* *********************************************************************)
-(*                                                                     *)
-(*              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.     *)
-(*                                                                     *)
-(* *********************************************************************)
-
-(** * Correctness of the C front end, part 3: semantic preservation *)
-
-Require Import Coqlib.
-Require Import Errors.
-Require Import Maps.
-Require Import Integers.
-Require Import Floats.
-Require Import AST.
-Require Import Values.
-Require Import Events.
-Require Import Memory.
-Require Import Globalenvs.
-Require Import Smallstep.
-Require Import Csyntax.
-Require Import Csem.
-Require Import Ctyping.
-Require Import Cminor.
-Require Import Csharpminor.
-Require Import Cshmgen.
-Require Import Cshmgenproof1.
-Require Import Cshmgenproof2.
-
-Section CORRECTNESS.
-
-Variable prog: Csyntax.program.
-Variable tprog: Csharpminor.program.
-Hypothesis WTPROG: wt_program prog.
-Hypothesis TRANSL: transl_program prog = OK tprog.
-
-Let ge := Genv.globalenv prog.
-Let tge := Genv.globalenv tprog.
-Let tgvare : gvarenv := global_var_env tprog.
-Let tgve := (tge, tgvare).
-
-Lemma symbols_preserved:
-  forall s, Genv.find_symbol tge s = Genv.find_symbol ge s.
-Proof (Genv.find_symbol_transf_partial2 transl_fundef transl_globvar _ TRANSL).
-
-Lemma functions_translated:
-  forall v f,
-  Genv.find_funct ge v = Some f ->
-  exists tf, Genv.find_funct tge v = Some tf /\ transl_fundef f = OK tf.
-Proof (Genv.find_funct_transf_partial2 transl_fundef transl_globvar _ TRANSL).
-
-Lemma function_ptr_translated:
-  forall b f,
-  Genv.find_funct_ptr ge b = Some f ->
-  exists tf, Genv.find_funct_ptr tge b = Some tf /\ transl_fundef f = OK tf.
-Proof (Genv.find_funct_ptr_transf_partial2 transl_fundef transl_globvar _ TRANSL).
-
-Lemma functions_well_typed:
-  forall v f,
-  Genv.find_funct ge v = Some f ->
-  wt_fundef (global_typenv prog) f.
-Proof.
-  intros. inversion WTPROG. 
-  apply (@Genv.find_funct_prop _ _ (wt_fundef (global_typenv prog)) prog v f).
-  intros. apply wt_program_funct with id. assumption.
-  assumption.
-Qed.
-
-Lemma function_ptr_well_typed:
-  forall b f,
-  Genv.find_funct_ptr ge b = Some f ->
-  wt_fundef (global_typenv prog) f.
-Proof.
-  intros. inversion WTPROG. 
-  apply (@Genv.find_funct_ptr_prop _ _ (wt_fundef (global_typenv prog)) prog b f).
-  intros. apply wt_program_funct with id. assumption.
-  assumption.
-Qed.
-
-(** * Matching between environments *)
-
-(** In this section, we define a matching relation between
-  a Clight local environment and a Csharpminor local environment,
-  parameterized by an assignment of types to the Clight variables. *)
-
-Record match_env (tyenv: typenv) (e: Csem.env) (te: Csharpminor.env) : Prop :=
-  mk_match_env {
-    me_local:
-      forall id b ty,
-      e!id = Some (b, ty) ->
-      exists vk,
-        tyenv!id = Some ty
-        /\ var_kind_of_type ty = OK vk
-        /\ te!id = Some (b, vk);
-    me_local_inv:
-      forall id b vk,
-      te!id = Some (b, vk) -> exists ty, e!id = Some(b, ty);
-    me_global:
-      forall id ty,
-      e!id = None -> tyenv!id = Some ty ->
-      te!id = None /\ 
-      (forall chunk, access_mode ty = By_value chunk -> (global_var_env tprog)!id = Some (Vscalar chunk))
-  }.
-
-Lemma match_env_same_blocks:
-  forall tyenv e te,
-  match_env tyenv e te ->
-  blocks_of_env te = Csem.blocks_of_env e.
-Proof.
-  intros.
-  set (R := fun (x: (block * type)) (y: (block * var_kind)) =>
-         match x, y with
-         | (b1, ty), (b2, vk) => b2 = b1 /\ var_kind_of_type ty = OK vk
-         end).
-  assert (list_forall2 
-            (fun i_x i_y => fst i_x = fst i_y /\ R (snd i_x) (snd i_y))
-            (PTree.elements e) (PTree.elements te)).
-  apply PTree.elements_canonical_order.
-  intros id [b ty] GET. exploit me_local; eauto. intros [vk [A [B C]]].
-  exists (b, vk); split; auto. red. auto.
-  intros id [b vk] GET. 
-  exploit me_local_inv; eauto. intros [ty A]. 
-  exploit me_local; eauto. intros [vk' [B [C D]]]. 
-  assert (vk' = vk) by congruence. subst vk'.
-  exists (b, ty); split; auto. red. auto.
-
-  unfold blocks_of_env, Csem.blocks_of_env.
-  generalize H0. induction 1. auto. 
-  simpl. f_equal; auto.
-  unfold block_of_binding, Csem.block_of_binding. 
-  destruct a1 as [id1 [blk1 ty1]]. destruct b1 as [id2 [blk2 vk2]].
-  simpl in *. destruct H1 as [A [B C]]. subst blk2 id2. f_equal.
-  apply sizeof_var_kind_of_type. auto. 
-Qed.
-
-Lemma match_env_free_blocks:
-  forall tyenv e te m m',
-  match_env tyenv e te ->
-  Mem.free_list m (Csem.blocks_of_env e) = Some m' ->
-  Mem.free_list m (blocks_of_env te) = Some m'.
-Proof.
-  intros. rewrite (match_env_same_blocks _ _ _ H). auto.
-Qed.
-
-Definition match_globalenv (tyenv: typenv) (gv: gvarenv): Prop :=
-  forall id ty chunk,
-  tyenv!id = Some ty -> access_mode ty = By_value chunk ->
-  gv!id = Some (Vscalar chunk).
-
-Lemma match_globalenv_match_env_empty:
-  forall tyenv,
-  match_globalenv tyenv (global_var_env tprog) ->
-  match_env tyenv Csem.empty_env Csharpminor.empty_env.
-Proof.
-  intros. unfold Csem.empty_env, Csharpminor.empty_env.
-  constructor.
-  intros until b. repeat rewrite PTree.gempty. congruence.
-  intros until vk. rewrite PTree.gempty. congruence.
-  intros. split.
-  apply PTree.gempty. 
-  intros. red in H. eauto.
-Qed.
-
-(** The following lemmas establish the [match_env] invariant at
-  the beginning of a function invocation, after allocation of
-  local variables and initialization of the parameters. *)
-
-Lemma match_env_alloc_variables:
-  forall e1 m1 vars e2 m2,
-  Csem.alloc_variables e1 m1 vars e2 m2 ->
-  forall tyenv te1 tvars,
-  match_env tyenv e1 te1 ->
-  transl_vars vars = OK tvars ->
-  exists te2,
-  Csharpminor.alloc_variables te1 m1 tvars te2 m2
-  /\ match_env (Ctyping.add_vars tyenv vars) e2 te2.
-Proof.
-  induction 1; intros.
-  simpl in H0. inversion H0; subst; clear H0. 
-  exists te1; split. constructor. simpl. auto.
-  generalize H2. simpl. 
-  caseEq (var_kind_of_type ty); simpl; [intros vk VK | congruence].
-  caseEq (transl_vars vars); simpl; [intros tvrs TVARS | congruence].
-  intro EQ; inversion EQ; subst tvars; clear EQ.
-  set (te2 := PTree.set id (b1, vk) te1).
-  assert (match_env (add_var tyenv (id, ty)) (PTree.set id (b1, ty) e) te2).
-    inversion H1. unfold te2, add_var. constructor.
-    (* me_local *)
-    intros until ty0. simpl. repeat rewrite PTree.gsspec.
-    destruct (peq id0 id); intros.
-    inv H3. exists vk; intuition.
-    auto.
-    (* me_local_inv *)
-    intros until vk0. repeat rewrite PTree.gsspec. 
-    destruct (peq id0 id); intros. exists ty; congruence. eauto. 
-    (* me_global *)
-    intros until ty0. repeat rewrite PTree.gsspec. simpl. destruct (peq id0 id); intros.
-    discriminate.
-    auto.
-  destruct (IHalloc_variables _ _ _ H3 TVARS) as [te3 [ALLOC MENV]]. 
-  exists te3; split.
-  econstructor; eauto.
-  rewrite (sizeof_var_kind_of_type _ _ VK). eauto. 
-  auto. 
-Qed. 
-
-Lemma bind_parameters_match_rec:
-  forall e m1 vars vals m2,
-  Csem.bind_parameters e m1 vars vals m2 ->
-  forall tyenv te tvars,
-  (forall id ty, In (id, ty) vars -> tyenv!id = Some ty) ->
-  match_env tyenv e te ->
-  transl_params vars = OK tvars ->
-  Csharpminor.bind_parameters te m1 tvars vals m2.
-Proof.
-  induction 1; intros.
-  simpl in H1. inversion H1. constructor.
-  generalize H4; clear H4; simpl. 
-  caseEq (chunk_of_type ty); simpl; [intros chunk CHK | congruence].
-  caseEq (transl_params params); simpl; [intros tparams TPARAMS | congruence].
-  intro EQ; inversion EQ; clear EQ; subst tvars.
-  generalize CHK. unfold chunk_of_type. 
-  caseEq (access_mode ty); intros; try discriminate.
-  inversion CHK0; clear CHK0; subst m0.
-  unfold store_value_of_type in H0. rewrite H4 in H0.
-  apply bind_parameters_cons with b m1. 
-  assert (tyenv!id = Some ty). apply H2. apply in_eq.
-  destruct (me_local _ _ _ H3 _ _ _ H)  as [vk [A [B C]]].
-  exploit var_kind_by_value; eauto. congruence.
-  assumption.
-  apply IHbind_parameters with tyenv; auto.
-  intros. apply H2. apply in_cons; auto.
-Qed.
-
-Lemma tyenv_add_vars_norepet:
-  forall vars tyenv,
-  list_norepet (var_names vars) ->
-  (forall id ty,
-   In (id, ty) vars -> (Ctyping.add_vars tyenv vars)!id = Some ty)
-  /\
-  (forall id,
-   ~In id (var_names vars) -> (Ctyping.add_vars tyenv vars)!id = tyenv!id).
-Proof.
-  induction vars; simpl; intros.
-  tauto.
-  destruct a as [id1 ty1]. simpl in *. inversion H; clear H; subst.
-  destruct (IHvars (add_var tyenv (id1, ty1)) H3) as [A B].
-  split; intros.
-  destruct H. inversion H; subst id1 ty1; clear H. 
-  rewrite B. unfold add_var. simpl. apply PTree.gss. auto.
-  auto.
-  rewrite B. unfold add_var; simpl. apply PTree.gso. apply sym_not_equal; tauto. tauto.
-Qed.
-
-Lemma bind_parameters_match:
-  forall e m1 params vals vars m2 tyenv tvars te,
-  Csem.bind_parameters e m1 params vals m2 ->
-  list_norepet (var_names params ++ var_names vars) ->
-  match_env (Ctyping.add_vars tyenv (params ++ vars)) e te ->
-  transl_params params = OK tvars ->
-  Csharpminor.bind_parameters te m1 tvars vals m2.
-Proof.
-  intros. 
-  eapply bind_parameters_match_rec; eauto.
-  assert (list_norepet (var_names (params ++ vars))).
-    unfold var_names. rewrite List.map_app. assumption.
-  destruct (tyenv_add_vars_norepet _ tyenv H3) as [A B].
-  intros. apply A. apply List.in_or_app. auto. 
-Qed.
-
-(** The following lemmas establish the matching property
-  between the global environments constructed at the beginning
-  of program execution. *)
-
-Definition globvarenv 
-    (gv: gvarenv)
-    (vars: list (ident * globvar var_kind)) :=
-  List.fold_left
-    (fun gve x => match x with (id, v) => PTree.set id (gvar_info v) gve end)
-    vars gv.
-
-Definition type_not_by_value (ty: type) : Prop :=
-  match access_mode ty with
-  | By_value _ => False
-  | _ => True
-  end.
-
-Lemma add_global_funs_charact:
-  forall fns tyenv,
-  (forall id ty, tyenv!id = Some ty -> type_not_by_value ty) ->
-  (forall id ty, (add_global_funs tyenv fns)!id = Some ty -> type_not_by_value ty).
-Proof.
-  induction fns; simpl; intros.
-  eauto.
-  apply IHfns with (add_global_fun tyenv a) id.
-  intros until ty0. destruct a as [id1 fn1]. 
-  unfold add_global_fun; simpl. rewrite PTree.gsspec.
-  destruct (peq id0 id1). 
-  intros. inversion H1. 
-  unfold type_of_fundef. destruct fn1; exact I.
-  eauto.
-  auto.
-Qed.
-
-Definition global_fun_typenv :=
-  add_global_funs (PTree.empty type) prog.(prog_funct).
-
-Lemma add_global_funs_match_global_env:
-  match_globalenv global_fun_typenv (PTree.empty var_kind).
-Proof.
-  intros; red; intros.
-  assert (type_not_by_value ty).
-    apply add_global_funs_charact with (prog_funct prog) (PTree.empty type) id.
-    intros until ty0. rewrite PTree.gempty. congruence.
-    assumption.
-  red in H1. rewrite H0 in H1. contradiction.
-Qed.
-
-Lemma add_global_var_match_globalenv:
-  forall vars tenv gv tvars,
-  match_globalenv tenv gv ->
-  map_partial AST.prefix_name (transf_globvar transl_globvar) vars = OK tvars ->
-  match_globalenv (add_global_vars tenv vars) (globvarenv gv tvars).
-Proof.
-  induction vars; simpl.
-  intros. inversion H0. assumption.
-  destruct a as [id v]. intros until tvars; intro.
-  caseEq (transf_globvar transl_globvar v); simpl; try congruence. intros vk VK. 
-  caseEq (map_partial AST.prefix_name (transf_globvar transl_globvar) vars); simpl; try congruence. intros tvars' EQ1 EQ2.
-  inversion EQ2; clear EQ2. simpl. 
-  apply IHvars; auto.
-  red. intros until chunk. unfold add_global_var. repeat rewrite PTree.gsspec. simpl. 
-  destruct (peq id0 id); intros.
-  inv H0. monadInv VK. unfold transl_globvar in EQ.  
-  generalize (var_kind_by_value _ _ H2). simpl. congruence.
-  red in H. eauto. 
-Qed.
-
-Lemma match_global_typenv:
-  match_globalenv (global_typenv prog) (global_var_env tprog).
-Proof.
-  change (global_var_env tprog)
-    with (globvarenv (PTree.empty var_kind) (prog_vars tprog)).
-  unfold global_typenv.
-  apply add_global_var_match_globalenv.
-  apply add_global_funs_match_global_env. 
-  unfold transl_program in TRANSL. monadInv TRANSL. auto.
-Qed.
-
-(* ** Correctness of variable accessors *)
-
-(** Correctness of the code generated by [var_get]. *)
-
-Lemma var_get_correct:
-  forall e m id ty loc ofs v tyenv code te,
-  Csem.eval_lvalue ge e m (Expr (Csyntax.Evar id) ty) loc ofs ->
-  load_value_of_type ty m loc ofs = Some v ->
-  wt_expr tyenv (Expr (Csyntax.Evar id) ty) ->
-  var_get id ty = OK code ->
-  match_env tyenv e te ->
-  eval_expr tgve te m code v.
-Proof.
-  intros. inversion H1; subst; clear H1. 
-  unfold load_value_of_type in H0.
-  unfold var_get in H2. 
-  caseEq (access_mode ty).
-  (* access mode By_value *)
-  intros chunk ACC. rewrite ACC in H0. rewrite ACC in H2. 
-  inversion H2; clear H2; subst.
-  inversion H; subst; clear H.
-    (* local variable *)
-    exploit me_local; eauto. intros [vk [A [B C]]].
-    assert (vk = Vscalar chunk).
-    exploit var_kind_by_value; eauto. congruence.
-    subst vk.
-    eapply eval_Evar. 
-    eapply eval_var_ref_local. eauto. assumption. 
-    (* global variable *)
-    exploit me_global; eauto. intros [A B].
-    eapply eval_Evar. 
-    eapply eval_var_ref_global. auto. 
-    fold tge. rewrite symbols_preserved. eauto.
-    eauto. assumption. 
-  (* access mode By_reference *)
-  intros ACC. rewrite ACC in H0. rewrite ACC in H2.
-  inversion H0; clear H0; subst.
-  inversion H2; clear H2; subst.
-  inversion H; subst; clear H.
-    (* local variable *)
-    exploit me_local; eauto. intros [vk [A [B C]]].
-    eapply eval_Eaddrof.
-    eapply eval_var_addr_local. eauto. 
-    (* global variable *)
-    exploit me_global; eauto. intros [A B].
-    eapply eval_Eaddrof.
-    eapply eval_var_addr_global. auto. 
-    fold tge. rewrite symbols_preserved. eauto.
-  (* access mode By_nothing *)
-  intros. rewrite H1 in H0; discriminate.
-Qed.
-
-(** Correctness of the code generated by [var_set]. *)
-
-Lemma var_set_correct:
-  forall e m id ty loc ofs v m' tyenv code te rhs f k, 
-  Csem.eval_lvalue ge e m (Expr (Csyntax.Evar id) ty) loc ofs ->
-  store_value_of_type ty m loc ofs v = Some m' ->
-  wt_expr tyenv (Expr (Csyntax.Evar id) ty) ->
-  var_set id ty rhs = OK code ->
-  match_env tyenv e te ->
-  eval_expr tgve te m rhs v ->
-  step tgve (State f code k te m) E0 (State f Sskip k te m').
-Proof.
-  intros. inversion H1; subst; clear H1. 
-  unfold store_value_of_type in H0.
-  unfold var_set in H2. 
-  caseEq (access_mode ty).
-  (* access mode By_value *)
-  intros chunk ACC. rewrite ACC in H0. rewrite ACC in H2. 
-  inversion H2; clear H2; subst.
-  inversion H; subst; clear H. 
-    (* local variable *)
-    exploit me_local; eauto. intros [vk [A [B C]]].
-    assert (vk = Vscalar chunk).
-      exploit var_kind_by_value; eauto. congruence.
-    subst vk.
-    eapply step_assign. eauto.
-    econstructor. eapply eval_var_ref_local. eauto. assumption. 
-    (* global variable *)
-    exploit me_global; eauto. intros [A B].
-    eapply step_assign. eauto.
-    econstructor. eapply eval_var_ref_global. auto.
-    change (fst tgve) with tge. rewrite symbols_preserved. eauto.
-    eauto. assumption. 
-  (* access mode By_reference *)
-  intros ACC. rewrite ACC in H0. discriminate.
-  (* access mode By_nothing *)
-  intros. rewrite H1 in H0; discriminate.
-Qed.
-
-Lemma call_dest_correct:
-  forall e m lhs loc ofs tyenv optid te,
-  Csem.eval_lvalue ge e m lhs loc ofs ->
-  wt_expr tyenv lhs ->
-  transl_lhs_call (Some lhs) = OK optid ->
-  match_env tyenv e te ->
-  exists id,
-     optid = Some id
-  /\ tyenv!id = Some (typeof lhs)
-  /\ ofs = Int.zero
-  /\ match access_mode (typeof lhs) with
-     | By_value chunk => eval_var_ref tgve te id loc chunk
-     | _ => True
-     end.
-Proof.
-  intros. generalize H1. simpl. caseEq (is_variable lhs); try congruence.
-  intros id ISV EQ. inv EQ. 
-  exploit is_variable_correct; eauto. intro EQ.
-  rewrite EQ in H0. inversion H0. subst id0 ty. 
-  exists id. split; auto. split. rewrite EQ in H0. inversion H0. auto.
-  rewrite EQ in H. inversion H.
-(* local variable *)
-  split. auto. 
-  subst id0 ty l ofs. exploit me_local; eauto. 
-  intros [vk [A [B C]]].
-  case_eq (access_mode (typeof lhs)); intros; auto.
-  assert (vk = Vscalar m0).
-    exploit var_kind_by_value; eauto. congruence.
-  subst vk. apply eval_var_ref_local; auto.
-(* global variable *)
-  split. auto.
-  subst id0 ty l ofs. exploit me_global; eauto. intros [A B].
-  case_eq (access_mode (typeof lhs)); intros; auto.
-  apply eval_var_ref_global; auto.
-  simpl. rewrite <- H9. apply symbols_preserved. 
-Qed.
-
-Lemma set_call_dest_correct:
-  forall ty m loc v m' tyenv e te id,
-  store_value_of_type ty m loc Int.zero v = Some m' ->
-  match access_mode ty with
-  | By_value chunk => eval_var_ref tgve te id loc chunk
-  | _ => True
-  end ->
-  match_env tyenv e te ->
-  tyenv!id = Some ty ->
-  exec_opt_assign tgve te m (Some id) v m'.
-Proof.
-  intros. generalize H. unfold store_value_of_type. case_eq (access_mode ty); intros; try congruence.
-  rewrite H3 in H0. 
-  constructor. econstructor. eauto. auto.
-Qed.
-
-(** * Proof of semantic preservation *)
-
-(** ** Semantic preservation for expressions *)
-
-(** The proof of semantic preservation for the translation of expressions
-  relies on simulation diagrams of the following form:
-<<
-         e, m, a ------------------- te, m, ta
-            |                           |
-            |                           |
-            |                           |
-            v                           v
-         e, m, v ------------------- te, m, v
->>
-  Left: evaluation of r-value expression [a] in Clight.
-  Right: evaluation of its translation [ta] in Csharpminor.
-  Top (precondition): matching between environments [e], [te], 
-    plus well-typedness of expression [a].
-  Bottom (postcondition): the result values [v] 
-    are identical in both evaluations.
-
-  We state these diagrams as the following properties, parameterized
-  by the Clight evaluation. *)
-
-Section EXPR.
-
-Variable e: Csem.env.
-Variable m: mem.
-Variable te: Csharpminor.env.
-Variable tyenv: typenv.
-Hypothesis MENV: match_env tyenv e te.
-
-Definition eval_expr_prop (a: Csyntax.expr) (v: val) : Prop :=
-  forall ta
-    (WT: wt_expr tyenv a)
-    (TR: transl_expr a = OK ta),
-  Csharpminor.eval_expr tgve te m ta v.
-
-Definition eval_lvalue_prop (a: Csyntax.expr) (b: block) (ofs: int) : Prop :=
-  forall ta
-    (WT: wt_expr tyenv a)
-    (TR: transl_lvalue a = OK ta),
-  Csharpminor.eval_expr tgve te m ta (Vptr b ofs).
-
-Definition eval_exprlist_prop (al: list Csyntax.expr) (vl: list val) : Prop :=
-  forall tal
-    (WT: wt_exprlist tyenv al)
-    (TR: transl_exprlist al = OK tal),
-  Csharpminor.eval_exprlist tgve te m tal vl.
-
-(* Check (eval_expr_ind2 ge e m eval_expr_prop eval_lvalue_prop). *)
-
-Lemma transl_Econst_int_correct:
-  forall (i : int) (ty : type),
-  eval_expr_prop (Expr (Econst_int i) ty) (Vint i).
-Proof.
-  intros; red; intros.
-  monadInv TR. apply make_intconst_correct.
-Qed.
-
-Lemma transl_Econst_float_correct:
-  forall (f0 : float) (ty : type),
-  eval_expr_prop (Expr (Econst_float f0) ty) (Vfloat f0).
-Proof.
-  intros; red; intros.
-  monadInv TR. apply make_floatconst_correct.
-Qed.
-
-Lemma transl_Elvalue_correct:
-  forall (a : expr_descr) (ty : type) (loc : block) (ofs : int)
-         (v : val),
-  eval_lvalue ge e m (Expr a ty) loc ofs ->
-  eval_lvalue_prop (Expr a ty) loc ofs ->
-  load_value_of_type ty m loc ofs = Some v ->
-  eval_expr_prop (Expr a ty) v.
-Proof.
-  intros; red; intros.
-  exploit transl_expr_lvalue; eauto. 
-  intros [[id [EQ VARGET]] | [tb [TRLVAL MKLOAD]]].
-  (* Case a is a variable *)
-  subst a. eapply var_get_correct; eauto.
-  (* Case a is another lvalue *)
-  eapply make_load_correct; eauto. 
-Qed.
-
-Lemma transl_Eaddrof_correct:
-  forall (a : Csyntax.expr) (ty : type) (loc : block) (ofs : int),
-  eval_lvalue ge e m a loc ofs ->
-  eval_lvalue_prop a loc ofs ->
-  eval_expr_prop (Expr (Csyntax.Eaddrof a) ty) (Vptr loc ofs).
-Proof.
-  intros; red; intros. inversion WT; clear WT; subst. simpl in TR. 
-  eauto.
-Qed.
-
-Lemma transl_Esizeof_correct:
-  forall ty' ty : type,
-  eval_expr_prop (Expr (Esizeof ty') ty)
-                 (Vint (Int.repr (Csyntax.sizeof ty'))).
-Proof.
-  intros; red; intros. monadInv TR. apply make_intconst_correct. 
-Qed.
-
-Lemma transl_Eunop_correct:
-  forall (op : Csyntax.unary_operation) (a : Csyntax.expr) (ty : type)
-         (v1 v : val),
-  Csem.eval_expr ge e m a v1 ->
-  eval_expr_prop a v1 ->
-  sem_unary_operation op v1 (typeof a) = Some v ->
-  eval_expr_prop (Expr (Csyntax.Eunop op a) ty) v.
-Proof.
-  intros; red; intros.
-  inversion WT; clear WT; subst.
-  monadInv TR. 
-  eapply transl_unop_correct; eauto. 
-Qed.
-
-Lemma transl_Ebinop_correct:
-  forall (op : Csyntax.binary_operation) (a1 a2 : Csyntax.expr)
-         (ty : type) (v1 v2 v : val),
-  Csem.eval_expr ge e m a1 v1 ->
-  eval_expr_prop a1 v1 ->
-  Csem.eval_expr ge e m a2 v2 ->
-  eval_expr_prop a2 v2 ->
-  sem_binary_operation op v1 (typeof a1) v2 (typeof a2) m = Some v ->
-  eval_expr_prop (Expr (Csyntax.Ebinop op a1 a2) ty) v.
-Proof.
-  intros; red; intros.
-  inversion WT; clear WT; subst.
-  monadInv TR. 
-  eapply transl_binop_correct; eauto. 
-Qed.
-
-Lemma transl_Econdition_true_correct:
-  forall (a1 a2 a3 : Csyntax.expr) (ty : type) (v1 v2 : val),
-  Csem.eval_expr ge e m a1 v1 ->
-  eval_expr_prop a1 v1 ->
-  is_true v1 (typeof a1) ->
-  Csem.eval_expr ge e m a2 v2 ->
-  eval_expr_prop a2 v2 ->
-  eval_expr_prop (Expr (Csyntax.Econdition a1 a2 a3) ty) v2.
-Proof.
-  intros; red; intros. inv WT. monadInv TR. 
-  exploit make_boolean_correct_true. eapply H0; eauto. eauto.
-  intros [vb [EVAL ISTRUE]].
-  eapply eval_Econdition; eauto. apply Val.bool_of_true_val; eauto.
-  simpl. eauto. 
-Qed.
-
-Lemma transl_Econdition_false_correct:
-  forall (a1 a2 a3 : Csyntax.expr) (ty : type) (v1 v3 : val),
-  Csem.eval_expr ge e m a1 v1 ->
-  eval_expr_prop a1 v1 ->
-  is_false v1 (typeof a1) ->
-  Csem.eval_expr ge e m a3 v3 ->
-  eval_expr_prop a3 v3 ->
-  eval_expr_prop (Expr (Csyntax.Econdition a1 a2 a3) ty) v3.
-Proof.
-  intros; red; intros. inv WT. monadInv TR. 
-  exploit make_boolean_correct_false. eapply H0; eauto. eauto.
-  intros [vb [EVAL ISTRUE]].
-  eapply eval_Econdition; eauto. apply Val.bool_of_false_val; eauto.
-  simpl. eauto. 
-Qed.
-
-Lemma transl_Eorbool_1_correct:
-  forall (a1 a2 : Csyntax.expr) (ty : type) (v1 : val),
-  Csem.eval_expr ge e m a1 v1 ->
-  eval_expr_prop a1 v1 ->
-  is_true v1 (typeof a1) ->
-  eval_expr_prop (Expr (Eorbool a1 a2) ty) Vtrue.
-Proof.
-  intros; red; intros. inversion WT; clear WT; subst. monadInv TR.
-  unfold make_orbool.
-  exploit make_boolean_correct_true; eauto. intros [vb [EVAL ISTRUE]].
-  eapply eval_Econdition; eauto. apply Val.bool_of_true_val; eauto.
-  simpl. unfold Vtrue; apply make_intconst_correct. 
-Qed.
-
-Lemma transl_Eorbool_2_correct:
-  forall (a1 a2 : Csyntax.expr) (ty : type) (v1 v2 v : val),
-  Csem.eval_expr ge e m a1 v1 ->
-  eval_expr_prop a1 v1 ->
-  is_false v1 (typeof a1) ->
-  Csem.eval_expr ge e m a2 v2 ->
-  eval_expr_prop a2 v2 ->
-  bool_of_val v2 (typeof a2) v ->
-  eval_expr_prop (Expr (Eorbool a1 a2) ty) v.
-Proof.
-  intros; red; intros. inversion WT; clear WT; subst. monadInv TR.
-  unfold make_orbool.
-  exploit make_boolean_correct_false. eapply H0; eauto. eauto. intros [vb [EVAL ISFALSE]].
-  eapply eval_Econdition; eauto. apply Val.bool_of_false_val; eauto.
-  simpl. inversion H4; subst.
-  exploit make_boolean_correct_true. eapply H3; eauto. eauto. intros [vc [EVAL' ISTRUE']].
-  eapply eval_Econdition; eauto. apply Val.bool_of_true_val; eauto. 
-  unfold Vtrue; apply make_intconst_correct.
-  exploit make_boolean_correct_false. eapply H3; eauto. eauto. intros [vc [EVAL' ISFALSE']].
-  eapply eval_Econdition; eauto. apply Val.bool_of_false_val; eauto. 
-  unfold Vfalse; apply make_intconst_correct. 
-Qed.
-
-Lemma transl_Eandbool_1_correct:
-  forall (a1 a2 : Csyntax.expr) (ty : type) (v1 : val),
-  Csem.eval_expr ge e m a1 v1 ->
-  eval_expr_prop a1 v1 ->
-  is_false v1 (typeof a1) ->
-  eval_expr_prop (Expr (Eandbool a1 a2) ty) Vfalse.
-Proof.
-  intros; red; intros. inversion WT; clear WT; subst. monadInv TR.
-  unfold make_andbool.
-  exploit make_boolean_correct_false; eauto. intros [vb [EVAL ISFALSE]].
-  eapply eval_Econdition; eauto. apply Val.bool_of_false_val; eauto. 
-  unfold Vfalse; apply make_intconst_correct. 
-Qed.
-
-Lemma transl_Eandbool_2_correct:
-  forall (a1 a2 : Csyntax.expr) (ty : type) (v1 v2 v : val),
-  Csem.eval_expr ge e m a1 v1 ->
-  eval_expr_prop a1 v1 ->
-  is_true v1 (typeof a1) ->
-  Csem.eval_expr ge e m a2 v2 ->
-  eval_expr_prop a2 v2 ->
-  bool_of_val v2 (typeof a2) v ->
-  eval_expr_prop (Expr (Eandbool a1 a2) ty) v.
-Proof.
-  intros; red; intros. inversion WT; clear WT; subst. monadInv TR.
-  unfold make_andbool.
-  exploit make_boolean_correct_true. eapply H0; eauto. eauto. intros [vb [EVAL ISTRUE]].
-  eapply eval_Econdition; eauto. apply Val.bool_of_true_val; eauto. 
-  simpl. inversion H4; subst.
-  exploit make_boolean_correct_true. eapply H3; eauto. eauto. intros [vc [EVAL' ISTRUE']].
-  eapply eval_Econdition; eauto. apply Val.bool_of_true_val; eauto.
-  unfold Vtrue; apply make_intconst_correct.
-  exploit make_boolean_correct_false. eapply H3; eauto. eauto. intros [vc [EVAL' ISFALSE']].
-  eapply eval_Econdition; eauto. apply Val.bool_of_false_val; eauto.
-  unfold Vfalse; apply make_intconst_correct.
-Qed.
-
-Lemma transl_Ecast_correct:
-  forall (a : Csyntax.expr) (ty ty': type) (v1 v : val),
-  Csem.eval_expr ge e m a v1 ->
-  eval_expr_prop a v1 ->
-  cast v1 (typeof a) ty v -> eval_expr_prop (Expr (Ecast ty a) ty') v.
-Proof.
-  intros; red; intros. inversion WT; clear WT; subst. monadInv TR.
-  eapply make_cast_correct; eauto.
-Qed.
-
-Lemma transl_Evar_local_correct:
-  forall (id : ident) (l : block) (ty : type),
-  e ! id = Some(l, ty) ->
-  eval_lvalue_prop (Expr (Csyntax.Evar id) ty) l Int.zero.
-Proof.
-  intros; red; intros. inversion WT; clear WT; subst. monadInv TR.
-  exploit (me_local _ _ _ MENV); eauto.
-  intros [vk [A [B C]]].
-  econstructor. eapply eval_var_addr_local. eauto. 
-Qed.
-
-Lemma transl_Evar_global_correct:
-  forall (id : ident) (l : block) (ty : type),
-  e ! id = None ->
-  Genv.find_symbol ge id = Some l ->
-  eval_lvalue_prop (Expr (Csyntax.Evar id) ty) l Int.zero.
-Proof.
-  intros; red; intros. inversion WT; clear WT; subst. monadInv TR. 
-  exploit (me_global _ _ _ MENV); eauto. intros [A B].
-  econstructor. eapply eval_var_addr_global. eauto. 
-  rewrite symbols_preserved. auto.
-Qed.
-
-Lemma transl_Ederef_correct:
-  forall (a : Csyntax.expr) (ty : type) (l : block) (ofs : int),
-  Csem.eval_expr ge e m a (Vptr l ofs) ->
-  eval_expr_prop a (Vptr l ofs) ->
-  eval_lvalue_prop (Expr (Ederef a) ty) l ofs.
-Proof.
-  intros; red; intros. inversion WT; clear WT; subst. simpl in TR. 
-  eauto.
-Qed.
-
-Lemma transl_Efield_struct_correct:
-  forall (a : Csyntax.expr) (i : ident) (ty : type) (l : block)
-         (ofs : int) (id : ident) (fList : fieldlist) (delta : Z),
-  eval_lvalue ge e m a l ofs ->
-  eval_lvalue_prop a l ofs ->
-  typeof a = Tstruct id fList ->
-  field_offset i fList = OK delta ->
-  eval_lvalue_prop (Expr (Efield a i) ty) l (Int.add ofs (Int.repr delta)).
-Proof.
-  intros; red; intros. inversion WT; clear WT; subst. 
-  simpl in TR. rewrite H1 in TR. monadInv TR.
-  eapply eval_Ebinop; eauto.
-  apply make_intconst_correct. 
-  simpl. congruence.
-Qed.
-
-Lemma transl_Efield_union_correct:
-  forall (a : Csyntax.expr) (i : ident) (ty : type) (l : block)
-         (ofs : int) (id : ident) (fList : fieldlist),
-  eval_lvalue ge e m a l ofs ->
-  eval_lvalue_prop a l ofs ->
-  typeof a = Tunion id fList ->
-  eval_lvalue_prop (Expr (Efield a i) ty) l ofs.
-Proof.
-  intros; red; intros. inversion WT; clear WT; subst. 
-  simpl in TR. rewrite H1 in TR. eauto.
-Qed.
-
-Lemma transl_expr_correct:
-  forall a v,
-  Csem.eval_expr ge e m a v ->
-  eval_expr_prop a v.
-Proof
-  (eval_expr_ind2 ge e m eval_expr_prop eval_lvalue_prop
-         transl_Econst_int_correct
-         transl_Econst_float_correct
-         transl_Elvalue_correct
-         transl_Eaddrof_correct
-         transl_Esizeof_correct
-         transl_Eunop_correct
-         transl_Ebinop_correct
-         transl_Econdition_true_correct
-         transl_Econdition_false_correct
-         transl_Eorbool_1_correct
-         transl_Eorbool_2_correct
-         transl_Eandbool_1_correct
-         transl_Eandbool_2_correct
-         transl_Ecast_correct
-         transl_Evar_local_correct
-         transl_Evar_global_correct
-         transl_Ederef_correct
-         transl_Efield_struct_correct
-         transl_Efield_union_correct).
-
-Lemma transl_lvalue_correct:
-  forall a blk ofs,
-  Csem.eval_lvalue ge e m a blk ofs ->
-  eval_lvalue_prop a blk ofs.
-Proof
-  (eval_lvalue_ind2 ge e m eval_expr_prop eval_lvalue_prop
-         transl_Econst_int_correct
-         transl_Econst_float_correct
-         transl_Elvalue_correct
-         transl_Eaddrof_correct
-         transl_Esizeof_correct
-         transl_Eunop_correct
-         transl_Ebinop_correct
-         transl_Econdition_true_correct
-         transl_Econdition_false_correct
-         transl_Eorbool_1_correct
-         transl_Eorbool_2_correct
-         transl_Eandbool_1_correct
-         transl_Eandbool_2_correct
-         transl_Ecast_correct
-         transl_Evar_local_correct
-         transl_Evar_global_correct
-         transl_Ederef_correct
-         transl_Efield_struct_correct
-         transl_Efield_union_correct).
-
-Lemma transl_exprlist_correct:
-  forall al vl,
-  Csem.eval_exprlist ge e m al vl ->
-  eval_exprlist_prop al vl.
-Proof.
-  induction 1; red; intros; monadInv TR; inv WT.
-  constructor.
-  constructor. eapply (transl_expr_correct _ _ H); eauto. eauto.
-Qed.
-
-End EXPR.
-
-Lemma exit_if_false_true:
-  forall a ts e m v tyenv te f tk,
-  exit_if_false a = OK ts ->
-  Csem.eval_expr ge e m a v ->
-  is_true v (typeof a) ->
-  match_env tyenv e te ->
-  wt_expr tyenv a ->
-  step tgve (State f ts tk te m) E0 (State f Sskip tk te m).
-Proof.
-  intros. monadInv H.
-  exploit make_boolean_correct_true.
-    eapply (transl_expr_correct _ _ _ _ H2 _ _ H0); eauto.
-    eauto.
-  intros [vb [EVAL ISTRUE]].
-  change Sskip with (if true then Sskip else Sexit 0).
-  eapply step_ifthenelse; eauto. 
-  apply Val.bool_of_true_val; eauto.  
-Qed.
- 
-Lemma exit_if_false_false:
-  forall a ts e m v tyenv te f tk,
-  exit_if_false a = OK ts ->
-  Csem.eval_expr ge e m a v ->
-  is_false v (typeof a) ->
-  match_env tyenv e te ->
-  wt_expr tyenv a ->
-  step tgve (State f ts tk te m) E0 (State f (Sexit 0) tk te m).
-Proof.
-  intros. monadInv H.
-  exploit make_boolean_correct_false.
-    eapply (transl_expr_correct _ _ _ _ H2 _ _ H0); eauto.
-    eauto.
-  intros [vb [EVAL ISFALSE]].
-  change (Sexit 0) with (if false then Sskip else Sexit 0).
-  eapply step_ifthenelse; eauto. 
-  apply Val.bool_of_false_val; eauto. 
-Qed.
-
-(** ** Semantic preservation for statements *)
-
-(** The simulation diagram for the translation of statements and functions
-  is a "plus" diagram of the form
-<<
-           I
-     S1 ------- R1
-     |          | 
-   t |        + | t
-     v          v  
-     S2 ------- R2
-           I                         I
->>
-
-The invariant [I] is the [match_states] predicate that we now define.
-*)
-
-Definition typenv_fun (f: Csyntax.function) :=
-  add_vars (global_typenv prog) (f.(Csyntax.fn_params) ++ f.(Csyntax.fn_vars)).
-
-Inductive match_transl: stmt -> cont -> stmt -> cont -> Prop :=
-  | match_transl_0: forall ts tk,
-      match_transl ts tk ts tk
-  | match_transl_1: forall ts tk,
-      match_transl (Sblock ts) tk ts (Kblock tk).
-
-Lemma match_transl_step:
-  forall ts tk ts' tk' f te m,
-  match_transl (Sblock ts) tk ts' tk' ->
-  star step tgve (State f ts' tk' te m) E0 (State f ts (Kblock tk) te m).
-Proof.
-  intros. inv H. 
-  apply star_one. constructor. 
-  apply star_refl.
-Qed.
-
-Inductive match_cont: typenv -> nat -> nat -> Csem.cont -> Csharpminor.cont -> Prop :=
-  | match_Kstop: forall tyenv nbrk ncnt,
-      match_cont tyenv nbrk ncnt Csem.Kstop Kstop
-  | match_Kseq: forall tyenv nbrk ncnt s k ts tk,
-      transl_statement nbrk ncnt s = OK ts ->
-      wt_stmt tyenv s ->
-      match_cont tyenv nbrk ncnt k tk ->
-      match_cont tyenv nbrk ncnt
-                 (Csem.Kseq s k)
-                 (Kseq ts tk)
-  | match_Kwhile: forall tyenv nbrk ncnt a s k ta ts tk,
-      exit_if_false a = OK ta ->
-      transl_statement 1%nat 0%nat s = OK ts ->
-      wt_expr tyenv a ->
-      wt_stmt tyenv s ->
-      match_cont tyenv nbrk ncnt k tk ->
-      match_cont tyenv 1%nat 0%nat
-                 (Csem.Kwhile a s k) 
-                 (Kblock (Kseq (Sloop (Sseq ta (Sblock ts))) (Kblock tk)))
-  | match_Kdowhile: forall tyenv nbrk ncnt a s k ta ts tk,
-      exit_if_false a = OK ta ->
-      transl_statement 1%nat 0%nat s = OK ts ->
-      wt_expr tyenv a ->
-      wt_stmt tyenv s ->
-      match_cont tyenv nbrk ncnt k tk ->
-      match_cont tyenv 1%nat 0%nat
-                 (Csem.Kdowhile a s k) 
-                 (Kblock (Kseq ta (Kseq (Sloop (Sseq (Sblock ts) ta)) (Kblock tk))))
-  | match_Kfor2: forall tyenv nbrk ncnt a2 a3 s k ta2 ta3 ts tk,
-      exit_if_false a2 = OK ta2 ->
-      transl_statement nbrk ncnt a3 = OK ta3 ->
-      transl_statement 1%nat 0%nat s = OK ts ->
-      wt_expr tyenv a2 -> wt_stmt tyenv a3 -> wt_stmt tyenv s ->
-      match_cont tyenv nbrk ncnt k tk ->
-      match_cont tyenv 1%nat 0%nat
-                 (Csem.Kfor2 a2 a3 s k)
-                 (Kblock (Kseq ta3 (Kseq (Sloop (Sseq ta2 (Sseq (Sblock ts) ta3))) (Kblock tk))))
-  | match_Kfor3: forall tyenv nbrk ncnt a2 a3 s k ta2 ta3 ts tk,
-      exit_if_false a2 = OK ta2 ->
-      transl_statement nbrk ncnt a3 = OK ta3 ->
-      transl_statement 1%nat 0%nat s = OK ts ->
-      wt_expr tyenv a2 -> wt_stmt tyenv a3 -> wt_stmt tyenv s ->
-      match_cont tyenv nbrk ncnt k tk ->
-      match_cont tyenv nbrk ncnt
-                 (Csem.Kfor3 a2 a3 s k)
-                 (Kseq (Sloop (Sseq ta2 (Sseq (Sblock ts) ta3))) (Kblock tk))
-  | match_Kswitch: forall tyenv nbrk ncnt k tk,
-      match_cont tyenv nbrk ncnt k tk ->
-      match_cont tyenv 0%nat (S ncnt)
-                 (Csem.Kswitch k)
-                 (Kblock tk)
-  | match_Kcall_none: forall tyenv nbrk ncnt nbrk' ncnt' f e k tf te tk,
-      transl_function f = OK tf ->
-      wt_stmt (typenv_fun f) f.(Csyntax.fn_body) ->
-      match_env (typenv_fun f) e te ->
-      match_cont (typenv_fun f) nbrk' ncnt' k tk ->
-      match_cont tyenv nbrk ncnt
-                 (Csem.Kcall None f e k)
-                 (Kcall None tf te tk)
-  | match_Kcall_some: forall tyenv nbrk ncnt nbrk' ncnt' loc ofs ty f e k id tf te tk,
-      transl_function f = OK tf ->
-      wt_stmt (typenv_fun f) f.(Csyntax.fn_body) ->
-      match_env (typenv_fun f) e te ->
-      ofs = Int.zero ->
-      (typenv_fun f)!id = Some ty ->
-      match access_mode ty with
-      | By_value chunk => eval_var_ref tgve te id loc chunk
-      | _ => True
-      end ->
-      match_cont (typenv_fun f) nbrk' ncnt' k tk ->
-      match_cont tyenv nbrk ncnt 
-                 (Csem.Kcall (Some(loc, ofs, ty)) f e k)
-                 (Kcall (Some id) tf te tk).
-
-Inductive match_states: Csem.state -> Csharpminor.state -> Prop :=
-  | match_state:
-      forall f nbrk ncnt s k e m tf ts tk te ts' tk'
-          (TRF: transl_function f = OK tf)
-          (TR: transl_statement nbrk ncnt s = OK ts)
-          (MTR: match_transl ts tk ts' tk')
-          (WTF: wt_stmt (typenv_fun f) f.(Csyntax.fn_body))
-          (WT: wt_stmt (typenv_fun f) s)
-          (MENV: match_env (typenv_fun f) e te)
-          (MK: match_cont (typenv_fun f) nbrk ncnt k tk),
-      match_states (Csem.State f s k e m)
-                   (State tf ts' tk' te m)
-  | match_callstate:
-      forall fd args k m tfd tk
-          (TR: transl_fundef fd = OK tfd)
-          (WT: wt_fundef (global_typenv prog) fd)
-          (MK: match_cont (global_typenv prog) 0%nat 0%nat k tk)
-          (ISCC: Csem.is_call_cont k),
-      match_states (Csem.Callstate fd args k m)
-                   (Callstate tfd args tk m)
-  | match_returnstate:
-      forall res k m tk 
-          (MK: match_cont (global_typenv prog) 0%nat 0%nat k tk),
-      match_states (Csem.Returnstate res k m)
-                   (Returnstate res tk m).
-
-Remark match_states_skip:
-  forall f e te nbrk ncnt k tf tk m,
-  transl_function f = OK tf ->
-  wt_stmt (typenv_fun f) f.(Csyntax.fn_body) ->
-  match_env (typenv_fun f) e te ->
-  match_cont (typenv_fun f) nbrk ncnt k tk ->
-  match_states (Csem.State f Csyntax.Sskip k e m) (State tf Sskip tk te m).
-Proof.
-  intros. econstructor; eauto. simpl; reflexivity. constructor. constructor.
-Qed.
-
-(** Commutation between label resolution and compilation *)
-
-Section FIND_LABEL.
-Variable lbl: label.
-Variable tyenv: typenv.
-
-Remark exit_if_false_no_label:
-  forall a s, exit_if_false a = OK s -> forall k, find_label lbl s k = None.
-Proof.
-  intros. unfold exit_if_false in H. monadInv H. simpl. auto.
-Qed.
-  
-Lemma transl_find_label:
-  forall s nbrk ncnt k ts tk
-  (WT: wt_stmt tyenv s)
-  (TR: transl_statement nbrk ncnt s = OK ts)
-  (MC: match_cont tyenv nbrk ncnt k tk),
-  match Csem.find_label lbl s k with
-  | None => find_label lbl ts tk = None
-  | Some (s', k') =>
-      exists ts', exists tk', exists nbrk', exists ncnt',
-      find_label lbl ts tk = Some (ts', tk')
-      /\ transl_statement nbrk' ncnt' s' = OK ts'
-      /\ match_cont tyenv nbrk' ncnt' k' tk'
-      /\ wt_stmt tyenv s'
-  end
-
-with transl_find_label_ls:
-  forall ls nbrk ncnt k tls tk
-  (WT: wt_lblstmts tyenv ls)
-  (TR: transl_lbl_stmt nbrk ncnt ls = OK tls)
-  (MC: match_cont tyenv nbrk ncnt k tk),
-  match Csem.find_label_ls lbl ls k with
-  | None => find_label_ls lbl tls tk = None
-  | Some (s', k') =>
-      exists ts', exists tk', exists nbrk', exists ncnt',
-      find_label_ls lbl tls tk = Some (ts', tk')
-      /\ transl_statement nbrk' ncnt' s' = OK ts'
-      /\ match_cont tyenv nbrk' ncnt' k' tk'
-      /\ wt_stmt tyenv s'
-  end.
-
-Proof.
-  intro s; case s; intros; inv WT; try (monadInv TR); simpl.
-(* skip *)
-  auto.
-(* assign *)
-  simpl in TR. destruct (is_variable e); monadInv TR.
-  unfold var_set in EQ0. destruct (access_mode (typeof e)); inv EQ0. auto.
-  unfold make_store in EQ2. destruct (access_mode (typeof e)); inv EQ2. auto.
-(* call *)
-  simpl in TR. destruct (classify_fun (typeof e)); monadInv TR. auto.
-(* seq *)
-  exploit (transl_find_label s0 nbrk ncnt (Csem.Kseq s1 k)); eauto. constructor; eauto. 
-  destruct (Csem.find_label lbl s0 (Csem.Kseq s1 k)) as [[s' k'] | ].
-  intros [ts' [tk' [nbrk' [ncnt' [A [B [C D]]]]]]].
-  rewrite A. exists ts'; exists tk'; exists nbrk'; exists ncnt'; auto.
-  intro. rewrite H. eapply transl_find_label; eauto.
-(* ifthenelse *)
-  exploit (transl_find_label s0); eauto. 
-  destruct (Csem.find_label lbl s0 k) as [[s' k'] | ].
-  intros [ts' [tk' [nbrk' [ncnt' [A [B [C D]]]]]]].
-  rewrite A. exists ts'; exists tk'; exists nbrk'; exists ncnt'; auto.
-  intro. rewrite H. eapply transl_find_label; eauto.
-(* while *)
-  rewrite (exit_if_false_no_label _ _ EQ).
-  eapply transl_find_label; eauto. econstructor; eauto.
-(* dowhile *)
-  exploit (transl_find_label s0 1%nat 0%nat (Csem.Kdowhile e s0 k)); eauto. econstructor; eauto.
-  destruct (Csem.find_label lbl s0 (Kdowhile e s0 k)) as [[s' k'] | ].
-  intros [ts' [tk' [nbrk' [ncnt' [A [B [C D]]]]]]].
-  rewrite A. exists ts'; exists tk'; exists nbrk'; exists ncnt'; auto.
-  intro. rewrite H. eapply exit_if_false_no_label; eauto.
-(* for *)
-  simpl in TR. destruct (is_Sskip s0); monadInv TR. 
-  simpl. rewrite (exit_if_false_no_label _ _ EQ). 
-  exploit (transl_find_label s2 1%nat 0%nat (Kfor2 e s1 s2 k)); eauto. econstructor; eauto.
-  destruct (Csem.find_label lbl s2 (Kfor2 e s1 s2 k)) as [[s' k'] | ].
-  intros [ts' [tk' [nbrk' [ncnt' [A [B [C D]]]]]]].
-  rewrite A. exists ts'; exists tk'; exists nbrk'; exists ncnt'; auto.
-  intro. rewrite H.
-  eapply transl_find_label; eauto. econstructor; eauto.
-  exploit (transl_find_label s0 nbrk ncnt (Csem.Kseq (Sfor Csyntax.Sskip e s1 s2) k)); eauto.
-  econstructor; eauto. simpl. rewrite is_Sskip_true. rewrite EQ1; simpl. rewrite EQ0; simpl. rewrite EQ2; simpl. reflexivity.
-  constructor; auto. constructor. 
-  simpl. rewrite (exit_if_false_no_label _ _ EQ1). 
-  destruct (Csem.find_label lbl s0 (Csem.Kseq (Sfor Csyntax.Sskip e s1 s2) k)) as [[s' k'] | ].
-  intros [ts' [tk' [nbrk' [ncnt' [A [B [C D]]]]]]].
-  rewrite A. exists ts'; exists tk'; exists nbrk'; exists ncnt'; auto.
-  intro. rewrite H. 
-  exploit (transl_find_label s2 1%nat 0%nat (Kfor2 e s1 s2 k)); eauto. econstructor; eauto.
-  destruct (Csem.find_label lbl s2 (Kfor2 e s1 s2 k)) as [[s' k'] | ].
-  intros [ts' [tk' [nbrk' [ncnt' [A [B [C D]]]]]]].
-  rewrite A. exists ts'; exists tk'; exists nbrk'; exists ncnt'; auto.
-  intro. rewrite H0.
-  eapply transl_find_label; eauto. econstructor; eauto.
-(* break *)
-  auto.
-(* continue *)
-  auto.
-(* return *)
-  simpl in TR. destruct o; monadInv TR. auto. auto. 
-(* switch *)
-  eapply transl_find_label_ls with (k := Csem.Kswitch k); eauto. econstructor; eauto. 
-(* label *)
-  destruct (ident_eq lbl l). 
-  exists x; exists tk; exists nbrk; exists ncnt; auto.
-  eapply transl_find_label; eauto.
-(* goto *)
-  auto.
-
-  intro ls; case ls; intros; inv WT; monadInv TR; simpl.
-(* default *)
-  eapply transl_find_label; eauto.
-(* case *)
-  exploit (transl_find_label s nbrk ncnt (Csem.Kseq (seq_of_labeled_statement l) k)); eauto. 
-  econstructor; eauto. apply transl_lbl_stmt_2; eauto.
-  apply wt_seq_of_labeled_statement; auto.
-  destruct (Csem.find_label lbl s (Csem.Kseq (seq_of_labeled_statement l) k)) as [[s' k'] | ].
-  intros [ts' [tk' [nbrk' [ncnt' [A [B [C D]]]]]]].
-  rewrite A. exists ts'; exists tk'; exists nbrk'; exists ncnt'; auto.
-  intro. rewrite H.
-  eapply transl_find_label_ls; eauto.
-Qed.
-
-End FIND_LABEL.
-
-(** Properties of call continuations *)
-
-Lemma match_cont_call_cont:
-  forall nbrk' ncnt' tyenv' tyenv nbrk ncnt k tk,
-  match_cont tyenv nbrk ncnt k tk ->
-  match_cont tyenv' nbrk' ncnt' (Csem.call_cont k) (call_cont tk).
-Proof.
-  induction 1; simpl; auto.
-  constructor.
-  econstructor; eauto. 
-  econstructor; eauto.
-Qed.
-
-Lemma match_cont_is_call_cont:
-  forall typenv nbrk ncnt k tk typenv' nbrk' ncnt',
-  match_cont typenv nbrk ncnt k tk ->
-  Csem.is_call_cont k ->
-  match_cont typenv' nbrk' ncnt' k tk /\ is_call_cont tk.
-Proof.
-  intros. inv H; simpl in H0; try contradiction; simpl; intuition.
-  constructor. 
-  econstructor; eauto. 
-  econstructor; eauto.
-Qed.
-
-(** The simulation proof *)
-
-Lemma transl_step:
-  forall S1 t S2, Csem.step ge S1 t S2 ->
-  forall T1, match_states S1 T1 ->
-  exists T2, plus step tgve T1 t T2 /\ match_states S2 T2.
-Proof.
-  induction 1; intros T1 MST; inv MST.
-
-(* assign *)
-  simpl in TR. inv WT. 
-  case_eq (is_variable a1); intros. 
-  rewrite H2 in TR. monadInv TR. 
-  exploit is_variable_correct; eauto. intro EQ1. rewrite EQ1 in H.
-  assert (ts' = ts /\ tk' = tk).
-    inversion MTR. auto. 
-    subst ts. unfold var_set in EQ0. destruct (access_mode (typeof a1)); congruence.
-  destruct H3; subst ts' tk'.
-  econstructor; split.
-  apply plus_one. eapply var_set_correct; eauto. congruence. 
-  exploit transl_expr_correct; eauto.
-  eapply match_states_skip; eauto.
-
-  rewrite H2 in TR. monadInv TR. 
-  assert (ts' = ts /\ tk' = tk).
-    inversion MTR. auto. 
-    subst ts. unfold make_store in EQ2. destruct (access_mode (typeof a1)); congruence.
-  destruct H3; subst ts' tk'.
-  econstructor; split.
-  apply plus_one. eapply make_store_correct; eauto.
-  exploit transl_lvalue_correct; eauto.
-  exploit transl_expr_correct; eauto.
-  eapply match_states_skip; eauto.
-
-(* call none *)
-  generalize TR. simpl. case_eq (classify_fun (typeof a)); try congruence.
-  intros targs tres CF TR'. monadInv TR'. inv MTR. inv WT.
-  exploit functions_translated; eauto. intros [tfd [FIND TFD]].
-  econstructor; split.
-  apply plus_one. econstructor; eauto. 
-  exploit transl_expr_correct; eauto.
-  exploit transl_exprlist_correct; eauto.
-  eapply transl_fundef_sig1; eauto. eapply functions_well_typed; eauto.
-  congruence.
-  econstructor; eauto. eapply functions_well_typed; eauto. 
-  econstructor; eauto. simpl. auto. 
-
-(* call some *)
-  generalize TR. simpl. case_eq (classify_fun (typeof a)); try congruence.
-  intros targs tres CF TR'. monadInv TR'. inv MTR. inv WT.
-  exploit functions_translated; eauto. intros [tfd [FIND TFD]].
-  inv H7. exploit call_dest_correct; eauto.
-  intros [id [A [B [C D]]]]. subst x ofs. 
-  econstructor; split.
-  apply plus_one. econstructor; eauto. 
-  exploit transl_expr_correct; eauto.
-  exploit transl_exprlist_correct; eauto.
-  eapply transl_fundef_sig1; eauto. eapply functions_well_typed; eauto.
-  congruence.
-  econstructor; eauto. eapply functions_well_typed; eauto.
-  econstructor; eauto. simpl; auto. 
-
-(* seq *)
-  monadInv TR. inv WT. inv MTR.
-  econstructor; split.
-  apply plus_one. constructor. 
-  econstructor; eauto. constructor. 
-  econstructor; eauto.
-
-(* skip seq *)
-  monadInv TR. inv MTR. inv MK.
-  econstructor; split.
-  apply plus_one. apply step_skip_seq. 
-  econstructor; eauto. constructor.
-
-(* continue seq *)
-  monadInv TR. inv MTR. inv MK.
-  econstructor; split.
-  apply plus_one. constructor. 
-  econstructor; eauto. simpl. reflexivity. constructor.
-
-(* break seq *)
-  monadInv TR. inv MTR. inv MK.
-  econstructor; split.
-  apply plus_one. constructor. 
-  econstructor; eauto. simpl. reflexivity. constructor.
-
-(* ifthenelse true *)
-  monadInv TR. inv MTR. inv WT.
-  exploit make_boolean_correct_true; eauto. 
-  exploit transl_expr_correct; eauto.
-  intros [v [A B]].
-  econstructor; split.
-  apply plus_one. apply step_ifthenelse with (v := v) (b := true). 
-  auto. apply Val.bool_of_true_val. auto.
-  econstructor; eauto. constructor.
-
-(* ifthenelse false *)
-  monadInv TR. inv MTR. inv WT.
-  exploit make_boolean_correct_false; eauto. 
-  exploit transl_expr_correct; eauto.
-  intros [v [A B]].
-  econstructor; split.
-  apply plus_one. apply step_ifthenelse with (v := v) (b := false). 
-  auto. apply Val.bool_of_false_val. auto.
-  econstructor; eauto. constructor.
-
-(* while false *)
-  monadInv TR. inv WT.
-  econstructor; split.
-  eapply star_plus_trans. eapply match_transl_step; eauto. 
-  eapply plus_left. constructor. 
-  eapply star_left. constructor.
-  eapply star_left. eapply exit_if_false_false; eauto.
-  eapply star_left. constructor. 
-  eapply star_left. constructor.
-  apply star_one. constructor.
-  reflexivity. reflexivity. reflexivity. reflexivity. reflexivity. traceEq.
-  eapply match_states_skip; eauto.
-
-(* while true *)
-  monadInv TR. inv WT.
-  econstructor; split.
-  eapply star_plus_trans. eapply match_transl_step; eauto. 
-  eapply plus_left. constructor.
-  eapply star_left. constructor.
-  eapply star_left. eapply exit_if_false_true; eauto.
-  eapply star_left. constructor.
-  apply star_one. constructor.
-  reflexivity. reflexivity. reflexivity. reflexivity. traceEq.
-  econstructor; eauto. constructor. 
-  econstructor; eauto.
-
-(* skip or continue while *)
-  assert ((ts' = Sskip \/ ts' = Sexit ncnt) /\ tk' = tk).
-    destruct H; subst x; monadInv TR; inv MTR; auto.
-  destruct H0. inv MK.
-  econstructor; split.
-  eapply plus_left.
-  destruct H0; subst ts'; constructor. 
-  apply star_one. constructor. traceEq.
-  econstructor; eauto.
-  simpl. rewrite H5; simpl. rewrite H6; simpl. reflexivity.
-  constructor. constructor; auto.
-
-(* break while *)
-  monadInv TR. inv MTR. inv MK.
-  econstructor; split.
-  eapply plus_left. constructor.
-  eapply star_left. constructor.
-  apply star_one. constructor.
-  reflexivity. traceEq.
-  eapply match_states_skip; eauto.
-
-(* dowhile *)
-  monadInv TR. inv WT.
-  econstructor; split.
-  eapply star_plus_trans. eapply match_transl_step; eauto. 
-  eapply plus_left. constructor.
-  eapply star_left. constructor.
-  apply star_one. constructor.
-  reflexivity. reflexivity. traceEq.
-  econstructor; eauto. constructor.
-  econstructor; eauto.
-
-(* skip or continue dowhile false *)
-  assert ((ts' = Sskip \/ ts' = Sexit ncnt) /\ tk' = tk).
-    destruct H; subst x; monadInv TR; inv MTR; auto.
-  destruct H2. inv MK.
-  econstructor; split.
-  eapply plus_left. destruct H2; subst ts'; constructor.
-  eapply star_left. constructor.
-  eapply star_left. eapply exit_if_false_false; eauto.
-  eapply star_left. constructor.
-  apply star_one. constructor.
-  reflexivity. reflexivity. reflexivity. traceEq.
-  eapply match_states_skip; eauto.
-
-(* skip or continue dowhile true *)
-  assert ((ts' = Sskip \/ ts' = Sexit ncnt) /\ tk' = tk).
-    destruct H; subst x; monadInv TR; inv MTR; auto.
-  destruct H2. inv MK.
-  econstructor; split.
-  eapply plus_left. destruct H2; subst ts'; constructor.
-  eapply star_left. constructor.
-  eapply star_left. eapply exit_if_false_true; eauto.
-  apply star_one. constructor.
-  reflexivity. reflexivity. traceEq.
-  econstructor; eauto.
-  simpl. rewrite H7; simpl. rewrite H8; simpl. reflexivity. constructor.
-  constructor; auto.
-
-(* break dowhile *)
-  monadInv TR. inv MTR. inv MK.
-  econstructor; split.
-  eapply plus_left. constructor.
-  eapply star_left. constructor.
-  eapply star_left. constructor.
-  apply star_one. constructor.
-  reflexivity. reflexivity. traceEq.
-  eapply match_states_skip; eauto.
-
-(* for start *)
-  simpl in TR. rewrite is_Sskip_false in TR; auto. monadInv TR. inv MTR. inv WT.
-  econstructor; split.
-  apply plus_one. constructor. 
-  econstructor; eauto. constructor.
-  constructor; auto. simpl. rewrite is_Sskip_true. rewrite EQ1; simpl. rewrite EQ0; simpl. rewrite EQ2; auto. 
-  constructor; auto. constructor.
-
-(* for false *)
-  simpl in TR. rewrite is_Sskip_true in TR. monadInv TR. inv WT.
-  econstructor; split.
-  eapply star_plus_trans. eapply match_transl_step; eauto.
-  eapply plus_left. constructor.
-  eapply star_left. constructor.
-  eapply star_left. eapply exit_if_false_false; eauto.
-  eapply star_left. constructor. 
-  eapply star_left. constructor.
-  apply star_one. constructor.
-  reflexivity. reflexivity. reflexivity. reflexivity. reflexivity. reflexivity.
-  eapply match_states_skip; eauto.
-
-(* for true *)
-  simpl in TR. rewrite is_Sskip_true in TR. monadInv TR. inv WT. 
-  econstructor; split.
-  eapply star_plus_trans. eapply match_transl_step; eauto.
-  eapply plus_left. constructor.
-  eapply star_left. constructor.
-  eapply star_left. eapply exit_if_false_true; eauto.
-  eapply star_left. constructor. 
-  eapply star_left. constructor.
-  apply star_one. constructor.
-  reflexivity. reflexivity. reflexivity. reflexivity. reflexivity. reflexivity.
-  econstructor; eauto. constructor.
-  econstructor; eauto. 
-
-(* skip or continue for2 *)
-  assert ((ts' = Sskip \/ ts' = Sexit ncnt) /\ tk' = tk).
-    destruct H; subst x; monadInv TR; inv MTR; auto.
-  destruct H0. inv MK.
-  econstructor; split.
-  eapply plus_left. destruct H0; subst ts'; constructor.
-  apply star_one. constructor. reflexivity. 
-  econstructor; eauto. constructor. 
-  constructor; auto. 
-
-(* break for2 *) 
-  monadInv TR. inv MTR. inv MK.
-  econstructor; split.
-  eapply plus_left. constructor.
-  eapply star_left. constructor.
-  eapply star_left. constructor.
-  apply star_one. constructor.
-  reflexivity. reflexivity. traceEq.
-  eapply match_states_skip; eauto.
-
-(* skip for3 *)
-  monadInv TR. inv MTR. inv MK.
-  econstructor; split.
-  apply plus_one. constructor.
-  econstructor; eauto.
-  simpl. rewrite is_Sskip_true. rewrite H3; simpl. rewrite H4; simpl. rewrite H5; simpl. reflexivity.
-  constructor. constructor; auto. 
-
-(* return none *)
-  monadInv TR. inv MTR. 
-  econstructor; split.
-  apply plus_one. constructor. monadInv TRF. simpl. rewrite H. auto.
-  eapply match_env_free_blocks; eauto. 
-  econstructor; eauto.
-  eapply match_cont_call_cont. eauto. 
-
-(* return some *)
-  monadInv TR. inv MTR. inv WT. inv H3. 
-  econstructor; split.
-  apply plus_one. constructor. monadInv TRF. simpl.
-  unfold opttyp_of_type. destruct (Csyntax.fn_return f); congruence.
-  exploit transl_expr_correct; eauto.
-  eapply match_env_free_blocks; eauto.
-  econstructor; eauto.
-  eapply match_cont_call_cont. eauto. 
-
-(* skip call *)
-  monadInv TR. inv MTR.
-  exploit match_cont_is_call_cont; eauto. intros [A B].
-  econstructor; split.
-  apply plus_one. apply step_skip_call. auto.
-  monadInv TRF. simpl. rewrite H0. auto.
-  eapply match_env_free_blocks; eauto.
-  constructor. eauto.
-
-(* switch *)
-  monadInv TR. inv WT.
-  exploit transl_expr_correct; eauto. intro EV.
-  econstructor; split.
-  eapply star_plus_trans. eapply match_transl_step; eauto.
-  apply plus_one. econstructor. eauto. traceEq. 
-  econstructor; eauto.
-  apply transl_lbl_stmt_2. apply transl_lbl_stmt_1. eauto. 
-  constructor.
-  apply wt_seq_of_labeled_statement. apply wt_select_switch. auto.
-  econstructor. eauto.
-
-(* skip or break switch *)
-  assert ((ts' = Sskip \/ ts' = Sexit nbrk) /\ tk' = tk).
-    destruct H; subst x; monadInv TR; inv MTR; auto.
-  destruct H0. inv MK.
-  econstructor; split.
-  apply plus_one. destruct H0; subst ts'; constructor.
-  eapply match_states_skip; eauto.
-
-
-(* continue switch *)
-  monadInv TR. inv MTR. inv MK.
-  econstructor; split.
-  apply plus_one. constructor. 
-  econstructor; eauto. simpl. reflexivity. constructor.
-
-(* label *)
-  monadInv TR. inv WT. inv MTR. 
-  econstructor; split.
-  apply plus_one. constructor. 
-  econstructor; eauto. constructor.
-
-(* goto *)
-  monadInv TR. inv MTR.
-  generalize TRF. unfold transl_function. intro TRF'. monadInv TRF'.
-  exploit (transl_find_label lbl). eexact WTF. eexact EQ0. eapply match_cont_call_cont. eauto.
-  rewrite H. 
-  intros [ts' [tk'' [nbrk' [ncnt' [A [B [C D]]]]]]].
-  econstructor; split.
-  apply plus_one. constructor. simpl. eexact A. 
-  econstructor; eauto. constructor.
-
-(* internal function *)
-  monadInv TR. inv WT. inv H3. monadInv EQ.
-  exploit match_cont_is_call_cont; eauto. intros [A B].
-  exploit match_env_alloc_variables; eauto. 
-  apply match_globalenv_match_env_empty. apply match_global_typenv. 
-  apply transl_fn_variables. eauto. eauto. 
-  intros [te1 [C D]].
-  econstructor; split.
-  apply plus_one. econstructor.
-  eapply transl_names_norepet; eauto. 
-  eexact C. eapply bind_parameters_match; eauto. 
-  econstructor; eauto.
-  unfold transl_function. rewrite EQ0; simpl. rewrite EQ; simpl. rewrite EQ1; auto. 
-  constructor.
-
-(* external function *)
-  monadInv TR. 
-  exploit match_cont_is_call_cont; eauto. intros [A B].
-  econstructor; split.
-  apply plus_one. constructor. eauto. 
-  eapply external_call_symbols_preserved_2; eauto.
-  exact symbols_preserved.
-  eexact (Genv.find_var_info_transf_partial2 transl_fundef transl_globvar _ TRANSL).
-  eexact (Genv.find_var_info_rev_transf_partial2 transl_fundef transl_globvar _ TRANSL).
-  econstructor; eauto.
-
-(* returnstate 0 *)
-  inv MK. 
-  econstructor; split.
-  apply plus_one. constructor. constructor. 
-  econstructor; eauto. simpl; reflexivity. constructor. constructor.
-
-(* returnstate 1 *)
-  inv MK.
-  econstructor; split.
-  apply plus_one. constructor. eapply set_call_dest_correct; eauto. 
-  econstructor; eauto. simpl; reflexivity. constructor. constructor.
-Qed.
-
-Lemma transl_initial_states:
-  forall S t S', Csem.initial_state prog S -> Csem.step ge S t S' ->
-  exists R, initial_state tprog R /\ match_states S R.
-Proof.
-  intros. inv H.
-  exploit function_ptr_translated; eauto. intros [tf [A B]].
-  assert (C: Genv.find_symbol tge (prog_main tprog) = Some b).
-    rewrite symbols_preserved. replace (prog_main tprog) with (prog_main prog).
-    exact H2. symmetry. unfold transl_program in TRANSL. 
-    eapply transform_partial_program2_main; eauto.
-  exploit function_ptr_well_typed. eauto. intro WTF.
-  assert (exists targs, type_of_fundef f = Tfunction targs (Tint I32 Signed)).
-    eapply wt_program_main. eauto. 
-    eapply Genv.find_funct_ptr_symbol_inversion; eauto.
-  destruct H as [targs D].
-  assert (targs = Tnil). 
-    inv H0.
-    (* internal function *)
-    inv H10. simpl in D. unfold type_of_function in D. rewrite <- H5 in D. 
-    simpl in D. congruence.
-    (* external function *)
-    simpl in D. inv D.
-    exploit external_call_arity; eauto. intro ARITY.
-    exploit function_ptr_well_typed; eauto. intro WT. inv WT.
-    rewrite H5 in ARITY. destruct targs; simpl in ARITY; congruence.
-  subst targs. 
-  assert (funsig tf = signature_of_type Tnil (Tint I32 Signed)).
-    eapply transl_fundef_sig2; eauto. 
-  econstructor; split.
-  econstructor; eauto. eapply Genv.init_mem_transf_partial2; eauto. 
-  constructor; auto. constructor. exact I.
-Qed.
-
-Lemma transl_final_states:
-  forall S R r,
-  match_states S R -> Csem.final_state S r -> final_state R r.
-Proof.
-  intros. inv H0. inv H. inv MK. constructor.
-Qed.
-
-Theorem transl_program_correct:
-  forall (beh: program_behavior),
-  not_wrong beh -> Csem.exec_program prog beh ->
-  Csharpminor.exec_program tprog beh.
-Proof.
-  set (order := fun (S1 S2: Csem.state) => False).
-  assert (WF: well_founded order).
-  unfold order; red. intros. constructor; intros. contradiction.
-  assert (transl_step':
-     forall S1 t S2, Csem.step ge S1 t S2 ->
-     forall T1, match_states S1 T1 ->
-     exists T2,
-      (plus step tgve T1 t T2 \/ star step tgve T1 t T2 /\ order S2 S1)
-      /\ match_states S2 T2).
-  intros. exploit transl_step; eauto. intros [T2 [A B]].
-  exists T2; split. auto. auto.
-  intros. inv H0.
-(* Terminates *)
-  assert (exists t1, exists s1, Csem.step (Genv.globalenv prog) s t1 s1).
-  inv H3. inv H2. inv H1. exists t1; exists s2; auto.
-  destruct H0 as [t1 [s1 ST]].
-  exploit transl_initial_states; eauto. intros [R [A B]].
-  exploit simulation_star_star; eauto. intros [R' [C D]]. 
-  econstructor; eauto. eapply transl_final_states; eauto.
-(* Diverges *)
-  assert (exists t1, exists s1, Csem.step (Genv.globalenv prog) s t1 s1).
-  inv H2. inv H3. exists E0; exists s2; auto. exists t1; exists s2; auto.
-  destruct H0 as [t1 [s1 ST]].
-  exploit transl_initial_states; eauto. intros [R [A B]].
-  exploit simulation_star_star; eauto. intros [R' [C D]]. 
-  econstructor; eauto. eapply simulation_star_forever_silent; eauto.
-(* Reacts *)
-  assert (exists t1, exists s1, Csem.step (Genv.globalenv prog) s t1 s1).
-  inv H2. inv H0. congruence. exists t1; exists s0; auto.
-  destruct H0 as [t1 [s1 ST]].
-  exploit transl_initial_states; eauto. intros [R [A B]].
-  exploit simulation_star_forever_reactive; eauto.
-  intro C.
-  econstructor; eauto.
-(* Goes wrong *)
-  contradiction. contradiction.
-Qed.
-
-End CORRECTNESS.
diff --git a/cfrontend/Cstrategy.v b/cfrontend/Cstrategy.v
new file mode 100644
index 0000000..3d81899
--- /dev/null
+++ b/cfrontend/Cstrategy.v
@@ -0,0 +1,2825 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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 GNU General Public License as published by  *)
+(*  the Free Software Foundation, either version 2 of the License, or  *)
+(*  (at your option) any later version.  This file is also distributed *)
+(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** A deterministic evaluation strategy for C. *)
+
+Require Import Coq.Program.Equality.
+Require Import Axioms.
+Require Import Coqlib.
+Require Import Errors.
+Require Import Maps.
+Require Import Integers.
+Require Import Floats.
+Require Import Values.
+Require Import AST.
+Require Import Memory.
+Require Import Events.
+Require Import Globalenvs.
+Require Import Smallstep.
+Require Import Determinism.
+Require Import Csyntax.
+Require Import Csem.
+
+Section STRATEGY.
+
+Variable ge: genv.
+
+(** * Definition of the strategy *)
+
+(** We now formalize a particular strategy for reducing expressions which
+  is the one implemented by the CompCert compiler.  It evaluates effectful
+  subexpressions first, in leftmost-innermost order, then finishes 
+  with the evaluation of the remaining simple expression. *)
+
+(** Simple expressions are defined as follows. *)
+
+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
+  | Econdition _ _ _ _ => False
+  | Esizeof _ _ => True
+  | Eassign _ _ _ => False
+  | Eassignop _ _ _ _ _ => False
+  | Epostincr _ _ _ => False
+  | Ecomma _ _ _ => False
+  | Ecall _ _ _ => False
+  | Eparen _ _ => False
+  end.
+
+Fixpoint simplelist (rl: exprlist) : Prop :=
+  match rl with Enil => True | Econs r rl' => simple r /\ simplelist rl' end.
+
+(** Simple expressions have interesting properties: their evaluations always
+  terminate, are deterministic, and preserve the memory state.
+  We seize this opportunity to define a big-step semantics for simple
+  expressions. *)
+
+Section SIMPLE_EXPRS.
+
+Variable e: env.
+Variable m: mem.
+
+Inductive eval_simple_lvalue: expr -> block -> int -> 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 Int.zero
+  | esl_var_global: forall x ty b,
+      e!x = None ->
+      Genv.find_symbol ge x = Some b ->
+      type_of_global ge b = Some ty ->
+      eval_simple_lvalue (Evar x ty) b Int.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 l f ty b ofs id fList delta,
+      eval_simple_lvalue l b ofs ->
+      typeof l = Tstruct id fList -> field_offset f fList = OK delta ->
+      eval_simple_lvalue (Efield l f ty) b (Int.add ofs (Int.repr delta))
+  | esl_field_union: forall l f ty b ofs id fList,
+      eval_simple_lvalue l b ofs ->
+      typeof l = Tunion id fList ->
+      eval_simple_lvalue (Efield l 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 ->
+      load_value_of_type ty m b ofs = Some 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) = 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 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 ->
+      cast v1 (typeof r1) ty v ->
+      eval_simple_rvalue (Ecast r1 ty) v
+  | esr_sizeof: forall ty1 ty,
+      eval_simple_rvalue (Esizeof ty1 ty) (Vint (Int.repr (sizeof ty1))).
+
+Inductive eval_simple_list: exprlist -> typelist -> list val -> Prop :=
+  | esrl_nil:
+      eval_simple_list Enil Tnil nil
+  | esrl_cons: forall r rl ty tyl v vl v',
+      eval_simple_rvalue r v' -> cast v' (typeof r) ty v ->
+      eval_simple_list rl tyl vl ->
+      eval_simple_list (Econs r rl) (Tcons ty tyl) (v :: vl).
+
+Scheme eval_simple_rvalue_ind2 := Minimality for eval_simple_rvalue Sort Prop
+  with eval_simple_lvalue_ind2 := Minimality for eval_simple_lvalue Sort Prop.
+Combined Scheme eval_simple_rvalue_lvalue_ind from eval_simple_rvalue_ind2, eval_simple_lvalue_ind2.
+
+End SIMPLE_EXPRS.
+
+(** Left reduction contexts. These contexts allow reducing to the right
+  of a binary operator only if the left subexpression is simple. *)
+
+Inductive leftcontext: kind -> kind -> (expr -> expr) -> Prop :=
+  | lctx_top: forall k,
+      leftcontext k k (fun x => x)
+  | lctx_deref: forall k C ty,
+      leftcontext k RV C -> leftcontext k LV (fun x => Ederef (C x) ty)
+  | lctx_field: forall k C f ty,
+      leftcontext k LV C -> leftcontext k LV (fun x => Efield (C x) f ty)
+  | lctx_rvalof: forall k C ty,
+      leftcontext k LV C -> leftcontext k RV (fun x => Evalof (C x) ty)
+  | lctx_addrof: forall k C ty,
+      leftcontext k LV C -> leftcontext k RV (fun x => Eaddrof (C x) ty)
+  | lctx_unop: forall k C op ty,
+      leftcontext k RV C -> leftcontext k RV (fun x => Eunop op (C x) ty)
+  | lctx_binop_left: forall k C op e2 ty,
+      leftcontext k RV C -> leftcontext k RV (fun x => Ebinop op (C x) e2 ty)
+  | lctx_binop_right: forall k C op e1 ty,
+      simple e1 -> leftcontext k RV C ->
+      leftcontext k RV (fun x => Ebinop op e1 (C x) ty)
+  | lctx_cast: forall k C ty,
+      leftcontext k RV C -> leftcontext k RV (fun x => Ecast (C x) ty)
+  | lctx_condition: forall k C r2 r3 ty,
+      leftcontext k RV C -> leftcontext k RV (fun x => Econdition (C x) r2 r3 ty)
+  | lctx_assign_left: forall k C e2 ty,
+      leftcontext k LV C -> leftcontext k RV (fun x => Eassign (C x) e2 ty)
+  | lctx_assign_right: forall k C e1 ty,
+      simple e1 -> leftcontext k RV C ->
+      leftcontext k RV (fun x => Eassign e1 (C x) ty)
+  | lctx_assignop_left: forall k C op e2 tyres ty,
+      leftcontext k LV C -> leftcontext k RV (fun x => Eassignop op (C x) e2 tyres ty)
+  | lctx_assignop_right: forall k C op e1 tyres ty,
+      simple e1 -> leftcontext k RV C ->
+      leftcontext k RV (fun x => Eassignop op e1 (C x) tyres ty)
+  | lctx_postincr: forall k C id ty,
+      leftcontext k LV C -> leftcontext k RV (fun x => Epostincr id (C x) ty)
+  | lctx_call_left: forall k C el ty,
+      leftcontext k RV C -> leftcontext k RV (fun x => Ecall (C x) el ty)
+  | lctx_call_right: forall k C e1 ty,
+      simple e1 -> leftcontextlist k C ->
+      leftcontext k RV (fun x => Ecall e1 (C x) ty)
+  | lctx_comma: forall k C e2 ty,
+      leftcontext k RV C -> leftcontext k RV (fun x => Ecomma (C x) e2 ty)
+  | lctx_paren: forall k C ty,
+      leftcontext k RV C -> leftcontext k RV (fun x => Eparen (C x) ty)
+
+with leftcontextlist: kind -> (expr -> exprlist) -> Prop :=
+  | lctx_list_head: forall k C el,
+      leftcontext k RV C -> leftcontextlist k (fun x => Econs (C x) el)
+  | lctx_list_tail: forall k C e1,
+      simple e1 -> leftcontextlist k C ->
+      leftcontextlist k (fun x => Econs e1 (C x)).
+
+Lemma leftcontext_context:
+  forall k1 k2 C, leftcontext k1 k2 C -> context k1 k2 C
+with leftcontextlist_contextlist:
+  forall k C, leftcontextlist k C -> contextlist k C.
+Proof.
+  induction 1; constructor; auto.
+  induction 1; constructor; auto.
+Qed.
+
+Hint Resolve leftcontext_context.
+
+(** Strategy for reducing expressions. We reduce the leftmost innermost
+  non-simple subexpression, evaluating its arguments (which are necessarily
+  simple expressions) with the big-step semantics.
+  If there are none, the whole expression is simple and is evaluated in
+  one big step. *)
+
+Inductive estep: state -> trace -> state -> Prop :=
+
+  | step_expr: forall f r k e m v ty,
+      eval_simple_rvalue e m r v ->
+      match r with Eval _ _ => False | _ => True end ->
+      ty = typeof r ->
+      estep (ExprState f r k e m)
+	 E0 (ExprState f (Eval v ty) k e m)
+
+  | step_condition_true: forall f C r1 r2 r3 ty k e m v,
+      leftcontext RV RV C ->
+      eval_simple_rvalue e m r1 v ->
+      is_true v (typeof r1) ->
+      typeof r2 = ty ->
+      estep (ExprState f (C (Econdition r1 r2 r3 ty)) k e m)
+	 E0 (ExprState f (C (Eparen r2 ty)) k e m)
+
+  | step_condition_false: forall f C r1 r2 r3 ty k e m v,
+      leftcontext RV RV C ->
+      eval_simple_rvalue e m r1 v ->
+      is_false v (typeof r1) ->
+      typeof r3 = ty ->
+      estep (ExprState f (C (Econdition r1 r2 r3 ty)) k e m)
+	 E0 (ExprState f (C (Eparen r3 ty)) k e m)
+
+  | step_assign: forall f C l r ty k e m b ofs v v' m',
+      leftcontext RV RV C ->
+      eval_simple_lvalue e m l b ofs ->
+      eval_simple_rvalue e m r v ->
+      cast v (typeof r) (typeof l) v' ->
+      store_value_of_type (typeof l) m b ofs v' = Some m' ->
+      ty = typeof l ->
+      estep (ExprState f (C (Eassign l r ty)) k e m)
+	 E0 (ExprState f (C (Eval v' ty)) k e m')
+
+  | step_assignop: forall f C op l r tyres ty k e m b ofs v1 v2 v3 v4 m',
+      leftcontext RV RV C ->
+      eval_simple_lvalue e m l b ofs ->
+      load_value_of_type (typeof l) m b ofs = Some v1 ->
+      eval_simple_rvalue e m r v2 ->
+      sem_binary_operation op v1 (typeof l) v2 (typeof r) m = Some v3 ->
+      cast v3 tyres (typeof l) v4 ->
+      store_value_of_type (typeof l) m b ofs v4 = Some m' ->
+      ty = typeof l ->
+      estep (ExprState f (C (Eassignop op l r tyres ty)) k e m)
+	 E0 (ExprState f (C (Eval v4 ty)) k e m')
+
+  | step_postincr: forall f C id l ty k e m b ofs v1 v2 v3 m',
+      leftcontext RV RV C ->
+      eval_simple_lvalue e m l b ofs ->
+      load_value_of_type ty m b ofs = Some v1 ->
+      sem_incrdecr id v1 ty = Some v2 ->
+      cast v2 (typeconv ty) ty v3 ->
+      store_value_of_type ty m b ofs v3 = Some m' ->
+      ty = typeof l ->
+      estep (ExprState f (C (Epostincr id l ty)) k e m)
+	 E0 (ExprState f (C (Eval v1 ty)) k e m')
+
+  | step_comma: forall f C r1 r2 ty k e m v,
+      leftcontext RV RV C ->
+      eval_simple_rvalue e m r1 v ->
+      ty = typeof r2 ->
+      estep (ExprState f (C (Ecomma r1 r2 ty)) k e m)
+         E0 (ExprState f (C r2) k e m)
+
+  | step_paren: forall f C r ty k e m v,
+      leftcontext RV RV C ->
+      eval_simple_rvalue e m r v ->
+      ty = typeof r ->
+      estep (ExprState f (C (Eparen r ty)) k e m)
+         E0 (ExprState f (C (Eval v ty)) k e m)
+
+  | step_call: forall f C rf rargs ty k e m targs tres vf vargs fd,
+      leftcontext RV RV C ->
+      typeof rf = Tfunction targs tres ->
+      eval_simple_rvalue e m rf vf ->
+      eval_simple_list e m rargs targs vargs ->
+      Genv.find_funct ge vf = Some fd ->
+      type_of_fundef fd = Tfunction targs tres ->
+      estep (ExprState f (C (Ecall rf rargs ty)) k e m)
+         E0 (Callstate fd vargs (Kcall f e C ty k) m).
+
+Definition step (S: state) (t: trace) (S': state) : Prop :=
+  estep S t S' \/ sstep ge S t S'.
+
+(** * Safe executions. *)
+
+(** A C program is safe (in the nondeterministic strategy) 
+  if it cannot get stuck.  The definition is parameterized by
+  an external world (cf. file [Determinism]) to constrain the behavior
+  of external functions. *)
+
+Inductive immsafe: world -> state -> Prop :=
+  | immsafe_final: forall w s r,
+      final_state s r ->
+      immsafe w s
+  | immsafe_step: forall w s t s' w',
+      Csem.step ge s t s' -> possible_trace w t w' ->
+      immsafe w s.
+
+Definition safe (w: world) (s: Csem.state) : Prop :=
+  forall t s' w', star Csem.step ge s t s' -> possible_trace w t w' -> immsafe w' s'.
+
+Lemma safe_steps:
+  forall w s t s' w',
+  safe w s -> star Csem.step ge s t s' -> possible_trace w t w' -> safe w' s'.
+Proof.
+  intros; red; intros. 
+  eapply H. eapply star_trans; eauto. eapply possible_trace_app; eauto.
+Qed.
+
+Lemma safe_imm:
+  forall w s, safe w s -> immsafe w s.
+Proof.
+  intros. eapply H. apply star_refl. constructor.
+Qed.
+
+Lemma not_stuck_val:
+  forall e v ty m,
+  not_stuck ge e (Eval v ty) m.
+Proof.
+  intros; red; intros. inv H; try congruence. subst e'. constructor.
+Qed.
+
+Lemma safe_not_stuck:
+  forall w f a k e m,
+  safe w (ExprState f a k e m) ->
+  not_stuck ge e a m.
+Proof.
+  intros. exploit safe_imm; eauto; intro IS; inv IS. 
+  inv H0.
+  inv H0. inv H2; auto; apply not_stuck_val. inv H2; apply not_stuck_val.
+Qed.
+
+Lemma safe_not_imm_stuck:
+  forall k C w f a K e m,
+  safe w (ExprState f (C a) K e m) ->
+  context k RV C ->
+  not_imm_stuck ge e k a m.
+Proof.
+  intros. exploit safe_not_stuck; eauto.
+Qed.
+
+(** Simple, non-stuck expressions are well-formed with respect to
+    l-values and r-values. *)
+
+Lemma context_compose:
+  forall k2 k3 C2, context k2 k3 C2 ->
+  forall k1 C1, context k1 k2 C1 ->
+  context k1 k3 (fun x => C2(C1 x))
+with contextlist_compose:
+  forall k2 C2, contextlist k2 C2 ->
+  forall k1 C1, context k1 k2 C1 ->
+  contextlist k1 (fun x => C2(C1 x)).
+Proof.
+  induction 1; intros; try (constructor; eauto).
+  replace (fun x => C1 x) with C1. auto. apply extensionality; auto.
+  induction 1; intros; constructor; eauto.
+Qed.
+
+Definition expr_kind (a: expr) : kind :=
+  match a with
+  | Eloc _ _ _ => LV
+  | Evar _ _ => LV
+  | Ederef _ _ => LV
+  | Efield _ _ _ => LV
+  | _ => RV
+  end.
+
+Lemma lred_kind:
+  forall e a m a' m', lred ge e a m a' m' -> expr_kind a = LV.
+Proof.
+  induction 1; auto.
+Qed.
+
+Lemma rred_kind:
+  forall a m a' m', rred a m a' m' -> expr_kind a = RV.
+Proof.
+  induction 1; auto.
+Qed.
+
+Lemma callred_kind:
+  forall a fd args ty, callred ge a fd args ty -> expr_kind a = RV.
+Proof.
+  induction 1; auto.
+Qed.
+
+Lemma context_kind:
+  forall a from to C, context from to C -> expr_kind a = from -> expr_kind (C a) = to.
+Proof.
+  induction 1; intros; simpl; auto.
+Qed.
+
+Lemma not_imm_stuck_kind:
+  forall e k a m, not_imm_stuck ge e k a m -> expr_kind a = k.
+Proof.
+  induction 1.
+  auto.
+  auto.
+  eapply context_kind; eauto. eapply lred_kind; eauto.
+  eapply context_kind; eauto. eapply rred_kind; eauto.
+  eapply context_kind; eauto. eapply callred_kind; eauto.
+Qed.
+
+Lemma safe_expr_kind:
+  forall from C w f a k e m,
+  context from RV C ->
+  safe w (ExprState f (C a) k e m) ->
+  expr_kind a = from.
+Proof.
+  intros. eapply not_imm_stuck_kind. eapply safe_not_imm_stuck; eauto.
+Qed.
+
+(** Painful inversion lemmas on particular states that are not stuck. *)
+
+Section INVERSION_LEMMAS.
+
+Variable e: env.
+
+Fixpoint exprlist_all_values (rl: exprlist) : Prop :=
+  match rl with
+  | Enil => True
+  | Econs (Eval v ty) rl' => exprlist_all_values rl'
+  | Econs _ _ => False
+  end.
+
+Definition invert_expr_prop (a: expr) (m: mem) : Prop :=
+  match a with
+  | Eloc b ofs ty => False
+  | Evar x ty =>
+      exists b,
+      e!x = Some(b, ty)
+      \/ (e!x = None /\ Genv.find_symbol ge x = Some b /\ type_of_global ge b = Some ty)
+  | Ederef (Eval v ty1) ty =>
+      exists b, exists ofs, v = Vptr b ofs
+  | Efield (Eloc b ofs ty1) f ty =>
+      match ty1 with
+      | Tstruct _ fList => exists delta, field_offset f fList = Errors.OK delta
+      | Tunion _ _ => True
+      | _ => False
+      end
+  | Eval v ty => False
+  | Evalof (Eloc b ofs ty') ty =>
+      ty' = ty /\ exists v, load_value_of_type ty m b ofs = Some v
+  | Eunop op (Eval v1 ty1) ty =>
+      exists v, sem_unary_operation op v1 ty1 = Some v
+  | Ebinop op (Eval v1 ty1) (Eval v2 ty2) ty =>
+      exists v, sem_binary_operation op v1 ty1 v2 ty2 m = Some v
+  | Ecast (Eval v1 ty1) ty =>
+      exists v, cast v1 ty1 ty v
+  | Econdition (Eval v1 ty1) r1 r2 ty =>
+      ((is_true v1 ty1 /\ typeof r1 = ty) \/ (is_false v1 ty1 /\ typeof r2 = ty))
+  | Eassign (Eloc b ofs ty1) (Eval v2 ty2) ty =>
+      exists v, exists m',
+      ty = ty1 /\ cast v2 ty2 ty1 v /\ store_value_of_type ty1 m b ofs v = Some m'
+  | Eassignop op (Eloc b ofs ty1) (Eval v2 ty2) tyres ty =>
+      exists v1, exists v, exists v', exists m',
+      ty = ty1 
+      /\ load_value_of_type ty1 m b ofs = Some v1
+      /\ sem_binary_operation op v1 ty1 v2 ty2 m = Some v
+      /\ cast v tyres ty1 v'
+      /\ store_value_of_type ty1 m b ofs v' = Some m'
+  | Epostincr id (Eloc b ofs ty1) ty =>
+      exists v1, exists v2, exists v3, exists m',
+      ty = ty1
+      /\ load_value_of_type ty m b ofs = Some v1
+      /\ sem_incrdecr id v1 ty = Some v2
+      /\ cast v2 (typeconv ty) ty v3
+      /\ store_value_of_type ty m b ofs v3 = Some m'
+  | Ecomma (Eval v ty1) r2 ty =>
+      typeof r2 = ty
+  | Eparen (Eval v ty1) ty =>
+      ty = ty1
+  | Ecall (Eval vf tyf) rargs ty =>
+      exprlist_all_values rargs ->
+      exists tyargs, exists tyres, exists fd, exists vl,
+         tyf = Tfunction tyargs tyres
+      /\ Genv.find_funct ge vf = Some fd
+      /\ cast_arguments rargs tyargs vl
+      /\ type_of_fundef fd = Tfunction tyargs tyres
+  | _ => True
+  end.
+
+Lemma lred_invert:
+  forall l m l' m', lred ge e l m l' m' -> invert_expr_prop l m.
+Proof.
+  induction 1; red; auto.
+  exists b; auto.
+  exists b; auto.
+  exists b; exists ofs; auto.
+  exists delta; auto.
+Qed.
+
+Lemma rred_invert:
+  forall r m r' m', rred r m r' m' -> invert_expr_prop r m.
+Proof.
+  induction 1; red; auto.
+  split; auto; exists v; auto.
+  exists v; auto.
+  exists v; auto.
+  exists v; auto.
+  exists v; exists m'; auto.
+  exists v1; exists v; exists v'; exists m'; auto.
+  exists v1; exists v2; exists v3; exists m'; auto.
+  destruct r; auto.
+Qed.
+
+Lemma callred_invert:
+  forall r fd args ty m,
+  callred ge r fd args ty ->
+  invert_expr_prop r m.
+Proof.
+  intros. inv H. simpl.
+  intros. exists tyargs; exists tyres; exists fd; exists args; auto.
+Qed.
+
+Scheme context_ind2 := Minimality for context Sort Prop
+  with contextlist_ind2 := Minimality for contextlist Sort Prop.
+Combined Scheme context_contextlist_ind from context_ind2, contextlist_ind2.
+
+Lemma invert_expr_context:
+  (forall from to C, context from to C ->
+   forall a m,
+   invert_expr_prop a m ->
+   invert_expr_prop (C a) m)
+/\(forall from C, contextlist from C ->
+  forall a m,
+  invert_expr_prop a m ->
+  ~exprlist_all_values (C a)).
+Proof.
+  apply context_contextlist_ind; intros; try (exploit H0; [eauto|intros]).
+  auto.
+  simpl. destruct (C a); auto. contradiction.
+  simpl. destruct (C a); auto. contradiction. 
+  simpl. destruct (C a); auto. contradiction. 
+  simpl. auto.
+  simpl. destruct (C a); auto. contradiction. 
+  simpl. destruct (C a); auto. contradiction. 
+  simpl.
+    destruct e1; auto. destruct (C a); auto. contradiction.
+  simpl. destruct (C a); auto. contradiction.
+  simpl. destruct (C a); auto. contradiction.
+  simpl. destruct (C a); auto. contradiction.
+  simpl.
+    destruct e1; auto. destruct (C a); auto. contradiction.
+  simpl. destruct (C a); auto. contradiction.
+  simpl.
+    destruct e1; auto. destruct (C a); auto. contradiction.
+  simpl. destruct (C a); auto. contradiction.
+  simpl. destruct (C a); auto. contradiction.
+  simpl. destruct e1; auto. intros. elim (H0 a m); auto.   
+  simpl. destruct (C a); auto. contradiction. 
+  simpl. destruct (C a); auto. contradiction.
+  simpl. red; intros. destruct (C a); auto. 
+  simpl; red; intros. destruct e1; auto. elim (H0 a m); auto. 
+Qed.
+
+Lemma not_imm_stuck_inv:
+  forall k a m,
+  not_imm_stuck ge e k a m ->
+  match a with
+  | Eloc _ _ _ => True
+  | Eval _ _ => True
+  | _ => invert_expr_prop a m
+  end.
+Proof.
+  destruct invert_expr_context as [A B].
+  intros. inv H. 
+  auto.
+  auto.
+  assert (invert_expr_prop (C e0) m).
+    eapply A; eauto. eapply lred_invert; eauto.
+  red in H. destruct (C e0); auto; contradiction.
+  assert (invert_expr_prop (C e0) m).
+    eapply A; eauto. eapply rred_invert; eauto.
+  red in H. destruct (C e0); auto; contradiction.
+  assert (invert_expr_prop (C e0) m).
+    eapply A; eauto. eapply callred_invert; eauto.
+  red in H. destruct (C e0); auto; contradiction.
+Qed.
+
+End INVERSION_LEMMAS.
+
+(** * Correctness of the strategy. *)
+
+Section SIMPLE_EVAL.
+
+Variable f: function.
+Variable k: cont.
+Variable e: env.
+Variable m: mem.
+Variable w: world.
+
+Lemma simple_eval:
+  forall a from C,
+  simple a -> context from RV C -> safe w (ExprState f (C a) k e m) ->
+  match from with
+  | LV =>
+     exists b, exists ofs,
+        eval_simple_lvalue e m a b ofs
+     /\ star Csem.step ge (ExprState f (C a) k e m)
+                       E0 (ExprState f (C (Eloc b ofs (typeof a))) k e m)
+  | RV =>
+     exists v,
+        eval_simple_rvalue e m a v
+     /\ star Csem.step ge (ExprState f (C a) k e m)
+                       E0 (ExprState f (C (Eval v (typeof a))) k e m)
+  end.
+Proof.
+  induction a; intros from C S CTX SAFE;
+  generalize (safe_expr_kind _ _ _ _ _ _ _ _ CTX SAFE); intro K; subst;
+  simpl in S; try contradiction; simpl.
+(* val *)
+  exists v; split. constructor. apply star_refl.
+(* var *)
+  exploit not_imm_stuck_inv. eapply safe_not_imm_stuck; eauto.
+  simpl. intros [b A].
+  exists b; exists Int.zero; split.
+  intuition. apply esl_var_local; auto. apply esl_var_global; auto.
+  apply star_one. left; apply step_lred.
+  intuition. apply red_var_local; auto. apply red_var_global; auto. 
+  eapply safe_not_stuck; eauto. auto.
+(* field *)
+  set (C1 := fun x => Efield x f0 ty).
+  set (C2 := fun x => C(C1 x)).
+  exploit (IHa LV C2); auto. eapply context_compose; eauto. repeat constructor.
+  unfold C2, C1; intros [b [ofs [A B]]].
+  exploit not_imm_stuck_inv.
+    eapply safe_not_imm_stuck. eapply safe_steps; eauto. constructor. eauto.
+  simpl. 
+  case_eq (typeof a); intros; try contradiction.
+  destruct H0 as [delta EQ]. 
+  exists b; econstructor; split.
+  eapply esl_field_struct; eauto.
+  eapply star_right. eauto. left; apply step_lred.
+  rewrite H. constructor; auto.
+  eapply safe_not_stuck. eapply safe_steps; eauto. constructor. auto.
+  traceEq.
+  exists b; exists ofs; split.
+  eapply esl_field_union; eauto.
+  eapply star_right. eauto. left; apply step_lred.
+  rewrite H. constructor; auto.
+  eapply safe_not_stuck. eapply safe_steps; eauto. constructor. auto.
+  traceEq.
+(* valof *)
+  set (C1 := fun x => Evalof x ty).
+  set (C2 := fun x => C(C1 x)).
+  exploit (IHa LV C2); auto. eapply context_compose; eauto. repeat constructor.
+  unfold C2, C1; intros [b [ofs [A B]]].
+  exploit not_imm_stuck_inv.
+    eapply safe_not_imm_stuck. eapply safe_steps; eauto. constructor. eauto. 
+  simpl. intros [D [v E]].
+  exists v; split.
+  econstructor; eauto.
+  eapply star_right. eauto. left; apply step_rred.
+  simpl. rewrite D. constructor. auto. 
+  eapply safe_not_stuck. eapply safe_steps; eauto. constructor. auto.
+  traceEq.
+(* deref *)
+  set (C1 := fun x => Ederef x ty).
+  set (C2 := fun x => C(C1 x)).
+  exploit (IHa RV C2); auto. eapply context_compose; eauto. repeat constructor.
+  unfold C2, C1; intros [v1 [A B]].
+  exploit not_imm_stuck_inv.
+    eapply safe_not_imm_stuck. eapply safe_steps; eauto. constructor. eauto.
+  simpl. intros [b [ofs D]]. subst v1. 
+  exists b; exists ofs; split.
+  econstructor; eauto. 
+  eapply star_right. eauto. left; apply step_lred.
+  simpl. constructor.
+  eapply safe_not_stuck. eapply safe_steps; eauto. constructor. auto.
+  traceEq.
+(* addrof *)
+  set (C1 := fun x => Eaddrof x ty).
+  set (C2 := fun x => C(C1 x)).
+  exploit (IHa LV C2); auto. eapply context_compose; eauto. repeat constructor.
+  unfold C2, C1; intros [b [ofs [A B]]].
+  exists (Vptr b ofs); split.
+  econstructor; eauto.
+  eapply star_right. eauto. left; apply step_rred.
+  simpl. constructor. 
+  eapply safe_not_stuck. eapply safe_steps; eauto. constructor. auto.
+  traceEq.
+(* unop *)
+  set (C1 := fun x => Eunop op x ty).
+  set (C2 := fun x => C(C1 x)).
+  exploit (IHa RV C2); auto. eapply context_compose; eauto. repeat constructor.
+  unfold C2, C1; intros [v1 [A B]].
+  exploit not_imm_stuck_inv.
+    eapply safe_not_imm_stuck. eapply safe_steps; eauto. constructor. eauto.
+  simpl. intros [v E].
+  exists v; split.
+  econstructor; eauto.
+  eapply star_right. eauto. left; apply step_rred.
+  simpl. constructor. auto. 
+  eapply safe_not_stuck. eapply safe_steps; eauto. constructor. auto.
+  traceEq.
+(* binop *)
+  set (C1 := fun x => Ebinop op x a2 ty).
+  set (C2 := fun x => C(C1 x)).
+  exploit (IHa1 RV C2). tauto. eapply context_compose; eauto. repeat constructor. auto.
+  unfold C2, C1; intros [v1 [A B]].
+  assert (safe w (ExprState f (C (Ebinop op (Eval v1 (typeof a1)) a2 ty)) k e m)).
+    eapply safe_steps; eauto. constructor.
+  set (C3 := fun x => Ebinop op (Eval v1 (typeof a1)) x ty).
+  set (C4 := fun x => C(C3 x)).
+  exploit (IHa2 RV C4). tauto. eapply context_compose; eauto. repeat constructor. auto.
+  unfold C4, C3; intros [v2 [D E]].
+  assert (safe w (ExprState f (C (Ebinop op (Eval v1 (typeof a1)) (Eval v2 (typeof a2)) ty)) k e m)).
+    eapply safe_steps; eauto. constructor.
+  exploit not_imm_stuck_inv.
+    eapply safe_not_imm_stuck. eexact H0. eauto. 
+  simpl. intros [v F].
+  exists v; split.
+  econstructor; eauto.
+  eapply star_right. eapply star_trans; eauto. left; apply step_rred.
+  simpl. constructor. auto. 
+  eapply safe_not_stuck. eauto.
+  auto.
+  traceEq.
+(* cast *)
+  set (C1 := fun x => Ecast x ty).
+  set (C2 := fun x => C(C1 x)).
+  exploit (IHa RV C2); auto. eapply context_compose; eauto. repeat constructor.
+  unfold C2, C1; intros [v1 [A B]].
+  exploit not_imm_stuck_inv.
+    eapply safe_not_imm_stuck. eapply safe_steps; eauto. constructor. eauto.
+  simpl. intros [v E].
+  exists v; split.
+  econstructor; eauto.
+  eapply star_right. eauto. left; apply step_rred.
+  simpl. constructor. auto. 
+  eapply safe_not_stuck. eapply safe_steps; eauto. constructor. auto.
+  traceEq.
+(* sizeof *)
+  econstructor; split. constructor. 
+  apply star_one. left; apply step_rred. constructor. 
+  eapply safe_not_stuck; eauto.
+  auto.
+(* loc *)
+  exploit not_imm_stuck_inv. eapply safe_not_imm_stuck; eauto.
+  simpl. intros.
+  exists b; exists ofs; split. constructor. apply star_refl.
+Qed.
+
+Lemma simple_eval_r:
+   forall r C, 
+   simple r -> context RV RV C -> safe w (ExprState f (C r) k e m) ->
+   exists v,
+      eval_simple_rvalue e m r v
+   /\ star Csem.step ge (ExprState f (C r) k e m)
+                     E0 (ExprState f (C (Eval v (typeof r))) k e m).
+Proof.
+  intros. apply (simple_eval r RV); auto.
+Qed.
+
+Lemma simple_eval_l:
+   forall l C,
+   simple l -> context LV RV C -> safe w (ExprState f (C l) k e m) ->
+   exists b, exists ofs,
+      eval_simple_lvalue e m l b ofs
+   /\ star Csem.step ge (ExprState f (C l) k e m)
+                     E0 (ExprState f (C (Eloc b ofs (typeof l))) k e m).
+Proof.
+  intros. apply (simple_eval l LV); auto.
+Qed.
+
+Fixpoint rval_list (vl: list val) (rl: exprlist) : exprlist :=
+  match vl, rl with
+  | v1 :: vl', Econs r1 rl' => Econs (Eval v1 (typeof r1)) (rval_list vl' rl')
+  | _, _ => Enil
+  end.
+
+Inductive eval_simple_list': exprlist -> list val -> Prop :=
+  | esrl'_nil:
+      eval_simple_list' Enil nil
+  | esrl'_cons: forall r rl v vl,
+      eval_simple_rvalue e m r v ->
+      eval_simple_list' rl vl ->
+      eval_simple_list' (Econs r rl) (v :: vl).
+
+Fixpoint exprlist_app (rl1 rl2: exprlist) : exprlist :=
+  match rl1 with
+  | Enil => rl2
+  | Econs r1 rl1' => Econs r1 (exprlist_app rl1' rl2)
+  end.
+
+Lemma exprlist_app_assoc:
+  forall rl2 rl3 rl1,
+  exprlist_app (exprlist_app rl1 rl2) rl3 =
+  exprlist_app rl1 (exprlist_app rl2 rl3).
+Proof.
+  induction rl1; auto. simpl. congruence. 
+Qed.
+
+Inductive contextlist' : (exprlist -> expr) -> Prop :=
+  | contextlist'_intro: forall r1 rl0 ty C,
+      context RV RV C ->
+      contextlist' (fun rl => C (Ecall r1 (exprlist_app rl0 rl) ty)).
+
+Lemma exprlist_app_context:
+  forall rl1 rl2,
+  contextlist RV (fun x => exprlist_app rl1 (Econs x rl2)).
+Proof.
+  induction rl1; simpl; intros. 
+  apply ctx_list_head. constructor.
+  apply ctx_list_tail. auto. 
+Qed.
+
+Lemma contextlist'_head:
+  forall rl C,
+  contextlist' C ->
+  context RV RV (fun x => C (Econs x rl)).
+Proof.
+  intros. inv H. 
+  set (C' := fun x => Ecall r1 (exprlist_app rl0 (Econs x rl)) ty).
+  assert (context RV RV C'). constructor. apply exprlist_app_context.
+  change (context RV RV (fun x => C0 (C' x))). 
+  eapply context_compose; eauto.
+Qed.
+
+Lemma contextlist'_tail:
+  forall r1 C,
+  contextlist' C ->
+  contextlist' (fun x => C (Econs r1 x)).
+Proof.
+  intros. inv H. 
+  replace (fun x => C0 (Ecall r0 (exprlist_app rl0 (Econs r1 x)) ty))
+     with (fun x => C0 (Ecall r0 (exprlist_app (exprlist_app rl0 (Econs r1 Enil)) x) ty)).
+  constructor. auto. 
+  apply extensionality; intros. f_equal. f_equal. apply exprlist_app_assoc.
+Qed.
+
+Lemma simple_eval_rlist:
+  forall rl C,
+  simplelist rl ->
+  contextlist' C ->
+  safe w (ExprState f (C rl) k e m) ->
+  exists vl,
+  eval_simple_list' rl vl
+  /\ star Csem.step ge (ExprState f (C rl) k e m)
+                       E0 (ExprState f (C (rval_list vl rl)) k e m).
+Proof.
+  induction rl; intros. 
+  econstructor; split. constructor. simpl. apply star_refl.
+  simpl in H; destruct H.
+  set (C1 := fun x => C (Econs x rl)). 
+  exploit (simple_eval_r r1 C1). auto. apply contextlist'_head. auto. auto.
+  unfold C1; intros [v [X Y]].
+  assert (safe w (ExprState f (C (Econs (Eval v (typeof r1)) rl)) k e m)).
+    eapply safe_steps; eauto. constructor.
+  set (C2 := fun x => C (Econs (Eval v (typeof r1)) x)). 
+  destruct (IHrl C2) as [vl [U V]]. auto. apply contextlist'_tail. auto. auto.
+  unfold C2 in V.
+  exists (v :: vl); split. constructor; auto.
+  simpl. eapply star_trans; eauto.
+Qed.
+
+Lemma rval_list_all_values:
+  forall vl rl, exprlist_all_values (rval_list vl rl).
+Proof.
+  induction vl; simpl; intros. auto. 
+  destruct rl; simpl; auto.
+Qed.
+
+Lemma can_eval_simple_list:
+  forall rl vl,
+  eval_simple_list' rl vl ->
+  forall tyl vl',
+  cast_arguments (rval_list vl rl) tyl vl' ->
+  eval_simple_list e m rl tyl vl'.
+Proof.
+  induction 1; simpl; intros. 
+  inv H. constructor.
+  inv H1. econstructor; eauto. 
+Qed.
+
+End SIMPLE_EVAL.
+
+(** Decomposition *)
+
+Section DECOMPOSITION.
+
+Variable f: function.
+Variable k: cont.
+Variable e: env.
+Variable m: mem.
+Variable w: world.
+
+Definition simple_side_effect (r: expr) : Prop :=
+  match r with
+  | Econdition r1 r2 r3 ty => simple r1
+  | Eassign l1 r2 _ => simple l1 /\ simple r2
+  | Eassignop _ l1 r2 _ _ => simple l1 /\ simple r2
+  | Epostincr _ l1 _ => simple l1
+  | Ecomma r1 r2 _ => simple r1
+  | Ecall r1 rl _ => simple r1 /\ simplelist rl
+  | Eparen r1 _ => simple r1
+  | _ => False
+  end.
+
+Scheme expr_ind2 := Induction for expr Sort Prop
+  with exprlist_ind2 := Induction for exprlist Sort Prop.
+Combined Scheme expr_expr_list_ind from expr_ind2, exprlist_ind2.
+
+Lemma decompose_expr:
+  (forall a from C,
+   context from RV C -> safe w (ExprState f (C a) k e m) ->
+       simple a
+    \/ exists C', exists a', simple_side_effect a' /\ leftcontext RV from C' /\ a = C' a')
+/\(forall rl C,
+   contextlist' C -> safe w (ExprState f (C rl) k e m) ->
+       simplelist rl
+    \/ exists C', exists a', simple_side_effect a' /\ leftcontextlist RV C' /\ rl = C' a').
+Proof.
+  apply expr_expr_list_ind; intros; simpl; auto.
+(* field *)
+  exploit safe_expr_kind; eauto; simpl; intros. subst.
+  destruct (H LV (fun x => C (Efield x f0 ty))) as [A | [C' [a' [A [B D]]]]].
+    eapply context_compose; eauto. repeat constructor. auto.
+  auto.
+  right; exists (fun x => Efield (C' x) f0 ty); exists a'.
+  split. auto. split. constructor; auto. rewrite D; auto.
+(* rvalof *)
+  exploit safe_expr_kind; eauto; simpl; intros. subst.
+  destruct (H LV (fun x => C (Evalof x ty))) as [A | [C' [a' [A [B D]]]]].
+    eapply context_compose; eauto. repeat constructor. auto.
+  auto.
+  right; exists (fun x => Evalof (C' x) ty); exists a'.
+  split. auto. split. constructor; auto. rewrite D; auto.
+(* deref *)
+  exploit safe_expr_kind; eauto; simpl; intros. subst.
+  subst. destruct (H RV (fun x => C (Ederef x ty))) as [A | [C' [a' [A [B D]]]]].
+    eapply context_compose; eauto. repeat constructor. auto.
+  auto.
+  right; exists (fun x => Ederef (C' x) ty); exists a'.
+  split. auto. split. constructor; auto. rewrite D; auto.
+(* addrof *)
+  exploit safe_expr_kind; eauto; simpl; intros. subst.
+  destruct (H LV (fun x => C (Eaddrof x ty))) as [A | [C' [a' [A [B D]]]]].
+    eapply context_compose; eauto. repeat constructor. auto.
+  auto.
+  right; exists (fun x => Eaddrof (C' x) ty); exists a'.
+  split. auto. split. constructor; auto. rewrite D; auto.
+(* unop *)
+  exploit safe_expr_kind; eauto; simpl; intros. subst.
+  destruct (H RV (fun x => C (Eunop op x ty))) as [A | [C' [a' [A [B D]]]]].
+    eapply context_compose; eauto. repeat constructor. auto.
+  auto.
+  right; exists (fun x => Eunop op (C' x) ty); exists a'.
+  split. auto. split. constructor; auto. rewrite D; auto.
+(* binop *)
+  exploit safe_expr_kind; eauto; simpl; intros. subst.
+  destruct (H RV (fun x => C (Ebinop op x r2 ty))) as [A | [C' [a' [A [B D]]]]].
+    eapply context_compose; eauto. repeat constructor. auto.
+  destruct (H0 RV (fun x => C (Ebinop op r1 x ty))) as [A' | [C' [a' [A' [B D]]]]].
+    eapply context_compose; eauto. repeat constructor. auto.
+  auto.
+  right; exists (fun x => Ebinop op r1 (C' x) ty); exists a'. 
+  split. auto. split. constructor; auto. rewrite D; auto.
+  right; exists (fun x => Ebinop op (C' x) r2 ty); exists a'. 
+  split. auto. split. constructor; auto. rewrite D; auto.
+(* cast *)
+  exploit safe_expr_kind; eauto; simpl; intros. subst.
+  destruct (H RV (fun x => C (Ecast x ty))) as [A | [C' [a' [A [B D]]]]].
+    eapply context_compose; eauto. repeat constructor. auto.
+  auto.
+  right; exists (fun x => Ecast (C' x) ty); exists a'.
+  split. auto. split. constructor; auto. rewrite D; auto.
+(* condition *)
+  exploit safe_expr_kind; eauto; simpl; intros. subst.
+  destruct (H RV (fun x => C(Econdition x r2 r3 ty))) as [A | [C' [a' [A [B D]]]]].
+    eapply context_compose; eauto. repeat constructor. auto.
+  right. exists (fun x => x); exists (Econdition r1 r2 r3 ty).
+  split. red; auto. split. constructor. auto.
+  right; exists (fun x => Econdition (C' x) r2 r3 ty); exists a'. 
+  split. auto. split. constructor; auto. rewrite D; auto.
+(* assign *)
+  exploit safe_expr_kind; eauto; simpl; intros. subst.
+  destruct (H LV (fun x => C (Eassign x r ty))) as [A | [C' [a' [A [B D]]]]].
+    eapply context_compose; eauto. repeat constructor. auto.
+  destruct (H0 RV (fun x => C (Eassign l x ty))) as [A' | [C' [a' [A' [B D]]]]].
+    eapply context_compose; eauto. repeat constructor. auto.
+  right. exists (fun x => x); exists (Eassign l r ty).
+  split. red; auto. split. constructor. auto.
+  right; exists (fun x => Eassign l (C' x) ty); exists a'. 
+  split. auto. split. constructor; auto. rewrite D; auto.
+  right; exists (fun x => Eassign (C' x) r ty); exists a'. 
+  split. auto. split. constructor; auto. rewrite D; auto.
+(* assignop *)
+  exploit safe_expr_kind; eauto; simpl; intros. subst.
+  destruct (H LV (fun x => C (Eassignop op x r tyres ty))) as [A | [C' [a' [A [B D]]]]].
+    eapply context_compose; eauto. repeat constructor. auto.
+  destruct (H0 RV (fun x => C (Eassignop op l x tyres ty))) as [A' | [C' [a' [A' [B D]]]]].
+    eapply context_compose; eauto. repeat constructor. auto.
+  right. exists (fun x => x); exists (Eassignop op l r tyres ty).
+  split. red; auto. split. constructor. auto.
+  right; exists (fun x => Eassignop op l (C' x) tyres ty); exists a'. 
+  split. auto. split. constructor; auto. rewrite D; auto.
+  right; exists (fun x => Eassignop op (C' x) r tyres ty); exists a'. 
+  split. auto. split. constructor; auto. rewrite D; auto.
+(* postincr *)
+  exploit safe_expr_kind; eauto; simpl; intros. subst.
+  destruct (H LV (fun x => C(Epostincr id x ty))) as [A | [C' [a' [A [B D]]]]].
+    eapply context_compose; eauto. repeat constructor. auto. 
+  right. exists (fun x => x); exists (Epostincr id l ty).
+  split. red; auto. split. constructor. auto.
+  right; exists (fun x => Epostincr id (C' x) ty); exists a'. 
+  split. auto. split. econstructor; eauto. rewrite D; auto.
+(* comma *)
+  exploit safe_expr_kind; eauto; simpl; intros. subst.
+  destruct (H RV (fun x => C(Ecomma x r2 ty))) as [A | [C' [a' [A [B D]]]]].
+    eapply context_compose; eauto. repeat constructor. auto. 
+  right. exists (fun x => x); exists (Ecomma r1 r2 ty).
+  split. red; auto. split. constructor. auto.
+  right; exists (fun x => Ecomma (C' x) r2 ty); exists a'. 
+  split. auto. split. econstructor; eauto. rewrite D; auto.
+(* call *)
+  exploit safe_expr_kind; eauto; simpl; intros. subst.
+  destruct (H RV (fun x => C (Ecall x rargs ty))) as [A | [C' [a' [A [B D]]]]].
+    eapply context_compose; eauto. repeat constructor. auto.
+  destruct (H0 (fun x => C (Ecall r1 x ty))) as [A' | [C' [a' [A' [B D]]]]].
+    eapply contextlist'_intro with (C := C) (rl0 := Enil). auto. auto.
+  right. exists (fun x => x); exists (Ecall r1 rargs ty).
+  split. red; auto. split. constructor. auto.
+  right; exists (fun x => Ecall r1 (C' x) ty); exists a'. 
+  split. auto. split. constructor; auto. rewrite D; auto.
+  right; exists (fun x => Ecall (C' x) rargs ty); exists a'.
+  split. auto. split. constructor; auto. rewrite D; auto.
+(* rparen *)
+  exploit safe_expr_kind; eauto; simpl; intros. subst.
+  destruct (H RV (fun x => C (Eparen x ty))) as [A | [C' [a' [A [B D]]]]].
+    eapply context_compose; eauto. repeat constructor. auto.
+  right. exists (fun x => x); exists (Eparen r ty).
+  split. red; auto. split. constructor. auto.
+  right; exists (fun x => Eparen (C' x) ty); exists a'. 
+  split. auto. split. econstructor; eauto. rewrite D; auto.
+(* cons *)
+  destruct (H RV (fun x => C (Econs x rl))) as [A | [C' [a' [A [B D]]]]].
+    eapply contextlist'_head; eauto. auto.
+  destruct (H0 (fun x => C (Econs r1 x))) as [A' | [C' [a' [A' [B D]]]]].
+    eapply contextlist'_tail; eauto. auto. 
+  auto.
+  right; exists (fun x => Econs r1 (C' x)); exists a'. 
+  split. auto. split. constructor; auto. rewrite D; auto.
+  right; exists (fun x => Econs (C' x) rl); exists a'. 
+  split. auto. split. constructor; auto. rewrite D; auto.
+Qed.
+
+Lemma decompose_topexpr:
+  forall a,
+  safe w (ExprState f a k e m) ->
+       simple a
+    \/ exists C, exists a', simple_side_effect a' /\ leftcontext RV RV C /\ a = C a'.
+Proof.
+  intros. eapply (proj1 decompose_expr). apply ctx_top. auto.
+Qed.
+
+End DECOMPOSITION.
+
+(** Simulation for expressions. *)
+
+Lemma can_estep:
+  forall w f a k e m,
+  safe w (ExprState f a k e m) ->
+  match a with Eval _ _ => False | _ => True end ->
+  exists S,
+     estep (ExprState f a k e m) E0 S
+  /\ plus Csem.step ge (ExprState f a k e m) E0 S.
+Proof.
+  intros. destruct (decompose_topexpr f k e m w a H) as [A | [C [b [P [Q R]]]]].
+(* expr *)
+  exploit (simple_eval_r f k e m w a (fun x => x)); auto. constructor.
+  intros [v [S T]].
+  econstructor; split. 
+  eapply step_expr; eauto.
+  inversion T. rewrite H2 in H0. contradiction. econstructor; eauto. 
+(* side effect *)
+  clear H0. subst a. red in P. destruct b; try contradiction. 
+(* condition *)
+  set (C1 := fun x => Econdition x b2 b3 ty).
+  exploit (simple_eval_r f k e m w b1 (fun x => C(C1 x))). auto. 
+    eapply context_compose; eauto. repeat constructor. auto. 
+  unfold C1; intros [v [A B]].
+  exploit not_imm_stuck_inv.
+    eapply safe_not_imm_stuck. eapply safe_steps; eauto. constructor. eauto.
+  simpl. intros [[X Y] | [X Y]].
+  econstructor; split. eapply step_condition_true; eauto.
+  eapply plus_right. eauto. left; eapply step_rred. constructor; auto.
+  eapply safe_not_stuck. eapply safe_steps; eauto. constructor. apply leftcontext_context; auto.
+  traceEq.
+  econstructor; split. eapply step_condition_false; eauto.
+  eapply plus_right. eauto. left; eapply step_rred. constructor; auto.
+  eapply safe_not_stuck. eapply safe_steps; eauto. constructor. apply leftcontext_context; auto.
+  traceEq.
+(* assign *)
+  destruct P.
+  set (C1 := fun x => Eassign x b2 ty).
+  exploit (simple_eval_l f k e m w b1 (fun x => C(C1 x))). auto. 
+    eapply context_compose; eauto. repeat constructor. auto. 
+  unfold C1; intros [blk [ofs [A B]]].
+  assert (S1: safe w (ExprState f (C (Eassign (Eloc blk ofs (typeof b1)) b2 ty)) k e m)).
+    eapply safe_steps; eauto. constructor.
+  set (C2 := fun x => Eassign (Eloc blk ofs (typeof b1)) x ty).
+  exploit (simple_eval_r f k e m w b2 (fun x => C(C2 x))). auto. 
+    eapply context_compose; eauto. repeat constructor. auto. 
+  unfold C2; intros [v [E F]].
+  assert (S2: safe w (ExprState f
+         (C (Eassign (Eloc blk ofs (typeof b1)) (Eval v (typeof b2)) ty)) k e
+         m)).
+    eapply safe_steps; eauto. constructor.
+  exploit not_imm_stuck_inv. eapply safe_not_imm_stuck. eexact S2. eauto. 
+  simpl. intros [v' [m' [X [Y Z]]]].
+  econstructor; split.
+  eapply step_assign with (C := C); eauto.
+  eapply star_plus_trans. eapply star_trans; eauto. 
+  apply plus_one. left. apply step_rred. rewrite X. econstructor; eauto. 
+  eapply safe_not_stuck; eauto. apply leftcontext_context; auto.
+  traceEq.
+(* assignop *)
+  destruct P.
+  set (C1 := fun x => Eassignop op x b2 tyres ty).
+  exploit (simple_eval_l f k e m w b1 (fun x => C(C1 x))). auto. 
+    eapply context_compose; eauto. repeat constructor. auto. 
+  unfold C1; intros [blk [ofs [A B]]].
+  assert (S1: safe w (ExprState f (C (Eassignop op (Eloc blk ofs (typeof b1)) b2 tyres ty)) k e m)).
+    eapply safe_steps; eauto. constructor.
+  set (C2 := fun x => Eassignop op (Eloc blk ofs (typeof b1)) x tyres ty).
+  exploit (simple_eval_r f k e m w b2 (fun x => C(C2 x))). auto. 
+    eapply context_compose; eauto. repeat constructor. auto. 
+  unfold C2; intros [v [E F]].
+  assert (S2: safe w (ExprState f
+         (C
+            (Eassignop op (Eloc blk ofs (typeof b1)) (Eval v (typeof b2))
+               tyres ty)) k e m)).
+    eapply safe_steps; eauto. constructor.
+  exploit not_imm_stuck_inv. eapply safe_not_imm_stuck. eexact S2. eauto. 
+  simpl. intros [v1 [v2 [v3 [m' [U [V [W [X Y]]]]]]]].
+  econstructor; split.
+  eapply step_assignop with (C := C); eauto.
+  eapply star_plus_trans. eapply star_trans; eauto. 
+  apply plus_one. left. apply step_rred. rewrite U. econstructor; eauto.
+  eapply safe_not_stuck; eauto. apply leftcontext_context; auto.
+  traceEq.
+(* postincr *)
+  set (C1 := fun x => Epostincr id x ty).
+  exploit (simple_eval_l f k e m w b (fun x => C(C1 x))). auto. 
+    eapply context_compose; eauto. repeat constructor. auto. 
+  unfold C1; intros [blk [ofs [A B]]].
+  assert (S1: safe w (ExprState f (C (Epostincr id (Eloc blk ofs (typeof b)) ty)) k e m)).
+    eapply safe_steps; eauto. constructor.
+  exploit not_imm_stuck_inv. eapply safe_not_imm_stuck. eexact S1. eauto. 
+  simpl. intros [v1 [v2 [v3 [m' [U [V [W [X Y]]]]]]]].
+  econstructor; split.
+  eapply step_postincr with (C := C); eauto.
+  eapply star_plus_trans. eauto. 
+  apply plus_one. left. apply step_rred. subst ty. econstructor; eauto.
+  eapply safe_not_stuck; eauto. apply leftcontext_context; auto.
+  traceEq.
+(* comma *)
+  set (C1 := fun x => Ecomma x b2 ty).
+  exploit (simple_eval_r f k e m w b1 (fun x => C(C1 x))). auto. 
+    eapply context_compose; eauto. repeat constructor. auto. 
+  unfold C1; intros [v1 [A B]].
+  assert (S1: safe w (ExprState f (C (Ecomma (Eval v1 (typeof b1)) b2 ty)) k e m)).
+    eapply safe_steps; eauto. constructor.
+  exploit not_imm_stuck_inv. eapply safe_not_imm_stuck. eexact S1. eauto. 
+  simpl. intro X.
+  econstructor; split.
+  eapply step_comma with (C := C); eauto.
+  eapply star_plus_trans. eauto. 
+  apply plus_one. left. apply step_rred. subst ty. econstructor; eauto.
+  eapply safe_not_stuck; eauto. apply leftcontext_context; auto.
+  traceEq.
+(* call *)
+  destruct P.
+  set (C1 := fun x => Ecall x rargs ty).
+  exploit (simple_eval_r f k e m w b (fun x => C(C1 x))). auto. 
+    eapply context_compose; eauto. repeat constructor. auto. 
+  unfold C1; intros [vf [A B]].
+  assert (S1: safe w (ExprState f (C (Ecall (Eval vf (typeof b)) rargs ty)) k e m)).
+    eapply safe_steps; eauto. constructor.
+  exploit (simple_eval_rlist f k e m w rargs (fun x => C(Ecall (Eval vf (typeof b)) x ty))).
+    auto. eapply contextlist'_intro with (rl0 := Enil). auto. auto.
+  intros [vl [E F]].
+  assert (S2: safe w (ExprState f (C (Ecall (Eval vf (typeof b)) (rval_list vl rargs) ty))
+         k e m)).
+    eapply safe_steps; eauto. constructor.
+  exploit not_imm_stuck_inv. eapply safe_not_imm_stuck. eexact S2. eauto. 
+  simpl. intros X.
+  destruct X as [tyargs [tyres [fd [vl' [U [V [W X]]]]]]].
+  apply rval_list_all_values.
+  econstructor; split.
+  eapply step_call with (C := C); eauto. eapply can_eval_simple_list; eauto.
+  eapply plus_right. eapply star_trans; eauto. 
+  left. econstructor. rewrite U. econstructor; eauto. 
+  eapply safe_not_stuck; eauto. apply leftcontext_context; auto.
+  traceEq.
+(* rparen *)
+  set (C1 := fun x => Eparen x ty).
+  exploit (simple_eval_r f k e m w b (fun x => C(C1 x))). auto. 
+    eapply context_compose; eauto. repeat constructor. auto. 
+  unfold C1; intros [v [A B]].
+  assert (S1: safe w (ExprState f (C (Eparen (Eval v (typeof b)) ty)) k e m)).
+    eapply safe_steps; eauto. constructor.
+  exploit not_imm_stuck_inv. eapply safe_not_imm_stuck. eexact S1. eauto. 
+  simpl. intros EQ. subst ty.
+  econstructor; split.
+  eapply step_paren with (C := C); eauto.
+  eapply star_plus_trans. eauto. 
+  apply plus_one. left. apply step_rred. econstructor; eauto.
+  eapply safe_not_stuck; eauto. apply leftcontext_context; auto.
+  traceEq.
+Qed.
+
+(** The main simulation result. *)
+
+Theorem strategy_simulation:
+  forall w S,
+  safe w S ->
+     (exists r, final_state S r)
+  \/ (exists t, exists S', exists w',
+         step S t S'
+      /\ plus Csem.step ge S t S'
+      /\ possible_trace w t w').
+Proof.
+  intros. exploit safe_imm; eauto. intros IS; inv IS.
+(* terminated *)
+  left; exists r; auto.
+  destruct H0.
+(* expression step *)
+  inv H0. 
+  (* lred *)
+  exploit can_estep; eauto. inv H4; auto. 
+  intros [S [A B]]. right. exists E0; exists S; exists w. 
+  split. left; auto. split. auto. constructor.
+  (* rred *)
+  exploit can_estep; eauto. inv H4; auto. inv H2; auto. 
+  intros [S [A B]]. right. exists E0; exists S; exists w. 
+  split. left; auto. split. auto. constructor.
+  (* callred *)
+  exploit can_estep; eauto. inv H4; auto. inv H2; auto. 
+  intros [S [A B]]. right. exists E0; exists S; exists w. 
+  split. left; auto. split. auto. constructor.
+(* other step *)
+  right. exists t; exists s'; exists w'.
+  split. right. auto. 
+  split. apply plus_one. right. auto. 
+  auto.
+Qed.
+
+End STRATEGY.
+
+(** * Whole-program behaviors *)
+
+Definition exec_program (p: program) (beh: program_behavior) : Prop :=
+  program_behaves step (initial_state p) final_state (Genv.globalenv p) beh.
+
+Definition safeprog (p: program) (w: world) : Prop :=
+  (exists s, initial_state p s)
+  /\ (forall s, initial_state p s -> safe (Genv.globalenv p) w s).
+
+(** We now show the existence of a safe behavior for the strategy,
+  which is also an acceptable behavior for the nondeterministic semantics. *)
+
+Section BEHAVIOR.
+
+Variable prog: program.
+Variable initial_world: world.
+
+(** We define a transition semantics that combines 
+- one strategy step;
+- one or several nondeterministic steps;
+- the state of the external world.
+*)
+
+Local Open Scope pair_scope.
+
+Definition comb_state := (state * world)%type.
+
+Definition comb_step (ge: genv) (s: comb_state) (t: trace) (s': comb_state) : Prop :=
+  (step ge s#1 t s'#1 /\ plus Csem.step ge s#1 t s'#1)
+  /\ possible_trace s#2 t s'#2.
+
+Definition comb_initial_state (s: comb_state) : Prop :=
+  initial_state prog s#1 /\ s#2 = initial_world.
+
+Definition comb_final_state (s: comb_state) (r: int) : Prop :=
+  final_state s#1 r.
+
+Definition comb_program_behaves (beh: program_behavior) : Prop :=
+  program_behaves comb_step comb_initial_state comb_final_state (Genv.globalenv prog) beh.
+
+(** If the source program is safe, the combined semantics cannot go wrong. *)
+
+Remark proj_star_comb_step:
+  forall ge s t s',
+  star comb_step ge s t s' ->
+  star Csem.step ge s#1 t s'#1 /\ possible_trace s#2 t s'#2.
+Proof.
+  induction 1. split; constructor.
+  destruct H as [[A B] C]. destruct IHstar. 
+  split. eapply star_trans. apply plus_star; eauto. eauto. auto. 
+  subst t. eapply possible_trace_app; eauto.
+Qed.
+
+Lemma comb_behavior_not_wrong:
+  forall beh,
+  safeprog prog initial_world -> comb_program_behaves beh -> not_wrong beh.
+Proof.
+  intros. destruct H. inv H0; simpl; auto.
+(* Goes wrong after some steps *)
+  destruct H2. exploit proj_star_comb_step; eauto. intros [A B].
+  assert (C: safe (Genv.globalenv prog) s'#2 s'#1).
+    eapply safe_steps. apply H1. eauto. eauto. congruence.
+  exploit strategy_simulation. eexact C. 
+  intros [[r P] | [t' [s'' [w'' [P [Q R]]]]]].
+  elim (H5 r). auto. 
+  elim (H4 t' (s'', w'')). red. auto. 
+(* Goes initiall wrong *)
+  destruct H as [s A]. elim (H2 (s, initial_world)). red; auto. 
+Qed.
+
+(** Any non-wrong behavior of the combined semantics is a behavior 
+  for the nondeterministic semantics. *)
+
+Lemma proj1_comb_behavior:
+  forall beh,
+  not_wrong beh ->
+  comb_program_behaves beh ->
+  Csem.exec_program prog beh.
+Proof.
+  intros. red in H0. red.
+  eapply simulation_plus_preservation with
+    (match_states := fun (S1: comb_state) (S2: state) => S2 = S1#1); eauto.
+  intros. destruct H1. exists (st1#1); auto.
+  intros. red in H2. congruence.
+  intros. destruct H1 as [[A B] D]. subst st2. exists (st1'#1); auto.
+Qed.
+
+(** Likewise, any non-wrong behavior of the combined semantics is a behavior 
+  for the strategy. *)
+
+Lemma proj2_comb_behavior:
+  forall beh,
+  not_wrong beh ->
+  comb_program_behaves beh ->
+  exec_program prog beh.
+Proof.
+  intros. red in H0. red.
+  eapply simulation_step_preservation with
+    (match_states := fun (S1: comb_state) (S2: state) => S2 = S1#1); eauto.
+  intros. destruct H1. exists (st1#1); auto.
+  intros. red in H2. congruence.
+  intros. destruct H1 as [[A B] D]. subst st2. exists (st1'#1); auto.
+Qed.
+
+(** Finally, any behavior of the combined semantics is possible in the
+  initial world. *)
+
+Lemma possible_comb_behavior:
+  forall beh,
+  comb_program_behaves beh ->
+  possible_behavior initial_world beh.
+Proof.
+  intros. 
+  apply (project_behaviors_trace _ _
+    (fun ge s t s' => step ge s t s' /\ plus Csem.step ge s t s')
+    (initial_state prog)
+    final_state
+    initial_world (Genv.globalenv prog)).
+  exact H. 
+Qed.
+
+(** It follows that a safe C program has a non-wrong behavior that
+  follows the strategy. *)
+
+Theorem strategy_behavior:
+  safeprog prog initial_world ->
+  exists beh, not_wrong beh 
+           /\ Csem.exec_program prog beh
+           /\ exec_program prog beh
+           /\ possible_behavior initial_world beh.
+Proof.
+  intros.
+  assert (exists beh, comb_program_behaves beh).
+    unfold comb_program_behaves. apply program_behaves_exists. 
+  destruct H0 as [beh CPB].
+  assert (not_wrong beh). eapply comb_behavior_not_wrong; eauto. 
+  exists beh. split. auto.
+  split. apply proj1_comb_behavior; auto.
+  split. apply proj2_comb_behavior; auto.
+  apply possible_comb_behavior; auto.
+Qed.
+
+End BEHAVIOR.
+
+(** * A big-step semantics implementing the reduction strategy. *)
+
+Section BIGSTEP.
+
+Variable ge: genv.
+
+(** The execution of a statement produces an ``outcome'', indicating
+  how the execution terminated: either normally or prematurely
+  through the execution of a [break], [continue] or [return] statement. *)
+
+Inductive outcome: Type :=
+   | Out_break: outcome                 (**r terminated by [break] *)
+   | Out_continue: outcome              (**r terminated by [continue] *)
+   | Out_normal: outcome                (**r terminated normally *)
+   | Out_return: option (val * type) -> outcome. (**r terminated by [return] *)
+
+Inductive out_normal_or_continue : outcome -> Prop :=
+  | Out_normal_or_continue_N: out_normal_or_continue Out_normal
+  | Out_normal_or_continue_C: out_normal_or_continue Out_continue.
+
+Inductive out_break_or_return : outcome -> outcome -> Prop :=
+  | Out_break_or_return_B: out_break_or_return Out_break Out_normal
+  | Out_break_or_return_R: forall ov,
+      out_break_or_return (Out_return ov) (Out_return ov).
+
+Definition outcome_switch (out: outcome) : outcome :=
+  match out with
+  | Out_break => Out_normal
+  | o => o
+  end.
+
+Definition outcome_result_value (out: outcome) (t: type) (v: val) : Prop :=
+  match out, t with
+  | Out_normal, Tvoid => v = Vundef
+  | Out_return None, Tvoid => v = Vundef
+  | Out_return (Some (v', ty')), ty => ty <> Tvoid /\ cast v' ty' ty v
+  | _, _ => False
+  end. 
+
+(** [eval_expression ge e m1 a t m2 a'] describes the evaluation of the
+  complex expression e.  [v] is the resulting value, [m2] the final
+  memory state, and [t] the trace of input/output events performed
+  during this evaluation.  *)
+
+Inductive eval_expression: env -> mem -> expr -> trace -> mem -> val -> Prop :=
+  | eval_expression_intro: forall e m a t m' a' v,
+      eval_expr e m RV a t m' a' -> eval_simple_rvalue ge e m' a' v ->
+      eval_expression e m a t m' v
+
+with eval_expr: env -> mem -> kind -> expr -> trace -> mem -> expr -> Prop :=
+  | eval_val: forall e m v ty,
+      eval_expr e m RV (Eval v ty) E0 m (Eval v ty)
+  | eval_var: forall e m x ty,
+      eval_expr e m LV (Evar x ty) E0 m (Evar x ty)
+  | eval_field: forall e m a t m' a' f ty,
+      eval_expr e m LV a t m' a' ->
+      eval_expr e m LV (Efield a f ty) t m' (Efield a' f ty)
+  | eval_valof: forall e m a t m' a' ty,
+      eval_expr e m LV a t m' a' ->
+      eval_expr e m RV (Evalof a ty) t m' (Evalof a' ty)
+  | eval_deref: forall e m a t m' a' ty,
+      eval_expr e m RV a t m' a' ->
+      eval_expr e m LV (Ederef a ty) t m' (Ederef a' ty)
+  | eval_addrof: forall e m a t m' a' ty,
+      eval_expr e m LV a t m' a' ->
+      eval_expr e m RV (Eaddrof a ty) t m' (Eaddrof a' ty)
+  | eval_unop: forall e m a t m' a' op ty,
+      eval_expr e m RV a t m' a' ->
+      eval_expr e m RV (Eunop op a ty) t m' (Eunop op a' ty)
+  | eval_binop: forall e m a1 t1 m' a1' a2 t2 m'' a2' op ty,
+      eval_expr e m RV a1 t1 m' a1' -> eval_expr e m' RV a2 t2 m'' a2' ->
+      eval_expr e m RV (Ebinop op a1 a2 ty) (t1 ** t2) m'' (Ebinop op a1' a2' ty)
+  | eval_cast: forall e m a t m' a' ty,
+      eval_expr e m RV a t m' a' ->
+      eval_expr e m RV (Ecast a ty) t m' (Ecast a' ty)
+  | eval_condition_true: forall e m a1 a2 a3 ty t1 m' a1' v1 t2 m'' a2' v,
+      eval_expr e m RV a1 t1 m' a1' -> eval_simple_rvalue ge e m' a1' v1 -> is_true v1 (typeof a1) ->
+      eval_expr e m' RV a2 t2 m'' a2' -> eval_simple_rvalue ge e m'' a2' v ->
+      ty = typeof a2 ->
+      eval_expr e m RV (Econdition a1 a2 a3 ty) (t1**t2) m'' (Eval v ty)
+  | eval_condition_false: forall e m a1 a2 a3 ty t1 m' a1' v1 t2 m'' a3' v,
+      eval_expr e m RV a1 t1 m' a1' -> eval_simple_rvalue ge e m' a1' v1 -> is_false v1 (typeof a1) ->
+      eval_expr e m' RV a3 t2 m'' a3' -> eval_simple_rvalue ge e m'' a3' v ->
+      ty = typeof a3 ->
+      eval_expr e m RV (Econdition a1 a2 a3 ty) (t1**t2) m'' (Eval v ty)
+  | eval_sizeof: forall e m ty' ty,
+      eval_expr e m RV (Esizeof ty' ty) E0 m (Esizeof ty' ty)
+  | eval_assign: forall e m l r ty t1 m1 l' t2 m2 r' b ofs v v' m3,
+      eval_expr e m LV l t1 m1 l' -> eval_expr e m1 RV r t2 m2 r' ->
+      eval_simple_lvalue ge e m2 l' b ofs ->
+      eval_simple_rvalue ge e m2 r' v ->
+      cast v (typeof r) (typeof l) v' ->
+      store_value_of_type (typeof l) m2 b ofs v' = Some m3 ->
+      ty = typeof l ->
+      eval_expr e m RV (Eassign l r ty) (t1**t2) m3 (Eval v' ty)
+  | eval_assignop: forall e m op l r tyres ty t1 m1 l' t2 m2 r' b ofs
+                          v1 v2 v3 v4 m3,
+      eval_expr e m LV l t1 m1 l' -> eval_expr e m1 RV r t2 m2 r' ->
+      eval_simple_lvalue ge e m2 l' b ofs ->
+      load_value_of_type (typeof l) m2 b ofs = Some v1 ->
+      eval_simple_rvalue ge e m2 r' v2 ->
+      sem_binary_operation op v1 (typeof l) v2 (typeof r) m2 = Some v3 ->
+      cast v3 tyres (typeof l) v4 ->
+      store_value_of_type (typeof l) m2 b ofs v4 = Some m3 ->
+      ty = typeof l ->
+      eval_expr e m RV (Eassignop op l r tyres ty) (t1**t2) m3 (Eval v4 ty)
+  | eval_postincr: forall e m id l ty t m1 l' b ofs v1 v2 v3 m2,
+      eval_expr e m LV l t m1 l' ->
+      eval_simple_lvalue ge e m1 l' b ofs ->
+      load_value_of_type ty m1 b ofs = Some v1 ->
+      sem_incrdecr id v1 ty = Some v2 ->
+      cast v2 (typeconv ty) ty v3 ->
+      store_value_of_type ty m1 b ofs v3 = Some m2 ->
+      ty = typeof l ->
+      eval_expr e m RV (Epostincr id l ty) t m2 (Eval v1 ty)
+  | eval_comma: forall e m r1 r2 ty t1 m1 r1' v1 t2 m2 r2',
+      eval_expr e m RV r1 t1 m1 r1' ->
+      eval_simple_rvalue ge e m1 r1' v1 ->
+      eval_expr e m1 RV r2 t2 m2 r2' ->
+      ty = typeof r2 ->
+      eval_expr e m RV (Ecomma r1 r2 ty) (t1**t2) m2 r2'
+  | eval_call: forall e m rf rargs ty t1 m1 rf' t2 m2 rargs' vf vargs
+                      targs tres fd t3 m3 vres,
+      eval_expr e m RV rf t1 m1 rf' -> eval_exprlist e m1 rargs t2 m2 rargs' ->
+      eval_simple_rvalue ge e m2 rf' vf ->
+      eval_simple_list ge e m2 rargs' targs vargs ->
+      typeof rf = Tfunction targs tres ->
+      Genv.find_funct ge vf = Some fd ->
+      type_of_fundef fd = Tfunction targs tres ->
+      eval_funcall m2 fd vargs t3 m3 vres ->
+      eval_expr e m RV (Ecall rf rargs ty) (t1**t2**t3) m3 (Eval vres ty)
+
+with eval_exprlist: env -> mem -> exprlist -> trace -> mem -> exprlist -> Prop :=
+  | eval_nil: forall e m,
+      eval_exprlist e m Enil E0 m Enil
+  | eval_cons: forall e m a1 al t1 m1 a1' t2 m2 al',
+      eval_expr e m RV a1 t1 m1 a1' -> eval_exprlist e m1 al t2 m2 al' ->
+      eval_exprlist e m (Econs a1 al) (t1**t2) m2 (Econs a1' al')
+
+(** [exec_stmt ge e m1 s t m2 out] describes the execution of 
+  the statement [s].  [out] is the outcome for this execution.
+  [m1] is the initial memory state, [m2] the final memory state.
+  [t] is the trace of input/output events performed during this
+  evaluation. *)
+
+with exec_stmt: env -> mem -> statement -> trace -> mem -> outcome -> Prop :=
+  | exec_Sskip:   forall e m,
+      exec_stmt e m Sskip
+               E0 m Out_normal
+  | exec_Sdo:     forall e m a t m' v,
+      eval_expression e m a t m' v ->
+      exec_stmt e m (Sdo a)
+                t m' Out_normal
+  | exec_Sseq_1:   forall e m s1 s2 t1 m1 t2 m2 out,
+      exec_stmt e m s1 t1 m1 Out_normal ->
+      exec_stmt e m1 s2 t2 m2 out ->
+      exec_stmt e m (Ssequence s1 s2)
+                (t1 ** t2) m2 out
+  | exec_Sseq_2:   forall e m s1 s2 t1 m1 out,
+      exec_stmt e m s1 t1 m1 out ->
+      out <> Out_normal ->
+      exec_stmt e m (Ssequence s1 s2)
+                t1 m1 out
+  | exec_Sifthenelse_true: forall e m a s1 s2 t1 m1 v1 t2 m2 out,
+      eval_expression e m a t1 m1 v1 ->
+      is_true v1 (typeof a) ->
+      exec_stmt e m1 s1 t2 m2 out ->
+      exec_stmt e m (Sifthenelse a s1 s2)
+                (t1**t2) m2 out
+  | exec_Sifthenelse_false: forall e m a s1 s2 t1 m1 v1 t2 m2 out,
+      eval_expression e m a t1 m1 v1 ->
+      is_false v1 (typeof a) ->
+      exec_stmt e m1 s2 t2 m2 out ->
+      exec_stmt e m (Sifthenelse a s1 s2)
+                (t1**t2) m2 out
+  | exec_Sreturn_none:   forall e m,
+      exec_stmt e m (Sreturn None)
+               E0 m (Out_return None)
+  | exec_Sreturn_some: forall e m a t m' v,
+      eval_expression e m a t m' v ->
+      exec_stmt e m (Sreturn (Some a))
+                t m' (Out_return (Some(v, typeof a)))
+  | exec_Sbreak:   forall e m,
+      exec_stmt e m Sbreak
+               E0 m Out_break
+  | exec_Scontinue:   forall e m,
+      exec_stmt e m Scontinue
+               E0 m Out_continue
+  | exec_Swhile_false: forall e m a s t m' v,
+      eval_expression e m a t m' v ->
+      is_false v (typeof a) ->
+      exec_stmt e m (Swhile a s)
+                t m' Out_normal
+  | exec_Swhile_stop: forall e m a s t1 m1 v t2 m2 out' out,
+      eval_expression e m a t1 m1 v ->
+      is_true v (typeof a) ->
+      exec_stmt e m1 s t2 m2 out' ->
+      out_break_or_return out' out ->
+      exec_stmt e m (Swhile a s)
+                (t1**t2) m2 out
+  | exec_Swhile_loop: forall e m a s t1 m1 v t2 m2 out1 t3 m3 out,
+      eval_expression e m a t1 m1 v ->
+      is_true v (typeof a) ->
+      exec_stmt e m1 s t2 m2 out1 ->
+      out_normal_or_continue out1 ->
+      exec_stmt e m2 (Swhile a s) t3 m3 out ->
+      exec_stmt e m (Swhile a s)
+                (t1 ** t2 ** t3) m3 out
+  | exec_Sdowhile_false: forall e m s a t1 m1 out1 t2 m2 v,
+      exec_stmt e m s t1 m1 out1 ->
+      out_normal_or_continue out1 ->
+      eval_expression e m1 a t2 m2 v ->
+      is_false v (typeof a) ->
+      exec_stmt e m (Sdowhile a s)
+                (t1 ** t2) m2 Out_normal
+  | exec_Sdowhile_stop: forall e m s a t m1 out1 out,
+      exec_stmt e m s t m1 out1 ->
+      out_break_or_return out1 out ->
+      exec_stmt e m (Sdowhile a s)
+                t m1 out
+  | exec_Sdowhile_loop: forall e m s a t1 m1 out1 t2 m2 v t3 m3 out,
+      exec_stmt e m s t1 m1 out1 ->
+      out_normal_or_continue out1 ->
+      eval_expression e m1 a t2 m2 v ->
+      is_true v (typeof a) ->
+      exec_stmt e m2 (Sdowhile a s) t3 m3 out ->
+      exec_stmt e m (Sdowhile a s) 
+                (t1 ** t2 ** t3) m3 out
+  | exec_Sfor_start: forall e m s a1 a2 a3 out m1 m2 t1 t2,
+      exec_stmt e m a1 t1 m1 Out_normal ->
+      exec_stmt e m1 (Sfor Sskip a2 a3 s) t2 m2 out ->
+      exec_stmt e m (Sfor a1 a2 a3 s) 
+                (t1 ** t2) m2 out
+  | exec_Sfor_false: forall e m s a2 a3 t m' v,
+      eval_expression e m a2 t m' v ->
+      is_false v (typeof a2) ->
+      exec_stmt e m (Sfor Sskip a2 a3 s)
+                t m' Out_normal
+  | exec_Sfor_stop: forall e m s a2 a3 t1 m1 v t2 m2 out1 out,
+      eval_expression e m a2 t1 m1 v ->
+      is_true v (typeof a2) ->
+      exec_stmt e m1 s t2 m2 out1 ->
+      out_break_or_return out1 out ->
+      exec_stmt e m (Sfor Sskip a2 a3 s)
+                (t1 ** t2) m2 out
+  | exec_Sfor_loop: forall e m s a2 a3 t1 m1 v t2 m2 out1 t3 m3 t4 m4 out,
+      eval_expression e m a2 t1 m1 v ->
+      is_true v (typeof a2) ->
+      exec_stmt e m1 s t2 m2 out1 ->
+      out_normal_or_continue out1 ->
+      exec_stmt e m2 a3 t3 m3 Out_normal ->
+      exec_stmt e m3 (Sfor Sskip a2 a3 s) t4 m4 out ->
+      exec_stmt e m (Sfor Sskip a2 a3 s)
+                (t1 ** t2 ** t3 ** t4) m4 out
+  | exec_Sswitch:   forall e m a sl t1 m1 n t2 m2 out,
+      eval_expression e m a t1 m1 (Vint n) ->
+      exec_stmt e m1 (seq_of_labeled_statement (select_switch n sl)) t2 m2 out ->
+      exec_stmt e m (Sswitch a sl)
+                (t1 ** t2) m2 (outcome_switch out)
+
+(** [eval_funcall m1 fd args t m2 res] describes the invocation of
+  function [fd] with arguments [args].  [res] is the value returned
+  by the call.  *)
+
+with eval_funcall: mem -> fundef -> list val -> trace -> mem -> val -> Prop :=
+  | eval_funcall_internal: forall m f vargs t e m1 m2 m3 out vres m4,
+      list_norepet (var_names f.(fn_params) ++ var_names f.(fn_vars)) ->
+      alloc_variables empty_env m (f.(fn_params) ++ f.(fn_vars)) e m1 ->
+      bind_parameters e m1 f.(fn_params) vargs m2 ->
+      exec_stmt e m2 f.(fn_body) t m3 out ->
+      outcome_result_value out f.(fn_return) vres ->
+      Mem.free_list m3 (blocks_of_env e) = Some m4 ->
+      eval_funcall m (Internal f) vargs t m4 vres
+  | eval_funcall_external: forall m ef targs tres vargs t vres m',
+      external_call ef ge vargs m t vres m' ->
+      eval_funcall m (External ef targs tres) vargs t m' vres.
+
+Scheme eval_expression_ind5 := Minimality for eval_expression Sort Prop
+  with eval_expr_ind5 := Minimality for eval_expr Sort Prop
+  with eval_exprlist_ind5 := Minimality for eval_exprlist Sort Prop
+  with exec_stmt_ind5 := Minimality for exec_stmt Sort Prop
+  with eval_funcall_ind5 := Minimality for eval_funcall Sort Prop.
+
+Combined Scheme bigstep_induction from
+        eval_expression_ind5,  eval_expr_ind5,  eval_exprlist_ind5,
+        exec_stmt_ind5, eval_funcall_ind5.
+
+(** [evalinf_expr ge e m1 K a T] denotes the fact that expression [a]
+  diverges in initial state [m1].  [T] is the trace of input/output
+  events performed during this evaluation.  *)
+
+CoInductive evalinf_expr: env -> mem -> kind -> expr -> traceinf -> Prop :=
+  | evalinf_field: forall e m a t f ty,
+      evalinf_expr e m LV a t ->
+      evalinf_expr e m LV (Efield a f ty) t
+  | evalinf_valof: forall e m a t ty,
+      evalinf_expr e m LV a t ->
+      evalinf_expr e m RV (Evalof a ty) t
+  | evalinf_deref: forall e m a t ty,
+      evalinf_expr e m RV a t ->
+      evalinf_expr e m LV (Ederef a ty) t
+  | evalinf_addrof: forall e m a t ty,
+      evalinf_expr e m LV a t ->
+      evalinf_expr e m RV (Eaddrof a ty) t
+  | evalinf_unop: forall e m a t op ty,
+      evalinf_expr e m RV a t ->
+      evalinf_expr e m RV (Eunop op a ty) t
+  | evalinf_binop_left: forall e m a1 t1 a2 op ty,
+      evalinf_expr e m RV a1 t1 ->
+      evalinf_expr e m RV (Ebinop op a1 a2 ty) t1
+  | evalinf_binop_right: forall e m a1 t1 m' a1' a2 t2 op ty,
+      eval_expr e m RV a1 t1 m' a1' -> evalinf_expr e m' RV a2 t2 ->
+      evalinf_expr e m RV (Ebinop op a1 a2 ty) (t1 *** t2)
+  | evalinf_cast: forall e m a t ty,
+      evalinf_expr e m RV a t ->
+      evalinf_expr e m RV (Ecast a ty) t
+  | evalinf_condition: forall e m a1 a2 a3 ty t1,
+      evalinf_expr e m RV a1 t1 ->
+      evalinf_expr e m RV (Econdition a1 a2 a3 ty) t1
+  | evalinf_condition_true: forall e m a1 a2 a3 ty t1 m' a1' v1 t2,
+      eval_expr e m RV a1 t1 m' a1' -> eval_simple_rvalue ge e m' a1' v1 -> is_true v1 (typeof a1) ->
+      evalinf_expr e m' RV a2 t2 ->
+      ty = typeof a2 ->
+      evalinf_expr e m RV (Econdition a1 a2 a3 ty) (t1***t2)
+  | evalinf_condition_false: forall e m a1 a2 a3 ty t1 m' a1' v1 t2,
+      eval_expr e m RV a1 t1 m' a1' -> eval_simple_rvalue ge e m' a1' v1 -> is_false v1 (typeof a1) ->
+      evalinf_expr e m' RV a3 t2 ->
+      ty = typeof a3 ->
+      evalinf_expr e m RV (Econdition a1 a2 a3 ty) (t1***t2)
+  | evalinf_assign_left: forall e m a1 t1 a2 ty,
+      evalinf_expr e m LV a1 t1 ->
+      evalinf_expr e m RV (Eassign a1 a2 ty) t1
+  | evalinf_assign_right: forall e m a1 t1 m' a1' a2 t2 ty,
+      eval_expr e m LV a1 t1 m' a1' -> evalinf_expr e m' RV a2 t2 ->
+      evalinf_expr e m RV (Eassign a1 a2 ty) (t1 *** t2)
+  | evalinf_assignop_left: forall e m a1 t1 a2 op tyres ty,
+      evalinf_expr e m LV a1 t1 ->
+      evalinf_expr e m RV (Eassignop op a1 a2 tyres ty) t1
+  | evalinf_assignop_right: forall e m a1 t1 m' a1' a2 t2 op tyres ty,
+      eval_expr e m LV a1 t1 m' a1' -> evalinf_expr e m' RV a2 t2 ->
+      evalinf_expr e m RV (Eassignop op a1 a2 tyres ty) (t1 *** t2)
+  | evalinf_postincr: forall e m a t id ty,
+      evalinf_expr e m LV a t ->
+      evalinf_expr e m RV (Epostincr id a ty) t
+  | evalinf_comma_left: forall e m a1 t1 a2 ty,
+      evalinf_expr e m RV a1 t1 ->
+      evalinf_expr e m RV (Ecomma a1 a2 ty) t1
+  | evalinf_comma_right: forall e m a1 t1 m1 a1' v1 a2 t2 ty,
+      eval_expr e m RV a1 t1 m1 a1' -> eval_simple_rvalue ge e m1 a1' v1 ->
+      ty = typeof a2 ->
+      evalinf_expr e m1 RV a2 t2 ->
+      evalinf_expr e m RV (Ecomma a1 a2 ty) (t1 *** t2)
+  | evalinf_call_left: forall e m a1 t1 a2 ty,
+      evalinf_expr e m RV a1 t1 ->
+      evalinf_expr e m RV (Ecall a1 a2 ty) t1
+  | evalinf_call_right: forall e m a1 t1 m1 a1' a2 t2 ty,
+      eval_expr e m RV a1 t1 m1 a1' -> 
+      evalinf_exprlist e m1 a2 t2 ->
+      evalinf_expr e m RV (Ecall a1 a2 ty) (t1 *** t2)
+  | evalinf_call: forall e m rf rargs ty t1 m1 rf' t2 m2 rargs' vf vargs
+                      targs tres fd t3,
+      eval_expr e m RV rf t1 m1 rf' -> eval_exprlist e m1 rargs t2 m2 rargs' ->
+      eval_simple_rvalue ge e m2 rf' vf ->
+      eval_simple_list ge e m2 rargs' targs vargs ->
+      typeof rf = Tfunction targs tres ->
+      Genv.find_funct ge vf = Some fd ->
+      type_of_fundef fd = Tfunction targs tres ->
+      evalinf_funcall m2 fd vargs t3 ->
+      evalinf_expr e m RV (Ecall rf rargs ty) (t1***t2***t3)
+
+with evalinf_exprlist: env -> mem -> exprlist -> traceinf -> Prop :=
+  | evalinf_cons_left: forall e m a1 al t1,
+      evalinf_expr e m RV a1 t1 ->
+      evalinf_exprlist e m (Econs a1 al) t1
+  | evalinf_cons_right: forall e m a1 al t1 m1 a1' t2,
+      eval_expr e m RV a1 t1 m1 a1' -> evalinf_exprlist e m1 al t2 ->
+      evalinf_exprlist e m (Econs a1 al) (t1***t2)
+
+(** [execinf_stmt ge e m1 s t] describes the diverging execution of 
+  the statement [s].  *)
+
+with execinf_stmt: env -> mem -> statement -> traceinf -> Prop :=
+  | execinf_Sdo:     forall e m a t,
+      evalinf_expr e m RV a t ->
+      execinf_stmt e m (Sdo a) t
+  | execinf_Sseq_1:   forall e m s1 s2 t1,
+      execinf_stmt e m s1 t1 ->
+      execinf_stmt e m (Ssequence s1 s2) t1
+  | execinf_Sseq_2:   forall e m s1 s2 t1 m1 t2,
+      exec_stmt e m s1 t1 m1 Out_normal ->
+      execinf_stmt e m1 s2 t2 ->
+      execinf_stmt e m (Ssequence s1 s2) (t1***t2)
+  | execinf_Sifthenelse_test: forall e m a s1 s2 t1,
+      evalinf_expr e m RV a t1 ->
+      execinf_stmt e m (Sifthenelse a s1 s2) t1
+  | execinf_Sifthenelse_true: forall e m a s1 s2 t1 m1 v1 t2,
+      eval_expression e m a t1 m1 v1 ->
+      is_true v1 (typeof a) ->
+      execinf_stmt e m1 s1 t2 ->
+      execinf_stmt e m (Sifthenelse a s1 s2) (t1***t2)
+  | execinf_Sifthenelse_false: forall e m a s1 s2 t1 m1 v1 t2,
+      eval_expression e m a t1 m1 v1 ->
+      is_false v1 (typeof a) ->
+      execinf_stmt e m1 s2 t2 ->
+      execinf_stmt e m (Sifthenelse a s1 s2) (t1***t2)
+  | execinf_Sreturn_some: forall e m a t,
+      evalinf_expr e m RV a t ->
+      execinf_stmt e m (Sreturn (Some a)) t
+  | execinf_Swhile_test: forall e m a s t1,
+      evalinf_expr e m RV a t1 ->
+      execinf_stmt e m (Swhile a s) t1
+  | execinf_Swhile_body: forall e m a s t1 m1 v t2,
+      eval_expression e m a t1 m1 v ->
+      is_true v (typeof a) ->
+      execinf_stmt e m1 s t2 ->
+      execinf_stmt e m (Swhile a s) (t1***t2)
+  | execinf_Swhile_loop: forall e m a s t1 m1 v t2 m2 out1 t3,
+      eval_expression e m a t1 m1 v ->
+      is_true v (typeof a) ->
+      exec_stmt e m1 s t2 m2 out1 ->
+      out_normal_or_continue out1 ->
+      execinf_stmt e m2 (Swhile a s) t3 ->
+      execinf_stmt e m (Swhile a s) (t1***t2***t3)
+  | execinf_Sdowhile_body: forall e m s a t1,
+      execinf_stmt e m s t1 ->
+      execinf_stmt e m (Sdowhile a s) t1
+  | execinf_Sdowhile_test: forall e m s a t1 m1 out1 t2,
+      exec_stmt e m s t1 m1 out1 ->
+      out_normal_or_continue out1 ->
+      evalinf_expr e m1 RV a t2 ->
+      execinf_stmt e m (Sdowhile a s) (t1***t2)
+  | execinf_Sdowhile_loop: forall e m s a t1 m1 out1 t2 m2 v t3,
+      exec_stmt e m s t1 m1 out1 ->
+      out_normal_or_continue out1 ->
+      eval_expression e m1 a t2 m2 v ->
+      is_true v (typeof a) ->
+      execinf_stmt e m2 (Sdowhile a s) t3 ->
+      execinf_stmt e m (Sdowhile a s) (t1***t2***t3)
+  | execinf_Sfor_start_1: forall e m s a1 a2 a3 t1,
+      execinf_stmt e m a1 t1 ->
+      execinf_stmt e m (Sfor a1 a2 a3 s) t1
+  | execinf_Sfor_start_2: forall e m s a1 a2 a3 m1 t1 t2,
+      exec_stmt e m a1 t1 m1 Out_normal -> a1 <> Sskip ->
+      execinf_stmt e m1 (Sfor Sskip a2 a3 s) t2 ->
+      execinf_stmt e m (Sfor a1 a2 a3 s) (t1***t2)
+  | execinf_Sfor_test: forall e m s a2 a3 t,
+      evalinf_expr e m RV a2 t ->
+      execinf_stmt e m (Sfor Sskip a2 a3 s) t
+  | execinf_Sfor_body: forall e m s a2 a3 t1 m1 v t2,
+      eval_expression e m a2 t1 m1 v ->
+      is_true v (typeof a2) ->
+      execinf_stmt e m1 s t2 ->
+      execinf_stmt e m (Sfor Sskip a2 a3 s) (t1***t2)
+  | execinf_Sfor_next: forall e m s a2 a3 t1 m1 v t2 m2 out1 t3,
+      eval_expression e m a2 t1 m1 v ->
+      is_true v (typeof a2) ->
+      exec_stmt e m1 s t2 m2 out1 ->
+      out_normal_or_continue out1 ->
+      execinf_stmt e m2 a3 t3 ->
+      execinf_stmt e m (Sfor Sskip a2 a3 s) (t1***t2***t3)
+  | execinf_Sfor_loop: forall e m s a2 a3 t1 m1 v t2 m2 out1 t3 m3 t4,
+      eval_expression e m a2 t1 m1 v ->
+      is_true v (typeof a2) ->
+      exec_stmt e m1 s t2 m2 out1 ->
+      out_normal_or_continue out1 ->
+      exec_stmt e m2 a3 t3 m3 Out_normal ->
+      execinf_stmt e m3 (Sfor Sskip a2 a3 s) t4 ->
+      execinf_stmt e m (Sfor Sskip a2 a3 s) (t1***t2***t3***t4)
+  | execinf_Sswitch_expr:   forall e m a sl t1,
+      evalinf_expr e m RV a t1 ->
+      execinf_stmt e m (Sswitch a sl) t1
+  | execinf_Sswitch_body:   forall e m a sl t1 m1 n t2,
+      eval_expression e m a t1 m1 (Vint n) ->
+      execinf_stmt e m1 (seq_of_labeled_statement (select_switch n sl)) t2 ->
+      execinf_stmt e m (Sswitch a sl) (t1***t2)
+
+(** [evalinf_funcall m1 fd args t m2 res] describes a diverging
+  invocation of function [fd] with arguments [args].  *)
+
+with evalinf_funcall: mem -> fundef -> list val -> traceinf -> Prop :=
+  | evalinf_funcall_internal: forall m f vargs t e m1 m2,
+      list_norepet (var_names f.(fn_params) ++ var_names f.(fn_vars)) ->
+      alloc_variables empty_env m (f.(fn_params) ++ f.(fn_vars)) e m1 ->
+      bind_parameters e m1 f.(fn_params) vargs m2 ->
+      execinf_stmt e m2 f.(fn_body) t ->
+      evalinf_funcall m (Internal f) vargs t.
+
+(** ** Implication from big-step semantics to transition semantics *)
+
+Inductive outcome_state_match
+       (e: env) (m: mem) (f: function) (k: cont): outcome -> state -> Prop :=
+  | osm_normal:
+      outcome_state_match e m f k Out_normal (State f Sskip k e m)
+  | osm_break:
+      outcome_state_match e m f k Out_break (State f Sbreak k e m)
+  | osm_continue:
+      outcome_state_match e m f k Out_continue (State f Scontinue k e m)
+  | osm_return_none: forall k',
+      call_cont k' = call_cont k ->
+      outcome_state_match e m f k 
+        (Out_return None) (State f (Sreturn None) k' e m)
+  | osm_return_some: forall v ty k',
+      call_cont k' = call_cont k ->
+      outcome_state_match e m f k
+        (Out_return (Some (v, ty))) (ExprState f (Eval v ty) (Kreturn k') e m).
+
+Lemma is_call_cont_call_cont:
+  forall k, is_call_cont k -> call_cont k = k.
+Proof.
+  destruct k; simpl; intros; contradiction || auto.
+Qed.
+
+Lemma leftcontext_compose:
+  forall k2 k3 C2, leftcontext k2 k3 C2 ->
+  forall k1 C1, leftcontext k1 k2 C1 ->
+  leftcontext k1 k3 (fun x => C2(C1 x))
+with leftcontextlist_compose:
+  forall k2 C2, leftcontextlist k2 C2 ->
+  forall k1 C1, leftcontext k1 k2 C1 ->
+  leftcontextlist k1 (fun x => C2(C1 x)).
+Proof.
+  induction 1; intros; try (constructor; eauto).
+  replace (fun x => C1 x) with C1. auto. apply extensionality; auto.
+  induction 1; intros; constructor; eauto.
+Qed.
+
+Lemma exprlist_app_leftcontext:
+  forall rl1 rl2,
+  simplelist rl1 -> leftcontextlist RV (fun x => exprlist_app rl1 (Econs x rl2)).
+Proof.
+  induction rl1; simpl; intros. 
+  apply lctx_list_head. constructor.
+  destruct H. apply lctx_list_tail. auto. auto. 
+Qed.
+
+Lemma exprlist_app_simple:
+  forall rl1 rl2, simplelist rl1 -> simplelist rl2 -> simplelist (exprlist_app rl1 rl2).
+Proof.
+  induction rl1; simpl; intros. auto. destruct H; auto. 
+Qed.
+
+Lemma bigstep_to_steps:
+  (forall e m a t m' v,
+   eval_expression e m a t m' v ->
+   forall f k,
+   star step ge (ExprState f a k e m) t (ExprState f (Eval v (typeof a)) k e m'))
+/\(forall e m K a t m' a',
+   eval_expr e m K a t m' a' ->
+   forall C f k, leftcontext K RV C ->
+   simple a' /\ typeof a' = typeof a /\
+   star step ge (ExprState f (C a) k e m) t (ExprState f (C a') k e m'))
+/\(forall e m al t m' al',
+   eval_exprlist e m al t m' al' ->
+   forall a1 al2 ty C f k, leftcontext RV RV C -> simple a1 -> simplelist al2 ->
+   simplelist al' /\
+   star step ge (ExprState f (C (Ecall a1 (exprlist_app al2 al) ty)) k e m)
+              t (ExprState f (C (Ecall a1 (exprlist_app al2 al') ty)) k e m'))
+/\(forall e m s t m' out,
+   exec_stmt e m s t m' out ->
+   forall f k,
+   match out with
+   | Out_return None => fn_return f = Tvoid
+   | Out_return (Some(v, ty)) => fn_return f <> Tvoid
+   | _ => True
+   end ->
+   exists S,
+   star step ge (State f s k e m) t S /\ outcome_state_match e m' f k out S)
+/\(forall m fd args t m' res,
+   eval_funcall m fd args t m' res ->
+   forall k,
+   is_call_cont k ->
+   star step ge (Callstate fd args k m) t (Returnstate res k m')).
+Proof.
+  apply bigstep_induction; intros.
+(* expression, general *)
+  exploit (H0 (fun x => x) f k). constructor. intros [A [B C]].
+  assert (match a' with Eval _ _ => False | _ => True end ->
+          star step ge (ExprState f a k e m) t (ExprState f (Eval v (typeof a)) k e m')).
+   intro. eapply star_right. eauto. left. eapply step_expr; eauto. traceEq. 
+  destruct a'; auto.
+  simpl in B. rewrite B in C. inv H1. auto. 
+
+(* val *)
+  simpl; intuition. apply star_refl.
+(* var *)
+  simpl; intuition. apply star_refl.
+(* field *)
+  exploit (H0 (fun x => C(Efield x f ty))).
+    eapply leftcontext_compose; eauto. repeat constructor. intros [A [B D]].
+  simpl; intuition; eauto. 
+(* valof *)
+  exploit (H0 (fun x => C(Evalof x ty))).
+    eapply leftcontext_compose; eauto. repeat constructor. intros [A [B D]].
+  simpl; intuition; eauto. 
+(* deref *)
+  exploit (H0 (fun x => C(Ederef x ty))).
+    eapply leftcontext_compose; eauto. repeat constructor. intros [A [B D]].
+  simpl; intuition; eauto.
+(* addrof *)
+  exploit (H0 (fun x => C(Eaddrof x ty))).
+    eapply leftcontext_compose; eauto. repeat constructor. intros [A [B D]].
+  simpl; intuition; eauto.
+(* unop *)
+  exploit (H0 (fun x => C(Eunop op x ty))).
+    eapply leftcontext_compose; eauto. repeat constructor. intros [A [B D]].
+  simpl; intuition; eauto.
+(* binop *)
+  exploit (H0 (fun x => C(Ebinop op x a2 ty))).
+    eapply leftcontext_compose; eauto. repeat constructor. intros [A [B D]].
+  exploit (H2 (fun x => C(Ebinop op a1' x ty))).
+    eapply leftcontext_compose; eauto. repeat constructor. auto. intros [E [F G]].
+  simpl; intuition. eapply star_trans; eauto. 
+(* cast *)
+  exploit (H0 (fun x => C(Ecast x ty))).
+    eapply leftcontext_compose; eauto. repeat constructor. intros [A [B D]].
+  simpl; intuition; eauto.
+(* condition *)
+  exploit (H0 (fun x => C(Econdition x a2 a3 ty))).
+    eapply leftcontext_compose; eauto. repeat constructor. intros [A [B D]].
+  exploit (H4 (fun x => C(Eparen x ty))).
+    eapply leftcontext_compose; eauto. repeat constructor. intros [E [F G]].
+  simpl; intuition.
+  eapply star_trans. eexact D.
+  eapply star_left. left; eapply step_condition_true; eauto. congruence.
+  eapply star_right. eexact G. left; eapply step_paren; eauto.  congruence. 
+  reflexivity. reflexivity. traceEq.
+(* condition false *)
+  exploit (H0 (fun x => C(Econdition x a2 a3 ty))).
+    eapply leftcontext_compose; eauto. repeat constructor. intros [A [B D]].
+  exploit (H4 (fun x => C(Eparen x ty))).
+    eapply leftcontext_compose; eauto. repeat constructor. intros [E [F G]].
+  simpl; intuition.
+  eapply star_trans. eexact D.
+  eapply star_left. left; eapply step_condition_false; eauto. congruence.
+  eapply star_right. eexact G. left; eapply step_paren; eauto.  congruence. 
+  reflexivity. reflexivity. traceEq.
+(* sizeof *)
+  simpl; intuition. apply star_refl.
+(* assign *)
+  exploit (H0 (fun x => C(Eassign x r ty))).
+    eapply leftcontext_compose; eauto. repeat constructor. intros [A [B D]].
+  exploit (H2 (fun x => C(Eassign l' x ty))).
+    eapply leftcontext_compose; eauto. repeat constructor. auto. intros [E [F G]].
+  simpl; intuition.
+  eapply star_trans. eexact D. 
+  eapply star_right. eexact G.
+  left. eapply step_assign; eauto. congruence. congruence. congruence. 
+  reflexivity. traceEq.
+(* assignop *)
+  exploit (H0 (fun x => C(Eassignop op x r tyres ty))).
+    eapply leftcontext_compose; eauto. repeat constructor. intros [A [B D]].
+  exploit (H2 (fun x => C(Eassignop op l' x tyres ty))).
+    eapply leftcontext_compose; eauto. repeat constructor. auto. intros [E [F G]].
+  simpl; intuition.
+  eapply star_trans. eexact D. 
+  eapply star_right. eexact G.
+  left. eapply step_assignop; eauto.
+  rewrite B; eauto. rewrite B; rewrite F; eauto. congruence. congruence. congruence.
+  reflexivity. traceEq.
+(* postincr *)
+  exploit (H0 (fun x => C(Epostincr id x ty))).
+    eapply leftcontext_compose; eauto. repeat constructor. intros [A [B D]].
+  simpl; intuition.
+  eapply star_right. eexact D. 
+  left. eapply step_postincr; eauto. congruence. 
+  traceEq.
+(* comma *)
+  exploit (H0 (fun x => C(Ecomma x r2 ty))).
+    eapply leftcontext_compose; eauto. repeat constructor. intros [A [B D]].
+  exploit (H3 C). auto. intros [E [F G]].
+  simpl; intuition. congruence.
+  eapply star_trans. eexact D.
+  eapply star_left. left; eapply step_comma; eauto. 
+  eexact G.
+  reflexivity. traceEq.
+(* call *)
+  exploit (H0 (fun x => C(Ecall x rargs ty))).
+    eapply leftcontext_compose; eauto. repeat constructor. intros [A [B D]].
+  exploit (H2 rf' Enil ty C); eauto. red; auto. intros [E F].
+  simpl; intuition. 
+  eapply star_trans. eexact D.
+  eapply star_trans. eexact F. 
+  eapply star_left. left; eapply step_call; eauto. congruence. 
+  eapply star_right. eapply H9. red; auto. 
+  right; constructor. 
+  reflexivity. reflexivity. reflexivity. traceEq.
+(* nil *)
+  simpl; intuition. apply star_refl.
+(* cons *)
+  exploit (H0 (fun x => C(Ecall a0 (exprlist_app al2 (Econs x al)) ty))).
+    eapply leftcontext_compose; eauto. repeat constructor. auto.
+    apply exprlist_app_leftcontext; auto. intros [A [B D]].
+  exploit (H2 a0 (exprlist_app al2 (Econs a1' Enil))); eauto.
+  apply exprlist_app_simple; auto. simpl. auto. 
+  repeat rewrite exprlist_app_assoc. simpl.  
+  intros [E F].
+
+  simpl; intuition. 
+  eapply star_trans; eauto.
+
+(* skip *)
+  econstructor; split. apply star_refl. constructor.
+
+(* do *)
+  econstructor; split. 
+  eapply star_left. right; constructor. 
+  eapply star_right. apply H0. right; constructor.
+  reflexivity. traceEq.
+  constructor.
+
+(* sequence 2 *)
+  destruct (H0 f (Kseq s2 k)) as [S1 [A1 B1]]; auto. inv B1.
+  destruct (H2 f k) as [S2 [A2 B2]]; auto.
+  econstructor; split.
+  eapply star_left. right; econstructor.
+  eapply star_trans. eexact A1. 
+  eapply star_left. right; constructor. eexact A2.
+  reflexivity. reflexivity. traceEq.
+  auto.
+
+(* sequence 1 *)
+  destruct (H0 f (Kseq s2 k)) as [S1 [A1 B1]]; auto.
+  set (S2 :=
+    match out with
+    | Out_break => State f Sbreak k e m1
+    | Out_continue => State f Scontinue k e m1
+    | _ => S1
+    end).
+  exists S2; split.
+  eapply star_left. right; econstructor.
+  eapply star_trans. eexact A1.
+  unfold S2; inv B1.
+    congruence.
+    apply star_one. right; apply step_break_seq.
+    apply star_one. right; apply step_continue_seq.
+    apply star_refl.
+    apply star_refl.
+  reflexivity. traceEq.
+  unfold S2; inv B1; congruence || econstructor; eauto.
+
+(* ifthenelse true *)
+  destruct (H3 f k) as [S1 [A1 B1]]; auto.
+  exists S1; split.
+  eapply star_left. right; apply step_ifthenelse.
+  eapply star_trans. eapply H0.
+  eapply star_left. right; eapply step_ifthenelse_true; eauto.
+  eexact A1. 
+  reflexivity. reflexivity. traceEq.
+  auto.
+
+(* ifthenelse false *)
+  destruct (H3 f k) as [S1 [A1 B1]]; auto.
+  exists S1; split.
+  eapply star_left. right; apply step_ifthenelse.
+  eapply star_trans. eapply H0.
+  eapply star_left. right; eapply step_ifthenelse_false; eauto.
+  eexact A1. 
+  reflexivity. reflexivity. traceEq.
+  auto.
+
+(* return none *)
+  econstructor; split. apply star_refl. constructor. auto.
+
+(* return some *)
+  econstructor; split.
+  eapply star_left. right; apply step_return_1. auto.
+  eapply H0. traceEq.
+  econstructor; eauto. 
+
+(* break *)
+  econstructor; split. apply star_refl. constructor.
+
+(* continue *)
+  econstructor; split. apply star_refl. constructor.
+
+(* while false *)
+  econstructor; split.
+  eapply star_left. right; apply step_while.
+  eapply star_right. apply H0. right; eapply step_while_false; eauto. 
+  reflexivity. traceEq.
+  constructor.
+
+(* while stop *)
+  destruct (H3 f (Kwhile2 a s k)) as [S1 [A1 B1]]. inv H4; auto. 
+  set (S2 :=
+    match out' with
+    | Out_break => State f Sskip k e m2
+    | _ => S1
+    end).
+  exists S2; split.
+  eapply star_left. right; apply step_while.
+  eapply star_trans. apply H0.
+  eapply star_left. right; eapply step_while_true; eauto.
+  eapply star_trans. eexact A1.
+  unfold S2. inversion H4; subst.
+  inv B1. apply star_one. right; constructor.    
+  apply star_refl.
+  reflexivity. reflexivity. reflexivity. traceEq.
+  unfold S2. inversion H4; subst. constructor. inv B1; econstructor; eauto.
+
+(* while loop *)
+  destruct (H3 f (Kwhile2 a s k)) as [S1 [A1 B1]]. inv H4; auto. 
+  destruct (H6 f k) as [S2 [A2 B2]]; auto.
+  exists S2; split.
+  eapply star_left. right; apply step_while.
+  eapply star_trans. apply H0.
+  eapply star_left. right; eapply step_while_true; eauto.
+  eapply star_trans. eexact A1.
+  eapply star_left.
+  inv H4; inv B1; right; apply step_skip_or_continue_while; auto.
+  eexact A2.
+  reflexivity. reflexivity. reflexivity. reflexivity. traceEq.
+  auto.
+
+(* dowhile false *)
+  destruct (H0 f (Kdowhile1 a s k)) as [S1 [A1 B1]]. inv H1; auto.
+  exists (State f Sskip k e m2); split.
+  eapply star_left. right; constructor.
+  eapply star_trans. eexact A1.
+  eapply star_left.
+  inv H1; inv B1; right; eapply step_skip_or_continue_dowhile; eauto.
+  eapply star_right. apply H3. 
+  right; eapply step_dowhile_false; eauto. 
+  reflexivity. reflexivity. reflexivity. traceEq. 
+  constructor.
+
+(* dowhile stop *)
+  destruct (H0 f (Kdowhile1 a s k)) as [S1 [A1 B1]]. inv H1; auto.
+  set (S2 :=
+    match out1 with
+    | Out_break => State f Sskip k e m1
+    | _ => S1
+    end).
+  exists S2; split.
+  eapply star_left. right; apply step_dowhile. 
+  eapply star_trans. eexact A1.
+  unfold S2. inversion H1; subst.
+  inv B1. apply star_one. right; constructor.
+  apply star_refl.
+  reflexivity. traceEq.
+  unfold S2. inversion H1; subst. constructor. inv B1; econstructor; eauto.
+
+(* dowhile loop *)
+  destruct (H0 f (Kdowhile1 a s k)) as [S1 [A1 B1]]. inv H1; auto.
+  destruct (H6 f k) as [S2 [A2 B2]]; auto.
+  exists S2; split.
+  eapply star_left. right; constructor.
+  eapply star_trans. eexact A1.
+  eapply star_left.
+  inv H1; inv B1; right; eapply step_skip_or_continue_dowhile; eauto.
+  eapply star_trans. apply H3.
+  eapply star_left. right; eapply step_dowhile_true; eauto.
+  eexact A2.
+  reflexivity. reflexivity. reflexivity. reflexivity. traceEq.
+  auto.
+
+(* for start *)
+  assert (a1 = Sskip \/ a1 <> Sskip). destruct a1; auto; right; congruence. 
+  destruct H4.
+  subst a1. inv H. apply H2; auto.
+  destruct (H0 f (Kseq (Sfor Sskip a2 a3 s) k)) as [S1 [A1 B1]]; auto. inv B1.
+  destruct (H2 f k) as [S2 [A2 B2]]; auto.
+  exists S2; split.
+  eapply star_left. right; apply step_for_start; auto.   
+  eapply star_trans. eexact A1.
+  eapply star_left. right; constructor. eexact A2.
+  reflexivity. reflexivity. traceEq.
+  auto.
+
+(* for false *)
+  econstructor; split.
+  eapply star_left. right; apply step_for. 
+  eapply star_right. apply H0. right; eapply step_for_false; eauto. 
+  reflexivity. traceEq.
+  constructor.
+
+(* for stop *)
+  destruct (H3 f (Kfor3 a2 a3 s k)) as [S1 [A1 B1]]. inv H4; auto. 
+  set (S2 :=
+    match out1 with
+    | Out_break => State f Sskip k e m2
+    | _ => S1
+    end).
+  exists S2; split.
+  eapply star_left. right; apply step_for. 
+  eapply star_trans. apply H0. 
+  eapply star_left. right; eapply step_for_true; eauto.
+  eapply star_trans. eexact A1. 
+  unfold S2. inversion H4; subst.
+  inv B1. apply star_one. right; constructor. 
+  apply star_refl.
+  reflexivity. reflexivity. reflexivity. traceEq.
+  unfold S2. inversion H4; subst. constructor. inv B1; econstructor; eauto.
+
+(* for loop *)
+  destruct (H3 f (Kfor3 a2 a3 s k)) as [S1 [A1 B1]]. inv H4; auto.
+  destruct (H6 f (Kfor4 a2 a3 s k)) as [S2 [A2 B2]]; auto. inv B2.
+  destruct (H8 f k) as [S3 [A3 B3]]; auto.
+  exists S3; split.
+  eapply star_left. right; apply step_for. 
+  eapply star_trans. apply H0. 
+  eapply star_left. right; eapply step_for_true; eauto.
+  eapply star_trans. eexact A1.
+  eapply star_trans with (s2 := State f a3 (Kfor4 a2 a3 s k) e m2).
+  inv H4; inv B1.
+  apply star_one. right; constructor; auto. 
+  apply star_one. right; constructor; auto. 
+  eapply star_trans. eexact A2. 
+  eapply star_left. right; constructor.
+  eexact A3.
+  reflexivity. reflexivity. reflexivity. reflexivity.
+  reflexivity. reflexivity. traceEq.
+  auto.
+
+(* switch *)
+  destruct (H2 f (Kswitch2 k)) as [S1 [A1 B1]]. destruct out; auto. 
+  set (S2 :=
+    match out with
+    | Out_normal => State f Sskip k e m2
+    | Out_break => State f Sskip k e m2
+    | Out_continue => State f Scontinue k e m2
+    | _ => S1
+    end).
+  exists S2; split.
+  eapply star_left. right; eapply step_switch.
+  eapply star_trans. apply H0. 
+  eapply star_left. right; eapply step_expr_switch.
+  eapply star_trans. eexact A1. 
+  unfold S2; inv B1.
+    apply star_one. right; constructor. auto. 
+    apply star_one. right; constructor. auto. 
+    apply star_one. right; constructor. 
+    apply star_refl.
+    apply star_refl.
+  reflexivity. reflexivity. reflexivity. traceEq.
+  unfold S2. inv B1; simpl; econstructor; eauto.
+
+(* call internal *)
+  destruct (H3 f k) as [S1 [A1 B1]].
+    red in H4. destruct out; auto. destruct o as [[v' ty'] | ].
+    tauto. destruct (fn_return f); tauto.
+  eapply star_left. right; eapply step_internal_function; eauto.
+  eapply star_right. eexact A1. 
+  inv B1; simpl in H4; try contradiction.
+  (* Out_normal *)
+  assert (fn_return f = Tvoid /\ vres = Vundef).
+    destruct (fn_return f); auto || contradiction.
+  destruct H7. subst vres. right; apply step_skip_call; auto.
+  (* Out_return None *)
+  assert (fn_return f = Tvoid /\ vres = Vundef).
+    destruct (fn_return f); auto || contradiction.
+  destruct H8. subst vres.
+  rewrite <- (is_call_cont_call_cont k H6). rewrite <- H7.
+  right; apply step_return_0; auto.
+  (* Out_return Some *)
+  destruct H4.
+  rewrite <- (is_call_cont_call_cont k H6). rewrite <- H7.
+  right; eapply step_return_2; eauto.
+  reflexivity. traceEq.
+
+(* call external *)
+  apply star_one. right; apply step_external_function; auto. 
+Qed.
+
+Lemma eval_expression_to_steps:
+   forall e m a t m' v,
+   eval_expression e m a t m' v ->
+   forall f k,
+   star step ge (ExprState f a k e m) t (ExprState f (Eval v (typeof a)) k e m').
+Proof (proj1 bigstep_to_steps).
+
+Lemma eval_expr_to_steps:
+   forall e m K a t m' a',
+   eval_expr e m K a t m' a' ->
+   forall C f k, leftcontext K RV C ->
+   simple a' /\ typeof a' = typeof a /\
+   star step ge (ExprState f (C a) k e m) t (ExprState f (C a') k e m').
+Proof (proj1 (proj2 bigstep_to_steps)).
+
+Lemma eval_exprlist_to_steps:
+   forall e m al t m' al',
+   eval_exprlist e m al t m' al' ->
+   forall a1 al2 ty C f k, leftcontext RV RV C -> simple a1 -> simplelist al2 ->
+   simplelist al' /\
+   star step ge (ExprState f (C (Ecall a1 (exprlist_app al2 al) ty)) k e m)
+              t (ExprState f (C (Ecall a1 (exprlist_app al2 al') ty)) k e m').
+Proof (proj1 (proj2 (proj2 bigstep_to_steps))).
+
+Lemma exec_stmt_to_steps:
+   forall e m s t m' out,
+   exec_stmt e m s t m' out ->
+   forall f k,
+   match out with
+   | Out_return None => fn_return f = Tvoid
+   | Out_return (Some(v, ty)) => fn_return f <> Tvoid
+   | _ => True
+   end ->
+   exists S,
+   star step ge (State f s k e m) t S /\ outcome_state_match e m' f k out S.
+Proof (proj1 (proj2 (proj2 (proj2 bigstep_to_steps)))).
+
+Lemma eval_funcall_to_steps:
+  forall m fd args t m' res,
+  eval_funcall m fd args t m' res ->
+  forall k,
+  is_call_cont k ->
+  star step ge (Callstate fd args k m) t (Returnstate res k m').
+Proof (proj2 (proj2 (proj2 (proj2 bigstep_to_steps)))).
+
+Fixpoint esize (a: expr) : nat :=
+  match a with
+  | Eloc _ _ _ => 1%nat
+  | Evar _ _ => 1%nat
+  | Ederef r1 _ => S(esize r1)
+  | Efield l1 _ _ => S(esize l1)
+  | Eval _ _ => O
+  | Evalof l1 _ => S(esize l1)
+  | Eaddrof l1 _ => S(esize l1)
+  | Eunop _ r1 _ => S(esize r1)
+  | Ebinop _ r1 r2 _ => S(esize r1 + esize r2)%nat
+  | Ecast r1 _ => S(esize r1)
+  | Econdition r1 _ _ _ => S(esize r1)
+  | Esizeof _ _ => 1%nat
+  | Eassign l1 r2 _ => S(esize l1 + esize r2)%nat
+  | Eassignop _ l1 r2 _ _ => S(esize l1 + esize r2)%nat
+  | Epostincr _ l1 _ => S(esize l1)
+  | Ecomma r1 r2 _ => S(esize r1 + esize r2)%nat
+  | Ecall r1 rl2 _ => S(esize r1 + esizelist rl2)%nat
+  | Eparen r1 _ => S(esize r1)
+  end
+
+with esizelist (el: exprlist) : nat :=
+  match el with
+  | Enil => O
+  | Econs r1 rl2 => S(esize r1 + esizelist rl2)%nat
+  end.
+
+Lemma leftcontext_size:
+  forall from to C,
+  leftcontext from to C ->
+  forall e1 e2,
+  (esize e1 < esize e2)%nat ->
+  (esize (C e1) < esize (C e2))%nat
+with leftcontextlist_size:
+  forall from C,
+  leftcontextlist from C ->
+  forall e1 e2,
+  (esize e1 < esize e2)%nat ->
+  (esizelist (C e1) < esizelist (C e2))%nat.
+Proof.
+  induction 1; intros; simpl; auto with arith. exploit leftcontextlist_size; eauto. auto with arith.
+  induction 1; intros; simpl; auto with arith. exploit leftcontext_size; eauto. auto with arith.
+Qed.
+
+Axiom ADMITTED: forall (P: Prop), P.
+
+Lemma evalinf_funcall_steps:
+  forall m fd args t k,
+  evalinf_funcall m fd args t ->
+  forever_N step lt ge O (Callstate fd args k m) t.
+Proof.
+  cofix COF.
+
+  assert (COS: 
+    forall e m s t f k,
+    execinf_stmt e m s t ->
+    forever_N step lt ge O (State f s k e m) t).
+  cofix COS.
+
+  assert (COE:
+    forall e m K a t C f k,
+    evalinf_expr e m K a t ->
+    leftcontext K RV C ->
+    forever_N step lt ge (esize a) (ExprState f (C a) k e m) t).
+  cofix COE.
+
+  assert (COEL:
+    forall e m a t C f k a1 al ty,
+    evalinf_exprlist e m a t ->
+    leftcontext RV RV C -> simple a1 -> simplelist al ->
+    forever_N step lt ge (esizelist a)
+                   (ExprState f (C (Ecall a1 (exprlist_app al a) ty)) k e m) t).
+  cofix COEL.
+  intros. inv H.
+(* cons left *)
+  eapply forever_N_star with (a2 := (esize a0)). apply star_refl. simpl; omega. 
+  eapply COE with (C := fun x => C(Ecall a1 (exprlist_app al (Econs x al0)) ty)).
+  eauto. eapply leftcontext_compose; eauto. constructor. auto. 
+  apply exprlist_app_leftcontext; auto. traceEq.
+(* cons right *) 
+  destruct (eval_expr_to_steps _ _ _ _ _ _ _ H3 
+             (fun x => C(Ecall a1 (exprlist_app al (Econs x al0)) ty)) f k)
+  as [P [Q R]]. 
+  eapply leftcontext_compose; eauto. repeat constructor. auto. 
+  apply exprlist_app_leftcontext; auto. 
+  eapply forever_N_star with (a2 := (esizelist al0)).
+  eexact R. simpl; omega.
+  change (Econs a1' al0) with (exprlist_app (Econs a1' Enil) al0).
+  rewrite <- exprlist_app_assoc.  
+  eapply COEL. eauto. auto. auto. 
+  apply exprlist_app_simple. auto. simpl; auto. traceEq.
+
+  intros. inv H.
+(* field *)
+  eapply forever_N_star with (a2 := (esize a0)). apply star_refl. simpl; omega.
+  eapply COE with (C := fun x => C(Efield x f0 ty)). eauto. 
+  eapply leftcontext_compose; eauto. repeat constructor. traceEq.
+(* valof *)
+  eapply forever_N_star with (a2 := (esize a0)). apply star_refl. simpl; omega.
+  eapply COE with (C := fun x => C(Evalof x ty)). eauto. 
+  eapply leftcontext_compose; eauto. repeat constructor. traceEq.
+(* deref *)
+  eapply forever_N_star with (a2 := (esize a0)). apply star_refl. simpl; omega.
+  eapply COE with (C := fun x => C(Ederef x ty)). eauto. 
+  eapply leftcontext_compose; eauto. repeat constructor. traceEq.
+(* addrof *)
+  eapply forever_N_star with (a2 := (esize a0)). apply star_refl. simpl; omega.
+  eapply COE with (C := fun x => C(Eaddrof x ty)). eauto. 
+  eapply leftcontext_compose; eauto. repeat constructor. traceEq.
+(* unop *)
+  eapply forever_N_star with (a2 := (esize a0)). apply star_refl. simpl; omega.
+  eapply COE with (C := fun x => C(Eunop op x ty)). eauto. 
+  eapply leftcontext_compose; eauto. repeat constructor. traceEq.
+(* binop left *)
+  eapply forever_N_star with (a2 := (esize a1)). apply star_refl. simpl; omega.
+  eapply COE with (C := fun x => C(Ebinop op x a2 ty)). eauto. 
+  eapply leftcontext_compose; eauto. repeat constructor. traceEq.
+(* binop right *)
+  destruct (eval_expr_to_steps _ _ _ _ _ _ _ H1 (fun x => C(Ebinop op x a2 ty)) f k)
+  as [P [Q R]]. 
+  eapply leftcontext_compose; eauto. repeat constructor.
+  eapply forever_N_star with (a2 := (esize a2)). eexact R. simpl; omega.
+  eapply COE with (C := fun x => C(Ebinop op a1' x ty)). eauto. 
+  eapply leftcontext_compose; eauto. repeat constructor. auto. traceEq.
+(* cast *)
+  eapply forever_N_star with (a2 := (esize a0)). apply star_refl. simpl; omega.
+  eapply COE with (C := fun x => C(Ecast x ty)). eauto. 
+  eapply leftcontext_compose; eauto. repeat constructor. traceEq.
+(* condition top *)
+  eapply forever_N_star with (a2 := (esize a1)). apply star_refl. simpl; omega.
+  eapply COE with (C := fun x => C(Econdition x a2 a3 ty)). eauto. 
+  eapply leftcontext_compose; eauto. repeat constructor. traceEq.
+(* condition true *)
+  destruct (eval_expr_to_steps _ _ _ _ _ _ _ H1 (fun x => C(Econdition x a2 a3 (typeof a2))) f k)
+  as [P [Q R]]. 
+  eapply leftcontext_compose; eauto. repeat constructor.
+  eapply forever_N_plus. eapply plus_right. eexact R. 
+  left; eapply step_condition_true; eauto. congruence. 
+  reflexivity. 
+  eapply COE with (C := fun x => (C (Eparen x (typeof a2)))). eauto.
+  eapply leftcontext_compose; eauto. repeat constructor. traceEq.
+(* condition false *)
+  destruct (eval_expr_to_steps _ _ _ _ _ _ _ H1 (fun x => C(Econdition x a2 a3 (typeof a3))) f k)
+  as [P [Q R]]. 
+  eapply leftcontext_compose; eauto. repeat constructor.
+  eapply forever_N_plus. eapply plus_right. eexact R. 
+  left; eapply step_condition_false; eauto. congruence. 
+  reflexivity. 
+  eapply COE with (C := fun x => (C (Eparen x (typeof a3)))). eauto.
+  eapply leftcontext_compose; eauto. repeat constructor. traceEq.
+(* assign left *)
+  eapply forever_N_star with (a2 := (esize a1)). apply star_refl. simpl; omega.
+  eapply COE with (C := fun x => C(Eassign x a2 ty)). eauto. 
+  eapply leftcontext_compose; eauto. repeat constructor. traceEq.
+(* assign right *)
+  destruct (eval_expr_to_steps _ _ _ _ _ _ _ H1 (fun x => C(Eassign x a2 ty)) f k)
+  as [P [Q R]]. 
+  eapply leftcontext_compose; eauto. repeat constructor.
+  eapply forever_N_star with (a2 := (esize a2)). eexact R. simpl; omega.
+  eapply COE with (C := fun x => C(Eassign a1' x ty)). eauto. 
+  eapply leftcontext_compose; eauto. repeat constructor. auto. traceEq.
+(* assignop left *)
+  eapply forever_N_star with (a2 := (esize a1)). apply star_refl. simpl; omega.
+  eapply COE with (C := fun x => C(Eassignop op x a2 tyres ty)). eauto. 
+  eapply leftcontext_compose; eauto. repeat constructor. traceEq.
+(* assignop right *)
+  destruct (eval_expr_to_steps _ _ _ _ _ _ _ H1 (fun x => C(Eassignop op x a2 tyres ty)) f k)
+  as [P [Q R]]. 
+  eapply leftcontext_compose; eauto. repeat constructor.
+  eapply forever_N_star with (a2 := (esize a2)). eexact R. simpl; omega.
+  eapply COE with (C := fun x => C(Eassignop op a1' x tyres ty)). eauto. 
+  eapply leftcontext_compose; eauto. repeat constructor. auto. traceEq.
+(* postincr *)
+  eapply forever_N_star with (a2 := (esize a0)). apply star_refl. simpl; omega.
+  eapply COE with (C := fun x => C(Epostincr id x ty)). eauto. 
+  eapply leftcontext_compose; eauto. repeat constructor. traceEq.
+(* comma left *)
+  eapply forever_N_star with (a2 := (esize a1)). apply star_refl. simpl; omega.
+  eapply COE with (C := fun x => C(Ecomma x a2 ty)). eauto. 
+  eapply leftcontext_compose; eauto. repeat constructor. traceEq.
+(* comma right *)
+  destruct (eval_expr_to_steps _ _ _ _ _ _ _ H1 (fun x => C(Ecomma x a2 (typeof a2))) f k)
+  as [P [Q R]]. 
+  eapply leftcontext_compose; eauto. repeat constructor.
+  eapply forever_N_plus. eapply plus_right. eexact R. 
+  left; eapply step_comma; eauto. reflexivity.  
+  eapply COE with (C := C); eauto. traceEq.
+(* call left *)
+  eapply forever_N_star with (a2 := (esize a1)). apply star_refl. simpl; omega.
+  eapply COE with (C := fun x => C(Ecall x a2 ty)). eauto. 
+  eapply leftcontext_compose; eauto. repeat constructor. traceEq.
+(* call right *)
+  destruct (eval_expr_to_steps _ _ _ _ _ _ _ H1 (fun x => C(Ecall x a2 ty)) f k)
+  as [P [Q R]]. 
+  eapply leftcontext_compose; eauto. repeat constructor.
+  eapply forever_N_star with (a2 := (esizelist a2)). eexact R. simpl; omega.
+  eapply COEL with (al := Enil). eauto. auto. auto. red; auto. traceEq.
+(* call *)
+  destruct (eval_expr_to_steps _ _ _ _ _ _ _ H1 (fun x => C(Ecall x rargs ty)) f k)
+  as [P [Q R]]. 
+  eapply leftcontext_compose; eauto. repeat constructor.
+  destruct (eval_exprlist_to_steps _ _ _ _ _ _ H2 rf' Enil ty C f k)
+  as [S T]. auto. auto. simpl; auto.
+  eapply forever_N_plus. eapply plus_right.
+  eapply star_trans. eexact R. eexact T. reflexivity.
+  simpl. left; eapply step_call; eauto. congruence. reflexivity. 
+  apply COF. eauto. traceEq. 
+
+(* statements *)
+  intros. inv H.
+(* do *)
+  eapply forever_N_plus. apply plus_one; right; constructor. 
+  eapply COE with (C := fun x => x); eauto. constructor. traceEq.
+(* seq 1 *)
+  eapply forever_N_plus. apply plus_one; right; constructor. 
+  eapply COS; eauto. traceEq.
+(* seq 2 *)
+  destruct (exec_stmt_to_steps _ _ _ _ _ _ H0 f (Kseq s2 k)) as [S1 [A1 B1]]; auto. inv B1.
+  eapply forever_N_plus. 
+  eapply plus_left. right; constructor. 
+  eapply star_right. eauto. right; constructor.
+  reflexivity. reflexivity. 
+  eapply COS; eauto. traceEq.
+(* if test *)
+  eapply forever_N_plus. apply plus_one; right; constructor. 
+  eapply COE with (C := fun x => x); eauto. constructor. traceEq.
+(* if true *)
+  eapply forever_N_plus.
+  eapply plus_left. right; constructor.
+  eapply star_right. eapply eval_expression_to_steps; eauto.
+  right. apply step_ifthenelse_true. auto. 
+  reflexivity. reflexivity.
+  eapply COS; eauto. traceEq.
+(* if false *)
+  eapply forever_N_plus.
+  eapply plus_left. right; constructor.
+  eapply star_right. eapply eval_expression_to_steps; eauto.
+  right. apply step_ifthenelse_false. auto. 
+  reflexivity. reflexivity.
+  eapply COS; eauto. traceEq.
+(* return some *)
+  eapply forever_N_plus. apply plus_one; right; constructor. apply ADMITTED.
+  eapply COE with (C := fun x => x); eauto. constructor. traceEq.
+(* while test *)
+  eapply forever_N_plus. apply plus_one; right; constructor.
+  eapply COE with (C := fun x => x); eauto. constructor. traceEq.
+(* while body *)
+  eapply forever_N_plus.
+  eapply plus_left. right; constructor. 
+  eapply star_right. eapply eval_expression_to_steps; eauto.
+  right; apply step_while_true; auto.
+  reflexivity. reflexivity.
+  eapply COS; eauto. traceEq.
+(* while loop *)
+  destruct (exec_stmt_to_steps _ _ _ _ _ _ H2 f (Kwhile2 a s0 k)) as [S1 [A1 B1]]; auto. inv H3; auto. 
+  eapply forever_N_plus.
+  eapply plus_left. right; constructor. 
+  eapply star_trans. eapply eval_expression_to_steps; eauto.
+  eapply star_left. right; apply step_while_true; auto.
+  eapply star_trans. eexact A1. 
+  inv H3; inv B1; apply star_one; right; apply step_skip_or_continue_while; auto.
+  reflexivity. reflexivity. reflexivity. reflexivity.
+  eapply COS; eauto. traceEq.
+(* dowhile body *)
+  eapply forever_N_plus. apply plus_one; right; constructor.
+  eapply COS; eauto. traceEq.
+(* dowhile test *)
+  destruct (exec_stmt_to_steps _ _ _ _ _ _ H0 f (Kdowhile1 a s0 k)) as [S1 [A1 B1]]; auto. inv H1; auto. 
+  eapply forever_N_plus.
+  eapply plus_left. right; constructor. 
+  eapply star_trans. eexact A1.
+  eapply star_one. right. inv H1; inv B1; apply step_skip_or_continue_dowhile; auto.
+  reflexivity. reflexivity.
+  eapply COE with (C := fun x => x); eauto. constructor. traceEq.
+(* dowhile loop *)
+  destruct (exec_stmt_to_steps _ _ _ _ _ _ H0 f (Kdowhile1 a s0 k)) as [S1 [A1 B1]]; auto. inv H1; auto. 
+  eapply forever_N_plus.
+  eapply plus_left. right; constructor. 
+  eapply star_trans. eexact A1.
+  eapply star_left. right. inv H1; inv B1; apply step_skip_or_continue_dowhile; auto.
+  eapply star_right. eapply eval_expression_to_steps; eauto.
+  right; apply step_dowhile_true; auto.
+  reflexivity. reflexivity. reflexivity. reflexivity.
+  eapply COS; eauto. traceEq.
+(* for start 1 *)
+  assert (a1 <> Sskip). red; intros; subst a1; inv H0.
+  eapply forever_N_plus. apply plus_one. right. constructor. auto.
+  eapply COS; eauto. traceEq.
+(* for start 2 *)
+  destruct (exec_stmt_to_steps _ _ _ _ _ _ H0 f (Kseq (Sfor Sskip a2 a3 s0) k)) as [S1 [A1 B1]]; auto. inv B1.
+  eapply forever_N_plus.
+  eapply plus_left. right; constructor. auto. 
+  eapply star_trans. eexact A1.
+  apply star_one. right; constructor. 
+  reflexivity. reflexivity.
+  eapply COS; eauto. traceEq.
+(* for test *)
+  eapply forever_N_plus. apply plus_one; right; apply step_for.
+  eapply COE with (C := fun x => x); eauto. constructor. traceEq.
+(* for body *)
+  eapply forever_N_plus.
+  eapply plus_left. right; apply step_for.
+  eapply star_right. eapply eval_expression_to_steps; eauto.
+  right; apply step_for_true; auto.
+  reflexivity. reflexivity.
+  eapply COS; eauto. traceEq.
+(* for next *)
+  destruct (exec_stmt_to_steps _ _ _ _ _ _ H2 f (Kfor3 a2 a3 s0 k)) as [S1 [A1 B1]]; auto. inv H3; auto. 
+  eapply forever_N_plus.
+  eapply plus_left. right; apply step_for.
+  eapply star_trans. eapply eval_expression_to_steps; eauto.
+  eapply star_left. right; apply step_for_true; auto.
+  eapply star_trans. eexact A1. 
+  inv H3; inv B1; apply star_one; right; apply step_skip_or_continue_for3; auto.
+  reflexivity. reflexivity. reflexivity. reflexivity.
+  eapply COS; eauto. traceEq.
+(* for loop *)
+  destruct (exec_stmt_to_steps _ _ _ _ _ _ H2 f (Kfor3 a2 a3 s0 k)) as [S1 [A1 B1]]; auto. inv H3; auto. 
+  destruct (exec_stmt_to_steps _ _ _ _ _ _ H4 f (Kfor4 a2 a3 s0 k)) as [S2 [A2 B2]]; auto. inv B2.
+  eapply forever_N_plus.
+  eapply plus_left. right; apply step_for.
+  eapply star_trans. eapply eval_expression_to_steps; eauto.
+  eapply star_left. right; apply step_for_true; auto.
+  eapply star_trans. eexact A1.
+  eapply star_left.
+  inv H3; inv B1; right; apply step_skip_or_continue_for3; auto.
+  eapply star_right. eexact A2. 
+  right; constructor.
+  reflexivity. reflexivity. reflexivity. reflexivity. reflexivity. reflexivity.
+  eapply COS; eauto. traceEq.
+(* switch expr *)
+  eapply forever_N_plus. apply plus_one; right; constructor.
+  eapply COE with (C := fun x => x); eauto. constructor. traceEq.
+(* switch body *)
+  eapply forever_N_plus.
+  eapply plus_left. right; constructor. 
+  eapply star_right. eapply eval_expression_to_steps; eauto. 
+  right; constructor. 
+  reflexivity. reflexivity. 
+  eapply COS; eauto. traceEq. 
+
+(* funcalls *)
+  intros. inv H.
+  eapply forever_N_plus. apply plus_one. right; econstructor; eauto. 
+  eapply COS; eauto. traceEq.
+Qed.
+
+End BIGSTEP.
+
+(** ** Whole-program behaviors, big-step style. *)
+
+Inductive bigstep_program_terminates (p: program): trace -> int -> Prop :=
+  | bigstep_program_terminates_intro: forall b f m0 m1 t r,
+      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 ->
+      type_of_fundef f = Tfunction Tnil (Tint I32 Signed) ->
+      eval_funcall ge m0 f nil t m1 (Vint r) ->
+      bigstep_program_terminates p t r.
+
+Inductive bigstep_program_diverges (p: program): traceinf -> Prop :=
+  | bigstep_program_diverges_intro: forall b f m0 t,
+      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 ->
+      type_of_fundef f = Tfunction Tnil (Tint I32 Signed) ->
+      evalinf_funcall ge m0 f nil t ->
+      bigstep_program_diverges p t.
+
+Theorem bigstep_program_terminates_exec:
+  forall prog t r,
+  bigstep_program_terminates prog t r -> exec_program prog (Terminates t r).
+Proof.
+  intros. inv H. 
+  econstructor.
+  econstructor; eauto.
+  apply eval_funcall_to_steps. eauto. red; auto. 
+  econstructor.
+Qed.
+
+Theorem bigstep_program_diverges_exec:
+  forall prog T,
+  bigstep_program_diverges prog T ->
+  exec_program prog (Reacts T) \/
+  exists t, exec_program prog (Diverges t) /\ traceinf_prefix t T.
+Proof.
+  intros. inv H.
+  set (st := Callstate f nil Kstop m0).
+  assert (forever step ge st T). 
+    eapply forever_N_forever with (order := lt).
+    apply lt_wf. 
+    eapply evalinf_funcall_steps; eauto. 
+  destruct (forever_silent_or_reactive _ _ _ _ _ _ H)
+  as [A | [t [s' [T' [B [C D]]]]]]. 
+  left. econstructor. econstructor; eauto. eauto.
+  right. exists t. split.
+  econstructor. econstructor; eauto. eauto. auto. 
+  subst T. rewrite <- (E0_right t) at 1. apply traceinf_prefix_app. constructor.
+Qed.
+
diff --git a/cfrontend/Csyntax.v b/cfrontend/Csyntax.v
index 9d0791e..6e9a860 100644
--- a/cfrontend/Csyntax.v
+++ b/cfrontend/Csyntax.v
@@ -13,19 +13,20 @@
 (*                                                                     *)
 (* *********************************************************************)
 
-(** Abstract syntax for the Clight language *)
+(** Abstract syntax for the Compcert C language *)
 
 Require Import Coqlib.
 Require Import Errors.
 Require Import Integers.
 Require Import Floats.
+Require Import Values.
 Require Import AST.
 
 (** * Abstract syntax *)
 
 (** ** Types *)
 
-(** Clight types are similar to those of C.  They include numeric types,
+(** Compcert C types are similar to those of C.  They include numeric types,
   pointers, arrays, function types, and composite types (struct and 
   union).  Numeric types (integers and floats) fully specify the
   bit size of the type.  An integer type is a pair of a signed/unsigned
@@ -64,7 +65,7 @@ Inductive floatsize : Type :=
 <<
   struct s2 { int n; struct s2 next; };
 >>
-  In Clight, struct and union types [Tstruct id fields] and
+  In Compcert C, struct and union types [Tstruct id fields] and
   [Tunion id fields] are compared by structure: the [fields]
   argument gives the names and types of the members.  The identifier
   [id] is a local name which can be used in conjuction with the
@@ -101,6 +102,18 @@ with fieldlist : Type :=
   | Fnil: fieldlist
   | Fcons: ident -> type -> fieldlist -> fieldlist.
 
+(** The usual unary conversion.  Promotes small integer types to [signed int32]
+  and degrades array types and function types to pointer types. *)
+
+Definition typeconv (ty: type) : type :=
+  match ty with
+  | Tint I32 Unsigned => ty
+  | Tint _ _ => Tint I32 Signed
+  | Tarray t sz => Tpointer t
+  | Tfunction _ _ => Tpointer ty
+  | _ => ty
+  end.
+
 (** ** Expressions *)
 
 (** Arithmetic and logical operators. *)
@@ -108,8 +121,7 @@ with fieldlist : Type :=
 Inductive unary_operation : Type :=
   | Onotbool : unary_operation          (**r boolean negation ([!] in C) *)
   | Onotint : unary_operation           (**r integer complement ([~] in C) *)
-  | Oneg : unary_operation              (**r opposite (unary [-]) *)
-  | Ofabs : unary_operation.            (**r floating-point absolute value *)
+  | Oneg : unary_operation.             (**r opposite (unary [-]) *)
 
 Inductive binary_operation : Type :=
   | Oadd : binary_operation             (**r addition (binary [+]) *)
@@ -129,52 +141,146 @@ Inductive binary_operation : Type :=
   | Ole: binary_operation               (**r comparison ([<=]) *)
   | Oge: binary_operation.              (**r comparison ([>=]) *)
 
-(** Clight expressions are a large subset of those of C.
-  The main omissions are string literals and assignment operators
-  ([=], [+=], [++], etc).  In Clight, assignment is a statement,
-  not an expression.  
+Inductive incr_or_decr : Type := Incr | Decr.
 
-  All expressions are annotated with their types.  An expression
-  (type [expr]) is therefore a pair of a type and an expression
-  description (type [expr_descr]).
-*)
+(** Compcert C expressions are almost identical to those of C.
+  The only omission is string literals.  Some operators are treated
+  as derived forms: array indexing, pre-increment, pre-decrement, and
+  the [&&] and [||] operators.  All expressions are annotated with
+  their types. *)
 
 Inductive expr : Type :=
-  | Expr: expr_descr -> type -> expr
-
-with expr_descr : Type :=
-  | Econst_int: int -> expr_descr       (**r integer literal *)
-  | Econst_float: float -> expr_descr   (**r float literal *)
-  | Evar: ident -> expr_descr           (**r variable *)
-  | Ederef: expr -> expr_descr          (**r pointer dereference (unary [*]) *)
-  | Eaddrof: expr -> expr_descr         (**r address-of operator ([&]) *)
-  | Eunop: unary_operation -> expr -> expr_descr  (**r unary operation *)
-  | Ebinop: binary_operation -> expr -> expr -> expr_descr (**r binary operation *)
-  | Ecast: type -> expr -> expr_descr   (**r type cast ([(ty) e]) *)
-  | Econdition: expr -> expr -> expr -> expr_descr (**r conditional ([e1 ? e2 : e3]) *)
-  | Eandbool: expr -> expr -> expr_descr (**r sequential and ([&&]) *)
-  | Eorbool: expr -> expr -> expr_descr (**r sequential or ([||]) *)
-  | Esizeof: type -> expr_descr         (**r size of a type *)
-  | Efield: expr -> ident -> expr_descr. (**r access to a member of a struct or union *)
-
-(** Extract the type part of a type-annotated Clight expression. *)
-
-Definition typeof (e: expr) : type :=
-  match e with Expr de te => te end.
+  | Eval (v: val) (ty: type)                                  (**r constant *)
+  | Evar (x: ident) (ty: type)                                (**r variable *)
+  | Efield (l: expr) (f: ident) (ty: type)
+                               (**r access to a member of a struct or union *)
+  | Evalof (l: expr) (ty: type)              (**r l-value used as a r-value *)
+  | Ederef (r: expr) (ty: type)        (**r pointer dereference (unary [*]) *)
+  | Eaddrof (l: expr) (ty: type)            (**r address-of operators ([&]) *)
+  | Eunop (op: unary_operation) (r: expr) (ty: type)
+                                            (**r unary arithmetic operation *)
+  | Ebinop (op: binary_operation) (r1 r2: expr) (ty: type)
+                                           (**r binary arithmetic operation *)
+  | Ecast (r: expr) (ty: type)                        (**r type cast [(ty)r] *)
+  | Econdition (r1 r2 r3: expr) (ty: type)  (**r conditional [r1 ? r2 : r3] *)
+  | Esizeof (ty': type) (ty: type)                      (**r size of a type *)
+  | Eassign (l: expr) (r: expr) (ty: type)          (**r assignment [l = r] *)
+  | Eassignop (op: binary_operation) (l: expr) (r: expr) (tyres ty: type)
+                                  (**r assignment with arithmetic [l op= r] *)
+  | Epostincr (id: incr_or_decr) (l: expr) (ty: type)
+                         (**r post-increment [l++] and post-decrement [l--] *)
+  | Ecomma (r1 r2: expr) (ty: type)       (**r sequence expression [r1, r2] *)
+  | Ecall (r1: expr) (rargs: exprlist) (ty: type)
+                                             (**r function call [r1(rargs)] *)
+  | Eloc (b: block) (ofs: int) (ty: type)
+                       (**r memory location, result of evaluating a l-value *)
+  | Eparen (r: expr) (ty: type)                   (**r marked subexpression *)
+
+with exprlist : Type :=
+  | Enil
+  | Econs (r1: expr) (rl: exprlist).
+
+(** Expressions are implicitly classified into l-values and r-values,
+ranged over by [l] and [r], respectively, in the grammar above.
+
+L-values are those expressions that can occur to the left of an assignment.
+They denote memory locations.  (Indeed, the reduction semantics for
+expression reduces them to [Eloc b ofs] expressions.)  L-values are
+variables ([Evar]), pointer dereferences ([Ederef]), field accesses ([Efield]).  
+R-values are all other expressions.  They denote values, and the reduction
+semantics reduces them to [Eval v] expressions.  
+
+A l-value can be used in a r-value context, but this use must be marked
+explicitly with the [Evalof] operator, which is not materialized in the 
+concrete syntax of C but denotes a read from the location corresponding to
+the l-value [l] argument of [Evalof l].
+
+The grammar above contains some forms that cannot appear in source terms
+but appear during reduction.  These forms are:
+- [Eval v] where [v] is a pointer or [Vundef].  ([Eval] of an integer or 
+  float value can occur in a source term and represents a numeric literal.)
+- [Eloc b ofs], which appears during reduction of l-values.
+- [Eparen r], which appears during reduction of conditionals [r1 ? r2 : r3].
+
+Some C expressions are derived forms.  Array access [r1[r2]] is expressed
+as [*(r1 + r2)].
+*)
+
+Definition Eindex (r1 r2: expr) (ty: type) :=
+  Ederef (Ebinop Oadd r1 r2 (Tpointer ty)) ty.
+
+(** Pre-increment [++l] and pre-decrement [--l] are expressed as
+    [l += 1] and [l -= 1], respectively. *)
+
+Definition Epreincr (id: incr_or_decr) (l: expr) (ty: type) :=
+  Eassignop (match id with Incr => Oadd | Decr => Osub end) 
+            l (Eval (Vint Int.one) (Tint I32 Signed)) (typeconv ty) ty.
+
+(** Sequential ``and'' [r1 && r2] is viewed as two conditionals
+    [r1 ? (r2 ? 1 : 0) : 0]. *)
+
+Definition Eseqand (r1 r2: expr) (ty: type) :=
+  Econdition r1 
+    (Econdition r2 (Eval (Vint Int.one) (Tint I32 Signed))
+                   (Eval (Vint Int.zero) (Tint I32 Signed)) ty)
+    (Eval (Vint Int.zero) (Tint I32 Signed))
+    ty.
+                  
+(** Sequential ``or'' [r1 || r2] is viewed as two conditionals
+    [r1 ? 1 : (r2 ? 1 : 0)]. *)
+
+Definition Eseqor (r1 r2: expr) (ty: type) :=
+  Econdition r1 
+    (Eval (Vint Int.one) (Tint I32 Signed))
+    (Econdition r2 (Eval (Vint Int.one) (Tint I32 Signed))
+                   (Eval (Vint Int.zero) (Tint I32 Signed)) ty)
+    ty.
+
+(** Extract the type part of a type-annotated expression. *)
+
+Definition typeof (a: expr) : type :=
+  match a with
+  | Eloc _ _ ty => ty
+  | Evar _ ty => ty
+  | Ederef _ ty => ty
+  | Efield _ _ ty => ty
+  | Eval _ ty => ty
+  | Evalof _ ty => ty
+  | Eaddrof _ ty => ty
+  | Eunop _ _ ty => ty
+  | Ebinop _ _ _ ty => ty
+  | Ecast _ ty => ty
+  | Econdition _ _ _ ty => ty
+  | Esizeof _ ty => ty
+  | Eassign _ _ ty => ty
+  | Eassignop _ _ _ _ ty => ty
+  | Epostincr _ _ ty => ty
+  | Ecomma _ _ ty => ty
+  | Ecall _ _ ty => ty
+  | Eparen _ ty => ty
+  end.
 
 (** ** Statements *)
 
-(** Clight statements include all C statements.
-  Only structured forms of [switch] are supported; moreover,
-  the [default] case must occur last.  Blocks and block-scoped declarations
-  are not supported. *)
+(** Compcert C statements are very much like those of C and include:
+- empty statement [Sskip]
+- evaluation of an expression for its side-effects [Sdo r]
+- conditional [if (...) { ... } else { ... }]
+- the three loops [while(...) { ... }] and [do { ... } while (...)]
+  and [for(..., ..., ...) { ... }]
+- the [switch] construct
+- [break], [continue], [return] (with and without argument)
+- [goto] and labeled statements.
+
+Only structured forms of [switch] are supported; moreover,
+the [default] case must occur last.  Blocks and block-scoped declarations
+are not supported. *)
 
 Definition label := ident.
 
 Inductive statement : Type :=
   | Sskip : statement                   (**r do nothing *)
-  | Sassign : expr -> expr -> statement (**r assignment [lvalue = rvalue] *)
-  | Scall: option expr -> expr -> list expr -> statement (**r function call *)
+  | Sdo : expr -> statement            (**r evaluate expression for side effects *)
   | Ssequence : statement -> statement -> statement  (**r sequence *)
   | Sifthenelse : expr  -> statement -> statement -> statement (**r conditional *)
   | Swhile : expr -> statement -> statement   (**r [while] loop *)
@@ -182,7 +288,7 @@ Inductive statement : Type :=
   | Sfor: statement -> expr -> statement -> statement -> statement (**r [for] loop *)
   | Sbreak : statement                      (**r [break] statement *)
   | Scontinue : statement                   (**r [continue] statement *)
-  | Sreturn : option expr -> statement      (**r [return] statement *)
+  | Sreturn : option expr -> statement     (**r [return] statement *)
   | Sswitch : expr -> labeled_statements -> statement  (**r [switch] statement *)
   | Slabel : label -> statement -> statement
   | Sgoto : label -> statement
@@ -205,6 +311,9 @@ Record function : Type := mkfunction {
   fn_body: statement
 }.
 
+Definition var_names (vars: list(ident * type)) : list ident :=
+  List.map (@fst ident type) vars.
+
 (** Functions can either be defined ([Internal]) or declared as
   external functions ([External]). *)
 
@@ -266,23 +375,73 @@ with alignof_fields (f: fieldlist) : Z :=
 Scheme type_ind2 := Induction for type Sort Prop
   with fieldlist_ind2 := Induction for fieldlist Sort Prop.
 
-Lemma alignof_fields_pos:
-  forall f, alignof_fields f > 0.
+Lemma alignof_power_of_2:
+  forall t, exists n, alignof t = two_power_nat n
+with alignof_fields_power_of_2:
+  forall f, exists n, alignof_fields f = two_power_nat n.
 Proof.
+  induction t; simpl.
+  exists 0%nat; auto.
+  destruct i. exists 0%nat; auto. exists 1%nat; auto. exists 2%nat; auto.
+  destruct f. exists 2%nat; auto. exists 3%nat; auto.
+  exists 2%nat; auto.
+  auto.
+  exists 0%nat; auto.
+  apply alignof_fields_power_of_2.
+  apply alignof_fields_power_of_2.
+  exists 2%nat; auto.
   induction f; simpl.
-  omega.
-  generalize (Zmax2 (alignof t) (alignof_fields f)). omega.
+  exists 0%nat; auto.
+  rewrite Zmax_spec. destruct (zlt (alignof_fields f) (alignof t)); auto.
 Qed.
 
 Lemma alignof_pos:
   forall t, alignof t > 0.
 Proof.
-  induction t; simpl; auto; try omega.
-  destruct i; omega.
-  destruct f; omega.
-  apply alignof_fields_pos.
-  apply alignof_fields_pos.
+  intros. destruct (alignof_power_of_2 t) as [p EQ]. rewrite EQ. apply two_power_nat_pos. 
+Qed.
+
+Lemma alignof_fields_pos:
+  forall f, alignof_fields f > 0.
+Proof.
+  intros. destruct (alignof_fields_power_of_2 f) as [p EQ]. rewrite EQ. apply two_power_nat_pos. 
+Qed.
+
+(*
+Fixpoint In_fieldlist (id: ident) (ty: type) (f: fieldlist) : Prop :=
+  match f with
+  | Fnil => False
+  | Fcons id1 ty1 f1 => (id1 = id /\ ty1 = ty) \/ In_fieldlist id ty f1
+  end.
+
+Remark divides_max_pow_two:
+  forall a b,
+  (two_power_nat b | Zmax (two_power_nat a) (two_power_nat b)).
+Proof.
+  intros.
+  rewrite Zmax_spec. destruct (zlt (two_power_nat b) (two_power_nat a)).
+  repeat rewrite two_power_nat_two_p in *. 
+  destruct (zle (Z_of_nat a) (Z_of_nat b)).
+  assert (two_p (Z_of_nat a) <= two_p (Z_of_nat b)). apply two_p_monotone; omega.
+  omegaContradiction.
+  exists (two_p (Z_of_nat a - Z_of_nat b)). 
+  rewrite <- two_p_is_exp. decEq. omega. omega. omega. 
+  apply Zdivide_refl.
+Qed.
+
+Lemma alignof_each_field:
+  forall f id t, In_fieldlist id t f -> (alignof t | alignof_fields f).
+Proof.
+  induction f; simpl; intros.
+  contradiction.
+  destruct (alignof_power_of_2 t) as [k1 EQ1].
+  destruct (alignof_fields_power_of_2 f) as [k2 EQ2].
+  destruct H as [[A B] | A]; subst; rewrite EQ1; rewrite EQ2. 
+  rewrite Zmax_comm. apply divides_max_pow_two.
+  eapply Zdivide_trans. eapply IHf; eauto. 
+  rewrite EQ2. apply divides_max_pow_two.
 Qed.
+*)
 
 (** Size of a type, in bytes. *)
 
@@ -346,6 +505,15 @@ Proof.
   assert (sizeof t > 0) by apply sizeof_pos. omega.
 Qed.
 
+Lemma sizeof_alignof_compat:
+  forall t, (alignof t | sizeof t).
+Proof.
+  induction t; simpl; try (apply Zdivide_refl).
+  apply Zdivide_mult_l. auto.
+  apply align_divides. apply alignof_fields_pos.
+  apply align_divides. apply alignof_fields_pos.
+Qed.
+
 (** Byte offset for a field in a struct or union.
   Field are laid out consecutively, and padding is inserted
   to align each field to the natural alignment for its type. *)
@@ -389,11 +557,13 @@ Proof.
 Qed.
 
 Lemma field_offset_in_range:
-  forall id fld ofs ty,
-  field_offset id fld = OK ofs -> field_type id fld = OK ty ->
-  0 <= ofs /\ ofs + sizeof ty <= sizeof_struct fld 0.
+  forall sid fld fid ofs ty,
+  field_offset fid fld = OK ofs -> field_type fid fld = OK ty ->
+  0 <= ofs /\ ofs + sizeof ty <= sizeof (Tstruct sid fld).
 Proof.
-  intros. eapply field_offset_rec_in_range. unfold field_offset in H; eauto. eauto.
+  intros. exploit field_offset_rec_in_range; eauto. intros [A B].
+  split. auto.  simpl. eapply Zle_trans. eauto.
+  eapply Zle_trans. eapply Zle_max_r. apply align_le. apply alignof_fields_pos.
 Qed.
 
 (** Second, two distinct fields do not overlap *)
@@ -422,8 +592,8 @@ Proof.
   apply H with fld0 0; auto.
 Qed.
 
-(** Third, if a struct is a prefix of another, the offsets of fields
-  in common is the same. *)
+(** Third, if a struct is a prefix of another, the offsets of common fields
+    are the same. *)
 
 Fixpoint fieldlist_app (fld1 fld2: fieldlist) {struct fld1} : fieldlist :=
   match fld1 with
@@ -445,16 +615,31 @@ Proof.
   intros. unfold field_offset; auto. 
 Qed.
 
-(** The [access_mode] function describes how a variable of the given
+(** Fourth, the position of each field respects its alignment. *)
+
+Lemma field_offset_aligned:
+  forall id fld ofs ty,
+  field_offset id fld = OK ofs -> field_type id fld = OK ty ->
+  (alignof ty | ofs).
+Proof.
+  assert (forall id ofs ty fld pos,
+          field_offset_rec id fld pos = OK ofs -> field_type id fld = OK ty ->
+          (alignof ty | ofs)).
+  induction fld; simpl; intros.
+  discriminate.
+  destruct (ident_eq id i). inv H; inv H0. 
+  apply align_divides. apply alignof_pos. 
+  eapply IHfld; eauto.
+  intros. eapply H with (pos := 0); eauto.
+Qed.
+
+(** The [access_mode] function describes how a l-value of the given
 type must be accessed:
 - [By_value ch]: access by value, i.e. by loading from the address
-  of the variable using the memory chunk [ch];
+  of the l-value using the memory chunk [ch];
 - [By_reference]: access by reference, i.e. by just returning
-  the address of the variable;
+  the address of the l-value;
 - [By_nothing]: no access is possible, e.g. for the [void] type.
-
-We currently do not support 64-bit integers and 128-bit floats, so these
-have an access mode of [By_nothing].
 *)
 
 Inductive mode: Type :=
@@ -480,124 +665,182 @@ Definition access_mode (ty: type) : mode :=
   | Tcomp_ptr _ => By_value Mint32
 end.
 
-(** The usual unary conversion.  Promotes small integer types to [signed int32]
-  and degrades array types and function types to pointer types. *)
-
-Definition typeconv (ty: type) : type :=
-  match ty with
-  | Tint I32 Unsigned => ty
-  | Tint _ _ => Tint I32 Signed
-  | Tarray t sz => Tpointer t
-  | Tfunction _ _ => Tpointer ty
-  | _ => ty
-  end.
-
 (** Classification of arithmetic operations and comparisons.
   The following [classify_] functions take as arguments the types
   of the arguments of an operation.  They return enough information
   to resolve overloading for this operator applications, such as
   ``both arguments are floats'', or ``the first is a pointer
   and the second is an integer''.  These functions are used to resolve
-  overloading both in the dynamic semantics (module [Csem]) and in the
-  compiler (module [Cshmgen]).
+  overloading both in the dynamic semantics (module [Csem]), in the
+  type system (module [Ctyping]), and in the compiler (module
+  [Cshmgen]).
 *)
 
+Inductive classify_neg_cases : Type :=
+  | neg_case_i(s: signedness)              (**r int *)
+  | neg_case_f                             (**r float *)
+  | neg_default.
+
+Definition classify_neg (ty: type) : classify_neg_cases :=
+  match ty with
+  | Tint I32 Unsigned => neg_case_i Unsigned
+  | Tint _ _ => neg_case_i Signed
+  | Tfloat _ => neg_case_f
+  | _ => neg_default
+  end.
+
+Inductive classify_notint_cases : Type :=
+  | notint_case_i(s: signedness)              (**r int *)
+  | notint_default.
+
+Definition classify_notint (ty: type) : classify_notint_cases :=
+  match ty with
+  | Tint I32 Unsigned => notint_case_i Unsigned
+  | Tint _ _ => notint_case_i Signed
+  | _ => notint_default
+  end.
+
+(** The following describes types that can be interpreted as a boolean:
+  integers, floats, pointers.  It is used for the semantics of 
+  the [!] and [?] operators, as well as the [if], [while], [for] statements. *)
+
+Inductive classify_bool_cases : Type :=
+  | bool_case_ip                          (**r integer or pointer *)
+  | bool_case_f                           (**r float *)
+  | bool_default.
+
+Definition classify_bool (ty: type) : classify_bool_cases :=
+  match typeconv ty with
+  | Tint _ _ => bool_case_ip
+  | Tpointer _ => bool_case_ip
+  | Tfloat _ => bool_case_f
+  | _ => bool_default
+  end.
+
 Inductive classify_add_cases : Type :=
-  | add_case_ii: classify_add_cases         (**r int , int *)
-  | add_case_ff: classify_add_cases         (**r float , float *)
-  | add_case_pi: type -> classify_add_cases (**r ptr or array, int *)
-  | add_case_ip: type -> classify_add_cases (**r int, ptr or array *)
-  | add_default: classify_add_cases.        (**r other *)
+  | add_case_ii(s: signedness)         (**r int, int *)
+  | add_case_ff                        (**r float, float *)
+  | add_case_if(s: signedness)         (**r int, float *)
+  | add_case_fi(s: signedness)         (**r float, int *)
+  | add_case_pi(ty: type)              (**r pointer, int *)
+  | add_case_ip(ty: type)              (**r int, pointer *)
+  | add_default.
 
 Definition classify_add (ty1: type) (ty2: type) :=
   match typeconv ty1, typeconv ty2 with
-  | Tint _ _, Tint _ _ => add_case_ii
+  | Tint I32 Unsigned, Tint _ _ => add_case_ii Unsigned
+  | Tint _ _, Tint I32 Unsigned => add_case_ii Unsigned
+  | Tint _ _, Tint _ _ => add_case_ii Signed
   | Tfloat _, Tfloat _ => add_case_ff
+  | Tint _ sg, Tfloat _ => add_case_if sg
+  | Tfloat _, Tint _ sg => add_case_fi sg
   | Tpointer ty, Tint _ _ => add_case_pi ty
   | Tint _ _, Tpointer ty => add_case_ip ty
   | _, _ => add_default
   end.
 
 Inductive classify_sub_cases : Type :=
-  | sub_case_ii: classify_sub_cases          (**r int , int *)
-  | sub_case_ff: classify_sub_cases          (**r float , float *)
-  | sub_case_pi: type -> classify_sub_cases  (**r ptr or array , int *)
-  | sub_case_pp: type -> classify_sub_cases  (**r ptr or array , ptr or array *)
-  | sub_default: classify_sub_cases .        (**r other *)
+  | sub_case_ii(s: signedness)          (**r int , int *)
+  | sub_case_ff                         (**r float , float *)
+  | sub_case_if(s: signedness)          (**r int, float *)
+  | sub_case_fi(s: signedness)          (**r float, int *)
+  | sub_case_pi(ty: type)               (**r pointer, int *)
+  | sub_case_pp(ty: type)               (**r pointer, pointer *)
+  | sub_default.
 
 Definition classify_sub (ty1: type) (ty2: type) :=
   match typeconv ty1, typeconv ty2 with
-  | Tint _ _ , Tint _ _ => sub_case_ii
+  | Tint I32 Unsigned, Tint _ _ => sub_case_ii Unsigned
+  | Tint _ _, Tint I32 Unsigned => sub_case_ii Unsigned
+  | Tint _ _, Tint _ _ => sub_case_ii Signed
   | Tfloat _ , Tfloat _ => sub_case_ff
+  | Tint _ sg, Tfloat _ => sub_case_if sg
+  | Tfloat _, Tint _ sg => sub_case_fi sg
   | Tpointer ty , Tint _ _ => sub_case_pi ty
   | Tpointer ty , Tpointer _ => sub_case_pp ty
   | _ ,_ => sub_default
   end.
 
 Inductive classify_mul_cases : Type:=
-  | mul_case_ii: classify_mul_cases (**r int , int *)
-  | mul_case_ff: classify_mul_cases (**r float , float *)
-  | mul_default: classify_mul_cases . (**r other *)
+  | mul_case_ii(s: signedness) (**r int , int *)
+  | mul_case_ff                (**r float , float *)
+  | mul_case_if(s: signedness) (**r int, float *)
+  | mul_case_fi(s: signedness) (**r float, int *)
+  | mul_default.
 
 Definition classify_mul (ty1: type) (ty2: type) :=
   match typeconv ty1, typeconv ty2 with
-  | Tint _ _, Tint _ _ => mul_case_ii
+  | Tint I32 Unsigned, Tint _ _ => mul_case_ii Unsigned
+  | Tint _ _, Tint I32 Unsigned => mul_case_ii Unsigned
+  | Tint _ _, Tint _ _ => mul_case_ii Signed
   | Tfloat _ , Tfloat _ => mul_case_ff
+  | Tint _ sg, Tfloat _ => mul_case_if sg
+  | Tfloat _, Tint _ sg => mul_case_fi sg
   | _,_  => mul_default
 end.
 
 Inductive classify_div_cases : Type:=
-  | div_case_I32unsi: classify_div_cases (**r unsigned int32 , int *)
-  | div_case_ii: classify_div_cases    (**r int , int *) 
-  | div_case_ff: classify_div_cases    (**r float , float *)
-  | div_default: classify_div_cases. (**r other *)
+  | div_case_ii(s: signedness) (**r int , int *)
+  | div_case_ff                (**r float , float *)
+  | div_case_if(s: signedness) (**r int, float *)
+  | div_case_fi(s: signedness) (**r float, int *)
+  | div_default.
 
 Definition classify_div (ty1: type) (ty2: type) :=
-  match typeconv ty1, typeconv ty2 with 
-  | Tint I32 Unsigned, Tint _ _ => div_case_I32unsi 
-  | Tint _ _ , Tint I32 Unsigned => div_case_I32unsi 
-  | Tint _ _ , Tint _ _ => div_case_ii 
-  | Tfloat _ , Tfloat _ => div_case_ff 
-  | _ ,_ => div_default 
+  match typeconv ty1, typeconv ty2 with
+  | Tint I32 Unsigned, Tint _ _ => div_case_ii Unsigned
+  | Tint _ _, Tint I32 Unsigned => div_case_ii Unsigned
+  | Tint _ _, Tint _ _ => div_case_ii Signed
+  | Tfloat _ , Tfloat _ => div_case_ff
+  | Tint _ sg, Tfloat _ => div_case_if sg
+  | Tfloat _, Tint _ sg => div_case_fi sg
+  | _,_  => div_default
 end.
 
-Inductive classify_mod_cases : Type:=
-  | mod_case_I32unsi: classify_mod_cases  (**r unsigned I32 , int *)
-  | mod_case_ii: classify_mod_cases  (**r int , int *)
-  | mod_default: classify_mod_cases . (**r other *)
+(** The following is common to binary integer-only operators:
+  modulus, bitwise "and", "or", and "xor". *)
 
-Definition classify_mod (ty1: type) (ty2: type) :=
+Inductive classify_binint_cases : Type:=
+  | binint_case_ii(s: signedness) (**r int , int *)
+  | binint_default.
+
+Definition classify_binint (ty1: type) (ty2: type) :=
   match typeconv ty1, typeconv ty2 with
-  | Tint I32 Unsigned , Tint _ _ => mod_case_I32unsi 
-  | Tint _ _ , Tint I32 Unsigned => mod_case_I32unsi 
-  | Tint _ _ , Tint _ _ => mod_case_ii 
-  | _ , _ => mod_default 
-end .
-
-Inductive classify_shr_cases :Type:=
-  | shr_case_I32unsi:  classify_shr_cases (**r unsigned I32 , int *)
-  | shr_case_ii :classify_shr_cases (**r int , int *)
-  | shr_default : classify_shr_cases . (**r other *)
-
-Definition classify_shr (ty1: type) (ty2: type) :=
+  | Tint I32 Unsigned, Tint _ _ => binint_case_ii Unsigned
+  | Tint _ _, Tint I32 Unsigned => binint_case_ii Unsigned
+  | Tint _ _, Tint _ _ => binint_case_ii Signed
+  | _,_  => binint_default
+end.
+
+(** The following is common to shift operators [<<] and [>>]. *)
+
+Inductive classify_shift_cases : Type:=
+  | shift_case_ii(s: signedness) (**r int , int *)
+  | shift_default.
+
+Definition classify_shift (ty1: type) (ty2: type) :=
   match typeconv ty1, typeconv ty2 with
-  | Tint I32 Unsigned , Tint _ _ => shr_case_I32unsi
-  | Tint _ _ , Tint _ _ => shr_case_ii
-  | _ , _ => shr_default 
-  end.
+  | Tint I32 Unsigned, Tint _ _ => shift_case_ii Unsigned
+  | Tint _ _, Tint _ _ => shift_case_ii Signed
+  | _,_  => shift_default
+end.
 
 Inductive classify_cmp_cases : Type:=
-  | cmp_case_I32unsi: classify_cmp_cases (**r unsigned I32 , int *)
-  | cmp_case_ipip: classify_cmp_cases  (**r int|ptr|array , int|ptr|array*)
-  | cmp_case_ff: classify_cmp_cases  (**r float , float *)
-  | cmp_default: classify_cmp_cases . (**r other *)
+  | cmp_case_iiu               (**r unsigned int, unsigned int *)
+  | cmp_case_ipip              (**r int-or-pointer, int-or-pointer *)
+  | cmp_case_ff                (**r float , float *)
+  | cmp_case_if(s: signedness) (**r int, float *)
+  | cmp_case_fi(s: signedness) (**r float, int *)
+  | cmp_default.
 
 Definition classify_cmp (ty1: type) (ty2: type) :=
   match typeconv ty1, typeconv ty2 with 
-  | Tint I32 Unsigned , Tint _ _ => cmp_case_I32unsi 
-  | Tint _ _ , Tint I32 Unsigned => cmp_case_I32unsi 
+  | Tint I32 Unsigned , Tint _ _ => cmp_case_iiu
+  | Tint _ _ , Tint I32 Unsigned => cmp_case_iiu
   | Tint _ _ , Tint _ _ => cmp_case_ipip
   | Tfloat _ , Tfloat _ => cmp_case_ff
+  | Tint _ sg, Tfloat _ => cmp_case_if sg
+  | Tfloat _, Tint _ sg => cmp_case_fi sg
   | Tpointer _ , Tpointer _ => cmp_case_ipip
   | Tpointer _ , Tint _ _ => cmp_case_ipip
   | Tint _ _, Tpointer _ => cmp_case_ipip
@@ -605,8 +848,8 @@ Definition classify_cmp (ty1: type) (ty2: type) :=
   end.
 
 Inductive classify_fun_cases : Type:=
-  | fun_case_f: typelist -> type -> classify_fun_cases   (**r (pointer to) function *)
-  | fun_default: classify_fun_cases . (**r other *)
+  | fun_case_f (targs: typelist) (tres: type) (**r (pointer to) function *)
+  | fun_default.
 
 Definition classify_fun (ty: type) :=
   match ty with 
@@ -615,7 +858,7 @@ Definition classify_fun (ty: type) :=
   | _ => fun_default
   end.
 
-(** Translating Clight types to Cminor types, function signatures,
+(** Translating C types to Cminor types, function signatures,
   and external functions. *)
 
 Definition typ_of_type (t: type) : AST.typ :=
diff --git a/cfrontend/Ctyping.v b/cfrontend/Ctyping.v
deleted file mode 100644
index 8e089f1..0000000
--- a/cfrontend/Ctyping.v
+++ /dev/null
@@ -1,459 +0,0 @@
-(* *********************************************************************)
-(*                                                                     *)
-(*              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.     *)
-(*                                                                     *)
-(* *********************************************************************)
-
-(** * Typing constraints on C programs *)
-
-Require Import Coqlib.
-Require Import Maps.
-Require Import AST.
-Require Import Csyntax.
-
-(** ** Typing rules *)
-
-(** We now define a simple, incomplete type system for the Clight language.
-  This ``type system'' is very coarse: we check only the typing properties
-  that matter for the translation to be correct.  Essentially,
-  we need to check that the types attached to variable references
-  match the declaration types for those variables. *)
-
-(** A typing environment maps variable names to their types. *)
-
-Definition typenv := PTree.t type.
-
-Section TYPING.
-
-Variable env: typenv.
-
-Inductive wt_expr: expr -> Prop :=
-  | wt_Econst_int: forall i ty,
-     wt_expr (Expr (Econst_int i) ty)
-  | wt_Econst_float: forall f ty,
-     wt_expr (Expr (Econst_float f) ty)
-  | wt_Evar: forall id ty,
-     env!id = Some ty ->
-     wt_expr (Expr (Evar id) ty)
-  | wt_Ederef: forall e ty,
-     wt_expr e ->
-     wt_expr (Expr (Ederef e) ty)
-  | wt_Eaddrof: forall e ty,
-     wt_expr e ->
-     wt_expr (Expr (Eaddrof e) ty)
-  | wt_Eunop: forall op e ty,
-     wt_expr e ->
-     wt_expr (Expr (Eunop op e) ty)
-  | wt_Ebinop: forall op e1 e2 ty,
-     wt_expr e1 -> wt_expr e2 ->
-     wt_expr (Expr (Ebinop op e1 e2) ty)
-  | wt_Ecast: forall e ty ty',
-     wt_expr e ->
-     wt_expr (Expr (Ecast ty' e) ty)
-  | wt_Econdition: forall e1 e2 e3 ty,
-     wt_expr e1 -> wt_expr e2 -> wt_expr e3 ->
-     wt_expr (Expr (Econdition e1 e2 e3) ty)
-  | wt_Eandbool: forall e1 e2 ty,
-     wt_expr e1 -> wt_expr e2 ->
-     wt_expr (Expr (Eandbool e1 e2) ty)
-  | wt_Eorbool: forall e1 e2 ty,
-     wt_expr e1 -> wt_expr e2 ->
-     wt_expr (Expr (Eorbool e1 e2) ty)
-  | wt_Esizeof: forall ty' ty,
-     wt_expr (Expr (Esizeof ty') ty)
-  | wt_Efield: forall e id ty,
-     wt_expr e ->
-     wt_expr (Expr (Efield e id) ty).
-
-Inductive wt_optexpr: option expr -> Prop :=
-  | wt_Enone:
-      wt_optexpr None
-  | wt_Esome: forall e,
-      wt_expr e ->
-      wt_optexpr (Some e).
-
-Inductive wt_exprlist: list expr -> Prop :=
-  | wt_Enil:
-     wt_exprlist nil
-  | wt_Econs: forall e el,
-     wt_expr e -> wt_exprlist el -> wt_exprlist (e :: el).
-
-Inductive wt_stmt: statement -> Prop :=
-  | wt_Sskip:
-     wt_stmt Sskip
-  | wt_Sassign: forall e1 e2,
-     wt_expr e1 -> wt_expr e2 ->
-     wt_stmt (Sassign e1 e2)
-  | wt_Scall: forall lhs e1 el,
-     wt_optexpr lhs ->
-     wt_expr e1 ->
-     wt_exprlist el ->
-     wt_stmt (Scall lhs e1 el)
-  | wt_Ssequence: forall s1 s2,
-     wt_stmt s1 -> wt_stmt s2 ->
-     wt_stmt (Ssequence s1 s2)
-  | wt_Sifthenelse: forall e s1 s2,
-     wt_expr e -> wt_stmt s1 -> wt_stmt s2 ->
-     wt_stmt (Sifthenelse e s1 s2)
-  | wt_Swhile: forall e s,
-     wt_expr e -> wt_stmt s ->
-     wt_stmt (Swhile e s)
-  | wt_Sdowhile: forall e s,
-     wt_expr e -> wt_stmt s ->
-     wt_stmt (Sdowhile e s)
-  | wt_Sfor: forall e s1 s2 s3,
-     wt_expr e -> wt_stmt s1 -> wt_stmt s2 -> wt_stmt s3 ->
-     wt_stmt (Sfor s1 e s2 s3)
-  | wt_Sbreak:
-     wt_stmt Sbreak
-  | wt_Scontinue:
-     wt_stmt Scontinue
-  | wt_Sreturn: forall opte,
-     wt_optexpr opte ->
-     wt_stmt (Sreturn opte)
-  | wt_Sswitch: forall e sl,
-     wt_expr e -> wt_lblstmts sl ->
-     wt_stmt (Sswitch e sl)
-  | wt_Slabel: forall lbl s,
-     wt_stmt s ->
-     wt_stmt (Slabel lbl s)
-  | wt_Sgoto: forall lbl,
-     wt_stmt (Sgoto lbl)
-
-with wt_lblstmts: labeled_statements -> Prop :=
-  | wt_LSdefault: forall s,
-     wt_stmt s ->
-     wt_lblstmts (LSdefault s)
-  | wt_LScase: forall n s sl,
-     wt_stmt s -> wt_lblstmts sl ->
-     wt_lblstmts (LScase n s sl).
-
-End TYPING.
-
-Definition add_var (env: typenv) (id_ty: ident * type) : typenv :=
-  PTree.set (fst id_ty) (snd id_ty) env.
-
-Definition add_vars (env: typenv) (vars: list(ident * type)) : typenv :=
-  List.fold_left add_var vars env.
-
-Definition var_names (vars: list(ident * type)) : list ident :=
-  List.map (@fst ident type) vars.
-
-Inductive wt_function: typenv -> function -> Prop :=
-  | wt_function_intro: forall env f,
-      list_norepet (var_names f.(fn_params) ++ var_names f.(fn_vars)) ->
-      wt_stmt (add_vars env (f.(fn_params) ++ f.(fn_vars))) f.(fn_body) ->
-      wt_function env f.
-
-Inductive wt_fundef: typenv -> fundef -> Prop :=
-  | wt_fundef_Internal: forall env f,
-      wt_function env f ->
-      wt_fundef env (Internal f)
-  | wt_fundef_External: forall env ef args res,
-      (ef_sig ef).(sig_args) = typlist_of_typelist args ->
-      (ef_sig ef).(sig_res) = opttyp_of_type res ->
-      wt_fundef env (External ef args res).
-
-Definition add_global_var
-     (env: typenv) (id_v: ident * globvar type) : typenv :=
-  PTree.set (fst id_v) (gvar_info (snd id_v)) env.
-
-Definition add_global_vars
-     (env: typenv) (vars: list(ident * globvar type)) : typenv :=
-  List.fold_left add_global_var vars env.
-
-Definition add_global_fun
-     (env: typenv) (id_fd: ident * fundef) : typenv :=
-  PTree.set (fst id_fd) (type_of_fundef (snd id_fd)) env.
-
-Definition add_global_funs
-     (env: typenv) (funs: list(ident * fundef)) : typenv :=
-  List.fold_left add_global_fun funs env.
-
-Definition global_typenv (p: program) :=
-  add_global_vars (add_global_funs (PTree.empty type) p.(prog_funct)) p.(prog_vars).
-
-Record wt_program (p: program) : Prop :=  mk_wt_program {
-  wt_program_funct:
-    forall id fd,
-    In (id, fd) p.(prog_funct) ->
-    wt_fundef (global_typenv p) fd;
-  wt_program_main:
-    forall fd,
-    In (p.(prog_main), fd) p.(prog_funct) ->
-    exists targs, type_of_fundef fd = Tfunction targs (Tint I32 Signed)
-}.
-
-(* ** Type-checking algorithm *)
-
-(** We now define and prove correct a type-checking algorithm
-  for the type system defined above. *)
-
-Lemma eq_signedness: forall (s1 s2: signedness), {s1=s2} + {s1<>s2}.
-Proof. decide equality. Qed.
-
-Lemma eq_intsize: forall (s1 s2: intsize), {s1=s2} + {s1<>s2}.
-Proof. decide equality. Qed.
-
-Lemma eq_floatsize: forall (s1 s2: floatsize), {s1=s2} + {s1<>s2}.
-Proof. decide equality. Qed.
-
-Fixpoint eq_type (t1 t2: type) {struct t1}: bool :=
-  match t1, t2 with
-  | Tvoid, Tvoid => true
-  | Tint sz1 sg1, Tint sz2 sg2 =>
-      if eq_intsize sz1 sz2
-      then if eq_signedness sg1 sg2 then true else false
-      else false
-  | Tfloat sz1, Tfloat sz2 =>
-      if eq_floatsize sz1 sz2 then true else false
-  | Tpointer u1, Tpointer u2 => eq_type u1 u2
-  | Tarray u1 sz1, Tarray u2 sz2 =>
-      eq_type u1 u2 && if zeq sz1 sz2 then true else false
-  | Tfunction args1 res1, Tfunction args2 res2 =>
-      eq_typelist args1 args2 && eq_type res1 res2
-  | Tstruct id1 f1, Tstruct id2 f2 =>
-      if ident_eq id1 id2 then eq_fieldlist f1 f2 else false
-  | Tunion id1 f1, Tunion id2 f2 =>
-      if ident_eq id1 id2 then eq_fieldlist f1 f2 else false
-  | Tcomp_ptr id1, Tcomp_ptr id2 =>
-      if ident_eq id1 id2 then true else false
-  | _, _ => false
-  end
-
-with eq_typelist (t1 t2: typelist) {struct t1} : bool :=
-  match t1, t2 with
-  | Tnil, Tnil => true
-  | Tcons u1 r1, Tcons u2 r2 => eq_type u1 u2 && eq_typelist r1 r2
-  | _, _ => false
-  end
-
-with eq_fieldlist (f1 f2: fieldlist) {struct f1} : bool :=
-  match f1, f2 with
-  | Fnil, Fnil => true
-  | Fcons id1 t1 r1, Fcons id2 t2 r2 =>
-      if ident_eq id1 id2
-      then eq_type t1 t2 && eq_fieldlist r1 r2
-      else false
-  | _, _ => false
-  end.
-
-Ltac TrueInv :=
-  match goal with
-  | [ H: ((if ?x then ?y else false) = true) |- _ ] =>
-        destruct x; [TrueInv | discriminate]
-  | [ H: (?x && ?y = true) |- _ ] =>
-        elim (andb_prop _ _ H); clear H; intros; TrueInv
-  | _ =>
-        idtac
-  end.
-
-Scheme type_ind_3 := Induction for type Sort Prop
-  with typelist_ind_3 := Induction for typelist Sort Prop
-  with fieldlist_ind_3 := Induction for fieldlist Sort Prop.
-
-Lemma eq_type_correct:
-  forall t1 t2, eq_type t1 t2 = true -> t1 = t2.
-Proof.
-  apply (type_ind_3 (fun t1 => forall t2, eq_type t1 t2 = true -> t1 = t2)
-                    (fun t1 => forall t2, eq_typelist t1 t2 = true -> t1 = t2)
-                    (fun t1 => forall t2, eq_fieldlist t1 t2 = true -> t1 = t2));
-  intros; destruct t2; simpl in *; try discriminate.
-  auto.
-  TrueInv. congruence.
-  TrueInv. congruence.
-  decEq; auto.
-  TrueInv. decEq; auto.
-  TrueInv. decEq; auto.
-  TrueInv. subst i0. decEq; auto.
-  TrueInv. subst i0. decEq; auto.
-  TrueInv. congruence.
-  auto.
-  TrueInv. decEq; auto.
-  auto.
-  TrueInv. decEq; auto.
-Qed.
-
-Section TYPECHECKING.
-
-Variable env: typenv.
-
-Fixpoint typecheck_expr (a: Csyntax.expr) {struct a} : bool :=
-  match a with
-  | Expr ad aty => typecheck_exprdescr ad aty
-  end
-
-with typecheck_exprdescr (a: Csyntax.expr_descr) (ty: type) {struct a} : bool :=
-  match a with
-  | Csyntax.Econst_int n => true
-  | Csyntax.Econst_float n => true
-  | Csyntax.Evar id =>
-      match env!id with
-      | None => false
-      | Some ty' => eq_type ty ty'
-      end
-  | Csyntax.Ederef b => typecheck_expr b
-  | Csyntax.Eaddrof b => typecheck_expr b
-  | Csyntax.Eunop op b => typecheck_expr b
-  | Csyntax.Ebinop op b c => typecheck_expr b && typecheck_expr c
-  | Csyntax.Ecast ty b => typecheck_expr b
-  | Csyntax.Econdition b c d => typecheck_expr b && typecheck_expr c && typecheck_expr d
-  | Csyntax.Eandbool b c => typecheck_expr b && typecheck_expr c
-  | Csyntax.Eorbool b c => typecheck_expr b && typecheck_expr c
-  | Csyntax.Esizeof ty => true
-  | Csyntax.Efield b i => typecheck_expr b
-  end.
-
-Fixpoint typecheck_exprlist (al: list Csyntax.expr): bool :=
-  match al with
-  | nil => true
-  | a1 :: a2 => typecheck_expr a1 && typecheck_exprlist a2
-  end.
-
-Definition typecheck_optexpr (opta: option Csyntax.expr): bool :=
-  match opta with
-  | None => true
-  | Some a => typecheck_expr a
-  end.
-
-Scheme expr_ind_2 := Induction for expr Sort Prop
-  with expr_descr_ind_2 := Induction for expr_descr Sort Prop.
-
-Lemma typecheck_expr_correct:
-  forall a, typecheck_expr a = true -> wt_expr env a.
-Proof.
-  apply (expr_ind_2 (fun a => typecheck_expr a = true -> wt_expr env a)
-                    (fun a => forall ty, typecheck_exprdescr a ty = true -> wt_expr env (Expr a ty)));
-  simpl; intros; TrueInv; try constructor; auto.
-  destruct (env!i). decEq; symmetry; apply eq_type_correct; auto.
-  discriminate.
-Qed.
-
-Lemma typecheck_exprlist_correct:
-  forall a, typecheck_exprlist a = true -> wt_exprlist env a.
-Proof.
-  induction a; simpl; intros.
-  constructor.
-  TrueInv. constructor; auto. apply typecheck_expr_correct; auto.
-Qed.
-
-Lemma typecheck_optexpr_correct:
-  forall a, typecheck_optexpr a = true -> wt_optexpr env a.
-Proof.
-  destruct a; simpl; intros.
-  constructor. apply typecheck_expr_correct; auto.
-  constructor.
-Qed.
-
-Fixpoint typecheck_stmt (s: Csyntax.statement) {struct s} : bool :=
-  match s with
-  | Csyntax.Sskip => true
-  | Csyntax.Sassign b c => typecheck_expr b && typecheck_expr c
-  | Csyntax.Scall a b cl => typecheck_optexpr a && typecheck_expr b && typecheck_exprlist cl
-  | Csyntax.Ssequence s1 s2 => typecheck_stmt s1 && typecheck_stmt s2
-  | Csyntax.Sifthenelse e s1 s2 =>
-      typecheck_expr e && typecheck_stmt s1 && typecheck_stmt s2
-  | Csyntax.Swhile e s1 => typecheck_expr e && typecheck_stmt s1
-  | Csyntax.Sdowhile e s1 => typecheck_expr e && typecheck_stmt s1
-  | Csyntax.Sfor e1 e2 e3 s1 =>
-      typecheck_stmt e1 && typecheck_expr e2 &&
-      typecheck_stmt e3 && typecheck_stmt s1
-  | Csyntax.Sbreak => true
-  | Csyntax.Scontinue => true
-  | Csyntax.Sreturn (Some e) => typecheck_expr e
-  | Csyntax.Sreturn None => true
-  | Csyntax.Sswitch e sl => typecheck_expr e && typecheck_lblstmts sl
-  | Csyntax.Slabel lbl s => typecheck_stmt s
-  | Csyntax.Sgoto lbl => true
-  end    
-
-with typecheck_lblstmts (sl: labeled_statements) {struct sl}: bool :=
-  match sl with
-  | LSdefault s => typecheck_stmt s
-  | LScase _ s rem => typecheck_stmt s && typecheck_lblstmts rem
-  end.
-
-Scheme stmt_ind_2 := Induction for statement Sort Prop
-  with lblstmts_ind_2 := Induction for labeled_statements Sort Prop.
-
-Lemma typecheck_stmt_correct:
-  forall s, typecheck_stmt s = true -> wt_stmt env s.
-Proof.
-  generalize typecheck_expr_correct; intro.
-  generalize typecheck_exprlist_correct; intro.
-  generalize typecheck_optexpr_correct; intro.
-  apply (stmt_ind_2 (fun s => typecheck_stmt s = true -> wt_stmt env s)
-                    (fun s => typecheck_lblstmts s = true -> wt_lblstmts env s));
-  simpl; intros; TrueInv; constructor; auto.
-Qed.
-
-End TYPECHECKING.
-
-Definition typecheck_function (env: typenv) (f: function) : bool :=
-  if list_norepet_dec ident_eq
-                      (var_names f.(fn_params) ++ var_names f.(fn_vars))
-  then typecheck_stmt (add_vars env (f.(fn_params) ++ f.(fn_vars)))
-                      f.(fn_body)
-  else false.
-
-Lemma typecheck_function_correct:
-  forall env f, typecheck_function env f = true -> wt_function env f.
-Proof.
-  unfold typecheck_function; intros; TrueInv.
-  constructor. auto. apply typecheck_stmt_correct; auto.
-Qed.
-
-Definition typecheck_fundef (main: ident) (env: typenv) (id_fd: ident * fundef) : bool :=
-  let (id, fd) := id_fd in
-  match fd with
-  | Internal f =>
-      typecheck_function env f
-  | External ef targs tres =>
-      let s := ef_sig ef in
-      list_eq_dec typ_eq s.(sig_args) (typlist_of_typelist targs) 
-      && opt_typ_eq s.(sig_res) (opttyp_of_type tres)
-  end &&
-  if ident_eq id main
-  then match type_of_fundef fd with
-       | Tfunction targs tres => eq_type tres (Tint I32 Signed)
-       | _ => false
-       end
-  else true.
-
-Lemma typecheck_fundef_correct:
-  forall main env id fd,
-  typecheck_fundef main env (id, fd) = true ->
-  wt_fundef env fd /\
-  (id = main ->
-   exists targs, type_of_fundef fd = Tfunction targs (Tint I32 Signed)).
-Proof.
-  intros. unfold typecheck_fundef in H; TrueInv.
-  split. 
-    destruct fd.
-    constructor. apply typecheck_function_correct; auto.
-    TrueInv. constructor; eapply proj_sumbool_true; eauto.
-  intro. destruct (ident_eq id main). 
-  destruct (type_of_fundef fd); try discriminate. 
-  exists t; decEq; auto. apply eq_type_correct; auto.
-  congruence.
-Qed.
-
-Definition typecheck_program (p: program) : bool :=
-  List.forallb (typecheck_fundef p.(prog_main) (global_typenv p))
-               p.(prog_funct).
-
-Lemma typecheck_program_correct:
-  forall p, typecheck_program p = true -> wt_program p.
-Proof.
-  unfold typecheck_program; intros. 
-  rewrite List.forallb_forall in H. 
-  constructor; intros.
-  exploit typecheck_fundef_correct; eauto. tauto. 
-  exploit typecheck_fundef_correct; eauto. tauto. 
-Qed.
diff --git a/cfrontend/PrintClight.ml b/cfrontend/PrintClight.ml
new file mode 100644
index 0000000..ad6887c
--- /dev/null
+++ b/cfrontend/PrintClight.ml
@@ -0,0 +1,365 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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 GNU General Public License as published by  *)
+(*  the Free Software Foundation, either version 2 of the License, or  *)
+(*  (at your option) any later version.  This file is also distributed *)
+(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** Pretty-printer for Clight *)
+
+open Format
+open Camlcoq
+open Datatypes
+open Values
+open AST
+open Csyntax
+open PrintCsyntax
+open Clight
+
+(* Collecting the names and fields of structs and unions *)
+
+module StructUnionSet = Set.Make(struct
+  type t = string * fieldlist
+  let compare (n1, _ : t) (n2, _ : t) = compare n1 n2
+end)
+
+let struct_unions = ref StructUnionSet.empty
+
+let register_struct_union id fld =
+  struct_unions := StructUnionSet.add (extern_atom id, fld) !struct_unions
+
+(* Naming temporaries *)
+
+let temp_name (id: ident) =
+  Printf.sprintf "$%ld" (camlint_of_positive id)
+
+(* Declarator (identifier + type) -- reuse from PrintCsyntax *)
+
+(* Precedences and associativity (H&S section 7.2) *)
+
+type associativity = LtoR | RtoL | NA
+
+let rec precedence = function
+  | Evar _ -> (16, NA)
+  | Etempvar _ -> (16, NA)
+  | Ederef _ -> (15, RtoL)
+  | Efield _ -> (16, LtoR)
+  | Econst_int _ -> (16, NA)
+  | Econst_float _ -> (16, NA)
+  | Esizeof _ -> (15, RtoL)
+  | Eunop _ -> (15, RtoL)
+  | Eaddrof _ -> (15, RtoL)
+  | Ecast _ -> (14, RtoL)
+  | Ebinop((Omul|Odiv|Omod), _, _, _) -> (13, LtoR)
+  | Ebinop((Oadd|Osub), _, _, _) -> (12, LtoR)
+  | Ebinop((Oshl|Oshr), _, _, _) -> (11, LtoR)
+  | Ebinop((Olt|Ogt|Ole|Oge), _, _, _) -> (10, LtoR)
+  | Ebinop((Oeq|One), _, _, _) -> (9, LtoR)
+  | Ebinop(Oand, _, _, _) -> (8, LtoR)
+  | Ebinop(Oxor, _, _, _) -> (7, LtoR)
+  | Ebinop(Oor, _, _, _) -> (6, LtoR)
+  | Econdition _ -> (3, RtoL)
+
+(* Expressions *)
+
+let rec expr p (prec, e) =
+  let (prec', assoc) = precedence e in
+  let (prec1, prec2) =
+    if assoc = LtoR
+    then (prec', prec' + 1)
+    else (prec' + 1, prec') in
+  if prec' < prec 
+  then fprintf p "@[<hov 2>("
+  else fprintf p "@[<hov 2>";
+  begin match e with
+  | Evar(id, _) ->
+      fprintf p "%s" (extern_atom id)
+  | Etempvar(id, _) ->
+      fprintf p "%s" (temp_name id)
+  | Ederef(a1, _) ->
+      fprintf p "*%a" expr (prec', a1)
+  | Efield(a1, f, _) ->
+      fprintf p "%a.%s" expr (prec', a1) (extern_atom f)
+  | Econst_int(n, _) ->
+      fprintf p "%ld" (camlint_of_coqint n)
+  | Econst_float(f, _) ->
+      fprintf p "%F" f
+  | Esizeof(ty, _) ->
+      fprintf p "sizeof(%s)" (name_type ty)
+  | Eunop(op, a1, _) ->
+      fprintf p "%s%a" (name_unop op) expr (prec', a1)
+  | Eaddrof(a1, _) ->
+      fprintf p "&%a" expr (prec', a1)
+  | Ebinop(op, a1, a2, _) ->
+      fprintf p "%a@ %s %a"
+                 expr (prec1, a1) (name_binop op) expr (prec2, a2)
+  | Ecast(a1, ty) ->
+      fprintf p "(%s) %a" (name_type ty) expr (prec', a1)
+  | Econdition(a1, a2, a3, _) ->
+      fprintf p "%a@ ? %a@ : %a" expr (4, a1) expr (4, a2) expr (4, a3)
+  end;
+  if prec' < prec then fprintf p ")@]" else fprintf p "@]"
+
+let print_expr p e = expr p (0, e)
+
+let rec print_expr_list p (first, rl) =
+  match rl with
+  | [] -> ()
+  | r :: rl ->
+      if not first then fprintf p ",@ ";
+      expr p (2, r);
+      print_expr_list p (false, rl)
+
+(* Statements *)
+
+let rec print_stmt p s =
+  match s with
+  | Sskip ->
+      fprintf p "/*skip*/;"
+  | Sassign(e1, e2) ->
+      fprintf p "@[<hv 2>%a =@ %a;@]" print_expr e1 print_expr e2
+  | Sset(id, e2) ->
+      fprintf p "@[<hv 2>%s =@ %a;@]" (temp_name id) print_expr e2
+  | Scall(None, e1, el) ->
+      fprintf p "@[<hv 2>%a@,(@[<hov 0>%a@]);@]"
+                print_expr e1
+                print_expr_list (true, el)
+  | Scall(Some id, e1, el) ->
+      fprintf p "@[<hv 2>%s =@ %a@,(@[<hov 0>%a@]);@]"
+                (temp_name id)
+                print_expr e1
+                print_expr_list (true, el)
+  | Ssequence(Sskip, s2) ->
+      print_stmt p s2
+  | Ssequence(s1, Sskip) ->
+      print_stmt p s1
+  | Ssequence(s1, s2) ->
+      fprintf p "%a@ %a" print_stmt s1 print_stmt s2
+  | Sifthenelse(e, s1, Sskip) ->
+      fprintf p "@[<v 2>if (%a) {@ %a@;<0 -2>}@]"
+              print_expr e
+              print_stmt s1
+  | Sifthenelse(e, Sskip, s2) ->
+      fprintf p "@[<v 2>if (! %a) {@ %a@;<0 -2>}@]"
+              expr (15, e)
+              print_stmt s2
+  | Sifthenelse(e, s1, s2) ->
+      fprintf p "@[<v 2>if (%a) {@ %a@;<0 -2>} else {@ %a@;<0 -2>}@]"
+              print_expr e
+              print_stmt s1
+              print_stmt s2
+  | Swhile(e, s) ->
+      fprintf p "@[<v 2>while (%a) {@ %a@;<0 -2>}@]"
+              print_expr e
+              print_stmt s
+  | Sdowhile(e, s) ->
+      fprintf p "@[<v 2>do {@ %a@;<0 -2>} while(%a);@]"
+              print_stmt s
+              print_expr e
+  | Sfor'(e, s_iter, s_body) ->
+      fprintf p "@[<v 2>for (@[<hv 0>;@ %a;@ %a) {@]@ %a@;<0 -2>}@]"
+              print_expr e
+              print_stmt_for s_iter
+              print_stmt s_body
+  | Sbreak ->
+      fprintf p "break;"
+  | Scontinue ->
+      fprintf p "continue;"
+  | Sswitch(e, cases) ->
+      fprintf p "@[<v 2>switch (%a) {@ %a@;<0 -2>}@]"
+              print_expr e
+              print_cases cases
+  | Sreturn None ->
+      fprintf p "return;"
+  | Sreturn (Some e) ->
+      fprintf p "return %a;" print_expr e
+  | Slabel(lbl, s1) ->
+      fprintf p "%s:@ %a" (extern_atom lbl) print_stmt s1
+  | Sgoto lbl ->
+      fprintf p "goto %s;" (extern_atom lbl)
+
+and print_cases p cases =
+  match cases with
+  | LSdefault Sskip ->
+      ()
+  | LSdefault s ->
+      fprintf p "@[<v 2>default:@ %a@]" print_stmt s
+  | LScase(lbl, Sskip, rem) ->
+      fprintf p "case %ld:@ %a"
+              (camlint_of_coqint lbl)
+              print_cases rem
+  | LScase(lbl, s, rem) ->
+      fprintf p "@[<v 2>case %ld:@ %a@]@ %a"
+              (camlint_of_coqint lbl)
+              print_stmt s
+              print_cases rem
+
+and print_stmt_for p s =
+  match s with
+  | Sskip ->
+      fprintf p "/*nothing*/"
+  | Sassign(e1, e2) ->
+      fprintf p "%a = %a" print_expr e1 print_expr e2
+  | Sset(id, e2) ->
+      fprintf p "%s = %a" (temp_name id) print_expr e2
+  | Ssequence(s1, s2) ->
+      fprintf p "%a, %a" print_stmt_for s1 print_stmt_for s2
+  | Scall(None, e1, el) ->
+      fprintf p "@[<hv 2>%a@,(@[<hov 0>%a@])@]"
+                print_expr e1
+                print_expr_list (true, el)
+  | Scall(Some id, e1, el) ->
+      fprintf p "@[<hv 2>%s =@ %a@,(@[<hov 0>%a@])@]"
+                (temp_name id)
+                print_expr e1
+                print_expr_list (true, el)
+  | _ ->
+      fprintf p "({ %a })" print_stmt s
+
+let print_function p id f =
+  fprintf p "%s@ "
+            (name_cdecl (name_function_parameters (extern_atom id)
+                                                  f.fn_params)
+                        f.fn_return);
+  fprintf p "@[<v 2>{@ ";
+  List.iter
+    (fun (Coq_pair(id, ty)) ->
+      fprintf p "%s;@ " (name_cdecl (extern_atom id) ty))
+    f.fn_vars;
+  List.iter
+    (fun (Coq_pair(id, ty)) ->
+      fprintf p "register %s;@ " (name_cdecl (temp_name id) ty))
+    f.fn_temps;
+  print_stmt p f.fn_body;
+  fprintf p "@;<0 -2>}@]@ @ "
+
+let print_fundef p (Coq_pair(id, fd)) =
+  match fd with
+  | External(_, args, res) ->
+      fprintf p "extern %s;@ @ "
+                (name_cdecl (extern_atom id) (Tfunction(args, res)))
+  | Internal f ->
+      print_function p id f
+
+(* Collect struct and union types *)
+
+let rec collect_type = function
+  | Tvoid -> ()
+  | Tint(sz, sg) -> ()
+  | Tfloat sz -> ()
+  | Tpointer t -> collect_type t
+  | Tarray(t, n) -> collect_type t
+  | Tfunction(args, res) -> collect_type_list args; collect_type res
+  | Tstruct(id, fld) -> register_struct_union id fld; collect_fields fld
+  | Tunion(id, fld) -> register_struct_union id fld; collect_fields fld
+  | Tcomp_ptr _ -> ()
+
+and collect_type_list = function
+  | Tnil -> ()
+  | Tcons(hd, tl) -> collect_type hd; collect_type_list tl
+
+and collect_fields = function
+  | Fnil -> ()
+  | Fcons(id, hd, tl) -> collect_type hd; collect_fields tl
+
+let rec collect_expr = function
+  | Econst_int _ -> ()
+  | Econst_float _ -> ()
+  | Evar _ -> ()
+  | Etempvar _ -> ()
+  | Ederef(r, _) -> collect_expr r
+  | Efield(l, _, _) -> collect_expr l
+  | Eaddrof(l, _) -> collect_expr l
+  | Eunop(_, r, _) -> collect_expr r
+  | Ebinop(_, r1, r2, _) -> collect_expr r1; collect_expr r2
+  | Ecast(r, _) -> collect_expr r
+  | Econdition(r1, r2, r3, _) -> 
+      collect_expr r1; collect_expr r2; collect_expr r3
+  | Esizeof _ -> ()
+
+let rec collect_exprlist = function
+  | [] -> ()
+  | r1 :: rl -> collect_expr r1; collect_exprlist rl
+
+let rec collect_stmt = function
+  | Sskip -> ()
+  | Sassign(e1, e2) -> collect_expr e1; collect_expr e2
+  | Sset(id, e2) -> collect_expr e2
+  | Scall(optid, e1, el) -> collect_expr e1; collect_exprlist el
+  | Ssequence(s1, s2) -> collect_stmt s1; collect_stmt s2
+  | Sifthenelse(e, s1, s2) -> collect_expr e; collect_stmt s1; collect_stmt s2
+  | Swhile(e, s) -> collect_expr e; collect_stmt s
+  | Sdowhile(e, s) -> collect_stmt s; collect_expr e
+  | Sfor'(e, s_iter, s_body) ->
+      collect_expr e; collect_stmt s_iter; collect_stmt s_body
+  | Sbreak -> ()
+  | Scontinue -> ()
+  | Sswitch(e, cases) -> collect_expr e; collect_cases cases
+  | Sreturn None -> ()
+  | Sreturn (Some e) -> collect_expr e
+  | Slabel(lbl, s) -> collect_stmt s
+  | Sgoto lbl -> ()
+
+and collect_cases = function
+  | LSdefault s -> collect_stmt s
+  | LScase(lbl, s, rem) -> collect_stmt s; collect_cases rem
+
+let collect_function f =
+  collect_type f.fn_return;
+  List.iter (fun (Coq_pair(id, ty)) -> collect_type ty) f.fn_params;
+  List.iter (fun (Coq_pair(id, ty)) -> collect_type ty) f.fn_vars;
+  List.iter (fun (Coq_pair(id, ty)) -> collect_type ty) f.fn_temps;
+  collect_stmt f.fn_body
+
+let collect_fundef (Coq_pair(id, fd)) =
+  match fd with
+  | External(_, args, res) -> collect_type_list args; collect_type res
+  | Internal f -> collect_function f
+
+let collect_globvar (Coq_pair(id, v)) =
+  collect_type v.gvar_info
+
+let collect_program p =
+  List.iter collect_globvar p.prog_vars;
+  List.iter collect_fundef p.prog_funct
+
+let declare_struct_or_union p (name, fld) =
+  fprintf p "%s;@ @ " name
+
+let print_struct_or_union p (name, fld) =
+  fprintf p "@[<v 2>%s {" name;
+  let rec print_fields = function
+  | Fnil -> ()
+  | Fcons(id, ty, rem) ->
+      fprintf p "@ %s;" (name_cdecl (extern_atom id) ty);
+      print_fields rem in
+  print_fields fld;
+  fprintf p "@;<0 -2>};@]@ "
+
+let print_program p prog =
+  struct_unions := StructUnionSet.empty;
+  collect_program prog;
+  fprintf p "@[<v 0>";
+  StructUnionSet.iter (declare_struct_or_union p) !struct_unions;
+  StructUnionSet.iter (print_struct_or_union p) !struct_unions;
+  List.iter (print_globvar p) prog.prog_vars;
+  List.iter (print_fundef p) prog.prog_funct;
+  fprintf p "@]@."
+
+let destination : string option ref = ref None
+
+let print_if prog =
+  match !destination with
+  | None -> ()
+  | Some f ->
+      let oc = open_out f in
+      print_program (formatter_of_out_channel oc) prog;
+      close_out oc
diff --git a/cfrontend/PrintCsyntax.ml b/cfrontend/PrintCsyntax.ml
index 3b5dbc5..61599cf 100644
--- a/cfrontend/PrintCsyntax.ml
+++ b/cfrontend/PrintCsyntax.ml
@@ -18,6 +18,7 @@
 open Format
 open Camlcoq
 open Datatypes
+open Values
 open AST
 open Csyntax
 
@@ -25,7 +26,6 @@ let name_unop = function
   | Onotbool -> "!"
   | Onotint  -> "~"
   | Oneg     -> "-"
-  | Ofabs    -> "__builtin_fabs"
 
 let name_binop = function
   | Oadd -> "+"
@@ -124,108 +124,112 @@ let rec name_cdecl id ty =
 
 let name_type ty = name_cdecl "" ty
 
+(* Precedences and associativity (H&S section 7.2) *)
+
+type associativity = LtoR | RtoL | NA
+
+let rec precedence = function
+  | Eloc _ -> assert false
+  | Evar _ -> (16, NA)
+  | Ederef _ -> (15, RtoL)
+  | Efield _ -> (16, LtoR)
+  | Eval _ -> (16, NA)
+  | Evalof(l, _) -> precedence l
+  | Esizeof _ -> (15, RtoL)
+  | Ecall _ -> (16, LtoR)
+  | Epostincr _ -> (16, LtoR)
+  | Eunop _ -> (15, RtoL)
+  | Eaddrof _ -> (15, RtoL)
+  | Ecast _ -> (14, RtoL)
+  | Ebinop((Omul|Odiv|Omod), _, _, _) -> (13, LtoR)
+  | Ebinop((Oadd|Osub), _, _, _) -> (12, LtoR)
+  | Ebinop((Oshl|Oshr), _, _, _) -> (11, LtoR)
+  | Ebinop((Olt|Ogt|Ole|Oge), _, _, _) -> (10, LtoR)
+  | Ebinop((Oeq|One), _, _, _) -> (9, LtoR)
+  | Ebinop(Oand, _, _, _) -> (8, LtoR)
+  | Ebinop(Oxor, _, _, _) -> (7, LtoR)
+  | Ebinop(Oor, _, _, _) -> (6, LtoR)
+  | Econdition _ -> (3, RtoL)
+  | Eassign _ -> (2, RtoL)
+  | Eassignop _ -> (2, RtoL)
+  | Ecomma _ -> (1, LtoR)
+  | Eparen _ -> assert false
+
 (* Expressions *)
 
-let parenthesis_level (Expr (e, ty)) =
-  match e with
-  | Econst_int _ -> 0
-  | Econst_float _ -> 0
-  | Evar _ -> 0
-  | Eunop(Ofabs, _) -> -10 (* force parentheses around argument *)
-  | Eunop(_, _) -> 30
-  | Ederef _ -> 20
-  | Eaddrof _ -> 30
-  | Ebinop(op, _, _) ->
-      begin match op with
-      | Oand | Oor | Oxor -> 75
-      | Oeq | One | Olt | Ogt | Ole | Oge -> 70
-      | Oadd | Osub | Oshl | Oshr -> 60
-      | Omul | Odiv | Omod -> 40
-      end
-  | Ecast _ -> 30
-  | Econdition(_, _, _) -> 80
-  | Eandbool(_, _) -> 80
-  | Eorbool(_, _) -> 80
-  | Esizeof _ -> 20
-  | Efield _ -> 20
-
-let rec print_expr p (Expr (eb, ty) as e) =
-  let level = parenthesis_level e in
-  match eb with
-  | Econst_int n ->
+let rec expr p (prec, e) =
+  let (prec', assoc) = precedence e in
+  let (prec1, prec2) =
+    if assoc = LtoR
+    then (prec', prec' + 1)
+    else (prec' + 1, prec') in
+  if prec' < prec 
+  then fprintf p "@[<hov 2>("
+  else fprintf p "@[<hov 2>";
+  begin match e with
+  | Eloc _ ->
+      assert false
+  | Evar(id, _) ->
+      fprintf p "%s" (extern_atom id)
+  | Ederef(a1, _) ->
+      fprintf p "*%a" expr (prec', a1)
+  | Efield(a1, f, _) ->
+      fprintf p "%a.%s" expr (prec', a1) (extern_atom f)
+  | Evalof(l, _) ->
+      expr p (prec, l)
+  | Eval(Vint n, _) ->
       fprintf p "%ld" (camlint_of_coqint n)
-  | Econst_float f ->
+  | Eval(Vfloat f, _) ->
       fprintf p "%F" f
-  | Evar id ->
-      fprintf p "%s" (extern_atom id)
-  | Eunop(op, e1) ->
-      fprintf p "%s%a" (name_unop op) print_expr_prec (level, e1)
-  | Ederef (Expr (Ebinop(Oadd, e1, e2), _)) ->
-      fprintf p "@[<hov 2>%a@,[%a]@]"
-                print_expr_prec (level, e1)
-                print_expr_prec (level, e2)
-  | Ederef (Expr (Efield(e1, id), _)) ->
-      fprintf p "%a->%s" print_expr_prec (level, e1) (extern_atom id)
-  | Ederef e ->
-      fprintf p "*%a" print_expr_prec (level, e)
-  | Eaddrof e ->
-      fprintf p "&%a" print_expr_prec (level, e)
-  | Ebinop(op, e1, e2) ->
-      fprintf p "@[<hov 0>%a@ %s %a@]"
-                print_expr_prec (level, e1)
-                (name_binop op)
-                print_expr_prec (level, e2)
-  | Ecast(ty, e1) ->
-      fprintf p "@[<hov 2>(%s)@,%a@]"
-                (name_type ty)
-                print_expr_prec (level, e1)
-  | Econdition(e1, e2, e3) ->
-      fprintf p "@[<hov 0>%a@ ? %a@ : %a@]"
-                print_expr_prec (level, e1)
-                print_expr_prec (level, e2)
-                print_expr_prec (level, e3)
-  | Eandbool(e1, e2) ->
-      fprintf p "@[<hov 0>%a@ && %a@]"
-                print_expr_prec (level, e1)
-                print_expr_prec (level, e2)
-  | Eorbool(e1, e2) ->
-      fprintf p "@[<hov 0>%a@ || %a@]"
-                print_expr_prec (level, e1)
-                print_expr_prec (level, e2)
-  | Esizeof ty ->
+  | Eval(_, _) ->
+      assert false
+  | Esizeof(ty, _) ->
       fprintf p "sizeof(%s)" (name_type ty)
-  | Efield(e1, id) ->
-      fprintf p "%a.%s" print_expr_prec (level, e1) (extern_atom id)
-
-and print_expr_prec p (context_prec, e) =
-  let this_prec = parenthesis_level e in
-  if this_prec >= context_prec
-  then fprintf p "(%a)" print_expr e
-  else print_expr p e
-
-let rec print_expr_list p (first, el) =
-  match el with
-  | [] -> ()
-  | e1 :: et ->
+  | Eunop(op, a1, _) ->
+      fprintf p "%s%a" (name_unop op) expr (prec', a1)
+  | Eaddrof(a1, _) ->
+      fprintf p "&%a" expr (prec', a1)
+  | Epostincr(id, a1, _) ->
+      fprintf p "%a%s" expr (prec', a1)
+                        (match id with Incr -> "++" | Decr -> "--")
+  | Ebinop(op, a1, a2, _) ->
+      fprintf p "%a@ %s %a"
+                 expr (prec1, a1) (name_binop op) expr (prec2, a2)
+  | Ecast(a1, ty) ->
+      fprintf p "(%s) %a" (name_type ty) expr (prec', a1)
+  | Eassign(a1, a2, _) ->
+      fprintf p "%a =@ %a" expr (prec1, a1) expr (prec2, a2)
+  | Eassignop(op, a1, a2, _, _) ->
+      fprintf p "%a %s=@ %a" expr (prec1, a1) (name_binop op) expr (prec2, a2)
+  | Econdition(a1, a2, a3, _) ->
+      fprintf p "%a@ ? %a@ : %a" expr (4, a1) expr (4, a2) expr (4, a3)
+  | Ecomma(a1, a2, _) ->
+      fprintf p "%a,@ %a" expr (prec1, a1) expr (prec2, a2)
+  | Ecall(a1, al, _) ->
+      fprintf p "%a@[<hov 1>(%a)@]" expr (prec', a1) exprlist (true, al)
+  | Eparen _ ->
+      assert false
+  end;
+  if prec' < prec then fprintf p ")@]" else fprintf p "@]"
+
+and exprlist p (first, rl) =
+  match rl with
+  | Enil -> ()
+  | Econs(r, rl) ->
       if not first then fprintf p ",@ ";
-      print_expr p e1;
-      print_expr_list p (false, et)
+      expr p (2, r);
+      exprlist p (false, rl)
+
+let print_expr p e = expr p (0, e)
+
+(* Statements *)
 
 let rec print_stmt p s =
   match s with
   | Sskip ->
       fprintf p "/*skip*/;"
-  | Sassign(e1, e2) ->
-      fprintf p "@[<hv 2>%a =@ %a;@]" print_expr e1 print_expr e2
-  | Scall(None, e1, el) ->
-      fprintf p "@[<hv 2>%a@,(@[<hov 0>%a@]);@]"
-                print_expr e1
-                print_expr_list (true, el)
-  | Scall(Some lhs, e1, el) ->
-      fprintf p "@[<hv 2>%a =@ %a@,(@[<hov 0>%a@]);@]"
-                print_expr lhs
-                print_expr e1
-                print_expr_list (true, el)
+  | Sdo e ->
+      fprintf p "%a;" print_expr e
   | Ssequence(s1, s2) ->
       fprintf p "%a@ %a" print_stmt s1 print_stmt s2
   | Sifthenelse(e, s1, Sskip) ->
@@ -288,19 +292,10 @@ and print_stmt_for p s =
   match s with
   | Sskip ->
       fprintf p "/*nothing*/"
-  | Sassign(e1, e2) ->
-      fprintf p "%a = %a" print_expr e1 print_expr e2
+  | Sdo e ->
+      print_expr p e
   | Ssequence(s1, s2) ->
       fprintf p "%a, %a" print_stmt_for s1 print_stmt_for s2
-  | Scall(None, e1, el) ->
-      fprintf p "@[<hv 2>%a@,(@[<hov 0>%a@])@]"
-                print_expr e1
-                print_expr_list (true, el)
-  | Scall(Some lhs, e1, el) ->
-      fprintf p "@[<hv 2>%a =@ %a@,(@[<hov 0>%a@])@]"
-                print_expr lhs
-                print_expr e1
-                print_expr_list (true, el)
   | _ ->
       fprintf p "({ %a })" print_stmt s
 
@@ -422,31 +417,34 @@ and collect_fields = function
   | Fnil -> ()
   | Fcons(id, hd, tl) -> collect_type hd; collect_fields tl
 
-let rec collect_expr (Expr(ed, ty)) =
-  match ed with
-  | Econst_int n -> ()
-  | Econst_float f -> ()
-  | Evar id -> ()
-  | Eunop(op, e1) -> collect_expr e1
-  | Ederef e -> collect_expr e
-  | Eaddrof e -> collect_expr e
-  | Ebinop(op, e1, e2) -> collect_expr e1; collect_expr e2
-  | Ecast(ty, e1) -> collect_type ty; collect_expr e1
-  | Econdition(e1, e2, e3) -> collect_expr e1; collect_expr e2; collect_expr e3
-  | Eandbool(e1, e2) -> collect_expr e1; collect_expr e2
-  | Eorbool(e1, e2) -> collect_expr e1; collect_expr e2
-  | Esizeof ty -> collect_type ty
-  | Efield(e1, id) -> collect_expr e1
-
-let rec collect_expr_list = function
-  | [] -> ()
-  | hd :: tl -> collect_expr hd; collect_expr_list tl
+let rec collect_expr = function
+  | Eloc _ -> assert false
+  | Evar _ -> ()
+  | Ederef(r, _) -> collect_expr r
+  | Efield(l, _, _) -> collect_expr l
+  | Eval _ -> ()
+  | Evalof(l, _) -> collect_expr l
+  | Eaddrof(l, _) -> collect_expr l
+  | Eunop(_, r, _) -> collect_expr r
+  | Ebinop(_, r1, r2, _) -> collect_expr r1; collect_expr r2
+  | Ecast(r, _) -> collect_expr r
+  | Econdition(r1, r2, r3, _) -> 
+      collect_expr r1; collect_expr r2; collect_expr r3
+  | Esizeof _ -> ()
+  | Eassign(l, r, _) -> collect_expr l; collect_expr r
+  | Eassignop(_, l, r, _, _) -> collect_expr l; collect_expr r
+  | Epostincr(_, l, _) -> collect_expr l
+  | Ecomma(r1, r2, _) -> collect_expr r1; collect_expr r2
+  | Ecall(r1, rl, _) ->  collect_expr r1; collect_exprlist rl
+  | Eparen _ -> assert false
+
+and collect_exprlist = function
+  | Enil -> ()
+  | Econs(r1, rl) ->  collect_expr r1; collect_exprlist rl
 
 let rec collect_stmt = function
   | Sskip -> ()
-  | Sassign(e1, e2) -> collect_expr e1; collect_expr e2
-  | Scall(None, e1, el) -> collect_expr e1; collect_expr_list el
-  | Scall(Some lhs, e1, el) -> collect_expr lhs; collect_expr e1; collect_expr_list el
+  | Sdo e -> collect_expr e
   | Ssequence(s1, s2) -> collect_stmt s1; collect_stmt s2
   | Sifthenelse(e, s1, s2) -> collect_expr e; collect_stmt s1; collect_stmt s2
   | Swhile(e, s) -> collect_expr e; collect_stmt s
@@ -507,4 +505,12 @@ let print_program p prog =
   List.iter (print_fundef p) prog.prog_funct;
   fprintf p "@]@."
 
+let destination : string option ref = ref None
 
+let print_if prog =
+  match !destination with
+  | None -> ()
+  | Some f ->
+      let oc = open_out f in
+      print_program (formatter_of_out_channel oc) prog;
+      close_out oc
diff --git a/cfrontend/SimplExpr.v b/cfrontend/SimplExpr.v
new file mode 100644
index 0000000..a10e55e
--- /dev/null
+++ b/cfrontend/SimplExpr.v
@@ -0,0 +1,403 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** Translation from Compcert C to Clight. 
+    Side effects are pulled out of Compcert C expressions. *)
+
+Require Import Coqlib.
+Require Import Errors.
+Require Import Integers.
+Require Import Floats.
+Require Import Values.
+Require Import AST.
+Require Import Csyntax.
+Require Import Clight.
+
+Module C := Csyntax.
+
+Open Local Scope string_scope.
+
+(** State and error monad for generating fresh identifiers. *)
+
+Record generator : Type := mkgenerator {
+  gen_next: ident;
+  gen_trail: list (ident * type)
+}.
+
+Inductive result (A: Type) (g: generator) : Type :=
+  | Err: Errors.errmsg -> result A g
+  | Res: A -> forall (g': generator), Ple (gen_next g) (gen_next g') -> result A g.
+
+Implicit Arguments Err [A g].
+Implicit Arguments Res [A g].
+
+Definition mon (A: Type) := forall (g: generator), result A g.
+
+Definition ret (A: Type) (x: A) : mon A :=
+  fun g => Res x g (Ple_refl (gen_next g)).
+
+Implicit Arguments ret [A].
+
+Definition error (A: Type) (msg: Errors.errmsg) : mon A :=
+  fun g => Err msg.
+
+Implicit Arguments error [A].
+
+Definition bind (A B: Type) (x: mon A) (f: A -> mon B) : mon B :=
+  fun g =>
+    match x g with
+      | Err msg => Err msg
+      | Res a g' i =>
+          match f a g' with
+          | Err msg => Err msg
+          | Res b g'' i' => Res b g'' (Ple_trans _ _ _ i i')
+      end
+    end.
+
+Implicit Arguments bind [A B].
+
+Definition bind2 (A B C: Type) (x: mon (A * B)) (f: A -> B -> mon C) : mon C :=
+  bind x (fun p => f (fst p) (snd p)).
+
+Implicit Arguments bind2 [A B C].
+
+Notation "'do' X <- A ; B" := (bind A (fun X => B))
+   (at level 200, X ident, A at level 100, B at level 200)
+   : gensym_monad_scope.
+Notation "'do' ( X , Y ) <- A ; B" := (bind2 A (fun X Y => B))
+   (at level 200, X ident, Y ident, A at level 100, B at level 200)
+   : gensym_monad_scope.
+
+Local Open Scope gensym_monad_scope.
+
+Definition initial_generator : generator := 
+  mkgenerator 1%positive nil.
+
+Definition gensym (ty: type): mon ident :=
+  fun (g: generator) => 
+    Res (gen_next g)
+        (mkgenerator (Psucc (gen_next g)) ((gen_next g, ty) :: gen_trail g))
+        (Ple_succ (gen_next g)).
+
+(** Construct a sequence from a list of statements.  To facilitate the
+   proof, the sequence is nested to the left and starts with a [Sskip]. *)
+
+Fixpoint makeseq_rec (s: statement) (l: list statement) : statement :=
+  match l with
+  | nil => s
+  | s' :: l' => makeseq_rec (Ssequence s s') l'
+  end.
+
+Definition makeseq (l: list statement) : statement :=
+  makeseq_rec Sskip l.
+
+(** Smart constructor for [if ... then ... else]. *)
+
+Function makeif (a: expr) (s1 s2: statement) : statement :=
+  match a with
+  | Econst_int n _ => if Int.eq_dec n Int.zero then s2 else s1
+  | _              => Sifthenelse a s1 s2
+  end.
+
+(** Translation of pre/post-increment/decrement. *)
+
+Definition transl_incrdecr (id: incr_or_decr) (a: expr) (ty: type) : expr :=
+  match id with
+  | Incr => Ebinop Oadd a (Econst_int Int.one (Tint I32 Signed)) (typeconv ty)
+  | Decr => Ebinop Osub a (Econst_int Int.one (Tint I32 Signed)) (typeconv ty)
+  end.
+
+(** Translation of expressions.  Return a pair [(sl, a)] of
+    a list of statements [sl] and a pure expression [a].
+- If the [dst] argument is [For_val], the statements [sl]
+  perform the side effects of the original expression,
+  and [a] evaluates to the same value as the original expression.
+- If the [dst] argument is [For_effects], the statements [sl]
+  perform the side effects of the original expression,
+  and [a] is meaningless.
+- If the [dst] argument is [For_test s1 s2], the statements [sl]
+  perform the side effects of the original expression, followed
+  by an [if (v) { s1 } else { s2 }] test, where [v] is the value
+  of the original expression.  [a] is meaningless.
+*)
+
+Inductive purpose : Type := 
+  | For_val
+  | For_effects
+  | For_test (s1 s2: statement).
+
+Definition dummy_expr := Econst_int Int.zero (Tint I32 Signed).
+
+Definition finish (dst: purpose) (sl: list statement) (a: expr) :=
+  match dst with
+  | For_val => (sl, a)
+  | For_effects => (sl, a)
+  | For_test s1 s2 => (sl ++ makeif a s1 s2 :: nil, a)
+  end.
+
+Fixpoint transl_expr (dst: purpose) (a: C.expr) : mon (list statement * expr) :=
+  match a with
+  | C.Eloc b ofs ty =>
+      error (msg "SimplExpr.transl_expr: C.Eloc")
+  | C.Evar x ty =>
+      ret (finish dst nil (Evar x ty))
+  | C.Ederef r ty =>
+      do (sl, a) <- transl_expr For_val r;
+      ret (finish dst sl (Ederef a ty))
+  | C.Efield l1 f ty =>
+      do (sl, a) <- transl_expr For_val l1;
+      ret (finish dst sl (Efield a f ty))
+  | C.Eval (Vint n) ty =>
+      ret (finish dst nil (Econst_int n ty))
+  | C.Eval (Vfloat n) ty =>
+      ret (finish dst nil (Econst_float n ty))
+  | C.Eval _ ty =>
+      error (msg "SimplExpr.transl_expr: val")
+  | C.Esizeof ty' ty =>
+      ret (finish dst nil (Esizeof ty' ty))
+  | C.Evalof l ty =>
+      do (sl, a) <- transl_expr For_val l;
+      ret (finish dst sl a)
+  | C.Eaddrof l ty =>
+      do (sl, a) <- transl_expr For_val l;
+      ret (finish dst sl (Eaddrof a ty))
+  | C.Eunop op r1 ty =>
+      do (sl1, a1) <- transl_expr For_val r1;
+      ret (finish dst sl1 (Eunop op a1 ty))
+  | C.Ebinop op r1 r2 ty =>
+      do (sl1, a1) <- transl_expr For_val r1;
+      do (sl2, a2) <- transl_expr For_val r2;
+      ret (finish dst (sl1 ++ sl2) (Ebinop op a1 a2 ty))
+  | C.Ecast r1 ty =>
+      do (sl1, a1) <- transl_expr For_val r1;
+      ret (finish dst sl1 (Ecast a1 ty))
+  | C.Econdition r1 r2 r3 ty =>
+      do (sl1, a1) <- transl_expr For_val r1;
+      do (sl2, a2) <- transl_expr dst r2;
+      do (sl3, a3) <- transl_expr dst r3;
+      match dst with
+      | For_val =>
+          do t <- gensym ty;
+          ret (sl1 ++ makeif a1 (Ssequence (makeseq sl2) (Sset t a2))
+                                (Ssequence (makeseq sl3) (Sset t a3)) :: nil,
+               Etempvar t ty)
+      | For_effects | For_test _ _ =>
+          ret (sl1 ++ makeif a1 (makeseq sl2) (makeseq sl3) :: nil,
+               dummy_expr)
+      end
+  | C.Eassign l1 r2 ty =>
+      do (sl1, a1) <- transl_expr For_val l1;
+      do (sl2, a2) <- transl_expr For_val r2;
+      let ty1 := C.typeof l1 in
+      let ty2 := C.typeof r2 in
+      match dst with
+      | For_val | For_test _ _ =>
+          do t <- gensym ty2;
+          ret (finish dst 
+                 (sl1 ++ sl2 ++ Sset t a2 :: Sassign a1 (Etempvar t ty2) :: nil)
+                 (Ecast (Etempvar t ty2) ty1))
+      | For_effects =>
+          ret (sl1 ++ sl2 ++ Sassign a1 a2 :: nil,
+               dummy_expr)
+      end
+  | C.Eassignop op l1 r2 tyres ty =>
+      do (sl1, a1) <- transl_expr For_val l1;
+      do (sl2, a2) <- transl_expr For_val r2;
+      let ty1 := C.typeof l1 in
+      match dst with
+      | For_val | For_test _ _ =>
+          do t <- gensym tyres;
+          ret (finish dst
+                 (sl1 ++ sl2 ++
+                  Sset t (Ebinop op a1 a2 tyres) ::
+                  Sassign a1 (Etempvar t tyres) :: nil)
+                 (Ecast (Etempvar t tyres) ty1))
+      | For_effects =>
+          ret (sl1 ++ sl2 ++ Sassign a1 (Ebinop op a1 a2 tyres) :: nil,
+               dummy_expr)
+      end
+  | C.Epostincr id l1 ty =>
+      do (sl1, a1) <- transl_expr For_val l1;
+      let ty1 := C.typeof l1 in
+      match dst with
+      | For_val | For_test _ _ =>
+          do t <- gensym ty1;
+          ret (finish dst
+                 (sl1 ++ Sset t a1 ::
+                  Sassign a1 (transl_incrdecr id (Etempvar t ty1) ty1) :: nil)
+                 (Etempvar t ty1))
+      | For_effects =>
+          ret (sl1 ++ Sassign a1 (transl_incrdecr id a1 ty1) :: nil,
+               dummy_expr)
+      end
+  | C.Ecomma r1 r2 ty =>
+      do (sl1, a1) <- transl_expr For_effects r1;
+      do (sl2, a2) <- transl_expr dst r2;
+      ret (sl1 ++ sl2, a2)
+  | C.Ecall r1 rl2 ty =>
+      do (sl1, a1) <- transl_expr For_val r1;
+      do (sl2, al2) <- transl_exprlist rl2;
+      match dst with
+      | For_val | For_test _ _ =>
+          do t <- gensym ty;
+          ret (finish dst (sl1 ++ sl2 ++ Scall (Some t) a1 al2 :: nil)
+                          (Etempvar t ty))
+      | For_effects =>
+          ret (sl1 ++ sl2 ++ Scall None a1 al2 :: nil, dummy_expr)
+      end
+  | C.Eparen r1 ty =>
+      error (msg "SimplExpr.transl_expr: paren")
+  end
+
+with transl_exprlist (rl: exprlist) : mon (list statement * list expr) :=
+  match rl with
+  | C.Enil =>
+      ret (nil, nil)
+  | C.Econs r1 rl2 =>
+      do (sl1, a1) <- transl_expr For_val r1;
+      do (sl2, al2) <- transl_exprlist rl2;
+      ret (sl1 ++ sl2, a1 :: al2)
+  end.
+
+Definition transl_expression (r: C.expr) : mon (statement * expr) :=
+  do (sl, a) <- transl_expr For_val r; ret (makeseq sl, a).
+
+Definition transl_expr_stmt (r: C.expr) : mon statement :=
+  do (sl, a) <- transl_expr For_effects r; ret (makeseq sl).
+
+Definition transl_if (r: C.expr) (s1 s2: statement) : mon statement :=
+  do (sl, a) <- transl_expr (For_test s1 s2) r; ret (makeseq sl).
+
+(** Translation of statements *)
+
+Definition expr_true := Econst_int Int.one (Tint I32 Signed).
+
+Definition is_Sskip:
+  forall s, {s = C.Sskip} + {s <> C.Sskip}.
+Proof.
+  destruct s; ((left; reflexivity) || (right; congruence)).
+Defined.
+
+(** There are two possible translations for an "if then else" statement.
+  One is more efficient if the condition contains "?" constructors
+  but can duplicate the "then" and "else" branches.
+  The other produces no code duplication.  We choose between the
+  two based on the shape of the "then" and "else" branches. *)
+
+Fixpoint small_stmt (s: statement) : bool :=
+  match s with
+  | Sskip => true
+  | Sbreak => true
+  | Scontinue => true
+  | Sgoto _ => true
+  | Sreturn None => true
+  | Ssequence s1 s2 => small_stmt s1 && small_stmt s2
+  | _ => false
+  end.
+
+Fixpoint transl_stmt (s: C.statement) : mon statement :=
+  match s with
+  | C.Sskip => ret Sskip
+  | C.Sdo e => transl_expr_stmt e
+  | C.Ssequence s1 s2 =>
+      do ts1 <- transl_stmt s1;
+      do ts2 <- transl_stmt s2;
+      ret (Ssequence ts1 ts2)
+  | C.Sifthenelse e s1 s2 =>
+      do ts1 <- transl_stmt s1;
+      do ts2 <- transl_stmt s2;
+      if small_stmt ts1 && small_stmt ts2 then
+        transl_if e ts1 ts2
+      else
+       (do (s', a) <- transl_expression e;
+        ret (Ssequence s' (Sifthenelse a ts1 ts2)))
+  | C.Swhile e s1 =>
+      do s' <- transl_if e Sskip Sbreak;
+      do ts1 <- transl_stmt s1;
+      ret (Swhile expr_true (Ssequence s' ts1))
+  | C.Sdowhile e s1 =>
+      do s' <- transl_if e Sskip Sbreak;
+      do ts1 <- transl_stmt s1;
+      ret (Sfor' expr_true s' ts1)
+  | C.Sfor s1 e2 s3 s4 =>
+      do ts1 <- transl_stmt s1;
+      do s' <- transl_if e2 Sskip Sbreak;
+      do ts3 <- transl_stmt s3;
+      do ts4 <- transl_stmt s4;
+      if is_Sskip s1 then
+        ret (Sfor' expr_true ts3 (Ssequence s' ts4))
+      else
+        ret (Ssequence ts1 (Sfor' expr_true ts3 (Ssequence s' ts4)))
+  | C.Sbreak =>
+      ret Sbreak
+  | C.Scontinue =>
+      ret Scontinue
+  | C.Sreturn None =>
+      ret (Sreturn None)
+  | C.Sreturn (Some e) =>
+      do (s', a) <- transl_expression e;
+      ret (Ssequence s' (Sreturn (Some a)))
+  | C.Sswitch e ls =>
+      do (s', a) <- transl_expression e;
+      do tls <- transl_lblstmt ls;
+      ret (Ssequence s' (Sswitch a tls))
+  | C.Slabel lbl s1 =>
+      do ts1 <- transl_stmt s1;
+      ret (Slabel lbl ts1)
+  | C.Sgoto lbl =>
+      ret (Sgoto lbl)
+  end
+
+with transl_lblstmt (ls: C.labeled_statements) : mon labeled_statements :=
+  match ls with
+  | C.LSdefault s =>
+      do ts <- transl_stmt s;
+      ret (LSdefault ts)
+  | C.LScase n s ls1 =>
+      do ts <- transl_stmt s;
+      do tls1 <- transl_lblstmt ls1;
+      ret (LScase n ts tls1)
+  end.
+
+(** Translation of a function *)
+
+Definition transl_function (f: C.function) : res function :=
+  match transl_stmt f.(C.fn_body) initial_generator with
+  | Err msg =>
+      Error msg
+  | Res tbody g i =>
+      OK (mkfunction
+              f.(C.fn_return)
+              f.(C.fn_params)
+              f.(C.fn_vars)
+              g.(gen_trail)
+              tbody)
+  end.
+
+Local Open Scope error_monad_scope.
+
+Definition transl_fundef (fd: C.fundef) : res fundef :=
+  match fd with
+  | C.Internal f =>
+      do tf <- transl_function f; OK (Internal tf)
+  | C.External ef targs tres =>
+      OK (External ef targs tres)
+  end.
+
+Definition transl_program (p: C.program) : res program :=
+  transform_partial_program transl_fundef p.
+
+
+
+      
+
+
diff --git a/cfrontend/SimplExprproof.v b/cfrontend/SimplExprproof.v
new file mode 100644
index 0000000..603e273
--- /dev/null
+++ b/cfrontend/SimplExprproof.v
@@ -0,0 +1,1851 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** Correctness proof for expression simplification. *)
+
+Require Import Coq.Program.Equality.
+Require Import Axioms.
+Require Import Coqlib.
+Require Import Maps.
+Require Import AST.
+Require Import Errors.
+Require Import Integers.
+Require Import Values.
+Require Import Memory.
+Require Import Events.
+Require Import Smallstep.
+Require Import Globalenvs.
+Require Import Determinism.
+Require Import Csyntax.
+Require Import Csem.
+Require Import Cstrategy.
+Require Import Clight.
+Require Import SimplExpr.
+Require Import SimplExprspec.
+
+Section PRESERVATION.
+
+Variable prog: C.program.
+Variable tprog: Clight.program.
+Hypothesis TRANSL: transl_program prog = OK tprog.
+
+Let ge := Genv.globalenv prog.
+Let tge := Genv.globalenv tprog.
+
+(** Invariance properties. *)
+
+Lemma symbols_preserved:
+  forall (s: ident), Genv.find_symbol tge s = Genv.find_symbol ge s.
+Proof
+  (Genv.find_symbol_transf_partial transl_fundef _ TRANSL).
+
+Lemma function_ptr_translated:
+  forall b f,
+  Genv.find_funct_ptr ge b = Some f ->
+  exists tf,
+  Genv.find_funct_ptr tge b = Some tf /\ transl_fundef f = OK tf.
+Proof
+  (Genv.find_funct_ptr_transf_partial transl_fundef _ TRANSL).
+
+Lemma functions_translated:
+  forall v f,
+  Genv.find_funct ge v = Some f ->
+  exists tf,
+  Genv.find_funct tge v = Some tf /\ transl_fundef f = OK tf.
+Proof
+  (Genv.find_funct_transf_partial transl_fundef _ TRANSL).
+
+Lemma varinfo_preserved:
+  forall b, Genv.find_var_info tge b = Genv.find_var_info ge b.
+Proof
+  (Genv.find_var_info_transf_partial transl_fundef _ TRANSL).
+
+Lemma type_of_fundef_preserved:
+  forall f tf, transl_fundef f = OK tf ->
+  type_of_fundef tf = C.type_of_fundef f.
+Proof.
+  intros. destruct f; monadInv H.
+  exploit transl_function_spec; eauto. intros [A [B [C D]]].
+  simpl. unfold type_of_function, C.type_of_function. congruence.
+  auto.
+Qed.
+
+Lemma function_return_preserved:
+  forall f tf, transl_function f = OK tf ->
+  fn_return tf = C.fn_return f.
+Proof.
+  intros. unfold transl_function in H.
+  destruct (transl_stmt (C.fn_body f) initial_generator); inv H.
+  auto.
+Qed.
+
+Lemma type_of_global_preserved:
+  forall b ty,
+  Csem.type_of_global ge b = Some ty ->
+  type_of_global tge b = Some ty.
+Proof.
+  intros until ty. unfold Csem.type_of_global, type_of_global.
+  rewrite varinfo_preserved. destruct (Genv.find_var_info ge b). auto. 
+  case_eq (Genv.find_funct_ptr ge b); intros. 
+  inv H0. exploit function_ptr_translated; eauto. intros [tf [A B]]. 
+  rewrite A. decEq. apply type_of_fundef_preserved; auto.
+  congruence.
+Qed.
+
+(** Translation of simple expressions. *)
+
+Lemma tr_simple_nil:
+  (forall le dst r sl a tmps, tr_expr le dst r sl a tmps ->
+   dst = For_val \/ dst = For_effects -> simple r -> sl = nil)
+/\(forall le rl sl al tmps, tr_exprlist le rl sl al tmps ->
+   simplelist rl -> sl = nil).
+Proof.
+  assert (A: forall dst a, dst = For_val \/ dst = For_effects -> final dst a = nil).
+    intros. destruct H; subst dst; auto.
+  apply tr_expr_exprlist; intros; simpl in *; try contradiction; auto.
+  rewrite H0; auto. simpl; auto.
+  rewrite H0; auto. simpl; auto.
+  destruct H1; congruence.
+  rewrite H0; auto. simpl; auto.
+  rewrite H0; auto. simpl; auto.
+  rewrite H0; auto. simpl; auto.
+  destruct H7. rewrite H0; auto. rewrite H2; auto. simpl; auto.
+  rewrite H0; auto. simpl; auto.
+  destruct H6. rewrite H0; auto.
+Qed.
+
+Lemma tr_simple_expr_nil:
+  forall le dst r sl a tmps, tr_expr le dst r sl a tmps ->
+  dst = For_val \/ dst = For_effects -> simple r -> sl = nil.
+Proof (proj1 tr_simple_nil).
+
+Lemma tr_simple_exprlist_nil:
+  forall le rl sl al tmps, tr_exprlist le rl sl al tmps ->
+  simplelist rl -> sl = nil.
+Proof (proj2 tr_simple_nil).
+
+(** Evaluation of simple expressions and of their translation *)
+
+Lemma tr_simple:
+ forall e m,
+ (forall r v,
+  eval_simple_rvalue ge e m r v ->
+  forall le dst sl a tmps,
+  tr_expr le dst r sl a tmps ->
+  match dst with
+  | For_val => sl = nil /\ C.typeof r = typeof a /\ eval_expr tge e le m a v
+  | For_effects => sl = nil
+  | For_test s1 s2 =>
+      exists b, sl = makeif b s1 s2 :: nil /\ C.typeof r = typeof b /\ eval_expr tge e le m b v
+  end)
+/\
+ (forall l b ofs,
+  eval_simple_lvalue ge e m l b ofs ->
+  forall le sl a tmps,
+  tr_expr le For_val l sl a tmps ->
+  sl = nil /\ C.typeof l = typeof a /\ eval_lvalue tge e le m a b ofs).
+Proof.
+Opaque makeif.
+  intros e m.
+  apply (eval_simple_rvalue_lvalue_ind ge e m); intros until tmps; intros TR; inv TR.
+(* value *)
+  auto.
+  auto.
+  exists a0; auto.
+(* rvalof *)
+  exploit H0; eauto. intros [A [B C]].
+  subst sl1; simpl.
+  assert (eval_expr tge e le m a v). eapply eval_Elvalue. eauto. congruence.
+  destruct dst; auto.
+  econstructor. split. simpl; eauto. auto. 
+(* addrof *)
+  exploit H0; eauto. intros [A [B C]].
+  subst sl1; simpl.
+  assert (eval_expr tge e le m (Eaddrof a1 ty) (Vptr b ofs)). econstructor; eauto.
+  destruct dst; auto. simpl; econstructor; eauto. 
+(* unop *)
+  exploit H0; eauto. intros [A [B C]].
+  subst sl1; simpl.
+  assert (eval_expr tge e le m (Eunop op a1 ty) v). econstructor; eauto. congruence.
+  destruct dst; auto. simpl; econstructor; eauto.
+(* binop *)
+  exploit H0; eauto. intros [A [B C]].
+  exploit H2; eauto. intros [D [E F]].
+  subst sl1 sl2; simpl.
+  assert (eval_expr tge e le m (Ebinop op a1 a2 ty) v). econstructor; eauto. congruence.
+  destruct dst; auto. simpl; econstructor; eauto.
+(* cast *)
+  exploit H0; eauto. intros [A [B C]].
+  subst sl1; simpl.
+  assert (eval_expr tge e le m (Ecast a1 ty) v). econstructor; eauto. congruence.
+  destruct dst; auto. simpl; econstructor; eauto.
+(* sizeof *)
+  destruct dst.
+  split; auto. split; auto. constructor.
+  auto.
+  exists (Esizeof ty1 ty). split. auto. split. auto. constructor.
+(* var local *)
+  split; auto. split; auto. apply eval_Evar_local; auto. 
+(* var global *)
+  split; auto. split; auto. apply eval_Evar_global; auto.
+    rewrite symbols_preserved; auto.
+    eapply type_of_global_preserved; eauto. 
+(* deref *)
+  exploit H0; eauto. intros [A [B C]]. subst sl1.
+  split; auto. split; auto. constructor; auto.
+(* field struct *)
+  exploit H0; eauto. intros [A [B C]]. subst sl1.
+  split; auto. split; auto. rewrite B in H1. eapply eval_Efield_struct; eauto.
+(* field union *)
+  exploit H0; eauto. intros [A [B C]]. subst sl1.
+  split; auto. split; auto. rewrite B in H1. eapply eval_Efield_union; eauto.
+Qed.
+
+Lemma tr_simple_rvalue:
+  forall e m r v,
+  eval_simple_rvalue ge e m r v ->
+  forall le dst sl a tmps,
+  tr_expr le dst r sl a tmps ->
+  match dst with
+  | For_val => sl = nil /\ C.typeof r = typeof a /\ eval_expr tge e le m a v
+  | For_effects => sl = nil
+  | For_test s1 s2 =>
+      exists b, sl = makeif b s1 s2 :: nil /\ C.typeof r = typeof b /\ eval_expr tge e le m b v
+  end.
+Proof.
+  intros e m. exact (proj1 (tr_simple e m)).
+Qed.
+
+Lemma tr_simple_lvalue: 
+  forall e m l b ofs,
+  eval_simple_lvalue ge e m l b ofs ->
+  forall le sl a tmps,
+  tr_expr le For_val l sl a tmps ->
+  sl = nil /\ C.typeof l = typeof a /\ eval_lvalue tge e le m a b ofs.
+Proof.
+  intros e m. exact (proj2 (tr_simple e m)).
+Qed.
+
+Lemma tr_simple_exprlist:
+  forall le rl sl al tmps,
+  tr_exprlist le rl sl al tmps ->
+  forall e m tyl vl,
+  eval_simple_list ge e m rl tyl vl ->
+  sl = nil /\ eval_exprlist tge e le m al tyl vl.
+Proof.
+  induction 1; intros. 
+  inv H. split. auto. constructor.
+  inv H4.
+  exploit tr_simple_rvalue; eauto. intros [A [B C]].
+  exploit IHtr_exprlist; eauto. intros [D E].
+  split. subst; auto. econstructor; eauto. congruence.
+Qed.
+
+(** Commutation between the translation of expressions and left contexts. *)
+
+Lemma typeof_context:
+  forall k1 k2 C, leftcontext k1 k2 C ->
+  forall e1 e2, C.typeof e1 = C.typeof e2 ->
+  C.typeof (C e1) = C.typeof (C e2).
+Proof.
+  induction 1; intros; auto. 
+Qed.
+
+Inductive compat_dest: (C.expr -> C.expr) -> purpose -> purpose -> list statement -> Prop :=
+  | compat_dest_base: forall dst,
+      compat_dest (fun x => x) dst dst nil
+  | compat_dest_val: forall C dst sl,
+      compat_dest C For_val dst sl
+  | compat_dest_effects: forall C dst sl,
+      compat_dest C For_effects dst sl
+  | compat_dest_paren: forall C ty dst' dst sl,
+      compat_dest C dst' dst sl ->
+      compat_dest (fun x => C.Eparen (C x) ty) dst' dst sl.
+
+Lemma compat_dest_not_test:
+  forall  C dst' dst sl,
+  compat_dest C dst' dst sl ->
+  dst = For_val \/ dst = For_effects ->
+  dst' = For_val \/ dst' = For_effects.
+Proof.
+  induction 1; intros; auto.
+Qed.
+
+Lemma compat_dest_change:
+  forall C1 dst' dst1 sl1 C2 dst2 sl2,
+  compat_dest C1 dst' dst1 sl1 ->
+  dst1 = For_val \/ dst1 = For_effects ->
+  compat_dest C2 dst' dst2 sl2.
+Proof.
+  intros. exploit compat_dest_not_test; eauto. intros [A | A]; subst dst'; constructor.
+Qed.
+
+Scheme leftcontext_ind2 := Minimality for leftcontext Sort Prop
+  with leftcontextlist_ind2 := Minimality for leftcontextlist Sort Prop.
+Combined Scheme leftcontext_leftcontextlist_ind from leftcontext_ind2, leftcontextlist_ind2.
+
+Lemma tr_expr_leftcontext_rec:
+ (
+  forall from to C, leftcontext from to C ->
+  forall le e dst sl a tmps,
+  tr_expr le dst (C e) sl a tmps ->
+  exists dst', exists sl1, exists sl2, exists a', exists tmp',
+  tr_expr le dst' e sl1 a' tmp'
+  /\ sl = sl1 ++ sl2
+  /\ compat_dest C dst' dst sl2
+  /\ incl tmp' tmps
+  /\ (forall le' e' sl3,
+        tr_expr le' dst' e' sl3 a' tmp' ->
+        (forall id, ~In id tmp' -> le'!id = le!id) ->
+        C.typeof e' = C.typeof e ->
+        tr_expr le' dst (C e') (sl3 ++ sl2) a tmps)
+ ) /\ (
+  forall from C, leftcontextlist from C ->
+  forall le e sl a tmps,
+  tr_exprlist le (C e) sl a tmps ->
+  exists dst', exists sl1, exists sl2, exists a', exists tmp',
+  tr_expr le dst' e sl1 a' tmp'
+  /\ sl = sl1 ++ sl2
+  /\ match dst' with For_test _ _ => False | _ => True end
+  /\ incl tmp' tmps
+  /\ (forall le' e' sl3,
+        tr_expr le' dst' e' sl3 a' tmp' ->
+        (forall id, ~In id tmp' -> le'!id = le!id) ->
+        C.typeof e' = C.typeof e ->
+        tr_exprlist le' (C e') (sl3 ++ sl2) a tmps)
+).
+Proof.
+
+Ltac TR :=
+  econstructor; econstructor; econstructor; econstructor; econstructor;
+  split; [eauto | split; [idtac | split; [eauto | split]]].
+
+Ltac NOTIN :=
+  match goal with
+  | [ H1: In ?x ?l, H2: list_disjoint ?l _ |- ~In ?x _ ] =>
+        red; intro; elim (H2 x x); auto
+  | [ H1: In ?x ?l, H2: list_disjoint _ ?l |- ~In ?x _ ] =>
+        red; intro; elim (H2 x x); auto
+  end.
+
+Ltac UNCHANGED :=
+  match goal with
+  | [ H: (forall (id: ident), ~In id _ -> ?le' ! id = ?le ! id) |-
+         (forall (id: ident), In id _ -> ?le' ! id = ?le ! id) ] =>
+      intros; apply H; NOTIN
+  end.
+
+  generalize compat_dest_change; intro CDC.
+  apply leftcontext_leftcontextlist_ind; intros.
+
+(* base *)
+  TR. rewrite <- app_nil_end; auto. constructor. red; auto.
+  intros. rewrite <- app_nil_end; auto. 
+(* deref *)
+  inv H1. 
+  exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [U [R S]]]]]]]]].
+  TR. subst sl1; rewrite app_ass; eauto. auto. 
+  intros. rewrite <- app_ass. econstructor; eauto. 
+(* field *)
+  inv H1.
+  exploit H0. eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [U [R S]]]]]]]]].
+  TR. subst sl1; rewrite app_ass; eauto. auto. 
+  intros. rewrite <- app_ass. econstructor; eauto.
+(* rvalof *)
+  inv H1.
+  exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [U [R S]]]]]]]]].
+  TR. subst sl1; rewrite app_ass; eauto. auto. 
+  intros. rewrite <- app_ass; econstructor; eauto.
+(* addrof *)
+  inv H1. 
+  exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [U [R S]]]]]]]]].
+  TR. subst sl1; rewrite app_ass; eauto. auto. 
+  intros. rewrite <- app_ass. econstructor; eauto.
+(* unop *) 
+  inv H1. 
+  exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [U [R S]]]]]]]]].
+  TR. subst sl1; rewrite app_ass; eauto. auto. 
+  intros. rewrite <- app_ass. econstructor; eauto. 
+(* binop left *)
+  inv H1.
+  exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [U [R S]]]]]]]]].
+  TR. subst sl1. rewrite app_ass. eauto. 
+  red; auto. 
+  intros. rewrite <- app_ass. econstructor; eauto.
+  eapply tr_expr_invariant; eauto. UNCHANGED. 
+(* binop right *)
+  inv H2. 
+  assert (sl1 = nil) by (eapply tr_simple_expr_nil; eauto). subst sl1; simpl.
+  exploit H1; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [U [R S]]]]]]]]].
+  TR. subst sl2. rewrite app_ass. eauto. 
+  red; auto. 
+  intros. rewrite <- app_ass. change (sl3 ++ sl2') with (nil ++ sl3 ++ sl2'). rewrite app_ass. econstructor; eauto.
+  eapply tr_expr_invariant; eauto. UNCHANGED. 
+(* cast *)
+  inv H1.
+  exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [U [R S]]]]]]]]].
+  TR. subst sl1; rewrite app_ass; eauto. auto. 
+  intros. rewrite <- app_ass. econstructor; eauto.
+(* condition *)
+  inv H1.
+  (* for val *)
+  exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [U [R S]]]]]]]]].
+  TR. 
+  rewrite Q. rewrite app_ass. eauto. 
+  red; auto.
+  intros. rewrite <- app_ass. econstructor. apply S; auto. 
+  eapply tr_expr_invariant; eauto. UNCHANGED.
+  eapply tr_expr_invariant; eauto. UNCHANGED.
+  auto. auto. auto. auto. auto. auto. auto. 
+  (* for effects *)
+  exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [U [R S]]]]]]]]].
+  TR. 
+  rewrite Q. rewrite app_ass. eauto. 
+  red; auto.
+  intros. rewrite <- app_ass. econstructor. auto. apply S; auto. 
+  eapply tr_expr_invariant; eauto. UNCHANGED.
+  eapply tr_expr_invariant; eauto. UNCHANGED.
+  auto. auto. auto. auto. auto.
+(* assign left *)
+  inv H1.
+  (* for effects *)
+  exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [U [R S]]]]]]]]].
+  TR. subst sl1. rewrite app_ass. eauto. 
+  red; auto. 
+  intros. rewrite <- app_ass. econstructor. apply S; auto.
+  eapply tr_expr_invariant; eauto. UNCHANGED.
+  auto. auto. auto.
+  (* for val *)
+  exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [U [R S]]]]]]]]].
+  TR. subst sl1. rewrite app_ass. eauto. 
+  red; auto. 
+  intros. rewrite <- app_ass. econstructor. apply S; auto.
+  eapply tr_expr_invariant; eauto. UNCHANGED.
+  auto. auto. auto. auto. auto. auto.
+  eapply typeof_context; eauto.
+  auto. 
+(* assign right *)
+  inv H2. 
+  (* for effects *)
+  assert (sl1 = nil) by (eapply tr_simple_expr_nil; eauto). subst sl1; simpl.
+  exploit H1; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [U [R S]]]]]]]]].
+  TR. subst sl2. rewrite app_ass. eauto. 
+  red; auto. 
+  intros. rewrite <- app_ass. change (sl3 ++ sl2') with (nil ++ (sl3 ++ sl2')). rewrite app_ass. 
+  econstructor. 
+  eapply tr_expr_invariant; eauto. UNCHANGED.
+  apply S; auto. auto. auto. auto.
+  (* for val *)
+  assert (sl1 = nil) by (eapply tr_simple_expr_nil; eauto). subst sl1; simpl.
+  exploit H1; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [U [R S]]]]]]]]].
+  TR. subst sl2. rewrite app_ass. eauto. 
+  red; auto. 
+  intros. rewrite <- app_ass. change (sl3 ++ sl2') with (nil ++ (sl3 ++ sl2')). rewrite app_ass. 
+  econstructor. 
+  eapply tr_expr_invariant; eauto. UNCHANGED.
+  apply S; auto. auto. auto. auto. auto. auto. auto. auto. 
+  eapply typeof_context; eauto.
+(* assignop left *)
+  inv H1.
+  (* for effects *)
+  exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [U [R S]]]]]]]]].
+  TR. subst sl1. rewrite app_ass. eauto. 
+  red; auto. 
+  intros. rewrite <- app_ass. econstructor. apply S; auto.
+  eapply tr_expr_invariant; eauto. UNCHANGED.
+  auto. auto. auto.
+  (* for val *)
+  exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [U [R S]]]]]]]]].
+  TR. subst sl1. rewrite app_ass. eauto. 
+  red; auto. 
+  intros. rewrite <- app_ass. econstructor. apply S; auto.
+  eapply tr_expr_invariant; eauto. UNCHANGED.
+  auto. auto. auto. auto. auto. auto.
+  eapply typeof_context; eauto.
+(* assignop right *)
+  inv H2.
+  (* for effects *)
+  assert (sl1 = nil) by (eapply tr_simple_expr_nil; eauto). subst sl1; simpl.
+  exploit H1; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [U [R S]]]]]]]]].
+  TR. subst sl2. rewrite app_ass. eauto. 
+  red; auto.
+  intros. rewrite <- app_ass. change (sl3 ++ sl2') with (nil ++ sl3 ++ sl2'). rewrite app_ass. econstructor. 
+  eapply tr_expr_invariant; eauto. UNCHANGED.
+  apply S; auto. auto. auto. auto.
+  (* for val *)
+  assert (sl1 = nil) by (eapply tr_simple_expr_nil; eauto). subst sl1; simpl.
+  exploit H1; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [U [R S]]]]]]]]].
+  TR. subst sl2. rewrite app_ass. eauto. 
+  red; auto. 
+  intros. rewrite <- app_ass. change (sl3 ++ sl2') with (nil ++ sl3 ++ sl2'). rewrite app_ass. econstructor. 
+  eapply tr_expr_invariant; eauto. UNCHANGED.
+  apply S; auto. auto. auto. auto. auto. auto. auto. auto. 
+(* postincr *)
+  inv H1.
+  (* for effects *)
+  exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [U [R S]]]]]]]]].
+  TR. rewrite Q; rewrite app_ass; eauto. red; auto. 
+  intros. replace (C.typeof (C e)) with (C.typeof (C e')). rewrite <- app_ass.
+  econstructor; eauto. 
+  eapply typeof_context; eauto.
+  (* for val *)
+  exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [U [R S]]]]]]]]].
+  TR. rewrite Q; rewrite app_ass; eauto. red; auto. 
+  intros. rewrite <- app_ass. econstructor; eauto. 
+  eapply typeof_context; eauto.
+(* call left *)
+  inv H1.
+  (* for effects *)
+  exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [U [R S]]]]]]]]].
+  TR. rewrite Q; rewrite app_ass; eauto. red; auto. 
+  intros. rewrite <- app_ass. econstructor. apply S; auto.
+  eapply tr_exprlist_invariant; eauto. UNCHANGED.
+  auto. auto. auto.
+  (* for val *)
+  exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [U [R S]]]]]]]]].
+  TR. rewrite Q; rewrite app_ass; eauto. red; auto. 
+  intros. rewrite <- app_ass. econstructor. auto. apply S; auto.
+  eapply tr_exprlist_invariant; eauto. UNCHANGED.
+  auto. auto. auto. auto. 
+(* call right *)
+  inv H2.
+  (* for effects *)
+  assert (sl1 = nil) by (eapply tr_simple_expr_nil; eauto). subst sl1; simpl. 
+  exploit H1; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [U [R S]]]]]]]]].
+  TR. rewrite Q; rewrite app_ass; eauto. destruct dst'; contradiction || constructor.
+  red; auto. 
+  intros. rewrite <- app_ass. change (sl3++sl2') with (nil ++ sl3 ++ sl2'). rewrite app_ass. econstructor.
+  eapply tr_expr_invariant; eauto. UNCHANGED.
+  apply S; auto. auto. auto. auto.
+  (* for val *)
+  assert (sl1 = nil) by (eapply tr_simple_expr_nil; eauto). subst sl1; simpl. 
+  exploit H1; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [U [R S]]]]]]]]].
+  TR. rewrite Q; rewrite app_ass; eauto. destruct dst'; contradiction || constructor.
+  red; auto. 
+  intros. rewrite <- app_ass. change (sl3++sl2') with (nil ++ sl3 ++ sl2'). rewrite app_ass. econstructor.
+  auto. eapply tr_expr_invariant; eauto. UNCHANGED.
+  apply S; auto.
+  auto. auto. auto. auto.
+(* comma *)
+  inv H1.
+  exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [U [R S]]]]]]]]].
+  TR. rewrite Q; rewrite app_ass; eauto. red; auto. 
+  intros. rewrite <- app_ass. econstructor. apply S; auto.
+  eapply tr_expr_invariant; eauto. UNCHANGED.
+  auto. auto. auto.
+(* paren *)
+  inv H1. 
+  (* for val *)
+  exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [U [R S]]]]]]]]].
+  TR. rewrite Q. rewrite app_ass. eauto. red; auto. 
+  intros. rewrite <- app_ass. econstructor; eauto. 
+  (* for effects *)
+  exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [U [R S]]]]]]]]].
+  TR. rewrite Q. eauto. constructor; auto. auto.
+  intros. econstructor; eauto.
+(* cons left *)
+  inv H1.
+  exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [U [R S]]]]]]]]].
+  TR. subst sl1. rewrite app_ass. eauto. 
+  exploit compat_dest_not_test; eauto. intros [A|A]; subst dst'; auto.
+  red; auto. 
+  intros. rewrite <- app_ass. econstructor. apply S; auto.
+  eapply tr_exprlist_invariant; eauto.  UNCHANGED.
+  auto. auto. auto.
+(* cons right *)
+  inv H2.
+  assert (sl1 = nil) by (eapply tr_simple_expr_nil; eauto). subst sl1; simpl. 
+  exploit H1; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [U [R S]]]]]]]]].
+  TR. subst sl2. eauto. 
+  red; auto. 
+  intros. change sl3 with (nil ++ sl3). rewrite app_ass. econstructor.
+  eapply tr_expr_invariant; eauto. UNCHANGED.
+  apply S; auto.
+  auto. auto. auto.
+Qed.
+
+Theorem tr_expr_leftcontext:
+  forall C le r dst sl a tmps,
+  leftcontext RV RV C ->
+  tr_expr le dst (C r) sl a tmps ->
+  exists dst', exists sl1, exists sl2, exists a', exists tmp',
+  tr_expr le dst' r sl1 a' tmp'
+  /\ sl = sl1 ++ sl2
+  /\ compat_dest C dst' dst sl2
+  /\ incl tmp' tmps
+  /\ (forall le' r' sl3,
+        tr_expr le' dst' r' sl3 a' tmp' ->
+        (forall id, ~In id tmp' -> le'!id = le!id) ->
+        C.typeof r' = C.typeof r ->
+        tr_expr le' dst (C r') (sl3 ++ sl2) a tmps).
+Proof.
+  intros. eapply (proj1 tr_expr_leftcontext_rec); eauto.
+Qed.
+
+Theorem tr_top_leftcontext:
+  forall e le m dst rtop sl a tmps,
+  tr_top tge e le m dst rtop sl a tmps ->
+  forall r C,
+  rtop = C r ->
+  leftcontext RV RV C ->
+  exists dst', exists sl1, exists sl2, exists a', exists tmp',
+  tr_top tge e le m dst' r sl1 a' tmp'
+  /\ sl = sl1 ++ sl2
+  /\ compat_dest C dst' dst sl2
+  /\ incl tmp' tmps
+  /\ (forall le' m' r' sl3,
+        tr_expr le' dst' r' sl3 a' tmp' ->
+        (forall id, ~In id tmp' -> le'!id = le!id) ->
+        C.typeof r' = C.typeof r ->
+        tr_top tge e le' m' dst (C r') (sl3 ++ sl2) a tmps).
+Proof.
+  induction 1; intros.
+(* val for val *)
+  inv H2; inv H1.
+  exists For_val; econstructor; econstructor; econstructor; econstructor.
+  split. apply tr_top_val_val; eauto.
+  split. instantiate (1 := nil); auto.
+  split. constructor.
+  split. apply incl_refl.
+  intros. rewrite <- app_nil_end. constructor; auto.
+(* val for test *)
+  inv H2; inv H1.
+  exists (For_test s1 s2); econstructor; econstructor; econstructor; econstructor.
+  split. apply tr_top_val_test; eauto.
+  split. instantiate (1 := nil); auto.
+  split. constructor.
+  split. apply incl_refl.
+  intros. rewrite <- app_nil_end. constructor; eauto.
+(* base *)
+  subst r. exploit tr_expr_leftcontext; eauto.
+  intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [R [S T]]]]]]]]].
+  exists dst'; exists sl1; exists sl2; exists a'; exists tmp'.
+  split. apply tr_top_base; auto.
+  split. auto. split. auto. split. auto.
+  intros. apply tr_top_base. apply T; auto. 
+(* paren *)
+  inv H1; inv H0.
+  (* at top *)
+  exists (For_test s1 s2); econstructor; econstructor; econstructor; econstructor.
+  split. apply tr_top_paren_test; eauto.
+  split. instantiate (1 := nil). rewrite <- app_nil_end; auto.
+  split. constructor.
+  split. apply incl_refl.
+  intros. rewrite <- app_nil_end. constructor; eauto.
+  (* below *)
+  exploit (IHtr_top r0 C0); auto. 
+  intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [T [R S]]]]]]]]].
+  exists dst'; exists sl1; exists sl2; exists a'; exists tmp'.
+  split. auto.
+  split. auto.
+  split. constructor; auto.
+  split. auto.
+  intros. apply tr_top_paren_test. apply S; auto.
+Qed.
+
+Theorem tr_top_testcontext:
+  forall C s1 s2 dst sl2 r sl1 a tmps e le m,
+  compat_dest C (For_test s1 s2) dst sl2 ->
+  tr_top tge e le m (For_test s1 s2) r sl1 a tmps ->
+  dst = For_test s1 s2 /\ tr_top tge e le m dst (C r) (sl1 ++ sl2) a tmps.
+Proof.
+  intros. dependent induction H.
+  split. auto. rewrite <- app_nil_end. auto.
+  exploit IHcompat_dest; eauto. intros [A B].
+  split. auto. subst dst. apply tr_top_paren_test. auto. 
+Qed.
+
+(** Semantics of smart constructors *)
+
+Lemma step_makeif_true:
+  forall f a s1 s2 k e le m v1,
+  eval_expr tge e le m a v1 ->
+  is_true v1 (typeof a) ->
+  star step tge (State f (makeif a s1 s2) k e le m)
+             E0 (State f s1 k e le m).
+Proof.
+  intros. functional induction (makeif a s1 s2).
+  inversion H. subst v1. inversion H0. congruence. congruence.
+  inversion H1.
+  apply star_refl.
+  apply star_one. apply step_ifthenelse_true with v1; auto. 
+Qed.
+
+Lemma step_makeif_false:
+  forall f a s1 s2 k e le m v1,
+  eval_expr tge e le m a v1 ->
+  is_false v1 (typeof a) ->
+  star step tge (State f (makeif a s1 s2) k e le m)
+             E0 (State f s2 k e le m).
+Proof.
+  intros. functional induction (makeif a s1 s2).
+  apply star_refl.
+  inversion H. subst v1. inversion H0. congruence. congruence.
+  inversion H1.
+  apply star_one. apply step_ifthenelse_false with v1; auto. 
+Qed.
+
+(** Matching between continuations *)
+
+Fixpoint Kseqlist (sl: list statement) (k: cont) :=
+  match sl with
+  | nil => k
+  | s :: l => Kseq s (Kseqlist l k)
+  end.
+
+Remark Kseqlist_app:
+  forall sl1 sl2 k,
+  Kseqlist (sl1 ++ sl2) k = Kseqlist sl1 (Kseqlist sl2 k).
+Proof.
+  induction sl1; simpl; congruence.
+Qed.
+
+Inductive match_cont : Csem.cont -> cont -> Prop :=
+  | match_Kstop:
+      match_cont Csem.Kstop Kstop
+  | match_Kseq: forall s k ts tk,
+      tr_stmt s ts ->
+      match_cont k tk ->
+      match_cont (Csem.Kseq s k) (Kseq ts tk)
+  | match_Kwhile2: forall r s k s' ts tk,
+      tr_if r Sskip Sbreak s' ->
+      tr_stmt s ts ->
+      match_cont k tk ->
+      match_cont (Csem.Kwhile2 r s k)
+                 (Kwhile expr_true (Ssequence s' ts) tk)
+  | match_Kdowhile1: forall r s k s' ts tk,
+      tr_if r Sskip Sbreak s' ->
+      tr_stmt s ts ->
+      match_cont k tk ->
+      match_cont (Csem.Kdowhile1 r s k)
+                 (Kfor2 expr_true s' ts tk)
+  | match_Kfor3: forall r s3 s k ts3 s' ts tk,
+      tr_if r Sskip Sbreak s' ->
+      tr_stmt s3 ts3 ->
+      tr_stmt s ts ->
+      match_cont k tk ->
+      match_cont (Csem.Kfor3 r s3 s k)
+                 (Kfor2 expr_true ts3 (Ssequence s' ts) tk)
+  | match_Kfor4: forall r s3 s k ts3 s' ts tk,
+      tr_if r Sskip Sbreak s' ->
+      tr_stmt s3 ts3 ->
+      tr_stmt s ts ->
+      match_cont k tk ->
+      match_cont (Csem.Kfor4 r s3 s k)
+                 (Kfor3 expr_true ts3 (Ssequence s' ts) tk)
+  | match_Kswitch2: forall k tk,
+      match_cont k tk ->
+      match_cont (Csem.Kswitch2 k) (Kswitch tk)
+  | match_Kcall_none: forall f e C ty k tf le sl tk a dest tmps,
+      transl_function f = Errors.OK tf ->
+      leftcontext RV RV C ->
+      (forall v m, tr_top tge e le m dest (C (C.Eval v ty)) sl a tmps) ->
+      match_cont_exp dest a k tk ->
+      match_cont (Csem.Kcall f e C ty k)
+                 (Kcall None tf e le (Kseqlist sl tk))
+  | match_Kcall_some: forall f e C ty k dst tf le sl tk a dest tmps,
+      transl_function f = Errors.OK tf ->
+      leftcontext RV RV C ->
+      (forall v m, tr_top tge e (PTree.set dst v le) m dest (C (C.Eval v ty)) sl a tmps) ->
+      match_cont_exp dest a k tk ->
+      match_cont (Csem.Kcall f e C ty k)
+                 (Kcall (Some dst) tf e le (Kseqlist sl tk))
+
+with match_cont_exp : purpose -> expr -> Csem.cont -> cont -> Prop :=
+  | match_Kdo: forall k a tk,
+      match_cont k tk ->
+      match_cont_exp For_effects a (Csem.Kdo k) tk
+  | match_Kifthenelse_1: forall a s1 s2 k ts1 ts2 tk,
+      tr_stmt s1 ts1 -> tr_stmt s2 ts2 ->
+      match_cont k tk ->
+      match_cont_exp For_val a (Csem.Kifthenelse s1 s2 k) (Kseq (Sifthenelse a ts1 ts2) tk)
+  | match_Kifthenelse_2: forall a s1 s2 k ts1 ts2 tk,
+      tr_stmt s1 ts1 -> tr_stmt s2 ts2 ->
+      match_cont k tk ->
+      match_cont_exp (For_test ts1 ts2) a (Csem.Kifthenelse s1 s2 k) tk
+  | match_Kwhile1: forall r s k s' a ts tk,
+      tr_if r Sskip Sbreak s' ->
+      tr_stmt s ts ->
+      match_cont k tk ->
+      match_cont_exp (For_test Sskip Sbreak) a
+         (Csem.Kwhile1 r s k)
+         (Kseq ts (Kwhile expr_true (Ssequence s' ts) tk))
+  | match_Kdowhile2: forall r s k s' a ts tk,
+      tr_if r Sskip Sbreak s' ->
+      tr_stmt s ts ->
+      match_cont k tk ->
+      match_cont_exp (For_test Sskip Sbreak) a
+        (Csem.Kdowhile2 r s k)
+        (Kfor3 expr_true s' ts tk)
+  | match_Kfor2: forall r s3 s k s' a ts3 ts tk,
+      tr_if r Sskip Sbreak s' ->
+      tr_stmt s3 ts3 ->
+      tr_stmt s ts ->
+      match_cont k tk ->
+      match_cont_exp (For_test Sskip Sbreak) a
+        (Csem.Kfor2 r s3 s k)
+        (Kseq ts (Kfor2 expr_true ts3 (Ssequence s' ts) tk))
+  | match_Kswitch1: forall ls k a tls tk,
+      tr_lblstmts ls tls ->
+      match_cont k tk ->
+      match_cont_exp For_val a (Csem.Kswitch1 ls k) (Kseq (Sswitch a tls) tk)
+  | match_Kreturn: forall k a tk,
+      match_cont k tk ->
+      match_cont_exp For_val a (Csem.Kreturn k) (Kseq (Sreturn (Some a)) tk).
+
+Lemma match_cont_call:
+  forall k tk,
+  match_cont k tk ->
+  match_cont (Csem.call_cont k) (call_cont tk).
+Proof.
+  induction 1; simpl; auto. constructor. econstructor; eauto. econstructor; eauto.
+Qed.
+
+Lemma match_cont_exp_for_test_inv:
+  forall s1 s2 a a' k tk,
+  match_cont_exp (For_test s1 s2) a k tk ->
+  match_cont_exp (For_test s1 s2) a' k tk.
+Proof.
+  intros. inv H; econstructor; eauto.
+Qed.
+
+(** Matching between states *)
+
+Inductive match_states: Csem.state -> state -> Prop :=
+  | match_exprstates: forall f r k e m tf sl tk le dest a tmps,
+      transl_function f = Errors.OK tf ->
+      tr_top tge e le m dest r sl a tmps ->
+      match_cont_exp dest a k tk ->
+      match_states (Csem.ExprState f r k e m)
+                   (State tf Sskip (Kseqlist sl tk) e le m)
+  | match_regularstates: forall f s k e m tf ts tk le,
+      transl_function f = Errors.OK tf ->
+      tr_stmt s ts ->
+      match_cont k tk ->
+      match_states (Csem.State f s k e m)
+                   (State tf ts tk e le m)
+  | match_callstates: forall fd args k m tfd tk,
+      transl_fundef fd = Errors.OK tfd ->
+      match_cont k tk ->
+      match_states (Csem.Callstate fd args k m)
+                   (Callstate tfd args tk m)
+  | match_returnstates: forall res k m tk,
+      match_cont k tk ->
+      match_states (Csem.Returnstate res k m)
+                   (Returnstate res tk m).
+
+Lemma push_seq:
+  forall f sl k e le m,
+  star step tge (State f (makeseq sl) k e le m)
+             E0 (State f Sskip (Kseqlist sl k) e le m).
+Proof.
+  intros. unfold makeseq. generalize Sskip. revert sl k. 
+  induction sl; simpl; intros.
+  apply star_refl.
+  eapply star_right. apply IHsl. constructor. traceEq.
+Qed.
+
+(** Additional results on translation of statements *)
+
+Lemma tr_select_switch:
+  forall n ls tls,
+  tr_lblstmts ls tls ->
+  tr_lblstmts (Csem.select_switch n ls) (select_switch n tls).
+Proof.
+  induction 1; simpl.
+  constructor; auto.
+  destruct (Int.eq n0 n). constructor; auto. auto.
+Qed.
+
+Lemma tr_seq_of_labeled_statement:
+  forall ls tls,
+  tr_lblstmts ls tls ->
+  tr_stmt (Csem.seq_of_labeled_statement ls) (seq_of_labeled_statement tls).
+Proof.
+  induction 1; simpl. auto. constructor; auto.
+Qed.
+
+(** Commutation between translation and the "find label" operation. *)
+
+Section FIND_LABEL.
+
+Variable lbl: label.
+
+Definition nolabel (s: statement) : Prop :=
+  forall k, find_label lbl s k = None.
+
+Fixpoint nolabel_list (sl: list statement) : Prop :=
+  match sl with
+  | nil => True
+  | s1 :: sl' => nolabel s1 /\ nolabel_list sl'
+  end.
+
+Lemma nolabel_list_app:
+  forall sl2 sl1, nolabel_list sl1 -> nolabel_list sl2 -> nolabel_list (sl1 ++ sl2).
+Proof.
+  induction sl1; simpl; intros. auto. tauto. 
+Qed.
+
+Lemma makeseq_nolabel:
+  forall sl, nolabel_list sl -> nolabel (makeseq sl).
+Proof.
+  assert (forall sl s, nolabel s -> nolabel_list sl -> nolabel (makeseq_rec s sl)).
+  induction sl; simpl; intros. auto. destruct H0. apply IHsl; auto. 
+  red. intros; simpl. rewrite H. apply H0.
+  intros. unfold makeseq. apply H; auto. red. auto. 
+Qed.
+
+Lemma small_stmt_nolabel:
+  forall s, small_stmt s = true -> nolabel s.
+Proof.
+  induction s; simpl; intros; congruence || (red; auto).
+  destruct (andb_prop _ _ H). intros; simpl. rewrite IHs1; auto. apply IHs2; auto. 
+Qed.
+
+Lemma makeif_nolabel:
+  forall a s1 s2, nolabel s1 -> nolabel s2 -> nolabel (makeif a s1 s2).
+Proof.
+  intros. functional induction (makeif a s1 s2); auto. 
+  red; simpl; intros. rewrite H; auto.
+Qed.
+
+Definition nolabel_dest (dst: purpose) : Prop :=
+  match dst with
+  | For_val => True
+  | For_effects => True
+  | For_test s1 s2 => nolabel s1 /\ nolabel s2
+  end.
+
+Lemma nolabel_final:
+  forall dst a, nolabel_dest dst -> nolabel_list (final dst a).
+Proof.
+  destruct dst; simpl; intros. auto. auto. 
+  split; auto. destruct H. apply makeif_nolabel; auto.
+Qed. 
+
+Ltac NoLabelTac :=
+  match goal with
+  | [ |- nolabel_list nil ] => exact I
+  | [ |- nolabel_list (final _ _) ] => apply nolabel_final; NoLabelTac
+  | [ |- nolabel_list (_ :: _) ] => simpl; split; NoLabelTac
+  | [ |- nolabel_list (_ ++ _) ] => apply nolabel_list_app; NoLabelTac
+  | [ |- nolabel_dest For_val ] => exact I
+  | [ |- nolabel_dest For_effects ] => exact I
+  | [ H: _ -> nolabel_list ?x |- nolabel_list ?x ] => apply H; NoLabelTac
+  | [ |- nolabel _ ] => red; intros; simpl; auto
+  | [ |- _ /\ _ ] => split; NoLabelTac
+  | _ => auto
+  end.
+
+Lemma tr_find_label_expr:
+  (forall le dst r sl a tmps, tr_expr le dst r sl a tmps -> nolabel_dest dst -> nolabel_list sl)
+/\(forall le rl sl al tmps, tr_exprlist le rl sl al tmps -> nolabel_list sl).
+Proof.
+  apply tr_expr_exprlist; intros; NoLabelTac.
+  destruct H1. apply makeif_nolabel; auto. 
+  apply makeif_nolabel; NoLabelTac.
+  rewrite (makeseq_nolabel sl2); auto.
+  rewrite (makeseq_nolabel sl3); auto.
+  apply makeif_nolabel; NoLabelTac.
+  rewrite (makeseq_nolabel sl2); auto.
+  rewrite (makeseq_nolabel sl3); auto.
+Qed.
+
+Lemma tr_find_label_top:
+  forall e le m dst r sl a tmps,
+  tr_top tge e le m dst r sl a tmps -> nolabel_dest dst -> nolabel_list sl.
+Proof.
+  induction 1; intros; NoLabelTac.
+  destruct H1. apply makeif_nolabel; auto. 
+  eapply (proj1 tr_find_label_expr); eauto.
+Qed.
+
+Lemma tr_find_label_expression:
+  forall r s a, tr_expression r s a -> forall k, find_label lbl s k = None.
+Proof.
+  intros. inv H.
+  assert (nolabel (makeseq sl)). apply makeseq_nolabel.
+  eapply tr_find_label_top with (e := empty_env) (le := PTree.empty val) (m := Mem.empty).
+  eauto. exact I. 
+  apply H.
+Qed.
+
+Lemma tr_find_label_expr_stmt:
+  forall r s, tr_expr_stmt r s -> forall k, find_label lbl s k = None.
+Proof.
+  intros. inv H.
+  assert (nolabel (makeseq sl)). apply makeseq_nolabel.
+  eapply tr_find_label_top with (e := empty_env) (le := PTree.empty val) (m := Mem.empty).
+  eauto. exact I. 
+  apply H.
+Qed.
+
+Lemma tr_find_label_if:
+  forall r s1 s2 s,
+  tr_if r s1 s2 s ->
+  small_stmt s1 = true -> small_stmt s2 = true ->
+  forall k, find_label lbl s k = None.
+Proof.
+  intros. inv H. 
+  assert (nolabel (makeseq sl)). apply makeseq_nolabel.
+  eapply tr_find_label_top with (e := empty_env) (le := PTree.empty val) (m := Mem.empty).
+  eauto. split; apply small_stmt_nolabel; auto.
+  apply H.
+Qed.
+
+Lemma tr_find_label:
+  forall s k ts tk
+    (TR: tr_stmt s ts)
+    (MC: match_cont k tk),
+  match Csem.find_label lbl s k with
+  | None =>
+      find_label lbl ts tk = None
+  | Some (s', k') =>
+      exists ts', exists tk',
+          find_label lbl ts tk = Some (ts', tk')
+       /\ tr_stmt s' ts'
+       /\ match_cont k' tk'
+  end
+with tr_find_label_ls:
+  forall s k ts tk
+    (TR: tr_lblstmts s ts)
+    (MC: match_cont k tk),
+  match Csem.find_label_ls lbl s k with
+  | None =>
+      find_label_ls lbl ts tk = None
+  | Some (s', k') =>
+      exists ts', exists tk',
+          find_label_ls lbl ts tk = Some (ts', tk')
+       /\ tr_stmt s' ts'
+       /\ match_cont k' tk'
+  end.
+Proof.
+  induction s; intros; inversion TR; subst; clear TR; simpl.
+  auto.
+  eapply tr_find_label_expr_stmt; eauto.
+(* seq *)
+  exploit (IHs1 (Csem.Kseq s2 k)); eauto. constructor; eauto.
+  destruct (Csem.find_label lbl s1 (Csem.Kseq s2 k)) as [[s' k'] | ].
+  intros [ts' [tk' [A [B C]]]]. rewrite A. exists ts'; exists tk'; auto.
+  intro EQ. rewrite EQ. eapply IHs2; eauto. 
+(* if no-opt *)
+  rename s' into sr. 
+  rewrite (tr_find_label_expression _ _ _ H2).
+  exploit (IHs1 k); eauto.
+  destruct (Csem.find_label lbl s1 k) as [[s' k'] | ].
+  intros [ts' [tk' [A [B C]]]]. rewrite A. exists ts'; exists tk'; intuition.
+  intro EQ. rewrite EQ. eapply IHs2; eauto.
+(* if opt *)
+  rewrite (tr_find_label_if _ _ _ _ H7); auto.
+  exploit (IHs1 k); eauto.
+  destruct (Csem.find_label lbl s1 k) as [[s' k'] | ].
+  intros [ts' [tk' [A [B C]]]]. 
+  exploit small_stmt_nolabel. eexact H4. instantiate (1 := tk). congruence.
+  intros.
+  exploit (IHs2 k); eauto.
+  destruct (Csem.find_label lbl s2 k) as [[s' k'] | ].
+  intros [ts' [tk' [A [B C]]]]. 
+  exploit small_stmt_nolabel. eexact H6. instantiate (1 := tk). congruence.
+  auto.
+(* while *)
+  rename s' into sr. 
+  rewrite (tr_find_label_if _ _ _ _ H1); auto.
+  eapply IHs; eauto. econstructor; eauto.
+(* dowhile *)
+  rename s' into sr.
+  rewrite (tr_find_label_if _ _ _ _ H1); auto.
+  exploit (IHs (Kdowhile1 e s k)); eauto. econstructor; eauto.
+  destruct (Csem.find_label lbl s (Kdowhile1 e s k)) as [[s' k'] | ].
+  intros [ts' [tk' [A [B C]]]]. rewrite A. exists ts'; exists tk'; intuition.
+  intro EQ. rewrite EQ. auto. 
+(* for skip *)
+  rename s' into sr.
+  rewrite (tr_find_label_if _ _ _ _ H4); auto.
+  exploit (IHs3 (Csem.Kfor3 e s2 s3 k)); eauto. econstructor; eauto.
+  destruct (Csem.find_label lbl s3 (Csem.Kfor3 e s2 s3 k)) as [[s' k'] | ].
+  intros [ts' [tk' [A [B C]]]]. rewrite A. exists ts'; exists tk'; intuition.
+  intro EQ. rewrite EQ.
+  exploit (IHs2 (Csem.Kfor4 e s2 s3 k)); eauto. econstructor; eauto.
+(* for not skip *)
+  rename s' into sr.
+  rewrite (tr_find_label_if _ _ _ _ H3); auto.
+  exploit (IHs1 (Csem.Kseq (C.Sfor C.Sskip e s2 s3) k)); eauto. 
+    econstructor; eauto. econstructor; eauto. 
+  destruct (Csem.find_label lbl s1
+               (Csem.Kseq (C.Sfor C.Sskip e s2 s3) k)) as [[s' k'] | ].
+  intros [ts' [tk' [A [B C]]]]. rewrite A. exists ts'; exists tk'; intuition.
+  intro EQ; rewrite EQ.
+  exploit (IHs3 (Csem.Kfor3 e s2 s3 k)); eauto. econstructor; eauto.
+  destruct (Csem.find_label lbl s3 (Csem.Kfor3 e s2 s3 k)) as [[s'' k''] | ].
+  intros [ts' [tk' [A [B C]]]]. rewrite A. exists ts'; exists tk'; intuition.
+  intro EQ'. rewrite EQ'. 
+  exploit (IHs2 (Csem.Kfor4 e s2 s3 k)); eauto. econstructor; eauto.
+(* break, continue, return 0 *)
+  auto. auto. auto.
+(* return 1 *)
+  rewrite (tr_find_label_expression _ _ _ H0). auto.
+(* switch *)
+  rewrite (tr_find_label_expression _ _ _ H1). apply tr_find_label_ls. auto. constructor; auto.
+(* labeled stmt *)
+  destruct (ident_eq lbl l). exists ts0; exists tk; auto. apply IHs; auto. 
+(* goto *)
+  auto.
+
+  induction s; intros; inversion TR; subst; clear TR; simpl.
+(* default *)
+  apply tr_find_label; auto. 
+(* case *)
+  exploit (tr_find_label s (Csem.Kseq (Csem.seq_of_labeled_statement s0) k)); eauto.
+  econstructor; eauto. apply tr_seq_of_labeled_statement; eauto.
+  destruct (Csem.find_label lbl s
+    (Csem.Kseq (Csem.seq_of_labeled_statement s0) k)) as [[s' k'] | ].
+  intros [ts' [tk' [A [B C]]]]. rewrite A. exists ts'; exists tk'; auto.
+  intro EQ. rewrite EQ. eapply IHs; eauto.
+Qed.
+ 
+End FIND_LABEL.
+
+(** Anti-stuttering measure *)
+
+(** There are some stuttering steps in the translation:
+- The execution of [Sdo a] where [a] is side-effect free,
+  which is three transitions in the source:
+<<
+    Sdo a, k  --->  a, Kdo k ---> rval v, Kdo k ---> Sskip, k
+>>
+  but the translation, which is [Sskip], makes no transitions.
+- The reduction [C.Ecomma (C.Eval v) r2 --> r2].
+- The reduction [C.Eparen (C.Eval v) --> C.Eval v] in a [For_effects] context.
+
+The following measure decreases for these stuttering steps. *)
+
+Fixpoint esize (a: C.expr) : nat :=
+  match a with
+  | C.Eloc _ _ _ => 1%nat
+  | C.Evar _ _ => 1%nat
+  | C.Ederef r1 _ => S(esize r1)
+  | C.Efield l1 _ _ => S(esize l1)
+  | C.Eval _ _ => O
+  | C.Evalof l1 _ => S(esize l1)
+  | C.Eaddrof l1 _ => S(esize l1)
+  | C.Eunop _ r1 _ => S(esize r1)
+  | C.Ebinop _ r1 r2 _ => S(esize r1 + esize r2)%nat
+  | C.Ecast r1 _ => S(esize r1)
+  | C.Econdition r1 _ _ _ => S(esize r1)
+  | C.Esizeof _ _ => 1%nat
+  | C.Eassign l1 r2 _ => S(esize l1 + esize r2)%nat
+  | C.Eassignop _ l1 r2 _ _ => S(esize l1 + esize r2)%nat
+  | C.Epostincr _ l1 _ => S(esize l1)
+  | C.Ecomma r1 r2 _ => S(esize r1 + esize r2)%nat
+  | C.Ecall r1 rl2 _ => S(esize r1 + esizelist rl2)%nat
+  | C.Eparen r1 _ => S(esize r1)
+  end
+
+with esizelist (el: C.exprlist) : nat :=
+  match el with
+  | C.Enil => O
+  | C.Econs r1 rl2 => (esize r1 + esizelist rl2)%nat
+  end.
+
+Definition measure (st: Csem.state) : nat :=
+  match st with
+  | Csem.ExprState _ r _ _ _ => (esize r + 1)%nat
+  | Csem.State _ C.Sskip _ _ _ => 0%nat
+  | Csem.State _ (C.Sdo r) _ _ _ => (esize r + 2)%nat
+  | Csem.State _ (C.Sifthenelse r _ _) _ _ _ => (esize r + 2)%nat
+  | _ => 0%nat
+  end.
+
+Lemma leftcontext_size:
+  forall from to C,
+  leftcontext from to C ->
+  forall e1 e2,
+  (esize e1 < esize e2)%nat ->
+  (esize (C e1) < esize (C e2))%nat
+with leftcontextlist_size:
+  forall from C,
+  leftcontextlist from C ->
+  forall e1 e2,
+  (esize e1 < esize e2)%nat ->
+  (esizelist (C e1) < esizelist (C e2))%nat.
+Proof.
+  induction 1; intros; simpl; auto with arith. exploit leftcontextlist_size; eauto. auto with arith.
+  induction 1; intros; simpl; auto with arith. exploit leftcontext_size; eauto. auto with arith.
+Qed.
+
+(** Forward simulation for expressions. *)
+
+Lemma tr_val_gen:
+  forall le dst 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 dst (C.Eval v ty) (final dst a) a tmp.
+Proof.
+  intros. destruct dst; simpl; econstructor; auto.
+Qed.
+
+Lemma estep_simulation:
+  forall S1 t S2, Cstrategy.estep ge S1 t S2 ->
+  forall S1' (MS: match_states S1 S1'),
+  exists S2',
+     (plus step tge S1' t S2' \/
+       (star step tge S1' t S2' /\ measure S2 < measure S1)%nat)
+  /\ match_states S2 S2'.
+Proof.
+  induction 1; intros; inv MS.
+(* expr *)
+  assert (tr_expr le dest r sl a tmps).
+    inv H9. contradiction. contradiction. auto. inv H. 
+  econstructor; split.
+  right; split. apply star_refl. destruct r; simpl; (contradiction || omega).
+  econstructor; eauto.
+  instantiate (1 := tmps).
+  exploit tr_simple_rvalue; eauto. destruct dest.
+  intros [A [B C]]. subst sl. apply tr_top_val_val; auto.
+  intros A. subst sl. apply tr_top_base. constructor. 
+  intros [b [A [B C]]]. subst sl. apply tr_top_val_test; auto. 
+(* condition true *)
+  exploit tr_top_leftcontext; eauto. clear H10. 
+  intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [T [R S]]]]]]]]].
+  inv P. inv H2. 
+  (* for value *)
+  exploit tr_simple_rvalue; eauto. intros [SL [TY EV]].
+  subst sl0; simpl Kseqlist.
+  econstructor; split.
+  left. eapply plus_left. constructor.
+  eapply star_trans. apply step_makeif_true with v; auto. congruence.
+  eapply star_left. constructor. apply push_seq. 
+  reflexivity. reflexivity. traceEq.
+  replace (Kseqlist sl3 (Kseq (Sset t a2) (Kseqlist sl2 tk)))
+     with (Kseqlist (sl3 ++ Sset t a2 :: sl2) tk).
+  eapply match_exprstates; eauto. 
+  change (Sset t a2 :: sl2) with ((Sset t a2 :: nil) ++ sl2). rewrite <- app_ass. 
+  apply S. econstructor; eauto.  auto. auto. 
+  rewrite Kseqlist_app. auto. 
+  (* for effects *)
+  exploit tr_simple_rvalue; eauto. intros [SL [TY EV]].
+  subst sl0; simpl Kseqlist.
+  econstructor; split.
+  left. eapply plus_left. constructor.
+  eapply star_trans. apply step_makeif_true with v; auto. congruence.
+  apply push_seq. 
+  reflexivity. traceEq.
+  rewrite <- Kseqlist_app.
+  econstructor. eauto. apply S.
+    econstructor; eauto. apply tr_expr_monotone with tmp2; eauto. 
+    econstructor; eauto. 
+  auto. auto.
+(* condition false *)
+  exploit tr_top_leftcontext; eauto. clear H10. 
+  intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [T [R S]]]]]]]]].
+  inv P. inv H2. 
+  (* for value *)
+  exploit tr_simple_rvalue; eauto. intros [SL [TY EV]].
+  subst sl0; simpl Kseqlist.
+  econstructor; split.
+  left. eapply plus_left. constructor.
+  eapply star_trans. apply step_makeif_false with v; auto. congruence.
+  eapply star_left. constructor. apply push_seq. 
+  reflexivity. reflexivity. traceEq.
+  replace (Kseqlist sl4 (Kseq (Sset t a3) (Kseqlist sl2 tk)))
+     with (Kseqlist (sl4 ++ Sset t a3 :: sl2) tk).
+  eapply match_exprstates; eauto. 
+  change (Sset t a3 :: sl2) with ((Sset t a3 :: nil) ++ sl2). rewrite <- app_ass. 
+  apply S. econstructor; eauto.  auto. auto. 
+  rewrite Kseqlist_app. auto. 
+  (* for effects *)
+  exploit tr_simple_rvalue; eauto. intros [SL [TY EV]].
+  subst sl0; simpl Kseqlist.
+  econstructor; split.
+  left. eapply plus_left. constructor.
+  eapply star_trans. apply step_makeif_false with v; auto. congruence.
+  apply push_seq. 
+  reflexivity. traceEq.
+  rewrite <- Kseqlist_app.
+  econstructor. eauto. apply S.
+    econstructor; eauto. apply tr_expr_monotone with tmp3; eauto. 
+  auto. auto. auto.
+(* assign *)
+  exploit tr_top_leftcontext; eauto. clear H12. 
+  intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [T [R S]]]]]]]]].
+  inv P. inv H4.
+  (* for effects *)
+  exploit tr_simple_rvalue; eauto. intros [SL2 [TY2 EV2]].
+  exploit tr_simple_lvalue; eauto. intros [SL1 [TY1 EV1]].
+  subst; simpl Kseqlist.
+  econstructor; split.
+  left. eapply plus_left. constructor.
+  apply star_one. econstructor; eauto.
+  rewrite <- TY1; rewrite <- TY2; eauto.
+  rewrite <- TY1; eauto.
+  traceEq.
+  econstructor. auto. change sl2 with (nil ++ sl2). apply S.
+  constructor. auto. auto. auto.
+  (* for value *)
+  exploit tr_simple_rvalue; eauto. intros [SL2 [TY2 EV2]].
+  exploit tr_simple_lvalue. eauto.
+    eapply tr_expr_invariant with (le' := PTree.set t v le). eauto. 
+    intros. apply PTree.gso. intuition congruence.
+  intros [SL1 [TY1 EV1]].
+  subst; simpl Kseqlist.
+  econstructor; split.
+  left. eapply plus_left. constructor. 
+  eapply star_left. constructor. eauto. 
+  eapply star_left. constructor.
+  apply star_one. econstructor; eauto. constructor. apply PTree.gss.
+  simpl. rewrite <- TY1; eauto.
+  rewrite <- TY1; eauto.
+  reflexivity. reflexivity. traceEq.
+  econstructor. auto. apply S.
+  apply tr_val_gen. auto. intros. econstructor; eauto. constructor. 
+  rewrite H4; auto. apply PTree.gss. 
+  intros. apply PTree.gso. intuition congruence.
+  auto. auto.
+(* assignop *)
+  exploit tr_top_leftcontext; eauto. clear H14. 
+  intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [T [R S]]]]]]]]].
+  inv P. inv H6.
+  (* for effects *)
+  exploit tr_simple_rvalue; eauto. intros [SL2 [TY2 EV2]].
+  exploit tr_simple_lvalue; eauto. intros [SL1 [TY1 EV1]].
+  subst; simpl Kseqlist.
+  econstructor; split.
+  left. eapply plus_left. constructor.
+  apply star_one. econstructor; eauto.
+    econstructor; eauto. eapply eval_Elvalue; eauto. rewrite <- TY1; eauto. 
+    rewrite <- TY1; rewrite <- TY2; eauto.
+    rewrite <- TY1; eauto.
+    rewrite <- TY1; eauto.
+  traceEq.
+  econstructor. auto. change sl2 with (nil ++ sl2). apply S.
+  constructor. auto. auto. auto.
+  (* for value *)
+  exploit tr_simple_rvalue; eauto. intros [SL2 [TY2 EV2]].
+  exploit tr_simple_lvalue; eauto. intros [SL1 [TY1 EV1]].
+  exploit tr_simple_lvalue. eauto.
+    eapply tr_expr_invariant with (le' := PTree.set t v3 le). eauto. 
+    intros. apply PTree.gso. intuition congruence.
+  intros [SL3 [TY3 EV3]]. 
+  subst; simpl Kseqlist.
+  econstructor; split.
+  left. eapply plus_left. constructor. 
+  eapply star_left. constructor.
+    econstructor. eapply eval_Elvalue; eauto. rewrite <- TY1; eauto. eauto.
+    rewrite <- TY1; rewrite <- TY2. eauto. 
+  eapply star_left. constructor.
+  apply star_one. econstructor. eauto. constructor. apply PTree.gss. 
+    rewrite <- TY1. eauto. rewrite <- TY1. eauto.
+  reflexivity. reflexivity. traceEq.
+  econstructor. auto. apply S.
+  apply tr_val_gen. auto. intros. econstructor; eauto. constructor. 
+  rewrite H6; auto. apply PTree.gss. 
+  intros. apply PTree.gso. intuition congruence.
+  auto. auto.
+(* postincr *)
+  exploit tr_top_leftcontext; eauto. clear H13. 
+  intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [T [R S]]]]]]]]].
+  inv P. inv H5.
+  (* for effects *)
+  exploit tr_simple_lvalue; eauto. intros [SL1 [TY1 EV1]].
+  assert (EV2: eval_expr tge e le m a1 v1). eapply eval_Elvalue; eauto. rewrite <- TY1; auto.
+  subst; simpl Kseqlist.
+  econstructor; split.
+  left. eapply plus_two. constructor.
+  econstructor; eauto.
+  unfold transl_incrdecr. destruct id; simpl in H2. 
+  econstructor. eauto. constructor. simpl. rewrite <- TY1. eauto.
+  econstructor. eauto. constructor. simpl. rewrite <- TY1. eauto.
+  rewrite <- TY1. instantiate (1 := v3). destruct id; auto. 
+  rewrite <- TY1. eauto. 
+  traceEq.
+  econstructor. auto. change sl2 with (nil ++ sl2). apply S.
+  constructor. auto. auto. auto.
+  (* for value *)
+  exploit tr_simple_lvalue; eauto. intros [SL1 [TY1 EV1]].
+  exploit tr_simple_lvalue. eauto.
+    eapply tr_expr_invariant with (le' := PTree.set t v1 le). eauto. 
+    intros. apply PTree.gso. intuition congruence.
+  intros [SL2 [TY2 EV2]].
+  subst; simpl Kseqlist.
+  econstructor; split.
+  left. eapply plus_four. constructor. 
+  constructor. eapply eval_Elvalue; eauto. rewrite <- TY1; eauto.
+  constructor.
+  econstructor. eauto. 
+  unfold transl_incrdecr. destruct id; simpl in H2. 
+  econstructor. constructor. apply PTree.gss. constructor. simpl. eauto.
+  econstructor. constructor. apply PTree.gss. constructor. simpl. eauto.
+  rewrite <- TY1. instantiate (1 := v3). destruct id; auto. 
+  rewrite <- TY1. eauto. 
+  traceEq.
+  econstructor. auto. apply S.
+  apply tr_val_gen. auto. intros. econstructor; eauto.
+  rewrite H5; auto. apply PTree.gss. 
+  intros. apply PTree.gso. intuition congruence.
+  auto. auto.
+(* comma *)
+  exploit tr_top_leftcontext; eauto. clear H9. 
+  intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [T [R S]]]]]]]]].
+  inv P. inv H1.
+  exploit tr_simple_rvalue; eauto. simpl; intro SL1.
+  subst sl0; simpl Kseqlist.
+  econstructor; split.
+  right; split. apply star_refl. simpl. apply plus_lt_compat_r. 
+  apply (leftcontext_size _ _ _ H). simpl. omega. 
+  econstructor; eauto. apply S. 
+  eapply tr_expr_monotone; eauto. 
+  auto. auto. 
+(* paren *)
+  exploit tr_top_leftcontext; eauto. clear H9. 
+  intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [T [R S]]]]]]]]].
+  inv P. inv H1.
+  (* for value *)
+  exploit tr_simple_rvalue; eauto. intros [SL1 [TY1 EV1]].
+  subst sl0; simpl Kseqlist.
+  econstructor; split.
+  left. eapply plus_left. constructor. apply star_one.
+  econstructor. eauto. traceEq.
+  econstructor; eauto. change sl2 with (final For_val (Etempvar t (C.typeof r)) ++ sl2). apply S.
+  constructor. auto. intros. constructor. rewrite H1; auto. apply PTree.gss.
+  intros. apply PTree.gso. intuition congruence.
+  auto. 
+  (* for effects *)
+  econstructor; split.
+  right; split. apply star_refl. simpl. apply plus_lt_compat_r.
+  apply (leftcontext_size _ _ _ H). simpl. omega.
+  econstructor; eauto.
+  exploit tr_simple_rvalue; eauto. destruct dst'.
+  (* dst' = For_val: impossible *)
+  congruence.
+  (* dst' = For_effects: easy *)
+  intros A. subst sl1. apply S. constructor; auto. auto. auto. 
+  (* dst' = For_test: then dest is For_test as well and C is a string of C.Eparen,
+     so we can apply tr_top_paren. *)
+  intros [b [A [B D]]].
+  eapply tr_top_testcontext; eauto. 
+  subst sl1. apply tr_top_val_test; auto.
+  (* already reduced *)
+  econstructor; split.
+  right; split. apply star_refl. simpl. apply plus_lt_compat_r.
+  apply (leftcontext_size _ _ _ H). simpl. omega.
+  econstructor; eauto. instantiate (1 := @nil ident).
+  inv H7. 
+    inv H0. eapply tr_top_testcontext; eauto. constructor. auto. auto.
+    exploit tr_simple_rvalue; eauto. simpl. intros [b [A [B D]]]. 
+    eapply tr_top_testcontext; eauto. subst sl1. apply tr_top_val_test. auto. auto. 
+    inv H0.
+(* call *)
+  exploit tr_top_leftcontext; eauto. clear H12. 
+  intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [U [R S]]]]]]]]].
+  inv P. inv H5.
+  (* for effects *)
+  exploit tr_simple_rvalue; eauto. intros [SL1 [TY1 EV1]].
+  exploit tr_simple_exprlist; eauto. intros [SL2 EV2].
+  subst. simpl Kseqlist.
+  exploit functions_translated; eauto. intros [tfd [J K]].
+  econstructor; split. 
+  left. eapply plus_left. constructor.  apply star_one.
+  econstructor; eauto. rewrite <- TY1; eauto.
+  exploit type_of_fundef_preserved; eauto. congruence.
+  traceEq.
+  constructor; auto. econstructor; eauto.
+  intros. change sl2 with (nil ++ sl2). apply S.
+  constructor. auto. auto. 
+  (* for value *)
+  exploit tr_simple_rvalue; eauto. intros [SL1 [TY1 EV1]].
+  exploit tr_simple_exprlist; eauto. intros [SL2 EV2].
+  subst. simpl Kseqlist.
+  exploit functions_translated; eauto. intros [tfd [J K]].
+  econstructor; split. 
+  left. eapply plus_left. constructor.  apply star_one.
+  econstructor; eauto. rewrite <- TY1; eauto.
+  exploit type_of_fundef_preserved; eauto. congruence.
+  traceEq.
+  constructor; auto. econstructor; eauto.
+  intros. apply S.
+  destruct dst'; constructor.
+  auto. intros. constructor. rewrite H5; auto. apply PTree.gss. 
+  auto. intros. constructor. rewrite H5; auto. apply PTree.gss.  
+  intros. apply PTree.gso. intuition congruence.
+  auto. 
+Qed.
+
+(** Forward simulation for statements. *)
+
+Lemma tr_top_val_for_val_inv:
+  forall e le m v ty sl a tmps,
+  tr_top tge e le m For_val (C.Eval v ty) sl a tmps ->
+  sl = nil /\ typeof a = ty /\ eval_expr tge e le m a v.
+Proof.
+  intros. inv H. auto. inv H0. auto. 
+Qed.
+
+Lemma tr_top_val_for_test_inv:
+  forall s1 s2 e le m v ty sl a tmps,
+  tr_top tge e le m (For_test s1 s2) (C.Eval v ty) sl a tmps ->
+  exists b, sl = makeif b s1 s2 :: nil /\ typeof b = ty /\ eval_expr tge e le m b v.
+Proof.
+  intros. inv H. exists a0; auto. 
+  inv H0. exists a0; auto.
+Qed.
+
+Lemma sstep_simulation:
+  forall S1 t S2, Csem.sstep ge S1 t S2 ->
+  forall S1' (MS: match_states S1 S1'),
+  exists S2',
+     (plus step tge S1' t S2' \/
+       (star step tge S1' t S2' /\ measure S2 < measure S1)%nat)
+  /\ match_states S2 S2'.
+Proof.
+  induction 1; intros; inv MS.
+(* do 1 *)
+  inv H6. inv H0. 
+  econstructor; split.
+  right; split. apply push_seq. 
+  simpl. omega.
+  econstructor; eauto. constructor. auto.
+(* do 2 *)
+  inv H7. inv H6. inv H.  
+  econstructor; split. 
+  right; split. apply star_refl. simpl. omega.
+  econstructor; eauto. constructor.
+
+(* seq *)
+  inv H6. econstructor; split. left. apply plus_one. constructor.
+  econstructor; eauto. constructor; auto.
+(* skip seq *)
+  inv H6; inv H7. econstructor; split.
+  left. apply plus_one; constructor.
+  econstructor; eauto.
+(* continue seq *)
+  inv H6; inv H7. econstructor; split.
+  left. apply plus_one; constructor.
+  econstructor; eauto. constructor.
+(* break seq *)
+  inv H6; inv H7. econstructor; split.
+  left. apply plus_one; constructor.
+  econstructor; eauto. constructor.
+
+(* ifthenelse *)
+  inv H6.
+  (* not optimized *)
+  inv H2. econstructor; split.
+  left. eapply plus_left. constructor. apply push_seq. traceEq.
+  econstructor; eauto. econstructor; eauto.
+  (* optimized *)
+  inv H10. econstructor; split.
+  right; split. apply push_seq. simpl. omega.
+  econstructor; eauto. constructor; auto. 
+(* ifthenelse true *)
+  inv H8. 
+  (* not optimized *)
+  exploit tr_top_val_for_val_inv; eauto. intros [A [B C]]. subst. 
+  econstructor; split.
+  left. eapply plus_two. constructor.
+  apply step_ifthenelse_true with v; auto. traceEq.
+  econstructor; eauto.
+  (* optimized *)
+  exploit tr_top_val_for_test_inv; eauto. intros [b [A [B C]]]. subst. 
+  econstructor; split.
+  left. simpl. eapply plus_left. constructor.
+  apply step_makeif_true with v; auto. traceEq.
+  econstructor; eauto.
+(* ifthenelse false *)
+  inv H8. 
+  (* not optimized *)
+  exploit tr_top_val_for_val_inv; eauto. intros [A [B C]]. subst. 
+  econstructor; split.
+  left. eapply plus_two. constructor.
+  apply step_ifthenelse_false with v; auto. traceEq.
+  econstructor; eauto.
+  (* optimized *)
+  exploit tr_top_val_for_test_inv; eauto. intros [b [A [B C]]]. subst. 
+  econstructor; split.
+  left. simpl. eapply plus_left. constructor.
+  apply step_makeif_false with v; auto. traceEq.
+  econstructor; eauto.
+
+(* while *)
+  inv H6. inv H1. econstructor; split.
+  left. eapply plus_left. eapply step_while_true. constructor. 
+  simpl. constructor. apply Int.one_not_zero.
+  eapply star_left. constructor.
+  apply push_seq.
+  reflexivity. traceEq.
+  econstructor; eauto. econstructor; eauto. econstructor; eauto.
+(* while false *)
+  inv H8. 
+  exploit tr_top_val_for_test_inv; eauto. intros [b [A [B C]]]. subst. 
+  econstructor; split.
+  left. simpl. eapply plus_left. constructor.
+  eapply star_trans. apply step_makeif_false with v; auto.
+  eapply star_two. constructor. apply step_break_while. 
+  reflexivity. reflexivity. traceEq.
+  constructor; auto. constructor.
+(* while true *)
+  inv H8. 
+  exploit tr_top_val_for_test_inv; eauto. intros [b [A [B C]]]. subst. 
+  econstructor; split.
+  left. simpl. eapply plus_left. constructor.
+  eapply star_right. apply step_makeif_true with v; auto.
+  constructor.
+  reflexivity. traceEq.
+  constructor; auto. constructor; auto. 
+(* skip-or-continue while *)
+  assert (ts = Sskip \/ ts = Scontinue). destruct H; subst s0; inv H7; auto.
+  inv H8.
+  econstructor; split.
+  left. apply plus_one. apply step_skip_or_continue_while; auto. 
+  constructor; auto. constructor; auto. 
+(* break while *)
+  inv H6. inv H7. 
+  econstructor; split.
+  left. apply plus_one. apply step_break_while. 
+  constructor; auto. constructor.
+
+(* dowhile *)
+  inv H6. 
+  econstructor; split.
+  left. apply plus_one.
+  apply step_for_true with (Vint Int.one). constructor. simpl; constructor. apply Int.one_not_zero.
+  constructor; auto. constructor; auto.
+(* skip_or_continue dowhile *)
+  assert (ts = Sskip \/ ts = Scontinue). destruct H; subst s0; inv H7; auto.
+  inv H8. inv H4.
+  econstructor; split.
+  left. eapply plus_left. apply step_skip_or_continue_for2. auto.
+  apply push_seq. 
+  reflexivity. traceEq.
+  econstructor; eauto. econstructor; auto. econstructor; eauto. 
+(* dowhile false *)
+  inv H8. 
+  exploit tr_top_val_for_test_inv; eauto. intros [b [A [B C]]]. subst. 
+  econstructor; split.
+  left. simpl. eapply plus_left. constructor. 
+  eapply star_right. apply step_makeif_false with v; auto. 
+  constructor. 
+  reflexivity. traceEq.
+  constructor; auto. constructor.
+(* dowhile true *)
+  inv H8. 
+  exploit tr_top_val_for_test_inv; eauto. intros [b [A [B C]]]. subst. 
+  econstructor; split.
+  left. simpl. eapply plus_left. constructor. 
+  eapply star_right. apply step_makeif_true with v; auto. 
+  constructor. 
+  reflexivity. traceEq.
+  constructor; auto. constructor; auto. 
+(* break dowhile *)
+  inv H6. inv H7.
+  econstructor; split.
+  left. apply plus_one. apply step_break_for2. 
+  constructor; auto. constructor.
+
+(* for start *)
+  inv H7. congruence. 
+  econstructor; split. 
+  left; apply plus_one. constructor.
+  econstructor; eauto. constructor; auto. econstructor; eauto. 
+(* for *)
+  inv H6; try congruence. inv H2. 
+  econstructor; split.
+  left. eapply plus_left. apply step_for_true with (Vint Int.one). 
+    constructor. simpl; constructor. apply Int.one_not_zero.
+  eapply star_left. constructor. apply push_seq.
+  reflexivity. traceEq.
+  econstructor; eauto. constructor; auto. econstructor; eauto.
+(* for false *)
+  inv H8. exploit tr_top_val_for_test_inv; eauto. intros [b [A [B C]]]. subst.
+  econstructor; split.
+  left. simpl. eapply plus_left. constructor.
+  eapply star_trans. apply step_makeif_false with v; auto.
+  eapply star_two. constructor. apply step_break_for2. 
+  reflexivity. reflexivity. traceEq.
+  constructor; auto. constructor.
+(* for true *)
+  inv H8. exploit tr_top_val_for_test_inv; eauto. intros [b [A [B C]]]. subst.
+  econstructor; split.
+  left. simpl. eapply plus_left. constructor. 
+  eapply star_right. apply step_makeif_true with v; auto.
+  constructor.
+  reflexivity. traceEq.
+  constructor; auto. constructor; auto. 
+(* skip_or_continue for3 *)
+  assert (ts = Sskip \/ ts = Scontinue). destruct H; subst x; inv H7; auto.
+  inv H8.
+  econstructor; split.
+  left. apply plus_one. apply step_skip_or_continue_for2. auto.
+  econstructor; eauto. econstructor; auto.
+(* break for3 *)
+  inv H6. inv H7. 
+  econstructor; split.
+  left. apply plus_one. apply step_break_for2.
+  econstructor; eauto. constructor.
+(* skip for4 *)
+  inv H6. inv H7. 
+  econstructor; split.
+  left. apply plus_one. constructor.
+  econstructor; eauto. constructor; auto. 
+
+(* return none *)
+  inv H8. econstructor; split.
+  left. apply plus_one. econstructor; eauto. 
+  rewrite <- H. apply function_return_preserved; auto.
+  constructor. apply match_cont_call; auto. 
+(* return some 1 *)
+  inv H7. inv H1. econstructor; split.
+  left; eapply plus_left. constructor. apply push_seq. traceEq.
+  econstructor; eauto. constructor. auto.
+(* return some 2 *)
+  inv H9. exploit tr_top_val_for_val_inv; eauto. intros [A [B C]]. subst.
+  econstructor; split.
+  left. eapply plus_two. constructor. econstructor. eauto.
+  replace (fn_return tf) with (C.fn_return f). eauto.
+  exploit transl_function_spec; eauto. intuition congruence. 
+  eauto. traceEq.
+  constructor. apply match_cont_call; auto.
+(* skip return *)
+  inv H9. 
+  assert (is_call_cont tk). inv H10; simpl in *; auto.
+  econstructor; split.
+  left. apply plus_one. apply step_skip_call; eauto.
+  rewrite <- H0. apply function_return_preserved; auto.
+  constructor. auto.
+
+(* switch *)
+  inv H6. inv H1. 
+  econstructor; split. 
+  left; eapply plus_left. constructor. apply push_seq. traceEq.
+  econstructor; eauto. constructor; auto. 
+(* expr switch *)
+  inv H7. exploit tr_top_val_for_val_inv; eauto. intros [A [B C]]. subst.
+  econstructor; split.
+  left; eapply plus_two. constructor. econstructor; eauto. traceEq.
+  econstructor; eauto.
+  apply tr_seq_of_labeled_statement. apply tr_select_switch. auto. 
+  constructor; auto.
+
+(* skip-or-break switch *)
+  assert (ts = Sskip \/ ts = Sbreak). destruct H; subst x; inv H7; auto.
+  inv H8.
+  econstructor; split.
+  left; apply plus_one. apply step_skip_break_switch. auto. 
+  constructor; auto. constructor.
+
+(* continue switch *)
+  inv H6. inv H7.
+  econstructor; split.
+  left; apply plus_one. apply step_continue_switch.
+  constructor; auto. constructor.
+
+(* label *)
+  inv H6. econstructor; split.
+  left; apply plus_one. constructor.
+  constructor; auto.
+
+(* goto *)
+  inv H7.
+  exploit transl_function_spec; eauto. intros [A [B [C D]]].
+  exploit tr_find_label. eexact A. apply match_cont_call. eauto. 
+  instantiate (1 := lbl). rewrite H. 
+  intros [ts' [tk' [P [Q R]]]]. 
+  econstructor; split. 
+  left. apply plus_one. econstructor; eauto.
+  econstructor; eauto. 
+
+(* internal function *)
+  monadInv H7. 
+  exploit transl_function_spec; eauto. intros [A [B [C D]]].
+  econstructor; split.
+  left; apply plus_one. eapply step_internal_function. 
+  rewrite C; rewrite D; auto.
+  rewrite C; rewrite D; eauto.
+  rewrite C; eauto.
+  constructor; auto. 
+
+(* external function *)
+  monadInv H5. 
+  econstructor; split.
+  left; apply plus_one. econstructor; eauto.
+  eapply external_call_symbols_preserved; eauto. 
+  exact symbols_preserved. exact varinfo_preserved. 
+  constructor; auto.
+
+(* return *)
+  inv H3.
+  (* none *)
+  econstructor; split.
+  left; apply plus_one. constructor.
+  econstructor; eauto.
+  (* some *)
+  econstructor; split.
+  left; apply plus_one. constructor.
+  econstructor; eauto.
+Qed.
+
+(** Semantic preservation *)
+
+Theorem simulation:
+  forall S1 t S2, Cstrategy.step ge S1 t S2 ->
+  forall S1' (MS: match_states S1 S1'),
+  exists S2',
+     (plus step tge S1' t S2' \/
+       (star step tge S1' t S2' /\ measure S2 < measure S1)%nat)
+  /\ match_states S2 S2'.
+Proof.
+  intros S1 t S2 STEP. destruct STEP. 
+  apply estep_simulation; auto.
+  apply sstep_simulation; auto.
+Qed.
+
+Lemma transl_initial_states:
+  forall S,
+  Csem.initial_state prog S ->
+  exists S', Clight.initial_state tprog S' /\ match_states S S'.
+Proof.
+  intros. inv H. 
+  exploit function_ptr_translated; eauto. intros [tf [FIND TR]].
+  econstructor; split.
+  econstructor.
+  apply (Genv.init_mem_transf_partial _ _ TRANSL). eauto. 
+  simpl. fold tge. rewrite symbols_preserved.
+  replace (prog_main tprog) with (prog_main prog). eexact H1.
+  symmetry. unfold transl_program in TRANSL.
+  eapply transform_partial_program_main; eauto.
+  eexact FIND.
+  rewrite <- H3. apply type_of_fundef_preserved. auto.
+  constructor. auto. constructor.
+Qed.
+
+Lemma transl_final_states:
+  forall S S' r,
+  match_states S S' -> Csem.final_state S r -> Clight.final_state S' r.
+Proof.
+  intros. inv H0. inv H. inv H4. constructor.
+Qed.
+
+Theorem transl_program_correct:
+  forall (beh: program_behavior),
+  not_wrong beh -> Cstrategy.exec_program prog beh ->
+  Clight.exec_program tprog beh.
+Proof.
+  unfold Cstrategy.exec_program, Clight.exec_program. intros. 
+  eapply simulation_star_wf_preservation; eauto. 
+  eexact transl_initial_states.
+  eexact transl_final_states.
+  instantiate (1 := ltof _ measure). apply well_founded_ltof. 
+  exact simulation.
+Qed.
+
+End PRESERVATION.
diff --git a/cfrontend/SimplExprspec.v b/cfrontend/SimplExprspec.v
new file mode 100644
index 0000000..7829c24
--- /dev/null
+++ b/cfrontend/SimplExprspec.v
@@ -0,0 +1,815 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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. *)
+
+Require Import Coqlib.
+Require Import Errors.
+Require Import Maps.
+Require Import Integers.
+Require Import Floats.
+Require Import Values.
+Require Import Memory.
+Require Import AST.
+Require Import Csyntax.
+Require Import Clight.
+Require Import SimplExpr.
+
+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 [C.Eparen], so that reductions of [C.Econdition]
+  expressions are properly tracked;
+- three additional cases allowing [C.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: purpose) (a: expr) : list statement :=
+  match dst with
+  | For_val => nil
+  | For_effects => nil
+  | For_test s1 s2 => makeif a s1 s2 :: nil
+  end.
+
+Inductive tr_expr: temp_env -> purpose -> C.expr -> list statement -> expr -> list ident -> Prop :=
+  | tr_var: forall le dst id ty tmp,
+      tr_expr le dst (C.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 (C.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 (C.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 (C.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 (C.Eval v ty) 
+                           nil a tmp
+  | tr_val_test: forall le s1 s2 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_test s1 s2) (C.Eval v ty) 
+                   (makeif a s1 s2 :: nil) any tmp
+  | tr_sizeof: forall le dst ty' ty tmp,
+      tr_expr le dst (C.Esizeof ty' ty)
+                   (final dst (Esizeof ty' ty))
+                   (Esizeof ty' ty) tmp
+  | tr_valof: forall le dst e1 ty tmp sl1 a1,
+      tr_expr le For_val e1 sl1 a1 tmp ->
+      tr_expr le dst (C.Evalof e1 ty)
+                   (sl1 ++ final dst a1)
+                   a1 tmp
+  | tr_addrof: forall le dst e1 ty tmp sl1 a1,
+      tr_expr le For_val e1 sl1 a1 tmp ->
+      tr_expr le dst (C.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 (C.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 (C.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 (C.Ecast e1 ty)
+                   (sl1 ++ final dst (Ecast a1 ty))
+                   (Ecast a1 ty) 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_val e2 sl2 a2 tmp2 ->
+      tr_expr le For_val e3 sl3 a3 tmp3 ->
+      list_disjoint tmp1 tmp2 ->
+      list_disjoint tmp1 tmp3 ->
+      incl tmp1 tmp -> incl tmp2 tmp ->  incl tmp3 tmp ->
+      In t tmp -> ~In t tmp1 ->
+      tr_expr le For_val (C.Econdition e1 e2 e3 ty)
+                      (sl1 ++ makeif a1 
+                                (Ssequence (makeseq sl2) (Sset t a2))
+                                (Ssequence (makeseq sl3) (Sset t a3)) :: nil)
+                      (Etempvar t ty) tmp
+  | tr_condition_effects: forall le dst e1 e2 e3 ty sl1 a1 tmp1 sl2 a2 tmp2 sl3 a3 tmp3 any tmp,
+      dst <> For_val ->
+      tr_expr le For_val e1 sl1 a1 tmp1 ->
+      tr_expr le dst e2 sl2 a2 tmp2 ->
+      tr_expr le dst e3 sl3 a3 tmp3 ->
+      list_disjoint tmp1 tmp2 ->
+      list_disjoint tmp1 tmp3 ->
+      incl tmp1 tmp -> incl tmp2 tmp -> incl tmp3 tmp ->
+      tr_expr le dst (C.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 (C.Eassign e1 e2 ty)
+                      (sl1 ++ sl2 ++ Sassign 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 = C.typeof e1 ->
+      ty2 = C.typeof e2 ->
+      tr_expr le dst (C.Eassign e1 e2 ty)
+                   (sl1 ++ sl2 ++ 
+                    Sset t a2 ::
+                    Sassign a1 (Etempvar t ty2) ::
+                    final dst (Ecast (Etempvar t ty2) ty1))
+                   (Ecast (Etempvar t ty2) ty1) tmp
+  | tr_assignop_effects: forall le op e1 e2 tyres 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 (C.Eassignop op e1 e2 tyres ty)
+                      (sl1 ++ sl2 ++ Sassign a1 (Ebinop op a1 a2 tyres) :: nil)
+                      any tmp
+  | tr_assignop_val: forall le dst op e1 e2 tyres ty sl1 a1 tmp1 sl2 a2 tmp2 t tmp ty1,
+      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 ->
+      In t tmp -> ~In t tmp1 -> ~In t tmp2 ->
+      ty1 = C.typeof e1 ->
+      tr_expr le dst (C.Eassignop op e1 e2 tyres ty)
+                   (sl1 ++ sl2 ++ 
+                    Sset t (Ebinop op a1 a2 tyres) ::
+                    Sassign a1 (Etempvar t tyres) ::
+                    final dst (Ecast (Etempvar t tyres) ty1))
+                   (Ecast (Etempvar t tyres) ty1) tmp
+  | tr_postincr_effects: forall le id e1 ty sl1 a1 tmp any,
+      tr_expr le For_val e1 sl1 a1 tmp ->
+      tr_expr le For_effects (C.Epostincr id e1 ty)
+                      (sl1 ++ Sassign a1 (transl_incrdecr id a1 (C.typeof e1)) :: 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 = C.typeof e1 ->
+      tr_expr le dst (C.Epostincr id e1 ty)
+                   (sl1 ++ Sset t a1 ::
+                    Sassign 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 (C.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 (C.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 (C.Ecall e1 el2 ty)
+                   (sl1 ++ sl2 ++ Scall (Some t) a1 al2 :: final dst (Etempvar t ty))
+                   (Etempvar t ty) tmp
+  | tr_paren_val: forall le e1 ty sl1 a1 tmp1 t tmp,
+      tr_expr le For_val e1 sl1 a1 tmp1 ->
+      incl tmp1 tmp -> In t tmp -> 
+      tr_expr le For_val (C.Eparen e1 ty)
+                       (sl1 ++ Sset t a1 :: nil)
+                       (Etempvar t ty) tmp
+  | tr_paren_effects: forall le dst e1 ty sl1 a1 tmp any,
+      dst <> For_val ->
+      tr_expr le dst e1 sl1 a1 tmp ->
+      tr_expr le dst (C.Eparen e1 ty) sl1 any tmp
+
+with tr_exprlist: temp_env -> C.exprlist -> list statement -> list expr -> list ident -> Prop :=
+  | tr_nil: forall le tmp,
+      tr_exprlist le C.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 (C.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. *)
+
+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.
+Proof.
+  induction 1; intros; econstructor; eauto.
+    intros. apply H0. intros. transitivity (le'!id); auto.
+    intros. apply H0. intros. transitivity (le'!id); auto.
+  induction 1; intros; econstructor; eauto.
+Qed.
+
+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'.
+Proof.
+  induction 1; intros; econstructor; unfold incl in *; eauto.
+  induction 1; intros; econstructor; unfold incl in *; eauto.
+Qed.
+
+(** ** Top-level translation *)
+
+(** The "top-level" translation is equivalent to [tr_expr] above
+  for source terms.  It brings additional flexibility in the matching
+  between C values and Cminor expressions: in the case of
+  [tr_expr], the Cminor expression must not depend on memory,
+  while in the case of [tr_top] it can depend on the current memory
+  state.  This special case is extended to values occurring under
+  one or several [C.Eparen]. *)
+
+Section TR_TOP.
+
+Variable ge: genv.
+Variable e: env.
+Variable le: temp_env.
+Variable m: mem.
+
+Inductive tr_top: purpose -> C.expr -> list statement -> expr -> list ident -> Prop :=
+  | tr_top_val_val: forall v ty a tmp,
+      typeof a = ty -> eval_expr ge e le m a v ->
+      tr_top For_val (C.Eval v ty) nil a tmp
+  | tr_top_val_test: forall s1 s2 v ty a any tmp,
+      typeof a = ty -> eval_expr ge e le m a v ->
+      tr_top (For_test s1 s2) (C.Eval v ty) (makeif a s1 s2 :: nil) any tmp
+  | tr_top_base: forall dst r sl a tmp,
+      tr_expr le dst r sl a tmp ->
+      tr_top dst r sl a tmp
+  | tr_top_paren_test: forall s1 s2 r ty sl a tmp,
+      tr_top (For_test s1 s2) r sl a tmp ->
+      tr_top (For_test s1 s2) (C.Eparen r ty) sl a tmp.
+
+End TR_TOP.
+
+(** ** Translation of statements *)
+
+Inductive tr_expression: C.expr -> statement -> expr -> Prop :=
+  | tr_expression_intro: forall r sl a tmps,
+      (forall ge e le m, tr_top ge e le m For_val r sl a tmps) ->
+      tr_expression r (makeseq sl) a.
+
+Inductive tr_expr_stmt: C.expr -> statement -> Prop :=
+  | tr_expr_stmt_intro: forall r sl a tmps,
+      (forall ge e le m, tr_top ge e le m For_effects r sl a tmps) ->
+      tr_expr_stmt r (makeseq sl).
+
+Inductive tr_if: C.expr -> statement -> statement -> statement -> Prop :=
+  | tr_if_intro: forall r s1 s2 sl a tmps,
+      (forall ge e le m, tr_top ge e le m (For_test s1 s2) r sl a tmps) ->
+      tr_if r s1 s2 (makeseq sl).
+
+Inductive tr_stmt: C.statement -> statement -> Prop :=
+  | tr_skip:
+      tr_stmt C.Sskip Sskip
+  | tr_do: forall r s,
+      tr_expr_stmt r s ->
+      tr_stmt (C.Sdo r) s
+  | tr_seq: forall s1 s2 ts1 ts2,
+      tr_stmt s1 ts1 -> tr_stmt s2 ts2 ->
+      tr_stmt (C.Ssequence s1 s2) (Ssequence ts1 ts2)
+  | tr_ifthenelse_big: forall r s1 s2 s' a ts1 ts2,
+      tr_expression r s' a ->
+      tr_stmt s1 ts1 -> tr_stmt s2 ts2 ->
+      tr_stmt (C.Sifthenelse r s1 s2) (Ssequence s' (Sifthenelse a ts1 ts2))
+  | tr_ifthenelse_small: forall r s1 s2 ts1 ts2 ts,
+      tr_stmt s1 ts1 -> tr_stmt s2 ts2 ->
+      small_stmt ts1 = true -> small_stmt ts2 = true ->
+      tr_if r ts1 ts2 ts ->
+      tr_stmt (C.Sifthenelse r s1 s2) ts
+  | tr_while: forall r s1 s' ts1,
+      tr_if r Sskip Sbreak s' ->
+      tr_stmt s1 ts1 ->
+      tr_stmt (C.Swhile r s1)
+              (Swhile expr_true (Ssequence s' ts1))
+  | tr_dowhile: forall r s1 s' ts1,
+      tr_if r Sskip Sbreak s' ->
+      tr_stmt s1 ts1 ->
+      tr_stmt (C.Sdowhile r s1)
+              (Sfor' expr_true s' ts1)
+  | tr_for_1: forall r s3 s4 s' ts3 ts4,
+      tr_if r Sskip Sbreak s' ->
+      tr_stmt s3 ts3 ->
+      tr_stmt s4 ts4 ->
+      tr_stmt (C.Sfor C.Sskip r s3 s4)
+              (Sfor' expr_true ts3 (Ssequence s' ts4))
+  | tr_for_2: forall s1 r s3 s4 s' ts1 ts3 ts4,
+      tr_if r Sskip Sbreak s' ->
+      s1 <> C.Sskip ->
+      tr_stmt s1 ts1 ->
+      tr_stmt s3 ts3 ->
+      tr_stmt s4 ts4 ->
+      tr_stmt (C.Sfor s1 r s3 s4)
+              (Ssequence ts1 (Sfor' expr_true ts3 (Ssequence s' ts4)))
+  | tr_break:
+      tr_stmt C.Sbreak Sbreak
+  | tr_continue:
+      tr_stmt C.Scontinue Scontinue
+  | tr_return_none:
+      tr_stmt (C.Sreturn None) (Sreturn None)
+  | tr_return_some: forall r s' a,
+      tr_expression r s' a ->
+      tr_stmt (C.Sreturn (Some r)) (Ssequence s' (Sreturn (Some a)))
+  | tr_switch: forall r ls s' a tls,
+      tr_expression r s' a ->
+      tr_lblstmts ls tls ->
+      tr_stmt (C.Sswitch r ls) (Ssequence s' (Sswitch a tls))
+  | tr_label: forall lbl s ts,
+      tr_stmt s ts ->
+      tr_stmt (C.Slabel lbl s) (Slabel lbl ts)
+  | tr_goto: forall lbl,
+      tr_stmt (C.Sgoto lbl) (Sgoto lbl)
+
+with tr_lblstmts: C.labeled_statements -> labeled_statements -> Prop :=
+  | tr_default: forall s ts,
+      tr_stmt s ts ->
+      tr_lblstmts (C.LSdefault s) (LSdefault ts)
+  | tr_case: forall n s ls ts tls,
+      tr_stmt s ts ->
+      tr_lblstmts ls tls ->
+      tr_lblstmts (C.LScase n s ls) (LScase n ts tls).
+
+(** * Correctness proof with respect to the specification. *)
+
+(** ** Properties of the monad *)
+
+Remark bind_inversion:
+  forall (A B: Type) (f: mon A) (g: A -> mon B) (y: B) (z1 z3: generator) I,
+  bind f g z1 = Res y z3 I ->
+  exists x, exists z2, exists I1, exists I2,
+  f z1 = Res x z2 I1 /\ g x z2 = Res y z3 I2.
+Proof.
+  intros until I. unfold bind. destruct (f z1).
+  congruence.
+  caseEq (g a g'); intros; inv H0.
+  econstructor; econstructor; econstructor; econstructor; eauto. 
+Qed.
+
+Remark bind2_inversion:
+  forall (A B C: Type) (f: mon (A*B)) (g: A -> B -> mon C) (y: C) (z1 z3: generator) I,
+  bind2 f g z1 = Res y z3 I ->
+  exists x1, exists x2, exists z2, exists I1, exists I2,
+  f z1 = Res (x1,x2) z2 I1 /\ g x1 x2 z2 = Res y z3 I2.
+Proof.
+  unfold bind2. intros. 
+  exploit bind_inversion; eauto. 
+  intros [[x1 x2] [z2 [I1 [I2 [P Q]]]]]. simpl in Q. 
+  exists x1; exists x2; exists z2; exists I1; exists I2; auto.
+Qed.
+
+Ltac monadInv1 H :=
+  match type of H with
+  | (Res _ _ _ = Res _ _ _) =>
+      inversion H; clear H; try subst
+  | (@ret _ _ _ = Res _ _ _) =>
+      inversion H; clear H; try subst
+  | (@error _ _ _ = Res _ _ _) =>
+      inversion H
+  | (bind ?F ?G ?Z = Res ?X ?Z' ?I) =>
+      let x := fresh "x" in (
+      let z := fresh "z" in (
+      let I1 := fresh "I" in (
+      let I2 := fresh "I" in (
+      let EQ1 := fresh "EQ" in (
+      let EQ2 := fresh "EQ" in (
+      destruct (bind_inversion _ _ F G X Z Z' I H) as [x [z [I1 [I2 [EQ1 EQ2]]]]];
+      clear H;
+      try (monadInv1 EQ2)))))))
+   | (bind2 ?F ?G ?Z = Res ?X ?Z' ?I) =>
+      let x := fresh "x" in (
+      let y := fresh "y" in (
+      let z := fresh "z" in (
+      let I1 := fresh "I" in (
+      let I2 := fresh "I" in (
+      let EQ1 := fresh "EQ" in (
+      let EQ2 := fresh "EQ" in (
+      destruct (bind2_inversion _ _ _ F G X Z Z' I H) as [x [y [z [I1 [I2 [EQ1 EQ2]]]]]];
+      clear H;
+      try (monadInv1 EQ2))))))))
+ end.
+
+Ltac monadInv H :=
+  match type of H with
+  | (@ret _ _ _ = Res _ _ _) => monadInv1 H
+  | (@error _ _ _ = Res _ _ _) => monadInv1 H
+  | (bind ?F ?G ?Z = Res ?X ?Z' ?I) => monadInv1 H
+  | (bind2 ?F ?G ?Z = Res ?X ?Z' ?I) => monadInv1 H
+  | (?F _ _ _ _ _ _ _ _ = Res _ _ _) => 
+      ((progress simpl in H) || unfold F in H); monadInv1 H
+  | (?F _ _ _ _ _ _ _ = Res _ _ _) =>
+      ((progress simpl in H) || unfold F in H); monadInv1 H
+  | (?F _ _ _ _ _ _ = Res _ _ _) =>
+      ((progress simpl in H) || unfold F in H); monadInv1 H
+  | (?F _ _ _ _ _ = Res _ _ _) =>
+      ((progress simpl in H) || unfold F in H); monadInv1 H
+  | (?F _ _ _ _ = Res _ _ _) =>
+      ((progress simpl in H) || unfold F in H); monadInv1 H
+  | (?F _ _ _ = Res _ _ _) =>
+      ((progress simpl in H) || unfold F in H); monadInv1 H
+  | (?F _ _ = Res _ _ _) =>
+      ((progress simpl in H) || unfold F in H); monadInv1 H
+  | (?F _ = Res _ _ _) =>
+      ((progress simpl in H) || unfold F in H); monadInv1 H
+  end.
+
+(** ** Freshness and separation properties. *)
+
+Definition within (id: ident) (g1 g2: generator) : Prop :=
+  Ple (gen_next g1) id /\ Plt id (gen_next g2).
+
+Lemma gensym_within:
+  forall ty g1 id g2 I,
+  gensym ty g1 = Res id g2 I -> within id g1 g2.
+Proof.
+  intros. monadInv H. split. apply Ple_refl. apply Plt_succ.
+Qed.
+
+Lemma within_widen:
+  forall id g1 g2 g1' g2',
+  within id g1 g2 ->
+  Ple (gen_next g1') (gen_next g1) ->
+  Ple (gen_next g2) (gen_next g2') ->
+  within id g1' g2'.
+Proof.
+  intros. destruct H. split. 
+  eapply Ple_trans; eauto.
+  unfold Plt, Ple in *. omega. 
+Qed.
+
+Definition contained (l: list ident) (g1 g2: generator) : Prop :=
+  forall id, In id l -> within id g1 g2.
+
+Lemma contained_nil:
+  forall g1 g2, contained nil g1 g2.
+Proof.
+  intros; red; intros; contradiction.
+Qed.
+
+Lemma contained_widen:
+  forall l g1 g2 g1' g2',
+  contained l g1 g2 ->
+  Ple (gen_next g1') (gen_next g1) ->
+  Ple (gen_next g2) (gen_next g2') ->
+  contained l g1' g2'.
+Proof.
+  intros; red; intros. eapply within_widen; eauto. 
+Qed.
+
+Lemma contained_cons:
+  forall id l g1 g2,
+  within id g1 g2 -> contained l g1 g2 -> contained (id :: l) g1 g2.
+Proof.
+  intros; red; intros. simpl in H1; destruct H1. subst id0. auto. auto. 
+Qed.
+
+Lemma contained_app:
+  forall l1 l2 g1 g2,
+  contained l1 g1 g2 -> contained l2 g1 g2 -> contained (l1 ++ l2) g1 g2.
+Proof.
+  intros; red; intros. destruct (in_app_or _ _ _ H1); auto.
+Qed.
+
+Lemma contained_disjoint:
+  forall g1 l1 g2 l2 g3,
+  contained l1 g1 g2 -> contained l2 g2 g3 -> list_disjoint l1 l2.
+Proof.
+  intros; red; intros. red; intro; subst y. 
+  exploit H; eauto. intros [A B]. exploit H0; eauto. intros [C D].
+  elim (Plt_strict x). apply Plt_Ple_trans with (gen_next g2); auto.
+Qed.
+
+Lemma contained_notin:
+  forall g1 l g2 id g3,
+  contained l g1 g2 -> within id g2 g3 -> ~In id l.
+Proof.
+  intros; red; intros. exploit H; eauto. intros [C D]. destruct H0 as [A B].
+  elim (Plt_strict id). apply Plt_Ple_trans with (gen_next g2); auto.
+Qed.
+
+Hint Resolve gensym_within within_widen contained_widen
+             contained_cons contained_app contained_disjoint
+             contained_notin contained_nil 
+             incl_refl incl_tl incl_app incl_appl incl_appr
+             in_eq in_cons
+             Ple_trans Ple_refl: gensym.
+
+(** ** Correctness of the translation functions *)
+
+Lemma finish_meets_spec_1:
+  forall dst sl a sl' a',
+  finish dst sl a = (sl', a') -> sl' = sl ++ final dst a.
+Proof.
+  intros. destruct dst; simpl in *; inv H. apply app_nil_end. apply app_nil_end. auto.
+Qed.
+
+Lemma finish_meets_spec_2:
+  forall dst sl a sl' a',
+  finish dst sl a = (sl', a') -> a' = a.
+Proof.
+  intros. destruct dst; simpl in *; inv H; auto.
+Qed.
+
+Ltac UseFinish :=
+  match goal with
+  | [ H: finish _ _ _ = (_, _) |- _ ] =>
+      try (rewrite (finish_meets_spec_2 _ _ _ _ _ H));
+      try (rewrite (finish_meets_spec_1 _ _ _ _ _ H));
+      repeat rewrite app_ass
+  end.
+
+Scheme expr_ind2 := Induction for C.expr Sort Prop
+  with exprlist_ind2 := Induction for C.exprlist Sort Prop.
+Combined Scheme expr_exprlist_ind from expr_ind2, exprlist_ind2.
+
+Lemma transl_meets_spec:
+   (forall r dst g sl a g' I,
+    transl_expr dst r g = Res (sl, a) g' I ->
+    exists tmps, (forall le, tr_expr le dst r sl a tmps) /\ contained tmps g g')
+  /\
+   (forall rl g sl al g' I,
+    transl_exprlist rl g = Res (sl, al) g' I ->
+    exists tmps, (forall le, tr_exprlist le rl sl al tmps) /\ contained tmps g g').
+Proof.
+  apply expr_exprlist_ind; intros.
+(* val *)
+  simpl in H. destruct v; monadInv H; exists (@nil ident); split; auto with gensym.
+Opaque makeif.
+  intros. destruct dst; simpl in H1; inv H1. 
+    constructor. auto. intros; constructor.
+    constructor.
+    constructor. auto. intros; constructor.
+  intros. destruct dst; simpl in H1; inv H1. 
+    constructor. auto. intros; constructor.
+    constructor.
+    constructor. auto. intros; constructor.
+(* var *)
+  monadInv H; econstructor; split; auto with gensym. UseFinish. constructor.
+(* field *)
+  monadInv H0. exploit H; eauto. intros [tmp [A B]]. UseFinish. 
+  econstructor; split; eauto. constructor; auto. 
+(* valof *)
+  monadInv H0. exploit H; eauto. intros [tmp [A B]]. UseFinish.  
+  econstructor; split.
+  econstructor; eauto. eauto with gensym.
+(* deref *)
+  monadInv H0. exploit H; eauto. intros [tmp [A B]]. UseFinish. 
+  econstructor; split; eauto. constructor; auto. 
+(* addrof *)
+  monadInv H0. exploit H; eauto. intros [tmp [A B]]. UseFinish. 
+  econstructor; split; eauto. econstructor; eauto.
+(* unop *)
+  monadInv H0. exploit H; eauto. intros [tmp [A B]]. UseFinish. 
+  econstructor; split; eauto. constructor; auto. 
+(* binop *)
+  monadInv H1. exploit H; eauto. intros [tmp1 [A B]].
+  exploit H0; eauto. intros [tmp2 [C D]]. UseFinish.
+  exists (tmp1 ++ tmp2); split. 
+  econstructor; eauto with gensym.
+  eauto with gensym.
+(* cast *)
+  monadInv H0. exploit H; eauto. intros [tmp [A B]]. UseFinish. 
+  econstructor; split; eauto. constructor; auto.
+(* condition *) 
+  monadInv H2. exploit H; eauto. intros [tmp1 [A B]].
+  exploit H0; eauto. intros [tmp2 [C D]].
+  exploit H1; eauto. intros [tmp3 [E F]].
+  destruct dst; monadInv EQ3.
+  (* for value *)
+  exists (x2 :: tmp1 ++ tmp2 ++ tmp3); split. 
+  econstructor; eauto with gensym.
+  apply contained_cons. eauto with gensym. 
+  apply contained_app. eauto with gensym.
+  apply contained_app; eauto with gensym.
+  (* for effects *)
+  exists (tmp1 ++ tmp2 ++ tmp3); split.
+  econstructor; eauto with gensym. congruence.
+  apply contained_app; eauto with gensym.
+  (* for test *)
+  exists (tmp1 ++ tmp2 ++ tmp3); split.
+  econstructor; eauto with gensym. congruence.
+  apply contained_app; eauto with gensym.
+(* sizeof *)
+  monadInv H. UseFinish.
+  exists (@nil ident); split; auto with gensym. constructor.
+(* assign *)
+  monadInv H1. exploit H; eauto. intros [tmp1 [A B]].
+  exploit H0; eauto. intros [tmp2 [C D]].
+  destruct dst; monadInv EQ2.
+  (* for value *)
+  exists (x1 :: tmp1 ++ tmp2); split. 
+  intros. eapply tr_assign_val with (dst := For_val); eauto with gensym.
+  apply contained_cons. eauto with gensym. 
+  apply contained_app; eauto with gensym.
+  (* for effects *)
+  exists (tmp1 ++ tmp2); split. 
+  econstructor; eauto with gensym.
+  apply contained_app; eauto with gensym.
+  (* for test *)
+  exists (x1 :: tmp1 ++ tmp2); split.
+  repeat rewrite app_ass. simpl. 
+  intros. eapply tr_assign_val with (dst := For_test s1 s2); eauto with gensym.
+  apply contained_cons. eauto with gensym. 
+  apply contained_app; eauto with gensym.
+(* assignop *)
+  monadInv H1. exploit H; eauto. intros [tmp1 [A B]].
+  exploit H0; eauto. intros [tmp2 [C D]].
+  destruct dst; monadInv EQ2.
+  (* for value *)
+  exists (x1 :: tmp1 ++ tmp2); split.
+  intros. eapply tr_assignop_val with (dst := For_val); eauto with gensym.
+  apply contained_cons. eauto with gensym. 
+  apply contained_app; eauto with gensym.
+  (* for effects *)
+  exists (tmp1 ++ tmp2); split. 
+  econstructor; eauto with gensym.
+  apply contained_app; eauto with gensym.
+  (* for test *)
+  exists (x1 :: tmp1 ++ tmp2); split.
+  repeat rewrite app_ass. simpl.
+  intros. eapply tr_assignop_val with (dst := For_test s1 s2); eauto with gensym.
+  apply contained_cons. eauto with gensym. 
+  apply contained_app; eauto with gensym.
+(* postincr *)
+  monadInv H0. exploit H; eauto. intros [tmp1 [A B]].
+  destruct dst; monadInv EQ0.
+  (* for value *)
+  exists (x0 :: tmp1); split. 
+  econstructor; eauto with gensym.
+  apply contained_cons; eauto with gensym. 
+  (* for effects *)
+  exists tmp1; split. 
+  econstructor; eauto with gensym. auto.
+  (* for test *)
+  repeat rewrite app_ass; simpl.
+  exists (x0 :: tmp1); split. 
+  econstructor; eauto with gensym.
+  apply contained_cons; eauto with gensym. 
+(* comma *)
+  monadInv H1. exploit H; eauto. intros [tmp1 [A B]].
+  exploit H0; eauto. intros [tmp2 [C D]].
+  exists (tmp1 ++ tmp2); split. 
+  econstructor; eauto with gensym.
+  apply contained_app; eauto with gensym.
+(* call *)
+  monadInv H1. exploit H; eauto. intros [tmp1 [A B]].
+  exploit H0; eauto. intros [tmp2 [C D]].
+  destruct dst; monadInv EQ2.
+  (* for value *)
+  exists (x1 :: tmp1 ++ tmp2); split. 
+  econstructor; eauto with gensym. congruence.
+  apply contained_cons. eauto with gensym. 
+  apply contained_app; eauto with gensym.
+  (* for effects *)
+  exists (tmp1 ++ tmp2); split. 
+  econstructor; eauto with gensym.
+  apply contained_app; eauto with gensym.
+  (* for test *)
+  exists (x1 :: tmp1 ++ tmp2); split. 
+  repeat rewrite app_ass. econstructor; eauto with gensym. congruence.
+  apply contained_cons. eauto with gensym. 
+  apply contained_app; eauto with gensym.
+(* loc *)
+  monadInv H.
+
+(* paren *)
+  monadInv H0. 
+(* nil *)
+  monadInv H; exists (@nil ident); split; auto with gensym. constructor.
+(* cons *)
+  monadInv H1. exploit H; eauto. intros [tmp1 [A B]].
+  exploit H0; eauto. intros [tmp2 [C D]].
+  exists (tmp1 ++ tmp2); split. 
+  econstructor; eauto with gensym.
+  eauto with gensym.
+Qed.
+
+Lemma transl_expr_meets_spec:
+   forall r dst g sl a g' I,
+   transl_expr dst r g = Res (sl, a) g' I ->
+   exists tmps, forall ge e le m, tr_top ge e le m dst r sl a tmps.
+Proof.
+  intros. exploit (proj1 transl_meets_spec); eauto. intros [tmps [A B]].
+  exists tmps; intros. apply tr_top_base. auto. 
+Qed.
+
+Lemma transl_expression_meets_spec:
+  forall r g s a g' I,
+  transl_expression r g = Res (s, a) g' I ->
+  tr_expression r s a.
+Proof.
+  intros. monadInv H. exploit transl_expr_meets_spec; eauto. 
+  intros [tmps A]. econstructor; eauto. 
+Qed.
+
+Lemma transl_expr_stmt_meets_spec:
+  forall r g s g' I,
+  transl_expr_stmt r g = Res s g' I ->
+  tr_expr_stmt r s.
+Proof.
+  intros. monadInv H. exploit transl_expr_meets_spec; eauto. 
+  intros [tmps A]. econstructor; eauto. 
+Qed.
+
+Lemma transl_if_meets_spec:
+  forall r s1 s2 g s g' I,
+  transl_if r s1 s2 g = Res s g' I ->
+  tr_if r s1 s2 s.
+Proof.
+  intros. monadInv H. exploit transl_expr_meets_spec; eauto. 
+  intros [tmps A]. econstructor; eauto. 
+Qed.
+
+Lemma transl_stmt_meets_spec:
+  forall s g ts g' I, transl_stmt s g = Res ts g' I -> tr_stmt s ts
+with transl_lblstmt_meets_spec:
+  forall s g ts g' I, transl_lblstmt s g = Res ts g' I -> tr_lblstmts s ts.
+Proof.
+  generalize transl_expression_meets_spec transl_expr_stmt_meets_spec transl_if_meets_spec; intros T1 T2 T3.
+Opaque transl_expression transl_expr_stmt.
+  clear transl_stmt_meets_spec.
+  induction s; simpl; intros until I; intros TR; 
+  try (monadInv TR); try (constructor; eauto).
+  remember (small_stmt x && small_stmt x0). destruct b.
+  exploit andb_prop; eauto. intros [A B]. 
+  eapply tr_ifthenelse_small; eauto.
+  monadInv EQ2. eapply tr_ifthenelse_big; eauto. 
+  destruct (is_Sskip s1); monadInv EQ4.
+  apply tr_for_1; eauto.
+  apply tr_for_2; eauto. 
+  destruct o; monadInv TR; constructor; eauto.
+
+  clear transl_lblstmt_meets_spec.
+  induction s; simpl; intros until I; intros TR;
+  monadInv TR; constructor; eauto.
+Qed.
+
+Theorem transl_function_spec:
+  forall f tf,
+  transl_function f = OK tf ->
+  tr_stmt f.(C.fn_body) tf.(fn_body)
+  /\ fn_return tf = C.fn_return f
+  /\ fn_params tf = C.fn_params f
+  /\ fn_vars tf = C.fn_vars f.
+Proof.
+  intros until tf. unfold transl_function.
+  case_eq (transl_stmt (C.fn_body f) initial_generator); intros; inv H0.
+  simpl. intuition. eapply transl_stmt_meets_spec; eauto.
+Qed.
+
+End SPEC.
+