From c48b9097201dc9a1e326acdbce491fe16cab01e6 Mon Sep 17 00:00:00 2001
From: xleroy <xleroy@fca1b0fc-160b-0410-b1d3-a4f43f01ea2e>
Date: Tue, 28 Aug 2007 12:57:58 +0000
Subject: [PATCH] Fusion de la branche restr-cminor. En Clight, C#minor et
Cminor, les expressions sont maintenant pures et les appels de fonctions sont
des statements. Ajout de semantiques coinductives pour la divergence en
Clight, C#minor, Cminor. Preuve de preservation semantique pour les
programmes qui divergent.
git-svn-id: https://yquem.inria.fr/compcert/svn/compcert/trunk@409 fca1b0fc-160b-0410-b1d3-a4f43f01ea2e
---
.depend | 14 +-
backend/Cminor.v | 359 +++++-----
backend/CminorSel.v | 329 +++++----
backend/RTLgen.v | 54 +-
backend/RTLgenproof.v | 1024 ++++++++++++++++-----------
backend/RTLgenspec.v | 250 ++++---
backend/Selection.v | 25 +-
backend/Selectionproof.v | 1105 ++++++++++++++---------------
caml/CMlexer.mll | 1 +
caml/CMparser.mly | 279 +++++---
caml/CMtypecheck.ml | 76 +-
caml/Cil2Csyntax.ml | 88 ++-
caml/PrintCsyntax.ml | 43 +-
cfrontend/Cminorgen.v | 77 +-
cfrontend/Cminorgenproof.v | 1293 ++++++++++++++++------------------
cfrontend/Csem.v | 477 ++++++++-----
cfrontend/Csharpminor.v | 415 ++++++-----
cfrontend/Cshmgen.v | 89 ++-
cfrontend/Cshmgenproof1.v | 63 +-
cfrontend/Cshmgenproof2.v | 182 +++--
cfrontend/Cshmgenproof3.v | 1357 ++++++++++++++++++++++--------------
cfrontend/Csyntax.v | 9 +-
cfrontend/Ctyping.v | 96 ++-
common/Complements.v | 73 +-
common/Events.v | 10 +-
common/Main.v | 14 +-
common/Smallstep.v | 31 +-
doc/index.html | 3 +-
doc/removeproofs | 4 +-
extraction/.depend | 244 ++++---
extraction/Makefile | 4 +-
test/c/Results/lists | 1 +
test/cminor/sha1.cmp | 6 +-
33 files changed, 4572 insertions(+), 3523 deletions(-)
diff --git a/.depend b/.depend
index fb4ecb531..3a2036e6f 100644
--- a/.depend
+++ b/.depend
@@ -15,10 +15,10 @@ common/Values.vo: common/Values.v lib/Coqlib.vo common/AST.vo lib/Integers.vo li
common/Smallstep.vo: common/Smallstep.v lib/Coqlib.vo common/AST.vo common/Events.vo common/Globalenvs.vo lib/Integers.vo
common/Switch.vo: common/Switch.v lib/Coqlib.vo lib/Integers.vo
common/Main.vo: common/Main.v lib/Coqlib.vo lib/Maps.vo common/Errors.vo common/AST.vo common/Values.vo common/Smallstep.vo cfrontend/Csyntax.vo cfrontend/Csem.vo cfrontend/Csharpminor.vo backend/Cminor.vo backend/CminorSel.vo backend/RTL.vo backend/LTL.vo backend/LTLin.vo backend/Linear.vo backend/Mach.vo backend/PPC.vo cfrontend/Cshmgen.vo cfrontend/Cminorgen.vo backend/Selection.vo backend/RTLgen.vo backend/Constprop.vo backend/CSE.vo backend/Allocation.vo backend/Tunneling.vo backend/Linearize.vo backend/Reload.vo backend/Stacking.vo backend/PPCgen.vo cfrontend/Ctyping.vo backend/RTLtyping.vo backend/LTLtyping.vo backend/LTLintyping.vo backend/Lineartyping.vo backend/Machtyping.vo cfrontend/Cshmgenproof3.vo cfrontend/Cminorgenproof.vo backend/Selectionproof.vo backend/RTLgenproof.vo backend/Constpropproof.vo backend/CSEproof.vo backend/Allocproof.vo backend/Alloctyping.vo backend/Tunnelingproof.vo backend/Tunnelingtyping.vo backend/Linearizeproof.vo backend/Linearizetyping.vo backend/Reloadproof.vo backend/Reloadtyping.vo backend/Stackingproof.vo backend/Stackingtyping.vo backend/Machabstr2concr.vo backend/PPCgenproof.vo
-common/Complements.vo: common/Complements.v lib/Coqlib.vo common/AST.vo lib/Integers.vo common/Values.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo backend/PPC.vo common/Main.vo common/Errors.vo
-backend/Cminor.vo: backend/Cminor.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Events.vo common/Values.vo common/Mem.vo common/Globalenvs.vo common/Switch.vo
+common/Complements.vo: common/Complements.v lib/Coqlib.vo common/AST.vo lib/Integers.vo common/Values.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo cfrontend/Csyntax.vo cfrontend/Csem.vo backend/PPC.vo common/Main.vo common/Errors.vo
+backend/Cminor.vo: backend/Cminor.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Events.vo common/Values.vo common/Mem.vo common/Globalenvs.vo common/Smallstep.vo common/Switch.vo
backend/Op.vo: backend/Op.v lib/Coqlib.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Mem.vo common/Globalenvs.vo
-backend/CminorSel.vo: backend/CminorSel.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Events.vo common/Values.vo common/Mem.vo backend/Cminor.vo backend/Op.vo common/Globalenvs.vo common/Switch.vo
+backend/CminorSel.vo: backend/CminorSel.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Events.vo common/Values.vo common/Mem.vo backend/Cminor.vo backend/Op.vo common/Globalenvs.vo common/Switch.vo common/Smallstep.vo
backend/Selection.vo: backend/Selection.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Mem.vo common/Globalenvs.vo backend/Cminor.vo backend/Op.vo backend/CminorSel.vo
backend/Selectionproof.vo: backend/Selectionproof.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Mem.vo common/Events.vo common/Globalenvs.vo backend/Cminor.vo backend/Op.vo backend/CminorSel.vo backend/Selection.vo
backend/Registers.vo: backend/Registers.v lib/Coqlib.vo common/AST.vo lib/Maps.vo lib/Ordered.vo
@@ -71,12 +71,12 @@ backend/PPCgenretaddr.vo: backend/PPCgenretaddr.v lib/Coqlib.vo lib/Maps.vo comm
backend/PPCgenproof1.vo: backend/PPCgenproof1.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Mem.vo common/Globalenvs.vo backend/Op.vo backend/Locations.vo backend/Mach.vo backend/Machconcr.vo backend/Machtyping.vo backend/PPC.vo backend/PPCgen.vo backend/Conventions.vo
backend/PPCgenproof.vo: backend/PPCgenproof.v lib/Coqlib.vo lib/Maps.vo common/Errors.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Mem.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo backend/Op.vo backend/Locations.vo backend/Mach.vo backend/Machconcr.vo backend/Machtyping.vo backend/PPC.vo backend/PPCgen.vo backend/PPCgenretaddr.vo backend/PPCgenproof1.vo
cfrontend/Csyntax.vo: cfrontend/Csyntax.v lib/Coqlib.vo common/Errors.vo lib/Integers.vo lib/Floats.vo common/AST.vo
-cfrontend/Csem.vo: cfrontend/Csem.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/AST.vo common/Mem.vo common/Events.vo common/Globalenvs.vo cfrontend/Csyntax.vo
+cfrontend/Csem.vo: cfrontend/Csem.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/AST.vo common/Mem.vo common/Events.vo common/Globalenvs.vo cfrontend/Csyntax.vo common/Smallstep.vo
cfrontend/Ctyping.vo: cfrontend/Ctyping.v lib/Coqlib.vo lib/Maps.vo common/AST.vo cfrontend/Csyntax.vo
cfrontend/Cshmgen.vo: cfrontend/Cshmgen.v lib/Coqlib.vo common/Errors.vo lib/Integers.vo lib/Floats.vo common/AST.vo cfrontend/Csyntax.vo backend/Cminor.vo cfrontend/Csharpminor.vo
cfrontend/Cshmgenproof1.vo: cfrontend/Cshmgenproof1.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo lib/Integers.vo lib/Floats.vo common/AST.vo common/Values.vo common/Events.vo common/Mem.vo common/Globalenvs.vo cfrontend/Csyntax.vo cfrontend/Csem.vo cfrontend/Ctyping.vo backend/Cminor.vo cfrontend/Csharpminor.vo cfrontend/Cshmgen.vo
cfrontend/Cshmgenproof2.vo: cfrontend/Cshmgenproof2.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo lib/Integers.vo lib/Floats.vo common/AST.vo common/Values.vo common/Events.vo common/Mem.vo common/Globalenvs.vo cfrontend/Csyntax.vo cfrontend/Csem.vo cfrontend/Ctyping.vo backend/Cminor.vo cfrontend/Csharpminor.vo cfrontend/Cshmgen.vo cfrontend/Cshmgenproof1.vo
-cfrontend/Cshmgenproof3.vo: cfrontend/Cshmgenproof3.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo lib/Integers.vo lib/Floats.vo common/AST.vo common/Values.vo common/Events.vo common/Mem.vo common/Globalenvs.vo cfrontend/Csyntax.vo cfrontend/Csem.vo cfrontend/Ctyping.vo backend/Cminor.vo cfrontend/Csharpminor.vo cfrontend/Cshmgen.vo cfrontend/Cshmgenproof1.vo cfrontend/Cshmgenproof2.vo
-cfrontend/Csharpminor.vo: cfrontend/Csharpminor.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Mem.vo common/Events.vo common/Globalenvs.vo backend/Cminor.vo
+cfrontend/Cshmgenproof3.vo: cfrontend/Cshmgenproof3.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo lib/Integers.vo lib/Floats.vo common/AST.vo common/Values.vo common/Events.vo common/Mem.vo common/Globalenvs.vo common/Smallstep.vo cfrontend/Csyntax.vo cfrontend/Csem.vo cfrontend/Ctyping.vo backend/Cminor.vo cfrontend/Csharpminor.vo cfrontend/Cshmgen.vo cfrontend/Cshmgenproof1.vo cfrontend/Cshmgenproof2.vo
+cfrontend/Csharpminor.vo: cfrontend/Csharpminor.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Mem.vo common/Events.vo common/Globalenvs.vo backend/Cminor.vo common/Smallstep.vo
cfrontend/Cminorgen.vo: cfrontend/Cminorgen.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo lib/Ordered.vo common/AST.vo lib/Integers.vo common/Mem.vo cfrontend/Csharpminor.vo backend/Op.vo backend/Cminor.vo
-cfrontend/Cminorgenproof.vo: cfrontend/Cminorgenproof.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Mem.vo common/Events.vo common/Globalenvs.vo cfrontend/Csharpminor.vo backend/Cminor.vo cfrontend/Cminorgen.vo
+cfrontend/Cminorgenproof.vo: cfrontend/Cminorgenproof.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Mem.vo common/Events.vo common/Globalenvs.vo cfrontend/Csharpminor.vo backend/Op.vo backend/Cminor.vo cfrontend/Cminorgen.vo
diff --git a/backend/Cminor.v b/backend/Cminor.v
index 2b9945ac7..1d2eea74d 100644
--- a/backend/Cminor.v
+++ b/backend/Cminor.v
@@ -9,6 +9,7 @@ Require Import Events.
Require Import Values.
Require Import Mem.
Require Import Globalenvs.
+Require Import Smallstep.
Require Import Switch.
(** * Abstract syntax *)
@@ -61,12 +62,8 @@ Inductive binary_operation : Set :=
| Ocmpf: comparison -> binary_operation. (**r float comparison *)
(** Expressions include reading local variables, constants and
- arithmetic operations, reading and writing store locations,
- function calls, and conditional expressions
- (similar to [e1 ? e2 : e3] in C).
- The [Elet] and [Eletvar] constructs enable sharing the computations
- of subexpressions. De Bruijn notation is used: [Eletvar n] refers
- to the value bound by then [n+1]-th enclosing [Elet] construct. *)
+ arithmetic operations, reading store locations, and conditional
+ expressions (similar to [e1 ? e2 : e3] in C). *)
Inductive expr : Set :=
| Evar : ident -> expr
@@ -74,26 +71,20 @@ Inductive expr : Set :=
| Eunop : unary_operation -> expr -> expr
| Ebinop : binary_operation -> expr -> expr -> expr
| Eload : memory_chunk -> expr -> expr
- | Estore : memory_chunk -> expr -> expr -> expr
- | Ecall : signature -> expr -> exprlist -> expr
- | Econdition : expr -> expr -> expr -> expr
- | Elet : expr -> expr -> expr
- | Eletvar : nat -> expr
- | Ealloc : expr -> expr
-
-with exprlist : Set :=
- | Enil: exprlist
- | Econs: expr -> exprlist -> exprlist.
+ | Econdition : expr -> expr -> expr -> expr.
(** Statements include expression evaluation, assignment to local variables,
- an if/then/else conditional, infinite loops, blocks and early block
- exits, and early function returns. [Sexit n] terminates prematurely
- the execution of the [n+1] enclosing [Sblock] statements. *)
+ memory stores, function calls, an if/then/else conditional, infinite
+ loops, blocks and early block exits, and early function returns.
+ [Sexit n] terminates prematurely the execution of the [n+1]
+ enclosing [Sblock] statements. *)
Inductive stmt : Set :=
| Sskip: stmt
- | Sexpr: expr -> stmt
| Sassign : ident -> expr -> stmt
+ | Sstore : memory_chunk -> expr -> expr -> stmt
+ | Scall : option ident -> signature -> expr -> list expr -> stmt
+ | Salloc : ident -> expr -> stmt
| Sseq: stmt -> stmt -> stmt
| Sifthenelse: expr -> stmt -> stmt -> stmt
| Sloop: stmt -> stmt
@@ -101,7 +92,7 @@ Inductive stmt : Set :=
| Sexit: nat -> stmt
| Sswitch: expr -> list (int * nat) -> nat -> stmt
| Sreturn: option expr -> stmt
- | Stailcall: signature -> expr -> exprlist -> stmt.
+ | Stailcall: signature -> expr -> list expr -> stmt.
(** Functions are composed of a signature, a list of parameter names,
a list of local variables, and a statement representing
@@ -163,15 +154,13 @@ Definition outcome_free_mem
| _ => Mem.free m sp
end.
-(** Three kinds of evaluation environments are involved:
+(** Two kinds of evaluation environments are involved:
- [genv]: global environments, define symbols and functions;
-- [env]: local environments, map local variables to values;
-- [lenv]: let environments, map de Bruijn indices to values.
+- [env]: local environments, map local variables to values.
*)
Definition genv := Genv.t fundef.
Definition env := PTree.t val.
-Definition letenv := list val.
(** The following functions build the initial local environment at
function entry, binding parameters to the provided arguments and
@@ -190,6 +179,12 @@ Fixpoint set_locals (il: list ident) (e: env) {struct il} : env :=
| i1 :: is => PTree.set i1 Vundef (set_locals is e)
end.
+Definition set_optvar (optid: option ident) (v: val) (e: env) : env :=
+ match optid with
+ | None => e
+ | Some id => PTree.set id v e
+ end.
+
Section RELSEM.
Variable ge: genv.
@@ -288,112 +283,62 @@ Definition eval_binop
| _, _, _ => None
end.
-(** Evaluation of an expression: [eval_expr ge sp le e m a t m' v]
- states that expression [a], in initial local environment [e] and
- memory state [m], evaluates to value [v]. [m'] is the final
- memory state, reflecting memory stores possibly performed by [a].
- [t] is the trace of I/O events generated during the evaluation.
- Expressions do not assign variables, therefore the local environment
- [e] is unchanged. [ge] and [le] are the global environment and let
- environment respectively, and are unchanged during evaluation. [sp]
- is the pointer to the memory block allocated for this function
+(** Evaluation of an expression: [eval_expr ge sp e m a v]
+ states that expression [a] evaluates to value [v].
+ [ge] is the global environment, [e] the local environment,
+ and [m] the current memory state. They are unchanged during evaluation.
+ [sp] is the pointer to the memory block allocated for this function
(stack frame).
*)
-Inductive eval_expr:
- val -> letenv -> env ->
- mem -> expr -> trace -> mem -> val -> Prop :=
- | eval_Evar:
- forall sp le e m id v,
+Section EVAL_EXPR.
+
+Variable sp: val.
+Variable e: env.
+Variable m: mem.
+
+Inductive eval_expr: expr -> val -> Prop :=
+ | eval_Evar: forall id v,
PTree.get id e = Some v ->
- eval_expr sp le e m (Evar id) E0 m v
- | eval_Econst:
- forall sp le e m cst v,
+ eval_expr (Evar id) v
+ | eval_Econst: forall cst v,
eval_constant sp cst = Some v ->
- eval_expr sp le e m (Econst cst) E0 m v
- | eval_Eunop:
- forall sp le e m op a t m1 v1 v,
- eval_expr sp le e m a t m1 v1 ->
+ eval_expr (Econst cst) v
+ | eval_Eunop: forall op a1 v1 v,
+ eval_expr a1 v1 ->
eval_unop op v1 = Some v ->
- eval_expr sp le e m (Eunop op a) t m1 v
- | eval_Ebinop:
- forall sp le e m op a1 a2 t1 m1 v1 t2 m2 v2 t v,
- eval_expr sp le e m a1 t1 m1 v1 ->
- eval_expr sp le e m1 a2 t2 m2 v2 ->
- eval_binop op v1 v2 m2 = Some v ->
- t = t1 ** t2 ->
- eval_expr sp le e m (Ebinop op a1 a2) t m2 v
- | eval_Eload:
- forall sp le e m chunk a t m1 v1 v,
- eval_expr sp le e m a t m1 v1 ->
- Mem.loadv chunk m1 v1 = Some v ->
- eval_expr sp le e m (Eload chunk a) t m1 v
- | eval_Estore:
- forall sp le e m chunk a1 a2 t t1 m1 v1 t2 m2 v2 m3,
- eval_expr sp le e m a1 t1 m1 v1 ->
- eval_expr sp le e m1 a2 t2 m2 v2 ->
- Mem.storev chunk m2 v1 v2 = Some m3 ->
- t = t1 ** t2 ->
- eval_expr sp le e m (Estore chunk a1 a2) t m3 v2
- | eval_Ecall:
- forall sp le e m sig a bl t t1 m1 t2 m2 t3 m3 vf vargs vres f,
- eval_expr sp le e m a t1 m1 vf ->
- eval_exprlist sp le e m1 bl t2 m2 vargs ->
- Genv.find_funct ge vf = Some f ->
- funsig f = sig ->
- eval_funcall m2 f vargs t3 m3 vres ->
- t = t1 ** t2 ** t3 ->
- eval_expr sp le e m (Ecall sig a bl) t m3 vres
- | eval_Econdition:
- forall sp le e m a1 a2 a3 t t1 m1 v1 b1 t2 m2 v2,
- eval_expr sp le e m a1 t1 m1 v1 ->
+ eval_expr (Eunop op a1) v
+ | eval_Ebinop: forall op a1 a2 v1 v2 v,
+ eval_expr a1 v1 ->
+ eval_expr a2 v2 ->
+ eval_binop op v1 v2 m = Some v ->
+ eval_expr (Ebinop op a1 a2) v
+ | eval_Eload: forall chunk addr vaddr v,
+ eval_expr addr vaddr ->
+ Mem.loadv chunk m vaddr = Some v ->
+ eval_expr (Eload chunk addr) v
+ | eval_Econdition: forall a1 a2 a3 v1 b1 v2,
+ eval_expr a1 v1 ->
Val.bool_of_val v1 b1 ->
- eval_expr sp le e m1 (if b1 then a2 else a3) t2 m2 v2 ->
- t = t1 ** t2 ->
- eval_expr sp le e m (Econdition a1 a2 a3) t m2 v2
- | eval_Elet:
- forall sp le e m a b t t1 m1 v1 t2 m2 v2,
- eval_expr sp le e m a t1 m1 v1 ->
- eval_expr sp (v1::le) e m1 b t2 m2 v2 ->
- t = t1 ** t2 ->
- eval_expr sp le e m (Elet a b) t m2 v2
- | eval_Eletvar:
- forall sp le e m n v,
- nth_error le n = Some v ->
- eval_expr sp le e m (Eletvar n) E0 m v
- | eval_Ealloc:
- forall sp le e m a t m1 n m2 b,
- eval_expr sp le e m a t m1 (Vint n) ->
- Mem.alloc m1 0 (Int.signed n) = (m2, b) ->
- eval_expr sp le e m (Ealloc a) t m2 (Vptr b Int.zero)
-
-(** Evaluation of a list of expressions:
- [eval_exprlist ge sp le al m a m' vl]
- states that the list [al] of expressions evaluate
- to the list [vl] of values.
- The other parameters are as in [eval_expr].
-*)
+ eval_expr (if b1 then a2 else a3) v2 ->
+ eval_expr (Econdition a1 a2 a3) v2.
-with eval_exprlist:
- val -> letenv -> env ->
- mem -> exprlist -> trace -> mem -> list val -> Prop :=
+Inductive eval_exprlist: list expr -> list val -> Prop :=
| eval_Enil:
- forall sp le e m,
- eval_exprlist sp le e m Enil E0 m nil
- | eval_Econs:
- forall sp le e m a bl t t1 m1 v t2 m2 vl,
- eval_expr sp le e m a t1 m1 v ->
- eval_exprlist sp le e m1 bl t2 m2 vl ->
- t = t1 ** t2 ->
- eval_exprlist sp le e m (Econs a bl) t m2 (v :: vl)
+ eval_exprlist nil nil
+ | eval_Econs: forall a1 al v1 vl,
+ eval_expr a1 v1 -> eval_exprlist al vl ->
+ eval_exprlist (a1 :: al) (v1 :: vl).
+
+End EVAL_EXPR.
-(** Evaluation of a function invocation: [eval_funcall ge m f args m' res]
+(** Evaluation of a function invocation: [eval_funcall ge m f args t m' res]
means that the function [f], applied to the arguments [args] in
memory state [m], returns the value [res] in modified memory state [m'].
[t] is the trace of observable events generated during the invocation.
*)
-with eval_funcall:
+Inductive eval_funcall:
mem -> fundef -> list val -> trace ->
mem -> val -> Prop :=
| eval_funcall_internal:
@@ -408,12 +353,13 @@ with eval_funcall:
event_match ef args t res ->
eval_funcall m (External ef) args t m res
-(** Execution of a statement: [exec_stmt ge sp e m s e' m' out]
+(** Execution of a statement: [exec_stmt ge sp e m s t e' m' out]
means that statement [s] executes with outcome [out].
[e] is the initial environment and [m] is the initial memory state.
[e'] is the final environment, reflecting variable assignments performed
by [s]. [m'] is the final memory state, reflecting memory stores
- performed by [s]. The other parameters are as in [eval_expr]. *)
+ performed by [s]. [t] is the trace of I/O events performed during
+ the execution. The other parameters are as in [eval_expr]. *)
with exec_stmt:
val ->
@@ -422,21 +368,37 @@ with exec_stmt:
| exec_Sskip:
forall sp e m,
exec_stmt sp e m Sskip E0 e m Out_normal
- | exec_Sexpr:
- forall sp e m a t m1 v,
- eval_expr sp nil e m a t m1 v ->
- exec_stmt sp e m (Sexpr a) t e m1 Out_normal
| exec_Sassign:
- forall sp e m id a t m1 v,
- eval_expr sp nil e m a t m1 v ->
- exec_stmt sp e m (Sassign id a) t (PTree.set id v e) m1 Out_normal
+ forall sp e m id a v,
+ eval_expr sp e m a v ->
+ exec_stmt sp e m (Sassign id a) E0 (PTree.set id v e) m Out_normal
+ | exec_Sstore:
+ forall sp e m chunk addr a vaddr v m',
+ eval_expr sp e m addr vaddr ->
+ eval_expr sp e m a v ->
+ Mem.storev chunk m vaddr v = Some m' ->
+ exec_stmt sp e m (Sstore chunk addr a) E0 e m' Out_normal
+ | exec_Scall:
+ forall sp e m optid sig a bl vf vargs f t m' vres e',
+ eval_expr sp e m a vf ->
+ eval_exprlist sp e m bl vargs ->
+ Genv.find_funct ge vf = Some f ->
+ funsig f = sig ->
+ eval_funcall m f vargs t m' vres ->
+ e' = set_optvar optid vres e ->
+ exec_stmt sp e m (Scall optid sig a bl) t e' m' Out_normal
+ | exec_Salloc:
+ forall sp e m id a n m' b,
+ eval_expr sp e m a (Vint n) ->
+ Mem.alloc m 0 (Int.signed n) = (m', b) ->
+ exec_stmt sp e m (Salloc id a)
+ E0 (PTree.set id (Vptr b Int.zero) e) m' Out_normal
| exec_Sifthenelse:
- forall sp e m a s1 s2 t t1 m1 v1 b1 t2 e2 m2 out,
- eval_expr sp nil e m a t1 m1 v1 ->
- Val.bool_of_val v1 b1 ->
- exec_stmt sp e m1 (if b1 then s1 else s2) t2 e2 m2 out ->
- t = t1 ** t2 ->
- exec_stmt sp e m (Sifthenelse a s1 s2) t e2 m2 out
+ forall sp e m a s1 s2 v b t e' m' out,
+ eval_expr sp e m a v ->
+ Val.bool_of_val v b ->
+ exec_stmt sp e m (if b then s1 else s2) t e' m' out ->
+ exec_stmt sp e m (Sifthenelse a s1 s2) t e' m' out
| exec_Sseq_continue:
forall sp e m t s1 t1 e1 m1 s2 t2 e2 m2 out,
exec_stmt sp e m s1 t1 e1 m1 Out_normal ->
@@ -467,46 +429,121 @@ with exec_stmt:
forall sp e m n,
exec_stmt sp e m (Sexit n) E0 e m (Out_exit n)
| exec_Sswitch:
- forall sp e m a cases default t1 m1 n,
- eval_expr sp nil e m a t1 m1 (Vint n) ->
+ forall sp e m a cases default n,
+ eval_expr sp e m a (Vint n) ->
exec_stmt sp e m (Sswitch a cases default)
- t1 e m1 (Out_exit (switch_target n default cases))
+ E0 e m (Out_exit (switch_target n default cases))
| exec_Sreturn_none:
forall sp e m,
exec_stmt sp e m (Sreturn None) E0 e m (Out_return None)
| exec_Sreturn_some:
- forall sp e m a t m1 v,
- eval_expr sp nil e m a t m1 v ->
- exec_stmt sp e m (Sreturn (Some a)) t e m1 (Out_return (Some v))
+ forall sp e m a v,
+ eval_expr sp e m a v ->
+ exec_stmt sp e m (Sreturn (Some a)) E0 e m (Out_return (Some v))
| exec_Stailcall:
- forall sp e m sig a bl t t1 m1 t2 m2 t3 m3 vf vargs vres f,
- eval_expr (Vptr sp Int.zero) nil e m a t1 m1 vf ->
- eval_exprlist (Vptr sp Int.zero) nil e m1 bl t2 m2 vargs ->
+ forall sp e m sig a bl vf vargs f t m' vres,
+ eval_expr (Vptr sp Int.zero) e m a vf ->
+ eval_exprlist (Vptr sp Int.zero) e m bl vargs ->
Genv.find_funct ge vf = Some f ->
funsig f = sig ->
- eval_funcall (Mem.free m2 sp) f vargs t3 m3 vres ->
- t = t1 ** t2 ** t3 ->
- exec_stmt (Vptr sp Int.zero) e m (Stailcall sig a bl) t e m3 (Out_tailcall_return vres).
+ eval_funcall (Mem.free m sp) f vargs t m' vres ->
+ exec_stmt (Vptr sp Int.zero) e m (Stailcall sig a bl) t e m' (Out_tailcall_return vres).
-Scheme eval_expr_ind4 := Minimality for eval_expr Sort Prop
- with eval_exprlist_ind4 := Minimality for eval_exprlist Sort Prop
- with eval_funcall_ind4 := Minimality for eval_funcall Sort Prop
- with exec_stmt_ind4 := Minimality for exec_stmt Sort Prop.
-
-End RELSEM.
+Scheme eval_funcall_ind2 := Minimality for eval_funcall Sort Prop
+ with exec_stmt_ind2 := Minimality for exec_stmt Sort Prop.
-(** Execution of a whole program: [exec_program p t r]
- holds if the application of [p]'s main function to no arguments
- in the initial memory state for [p] performs the input/output
- operations described in the trace [t], and eventually returns value [r].
+(** Coinductive semantics for divergence.
+ [evalinf_funcall ge m f args t]
+ means that the function [f] diverges when applied to the arguments [args] in
+ memory state [m]. The infinite trace [t] is the trace of
+ observable events generated during the invocation.
*)
-Definition exec_program (p: program) (t: trace) (r: val) : Prop :=
- let ge := Genv.globalenv p in
- let m0 := Genv.init_mem p in
- exists b, exists f, exists m,
- Genv.find_symbol ge p.(prog_main) = Some b /\
- Genv.find_funct_ptr ge b = Some f /\
- funsig f = mksignature nil (Some Tint) /\
- eval_funcall ge m0 f nil t m r.
+CoInductive evalinf_funcall:
+ mem -> fundef -> list val -> traceinf -> Prop :=
+ | evalinf_funcall_internal:
+ forall m f vargs m1 sp e t,
+ Mem.alloc m 0 f.(fn_stackspace) = (m1, sp) ->
+ set_locals f.(fn_vars) (set_params vargs f.(fn_params)) = e ->
+ execinf_stmt (Vptr sp Int.zero) e m1 f.(fn_body) t ->
+ evalinf_funcall m (Internal f) vargs t
+
+(** [execinf_stmt ge sp e m s t] means that statement [s] diverges.
+ [e] is the initial environment, [m] is the initial memory state,
+ and [t] the trace of observable events performed during the execution. *)
+
+with execinf_stmt:
+ val -> env -> mem -> stmt -> traceinf -> Prop :=
+ | execinf_Scall:
+ forall sp e m optid sig a bl vf vargs f t,
+ eval_expr sp e m a vf ->
+ eval_exprlist sp e m bl vargs ->
+ Genv.find_funct ge vf = Some f ->
+ funsig f = sig ->
+ evalinf_funcall m f vargs t ->
+ execinf_stmt sp e m (Scall optid sig a bl) t
+ | execinf_Sifthenelse:
+ forall sp e m a s1 s2 v b t,
+ eval_expr sp e m a v ->
+ Val.bool_of_val v b ->
+ execinf_stmt sp e m (if b then s1 else s2) t ->
+ execinf_stmt sp e m (Sifthenelse a s1 s2) t
+ | execinf_Sseq_1:
+ forall sp e m t s1 s2,
+ execinf_stmt sp e m s1 t ->
+ execinf_stmt sp e m (Sseq s1 s2) t
+ | execinf_Sseq_2:
+ forall sp e m t s1 t1 e1 m1 s2 t2,
+ exec_stmt sp e m s1 t1 e1 m1 Out_normal ->
+ execinf_stmt sp e1 m1 s2 t2 ->
+ t = t1 *** t2 ->
+ execinf_stmt sp e m (Sseq s1 s2) t
+ | execinf_Sloop_body:
+ forall sp e m s t,
+ execinf_stmt sp e m s t ->
+ execinf_stmt sp e m (Sloop s) t
+ | execinf_Sloop_loop:
+ forall sp e m s t t1 e1 m1 t2,
+ exec_stmt sp e m s t1 e1 m1 Out_normal ->
+ execinf_stmt sp e1 m1 (Sloop s) t2 ->
+ t = t1 *** t2 ->
+ execinf_stmt sp e m (Sloop s) t
+ | execinf_Sblock:
+ forall sp e m s t,
+ execinf_stmt sp e m s t ->
+ execinf_stmt sp e m (Sblock s) t
+ | execinf_Stailcall:
+ forall sp e m sig a bl vf vargs f t,
+ eval_expr (Vptr sp Int.zero) e m a vf ->
+ eval_exprlist (Vptr sp Int.zero) e m bl vargs ->
+ Genv.find_funct ge vf = Some f ->
+ funsig f = sig ->
+ evalinf_funcall (Mem.free m sp) f vargs t ->
+ execinf_stmt (Vptr sp Int.zero) e m (Stailcall sig a bl) t.
+
+End RELSEM.
+(** 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. *)
+
+Inductive exec_program (p: program): program_behavior -> Prop :=
+ | program_terminates:
+ forall b f t m r,
+ let ge := Genv.globalenv p in
+ let m0 := Genv.init_mem p in
+ Genv.find_symbol ge p.(prog_main) = Some b ->
+ Genv.find_funct_ptr ge b = Some f ->
+ funsig f = mksignature nil (Some Tint) ->
+ eval_funcall ge m0 f nil t m (Vint r) ->
+ exec_program p (Terminates t r)
+ | program_diverges:
+ forall b f t,
+ let ge := Genv.globalenv p in
+ let m0 := Genv.init_mem p in
+ Genv.find_symbol ge p.(prog_main) = Some b ->
+ Genv.find_funct_ptr ge b = Some f ->
+ funsig f = mksignature nil (Some Tint) ->
+ evalinf_funcall ge m0 f nil t ->
+ exec_program p (Diverges t).
diff --git a/backend/CminorSel.v b/backend/CminorSel.v
index 331105ead..859c46e75 100644
--- a/backend/CminorSel.v
+++ b/backend/CminorSel.v
@@ -12,6 +12,7 @@ Require Import Cminor.
Require Import Op.
Require Import Globalenvs.
Require Import Switch.
+Require Import Smallstep.
(** * Abstract syntax *)
@@ -19,7 +20,10 @@ Require Import Switch.
functions, statements and expressions. However, CminorSel uses
machine-dependent operations, addressing modes and conditions,
as defined in module [Op] and used in lower-level intermediate
- languages ([RTL] and below). Moreover, a variant [condexpr] of [expr]
+ languages ([RTL] and below). Moreover, to express sharing of
+ sub-computations, a "let" binding is provided (constructions
+ [Elet] and [Eletvar]), using de Bruijn indices to refer to "let"-bound
+ variables. Finally, a variant [condexpr] of [expr]
is used to represent expressions which are evaluated for their
boolean value only and not their exact value.
*)
@@ -28,12 +32,9 @@ Inductive expr : Set :=
| Evar : ident -> expr
| Eop : operation -> exprlist -> expr
| Eload : memory_chunk -> addressing -> exprlist -> expr
- | Estore : memory_chunk -> addressing -> exprlist -> expr -> expr
- | Ecall : signature -> expr -> exprlist -> expr
| Econdition : condexpr -> expr -> expr -> expr
| Elet : expr -> expr -> expr
| Eletvar : nat -> expr
- | Ealloc : expr -> expr
with condexpr : Set :=
| CEtrue: condexpr
@@ -46,12 +47,15 @@ with exprlist : Set :=
| Econs: expr -> exprlist -> exprlist.
(** Statements are as in Cminor, except that the condition of an
- if/then/else conditional is a [condexpr]. *)
+ if/then/else conditional is a [condexpr], and the [Sstore] construct
+ uses a machine-dependent addressing mode. *)
Inductive stmt : Set :=
| Sskip: stmt
- | Sexpr: expr -> stmt
| Sassign : ident -> expr -> stmt
+ | Sstore : memory_chunk -> addressing -> exprlist -> expr -> stmt
+ | Scall : option ident -> signature -> expr -> exprlist -> stmt
+ | Salloc : ident -> expr -> stmt
| Sseq: stmt -> stmt -> stmt
| Sifthenelse: condexpr -> stmt -> stmt -> stmt
| Sloop: stmt -> stmt
@@ -87,6 +91,7 @@ Definition funsig (fd: fundef) :=
*)
Definition genv := Genv.t fundef.
+Definition letenv := list val.
Section RELSEM.
@@ -96,101 +101,68 @@ Variable ge: genv.
of Cminor. Refer to the description of Cminor semantics for
the meaning of the parameters of the predicates.
One additional predicate is introduced:
- [eval_condexpr ge sp le e m a t m' b], meaning that the conditional
+ [eval_condexpr ge sp e m le a b], meaning that the conditional
expression [a] evaluates to the boolean [b]. *)
-Inductive eval_expr:
- val -> letenv -> env ->
- mem -> expr -> trace -> mem -> val -> Prop :=
- | eval_Evar:
- forall sp le e m id v,
+Section EVAL_EXPR.
+
+Variable sp: val.
+Variable e: env.
+Variable m: mem.
+
+Inductive eval_expr: letenv -> expr -> val -> Prop :=
+ | eval_Evar: forall le id v,
PTree.get id e = Some v ->
- eval_expr sp le e m (Evar id) E0 m v
- | eval_Eop:
- forall sp le e m op al t m1 vl v,
- eval_exprlist sp le e m al t m1 vl ->
- eval_operation ge sp op vl m1 = Some v ->
- eval_expr sp le e m (Eop op al) t m1 v
- | eval_Eload:
- forall sp le e m chunk addr al t m1 v vl a,
- eval_exprlist sp le e m al t m1 vl ->
- eval_addressing ge sp addr vl = Some a ->
- Mem.loadv chunk m1 a = Some v ->
- eval_expr sp le e m (Eload chunk addr al) t m1 v
- | eval_Estore:
- forall sp le e m chunk addr al b t t1 m1 vl t2 m2 m3 v a,
- eval_exprlist sp le e m al t1 m1 vl ->
- eval_expr sp le e m1 b t2 m2 v ->
- eval_addressing ge sp addr vl = Some a ->
- Mem.storev chunk m2 a v = Some m3 ->
- t = t1 ** t2 ->
- eval_expr sp le e m (Estore chunk addr al b) t m3 v
- | eval_Ecall:
- forall sp le e m sig a bl t t1 m1 t2 m2 t3 m3 vf vargs vres f,
- eval_expr sp le e m a t1 m1 vf ->
- eval_exprlist sp le e m1 bl t2 m2 vargs ->
- Genv.find_funct ge vf = Some f ->
- funsig f = sig ->
- eval_funcall m2 f vargs t3 m3 vres ->
- t = t1 ** t2 ** t3 ->
- eval_expr sp le e m (Ecall sig a bl) t m3 vres
- | eval_Econdition:
- forall sp le e m a b c t t1 m1 v1 t2 m2 v2,
- eval_condexpr sp le e m a t1 m1 v1 ->
- eval_expr sp le e m1 (if v1 then b else c) t2 m2 v2 ->
- t = t1 ** t2 ->
- eval_expr sp le e m (Econdition a b c) t m2 v2
- | eval_Elet:
- forall sp le e m a b t t1 m1 v1 t2 m2 v2,
- eval_expr sp le e m a t1 m1 v1 ->
- eval_expr sp (v1::le) e m1 b t2 m2 v2 ->
- t = t1 ** t2 ->
- eval_expr sp le e m (Elet a b) t m2 v2
- | eval_Eletvar:
- forall sp le e m n v,
+ eval_expr le (Evar id) v
+ | eval_Eop: forall le op al vl v,
+ eval_exprlist le al vl ->
+ eval_operation ge sp op vl m = Some v ->
+ eval_expr le (Eop op al) v
+ | eval_Eload: forall le chunk addr al vl vaddr v,
+ eval_exprlist le al vl ->
+ eval_addressing ge sp addr vl = Some vaddr ->
+ Mem.loadv chunk m vaddr = Some v ->
+ eval_expr le (Eload chunk addr al) v
+ | eval_Econdition: forall le a b c v1 v2,
+ eval_condexpr le a v1 ->
+ eval_expr le (if v1 then b else c) v2 ->
+ eval_expr le (Econdition a b c) v2
+ | eval_Elet: forall le a b v1 v2,
+ eval_expr le a v1 ->
+ eval_expr (v1 :: le) b v2 ->
+ eval_expr le (Elet a b) v2
+ | eval_Eletvar: forall le n v,
nth_error le n = Some v ->
- eval_expr sp le e m (Eletvar n) E0 m v
- | eval_Ealloc:
- forall sp le e m a t m1 n m2 b,
- eval_expr sp le e m a t m1 (Vint n) ->
- Mem.alloc m1 0 (Int.signed n) = (m2, b) ->
- eval_expr sp le e m (Ealloc a) t m2 (Vptr b Int.zero)
-
-with eval_condexpr:
- val -> letenv -> env ->
- mem -> condexpr -> trace -> mem -> bool -> Prop :=
- | eval_CEtrue:
- forall sp le e m,
- eval_condexpr sp le e m CEtrue E0 m true
- | eval_CEfalse:
- forall sp le e m,
- eval_condexpr sp le e m CEfalse E0 m false
- | eval_CEcond:
- forall sp le e m cond al t1 m1 vl b,
- eval_exprlist sp le e m al t1 m1 vl ->
- eval_condition cond vl m1 = Some b ->
- eval_condexpr sp le e m (CEcond cond al) t1 m1 b
- | eval_CEcondition:
- forall sp le e m a b c t t1 m1 vb1 t2 m2 vb2,
- eval_condexpr sp le e m a t1 m1 vb1 ->
- eval_condexpr sp le e m1 (if vb1 then b else c) t2 m2 vb2 ->
- t = t1 ** t2 ->
- eval_condexpr sp le e m (CEcondition a b c) t m2 vb2
-
-with eval_exprlist:
- val -> letenv -> env ->
- mem -> exprlist -> trace -> mem -> list val -> Prop :=
- | eval_Enil:
- forall sp le e m,
- eval_exprlist sp le e m Enil E0 m nil
- | eval_Econs:
- forall sp le e m a bl t t1 m1 v t2 m2 vl,
- eval_expr sp le e m a t1 m1 v ->
- eval_exprlist sp le e m1 bl t2 m2 vl ->
- t = t1 ** t2 ->
- eval_exprlist sp le e m (Econs a bl) t m2 (v :: vl)
+ eval_expr le (Eletvar n) v
+
+with eval_condexpr: letenv -> condexpr -> bool -> Prop :=
+ | eval_CEtrue: forall le,
+ eval_condexpr le CEtrue true
+ | eval_CEfalse: forall le,
+ eval_condexpr le CEfalse false
+ | eval_CEcond: forall le cond al vl b,
+ eval_exprlist le al vl ->
+ eval_condition cond vl m = Some b ->
+ eval_condexpr le (CEcond cond al) b
+ | eval_CEcondition: forall le a b c vb1 vb2,
+ eval_condexpr le a vb1 ->
+ eval_condexpr le (if vb1 then b else c) vb2 ->
+ eval_condexpr le (CEcondition a b c) vb2
+
+with eval_exprlist: letenv -> exprlist -> list val -> Prop :=
+ | eval_Enil: forall le,
+ eval_exprlist le Enil nil
+ | eval_Econs: forall le a1 al v1 vl,
+ eval_expr le a1 v1 -> eval_exprlist le al vl ->
+ eval_exprlist le (Econs a1 al) (v1 :: vl).
-with eval_funcall:
+Scheme eval_expr_ind3 := Minimality for eval_expr Sort Prop
+ with eval_condexpr_ind3 := Minimality for eval_condexpr Sort Prop
+ with eval_exprlist_ind3 := Minimality for eval_exprlist Sort Prop.
+
+End EVAL_EXPR.
+
+Inductive eval_funcall:
mem -> fundef -> list val -> trace ->
mem -> val -> Prop :=
| eval_funcall_internal:
@@ -212,20 +184,37 @@ with exec_stmt:
| exec_Sskip:
forall sp e m,
exec_stmt sp e m Sskip E0 e m Out_normal
- | exec_Sexpr:
- forall sp e m a t m1 v,
- eval_expr sp nil e m a t m1 v ->
- exec_stmt sp e m (Sexpr a) t e m1 Out_normal
| exec_Sassign:
- forall sp e m id a t m1 v,
- eval_expr sp nil e m a t m1 v ->
- exec_stmt sp e m (Sassign id a) t (PTree.set id v e) m1 Out_normal
+ forall sp e m id a v,
+ eval_expr sp e m nil a v ->
+ exec_stmt sp e m (Sassign id a) E0 (PTree.set id v e) m Out_normal
+ | exec_Sstore:
+ forall sp e m chunk addr al b vl v vaddr m',
+ eval_exprlist sp e m nil al vl ->
+ eval_expr sp e m nil b v ->
+ eval_addressing ge sp addr vl = Some vaddr ->
+ Mem.storev chunk m vaddr v = Some m' ->
+ exec_stmt sp e m (Sstore chunk addr al b) E0 e m' Out_normal
+ | exec_Scall:
+ forall sp e m optid sig a bl vf vargs f t m' vres e',
+ eval_expr sp e m nil a vf ->
+ eval_exprlist sp e m nil bl vargs ->
+ Genv.find_funct ge vf = Some f ->
+ funsig f = sig ->
+ eval_funcall m f vargs t m' vres ->
+ e' = set_optvar optid vres e ->
+ exec_stmt sp e m (Scall optid sig a bl) t e' m' Out_normal
+ | exec_Salloc:
+ forall sp e m id a n m' b,
+ eval_expr sp e m nil a (Vint n) ->
+ Mem.alloc m 0 (Int.signed n) = (m', b) ->
+ exec_stmt sp e m (Salloc id a)
+ E0 (PTree.set id (Vptr b Int.zero) e) m' Out_normal
| exec_Sifthenelse:
- forall sp e m a s1 s2 t t1 m1 v1 t2 e2 m2 out,
- eval_condexpr sp nil e m a t1 m1 v1 ->
- exec_stmt sp e m1 (if v1 then s1 else s2) t2 e2 m2 out ->
- t = t1 ** t2 ->
- exec_stmt sp e m (Sifthenelse a s1 s2) t e2 m2 out
+ forall sp e m a s1 s2 v t e' m' out,
+ eval_condexpr sp e m nil a v ->
+ exec_stmt sp e m (if v then s1 else s2) t e' m' out ->
+ exec_stmt sp e m (Sifthenelse a s1 s2) t e' m' out
| exec_Sseq_continue:
forall sp e m t s1 t1 e1 m1 s2 t2 e2 m2 out,
exec_stmt sp e m s1 t1 e1 m1 Out_normal ->
@@ -256,41 +245,115 @@ with exec_stmt:
forall sp e m n,
exec_stmt sp e m (Sexit n) E0 e m (Out_exit n)
| exec_Sswitch:
- forall sp e m a cases default t1 m1 n,
- eval_expr sp nil e m a t1 m1 (Vint n) ->
+ forall sp e m a cases default n,
+ eval_expr sp e m nil a (Vint n) ->
exec_stmt sp e m (Sswitch a cases default)
- t1 e m1 (Out_exit (switch_target n default cases))
+ E0 e m (Out_exit (switch_target n default cases))
| exec_Sreturn_none:
forall sp e m,
exec_stmt sp e m (Sreturn None) E0 e m (Out_return None)
| exec_Sreturn_some:
- forall sp e m a t m1 v,
- eval_expr sp nil e m a t m1 v ->
- exec_stmt sp e m (Sreturn (Some a)) t e m1 (Out_return (Some v))
+ forall sp e m a v,
+ eval_expr sp e m nil a v ->
+ exec_stmt sp e m (Sreturn (Some a)) E0 e m (Out_return (Some v))
| exec_Stailcall:
- forall sp e m sig a bl t t1 m1 t2 m2 t3 m3 vf vargs vres f,
- eval_expr (Vptr sp Int.zero) nil e m a t1 m1 vf ->
- eval_exprlist (Vptr sp Int.zero) nil e m1 bl t2 m2 vargs ->
+ forall sp e m sig a bl vf vargs f t m' vres,
+ eval_expr (Vptr sp Int.zero) e m nil a vf ->
+ eval_exprlist (Vptr sp Int.zero) e m nil bl vargs ->
Genv.find_funct ge vf = Some f ->
funsig f = sig ->
- eval_funcall (Mem.free m2 sp) f vargs t3 m3 vres ->
- t = t1 ** t2 ** t3 ->
- exec_stmt (Vptr sp Int.zero) e m (Stailcall sig a bl) t e m3 (Out_tailcall_return vres).
+ eval_funcall (Mem.free m sp) f vargs t m' vres ->
+ exec_stmt (Vptr sp Int.zero) e m (Stailcall sig a bl) t e m' (Out_tailcall_return vres).
+
+Scheme eval_funcall_ind2 := Minimality for eval_funcall Sort Prop
+ with exec_stmt_ind2 := Minimality for exec_stmt Sort Prop.
+
+(** Coinductive semantics for divergence. *)
+
+CoInductive evalinf_funcall:
+ mem -> fundef -> list val -> traceinf -> Prop :=
+ | evalinf_funcall_internal:
+ forall m f vargs m1 sp e t,
+ Mem.alloc m 0 f.(fn_stackspace) = (m1, sp) ->
+ set_locals f.(fn_vars) (set_params vargs f.(fn_params)) = e ->
+ execinf_stmt (Vptr sp Int.zero) e m1 f.(fn_body) t ->
+ evalinf_funcall m (Internal f) vargs t
-Scheme eval_expr_ind5 := Minimality for eval_expr Sort Prop
- with eval_condexpr_ind5 := Minimality for eval_condexpr Sort Prop
- with eval_exprlist_ind5 := Minimality for eval_exprlist Sort Prop
- with eval_funcall_ind5 := Minimality for eval_funcall Sort Prop
- with exec_stmt_ind5 := Minimality for exec_stmt Sort Prop.
+(** [execinf_stmt ge sp e m s t] means that statement [s] diverges.
+ [e] is the initial environment, [m] is the initial memory state,
+ and [t] the trace of observable events performed during the execution. *)
+
+with execinf_stmt:
+ val -> env -> mem -> stmt -> traceinf -> Prop :=
+ | execinf_Scall:
+ forall sp e m optid sig a bl vf vargs f t,
+ eval_expr sp e m nil a vf ->
+ eval_exprlist sp e m nil bl vargs ->
+ Genv.find_funct ge vf = Some f ->
+ funsig f = sig ->
+ evalinf_funcall m f vargs t ->
+ execinf_stmt sp e m (Scall optid sig a bl) t
+ | execinf_Sifthenelse:
+ forall sp e m a s1 s2 v t,
+ eval_condexpr sp e m nil a v ->
+ execinf_stmt sp e m (if v then s1 else s2) t ->
+ execinf_stmt sp e m (Sifthenelse a s1 s2) t
+ | execinf_Sseq_1:
+ forall sp e m t s1 s2,
+ execinf_stmt sp e m s1 t ->
+ execinf_stmt sp e m (Sseq s1 s2) t
+ | execinf_Sseq_2:
+ forall sp e m t s1 t1 e1 m1 s2 t2,
+ exec_stmt sp e m s1 t1 e1 m1 Out_normal ->
+ execinf_stmt sp e1 m1 s2 t2 ->
+ t = t1 *** t2 ->
+ execinf_stmt sp e m (Sseq s1 s2) t
+ | execinf_Sloop_body:
+ forall sp e m s t,
+ execinf_stmt sp e m s t ->
+ execinf_stmt sp e m (Sloop s) t
+ | execinf_Sloop_loop:
+ forall sp e m s t t1 e1 m1 t2,
+ exec_stmt sp e m s t1 e1 m1 Out_normal ->
+ execinf_stmt sp e1 m1 (Sloop s) t2 ->
+ t = t1 *** t2 ->
+ execinf_stmt sp e m (Sloop s) t
+ | execinf_Sblock:
+ forall sp e m s t,
+ execinf_stmt sp e m s t ->
+ execinf_stmt sp e m (Sblock s) t
+ | execinf_Stailcall:
+ forall sp e m sig a bl vf vargs f t,
+ eval_expr (Vptr sp Int.zero) e m nil a vf ->
+ eval_exprlist (Vptr sp Int.zero) e m nil bl vargs ->
+ Genv.find_funct ge vf = Some f ->
+ funsig f = sig ->
+ evalinf_funcall (Mem.free m sp) f vargs t ->
+ execinf_stmt (Vptr sp Int.zero) e m (Stailcall sig a bl) t.
End RELSEM.
-Definition exec_program (p: program) (t: trace) (r: val) : Prop :=
- let ge := Genv.globalenv p in
- let m0 := Genv.init_mem p in
- exists b, exists f, exists m,
- Genv.find_symbol ge p.(prog_main) = Some b /\
- Genv.find_funct_ptr ge b = Some f /\
- funsig f = mksignature nil (Some Tint) /\
- eval_funcall ge m0 f nil t 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. *)
+Inductive exec_program (p: program): program_behavior -> Prop :=
+ | program_terminates:
+ forall b f t m r,
+ let ge := Genv.globalenv p in
+ let m0 := Genv.init_mem p in
+ Genv.find_symbol ge p.(prog_main) = Some b ->
+ Genv.find_funct_ptr ge b = Some f ->
+ funsig f = mksignature nil (Some Tint) ->
+ eval_funcall ge m0 f nil t m (Vint r) ->
+ exec_program p (Terminates t r)
+ | program_diverges:
+ forall b f t,
+ let ge := Genv.globalenv p in
+ let m0 := Genv.init_mem p in
+ Genv.find_symbol ge p.(prog_main) = Some b ->
+ Genv.find_funct_ptr ge b = Some f ->
+ funsig f = mksignature nil (Some Tint) ->
+ evalinf_funcall ge m0 f nil t ->
+ exec_program p (Diverges t).
diff --git a/backend/RTLgen.v b/backend/RTLgen.v
index 117631eff..2fe13e5cd 100644
--- a/backend/RTLgen.v
+++ b/backend/RTLgen.v
@@ -266,17 +266,6 @@ Fixpoint transl_expr (map: mapping) (a: expr) (rd: reg) (nd: node)
do rl <- alloc_regs map al;
do no <- add_instr (Iload chunk addr rl rd nd);
transl_exprlist map al rl no
- | Estore chunk addr al b =>
- do rl <- alloc_regs map al;
- do no <- add_instr (Istore chunk addr rl rd nd);
- do ns <- transl_expr map b rd no;
- transl_exprlist map al rl ns
- | Ecall sig b cl =>
- do rf <- alloc_reg map b;
- do rargs <- alloc_regs map cl;
- do n1 <- add_instr (Icall sig (inl _ rf) rargs rd nd);
- do n2 <- transl_exprlist map cl rargs n1;
- transl_expr map b rf n2
| Econdition b c d =>
do nfalse <- transl_expr map d rd nd;
do ntrue <- transl_expr map c rd nd;
@@ -287,10 +276,6 @@ Fixpoint transl_expr (map: mapping) (a: expr) (rd: reg) (nd: node)
transl_expr map b r nc
| Eletvar n =>
do r <- find_letvar map n; add_move r rd nd
- | Ealloc a =>
- do r <- alloc_reg map a;
- do no <- add_instr (Ialloc r rd nd);
- transl_expr map a r no
end
(** Translation of a conditional expression. Similar to [transl_expr],
@@ -329,6 +314,20 @@ with transl_exprlist (map: mapping) (al: exprlist) (rl: list reg) (nd: node)
error node (Errors.msg "RTLgen.transl_exprlist")
end.
+(** Generation of code for variable assignments. *)
+
+Definition store_var
+ (map: mapping) (rs: reg) (id: ident) (nd: node) : mon node :=
+ do rv <- find_var map id;
+ add_move rs rv nd.
+
+Definition store_optvar
+ (map: mapping) (rs: reg) (optid: option ident) (nd: node) : mon node :=
+ match optid with
+ | None => ret nd
+ | Some id => store_var map rs id nd
+ end.
+
(** Auxiliary for branch prediction. When compiling an if/then/else
statement, we have a choice between translating the ``then'' branch
first or the ``else'' branch first. Linearization of RTL control-flow
@@ -379,13 +378,30 @@ Fixpoint transl_stmt (map: mapping) (s: stmt) (nd: node)
match s with
| Sskip =>
ret nd
- | Sexpr a =>
- do r <- alloc_reg map a; transl_expr map a r nd
| Sassign v b =>
- do rv <- find_var map v;
do rt <- alloc_reg map b;
- do no <- add_move rt rv nd;
+ do no <- store_var map rt v nd;
transl_expr map b rt no
+ | Sstore chunk addr al b =>
+ do rl <- alloc_regs map al;
+ do r <- alloc_reg map b;
+ do no <- add_instr (Istore chunk addr rl r nd);
+ do ns <- transl_expr map b r no;
+ transl_exprlist map al rl ns
+ | Scall optid sig b cl =>
+ do rf <- alloc_reg map b;
+ do rargs <- alloc_regs map cl;
+ do r <- new_reg;
+ do n1 <- store_optvar map r optid nd;
+ do n2 <- add_instr (Icall sig (inl _ rf) rargs r n1);
+ do n3 <- transl_exprlist map cl rargs n2;
+ transl_expr map b rf n3
+ | Salloc id a =>
+ do ra <- alloc_reg map a;
+ do rr <- new_reg;
+ do n1 <- store_var map rr id nd;
+ do n2 <- add_instr (Ialloc ra rr n1);
+ transl_expr map a ra n2
| Sseq s1 s2 =>
do ns <- transl_stmt map s2 nd nexits nret rret;
transl_stmt map s1 ns nexits nret rret
diff --git a/backend/RTLgenproof.v b/backend/RTLgenproof.v
index 15f305a8b..e9a04fcc5 100644
--- a/backend/RTLgenproof.v
+++ b/backend/RTLgenproof.v
@@ -94,13 +94,13 @@ Proof.
eauto.
Qed.
-(** An RTL register environment matches a Cminor local environment and
+(** An RTL register environment matches a CminorSel local environment and
let-environment if the value of every local or let-bound variable in
- the Cminor environments is identical to the value of the
+ the CminorSel environments is identical to the value of the
corresponding pseudo-register in the RTL register environment. *)
Record match_env
- (map: mapping) (e: Cminor.env) (le: Cminor.letenv) (rs: regset) : Prop :=
+ (map: mapping) (e: env) (le: letenv) (rs: regset) : Prop :=
mk_match_env {
me_vars:
(forall id v,
@@ -367,6 +367,51 @@ Proof.
split. apply Regmap.gss. intros; apply Regmap.gso; auto.
Qed.
+(** Correctness of the code generated by [store_var] and [store_optvar]. *)
+
+Lemma tr_store_var_correct:
+ forall rs cs code map r id ns nd e sp m,
+ tr_store_var code map r id ns nd ->
+ map_wf map ->
+ match_env map e nil rs ->
+ exists rs',
+ star step tge (State cs code sp ns rs m)
+ E0 (State cs code sp nd rs' m)
+ /\ match_env map (PTree.set id rs#r e) nil rs'.
+Proof.
+ intros. destruct H as [rv [A B]].
+ exploit tr_move_correct; eauto. intros [rs' [EX [RES OTHER]]].
+ exists rs'; split. eexact EX.
+ apply match_env_invariant with (rs#rv <- (rs#r)).
+ apply match_env_update_var; auto.
+ intros. rewrite Regmap.gsspec. destruct (peq r0 rv).
+ subst r0; auto.
+ auto.
+Qed.
+
+Lemma tr_store_optvar_correct:
+ forall rs cs code map r optid ns nd e sp m,
+ tr_store_optvar code map r optid ns nd ->
+ map_wf map ->
+ match_env map e nil rs ->
+ exists rs',
+ star step tge (State cs code sp ns rs m)
+ E0 (State cs code sp nd rs' m)
+ /\ match_env map (set_optvar optid rs#r e) nil rs'.
+Proof.
+ intros. destruct optid; simpl in *.
+ eapply tr_store_var_correct; eauto.
+ exists rs; split. subst nd. apply star_refl. auto.
+Qed.
+
+(** ** Semantic preservation for the translation of expressions *)
+
+Section CORRECTNESS_EXPR.
+
+Variable sp: val.
+Variable e: env.
+Variable m: mem.
+
(** The proof of semantic preservation for the translation of expressions
is a simulation argument based on diagrams of the following form:
<<
@@ -380,16 +425,14 @@ Qed.
I /\ Q
>>
where [tr_expr code map pr a ns nd rd] is assumed to hold.
- The left vertical arrow represents an evaluation of the expression [a]
- to value [v].
+ The left vertical arrow represents an evaluation of the expression [a].
The right vertical arrow represents the execution of zero, one or
several instructions in the generated RTL flow graph [code].
- The invariant [I] is the agreement between CminorSel environments
- [e], [le] and the RTL register environment [rs],
- as captured by [match_envs].
+ The invariant [I] is the agreement between Cminor environments and
+ RTL register environment, as captured by [match_envs].
- The precondition [P] is the well-formedness of the compilation
+ The precondition [P] includes the well-formedness of the compilation
environment [mut].
The postconditions [Q] state that in the final register environment
@@ -400,15 +443,14 @@ Qed.
We formalize this simulation property by the following predicate
parameterized by the CminorSel evaluation (left arrow). *)
-Definition transl_expr_correct
- (sp: val) (le: letenv) (e: env) (m: mem) (a: expr)
- (t: trace) (m': mem) (v: val) : Prop :=
+Definition transl_expr_prop
+ (le: letenv) (a: expr) (v: val) : Prop :=
forall cs code map pr ns nd rd rs
(MWF: map_wf map)
(TE: tr_expr code map pr a ns nd rd)
(ME: match_env map e le rs),
exists rs',
- star step tge (State cs code sp ns rs m) t (State cs code sp nd rs' m')
+ star step tge (State cs code sp ns rs m) E0 (State cs code sp nd rs' m)
/\ match_env map e le rs'
/\ rs'#rd = v
/\ (forall r, reg_in_map map r \/ In r pr -> rs'#r = rs#r).
@@ -416,123 +458,44 @@ Definition transl_expr_correct
(** The simulation properties for lists of expressions and for
conditional expressions are similar. *)
-Definition transl_exprlist_correct
- (sp: val) (le: letenv) (e: env) (m: mem) (al: exprlist)
- (t: trace) (m': mem) (vl: list val) : Prop :=
+Definition transl_exprlist_prop
+ (le: letenv) (al: exprlist) (vl: list val) : Prop :=
forall cs code map pr ns nd rl rs
(MWF: map_wf map)
(TE: tr_exprlist code map pr al ns nd rl)
(ME: match_env map e le rs),
exists rs',
- star step tge (State cs code sp ns rs m) t (State cs code sp nd rs' m')
+ star step tge (State cs code sp ns rs m) E0 (State cs code sp nd rs' m)
/\ match_env map e le rs'
/\ rs'##rl = vl
/\ (forall r, reg_in_map map r \/ In r pr -> rs'#r = rs#r).
-Definition transl_condition_correct
- (sp: val) (le: letenv) (e: env) (m: mem) (a: condexpr)
- (t: trace) (m': mem) (vb: bool) : Prop :=
+Definition transl_condition_prop
+ (le: letenv) (a: condexpr) (vb: bool) : Prop :=
forall cs code map pr ns ntrue nfalse rs
(MWF: map_wf map)
(TE: tr_condition code map pr a ns ntrue nfalse)
(ME: match_env map e le rs),
exists rs',
- star step tge (State cs code sp ns rs m) t
- (State cs code sp (if vb then ntrue else nfalse) rs' m')
+ star step tge (State cs code sp ns rs m) E0
+ (State cs code sp (if vb then ntrue else nfalse) rs' m)
/\ match_env map e le rs'
/\ (forall r, reg_in_map map r \/ In r pr -> rs'#r = rs#r).
-(** The simulation diagram for the translation of statements
- is of the following form:
-<<
- I /\ P
- e, m, a -------------- State cs code sp ns rs m
- || |
- t|| t|*
- || |
- \/ v
- e', m', out -------------- st'
- I /\ Q
->>
- where [tr_stmt code map a ns ncont nexits nret rret] holds.
- The left vertical arrow represents an execution of the statement [a]
- with outcome [out].
- The right vertical arrow represents the execution of
- zero, one or several instructions in the generated RTL flow graph [code].
-
- The invariant [I] is the agreement between CminorSel environments and
- RTL register environment, as captured by [match_envs].
-
- The precondition [P] is the well-formedness of the compilation
- environment [mut].
-
- The postcondition [Q] characterizes the final RTL state [st'].
- It must have memory state [m'] and a register state [rs'] that matches
- [e']. Moreover, the program point reached must correspond to the outcome
- [out]. This is captured by the following [state_for_outcome] predicate. *)
-
-Inductive state_for_outcome
- (ncont: node) (nexits: list node) (nret: node) (rret: option reg)
- (cs: list stackframe) (c: code) (sp: val) (rs: regset) (m: mem):
- outcome -> RTL.state -> Prop :=
- | state_for_normal:
- state_for_outcome ncont nexits nret rret cs c sp rs m
- Out_normal (State cs c sp ncont rs m)
- | state_for_exit: forall n nexit,
- nth_error nexits n = Some nexit ->
- state_for_outcome ncont nexits nret rret cs c sp rs m
- (Out_exit n) (State cs c sp nexit rs m)
- | state_for_return_none:
- rret = None ->
- state_for_outcome ncont nexits nret rret cs c sp rs m
- (Out_return None) (State cs c sp nret rs m)
- | state_for_return_some: forall r v,
- rret = Some r ->
- rs#r = v ->
- state_for_outcome ncont nexits nret rret cs c sp rs m
- (Out_return (Some v)) (State cs c sp nret rs m)
- | state_for_return_tail: forall v,
- state_for_outcome ncont nexits nret rret cs c sp rs m
- (Out_tailcall_return v) (Returnstate cs v m).
-
-Definition transl_stmt_correct
- (sp: val) (e: env) (m: mem) (a: stmt)
- (t: trace) (e': env) (m': mem) (out: outcome) : Prop :=
- forall cs code map ns ncont nexits nret rret rs
- (MWF: map_wf map)
- (TE: tr_stmt code map a ns ncont nexits nret rret)
- (ME: match_env map e nil rs),
- exists rs', exists st,
- state_for_outcome ncont nexits nret rret cs code sp rs' m' out st
- /\ star step tge (State cs code sp ns rs m) t st
- /\ match_env map e' nil rs'.
-
-(** Finally, the correctness condition for the translation of functions
- is that the translated RTL function, when applied to the same arguments
- as the original CminorSel function, returns the same value, produces
- the same trace of events, and performs the same modifications on the
- memory state. *)
-
-Definition transl_function_correct
- (m: mem) (f: CminorSel.fundef) (vargs: list val)
- (t: trace) (m': mem) (vres: val) : Prop :=
- forall cs tf
- (TE: transl_fundef f = OK tf),
- star step tge (Callstate cs tf vargs m) t (Returnstate cs vres m').
(** The correctness of the translation is a huge induction over
- the CminorSel evaluation derivation for the source program. To keep
+ the Cminor evaluation derivation for the source program. To keep
the proof manageable, we put each case of the proof in a separate
- lemma. There is one lemma for each CminorSel evaluation rule.
- It takes as hypotheses the premises of the CminorSel evaluation rule,
- plus the induction hypotheses, that is, the [transl_expr_correct], etc,
+ lemma. There is one lemma for each Cminor evaluation rule.
+ It takes as hypotheses the premises of the Cminor evaluation rule,
+ plus the induction hypotheses, that is, the [transl_expr_prop], etc,
corresponding to the evaluations of sub-expressions or sub-statements. *)
Lemma transl_expr_Evar_correct:
- forall (sp: val) (le: letenv) (e: env) (m: mem) (id: ident) (v: val),
- e!id = Some v ->
- transl_expr_correct sp le e m (Evar id) E0 m v.
+ forall (le : letenv) (id : positive) (v : val),
+ e ! id = Some v ->
+ transl_expr_prop le (Evar id) v.
Proof.
intros; red; intros. inv TE.
exploit tr_move_correct; eauto. intros [rs' [A [B C]]].
@@ -553,13 +516,12 @@ Proof.
Qed.
Lemma transl_expr_Eop_correct:
- forall (sp: val) (le : letenv) (e : env) (m : mem) (op : operation)
- (al : exprlist) (t: trace) (m1 : mem) (vl : list val)
- (v: val),
- eval_exprlist ge sp le e m al t m1 vl ->
- transl_exprlist_correct sp le e m al t m1 vl ->
- eval_operation ge sp op vl m1 = Some v ->
- transl_expr_correct sp le e m (Eop op al) t m1 v.
+ forall (le : letenv) (op : operation) (args : exprlist)
+ (vargs : list val) (v : val),
+ eval_exprlist ge sp e m le args vargs ->
+ transl_exprlist_prop le args vargs ->
+ eval_operation ge sp op vargs m = Some v ->
+ transl_expr_prop le (Eop op args) v.
Proof.
intros; red; intros. inv TE.
exploit H0; eauto. intros [rs1 [EX1 [ME1 [RR1 RO1]]]].
@@ -567,7 +529,7 @@ Proof.
(* Exec *)
split. eapply star_right. eexact EX1.
eapply exec_Iop; eauto.
- subst vl.
+ subst vargs.
rewrite (@eval_operation_preserved CminorSel.fundef RTL.fundef ge tge).
auto.
exact symbols_preserved. traceEq.
@@ -580,15 +542,13 @@ Proof.
Qed.
Lemma transl_expr_Eload_correct:
- forall (sp: val) (le : letenv) (e : env) (m : mem)
- (chunk : memory_chunk) (addr : addressing)
- (al : exprlist) (t: trace) (m1 : mem) (v : val)
- (vl : list val) (a: val),
- eval_exprlist ge sp le e m al t m1 vl ->
- transl_exprlist_correct sp le e m al t m1 vl ->
- eval_addressing ge sp addr vl = Some a ->
- Mem.loadv chunk m1 a = Some v ->
- transl_expr_correct sp le e m (Eload chunk addr al) t m1 v.
+ forall (le : letenv) (chunk : memory_chunk) (addr : Op.addressing)
+ (args : exprlist) (vargs : list val) (vaddr v : val),
+ eval_exprlist ge sp e m le args vargs ->
+ transl_exprlist_prop le args vargs ->
+ Op.eval_addressing ge sp addr vargs = Some vaddr ->
+ loadv chunk m vaddr = Some v ->
+ transl_expr_prop le (Eload chunk addr args) v.
Proof.
intros; red; intros. inv TE.
exploit H0; eauto. intros [rs1 [EX1 [ME1 [RES1 OTHER1]]]].
@@ -605,105 +565,19 @@ Proof.
intros. rewrite Regmap.gso. auto. intuition congruence.
Qed.
-Lemma transl_expr_Estore_correct:
- forall (sp: val) (le : letenv) (e : env) (m : mem)
- (chunk : memory_chunk) (addr : addressing)
- (al : exprlist) (b : expr) (t t1: trace) (m1 : mem)
- (vl : list val) (t2: trace) (m2 m3 : mem)
- (v : val) (a: val),
- eval_exprlist ge sp le e m al t1 m1 vl ->
- transl_exprlist_correct sp le e m al t1 m1 vl ->
- eval_expr ge sp le e m1 b t2 m2 v ->
- transl_expr_correct sp le e m1 b t2 m2 v ->
- eval_addressing ge sp addr vl = Some a ->
- Mem.storev chunk m2 a v = Some m3 ->
- t = t1 ** t2 ->
- transl_expr_correct sp le e m (Estore chunk addr al b) t m3 v.
-Proof.
- intros; red; intros; inv TE.
- exploit H0; eauto. intros [rs1 [EX1 [ME1 [RES1 OTHER1]]]].
- exploit H2; eauto. intros [rs2 [EX2 [ME2 [RES2 OTHER2]]]].
- exists rs2.
-(* Exec *)
- split. eapply star_trans. eexact EX1.
- eapply star_right. eexact EX2.
- eapply exec_Istore; eauto.
- assert (rs2##rl = rs1##rl).
- apply list_map_exten. intros r' IN. symmetry. apply OTHER2.
- right. apply in_or_app. auto.
- rewrite H5; rewrite RES1.
- rewrite (@eval_addressing_preserved _ _ ge tge).
- eexact H3. exact symbols_preserved.
- rewrite RES2. assumption.
- reflexivity. traceEq.
-(* Match-env *)
- split. assumption.
-(* Result *)
- split. assumption.
-(* Other regs *)
- intro r'; intros. transitivity (rs1#r').
- apply OTHER2. intuition.
- auto.
-Qed.
-
-Lemma transl_expr_Ecall_correct:
- forall (sp: val) (le : letenv) (e : env) (m : mem)
- (sig : signature) (a : expr) (bl : exprlist) (t t1: trace)
- (m1: mem) (t2: trace) (m2 : mem)
- (t3: trace) (m3: mem) (vf : val)
- (vargs : list val) (vres : val) (f : CminorSel.fundef),
- eval_expr ge sp le e m a t1 m1 vf ->
- transl_expr_correct sp le e m a t1 m1 vf ->
- eval_exprlist ge sp le e m1 bl t2 m2 vargs ->
- transl_exprlist_correct sp le e m1 bl t2 m2 vargs ->
- Genv.find_funct ge vf = Some f ->
- CminorSel.funsig f = sig ->
- eval_funcall ge m2 f vargs t3 m3 vres ->
- transl_function_correct m2 f vargs t3 m3 vres ->
- t = t1 ** t2 ** t3 ->
- transl_expr_correct sp le e m (Ecall sig a bl) t m3 vres.
-Proof.
- intros; red; intros; inv TE.
- exploit H0; eauto. intros [rs1 [EX1 [ME1 [RES1 OTHER1]]]].
- exploit H2; eauto. intros [rs2 [EX2 [ME2 [RES2 OTHER2]]]].
- exploit functions_translated; eauto. intros [tf [TFIND TF]].
- exploit H6; eauto. intro EXF.
- exists (rs2#rd <- vres).
-(* Exec *)
- split. eapply star_trans. eexact EX1.
- eapply star_trans. eexact EX2.
- eapply star_left. eapply exec_Icall; eauto.
- simpl. rewrite OTHER2. rewrite RES1. eauto. simpl; tauto.
- eapply sig_transl_function; eauto.
- eapply star_right. rewrite RES2. eexact EXF.
- apply exec_return. reflexivity. reflexivity. reflexivity. traceEq.
-(* Match env *)
- split. eauto with rtlg.
-(* Result *)
- split. apply Regmap.gss.
-(* Other regs *)
- intros.
- rewrite Regmap.gso. transitivity (rs1#r).
- apply OTHER2. simpl; tauto.
- apply OTHER1; auto.
- intuition congruence.
-Qed.
-
Lemma transl_expr_Econdition_correct:
- forall (sp: val) (le : letenv) (e : env) (m : mem)
- (a : condexpr) (b c : expr) (t t1: trace) (m1 : mem)
- (v1 : bool) (t2: trace) (m2 : mem) (v2 : val),
- eval_condexpr ge sp le e m a t1 m1 v1 ->
- transl_condition_correct sp le e m a t1 m1 v1 ->
- eval_expr ge sp le e m1 (if v1 then b else c) t2 m2 v2 ->
- transl_expr_correct sp le e m1 (if v1 then b else c) t2 m2 v2 ->
- t = t1 ** t2 ->
- transl_expr_correct sp le e m (Econdition a b c) t m2 v2.
+ forall (le : letenv) (cond : condexpr) (ifso ifnot : expr)
+ (vcond : bool) (v : val),
+ eval_condexpr ge sp e m le cond vcond ->
+ transl_condition_prop le cond vcond ->
+ eval_expr ge sp e m le (if vcond then ifso else ifnot) v ->
+ transl_expr_prop le (if vcond then ifso else ifnot) v ->
+ transl_expr_prop le (Econdition cond ifso ifnot) v.
Proof.
intros; red; intros; inv TE.
exploit H0; eauto. intros [rs1 [EX1 [ME1 OTHER1]]].
- assert (tr_expr code map pr (if v1 then b else c) (if v1 then ntrue else nfalse) nd rd).
- destruct v1; auto.
+ assert (tr_expr code map pr (if vcond then ifso else ifnot) (if vcond then ntrue else nfalse) nd rd).
+ destruct vcond; auto.
exploit H2; eauto. intros [rs2 [EX2 [ME2 [RES2 OTHER2]]]].
exists rs2.
(* Exec *)
@@ -717,15 +591,12 @@ Proof.
Qed.
Lemma transl_expr_Elet_correct:
- forall (sp: val) (le : letenv) (e : env) (m : mem)
- (a b : expr) (t t1: trace) (m1 : mem) (v1 : val)
- (t2: trace) (m2 : mem) (v2 : val),
- eval_expr ge sp le e m a t1 m1 v1 ->
- transl_expr_correct sp le e m a t1 m1 v1 ->
- eval_expr ge sp (v1 :: le) e m1 b t2 m2 v2 ->
- transl_expr_correct sp (v1 :: le) e m1 b t2 m2 v2 ->
- t = t1 ** t2 ->
- transl_expr_correct sp le e m (Elet a b) t m2 v2.
+ forall (le : letenv) (a1 a2 : expr) (v1 v2 : val),
+ eval_expr ge sp e m le a1 v1 ->
+ transl_expr_prop le a1 v1 ->
+ eval_expr ge sp e m (v1 :: le) a2 v2 ->
+ transl_expr_prop (v1 :: le) a2 v2 ->
+ transl_expr_prop le (Elet a1 a2) v2.
Proof.
intros; red; intros; inv TE.
exploit H0; eauto. intros [rs1 [EX1 [ME1 [RES1 OTHER1]]]].
@@ -744,15 +615,14 @@ Proof.
intros. transitivity (rs1#r0).
apply OTHER2. elim H4; intro; auto.
unfold reg_in_map, add_letvar; simpl.
- unfold reg_in_map in H5; tauto.
+ unfold reg_in_map in H6; tauto.
auto.
Qed.
Lemma transl_expr_Eletvar_correct:
- forall (sp: val) (le : list val) (e : env)
- (m : mem) (n : nat) (v : val),
+ forall (le : list val) (n : nat) (v : val),
nth_error le n = Some v ->
- transl_expr_correct sp le e m (Eletvar n) E0 m v.
+ transl_expr_prop le (Eletvar n) v.
Proof.
intros; red; intros; inv TE.
exploit tr_move_correct; eauto. intros [rs1 [EX1 [RES1 OTHER1]]].
@@ -772,54 +642,29 @@ Proof.
apply OTHER1. intuition congruence.
Qed.
-Lemma transl_expr_Ealloc_correct:
- forall (sp: val) (le : letenv) (e : env) (m : mem)
- (a : expr) (t: trace) (m1 : mem) (n: int)
- (m2: mem) (b: block),
- eval_expr ge sp le e m a t m1 (Vint n) ->
- transl_expr_correct sp le e m a t m1 (Vint n) ->
- Mem.alloc m1 0 (Int.signed n) = (m2, b) ->
- transl_expr_correct sp le e m (Ealloc a) t m2 (Vptr b Int.zero).
-Proof.
- intros; red; intros; inv TE.
- exploit H0; eauto. intros [rs1 [EX1 [ME1 [RR1 RO1]]]].
- exists (rs1#rd <- (Vptr b Int.zero)).
-(* Exec *)
- split. eapply star_right. eexact EX1.
- eapply exec_Ialloc. eauto with rtlg.
- eexact RR1. assumption. traceEq.
-(* Match-env *)
- split. eauto with rtlg.
-(* Result *)
- split. apply Regmap.gss.
-(* Other regs *)
- intros. rewrite Regmap.gso. auto. intuition congruence.
-Qed.
-
Lemma transl_condition_CEtrue_correct:
- forall (sp: val) (le : letenv) (e : env) (m : mem),
- transl_condition_correct sp le e m CEtrue E0 m true.
+ forall (le : letenv),
+ transl_condition_prop le CEtrue true.
Proof.
intros; red; intros; inv TE.
exists rs. split. apply star_refl. split. auto. auto.
Qed.
Lemma transl_condition_CEfalse_correct:
- forall (sp: val) (le : letenv) (e : env) (m : mem),
- transl_condition_correct sp le e m CEfalse E0 m false.
+ forall (le : letenv),
+ transl_condition_prop le CEfalse false.
Proof.
intros; red; intros; inv TE.
exists rs. split. apply star_refl. split. auto. auto.
Qed.
Lemma transl_condition_CEcond_correct:
- forall (sp: val) (le : letenv) (e : env) (m : mem)
- (cond : condition) (al : exprlist) (t1: trace)
- (m1 : mem) (vl : list val) (b : bool),
- eval_exprlist ge sp le e m al t1 m1 vl ->
- transl_exprlist_correct sp le e m al t1 m1 vl ->
- eval_condition cond vl m1 = Some b ->
- transl_condition_correct sp le e m (CEcond cond al) t1 m1 b.
+ forall (le : letenv) (cond : condition) (args : exprlist)
+ (vargs : list val) (b : bool),
+ eval_exprlist ge sp e m le args vargs ->
+ transl_exprlist_prop le args vargs ->
+ eval_condition cond vargs m = Some b ->
+ transl_condition_prop le (CEcond cond args) b.
Proof.
intros; red; intros; inv TE.
exploit H0; eauto. intros [rs1 [EX1 [ME1 [RES1 OTHER1]]]].
@@ -839,21 +684,18 @@ Proof.
Qed.
Lemma transl_condition_CEcondition_correct:
- forall (sp: val) (le : letenv) (e : env) (m : mem)
- (a b c : condexpr) (t t1: trace) (m1 : mem)
- (vb1 : bool) (t2: trace) (m2 : mem) (vb2 : bool),
- eval_condexpr ge sp le e m a t1 m1 vb1 ->
- transl_condition_correct sp le e m a t1 m1 vb1 ->
- eval_condexpr ge sp le e m1 (if vb1 then b else c) t2 m2 vb2 ->
- transl_condition_correct sp le e m1 (if vb1 then b else c) t2 m2 vb2 ->
- t = t1 ** t2 ->
- transl_condition_correct sp le e m (CEcondition a b c) t m2 vb2.
+ forall (le : letenv) (cond ifso ifnot : condexpr) (vcond v : bool),
+ eval_condexpr ge sp e m le cond vcond ->
+ transl_condition_prop le cond vcond ->
+ eval_condexpr ge sp e m le (if vcond then ifso else ifnot) v ->
+ transl_condition_prop le (if vcond then ifso else ifnot) v ->
+ transl_condition_prop le (CEcondition cond ifso ifnot) v.
Proof.
intros; red; intros; inv TE.
exploit H0; eauto. intros [rs1 [EX1 [ME1 OTHER1]]].
- assert (tr_condition code map pr (if vb1 then b else c)
- (if vb1 then ntrue' else nfalse') ntrue nfalse).
- destruct vb1; auto.
+ assert (tr_condition code map pr (if vcond then ifso else ifnot)
+ (if vcond then ntrue' else nfalse') ntrue nfalse).
+ destruct vcond; auto.
exploit H2; eauto. intros [rs2 [EX2 [ME2 OTHER2]]].
exists rs2.
(* Execution *)
@@ -865,8 +707,8 @@ Proof.
Qed.
Lemma transl_exprlist_Enil_correct:
- forall (sp: val) (le : letenv) (e : env) (m : mem),
- transl_exprlist_correct sp le e m Enil E0 m nil.
+ forall (le : letenv),
+ transl_exprlist_prop le Enil nil.
Proof.
intros; red; intros; inv TE.
exists rs.
@@ -877,15 +719,13 @@ Proof.
Qed.
Lemma transl_exprlist_Econs_correct:
- forall (sp: val) (le : letenv) (e : env) (m : mem)
- (a : expr) (bl : exprlist) (t t1: trace) (m1 : mem)
- (v : val) (t2: trace) (m2 : mem) (vl : list val),
- eval_expr ge sp le e m a t1 m1 v ->
- transl_expr_correct sp le e m a t1 m1 v ->
- eval_exprlist ge sp le e m1 bl t2 m2 vl ->
- transl_exprlist_correct sp le e m1 bl t2 m2 vl ->
- t = t1 ** t2 ->
- transl_exprlist_correct sp le e m (Econs a bl) t m2 (v :: vl).
+ forall (le : letenv) (a1 : expr) (al : exprlist) (v1 : val)
+ (vl : list val),
+ eval_expr ge sp e m le a1 v1 ->
+ transl_expr_prop le a1 v1 ->
+ eval_exprlist ge sp e m le al vl ->
+ transl_exprlist_prop le al vl ->
+ transl_exprlist_prop le (Econs a1 al) (v1 :: vl).
Proof.
intros; red; intros; inv TE.
exploit H0; eauto. intros [rs1 [EX1 [ME1 [RES1 OTHER1]]]].
@@ -904,6 +744,153 @@ Proof.
apply OTHER1; auto.
Qed.
+Theorem transl_expr_correct:
+ forall le a v,
+ eval_expr ge sp e m le a v ->
+ transl_expr_prop le a v.
+Proof
+ (eval_expr_ind3 ge sp e m
+ transl_expr_prop
+ transl_condition_prop
+ transl_exprlist_prop
+ transl_expr_Evar_correct
+ transl_expr_Eop_correct
+ transl_expr_Eload_correct
+ transl_expr_Econdition_correct
+ transl_expr_Elet_correct
+ transl_expr_Eletvar_correct
+ transl_condition_CEtrue_correct
+ transl_condition_CEfalse_correct
+ transl_condition_CEcond_correct
+ transl_condition_CEcondition_correct
+ transl_exprlist_Enil_correct
+ transl_exprlist_Econs_correct).
+
+Theorem transl_condexpr_correct:
+ forall le a v,
+ eval_condexpr ge sp e m le a v ->
+ transl_condition_prop le a v.
+Proof
+ (eval_condexpr_ind3 ge sp e m
+ transl_expr_prop
+ transl_condition_prop
+ transl_exprlist_prop
+ transl_expr_Evar_correct
+ transl_expr_Eop_correct
+ transl_expr_Eload_correct
+ transl_expr_Econdition_correct
+ transl_expr_Elet_correct
+ transl_expr_Eletvar_correct
+ transl_condition_CEtrue_correct
+ transl_condition_CEfalse_correct
+ transl_condition_CEcond_correct
+ transl_condition_CEcondition_correct
+ transl_exprlist_Enil_correct
+ transl_exprlist_Econs_correct).
+
+
+Theorem transl_exprlist_correct:
+ forall le a v,
+ eval_exprlist ge sp e m le a v ->
+ transl_exprlist_prop le a v.
+Proof
+ (eval_exprlist_ind3 ge sp e m
+ transl_expr_prop
+ transl_condition_prop
+ transl_exprlist_prop
+ transl_expr_Evar_correct
+ transl_expr_Eop_correct
+ transl_expr_Eload_correct
+ transl_expr_Econdition_correct
+ transl_expr_Elet_correct
+ transl_expr_Eletvar_correct
+ transl_condition_CEtrue_correct
+ transl_condition_CEfalse_correct
+ transl_condition_CEcond_correct
+ transl_condition_CEcondition_correct
+ transl_exprlist_Enil_correct
+ transl_exprlist_Econs_correct).
+
+End CORRECTNESS_EXPR.
+
+(** ** Semantic preservation for the translation of terminating statements *)
+
+(** The simulation diagram for the translation of statements
+ is of the following form:
+<<
+ I /\ P
+ e, m, a ---------------- State cs code sp ns rs m
+ || |
+ t|| t|*
+ || |
+ \/ v
+ e', m', out ------------------ st'
+ I /\ Q
+>>
+ where [tr_stmt code map a ns ncont nexits nret rret] holds.
+ The left vertical arrow represents an execution of the statement [a].
+ The right vertical arrow represents the execution of
+ zero, one or several instructions in the generated RTL flow graph [code].
+
+ The invariant [I] is the agreement between Cminor environments and
+ RTL register environment, as captured by [match_envs].
+
+ The precondition [P] is the well-formedness of the compilation
+ environment [mut].
+
+ The postcondition [Q] characterizes the final RTL state [st'].
+ It must have memory state [m'] and register state [rs'] that matches
+ [e']. Moreover, the program point reached must correspond to the outcome
+ [out]. This is captured by the following [state_for_outcome] predicate. *)
+
+Inductive state_for_outcome
+ (ncont: node) (nexits: list node) (nret: node) (rret: option reg)
+ (cs: list stackframe) (c: code) (sp: val) (rs: regset) (m: mem):
+ outcome -> RTL.state -> Prop :=
+ | state_for_normal:
+ state_for_outcome ncont nexits nret rret cs c sp rs m
+ Out_normal (State cs c sp ncont rs m)
+ | state_for_exit: forall n nexit,
+ nth_error nexits n = Some nexit ->
+ state_for_outcome ncont nexits nret rret cs c sp rs m
+ (Out_exit n) (State cs c sp nexit rs m)
+ | state_for_return_none:
+ rret = None ->
+ state_for_outcome ncont nexits nret rret cs c sp rs m
+ (Out_return None) (State cs c sp nret rs m)
+ | state_for_return_some: forall r v,
+ rret = Some r ->
+ rs#r = v ->
+ state_for_outcome ncont nexits nret rret cs c sp rs m
+ (Out_return (Some v)) (State cs c sp nret rs m)
+ | state_for_return_tail: forall v,
+ state_for_outcome ncont nexits nret rret cs c sp rs m
+ (Out_tailcall_return v) (Returnstate cs v m).
+
+Definition transl_stmt_prop
+ (sp: val) (e: env) (m: mem) (a: stmt)
+ (t: trace) (e': env) (m': mem) (out: outcome) : Prop :=
+ forall cs code map ns ncont nexits nret rret rs
+ (MWF: map_wf map)
+ (TE: tr_stmt code map a ns ncont nexits nret rret)
+ (ME: match_env map e nil rs),
+ exists rs', exists st,
+ state_for_outcome ncont nexits nret rret cs code sp rs' m' out st
+ /\ star step tge (State cs code sp ns rs m) t st
+ /\ match_env map e' nil rs'.
+
+(** Finally, the correctness condition for the translation of functions
+ is that the translated RTL function, when applied to the same arguments
+ as the original Cminor function, returns the same value and performs
+ the same modifications on the memory state. *)
+
+Definition transl_function_prop
+ (m: mem) (f: CminorSel.fundef) (vargs: list val)
+ (t: trace) (m': mem) (vres: val) : Prop :=
+ forall cs tf
+ (TE: transl_fundef f = OK tf),
+ star step tge (Callstate cs tf vargs m) t (Returnstate cs vres m').
+
Lemma transl_funcall_internal_correct:
forall (m : mem) (f : CminorSel.function)
(vargs : list val) (m1 : mem) (sp : block) (e : env) (t : trace)
@@ -911,9 +898,9 @@ Lemma transl_funcall_internal_correct:
Mem.alloc m 0 (fn_stackspace f) = (m1, sp) ->
set_locals (fn_vars f) (set_params vargs (CminorSel.fn_params f)) = e ->
exec_stmt ge (Vptr sp Int.zero) e m1 (fn_body f) t e2 m2 out ->
- transl_stmt_correct (Vptr sp Int.zero) e m1 (fn_body f) t e2 m2 out ->
+ transl_stmt_prop (Vptr sp Int.zero) e m1 (fn_body f) t e2 m2 out ->
outcome_result_value out f.(CminorSel.fn_sig).(sig_res) vres ->
- transl_function_correct m (Internal f) vargs t
+ transl_function_prop m (Internal f) vargs t
(outcome_free_mem out m2 sp) vres.
Proof.
intros; red; intros.
@@ -976,7 +963,7 @@ Qed.
Lemma transl_funcall_external_correct:
forall (ef : external_function) (m : mem) (args : list val) (t: trace) (res : val),
event_match ef args t res ->
- transl_function_correct m (External ef) args t m res.
+ transl_function_prop m (External ef) args t m res.
Proof.
intros; red; intros. unfold transl_function in TE; simpl in TE.
inversion TE; subst tf.
@@ -985,7 +972,7 @@ Qed.
Lemma transl_stmt_Sskip_correct:
forall (sp: val) (e : env) (m : mem),
- transl_stmt_correct sp e m Sskip E0 e m Out_normal.
+ transl_stmt_prop sp e m Sskip E0 e m Out_normal.
Proof.
intros; red; intros; inv TE.
exists rs; econstructor.
@@ -1008,11 +995,11 @@ Lemma transl_stmt_Sseq_continue_correct:
(t1: trace) (e1 : env) (m1 : mem) (s2 : stmt) (t2: trace)
(e2 : env) (m2 : mem) (out : outcome),
exec_stmt ge sp e m s1 t1 e1 m1 Out_normal ->
- transl_stmt_correct sp e m s1 t1 e1 m1 Out_normal ->
+ transl_stmt_prop sp e m s1 t1 e1 m1 Out_normal ->
exec_stmt ge sp e1 m1 s2 t2 e2 m2 out ->
- transl_stmt_correct sp e1 m1 s2 t2 e2 m2 out ->
+ transl_stmt_prop sp e1 m1 s2 t2 e2 m2 out ->
t = t1 ** t2 ->
- transl_stmt_correct sp e m (Sseq s1 s2) t e2 m2 out.
+ transl_stmt_prop sp e m (Sseq s1 s2) t e2 m2 out.
Proof.
intros; red; intros; inv TE.
exploit H0; eauto. intros [rs1 [st1 [OUT1 [EX1 ME1]]]]. inv OUT1.
@@ -1027,9 +1014,9 @@ Lemma transl_stmt_Sseq_stop_correct:
forall (sp : val) (e : env) (m : mem) (t: trace) (s1 s2 : stmt) (e1 : env)
(m1 : mem) (out : outcome),
exec_stmt ge sp e m s1 t e1 m1 out ->
- transl_stmt_correct sp e m s1 t e1 m1 out ->
+ transl_stmt_prop sp e m s1 t e1 m1 out ->
out <> Out_normal ->
- transl_stmt_correct sp e m (Sseq s1 s2) t e1 m1 out.
+ transl_stmt_prop sp e m (Sseq s1 s2) t e1 m1 out.
Proof.
intros; red; intros; inv TE.
exploit H0; eauto. intros [rs1 [st1 [OUT1 [EX1 ME1]]]].
@@ -1038,56 +1025,135 @@ Proof.
auto.
Qed.
-Lemma transl_stmt_Sexpr_correct:
- forall (sp: val) (e : env) (m : mem) (a : expr) (t: trace)
- (m1 : mem) (v : val),
- eval_expr ge sp nil e m a t m1 v ->
- transl_expr_correct sp nil e m a t m1 v ->
- transl_stmt_correct sp e m (Sexpr a) t e m1 Out_normal.
+Lemma transl_stmt_Sassign_correct:
+ forall (sp : val) (e : env) (m : mem) (id : ident) (a : expr)
+ (v : val),
+ eval_expr ge sp e m nil a v ->
+ transl_stmt_prop sp e m (Sassign id a) E0 (PTree.set id v e) m Out_normal.
Proof.
intros; red; intros; inv TE.
- exploit H0; eauto. intros [rs1 [EX1 [ME1 [RES1 OTHER1]]]].
- exists rs1; econstructor.
+ exploit transl_expr_correct; eauto.
+ intros [rs1 [EX1 [ME1 [RES1 OTHER1]]]].
+ exploit tr_store_var_correct; eauto. intros [rs2 [EX2 ME2]].
+ exists rs2; econstructor.
split. constructor.
- eauto.
+ split. eapply star_trans. eexact EX1. eexact EX2. traceEq.
+ congruence.
Qed.
-Lemma transl_stmt_Sassign_correct:
- forall (sp: val) (e : env) (m : mem)
- (id : ident) (a : expr) (t: trace) (m1 : mem) (v : val),
- eval_expr ge sp nil e m a t m1 v ->
- transl_expr_correct sp nil e m a t m1 v ->
- transl_stmt_correct sp e m (Sassign id a) t (PTree.set id v e) m1 Out_normal.
+Lemma transl_stmt_Sstore_correct:
+ forall (sp : val) (e : env) (m : mem) (chunk : memory_chunk)
+ (addr: addressing) (al: exprlist) (b: expr)
+ (vl: list val) (v: val) (vaddr: val) (m' : mem),
+ eval_exprlist ge sp e m nil al vl ->
+ eval_expr ge sp e m nil b v ->
+ eval_addressing ge sp addr vl = Some vaddr ->
+ storev chunk m vaddr v = Some m' ->
+ transl_stmt_prop sp e m (Sstore chunk addr al b) E0 e m' Out_normal.
Proof.
- intros; red; intros; inv TE.
- exploit H0; eauto. intros [rs1 [EX1 [ME1 [RES1 OTHER1]]]].
- exploit tr_move_correct; eauto. intros [rs2 [EX2 [RES2 OTHER2]]].
+ intros; red; intros; inv TE.
+ exploit transl_exprlist_correct; eauto. intros [rs1 [EX1 [ME1 [RES1 OTHER1]]]].
+ exploit transl_expr_correct; eauto. intros [rs2 [EX2 [ME2 [RES2 OTHER2]]]].
exists rs2; econstructor.
+ (* Outcome *)
split. constructor.
- split. eapply star_trans. eexact EX1. eexact EX2. traceEq.
- apply match_env_invariant with (rs1#rv <- v).
- apply match_env_update_var; auto.
- intros. rewrite Regmap.gsspec. destruct (peq r rv).
- subst r. congruence.
+ (* Exec *)
+ split. eapply star_trans. eexact EX1.
+ eapply star_right. eexact EX2.
+ eapply exec_Istore; eauto.
+ assert (rs2##rl = rs1##rl).
+ apply list_map_exten. intros r' IN. symmetry. apply OTHER2. auto.
+ rewrite H3; rewrite RES1.
+ rewrite (@eval_addressing_preserved _ _ ge tge). eexact H1.
+ exact symbols_preserved.
+ rewrite RES2. auto.
+ reflexivity. traceEq.
+ (* Match-env *)
auto.
Qed.
+Lemma transl_stmt_Scall_correct:
+ forall (sp : val) (e : env) (m : mem) (optid : option ident)
+ (sig : signature) (a : expr) (bl : exprlist) (vf : val)
+ (vargs : list val) (f : CminorSel.fundef) (t : trace) (m' : mem)
+ (vres : val) (e' : env),
+ eval_expr ge sp e m nil a vf ->
+ eval_exprlist ge sp e m nil bl vargs ->
+ Genv.find_funct ge vf = Some f ->
+ CminorSel.funsig f = sig ->
+ eval_funcall ge m f vargs t m' vres ->
+ transl_function_prop m f vargs t m' vres ->
+ e' = set_optvar optid vres e ->
+ transl_stmt_prop sp e m (Scall optid sig a bl) t e' m' Out_normal.
+Proof.
+ intros; red; intros; inv TE.
+ exploit transl_expr_correct; eauto.
+ intros [rs1 [EX1 [ME1 [RES1 OTHER1]]]].
+ exploit transl_exprlist_correct; eauto.
+ intros [rs2 [EX2 [ME2 [RES2 OTHER2]]]].
+ exploit functions_translated; eauto. intros [tf [TFIND TF]].
+ exploit H4; eauto. intro EXF.
+ exploit (tr_store_optvar_correct (rs2#rd <- vres)); eauto.
+ apply match_env_update_temp; eauto.
+ intros [rs3 [EX3 ME3]].
+ exists rs3; econstructor.
+ (* Outcome *)
+ split. constructor.
+ (* Exec *)
+ split. eapply star_trans. eexact EX1.
+ eapply star_trans. eexact EX2.
+ eapply star_left. eapply exec_Icall; eauto.
+ simpl. rewrite OTHER2. rewrite RES1. eauto. simpl; tauto.
+ eapply sig_transl_function; eauto.
+ eapply star_trans. rewrite RES2. eexact EXF.
+ eapply star_left. apply exec_return.
+ eexact EX3.
+ reflexivity. reflexivity. reflexivity. reflexivity. traceEq.
+ (* Match-env *)
+ rewrite Regmap.gss in ME3. auto.
+Qed.
+
+Lemma transl_stmt_Salloc_correct:
+ forall (sp : val) (e : env) (m : mem) (id : ident) (a : expr)
+ (n : int) (m' : mem) (b : block),
+ eval_expr ge sp e m nil a (Vint n) ->
+ alloc m 0 (Int.signed n) = (m', b) ->
+ transl_stmt_prop sp e m (Salloc id a) E0
+ (PTree.set id (Vptr b Int.zero) e) m' Out_normal.
+Proof.
+ intros; red; intros; inv TE.
+ exploit transl_expr_correct; eauto.
+ intros [rs1 [EX1 [ME1 [RES1 OTHER1]]]].
+ exploit (tr_store_var_correct (rs1#rd <- (Vptr b Int.zero))); eauto.
+ apply match_env_update_temp; eauto.
+ intros [rs2 [EX2 ME2]].
+ exists rs2; econstructor.
+ (* Outcome *)
+ split. constructor.
+ (* Execution *)
+ split. eapply star_trans. eexact EX1.
+ eapply star_left. 2: eexact EX2.
+ eapply exec_Ialloc; eauto.
+ reflexivity. traceEq.
+ (* Match-env *)
+ rewrite Regmap.gss in ME2. auto.
+Qed.
+
Lemma transl_stmt_Sifthenelse_correct:
- forall (sp: val) (e : env) (m : mem) (a : condexpr)
- (s1 s2 : stmt) (t t1: trace) (m1 : mem)
- (v1 : bool) (t2: trace) (e2 : env) (m2 : mem) (out : outcome),
- eval_condexpr ge sp nil e m a t1 m1 v1 ->
- transl_condition_correct sp nil e m a t1 m1 v1 ->
- exec_stmt ge sp e m1 (if v1 then s1 else s2) t2 e2 m2 out ->
- transl_stmt_correct sp e m1 (if v1 then s1 else s2) t2 e2 m2 out ->
- t = t1 ** t2 ->
- transl_stmt_correct sp e m (Sifthenelse a s1 s2) t e2 m2 out.
+ forall (sp : val) (e : env) (m : mem) (a : condexpr) (s1 s2 : stmt)
+ (v : bool) (t : trace) (e' : env) (m' : mem) (out : outcome),
+ eval_condexpr ge sp e m nil a v ->
+ exec_stmt ge sp e m (if v then s1 else s2) t e' m' out ->
+ transl_stmt_prop sp e m (if v then s1 else s2) t e' m' out ->
+ transl_stmt_prop sp e m (Sifthenelse a s1 s2) t e' m' out.
Proof.
intros; red; intros; inv TE.
- exploit H0; eauto. intros [rs1 [EX1 [ME1 OTHER1]]].
- assert (tr_stmt code map (if v1 then s1 else s2) (if v1 then ntrue else nfalse) ncont nexits nret rret).
- destruct v1; auto.
- exploit H2; eauto. intros [rs2 [st2 [OUT2 [EX2 ME2]]]].
+ exploit transl_condexpr_correct; eauto.
+ intros [rs1 [EX1 [ME1 OTHER1]]].
+ assert (tr_stmt code map (if v then s1 else s2) (if v then ntrue else nfalse)
+ ncont nexits nret rret).
+ destruct v; auto.
+ exploit H1; eauto. intros [rs2 [st2 [OUT2 [EX2 ME2]]]].
exists rs2; exists st2.
split. eauto.
split. eapply star_trans. eexact EX1. eexact EX2. auto.
@@ -1099,11 +1165,11 @@ Lemma transl_stmt_Sloop_loop_correct:
(e1 : env) (m1 : mem) (t2: trace) (e2 : env) (m2 : mem)
(out : outcome),
exec_stmt ge sp e m sl t1 e1 m1 Out_normal ->
- transl_stmt_correct sp e m sl t1 e1 m1 Out_normal ->
+ transl_stmt_prop sp e m sl t1 e1 m1 Out_normal ->
exec_stmt ge sp e1 m1 (Sloop sl) t2 e2 m2 out ->
- transl_stmt_correct sp e1 m1 (Sloop sl) t2 e2 m2 out ->
+ transl_stmt_prop sp e1 m1 (Sloop sl) t2 e2 m2 out ->
t = t1 ** t2 ->
- transl_stmt_correct sp e m (Sloop sl) t e2 m2 out.
+ transl_stmt_prop sp e m (Sloop sl) t e2 m2 out.
Proof.
intros; red; intros; inversion TE. subst.
exploit H0; eauto. intros [rs1 [st1 [OUT1 [EX1 ME1]]]]. inv OUT1.
@@ -1120,9 +1186,9 @@ Lemma transl_stmt_Sloop_stop_correct:
forall (sp: val) (e : env) (m : mem) (t: trace) (sl : stmt)
(e1 : env) (m1 : mem) (out : outcome),
exec_stmt ge sp e m sl t e1 m1 out ->
- transl_stmt_correct sp e m sl t e1 m1 out ->
+ transl_stmt_prop sp e m sl t e1 m1 out ->
out <> Out_normal ->
- transl_stmt_correct sp e m (Sloop sl) t e1 m1 out.
+ transl_stmt_prop sp e m (Sloop sl) t e1 m1 out.
Proof.
intros; red; intros; inv TE.
exploit H0; eauto. intros [rs1 [st1 [OUT1 [EX1 ME1]]]].
@@ -1135,8 +1201,8 @@ Lemma transl_stmt_Sblock_correct:
forall (sp: val) (e : env) (m : mem) (sl : stmt) (t: trace)
(e1 : env) (m1 : mem) (out : outcome),
exec_stmt ge sp e m sl t e1 m1 out ->
- transl_stmt_correct sp e m sl t e1 m1 out ->
- transl_stmt_correct sp e m (Sblock sl) t e1 m1 (outcome_block out).
+ transl_stmt_prop sp e m sl t e1 m1 out ->
+ transl_stmt_prop sp e m (Sblock sl) t e1 m1 (outcome_block out).
Proof.
intros; red; intros; inv TE.
exploit H0; eauto. intros [rs1 [st1 [OUT1 [EX1 ME1]]]].
@@ -1150,7 +1216,7 @@ Qed.
Lemma transl_stmt_Sexit_correct:
forall (sp: val) (e : env) (m : mem) (n : nat),
- transl_stmt_correct sp e m (Sexit n) E0 e m (Out_exit n).
+ transl_stmt_prop sp e m (Sexit n) E0 e m (Out_exit n).
Proof.
intros; red; intros; inv TE.
exists rs; econstructor.
@@ -1195,26 +1261,25 @@ Qed.
Lemma transl_stmt_Sswitch_correct:
forall (sp : val) (e : env) (m : mem) (a : expr)
- (cases : list (int * nat)) (default : nat)
- (t1 : trace) (m1 : mem) (n : int),
- eval_expr ge sp nil e m a t1 m1 (Vint n) ->
- transl_expr_correct sp nil e m a t1 m1 (Vint n) ->
- transl_stmt_correct sp e m (Sswitch a cases default) t1 e m1
+ (cases : list (int * nat)) (default : nat) (n : int),
+ eval_expr ge sp e m nil a (Vint n) ->
+ transl_stmt_prop sp e m (Sswitch a cases default) E0 e m
(Out_exit (switch_target n default cases)).
Proof.
intros; red; intros; inv TE.
- exploit H0; eauto. intros [rs1 [EX1 [ME1 [RES1 OTHER1]]]].
+ exploit transl_expr_correct; eauto.
+ intros [rs1 [EX1 [ME1 [RES1 OTHER1]]]].
exploit transl_switch_correct; eauto. intros [nd [EX2 MO2]].
exists rs1; econstructor.
split. econstructor.
- rewrite (validate_switch_correct _ _ _ H4 n). eauto.
+ rewrite (validate_switch_correct _ _ _ H3 n). eauto.
split. eapply star_trans. eexact EX1. eexact EX2. traceEq.
auto.
Qed.
Lemma transl_stmt_Sreturn_none_correct:
forall (sp: val) (e : env) (m : mem),
- transl_stmt_correct sp e m (Sreturn None) E0 e m (Out_return None).
+ transl_stmt_prop sp e m (Sreturn None) E0 e m (Out_return None).
Proof.
intros; red; intros; inv TE.
exists rs; econstructor.
@@ -1224,14 +1289,13 @@ Proof.
Qed.
Lemma transl_stmt_Sreturn_some_correct:
- forall (sp: val) (e : env) (m : mem) (a : expr) (t: trace)
- (m1 : mem) (v : val),
- eval_expr ge sp nil e m a t m1 v ->
- transl_expr_correct sp nil e m a t m1 v ->
- transl_stmt_correct sp e m (Sreturn (Some a)) t e m1 (Out_return (Some v)).
+ forall (sp : val) (e : env) (m : mem) (a : expr) (v : val),
+ eval_expr ge sp e m nil a v ->
+ transl_stmt_prop sp e m (Sreturn (Some a)) E0 e m (Out_return (Some v)).
Proof.
intros; red; intros; inv TE.
- exploit H0; eauto. intros [rs1 [EX1 [ME1 [RES1 OTHER1]]]].
+ exploit transl_expr_correct; eauto.
+ intros [rs1 [EX1 [ME1 [RES1 OTHER1]]]].
exists rs1; econstructor.
split. econstructor. reflexivity. auto.
eauto.
@@ -1239,26 +1303,22 @@ Qed.
Lemma transl_stmt_Stailcall_correct:
forall (sp : block) (e : env) (m : mem) (sig : signature) (a : expr)
- (bl : exprlist) (t t1 : trace) (m1 : mem) (t2 : trace) (m2 : mem)
- (t3 : trace) (m3 : mem) (vf : val) (vargs : list val) (vres : val)
- (f : CminorSel.fundef),
- eval_expr ge (Vptr sp Int.zero) nil e m a t1 m1 vf ->
- transl_expr_correct (Vptr sp Int.zero) nil e m a t1 m1 vf ->
- eval_exprlist ge (Vptr sp Int.zero) nil e m1 bl t2 m2 vargs ->
- transl_exprlist_correct (Vptr sp Int.zero) nil e m1 bl t2 m2 vargs ->
+ (bl : exprlist) (vf : val) (vargs : list val) (f : CminorSel.fundef)
+ (t : trace) (m' : mem) (vres : val),
+ eval_expr ge (Vptr sp Int.zero) e m nil a vf ->
+ eval_exprlist ge (Vptr sp Int.zero) e m nil bl vargs ->
Genv.find_funct ge vf = Some f ->
CminorSel.funsig f = sig ->
- eval_funcall ge (free m2 sp) f vargs t3 m3 vres ->
- transl_function_correct (free m2 sp) f vargs t3 m3 vres ->
- t = t1 ** t2 ** t3 ->
- transl_stmt_correct (Vptr sp Int.zero) e m (Stailcall sig a bl)
- t e m3 (Out_tailcall_return vres).
+ eval_funcall ge (free m sp) f vargs t m' vres ->
+ transl_function_prop (free m sp) f vargs t m' vres ->
+ transl_stmt_prop (Vptr sp Int.zero) e m (Stailcall sig a bl) t e
+ m' (Out_tailcall_return vres).
Proof.
intros; red; intros; inv TE.
- exploit H0; eauto. intros [rs1 [EX1 [ME1 [RES1 OTHER1]]]].
- exploit H2; eauto. intros [rs2 [EX2 [ME2 [RES2 OTHER2]]]].
+ exploit transl_expr_correct; eauto. intros [rs1 [EX1 [ME1 [RES1 OTHER1]]]].
+ exploit transl_exprlist_correct; eauto. intros [rs2 [EX2 [ME2 [RES2 OTHER2]]]].
exploit functions_translated; eauto. intros [tf [TFIND TF]].
- exploit H6; eauto. intro EXF.
+ exploit H4; eauto. intro EXF.
exists rs2; econstructor.
split. constructor.
split.
@@ -1274,41 +1334,25 @@ Proof.
Qed.
(** The correctness of the translation then follows by application
- of the mutual induction principle for CminorSel evaluation derivations
+ of the mutual induction principle for Cminor evaluation derivations
to the lemmas above. *)
-Theorem transl_function_correctness:
+Theorem transl_function_correct:
forall m f vargs t m' vres,
eval_funcall ge m f vargs t m' vres ->
- transl_function_correct m f vargs t m' vres.
+ transl_function_prop m f vargs t m' vres.
Proof
- (eval_funcall_ind5 ge
- transl_expr_correct
- transl_condition_correct
- transl_exprlist_correct
- transl_function_correct
- transl_stmt_correct
-
- transl_expr_Evar_correct
- transl_expr_Eop_correct
- transl_expr_Eload_correct
- transl_expr_Estore_correct
- transl_expr_Ecall_correct
- transl_expr_Econdition_correct
- transl_expr_Elet_correct
- transl_expr_Eletvar_correct
- transl_expr_Ealloc_correct
- transl_condition_CEtrue_correct
- transl_condition_CEfalse_correct
- transl_condition_CEcond_correct
- transl_condition_CEcondition_correct
- transl_exprlist_Enil_correct
- transl_exprlist_Econs_correct
+ (eval_funcall_ind2 ge
+ transl_function_prop
+ transl_stmt_prop
+
transl_funcall_internal_correct
transl_funcall_external_correct
transl_stmt_Sskip_correct
- transl_stmt_Sexpr_correct
transl_stmt_Sassign_correct
+ transl_stmt_Sstore_correct
+ transl_stmt_Scall_correct
+ transl_stmt_Salloc_correct
transl_stmt_Sifthenelse_correct
transl_stmt_Sseq_continue_correct
transl_stmt_Sseq_stop_correct
@@ -1321,21 +1365,171 @@ Proof
transl_stmt_Sreturn_some_correct
transl_stmt_Stailcall_correct).
-Require Import Smallstep.
+Theorem transl_stmt_correct:
+ forall sp e m s t e' m' out,
+ exec_stmt ge sp e m s t e' m' out ->
+ transl_stmt_prop sp e m s t e' m' out.
+Proof
+ (exec_stmt_ind2 ge
+ transl_function_prop
+ transl_stmt_prop
+
+ transl_funcall_internal_correct
+ transl_funcall_external_correct
+ transl_stmt_Sskip_correct
+ transl_stmt_Sassign_correct
+ transl_stmt_Sstore_correct
+ transl_stmt_Scall_correct
+ transl_stmt_Salloc_correct
+ transl_stmt_Sifthenelse_correct
+ transl_stmt_Sseq_continue_correct
+ transl_stmt_Sseq_stop_correct
+ transl_stmt_Sloop_loop_correct
+ transl_stmt_Sloop_stop_correct
+ transl_stmt_Sblock_correct
+ transl_stmt_Sexit_correct
+ transl_stmt_Sswitch_correct
+ transl_stmt_Sreturn_none_correct
+ transl_stmt_Sreturn_some_correct
+ transl_stmt_Stailcall_correct).
-(** The correctness of the translation follows: if the original CminorSel
- program executes with trace [t] and exit code [r], then the generated
- RTL program terminates with the same trace and exit code. *)
+(** ** Semantic preservation for the translation of divering statements *)
+
+Fixpoint size_stmt (s: stmt) : nat :=
+ match s with
+ | Sseq s1 s2 => (1 + size_stmt s1 + size_stmt s2)%nat
+ | Sifthenelse e s1 s2 => (1 + size_stmt s1 + size_stmt s2)%nat
+ | Sloop s1 => (1 + size_stmt s1)%nat
+ | Sblock s1 => (1 + size_stmt s1)%nat
+ | _ => 1%nat
+ end.
+
+Theorem transl_function_correct_divergence:
+ forall m fd vargs t tfd cs,
+ evalinf_funcall ge m fd vargs t ->
+ transl_fundef fd = OK tfd ->
+ forever_N step tge O (Callstate cs tfd vargs m) t.
+Proof.
+ cofix FUNCALL.
+ assert (STMT: forall sp e m s t,
+ execinf_stmt ge sp e m s t ->
+ forall cs code map ns ncont nexits nret rret rs
+ (MWF: map_wf map)
+ (TE: tr_stmt code map s ns ncont nexits nret rret)
+ (ME: match_env map e nil rs),
+ forever_N step tge (size_stmt s) (State cs code sp ns rs m) t).
+ cofix STMT; intros.
+ inv H; inversion TE; subst.
+ (* Scall *)
+ destruct (transl_expr_correct _ _ _ _ _ _ H0
+ cs _ _ _ _ _ _ _ MWF H7 ME)
+ as [rs1 [EX1 [ME1 [RES1 OTHER1]]]].
+ destruct (transl_exprlist_correct _ _ _ _ _ _ H1
+ cs _ _ _ _ _ _ _ MWF H8 ME1)
+ as [rs2 [EX2 [ME2 [RES2 OTHER2]]]].
+ destruct (functions_translated _ _ H2) as [tf [TFIND TF]].
+ eapply forever_N_star with (p := O).
+ eapply star_trans. eexact EX1. eexact EX2. reflexivity.
+ simpl; omega.
+ eapply forever_N_plus with (p := O).
+ apply plus_one. eapply exec_Icall; eauto.
+ simpl. rewrite OTHER2. rewrite RES1. eauto. simpl; tauto.
+ eapply sig_transl_function; eauto.
+ eapply FUNCALL. rewrite RES2. eexact H4. assumption.
+ reflexivity. traceEq.
+ (* Sifthenelse *)
+ destruct (transl_condexpr_correct _ _ _ _ _ _ H0
+ cs _ _ _ _ _ _ _ MWF H11 ME)
+ as [rs1 [EX1 [ME1 OTHER1]]].
+ eapply forever_N_star with (p := size_stmt (if v then s1 else s2)).
+ eexact EX1. destruct v; simpl; omega.
+ eapply STMT. eexact H1. eauto. destruct v; eauto. eauto.
+ traceEq.
+ (* Sseq, 1 *)
+ eapply forever_N_star with (p := size_stmt s1).
+ apply star_refl. simpl; omega.
+ eapply STMT; eauto.
+ traceEq.
+ (* Sseq, 2 *)
+ destruct (transl_stmt_correct _ _ _ _ _ _ _ _ H0
+ cs _ _ _ _ _ _ _ _ MWF H9 ME)
+ as [rs1 [st1 [OUT1 [EX1 ME1]]]].
+ inv OUT1.
+ eapply forever_N_star with (p := size_stmt s2).
+ eexact EX1. simpl; omega.
+ eapply STMT; eauto.
+ traceEq.
+ (* Sloop, body *)
+ eapply forever_N_star with (p := size_stmt s0).
+ apply star_refl. simpl; omega.
+ eapply STMT; eauto.
+ traceEq.
+ (* Sloop, loop *)
+ destruct (transl_stmt_correct _ _ _ _ _ _ _ _ H0
+ cs _ _ _ _ _ _ _ _ MWF H2 ME)
+ as [rs1 [st1 [OUT1 [EX1 ME1]]]].
+ inv OUT1.
+ eapply forever_N_plus with (p := size_stmt (Sloop s0)).
+ eapply plus_right. eexact EX1. eapply exec_Inop; eauto. reflexivity.
+ eapply STMT; eauto.
+ traceEq.
+ (* Sblock *)
+ eapply forever_N_star with (p := size_stmt s0).
+ apply star_refl. simpl; omega.
+ eapply STMT; eauto.
+ traceEq.
+ (* Stailcall *)
+ destruct (transl_expr_correct _ _ _ _ _ _ H0
+ cs _ _ _ _ _ _ _ MWF H6 ME)
+ as [rs1 [EX1 [ME1 [RES1 OTHER1]]]].
+ destruct (transl_exprlist_correct _ _ _ _ _ _ H1
+ cs _ _ _ _ _ _ _ MWF H12 ME1)
+ as [rs2 [EX2 [ME2 [RES2 OTHER2]]]].
+ destruct (functions_translated _ _ H2) as [tf [TFIND TF]].
+ eapply forever_N_star with (p := O).
+ eapply star_trans. eexact EX1. eexact EX2. reflexivity.
+ simpl; omega.
+ eapply forever_N_plus with (p := O).
+ apply plus_one. eapply exec_Itailcall; eauto.
+ simpl. rewrite OTHER2. rewrite RES1. eauto. simpl; tauto.
+ eapply sig_transl_function; eauto.
+ eapply FUNCALL. rewrite RES2. eexact H4. assumption.
+ reflexivity. traceEq.
+ (* funcall *)
+ intros. inversion H. subst m0 fd vargs0 t0.
+ generalize H0; simpl. caseEq (transl_function f); simpl. 2: congruence.
+ intros tfi EQ1 EQ2. injection EQ2; clear EQ2; intro EQ2.
+ assert (TR: tr_function f tfi). apply transl_function_charact; auto.
+ rewrite <- EQ2. inversion TR. subst f0.
+ pose (rs := init_regs vargs rparams).
+ assert (ME: match_env map2 e nil rs).
+ rewrite <- H2. unfold rs.
+ eapply match_init_env_init_reg; eauto.
+ assert (MWF: map_wf map2).
+ assert (map_valid init_mapping init_state) by apply init_mapping_valid.
+ exploit (add_vars_valid (CminorSel.fn_params f)); eauto. intros [A B].
+ eapply add_vars_wf; eauto. eapply add_vars_wf; eauto. apply init_mapping_wf.
+ eapply forever_N_plus with (p := size_stmt (fn_body f)).
+ apply plus_one. eapply exec_function_internal; eauto.
+ simpl. eapply STMT; eauto.
+ traceEq.
+Qed.
+
+(** ** Semantic preservation for whole programs. *)
+
+(** The correctness of the translation follows:
+ if the original Cminor program executes with observable behavior [beh],
+ then the generated RTL program executes with the same behavior. *)
Theorem transl_program_correct:
- forall (t: trace) (r: int),
- CminorSel.exec_program prog t (Vint r) ->
- RTL.exec_program tprog (Terminates t r).
+ forall (beh: program_behavior),
+ CminorSel.exec_program prog beh ->
+ RTL.exec_program tprog beh.
Proof.
- intros t r [b [f [m [SYMB [FUNC [SIG EVAL]]]]]].
- generalize (function_ptr_translated _ _ FUNC).
- intros [tf [TFIND TRANSLF]].
- exploit transl_function_correctness; eauto. intro EX.
+ intros. inv H.
+ (* termination *)
+ exploit function_ptr_translated; eauto. intros [tf [TFIND TRANSLF]].
+ exploit transl_function_correct; eauto. intro EX.
econstructor.
econstructor.
rewrite symbols_preserved.
@@ -1347,6 +1541,20 @@ Proof.
unfold fundef; rewrite (Genv.init_mem_transf_partial transl_fundef prog TRANSL).
eexact EX.
constructor.
+ (* divergence *)
+ exploit function_ptr_translated; eauto. intros [tf [TFIND TRANSLF]].
+ exploit transl_function_correct_divergence; eauto. intro EX.
+ econstructor.
+ econstructor.
+ rewrite symbols_preserved.
+ replace (prog_main tprog) with (prog_main prog). eauto.
+ symmetry; apply transform_partial_program_main with transl_fundef.
+ exact TRANSL.
+ eexact TFIND.
+ generalize (sig_transl_function _ _ TRANSLF). congruence.
+ eapply forever_N_forever.
+ unfold fundef; rewrite (Genv.init_mem_transf_partial transl_fundef prog TRANSL).
+ eexact EX.
Qed.
End CORRECTNESS.
diff --git a/backend/RTLgenspec.v b/backend/RTLgenspec.v
index c46bdbbaf..a291d3219 100644
--- a/backend/RTLgenspec.v
+++ b/backend/RTLgenspec.v
@@ -799,17 +799,6 @@ Inductive tr_expr (c: code):
c!n1 = Some (Iload chunk addr rl rd nd) ->
~reg_in_map map rd -> ~In rd pr ->
tr_expr c map pr (Eload chunk addr al) ns nd rd
- | tr_Estore: forall map pr chunk addr al b ns nd rd n1 rl n2,
- tr_exprlist c map pr al ns n1 rl ->
- tr_expr c map (rl ++ pr) b n1 n2 rd ->
- c!n2 = Some (Istore chunk addr rl rd nd) ->
- tr_expr c map pr (Estore chunk addr al b) ns nd rd
- | tr_Ecall: forall map pr sig b cl ns nd rd n1 rf n2 rargs,
- tr_expr c map pr b ns n1 rf ->
- tr_exprlist c map (rf :: pr) cl n1 n2 rargs ->
- c!n2 = Some (Icall sig (inl _ rf) rargs rd nd) ->
- ~reg_in_map map rd -> ~In rd pr ->
- tr_expr c map pr (Ecall sig b cl) ns nd rd
| tr_Econdition: forall map pr b ifso ifnot ns nd rd ntrue nfalse,
tr_condition c map pr b ns ntrue nfalse ->
tr_expr c map pr ifso ntrue nd rd ->
@@ -825,13 +814,8 @@ Inductive tr_expr (c: code):
(rd = r \/ ~reg_in_map map rd /\ ~In rd pr) ->
tr_move c ns r nd rd ->
tr_expr c map pr (Eletvar n) ns nd rd
- | tr_Ealloc: forall map pr a ns nd rd n1 r,
- tr_expr c map pr a ns n1 r ->
- c!n1 = Some (Ialloc r rd nd) ->
- ~reg_in_map map rd -> ~In rd pr ->
- tr_expr c map pr (Ealloc a) ns nd rd
-(** [tr_expr c map pr cond ns ntrue nfalse rd] holds if the graph [c],
+(** [tr_condition c map pr cond ns ntrue nfalse rd] holds if the graph [c],
starting at node [ns], contains instructions that compute the truth
value of the Cminor conditional expression [cond] and terminate
on node [ntrue] if the condition holds and on node [nfalse] otherwise. *)
@@ -866,6 +850,19 @@ with tr_exprlist (c: code):
tr_exprlist c map (r1 :: pr) al n1 nd rl ->
tr_exprlist c map pr (Econs a1 al) ns nd (r1 :: rl).
+(** Auxiliary for the compilation of variable assignments. *)
+
+Definition tr_store_var (c: code) (map: mapping)
+ (rs: reg) (id: ident) (ns nd: node): Prop :=
+ exists rv, map.(map_vars)!id = Some rv /\ tr_move c ns rs nd rv.
+
+Definition tr_store_optvar (c: code) (map: mapping)
+ (rs: reg) (optid: option ident) (ns nd: node): Prop :=
+ match optid with
+ | None => ns = nd
+ | Some id => tr_store_var c map rs id ns nd
+ end.
+
(** Auxiliary for the compilation of [switch] statements. *)
Inductive tr_switch
@@ -898,14 +895,28 @@ Inductive tr_stmt (c: code) (map: mapping):
stmt -> node -> node -> list node -> node -> option reg -> Prop :=
| tr_Sskip: forall ns nexits nret rret,
tr_stmt c map Sskip ns ns nexits nret rret
- | tr_Sexpr: forall a ns nd nexits nret rret r,
- tr_expr c map nil a ns nd r ->
- tr_stmt c map (Sexpr a) ns nd nexits nret rret
- | tr_Sassign: forall id a ns nd nexits nret rret rv rt n,
- map.(map_vars)!id = Some rv ->
- tr_move c n rt nd rv ->
+ | tr_Sassign: forall id a ns nd nexits nret rret rt n,
tr_expr c map nil a ns n rt ->
+ tr_store_var c map rt id n nd ->
tr_stmt c map (Sassign id a) ns nd nexits nret rret
+ | tr_Sstore: forall chunk addr al b ns nd nexits nret rret rd n1 rl n2,
+ tr_exprlist c map nil al ns n1 rl ->
+ tr_expr c map rl b n1 n2 rd ->
+ c!n2 = Some (Istore chunk addr rl rd nd) ->
+ tr_stmt c map (Sstore chunk addr al b) ns nd nexits nret rret
+ | tr_Scall: forall optid sig b cl ns nd nexits nret rret rd n1 rf n2 n3 rargs,
+ tr_expr c map nil b ns n1 rf ->
+ tr_exprlist c map (rf :: nil) cl n1 n2 rargs ->
+ c!n2 = Some (Icall sig (inl _ rf) rargs rd n3) ->
+ tr_store_optvar c map rd optid n3 nd ->
+ ~reg_in_map map rd ->
+ tr_stmt c map (Scall optid sig b cl) ns nd nexits nret rret
+ | tr_Salloc: forall id a ns nd nexits nret rret rd n1 n2 r,
+ tr_expr c map nil a ns n1 r ->
+ c!n1 = Some (Ialloc r rd n2) ->
+ tr_store_var c map rd id n2 nd ->
+ ~reg_in_map map rd ->
+ tr_stmt c map (Salloc id a) ns nd nexits nret rret
| tr_Sseq: forall s1 s2 ns nd nexits nret rret n,
tr_stmt c map s2 n nd nexits nret rret ->
tr_stmt c map s1 ns n nexits nret rret ->
@@ -975,10 +986,10 @@ Definition tr_expr_condition_exprlist_ind3
(P : mapping -> list reg -> expr -> node -> node -> reg -> Prop)
(P0 : mapping -> list reg -> condexpr -> node -> node -> node -> Prop)
(P1 : mapping -> list reg -> exprlist -> node -> node -> list reg -> Prop) :=
- fun a b c' d e f g h i j k l m n o =>
- conj (tr_expr_ind3 c P P0 P1 a b c' d e f g h i j k l m n o)
- (conj (tr_condition_ind3 c P P0 P1 a b c' d e f g h i j k l m n o)
- (tr_exprlist_ind3 c P P0 P1 a b c' d e f g h i j k l m n o)).
+ fun a b c' d e f g h i j k l =>
+ conj (tr_expr_ind3 c P P0 P1 a b c' d e f g h i j k l)
+ (conj (tr_condition_ind3 c P P0 P1 a b c' d e f g h i j k l)
+ (tr_exprlist_ind3 c P P0 P1 a b c' d e f g h i j k l)).
Lemma tr_move_extends:
forall s1 s2, state_extends s1 s2 ->
@@ -1048,10 +1059,10 @@ Scheme expr_ind3 := Induction for expr Sort Prop
Definition expr_condexpr_exprlist_ind
(P1: expr -> Prop) (P2: condexpr -> Prop) (P3: exprlist -> Prop) :=
- fun a b c d e f g h i j k l m n o =>
- conj (expr_ind3 P1 P2 P3 a b c d e f g h i j k l m n o)
- (conj (condexpr_ind3 P1 P2 P3 a b c d e f g h i j k l m n o)
- (exprlist_ind3 P1 P2 P3 a b c d e f g h i j k l m n o)).
+ fun a b c d e f g h i j k l =>
+ conj (expr_ind3 P1 P2 P3 a b c d e f g h i j k l)
+ (conj (condexpr_ind3 P1 P2 P3 a b c d e f g h i j k l)
+ (exprlist_ind3 P1 P2 P3 a b c d e f g h i j k l)).
Lemma add_move_charact:
forall s ns rs nd rd s',
@@ -1109,49 +1120,6 @@ Proof.
split. econstructor; eauto.
eapply instr_at_incr; eauto.
apply state_incr_trans with s1; eauto with rtlg.
- (* Estore *)
- inv OK.
- assert (state_incr s s1). eauto with rtlg.
- exploit (H0 _ _ _ _ _ _ (x ++ pr) EQ0).
- eauto with rtlg.
- apply target_reg_ok_append. constructor; auto.
- intros. exploit alloc_regs_fresh_or_in_map; eauto.
- intros [A|B]. auto. right. apply sym_not_equal.
- eapply valid_fresh_different; eauto with rtlg.
- red; intros. elim (in_app_or _ _ _ H4); intro.
- exploit alloc_regs_valid; eauto with rtlg.
- generalize (VALID _ H5). eauto with rtlg.
- eauto with rtlg.
- intros [A B].
- exploit (H _ _ _ _ _ _ pr EQ3); eauto with rtlg.
- intros [C D].
- split. econstructor; eauto.
- apply tr_expr_incr with s2; eauto with rtlg.
- apply instr_at_incr with s1; eauto with rtlg.
- eauto with rtlg.
- (* Ecall *)
- inv OK.
- assert (state_incr s0 s3).
- apply state_incr_trans with s1. eauto with rtlg.
- apply state_incr_trans with s2; eauto with rtlg.
- assert (regs_valid (x :: pr) s1).
- apply regs_valid_cons; eauto with rtlg.
- exploit (H0 _ _ _ _ _ _ (x :: pr) EQ2).
- eauto with rtlg.
- apply alloc_regs_target_ok with s1 s2; eauto with rtlg.
- eauto with rtlg.
- apply regs_valid_incr with s2; eauto with rtlg.
- intros [A B].
- exploit (H _ _ _ _ _ _ pr EQ4).
- eauto with rtlg.
- eauto with rtlg.
- apply regs_valid_incr with s0; eauto with rtlg.
- apply reg_valid_incr with s1; eauto with rtlg.
- intros [C D].
- split. econstructor; eauto.
- apply tr_exprlist_incr with s4; eauto.
- apply instr_at_incr with s3; eauto with rtlg.
- eauto with rtlg.
(* Econdition *)
inv OK.
exploit (H1 _ _ _ _ _ _ pr EQ); eauto with rtlg.
@@ -1192,13 +1160,6 @@ Proof.
inv OK. left; congruence. right; eauto.
auto.
monadInv EQ1.
- (* Ealloc *)
- inv OK.
- exploit (H _ _ _ _ _ _ pr EQ2); eauto with rtlg.
- intros [A B].
- split. econstructor; eauto.
- eapply instr_at_incr; eauto.
- apply state_incr_trans with s1; eauto with rtlg.
(* CEtrue *)
split. constructor. auto with rtlg.
@@ -1264,6 +1225,27 @@ Proof.
intros. eapply B; eauto with rtlg.
Qed.
+Lemma tr_store_var_extends:
+ forall s1 s2, state_extends s1 s2 ->
+ forall map rs id ns nd,
+ tr_store_var s1.(st_code) map rs id ns nd ->
+ tr_store_var s2.(st_code) map rs id ns nd.
+Proof.
+ intros. destruct H0 as [rv [A B]].
+ econstructor; split. eauto. eapply tr_move_extends; eauto.
+Qed.
+
+Lemma tr_store_optvar_extends:
+ forall s1 s2, state_extends s1 s2 ->
+ forall map rs optid ns nd,
+ tr_store_optvar s1.(st_code) map rs optid ns nd ->
+ tr_store_optvar s2.(st_code) map rs optid ns nd.
+Proof.
+ intros until nd. destruct optid; simpl.
+ apply tr_store_var_extends; auto.
+ auto.
+Qed.
+
Lemma tr_switch_extends:
forall s1 s2, state_extends s1 s2 ->
forall r nexits t ns,
@@ -1284,8 +1266,9 @@ Proof.
intros s1 s2 EXT.
destruct (tr_expr_condition_exprlist_extends s1 s2 EXT) as [A [B C]].
pose (AT := fun pc i => instr_at_extends s1 s2 pc i EXT).
+ pose (STV := tr_store_var_extends s1 s2 EXT).
+ pose (STOV := tr_store_optvar_extends s1 s2 EXT).
induction 1; econstructor; eauto.
- eapply tr_move_extends; eauto.
eapply tr_switch_extends; eauto.
Qed.
@@ -1298,6 +1281,28 @@ Proof.
intros. eapply tr_stmt_extends; eauto with rtlg.
Qed.
+
+Lemma store_var_charact:
+ forall map rs id nd s ns s',
+ store_var map rs id nd s = OK ns s' ->
+ tr_store_var s'.(st_code) map rs id ns nd /\ state_incr s s'.
+Proof.
+ intros. monadInv H. generalize EQ. unfold find_var.
+ caseEq ((map_vars map)!id). 2: intros; discriminate. intros. monadInv EQ1.
+ exploit add_move_charact; eauto. intros [A B].
+ split; auto. exists x; auto.
+Qed.
+
+Lemma store_optvar_charact:
+ forall map rs optid nd s ns s',
+ store_optvar map rs optid nd s = OK ns s' ->
+ tr_store_optvar s'.(st_code) map rs optid ns nd /\ state_incr s s'.
+Proof.
+ intros. destruct optid; simpl in H; simpl.
+ eapply store_var_charact; eauto.
+ monadInv H. split. auto. apply state_incr_refl.
+Qed.
+
Lemma transl_exit_charact:
forall nexits n s ne s',
transl_exit nexits n s = OK ne s' ->
@@ -1344,18 +1349,85 @@ Proof.
induction stmt; intros; simpl in TR; try (monadInv TR).
(* Sskip *)
split. constructor. auto with rtlg.
- (* Sexpr *)
- exploit transl_expr_charact; eauto with rtlg. intros [A B].
- split. econstructor; eauto. eauto with rtlg.
(* Sassign *)
- exploit add_move_charact; eauto. intros [A B].
+ exploit store_var_charact; eauto. intros [A B].
exploit transl_expr_charact; eauto with rtlg.
- apply map_valid_incr with s; eauto with rtlg.
intros [C D].
- generalize EQ. unfold find_var. caseEq (map_vars map)!i; intros; inv EQ2.
split. econstructor; eauto.
- apply tr_move_extends with s2; eauto with rtlg.
+ apply tr_store_var_extends with s1; eauto with rtlg.
eauto with rtlg.
+ (* Sstore *)
+ assert (state_incr s s1). eauto with rtlg.
+ assert (state_incr s s2). eauto with rtlg.
+ assert (map_valid map s2). eauto with rtlg.
+ destruct transl_expr_condexpr_list_charact as [P1 [P2 P3]].
+ exploit (P1 _ _ _ _ _ _ _ x EQ2).
+ auto.
+ eapply alloc_reg_target_ok with (s1 := s0); eauto with rtlg.
+ apply regs_valid_incr with s0; eauto with rtlg.
+ apply reg_valid_incr with s1; eauto with rtlg.
+ intros [A B].
+ exploit (P3 _ _ _ _ _ _ _ nil EQ4).
+ apply map_valid_incr with s2; auto.
+ eapply alloc_regs_target_ok with (s1 := s); eauto with rtlg.
+ auto with rtlg.
+ apply regs_valid_incr with s0; eauto with rtlg.
+ intros [C D].
+ split. econstructor; eauto.
+ apply tr_expr_incr with s3; eauto with rtlg.
+ apply instr_at_incr with s2; eauto with rtlg.
+ eauto with rtlg.
+ (* Scall *)
+ assert (state_incr s0 s3).
+ apply state_incr_trans with s1. eauto with rtlg.
+ apply state_incr_trans with s2; eauto with rtlg.
+ exploit store_optvar_charact; eauto. intros [A B].
+ assert (state_incr s0 s5) by eauto with rtlg.
+ destruct transl_expr_condexpr_list_charact as [P1 [P2 P3]].
+ exploit (P3 _ _ _ _ _ _ _ (x :: nil) EQ4).
+ apply map_valid_incr with s0; auto.
+ eapply alloc_regs_target_ok with (s1 := s1); eauto with rtlg.
+ apply regs_valid_cons; eauto with rtlg.
+ apply regs_valid_incr with s1.
+ apply state_incr_trans with s3; eauto with rtlg.
+ apply regs_valid_cons; eauto with rtlg.
+ apply regs_valid_incr with s2.
+ apply state_incr_trans with s3; eauto with rtlg.
+ eauto with rtlg.
+ intros [C D].
+ exploit (P1 _ _ _ _ _ _ _ nil EQ6).
+ apply map_valid_incr with s0; eauto with rtlg.
+ eapply alloc_reg_target_ok with (s1 := s0); eauto with rtlg.
+ auto with rtlg.
+ apply reg_valid_incr with s1.
+ apply state_incr_trans with s3; eauto with rtlg.
+ eauto with rtlg.
+ intros [E F].
+ split. econstructor; eauto.
+ apply tr_exprlist_incr with s6; eauto.
+ apply instr_at_incr with s5; eauto with rtlg.
+ apply tr_store_optvar_extends with s4; eauto with rtlg.
+ red; intro.
+ apply valid_fresh_absurd with x1 s2.
+ apply reg_valid_incr with s0; eauto with rtlg.
+ eauto with rtlg.
+ eauto with rtlg.
+ (* Salloc *)
+ exploit store_var_charact; eauto. intros [A B].
+ exploit transl_expr_charact; eauto.
+ apply map_valid_incr with s; auto.
+ apply state_incr_trans with s1; eauto with rtlg.
+ eapply alloc_reg_target_ok with (s1 := s); eauto with rtlg.
+ apply reg_valid_incr with s0; eauto with rtlg.
+ intros [C D].
+ split. econstructor; eauto.
+ apply instr_at_incr with s3; eauto with rtlg.
+ apply tr_store_var_extends with s2; eauto with rtlg.
+ red; intro.
+ apply valid_fresh_absurd with x0 s0.
+ apply reg_valid_incr with s; eauto with rtlg.
+ eauto with rtlg.
+ apply state_incr_trans with s2; eauto with rtlg.
(* Sseq *)
exploit IHstmt2; eauto with rtlg. intros [A B].
exploit IHstmt1; eauto with rtlg. intros [C D].
diff --git a/backend/Selection.v b/backend/Selection.v
index c98e55e4f..0183ee7d9 100644
--- a/backend/Selection.v
+++ b/backend/Selection.v
@@ -38,16 +38,11 @@ Fixpoint lift_expr (p: nat) (a: expr) {struct a}: expr :=
| Evar id => Evar id
| Eop op bl => Eop op (lift_exprlist p bl)
| Eload chunk addr bl => Eload chunk addr (lift_exprlist p bl)
- | Estore chunk addr bl c =>
- Estore chunk addr (lift_exprlist p bl) (lift_expr p c)
- | Ecall sig b cl => Ecall sig (lift_expr p b) (lift_exprlist p cl)
| Econdition b c d =>
Econdition (lift_condexpr p b) (lift_expr p c) (lift_expr p d)
| Elet b c => Elet (lift_expr p b) (lift_expr (S p) c)
| Eletvar n =>
if le_gt_dec p n then Eletvar (S n) else Eletvar n
- | Ealloc b =>
- Ealloc (lift_expr p b)
end
with lift_condexpr (p: nat) (a: condexpr) {struct a}: condexpr :=
@@ -981,7 +976,7 @@ Definition load (chunk: memory_chunk) (e1: expr) :=
Definition store (chunk: memory_chunk) (e1 e2: expr) :=
match addressing e1 with
- | (mode, args) => Estore chunk mode args e2
+ | (mode, args) => Sstore chunk mode args e2
end.
(** * Translation from Cminor to CminorSel *)
@@ -1046,20 +1041,15 @@ Fixpoint sel_expr (a: Cminor.expr) : expr :=
| Cminor.Eunop op arg => sel_unop op (sel_expr arg)
| Cminor.Ebinop op arg1 arg2 => sel_binop op (sel_expr arg1) (sel_expr arg2)
| Cminor.Eload chunk addr => load chunk (sel_expr addr)
- | Cminor.Estore chunk addr rhs => store chunk (sel_expr addr) (sel_expr rhs)
- | Cminor.Ecall sg fn args => Ecall sg (sel_expr fn) (sel_exprlist args)
| Cminor.Econdition cond ifso ifnot =>
Econdition (condexpr_of_expr (sel_expr cond))
(sel_expr ifso) (sel_expr ifnot)
- | Cminor.Elet b c => Elet (sel_expr b) (sel_expr c)
- | Cminor.Eletvar n => Eletvar n
- | Cminor.Ealloc b => Ealloc (sel_expr b)
- end
+ end.
-with sel_exprlist (al: Cminor.exprlist) : exprlist :=
+Fixpoint sel_exprlist (al: list Cminor.expr) : exprlist :=
match al with
- | Cminor.Enil => Enil
- | Cminor.Econs a bl => Econs (sel_expr a) (sel_exprlist bl)
+ | nil => Enil
+ | a :: bl => Econs (sel_expr a) (sel_exprlist bl)
end.
(** Conversion from Cminor statements to Cminorsel statements. *)
@@ -1067,8 +1057,11 @@ with sel_exprlist (al: Cminor.exprlist) : exprlist :=
Fixpoint sel_stmt (s: Cminor.stmt) : stmt :=
match s with
| Cminor.Sskip => Sskip
- | Cminor.Sexpr e => Sexpr (sel_expr e)
| Cminor.Sassign id e => Sassign id (sel_expr e)
+ | Cminor.Sstore chunk addr rhs => store chunk (sel_expr addr) (sel_expr rhs)
+ | Cminor.Scall optid sg fn args =>
+ Scall optid sg (sel_expr fn) (sel_exprlist args)
+ | Cminor.Salloc id b => Salloc id (sel_expr b)
| Cminor.Sseq s1 s2 => Sseq (sel_stmt s1) (sel_stmt s2)
| Cminor.Sifthenelse e ifso ifnot =>
Sifthenelse (condexpr_of_expr (sel_expr e))
diff --git a/backend/Selectionproof.v b/backend/Selectionproof.v
index e41765a76..177e32118 100644
--- a/backend/Selectionproof.v
+++ b/backend/Selectionproof.v
@@ -19,6 +19,9 @@ Open Local Scope selection_scope.
Section CMCONSTR.
Variable ge: genv.
+Variable sp: val.
+Variable e: env.
+Variable m: mem.
(** * Lifting of let-bound variables *)
@@ -57,72 +60,34 @@ Proof.
apply IHinsert_lenv. exact H0. omega.
Qed.
-Scheme eval_expr_ind_3 := Minimality for eval_expr Sort Prop
- with eval_condexpr_ind_3 := Minimality for eval_condexpr Sort Prop
- with eval_exprlist_ind_3 := Minimality for eval_exprlist Sort Prop.
-
-Hint Resolve eval_Evar eval_Eop eval_Eload eval_Estore
- eval_Ecall eval_Econdition eval_Ealloc
+Hint Resolve eval_Evar eval_Eop eval_Eload eval_Econdition
eval_Elet eval_Eletvar
eval_CEtrue eval_CEfalse eval_CEcond
eval_CEcondition eval_Enil eval_Econs: evalexpr.
-Lemma eval_list_one:
- forall sp le e m1 a t m2 v,
- eval_expr ge sp le e m1 a t m2 v ->
- eval_exprlist ge sp le e m1 (a ::: Enil) t m2 (v :: nil).
-Proof.
- intros. econstructor. eauto. constructor. traceEq.
-Qed.
-
-Lemma eval_list_two:
- forall sp le e m1 a1 t1 m2 v1 a2 t2 m3 v2 t,
- eval_expr ge sp le e m1 a1 t1 m2 v1 ->
- eval_expr ge sp le e m2 a2 t2 m3 v2 ->
- t = t1 ** t2 ->
- eval_exprlist ge sp le e m1 (a1 ::: a2 ::: Enil) t m3 (v1 :: v2 :: nil).
-Proof.
- intros. econstructor. eauto. econstructor. eauto. constructor.
- reflexivity. traceEq.
-Qed.
-
-Lemma eval_list_three:
- forall sp le e m1 a1 t1 m2 v1 a2 t2 m3 v2 a3 t3 m4 v3 t,
- eval_expr ge sp le e m1 a1 t1 m2 v1 ->
- eval_expr ge sp le e m2 a2 t2 m3 v2 ->
- eval_expr ge sp le e m3 a3 t3 m4 v3 ->
- t = t1 ** t2 ** t3 ->
- eval_exprlist ge sp le e m1 (a1 ::: a2 ::: a3 ::: Enil) t m4 (v1 :: v2 :: v3 :: nil).
-Proof.
- intros. econstructor. eauto. econstructor. eauto. econstructor. eauto. constructor.
- reflexivity. reflexivity. traceEq.
-Qed.
-
-Hint Resolve eval_list_one eval_list_two eval_list_three: evalexpr.
-
Lemma eval_lift_expr:
- forall w sp le e m1 a t m2 v,
- eval_expr ge sp le e m1 a t m2 v ->
+ forall w le a v,
+ eval_expr ge sp e m le a v ->
forall p le', insert_lenv le p w le' ->
- eval_expr ge sp le' e m1 (lift_expr p a) t m2 v.
+ eval_expr ge sp e m le' (lift_expr p a) v.
Proof.
- intros w.
- apply (eval_expr_ind_3 ge
- (fun sp le e m1 a t m2 v =>
+ intro w.
+ apply (eval_expr_ind3 ge sp e m
+ (fun le a v =>
forall p le', insert_lenv le p w le' ->
- eval_expr ge sp le' e m1 (lift_expr p a) t m2 v)
- (fun sp le e m1 a t m2 vb =>
+ eval_expr ge sp e m le' (lift_expr p a) v)
+ (fun le a v =>
forall p le', insert_lenv le p w le' ->
- eval_condexpr ge sp le' e m1 (lift_condexpr p a) t m2 vb)
- (fun sp le e m1 al t m2 vl =>
+ eval_condexpr ge sp e m le' (lift_condexpr p a) v)
+ (fun le al vl =>
forall p le', insert_lenv le p w le' ->
- eval_exprlist ge sp le' e m1 (lift_exprlist p al) t m2 vl));
+ eval_exprlist ge sp e m le' (lift_exprlist p al) vl));
simpl; intros; eauto with evalexpr.
destruct v1; eapply eval_Econdition;
eauto with evalexpr; simpl; eauto with evalexpr.
- eapply eval_Elet. eauto. apply H2. apply insert_lenv_S; auto. auto.
+ eapply eval_Elet. eauto. apply H2. apply insert_lenv_S; auto.
case (le_gt_dec p n); intro.
apply eval_Eletvar. eapply insert_lenv_lookup2; eauto.
@@ -133,13 +98,14 @@ Proof.
Qed.
Lemma eval_lift:
- forall sp le e m1 a t m2 v w,
- eval_expr ge sp le e m1 a t m2 v ->
- eval_expr ge sp (w::le) e m1 (lift a) t m2 v.
+ forall le a v w,
+ eval_expr ge sp e m le a v ->
+ eval_expr ge sp e m (w::le) (lift a) v.
Proof.
intros. unfold lift. eapply eval_lift_expr.
eexact H. apply insert_lenv_0.
Qed.
+
Hint Resolve eval_lift: evalexpr.
(** * Useful lemmas and tactics *)
@@ -152,75 +118,37 @@ Ltac EvalOp := eapply eval_Eop; eauto with evalexpr.
Ltac TrivialOp cstr := unfold cstr; intros; EvalOp.
-Lemma inv_eval_Eop_0:
- forall sp le e m1 op t m2 v,
- eval_expr ge sp le e m1 (Eop op Enil) t m2 v ->
- t = E0 /\ m2 = m1 /\ eval_operation ge sp op nil m1 = Some v.
-Proof.
- intros. inversion H. inversion H6.
- intuition. congruence.
-Qed.
-
-Lemma inv_eval_Eop_1:
- forall sp le e m1 op t a1 m2 v,
- eval_expr ge sp le e m1 (Eop op (a1 ::: Enil)) t m2 v ->
- exists v1,
- eval_expr ge sp le e m1 a1 t m2 v1 /\
- eval_operation ge sp op (v1 :: nil) m2 = Some v.
-Proof.
- intros.
- inversion H. inversion H6. inversion H18.
- subst. exists v1; intuition. rewrite E0_right. auto.
-Qed.
-
-Lemma inv_eval_Eop_2:
- forall sp le e m1 op a1 a2 t3 m3 v,
- eval_expr ge sp le e m1 (Eop op (a1 ::: a2 ::: Enil)) t3 m3 v ->
- exists t1, exists t2, exists m2, exists v1, exists v2,
- eval_expr ge sp le e m1 a1 t1 m2 v1 /\
- eval_expr ge sp le e m2 a2 t2 m3 v2 /\
- t3 = t1 ** t2 /\
- eval_operation ge sp op (v1 :: v2 :: nil) m3 = Some v.
-Proof.
- intros.
- inversion H. subst. inversion H6. subst. inversion H8. subst.
- inversion H11. subst.
- exists t1; exists t0; exists m0; exists v0; exists v1.
- intuition. traceEq.
-Qed.
+Ltac InvEval1 :=
+ match goal with
+ | [ H: (eval_expr _ _ _ _ _ (Eop _ Enil) _) |- _ ] =>
+ inv H; InvEval1
+ | [ H: (eval_expr _ _ _ _ _ (Eop _ (_ ::: Enil)) _) |- _ ] =>
+ inv H; InvEval1
+ | [ H: (eval_expr _ _ _ _ _ (Eop _ (_ ::: _ ::: Enil)) _) |- _ ] =>
+ inv H; InvEval1
+ | [ H: (eval_exprlist _ _ _ _ _ Enil _) |- _ ] =>
+ inv H; InvEval1
+ | [ H: (eval_exprlist _ _ _ _ _ (_ ::: _) _) |- _ ] =>
+ inv H; InvEval1
+ | _ =>
+ idtac
+ end.
-Ltac SimplEval :=
+Ltac InvEval2 :=
match goal with
- | [ |- (eval_expr _ ?sp ?le ?e ?m1 (Eop ?op Enil) ?t ?m2 ?v) -> _] =>
- intro XX1;
- generalize (inv_eval_Eop_0 sp le e m1 op t m2 v XX1);
- clear XX1;
- intros [XX1 [XX2 XX3]];
- subst t m2; simpl in XX3;
- try (simplify_eq XX3; clear XX3;
- let EQ := fresh "EQ" in (intro EQ; rewrite EQ))
- | [ |- (eval_expr _ ?sp ?le ?e ?m1 (Eop ?op (?a1 ::: Enil)) ?t ?m2 ?v) -> _] =>
- intro XX1;
- generalize (inv_eval_Eop_1 sp le e m1 op t a1 m2 v XX1);
- clear XX1;
- let v1 := fresh "v" in let EV := fresh "EV" in
- let EQ := fresh "EQ" in
- (intros [v1 [EV EQ]]; simpl in EQ)
- | [ |- (eval_expr _ ?sp ?le ?e ?m1 (Eop ?op (?a1 ::: ?a2 ::: Enil)) ?t ?m2 ?v) -> _] =>
- intro XX1;
- generalize (inv_eval_Eop_2 sp le e m1 op a1 a2 t m2 v XX1);
- clear XX1;
- let t1 := fresh "t" in let t2 := fresh "t" in
- let m := fresh "m" in
- let v1 := fresh "v" in let v2 := fresh "v" in
- let EV1 := fresh "EV" in let EV2 := fresh "EV" in
- let EQ := fresh "EQ" in let TR := fresh "TR" in
- (intros [t1 [t2 [m [v1 [v2 [EV1 [EV2 [TR EQ]]]]]]]]; simpl in EQ)
- | _ => idtac
+ | [ H: (eval_operation _ _ _ nil _ = Some _) |- _ ] =>
+ simpl in H; inv H
+ | [ H: (eval_operation _ _ _ (_ :: nil) _ = Some _) |- _ ] =>
+ simpl in H; FuncInv
+ | [ H: (eval_operation _ _ _ (_ :: _ :: nil) _ = Some _) |- _ ] =>
+ simpl in H; FuncInv
+ | [ H: (eval_operation _ _ _ (_ :: _ :: _ :: nil) _ = Some _) |- _ ] =>
+ simpl in H; FuncInv
+ | _ =>
+ idtac
end.
-Ltac InvEval H :=
- generalize H; SimplEval; clear H.
+Ltac InvEval := InvEval1; InvEval2; InvEval2.
(** * Correctness of the smart constructors *)
@@ -244,31 +172,31 @@ Ltac InvEval H :=
by the smart constructor.
*)
-Lemma eval_notint:
- forall sp le e m1 a t m2 x,
- eval_expr ge sp le e m1 a t m2 (Vint x) ->
- eval_expr ge sp le e m1 (notint a) t m2 (Vint (Int.not x)).
+Theorem eval_notint:
+ forall le a x,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le (notint a) (Vint (Int.not x)).
Proof.
- unfold notint; intros until x; case (notint_match a); intros.
- InvEval H. FuncInv. EvalOp. simpl. congruence.
- InvEval H. FuncInv. EvalOp. simpl. congruence.
- InvEval H. FuncInv. EvalOp. simpl. congruence.
+ unfold notint; intros until x; case (notint_match a); intros; InvEval.
+ EvalOp. simpl. congruence.
+ EvalOp. simpl. congruence.
+ EvalOp. simpl. congruence.
eapply eval_Elet. eexact H.
eapply eval_Eop.
eapply eval_Econs. apply eval_Eletvar. simpl. reflexivity.
eapply eval_Econs. apply eval_Eletvar. simpl. reflexivity.
- apply eval_Enil. reflexivity. reflexivity.
- simpl. rewrite Int.or_idem. auto. traceEq.
+ apply eval_Enil.
+ simpl. rewrite Int.or_idem. auto.
Qed.
Lemma eval_notbool_base:
- forall sp le e m1 a t m2 v b,
- eval_expr ge sp le e m1 a t m2 v ->
+ forall le a v b,
+ eval_expr ge sp e m le a v ->
Val.bool_of_val v b ->
- eval_expr ge sp le e m1 (notbool_base a) t m2 (Val.of_bool (negb b)).
+ eval_expr ge sp e m le (notbool_base a) (Val.of_bool (negb b)).
Proof.
TrivialOp notbool_base. simpl.
- inversion H0.
+ inv H0.
rewrite Int.eq_false; auto.
rewrite Int.eq_true; auto.
reflexivity.
@@ -277,245 +205,203 @@ Qed.
Hint Resolve Val.bool_of_true_val Val.bool_of_false_val
Val.bool_of_true_val_inv Val.bool_of_false_val_inv: valboolof.
-Lemma eval_notbool:
- forall a sp le e m1 t m2 v b,
- eval_expr ge sp le e m1 a t m2 v ->
+Theorem eval_notbool:
+ forall le a v b,
+ eval_expr ge sp e m le a v ->
Val.bool_of_val v b ->
- eval_expr ge sp le e m1 (notbool a) t m2 (Val.of_bool (negb b)).
+ eval_expr ge sp e m le (notbool a) (Val.of_bool (negb b)).
Proof.
- assert (N1: forall v b, Val.is_false v -> Val.bool_of_val v b -> Val.is_true (Val.of_bool (negb b))).
- intros. inversion H0; simpl; auto; subst v; simpl in H.
- congruence. apply Int.one_not_zero. contradiction.
- assert (N2: forall v b, Val.is_true v -> Val.bool_of_val v b -> Val.is_false (Val.of_bool (negb b))).
- intros. inversion H0; simpl; auto; subst v; simpl in H.
- congruence.
-
induction a; simpl; intros; try (eapply eval_notbool_base; eauto).
destruct o; try (eapply eval_notbool_base; eauto).
- destruct e. InvEval H. injection XX3; clear XX3; intro; subst v.
- inversion H0. rewrite Int.eq_false; auto.
+ destruct e0. InvEval.
+ inv H0. rewrite Int.eq_false; auto.
simpl; eauto with evalexpr.
rewrite Int.eq_true; simpl; eauto with evalexpr.
eapply eval_notbool_base; eauto.
- inversion H. subst.
- simpl in H11. eapply eval_Eop; eauto.
- simpl. caseEq (eval_condition c vl m2); intros.
- rewrite H1 in H11.
- assert (b0 = b).
- destruct b0; inversion H11; subst v; inversion H0; auto.
- subst b0. rewrite (Op.eval_negate_condition _ _ _ H1).
+ inv H. eapply eval_Eop; eauto.
+ simpl. assert (eval_condition c vl m = Some b).
+ generalize H6. simpl.
+ case (eval_condition c vl m); intros.
+ destruct b0; inv H1; inversion H0; auto; congruence.
+ congruence.
+ rewrite (Op.eval_negate_condition _ _ _ H).
destruct b; reflexivity.
- rewrite H1 in H11; discriminate.
- inversion H; eauto 10 with evalexpr valboolof.
- inversion H; eauto 10 with evalexpr valboolof.
-
- inversion H. subst. eapply eval_Econdition with (t2 := t8). eexact H34.
- destruct v4; eauto. auto.
+ inv H. eapply eval_Econdition; eauto.
+ destruct v1; eauto.
Qed.
-Lemma eval_addimm:
- forall sp le e m1 n a t m2 x,
- eval_expr ge sp le e m1 a t m2 (Vint x) ->
- eval_expr ge sp le e m1 (addimm n a) t m2 (Vint (Int.add x n)).
+Theorem eval_addimm:
+ forall le n a x,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le (addimm n a) (Vint (Int.add x n)).
Proof.
unfold addimm; intros until x.
generalize (Int.eq_spec n Int.zero). case (Int.eq n Int.zero); intro.
subst n. rewrite Int.add_zero. auto.
- case (addimm_match a); intros.
- InvEval H0. EvalOp. simpl. rewrite Int.add_commut. auto.
- InvEval H0. destruct (Genv.find_symbol ge s); discriminate.
- InvEval H0.
- destruct sp; simpl in XX3; discriminate.
- InvEval H0. FuncInv. EvalOp. simpl. subst x.
- rewrite Int.add_assoc. decEq; decEq; decEq. apply Int.add_commut.
- EvalOp.
+ case (addimm_match a); intros; InvEval; EvalOp; simpl.
+ rewrite Int.add_commut. auto.
+ destruct (Genv.find_symbol ge s); discriminate.
+ destruct sp; simpl in H1; discriminate.
+ subst x. rewrite Int.add_assoc. decEq; decEq; decEq. apply Int.add_commut.
Qed.
-Lemma eval_addimm_ptr:
- forall sp le e m1 n t a m2 b ofs,
- eval_expr ge sp le e m1 a t m2 (Vptr b ofs) ->
- eval_expr ge sp le e m1 (addimm n a) t m2 (Vptr b (Int.add ofs n)).
+Theorem eval_addimm_ptr:
+ forall le n a b ofs,
+ eval_expr ge sp e m le a (Vptr b ofs) ->
+ eval_expr ge sp e m le (addimm n a) (Vptr b (Int.add ofs n)).
Proof.
unfold addimm; intros until ofs.
generalize (Int.eq_spec n Int.zero). case (Int.eq n Int.zero); intro.
subst n. rewrite Int.add_zero. auto.
- case (addimm_match a); intros.
- InvEval H0.
- InvEval H0. EvalOp. simpl.
- destruct (Genv.find_symbol ge s).
- rewrite Int.add_commut. congruence.
- discriminate.
- InvEval H0. destruct sp; simpl in XX3; try discriminate.
- inversion XX3. EvalOp. simpl. decEq. decEq.
+ case (addimm_match a); intros; InvEval; EvalOp; simpl.
+ destruct (Genv.find_symbol ge s).
+ rewrite Int.add_commut. congruence.
+ discriminate.
+ destruct sp; simpl in H1; try discriminate.
+ inv H1. simpl. decEq. decEq.
rewrite Int.add_assoc. decEq. apply Int.add_commut.
- InvEval H0. FuncInv. subst b0; subst ofs. EvalOp. simpl.
- rewrite (Int.add_commut n m). rewrite Int.add_assoc. auto.
- EvalOp.
+ subst. rewrite (Int.add_commut n m0). rewrite Int.add_assoc. auto.
Qed.
-Lemma eval_add:
- forall sp le e m1 a t1 m2 x b t2 m3 y,
- eval_expr ge sp le e m1 a t1 m2 (Vint x) ->
- eval_expr ge sp le e m2 b t2 m3 (Vint y) ->
- eval_expr ge sp le e m1 (add a b) (t1**t2) m3 (Vint (Int.add x y)).
+Theorem eval_add:
+ forall le a b x y,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le b (Vint y) ->
+ eval_expr ge sp e m le (add a b) (Vint (Int.add x y)).
Proof.
- intros until y. unfold add; case (add_match a b); intros.
- InvEval H. rewrite Int.add_commut. apply eval_addimm.
- rewrite E0_left; assumption.
- InvEval H. FuncInv. InvEval H0. FuncInv.
- replace (Int.add x y) with (Int.add (Int.add i i0) (Int.add n1 n2)).
- apply eval_addimm. EvalOp.
+ intros until y.
+ unfold add; case (add_match a b); intros; InvEval.
+ rewrite Int.add_commut. apply eval_addimm. auto.
+ replace (Int.add x y) with (Int.add (Int.add i0 i) (Int.add n1 n2)).
+ apply eval_addimm. EvalOp.
subst x; subst y.
repeat rewrite Int.add_assoc. decEq. apply Int.add_permut.
- InvEval H. FuncInv.
- replace (Int.add x y) with (Int.add (Int.add i y) n1).
+ replace (Int.add x y) with (Int.add (Int.add i y) n1).
apply eval_addimm. EvalOp.
subst x. repeat rewrite Int.add_assoc. decEq. apply Int.add_commut.
- InvEval H0. FuncInv.
- apply eval_addimm. rewrite E0_right. auto.
- InvEval H0. FuncInv.
- replace (Int.add x y) with (Int.add (Int.add x i) n2).
+ apply eval_addimm. auto.
+ replace (Int.add x y) with (Int.add (Int.add x i) n2).
apply eval_addimm. EvalOp.
subst y. rewrite Int.add_assoc. auto.
EvalOp.
Qed.
-Lemma eval_add_ptr:
- forall sp le e m1 a t1 m2 p x b t2 m3 y,
- eval_expr ge sp le e m1 a t1 m2 (Vptr p x) ->
- eval_expr ge sp le e m2 b t2 m3 (Vint y) ->
- eval_expr ge sp le e m1 (add a b) (t1**t2) m3 (Vptr p (Int.add x y)).
+Theorem eval_add_ptr:
+ forall le a b p x y,
+ eval_expr ge sp e m le a (Vptr p x) ->
+ eval_expr ge sp e m le b (Vint y) ->
+ eval_expr ge sp e m le (add a b) (Vptr p (Int.add x y)).
Proof.
- intros until y. unfold add; case (add_match a b); intros.
- InvEval H.
- InvEval H. FuncInv. InvEval H0. FuncInv.
- replace (Int.add x y) with (Int.add (Int.add i i0) (Int.add n1 n2)).
+ intros until y. unfold add; case (add_match a b); intros; InvEval.
+ replace (Int.add x y) with (Int.add (Int.add i0 i) (Int.add n1 n2)).
apply eval_addimm_ptr. subst b0. EvalOp.
subst x; subst y.
repeat rewrite Int.add_assoc. decEq. apply Int.add_permut.
- InvEval H. FuncInv.
- replace (Int.add x y) with (Int.add (Int.add i y) n1).
+ replace (Int.add x y) with (Int.add (Int.add i y) n1).
apply eval_addimm_ptr. subst b0. EvalOp.
subst x. repeat rewrite Int.add_assoc. decEq. apply Int.add_commut.
- InvEval H0. apply eval_addimm_ptr. rewrite E0_right. auto.
- InvEval H0. FuncInv.
- replace (Int.add x y) with (Int.add (Int.add x i) n2).
+ apply eval_addimm_ptr. auto.
+ replace (Int.add x y) with (Int.add (Int.add x i) n2).
apply eval_addimm_ptr. EvalOp.
subst y. rewrite Int.add_assoc. auto.
EvalOp.
Qed.
-Lemma eval_add_ptr_2:
- forall sp le e m1 a t1 m2 p x b t2 m3 y,
- eval_expr ge sp le e m1 a t1 m2 (Vint x) ->
- eval_expr ge sp le e m2 b t2 m3 (Vptr p y) ->
- eval_expr ge sp le e m1 (add a b) (t1**t2) m3 (Vptr p (Int.add y x)).
+Theorem eval_add_ptr_2:
+ forall le a b x p y,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le b (Vptr p y) ->
+ eval_expr ge sp e m le (add a b) (Vptr p (Int.add y x)).
Proof.
- intros until y. unfold add; case (add_match a b); intros.
- InvEval H.
- apply eval_addimm_ptr. rewrite E0_left. auto.
- InvEval H. FuncInv. InvEval H0. FuncInv.
- replace (Int.add y x) with (Int.add (Int.add i0 i) (Int.add n1 n2)).
+ intros until y. unfold add; case (add_match a b); intros; InvEval.
+ apply eval_addimm_ptr. auto.
+ replace (Int.add y x) with (Int.add (Int.add i i0) (Int.add n1 n2)).
apply eval_addimm_ptr. subst b0. EvalOp.
subst x; subst y.
repeat rewrite Int.add_assoc. decEq.
rewrite (Int.add_commut n1 n2). apply Int.add_permut.
- InvEval H. FuncInv.
- replace (Int.add y x) with (Int.add (Int.add y i) n1).
+ replace (Int.add y x) with (Int.add (Int.add y i) n1).
apply eval_addimm_ptr. EvalOp.
subst x. repeat rewrite Int.add_assoc. auto.
- InvEval H0.
- InvEval H0. FuncInv.
- replace (Int.add y x) with (Int.add (Int.add i x) n2).
+ replace (Int.add y x) with (Int.add (Int.add i x) n2).
apply eval_addimm_ptr. EvalOp. subst b0; reflexivity.
subst y. repeat rewrite Int.add_assoc. decEq. apply Int.add_commut.
EvalOp.
Qed.
-Lemma eval_sub:
- forall sp le e m1 a t1 m2 x b t2 m3 y,
- eval_expr ge sp le e m1 a t1 m2 (Vint x) ->
- eval_expr ge sp le e m2 b t2 m3 (Vint y) ->
- eval_expr ge sp le e m1 (sub a b) (t1**t2) m3 (Vint (Int.sub x y)).
+Theorem eval_sub:
+ forall le a b x y,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le b (Vint y) ->
+ eval_expr ge sp e m le (sub a b) (Vint (Int.sub x y)).
Proof.
intros until y.
- unfold sub; case (sub_match a b); intros.
- InvEval H0. rewrite Int.sub_add_opp.
- apply eval_addimm. rewrite E0_right. assumption.
- InvEval H. FuncInv. InvEval H0. FuncInv.
- replace (Int.sub x y) with (Int.add (Int.sub i i0) (Int.sub n1 n2)).
+ unfold sub; case (sub_match a b); intros; InvEval.
+ rewrite Int.sub_add_opp.
+ apply eval_addimm. assumption.
+ replace (Int.sub x y) with (Int.add (Int.sub i0 i) (Int.sub n1 n2)).
apply eval_addimm. EvalOp.
subst x; subst y.
repeat rewrite Int.sub_add_opp.
repeat rewrite Int.add_assoc. decEq.
rewrite Int.add_permut. decEq. symmetry. apply Int.neg_add_distr.
- InvEval H. FuncInv.
- replace (Int.sub x y) with (Int.add (Int.sub i y) n1).
+ replace (Int.sub x y) with (Int.add (Int.sub i y) n1).
apply eval_addimm. EvalOp.
subst x. rewrite Int.sub_add_l. auto.
- InvEval H0. FuncInv.
- replace (Int.sub x y) with (Int.add (Int.sub x i) (Int.neg n2)).
+ replace (Int.sub x y) with (Int.add (Int.sub x i) (Int.neg n2)).
apply eval_addimm. EvalOp.
subst y. rewrite (Int.add_commut i n2). symmetry. apply Int.sub_add_r.
EvalOp.
Qed.
-Lemma eval_sub_ptr_int:
- forall sp le e m1 a t1 m2 p x b t2 m3 y,
- eval_expr ge sp le e m1 a t1 m2 (Vptr p x) ->
- eval_expr ge sp le e m2 b t2 m3 (Vint y) ->
- eval_expr ge sp le e m1 (sub a b) (t1**t2) m3 (Vptr p (Int.sub x y)).
+Theorem eval_sub_ptr_int:
+ forall le a b p x y,
+ eval_expr ge sp e m le a (Vptr p x) ->
+ eval_expr ge sp e m le b (Vint y) ->
+ eval_expr ge sp e m le (sub a b) (Vptr p (Int.sub x y)).
Proof.
intros until y.
- unfold sub; case (sub_match a b); intros.
- InvEval H0. rewrite Int.sub_add_opp.
- apply eval_addimm_ptr. rewrite E0_right. assumption.
- InvEval H. FuncInv. InvEval H0. FuncInv.
- subst b0.
- replace (Int.sub x y) with (Int.add (Int.sub i i0) (Int.sub n1 n2)).
+ unfold sub; case (sub_match a b); intros; InvEval.
+ rewrite Int.sub_add_opp.
+ apply eval_addimm_ptr. assumption.
+ subst b0. replace (Int.sub x y) with (Int.add (Int.sub i0 i) (Int.sub n1 n2)).
apply eval_addimm_ptr. EvalOp.
subst x; subst y.
repeat rewrite Int.sub_add_opp.
repeat rewrite Int.add_assoc. decEq.
rewrite Int.add_permut. decEq. symmetry. apply Int.neg_add_distr.
- InvEval H. FuncInv. subst b0.
- replace (Int.sub x y) with (Int.add (Int.sub i y) n1).
+ subst b0. replace (Int.sub x y) with (Int.add (Int.sub i y) n1).
apply eval_addimm_ptr. EvalOp.
subst x. rewrite Int.sub_add_l. auto.
- InvEval H0. FuncInv.
- replace (Int.sub x y) with (Int.add (Int.sub x i) (Int.neg n2)).
+ replace (Int.sub x y) with (Int.add (Int.sub x i) (Int.neg n2)).
apply eval_addimm_ptr. EvalOp.
subst y. rewrite (Int.add_commut i n2). symmetry. apply Int.sub_add_r.
EvalOp.
Qed.
-Lemma eval_sub_ptr_ptr:
- forall sp le e m1 a t1 m2 p x b t2 m3 y,
- eval_expr ge sp le e m1 a t1 m2 (Vptr p x) ->
- eval_expr ge sp le e m2 b t2 m3 (Vptr p y) ->
- eval_expr ge sp le e m1 (sub a b) (t1**t2) m3 (Vint (Int.sub x y)).
+Theorem eval_sub_ptr_ptr:
+ forall le a b p x y,
+ eval_expr ge sp e m le a (Vptr p x) ->
+ eval_expr ge sp e m le b (Vptr p y) ->
+ eval_expr ge sp e m le (sub a b) (Vint (Int.sub x y)).
Proof.
intros until y.
- unfold sub; case (sub_match a b); intros.
- InvEval H0.
- InvEval H. FuncInv. InvEval H0. FuncInv.
- replace (Int.sub x y) with (Int.add (Int.sub i i0) (Int.sub n1 n2)).
+ unfold sub; case (sub_match a b); intros; InvEval.
+ replace (Int.sub x y) with (Int.add (Int.sub i0 i) (Int.sub n1 n2)).
apply eval_addimm. EvalOp.
simpl; unfold eq_block. subst b0; subst b1; rewrite zeq_true. auto.
subst x; subst y.
repeat rewrite Int.sub_add_opp.
repeat rewrite Int.add_assoc. decEq.
rewrite Int.add_permut. decEq. symmetry. apply Int.neg_add_distr.
- InvEval H. FuncInv. subst b0.
- replace (Int.sub x y) with (Int.add (Int.sub i y) n1).
+ subst b0. replace (Int.sub x y) with (Int.add (Int.sub i y) n1).
apply eval_addimm. EvalOp.
simpl. unfold eq_block. rewrite zeq_true. auto.
subst x. rewrite Int.sub_add_l. auto.
- InvEval H0. FuncInv. subst b0.
- replace (Int.sub x y) with (Int.add (Int.sub x i) (Int.neg n2)).
+ subst b0. replace (Int.sub x y) with (Int.add (Int.sub x i) (Int.neg n2)).
apply eval_addimm. EvalOp.
simpl. unfold eq_block. rewrite zeq_true. auto.
subst y. rewrite (Int.add_commut i n2). symmetry. apply Int.sub_add_r.
@@ -523,29 +409,29 @@ Proof.
Qed.
Lemma eval_rolm:
- forall sp le e m1 a amount mask t m2 x,
- eval_expr ge sp le e m1 a t m2 (Vint x) ->
- eval_expr ge sp le e m1 (rolm a amount mask) t m2 (Vint (Int.rolm x amount mask)).
+ forall le a amount mask x,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le (rolm a amount mask) (Vint (Int.rolm x amount mask)).
Proof.
- intros until x. unfold rolm; case (rolm_match a); intros.
- InvEval H. eauto with evalexpr.
+ intros until x. unfold rolm; case (rolm_match a); intros; InvEval.
+ eauto with evalexpr.
case (Int.is_rlw_mask (Int.and (Int.rol mask1 amount) mask)).
- InvEval H. FuncInv. EvalOp. simpl. subst x.
+ EvalOp. simpl. subst x.
decEq. decEq.
replace (Int.and (Int.add amount1 amount) (Int.repr 31))
with (Int.modu (Int.add amount1 amount) (Int.repr 32)).
symmetry. apply Int.rolm_rolm.
change (Int.repr 31) with (Int.sub (Int.repr 32) Int.one).
apply Int.modu_and with (Int.repr 5). reflexivity.
- EvalOp.
+ EvalOp. econstructor. EvalOp. simpl. rewrite H. reflexivity. constructor. auto.
EvalOp.
Qed.
-Lemma eval_shlimm:
- forall sp le e m1 a n t m2 x,
- eval_expr ge sp le e m1 a t m2 (Vint x) ->
+Theorem eval_shlimm:
+ forall le a n x,
+ eval_expr ge sp e m le a (Vint x) ->
Int.ltu n (Int.repr 32) = true ->
- eval_expr ge sp le e m1 (shlimm a n) t m2 (Vint (Int.shl x n)).
+ eval_expr ge sp e m le (shlimm a n) (Vint (Int.shl x n)).
Proof.
intros. unfold shlimm.
generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intro.
@@ -555,11 +441,11 @@ Proof.
apply eval_rolm. auto. symmetry. apply Int.shl_rolm. exact H0.
Qed.
-Lemma eval_shruimm:
- forall sp le e m1 a n t m2 x,
- eval_expr ge sp le e m1 a t m2 (Vint x) ->
+Theorem eval_shruimm:
+ forall le a n x,
+ eval_expr ge sp e m le a (Vint x) ->
Int.ltu n (Int.repr 32) = true ->
- eval_expr ge sp le e m1 (shruimm a n) t m2 (Vint (Int.shru x n)).
+ eval_expr ge sp e m le (shruimm a n) (Vint (Int.shru x n)).
Proof.
intros. unfold shruimm.
generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intro.
@@ -570,9 +456,9 @@ Proof.
Qed.
Lemma eval_mulimm_base:
- forall sp le e m1 a t n m2 x,
- eval_expr ge sp le e m1 a t m2 (Vint x) ->
- eval_expr ge sp le e m1 (mulimm_base n a) t m2 (Vint (Int.mul x n)).
+ forall le a n x,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le (mulimm_base n a) (Vint (Int.mul x n)).
Proof.
intros; unfold mulimm_base.
generalize (Int.one_bits_decomp n).
@@ -585,7 +471,7 @@ Proof.
rewrite Int.add_zero. rewrite <- Int.shl_mul.
apply eval_shlimm. auto. auto with coqlib.
destruct l.
- intros. apply eval_Elet with t m2 (Vint x) E0. auto.
+ intros. apply eval_Elet with (Vint x). auto.
rewrite H1. simpl. rewrite Int.add_zero.
rewrite Int.mul_add_distr_r.
rewrite <- Int.shl_mul.
@@ -597,50 +483,48 @@ Proof.
apply eval_shlimm. apply eval_Eletvar. simpl. reflexivity.
auto with coqlib.
auto with evalexpr.
- reflexivity. traceEq. reflexivity. traceEq.
+ reflexivity.
intros. EvalOp.
Qed.
-Lemma eval_mulimm:
- forall sp le e m1 a n t m2 x,
- eval_expr ge sp le e m1 a t m2 (Vint x) ->
- eval_expr ge sp le e m1 (mulimm n a) t m2 (Vint (Int.mul x n)).
+Theorem eval_mulimm:
+ forall le a n x,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le (mulimm n a) (Vint (Int.mul x n)).
Proof.
intros until x; unfold mulimm.
generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intro.
subst n. rewrite Int.mul_zero.
- intro. eapply eval_Elet; eauto with evalexpr. traceEq.
+ intro. eapply eval_Elet; eauto with evalexpr.
generalize (Int.eq_spec n Int.one); case (Int.eq n Int.one); intro.
subst n. rewrite Int.mul_one. auto.
- case (mulimm_match a); intros.
- InvEval H1. EvalOp. rewrite Int.mul_commut. reflexivity.
- InvEval H1. FuncInv.
+ case (mulimm_match a); intros; InvEval.
+ EvalOp. rewrite Int.mul_commut. reflexivity.
replace (Int.mul x n) with (Int.add (Int.mul i n) (Int.mul n n2)).
apply eval_addimm. apply eval_mulimm_base. auto.
subst x. rewrite Int.mul_add_distr_l. decEq. apply Int.mul_commut.
apply eval_mulimm_base. assumption.
Qed.
-Lemma eval_mul:
- forall sp le e m1 a t1 m2 x b t2 m3 y,
- eval_expr ge sp le e m1 a t1 m2 (Vint x) ->
- eval_expr ge sp le e m2 b t2 m3 (Vint y) ->
- eval_expr ge sp le e m1 (mul a b) (t1**t2) m3 (Vint (Int.mul x y)).
+Theorem eval_mul:
+ forall le a b x y,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le b (Vint y) ->
+ eval_expr ge sp e m le (mul a b) (Vint (Int.mul x y)).
Proof.
intros until y.
- unfold mul; case (mul_match a b); intros.
- InvEval H. rewrite Int.mul_commut. apply eval_mulimm.
- rewrite E0_left; auto.
- InvEval H0. rewrite E0_right. apply eval_mulimm. auto.
+ unfold mul; case (mul_match a b); intros; InvEval.
+ rewrite Int.mul_commut. apply eval_mulimm. auto.
+ apply eval_mulimm. auto.
EvalOp.
Qed.
-Lemma eval_divs:
- forall sp le e m1 a t1 m2 x b t2 m3 y,
- eval_expr ge sp le e m1 a t1 m2 (Vint x) ->
- eval_expr ge sp le e m2 b t2 m3 (Vint y) ->
+Theorem eval_divs:
+ forall le a b x y,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le b (Vint y) ->
y <> Int.zero ->
- eval_expr ge sp le e m1 (divs a b) (t1**t2) m3 (Vint (Int.divs x y)).
+ eval_expr ge sp e m le (divs a b) (Vint (Int.divs x y)).
Proof.
TrivialOp divs. simpl.
predSpec Int.eq Int.eq_spec y Int.zero. contradiction. auto.
@@ -652,11 +536,11 @@ Lemma eval_mod_aux:
y <> Int.zero ->
eval_operation ge sp divop (Vint x :: Vint y :: nil) m =
Some (Vint (semdivop x y))) ->
- forall sp le e m1 a t1 m2 x b t2 m3 y,
- eval_expr ge sp le e m1 a t1 m2 (Vint x) ->
- eval_expr ge sp le e m2 b t2 m3 (Vint y) ->
+ forall le a b x y,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le b (Vint y) ->
y <> Int.zero ->
- eval_expr ge sp le e m1 (mod_aux divop a b) (t1**t2) m3
+ eval_expr ge sp e m le (mod_aux divop a b)
(Vint (Int.sub x (Int.mul (semdivop x y) y))).
Proof.
intros; unfold mod_aux.
@@ -668,21 +552,20 @@ Proof.
eapply eval_Econs. eapply eval_Eop.
eapply eval_Econs. apply eval_Eletvar. simpl; reflexivity.
eapply eval_Econs. apply eval_Eletvar. simpl; reflexivity.
- apply eval_Enil. reflexivity. reflexivity.
+ apply eval_Enil.
apply H. assumption.
eapply eval_Econs. apply eval_Eletvar. simpl; reflexivity.
- apply eval_Enil. reflexivity. reflexivity.
+ apply eval_Enil.
simpl; reflexivity. apply eval_Enil.
- reflexivity. reflexivity. reflexivity.
- reflexivity. traceEq.
+ reflexivity.
Qed.
-Lemma eval_mods:
- forall sp le e m1 a t1 m2 x b t2 m3 y,
- eval_expr ge sp le e m1 a t1 m2 (Vint x) ->
- eval_expr ge sp le e m2 b t2 m3 (Vint y) ->
+Theorem eval_mods:
+ forall le a b x y,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le b (Vint y) ->
y <> Int.zero ->
- eval_expr ge sp le e m1 (mods a b) (t1**t2) m3 (Vint (Int.mods x y)).
+ eval_expr ge sp e m le (mods a b) (Vint (Int.mods x y)).
Proof.
intros; unfold mods.
rewrite Int.mods_divs.
@@ -692,232 +575,217 @@ Proof.
Qed.
Lemma eval_divu_base:
- forall sp le e m1 a t1 m2 x b t2 m3 y,
- eval_expr ge sp le e m1 a t1 m2 (Vint x) ->
- eval_expr ge sp le e m2 b t2 m3 (Vint y) ->
+ forall le a x b y,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le b (Vint y) ->
y <> Int.zero ->
- eval_expr ge sp le e m1 (Eop Odivu (a ::: b ::: Enil)) (t1**t2) m3 (Vint (Int.divu x y)).
+ eval_expr ge sp e m le (Eop Odivu (a ::: b ::: Enil)) (Vint (Int.divu x y)).
Proof.
intros. EvalOp. simpl.
predSpec Int.eq Int.eq_spec y Int.zero. contradiction. auto.
Qed.
-Lemma eval_divu:
- forall sp le e m1 a t1 m2 x b t2 m3 y,
- eval_expr ge sp le e m1 a t1 m2 (Vint x) ->
- eval_expr ge sp le e m2 b t2 m3 (Vint y) ->
+Theorem eval_divu:
+ forall le a x b y,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le b (Vint y) ->
y <> Int.zero ->
- eval_expr ge sp le e m1 (divu a b) (t1**t2) m3 (Vint (Int.divu x y)).
+ eval_expr ge sp e m le (divu a b) (Vint (Int.divu x y)).
Proof.
intros until y.
- unfold divu; case (divu_match b); intros.
- InvEval H0. caseEq (Int.is_power2 y).
+ unfold divu; case (divu_match b); intros; InvEval.
+ caseEq (Int.is_power2 y).
intros. rewrite (Int.divu_pow2 x y i H0).
- apply eval_shruimm. rewrite E0_right. auto.
+ apply eval_shruimm. auto.
apply Int.is_power2_range with y. auto.
- intros. subst n2. eapply eval_divu_base. eexact H. EvalOp. auto.
+ intros. apply eval_divu_base. auto. EvalOp. auto.
eapply eval_divu_base; eauto.
Qed.
-Lemma eval_modu:
- forall sp le e m1 a t1 m2 x b t2 m3 y,
- eval_expr ge sp le e m1 a t1 m2 (Vint x) ->
- eval_expr ge sp le e m2 b t2 m3 (Vint y) ->
+Theorem eval_modu:
+ forall le a x b y,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le b (Vint y) ->
y <> Int.zero ->
- eval_expr ge sp le e m1 (modu a b) (t1**t2) m3 (Vint (Int.modu x y)).
+ eval_expr ge sp e m le (modu a b) (Vint (Int.modu x y)).
Proof.
- intros until y; unfold modu; case (divu_match b); intros.
- InvEval H0. caseEq (Int.is_power2 y).
+ intros until y; unfold modu; case (divu_match b); intros; InvEval.
+ caseEq (Int.is_power2 y).
intros. rewrite (Int.modu_and x y i H0).
- rewrite <- Int.rolm_zero. apply eval_rolm. rewrite E0_right; auto.
+ rewrite <- Int.rolm_zero. apply eval_rolm. auto.
intro. rewrite Int.modu_divu. eapply eval_mod_aux.
intros. simpl. predSpec Int.eq Int.eq_spec y0 Int.zero.
contradiction. auto.
- eexact H. EvalOp. auto. auto.
+ auto. EvalOp. auto. auto.
rewrite Int.modu_divu. eapply eval_mod_aux.
intros. simpl. predSpec Int.eq Int.eq_spec y0 Int.zero.
- contradiction. auto.
- eexact H. eexact H0. auto. auto.
+ contradiction. auto. auto. auto. auto. auto.
Qed.
-Lemma eval_andimm:
- forall sp le e m1 n a t m2 x,
- eval_expr ge sp le e m1 a t m2 (Vint x) ->
- eval_expr ge sp le e m1 (andimm n a) t m2 (Vint (Int.and x n)).
+Theorem eval_andimm:
+ forall le n a x,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le (andimm n a) (Vint (Int.and x n)).
Proof.
intros. unfold andimm. case (Int.is_rlw_mask n).
rewrite <- Int.rolm_zero. apply eval_rolm; auto.
EvalOp.
Qed.
-Lemma eval_and:
- forall sp le e m1 a t1 m2 x b t2 m3 y,
- eval_expr ge sp le e m1 a t1 m2 (Vint x) ->
- eval_expr ge sp le e m2 b t2 m3 (Vint y) ->
- eval_expr ge sp le e m1 (and a b) (t1**t2) m3 (Vint (Int.and x y)).
+Theorem eval_and:
+ forall le a x b y,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le b (Vint y) ->
+ eval_expr ge sp e m le (and a b) (Vint (Int.and x y)).
Proof.
- intros until y; unfold and; case (mul_match a b); intros.
- InvEval H. rewrite Int.and_commut.
- rewrite E0_left; apply eval_andimm; auto.
- InvEval H0. rewrite E0_right; apply eval_andimm; auto.
+ intros until y; unfold and; case (mul_match a b); intros; InvEval.
+ rewrite Int.and_commut. apply eval_andimm; auto.
+ apply eval_andimm; auto.
EvalOp.
Qed.
-Remark eval_same_expr_pure:
- forall a1 a2 sp le e m1 t1 m2 v1 t2 m3 v2,
+Remark eval_same_expr:
+ forall a1 a2 le v1 v2,
same_expr_pure a1 a2 = true ->
- eval_expr ge sp le e m1 a1 t1 m2 v1 ->
- eval_expr ge sp le e m2 a2 t2 m3 v2 ->
- t1 = E0 /\ t2 = E0 /\ a2 = a1 /\ v2 = v1 /\ m2 = m1.
+ eval_expr ge sp e m le a1 v1 ->
+ eval_expr ge sp e m le a2 v2 ->
+ a1 = a2 /\ v1 = v2.
Proof.
intros until v2.
destruct a1; simpl; try (intros; discriminate).
destruct a2; simpl; try (intros; discriminate).
case (ident_eq i i0); intros.
- subst i0. inversion H0. inversion H1.
- assert (v2 = v1). congruence. tauto.
+ subst i0. inversion H0. inversion H1. split. auto. congruence.
discriminate.
Qed.
Lemma eval_or:
- forall sp le e m1 a t1 m2 x b t2 m3 y,
- eval_expr ge sp le e m1 a t1 m2 (Vint x) ->
- eval_expr ge sp le e m2 b t2 m3 (Vint y) ->
- eval_expr ge sp le e m1 (or a b) (t1**t2) m3 (Vint (Int.or x y)).
+ forall le a x b y,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le b (Vint y) ->
+ eval_expr ge sp e m le (or a b) (Vint (Int.or x y)).
Proof.
- intros until y; unfold or; case (or_match a b); intros.
- generalize (Int.eq_spec amount1 amount2); case (Int.eq amount1 amount2); intro.
- case (Int.is_rlw_mask (Int.or mask1 mask2)).
- caseEq (same_expr_pure t0 t3); intro.
- simpl. InvEval H. FuncInv. InvEval H0. FuncInv.
- generalize (eval_same_expr_pure _ _ _ _ _ _ _ _ _ _ _ _ H2 EV EV0).
- intros [EQ1 [EQ2 [EQ3 [EQ4 EQ5]]]].
- injection EQ4; intro EQ7. subst.
- EvalOp. simpl. rewrite Int.or_rolm. auto.
- simpl. EvalOp.
- simpl. EvalOp.
- simpl. EvalOp.
+ intros until y; unfold or; case (or_match a b); intros; InvEval.
+ caseEq (Int.eq amount1 amount2
+ && Int.is_rlw_mask (Int.or mask1 mask2)
+ && same_expr_pure t1 t2); intro.
+ destruct (andb_prop _ _ H1). destruct (andb_prop _ _ H4).
+ generalize (Int.eq_spec amount1 amount2). rewrite H6. intro. subst amount2.
+ exploit eval_same_expr; eauto. intros [EQ1 EQ2]. inv EQ1. inv EQ2.
+ simpl. EvalOp. simpl. rewrite Int.or_rolm. auto.
+ simpl. apply eval_Eop with (Vint x :: Vint y :: nil).
+ econstructor. EvalOp. simpl. congruence.
+ econstructor. EvalOp. simpl. congruence. constructor. auto.
EvalOp.
Qed.
-Lemma eval_shl:
- forall sp le e m1 a t1 m2 x b t2 m3 y,
- eval_expr ge sp le e m1 a t1 m2 (Vint x) ->
- eval_expr ge sp le e m2 b t2 m3 (Vint y) ->
+Theorem eval_shl:
+ forall le a x b y,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le b (Vint y) ->
Int.ltu y (Int.repr 32) = true ->
- eval_expr ge sp le e m1 (shl a b) (t1**t2) m3 (Vint (Int.shl x y)).
+ eval_expr ge sp e m le (shl a b) (Vint (Int.shl x y)).
Proof.
intros until y; unfold shl; case (shift_match b); intros.
- InvEval H0. rewrite E0_right. apply eval_shlimm; auto.
+ InvEval. apply eval_shlimm; auto.
EvalOp. simpl. rewrite H1. auto.
Qed.
-Lemma eval_shru:
- forall sp le e m1 a t1 m2 x b t2 m3 y,
- eval_expr ge sp le e m1 a t1 m2 (Vint x) ->
- eval_expr ge sp le e m2 b t2 m3 (Vint y) ->
+Theorem eval_shru:
+ forall le a x b y,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le b (Vint y) ->
Int.ltu y (Int.repr 32) = true ->
- eval_expr ge sp le e m1 (shru a b) (t1**t2) m3 (Vint (Int.shru x y)).
+ eval_expr ge sp e m le (shru a b) (Vint (Int.shru x y)).
Proof.
intros until y; unfold shru; case (shift_match b); intros.
- InvEval H0. rewrite E0_right; apply eval_shruimm; auto.
+ InvEval. apply eval_shruimm; auto.
EvalOp. simpl. rewrite H1. auto.
Qed.
-Lemma eval_addf:
- forall sp le e m1 a t1 m2 x b t2 m3 y,
- eval_expr ge sp le e m1 a t1 m2 (Vfloat x) ->
- eval_expr ge sp le e m2 b t2 m3 (Vfloat y) ->
- eval_expr ge sp le e m1 (addf a b) (t1**t2) m3 (Vfloat (Float.add x y)).
+Theorem eval_addf:
+ forall le a x b y,
+ eval_expr ge sp e m le a (Vfloat x) ->
+ eval_expr ge sp e m le b (Vfloat y) ->
+ eval_expr ge sp e m le (addf a b) (Vfloat (Float.add x y)).
Proof.
- intros until y; unfold addf; case (addf_match a b); intros.
- InvEval H. FuncInv. EvalOp.
- econstructor; eauto. econstructor; eauto. econstructor; eauto. constructor.
- traceEq. simpl. subst x. reflexivity.
- InvEval H0. FuncInv. eapply eval_Elet. eexact H. EvalOp.
- econstructor; eauto with evalexpr.
- econstructor; eauto with evalexpr.
- econstructor. apply eval_Eletvar. simpl; reflexivity.
- constructor. reflexivity. traceEq.
- subst y. rewrite Float.addf_commut. reflexivity. auto.
+ intros until y; unfold addf; case (addf_match a b); intros; InvEval.
+ EvalOp. simpl. congruence.
+ econstructor. eauto. EvalOp. econstructor. eauto with evalexpr.
+ econstructor. eauto with evalexpr. econstructor.
+ econstructor. simpl. reflexivity. constructor.
+ simpl. subst y. rewrite Float.addf_commut. auto.
EvalOp.
Qed.
-Lemma eval_subf:
- forall sp le e m1 a t1 m2 x b t2 m3 y,
- eval_expr ge sp le e m1 a t1 m2 (Vfloat x) ->
- eval_expr ge sp le e m2 b t2 m3 (Vfloat y) ->
- eval_expr ge sp le e m1 (subf a b) (t1**t2) m3 (Vfloat (Float.sub x y)).
+Theorem eval_subf:
+ forall le a x b y,
+ eval_expr ge sp e m le a (Vfloat x) ->
+ eval_expr ge sp e m le b (Vfloat y) ->
+ eval_expr ge sp e m le (subf a b) (Vfloat (Float.sub x y)).
Proof.
intros until y; unfold subf; case (subf_match a b); intros.
- InvEval H. FuncInv. EvalOp.
- econstructor; eauto. econstructor; eauto. econstructor; eauto. constructor.
- traceEq. subst x. reflexivity.
+ InvEval. EvalOp. simpl. congruence.
EvalOp.
Qed.
-Lemma eval_cast8signed:
- forall sp le e m1 a t m2 v,
- eval_expr ge sp le e m1 a t m2 v ->
- eval_expr ge sp le e m1 (cast8signed a) t m2 (Val.cast8signed v).
+Theorem eval_cast8signed:
+ forall le a v,
+ eval_expr ge sp e m le a v ->
+ eval_expr ge sp e m le (cast8signed a) (Val.cast8signed v).
Proof.
- intros until v; unfold cast8signed; case (cast8signed_match a); intros.
- replace (Val.cast8signed v) with v. auto.
- InvEval H. inversion EQ. destruct v0; simpl; auto. rewrite Int.cast8_signed_idem. reflexivity.
+ intros until v; unfold cast8signed; case (cast8signed_match a); intros; InvEval.
+ EvalOp. simpl. subst v. destruct v1; simpl; auto. rewrite Int.cast8_signed_idem. reflexivity.
EvalOp.
Qed.
-Lemma eval_cast8unsigned:
- forall sp le e m1 a t m2 v,
- eval_expr ge sp le e m1 a t m2 v ->
- eval_expr ge sp le e m1 (cast8unsigned a) t m2 (Val.cast8unsigned v).
+Theorem eval_cast8unsigned:
+ forall le a v,
+ eval_expr ge sp e m le a v ->
+ eval_expr ge sp e m le (cast8unsigned a) (Val.cast8unsigned v).
Proof.
- intros until v; unfold cast8unsigned; case (cast8unsigned_match a); intros.
- replace (Val.cast8unsigned v) with v. auto.
- InvEval H. inversion EQ. destruct v0; simpl; auto. rewrite Int.cast8_unsigned_idem. reflexivity.
+ intros until v; unfold cast8unsigned; case (cast8unsigned_match a); intros; InvEval.
+ EvalOp. simpl. subst v. destruct v1; simpl; auto. rewrite Int.cast8_unsigned_idem. reflexivity.
EvalOp.
Qed.
-Lemma eval_cast16signed:
- forall sp le e m1 a t m2 v,
- eval_expr ge sp le e m1 a t m2 v ->
- eval_expr ge sp le e m1 (cast16signed a) t m2 (Val.cast16signed v).
+Theorem eval_cast16signed:
+ forall le a v,
+ eval_expr ge sp e m le a v ->
+ eval_expr ge sp e m le (cast16signed a) (Val.cast16signed v).
Proof.
- intros until v; unfold cast16signed; case (cast16signed_match a); intros.
- replace (Val.cast16signed v) with v. auto.
- InvEval H. inversion EQ. destruct v0; simpl; auto. rewrite Int.cast16_signed_idem. reflexivity.
+ intros until v; unfold cast16signed; case (cast16signed_match a); intros; InvEval.
+ EvalOp. simpl. subst v. destruct v1; simpl; auto. rewrite Int.cast16_signed_idem. reflexivity.
EvalOp.
Qed.
-Lemma eval_cast16unsigned:
- forall sp le e m1 a t m2 v,
- eval_expr ge sp le e m1 a t m2 v ->
- eval_expr ge sp le e m1 (cast16unsigned a) t m2 (Val.cast16unsigned v).
+Theorem eval_cast16unsigned:
+ forall le a v,
+ eval_expr ge sp e m le a v ->
+ eval_expr ge sp e m le (cast16unsigned a) (Val.cast16unsigned v).
Proof.
- intros until v; unfold cast16unsigned; case (cast16unsigned_match a); intros.
- replace (Val.cast16unsigned v) with v. auto.
- InvEval H. inversion EQ. destruct v0; simpl; auto. rewrite Int.cast16_unsigned_idem. reflexivity.
+ intros until v; unfold cast16unsigned; case (cast16unsigned_match a); intros; InvEval.
+ EvalOp. simpl. subst v. destruct v1; simpl; auto. rewrite Int.cast16_unsigned_idem. reflexivity.
EvalOp.
Qed.
-Lemma eval_singleoffloat:
- forall sp le e m1 a t m2 v,
- eval_expr ge sp le e m1 a t m2 v ->
- eval_expr ge sp le e m1 (singleoffloat a) t m2 (Val.singleoffloat v).
+Theorem eval_singleoffloat:
+ forall le a v,
+ eval_expr ge sp e m le a v ->
+ eval_expr ge sp e m le (singleoffloat a) (Val.singleoffloat v).
Proof.
- intros until v; unfold singleoffloat; case (singleoffloat_match a); intros.
- replace (Val.singleoffloat v) with v. auto.
- InvEval H. inversion EQ. destruct v0; simpl; auto. rewrite Float.singleoffloat_idem. reflexivity.
+ intros until v; unfold singleoffloat; case (singleoffloat_match a); intros; InvEval.
+ EvalOp. simpl. subst v. destruct v1; simpl; auto. rewrite Float.singleoffloat_idem. reflexivity.
EvalOp.
Qed.
Lemma eval_base_condition_of_expr:
- forall sp le a e m1 t m2 v (b: bool),
- eval_expr ge sp le e m1 a t m2 v ->
+ forall le a v b,
+ eval_expr ge sp e m le a v ->
Val.bool_of_val v b ->
- eval_condexpr ge sp le e m1
+ eval_condexpr ge sp e m le
(CEcond (Ccompimm Cne Int.zero) (a ::: Enil))
- t m2 b.
+ b.
Proof.
intros.
eapply eval_CEcond. eauto with evalexpr.
@@ -925,90 +793,81 @@ Proof.
Qed.
Lemma eval_condition_of_expr:
- forall a sp le e m1 t m2 v (b: bool),
- eval_expr ge sp le e m1 a t m2 v ->
+ forall a le v b,
+ eval_expr ge sp e m le a v ->
Val.bool_of_val v b ->
- eval_condexpr ge sp le e m1 (condexpr_of_expr a) t m2 b.
+ eval_condexpr ge sp e m le (condexpr_of_expr a) b.
Proof.
induction a; simpl; intros;
try (eapply eval_base_condition_of_expr; eauto; fail).
+
destruct o; try (eapply eval_base_condition_of_expr; eauto; fail).
- destruct e. InvEval H. inversion XX3; subst v.
+ destruct e0. InvEval.
inversion H0.
rewrite Int.eq_false; auto. constructor.
subst i; rewrite Int.eq_true. constructor.
eapply eval_base_condition_of_expr; eauto.
- inversion H. subst. eapply eval_CEcond; eauto. simpl in H11.
- destruct (eval_condition c vl); try discriminate.
- destruct b0; inversion H11; subst; inversion H0; congruence.
+ inv H. eapply eval_CEcond; eauto. simpl in H6.
+ destruct (eval_condition c vl m); try discriminate.
+ destruct b0; inv H6; inversion H0; congruence.
- inversion H. subst.
- destruct v1; eauto with evalexpr.
+ inv H. destruct v1; eauto with evalexpr.
Qed.
Lemma eval_addressing:
- forall sp le e m1 a t m2 v b ofs,
- eval_expr ge sp le e m1 a t m2 v ->
+ forall le a v b ofs,
+ eval_expr ge sp e m le a v ->
v = Vptr b ofs ->
match addressing a with (mode, args) =>
exists vl,
- eval_exprlist ge sp le e m1 args t m2 vl /\
+ eval_exprlist ge sp e m le args vl /\
eval_addressing ge sp mode vl = Some v
end.
Proof.
- intros until v. unfold addressing; case (addressing_match a); intros.
- InvEval H. exists (@nil val). split. eauto with evalexpr.
- simpl. auto.
- InvEval H. exists (@nil val). split. eauto with evalexpr.
- simpl. auto.
- InvEval H. InvEval EV. rewrite E0_left in TR. subst t1. FuncInv.
- congruence.
- destruct (Genv.find_symbol ge s); congruence.
- exists (Vint i0 :: nil). split. eauto with evalexpr.
- simpl. subst v. destruct (Genv.find_symbol ge s). congruence.
- discriminate.
- InvEval H. FuncInv.
- congruence.
- exists (Vptr b0 i :: nil). split. eauto with evalexpr.
+ intros until v. unfold addressing; case (addressing_match a); intros; InvEval.
+ exists (@nil val). split. eauto with evalexpr. simpl. auto.
+ exists (@nil val). split. eauto with evalexpr. simpl. auto.
+ destruct (Genv.find_symbol ge s); congruence.
+ exists (Vint i0 :: nil). split. eauto with evalexpr.
+ simpl. destruct (Genv.find_symbol ge s). congruence. discriminate.
+ exists (Vptr b0 i :: nil). split. eauto with evalexpr.
simpl. congruence.
- InvEval H. FuncInv.
- congruence.
- exists (Vint i :: Vptr b0 i0 :: nil).
+ exists (Vint i :: Vptr b0 i0 :: nil).
split. eauto with evalexpr. simpl.
rewrite Int.add_commut. congruence.
- exists (Vptr b0 i :: Vint i0 :: nil).
+ exists (Vptr b0 i :: Vint i0 :: nil).
split. eauto with evalexpr. simpl. congruence.
exists (v :: nil). split. eauto with evalexpr.
subst v. simpl. rewrite Int.add_zero. auto.
Qed.
Lemma eval_load:
- forall sp le e m1 a t m2 v chunk v',
- eval_expr ge sp le e m1 a t m2 v ->
- Mem.loadv chunk m2 v = Some v' ->
- eval_expr ge sp le e m1 (load chunk a) t m2 v'.
+ forall le a v chunk v',
+ eval_expr ge sp e m le a v ->
+ Mem.loadv chunk m v = Some v' ->
+ eval_expr ge sp e m le (load chunk a) v'.
Proof.
intros. generalize H0; destruct v; simpl; intro; try discriminate.
unfold load.
- generalize (eval_addressing _ _ _ _ _ _ _ _ _ _ H (refl_equal _)).
+ generalize (eval_addressing _ _ _ _ _ H (refl_equal _)).
destruct (addressing a). intros [vl [EV EQ]].
eapply eval_Eload; eauto.
Qed.
Lemma eval_store:
- forall sp le e m1 a1 t1 m2 v1 a2 t2 m3 v2 chunk m4,
- eval_expr ge sp le e m1 a1 t1 m2 v1 ->
- eval_expr ge sp le e m2 a2 t2 m3 v2 ->
- Mem.storev chunk m3 v1 v2 = Some m4 ->
- eval_expr ge sp le e m1 (store chunk a1 a2) (t1**t2) m4 v2.
+ forall chunk a1 a2 v1 v2 m',
+ eval_expr ge sp e m nil a1 v1 ->
+ eval_expr ge sp e m nil a2 v2 ->
+ Mem.storev chunk m v1 v2 = Some m' ->
+ exec_stmt ge sp e m (store chunk a1 a2) E0 e m' Out_normal.
Proof.
intros. generalize H1; destruct v1; simpl; intro; try discriminate.
unfold store.
- generalize (eval_addressing _ _ _ _ _ _ _ _ _ _ H (refl_equal _)).
+ generalize (eval_addressing _ _ _ _ _ H (refl_equal _)).
destruct (addressing a1). intros [vl [EV EQ]].
- eapply eval_Estore; eauto.
+ eapply exec_Sstore; eauto.
Qed.
(** * Correctness of instruction selection for operators *)
@@ -1018,10 +877,10 @@ Qed.
the results of the previous section. *)
Lemma eval_sel_unop:
- forall sp le e m op a1 t m1 v1 v,
- eval_expr ge sp le e m a1 t m1 v1 ->
+ forall le op a1 v1 v,
+ eval_expr ge sp e m le a1 v1 ->
eval_unop op v1 = Some v ->
- eval_expr ge sp le e m (sel_unop op a1) t m1 v.
+ eval_expr ge sp e m le (sel_unop op a1) v.
Proof.
destruct op; simpl; intros; FuncInv; try subst v.
apply eval_cast8unsigned; auto.
@@ -1044,39 +903,39 @@ Proof.
Qed.
Lemma eval_sel_binop:
- forall sp le e m op a1 a2 t1 m1 v1 t2 m2 v2 v,
- eval_expr ge sp le e m a1 t1 m1 v1 ->
- eval_expr ge sp le e m1 a2 t2 m2 v2 ->
- eval_binop op v1 v2 m2 = Some v ->
- eval_expr ge sp le e m (sel_binop op a1 a2) (t1 ** t2) m2 v.
+ forall le op a1 a2 v1 v2 v,
+ eval_expr ge sp e m le a1 v1 ->
+ eval_expr ge sp e m le a2 v2 ->
+ eval_binop op v1 v2 m = Some v ->
+ eval_expr ge sp e m le (sel_binop op a1 a2) v.
Proof.
destruct op; simpl; intros; FuncInv; try subst v.
- eapply eval_add; eauto.
- eapply eval_add_ptr_2; eauto.
- eapply eval_add_ptr; eauto.
- eapply eval_sub; eauto.
- eapply eval_sub_ptr_int; eauto.
+ apply eval_add; auto.
+ apply eval_add_ptr_2; auto.
+ apply eval_add_ptr; auto.
+ apply eval_sub; auto.
+ apply eval_sub_ptr_int; auto.
destruct (eq_block b b0); inv H1.
eapply eval_sub_ptr_ptr; eauto.
- eapply eval_mul; eauto.
- generalize (Int.eq_spec i0 Int.zero). intro. destruct (Int.eq i0 Int.zero); inv H1.
- eapply eval_divs; eauto.
- generalize (Int.eq_spec i0 Int.zero). intro. destruct (Int.eq i0 Int.zero); inv H1.
- eapply eval_divu; eauto.
- generalize (Int.eq_spec i0 Int.zero). intro. destruct (Int.eq i0 Int.zero); inv H1.
- eapply eval_mods; eauto.
- generalize (Int.eq_spec i0 Int.zero). intro. destruct (Int.eq i0 Int.zero); inv H1.
- eapply eval_modu; eauto.
- eapply eval_and; eauto.
- eapply eval_or; eauto.
+ apply eval_mul; eauto.
+ generalize (Int.eq_spec i0 Int.zero). destruct (Int.eq i0 Int.zero); inv H1.
+ apply eval_divs; eauto.
+ generalize (Int.eq_spec i0 Int.zero). destruct (Int.eq i0 Int.zero); inv H1.
+ apply eval_divu; eauto.
+ generalize (Int.eq_spec i0 Int.zero). destruct (Int.eq i0 Int.zero); inv H1.
+ apply eval_mods; eauto.
+ generalize (Int.eq_spec i0 Int.zero). destruct (Int.eq i0 Int.zero); inv H1.
+ apply eval_modu; eauto.
+ apply eval_and; auto.
+ apply eval_or; auto.
EvalOp.
caseEq (Int.ltu i0 (Int.repr 32)); intro; rewrite H2 in H1; inv H1.
- eapply eval_shl; eauto.
+ apply eval_shl; auto.
EvalOp.
caseEq (Int.ltu i0 (Int.repr 32)); intro; rewrite H2 in H1; inv H1.
- eapply eval_shru; eauto.
- eapply eval_addf; eauto.
- eapply eval_subf; eauto.
+ apply eval_shru; auto.
+ apply eval_addf; auto.
+ apply eval_subf; auto.
EvalOp.
EvalOp.
EvalOp. simpl. destruct (Int.cmp c i i0); auto.
@@ -1087,7 +946,7 @@ Proof.
destruct (Int.eq i0 Int.zero). destruct c; intro EQ; inv EQ; auto.
auto.
EvalOp. simpl.
- destruct (valid_pointer m2 b (Int.signed i) && valid_pointer m2 b0 (Int.signed i0)).
+ destruct (valid_pointer m b (Int.signed i) && valid_pointer m b0 (Int.signed i0)).
destruct (eq_block b b0); inv H1.
destruct (Int.cmp c i i0); auto.
auto.
@@ -1141,21 +1000,15 @@ Proof.
intros. destruct f; reflexivity.
Qed.
-(** This is the main semantic preservation theorem:
- instruction selection preserves the semantics of function invocations.
- The proof is an induction over the Cminor evaluation derivation. *)
+(** Semantic preservation for expressions. *)
-Lemma sel_function_correct:
- forall m fd vargs t m' vres,
- Cminor.eval_funcall ge m fd vargs t m' vres ->
- CminorSel.eval_funcall tge m (sel_fundef fd) vargs t m' vres.
+Lemma sel_expr_correct:
+ forall sp e m a v,
+ Cminor.eval_expr ge sp e m a v ->
+ forall le,
+ eval_expr tge sp e m le (sel_expr a) v.
Proof.
- apply (Cminor.eval_funcall_ind4 ge
- (fun sp le e m a t m' v => eval_expr tge sp le e m (sel_expr a) t m' v)
- (fun sp le e m a t m' v => eval_exprlist tge sp le e m (sel_exprlist a) t m' v)
- (fun m fd vargs t m' vres => eval_funcall tge m (sel_fundef fd) vargs t m' vres)
- (fun sp e m s t e' m' out => exec_stmt tge sp e m (sel_stmt s) t e' m' out));
- intros; simpl.
+ induction 1; intros; simpl.
(* Evar *)
constructor; auto.
(* Econst *)
@@ -1164,40 +1017,65 @@ Proof.
(* Eunop *)
eapply eval_sel_unop; eauto.
(* Ebinop *)
- subst t. eapply eval_sel_binop; eauto.
+ eapply eval_sel_binop; eauto.
(* Eload *)
eapply eval_load; eauto.
- (* Estore *)
- subst t. eapply eval_store; eauto.
- (* Ecall *)
- econstructor; eauto. apply functions_translated; auto.
- rewrite <- H4. apply sig_function_translated.
(* Econdition *)
econstructor; eauto. eapply eval_condition_of_expr; eauto.
destruct b1; auto.
- (* Elet *)
- econstructor; eauto.
- (* Eletvar *)
- constructor; auto.
- (* Ealloc *)
- econstructor; eauto.
- (* Enil *)
- constructor.
- (* Econs *)
- econstructor; eauto.
+Qed.
+
+Hint Resolve sel_expr_correct: evalexpr.
+
+Lemma sel_exprlist_correct:
+ forall sp e m a v,
+ Cminor.eval_exprlist ge sp e m a v ->
+ forall le,
+ eval_exprlist tge sp e m le (sel_exprlist a) v.
+Proof.
+ induction 1; intros; simpl; constructor; auto with evalexpr.
+Qed.
+
+Hint Resolve sel_exprlist_correct: evalexpr.
+
+(** Semantic preservation for terminating function calls and statements. *)
+
+Definition eval_funcall_exec_stmt_ind2
+ (P1 : mem -> Cminor.fundef -> list val -> trace -> mem -> val -> Prop)
+ (P2 : val -> env -> mem -> Cminor.stmt -> trace -> env -> mem -> outcome -> Prop) :=
+ fun a b c d e f g h i j k l m n o p q r =>
+ conj (Cminor.eval_funcall_ind2 ge P1 P2 a b c d e f g h i j k l m n o p q r)
+ (Cminor.exec_stmt_ind2 ge P1 P2 a b c d e f g h i j k l m n o p q r).
+
+Lemma sel_function_stmt_correct:
+ (forall m fd vargs t m' vres,
+ Cminor.eval_funcall ge m fd vargs t m' vres ->
+ CminorSel.eval_funcall tge m (sel_fundef fd) vargs t m' vres)
+ /\ (forall sp e m s t e' m' out,
+ Cminor.exec_stmt ge sp e m s t e' m' out ->
+ CminorSel.exec_stmt tge sp e m (sel_stmt s) t e' m' out).
+Proof.
+ apply eval_funcall_exec_stmt_ind2; intros; simpl.
(* Internal function *)
econstructor; eauto.
(* External function *)
econstructor; eauto.
(* Sskip *)
constructor.
- (* Sexpr *)
- econstructor; eauto.
(* Sassign *)
- econstructor; eauto.
+ econstructor; eauto with evalexpr.
+ (* Sstore *)
+ eapply eval_store; eauto with evalexpr.
+ (* Scall *)
+ econstructor; eauto with evalexpr.
+ apply functions_translated; auto.
+ rewrite <- H2. apply sig_function_translated.
+ (* Salloc *)
+ econstructor; eauto with evalexpr.
(* Sifthenelse *)
- econstructor; eauto. eapply eval_condition_of_expr; eauto.
- destruct b1; auto.
+ econstructor; eauto with evalexpr.
+ eapply eval_condition_of_expr; eauto with evalexpr.
+ destruct b; auto.
(* Sseq *)
eapply exec_Sseq_continue; eauto.
eapply exec_Sseq_stop; eauto.
@@ -1209,32 +1087,97 @@ Proof.
(* Sexit *)
constructor.
(* Sswitch *)
- econstructor; eauto.
+ econstructor; eauto with evalexpr.
(* Sreturn *)
constructor.
- econstructor; eauto.
+ econstructor; eauto with evalexpr.
(* Stailcall *)
- econstructor; eauto. apply functions_translated; auto.
- rewrite <- H4. apply sig_function_translated.
+ econstructor; eauto with evalexpr.
+ apply functions_translated; auto.
+ rewrite <- H2. apply sig_function_translated.
Qed.
+Lemma sel_function_correct:
+ forall m fd vargs t m' vres,
+ Cminor.eval_funcall ge m fd vargs t m' vres ->
+ CminorSel.eval_funcall tge m (sel_fundef fd) vargs t m' vres.
+Proof (proj1 sel_function_stmt_correct).
+
+Lemma sel_stmt_correct:
+ forall sp e m s t e' m' out,
+ Cminor.exec_stmt ge sp e m s t e' m' out ->
+ CminorSel.exec_stmt tge sp e m (sel_stmt s) t e' m' out.
+Proof (proj2 sel_function_stmt_correct).
+
+Hint Resolve sel_stmt_correct: evalexpr.
+
+(** Semantic preservation for diverging function calls and statements. *)
+
+Lemma sel_function_divergence_correct:
+ forall m fd vargs t,
+ Cminor.evalinf_funcall ge m fd vargs t ->
+ CminorSel.evalinf_funcall tge m (sel_fundef fd) vargs t.
+Proof.
+ cofix FUNCALL.
+ assert (STMT: forall sp e m s t,
+ Cminor.execinf_stmt ge sp e m s t ->
+ CminorSel.execinf_stmt tge sp e m (sel_stmt s) t).
+ cofix STMT; intros.
+ inversion H; subst; simpl.
+ (* Call *)
+ econstructor; eauto with evalexpr.
+ apply functions_translated; auto.
+ apply sig_function_translated.
+ (* Ifthenelse *)
+ econstructor; eauto with evalexpr.
+ eapply eval_condition_of_expr; eauto with evalexpr.
+ destruct b; eapply STMT; eauto.
+ (* Seq *)
+ apply execinf_Sseq_1; eauto.
+ eapply execinf_Sseq_2; eauto with evalexpr.
+ (* Loop *)
+ eapply execinf_Sloop_body; eauto.
+ eapply execinf_Sloop_loop; eauto with evalexpr.
+ change (Sloop (sel_stmt s0)) with (sel_stmt (Cminor.Sloop s0)).
+ apply STMT. auto.
+ (* Block *)
+ apply execinf_Sblock; eauto.
+ (* Tailcall *)
+ econstructor; eauto with evalexpr.
+ apply functions_translated; auto.
+ apply sig_function_translated.
+
+ intros. inv H; simpl.
+ (* Internal functions *)
+ econstructor; eauto with evalexpr.
+ unfold sel_function; simpl. eapply STMT; eauto.
+Qed.
+
End PRESERVATION.
(** As a corollary, instruction selection preserves the observable
behaviour of programs. *)
Theorem sel_program_correct:
- forall prog t r,
- Cminor.exec_program prog t r ->
- CminorSel.exec_program (sel_program prog) t r.
+ forall prog beh,
+ Cminor.exec_program prog beh ->
+ CminorSel.exec_program (sel_program prog) beh.
Proof.
- intros.
- destruct H as [b [f [m [FINDS [FINDF [SIG EXEC]]]]]].
- exists b; exists (sel_fundef f); exists m.
- split. simpl. rewrite <- FINDS. apply symbols_preserved.
- split. apply function_ptr_translated. auto.
- split. rewrite <- SIG. apply sig_function_translated.
+ intros. inv H.
+ (* Terminating *)
+ apply program_terminates with b (sel_fundef f) m.
+ simpl. rewrite <- H0. unfold ge. apply symbols_preserved.
+ apply function_ptr_translated. auto.
+ rewrite <- H2. apply sig_function_translated.
replace (Genv.init_mem (sel_program prog)) with (Genv.init_mem prog).
apply sel_function_correct; auto.
symmetry. unfold sel_program. apply Genv.init_mem_transf.
+ (* Diverging *)
+ apply program_diverges with b (sel_fundef f).
+ simpl. rewrite <- H0. unfold ge. apply symbols_preserved.
+ apply function_ptr_translated. auto.
+ rewrite <- H2. apply sig_function_translated.
+ replace (Genv.init_mem (sel_program prog)) with (Genv.init_mem prog).
+ apply sel_function_divergence_correct; auto.
+ symmetry. unfold sel_program. apply Genv.init_mem_transf.
Qed.
diff --git a/caml/CMlexer.mll b/caml/CMlexer.mll
index ae71e0c13..7951982f2 100644
--- a/caml/CMlexer.mll
+++ b/caml/CMlexer.mll
@@ -99,6 +99,7 @@ rule token = parse
| "*" { STAR }
| "*f" { STARF }
| "switch" { SWITCH }
+ | "tailcall" { TAILCALL }
| "~" { TILDE }
| "var" { VAR }
| "void" { VOID }
diff --git a/caml/CMparser.mly b/caml/CMparser.mly
index 0db0af2b5..fb095275a 100644
--- a/caml/CMparser.mly
+++ b/caml/CMparser.mly
@@ -10,22 +10,136 @@ open Integers
open AST
open Cminor
+(** Naming function calls in expressions *)
+
+type rexpr =
+ | Rvar of ident
+ | Rconst of constant
+ | Runop of unary_operation * rexpr
+ | Rbinop of binary_operation * rexpr * rexpr
+ | Rload of memory_chunk * rexpr
+ | Rcondition of rexpr * rexpr * rexpr
+ | Rcall of signature * rexpr * rexpr list
+ | Ralloc of rexpr
+
+let temp_counter = ref 0
+
+let temporaries = ref Coq_nil
+
+let mktemp () =
+ incr temp_counter;
+ let n = Printf.sprintf "__t%d" !temp_counter in
+ let id = intern_string n in
+ temporaries := Coq_cons(id, !temporaries);
+ id
+
+let convert_accu = ref []
+
+let rec convert_rexpr = function
+ | Rvar id -> Evar id
+ | Rconst c -> Econst c
+ | Runop(op, e1) -> Eunop(op, convert_rexpr e1)
+ | Rbinop(op, e1, e2) ->
+ let c1 = convert_rexpr e1 in
+ let c2 = convert_rexpr e2 in
+ Ebinop(op, c1, c2)
+ | Rload(chunk, e1) -> Eload(chunk, convert_rexpr e1)
+ | Rcondition(e1, e2, e3) ->
+ let c1 = convert_rexpr e1 in
+ let c2 = convert_rexpr e2 in
+ let c3 = convert_rexpr e3 in
+ Econdition(c1, c2, c3)
+ | Rcall(sg, e1, el) ->
+ let c1 = convert_rexpr e1 in
+ let cl = convert_rexpr_list el in
+ let t = mktemp() in
+ convert_accu := Scall(Some t, sg, c1, cl) :: !convert_accu;
+ Evar t
+ | Ralloc e1 ->
+ let c1 = convert_rexpr e1 in
+ let t = mktemp() in
+ convert_accu := Salloc(t, c1) :: !convert_accu;
+ Evar t
+
+and convert_rexpr_list = function
+ | Coq_nil -> Coq_nil
+ | Coq_cons(e1, el) ->
+ let c1 = convert_rexpr e1 in
+ let cl = convert_rexpr_list el in
+ Coq_cons(c1, cl)
+
+let rec prepend_seq stmts last =
+ match stmts with
+ | [] -> last
+ | s1 :: sl -> prepend_seq sl (Sseq(s1, last))
+
+let mkeval e =
+ convert_accu := [];
+ match e with
+ | Rcall(sg, e1, el) ->
+ let c1 = convert_rexpr e1 in
+ let cl = convert_rexpr_list el in
+ prepend_seq !convert_accu (Scall(None, sg, c1, cl))
+ | _ ->
+ ignore (convert_rexpr e);
+ prepend_seq !convert_accu Sskip
+
+let mkassign id e =
+ convert_accu := [];
+ match e with
+ | Rcall(sg, e1, el) ->
+ let c1 = convert_rexpr e1 in
+ let cl = convert_rexpr_list el in
+ prepend_seq !convert_accu (Scall(Some id, sg, c1, cl))
+ | Ralloc(e1) ->
+ let c1 = convert_rexpr e1 in
+ prepend_seq !convert_accu (Salloc(id, c1))
+ | _ ->
+ let c = convert_rexpr e in
+ prepend_seq !convert_accu (Sassign(id, c))
+
+let mkstore chunk e1 e2 =
+ convert_accu := [];
+ let c1 = convert_rexpr e1 in
+ let c2 = convert_rexpr e2 in
+ prepend_seq !convert_accu (Sstore(chunk, c1, c2))
+
+let mkifthenelse e s1 s2 =
+ convert_accu := [];
+ let c = convert_rexpr e in
+ prepend_seq !convert_accu (Sifthenelse(c, s1, s2))
+
+let mkreturn_some e =
+ convert_accu := [];
+ let c = convert_rexpr e in
+ prepend_seq !convert_accu (Sreturn (Some c))
+
+let mktailcall sg e1 el =
+ convert_accu := [];
+ let c1 = convert_rexpr e1 in
+ let cl = convert_rexpr_list el in
+ prepend_seq !convert_accu (Stailcall(sg, c1, cl))
+
+(** Other constructors *)
+
let intconst n =
- Econst(Ointconst(coqint_of_camlint n))
+ Rconst(Ointconst(coqint_of_camlint n))
let andbool e1 e2 =
- Econdition(e1, e2, intconst 0l)
+ Rcondition(e1, e2, intconst 0l)
let orbool e1 e2 =
- Econdition(e1, intconst 1l, e2)
+ Rcondition(e1, intconst 1l, e2)
let exitnum n = nat_of_camlint(Int32.pred n)
let mkswitch expr (cases, dfl) =
+ convert_accu := [];
+ let c = convert_rexpr expr in
let rec mktable = function
| [] -> Coq_nil
| (key, exit) :: rem ->
Coq_cons(Coq_pair(coqint_of_camlint key, exitnum exit), mktable rem) in
- Sswitch(expr, mktable cases, exitnum dfl)
+ prepend_seq !convert_accu (Sswitch(c, mktable cases, exitnum dfl))
(***
match (a) { case 0: s0; case 1: s1; case 2: s2; } --->
@@ -65,10 +179,14 @@ let mkmatch_aux expr cases =
mkblocks (Sblock sw) (Int32.pred ncases) cases
let mkmatch expr cases =
- match cases with
- | [] -> Sskip (* ??? *)
- | [key, action] -> action
- | _ -> mkmatch_aux expr cases
+ convert_accu := [];
+ let c = convert_rexpr expr in
+ let s =
+ match cases with
+ | [] -> Sskip (* ??? *)
+ | [key, action] -> action
+ | _ -> mkmatch_aux c cases in
+ prepend_seq !convert_accu s
%}
@@ -158,6 +276,7 @@ let mkmatch expr cases =
%token <AST.ident> STRINGLIT
%token SWITCH
%token TILDE
+%token TAILCALL
%token VAR
%token VOID
@@ -221,10 +340,13 @@ proc:
var_declarations
stmt_list
RBRACE
- { Coq_pair($1,
+ { let tmp = !temporaries in
+ temporaries := Coq_nil;
+ temp_counter := 0;
+ Coq_pair($1,
Internal { fn_sig = $6;
fn_params = CList.rev $3;
- fn_vars = CList.rev $9;
+ fn_vars = CList.rev (CList.app tmp $9);
fn_stackspace = $8;
fn_body = $10 }) }
| EXTERN STRINGLIT COLON signature
@@ -269,20 +391,24 @@ var_declaration:
/* Statements */
stmt:
- expr SEMICOLON { Sexpr $1 }
- | IDENT EQUAL expr SEMICOLON { Sassign($1, $3) }
- | IF LPAREN expr RPAREN stmts ELSE stmts { Sifthenelse($3, $5, $7) }
- | IF LPAREN expr RPAREN stmts { Sifthenelse($3, $5, Sskip) }
+ expr SEMICOLON { mkeval $1 }
+ | IDENT EQUAL expr SEMICOLON { mkassign $1 $3 }
+ | memory_chunk LBRACKET expr RBRACKET EQUAL expr SEMICOLON
+ { mkstore $1 $3 $6 }
+ | IF LPAREN expr RPAREN stmts ELSE stmts { mkifthenelse $3 $5 $7 }
+ | IF LPAREN expr RPAREN stmts { mkifthenelse $3 $5 Sskip }
| LOOP stmts { Sloop($2) }
| LBRACELBRACE stmt_list RBRACERBRACE { Sblock($2) }
| EXIT SEMICOLON { Sexit O }
| EXIT INTLIT SEMICOLON { Sexit (exitnum $2) }
| RETURN SEMICOLON { Sreturn None }
- | RETURN expr SEMICOLON { Sreturn (Some $2) }
+ | RETURN expr SEMICOLON { mkreturn_some $2 }
| SWITCH LPAREN expr RPAREN LBRACE switch_cases RBRACE
{ mkswitch $3 $6 }
| MATCH LPAREN expr RPAREN LBRACE match_cases RBRACE
{ mkmatch $3 $6 }
+ | TAILCALL expr LPAREN expr_list RPAREN COLON signature SEMICOLON
+ { mktailcall $7 $2 $4 }
;
stmts:
@@ -311,80 +437,75 @@ match_cases:
expr:
LPAREN expr RPAREN { $2 }
- | IDENT { Evar $1 }
+ | IDENT { Rvar $1 }
| INTLIT { intconst $1 }
- | FLOATLIT { Econst(Ofloatconst $1) }
- | STRINGLIT { Econst(Oaddrsymbol($1, Int.zero)) }
- | AMPERSAND INTLIT { Econst(Oaddrstack(coqint_of_camlint $2)) }
- | MINUS expr %prec p_uminus { Eunop(Onegint, $2) }
- | MINUSF expr %prec p_uminus { Eunop(Onegf, $2) }
- | ABSF expr { Eunop(Oabsf, $2) }
- | INTOFFLOAT expr { Eunop(Ointoffloat, $2) }
- | FLOATOFINT expr { Eunop(Ofloatofint, $2) }
- | FLOATOFINTU expr { Eunop(Ofloatofintu, $2) }
- | TILDE expr { Eunop(Onotint, $2) }
- | BANG expr { Eunop(Onotbool, $2) }
- | INT8S expr { Eunop(Ocast8signed, $2) }
- | INT8U expr { Eunop(Ocast8unsigned, $2) }
- | INT16S expr { Eunop(Ocast16signed, $2) }
- | INT16U expr { Eunop(Ocast16unsigned, $2) }
- | FLOAT32 expr { Eunop(Osingleoffloat, $2) }
- | ALLOC expr { Ealloc $2 }
- | expr PLUS expr { Ebinop(Oadd, $1, $3) }
- | expr MINUS expr { Ebinop(Osub, $1, $3) }
- | expr STAR expr { Ebinop(Omul, $1, $3) }
- | expr SLASH expr { Ebinop(Odiv, $1, $3) }
- | expr PERCENT expr { Ebinop(Omod, $1, $3) }
- | expr SLASHU expr { Ebinop(Odivu, $1, $3) }
- | expr PERCENTU expr { Ebinop(Omodu, $1, $3) }
- | expr AMPERSAND expr { Ebinop(Oand, $1, $3) }
- | expr BAR expr { Ebinop(Oor, $1, $3) }
- | expr CARET expr { Ebinop(Oxor, $1, $3) }
- | expr LESSLESS expr { Ebinop(Oshl, $1, $3) }
- | expr GREATERGREATER expr { Ebinop(Oshr, $1, $3) }
- | expr GREATERGREATERU expr { Ebinop(Oshru, $1, $3) }
- | expr PLUSF expr { Ebinop(Oaddf, $1, $3) }
- | expr MINUSF expr { Ebinop(Osubf, $1, $3) }
- | expr STARF expr { Ebinop(Omulf, $1, $3) }
- | expr SLASHF expr { Ebinop(Odivf, $1, $3) }
- | expr EQUALEQUAL expr { Ebinop(Ocmp Ceq, $1, $3) }
- | expr BANGEQUAL expr { Ebinop(Ocmp Cne, $1, $3) }
- | expr LESS expr { Ebinop(Ocmp Clt, $1, $3) }
- | expr LESSEQUAL expr { Ebinop(Ocmp Cle, $1, $3) }
- | expr GREATER expr { Ebinop(Ocmp Cgt, $1, $3) }
- | expr GREATEREQUAL expr { Ebinop(Ocmp Cge, $1, $3) }
- | expr EQUALEQUALU expr { Ebinop(Ocmpu Ceq, $1, $3) }
- | expr BANGEQUALU expr { Ebinop(Ocmpu Cne, $1, $3) }
- | expr LESSU expr { Ebinop(Ocmpu Clt, $1, $3) }
- | expr LESSEQUALU expr { Ebinop(Ocmpu Cle, $1, $3) }
- | expr GREATERU expr { Ebinop(Ocmpu Cgt, $1, $3) }
- | expr GREATEREQUALU expr { Ebinop(Ocmpu Cge, $1, $3) }
- | expr EQUALEQUALF expr { Ebinop(Ocmpf Ceq, $1, $3) }
- | expr BANGEQUALF expr { Ebinop(Ocmpf Cne, $1, $3) }
- | expr LESSF expr { Ebinop(Ocmpf Clt, $1, $3) }
- | expr LESSEQUALF expr { Ebinop(Ocmpf Cle, $1, $3) }
- | expr GREATERF expr { Ebinop(Ocmpf Cgt, $1, $3) }
- | expr GREATEREQUALF expr { Ebinop(Ocmpf Cge, $1, $3) }
- | memory_chunk LBRACKET expr RBRACKET { Eload($1, $3) }
- | memory_chunk LBRACKET expr RBRACKET EQUAL expr
- { Estore($1, $3, $6) }
- | expr LPAREN expr_list RPAREN COLON signature
- { Ecall($6, $1, $3) }
+ | FLOATLIT { Rconst(Ofloatconst $1) }
+ | STRINGLIT { Rconst(Oaddrsymbol($1, Int.zero)) }
+ | AMPERSAND INTLIT { Rconst(Oaddrstack(coqint_of_camlint $2)) }
+ | MINUS expr %prec p_uminus { Rbinop(Osub, intconst 0l, $2) } /***FIXME***/
+ | MINUSF expr %prec p_uminus { Runop(Onegf, $2) }
+ | ABSF expr { Runop(Oabsf, $2) }
+ | INTOFFLOAT expr { Runop(Ointoffloat, $2) }
+ | FLOATOFINT expr { Runop(Ofloatofint, $2) }
+ | FLOATOFINTU expr { Runop(Ofloatofintu, $2) }
+ | TILDE expr { Runop(Onotint, $2) }
+ | BANG expr { Runop(Onotbool, $2) }
+ | INT8S expr { Runop(Ocast8signed, $2) }
+ | INT8U expr { Runop(Ocast8unsigned, $2) }
+ | INT16S expr { Runop(Ocast16signed, $2) }
+ | INT16U expr { Runop(Ocast16unsigned, $2) }
+ | FLOAT32 expr { Runop(Osingleoffloat, $2) }
+ | expr PLUS expr { Rbinop(Oadd, $1, $3) }
+ | expr MINUS expr { Rbinop(Osub, $1, $3) }
+ | expr STAR expr { Rbinop(Omul, $1, $3) }
+ | expr SLASH expr { Rbinop(Odiv, $1, $3) }
+ | expr PERCENT expr { Rbinop(Omod, $1, $3) }
+ | expr SLASHU expr { Rbinop(Odivu, $1, $3) }
+ | expr PERCENTU expr { Rbinop(Omodu, $1, $3) }
+ | expr AMPERSAND expr { Rbinop(Oand, $1, $3) }
+ | expr BAR expr { Rbinop(Oor, $1, $3) }
+ | expr CARET expr { Rbinop(Oxor, $1, $3) }
+ | expr LESSLESS expr { Rbinop(Oshl, $1, $3) }
+ | expr GREATERGREATER expr { Rbinop(Oshr, $1, $3) }
+ | expr GREATERGREATERU expr { Rbinop(Oshru, $1, $3) }
+ | expr PLUSF expr { Rbinop(Oaddf, $1, $3) }
+ | expr MINUSF expr { Rbinop(Osubf, $1, $3) }
+ | expr STARF expr { Rbinop(Omulf, $1, $3) }
+ | expr SLASHF expr { Rbinop(Odivf, $1, $3) }
+ | expr EQUALEQUAL expr { Rbinop(Ocmp Ceq, $1, $3) }
+ | expr BANGEQUAL expr { Rbinop(Ocmp Cne, $1, $3) }
+ | expr LESS expr { Rbinop(Ocmp Clt, $1, $3) }
+ | expr LESSEQUAL expr { Rbinop(Ocmp Cle, $1, $3) }
+ | expr GREATER expr { Rbinop(Ocmp Cgt, $1, $3) }
+ | expr GREATEREQUAL expr { Rbinop(Ocmp Cge, $1, $3) }
+ | expr EQUALEQUALU expr { Rbinop(Ocmpu Ceq, $1, $3) }
+ | expr BANGEQUALU expr { Rbinop(Ocmpu Cne, $1, $3) }
+ | expr LESSU expr { Rbinop(Ocmpu Clt, $1, $3) }
+ | expr LESSEQUALU expr { Rbinop(Ocmpu Cle, $1, $3) }
+ | expr GREATERU expr { Rbinop(Ocmpu Cgt, $1, $3) }
+ | expr GREATEREQUALU expr { Rbinop(Ocmpu Cge, $1, $3) }
+ | expr EQUALEQUALF expr { Rbinop(Ocmpf Ceq, $1, $3) }
+ | expr BANGEQUALF expr { Rbinop(Ocmpf Cne, $1, $3) }
+ | expr LESSF expr { Rbinop(Ocmpf Clt, $1, $3) }
+ | expr LESSEQUALF expr { Rbinop(Ocmpf Cle, $1, $3) }
+ | expr GREATERF expr { Rbinop(Ocmpf Cgt, $1, $3) }
+ | expr GREATEREQUALF expr { Rbinop(Ocmpf Cge, $1, $3) }
+ | memory_chunk LBRACKET expr RBRACKET { Rload($1, $3) }
| expr AMPERSANDAMPERSAND expr { andbool $1 $3 }
| expr BARBAR expr { orbool $1 $3 }
- | expr QUESTION expr COLON expr { Econdition($1, $3, $5) }
- | LET expr IN expr %prec p_let { Elet($2, $4) }
- | DOLLAR INTLIT { Eletvar (nat_of_camlint $2) }
+ | expr QUESTION expr COLON expr { Rcondition($1, $3, $5) }
+ | expr LPAREN expr_list RPAREN COLON signature{ Rcall($6, $1, $3) }
+ | ALLOC expr { Ralloc $2 }
;
expr_list:
- /* empty */ { Enil }
+ /* empty */ { Coq_nil }
| expr_list_1 { $1 }
;
expr_list_1:
- expr %prec COMMA { Econs($1, Enil) }
- | expr COMMA expr_list_1 { Econs($1, $3) }
+ expr %prec COMMA { Coq_cons($1, Coq_nil) }
+ | expr COMMA expr_list_1 { Coq_cons($1, $3) }
;
memory_chunk:
diff --git a/caml/CMtypecheck.ml b/caml/CMtypecheck.ml
index 495ded0cf..9277829c4 100644
--- a/caml/CMtypecheck.ml
+++ b/caml/CMtypecheck.ml
@@ -206,30 +206,6 @@ let rec type_expr env lenv e =
(name_of_chunk chunk) s))
end;
type_chunk chunk
- | Estore(chunk, e1, e2) ->
- let te1 = type_expr env lenv e1 in
- let te2 = type_expr env lenv e2 in
- begin try
- unify tint te1;
- unify (type_chunk chunk) te2
- with Error s ->
- raise (Error (sprintf "In store %s:\n%s"
- (name_of_chunk chunk) s))
- end;
- te1
- | Ecall(sg, e1, el) ->
- let te1 = type_expr env lenv e1 in
- let tel = type_exprlist env lenv el in
- begin try
- unify tint te1;
- unify_list (ty_of_sig_args sg.sig_args) tel
- with Error s ->
- raise (Error (sprintf "In call:\n%s" s))
- end;
- begin match sg.sig_res with
- | None -> tint (*???*)
- | Some t -> ty_of_typ t
- end
| Econdition(e1, e2, e3) ->
type_condexpr env lenv e1;
let te2 = type_expr env lenv e2 in
@@ -240,25 +216,19 @@ let rec type_expr env lenv e =
raise (Error (sprintf "In conditional expression:\n%s" s))
end;
te2
+(*
| Elet(e1, e2) ->
let te1 = type_expr env lenv e1 in
let te2 = type_expr env (te1 :: lenv) e2 in
te2
| Eletvar n ->
type_letvar lenv n
- | Ealloc e ->
- let te = type_expr env lenv e in
- begin try
- unify tint te
- with Error s ->
- raise (Error (sprintf "In alloc:\n%s" s))
- end;
- tint
+*)
and type_exprlist env lenv el =
match el with
- | Enil -> []
- | Econs (e1, et) ->
+ | Coq_nil -> []
+ | Coq_cons (e1, et) ->
let te1 = type_expr env lenv e1 in
let tet = type_exprlist env lenv et in
(te1 :: tet)
@@ -274,8 +244,6 @@ and type_condexpr env lenv e =
let rec type_stmt env blk ret s =
match s with
| Sskip -> ()
- | Sexpr e ->
- ignore (type_expr env [] e)
| Sassign(id, e1) ->
let tid = type_var env id in
let te1 = type_expr env [] e1 in
@@ -284,6 +252,42 @@ let rec type_stmt env blk ret s =
with Error s ->
raise (Error (sprintf "In assignment to %s:\n%s" (extern_atom id) s))
end
+ | Sstore(chunk, e1, e2) ->
+ let te1 = type_expr env [] e1 in
+ let te2 = type_expr env [] e2 in
+ begin try
+ unify tint te1;
+ unify (type_chunk chunk) te2
+ with Error s ->
+ raise (Error (sprintf "In store %s:\n%s"
+ (name_of_chunk chunk) s))
+ end
+ | Scall(optid, sg, e1, el) ->
+ let te1 = type_expr env [] e1 in
+ let tel = type_exprlist env [] el in
+ begin try
+ unify tint te1;
+ unify_list (ty_of_sig_args sg.sig_args) tel;
+ let ty_res =
+ match sg.sig_res with
+ | None -> tint (*???*)
+ | Some t -> ty_of_typ t in
+ begin match optid with
+ | None -> ()
+ | Some id -> unify (type_var env id) ty_res
+ end
+ with Error s ->
+ raise (Error (sprintf "In call:\n%s" s))
+ end
+ | Salloc(id, e) ->
+ let tid = type_var env id in
+ let te = type_expr env [] e in
+ begin try
+ unify tint te;
+ unify tint tid
+ with Error s ->
+ raise (Error (sprintf "In alloc:\n%s" s))
+ end
| Sseq(s1, s2) ->
type_stmt env blk ret s1;
type_stmt env blk ret s2
diff --git a/caml/Cil2Csyntax.ml b/caml/Cil2Csyntax.ml
index 553229c64..0e168414d 100644
--- a/caml/Cil2Csyntax.ml
+++ b/caml/Cil2Csyntax.ml
@@ -3,6 +3,7 @@ CIL -> CabsCoq translator
**************************************************************************)
open Cil
+open CList
open Camlcoq
open AST
open Csyntax
@@ -192,6 +193,17 @@ let declare_stub_functions k =
Hashtbl.fold (fun n i k -> CList.Coq_cons(declare_stub_function n i, k))
stub_function_table k
+(** ** Generation of temporary variable names *)
+
+let current_function = ref (None: Cil.fundec option)
+
+let make_temp typ =
+ match !current_function with
+ | None -> assert false
+ | Some f ->
+ let v = Cil.makeTempVar f typ in
+ intern_string v.vname
+
(** ** Translation functions *)
(** Convert a [Cil.ikind] into a pair [(intsize * signedness)] *)
@@ -310,13 +322,13 @@ and processCast t e =
(** Convert a [Cil.exp list] into an [CamlCoq.exprlist] *)
and processParamsE = function
- | [] -> Enil
+ | [] -> Coq_nil
| e :: l ->
let (Expr (_, t)) as e' = convertExp e in
match t with
| Tstruct _ | Tunion _ ->
unsupported "function parameter of struct or union type"
- | _ -> Econs (e', processParamsE l)
+ | _ -> Coq_cons (e', processParamsE l)
(** Convert a [Cil.exp] into a [CabsCoq.expr] *)
@@ -489,8 +501,8 @@ let convertVarinfoParam v =
(** Convert a [Cil.exp] which has a function type into a [CabsCoq.expr]
(used only to translate function calls) *)
-let convertExpFuncall e tfun eList =
- match tfun with
+let convertExpFuncall e eList =
+ match typeOf e with
| TFun (res, argListOpt, vArg, _) ->
begin match argListOpt, vArg with
| Some argList, false ->
@@ -512,8 +524,8 @@ let convertExpFuncall e tfun eList =
| _ ->
unsupported "call to variadic or non-prototyped function" in
let rec typeOfExprList = function
- | Enil -> Tnil
- | Econs (Expr (_, ty), rem) -> Tcons (ty, typeOfExprList rem) in
+ | Coq_nil -> Tnil
+ | Coq_cons (Expr (_, ty), rem) -> Tcons (ty, typeOfExprList rem) in
let targs = typeOfExprList params in
let tres = convertTyp res in
let (stub_fun_name, stub_fun_typ) =
@@ -523,6 +535,33 @@ let convertExpFuncall e tfun eList =
end
| _ -> internal_error "convertExpFuncall: not a function"
+(** Auxiliaries for function calls *)
+
+let makeFuncall1 tyfun (Expr(_, tlhs) as elhs) efun eargs =
+ match tyfun with
+ | TFun (t, _, _, _) ->
+ let tres = convertTyp t in
+ if tlhs = tres then
+ Scall(Datatypes.Some elhs, efun, eargs)
+ else begin
+ let tmp = make_temp t in
+ let elhs' = Expr(Evar tmp, tres) in
+ Ssequence(Scall(Datatypes.Some elhs', efun, eargs),
+ Sassign(elhs, Expr(Ecast(tlhs, elhs'), tlhs)))
+ end
+ | _ -> internal_error "wrong type for function in call"
+
+let makeFuncall2 tyfun tylhs elhs efun eargs =
+ match elhs with
+ | Expr(Evar _, _) ->
+ makeFuncall1 tyfun elhs efun eargs
+ | Expr(_, tlhs) ->
+ let tmp = make_temp tylhs in
+ let elhs' = Expr(Evar tmp, tlhs) in
+ Ssequence(makeFuncall1 tyfun elhs' efun eargs,
+ Sassign(elhs, elhs'))
+
+
(** Convert a [Cil.instr list] into a [CabsCoq.statement] *)
let rec processInstrList l =
(* convert an instruction *)
@@ -533,33 +572,14 @@ let rec processInstrList l =
| Tstruct _ | Tunion _ -> unsupported "struct or union assignment"
| t -> Sassign (convertLval lv, convertExp e)
end
- | Call (lvOpt, e, eList, loc) ->
+ | Call (None, e, eList, loc) ->
updateLoc(loc);
- begin match Cil.unrollType (Cil.typeOf e) with
- | TFun (t, _, _, _) as tfun ->
- let t' = convertTyp t in
- let (efun, params) = convertExpFuncall e tfun eList in
- let e' = Expr (Ecall (efun, params), t') in
- begin match lvOpt with
- | None -> Sexpr e'
- | Some lv ->
- let (Expr (_, tlv)) as elv = convertLval lv in
- begin match tlv with
- | Tstruct _ | Tunion _ ->
- unsupported "struct or union assignment"
- | _ ->
- if tlv = t' then
- Sassign (elv, e')
- else
- (* a cast must be inserted *)
- if compatibleTypes tlv t' then
- Sassign (elv,
- Expr (Ecast (tlv, e'), tlv))
- else internal_error "processCast: illegal cast"
- end
- end
- | _ -> internal_error "convertInstr: illegal call"
- end
+ let (efun, params) = convertExpFuncall e eList in
+ Scall(Datatypes.None, efun, params)
+ | Call (Some lv, e, eList, loc) ->
+ updateLoc(loc);
+ let (efun, params) = convertExpFuncall e eList in
+ makeFuncall2 (Cil.typeOf e) (Cil.typeOfLval lv) (convertLval lv) efun params
| Asm (_, _, _, _, _, loc) ->
updateLoc(loc);
unsupported "inline assembly"
@@ -687,6 +707,7 @@ and convertStmt s =
(** Convert a [Cil.GFun] into a pair [(ident * coq_fundecl)] *)
let convertGFun fdec =
+ current_function := Some fdec;
let v = fdec.svar in
let ret = match v.vtype with
| TFun (t, _, vArg, _) ->
@@ -698,15 +719,16 @@ let convertGFun fdec =
end
| _ -> internal_error "convertGFun: incorrect function type"
in
+ let s = processStmtList fdec.sbody.bstmts in (* function body -- do it first because of generated temps *)
let args = map_coqlist convertVarinfoParam fdec.sformals in (* parameters*)
let varList = map_coqlist convertVarinfo fdec.slocals in (* local vars *)
- let s = processStmtList fdec.sbody.bstmts in (* function body *)
if v.vname = "main" then begin
match ret with
| Tint(_, _) -> ()
| _ -> updateLoc v.vdecl;
unsupported "the return type of main() must be an integer type"
end;
+ current_function := None;
Datatypes.Coq_pair
(intern_string v.vname,
Internal { fn_return=ret; fn_params=args; fn_vars=varList; fn_body=s })
diff --git a/caml/PrintCsyntax.ml b/caml/PrintCsyntax.ml
index f9abd9a2f..59c42d3bf 100644
--- a/caml/PrintCsyntax.ml
+++ b/caml/PrintCsyntax.ml
@@ -129,7 +129,6 @@ let parenthesis_level (Expr (e, ty)) =
end
| Ecast _ -> 30
| Eindex(_, _) -> 20
- | Ecall(_, _) -> 20
| Eandbool(_, _) -> 80
| Eorbool(_, _) -> 80
| Esizeof _ -> 20
@@ -163,10 +162,6 @@ let rec print_expr p (Expr (eb, ty) as e) =
fprintf p "@[<hov 2>%a@,[%a]@]"
print_expr_prec (level, e1)
print_expr_prec (level, e2)
- | Ecall(e1, el) ->
- fprintf p "@[<hov 2>%a@,(@[<hov 0>%a@])@]"
- print_expr_prec (level, e1)
- print_expr_list (true, el)
| Eandbool(e1, e2) ->
fprintf p "@[<hov 0>%a@ && %a@]"
print_expr_prec (level, e1)
@@ -186,10 +181,10 @@ and print_expr_prec p (context_prec, e) =
then fprintf p "(%a)" print_expr e
else print_expr p e
-and print_expr_list p (first, el) =
+let rec print_expr_list p (first, el) =
match el with
- | Enil -> ()
- | Econs(e1, et) ->
+ | Coq_nil -> ()
+ | Coq_cons(e1, et) ->
if not first then fprintf p ",@ ";
print_expr p e1;
print_expr_list p (false, et)
@@ -198,10 +193,17 @@ let rec print_stmt p s =
match s with
| Sskip ->
fprintf p "/*skip*/;"
- | Sexpr e ->
- fprintf p "%a;" print_expr e
| 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)
| Ssequence(s1, s2) ->
fprintf p "%a@ %a" print_stmt s1 print_stmt s2
| Sifthenelse(e, s1, Sskip) ->
@@ -260,12 +262,19 @@ and print_stmt_for p s =
match s with
| Sskip ->
fprintf p "/*nothing*/"
- | Sexpr e ->
- fprintf p "%a" print_expr e
| Sassign(e1, e2) ->
fprintf p "%a = %a" print_expr e1 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 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 "<impossible>"
@@ -395,20 +404,20 @@ let rec collect_expr (Expr(ed, ty)) =
| Ebinop(op, e1, e2) -> collect_expr e1; collect_expr e2
| Ecast(ty, e1) -> collect_type ty; collect_expr e1
| Eindex(e1, e2) -> collect_expr e1; collect_expr e2
- | Ecall(e1, el) -> collect_expr e1; collect_expr_list el
| 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
-and collect_expr_list = function
- | Enil -> ()
- | Econs(hd, tl) -> collect_expr hd; collect_expr_list tl
+let rec collect_expr_list = function
+ | Coq_nil -> ()
+ | Coq_cons(hd, tl) -> collect_expr hd; collect_expr_list tl
let rec collect_stmt = function
| Sskip -> ()
- | Sexpr e -> collect_expr e
| 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
| 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
diff --git a/cfrontend/Cminorgen.v b/cfrontend/Cminorgen.v
index d021a63c6..8596ebfa8 100644
--- a/cfrontend/Cminorgen.v
+++ b/cfrontend/Cminorgen.v
@@ -79,7 +79,7 @@ Definition store_arg (chunk: memory_chunk) (e: expr) : expr :=
end.
Definition make_store (chunk: memory_chunk) (e1 e2: expr): stmt :=
- Sexpr (Estore chunk e1 (store_arg chunk e2)).
+ Sstore chunk e1 (store_arg chunk e2).
Definition make_stackaddr (ofs: Z): expr :=
Econst (Oaddrstack (Int.repr ofs)).
@@ -160,35 +160,22 @@ Fixpoint transl_expr (cenv: compilenv) (e: Csharpminor.expr)
| Csharpminor.Eload chunk e =>
do te <- transl_expr cenv e;
OK (Eload chunk te)
- | Csharpminor.Ecall sig e el =>
- do te <- transl_expr cenv e;
- do tel <- transl_exprlist cenv el;
- OK (Ecall sig te tel)
| Csharpminor.Econdition e1 e2 e3 =>
do te1 <- transl_expr cenv e1;
do te2 <- transl_expr cenv e2;
do te3 <- transl_expr cenv e3;
OK (Econdition te1 te2 te3)
- | Csharpminor.Elet e1 e2 =>
- do te1 <- transl_expr cenv e1;
- do te2 <- transl_expr cenv e2;
- OK (Elet te1 te2)
- | Csharpminor.Eletvar n =>
- OK (Eletvar n)
- | Csharpminor.Ealloc e =>
- do te <- transl_expr cenv e;
- OK (Ealloc te)
- end
+ end.
-with transl_exprlist (cenv: compilenv) (el: Csharpminor.exprlist)
- {struct el}: res exprlist :=
+Fixpoint transl_exprlist (cenv: compilenv) (el: list Csharpminor.expr)
+ {struct el}: res (list expr) :=
match el with
- | Csharpminor.Enil =>
- OK Enil
- | Csharpminor.Econs e1 e2 =>
+ | nil =>
+ OK nil
+ | e1 :: e2 =>
do te1 <- transl_expr cenv e1;
do te2 <- transl_exprlist cenv e2;
- OK (Econs te1 te2)
+ OK (te1 :: te2)
end.
(** Translation of statements. Entirely straightforward. *)
@@ -198,14 +185,21 @@ Fixpoint transl_stmt (cenv: compilenv) (s: Csharpminor.stmt)
match s with
| Csharpminor.Sskip =>
OK Sskip
- | Csharpminor.Sexpr e =>
- do te <- transl_expr cenv e; OK(Sexpr te)
| Csharpminor.Sassign id e =>
do te <- transl_expr cenv e; var_set cenv 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;
+ OK (Scall None sig te tel)
+ | Csharpminor.Scall (Some id) sig e el =>
+ do te <- transl_expr cenv e;
+ do tel <- transl_exprlist cenv el;
+ do s <- var_set cenv id (Evar id);
+ OK (Sseq (Scall (Some id) sig te tel) s)
| Csharpminor.Sseq s1 s2 =>
do ts1 <- transl_stmt cenv s1;
do ts2 <- transl_stmt cenv s2;
@@ -245,31 +239,26 @@ Fixpoint addr_taken_expr (e: Csharpminor.expr): Identset.t :=
| Csharpminor.Ebinop op e1 e2 =>
Identset.union (addr_taken_expr e1) (addr_taken_expr e2)
| Csharpminor.Eload chunk e => addr_taken_expr e
- | Csharpminor.Ecall sig e el =>
- Identset.union (addr_taken_expr e) (addr_taken_exprlist el)
| Csharpminor.Econdition e1 e2 e3 =>
Identset.union (addr_taken_expr e1)
(Identset.union (addr_taken_expr e2) (addr_taken_expr e3))
- | Csharpminor.Elet e1 e2 =>
- Identset.union (addr_taken_expr e1) (addr_taken_expr e2)
- | Csharpminor.Eletvar n => Identset.empty
- | Csharpminor.Ealloc e => addr_taken_expr e
- end
+ end.
-with addr_taken_exprlist (e: Csharpminor.exprlist): Identset.t :=
+Fixpoint addr_taken_exprlist (e: list Csharpminor.expr): Identset.t :=
match e with
- | Csharpminor.Enil => Identset.empty
- | Csharpminor.Econs e1 e2 =>
+ | nil => Identset.empty
+ | e1 :: e2 =>
Identset.union (addr_taken_expr e1) (addr_taken_exprlist e2)
end.
Fixpoint addr_taken_stmt (s: Csharpminor.stmt): Identset.t :=
match s with
| Csharpminor.Sskip => Identset.empty
- | Csharpminor.Sexpr e => addr_taken_expr e
| Csharpminor.Sassign 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 =>
+ Identset.union (addr_taken_expr e) (addr_taken_exprlist el)
| Csharpminor.Sseq s1 s2 =>
Identset.union (addr_taken_stmt s1) (addr_taken_stmt s2)
| Csharpminor.Sifthenelse e s1 s2 =>
@@ -342,20 +331,13 @@ Definition build_global_compilenv (p: Csharpminor.program) : compilenv :=
Fixpoint store_parameters
(cenv: compilenv) (params: list (ident * memory_chunk))
- {struct params} : stmt :=
+ {struct params} : res stmt :=
match params with
- | nil => Sskip
+ | nil => OK Sskip
| (id, chunk) :: rem =>
- match PMap.get id cenv with
- | Var_local chunk =>
- Sseq (Sassign id (make_cast chunk (Evar id)))
- (store_parameters cenv rem)
- | Var_stack_scalar chunk ofs =>
- Sseq (make_store chunk (make_stackaddr ofs) (Evar id))
- (store_parameters cenv rem)
- | _ =>
- Sskip (* should never happen *)
- end
+ do s1 <- var_set cenv id (Evar id);
+ do s2 <- store_parameters cenv rem;
+ OK (Sseq s1 s2)
end.
(** Translation of a Csharpminor function. We must check that the
@@ -368,12 +350,13 @@ Definition transl_function
let (cenv, stacksize) := build_compilenv gce f in
if zle stacksize Int.max_signed then
do tbody <- transl_stmt cenv f.(Csharpminor.fn_body);
+ do sparams <- store_parameters cenv f.(Csharpminor.fn_params);
OK (mkfunction
(Csharpminor.fn_sig f)
(Csharpminor.fn_params_names f)
(Csharpminor.fn_vars_names f)
stacksize
- (Sseq (store_parameters cenv f.(Csharpminor.fn_params)) tbody))
+ (Sseq sparams tbody))
else Error(msg "Cminorgen: too many local variables, stack size exceeded").
Definition transl_fundef (gce: compilenv) (f: Csharpminor.fundef): res fundef :=
diff --git a/cfrontend/Cminorgenproof.v b/cfrontend/Cminorgenproof.v
index 5bcb88016..ff10bb3ee 100644
--- a/cfrontend/Cminorgenproof.v
+++ b/cfrontend/Cminorgenproof.v
@@ -12,6 +12,7 @@ Require Import Mem.
Require Import Events.
Require Import Globalenvs.
Require Import Csharpminor.
+Require Import Op.
Require Import Cminor.
Require Import Cminorgen.
@@ -279,30 +280,6 @@ Qed.
must be normalized with respect to the memory chunk of the variable,
in the following sense. *)
-(*
-Definition val_normalized (chunk: memory_chunk) (v: val) : Prop :=
- exists v0, v = Val.load_result chunk v0.
-
-Lemma load_result_idem:
- forall chunk v,
- Val.load_result chunk (Val.load_result chunk v) =
- Val.load_result chunk v.
-Proof.
- destruct chunk; destruct v; simpl; auto.
- rewrite Int.cast8_signed_idem; auto.
- rewrite Int.cast8_unsigned_idem; auto.
- rewrite Int.cast16_signed_idem; auto.
- rewrite Int.cast16_unsigned_idem; auto.
- rewrite Float.singleoffloat_idem; auto.
-Qed.
-
-Lemma load_result_normalized:
- forall chunk v,
- val_normalized chunk v -> Val.load_result chunk v = v.
-Proof.
- intros chunk v [v0 EQ]. rewrite EQ. apply load_result_idem.
-Qed.
-*)
Lemma match_env_store_local:
forall f cenv e m1 m2 te sp lo hi id b chunk v tv,
e!id = Some(b, Vscalar chunk) ->
@@ -796,21 +773,12 @@ Qed.
(** * Correctness of Cminor construction functions *)
-Hint Resolve eval_Econst eval_Eunop eval_Ebinop eval_Eload: evalexpr.
-
Remark val_inject_val_of_bool:
forall f b, val_inject f (Val.of_bool b) (Val.of_bool b).
Proof.
intros; destruct b; unfold Val.of_bool, Vtrue, Vfalse; constructor.
Qed.
-Remark val_inject_bool_of_val:
- forall f v b tv,
- val_inject f v tv -> Val.bool_of_val v b -> Val.bool_of_val tv b.
-Proof.
- intros. inv H; inv H0; constructor; auto.
-Qed.
-
Remark val_inject_eval_compare_null:
forall f c i v,
eval_compare_null c i = Some v ->
@@ -822,6 +790,8 @@ Proof.
discriminate.
Qed.
+Hint Resolve eval_Econst eval_Eunop eval_Ebinop eval_Eload: evalexpr.
+
Ltac TrivialOp :=
match goal with
| [ |- exists y, _ /\ val_inject _ (Vint ?x) _ ] =>
@@ -838,6 +808,17 @@ Ltac TrivialOp :=
| _ => idtac
end.
+Remark eval_compare_null_inv:
+ forall c i v,
+ eval_compare_null c i = Some v ->
+ i = Int.zero /\ (c = Ceq /\ v = Vfalse \/ c = Cne /\ v = Vtrue).
+Proof.
+ intros until v. unfold eval_compare_null.
+ predSpec Int.eq Int.eq_spec i Int.zero.
+ case c; intro EQ; simplify_eq EQ; intro; subst v; tauto.
+ congruence.
+Qed.
+
(** Correctness of [transl_constant]. *)
Lemma transl_constant_correct:
@@ -865,12 +846,12 @@ Proof.
inv H; inv H0; simpl; TrivialOp.
inv H; inv H0; simpl; TrivialOp.
inv H; inv H0; simpl; TrivialOp.
- inv H0; inv H. TrivialOp.
+ inv H0; inv H. TrivialOp. unfold Vfalse; TrivialOp.
inv H0; inv H. TrivialOp. unfold Vfalse; TrivialOp.
inv H0; inv H; TrivialOp.
inv H0; inv H; TrivialOp.
inv H0; inv H; TrivialOp.
- inv H; inv H0; simpl; TrivialOp.
+ inv H0; inv H; TrivialOp.
inv H0; inv H; TrivialOp.
inv H0; inv H; TrivialOp.
inv H0; inv H; TrivialOp.
@@ -950,12 +931,11 @@ Qed.
normalized according to the given memory chunk. *)
Lemma make_cast_correct:
- forall f sp le te tm1 a t tm2 v chunk tv,
- eval_expr tge (Vptr sp Int.zero) le te tm1 a t tm2 tv ->
+ 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 (Vptr sp Int.zero) le
- te tm1 (make_cast chunk a) t tm2 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.
@@ -983,46 +963,44 @@ Proof.
Qed.
Lemma make_stackaddr_correct:
- forall sp le te tm ofs,
- eval_expr tge (Vptr sp Int.zero) le
- te tm (make_stackaddr ofs)
- E0 tm (Vptr sp (Int.repr ofs)).
+ forall sp te tm ofs,
+ eval_expr tge (Vptr sp Int.zero) te tm
+ (make_stackaddr ofs) (Vptr sp (Int.repr ofs)).
Proof.
intros; unfold make_stackaddr.
- econstructor. simpl. decEq. decEq.
+ eapply eval_Econst. simpl. decEq. decEq.
rewrite Int.add_commut. apply Int.add_zero.
Qed.
Lemma make_globaladdr_correct:
- forall sp le te tm id b,
+ forall sp te tm id b,
Genv.find_symbol tge id = Some b ->
- eval_expr tge (Vptr sp Int.zero) le
- te tm (make_globaladdr id)
- E0 tm (Vptr b Int.zero).
+ eval_expr tge (Vptr sp Int.zero) te tm
+ (make_globaladdr id) (Vptr b Int.zero).
Proof.
intros; unfold make_globaladdr.
- econstructor. simpl. rewrite H. auto.
+ eapply eval_Econst. simpl. rewrite H. auto.
Qed.
(** Correctness of [make_store]. *)
Lemma store_arg_content_inject:
- forall f sp le te tm1 a t tm2 v va chunk,
- eval_expr tge (Vptr sp Int.zero) le te tm1 a t tm2 va ->
+ forall f sp te tm a v va chunk,
+ eval_expr tge sp te tm a va ->
val_inject f v va ->
exists vb,
- eval_expr tge (Vptr sp Int.zero) le te tm1 (store_arg chunk a) t tm2 vb
+ eval_expr tge sp te tm (store_arg chunk a) vb
/\ val_content_inject f chunk v vb.
Proof.
intros.
assert (exists vb,
- eval_expr tge (Vptr sp Int.zero) le te tm1 a t tm2 vb
+ eval_expr tge sp te tm a vb
/\ val_content_inject f chunk v vb).
exists va; split. assumption. constructor. assumption.
destruct a; simpl store_arg; trivial;
destruct u; trivial;
destruct chunk; trivial;
- inv H; simpl in H12; inv H12;
+ inv H; simpl in H6; inv H6;
econstructor; (split; [eauto|idtac]);
destruct v1; simpl in H0; inv H0; try (constructor; constructor).
apply val_content_inject_8. auto. apply Int.cast8_unsigned_idem.
@@ -1033,47 +1011,43 @@ Proof.
Qed.
Lemma make_store_correct:
- forall f sp te tm1 addr tm2 tvaddr rhs tm3 tvrhs
- chunk vrhs m3 vaddr m4 t1 t2,
- eval_expr tge (Vptr sp Int.zero) nil
- te tm1 addr t1 tm2 tvaddr ->
- eval_expr tge (Vptr sp Int.zero) nil
- te tm2 rhs t2 tm3 tvrhs ->
- Mem.storev chunk m3 vaddr vrhs = Some m4 ->
- mem_inject f m3 tm3 ->
+ forall f sp te tm addr tvaddr rhs tvrhs chunk m vaddr vrhs m',
+ eval_expr tge sp te tm addr tvaddr ->
+ eval_expr tge sp te tm rhs tvrhs ->
+ Mem.storev chunk m vaddr vrhs = Some m' ->
+ mem_inject f m tm ->
val_inject f vaddr tvaddr ->
val_inject f vrhs tvrhs ->
- exists tm4,
- exec_stmt tge (Vptr sp Int.zero)
- te tm1 (make_store chunk addr rhs)
- (t1**t2) te tm4 Out_normal
- /\ mem_inject f m4 tm4
- /\ nextblock tm4 = nextblock tm3.
+ exists tm',
+ exec_stmt tge sp te tm (make_store chunk addr rhs)
+ E0 te tm' Out_normal
+ /\ mem_inject f m' tm'
+ /\ nextblock tm' = nextblock tm.
Proof.
intros. unfold make_store.
exploit store_arg_content_inject. eexact H0. eauto.
intros [tv [EVAL VCINJ]].
exploit storev_mapped_inject_1; eauto.
- intros [tm4 [STORE MEMINJ]].
- exists tm4.
- split. apply exec_Sexpr with tv. eapply eval_Estore; eauto.
- split. auto.
+ intros [tm' [STORE MEMINJ]].
+ exists tm'.
+ split. eapply exec_Sstore; eauto.
+ split. auto.
unfold storev in STORE; destruct tvaddr; try discriminate.
eapply nextblock_store; eauto.
Qed.
-(** Correctness of the variable accessors [var_get], [var_set]
- and [var_addr]. *)
+(** Correctness of the variable accessors [var_get], [var_addr],
+ and [var_set]. *)
Lemma var_get_correct:
- forall cenv id a f e te sp lo hi m cs tm b chunk v le,
+ forall cenv id a f e te sp lo hi m cs tm b chunk v,
var_get cenv id = OK a ->
match_callstack f (mkframe cenv e te sp lo hi :: cs) m.(nextblock) tm.(nextblock) m ->
mem_inject f m tm ->
eval_var_ref prog e id b chunk ->
load chunk m b 0 = Some v ->
exists tv,
- eval_expr tge (Vptr sp Int.zero) le te tm a E0 tm tv /\
+ eval_expr tge (Vptr sp Int.zero) te tm a tv /\
val_inject f v tv.
Proof.
unfold var_get; intros.
@@ -1093,7 +1067,7 @@ Proof.
unfold loadv. eexact H3.
intros [tv [LOAD INJ]].
exists tv; split.
- econstructor; eauto. eapply make_stackaddr_correct; eauto.
+ eapply eval_Eload; eauto. eapply make_stackaddr_correct; eauto.
auto.
(* var_global_scalar *)
inversion H2; [congruence|subst].
@@ -1106,17 +1080,17 @@ Proof.
generalize (loadv_inject _ _ _ _ _ _ _ H1 H12 H13).
intros [tv [LOAD INJ]].
exists tv; split.
- econstructor; eauto. eapply make_globaladdr_correct; eauto.
+ eapply eval_Eload; eauto. eapply make_globaladdr_correct; eauto.
auto.
Qed.
Lemma var_addr_correct:
- forall cenv id a f e te sp lo hi m cs tm b le,
+ forall cenv id a f e te sp lo hi m cs tm b,
match_callstack f (mkframe cenv e te sp lo hi :: cs) m.(nextblock) tm.(nextblock) m ->
var_addr cenv id = OK a ->
eval_var_addr prog e id b ->
exists tv,
- eval_expr tge (Vptr sp Int.zero) le te tm a E0 tm tv /\
+ eval_expr tge (Vptr sp Int.zero) te tm a tv /\
val_inject f (Vptr b Int.zero) tv.
Proof.
unfold var_addr; intros.
@@ -1150,62 +1124,169 @@ Proof.
Qed.
Lemma var_set_correct:
- forall cenv id rhs a f e te sp lo hi m2 cs tm2 tm1 tv b chunk v m3 t,
+ forall cenv id rhs a f e te sp lo hi m cs tm tv v m',
var_set cenv id rhs = OK a ->
- match_callstack f (mkframe cenv e te sp lo hi :: cs) m2.(nextblock) tm2.(nextblock) m2 ->
- eval_expr tge (Vptr sp Int.zero) nil te tm1 rhs t tm2 tv ->
+ match_callstack f (mkframe cenv e te sp lo hi :: cs) m.(nextblock) tm.(nextblock) m ->
+ eval_expr tge (Vptr sp Int.zero) te tm rhs tv ->
val_inject f v tv ->
- mem_inject f m2 tm2 ->
- eval_var_ref prog e id b chunk ->
- store chunk m2 b 0 v = Some m3 ->
- exists te3, exists tm3,
- exec_stmt tge (Vptr sp Int.zero) te tm1 a t te3 tm3 Out_normal /\
- mem_inject f m3 tm3 /\
- match_callstack f (mkframe cenv e te3 sp lo hi :: cs) m3.(nextblock) tm3.(nextblock) m3.
+ mem_inject f m tm ->
+ exec_assign prog e m id v m' ->
+ exists te', exists tm',
+ exec_stmt tge (Vptr sp Int.zero) te tm a E0 te' tm' Out_normal /\
+ mem_inject f m' tm' /\
+ match_callstack f (mkframe cenv e te' sp lo hi :: cs) m'.(nextblock) tm'.(nextblock) m' /\
+ (forall id', id' <> id -> te'!id' = te!id').
Proof.
unfold var_set; intros.
- assert (NEXTBLOCK: nextblock m3 = nextblock m2).
+ inv H4.
+ assert (NEXTBLOCK: nextblock m' = nextblock m).
eapply nextblock_store; eauto.
- inversion H0. subst.
- assert (match_var f id e m2 te sp cenv!!id). inversion H19; auto.
- inversion H6; subst; rewrite <- H7 in H; inversion H; subst; clear H.
+ inversion H0; subst.
+ assert (match_var f id e m te sp cenv!!id). inversion H19; auto.
+ inv H4; rewrite <- H7 in H; inv H.
(* var_local *)
- inversion H4; [subst|congruence].
- assert (b0 = b). congruence. subst b0.
- assert (chunk0 = chunk). congruence. subst chunk0.
+ inversion H5; [subst|congruence].
+ assert (b0 = b) by congruence. subst b0.
+ assert (chunk0 = chunk) by congruence. subst chunk0.
exploit make_cast_correct; eauto.
intros [tv' [EVAL INJ]].
- exists (PTree.set id tv' te); exists tm2.
+ exists (PTree.set id tv' te); exists tm.
split. eapply exec_Sassign. eauto.
split. eapply store_unmapped_inject; eauto.
- rewrite NEXTBLOCK. eapply match_callstack_store_local; eauto.
+ split. rewrite NEXTBLOCK. eapply match_callstack_store_local; eauto.
+ intros. apply PTree.gso; auto.
(* var_stack_scalar *)
+ inversion H5; [subst|congruence].
+ assert (b0 = b) by congruence. subst b0.
+ assert (chunk0 = chunk) by congruence. subst chunk0.
+ assert (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' [EVAL [MEMINJ TNEXTBLOCK]]].
+ exists te; exists tm'.
+ split. auto. split. auto.
+ split. rewrite NEXTBLOCK; rewrite TNEXTBLOCK.
+ eapply match_callstack_mapped; eauto.
+ inversion H9; congruence.
+ auto.
+ (* var_global_scalar *)
+ inversion H5; [congruence|subst].
+ assert (chunk0 = chunk) by congruence. subst chunk0.
+ assert (storev chunk m (Vptr b Int.zero) v = Some m'). assumption.
+ assert (match_globalenvs f). eapply match_callstack_match_globalenvs; eauto.
+ inversion H12. destruct (mg_symbols0 _ _ H4) as [A B].
+ exploit make_store_correct.
+ eapply make_globaladdr_correct; eauto.
+ eauto. eauto. eauto. eauto. eauto.
+ intros [tm' [EVAL [MEMINJ TNEXTBLOCK]]].
+ exists te; exists tm'.
+ split. auto. split. auto.
+ split. rewrite NEXTBLOCK; rewrite TNEXTBLOCK.
+ eapply match_callstack_mapped; eauto. congruence.
+ auto.
+Qed.
+
+Lemma match_env_extensional':
+ forall f cenv e m te1 sp lo hi,
+ match_env f cenv e m te1 sp lo hi ->
+ forall te2,
+ (forall id,
+ match cenv!!id with
+ | Var_local _ => te2!id = te1!id
+ | _ => True
+ end) ->
+ match_env f cenv e m te2 sp lo hi.
+Proof.
+ induction 1; intros; econstructor; eauto.
+ intros. generalize (me_vars0 id); intro.
+ inversion H0; econstructor; eauto.
+ generalize (H id). rewrite <- H1. congruence.
+Qed.
+
+
+Lemma match_callstack_extensional:
+ forall f cenv e te1 te2 sp lo hi cs bound tbound m,
+ (forall id,
+ match cenv!!id with
+ | Var_local _ => te2!id = te1!id
+ | _ => True
+ end) ->
+ match_callstack f (mkframe cenv e te1 sp lo hi :: cs) bound tbound m ->
+ match_callstack f (mkframe cenv e te2 sp lo hi :: cs) bound tbound m.
+Proof.
+ intros. inv H0. constructor; auto.
+ apply match_env_extensional' with te1; auto.
+Qed.
+
+Lemma var_set_self_correct:
+ forall cenv id a f e te sp lo hi m cs tm tv v m',
+ var_set cenv id (Evar id) = OK a ->
+ match_callstack f (mkframe cenv e te sp lo hi :: cs) m.(nextblock) tm.(nextblock) m ->
+ val_inject f v tv ->
+ mem_inject f m tm ->
+ exec_assign prog e m id v m' ->
+ exists te', exists tm',
+ exec_stmt tge (Vptr sp Int.zero) (PTree.set id tv te) tm a E0 te' tm' Out_normal /\
+ mem_inject f m' tm' /\
+ match_callstack f (mkframe cenv e te' sp lo hi :: cs) m'.(nextblock) tm'.(nextblock) m'.
+Proof.
+ unfold var_set; intros.
+ inv H3.
+ assert (NEXTBLOCK: nextblock m' = nextblock m).
+ eapply nextblock_store; eauto.
+ inversion H0; subst.
+ assert (EVAR: eval_expr tge (Vptr sp Int.zero) (PTree.set id tv te) tm (Evar id) tv).
+ constructor. apply PTree.gss.
+ assert (match_var f id e m te sp cenv!!id). inversion H18; auto.
+ inv H3; rewrite <- H6 in H; inv H.
+ (* var_local *)
inversion H4; [subst|congruence].
- assert (b0 = b). congruence. subst b0.
- assert (chunk0 = chunk). congruence. subst chunk0.
- assert (storev chunk m2 (Vptr b Int.zero) v = Some m3). assumption.
+ assert (b0 = b) by congruence. subst b0.
+ assert (chunk0 = chunk) by congruence. subst chunk0.
+ exploit make_cast_correct; eauto.
+ intros [tv' [EVAL INJ]].
+ exists (PTree.set id tv' (PTree.set id tv te)); exists tm.
+ split. eapply exec_Sassign. eauto.
+ split. eapply store_unmapped_inject; eauto.
+ rewrite NEXTBLOCK.
+ apply match_callstack_extensional with (PTree.set id tv' te).
+ intros. destruct (cenv!!id0); auto.
+ repeat rewrite PTree.gsspec. destruct (peq id0 id); auto.
+ eapply match_callstack_store_local; eauto.
+ (* var_stack_scalar *)
+ inversion H4; [subst|congruence].
+ assert (b0 = b) by congruence. subst b0.
+ assert (chunk0 = chunk) by congruence. subst chunk0.
+ assert (storev chunk m (Vptr b Int.zero) v = Some m'). assumption.
exploit make_store_correct.
eapply make_stackaddr_correct.
eauto. eauto. eauto. eauto. eauto.
- rewrite E0_left. intros [tm3 [EVAL [MEMINJ TNEXTBLOCK]]].
- exists te; exists tm3.
+ intros [tm' [EVAL [MEMINJ TNEXTBLOCK]]].
+ exists (PTree.set id tv te); exists tm'.
split. auto. split. auto.
rewrite NEXTBLOCK; rewrite TNEXTBLOCK.
+ apply match_callstack_extensional with te.
+ intros. caseEq (cenv!!id0); intros; auto.
+ rewrite PTree.gsspec. destruct (peq id0 id). congruence. auto.
eapply match_callstack_mapped; eauto.
- inversion H9; congruence.
+ inversion H8; congruence.
(* var_global_scalar *)
inversion H4; [congruence|subst].
- assert (chunk0 = chunk). congruence. subst chunk0.
- assert (storev chunk m2 (Vptr b Int.zero) v = Some m3). assumption.
+ assert (chunk0 = chunk) by congruence. subst chunk0.
+ assert (storev chunk m (Vptr b Int.zero) v = Some m'). assumption.
assert (match_globalenvs f). eapply match_callstack_match_globalenvs; eauto.
- inversion H13. destruct (mg_symbols0 _ _ H10) as [A B].
+ inversion H11. destruct (mg_symbols0 _ _ H3) as [A B].
exploit make_store_correct.
eapply make_globaladdr_correct; eauto.
eauto. eauto. eauto. eauto. eauto.
- rewrite E0_left. intros [tm3 [EVAL [MEMINJ TNEXTBLOCK]]].
- exists te; exists tm3.
+ intros [tm' [EVAL [MEMINJ TNEXTBLOCK]]].
+ exists (PTree.set id tv te); exists tm'.
split. auto. split. auto.
rewrite NEXTBLOCK; rewrite TNEXTBLOCK.
+ apply match_callstack_extensional with te.
+ intros. caseEq (cenv!!id0); intros; auto.
+ rewrite PTree.gsspec. destruct (peq id0 id). congruence. auto.
eapply match_callstack_mapped; eauto. congruence.
Qed.
@@ -1501,79 +1582,42 @@ Qed.
Lemma store_parameters_correct:
forall e m1 params vl m2,
bind_parameters e m1 params vl m2 ->
- forall f te1 cenv sp lo hi cs tm1,
+ forall s f te1 cenv sp lo hi cs tm1,
vars_vals_match f params vl te1 ->
list_norepet (List.map (@fst ident memory_chunk) params) ->
mem_inject f m1 tm1 ->
match_callstack f (mkframe cenv e te1 sp lo hi :: cs) m1.(nextblock) tm1.(nextblock) m1 ->
+ store_parameters cenv params = OK s ->
exists te2, exists tm2,
exec_stmt tge (Vptr sp Int.zero)
- te1 tm1 (store_parameters cenv params)
+ te1 tm1 s
E0 te2 tm2 Out_normal
/\ mem_inject f m2 tm2
/\ match_callstack f (mkframe cenv e te2 sp lo hi :: cs) m2.(nextblock) tm2.(nextblock) m2.
Proof.
induction 1.
(* base case *)
- intros; simpl. exists te1; exists tm1. split. constructor. tauto.
+ intros; simpl. monadInv H3.
+ exists te1; exists tm1. split. constructor. tauto.
(* inductive case *)
- intros until tm1. intros VVM NOREPET MINJ MATCH. simpl.
+ intros until tm1. intros VVM NOREPET MINJ MATCH STOREP.
+ monadInv STOREP.
inversion VVM. subst f0 id0 chunk0 vars v vals te.
- inversion MATCH. subst f0 cenv0 e0 te sp0 lo0 hi0 cs0 bound tbound m0.
- inversion H18.
inversion NOREPET. subst hd tl.
- assert (NEXT: nextblock m1 = nextblock m).
- eapply nextblock_store; eauto.
- generalize (me_vars0 id). intro. inversion H2; subst.
- (* cenv!!id = Var_local chunk *)
- assert (b0 = b). congruence. subst b0.
- assert (chunk0 = chunk). congruence. subst chunk0.
- assert (v' = tv). congruence. subst v'.
- exploit make_cast_correct.
- apply eval_Evar with (id := id). eauto.
- eexact H10.
- intros [tv' [EVAL1 VINJ1]].
- set (te2 := PTree.set id tv' te1).
- assert (VVM2: vars_vals_match f params vl te2).
+ exploit var_set_correct; eauto.
+ constructor; auto.
+ 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. unfold te2; apply PTree.gso. red; intro; subst id0.
- elim H4. change id with (fst (id, lv)). apply List.in_map; auto.
- exploit store_unmapped_inject; eauto. intro MINJ2.
- exploit match_callstack_store_local; eauto.
- fold te2; rewrite <- NEXT; intro MATCH2.
+ intros. apply UNCHANGED1. red; intro; subst id0.
+ elim H4. change id with (fst (id, lv)). apply List.in_map. auto.
exploit IHbind_parameters; eauto.
- intros [te3 [tm3 [EXEC3 [MINJ3 MATCH3]]]].
- exists te3; exists tm3.
- (* execution *)
- split. apply exec_Sseq_continue with E0 te2 tm1 E0.
- unfold te2. constructor. eassumption. assumption. traceEq.
- (* meminj & match_callstack *)
- tauto.
-
- (* cenv!!id = Var_stack_scalar *)
- assert (b0 = b). congruence. subst b0.
- assert (chunk0 = chunk). congruence. subst chunk0.
- exploit make_store_correct.
- eapply make_stackaddr_correct.
- apply eval_Evar with (id := id).
- eauto. 2:eauto. 2:eauto. unfold storev; eexact H0. eauto.
- intros [tm2 [EVAL3 [MINJ2 NEXT1]]].
- exploit match_callstack_mapped.
- eexact MATCH. 2:eauto. inversion H7. congruence.
- rewrite <- NEXT; rewrite <- NEXT1; intro MATCH2.
- exploit IHbind_parameters; eauto.
- intros [te3 [tm3 [EVAL4 [MINJ3 MATCH3]]]].
+ intros [te3 [tm3 [EXEC2 [MINJ2 MATCH2]]]].
exists te3; exists tm3.
- (* execution *)
- split. apply exec_Sseq_continue with (E0**E0) te1 tm2 E0.
- auto. assumption. traceEq.
- (* meminj & match_callstack *)
- tauto.
-
- (* Impossible cases on cenv!!id *)
- congruence.
- congruence.
- congruence.
+ split. econstructor; eauto.
+ auto.
Qed.
Lemma vars_vals_match_holds_1:
@@ -1634,7 +1678,7 @@ Qed.
and initialize the blocks corresponding to function parameters). *)
Lemma function_entry_ok:
- forall fn m e m1 lb vargs m2 f cs tm cenv sz tm1 sp tvargs,
+ forall fn m e m1 lb vargs m2 f cs tm cenv sz tm1 sp tvargs s,
alloc_variables empty_env m (fn_variables fn) e m1 lb ->
bind_parameters e m1 fn.(Csharpminor.fn_params) vargs m2 ->
match_callstack f cs m.(nextblock) tm.(nextblock) m ->
@@ -1646,9 +1690,10 @@ Lemma function_entry_ok:
val_list_inject f vargs tvargs ->
mem_inject f m tm ->
list_norepet (fn_params_names fn ++ fn_vars_names fn) ->
+ store_parameters cenv fn.(Csharpminor.fn_params) = OK s ->
exists f2, exists te2, exists tm2,
exec_stmt tge (Vptr sp Int.zero)
- te tm1 (store_parameters cenv fn.(Csharpminor.fn_params))
+ te tm1 s
E0 te2 tm2 Out_normal
/\ mem_inject f2 m2 tm2
/\ inject_incr f f2
@@ -1669,7 +1714,7 @@ Proof.
exploit store_parameters_correct.
eauto. eauto.
unfold fn_params_names in H7. eapply list_norepet_append_left; eauto.
- eexact MINJ1. eauto.
+ eexact MINJ1. eauto. eauto.
intros [te2 [tm2 [EXEC [MINJ2 MATCH2]]]].
exists f1; exists te2; exists tm2.
split; auto. split; auto. split; auto. split; auto.
@@ -1681,64 +1726,101 @@ Qed.
(** The proof of semantic preservation uses simulation diagrams of the
following form:
<<
- le, e, m1, a --------------- tle, sp, te1, tm1, ta
- | |
+ e, m1, s ----------------- sp, te1, tm1, ts
| |
+ t| |t
v v
- le, e, m2, v --------------- tle, sp, te2, tm2, tv
+ e, m2, out --------------- sp, te2, tm2, tout
>>
- where [ta] is the Cminor expression obtained by translating the
- Csharpminor expression [a]. The left vertical arrow is an evaluation
- of a Csharpminor expression. The right vertical arrow is an evaluation
- of a Cminor expression. The precondition (top vertical bar)
+ where [ts] is the Cminor statement obtained by translating the
+ Csharpminor statement [s]. The left vertical arrow is an execution
+ of a Csharpminor statement. The right vertical arrow is an execution
+ of a Cminor statement. The precondition (top vertical bar)
includes a [mem_inject] relation between the memory states [m1] and [tm1],
- a [val_list_inject] relation between the let environments [le] and [tle],
and a [match_callstack] relation for any callstack having
[e], [te1], [sp] as top frame. The postcondition (bottom vertical bar)
is the existence of a memory injection [f2] that extends the injection
[f1] we started with, preserves the [match_callstack] relation for
the transformed callstack at the final state, and validates a
- [val_inject] relation between the result values [v] and [tv].
+ [outcome_inject] relation between the outcomes [out] and [tout].
+*)
- We capture these diagrams by the following predicates, parameterized
- over the Csharpminor executions, which will serve as induction
- hypotheses in the proof of simulation. *)
+(** ** Semantic preservation for expressions *)
-Definition eval_expr_prop
- (le: Csharpminor.letenv) (e: Csharpminor.env) (m1: mem) (a: Csharpminor.expr) (t: trace) (m2: mem) (v: val) : Prop :=
- forall cenv ta f1 tle te tm1 sp lo hi cs
- (TR: transl_expr cenv a = OK ta)
- (LINJ: val_list_inject f1 le tle)
- (MINJ: mem_inject f1 m1 tm1)
- (MATCH: match_callstack f1
- (mkframe cenv e te sp lo hi :: cs)
- m1.(nextblock) tm1.(nextblock) m1),
- exists f2, exists tm2, exists tv,
- eval_expr tge (Vptr sp Int.zero) tle te tm1 ta t tm2 tv
- /\ val_inject f2 v tv
- /\ mem_inject f2 m2 tm2
- /\ inject_incr f1 f2
- /\ match_callstack f2
- (mkframe cenv e te sp lo hi :: cs)
- m2.(nextblock) tm2.(nextblock) m2.
+Remark bool_of_val_inject:
+ forall f v tv b,
+ Val.bool_of_val v b -> val_inject f v tv -> Val.bool_of_val tv b.
+Proof.
+ intros. inv H0; inv H; constructor; auto.
+Qed.
-Definition eval_exprlist_prop
- (le: Csharpminor.letenv) (e: Csharpminor.env) (m1: mem) (al: Csharpminor.exprlist) (t: trace) (m2: mem) (vl: list val) : Prop :=
- forall cenv tal f1 tle te tm1 sp lo hi cs
- (TR: transl_exprlist cenv al = OK tal)
- (LINJ: val_list_inject f1 le tle)
- (MINJ: mem_inject f1 m1 tm1)
- (MATCH: match_callstack f1
- (mkframe cenv e te sp lo hi :: cs)
- m1.(nextblock) tm1.(nextblock) m1),
- exists f2, exists tm2, exists tvl,
- eval_exprlist tge (Vptr sp Int.zero) tle te tm1 tal t tm2 tvl
- /\ val_list_inject f2 vl tvl
- /\ mem_inject f2 m2 tm2
- /\ inject_incr f1 f2
- /\ match_callstack f2
- (mkframe cenv e te sp lo hi :: cs)
- m2.(nextblock) tm2.(nextblock) m2.
+Lemma transl_expr_correct:
+ forall f m tm cenv e te sp lo hi cs
+ (MINJ: mem_inject f m tm)
+ (MATCH: match_callstack f
+ (mkframe cenv e te sp lo hi :: cs)
+ m.(nextblock) tm.(nextblock) m),
+ forall a v,
+ Csharpminor.eval_expr prog e m a v ->
+ forall ta
+ (TR: transl_expr cenv a = OK ta),
+ exists tv,
+ eval_expr tge (Vptr sp Int.zero) te tm ta tv
+ /\ val_inject f v tv.
+Proof.
+ induction 3; intros; simpl in TR; try (monadInv TR).
+ (* Evar *)
+ eapply var_get_correct; eauto.
+ (* Eaddrof *)
+ eapply var_addr_correct; eauto.
+ (* Econst *)
+ exploit transl_constant_correct; eauto. intros [tv [A B]].
+ exists tv; split. constructor; eauto. eauto.
+ (* Eunop *)
+ exploit IHeval_expr; eauto. intros [tv1 [EVAL1 INJ1]].
+ exploit eval_unop_compat; eauto. intros [tv [EVAL INJ]].
+ exists tv; split. econstructor; eauto. auto.
+ (* Ebinop *)
+ exploit IHeval_expr1; eauto. intros [tv1 [EVAL1 INJ1]].
+ exploit IHeval_expr2; eauto. intros [tv2 [EVAL2 INJ2]].
+ exploit eval_binop_compat; eauto. intros [tv [EVAL INJ]].
+ exists tv; split. econstructor; eauto. auto.
+ (* Eload *)
+ exploit IHeval_expr; eauto. intros [tv1 [EVAL1 INJ1]].
+ exploit loadv_inject; eauto. intros [tv [LOAD INJ]].
+ exists tv; split. econstructor; eauto. auto.
+ (* Econdition *)
+ exploit IHeval_expr1; eauto. intros [tv1 [EVAL1 INJ1]].
+ assert (transl_expr cenv (if vb1 then b else c) =
+ OK (if vb1 then x0 else x1)).
+ destruct vb1; auto.
+ exploit IHeval_expr2; eauto. intros [tv2 [EVAL2 INJ2]].
+ exists tv2; split. eapply eval_Econdition; eauto.
+ eapply bool_of_val_inject; eauto. auto.
+Qed.
+
+Lemma transl_exprlist_correct:
+ forall f m tm cenv e te sp lo hi cs
+ (MINJ: mem_inject f m tm)
+ (MATCH: match_callstack f
+ (mkframe cenv e te sp lo hi :: cs)
+ m.(nextblock) tm.(nextblock) m),
+ forall a v,
+ Csharpminor.eval_exprlist prog e m a v ->
+ forall ta
+ (TR: transl_exprlist cenv a = OK ta),
+ exists tv,
+ eval_exprlist tge (Vptr sp Int.zero) te tm ta tv
+ /\ val_list_inject f v tv.
+Proof.
+ induction 3; intros; monadInv TR.
+ exists (@nil val); split. constructor. constructor.
+ exploit transl_expr_correct; eauto. intros [tv1 [EVAL1 VINJ1]].
+ exploit IHeval_exprlist; eauto. intros [tv2 [EVAL2 VINJ2]].
+ exists (tv1 :: tv2); split. constructor; auto. constructor; auto.
+Qed.
+
+(** ** Semantic preservation for statements and functions *)
Definition eval_funcall_prop
(m1: mem) (fn: Csharpminor.fundef) (args: list val) (t: trace) (m2: mem) (res: val) : Prop :=
@@ -1783,316 +1865,12 @@ Definition exec_stmt_prop
(mkframe cenv e te2 sp lo hi :: cs)
m2.(nextblock) tm2.(nextblock) m2.
+(* Check (Csharpminor.eval_funcall_ind2 prog eval_funcall_prop exec_stmt_prop). *)
+
(** There are as many cases in the inductive proof as there are evaluation
rules in the Csharpminor semantics. We treat each case as a separate
lemma. *)
-Lemma transl_expr_Evar_correct:
- forall (le : Csharpminor.letenv)
- (e : Csharpminor.env) (m : mem) (id : positive)
- (b : block) (chunk : memory_chunk) (v : val),
- eval_var_ref prog e id b chunk ->
- load chunk m b 0 = Some v ->
- eval_expr_prop le e m (Csharpminor.Evar id) E0 m v.
-Proof.
- intros; red; intros. unfold transl_expr in TR.
- exploit var_get_correct; eauto.
- intros [tv [EVAL VINJ]].
- exists f1; exists tm1; exists tv; intuition eauto.
-Qed.
-
-Lemma transl_expr_Eaddrof_correct:
- forall (le : Csharpminor.letenv)
- (e : Csharpminor.env) (m : mem) (id : positive)
- (b : block),
- eval_var_addr prog e id b ->
- eval_expr_prop le e m (Eaddrof id) E0 m (Vptr b Int.zero).
-Proof.
- intros; red; intros. simpl in TR.
- exploit var_addr_correct; eauto.
- intros [tv [EVAL VINJ]].
- exists f1; exists tm1; exists tv. intuition eauto.
-Qed.
-
-Lemma transl_expr_Econst_correct:
- forall (le : Csharpminor.letenv) (e : Csharpminor.env) (m : mem)
- (cst : Csharpminor.constant) (v : val),
- Csharpminor.eval_constant cst = Some v ->
- eval_expr_prop le e m (Csharpminor.Econst cst) E0 m v.
-Proof.
- intros; red; intros; monadInv TR.
- exploit transl_constant_correct; eauto.
- intros [tv [EVAL VINJ]].
- exists f1; exists tm1; exists tv. intuition eauto.
- constructor; eauto.
-Qed.
-
-Lemma transl_expr_Eunop_correct:
- forall (le : Csharpminor.letenv) (e : Csharpminor.env) (m : mem)
- (op : unary_operation) (a : Csharpminor.expr) (t : trace)
- (m1 : mem) (v1 v : val),
- Csharpminor.eval_expr prog le e m a t m1 v1 ->
- eval_expr_prop le e m a t m1 v1 ->
- Csharpminor.eval_unop op v1 = Some v ->
- eval_expr_prop le e m (Csharpminor.Eunop op a) t m1 v.
-Proof.
- intros; red; intros. monadInv TR.
- exploit H0; eauto.
- intros [f2 [tm2 [tvl [EVAL1 [VINJ1 [MINJ1 [INCR1 MATCH1]]]]]]].
- exploit eval_unop_compat; eauto. intros [tv [EVAL VINJ]].
- exists f2; exists tm2; exists tv; intuition.
- econstructor; eauto.
-Qed.
-
-Lemma transl_expr_Ebinop_correct:
- forall (le : Csharpminor.letenv) (e : Csharpminor.env) (m : mem)
- (op : binary_operation) (a1 a2 : Csharpminor.expr) (t1 : trace)
- (m1 : mem) (v1 : val) (t2 : trace) (m2 : mem) (v2 : val)
- (t : trace) (v : val),
- Csharpminor.eval_expr prog le e m a1 t1 m1 v1 ->
- eval_expr_prop le e m a1 t1 m1 v1 ->
- Csharpminor.eval_expr prog le e m1 a2 t2 m2 v2 ->
- eval_expr_prop le e m1 a2 t2 m2 v2 ->
- Csharpminor.eval_binop op v1 v2 m2 = Some v ->
- t = t1 ** t2 ->
- eval_expr_prop le e m (Csharpminor.Ebinop op a1 a2) t m2 v.
-Proof.
- intros; red; intros. monadInv TR.
- exploit H0; eauto.
- intros [f2 [tm2 [tvl [EVAL1 [VINJ1 [MINJ1 [INCR1 MATCH1]]]]]]].
- exploit H2.
- eauto. eapply val_list_inject_incr; eauto. eauto. eauto.
- intros [f3 [tm3 [tv2 [EVAL2 [VINJ2 [MINJ2 [INCR2 MATCH2]]]]]]].
- exploit eval_binop_compat.
- eauto. eapply val_inject_incr; eauto. eauto. eauto.
- intros [tv [EVAL VINJ]].
- exists f3; exists tm3; exists tv; intuition.
- econstructor; eauto.
- eapply inject_incr_trans; eauto.
-Qed.
-
-Lemma transl_expr_Eload_correct:
- forall (le : Csharpminor.letenv) (e : Csharpminor.env) (m : mem)
- (chunk : memory_chunk) (a : Csharpminor.expr) (t: trace) (m1 : mem)
- (v1 v : val),
- Csharpminor.eval_expr prog le e m a t m1 v1 ->
- eval_expr_prop le e m a t m1 v1 ->
- loadv chunk m1 v1 = Some v ->
- eval_expr_prop le e m (Csharpminor.Eload chunk a) t m1 v.
-Proof.
- intros; red; intros.
- monadInv TR.
- exploit H0; eauto.
- intros [f2 [tm2 [tv1 [EVAL [VINJ1 [MINJ2 [INCR MATCH2]]]]]]].
- exploit loadv_inject; eauto.
- intros [tv [TLOAD VINJ]].
- exists f2; exists tm2; exists tv.
- intuition.
- econstructor; eauto.
-Qed.
-
-Lemma transl_expr_Ecall_correct:
- forall (le : Csharpminor.letenv) (e : Csharpminor.env) (m : mem)
- (sig : signature) (a : Csharpminor.expr) (bl : Csharpminor.exprlist)
- (t1: trace) (m1: mem) (t2: trace) (m2: mem) (t3: trace) (m3: mem)
- (vf : val) (vargs : list val) (vres : val)
- (f : Csharpminor.fundef) (t: trace),
- Csharpminor.eval_expr prog le e m a t1 m1 vf ->
- eval_expr_prop le e m a t1 m1 vf ->
- Csharpminor.eval_exprlist prog le e m1 bl t2 m2 vargs ->
- eval_exprlist_prop le e m1 bl t2 m2 vargs ->
- Genv.find_funct ge vf = Some f ->
- Csharpminor.funsig f = sig ->
- Csharpminor.eval_funcall prog m2 f vargs t3 m3 vres ->
- eval_funcall_prop m2 f vargs t3 m3 vres ->
- t = t1 ** t2 ** t3 ->
- eval_expr_prop le e m (Csharpminor.Ecall sig a bl) t m3 vres.
-Proof.
- intros;red;intros. monadInv TR.
- exploit H0; eauto.
- intros [f2 [tm2 [tv1 [EVAL1 [VINJ1 [MINJ1 [INCR1 MATCH1]]]]]]].
- exploit H2.
- eauto. eapply val_list_inject_incr; eauto. eauto. eauto.
- intros [f3 [tm3 [tv2 [EVAL2 [VINJ2 [MINJ2 [INCR2 MATCH2]]]]]]].
- assert (tv1 = vf).
- elim (Genv.find_funct_inv H3). intros bf VF. rewrite VF in H3.
- rewrite Genv.find_funct_find_funct_ptr in H3.
- generalize (Genv.find_funct_ptr_negative H3). intro.
- assert (match_globalenvs f2). eapply match_callstack_match_globalenvs; eauto.
- generalize (mg_functions _ H7 _ H4). intro.
- rewrite VF in VINJ1. inversion VINJ1. subst vf.
- decEq. congruence.
- subst ofs2. replace x1 with 0. reflexivity. congruence.
- subst tv1. elim (functions_translated _ _ H3). intros tf [FIND TRF].
- exploit H6; eauto.
- intros [f4 [tm4 [tres [EVAL3 [VINJ3 [MINJ3 [INCR3 MATCH3]]]]]]].
- exists f4; exists tm4; exists tres. intuition.
- eapply eval_Ecall; eauto.
- apply sig_preserved; auto.
- apply inject_incr_trans with f2; auto.
- apply inject_incr_trans with f3; auto.
-Qed.
-
-Lemma transl_expr_Econdition_true_correct:
- forall (le : Csharpminor.letenv) (e : Csharpminor.env) (m : mem)
- (a b c : Csharpminor.expr) (t1: trace) (m1 : mem) (v1 : val)
- (t2: trace) (m2 : mem) (v2 : val) (t: trace),
- Csharpminor.eval_expr prog le e m a t1 m1 v1 ->
- eval_expr_prop le e m a t1 m1 v1 ->
- Val.is_true v1 ->
- Csharpminor.eval_expr prog le e m1 b t2 m2 v2 ->
- eval_expr_prop le e m1 b t2 m2 v2 ->
- t = t1 ** t2 ->
- eval_expr_prop le e m (Csharpminor.Econdition a b c) t m2 v2.
-Proof.
- intros; red; intros. monadInv TR.
- exploit H0; eauto.
- intros [f2 [tm2 [tv1 [EVAL1 [VINJ1 [MINJ1 [INCR1 MATCH1]]]]]]].
- exploit H3.
- eauto. eapply val_list_inject_incr; eauto. eauto. eauto.
- intros [f3 [tm3 [tv2 [EVAL2 [VINJ2 [MINJ2 [INCR2 MATCH2]]]]]]].
- exists f3; exists tm3; exists tv2.
- intuition.
- eapply eval_Econdition with (b1 := true); eauto.
- eapply val_inject_bool_of_val; eauto. apply Val.bool_of_true_val; eauto.
- eapply inject_incr_trans; eauto.
-Qed.
-
-Lemma transl_expr_Econdition_false_correct:
- forall (le : Csharpminor.letenv) (e : Csharpminor.env) (m : mem)
- (a b c : Csharpminor.expr) (t1: trace) (m1 : mem) (v1 : val)
- (t2: trace) (m2 : mem) (v2 : val) (t: trace),
- Csharpminor.eval_expr prog le e m a t1 m1 v1 ->
- eval_expr_prop le e m a t1 m1 v1 ->
- Val.is_false v1 ->
- Csharpminor.eval_expr prog le e m1 c t2 m2 v2 ->
- eval_expr_prop le e m1 c t2 m2 v2 ->
- t = t1 ** t2 ->
- eval_expr_prop le e m (Csharpminor.Econdition a b c) t m2 v2.
-Proof.
- intros; red; intros. monadInv TR.
- exploit H0; eauto.
- intros [f2 [tm2 [tv1 [EVAL1 [VINJ1 [MINJ1 [INCR1 MATCH1]]]]]]].
- exploit H3.
- eauto. eapply val_list_inject_incr; eauto. eauto. eauto.
- intros [f3 [tm3 [tv2 [EVAL2 [VINJ2 [MINJ2 [INCR2 MATCH2]]]]]]].
- exists f3; exists tm3; exists tv2.
- intuition.
- eapply eval_Econdition with (b1 := false); eauto.
- eapply val_inject_bool_of_val; eauto. apply Val.bool_of_false_val; eauto.
- eapply inject_incr_trans; eauto.
-Qed.
-
-Lemma transl_expr_Elet_correct:
- forall (le : Csharpminor.letenv) (e : Csharpminor.env) (m : mem)
- (a b : Csharpminor.expr) (t1: trace) (m1 : mem) (v1 : val)
- (t2: trace) (m2 : mem) (v2 : val) (t: trace),
- Csharpminor.eval_expr prog le e m a t1 m1 v1 ->
- eval_expr_prop le e m a t1 m1 v1 ->
- Csharpminor.eval_expr prog (v1 :: le) e m1 b t2 m2 v2 ->
- eval_expr_prop (v1 :: le) e m1 b t2 m2 v2 ->
- t = t1 ** t2 ->
- eval_expr_prop le e m (Csharpminor.Elet a b) t m2 v2.
-Proof.
- intros; red; intros. monadInv TR.
- exploit H0; eauto.
- intros [f2 [tm2 [tv1 [EVAL1 [VINJ1 [MINJ1 [INCR1 MATCH1]]]]]]].
- exploit H2.
- eauto.
- constructor. eauto. eapply val_list_inject_incr; eauto.
- eauto. eauto.
- intros [f3 [tm3 [tv2 [EVAL2 [VINJ2 [MINJ2 [INCR2 MATCH2]]]]]]].
- exists f3; exists tm3; exists tv2.
- intuition.
- eapply eval_Elet; eauto.
- eapply inject_incr_trans; eauto.
-Qed.
-
-Remark val_list_inject_nth:
- forall f l1 l2, val_list_inject f l1 l2 ->
- forall n v1, nth_error l1 n = Some v1 ->
- exists v2, nth_error l2 n = Some v2 /\ val_inject f v1 v2.
-Proof.
- induction 1; destruct n; simpl; intros.
- discriminate. discriminate.
- injection H1; intros; subst v. exists v'; split; auto.
- eauto.
-Qed.
-
-Lemma transl_expr_Eletvar_correct:
- forall (le : list val) (e : Csharpminor.env) (m : mem) (n : nat)
- (v : val),
- nth_error le n = Some v ->
- eval_expr_prop le e m (Csharpminor.Eletvar n) E0 m v.
-Proof.
- intros; red; intros. monadInv TR.
- exploit val_list_inject_nth; eauto. intros [tv [A B]].
- exists f1; exists tm1; exists tv.
- intuition.
- eapply eval_Eletvar; auto.
-Qed.
-
-Lemma transl_expr_Ealloc_correct:
- forall (le: list val) (e: Csharpminor.env) (m1: mem) (a: Csharpminor.expr)
- (t: trace) (m2: mem) (n: int) (m3: mem) (b: block),
- Csharpminor.eval_expr prog le e m1 a t m2 (Vint n) ->
- eval_expr_prop le e m1 a t m2 (Vint n) ->
- Mem.alloc m2 0 (Int.signed n) = (m3, b) ->
- eval_expr_prop le e m1 (Csharpminor.Ealloc a) t m3 (Vptr b Int.zero).
-Proof.
- intros; red; intros. monadInv TR.
- exploit H0; eauto.
- intros [f2 [tm2 [tv1 [EVAL1 [VINJ1 [MINJ2 [INCR2 MATCH2]]]]]]].
- inversion VINJ1. subst tv1 i.
- caseEq (alloc tm2 0 (Int.signed n)). intros tm3 tb TALLOC.
- assert (LB: Int.min_signed <= 0). compute. congruence.
- assert (HB: Int.signed n <= Int.max_signed).
- generalize (Int.signed_range n); omega.
- exploit alloc_parallel_inject; eauto.
- intros [MINJ3 INCR3].
- exists (extend_inject b (Some (tb, 0)) f2);
- exists tm3; exists (Vptr tb Int.zero).
- split. econstructor; eauto.
- split. econstructor. unfold extend_inject, eq_block. rewrite zeq_true. reflexivity.
- reflexivity.
- split. assumption.
- split. eapply inject_incr_trans; eauto.
- eapply match_callstack_alloc; eauto.
-Qed.
-
-Lemma transl_exprlist_Enil_correct:
- forall (le : Csharpminor.letenv) (e : Csharpminor.env) (m : mem),
- eval_exprlist_prop le e m Csharpminor.Enil E0 m nil.
-Proof.
- intros; red; intros. monadInv TR.
- exists f1; exists tm1; exists (@nil val).
- intuition. constructor.
-Qed.
-
-Lemma transl_exprlist_Econs_correct:
- forall (le : Csharpminor.letenv) (e : Csharpminor.env) (m : mem)
- (a : Csharpminor.expr) (bl : Csharpminor.exprlist)
- (t1: trace) (m1 : mem) (v : val)
- (t2: trace) (m2 : mem) (vl : list val) (t: trace),
- Csharpminor.eval_expr prog le e m a t1 m1 v ->
- eval_expr_prop le e m a t1 m1 v ->
- Csharpminor.eval_exprlist prog le e m1 bl t2 m2 vl ->
- eval_exprlist_prop le e m1 bl t2 m2 vl ->
- t = t1 ** t2 ->
- eval_exprlist_prop le e m (Csharpminor.Econs a bl) t m2 (v :: vl).
-Proof.
- intros; red; intros. monadInv TR.
- exploit H0; eauto.
- intros [f2 [tm2 [tv1 [EVAL1 [VINJ1 [MINJ2 [INCR2 MATCH2]]]]]]].
- exploit H2.
- eauto. eapply val_list_inject_incr; eauto. eauto. eauto.
- intros [f3 [tm3 [tv2 [EVAL2 [VINJ2 [MINJ3 [INCR3 MATCH3]]]]]]].
- exists f3; exists tm3; exists (tv1 :: tv2).
- intuition. econstructor; eauto.
- constructor. eapply val_inject_incr; eauto. auto.
- eapply inject_incr_trans; eauto.
-Qed.
-
Lemma transl_funcall_internal_correct:
forall (m : mem) (f : Csharpminor.function) (vargs : list val)
(e : Csharpminor.env) (m1 : mem) (lb : list block) (m2: mem)
@@ -2176,77 +1954,104 @@ Proof.
intuition. constructor. constructor.
Qed.
-Lemma transl_stmt_Sexpr_correct:
- forall (e : Csharpminor.env) (m : mem) (a : Csharpminor.expr)
- (t: trace) (m1 : mem) (v : val),
- Csharpminor.eval_expr prog nil e m a t m1 v ->
- eval_expr_prop nil e m a t m1 v ->
- exec_stmt_prop e m (Csharpminor.Sexpr a) t m1 Csharpminor.Out_normal.
-Proof.
- intros; red; intros. monadInv TR.
- exploit H0; eauto.
- intros [f2 [tm2 [tv1 [EVAL1 [VINJ1 [MINJ2 [INCR2 MATCH2]]]]]]].
- exists f2; exists te1; exists tm2; exists Out_normal.
- intuition. econstructor; eauto.
- constructor.
-Qed.
-
Lemma transl_stmt_Sassign_correct:
- forall (e : Csharpminor.env) (m : mem)
- (id : ident) (a : Csharpminor.expr) (t: trace) (m1 : mem) (b : block)
- (chunk : memory_chunk) (v : val) (m2 : mem),
- Csharpminor.eval_expr prog nil e m a t m1 v ->
- eval_expr_prop nil e m a t m1 v ->
- eval_var_ref prog e id b chunk ->
- store chunk m1 b 0 v = Some m2 ->
- exec_stmt_prop e m (Csharpminor.Sassign id a) t m2 Csharpminor.Out_normal.
+ forall (e : Csharpminor.env) (m : mem) (id : ident)
+ (a : Csharpminor.expr) (v : val) (m' : mem),
+ Csharpminor.eval_expr prog e m a v ->
+ exec_assign prog e m id v m' ->
+ exec_stmt_prop e m (Csharpminor.Sassign id a) E0 m' Csharpminor.Out_normal.
Proof.
intros; red; intros. monadInv TR.
- exploit H0; eauto.
- intros [f2 [tm2 [tv1 [EVAL1 [VINJ1 [MINJ1 [INCR12 MATCH1]]]]]]].
- exploit var_set_correct; eauto.
- intros [te3 [tm3 [EVAL2 [MINJ2 MATCH2]]]].
- exists f2; exists te3; exists tm3; exists Out_normal.
+ exploit transl_expr_correct; eauto. intros [tv1 [EVAL1 VINJ1]].
+ exploit var_set_correct; eauto.
+ intros [te2 [tm2 [EVAL2 [MINJ2 MATCH2]]]].
+ exists f1; exists te2; exists tm2; exists Out_normal.
intuition. constructor.
Qed.
Lemma transl_stmt_Sstore_correct:
- forall (e : Csharpminor.env) (m : mem)
- (chunk : memory_chunk) (a b : Csharpminor.expr) (t1: trace) (m1 : mem)
- (v1 : val) (t2: trace) (m2 : mem) (v2 : val)
- (t3: trace) (m3 : mem),
- Csharpminor.eval_expr prog nil e m a t1 m1 v1 ->
- eval_expr_prop nil e m a t1 m1 v1 ->
- Csharpminor.eval_expr prog nil e m1 b t2 m2 v2 ->
- eval_expr_prop nil e m1 b t2 m2 v2 ->
- storev chunk m2 v1 v2 = Some m3 ->
- t3 = t1 ** t2 ->
- exec_stmt_prop e m (Csharpminor.Sstore chunk a b) t3 m3 Csharpminor.Out_normal.
+ forall (e : Csharpminor.env) (m : mem) (chunk : memory_chunk)
+ (a b : Csharpminor.expr) (v1 v2 : val) (m' : mem),
+ Csharpminor.eval_expr prog e m a v1 ->
+ Csharpminor.eval_expr prog e m b v2 ->
+ storev chunk m v1 v2 = Some m' ->
+ exec_stmt_prop e m (Csharpminor.Sstore chunk a b) E0 m' Csharpminor.Out_normal.
Proof.
intros; red; intros. monadInv TR.
- exploit H0; eauto.
- intros [f2 [tm2 [tv1 [EVAL1 [VINJ1 [MINJ2 [INCR2 MATCH2]]]]]]].
- exploit H2.
- eauto.
- eapply val_list_inject_incr; eauto.
- eauto. eauto.
- intros [f3 [tm3 [tv2 [EVAL2 [VINJ2 [MINJ3 [INCR3 MATCH3]]]]]]].
+ exploit transl_expr_correct.
+ eauto. eauto. eexact H. eauto.
+ intros [tv1 [EVAL1 INJ1]].
+ exploit transl_expr_correct.
+ eauto. eauto. eexact H0. eauto.
+ intros [tv2 [EVAL2 INJ2]].
exploit make_store_correct.
- eexact EVAL1. eexact EVAL2. eauto. eauto.
- eapply val_inject_incr; eauto. eauto.
- intros [tm4 [EVAL [MINJ4 NEXTBLOCK]]].
- exists f3; exists te1; exists tm4; exists Out_normal.
+ eexact EVAL1. eexact EVAL2. eauto. eauto. eauto. eauto.
+ intros [tm2 [EXEC [MINJ2 NEXTBLOCK]]].
+ exists f1; exists te1; exists tm2; exists Out_normal.
intuition.
constructor.
- eapply inject_incr_trans; eauto.
- assert (val_inject f3 v1 tv1). eapply val_inject_incr; eauto.
- unfold storev in H3; destruct v1; try discriminate.
- inversion H4.
- rewrite NEXTBLOCK. replace (nextblock m3) with (nextblock m2).
+ unfold storev in H1; destruct v1; try discriminate.
+ inv INJ1.
+ rewrite NEXTBLOCK. replace (nextblock m') with (nextblock m).
eapply match_callstack_mapped; eauto. congruence.
symmetry. eapply nextblock_store; eauto.
Qed.
+Lemma transl_stmt_Scall_correct:
+ forall (e : Csharpminor.env) (m : mem) (optid : option ident)
+ (sig : signature) (a : Csharpminor.expr)
+ (bl : list Csharpminor.expr) (vf : val) (vargs : list val)
+ (f : Csharpminor.fundef) (t : trace) (m1 : mem) (vres : val)
+ (m2 : mem),
+ Csharpminor.eval_expr prog e m a vf ->
+ Csharpminor.eval_exprlist prog e m bl vargs ->
+ Genv.find_funct (Genv.globalenv prog) vf = Some f ->
+ Csharpminor.funsig f = sig ->
+ Csharpminor.eval_funcall prog m f vargs t m1 vres ->
+ eval_funcall_prop m f vargs t m1 vres ->
+ exec_opt_assign prog e m1 optid vres m2 ->
+ exec_stmt_prop e m (Csharpminor.Scall optid sig a bl) t m2 Csharpminor.Out_normal.
+Proof.
+ intros;red;intros.
+ assert (forall tv, val_inject f1 vf tv -> tv = vf).
+ intros.
+ elim (Genv.find_funct_inv H1). intros bf VF. rewrite VF in H1.
+ rewrite Genv.find_funct_find_funct_ptr in H1.
+ generalize (Genv.find_funct_ptr_negative H1). intro.
+ assert (match_globalenvs f1). eapply match_callstack_match_globalenvs; eauto.
+ generalize (mg_functions _ H8 _ H7). intro.
+ rewrite VF in H6. inv H6.
+ decEq. congruence.
+ replace x with 0. reflexivity. congruence.
+ inv H5; monadInv TR.
+ (* optid = None *)
+ exploit transl_expr_correct; eauto. intros [tv1 [EVAL1 VINJ1]].
+ exploit transl_exprlist_correct; eauto. intros [tv2 [EVAL2 VINJ2]].
+ rewrite <- (H6 _ VINJ1) in H1.
+ elim (functions_translated _ _ H1). intros tf [FIND TRF].
+ exploit H4; eauto.
+ intros [f2 [tm2 [tres [EVAL3 [VINJ3 [MINJ3 [INCR3 MATCH3]]]]]]].
+ exists f2; exists te1; exists tm2; exists Out_normal.
+ intuition. eapply exec_Scall; eauto.
+ apply sig_preserved; auto.
+ constructor.
+ (* optid = Some id *)
+ exploit transl_expr_correct; eauto. intros [tv1 [EVAL1 VINJ1]].
+ exploit transl_exprlist_correct; eauto. intros [tv2 [EVAL2 VINJ2]].
+ rewrite <- (H6 _ VINJ1) in H1.
+ elim (functions_translated _ _ H1). intros tf [FIND TRF].
+ exploit H4; eauto.
+ intros [f2 [tm2 [tres [EVAL3 [VINJ3 [MINJ3 [INCR3 MATCH3]]]]]]].
+ exploit var_set_self_correct.
+ eauto. eexact MATCH3. eauto. eauto. eauto.
+ intros [te3 [tm3 [EVAL4 [MINJ4 MATCH4]]]].
+ exists f2; exists te3; exists tm3; exists Out_normal. intuition.
+ eapply exec_Sseq_continue. eapply exec_Scall; eauto.
+ apply sig_preserved; auto.
+ simpl. eexact EVAL4. traceEq.
+ constructor.
+Qed.
+
Lemma transl_stmt_Sseq_continue_correct:
forall (e : Csharpminor.env) (m : mem) (s1 s2 : Csharpminor.stmt)
(t1 t2: trace) (m1 m2 : mem) (t: trace) (out : Csharpminor.outcome),
@@ -2284,54 +2089,27 @@ Proof.
inversion OINJ1; subst out tout1; congruence.
Qed.
-Lemma transl_stmt_Sifthenelse_true_correct:
- forall (e : Csharpminor.env) (m : mem) (a : Csharpminor.expr)
- (sl1 sl2 : Csharpminor.stmt)
- (t1: trace) (m1 : mem) (v1 : val) (t2: trace) (m2 : mem)
- (out : Csharpminor.outcome) (t: trace),
- Csharpminor.eval_expr prog nil e m a t1 m1 v1 ->
- eval_expr_prop nil e m a t1 m1 v1 ->
- Val.is_true v1 ->
- Csharpminor.exec_stmt prog e m1 sl1 t2 m2 out ->
- exec_stmt_prop e m1 sl1 t2 m2 out ->
- t = t1 ** t2 ->
- exec_stmt_prop e m (Csharpminor.Sifthenelse a sl1 sl2) t m2 out.
-Proof.
- intros; red; intros. monadInv TR.
- exploit H0; eauto.
- intros [f2 [tm2 [tv1 [EVAL1 [VINJ1 [MINJ2 [INCR2 MATCH2]]]]]]].
- exploit H3; eauto.
- intros [f3 [te3 [tm3 [tout [EVAL2 [OINJ [MINJ3 [INCR3 MATCH3]]]]]]]].
- exists f3; exists te3; exists tm3; exists tout.
- intuition.
- eapply exec_Sifthenelse with (b1 := true); eauto.
- eapply val_inject_bool_of_val; eauto. apply Val.bool_of_true_val; auto.
- eapply inject_incr_trans; eauto.
-Qed.
-
-Lemma transl_stmt_Sifthenelse_false_correct:
- forall (e : Csharpminor.env) (m : mem) (a : Csharpminor.expr)
- (sl1 sl2 : Csharpminor.stmt)
- (t1: trace) (m1 : mem) (v1 : val) (t2: trace) (m2 : mem)
- (out : Csharpminor.outcome) (t: trace),
- Csharpminor.eval_expr prog nil e m a t1 m1 v1 ->
- eval_expr_prop nil e m a t1 m1 v1 ->
- Val.is_false v1 ->
- Csharpminor.exec_stmt prog e m1 sl2 t2 m2 out ->
- exec_stmt_prop e m1 sl2 t2 m2 out ->
- t = t1 ** t2 ->
- exec_stmt_prop e m (Csharpminor.Sifthenelse a sl1 sl2) t m2 out.
+Lemma transl_stmt_Sifthenelse_correct:
+ forall (e : Csharpminor.env) (m : mem) (a : Csharpminor.expr)
+ (sl1 sl2 : Csharpminor.stmt) (v : val) (vb : bool) (t : trace)
+ (m' : mem) (out : Csharpminor.outcome),
+ Csharpminor.eval_expr prog e m a v ->
+ Val.bool_of_val v vb ->
+ Csharpminor.exec_stmt prog e m (if vb then sl1 else sl2) t m' out ->
+ exec_stmt_prop e m (if vb then sl1 else sl2) t m' out ->
+ exec_stmt_prop e m (Csharpminor.Sifthenelse a sl1 sl2) t m' out.
Proof.
intros; red; intros. monadInv TR.
- exploit H0; eauto.
- intros [f2 [tm2 [tv1 [EVAL1 [VINJ1 [MINJ2 [INCR2 MATCH2]]]]]]].
- exploit H3; eauto.
- intros [f3 [te3 [tm3 [tout [EVAL2 [OINJ [MINJ3 [INCR3 MATCH3]]]]]]]].
- exists f3; exists te3; exists tm3; exists tout.
+ exploit transl_expr_correct; eauto.
+ intros [tv1 [EVAL1 VINJ1]].
+ assert (transl_stmt cenv (if vb then sl1 else sl2) =
+ OK (if vb then x0 else x1)). destruct vb; auto.
+ exploit H2; eauto.
+ intros [f2 [te2 [tm2 [tout [EVAL2 [OINJ [MINJ2 [INCR2 MATCH2]]]]]]]].
+ exists f2; exists te2; exists tm2; exists tout.
intuition.
- eapply exec_Sifthenelse with (b1 := false); eauto.
- eapply val_inject_bool_of_val; eauto. apply Val.bool_of_false_val; auto.
- eapply inject_incr_trans; eauto.
+ eapply exec_Sifthenelse; eauto.
+ eapply bool_of_val_inject; eauto.
Qed.
Lemma transl_stmt_Sloop_loop_correct:
@@ -2373,6 +2151,18 @@ Proof.
inversion OINJ1; subst out tout1; congruence.
Qed.
+Remark outcome_block_inject:
+ forall f out tout,
+ outcome_inject f out tout ->
+ outcome_inject f (Csharpminor.outcome_block out) (outcome_block tout).
+Proof.
+ induction 1; simpl.
+ constructor.
+ destruct n; constructor.
+ constructor.
+ constructor; auto.
+Qed.
+
Lemma transl_stmt_Sblock_correct:
forall (e : Csharpminor.env) (m : mem) (sl : Csharpminor.stmt)
(t1: trace) (m1 : mem) (out : Csharpminor.outcome),
@@ -2386,11 +2176,7 @@ Proof.
intros [f2 [te2 [tm2 [tout1 [EVAL1 [OINJ1 [MINJ2 [INCR2 MATCH2]]]]]]]].
exists f2; exists te2; exists tm2; exists (outcome_block tout1).
intuition. eapply exec_Sblock; eauto.
- inversion OINJ1; subst out tout1; simpl.
- constructor.
- destruct n; constructor.
- constructor.
- constructor; auto.
+ apply outcome_block_inject; auto.
Qed.
Lemma transl_stmt_Sexit_correct:
@@ -2403,21 +2189,22 @@ Proof.
Qed.
Lemma transl_stmt_Sswitch_correct:
- forall (e : Csharpminor.env) (m : mem)
- (a : Csharpminor.expr) (cases : list (int * nat)) (default : nat)
- (t1 : trace) (m1 : mem) (n : int),
- Csharpminor.eval_expr prog nil e m a t1 m1 (Vint n) ->
- eval_expr_prop nil e m a t1 m1 (Vint n) ->
- exec_stmt_prop e m (Csharpminor.Sswitch a cases default) t1 m1
- (Csharpminor.Out_exit (Csharpminor.switch_target n default cases)).
+ forall (e : Csharpminor.env) (m : mem) (a : Csharpminor.expr)
+ (cases : list (int * nat)) (default : nat) (n : int),
+ Csharpminor.eval_expr prog e m a (Vint n) ->
+ exec_stmt_prop e m (Csharpminor.Sswitch a cases default) E0 m
+ (Csharpminor.Out_exit (switch_target n default cases)).
Proof.
intros; red; intros. monadInv TR.
- exploit H0; eauto.
- intros [f2 [tm2 [tv1 [EVAL [VINJ1 [MINJ2 [INCR MATCH2]]]]]]].
- exists f2; exists te1; exists tm2;
- exists (Out_exit (switch_target n default cases)). intuition.
- constructor. inversion VINJ1. subst tv1. assumption.
- constructor.
+ exploit transl_expr_correct; eauto.
+ intros [tv1 [EVAL VINJ1]].
+ inv VINJ1.
+ exists f1; exists te1; exists tm1; exists (Out_exit (switch_target n default cases)).
+ split. constructor. auto.
+ split. constructor.
+ split. auto.
+ split. apply inject_incr_refl.
+ auto.
Qed.
Lemma transl_stmt_Sreturn_none_correct:
@@ -2431,17 +2218,16 @@ Proof.
Qed.
Lemma transl_stmt_Sreturn_some_correct:
- forall (e : Csharpminor.env) (m : mem) (a : Csharpminor.expr)
- (t1: trace) (m1 : mem) (v : val),
- Csharpminor.eval_expr prog nil e m a t1 m1 v ->
- eval_expr_prop nil e m a t1 m1 v ->
- exec_stmt_prop e m (Csharpminor.Sreturn (Some a)) t1 m1
- (Csharpminor.Out_return (Some v)).
+ forall (e : Csharpminor.env) (m : mem) (a : Csharpminor.expr)
+ (v : val),
+ Csharpminor.eval_expr prog e m a v ->
+ exec_stmt_prop e m (Csharpminor.Sreturn (Some a)) E0 m
+ (Csharpminor.Out_return (Some v)).
Proof.
intros; red; intros; monadInv TR.
- exploit H0; eauto.
- intros [f2 [tm2 [tv1 [EVAL [VINJ1 [MINJ2 [INCR MATCH2]]]]]]].
- exists f2; exists te1; exists tm2; exists (Out_return (Some tv1)).
+ exploit transl_expr_correct; eauto.
+ intros [tv1 [EVAL VINJ1]].
+ exists f1; exists te1; exists tm1; exists (Out_return (Some tv1)).
intuition. econstructor; eauto. constructor; auto.
Qed.
@@ -2453,36 +2239,45 @@ Lemma transl_function_correct:
Csharpminor.eval_funcall prog m1 f vargs t m2 vres ->
eval_funcall_prop m1 f vargs t m2 vres.
Proof
- (Csharpminor.eval_funcall_ind4 prog
- eval_expr_prop
- eval_exprlist_prop
+ (Csharpminor.eval_funcall_ind2 prog
+ eval_funcall_prop
+ exec_stmt_prop
+
+ transl_funcall_internal_correct
+ transl_funcall_external_correct
+ transl_stmt_Sskip_correct
+ transl_stmt_Sassign_correct
+ transl_stmt_Sstore_correct
+ transl_stmt_Scall_correct
+ transl_stmt_Sseq_continue_correct
+ transl_stmt_Sseq_stop_correct
+ transl_stmt_Sifthenelse_correct
+ transl_stmt_Sloop_loop_correct
+ transl_stmt_Sloop_exit_correct
+ transl_stmt_Sblock_correct
+ transl_stmt_Sexit_correct
+ transl_stmt_Sswitch_correct
+ transl_stmt_Sreturn_none_correct
+ transl_stmt_Sreturn_some_correct).
+
+Lemma transl_stmt_correct:
+ forall e m1 s t m2 out,
+ Csharpminor.exec_stmt prog e m1 s t m2 out ->
+ exec_stmt_prop e m1 s t m2 out.
+Proof
+ (Csharpminor.exec_stmt_ind2 prog
eval_funcall_prop
exec_stmt_prop
- transl_expr_Evar_correct
- transl_expr_Eaddrof_correct
- transl_expr_Econst_correct
- transl_expr_Eunop_correct
- transl_expr_Ebinop_correct
- transl_expr_Eload_correct
- transl_expr_Ecall_correct
- transl_expr_Econdition_true_correct
- transl_expr_Econdition_false_correct
- transl_expr_Elet_correct
- transl_expr_Eletvar_correct
- transl_expr_Ealloc_correct
- transl_exprlist_Enil_correct
- transl_exprlist_Econs_correct
transl_funcall_internal_correct
transl_funcall_external_correct
transl_stmt_Sskip_correct
- transl_stmt_Sexpr_correct
transl_stmt_Sassign_correct
transl_stmt_Sstore_correct
+ transl_stmt_Scall_correct
transl_stmt_Sseq_continue_correct
transl_stmt_Sseq_stop_correct
- transl_stmt_Sifthenelse_true_correct
- transl_stmt_Sifthenelse_false_correct
+ transl_stmt_Sifthenelse_correct
transl_stmt_Sloop_loop_correct
transl_stmt_Sloop_exit_correct
transl_stmt_Sblock_correct
@@ -2491,6 +2286,133 @@ Proof
transl_stmt_Sreturn_none_correct
transl_stmt_Sreturn_some_correct).
+(** ** Semantic preservation for divergence *)
+
+Definition evalinf_funcall_prop
+ (m1: mem) (fn: Csharpminor.fundef) (args: list val) (t: traceinf) : Prop :=
+ forall tfn f1 tm1 cs targs
+ (TR: transl_fundef gce fn = OK tfn)
+ (MINJ: mem_inject f1 m1 tm1)
+ (MATCH: match_callstack f1 cs m1.(nextblock) tm1.(nextblock) m1)
+ (ARGSINJ: val_list_inject f1 args targs),
+ evalinf_funcall tge tm1 tfn targs t.
+
+Definition execinf_stmt_prop
+ (e: Csharpminor.env) (m1: mem) (s: Csharpminor.stmt) (t: traceinf): Prop :=
+ forall cenv ts f1 te1 tm1 sp lo hi cs
+ (TR: transl_stmt cenv s = OK ts)
+ (MINJ: mem_inject f1 m1 tm1)
+ (MATCH: match_callstack f1
+ (mkframe cenv e te1 sp lo hi :: cs)
+ m1.(nextblock) tm1.(nextblock) m1),
+ execinf_stmt tge (Vptr sp Int.zero) te1 tm1 ts t.
+
+Theorem transl_function_divergence_correct:
+ forall m1 fn args t,
+ Csharpminor.evalinf_funcall prog m1 fn args t ->
+ evalinf_funcall_prop m1 fn args t.
+Proof.
+ unfold evalinf_funcall_prop; cofix FUNCALL.
+ assert (STMT: forall e m1 s t,
+ Csharpminor.execinf_stmt prog e m1 s t ->
+ execinf_stmt_prop e m1 s t).
+ unfold execinf_stmt_prop; cofix STMT.
+ intros. inv H; simpl in TR; try (monadInv TR).
+ (* Scall *)
+ assert (forall tv, val_inject f1 vf tv -> tv = vf).
+ intros.
+ elim (Genv.find_funct_inv H2). intros bf VF. rewrite VF in H2.
+ rewrite Genv.find_funct_find_funct_ptr in H2.
+ generalize (Genv.find_funct_ptr_negative H2). intro.
+ assert (match_globalenvs f1). eapply match_callstack_match_globalenvs; eauto.
+ generalize (mg_functions _ H5 _ H3). intro.
+ rewrite VF in H. inv H.
+ decEq. congruence.
+ replace x with 0. reflexivity. congruence.
+ destruct optid; monadInv TR.
+ (* optid = Some i *)
+ destruct (transl_expr_correct _ _ _ _ _ _ _ _ _ _ MINJ MATCH _ _ H0 _ EQ)
+ as [tv1 [EVAL1 VINJ1]].
+ destruct (transl_exprlist_correct _ _ _ _ _ _ _ _ _ _ MINJ MATCH _ _ H1 _ EQ1)
+ as [tv2 [EVAL2 VINJ2]].
+ rewrite <- (H _ VINJ1) in H2.
+ elim (functions_translated _ _ H2). intros tf [FIND TRF].
+ apply execinf_Sseq_1. eapply execinf_Scall.
+ eauto. eauto. eauto. apply sig_preserved; auto.
+ eapply FUNCALL; eauto.
+ (* optid = None *)
+ destruct (transl_expr_correct _ _ _ _ _ _ _ _ _ _ MINJ MATCH _ _ H0 _ EQ)
+ as [tv1 [EVAL1 VINJ1]].
+ destruct (transl_exprlist_correct _ _ _ _ _ _ _ _ _ _ MINJ MATCH _ _ H1 _ EQ1)
+ as [tv2 [EVAL2 VINJ2]].
+ rewrite <- (H _ VINJ1) in H2.
+ elim (functions_translated _ _ H2). intros tf [FIND TRF].
+ eapply execinf_Scall.
+ eauto. eauto. eauto. apply sig_preserved; auto.
+ eapply FUNCALL; eauto.
+ (* Sseq, 1 *)
+ apply execinf_Sseq_1. eapply STMT; eauto.
+ (* Sseq, 2 *)
+ destruct (transl_stmt_correct _ _ _ _ _ _ H0
+ _ _ _ _ _ _ _ _ _ EQ MINJ MATCH)
+ as [f2 [te2 [tm2 [tout [EXEC1 [OUT [MINJ2 [INCR12 MATCH2]]]]]]]].
+ inv OUT.
+ eapply execinf_Sseq_2. eexact EXEC1.
+ eapply STMT; eauto.
+ auto.
+ (* Sifthenelse, true *)
+ destruct (transl_expr_correct _ _ _ _ _ _ _ _ _ _ MINJ MATCH _ _ H0 _ EQ)
+ as [tv1 [EVAL1 VINJ1]].
+ assert (transl_stmt cenv (if vb then sl1 else sl2) =
+ OK (if vb then x0 else x1)). destruct vb; auto.
+ eapply execinf_Sifthenelse. eexact EVAL1.
+ eapply bool_of_val_inject; eauto.
+ eapply STMT; eauto.
+ (* Sloop, body *)
+ eapply execinf_Sloop_body. eapply STMT; eauto.
+ (* Sloop, loop *)
+ destruct (transl_stmt_correct _ _ _ _ _ _ H0
+ _ _ _ _ _ _ _ _ _ EQ MINJ MATCH)
+ as [f2 [te2 [tm2 [tout [EXEC1 [OUT [MINJ2 [INCR12 MATCH2]]]]]]]].
+ inv OUT.
+ eapply execinf_Sloop_loop. eexact EXEC1.
+ eapply STMT; eauto.
+ simpl. rewrite EQ. auto. auto.
+ (* Sblock *)
+ apply execinf_Sblock. eapply STMT; eauto.
+ (* stutter *)
+ generalize (execinf_stmt_N_inv _ _ _ _ _ _ H0); intro.
+ destruct s; try contradiction; monadInv TR.
+ apply execinf_Sseq_1. eapply STMT; eauto.
+ apply execinf_Sblock. eapply STMT; eauto.
+ (* Sloop_block *)
+ destruct (transl_stmt_correct _ _ _ _ _ _ H0
+ _ _ _ _ _ _ _ _ _ EQ MINJ MATCH)
+ as [f2 [te2 [tm2 [tout [EXEC1 [OUT [MINJ2 [INCR12 MATCH2]]]]]]]].
+ inv OUT.
+ eapply execinf_Sloop_loop. eexact EXEC1.
+ eapply STMT with (s := Csharpminor.Sloop sl); eauto.
+ apply execinf_Sblock_inv; eauto.
+ simpl. rewrite EQ; auto. auto.
+ (* Function *)
+ intros. inv H.
+ monadInv TR. generalize EQ.
+ unfold transl_function.
+ caseEq (build_compilenv gce f); intros cenv stacksize CENV.
+ destruct (zle stacksize Int.max_signed); try congruence.
+ intro TR. monadInv TR.
+ caseEq (alloc tm1 0 stacksize). intros tm2 sp ALLOC.
+ destruct (function_entry_ok _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
+ H1 H2 MATCH CENV z ALLOC ARGSINJ MINJ H0 EQ2)
+ as [f2 [te2 [tm3 [STOREPARAM [MINJ2 [INCR12 [MATCH2 BLOCKS]]]]]]].
+ eapply evalinf_funcall_internal; simpl.
+ eauto. reflexivity. eapply execinf_Sseq_2. eexact STOREPARAM.
+ unfold execinf_stmt_prop in STMT. eapply STMT; eauto.
+ traceEq.
+Qed.
+
+(** ** Semantic preservation for whole programs *)
+
(** The [match_globalenvs] relation holds for the global environments
of the source program and the transformed program. *)
@@ -2513,12 +2435,11 @@ Qed.
follows. *)
Theorem transl_program_correct:
- forall t n,
- Csharpminor.exec_program prog t (Vint n) ->
- exec_program tprog t (Vint n).
+ forall beh,
+ Csharpminor.exec_program prog beh ->
+ exec_program tprog beh.
Proof.
- intros t n [b [fn [m [FINDS [FINDF [SIG EVAL]]]]]].
- elim (function_ptr_translated _ _ FINDF). intros tfn [TFIND TR].
+ intros.
set (m0 := Genv.init_mem prog) in *.
set (f := meminj_init m0).
assert (MINJ0: mem_inject f m0 m0).
@@ -2526,17 +2447,31 @@ Proof.
unfold m0; apply Genv.initmem_inject_neutral.
assert (MATCH0: match_callstack f nil m0.(nextblock) m0.(nextblock) m0).
constructor. unfold f; apply match_globalenvs_init.
- fold ge in EVAL.
+ inv H.
+ (* Terminating case *)
+ subst ge0 m1.
+ elim (function_ptr_translated _ _ H1). intros tfn [TFIND TR].
+ fold ge in H3.
exploit transl_function_correct; eauto.
intros [f1 [tm1 [tres [TEVAL [VINJ [MINJ1 [INCR MATCH1]]]]]]].
- exists b; exists tfn; exists tm1.
- split. fold tge. rewrite <- FINDS.
- replace (prog_main prog) with (AST.prog_main tprog). fold ge. apply symbols_preserved.
+ econstructor; eauto.
+ fold tge. rewrite <- H0. fold ge.
+ replace (prog_main prog) with (AST.prog_main tprog). apply symbols_preserved.
apply transform_partial_program2_main with (transl_fundef gce) transl_globvar. assumption.
- split. assumption.
- split. rewrite <- SIG. apply sig_preserved; auto.
+ rewrite <- H2. apply sig_preserved; auto.
+ rewrite (Genv.init_mem_transf_partial2 (transl_fundef gce) transl_globvar _ TRANSL).
+ inv VINJ. fold tge; fold m0. eexact TEVAL.
+ (* Diverging case *)
+ subst ge0 m1.
+ elim (function_ptr_translated _ _ H1). intros tfn [TFIND TR].
+ econstructor; eauto.
+ fold tge. rewrite <- H0. fold ge.
+ replace (prog_main prog) with (AST.prog_main tprog). apply symbols_preserved.
+ apply transform_partial_program2_main with (transl_fundef gce) transl_globvar. assumption.
+ rewrite <- H2. apply sig_preserved; auto.
rewrite (Genv.init_mem_transf_partial2 (transl_fundef gce) transl_globvar _ TRANSL).
- inversion VINJ; subst tres. assumption.
+ fold tge; fold m0.
+ eapply (transl_function_divergence_correct _ _ _ _ H3); eauto.
Qed.
End TRANSLATION.
diff --git a/cfrontend/Csem.v b/cfrontend/Csem.v
index 385f7c683..af601acae 100644
--- a/cfrontend/Csem.v
+++ b/cfrontend/Csem.v
@@ -11,6 +11,7 @@ Require Import Mem.
Require Import Events.
Require Import Globalenvs.
Require Import Csyntax.
+Require Import Smallstep.
(** * Semantics of type-dependent operations *)
@@ -509,129 +510,108 @@ Section RELSEM.
Variable ge: genv.
-(** [eval_expr ge e m1 a t m2 v] defines the evaluation of expression [a]
- in r-value position. [v] is the value of the expression.
- [m1] is the initial memory state, [m2] the final memory state.
- [t] is the trace of input/output events performed during this
- evaluation. *)
+Section EXPR.
+
+Variable e: env.
+Variable m: mem.
-Inductive eval_expr: env -> mem -> expr -> trace -> mem -> val -> Prop :=
- | eval_Econst_int: forall e m i ty,
- eval_expr e m (Expr (Econst_int i) ty)
- E0 m (Vint i)
- | eval_Econst_float: forall e m f ty,
- eval_expr e m (Expr (Econst_float f) ty)
- E0 m (Vfloat f)
- | eval_Elvalue: forall e m a ty t m1 loc ofs v,
- eval_lvalue e m (Expr a ty) t m1 loc ofs ->
- load_value_of_type ty m1 loc ofs = Some v ->
- eval_expr e m (Expr a ty)
- t m1 v
- | eval_Eaddrof: forall e m a t m1 loc ofs ty,
- eval_lvalue e m a t m1 loc ofs ->
- eval_expr e m (Expr (Eaddrof a) ty)
- t m1 (Vptr loc ofs)
- | eval_Esizeof: forall e m ty' ty,
- eval_expr e m (Expr (Esizeof ty') ty)
- E0 m (Vint (Int.repr (sizeof ty')))
- | eval_Eunop: forall e m op a ty t m1 v1 v,
- eval_expr e m a t m1 v1 ->
+(** [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 e m (Expr (Eunop op a) ty)
- t m1 v
- | eval_Ebinop: forall e m op a1 a2 ty t1 m1 v1 t2 m2 v2 v,
- eval_expr e m a1 t1 m1 v1 ->
- eval_expr e m1 a2 t2 m2 v2 ->
- sem_binary_operation op v1 (typeof a1) v2 (typeof a2) m2 = Some v ->
- eval_expr e m (Expr (Ebinop op a1 a2) ty)
- (t1 ** t2) m2 v
- | eval_Eorbool_1: forall e m a1 a2 t m1 v1 ty,
- eval_expr e m a1 t m1 v1 ->
+ 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_Eorbool_1: forall a1 a2 ty v1,
+ eval_expr a1 v1 ->
is_true v1 (typeof a1) ->
- eval_expr e m (Expr (Eorbool a1 a2) ty)
- t m1 Vtrue
- | eval_Eorbool_2: forall e m a1 a2 ty t1 m1 v1 t2 m2 v2 v,
- eval_expr e m a1 t1 m1 v1 ->
+ 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 e m1 a2 t2 m2 v2 ->
+ eval_expr a2 v2 ->
bool_of_val v2 (typeof a2) v ->
- eval_expr e m (Expr (Eorbool a1 a2) ty)
- (t1 ** t2) m2 v
- | eval_Eandbool_1: forall e m a1 a2 t m1 v1 ty,
- eval_expr e m a1 t m1 v1 ->
+ 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 e m (Expr (Eandbool a1 a2) ty)
- t m1 Vfalse
- | eval_Eandbool_2: forall e m a1 a2 ty t1 m1 v1 t2 m2 v2 v,
- eval_expr e m a1 t1 m1 v1 ->
+ 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 e m1 a2 t2 m2 v2 ->
+ eval_expr a2 v2 ->
bool_of_val v2 (typeof a2) v ->
- eval_expr e m (Expr (Eandbool a1 a2) ty)
- (t1 ** t2) m2 v
- | eval_Ecast: forall e m a ty t m1 v1 v,
- eval_expr e m a t m1 v1 ->
+ eval_expr (Expr (Eandbool a1 a2) ty) v
+ | eval_Ecast: forall a ty v1 v,
+ eval_expr a v1 ->
cast v1 (typeof a) ty v ->
- eval_expr e m (Expr (Ecast ty a) ty)
- t m1 v
- | eval_Ecall: forall e m a bl ty m3 vres t1 m1 vf t2 m2 vargs f t3,
- eval_expr e m a t1 m1 vf ->
- eval_exprlist e m1 bl t2 m2 vargs ->
- Genv.find_funct ge vf = Some f ->
- type_of_fundef f = typeof a ->
- eval_funcall m2 f vargs t3 m3 vres ->
- eval_expr e m (Expr (Ecall a bl) ty)
- (t1 ** t2 ** t3) m3 vres
-
-(** [eval_lvalue ge e m1 a t m2 b ofs] defines the evaluation of
- expression [a] in r-value position. The result of the evaluation
- is the block reference [b] and the byte offset [ofs] of the
- memory location where the value of [a] resides.
- The other parameters are as in [eval_expr]. *)
-
-with eval_lvalue: env -> mem -> expr -> trace -> mem -> block -> int -> Prop :=
- | eval_Evar_local: forall e m id l ty,
+ 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 ->
- eval_lvalue e m (Expr (Evar id) ty)
- E0 m l Int.zero
- | eval_Evar_global: forall e m id 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 e m (Expr (Evar id) ty)
- E0 m l Int.zero
- | eval_Ederef: forall e m m1 a t ofs ty l,
- eval_expr e m a t m1 (Vptr l ofs) ->
- eval_lvalue e m (Expr (Ederef a) ty)
- t m1 l ofs
- | eval_Eindex: forall e m a1 t1 m1 v1 a2 t2 m2 v2 l ofs ty,
- eval_expr e m a1 t1 m1 v1 ->
- eval_expr e m1 a2 t2 m2 v2 ->
+ 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_Eindex: forall a1 a2 ty v1 v2 l ofs,
+ eval_expr a1 v1 ->
+ eval_expr a2 v2 ->
sem_add v1 (typeof a1) v2 (typeof a2) = Some (Vptr l ofs) ->
- eval_lvalue e m (Expr (Eindex a1 a2) ty)
- (t1 ** t2) m2 l ofs
- | eval_Efield_struct: forall e m a t m1 l ofs id fList i ty delta,
- eval_lvalue e m a t m1 l ofs ->
+ eval_lvalue (Expr (Eindex a1 a2) 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 e m (Expr (Efield a i) ty)
- t m1 l (Int.add ofs (Int.repr delta))
- | eval_Efield_union: forall e m a t m1 l ofs id fList i ty,
- eval_lvalue e m a t m1 l ofs ->
+ 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 e m (Expr (Efield a i) ty)
- t m1 l ofs
+ 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 m1 al t m2 vl] evaluates a list of r-value
+(** [eval_exprlist ge e m al vl] evaluates a list of r-value
expressions [al] to their values [vl]. *)
-with eval_exprlist: env -> mem -> exprlist -> trace -> mem -> list val -> Prop :=
- | eval_Enil: forall e m,
- eval_exprlist e m Enil E0 m nil
- | eval_Econs: forall e m a bl t1 m1 v t2 m2 vl,
- eval_expr e m a t1 m1 v ->
- eval_exprlist e m1 bl t2 m2 vl ->
- eval_exprlist e m (Econs a bl)
- (t1 ** t2) m2 (v :: 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.
(** [exec_stmt ge e m1 s t m2 out] describes the execution of
the statement [s]. [out] is the outcome for this execution.
@@ -639,20 +619,34 @@ with eval_exprlist: env -> mem -> exprlist -> trace -> mem -> list val -> Prop :
[t] is the trace of input/output events performed during this
evaluation. *)
-with exec_stmt: env -> mem -> statement -> trace -> mem -> outcome -> Prop :=
+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_Sexpr: forall e m a t m1 v,
- eval_expr e m a t m1 v ->
- exec_stmt e m (Sexpr a)
- t m1 Out_normal
- | exec_Sassign: forall e m a1 a2 t1 m1 loc ofs t2 m2 v2 m3,
- eval_lvalue e m a1 t1 m1 loc ofs ->
- eval_expr e m1 a2 t2 m2 v2 ->
- store_value_of_type (typeof a1) m2 loc ofs v2 = Some m3 ->
+ | 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)
- (t1 ** t2) m3 Out_normal
+ 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 ->
@@ -663,102 +657,103 @@ with exec_stmt: env -> mem -> statement -> trace -> mem -> outcome -> Prop :=
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_expr e m a t1 m1 v1 ->
+ | 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 m1 s1 t2 m2 out ->
+ exec_stmt e m s1 t m' 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_expr e m a t1 m1 v1 ->
+ 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 m1 s2 t2 m2 out ->
+ exec_stmt e m s2 t m' out ->
exec_stmt e m (Sifthenelse a s1 s2)
- (t1 ** t2) m2 out
+ 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 t m1 v,
- eval_expr e m a t m1 v ->
+ | exec_Sreturn_some: forall e m a v,
+ eval_expr e m a v ->
exec_stmt e m (Sreturn (Some a))
- t m1 (Out_return (Some v))
+ 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 s a t v m1,
- eval_expr e m a t m1 v ->
+ | 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)
- t m1 Out_normal
- | exec_Swhile_stop: forall e m a t1 m1 v s m2 t2 out2 out,
- eval_expr e m a t1 m1 v ->
+ 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 m1 s t2 m2 out2 ->
- out_break_or_return out2 out ->
+ exec_stmt e m s t m' 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 t1 m1 v s out2 out t2 m2 t3 m3,
- eval_expr e m a t1 m1 v ->
+ 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 m1 s t2 m2 out2 ->
- out_normal_or_continue out2 ->
- 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 v t2 m2,
exec_stmt e m s t1 m1 out1 ->
out_normal_or_continue out1 ->
- eval_expr e m1 a t2 m2 v ->
+ 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)
- (t1 ** t2) m2 Out_normal
+ 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 m3 t1 t2 t3 out out1 v,
+ | 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 t2 m2 v ->
+ eval_expr e m1 a v ->
is_true v (typeof a) ->
- exec_stmt e m2 (Sdowhile a s) t3 m3 out ->
+ exec_stmt e m1 (Sdowhile a s) t2 m2 out ->
exec_stmt e m (Sdowhile a s)
- (t1 ** t2 ** t3) m3 out
+ (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 t v m1,
- eval_expr e m a2 t m1 v ->
+ | 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)
- t m1 Out_normal
- | exec_Sfor_stop: forall e m s a2 a3 v m1 m2 t1 t2 out2 out,
- eval_expr e m a2 t1 m1 v ->
+ 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 m1 s t2 m2 out2 ->
- out_break_or_return out2 out ->
+ exec_stmt e m s t m1 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 v m1 m2 m3 m4 t1 t2 t3 t4 out2 out,
- eval_expr e m a2 t1 m1 v ->
+ 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 m1 s t2 m2 out2 ->
- out_normal_or_continue out2 ->
- 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 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 ** t4) m4 out
- | exec_Sswitch: forall e m a t1 m1 n sl t2 m2 out,
- eval_expr e m a t1 m1 (Vint n) ->
- exec_lblstmts e m1 (select_switch n sl) t2 m2 out ->
+ (t1 ** t2 ** t3) m3 out
+ | exec_Sswitch: forall e m a t n sl m1 out,
+ eval_expr e m a (Vint n) ->
+ exec_lblstmts e m (select_switch n sl) t m1 out ->
exec_stmt e m (Sswitch a sl)
- (t1 ** t2) m2 (outcome_switch out)
+ t m1 (outcome_switch out)
(** [exec_lblstmts ge e m1 ls t m2 out] is a variant of [exec_stmt]
that executes in sequence all statements in the list of labeled
@@ -791,25 +786,137 @@ with eval_funcall: mem -> fundef -> list val -> trace -> mem -> val -> Prop :=
event_match (external_function id targs tres) vargs t vres ->
eval_funcall m (External id targs tres) vargs t m vres.
-Scheme eval_expr_ind6 := Minimality for eval_expr Sort Prop
- with eval_lvalue_ind6 := Minimality for eval_lvalue Sort Prop
- with eval_exprlist_ind6 := Minimality for eval_exprlist Sort Prop
- with exec_stmt_ind6 := Minimality for exec_stmt Sort Prop
- with exec_lblstmts_ind6 := Minimality for exec_lblstmts Sort Prop
- with eval_funcall_ind6 := Minimality for eval_funcall Sort Prop.
+Scheme exec_stmt_ind3 := Minimality for exec_stmt Sort Prop
+ with exec_lblstmts_ind3 := Minimality for exec_lblstmts Sort Prop
+ with eval_funcall_ind3 := Minimality for eval_funcall Sort Prop.
+
+(** 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: forall e m lhs 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 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_lblstmts e m (select_switch n sl) t ->
+ execinf_stmt e m (Sswitch a sl) t
+
+with execinf_lblstmts: env -> mem -> labeled_statements -> traceinf -> Prop :=
+ | execinf_LSdefault: forall e m s t,
+ execinf_stmt e m s t ->
+ execinf_lblstmts e m (LSdefault s) t
+ | execinf_LScase_body: forall e m n s ls t,
+ execinf_stmt e m s t ->
+ execinf_lblstmts e m (LScase n s ls) t
+ | execinf_LScase_fallthrough: forall e m n s ls t1 m1 t2,
+ exec_stmt e m s t1 m1 Out_normal ->
+ execinf_lblstmts e m1 ls t2 ->
+ execinf_lblstmts e m (LScase n s ls) (t1 *** t2)
+
+(** [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 lb m2,
+ alloc_variables empty_env m (f.(fn_params) ++ f.(fn_vars)) e m1 lb ->
+ bind_parameters e m1 f.(fn_params) vargs m2 ->
+ execinf_stmt e m2 f.(fn_body) t ->
+ evalinf_funcall m (Internal f) vargs t.
End RELSEM.
-(** Execution of a whole program: [exec_program p t r]
- holds if the application of [p]'s main function to no arguments
- in the initial memory state for [p] performs the input/output
- operations described in the trace [t], and eventually returns value [r].
-*)
-
-Definition exec_program (p: program) (t: trace) (r: val) : Prop :=
- let ge := Genv.globalenv p in
- let m0 := Genv.init_mem p in
- exists b, exists f, exists m1,
- 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 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] executes without errors and produces
+ the observable behaviour [beh]. *)
+
+Inductive exec_program (p: program): program_behavior -> Prop :=
+ | program_terminates: forall b f m1 t r,
+ let ge := Genv.globalenv p in
+ let m0 := Genv.init_mem p in
+ 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) ->
+ exec_program p (Terminates t r)
+ | program_diverges: forall b f t,
+ let ge := Genv.globalenv p in
+ let m0 := Genv.init_mem p in
+ Genv.find_symbol ge p.(prog_main) = Some b ->
+ Genv.find_funct_ptr ge b = Some f ->
+ evalinf_funcall ge m0 f nil t ->
+ exec_program p (Diverges t).
+
diff --git a/cfrontend/Csharpminor.v b/cfrontend/Csharpminor.v
index 7d805c386..7afe27f2f 100644
--- a/cfrontend/Csharpminor.v
+++ b/cfrontend/Csharpminor.v
@@ -10,6 +10,7 @@ Require Import Mem.
Require Import Events.
Require Import Globalenvs.
Require Cminor.
+Require Import Smallstep.
(** Abstract syntax *)
@@ -17,10 +18,7 @@ Require Cminor.
statements, functions and programs. Expressions include
reading global or local variables, reading store locations,
arithmetic operations, function calls, and conditional expressions
- (similar to [e1 ? e2 : e3] in C). The [Elet] and [Eletvar] constructs
- enable sharing the computations of subexpressions. De Bruijn notation
- is used: [Eletvar n] refers to the value bound by then [n+1]-th enclosing
- [Elet] construct.
+ (similar to [e1 ? e2 : e3] in C).
Unlike in Cminor (the next intermediate language of the back-end),
Csharpminor local variables reside in memory, and their addresses can
@@ -41,27 +39,19 @@ Inductive expr : Set :=
| Eunop : unary_operation -> expr -> expr (**r unary operation *)
| Ebinop : binary_operation -> expr -> expr -> expr (**r binary operation *)
| Eload : memory_chunk -> expr -> expr (**r memory read *)
- | Ecall : signature -> expr -> exprlist -> expr (**r function call *)
- | Econdition : expr -> expr -> expr -> expr (**r conditional expression *)
- | Elet : expr -> expr -> expr (**r let binding *)
- | Eletvar : nat -> expr (**r reference to a let-bound variable *)
- | Ealloc : expr -> expr (**r memory allocation *)
-
-with exprlist : Set :=
- | Enil: exprlist
- | Econs: expr -> exprlist -> exprlist.
+ | Econdition : expr -> expr -> expr -> expr. (**r conditional expression *)
(** Statements include expression evaluation, variable assignment,
- memory stores, an if/then/else conditional,
+ memory stores, function calls, an if/then/else conditional,
infinite loops, blocks and early block exits, and early function returns.
[Sexit n] terminates prematurely the execution of the [n+1] enclosing
[Sblock] statements. *)
Inductive stmt : Set :=
| Sskip: stmt
- | Sexpr: expr -> stmt
| Sassign : ident -> expr -> stmt
| Sstore : memory_chunk -> expr -> expr -> stmt
+ | Scall : option ident -> signature -> expr -> list expr -> stmt
| Sseq: stmt -> stmt -> stmt
| Sifthenelse: expr -> stmt -> stmt -> stmt
| Sloop: stmt -> stmt
@@ -136,19 +126,17 @@ Fixpoint switch_target (n: int) (dfl: nat) (cases: list (int * nat))
| (n1, lbl1) :: rem => if Int.eq n n1 then lbl1 else switch_target n dfl rem
end.
-(** Four kinds of evaluation environments are involved:
+(** Three kinds of evaluation environments are involved:
- [genv]: global environments, define symbols and functions;
- [gvarenv]: map global variables to variable informations (type [var_kind]);
- [env]: local environments, map local variables
- to memory blocks and variable informations;
-- [lenv]: let environments, map de Bruijn indices to values.
+ to memory blocks and variable informations.
*)
Definition genv := Genv.t fundef.
Definition gvarenv := PTree.t var_kind.
Definition env := PTree.t (block * var_kind).
Definition empty_env : env := PTree.empty (block * var_kind).
-Definition letenv := list val.
Definition sizeof (lv: var_kind) : Z :=
match lv with
@@ -252,111 +240,80 @@ Inductive eval_var_ref: env -> ident -> block -> memory_chunk -> Prop :=
PTree.get id (global_var_env prg) = Some (Vscalar chunk) ->
eval_var_ref e id b chunk.
-(** Evaluation of an expression: [eval_expr prg le e m a t m' v] states
- that expression [a], in initial memory state [m], evaluates to value
- [v]. [m'] is the final memory state, respectively, reflecting
- memory stores possibly performed by [a]. [t] is the trace of input/output
- events generated during the evaluation.
- [e] and [le] are the local environment and let environment respectively. *)
-
-Inductive eval_expr:
- letenv -> env ->
- mem -> expr -> trace -> mem -> val -> Prop :=
- | eval_Evar:
- forall le e m id b chunk v,
+(** Evaluation of an expression: [eval_expr prg e m a v] states
+ that expression [a], in initial memory state [m] and local
+ environment [e], evaluates to value [v]. *)
+
+Section EVAL_EXPR.
+
+Variable e: env.
+Variable m: mem.
+
+Inductive eval_expr: expr -> val -> Prop :=
+ | eval_Evar: forall id b chunk v,
eval_var_ref e id b chunk ->
Mem.load chunk m b 0 = Some v ->
- eval_expr le e m (Evar id) E0 m v
- | eval_Eaddrof:
- forall le e m id b,
+ eval_expr (Evar id) v
+ | eval_Eaddrof: forall id b,
eval_var_addr e id b ->
- eval_expr le e m (Eaddrof id) E0 m (Vptr b Int.zero)
- | eval_Econst:
- forall le e m cst v,
+ eval_expr (Eaddrof id) (Vptr b Int.zero)
+ | eval_Econst: forall cst v,
eval_constant cst = Some v ->
- eval_expr le e m (Econst cst) E0 m v
- | eval_Eunop:
- forall le e m op a t m1 v1 v,
- eval_expr le e m a t m1 v1 ->
+ eval_expr (Econst cst) v
+ | eval_Eunop: forall op a1 v1 v,
+ eval_expr a1 v1 ->
eval_unop op v1 = Some v ->
- eval_expr le e m (Eunop op a) t m1 v
- | eval_Ebinop:
- forall le e m op a1 a2 t1 m1 v1 t2 m2 v2 t v,
- eval_expr le e m a1 t1 m1 v1 ->
- eval_expr le e m1 a2 t2 m2 v2 ->
- eval_binop op v1 v2 m2 = Some v ->
- t = t1 ** t2 ->
- eval_expr le e m (Ebinop op a1 a2) t m2 v
- | eval_Eload:
- forall le e m chunk a t m1 v1 v,
- eval_expr le e m a t m1 v1 ->
- Mem.loadv chunk m1 v1 = Some v ->
- eval_expr le e m (Eload chunk a) t m1 v
- | eval_Ecall:
- forall le e m sig a bl t1 m1 t2 m2 t3 m3 vf vargs vres f t,
- eval_expr le e m a t1 m1 vf ->
- eval_exprlist le e m1 bl t2 m2 vargs ->
- Genv.find_funct ge vf = Some f ->
- funsig f = sig ->
- eval_funcall m2 f vargs t3 m3 vres ->
- t = t1 ** t2 ** t3 ->
- eval_expr le e m (Ecall sig a bl) t m3 vres
- | eval_Econdition_true:
- forall le e m a b c t1 m1 v1 t2 m2 v2 t,
- eval_expr le e m a t1 m1 v1 ->
- Val.is_true v1 ->
- eval_expr le e m1 b t2 m2 v2 ->
- t = t1 ** t2 ->
- eval_expr le e m (Econdition a b c) t m2 v2
- | eval_Econdition_false:
- forall le e m a b c t1 m1 v1 t2 m2 v2 t,
- eval_expr le e m a t1 m1 v1 ->
- Val.is_false v1 ->
- eval_expr le e m1 c t2 m2 v2 ->
- t = t1 ** t2 ->
- eval_expr le e m (Econdition a b c) t m2 v2
- | eval_Elet:
- forall le e m a b t1 m1 v1 t2 m2 v2 t,
- eval_expr le e m a t1 m1 v1 ->
- eval_expr (v1::le) e m1 b t2 m2 v2 ->
- t = t1 ** t2 ->
- eval_expr le e m (Elet a b) t m2 v2
- | eval_Eletvar:
- forall le e m n v,
- nth_error le n = Some v ->
- eval_expr le e m (Eletvar n) E0 m v
- | eval_Ealloc:
- forall le e m a t m1 n m2 b,
- eval_expr le e m a t m1 (Vint n) ->
- Mem.alloc m1 0 (Int.signed n) = (m2, b) ->
- eval_expr le e m (Ealloc a) t m2 (Vptr b Int.zero)
+ eval_expr (Eunop op a1) v
+ | eval_Ebinop: forall op a1 a2 v1 v2 v,
+ eval_expr a1 v1 ->
+ eval_expr a2 v2 ->
+ eval_binop op v1 v2 m = Some v ->
+ eval_expr (Ebinop op a1 a2) v
+ | eval_Eload: forall chunk a v1 v,
+ eval_expr a v1 ->
+ Mem.loadv chunk m v1 = Some v ->
+ eval_expr (Eload chunk a) v
+ | eval_Econdition: forall a b c v1 vb1 v2,
+ eval_expr a v1 ->
+ Val.bool_of_val v1 vb1 ->
+ eval_expr (if vb1 then b else c) v2 ->
+ eval_expr (Econdition a b c) v2.
(** Evaluation of a list of expressions:
- [eval_exprlist prg le al m a t m' vl]
- states that the list [al] of expressions evaluate
- to the list [vl] of values.
- The other parameters are as in [eval_expr].
-*)
+ [eval_exprlist prg e m al vl] states that the list [al] of
+ expressions evaluate to the list [vl] of values. The other
+ parameters are as in [eval_expr]. *)
-with eval_exprlist:
- letenv -> env ->
- mem -> exprlist -> trace ->
- mem -> list val -> Prop :=
+Inductive eval_exprlist: list expr -> list val -> Prop :=
| eval_Enil:
- forall le e m,
- eval_exprlist le e m Enil E0 m nil
- | eval_Econs:
- forall le e m a bl t1 m1 v t2 m2 vl t,
- eval_expr le e m a t1 m1 v ->
- eval_exprlist le e m1 bl t2 m2 vl ->
- t = t1 ** t2 ->
- eval_exprlist le e m (Econs a bl) t m2 (v :: vl)
+ eval_exprlist nil nil
+ | eval_Econs: forall a1 al v1 vl,
+ eval_expr a1 v1 -> eval_exprlist al vl ->
+ eval_exprlist (a1 :: al) (v1 :: vl).
+
+End EVAL_EXPR.
+
+(** Execution of an assignment to a variable. *)
+
+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 ->
+ 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'.
(** Evaluation of a function invocation: [eval_funcall prg m f args t m' res]
means that the function [f], applied to the arguments [args] in
memory state [m], returns the value [res] in modified memory state [m'].
-*)
-with eval_funcall:
+ [t] is the trace of observable events performed during the call. *)
+
+Inductive eval_funcall:
mem -> fundef -> list val -> trace ->
mem -> val -> Prop :=
| eval_funcall_internal:
@@ -374,6 +331,8 @@ with eval_funcall:
(** Execution of a statement: [exec_stmt prg e m s t m' out]
means that statement [s] executes with outcome [out].
+ [m] is the initial memory state, [m'] the final memory state,
+ and [t] the trace of events performed.
The other parameters are as in [eval_expr]. *)
with exec_stmt:
@@ -383,23 +342,26 @@ with exec_stmt:
| exec_Sskip:
forall e m,
exec_stmt e m Sskip E0 m Out_normal
- | exec_Sexpr:
- forall e m a t m1 v,
- eval_expr nil e m a t m1 v ->
- exec_stmt e m (Sexpr a) t m1 Out_normal
- | eval_Sassign:
- forall e m id a t m1 b chunk v m2,
- eval_expr nil e m a t m1 v ->
- eval_var_ref e id b chunk ->
- Mem.store chunk m1 b 0 v = Some m2 ->
- exec_stmt e m (Sassign id a) t m2 Out_normal
- | eval_Sstore:
- forall e m chunk a b t1 m1 v1 t2 m2 v2 t3 m3,
- eval_expr nil e m a t1 m1 v1 ->
- eval_expr nil e m1 b t2 m2 v2 ->
- Mem.storev chunk m2 v1 v2 = Some m3 ->
- t3 = t1 ** t2 ->
- exec_stmt e m (Sstore chunk a b) t3 m3 Out_normal
+ | exec_Sassign:
+ forall e m id a v m',
+ eval_expr e m a v ->
+ exec_assign e m id v m' ->
+ exec_stmt e m (Sassign id a) E0 m' Out_normal
+ | exec_Sstore:
+ forall e m chunk a b v1 v2 m',
+ eval_expr e m a v1 ->
+ eval_expr e m b v2 ->
+ Mem.storev chunk m v1 v2 = Some m' ->
+ exec_stmt e m (Sstore chunk a b) E0 m' Out_normal
+ | exec_Scall:
+ forall e m optid sig a bl vf vargs f t m1 vres m2,
+ eval_expr e m a vf ->
+ eval_exprlist e m bl vargs ->
+ Genv.find_funct ge vf = Some f ->
+ funsig f = sig ->
+ eval_funcall m f vargs t m1 vres ->
+ exec_opt_assign e m1 optid vres m2 ->
+ exec_stmt e m (Scall optid sig a bl) t m2 Out_normal
| exec_Sseq_continue:
forall e m s1 s2 t1 t2 m1 m2 t out,
exec_stmt e m s1 t1 m1 Out_normal ->
@@ -411,20 +373,12 @@ with exec_stmt:
exec_stmt e m s1 t1 m1 out ->
out <> Out_normal ->
exec_stmt e m (Sseq s1 s2) t1 m1 out
- | exec_Sifthenelse_true:
- forall e m a sl1 sl2 t1 m1 v1 t2 m2 out t,
- eval_expr nil e m a t1 m1 v1 ->
- Val.is_true v1 ->
- exec_stmt e m1 sl1 t2 m2 out ->
- t = t1 ** t2 ->
- exec_stmt e m (Sifthenelse a sl1 sl2) t m2 out
- | exec_Sifthenelse_false:
- forall e m a sl1 sl2 t1 m1 v1 t2 m2 out t,
- eval_expr nil e m a t1 m1 v1 ->
- Val.is_false v1 ->
- exec_stmt e m1 sl2 t2 m2 out ->
- t = t1 ** t2 ->
- exec_stmt e m (Sifthenelse a sl1 sl2) t m2 out
+ | exec_Sifthenelse:
+ forall e m a sl1 sl2 v vb t m' out,
+ eval_expr e m a v ->
+ Val.bool_of_val v vb ->
+ exec_stmt e m (if vb then sl1 else sl2) t m' out ->
+ exec_stmt e m (Sifthenelse a sl1 sl2) t m' out
| exec_Sloop_loop:
forall e m sl t1 m1 t2 m2 out t,
exec_stmt e m sl t1 m1 Out_normal ->
@@ -444,35 +398,166 @@ with exec_stmt:
forall e m n,
exec_stmt e m (Sexit n) E0 m (Out_exit n)
| exec_Sswitch:
- forall e m a cases default t1 m1 n,
- eval_expr nil e m a t1 m1 (Vint n) ->
+ forall e m a cases default n,
+ eval_expr e m a (Vint n) ->
exec_stmt e m (Sswitch a cases default)
- t1 m1 (Out_exit (switch_target n default cases))
+ E0 m (Out_exit (switch_target n default cases))
| exec_Sreturn_none:
forall e m,
exec_stmt e m (Sreturn None) E0 m (Out_return None)
| exec_Sreturn_some:
- forall e m a t1 m1 v,
- eval_expr nil e m a t1 m1 v ->
- exec_stmt e m (Sreturn (Some a)) t1 m1 (Out_return (Some v)).
-
-Scheme eval_expr_ind4 := Minimality for eval_expr Sort Prop
- with eval_exprlist_ind4 := Minimality for eval_exprlist Sort Prop
- with eval_funcall_ind4 := Minimality for eval_funcall Sort Prop
- with exec_stmt_ind4 := Minimality for exec_stmt Sort Prop.
+ forall e m a v,
+ eval_expr e m a v ->
+ exec_stmt e m (Sreturn (Some a)) E0 m (Out_return (Some v)).
+
+Scheme eval_funcall_ind2 := Minimality for eval_funcall Sort Prop
+ with exec_stmt_ind2 := Minimality for exec_stmt Sort Prop.
+
+(** Coinductive semantics for divergence. *)
+
+Inductive block_seq_context: (stmt -> stmt) -> Prop :=
+ | block_seq_context_base_1:
+ block_seq_context (fun x => Sblock x)
+ | block_seq_context_base_2: forall s,
+ block_seq_context (fun x => Sseq x s)
+ | block_seq_context_ctx_1: forall ctx,
+ block_seq_context ctx ->
+ block_seq_context (fun x => Sblock (ctx x))
+ | block_seq_context_ctx_2: forall s ctx,
+ block_seq_context ctx ->
+ block_seq_context (fun x => Sseq (ctx x) s).
+
+CoInductive evalinf_funcall:
+ mem -> fundef -> list val -> traceinf -> Prop :=
+ | evalinf_funcall_internal:
+ forall m f vargs e m1 lb m2 t,
+ list_norepet (fn_params_names f ++ fn_vars_names f) ->
+ alloc_variables empty_env m (fn_variables f) e m1 lb ->
+ bind_parameters e m1 f.(fn_params) vargs m2 ->
+ execinf_stmt e m2 f.(fn_body) t ->
+ evalinf_funcall m (Internal f) vargs t
+
+with execinf_stmt:
+ env -> mem -> stmt -> traceinf -> Prop :=
+ | execinf_Scall:
+ forall e m optid sig a bl vf vargs f t,
+ eval_expr e m a vf ->
+ eval_exprlist e m bl vargs ->
+ Genv.find_funct ge vf = Some f ->
+ funsig f = sig ->
+ evalinf_funcall m f vargs t ->
+ execinf_stmt e m (Scall optid sig a bl) t
+ | execinf_Sseq_1:
+ forall e m s1 s2 t,
+ execinf_stmt e m s1 t ->
+ execinf_stmt e m (Sseq s1 s2) t
+ | execinf_Sseq_2:
+ forall e m s1 s2 t1 t2 m1 t,
+ exec_stmt e m s1 t1 m1 Out_normal ->
+ execinf_stmt e m1 s2 t2 ->
+ t = t1 *** t2 ->
+ execinf_stmt e m (Sseq s1 s2) t
+ | execinf_Sifthenelse:
+ forall e m a sl1 sl2 v vb t,
+ eval_expr e m a v ->
+ Val.bool_of_val v vb ->
+ execinf_stmt e m (if vb then sl1 else sl2) t ->
+ execinf_stmt e m (Sifthenelse a sl1 sl2) t
+ | execinf_Sloop_body:
+ forall e m sl t,
+ execinf_stmt e m sl t ->
+ execinf_stmt e m (Sloop sl) t
+ | execinf_Sloop_loop:
+ forall e m sl t1 m1 t2 t,
+ exec_stmt e m sl t1 m1 Out_normal ->
+ execinf_stmt e m1 (Sloop sl) t2 ->
+ t = t1 *** t2 ->
+ execinf_stmt e m (Sloop sl) t
+ | execinf_Sblock:
+ forall e m sl t,
+ execinf_stmt e m sl t ->
+ execinf_stmt e m (Sblock sl) t
+ | execinf_stutter:
+ forall n e m s t,
+ execinf_stmt_N n e m s t ->
+ execinf_stmt e m s t
+ | execinf_Sloop_block:
+ forall e m sl t1 m1 t2 t,
+ exec_stmt e m sl t1 m1 Out_normal ->
+ execinf_stmt e m1 (Sblock (Sloop sl)) t2 ->
+ t = t1 *** t2 ->
+ execinf_stmt e m (Sloop sl) t
+
+with execinf_stmt_N:
+ nat -> env -> mem -> stmt -> traceinf -> Prop :=
+ | execinf_context: forall n e m s t ctx,
+ execinf_stmt e m s t -> block_seq_context ctx ->
+ execinf_stmt_N n e m (ctx s) t
+ | execinf_sleep: forall n e m s t,
+ execinf_stmt_N n e m s t ->
+ execinf_stmt_N (S n) e m s t.
+
+Lemma execinf_stmt_N_inv:
+ forall n e m s t,
+ execinf_stmt_N n e m s t ->
+ match s with
+ | Sblock s1 => execinf_stmt e m s1 t
+ | Sseq s1 s2 => execinf_stmt e m s1 t
+ | _ => False
+ end.
+Proof.
+ assert (BASECASE: forall e m s t ctx,
+ execinf_stmt e m s t -> block_seq_context ctx ->
+ match ctx s with
+ | Sblock s1 => execinf_stmt e m s1 t
+ | Sseq s1 s2 => execinf_stmt e m s1 t
+ | _ => False
+ end).
+ intros. inv H0.
+ auto.
+ auto.
+ apply execinf_stutter with O. apply execinf_context; eauto.
+ apply execinf_stutter with O. apply execinf_context; eauto.
+
+ induction n; intros; inv H.
+ apply BASECASE; auto.
+ apply BASECASE; auto.
+ eapply IHn; eauto.
+Qed.
+
+Lemma execinf_Sblock_inv:
+ forall e m s t,
+ execinf_stmt e m (Sblock s) t ->
+ execinf_stmt e m s t.
+Proof.
+ intros. inv H.
+ auto.
+ exact (execinf_stmt_N_inv _ _ _ _ _ H0).
+Qed.
End RELSEM.
-(** Execution of a whole program: [exec_program p t 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] performs the events described
- in trace [t] and eventually returns value [r]. *)
-
-Definition exec_program (p: program) (t: trace) (r: val) : Prop :=
- let ge := Genv.globalenv p in
- let m0 := Genv.init_mem p in
- exists b, exists f, exists m,
- Genv.find_symbol ge p.(prog_main) = Some b /\
- Genv.find_funct_ptr ge b = Some f /\
- funsig f = mksignature nil (Some Tint) /\
- eval_funcall p m0 f nil t m r.
+ in the initial memory state for [p] has [beh] as observable
+ behavior. *)
+
+Inductive exec_program (p: program): program_behavior -> Prop :=
+ | program_terminates:
+ forall b f t m r,
+ let ge := Genv.globalenv p in
+ let m0 := Genv.init_mem p in
+ Genv.find_symbol ge p.(prog_main) = Some b ->
+ Genv.find_funct_ptr ge b = Some f ->
+ funsig f = mksignature nil (Some Tint) ->
+ eval_funcall p m0 f nil t m (Vint r) ->
+ exec_program p (Terminates t r)
+ | program_diverges:
+ forall b f t,
+ let ge := Genv.globalenv p in
+ let m0 := Genv.init_mem p in
+ Genv.find_symbol ge p.(prog_main) = Some b ->
+ Genv.find_funct_ptr ge b = Some f ->
+ funsig f = mksignature nil (Some Tint) ->
+ evalinf_funcall p m0 f nil t ->
+ exec_program p (Diverges t).
diff --git a/cfrontend/Cshmgen.v b/cfrontend/Cshmgen.v
index 937ea78a8..6ec3757b3 100644
--- a/cfrontend/Cshmgen.v
+++ b/cfrontend/Cshmgen.v
@@ -253,6 +253,14 @@ Definition make_store (addr: expr) (ty: type) (rhs: expr) :=
(** * Reading and writing variables *)
+(** Determine if a C expression is a variable *)
+
+Definition is_variable (e: Csyntax.expr) : option ident :=
+ match e with
+ | Expr (Csyntax.Evar id) _ => Some id
+ | _ => None
+ end.
+
(** [var_get id ty] returns Csharpminor code that evaluates to the
value of C variable [id] with type [ty]. Note that
C variables of array or function type evaluate to the address
@@ -277,7 +285,19 @@ Definition var_set (id: ident) (ty: type) (rhs: expr) :=
| _ => Error (MSG "Cshmgen.var_set " :: CTX id :: nil)
end.
-(** * Translation of operators *)
+(** 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
@@ -350,15 +370,6 @@ Fixpoint transl_expr (a: Csyntax.expr) {struct a} : res expr :=
do tc <- transl_expr c;
do ts <- make_add tb (typeof b) tc (typeof c);
make_load ts ty
- | Expr (Csyntax.Ecall b cl) _ =>
- match (classify_fun (typeof b)) with
- | fun_case_f args res =>
- do tb <- transl_expr b;
- do tcl <- transl_exprlist cl;
- OK(Ecall (signature_of_type args res) tb tcl)
- | _ =>
- Error(msg "Cshmgen.transl_expr(call)")
- end
| Expr (Csyntax.Eandbool b c) _ =>
do tb <- transl_expr b;
do tc <- transl_expr c;
@@ -413,31 +424,23 @@ with transl_lvalue (a: Csyntax.expr) {struct a} : res expr :=
end
| _ =>
Error(msg "Cshmgen.transl_lvalue")
- end
+ end.
(** [transl_exprlist al] returns a list of Csharpminor expressions
that compute the values of the list [al] of Csyntax expressions.
Used for function applications. *)
-with transl_exprlist (al: Csyntax.exprlist): res exprlist :=
+Fixpoint transl_exprlist (al: list Csyntax.expr): res (list expr) :=
match al with
- | Csyntax.Enil => OK Enil
- | Csyntax.Econs a1 a2 =>
+ | nil => OK nil
+ | a1 :: a2 =>
do ta1 <- transl_expr a1;
do ta2 <- transl_exprlist a2;
- OK (Econs ta1 ta2)
+ OK (ta1 :: ta2)
end.
(** * Translation of statements *)
-(** Determine if a C expression is a variable *)
-
-Definition is_variable (e: Csyntax.expr) : option ident :=
- match e with
- | Expr (Csyntax.Evar id) _ => Some id
- | _ => None
- end.
-
(** [exit_if_false e] return the statement that tests the boolean
value of the Clight expression [e]. If [e] evaluates to false,
an [exit 0] is performed. If [e] evaluates to true, the generated
@@ -512,15 +515,18 @@ Fixpoint switch_table (sl: labeled_statements) (k: nat) {struct sl} : list (int
| LScase ni _ rem => (ni, k) :: switch_table rem (k+1)
end.
+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 :=
match s with
| Csyntax.Sskip =>
OK Sskip
- | Csyntax.Sexpr e =>
- do te <- transl_expr e;
- OK (Sexpr te)
| Csyntax.Sassign b c =>
- match (is_variable b) with
+ match is_variable b with
| Some id =>
do tc <- transl_expr c;
var_set id (typeof b) tc
@@ -529,6 +535,15 @@ Fixpoint transl_statement (nbrk ncnt: nat) (s: Csyntax.statement) {struct s} : r
do tc <- transl_expr c;
make_store tb (typeof b) tc
end
+ | Csyntax.Scall opta 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)
+ | _ => 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;
@@ -547,11 +562,17 @@ Fixpoint transl_statement (nbrk ncnt: nat) (s: Csyntax.statement) {struct s} : r
do ts1 <- transl_statement 1%nat 0%nat s1;
OK (Sblock (Sloop (Sseq (Sblock ts1) te)))
| Csyntax.Sfor e1 e2 e3 s1 =>
- 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)))))
+ 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 =>
OK (Sexit nbrk)
| Csyntax.Scontinue =>
@@ -579,7 +600,7 @@ with transl_lblstmts (nbrk ncnt: nat) (sl: labeled_statements) (body: stmt)
transl_lblstmts (pred nbrk) (pred ncnt) rem (Sblock (Sseq body ts))
end.
-(** * Translation of functions and programs *)
+(*** Translation of functions *)
Definition prefix_var_name (id: ident) : errmsg :=
MSG "In local variable " :: CTX id :: MSG ":\n" :: nil.
@@ -603,6 +624,8 @@ Definition transl_fundef (f: Csyntax.fundef) : res fundef :=
OK(AST.External (external_function id args res))
end.
+(** ** Translation of programs *)
+
Definition transl_globvar (ty: type) := var_kind_of_type ty.
Definition transl_program (p: Csyntax.program) : res program :=
diff --git a/cfrontend/Cshmgenproof1.v b/cfrontend/Cshmgenproof1.v
index b86b09bfb..9930ef808 100644
--- a/cfrontend/Cshmgenproof1.v
+++ b/cfrontend/Cshmgenproof1.v
@@ -175,8 +175,8 @@ Proof.
Qed.
Lemma transl_expr_lvalue:
- forall ge e m1 a ty t m2 loc ofs ta,
- Csem.eval_lvalue ge e m1 (Expr a ty) t m2 loc ofs ->
+ 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 /\
@@ -188,28 +188,44 @@ Proof.
monadInv H0. right. exists x; split; auto.
simpl. monadInv H0. right. exists x1; split; auto.
simpl. rewrite EQ; rewrite EQ1. simpl. auto.
- rewrite H6 in H0. monadInv H0. right.
+ rewrite H4 in H0. monadInv H0. right.
exists (Ebinop Oadd x (make_intconst (Int.repr x0))). split; auto.
- simpl. rewrite H6. rewrite EQ. rewrite EQ1. auto.
- rewrite H10 in H0. monadInv H0. right.
+ simpl. rewrite H4. rewrite EQ. rewrite EQ1. auto.
+ rewrite H6 in H0. monadInv H0. right.
exists x; split; auto.
- simpl. rewrite H10. auto.
+ simpl. rewrite H6. auto.
Qed.
Lemma transl_stmt_Sfor_start:
forall nbrk ncnt s1 e2 s3 s4 ts,
transl_statement nbrk ncnt (Sfor s1 e2 s3 s4) = OK ts ->
+ s1 <> Csyntax.Sskip ->
exists ts1, exists ts2,
ts = Sseq ts1 ts2
/\ transl_statement nbrk ncnt s1 = OK ts1
- /\ transl_statement nbrk ncnt (Sfor Csyntax.Sskip e2 s3 s4) = OK (Sseq Sskip ts2).
+ /\ transl_statement nbrk ncnt (Sfor Csyntax.Sskip e2 s3 s4) = OK ts2.
Proof.
- intros. monadInv H. econstructor; econstructor.
+ intros. simpl in H. destruct (is_Sskip s1). contradiction.
+ monadInv H. econstructor; econstructor.
split. reflexivity. split. auto. simpl.
+ destruct (is_Sskip Csyntax.Sskip). 2: tauto.
rewrite EQ1; rewrite EQ0; rewrite EQ2; auto.
Qed.
-(** Properties related to [switch] constructs. *)
+Open Local Scope error_monad_scope.
+
+Lemma transl_stmt_Sfor_not_start:
+ forall nbrk ncnt e2 e3 s1,
+ transl_statement nbrk ncnt (Sfor Csyntax.Sskip e2 e3 s1) =
+ (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))))).
+Proof.
+ intros. simpl. destruct (is_Sskip Csyntax.Sskip). auto. congruence.
+Qed.
+
+(** Properties related to switch constructs *)
Fixpoint lblstmts_length (sl: labeled_statements) : nat :=
match sl with
@@ -233,4 +249,33 @@ Proof.
induction sl; intro; simpl. auto. decEq; auto.
Qed.
+Lemma block_seq_context_compose:
+ forall ctx2 ctx1,
+ block_seq_context ctx1 ->
+ block_seq_context ctx2 ->
+ block_seq_context (fun x => ctx1 (ctx2 x)).
+Proof.
+ induction 1; intros; constructor; auto.
+Qed.
+
+Lemma transl_lblstmts_context:
+ forall sl nbrk ncnt body s,
+ transl_lblstmts nbrk ncnt sl body = OK s ->
+ exists ctx, block_seq_context ctx /\ s = ctx body.
+Proof.
+ induction sl; simpl; intros.
+ monadInv H. exists (fun y => Sblock (Sseq y x)); split.
+ apply block_seq_context_ctx_1. apply block_seq_context_base_2.
+ auto.
+ monadInv H. exploit IHsl; eauto. intros [ctx [A B]].
+ exists (fun y => ctx (Sblock (Sseq y x))); split.
+ apply block_seq_context_compose with
+ (ctx1 := ctx)
+ (ctx2 := fun y => Sblock (Sseq y x)).
+ auto. apply block_seq_context_ctx_1. apply block_seq_context_base_2.
+ auto.
+Qed.
+
+
+
diff --git a/cfrontend/Cshmgenproof2.v b/cfrontend/Cshmgenproof2.v
index a75621cae..aa4e391a9 100644
--- a/cfrontend/Cshmgenproof2.v
+++ b/cfrontend/Cshmgenproof2.v
@@ -60,17 +60,17 @@ Qed.
(** * Correctness of Csharpminor construction functions *)
Lemma make_intconst_correct:
- forall n le e m1,
- Csharpminor.eval_expr tprog le e m1 (make_intconst n) E0 m1 (Vint n).
+ forall n e m,
+ eval_expr tprog e m (make_intconst n) (Vint n).
Proof.
- intros. unfold make_intconst. econstructor. constructor.
+ intros. unfold make_intconst. econstructor. reflexivity.
Qed.
Lemma make_floatconst_correct:
- forall n le e m1,
- Csharpminor.eval_expr tprog le e m1 (make_floatconst n) E0 m1 (Vfloat n).
+ forall n e m,
+ eval_expr tprog e m (make_floatconst n) (Vfloat n).
Proof.
- intros. unfold make_floatconst. econstructor. constructor.
+ intros. unfold make_floatconst. econstructor. reflexivity.
Qed.
Hint Resolve make_intconst_correct make_floatconst_correct
@@ -88,18 +88,18 @@ Proof.
Qed.
Lemma make_boolean_correct_true:
- forall le e m1 a t m2 v ty,
- Csharpminor.eval_expr tprog le e m1 a t m2 v ->
+ forall e m a v ty,
+ eval_expr tprog e m a v ->
is_true v ty ->
exists vb,
- Csharpminor.eval_expr tprog le e m1 (make_boolean a ty) t m2 vb
+ eval_expr tprog 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.
- econstructor; eauto with cshm.
+ eapply eval_Ebinop; eauto with cshm.
inversion VTRUE; simpl.
replace (Float.cmp Cne f0 Float.zero) with (negb (Float.cmp Ceq f0 Float.zero)).
rewrite Float.eq_zero_false. reflexivity. auto.
@@ -108,18 +108,18 @@ Proof.
Qed.
Lemma make_boolean_correct_false:
- forall le e m1 a t m2 v ty,
- Csharpminor.eval_expr tprog le e m1 a t m2 v ->
+ forall e m a v ty,
+ eval_expr tprog e m a v ->
is_false v ty ->
exists vb,
- Csharpminor.eval_expr tprog le e m1 (make_boolean a ty) t m2 vb
+ eval_expr tprog 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.
- econstructor; eauto with cshm.
+ eapply eval_Ebinop; eauto with cshm.
inversion VFALSE; simpl.
replace (Float.cmp Cne Float.zero Float.zero) with (negb (Float.cmp Ceq Float.zero Float.zero)).
rewrite Float.eq_zero_true. reflexivity.
@@ -128,38 +128,38 @@ Proof.
Qed.
Lemma make_neg_correct:
- forall a tya c ta va v le e m1 m2,
+ forall a tya c va v e m,
sem_neg va tya = Some v ->
make_neg a tya = OK c ->
- eval_expr tprog le e m1 a ta m2 va ->
- eval_expr tprog le e m1 c ta m2 v.
+ eval_expr tprog e m a va ->
+ eval_expr tprog e m c v.
Proof.
- intros until m2; intro SEM. unfold make_neg.
+ intros until m; intro SEM. unfold make_neg.
functional inversion SEM; intros.
- inversion H4. econstructor; eauto with cshm.
+ inversion H4. eapply eval_Eunop; eauto with cshm.
inversion H4. eauto with cshm.
Qed.
Lemma make_notbool_correct:
- forall a tya c ta va v le e m1 m2,
+ forall a tya c va v e m,
sem_notbool va tya = Some v ->
make_notbool a tya = c ->
- eval_expr tprog le e m1 a ta m2 va ->
- eval_expr tprog le e m1 c ta m2 v.
+ eval_expr tprog e m a va ->
+ eval_expr tprog e m c v.
Proof.
- intros until m2; intro SEM. unfold make_notbool.
+ intros until m; intro SEM. unfold make_notbool.
functional inversion SEM; intros; inversion H4; simpl;
eauto with cshm.
Qed.
Lemma make_notint_correct:
- forall a tya c ta va v le e m1 m2,
+ forall a tya c va v e m,
sem_notint va = Some v ->
make_notint a tya = c ->
- eval_expr tprog le e m1 a ta m2 va ->
- eval_expr tprog le e m1 c ta m2 v.
+ eval_expr tprog e m a va ->
+ eval_expr tprog e m c v.
Proof.
- intros until m2; intro SEM. unfold make_notint.
+ intros until m; intro SEM. unfold make_notint.
functional inversion SEM; intros.
inversion H2; eauto with cshm.
Qed.
@@ -167,143 +167,141 @@ 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 ta va tb vb v le e m1 m2 m3,
+ 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 tprog le e m1 a ta m2 va ->
- eval_expr tprog le e m2 b tb m3 vb ->
- eval_expr tprog le e m1 c (ta ** tb) m3 v.
+ eval_expr tprog e m a va ->
+ eval_expr tprog e m b vb ->
+ eval_expr tprog 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 ta va tb vb v le e m1 m2 m3,
+ 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 tprog le e m1 a ta m2 va ->
- eval_expr tprog le e m2 b tb m3 vb ->
- eval_expr tprog le e m1 c (ta ** tb) m3 v.
+ eval_expr tprog e m a va ->
+ eval_expr tprog e m b vb ->
+ eval_expr tprog e m c v.
Lemma make_add_correct: binary_constructor_correct make_add sem_add.
Proof.
- red; intros until m3. intro SEM. unfold make_add.
+ 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.
- econstructor. eauto.
- econstructor. eauto with cshm. eauto.
+ eapply eval_Ebinop. eauto.
+ eapply eval_Ebinop. eauto with cshm. eauto.
simpl. reflexivity. reflexivity.
- simpl. reflexivity. traceEq.
Qed.
Lemma make_sub_correct: binary_constructor_correct make_sub sem_sub.
Proof.
- red; intros until m3. intro SEM. unfold make_sub.
+ red; intros until m. intro SEM. unfold make_sub.
functional inversion SEM; rewrite H0; intros;
inversion H7; eauto with cshm.
- econstructor. eauto.
- econstructor. eauto with cshm. eauto.
+ eapply eval_Ebinop. eauto.
+ eapply eval_Ebinop. eauto with cshm. eauto.
simpl. reflexivity. reflexivity.
- simpl. reflexivity. traceEq.
- inversion H9. econstructor.
- econstructor; eauto.
+ inversion H9. eapply eval_Ebinop.
+ eapply eval_Ebinop; eauto.
simpl. unfold eq_block; rewrite H3. reflexivity.
- eauto with cshm. simpl. rewrite H8. reflexivity. traceEq.
+ eauto with cshm. simpl. rewrite H8. reflexivity.
Qed.
Lemma make_mul_correct: binary_constructor_correct make_mul sem_mul.
Proof.
- red; intros until m3. intro SEM. unfold make_mul.
+ 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 m3. intro SEM. unfold make_div.
+ red; intros until m. intro SEM. unfold make_div.
functional inversion SEM; rewrite H0; intros.
- inversion H8. econstructor; eauto with cshm.
+ inversion H8. eapply eval_Ebinop; eauto with cshm.
simpl. rewrite H7; auto.
- inversion H8. econstructor; eauto with cshm.
+ 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 m3. intro SEM. unfold make_mod.
+ red; intros until m. intro SEM. unfold make_mod.
functional inversion SEM; rewrite H0; intros.
- inversion H8. econstructor; eauto with cshm.
+ inversion H8. eapply eval_Ebinop; eauto with cshm.
simpl. rewrite H7; auto.
- inversion H8. econstructor; eauto with cshm.
+ 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 m3. intro SEM. unfold make_and.
+ 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 m3. intro SEM. unfold make_or.
+ 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 m3. intro SEM. unfold make_xor.
+ 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 m3. intro SEM. unfold make_shl.
+ red; intros until m. intro SEM. unfold make_shl.
functional inversion SEM. intros. inversion H5.
- econstructor; eauto with cshm.
+ 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 m3. intro SEM. unfold make_shr.
+ red; intros until m. intro SEM. unfold make_shr.
functional inversion SEM; intros; rewrite H0 in H8; inversion H8.
- econstructor; eauto with cshm.
+ eapply eval_Ebinop; eauto with cshm.
simpl; rewrite H7; auto.
- econstructor; eauto with cshm.
+ eapply eval_Ebinop; eauto with cshm.
simpl; rewrite H7; auto.
Qed.
Lemma make_cmp_correct:
- forall cmp a tya b tyb c ta va tb vb v le e m1 m2 m3,
- sem_cmp cmp va tya vb tyb m3 = Some v ->
+ 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 tprog le e m1 a ta m2 va ->
- eval_expr tprog le e m2 b tb m3 vb ->
- eval_expr tprog le e m1 c (ta ** tb) m3 v.
+ eval_expr tprog e m a va ->
+ eval_expr tprog e m b vb ->
+ eval_expr tprog e m c v.
Proof.
- intros until m3. intro SEM. unfold make_cmp.
+ intros until m. intro SEM. unfold make_cmp.
functional inversion SEM; rewrite H0; intros.
inversion H8. eauto with cshm.
inversion H8. eauto with cshm.
inversion H8. eauto with cshm.
- inversion H9. econstructor; eauto with cshm.
+ inversion H9. eapply eval_Ebinop; eauto with cshm.
simpl. functional inversion H; subst; unfold eval_compare_null;
rewrite H8; auto.
- inversion H10. econstructor; eauto with cshm.
+ inversion H10. eapply eval_Ebinop; eauto with cshm.
simpl. rewrite H3. unfold eq_block; rewrite H9. auto.
Qed.
Lemma transl_unop_correct:
- forall op a tya c ta va v le e m1 m2,
+ 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 tprog le e m1 a ta m2 va ->
- eval_expr tprog le e m1 c ta m2 v.
+ eval_expr tprog e m a va ->
+ eval_expr tprog e m c v.
Proof.
intros. destruct op; simpl in *.
eapply make_notbool_correct; eauto. congruence.
@@ -312,12 +310,12 @@ Proof.
Qed.
Lemma transl_binop_correct:
-forall op a tya b tyb c ta va tb vb v le e m1 m2 m3,
+ 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 m3 = Some v ->
- eval_expr tprog le e m1 a ta m2 va ->
- eval_expr tprog le e m2 b tb m3 vb ->
- eval_expr tprog le e m1 c (ta ** tb) m3 v.
+ sem_binary_operation op va tya vb tyb m = Some v ->
+ eval_expr tprog e m a va ->
+ eval_expr tprog e m b vb ->
+ eval_expr tprog e m c v.
Proof.
intros. destruct op; simpl in *.
eapply make_add_correct; eauto.
@@ -339,10 +337,10 @@ Proof.
Qed.
Lemma make_cast_correct:
- forall le e m1 a t m2 v ty1 ty2 v',
- eval_expr tprog le e m1 a t m2 v ->
+ forall e m a v ty1 ty2 v',
+ eval_expr tprog e m a v ->
cast v ty1 ty2 v' ->
- eval_expr tprog le e m1 (make_cast ty1 ty2 a) t m2 v'.
+ eval_expr tprog e m (make_cast ty1 ty2 a) v'.
Proof.
unfold make_cast, make_cast1, make_cast2.
intros until v'; intros EVAL CAST.
@@ -362,14 +360,14 @@ Proof.
Qed.
Lemma make_load_correct:
- forall addr ty code b ofs v le e m1 t m2,
+ forall addr ty code b ofs v e m,
make_load addr ty = OK code ->
- eval_expr tprog le e m1 addr t m2 (Vptr b ofs) ->
- load_value_of_type ty m2 b ofs = Some v ->
- eval_expr tprog le e m1 code t m2 v.
+ eval_expr tprog e m addr (Vptr b ofs) ->
+ load_value_of_type ty m b ofs = Some v ->
+ eval_expr tprog e m code v.
Proof.
unfold make_load, load_value_of_type.
- intros until m2; intros MKLOAD EVEXP LDVAL.
+ 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.
@@ -378,18 +376,18 @@ Proof.
Qed.
Lemma make_store_correct:
- forall addr ty rhs code e m1 t1 m2 b ofs t2 m3 v m4,
+ forall addr ty rhs code e m b ofs v m',
make_store addr ty rhs = OK code ->
- eval_expr tprog nil e m1 addr t1 m2 (Vptr b ofs) ->
- eval_expr tprog nil e m2 rhs t2 m3 v ->
- store_value_of_type ty m3 b ofs v = Some m4 ->
- exec_stmt tprog e m1 code (t1 ** t2) m4 Out_normal.
+ eval_expr tprog e m addr (Vptr b ofs) ->
+ eval_expr tprog e m rhs v ->
+ store_value_of_type ty m b ofs v = Some m' ->
+ exec_stmt tprog e m code E0 m' Out_normal.
Proof.
unfold make_store, store_value_of_type.
- intros until m4; intros MKSTORE EV1 EV2 STVAL.
+ intros until m'; intros MKSTORE EV1 EV2 STVAL.
destruct (access_mode ty); inversion MKSTORE.
(* access_mode ty = By_value m *)
- eapply eval_Sstore; eauto.
+ eapply exec_Sstore; eauto.
Qed.
End CONSTRUCTORS.
diff --git a/cfrontend/Cshmgenproof3.v b/cfrontend/Cshmgenproof3.v
index 10f48f612..54f9b7727 100644
--- a/cfrontend/Cshmgenproof3.v
+++ b/cfrontend/Cshmgenproof3.v
@@ -10,6 +10,7 @@ Require Import Values.
Require Import Events.
Require Import Mem.
Require Import Globalenvs.
+Require Import Smallstep.
Require Import Csyntax.
Require Import Csem.
Require Import Ctyping.
@@ -307,13 +308,13 @@ Qed.
(** Correctness of the code generated by [var_get]. *)
Lemma var_get_correct:
- forall e m id ty loc ofs v tyenv code te le,
- Csem.eval_lvalue ge e m (Expr (Csyntax.Evar id) ty) E0 m loc ofs ->
+ 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 tprog le te m code E0 m v.
+ eval_expr tprog te m code v.
Proof.
intros. inversion H1; subst; clear H1.
unfold load_value_of_type in H0.
@@ -356,14 +357,14 @@ Qed.
(** Correctness of the code generated by [var_set]. *)
Lemma var_set_correct:
- forall e m id ty m1 loc ofs t1 m2 v t2 m3 tyenv code te rhs,
- Csem.eval_lvalue ge e m (Expr (Csyntax.Evar id) ty) t1 m1 loc ofs ->
- store_value_of_type ty m2 loc ofs v = Some m3 ->
+ forall e m id ty loc ofs v m' tyenv code te rhs,
+ 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 tprog nil te m1 rhs t2 m2 v ->
- exec_stmt tprog te m code (t1 ** t2) m3 Out_normal.
+ eval_expr tprog te m rhs v ->
+ exec_stmt tprog te m code E0 m' Out_normal.
Proof.
intros. inversion H1; subst; clear H1.
unfold store_value_of_type in H0.
@@ -372,16 +373,16 @@ Proof.
(* 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; rewrite E0_left.
+ inversion H; subst; clear H.
(* local variable *)
exploit me_local; eauto. intros [vk [A B]].
red in A; rewrite ACC in A; subst vk.
- eapply eval_Sassign. eauto.
- eapply eval_var_ref_local. eauto. assumption.
+ eapply exec_Sassign. eauto.
+ econstructor. eapply eval_var_ref_local. eauto. assumption.
(* global variable *)
exploit me_global; eauto. intros [A B].
- eapply eval_Sassign. eauto.
- eapply eval_var_ref_global. auto.
+ eapply exec_Sassign. eauto.
+ econstructor. eapply eval_var_ref_global. auto.
fold tge. rewrite symbols_preserved. eauto.
eauto. assumption.
(* access mode By_reference *)
@@ -390,158 +391,145 @@ Proof.
intros. rewrite H1 in H0; discriminate.
Qed.
-(** * Proof of semantic simulation *)
+Lemma call_dest_set_correct:
+ forall e m0 lhs loc ofs m1 v m2 tyenv optid te,
+ Csem.eval_lvalue ge e m0 lhs loc ofs ->
+ store_value_of_type (typeof lhs) m1 loc ofs v = Some m2 ->
+ wt_expr tyenv lhs ->
+ transl_lhs_call (Some lhs) = OK optid ->
+ match_env tyenv e te ->
+ exec_opt_assign tprog te m1 optid v m2.
+Proof.
+ intros. generalize H2. simpl. caseEq (is_variable lhs). 2: congruence.
+ intros. inv H5.
+ exploit is_variable_correct; eauto. intro.
+ rewrite H5 in H. rewrite H5 in H1. inversion H1. subst i ty.
+ constructor.
+ generalize H0. unfold store_value_of_type.
+ caseEq (access_mode (typeof lhs)); intros; try discriminate.
+ (* access mode By_value *)
+ inversion H.
+ (* local variable *)
+ subst id0 ty l ofs. exploit me_local; eauto.
+ intros [vk [A B]]. red in A. rewrite H6 in A. subst vk.
+ econstructor. eapply eval_var_ref_local; eauto. assumption.
+ (* global variable *)
+ subst id0 ty l ofs. exploit me_global; eauto.
+ intros [A B].
+ econstructor. eapply eval_var_ref_global; eauto.
+ rewrite symbols_preserved. eauto. assumption.
+Qed.
+
+(** * Proof of semantic preservation *)
+
+(** ** Semantic preservation for expressions *)
-(** The proof of semantic preservation for this compiler pass relies
- on simulation diagrams of the following form:
+(** The proof of semantic preservation for the translation of expressions
+ relies on simulation diagrams of the following form:
<<
- e, m1, a ------------------- te, m1, ta
+ e, m, a ------------------- te, m, ta
| |
t| |t
| |
v v
- e, m2, v ------------------- te, m2, v
+ e, m, v ------------------- te, m, v
>>
- Left: evaluation of expression [a] in Clight.
+ 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] and final memory states [m2]
+ Bottom (postcondition): the result values [v]
are identical in both evaluations.
We state these diagrams as the following properties, parameterized
by the Clight evaluation. *)
-Definition eval_expr_prop
- (e: Csem.env) (m1: mem) (a: Csyntax.expr) (t: trace) (m2: mem) (v: val) : Prop :=
- forall tyenv ta te tle
+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)
- (MENV: match_env tyenv e te),
- Csharpminor.eval_expr tprog tle te m1 ta t m2 v.
+ (TR: transl_expr a = OK ta),
+ Csharpminor.eval_expr tprog te m ta v.
-Definition eval_lvalue_prop
- (e: Csem.env) (m1: mem) (a: Csyntax.expr) (t: trace)
- (m2: mem) (b: block) (ofs: int) : Prop :=
- forall tyenv ta te tle
+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)
- (MENV: match_env tyenv e te),
- Csharpminor.eval_expr tprog tle te m1 ta t m2 (Vptr b ofs).
+ (TR: transl_lvalue a = OK ta),
+ Csharpminor.eval_expr tprog te m ta (Vptr b ofs).
-Definition eval_exprlist_prop
- (e: Csem.env) (m1: mem) (al: Csyntax.exprlist) (t: trace)
- (m2: mem) (vl: list val) : Prop :=
- forall tyenv tal te tle
+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)
- (MENV: match_env tyenv e te),
- Csharpminor.eval_exprlist tprog tle te m1 tal t m2 vl.
-
-Definition transl_outcome (nbrk ncnt: nat) (out: Csem.outcome): Csharpminor.outcome :=
- match out with
- | Csem.Out_normal => Csharpminor.Out_normal
- | Csem.Out_break => Csharpminor.Out_exit nbrk
- | Csem.Out_continue => Csharpminor.Out_exit ncnt
- | Csem.Out_return vopt => Csharpminor.Out_return vopt
- end.
-
-Definition exec_stmt_prop
- (e: Csem.env) (m1: mem) (s: Csyntax.statement) (t: trace)
- (m2: mem) (out: Csem.outcome) : Prop :=
- forall tyenv nbrk ncnt ts te
- (WT: wt_stmt tyenv s)
- (TR: transl_statement nbrk ncnt s = OK ts)
- (MENV: match_env tyenv e te),
- Csharpminor.exec_stmt tprog te m1 ts t m2 (transl_outcome nbrk ncnt out).
-
-Definition exec_lblstmts_prop
- (e: Csem.env) (m1: mem) (s: Csyntax.labeled_statements)
- (t: trace) (m2: mem) (out: Csem.outcome) : Prop :=
- forall tyenv nbrk ncnt body ts te m0 t0
- (WT: wt_lblstmts tyenv s)
- (TR: transl_lblstmts (lblstmts_length s)
- (1 + lblstmts_length s + ncnt)
- s body = OK ts)
- (MENV: match_env tyenv e te)
- (BODY: Csharpminor.exec_stmt tprog te m0 body t0 m1 Out_normal),
- Csharpminor.exec_stmt tprog te m0 ts (t0 ** t) m2
- (transl_outcome nbrk ncnt (outcome_switch out)).
-
-Definition eval_funcall_prop
- (m1: mem) (f: Csyntax.fundef) (params: list val)
- (t: trace) (m2: mem) (res: val) : Prop :=
- forall tf
- (WT: wt_fundef (global_typenv prog) f)
- (TR: transl_fundef f = OK tf),
- Csharpminor.eval_funcall tprog m1 tf params t m2 res.
+ (TR: transl_exprlist al = OK tal),
+ Csharpminor.eval_exprlist tprog te m tal vl.
-(** The proof of semantic preservation is by induction on the Clight
- evaluation derivation. Since this proof is large, we break it
- into one lemma for each Clight evaluation rule. *)
+(* Check (eval_expr_ind2 ge e m eval_expr_prop eval_lvalue_prop).*)
Lemma transl_Econst_int_correct:
- (forall (e : Csem.env) (m : mem) (i : int) (ty : type),
- eval_expr_prop e m (Expr (Econst_int i) ty) E0 m (Vint i)).
+ 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 (e : Csem.env) (m : mem) (f0 : float) (ty : type),
- eval_expr_prop e m (Expr (Econst_float f0) ty) E0 m (Vfloat f0)).
+ 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 (e : Csem.env) (m : mem) (a : expr_descr) (ty : type)
- (t : trace) (m1 : mem) (loc : block) (ofs : int) (v : val),
- eval_lvalue ge e m (Expr a ty) t m1 loc ofs ->
- eval_lvalue_prop e m (Expr a ty) t m1 loc ofs ->
- load_value_of_type ty m1 loc ofs = Some v ->
- eval_expr_prop e m (Expr a ty) t m1 v).
+ 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.
- assert (t = E0 /\ m1 = m). inversion H; auto.
- destruct H2; subst t m1.
- eapply var_get_correct; eauto.
+ subst a. eapply var_get_correct; eauto.
(* Case a is another lvalue *)
eapply make_load_correct; eauto.
Qed.
Lemma transl_Eaddrof_correct:
- (forall (e : Csem.env) (m : mem) (a : Csyntax.expr) (t : trace)
- (m1 : mem) (loc : block) (ofs : int) (ty : type),
- eval_lvalue ge e m a t m1 loc ofs ->
- eval_lvalue_prop e m a t m1 loc ofs ->
- eval_expr_prop e m (Expr (Csyntax.Eaddrof a) ty) t m1 (Vptr loc ofs)).
+ 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 (e : Csem.env) (m : mem) (ty' ty : type),
- eval_expr_prop e m (Expr (Esizeof ty') ty) E0 m
- (Vint (Int.repr (Csyntax.sizeof ty')))).
+ 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 (e : Csem.env) (m : mem) (op : Csyntax.unary_operation)
- (a : Csyntax.expr) (ty : type) (t : trace) (m1 : mem) (v1 v : val),
- Csem.eval_expr ge e m a t m1 v1 ->
- eval_expr_prop e m a t m1 v1 ->
- sem_unary_operation op v1 (typeof a) = Some v ->
- eval_expr_prop e m (Expr (Csyntax.Eunop op a) ty) t m1 v).
+ 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.
@@ -550,15 +538,14 @@ Proof.
Qed.
Lemma transl_Ebinop_correct:
- (forall (e : Csem.env) (m : mem) (op : Csyntax.binary_operation)
- (a1 a2 : Csyntax.expr) (ty : type) (t1 : trace) (m1 : mem)
- (v1 : val) (t2 : trace) (m2 : mem) (v2 v : val),
- Csem.eval_expr ge e m a1 t1 m1 v1 ->
- eval_expr_prop e m a1 t1 m1 v1 ->
- Csem.eval_expr ge e m1 a2 t2 m2 v2 ->
- eval_expr_prop e m1 a2 t2 m2 v2 ->
- sem_binary_operation op v1 (typeof a1) v2 (typeof a2) m2 = Some v ->
- eval_expr_prop e m (Expr (Csyntax.Ebinop op a1 a2) ty) (t1 ** t2) m2 v).
+ 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.
@@ -567,137 +554,93 @@ Proof.
Qed.
Lemma transl_Eorbool_1_correct:
- (forall (e : Csem.env) (m : mem) (a1 a2 : Csyntax.expr) (t : trace)
- (m1 : mem) (v1 : val) (ty : type),
- Csem.eval_expr ge e m a1 t m1 v1 ->
- eval_expr_prop e m a1 t m1 v1 ->
- is_true v1 (typeof a1) ->
- eval_expr_prop e m (Expr (Eorbool a1 a2) ty) t m1 Vtrue).
+ 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_true; eauto.
- unfold Vtrue; apply make_intconst_correct. traceEq.
+ 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 (e : Csem.env) (m : mem) (a1 a2 : Csyntax.expr) (ty : type)
- (t1 : trace) (m1 : mem) (v1 : val) (t2 : trace) (m2 : mem)
- (v2 v : val),
- Csem.eval_expr ge e m a1 t1 m1 v1 ->
- eval_expr_prop e m a1 t1 m1 v1 ->
- is_false v1 (typeof a1) ->
- Csem.eval_expr ge e m1 a2 t2 m2 v2 ->
- eval_expr_prop e m1 a2 t2 m2 v2 ->
- bool_of_val v2 (typeof a2) v ->
- eval_expr_prop e m (Expr (Eorbool a1 a2) ty) (t1 ** t2) m2 v).
+ 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_false; eauto.
- inversion H4; subst.
+ 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_true; eauto.
- unfold Vtrue; apply make_intconst_correct. traceEq.
+ 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_false; eauto.
- unfold Vfalse; apply make_intconst_correct. traceEq.
+ eapply eval_Econdition; eauto. apply Val.bool_of_false_val; eauto.
+ unfold Vfalse; apply make_intconst_correct.
Qed.
Lemma transl_Eandbool_1_correct:
- (forall (e : Csem.env) (m : mem) (a1 a2 : Csyntax.expr) (t : trace)
- (m1 : mem) (v1 : val) (ty : type),
- Csem.eval_expr ge e m a1 t m1 v1 ->
- eval_expr_prop e m a1 t m1 v1 ->
- is_false v1 (typeof a1) ->
- eval_expr_prop e m (Expr (Eandbool a1 a2) ty) t m1 Vfalse).
+ 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_false; eauto.
- unfold Vfalse; apply make_intconst_correct. traceEq.
+ eapply eval_Econdition; eauto. apply Val.bool_of_false_val; eauto.
+ unfold Vfalse; apply make_intconst_correct.
Qed.
Lemma transl_Eandbool_2_correct:
- (forall (e : Csem.env) (m : mem) (a1 a2 : Csyntax.expr) (ty : type)
- (t1 : trace) (m1 : mem) (v1 : val) (t2 : trace) (m2 : mem)
- (v2 v : val),
- Csem.eval_expr ge e m a1 t1 m1 v1 ->
- eval_expr_prop e m a1 t1 m1 v1 ->
- is_true v1 (typeof a1) ->
- Csem.eval_expr ge e m1 a2 t2 m2 v2 ->
- eval_expr_prop e m1 a2 t2 m2 v2 ->
- bool_of_val v2 (typeof a2) v ->
- eval_expr_prop e m (Expr (Eandbool a1 a2) ty) (t1 ** t2) m2 v).
+ 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_true; eauto.
- inversion H4; subst.
+ 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_true; eauto.
- unfold Vtrue; apply make_intconst_correct. traceEq.
+ 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_false; eauto.
- unfold Vfalse; apply make_intconst_correct. traceEq.
+ eapply eval_Econdition; eauto. apply Val.bool_of_false_val; eauto.
+ unfold Vfalse; apply make_intconst_correct.
Qed.
Lemma transl_Ecast_correct:
- (forall (e : Csem.env) (m : mem) (a : Csyntax.expr) (ty : type)
- (t : trace) (m1 : mem) (v1 v : val),
- Csem.eval_expr ge e m a t m1 v1 ->
- eval_expr_prop e m a t m1 v1 ->
- cast v1 (typeof a) ty v ->
- eval_expr_prop e m (Expr (Ecast ty a) ty) t m1 v).
+ forall (a : Csyntax.expr) (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_Ecall_correct:
- (forall (e : Csem.env) (m : mem) (a : Csyntax.expr)
- (bl : Csyntax.exprlist) (ty : type) (m3 : mem) (vres : val)
- (t1 : trace) (m1 : mem) (vf : val) (t2 : trace) (m2 : mem)
- (vargs : list val) (f : Csyntax.fundef) (t3 : trace),
- Csem.eval_expr ge e m a t1 m1 vf ->
- eval_expr_prop e m a t1 m1 vf ->
- Csem.eval_exprlist ge e m1 bl t2 m2 vargs ->
- eval_exprlist_prop e m1 bl t2 m2 vargs ->
- Genv.find_funct ge vf = Some f ->
- type_of_fundef f = typeof a ->
- Csem.eval_funcall ge m2 f vargs t3 m3 vres ->
- eval_funcall_prop m2 f vargs t3 m3 vres ->
- eval_expr_prop e m (Expr (Csyntax.Ecall a bl) ty) (t1 ** t2 ** t3) m3
- vres).
-Proof.
- intros; red; intros.
- inversion WT; clear WT; subst.
- simpl in TR.
- caseEq (classify_fun (typeof a)).
- 2: intros; rewrite H7 in TR; discriminate.
- intros targs tres EQ. rewrite EQ in TR.
- monadInv TR.
- rewrite <- H4 in EQ.
- exploit functions_translated; eauto. intros [tf [FIND TRL]].
- econstructor.
- eapply H0; eauto.
- eapply H2; eauto.
- eexact FIND.
- eapply transl_fundef_sig1; eauto.
- eapply H6; eauto.
- eapply functions_well_typed; eauto.
- auto.
-Qed.
-
Lemma transl_Evar_local_correct:
- (forall (e : Csem.env) (m : mem) (id : positive) (l : block)
- (ty : type),
- e ! id = Some l ->
- eval_lvalue_prop e m (Expr (Csyntax.Evar id) ty) E0 m l Int.zero).
+ forall (id : ident) (l : block) (ty : type),
+ e ! 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_local _ _ _ MENV); eauto. intros [vk [A B]].
@@ -705,11 +648,10 @@ Proof.
Qed.
Lemma transl_Evar_global_correct:
- (forall (e : PTree.t block) (m : mem) (id : positive) (l : block)
- (ty : type),
- e ! id = None ->
- Genv.find_symbol ge id = Some l ->
- eval_lvalue_prop e m (Expr (Csyntax.Evar id) ty) E0 m l Int.zero).
+ 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].
@@ -718,83 +660,183 @@ Proof.
Qed.
Lemma transl_Ederef_correct:
- (forall (e : Csem.env) (m m1 : mem) (a : Csyntax.expr) (t : trace)
- (ofs : int) (ty : type) (l : block),
- Csem.eval_expr ge e m a t m1 (Vptr l ofs) ->
- eval_expr_prop e m a t m1 (Vptr l ofs) ->
- eval_lvalue_prop e m (Expr (Ederef a) ty) t m1 l ofs).
+ 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_Eindex_correct:
- (forall (e : Csem.env) (m : mem) (a1 : Csyntax.expr) (t1 : trace)
- (m1 : mem) (v1 : val) (a2 : Csyntax.expr) (t2 : trace) (m2 : mem)
- (v2 : val) (l : block) (ofs : int) (ty : type),
- Csem.eval_expr ge e m a1 t1 m1 v1 ->
- eval_expr_prop e m a1 t1 m1 v1 ->
- Csem.eval_expr ge e m1 a2 t2 m2 v2 ->
- eval_expr_prop e m1 a2 t2 m2 v2 ->
- sem_add v1 (typeof a1) v2 (typeof a2) = Some (Vptr l ofs) ->
- eval_lvalue_prop e m (Expr (Eindex a1 a2) ty) (t1 ** t2) m2 l ofs).
+ forall (a1 a2 : Csyntax.expr) (ty : type) (v1 v2 : val) (l : block)
+ (ofs : int),
+ 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_add v1 (typeof a1) v2 (typeof a2) = Some (Vptr l ofs) ->
+ eval_lvalue_prop (Expr (Eindex a1 a2) ty) l ofs.
Proof.
intros; red; intros. inversion WT; clear WT; subst. simpl in TR. monadInv TR.
eapply (make_add_correct tprog); eauto.
Qed.
Lemma transl_Efield_struct_correct:
- (forall (e : Csem.env) (m : mem) (a : Csyntax.expr) (t : trace)
- (m1 : mem) (l : block) (ofs : int) (id: ident) (fList : fieldlist) (i : ident)
- (ty : type) (delta : Z),
- eval_lvalue ge e m a t m1 l ofs ->
- eval_lvalue_prop e m a t m1 l ofs ->
- typeof a = Tstruct id fList ->
- field_offset i fList = OK delta ->
- eval_lvalue_prop e m (Expr (Efield a i) ty) t m1 l
- (Int.add ofs (Int.repr delta))).
+ 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.
- econstructor; eauto.
+ eapply eval_Ebinop; eauto.
apply make_intconst_correct.
- simpl. congruence. traceEq.
+ simpl. congruence.
Qed.
Lemma transl_Efield_union_correct:
- (forall (e : Csem.env) (m : mem) (a : Csyntax.expr) (t : trace)
- (m1 : mem) (l : block) (ofs : int) (id: ident) (fList : fieldlist) (i : ident)
- (ty : type),
- eval_lvalue ge e m a t m1 l ofs ->
- eval_lvalue_prop e m a t m1 l ofs ->
- typeof a = Tunion id fList ->
- eval_lvalue_prop e m (Expr (Efield a i) ty) t m1 l ofs).
+ 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_Enil_correct:
- (forall (e : Csem.env) (m : mem),
- eval_exprlist_prop e m Csyntax.Enil E0 m nil).
-Proof.
- intros; red; intros. monadInv TR. constructor.
-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_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_Eindex_correct
+ transl_Efield_struct_correct
+ transl_Efield_union_correct).
-Lemma transl_Econs_correct:
- (forall (e : Csem.env) (m : mem) (a : Csyntax.expr)
- (bl : Csyntax.exprlist) (t1 : trace) (m1 : mem) (v : val)
- (t2 : trace) (m2 : mem) (vl : list val),
- Csem.eval_expr ge e m a t1 m1 v ->
- eval_expr_prop e m a t1 m1 v ->
- Csem.eval_exprlist ge e m1 bl t2 m2 vl ->
- eval_exprlist_prop e m1 bl t2 m2 vl ->
- eval_exprlist_prop e m (Csyntax.Econs a bl) (t1 ** t2) m2 (v :: vl)).
+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_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_Eindex_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.
- intros; red; intros. inversion WT; clear WT; subst. simpl in TR; monadInv TR.
- econstructor; eauto.
+ induction 1; red; intros; monadInv TR; inv WT.
+ constructor.
+ constructor. eapply (transl_expr_correct _ _ H); eauto. eauto.
Qed.
+End EXPR.
+
+(** ** Semantic preservation for statements *)
+
+(** The simulation diagrams for terminating statements and function
+ calls are of the following form:
+ relies on simulation diagrams of the following form:
+<<
+ e, m1, s ------------------- te, m1, ts
+ | |
+ t| |t
+ | |
+ v v
+ e, m2, out ----------------- te, m2, tout
+>>
+ Left: execution of statement [s] in Clight.
+ Right: execution of its translation [ts] in Csharpminor.
+ Top (precondition): matching between environments [e], [te],
+ plus well-typedness of statement [s].
+ Bottom (postcondition): the outcomes [out] and [tout] are
+ related per the following function [transl_outcome].
+*)
+
+Definition transl_outcome (nbrk ncnt: nat) (out: Csem.outcome): Csharpminor.outcome :=
+ match out with
+ | Csem.Out_normal => Csharpminor.Out_normal
+ | Csem.Out_break => Csharpminor.Out_exit nbrk
+ | Csem.Out_continue => Csharpminor.Out_exit ncnt
+ | Csem.Out_return vopt => Csharpminor.Out_return vopt
+ end.
+
+Definition exec_stmt_prop
+ (e: Csem.env) (m1: mem) (s: Csyntax.statement) (t: trace)
+ (m2: mem) (out: Csem.outcome) : Prop :=
+ forall tyenv nbrk ncnt ts te
+ (WT: wt_stmt tyenv s)
+ (TR: transl_statement nbrk ncnt s = OK ts)
+ (MENV: match_env tyenv e te),
+ Csharpminor.exec_stmt tprog te m1 ts t m2 (transl_outcome nbrk ncnt out).
+
+Definition exec_lblstmts_prop
+ (e: Csem.env) (m1: mem) (s: Csyntax.labeled_statements)
+ (t: trace) (m2: mem) (out: Csem.outcome) : Prop :=
+ forall tyenv nbrk ncnt body ts te m0 t0
+ (WT: wt_lblstmts tyenv s)
+ (TR: transl_lblstmts (lblstmts_length s)
+ (1 + lblstmts_length s + ncnt)
+ s body = OK ts)
+ (MENV: match_env tyenv e te)
+ (BODY: Csharpminor.exec_stmt tprog te m0 body t0 m1 Out_normal),
+ Csharpminor.exec_stmt tprog te m0 ts (t0 ** t) m2
+ (transl_outcome nbrk ncnt (outcome_switch out)).
+
+Definition eval_funcall_prop
+ (m1: mem) (f: Csyntax.fundef) (params: list val)
+ (t: trace) (m2: mem) (res: val) : Prop :=
+ forall tf
+ (WT: wt_fundef (global_typenv prog) f)
+ (TR: transl_fundef f = OK tf),
+ Csharpminor.eval_funcall tprog m1 tf params t m2 res.
+
+(*
+Set Printing Depth 100.
+Check (Csem.eval_funcall_ind3 ge exec_stmt_prop exec_lblstmts_prop eval_funcall_prop).
+*)
+
Lemma transl_Sskip_correct:
(forall (e : Csem.env) (m : mem),
exec_stmt_prop e m Csyntax.Sskip E0 m Csem.Out_normal).
@@ -802,28 +844,13 @@ Proof.
intros; red; intros. monadInv TR. simpl. constructor.
Qed.
-Lemma transl_Sexpr_correct:
- (forall (e : Csem.env) (m : mem) (a : Csyntax.expr) (t : trace)
- (m1 : mem) (v : val),
- Csem.eval_expr ge e m a t m1 v ->
- eval_expr_prop e m a t m1 v ->
- exec_stmt_prop e m (Csyntax.Sexpr a) t m1 Csem.Out_normal).
-Proof.
- intros; red; intros; simpl. inversion WT; clear WT; subst.
- monadInv TR. econstructor; eauto.
-Qed.
-
Lemma transl_Sassign_correct:
- (forall (e : Csem.env) (m : mem) (a1 a2 : Csyntax.expr) (t1 : trace)
- (m1 : mem) (loc : block) (ofs : int) (t2 : trace) (m2 : mem)
- (v2 : val) (m3 : mem),
- eval_lvalue ge e m a1 t1 m1 loc ofs ->
- eval_lvalue_prop e m a1 t1 m1 loc ofs ->
- Csem.eval_expr ge e m1 a2 t2 m2 v2 ->
- eval_expr_prop e m1 a2 t2 m2 v2 ->
- store_value_of_type (typeof a1) m2 loc ofs v2 = Some m3 ->
- exec_stmt_prop e m (Csyntax.Sassign a1 a2) (t1 ** t2) m3
- Csem.Out_normal).
+ forall (e : Csem.env) (m : mem) (a1 a2 : Csyntax.expr) (loc : block)
+ (ofs : int) (v2 : val) (m' : mem),
+ eval_lvalue ge e m a1 loc ofs ->
+ Csem.eval_expr ge e m a2 v2 ->
+ store_value_of_type (typeof a1) m loc ofs v2 = Some m' ->
+ exec_stmt_prop e m (Csyntax.Sassign a1 a2) E0 m' Csem.Out_normal.
Proof.
intros; red; intros.
inversion WT; subst; clear WT.
@@ -832,12 +859,70 @@ Proof.
(* a = variable id *)
intros id ISVAR. rewrite ISVAR in TR.
generalize (is_variable_correct _ _ ISVAR). intro EQ.
- rewrite EQ in H; rewrite EQ in H0; rewrite EQ in H6.
+ rewrite EQ in H; rewrite EQ in H4.
monadInv TR.
- eapply var_set_correct; eauto.
+ eapply var_set_correct; eauto.
+ eapply (transl_expr_correct _ _ _ _ MENV _ _ H0); eauto.
(* a is not a variable *)
intro ISVAR; rewrite ISVAR in TR. monadInv TR.
eapply make_store_correct; eauto.
+ eapply (transl_lvalue_correct _ _ _ _ MENV _ _ _ H); eauto.
+ eapply (transl_expr_correct _ _ _ _ MENV _ _ H0); eauto.
+Qed.
+
+Lemma transl_Scall_None_correct:
+ forall (e : Csem.env) (m : mem) (a : Csyntax.expr)
+ (al : list Csyntax.expr) (vf : val) (vargs : list val)
+ (f : Csyntax.fundef) (t : trace) (m' : mem) (vres : val),
+ Csem.eval_expr ge e m a vf ->
+ Csem.eval_exprlist ge e m al vargs ->
+ Genv.find_funct ge vf = Some f ->
+ type_of_fundef f = typeof a ->
+ Csem.eval_funcall ge m f vargs t m' vres ->
+ eval_funcall_prop m f vargs t m' vres ->
+ exec_stmt_prop e m (Csyntax.Scall None a al) t m' Csem.Out_normal.
+Proof.
+ intros; red; intros; simpl.
+ inv WT. simpl in TR.
+ caseEq (classify_fun (typeof a)); intros; rewrite H5 in TR; monadInv TR.
+ exploit functions_translated; eauto. intros [tf [TFIND TFD]].
+ econstructor.
+ eapply (transl_expr_correct _ _ _ _ MENV _ _ H); eauto.
+ eapply (transl_exprlist_correct _ _ _ _ MENV _ _ H0); eauto.
+ eauto.
+ eapply transl_fundef_sig1; eauto. rewrite H2; auto.
+ eapply H4; eauto.
+ eapply functions_well_typed; eauto.
+ constructor.
+Qed.
+
+Lemma transl_Scall_Some_correct:
+ forall (e : Csem.env) (m : mem) (lhs a : Csyntax.expr)
+ (al : list Csyntax.expr) (loc : block) (ofs : int) (vf : val)
+ (vargs : list val) (f : Csyntax.fundef) (t : trace) (m' : mem)
+ (vres : val) (m'' : mem),
+ eval_lvalue ge e m lhs loc ofs ->
+ Csem.eval_expr ge e m a vf ->
+ Csem.eval_exprlist ge e m al vargs ->
+ Genv.find_funct ge vf = Some f ->
+ type_of_fundef f = typeof a ->
+ Csem.eval_funcall ge m f vargs t m' vres ->
+ eval_funcall_prop m f vargs t m' vres ->
+ store_value_of_type (typeof lhs) m' loc ofs vres = Some m'' ->
+ exec_stmt_prop e m (Csyntax.Scall (Some lhs) a al) t m'' Csem.Out_normal.
+Proof.
+ intros; red; intros; simpl.
+ inv WT. inv H10. unfold transl_statement in TR.
+ caseEq (classify_fun (typeof a)); intros; rewrite H7 in TR; monadInv TR.
+ exploit functions_translated; eauto. intros [tf [TFIND TFD]].
+ econstructor.
+ eapply (transl_expr_correct _ _ _ _ MENV _ _ H0); eauto.
+ eapply (transl_exprlist_correct _ _ _ _ MENV _ _ H1); eauto.
+ eauto.
+ eapply transl_fundef_sig1; eauto. rewrite H3; auto.
+ eapply H5; eauto.
+ eapply functions_well_typed; eauto.
+ eapply call_dest_set_correct; eauto.
Qed.
Lemma transl_Ssequence_1_correct:
@@ -867,35 +952,39 @@ Proof.
Qed.
Lemma transl_Sifthenelse_true_correct:
- (forall (e : Csem.env) (m : mem) (a : Csyntax.expr)
- (s1 s2 : statement) (t1 : trace) (m1 : mem) (v1 : val) (t2 : trace)
- (m2 : mem) (out : Csem.outcome),
- Csem.eval_expr ge e m a t1 m1 v1 ->
- eval_expr_prop e m a t1 m1 v1 ->
+ (forall (e : Csem.env) (m : mem) (a : Csyntax.expr)
+ (s1 s2 : statement) (v1 : val) (t : trace) (m' : mem)
+ (out : Csem.outcome),
+ Csem.eval_expr ge e m a v1 ->
is_true v1 (typeof a) ->
- Csem.exec_stmt ge e m1 s1 t2 m2 out ->
- exec_stmt_prop e m1 s1 t2 m2 out ->
- exec_stmt_prop e m (Csyntax.Sifthenelse a s1 s2) (t1 ** t2) m2 out).
+ Csem.exec_stmt ge e m s1 t m' out ->
+ exec_stmt_prop e m s1 t m' out ->
+ exec_stmt_prop e m (Csyntax.Sifthenelse a s1 s2) t m' out).
Proof.
intros; red; intros. inversion WT; clear WT; subst. simpl in TR; monadInv TR.
- exploit make_boolean_correct_true. eapply H0; eauto. eauto. intros [vb [EVAL ISTRUE]].
- eapply exec_Sifthenelse_true; eauto.
+ exploit make_boolean_correct_true.
+ eapply (transl_expr_correct _ _ _ _ MENV _ _ H); eauto.
+ eauto.
+ intros [vb [EVAL ISTRUE]].
+ eapply exec_Sifthenelse; eauto. apply Val.bool_of_true_val; eauto. simpl; eauto.
Qed.
Lemma transl_Sifthenelse_false_correct:
(forall (e : Csem.env) (m : mem) (a : Csyntax.expr)
- (s1 s2 : statement) (t1 : trace) (m1 : mem) (v1 : val) (t2 : trace)
- (m2 : mem) (out : Csem.outcome),
- Csem.eval_expr ge e m a t1 m1 v1 ->
- eval_expr_prop e m a t1 m1 v1 ->
+ (s1 s2 : statement) (v1 : val) (t : trace) (m' : mem)
+ (out : Csem.outcome),
+ Csem.eval_expr ge e m a v1 ->
is_false v1 (typeof a) ->
- Csem.exec_stmt ge e m1 s2 t2 m2 out ->
- exec_stmt_prop e m1 s2 t2 m2 out ->
- exec_stmt_prop e m (Csyntax.Sifthenelse a s1 s2) (t1 ** t2) m2 out).
+ Csem.exec_stmt ge e m s2 t m' out ->
+ exec_stmt_prop e m s2 t m' out ->
+ exec_stmt_prop e m (Csyntax.Sifthenelse a s1 s2) t m' out).
Proof.
intros; red; intros. inversion WT; clear WT; subst. simpl in TR; monadInv TR.
- exploit make_boolean_correct_false. eapply H0; eauto. eauto. intros [vb [EVAL ISFALSE]].
- eapply exec_Sifthenelse_false; eauto.
+ exploit make_boolean_correct_false.
+ eapply (transl_expr_correct _ _ _ _ MENV _ _ H); eauto.
+ eauto.
+ intros [vb [EVAL ISFALSE]].
+ eapply exec_Sifthenelse; eauto. apply Val.bool_of_false_val; eauto. simpl; eauto.
Qed.
Lemma transl_Sreturn_none_correct:
@@ -907,15 +996,13 @@ Proof.
Qed.
Lemma transl_Sreturn_some_correct:
- (forall (e : Csem.env) (m : mem) (a : Csyntax.expr) (t : trace)
- (m1 : mem) (v : val),
- Csem.eval_expr ge e m a t m1 v ->
- eval_expr_prop e m a t m1 v ->
- exec_stmt_prop e m (Csyntax.Sreturn (Some a)) t m1
- (Csem.Out_return (Some v))).
+ (forall (e : Csem.env) (m : mem) (a : Csyntax.expr) (v : val),
+ Csem.eval_expr ge e m a v ->
+ exec_stmt_prop e m (Csyntax.Sreturn (Some a)) E0 m (Csem.Out_return (Some v))).
Proof.
- intros; red; intros. inversion WT; clear WT; subst. simpl in TR; monadInv TR.
- simpl. eapply exec_Sreturn_some; eauto.
+ intros; red; intros. inv WT. inv H1. monadInv TR.
+ simpl. eapply exec_Sreturn_some; eauto.
+ eapply (transl_expr_correct _ _ _ _ MENV _ _ H); eauto.
Qed.
Lemma transl_Sbreak_correct:
@@ -935,47 +1022,51 @@ Proof.
Qed.
Lemma exit_if_false_true:
- forall a ts e m1 t m2 v tyenv te,
+ forall a ts e m v tyenv te,
exit_if_false a = OK ts ->
- eval_expr_prop e m1 a t m2 v ->
+ Csem.eval_expr ge e m a v ->
+ is_true v (typeof a) ->
match_env tyenv e te ->
wt_expr tyenv a ->
- is_true v (typeof a) ->
- exec_stmt tprog te m1 ts t m2 Out_normal.
+ exec_stmt tprog te m ts E0 m Out_normal.
Proof.
- intros. monadInv H.
- exploit make_boolean_correct_true. eapply H0; eauto. eauto.
+ intros. monadInv H.
+ exploit make_boolean_correct_true.
+ eapply (transl_expr_correct _ _ _ _ H2 _ _ H0); eauto.
+ eauto.
intros [vb [EVAL ISTRUE]].
- eapply exec_Sifthenelse_true with (v1 := vb); eauto.
- constructor. traceEq.
+ eapply exec_Sifthenelse with (v := vb); eauto.
+ apply Val.bool_of_true_val; eauto.
+ constructor.
Qed.
Lemma exit_if_false_false:
- forall a ts e m1 t m2 v tyenv te,
+ forall a ts e m v tyenv te,
exit_if_false a = OK ts ->
- eval_expr_prop e m1 a t m2 v ->
+ Csem.eval_expr ge e m a v ->
+ is_false v (typeof a) ->
match_env tyenv e te ->
wt_expr tyenv a ->
- is_false v (typeof a) ->
- exec_stmt tprog te m1 ts t m2 (Out_exit 0).
+ exec_stmt tprog te m ts E0 m (Out_exit 0).
Proof.
- intros. monadInv H.
- exploit make_boolean_correct_false. eapply H0; eauto. eauto.
+ intros. monadInv H.
+ exploit make_boolean_correct_false.
+ eapply (transl_expr_correct _ _ _ _ H2 _ _ H0); eauto.
+ eauto.
intros [vb [EVAL ISFALSE]].
- eapply exec_Sifthenelse_false with (v1 := vb); eauto.
- constructor. traceEq.
+ eapply exec_Sifthenelse with (v := vb); eauto.
+ apply Val.bool_of_false_val; eauto.
+ simpl. constructor.
Qed.
Lemma transl_Swhile_false_correct:
- (forall (e : Csem.env) (m : mem) (s : statement) (a : Csyntax.expr)
- (t : trace) (v : val) (m1 : mem),
- Csem.eval_expr ge e m a t m1 v ->
- eval_expr_prop e m a t m1 v ->
+ (forall (e : Csem.env) (m : mem) (a : Csyntax.expr) (s : statement)
+ (v : val),
+ Csem.eval_expr ge e m a v ->
is_false v (typeof a) ->
- exec_stmt_prop e m (Swhile a s) t m1 Csem.Out_normal).
+ exec_stmt_prop e m (Swhile a s) E0 m Csem.Out_normal).
Proof.
- intros; red; intros. inversion WT; clear WT; subst. simpl in TR; monadInv TR.
- simpl.
+ intros; red; intros; simpl. inv WT. monadInv TR.
change Out_normal with (outcome_block (Out_exit 0)).
apply exec_Sblock. apply exec_Sloop_stop. apply exec_Sseq_stop.
eapply exit_if_false_false; eauto. congruence. congruence.
@@ -999,48 +1090,45 @@ Proof.
Qed.
Lemma transl_Swhile_stop_correct:
- (forall (e : Csem.env) (m : mem) (a : Csyntax.expr) (t1 : trace)
- (m1 : mem) (v : val) (s : statement) (m2 : mem) (t2 : trace)
- (out2 out : Csem.outcome),
- Csem.eval_expr ge e m a t1 m1 v ->
- eval_expr_prop e m a t1 m1 v ->
+ (forall (e : Csem.env) (m : mem) (a : Csyntax.expr) (v : val)
+ (s : statement) (t : trace) (m' : mem) (out' out : Csem.outcome),
+ Csem.eval_expr ge e m a v ->
is_true v (typeof a) ->
- Csem.exec_stmt ge e m1 s t2 m2 out2 ->
- exec_stmt_prop e m1 s t2 m2 out2 ->
- out_break_or_return out2 out ->
- exec_stmt_prop e m (Swhile a s) (t1 ** t2) m2 out).
+ Csem.exec_stmt ge e m s t m' out' ->
+ exec_stmt_prop e m s t m' out' ->
+ out_break_or_return out' out ->
+ exec_stmt_prop e m (Swhile a s) t m' out).
Proof.
- intros; red; intros. inversion WT; clear WT; subst. simpl in TR; monadInv TR.
- rewrite (transl_out_break_or_return _ _ nbrk ncnt H4).
+ intros; red; intros. inv WT. monadInv TR.
+ rewrite (transl_out_break_or_return _ _ nbrk ncnt H3).
apply exec_Sblock. apply exec_Sloop_stop.
eapply exec_Sseq_continue.
eapply exit_if_false_true; eauto.
- apply exec_Sblock. eauto.
- auto. inversion H4; simpl; congruence.
+ apply exec_Sblock. eauto. traceEq.
+ inversion H3; simpl; congruence.
Qed.
Lemma transl_Swhile_loop_correct:
- (forall (e : Csem.env) (m : mem) (a : Csyntax.expr) (t1 : trace)
- (m1 : mem) (v : val) (s : statement) (out2 out : Csem.outcome)
- (t2 : trace) (m2 : mem) (t3 : trace) (m3 : mem),
- Csem.eval_expr ge e m a t1 m1 v ->
- eval_expr_prop e m a t1 m1 v ->
+ (forall (e : Csem.env) (m : mem) (a : Csyntax.expr) (s : statement)
+ (v : val) (t1 : trace) (m1 : mem) (out1 : Csem.outcome)
+ (t2 : trace) (m2 : mem) (out : Csem.outcome),
+ Csem.eval_expr ge e m a v ->
is_true v (typeof a) ->
- Csem.exec_stmt ge e m1 s t2 m2 out2 ->
- exec_stmt_prop e m1 s t2 m2 out2 ->
- out_normal_or_continue out2 ->
- Csem.exec_stmt ge e m2 (Swhile a s) t3 m3 out ->
- exec_stmt_prop e m2 (Swhile a s) t3 m3 out ->
- exec_stmt_prop e m (Swhile a s) (t1 ** t2 ** t3) m3 out).
+ Csem.exec_stmt ge e m s t1 m1 out1 ->
+ exec_stmt_prop e m s t1 m1 out1 ->
+ out_normal_or_continue out1 ->
+ Csem.exec_stmt ge e m1 (Swhile a s) t2 m2 out ->
+ exec_stmt_prop e m1 (Swhile a s) t2 m2 out ->
+ exec_stmt_prop e m (Swhile a s) (t1 ** t2) m2 out).
Proof.
intros; red; intros.
- exploit H6; eauto. intro NEXTITER.
- inversion WT; clear WT; subst. simpl in TR; monadInv TR.
+ exploit H5; eauto. intro NEXTITER.
+ inv WT. monadInv TR.
inversion NEXTITER; subst.
apply exec_Sblock.
eapply exec_Sloop_loop. eapply exec_Sseq_continue.
eapply exit_if_false_true; eauto.
- rewrite (transl_out_normal_or_continue _ H4).
+ rewrite (transl_out_normal_or_continue _ H3).
apply exec_Sblock. eauto.
reflexivity. eassumption.
traceEq.
@@ -1048,23 +1136,21 @@ Qed.
Lemma transl_Sdowhile_false_correct:
(forall (e : Csem.env) (m : mem) (s : statement) (a : Csyntax.expr)
- (t1 : trace) (m1 : mem) (out1 : Csem.outcome) (v : val)
- (t2 : trace) (m2 : mem),
- Csem.exec_stmt ge e m s t1 m1 out1 ->
- exec_stmt_prop e m s t1 m1 out1 ->
+ (t : trace) (m1 : mem) (out1 : Csem.outcome) (v : val),
+ Csem.exec_stmt ge e m s t m1 out1 ->
+ exec_stmt_prop e m s t m1 out1 ->
out_normal_or_continue out1 ->
- Csem.eval_expr ge e m1 a t2 m2 v ->
- eval_expr_prop e m1 a t2 m2 v ->
+ Csem.eval_expr ge e m1 a v ->
is_false v (typeof a) ->
- exec_stmt_prop e m (Sdowhile a s) (t1 ** t2) m2 Csem.Out_normal).
+ exec_stmt_prop e m (Sdowhile a s) t m1 Csem.Out_normal).
Proof.
- intros; red; intros. inversion WT; clear WT; subst. simpl in TR; monadInv TR.
+ intros; red; intros. inv WT. monadInv TR.
simpl.
change Out_normal with (outcome_block (Out_exit 0)).
apply exec_Sblock. apply exec_Sloop_stop. eapply exec_Sseq_continue.
rewrite (transl_out_normal_or_continue out1 H1).
apply exec_Sblock. eauto.
- eapply exit_if_false_false; eauto. auto. congruence.
+ eapply exit_if_false_false; eauto. traceEq. congruence.
Qed.
Lemma transl_Sdowhile_stop_correct:
@@ -1075,7 +1161,7 @@ Lemma transl_Sdowhile_stop_correct:
out_break_or_return out1 out ->
exec_stmt_prop e m (Sdowhile a s) t m1 out).
Proof.
- intros; red; intros. inversion WT; clear WT; subst. simpl in TR; monadInv TR.
+ intros; red; intros. inv WT. monadInv TR.
simpl.
assert (outcome_block (transl_outcome 1 0 out1) <> Out_normal).
inversion H1; simpl; congruence.
@@ -1087,22 +1173,19 @@ Qed.
Lemma transl_Sdowhile_loop_correct:
(forall (e : Csem.env) (m : mem) (s : statement) (a : Csyntax.expr)
- (m1 m2 m3 : mem) (t1 t2 t3 : trace) (out out1 : Csem.outcome)
- (v : val),
+ (m1 m2 : mem) (t1 t2 : trace) (out out1 : Csem.outcome) (v : val),
Csem.exec_stmt ge e m s t1 m1 out1 ->
exec_stmt_prop e m s t1 m1 out1 ->
out_normal_or_continue out1 ->
- Csem.eval_expr ge e m1 a t2 m2 v ->
- eval_expr_prop e m1 a t2 m2 v ->
+ Csem.eval_expr ge e m1 a v ->
is_true v (typeof a) ->
- Csem.exec_stmt ge e m2 (Sdowhile a s) t3 m3 out ->
- exec_stmt_prop e m2 (Sdowhile a s) t3 m3 out ->
- exec_stmt_prop e m (Sdowhile a s) (t1 ** t2 ** t3) m3 out).
+ Csem.exec_stmt ge e m1 (Sdowhile a s) t2 m2 out ->
+ exec_stmt_prop e m1 (Sdowhile a s) t2 m2 out ->
+ exec_stmt_prop e m (Sdowhile a s) (t1 ** t2) m2 out).
Proof.
intros; red; intros.
- exploit H6; eauto. intro NEXTITER.
- inversion WT; clear WT; subst. simpl in TR; monadInv TR.
- inversion NEXTITER; subst.
+ exploit H5; eauto. intro NEXTITER.
+ inv WT. monadInv TR. inversion NEXTITER; subst.
apply exec_Sblock.
eapply exec_Sloop_loop. eapply exec_Sseq_continue.
rewrite (transl_out_normal_or_continue _ H1).
@@ -1115,6 +1198,7 @@ Lemma transl_Sfor_start_correct:
(forall (e : Csem.env) (m : mem) (s a1 : statement)
(a2 : Csyntax.expr) (a3 : statement) (out : Csem.outcome)
(m1 m2 : mem) (t1 t2 : trace),
+ a1 <> Csyntax.Sskip ->
Csem.exec_stmt ge e m a1 t1 m1 Csem.Out_normal ->
exec_stmt_prop e m a1 t1 m1 Csem.Out_normal ->
Csem.exec_stmt ge e m1 (Sfor Csyntax.Sskip a2 a3 s) t2 m2 out ->
@@ -1122,101 +1206,88 @@ Lemma transl_Sfor_start_correct:
exec_stmt_prop e m (Sfor a1 a2 a3 s) (t1 ** t2) m2 out).
Proof.
intros; red; intros.
- exploit transl_stmt_Sfor_start; eauto.
- intros [ts1 [ts2 [A [B C]]]].
- clear TR; subst ts.
- inversion WT; subst.
+ destruct (transl_stmt_Sfor_start _ _ _ _ _ _ _ TR H) as [ts1 [ts2 [EQ [TR1 TR2]]]].
+ subst ts.
+ inv WT.
assert (WT': wt_stmt tyenv (Sfor Csyntax.Sskip a2 a3 s)).
constructor; auto. constructor.
- exploit H0; eauto. simpl. intro EXEC1.
- exploit H2; eauto. intro EXEC2.
- assert (EXEC3: exec_stmt tprog te m1 ts2 t2 m2 (transl_outcome nbrk ncnt out)).
- inversion EXEC2; subst.
- inversion H5; subst. rewrite E0_left; auto.
- inversion H11; subst. congruence.
- eapply exec_Sseq_continue; eauto.
+ exploit H1; eauto. simpl. intro EXEC1.
+ exploit H3; eauto. intro EXEC2.
+ eapply exec_Sseq_continue; eauto.
Qed.
Lemma transl_Sfor_false_correct:
(forall (e : Csem.env) (m : mem) (s : statement) (a2 : Csyntax.expr)
- (a3 : statement) (t : trace) (v : val) (m1 : mem),
- Csem.eval_expr ge e m a2 t m1 v ->
- eval_expr_prop e m a2 t m1 v ->
+ (a3 : statement) (v : val),
+ Csem.eval_expr ge e m a2 v ->
is_false v (typeof a2) ->
- exec_stmt_prop e m (Sfor Csyntax.Sskip a2 a3 s) t m1 Csem.Out_normal).
+ exec_stmt_prop e m (Sfor Csyntax.Sskip a2 a3 s) E0 m Csem.Out_normal).
Proof.
- intros; red; intros. inversion WT; clear WT; subst. simpl in TR; monadInv TR.
+ intros; red; intros. inv WT.
+ rewrite transl_stmt_Sfor_not_start in TR; monadInv TR.
simpl.
- eapply exec_Sseq_continue. apply exec_Sskip.
change Out_normal with (outcome_block (Out_exit 0)).
apply exec_Sblock. apply exec_Sloop_stop.
apply exec_Sseq_stop. eapply exit_if_false_false; eauto.
- congruence. congruence. traceEq.
+ congruence. congruence.
Qed.
Lemma transl_Sfor_stop_correct:
(forall (e : Csem.env) (m : mem) (s : statement) (a2 : Csyntax.expr)
- (a3 : statement) (v : val) (m1 m2 : mem) (t1 t2 : trace)
- (out2 out : Csem.outcome),
- Csem.eval_expr ge e m a2 t1 m1 v ->
- eval_expr_prop e m a2 t1 m1 v ->
+ (a3 : statement) (v : val) (m1 : mem) (t : trace)
+ (out1 out : Csem.outcome),
+ Csem.eval_expr ge e m a2 v ->
is_true v (typeof a2) ->
- Csem.exec_stmt ge e m1 s t2 m2 out2 ->
- exec_stmt_prop e m1 s t2 m2 out2 ->
- out_break_or_return out2 out ->
- exec_stmt_prop e m (Sfor Csyntax.Sskip a2 a3 s) (t1 ** t2) m2 out).
+ Csem.exec_stmt ge e m s t m1 out1 ->
+ exec_stmt_prop e m s t m1 out1 ->
+ out_break_or_return out1 out ->
+ exec_stmt_prop e m (Sfor Csyntax.Sskip a2 a3 s) t m1 out).
Proof.
- intros; red; intros. inversion WT; clear WT; subst. simpl in TR; monadInv TR.
- simpl.
- assert (outcome_block (transl_outcome 1 0 out2) <> Out_normal).
- inversion H4; simpl; congruence.
- rewrite (transl_out_break_or_return _ _ nbrk ncnt H4).
- eapply exec_Sseq_continue. apply exec_Sskip.
+ intros; red; intros. inv WT.
+ rewrite transl_stmt_Sfor_not_start in TR; monadInv TR.
+ assert (outcome_block (transl_outcome 1 0 out1) <> Out_normal).
+ inversion H3; simpl; congruence.
+ rewrite (transl_out_break_or_return _ _ nbrk ncnt H3).
apply exec_Sblock. apply exec_Sloop_stop.
eapply exec_Sseq_continue. eapply exit_if_false_true; eauto.
apply exec_Sseq_stop. apply exec_Sblock. eauto.
- auto. reflexivity. auto. traceEq.
+ auto. reflexivity. auto.
Qed.
Lemma transl_Sfor_loop_correct:
(forall (e : Csem.env) (m : mem) (s : statement) (a2 : Csyntax.expr)
- (a3 : statement) (v : val) (m1 m2 m3 m4 : mem)
- (t1 t2 t3 t4 : trace) (out2 out : Csem.outcome),
- Csem.eval_expr ge e m a2 t1 m1 v ->
- eval_expr_prop e m a2 t1 m1 v ->
+ (a3 : statement) (v : val) (m1 m2 m3 : mem) (t1 t2 t3 : trace)
+ (out1 out : Csem.outcome),
+ Csem.eval_expr ge e m a2 v ->
is_true v (typeof a2) ->
- Csem.exec_stmt ge e m1 s t2 m2 out2 ->
- exec_stmt_prop e m1 s t2 m2 out2 ->
- out_normal_or_continue out2 ->
- Csem.exec_stmt ge e m2 a3 t3 m3 Csem.Out_normal ->
- exec_stmt_prop e m2 a3 t3 m3 Csem.Out_normal ->
- Csem.exec_stmt ge e m3 (Sfor Csyntax.Sskip a2 a3 s) t4 m4 out ->
- exec_stmt_prop e m3 (Sfor Csyntax.Sskip a2 a3 s) t4 m4 out ->
- exec_stmt_prop e m (Sfor Csyntax.Sskip a2 a3 s)
- (t1 ** t2 ** t3 ** t4) m4 out).
+ Csem.exec_stmt ge e m s t1 m1 out1 ->
+ exec_stmt_prop e m s t1 m1 out1 ->
+ out_normal_or_continue out1 ->
+ Csem.exec_stmt ge e m1 a3 t2 m2 Csem.Out_normal ->
+ exec_stmt_prop e m1 a3 t2 m2 Csem.Out_normal ->
+ Csem.exec_stmt ge e m2 (Sfor Csyntax.Sskip a2 a3 s) t3 m3 out ->
+ exec_stmt_prop e m2 (Sfor Csyntax.Sskip a2 a3 s) t3 m3 out ->
+ exec_stmt_prop e m (Sfor Csyntax.Sskip a2 a3 s) (t1 ** t2 ** t3) m3 out).
Proof.
intros; red; intros.
- exploit H8; eauto. intro NEXTITER.
- inversion WT; clear WT; subst. simpl in TR; monadInv TR.
+ exploit H7; eauto. intro NEXTITER.
+ inv WT.
+ rewrite transl_stmt_Sfor_not_start in TR; monadInv TR.
inversion NEXTITER; subst.
- inversion H11; subst.
- inversion H18; subst.
- eapply exec_Sseq_continue. apply exec_Sskip.
apply exec_Sblock.
eapply exec_Sloop_loop. eapply exec_Sseq_continue.
eapply exit_if_false_true; eauto.
eapply exec_Sseq_continue.
- rewrite (transl_out_normal_or_continue _ H4).
+ rewrite (transl_out_normal_or_continue _ H3).
apply exec_Sblock. eauto.
- red in H6; simpl in H6; eauto.
+ red in H5; simpl in H5; eauto.
reflexivity. reflexivity. eassumption.
- reflexivity. traceEq.
- inversion H17. congruence.
+ traceEq.
Qed.
Lemma transl_lblstmts_switch:
- forall e m0 t1 m1 n nbrk ncnt tyenv te t2 m2 out sl body ts,
- exec_stmt tprog te m0 body t1 m1
+ forall e m0 m1 n nbrk ncnt tyenv te t0 t m2 out sl body ts,
+ exec_stmt tprog te m0 body t0 m1
(Out_exit (switch_target n (lblstmts_length sl) (switch_table sl 0))) ->
transl_lblstmts
(lblstmts_length sl)
@@ -1224,8 +1295,8 @@ Lemma transl_lblstmts_switch:
sl (Sblock body) = OK ts ->
wt_lblstmts tyenv sl ->
match_env tyenv e te ->
- exec_lblstmts_prop e m1 (select_switch n sl) t2 m2 out ->
- Csharpminor.exec_stmt tprog te m0 ts (t1 ** t2) m2
+ exec_lblstmts_prop e m1 (select_switch n sl) t m2 out ->
+ Csharpminor.exec_stmt tprog te m0 ts (t0 ** t) m2
(transl_outcome nbrk ncnt (outcome_switch out)).
Proof.
induction sl; intros.
@@ -1251,24 +1322,20 @@ Proof.
Qed.
Lemma transl_Sswitch_correct:
- (forall (e : Csem.env) (m : mem) (a : Csyntax.expr) (t1 : trace)
- (m1 : mem) (n : int) (sl : labeled_statements) (t2 : trace)
- (m2 : mem) (out : Csem.outcome),
- Csem.eval_expr ge e m a t1 m1 (Vint n) ->
- eval_expr_prop e m a t1 m1 (Vint n) ->
- exec_lblstmts ge e m1 (select_switch n sl) t2 m2 out ->
- exec_lblstmts_prop e m1 (select_switch n sl) t2 m2 out ->
- exec_stmt_prop e m (Csyntax.Sswitch a sl) (t1 ** t2) m2
- (outcome_switch out)).
+ (forall (e : Csem.env) (m : mem) (a : Csyntax.expr) (t : trace)
+ (n : int) (sl : labeled_statements) (m1 : mem) (out : Csem.outcome),
+ Csem.eval_expr ge e m a (Vint n) ->
+ exec_lblstmts ge e m (select_switch n sl) t m1 out ->
+ exec_lblstmts_prop e m (select_switch n sl) t m1 out ->
+ exec_stmt_prop e m (Csyntax.Sswitch a sl) t m1 (outcome_switch out)).
Proof.
intros; red; intros.
- inversion WT; clear WT; subst.
- simpl in TR. monadInv TR.
+ inv WT. monadInv TR.
rewrite length_switch_table in EQ0.
replace (ncnt + lblstmts_length sl + 1)%nat
with (S (lblstmts_length sl + ncnt))%nat in EQ0 by omega.
- eapply transl_lblstmts_switch; eauto.
- constructor. eapply H0; eauto.
+ change t with (E0 ** t). eapply transl_lblstmts_switch; eauto.
+ constructor. eapply (transl_expr_correct _ _ _ _ MENV _ _ H); eauto.
Qed.
Lemma transl_LSdefault_correct:
@@ -1278,9 +1345,7 @@ Lemma transl_LSdefault_correct:
exec_stmt_prop e m s t m1 out ->
exec_lblstmts_prop e m (LSdefault s) t m1 out).
Proof.
- intros; red; intros.
- inversion WT; subst.
- simpl in TR. monadInv TR.
+ intros; red; intros. inv WT. monadInv TR.
replace (transl_outcome nbrk ncnt (outcome_switch out))
with (outcome_block (transl_outcome 0 (S ncnt) out)).
constructor.
@@ -1299,11 +1364,9 @@ Lemma transl_LScase_fallthrough_correct:
exec_lblstmts_prop e m1 ls t2 m2 out ->
exec_lblstmts_prop e m (LScase n s ls) (t1 ** t2) m2 out).
Proof.
- intros; red; intros.
- inversion WT; subst.
- monadInv TR.
+ intros; red; intros. inv WT. monadInv TR.
assert (exec_stmt tprog te m0 (Sblock (Sseq body x))
- (t0 ** t1) m1 Out_normal).
+ (t0 ** t1) m1 Out_normal).
change Out_normal with
(outcome_block (transl_outcome (S (lblstmts_length ls))
(S (S (lblstmts_length ls + ncnt)))
@@ -1316,7 +1379,7 @@ Proof.
Qed.
Lemma transl_LScase_stop_correct:
- (forall (e : Csem.env) (m : mem) (n : int) (s : statement)
+ (forall (e : Csem.env) (m : mem) (n : int) (s : statement)
(ls : labeled_statements) (t : trace) (m1 : mem)
(out : Csem.outcome),
Csem.exec_stmt ge e m s t m1 out ->
@@ -1324,9 +1387,7 @@ Lemma transl_LScase_stop_correct:
out <> Csem.Out_normal ->
exec_lblstmts_prop e m (LScase n s ls) t m1 out).
Proof.
- intros; red; intros.
- inversion WT; subst.
- monadInv TR.
+ intros; red; intros. inv WT. monadInv TR.
exploit H0; eauto. intro EXEC.
destruct out; simpl; simpl in EXEC.
(* out = Out_break *)
@@ -1378,8 +1439,7 @@ Lemma transl_funcall_internal_correct:
Proof.
intros; red; intros.
(* Exploitation of typing hypothesis *)
- inversion WT; clear WT; subst.
- inversion H6; clear H6; subst.
+ inv WT. inv H6.
(* Exploitation of translation hypothesis *)
monadInv TR.
monadInv EQ.
@@ -1419,38 +1479,55 @@ Theorem transl_funcall_correct:
Csem.eval_funcall ge m f l t m0 v ->
eval_funcall_prop m f l t m0 v.
Proof
- (Csem.eval_funcall_ind6 ge
- eval_expr_prop
- eval_lvalue_prop
- eval_exprlist_prop
+ (Csem.eval_funcall_ind3 ge
+ exec_stmt_prop
+ exec_lblstmts_prop
+ eval_funcall_prop
+
+ transl_Sskip_correct
+ transl_Sassign_correct
+ transl_Scall_None_correct
+ transl_Scall_Some_correct
+ transl_Ssequence_1_correct
+ transl_Ssequence_2_correct
+ transl_Sifthenelse_true_correct
+ transl_Sifthenelse_false_correct
+ transl_Sreturn_none_correct
+ transl_Sreturn_some_correct
+ transl_Sbreak_correct
+ transl_Scontinue_correct
+ transl_Swhile_false_correct
+ transl_Swhile_stop_correct
+ transl_Swhile_loop_correct
+ transl_Sdowhile_false_correct
+ transl_Sdowhile_stop_correct
+ transl_Sdowhile_loop_correct
+ transl_Sfor_start_correct
+ transl_Sfor_false_correct
+ transl_Sfor_stop_correct
+ transl_Sfor_loop_correct
+ transl_Sswitch_correct
+ transl_LSdefault_correct
+ transl_LScase_fallthrough_correct
+ transl_LScase_stop_correct
+ transl_funcall_internal_correct
+ transl_funcall_external_correct).
+
+Theorem transl_stmt_correct:
+ forall (e: Csem.env) (m1: mem) (s: Csyntax.statement) (t: trace)
+ (m2: mem) (out: Csem.outcome),
+ Csem.exec_stmt ge e m1 s t m2 out ->
+ exec_stmt_prop e m1 s t m2 out.
+Proof
+ (Csem.exec_stmt_ind3 ge
exec_stmt_prop
exec_lblstmts_prop
eval_funcall_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_Eorbool_1_correct
- transl_Eorbool_2_correct
- transl_Eandbool_1_correct
- transl_Eandbool_2_correct
- transl_Ecast_correct
- transl_Ecall_correct
- transl_Evar_local_correct
- transl_Evar_global_correct
- transl_Ederef_correct
- transl_Eindex_correct
- transl_Efield_struct_correct
- transl_Efield_union_correct
- transl_Enil_correct
- transl_Econs_correct
transl_Sskip_correct
- transl_Sexpr_correct
transl_Sassign_correct
+ transl_Scall_None_correct
+ transl_Scall_Some_correct
transl_Ssequence_1_correct
transl_Ssequence_2_correct
transl_Sifthenelse_true_correct
@@ -1476,41 +1553,287 @@ Proof
transl_funcall_internal_correct
transl_funcall_external_correct).
+(** ** Semantic preservation for divergence *)
+
+Lemma transl_funcall_divergence_correct:
+ forall m1 f params t tf,
+ Csem.evalinf_funcall ge m1 f params t ->
+ wt_fundef (global_typenv prog) f ->
+ transl_fundef f = OK tf ->
+ Csharpminor.evalinf_funcall tprog m1 tf params t.
+Proof.
+ cofix FUNCALL.
+ assert (STMT:
+ forall e m1 s t,
+ Csem.execinf_stmt ge e m1 s t ->
+ forall tyenv nbrk ncnt ts te
+ (WT: wt_stmt tyenv s)
+ (TR: transl_statement nbrk ncnt s = OK ts)
+ (MENV: match_env tyenv e te),
+ Csharpminor.execinf_stmt tprog te m1 ts t).
+ cofix STMT.
+ assert(LBLSTMT:
+ forall s ncnt body ts tyenv e te m0 t0 m1 t1 n,
+ transl_lblstmts (lblstmts_length s)
+ (S (lblstmts_length s + ncnt))
+ s body = OK ts ->
+ wt_lblstmts tyenv s ->
+ match_env tyenv e te ->
+ (exec_stmt tprog te m0 body t0 m1
+ (outcome_block (Out_exit
+ (switch_target n (lblstmts_length s) (switch_table s 0))))
+ /\ execinf_lblstmts ge e m1 (select_switch n s) t1)
+ \/ (exec_stmt tprog te m0 body t0 m1 Out_normal
+ /\ execinf_lblstmts ge e m1 s t1) ->
+ execinf_stmt_N tprog (lblstmts_length s) te m0 ts (t0 *** t1)).
+
+ cofix LBLSTMT; intros.
+ destruct s; simpl in *; monadInv H; inv H0.
+ (* 1. LSdefault *)
+ assert (exec_stmt tprog te m0 body t0 m1 Out_normal) by tauto.
+ assert (execinf_lblstmts ge e m1 (LSdefault s) t1) by tauto.
+ clear H2. inv H0.
+ change (Sblock (Sseq body x))
+ with ((fun z => Sblock z) (Sseq body x)).
+ apply execinf_context.
+ eapply execinf_Sseq_2. eauto. eapply STMT; eauto. auto.
+ constructor.
+ (* 2. LScase *)
+ elim H2; clear H2.
+ (* 2.1 searching for the case *)
+ rewrite (Int.eq_sym i n).
+ destruct (Int.eq n i).
+ (* 2.1.1 found it! *)
+ intros [A B]. inv B.
+ (* 2.1.1.1 we diverge because of this case *)
+ destruct (transl_lblstmts_context _ _ _ _ _ EQ0) as [ctx [CTX EQ1]].
+ rewrite EQ1. apply execinf_context; auto.
+ apply execinf_Sblock. eapply execinf_Sseq_2. eauto.
+ eapply STMT; eauto. auto.
+ (* 2.1.1.2 we diverge later, after falling through *)
+ simpl. apply execinf_sleep.
+ replace (t0 *** t2 *** t3) with ((t0 ** t2) *** t3).
+ eapply LBLSTMT with (n := n); eauto. right. split.
+ change Out_normal with (outcome_block Out_normal).
+ apply exec_Sblock.
+ eapply exec_Sseq_continue. eauto.
+ change Out_normal with (transl_outcome (S (lblstmts_length s0)) (S (S (lblstmts_length s0 + ncnt))) Csem.Out_normal).
+ eapply (transl_stmt_correct _ _ _ _ _ _ H8); eauto.
+ auto. auto. traceEq.
+ (* 2.1.2 still searching *)
+ rewrite switch_target_table_shift. intros [A B].
+ apply execinf_sleep.
+ eapply LBLSTMT with (n := n); eauto. left. split.
+ fold (outcome_block (Out_exit (switch_target n (lblstmts_length s0) (switch_table s0 0)))).
+ apply exec_Sblock. apply exec_Sseq_stop. eauto. congruence.
+ auto.
+ (* 2.2 found the case already, falling through next cases *)
+ intros [A B]. inv B.
+ (* 2.2.1 we diverge because of this case *)
+ destruct (transl_lblstmts_context _ _ _ _ _ EQ0) as [ctx [CTX EQ1]].
+ rewrite EQ1. apply execinf_context; auto.
+ apply execinf_Sblock. eapply execinf_Sseq_2. eauto.
+ eapply STMT; eauto. auto.
+ (* 2.2.2 we diverge later *)
+ simpl. apply execinf_sleep.
+ replace (t0 *** t2 *** t3) with ((t0 ** t2) *** t3).
+ eapply LBLSTMT with (n := n); eauto. right. split.
+ change Out_normal with (outcome_block Out_normal).
+ apply exec_Sblock.
+ eapply exec_Sseq_continue. eauto.
+ change Out_normal with (transl_outcome (S (lblstmts_length s0)) (S (S (lblstmts_length s0 + ncnt))) Csem.Out_normal).
+ eapply (transl_stmt_correct _ _ _ _ _ _ H8); eauto.
+ auto. auto. traceEq.
+
+
+ intros. inv H; inv WT; try (generalize TR; intro TR'; monadInv TR').
+ (* Scall *)
+ simpl in TR.
+ caseEq (classify_fun (typeof a)); intros; rewrite H in TR; monadInv TR.
+ destruct (functions_translated _ _ H2) as [tf [TFIND TFD]].
+ eapply execinf_Scall.
+ eapply (transl_expr_correct _ _ _ _ MENV _ _ H0); eauto.
+ eapply (transl_exprlist_correct _ _ _ _ MENV _ _ H1); eauto.
+ eauto.
+ eapply transl_fundef_sig1; eauto. rewrite H3; auto.
+ eapply FUNCALL; eauto.
+ eapply functions_well_typed; eauto.
+ (* Sseq 1 *)
+ apply execinf_Sseq_1. eapply STMT; eauto.
+ (* Sseq 2 *)
+ eapply execinf_Sseq_2.
+ change Out_normal with (transl_outcome nbrk ncnt Csem.Out_normal).
+ eapply (transl_stmt_correct _ _ _ _ _ _ H0); eauto.
+ eapply STMT; eauto. auto.
+ (* Sifthenelse, true *)
+ assert (eval_expr tprog te m1 x v1).
+ eapply (transl_expr_correct _ _ _ _ MENV _ _ H0); eauto.
+ destruct (make_boolean_correct_true _ _ _ _ _ _ H H1) as [vb [A B]].
+ eapply execinf_Sifthenelse. eauto. apply Val.bool_of_true_val; eauto.
+ auto. eapply STMT; eauto.
+ (* Sifthenelse, false *)
+ assert (eval_expr tprog te m1 x v1).
+ eapply (transl_expr_correct _ _ _ _ MENV _ _ H0); eauto.
+ destruct (make_boolean_correct_false _ _ _ _ _ _ H H1) as [vb [A B]].
+ eapply execinf_Sifthenelse. eauto. apply Val.bool_of_false_val; eauto.
+ auto. eapply STMT; eauto.
+ (* Swhile, body *)
+ apply execinf_Sblock. apply execinf_Sloop_body.
+ eapply execinf_Sseq_2. eapply exit_if_false_true; eauto.
+ apply execinf_Sblock. eapply STMT; eauto. traceEq.
+ (* Swhile, loop *)
+ apply execinf_Sblock. eapply execinf_Sloop_block.
+ eapply exec_Sseq_continue. eapply exit_if_false_true; eauto.
+ rewrite (transl_out_normal_or_continue out1 H3).
+ apply exec_Sblock.
+ eapply (transl_stmt_correct _ _ _ _ _ _ H2); eauto. reflexivity.
+ eapply STMT with (nbrk := 1%nat) (ncnt := 0%nat); eauto.
+ constructor; eauto.
+ traceEq.
+ (* Sdowhile, body *)
+ apply execinf_Sblock. apply execinf_Sloop_body.
+ apply execinf_Sseq_1. apply execinf_Sblock.
+ eapply STMT; eauto.
+ (* Sdowhile, loop *)
+ apply execinf_Sblock. eapply execinf_Sloop_block.
+ eapply exec_Sseq_continue.
+ rewrite (transl_out_normal_or_continue out1 H1).
+ apply exec_Sblock.
+ eapply (transl_stmt_correct _ _ _ _ _ _ H0); eauto.
+ eapply exit_if_false_true; eauto. reflexivity.
+ eapply STMT with (nbrk := 1%nat) (ncnt := 0%nat); eauto.
+ constructor; auto.
+ traceEq.
+ (* Sfor start 1 *)
+ simpl in TR. destruct (is_Sskip a1).
+ subst a1. inv H0.
+ monadInv TR.
+ apply execinf_Sseq_1. eapply STMT; eauto.
+ (* Sfor start 2 *)
+ destruct (transl_stmt_Sfor_start _ _ _ _ _ _ _ TR H0) as [ts1 [ts2 [EQ [TR1 TR2]]]].
+ subst ts.
+ eapply execinf_Sseq_2.
+ change Out_normal with (transl_outcome nbrk ncnt Csem.Out_normal).
+ eapply (transl_stmt_correct _ _ _ _ _ _ H1); eauto.
+ eapply STMT; eauto.
+ constructor; auto. constructor.
+ auto.
+ (* Sfor_body *)
+ rewrite transl_stmt_Sfor_not_start in TR; monadInv TR.
+ apply execinf_Sblock. apply execinf_Sloop_body.
+ eapply execinf_Sseq_2.
+ eapply exit_if_false_true; eauto.
+ apply execinf_Sseq_1. apply execinf_Sblock.
+ eapply STMT; eauto.
+ traceEq.
+ (* Sfor next *)
+ rewrite transl_stmt_Sfor_not_start in TR; monadInv TR.
+ apply execinf_Sblock. apply execinf_Sloop_body.
+ eapply execinf_Sseq_2.
+ eapply exit_if_false_true; eauto.
+ eapply execinf_Sseq_2.
+ rewrite (transl_out_normal_or_continue out1 H3).
+ apply exec_Sblock.
+ eapply (transl_stmt_correct _ _ _ _ _ _ H2); eauto.
+ eapply STMT; eauto.
+ reflexivity. traceEq.
+ (* Sfor loop *)
+ generalize TR. rewrite transl_stmt_Sfor_not_start; intro TR'; monadInv TR'.
+ apply execinf_Sblock. eapply execinf_Sloop_block.
+ eapply exec_Sseq_continue.
+ eapply exit_if_false_true; eauto.
+ eapply exec_Sseq_continue.
+ rewrite (transl_out_normal_or_continue out1 H3).
+ apply exec_Sblock.
+ eapply (transl_stmt_correct _ _ _ _ _ _ H2); eauto.
+ change Out_normal with (transl_outcome nbrk ncnt Csem.Out_normal).
+ eapply (transl_stmt_correct _ _ _ _ _ _ H4); eauto.
+ reflexivity. reflexivity.
+ eapply STMT; eauto.
+ constructor; auto.
+ traceEq.
+ (* Sswitch *)
+ apply execinf_stutter with (lblstmts_length sl).
+ rewrite length_switch_table in EQ0.
+ replace (ncnt + lblstmts_length sl + 1)%nat
+ with (S (lblstmts_length sl + ncnt))%nat in EQ0 by omega.
+ change t with (E0 *** t).
+ eapply LBLSTMT; eauto.
+ left. split. apply exec_Sblock. constructor.
+ eapply (transl_expr_correct _ _ _ _ MENV _ _ H0); eauto.
+ auto.
+
+ (* Functions *)
+ intros. inv H.
+ (* Exploitation of typing hypothesis *)
+ inv H0. inv H6.
+ (* Exploitation of translation hypothesis *)
+ monadInv H1. monadInv EQ.
+ (* Allocation of variables *)
+ assert (match_env (global_typenv prog) Csem.empty_env Csharpminor.empty_env).
+ apply match_globalenv_match_env_empty. apply match_global_typenv.
+ generalize (transl_fn_variables _ _ (signature_of_function f0) _ _ x2 EQ0 EQ).
+ intro.
+ destruct (match_env_alloc_variables _ _ _ _ _ _ H2 _ _ _ H1 H5)
+ as [te [ALLOCVARS MATCHENV]].
+ (* Execution *)
+ econstructor; simpl.
+ eapply transl_names_norepet; eauto.
+ eexact ALLOCVARS.
+ eapply bind_parameters_match; eauto.
+ eapply STMT; eauto.
+Qed.
+
End CORRECTNESS.
(** Semantic preservation for whole programs. *)
Theorem transl_program_correct:
- forall prog tprog t r,
+ forall prog tprog beh,
transl_program prog = OK tprog ->
Ctyping.wt_program prog ->
- Csem.exec_program prog t r ->
- Csharpminor.exec_program tprog t r.
+ Csem.exec_program prog beh ->
+ Csharpminor.exec_program tprog beh.
Proof.
- intros until r. intros TRANSL WT [b [f [m1 [FINDS [FINDF EVAL]]]]].
- inversion WT; subst.
-
+ intros. inversion H0; subst. inv H1.
+ (* Termination *)
assert (exists targs, type_of_fundef f = Tfunction targs (Tint I32 Signed)).
apply wt_program_main.
eapply Genv.find_funct_ptr_symbol_inversion; eauto.
- elim H; clear H; intros targs TYP.
+ elim H1; clear H1; intros targs TYP.
assert (targs = Tnil).
- inversion EVAL; subst; simpl in TYP.
- inversion H0; subst. injection TYP. rewrite <- H6. simpl; auto.
- inversion TYP; subst targs0 tres. inversion H. simpl in H0.
- inversion H0. destruct targs; simpl in H8; congruence.
+ inv H4; simpl in TYP.
+ inv H5. injection TYP. rewrite <- H10. simpl. auto.
+ inv TYP. inv H1.
+ destruct targs; simpl in H4. auto. inv H4.
subst targs.
exploit function_ptr_translated; eauto. intros [tf [TFINDF TRANSLFD]].
- exists b; exists tf; exists m1.
- split.
- rewrite (symbols_preserved _ _ TRANSL).
- rewrite (transform_partial_program2_main transl_fundef transl_globvar prog TRANSL). auto.
- split. auto.
- split.
- generalize (transl_fundef_sig2 _ _ _ _ TRANSLFD TYP). simpl; auto.
- rewrite (@Genv.init_mem_transf_partial2 _ _ _ _ transl_fundef transl_globvar prog tprog TRANSL).
- generalize (transl_funcall_correct _ _ WT TRANSL _ _ _ _ _ _ EVAL).
- intro. eapply H.
+ apply program_terminates with b tf m1.
+ rewrite (symbols_preserved _ _ H).
+ rewrite (transform_partial_program2_main transl_fundef transl_globvar prog H). auto.
+ auto.
+ generalize (transl_fundef_sig2 _ _ _ _ TRANSLFD TYP). simpl; auto.
+ rewrite (@Genv.init_mem_transf_partial2 _ _ _ _ transl_fundef transl_globvar prog tprog H).
+ generalize (transl_funcall_correct _ _ H0 H _ _ _ _ _ _ H4).
+ intro. eapply H1.
eapply function_ptr_well_typed; eauto.
auto.
+ (* Divergence *)
+ assert (exists targs, type_of_fundef f = Tfunction targs (Tint I32 Signed)).
+ apply wt_program_main.
+ eapply Genv.find_funct_ptr_symbol_inversion; eauto.
+ elim H1; clear H1; intros targs TYP.
+ assert (targs = Tnil).
+ inv H4; simpl in TYP.
+ inv H5. injection TYP. rewrite <- H9. simpl. auto.
+ subst targs.
+ exploit function_ptr_translated; eauto. intros [tf [TFINDF TRANSLFD]].
+ apply program_diverges with b tf.
+ rewrite (symbols_preserved _ _ H).
+ rewrite (transform_partial_program2_main transl_fundef transl_globvar prog H). auto.
+ auto.
+ generalize (transl_fundef_sig2 _ _ _ _ TRANSLFD TYP). simpl; auto.
+ rewrite (@Genv.init_mem_transf_partial2 _ _ _ _ transl_fundef transl_globvar prog tprog H).
+ eapply transl_funcall_divergence_correct; eauto.
+ eapply function_ptr_well_typed; eauto.
Qed.
diff --git a/cfrontend/Csyntax.v b/cfrontend/Csyntax.v
index 3866669a4..31d1d873e 100644
--- a/cfrontend/Csyntax.v
+++ b/cfrontend/Csyntax.v
@@ -136,15 +136,10 @@ with expr_descr : Set :=
| Ebinop: binary_operation -> expr -> expr -> expr_descr (**r binary operation *)
| Ecast: type -> expr -> expr_descr (**r type cast ([(ty) e]) *)
| Eindex: expr -> expr -> expr_descr (**r array indexing ([e1[e2]]) *)
- | Ecall: expr -> exprlist -> expr_descr (**r function call *)
| 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 *)
-
-with exprlist : Set :=
- | Enil: exprlist
- | Econs: expr -> exprlist -> exprlist.
+ | 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. *)
@@ -160,8 +155,8 @@ Definition typeof (e: expr) : type :=
Inductive statement : Set :=
| Sskip : statement (**r do nothing *)
- | Sexpr : expr -> statement (**r evaluate expression for its side-effects *)
| Sassign : expr -> expr -> statement (**r assignment [lvalue = rvalue] *)
+ | Scall: option expr -> 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 *)
diff --git a/cfrontend/Ctyping.v b/cfrontend/Ctyping.v
index cb572c09e..72c4edf2b 100644
--- a/cfrontend/Ctyping.v
+++ b/cfrontend/Ctyping.v
@@ -47,10 +47,6 @@ Inductive wt_expr: expr -> Prop :=
| wt_Eindex: forall e1 e2 ty,
wt_expr e1 -> wt_expr e2 ->
wt_expr (Expr (Eindex e1 e2) ty)
- | wt_Ecall: forall e1 el ty,
- wt_expr e1 ->
- wt_exprlist el ->
- wt_expr (Expr (Ecall e1 el) ty)
| wt_Eandbool: forall e1 e2 ty,
wt_expr e1 -> wt_expr e2 ->
wt_expr (Expr (Eandbool e1 e2) ty)
@@ -61,23 +57,32 @@ Inductive wt_expr: expr -> Prop :=
wt_expr (Expr (Esizeof ty') ty)
| wt_Efield: forall e id ty,
wt_expr e ->
- wt_expr (Expr (Efield e id) ty)
+ 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).
-with wt_exprlist: exprlist -> Prop :=
+Inductive wt_exprlist: list expr -> Prop :=
| wt_Enil:
- wt_exprlist Enil
+ wt_exprlist nil
| wt_Econs: forall e el,
- wt_expr e -> wt_exprlist el -> wt_exprlist (Econs e el).
+ wt_expr e -> wt_exprlist el -> wt_exprlist (e :: el).
Inductive wt_stmt: statement -> Prop :=
| wt_Sskip:
wt_stmt Sskip
- | wt_Sexpr: forall e,
- wt_expr e ->
- wt_stmt (Sexpr e)
| 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)
@@ -97,11 +102,9 @@ Inductive wt_stmt: statement -> Prop :=
wt_stmt Sbreak
| wt_Scontinue:
wt_stmt Scontinue
- | wt_Sreturn_some: forall e,
- wt_expr e ->
- wt_stmt (Sreturn (Some e))
- | wt_Sreturn_none:
- wt_stmt (Sreturn None)
+ | 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)
@@ -282,49 +285,35 @@ with typecheck_exprdescr (a: Csyntax.expr_descr) (ty: type) {struct a} : bool :=
| Csyntax.Ebinop op b c => typecheck_expr b && typecheck_expr c
| Csyntax.Ecast ty b => typecheck_expr b
| Csyntax.Eindex b c => typecheck_expr b && typecheck_expr c
- | Csyntax.Ecall b cl => typecheck_expr b && typecheck_exprlist cl
| 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
+ end.
-with typecheck_exprlist (al: Csyntax.exprlist): bool :=
+Fixpoint typecheck_exprlist (al: list Csyntax.expr): bool :=
match al with
- | Csyntax.Enil => true
- | Csyntax.Econs a1 a2 => typecheck_expr a1 && typecheck_exprlist a2
+ | 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_3 := Induction for expr Sort Prop
- with expr_descr_ind_3 := Induction for expr_descr Sort Prop
- with exprlist_ind_3 := Induction for exprlist Sort Prop.
+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_3 (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))
- (fun a => typecheck_exprlist a = true -> wt_exprlist env a));
- simpl; intros; TrueInv.
- auto.
- constructor.
- constructor.
- constructor. destruct (env!i). decEq; symmetry; apply eq_type_correct; auto.
+ 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.
- constructor; auto.
- constructor; auto.
- constructor; auto.
- constructor; auto.
- constructor; auto.
- constructor; auto.
- constructor; auto.
- constructor; auto.
- constructor; auto.
- auto.
- constructor; auto.
- constructor; auto.
- constructor.
- constructor; auto.
Qed.
Lemma typecheck_exprlist_correct:
@@ -335,11 +324,19 @@ Proof.
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.Sexpr e => typecheck_expr e
| 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
@@ -368,10 +365,11 @@ 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; try constructor; auto.
- destruct o; constructor; auto.
+ simpl; intros; TrueInv; constructor; auto.
Qed.
End TYPECHECKING.
diff --git a/common/Complements.v b/common/Complements.v
index 5280947ba..2263f4ece 100644
--- a/common/Complements.v
+++ b/common/Complements.v
@@ -8,8 +8,11 @@ Require Import Values.
Require Import Events.
Require Import Globalenvs.
Require Import Smallstep.
+Require Import Csyntax.
+Require Import Csem.
Require Import PPC.
Require Import Main.
+Require Import Errors.
(** * Determinism of PPC semantics *)
@@ -555,22 +558,29 @@ Proof.
auto. apply traceinf_sim_sym; auto. apply traceinf_sim_refl.
Qed.
-(** * Strong semantic preservation property *)
+(** * Additional semantic preservation property *)
-Require Import Errors.
+(** Combining the semantic preservation theorem from module [Main]
+ with the determinism of PPC executions, we easily obtain
+ additional, stronger semantic preservation properties.
+ The first property states that, when compiling a Clight
+ program that has well-defined semantics, all possible executions
+ of the resulting PPC code correspond to an execution of
+ the source Clight program, in the sense of the [matching_behaviors]
+ predicate. *)
-Theorem transf_rtl_program_correct_strong:
+Theorem transf_c_program_correct_strong:
forall p tp b w,
- transf_rtl_program p = OK tp ->
- RTL.exec_program p b ->
+ transf_c_program p = OK tp ->
+ Csem.exec_program p b ->
possible_behavior w b ->
(exists b', exec_program' tp w b')
/\(forall b', exec_program' tp w b' ->
- exists b0, RTL.exec_program p b0 /\ matching_behaviors b0 b').
+ exists b0, Csem.exec_program p b0 /\ matching_behaviors b0 b').
Proof.
intros.
assert (PPC.exec_program tp b).
- eapply transf_rtl_program_correct; eauto.
+ eapply transf_c_program_correct; eauto.
exploit exec_program_program'; eauto.
intros [b' [A B]].
split. exists b'; auto.
@@ -578,3 +588,52 @@ Proof.
apply matching_behaviors_same with b'. auto.
eapply exec_program'_deterministic; eauto.
Qed.
+
+Section SPECS_PRESERVED.
+
+(** The second additional results shows that if one execution
+ of the source Clight program satisfies a given specification
+ (a predicate on the observable behavior of the program),
+ then all executions of the produced PPC program satisfy
+ this specification as well. *)
+
+Variable spec: program_behavior -> Prop.
+
+(* Since the execution trace for a diverging Clight program
+ is not uniquely defined (the trace can contain events that
+ the program will never perform because it loops earlier),
+ this result holds only if the specification is closed under
+ prefixes in the case of diverging executions. This is the
+ case for all safety properties (some undesirable event never
+ occurs), but not for liveness properties (some desirable event
+ always occurs). *)
+
+Hypothesis spec_safety:
+ forall T T', traceinf_prefix T T' -> spec (Diverges T') -> spec (Diverges T).
+
+Theorem transf_c_program_preserves_spec:
+ forall p tp b w,
+ transf_c_program p = OK tp ->
+ Csem.exec_program p b ->
+ possible_behavior w b ->
+ spec b ->
+ (exists b', exec_program' tp w b')
+/\(forall b', exec_program' tp w b' -> spec b').
+Proof.
+ intros.
+ assert (PPC.exec_program tp b).
+ eapply transf_c_program_correct; eauto.
+ exploit exec_program_program'; eauto.
+ intros [b' [A B]].
+ split. exists b'; auto.
+ intros b'' EX.
+ assert (same_behaviors b' b''). eapply exec_program'_deterministic; eauto.
+ inv B; inv H4.
+ auto.
+ apply spec_safety with T1.
+ eapply traceinf_prefix_compat with T2 T1.
+ auto. apply traceinf_sim_sym; auto. apply traceinf_sim_refl.
+ auto.
+Qed.
+
+End SPECS_PRESERVED.
diff --git a/common/Events.v b/common/Events.v
index 83a7a19bb..e9070e169 100644
--- a/common/Events.v
+++ b/common/Events.v
@@ -66,14 +66,18 @@ Proof. intros. unfold E0, Eapp. rewrite <- app_nil_end. auto. Qed.
Lemma Eapp_assoc: forall t1 t2 t3, (t1 ** t2) ** t3 = t1 ** (t2 ** t3).
Proof. intros. unfold Eapp, trace. apply app_ass. Qed.
+Lemma E0_left_inf: forall T, E0 *** T = T.
+Proof. auto. Qed.
+
Lemma Eappinf_assoc: forall t1 t2 T, (t1 ** t2) *** T = t1 *** (t2 *** T).
Proof.
induction t1; intros; simpl. auto. decEq; auto.
Qed.
-Hint Rewrite E0_left E0_right Eapp_assoc: trace_rewrite.
+Hint Rewrite E0_left E0_right Eapp_assoc
+ E0_left_inf Eappinf_assoc: trace_rewrite.
-Opaque trace E0 Eextcall Eapp.
+Opaque trace E0 Eextcall Eapp Eappinf.
(** The following [traceEq] tactic proves equalities between traces
or infinite traces. *)
@@ -251,7 +255,7 @@ Proof.
inv H; inv H0; inv H1; constructor; eapply COINDHYP; eauto.
Qed.
-Transparent trace E0 Eapp.
+Transparent trace E0 Eapp Eappinf.
Lemma traceinf_prefix_app:
forall T1 T2 t,
diff --git a/common/Main.v b/common/Main.v
index 33bc7830d..db159298e 100644
--- a/common/Main.v
+++ b/common/Main.v
@@ -258,10 +258,10 @@ Proof.
Qed.
Theorem transf_cminor_program_correct:
- forall p tp t n,
+ forall p tp beh,
transf_cminor_program p = OK tp ->
- Cminor.exec_program p t (Vint n) ->
- PPC.exec_program tp (Terminates t n).
+ Cminor.exec_program p beh ->
+ PPC.exec_program tp beh.
Proof.
intros. unfold transf_cminor_program, transf_cminor_fundef in H.
destruct (transform_partial_program_compose _ _ _ _ _ _ _ _ H) as [p3 [H3 P3]].
@@ -276,12 +276,12 @@ Proof.
Qed.
Theorem transf_c_program_correct:
- forall p tp t n,
+ forall p tp beh,
transf_c_program p = OK tp ->
- Csem.exec_program p t (Vint n) ->
- PPC.exec_program tp (Terminates t n).
+ Csem.exec_program p beh ->
+ PPC.exec_program tp beh.
Proof.
- intros until n; unfold transf_c_program; simpl.
+ intros until beh; unfold transf_c_program; simpl.
caseEq (Ctyping.typecheck_program p); try congruence; intro.
caseEq (Cshmgen.transl_program p); simpl; try congruence; intros p1 EQ1.
caseEq (Cminorgen.transl_program p1); simpl; try congruence; intros p2 EQ2.
diff --git a/common/Smallstep.v b/common/Smallstep.v
index f60746d3f..8039ba43a 100644
--- a/common/Smallstep.v
+++ b/common/Smallstep.v
@@ -172,12 +172,17 @@ Qed.
for coinductive reasoning. *)
CoInductive forever_N (ge: genv): nat -> state -> traceinf -> Prop :=
- | forever_N_star: forall s1 t s2 p q T,
- star ge s1 t s2 -> (p < q)%nat -> forever_N ge p s2 T ->
- forever_N ge q s1 (t *** T)
- | forever_N_plus: forall s1 t s2 p q T,
- plus ge s1 t s2 -> forever_N ge p s2 T ->
- forever_N ge q s1 (t *** T).
+ | forever_N_star: forall s1 t s2 p q T1 T2,
+ star ge s1 t s2 ->
+ (p < q)%nat ->
+ forever_N ge p s2 T2 ->
+ T1 = t *** T2 ->
+ forever_N ge q s1 T1
+ | forever_N_plus: forall s1 t s2 p q T1 T2,
+ plus ge s1 t s2 ->
+ forever_N ge p s2 T2 ->
+ T1 = t *** T2 ->
+ forever_N ge q s1 T1.
Remark Peano_induction:
forall (P: nat -> Prop),
@@ -202,14 +207,14 @@ Proof.
(* star case *)
inv H1.
(* no transition *)
- change (E0 *** T0) with T0. apply H with p1. auto. auto.
+ change (E0 *** T2) with T2. apply H with p1. auto. auto.
(* at least one transition *)
- exists t1; exists s0; exists p0; exists (t2 *** T0).
+ exists t1; exists s0; exists p0; exists (t2 *** T2).
split. auto. split. eapply forever_N_star; eauto.
apply Eappinf_assoc.
(* plus case *)
inv H1.
- exists t1; exists s0; exists (S p1); exists (t2 *** T0).
+ exists t1; exists s0; exists (S p1); exists (t2 *** T2).
split. auto. split. eapply forever_N_star; eauto.
apply Eappinf_assoc.
Qed.
@@ -348,12 +353,12 @@ Proof.
forever_N step2 ge2 (measure st1) st2 T).
cofix COINDHYP; intros.
inversion H; subst. elim (simulation H1 H0).
- intros [st2' [A B]]. apply forever_N_plus with st2' (measure s2).
- auto. apply COINDHYP. assumption. assumption.
+ intros [st2' [A B]]. apply forever_N_plus with t st2' (measure s2) T0.
+ auto. apply COINDHYP. assumption. assumption. auto.
intros [A [B C]].
- apply forever_N_star with st2 (measure s2).
+ apply forever_N_star with t st2 (measure s2) T0.
rewrite B. apply star_refl. auto.
- apply COINDHYP. assumption. auto.
+ apply COINDHYP. assumption. auto. auto.
intros. eapply forever_N_forever; eauto.
Qed.
diff --git a/doc/index.html b/doc/index.html
index e75e7b17b..4390c8765 100644
--- a/doc/index.html
+++ b/doc/index.html
@@ -25,7 +25,7 @@ a:active {color : Red; text-decoration : underline; }
<H1 align="center">The Compcert certified compiler</H1>
<H2 align="center">Commented Coq development</H2>
-<H3 align="center">Version 1.0, 2007-08-03</H3>
+<H3 align="center">Version 1.0, 2007-08-28</H3>
<H2>Introduction</H2>
@@ -274,6 +274,7 @@ Proofs that compiler passes are type-preserving:
<UL>
<LI> <A HREF="html/Main.html">Main</A>: composing the passes together; the
final semantic preservation theorems.
+<LI> <A HREF="html/Complements.html">Complements</A>: interesting consequences of the semantic preservation theorems.
</UL>
<HR>
diff --git a/doc/removeproofs b/doc/removeproofs
index 82809ba68..5ae9a2354 100755
--- a/doc/removeproofs
+++ b/doc/removeproofs
@@ -2,7 +2,9 @@
for i in $*; do
mv $i $i.bak
- sed -e '/<code class="keyword">Proof<\/code> *\./,/<code class="keyword">\(Qed\|Defined\)<\/code> *\./d' $i.bak > $i
+ sed -e '/<span class="keyword">Proof<\/span> *\./,/<span class="keyword">\(Qed\|Defined\)<\/span> *\./d' \
+ -e "s/\"'do' X <- A ; B\" error_monad_scope/doXAB error_monad_scope/g" \
+ $i.bak > $i
rm $i.bak
done
diff --git a/extraction/.depend b/extraction/.depend
index afffe8169..6a10752b5 100644
--- a/extraction/.depend
+++ b/extraction/.depend
@@ -4,14 +4,6 @@
../caml/Coloringaux.cmi: Registers.cmi RTLtyping.cmi RTL.cmi Locations.cmi \
InterfGraph.cmi
../caml/PrintPPC.cmi: PPC.cmi
-../caml/Camlcoq.cmo: Integers.cmi Datatypes.cmi CString.cmi CList.cmi \
- BinPos.cmi BinInt.cmi Ascii.cmi
-../caml/Camlcoq.cmx: Integers.cmx Datatypes.cmx CString.cmx CList.cmx \
- BinPos.cmx BinInt.cmx Ascii.cmx
-../caml/Cil2Csyntax.cmo: Datatypes.cmi Csyntax.cmi ../caml/Camlcoq.cmo \
- CList.cmi AST.cmi
-../caml/Cil2Csyntax.cmx: Datatypes.cmx Csyntax.cmx ../caml/Camlcoq.cmx \
- CList.cmx AST.cmx
../caml/CMlexer.cmo: ../caml/Camlcoq.cmo ../caml/CMparser.cmi \
../caml/CMlexer.cmi
../caml/CMlexer.cmx: ../caml/Camlcoq.cmx ../caml/CMparser.cmx \
@@ -26,6 +18,14 @@
../caml/Camlcoq.cmo CList.cmi AST.cmi ../caml/CMtypecheck.cmi
../caml/CMtypecheck.cmx: Integers.cmx Datatypes.cmx Cminor.cmx \
../caml/Camlcoq.cmx CList.cmx AST.cmx ../caml/CMtypecheck.cmi
+../caml/Camlcoq.cmo: Integers.cmi Datatypes.cmi CString.cmi CList.cmi \
+ BinPos.cmi BinInt.cmi Ascii.cmi
+../caml/Camlcoq.cmx: Integers.cmx Datatypes.cmx CString.cmx CList.cmx \
+ BinPos.cmx BinInt.cmx Ascii.cmx
+../caml/Cil2Csyntax.cmo: Datatypes.cmi Csyntax.cmi ../caml/Camlcoq.cmo \
+ CList.cmi AST.cmi
+../caml/Cil2Csyntax.cmx: Datatypes.cmx Csyntax.cmx ../caml/Camlcoq.cmx \
+ CList.cmx AST.cmx
../caml/Coloringaux.cmo: Registers.cmi RTLtyping.cmi RTL.cmi Maps.cmi \
Locations.cmi InterfGraph.cmi Datatypes.cmi Conventions.cmi \
../caml/Camlcoq.cmo BinPos.cmi BinInt.cmi AST.cmi ../caml/Coloringaux.cmi
@@ -42,12 +42,6 @@
../caml/CMlexer.cmx
../caml/Floataux.cmo: Integers.cmi ../caml/Camlcoq.cmo
../caml/Floataux.cmx: Integers.cmx ../caml/Camlcoq.cmx
-../caml/Main2.cmo: ../caml/PrintPPC.cmi ../caml/PrintCsyntax.cmo Main.cmi \
- Errors.cmi Csyntax.cmi ../caml/Cil2Csyntax.cmo ../caml/CMtypecheck.cmi \
- ../caml/CMparser.cmi ../caml/CMlexer.cmi
-../caml/Main2.cmx: ../caml/PrintPPC.cmx ../caml/PrintCsyntax.cmx Main.cmx \
- Errors.cmx Csyntax.cmx ../caml/Cil2Csyntax.cmx ../caml/CMtypecheck.cmx \
- ../caml/CMparser.cmx ../caml/CMlexer.cmx
../caml/PrintCshm.cmo: Integers.cmi Datatypes.cmi Csharpminor.cmi \
../caml/Camlcoq.cmo CList.cmi AST.cmi
../caml/PrintCshm.cmx: Integers.cmx Datatypes.cmx Csharpminor.cmx \
@@ -68,12 +62,12 @@
../caml/Camlcoq.cmo CList.cmi AST.cmi
../caml/RTLtypingaux.cmx: Registers.cmx RTL.cmx Op.cmx Maps.cmx Datatypes.cmx \
../caml/Camlcoq.cmx CList.cmx AST.cmx
+AST.cmi: Specif.cmi Integers.cmi Floats.cmi Errors.cmi Datatypes.cmi \
+ Coqlib.cmi CString.cmi CList.cmi BinPos.cmi BinInt.cmi Ascii.cmi
Allocation.cmi: Specif.cmi Registers.cmi RTLtyping.cmi RTL.cmi Op.cmi \
Maps.cmi Locations.cmi LTL.cmi Errors.cmi Datatypes.cmi Coloring.cmi \
CString.cmi CList.cmi BinPos.cmi Ascii.cmi AST.cmi
Ascii.cmi: Specif.cmi Peano.cmi Datatypes.cmi Bool.cmi BinPos.cmi
-AST.cmi: Specif.cmi Integers.cmi Floats.cmi Errors.cmi Datatypes.cmi \
- Coqlib.cmi CString.cmi CList.cmi BinPos.cmi BinInt.cmi Ascii.cmi
BinInt.cmi: Datatypes.cmi BinPos.cmi BinNat.cmi
BinNat.cmi: Specif.cmi Datatypes.cmi BinPos.cmi
BinPos.cmi: Peano.cmi Datatypes.cmi
@@ -82,15 +76,18 @@ Bounds.cmi: Zmax.cmi Locations.cmi Linear.cmi Conventions.cmi CList.cmi \
BinPos.cmi BinInt.cmi AST.cmi
CInt.cmi: Zmax.cmi ZArith_dec.cmi Specif.cmi BinPos.cmi BinInt.cmi
CList.cmi: Specif.cmi Datatypes.cmi
+CSE.cmi: Specif.cmi Registers.cmi RTL.cmi Op.cmi Maps.cmi Integers.cmi \
+ Floats.cmi Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi AST.cmi
+CString.cmi: Specif.cmi Datatypes.cmi Ascii.cmi
+Cminor.cmi: Values.cmi Specif.cmi Mem.cmi Maps.cmi Integers.cmi \
+ Globalenvs.cmi Floats.cmi Datatypes.cmi CList.cmi BinPos.cmi BinInt.cmi \
+ AST.cmi
+CminorSel.cmi: Values.cmi Op.cmi Integers.cmi Globalenvs.cmi Datatypes.cmi \
+ CList.cmi BinInt.cmi AST.cmi
Cminorgen.cmi: Zmax.cmi Specif.cmi OrderedType.cmi Ordered.cmi Mem.cmi \
Maps.cmi Integers.cmi Errors.cmi Datatypes.cmi Csharpminor.cmi Coqlib.cmi \
Cminor.cmi CString.cmi CList.cmi CInt.cmi BinPos.cmi BinInt.cmi Ascii.cmi \
AST.cmi
-Cminor.cmi: Values.cmi Specif.cmi Mem.cmi Maps.cmi Integers.cmi \
- Globalenvs.cmi Floats.cmi Datatypes.cmi CList.cmi BinPos.cmi BinInt.cmi \
- AST.cmi
-CminorSel.cmi: Op.cmi Integers.cmi Globalenvs.cmi Datatypes.cmi CList.cmi \
- BinInt.cmi AST.cmi
Coloring.cmi: Specif.cmi Registers.cmi RTLtyping.cmi RTL.cmi Op.cmi Maps.cmi \
Locations.cmi InterfGraph.cmi Datatypes.cmi Coqlib.cmi Conventions.cmi \
CList.cmi BinInt.cmi AST.cmi
@@ -101,15 +98,12 @@ Conventions.cmi: Locations.cmi Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi \
BinInt.cmi AST.cmi
Coqlib.cmi: Zdiv.cmi ZArith_dec.cmi Wf.cmi Specif.cmi Datatypes.cmi CList.cmi \
BinPos.cmi BinInt.cmi
-CSE.cmi: Specif.cmi Registers.cmi RTL.cmi Op.cmi Maps.cmi Integers.cmi \
- Floats.cmi Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi AST.cmi
Csharpminor.cmi: Zmax.cmi Values.cmi Mem.cmi Maps.cmi Integers.cmi \
Globalenvs.cmi Floats.cmi Datatypes.cmi Cminor.cmi CList.cmi BinInt.cmi \
AST.cmi
-Cshmgen.cmi: Peano.cmi Integers.cmi Floats.cmi Errors.cmi Datatypes.cmi \
- Csyntax.cmi Csharpminor.cmi Cminor.cmi CString.cmi CList.cmi Ascii.cmi \
- AST.cmi
-CString.cmi: Specif.cmi Datatypes.cmi Ascii.cmi
+Cshmgen.cmi: Specif.cmi Peano.cmi Integers.cmi Floats.cmi Errors.cmi \
+ Datatypes.cmi Csyntax.cmi Csharpminor.cmi Cminor.cmi CString.cmi \
+ CList.cmi Ascii.cmi AST.cmi
Csyntax.cmi: Zmax.cmi Specif.cmi Integers.cmi Floats.cmi Errors.cmi \
Datatypes.cmi Coqlib.cmi CString.cmi CList.cmi BinPos.cmi BinInt.cmi \
Ascii.cmi AST.cmi
@@ -117,12 +111,12 @@ Ctyping.cmi: Specif.cmi Maps.cmi Datatypes.cmi Csyntax.cmi Coqlib.cmi \
CList.cmi AST.cmi
EqNat.cmi: Specif.cmi Datatypes.cmi
Errors.cmi: Datatypes.cmi CString.cmi CList.cmi BinPos.cmi
-Floats.cmi: Specif.cmi Integers.cmi Datatypes.cmi
FSetAVL.cmi: Wf.cmi Specif.cmi Peano.cmi OrderedType.cmi Datatypes.cmi \
CList.cmi CInt.cmi BinPos.cmi BinInt.cmi
FSetFacts.cmi: Specif.cmi Setoid.cmi FSetInterface.cmi Datatypes.cmi
FSetInterface.cmi: Specif.cmi OrderedType.cmi Datatypes.cmi CList.cmi
FSetList.cmi: Specif.cmi OrderedType.cmi Datatypes.cmi CList.cmi
+Floats.cmi: Specif.cmi Integers.cmi Datatypes.cmi
Globalenvs.cmi: Values.cmi Mem.cmi Maps.cmi Integers.cmi Datatypes.cmi \
CList.cmi BinPos.cmi BinInt.cmi AST.cmi
Integers.cmi: Zpower.cmi Zdiv.cmi Specif.cmi Datatypes.cmi Coqlib.cmi \
@@ -133,21 +127,21 @@ Iteration.cmi: Wf.cmi Specif.cmi Datatypes.cmi Coqlib.cmi BinPos.cmi
Kildall.cmi: Specif.cmi Setoid.cmi OrderedType.cmi Ordered.cmi Maps.cmi \
Lattice.cmi Iteration.cmi Datatypes.cmi Coqlib.cmi CList.cmi CInt.cmi \
BinPos.cmi BinInt.cmi
+LTL.cmi: Values.cmi Specif.cmi Op.cmi Mem.cmi Maps.cmi Locations.cmi \
+ Integers.cmi Globalenvs.cmi Datatypes.cmi Conventions.cmi CList.cmi \
+ BinPos.cmi BinInt.cmi AST.cmi
+LTLin.cmi: Values.cmi Specif.cmi Op.cmi Mem.cmi Locations.cmi Integers.cmi \
+ Globalenvs.cmi Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi BinInt.cmi \
+ AST.cmi
Lattice.cmi: Specif.cmi Maps.cmi FSetInterface.cmi Datatypes.cmi Bool.cmi \
BinPos.cmi
-Linearize.cmi: Specif.cmi Op.cmi Maps.cmi Lattice.cmi LTLin.cmi LTL.cmi \
- Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi AST.cmi
Linear.cmi: Values.cmi Specif.cmi Op.cmi Mem.cmi Locations.cmi Integers.cmi \
Globalenvs.cmi Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi BinInt.cmi \
AST.cmi
+Linearize.cmi: Specif.cmi Op.cmi Maps.cmi Lattice.cmi LTLin.cmi LTL.cmi \
+ Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi AST.cmi
Locations.cmi: Values.cmi Specif.cmi Datatypes.cmi Coqlib.cmi BinPos.cmi \
BinInt.cmi AST.cmi
-LTLin.cmi: Values.cmi Specif.cmi Op.cmi Mem.cmi Locations.cmi Integers.cmi \
- Globalenvs.cmi Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi BinInt.cmi \
- AST.cmi
-LTL.cmi: Values.cmi Specif.cmi Op.cmi Mem.cmi Maps.cmi Locations.cmi \
- Integers.cmi Globalenvs.cmi Datatypes.cmi Conventions.cmi CList.cmi \
- BinPos.cmi BinInt.cmi AST.cmi
Mach.cmi: Zmax.cmi Zdiv.cmi Values.cmi Specif.cmi Op.cmi Locations.cmi \
Integers.cmi Globalenvs.cmi Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi \
BinInt.cmi AST.cmi
@@ -164,26 +158,26 @@ Op.cmi: Values.cmi Specif.cmi Mem.cmi Integers.cmi Globalenvs.cmi Floats.cmi \
Ordered.cmi: Specif.cmi OrderedType.cmi Maps.cmi Datatypes.cmi Coqlib.cmi \
BinPos.cmi
OrderedType.cmi: Specif.cmi Datatypes.cmi
-Parallelmove.cmi: Parmov.cmi Locations.cmi Datatypes.cmi CList.cmi AST.cmi
-Parmov.cmi: Specif.cmi Peano.cmi Datatypes.cmi CList.cmi
-Peano.cmi: Datatypes.cmi
+PPC.cmi: Values.cmi Specif.cmi Mem.cmi Integers.cmi Globalenvs.cmi Floats.cmi \
+ Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi BinInt.cmi AST.cmi
PPCgen.cmi: Specif.cmi PPC.cmi Op.cmi Mach.cmi Locations.cmi Integers.cmi \
Errors.cmi Datatypes.cmi Coqlib.cmi CString.cmi CList.cmi Bool.cmi \
BinPos.cmi BinInt.cmi Ascii.cmi AST.cmi
-PPC.cmi: Values.cmi Specif.cmi Mem.cmi Integers.cmi Globalenvs.cmi Floats.cmi \
- Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi BinInt.cmi AST.cmi
-Registers.cmi: Specif.cmi OrderedType.cmi Ordered.cmi Maps.cmi Datatypes.cmi \
- Coqlib.cmi CList.cmi CInt.cmi BinPos.cmi BinInt.cmi AST.cmi
-Reload.cmi: Specif.cmi Parallelmove.cmi Op.cmi Locations.cmi Linear.cmi \
- LTLin.cmi Datatypes.cmi Conventions.cmi CList.cmi AST.cmi
+Parallelmove.cmi: Parmov.cmi Locations.cmi Datatypes.cmi CList.cmi AST.cmi
+Parmov.cmi: Specif.cmi Peano.cmi Datatypes.cmi CList.cmi
+Peano.cmi: Datatypes.cmi
+RTL.cmi: Values.cmi Registers.cmi Op.cmi Mem.cmi Maps.cmi Integers.cmi \
+ Globalenvs.cmi Datatypes.cmi CList.cmi BinPos.cmi BinInt.cmi AST.cmi
RTLgen.cmi: Switch.cmi Specif.cmi Registers.cmi RTL.cmi Op.cmi Maps.cmi \
Integers.cmi Errors.cmi Datatypes.cmi Coqlib.cmi CminorSel.cmi \
CString.cmi CList.cmi BinPos.cmi Ascii.cmi AST.cmi
-RTL.cmi: Values.cmi Registers.cmi Op.cmi Mem.cmi Maps.cmi Integers.cmi \
- Globalenvs.cmi Datatypes.cmi CList.cmi BinPos.cmi BinInt.cmi AST.cmi
RTLtyping.cmi: Specif.cmi Registers.cmi RTL.cmi Op.cmi Maps.cmi Errors.cmi \
Datatypes.cmi Coqlib.cmi Conventions.cmi CString.cmi CList.cmi BinPos.cmi \
BinInt.cmi Ascii.cmi AST.cmi
+Registers.cmi: Specif.cmi OrderedType.cmi Ordered.cmi Maps.cmi Datatypes.cmi \
+ Coqlib.cmi CList.cmi CInt.cmi BinPos.cmi BinInt.cmi AST.cmi
+Reload.cmi: Specif.cmi Parallelmove.cmi Op.cmi Locations.cmi Linear.cmi \
+ LTLin.cmi Datatypes.cmi Conventions.cmi CList.cmi AST.cmi
Selection.cmi: Specif.cmi Op.cmi Integers.cmi Datatypes.cmi Compare_dec.cmi \
CminorSel.cmi Cminor.cmi CList.cmi BinPos.cmi BinInt.cmi AST.cmi
Setoid.cmi: Datatypes.cmi
@@ -205,6 +199,10 @@ Zeven.cmi: Specif.cmi Datatypes.cmi BinPos.cmi BinInt.cmi
Zmax.cmi: Datatypes.cmi BinInt.cmi
Zmisc.cmi: Datatypes.cmi BinPos.cmi BinInt.cmi
Zpower.cmi: Zmisc.cmi Datatypes.cmi BinPos.cmi BinInt.cmi
+AST.cmo: Specif.cmi Integers.cmi Floats.cmi Errors.cmi Datatypes.cmi \
+ Coqlib.cmi CString.cmi CList.cmi BinPos.cmi BinInt.cmi Ascii.cmi AST.cmi
+AST.cmx: Specif.cmx Integers.cmx Floats.cmx Errors.cmx Datatypes.cmx \
+ Coqlib.cmx CString.cmx CList.cmx BinPos.cmx BinInt.cmx Ascii.cmx AST.cmi
Allocation.cmo: Specif.cmi Registers.cmi RTLtyping.cmi RTL.cmi Op.cmi \
Maps.cmi Locations.cmi Lattice.cmi LTL.cmi Kildall.cmi Errors.cmi \
Datatypes.cmi Coloring.cmi CString.cmi CList.cmi BinPos.cmi Ascii.cmi \
@@ -215,10 +213,6 @@ Allocation.cmx: Specif.cmx Registers.cmx RTLtyping.cmx RTL.cmx Op.cmx \
AST.cmx Allocation.cmi
Ascii.cmo: Specif.cmi Peano.cmi Datatypes.cmi Bool.cmi BinPos.cmi Ascii.cmi
Ascii.cmx: Specif.cmx Peano.cmx Datatypes.cmx Bool.cmx BinPos.cmx Ascii.cmi
-AST.cmo: Specif.cmi Integers.cmi Floats.cmi Errors.cmi Datatypes.cmi \
- Coqlib.cmi CString.cmi CList.cmi BinPos.cmi BinInt.cmi Ascii.cmi AST.cmi
-AST.cmx: Specif.cmx Integers.cmx Floats.cmx Errors.cmx Datatypes.cmx \
- Coqlib.cmx CString.cmx CList.cmx BinPos.cmx BinInt.cmx Ascii.cmx AST.cmi
BinInt.cmo: Datatypes.cmi BinPos.cmi BinNat.cmi BinInt.cmi
BinInt.cmx: Datatypes.cmx BinPos.cmx BinNat.cmx BinInt.cmi
BinNat.cmo: Specif.cmi Datatypes.cmi BinPos.cmi BinNat.cmi
@@ -235,6 +229,24 @@ CInt.cmo: Zmax.cmi ZArith_dec.cmi Specif.cmi BinPos.cmi BinInt.cmi CInt.cmi
CInt.cmx: Zmax.cmx ZArith_dec.cmx Specif.cmx BinPos.cmx BinInt.cmx CInt.cmi
CList.cmo: Specif.cmi Datatypes.cmi CList.cmi
CList.cmx: Specif.cmx Datatypes.cmx CList.cmi
+CSE.cmo: Specif.cmi Registers.cmi RTL.cmi Op.cmi Maps.cmi Kildall.cmi \
+ Integers.cmi Floats.cmi Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi \
+ AST.cmi CSE.cmi
+CSE.cmx: Specif.cmx Registers.cmx RTL.cmx Op.cmx Maps.cmx Kildall.cmx \
+ Integers.cmx Floats.cmx Datatypes.cmx Coqlib.cmx CList.cmx BinPos.cmx \
+ AST.cmx CSE.cmi
+CString.cmo: Specif.cmi Datatypes.cmi Ascii.cmi CString.cmi
+CString.cmx: Specif.cmx Datatypes.cmx Ascii.cmx CString.cmi
+Cminor.cmo: Values.cmi Specif.cmi Mem.cmi Maps.cmi Integers.cmi \
+ Globalenvs.cmi Floats.cmi Datatypes.cmi CList.cmi BinPos.cmi BinInt.cmi \
+ AST.cmi Cminor.cmi
+Cminor.cmx: Values.cmx Specif.cmx Mem.cmx Maps.cmx Integers.cmx \
+ Globalenvs.cmx Floats.cmx Datatypes.cmx CList.cmx BinPos.cmx BinInt.cmx \
+ AST.cmx Cminor.cmi
+CminorSel.cmo: Values.cmi Op.cmi Integers.cmi Globalenvs.cmi Datatypes.cmi \
+ CList.cmi BinInt.cmi AST.cmi CminorSel.cmi
+CminorSel.cmx: Values.cmx Op.cmx Integers.cmx Globalenvs.cmx Datatypes.cmx \
+ CList.cmx BinInt.cmx AST.cmx CminorSel.cmi
Cminorgen.cmo: Zmax.cmi Specif.cmi OrderedType.cmi Ordered.cmi Mem.cmi \
Maps.cmi Integers.cmi FSetAVL.cmi Errors.cmi Datatypes.cmi \
Csharpminor.cmi Coqlib.cmi Cminor.cmi CString.cmi CList.cmi BinPos.cmi \
@@ -243,16 +255,6 @@ Cminorgen.cmx: Zmax.cmx Specif.cmx OrderedType.cmx Ordered.cmx Mem.cmx \
Maps.cmx Integers.cmx FSetAVL.cmx Errors.cmx Datatypes.cmx \
Csharpminor.cmx Coqlib.cmx Cminor.cmx CString.cmx CList.cmx BinPos.cmx \
BinInt.cmx Ascii.cmx AST.cmx Cminorgen.cmi
-Cminor.cmo: Values.cmi Specif.cmi Mem.cmi Maps.cmi Integers.cmi \
- Globalenvs.cmi Floats.cmi Datatypes.cmi CList.cmi BinPos.cmi BinInt.cmi \
- AST.cmi Cminor.cmi
-Cminor.cmx: Values.cmx Specif.cmx Mem.cmx Maps.cmx Integers.cmx \
- Globalenvs.cmx Floats.cmx Datatypes.cmx CList.cmx BinPos.cmx BinInt.cmx \
- AST.cmx Cminor.cmi
-CminorSel.cmo: Op.cmi Integers.cmi Globalenvs.cmi Datatypes.cmi CList.cmi \
- BinInt.cmi AST.cmi CminorSel.cmi
-CminorSel.cmx: Op.cmx Integers.cmx Globalenvs.cmx Datatypes.cmx CList.cmx \
- BinInt.cmx AST.cmx CminorSel.cmi
Coloring.cmo: Specif.cmi Registers.cmi RTLtyping.cmi RTL.cmi Op.cmi Maps.cmi \
Locations.cmi InterfGraph.cmi Datatypes.cmi Coqlib.cmi Conventions.cmi \
../caml/Coloringaux.cmi CList.cmi BinInt.cmi AST.cmi Coloring.cmi
@@ -275,26 +277,18 @@ Coqlib.cmo: Zdiv.cmi ZArith_dec.cmi Wf.cmi Specif.cmi Datatypes.cmi CList.cmi \
BinPos.cmi BinInt.cmi Coqlib.cmi
Coqlib.cmx: Zdiv.cmx ZArith_dec.cmx Wf.cmx Specif.cmx Datatypes.cmx CList.cmx \
BinPos.cmx BinInt.cmx Coqlib.cmi
-CSE.cmo: Specif.cmi Registers.cmi RTL.cmi Op.cmi Maps.cmi Kildall.cmi \
- Integers.cmi Floats.cmi Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi \
- AST.cmi CSE.cmi
-CSE.cmx: Specif.cmx Registers.cmx RTL.cmx Op.cmx Maps.cmx Kildall.cmx \
- Integers.cmx Floats.cmx Datatypes.cmx Coqlib.cmx CList.cmx BinPos.cmx \
- AST.cmx CSE.cmi
Csharpminor.cmo: Zmax.cmi Values.cmi Mem.cmi Maps.cmi Integers.cmi \
Globalenvs.cmi Floats.cmi Datatypes.cmi Cminor.cmi CList.cmi BinInt.cmi \
AST.cmi Csharpminor.cmi
Csharpminor.cmx: Zmax.cmx Values.cmx Mem.cmx Maps.cmx Integers.cmx \
Globalenvs.cmx Floats.cmx Datatypes.cmx Cminor.cmx CList.cmx BinInt.cmx \
AST.cmx Csharpminor.cmi
-Cshmgen.cmo: Peano.cmi Integers.cmi Floats.cmi Errors.cmi Datatypes.cmi \
- Csyntax.cmi Csharpminor.cmi Cminor.cmi CString.cmi CList.cmi Ascii.cmi \
- AST.cmi Cshmgen.cmi
-Cshmgen.cmx: Peano.cmx Integers.cmx Floats.cmx Errors.cmx Datatypes.cmx \
- Csyntax.cmx Csharpminor.cmx Cminor.cmx CString.cmx CList.cmx Ascii.cmx \
- AST.cmx Cshmgen.cmi
-CString.cmo: Specif.cmi Datatypes.cmi Ascii.cmi CString.cmi
-CString.cmx: Specif.cmx Datatypes.cmx Ascii.cmx CString.cmi
+Cshmgen.cmo: Specif.cmi Peano.cmi Integers.cmi Floats.cmi Errors.cmi \
+ Datatypes.cmi Csyntax.cmi Csharpminor.cmi Cminor.cmi CString.cmi \
+ CList.cmi Ascii.cmi AST.cmi Cshmgen.cmi
+Cshmgen.cmx: Specif.cmx Peano.cmx Integers.cmx Floats.cmx Errors.cmx \
+ Datatypes.cmx Csyntax.cmx Csharpminor.cmx Cminor.cmx CString.cmx \
+ CList.cmx Ascii.cmx AST.cmx Cshmgen.cmi
Csyntax.cmo: Zmax.cmi Specif.cmi Integers.cmi Floats.cmi Errors.cmi \
Datatypes.cmi Coqlib.cmi CString.cmi CList.cmi BinPos.cmi BinInt.cmi \
Ascii.cmi AST.cmi Csyntax.cmi
@@ -311,10 +305,6 @@ EqNat.cmo: Specif.cmi Datatypes.cmi EqNat.cmi
EqNat.cmx: Specif.cmx Datatypes.cmx EqNat.cmi
Errors.cmo: Datatypes.cmi CString.cmi CList.cmi BinPos.cmi Errors.cmi
Errors.cmx: Datatypes.cmx CString.cmx CList.cmx BinPos.cmx Errors.cmi
-Floats.cmo: Specif.cmi Integers.cmi ../caml/Floataux.cmo Datatypes.cmi \
- Floats.cmi
-Floats.cmx: Specif.cmx Integers.cmx ../caml/Floataux.cmx Datatypes.cmx \
- Floats.cmi
FSetAVL.cmo: Wf.cmi Specif.cmi Peano.cmi OrderedType.cmi FSetList.cmi \
Datatypes.cmi CList.cmi CInt.cmi BinPos.cmi BinInt.cmi FSetAVL.cmi
FSetAVL.cmx: Wf.cmx Specif.cmx Peano.cmx OrderedType.cmx FSetList.cmx \
@@ -329,6 +319,10 @@ FSetInterface.cmx: Specif.cmx OrderedType.cmx Datatypes.cmx CList.cmx \
FSetInterface.cmi
FSetList.cmo: Specif.cmi OrderedType.cmi Datatypes.cmi CList.cmi FSetList.cmi
FSetList.cmx: Specif.cmx OrderedType.cmx Datatypes.cmx CList.cmx FSetList.cmi
+Floats.cmo: Specif.cmi Integers.cmi ../caml/Floataux.cmo Datatypes.cmi \
+ Floats.cmi
+Floats.cmx: Specif.cmx Integers.cmx ../caml/Floataux.cmx Datatypes.cmx \
+ Floats.cmi
Globalenvs.cmo: Values.cmi Mem.cmi Maps.cmi Integers.cmi Datatypes.cmi \
CList.cmi BinPos.cmi BinInt.cmi AST.cmi Globalenvs.cmi
Globalenvs.cmx: Values.cmx Mem.cmx Maps.cmx Integers.cmx Datatypes.cmx \
@@ -353,40 +347,40 @@ Kildall.cmo: Specif.cmi Setoid.cmi OrderedType.cmi Ordered.cmi Maps.cmi \
Kildall.cmx: Specif.cmx Setoid.cmx OrderedType.cmx Ordered.cmx Maps.cmx \
Lattice.cmx Iteration.cmx FSetFacts.cmx FSetAVL.cmx Datatypes.cmx \
Coqlib.cmx CList.cmx BinPos.cmx BinInt.cmx Kildall.cmi
+LTL.cmo: Values.cmi Specif.cmi Op.cmi Mem.cmi Maps.cmi Locations.cmi \
+ Integers.cmi Globalenvs.cmi Datatypes.cmi Conventions.cmi CList.cmi \
+ BinPos.cmi BinInt.cmi AST.cmi LTL.cmi
+LTL.cmx: Values.cmx Specif.cmx Op.cmx Mem.cmx Maps.cmx Locations.cmx \
+ Integers.cmx Globalenvs.cmx Datatypes.cmx Conventions.cmx CList.cmx \
+ BinPos.cmx BinInt.cmx AST.cmx LTL.cmi
+LTLin.cmo: Values.cmi Specif.cmi Op.cmi Mem.cmi Locations.cmi Integers.cmi \
+ Globalenvs.cmi Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi BinInt.cmi \
+ AST.cmi LTLin.cmi
+LTLin.cmx: Values.cmx Specif.cmx Op.cmx Mem.cmx Locations.cmx Integers.cmx \
+ Globalenvs.cmx Datatypes.cmx Coqlib.cmx CList.cmx BinPos.cmx BinInt.cmx \
+ AST.cmx LTLin.cmi
Lattice.cmo: Specif.cmi Maps.cmi FSetInterface.cmi Datatypes.cmi Bool.cmi \
BinPos.cmi Lattice.cmi
Lattice.cmx: Specif.cmx Maps.cmx FSetInterface.cmx Datatypes.cmx Bool.cmx \
BinPos.cmx Lattice.cmi
-Linearize.cmo: Specif.cmi Op.cmi Maps.cmi Lattice.cmi LTLin.cmi LTL.cmi \
- Kildall.cmi Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi AST.cmi \
- Linearize.cmi
-Linearize.cmx: Specif.cmx Op.cmx Maps.cmx Lattice.cmx LTLin.cmx LTL.cmx \
- Kildall.cmx Datatypes.cmx Coqlib.cmx CList.cmx BinPos.cmx AST.cmx \
- Linearize.cmi
Linear.cmo: Values.cmi Specif.cmi Op.cmi Mem.cmi Locations.cmi Integers.cmi \
Globalenvs.cmi Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi BinInt.cmi \
AST.cmi Linear.cmi
Linear.cmx: Values.cmx Specif.cmx Op.cmx Mem.cmx Locations.cmx Integers.cmx \
Globalenvs.cmx Datatypes.cmx Coqlib.cmx CList.cmx BinPos.cmx BinInt.cmx \
AST.cmx Linear.cmi
+Linearize.cmo: Specif.cmi Op.cmi Maps.cmi Lattice.cmi LTLin.cmi LTL.cmi \
+ Kildall.cmi Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi AST.cmi \
+ Linearize.cmi
+Linearize.cmx: Specif.cmx Op.cmx Maps.cmx Lattice.cmx LTLin.cmx LTL.cmx \
+ Kildall.cmx Datatypes.cmx Coqlib.cmx CList.cmx BinPos.cmx AST.cmx \
+ Linearize.cmi
Locations.cmo: Values.cmi Specif.cmi Datatypes.cmi Coqlib.cmi BinPos.cmi \
BinInt.cmi AST.cmi Locations.cmi
Locations.cmx: Values.cmx Specif.cmx Datatypes.cmx Coqlib.cmx BinPos.cmx \
BinInt.cmx AST.cmx Locations.cmi
Logic.cmo: Logic.cmi
Logic.cmx: Logic.cmi
-LTLin.cmo: Values.cmi Specif.cmi Op.cmi Mem.cmi Locations.cmi Integers.cmi \
- Globalenvs.cmi Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi BinInt.cmi \
- AST.cmi LTLin.cmi
-LTLin.cmx: Values.cmx Specif.cmx Op.cmx Mem.cmx Locations.cmx Integers.cmx \
- Globalenvs.cmx Datatypes.cmx Coqlib.cmx CList.cmx BinPos.cmx BinInt.cmx \
- AST.cmx LTLin.cmi
-LTL.cmo: Values.cmi Specif.cmi Op.cmi Mem.cmi Maps.cmi Locations.cmi \
- Integers.cmi Globalenvs.cmi Datatypes.cmi Conventions.cmi CList.cmi \
- BinPos.cmi BinInt.cmi AST.cmi LTL.cmi
-LTL.cmx: Values.cmx Specif.cmx Op.cmx Mem.cmx Maps.cmx Locations.cmx \
- Integers.cmx Globalenvs.cmx Datatypes.cmx Conventions.cmx CList.cmx \
- BinPos.cmx BinInt.cmx AST.cmx LTL.cmi
Mach.cmo: Zmax.cmi Zdiv.cmi Values.cmi Specif.cmi Op.cmi Maps.cmi \
Locations.cmi Integers.cmi Globalenvs.cmi Datatypes.cmi Coqlib.cmi \
CList.cmi BinPos.cmi BinInt.cmi AST.cmi Mach.cmi
@@ -419,6 +413,18 @@ Ordered.cmx: Specif.cmx OrderedType.cmx Maps.cmx Datatypes.cmx Coqlib.cmx \
BinPos.cmx Ordered.cmi
OrderedType.cmo: Specif.cmi Datatypes.cmi OrderedType.cmi
OrderedType.cmx: Specif.cmx Datatypes.cmx OrderedType.cmi
+PPC.cmo: Values.cmi Specif.cmi Mem.cmi Maps.cmi Integers.cmi Globalenvs.cmi \
+ Floats.cmi Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi BinInt.cmi \
+ AST.cmi PPC.cmi
+PPC.cmx: Values.cmx Specif.cmx Mem.cmx Maps.cmx Integers.cmx Globalenvs.cmx \
+ Floats.cmx Datatypes.cmx Coqlib.cmx CList.cmx BinPos.cmx BinInt.cmx \
+ AST.cmx PPC.cmi
+PPCgen.cmo: Specif.cmi PPC.cmi Op.cmi Mach.cmi Locations.cmi Integers.cmi \
+ Errors.cmi Datatypes.cmi Coqlib.cmi CString.cmi CList.cmi Bool.cmi \
+ BinPos.cmi BinInt.cmi Ascii.cmi AST.cmi PPCgen.cmi
+PPCgen.cmx: Specif.cmx PPC.cmx Op.cmx Mach.cmx Locations.cmx Integers.cmx \
+ Errors.cmx Datatypes.cmx Coqlib.cmx CString.cmx CList.cmx Bool.cmx \
+ BinPos.cmx BinInt.cmx Ascii.cmx AST.cmx PPCgen.cmi
Parallelmove.cmo: Parmov.cmi Locations.cmi Datatypes.cmi CList.cmi AST.cmi \
Parallelmove.cmi
Parallelmove.cmx: Parmov.cmx Locations.cmx Datatypes.cmx CList.cmx AST.cmx \
@@ -427,28 +433,12 @@ Parmov.cmo: Specif.cmi Peano.cmi Datatypes.cmi CList.cmi Parmov.cmi
Parmov.cmx: Specif.cmx Peano.cmx Datatypes.cmx CList.cmx Parmov.cmi
Peano.cmo: Datatypes.cmi Peano.cmi
Peano.cmx: Datatypes.cmx Peano.cmi
-PPCgen.cmo: Specif.cmi PPC.cmi Op.cmi Mach.cmi Locations.cmi Integers.cmi \
- Errors.cmi Datatypes.cmi Coqlib.cmi CString.cmi CList.cmi Bool.cmi \
- BinPos.cmi BinInt.cmi Ascii.cmi AST.cmi PPCgen.cmi
-PPCgen.cmx: Specif.cmx PPC.cmx Op.cmx Mach.cmx Locations.cmx Integers.cmx \
- Errors.cmx Datatypes.cmx Coqlib.cmx CString.cmx CList.cmx Bool.cmx \
- BinPos.cmx BinInt.cmx Ascii.cmx AST.cmx PPCgen.cmi
-PPC.cmo: Values.cmi Specif.cmi Mem.cmi Maps.cmi Integers.cmi Globalenvs.cmi \
- Floats.cmi Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi BinInt.cmi \
- AST.cmi PPC.cmi
-PPC.cmx: Values.cmx Specif.cmx Mem.cmx Maps.cmx Integers.cmx Globalenvs.cmx \
- Floats.cmx Datatypes.cmx Coqlib.cmx CList.cmx BinPos.cmx BinInt.cmx \
- AST.cmx PPC.cmi
-Registers.cmo: Specif.cmi OrderedType.cmi Ordered.cmi Maps.cmi FSetAVL.cmi \
- Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi BinInt.cmi AST.cmi \
- Registers.cmi
-Registers.cmx: Specif.cmx OrderedType.cmx Ordered.cmx Maps.cmx FSetAVL.cmx \
- Datatypes.cmx Coqlib.cmx CList.cmx BinPos.cmx BinInt.cmx AST.cmx \
- Registers.cmi
-Reload.cmo: Specif.cmi Parallelmove.cmi Op.cmi Locations.cmi Linear.cmi \
- LTLin.cmi Datatypes.cmi Conventions.cmi CList.cmi AST.cmi Reload.cmi
-Reload.cmx: Specif.cmx Parallelmove.cmx Op.cmx Locations.cmx Linear.cmx \
- LTLin.cmx Datatypes.cmx Conventions.cmx CList.cmx AST.cmx Reload.cmi
+RTL.cmo: Values.cmi Registers.cmi Op.cmi Mem.cmi Maps.cmi Integers.cmi \
+ Globalenvs.cmi Datatypes.cmi CList.cmi BinPos.cmi BinInt.cmi AST.cmi \
+ RTL.cmi
+RTL.cmx: Values.cmx Registers.cmx Op.cmx Mem.cmx Maps.cmx Integers.cmx \
+ Globalenvs.cmx Datatypes.cmx CList.cmx BinPos.cmx BinInt.cmx AST.cmx \
+ RTL.cmi
RTLgen.cmo: Switch.cmi Specif.cmi Registers.cmi ../caml/RTLgenaux.cmo RTL.cmi \
Op.cmi Maps.cmi Integers.cmi Errors.cmi Datatypes.cmi Coqlib.cmi \
CminorSel.cmi CString.cmi CList.cmi BinPos.cmi Ascii.cmi AST.cmi \
@@ -457,12 +447,6 @@ RTLgen.cmx: Switch.cmx Specif.cmx Registers.cmx ../caml/RTLgenaux.cmx RTL.cmx \
Op.cmx Maps.cmx Integers.cmx Errors.cmx Datatypes.cmx Coqlib.cmx \
CminorSel.cmx CString.cmx CList.cmx BinPos.cmx Ascii.cmx AST.cmx \
RTLgen.cmi
-RTL.cmo: Values.cmi Registers.cmi Op.cmi Mem.cmi Maps.cmi Integers.cmi \
- Globalenvs.cmi Datatypes.cmi CList.cmi BinPos.cmi BinInt.cmi AST.cmi \
- RTL.cmi
-RTL.cmx: Values.cmx Registers.cmx Op.cmx Mem.cmx Maps.cmx Integers.cmx \
- Globalenvs.cmx Datatypes.cmx CList.cmx BinPos.cmx BinInt.cmx AST.cmx \
- RTL.cmi
RTLtyping.cmo: Specif.cmi Registers.cmi ../caml/RTLtypingaux.cmo RTL.cmi \
Op.cmi Maps.cmi Errors.cmi Datatypes.cmi Coqlib.cmi Conventions.cmi \
CString.cmi CList.cmi BinPos.cmi BinInt.cmi Ascii.cmi AST.cmi \
@@ -471,6 +455,16 @@ RTLtyping.cmx: Specif.cmx Registers.cmx ../caml/RTLtypingaux.cmx RTL.cmx \
Op.cmx Maps.cmx Errors.cmx Datatypes.cmx Coqlib.cmx Conventions.cmx \
CString.cmx CList.cmx BinPos.cmx BinInt.cmx Ascii.cmx AST.cmx \
RTLtyping.cmi
+Registers.cmo: Specif.cmi OrderedType.cmi Ordered.cmi Maps.cmi FSetAVL.cmi \
+ Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi BinInt.cmi AST.cmi \
+ Registers.cmi
+Registers.cmx: Specif.cmx OrderedType.cmx Ordered.cmx Maps.cmx FSetAVL.cmx \
+ Datatypes.cmx Coqlib.cmx CList.cmx BinPos.cmx BinInt.cmx AST.cmx \
+ Registers.cmi
+Reload.cmo: Specif.cmi Parallelmove.cmi Op.cmi Locations.cmi Linear.cmi \
+ LTLin.cmi Datatypes.cmi Conventions.cmi CList.cmi AST.cmi Reload.cmi
+Reload.cmx: Specif.cmx Parallelmove.cmx Op.cmx Locations.cmx Linear.cmx \
+ LTLin.cmx Datatypes.cmx Conventions.cmx CList.cmx AST.cmx Reload.cmi
Selection.cmo: Specif.cmi Op.cmi Integers.cmi Datatypes.cmi Compare_dec.cmi \
CminorSel.cmi Cminor.cmi CList.cmi BinPos.cmi BinInt.cmi AST.cmi \
Selection.cmi
diff --git a/extraction/Makefile b/extraction/Makefile
index dd70d8803..4274e8e1b 100644
--- a/extraction/Makefile
+++ b/extraction/Makefile
@@ -28,9 +28,9 @@ FILES=\
Mach.ml Bounds.ml Stacking.ml \
PPC.ml PPCgen.ml \
Main.ml \
- ../caml/Cil2Csyntax.ml \
+ ../caml/PrintCsyntax.ml ../caml/Cil2Csyntax.ml \
../caml/CMparser.ml ../caml/CMlexer.ml ../caml/CMtypecheck.ml \
- ../caml/PrintCsyntax.ml ../caml/PrintPPC.ml \
+ ../caml/PrintPPC.ml \
../caml/Configuration.ml ../caml/Driver.ml
EXTRACTEDFILES:=$(filter-out ../caml/%, $(FILES))
diff --git a/test/c/Results/lists b/test/c/Results/lists
index d86bac9de..2c94e4837 100644
--- a/test/c/Results/lists
+++ b/test/c/Results/lists
@@ -1 +1,2 @@
OK
+OK
diff --git a/test/cminor/sha1.cmp b/test/cminor/sha1.cmp
index 31c4b1786..9d7744c5c 100644
--- a/test/cminor/sha1.cmp
+++ b/test/cminor/sha1.cmp
@@ -125,11 +125,13 @@ extern "memset" : int -> int -> int -> void
"SHA1_add_data"(ctx, data, len) : int -> int -> int -> void
{
- var t;
+ var t, t2;
/* Update length */
t = context_length_lo(ctx);
- if ((context_length_lo(ctx) = t + (len << 3)) <u t)
+ t2 = t + (len << 3);
+ context_length_lo(ctx) = t2;
+ if (t2 <u t)
context_length_hi(ctx) = context_length_hi(ctx) + 1;
context_length_hi(ctx) = context_length_hi(ctx) + (len >>u 29);
--
GitLab