diff options
33 files changed, 4572 insertions, 3523 deletions
@@ -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 2b9945a..1d2eea7 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 331105e..859c46e 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 117631e..2fe13e5 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 15f305a..e9a04fc 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 c46bdbb..a291d32 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 c98e55e..0183ee7 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 e41765a..177e321 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 ae71e0c..7951982 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 0db0af2..fb09527 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 495ded0..9277829 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 553229c..0e16841 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 f9abd9a..59c42d3 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 d021a63..8596ebf 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 5bcb880..ff10bb3 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 385f7c6..af601ac 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 7d805c3..7afe27f 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 937ea78..6ec3757 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 b86b09b..9930ef8 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 a75621c..aa4e391 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 10f48f6..54f9b77 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 3866669..31d1d87 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 cb572c0..72c4edf 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 5280947..2263f4e 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 83a7a19..e9070e1 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 33bc783..db15929 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 f60746d..8039ba4 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 e75e7b1..4390c87 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 82809ba..5ae9a23 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 afffe81..6a10752 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 dd70d88..4274e8e 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 d86bac9..2c94e48 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 31c4b17..9d7744c 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); |