(* *********************************************************************)
(*                                                                     *)
(*              The Compcert verified compiler                         *)
(*                                                                     *)
(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
(*           Prashanth Mundkur, SRI International                      *)
(*                                                                     *)
(*  Copyright Institut National de Recherche en Informatique et en     *)
(*  Automatique.  All rights reserved.  This file is distributed       *)
(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
(*                                                                     *)
(*  The contributions by Prashanth Mundkur are reused and adapted      *)
(*  under the terms of a Contributor License Agreement between         *)
(*  SRI International and INRIA.                                       *)
(*                                                                     *)
(* *********************************************************************)
(** Correctness of instruction selection for operators *)
Local Open Scope cminorsel_scope.
(** * Useful lemmas and tactics *)
(** The following are trivial lemmas and custom tactics that help perform backward (inversion) and forward reasoning over the evaluation of operator applications. *)
Ltac EvalOp := eapply eval_Eop; eauto with evalexpr.
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 InvEval2 :=
match goal with
| [ 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 := InvEval1; InvEval2; InvEval2.
Ltac TrivialExists :=
match goal with
| [ |- exists v, _ /\ Val.lessdef ?a v ] => exists a; split; [EvalOp | auto]
end.
(** * Correctness of the smart constructors *)
Section CMCONSTR.
Variable ge: genv.
Variable sp: val.
Variable e: env.
Variable m: mem.
(** We now show that the code generated by "smart constructor" functions such as [Selection.notint] behaves as expected.  Continuing the [notint] example, we show that if the expression [e] evaluates to some integer value [Vint n], then [Selection.notint e] evaluates to a value [Vint (Int.not n)] which is indeed the integer negation of the value of [e].  All proofs follow a common pattern: - Reasoning by case over the result of the classification functions (such as [add_match] for integer addition), gathering additional information on the shape of the argument expressions in the non-default cases. - Inversion of the evaluations of the arguments, exploiting the additional information thus gathered. - Equational reasoning over the arithmetic operations performed, using the lemmas from the [Int] and [Float] modules. - Construction of an evaluation derivation for the expression returned by the smart constructor. *)
Definition unary_constructor_sound (cstr: expr -> expr) (sem: val -> val) : Prop :=
forall le a x,
eval_expr ge sp e m le a x ->
exists v, eval_expr ge sp e m le (cstr a) v /\ Val.lessdef (sem x) v.
Definition binary_constructor_sound (cstr: expr -> expr -> expr) (sem: val -> val -> val) : Prop :=
forall le a x b y,
eval_expr ge sp e m le a x ->
eval_expr ge sp e m le b y ->
exists v, eval_expr ge sp e m le (cstr a b) v /\ Val.lessdef (sem x y) v.

(* Specifications: *)
Theorem eval_addrsymbol:
forall le id ofs,
exists v, eval_expr ge sp e m le (addrsymbol id ofs) v /\ Val.lessdef (Genv.symbol_address ge id ofs) v.
Theorem eval_addrstack:
forall le ofs,
exists v, eval_expr ge sp e m le (addrstack ofs) v /\ Val.lessdef (Val.offset_ptr sp ofs) v.
Theorem eval_addimm:
forall n, unary_constructor_sound (addimm n) (fun x => Val.add x (Vint n)).
Theorem eval_add: binary_constructor_sound add Val.add.
Theorem eval_sub: binary_constructor_sound sub Val.sub.
Theorem eval_negint: unary_constructor_sound negint (fun v => Val.sub Vzero v).
Theorem eval_shlimm:
forall n, unary_constructor_sound (fun a => shlimm a n)
(fun x => Val.shl x (Vint n)).
Theorem eval_shruimm:
forall n, unary_constructor_sound (fun a => shruimm a n)
(fun x => Val.shru x (Vint n)).
Theorem eval_shrimm:
forall n, unary_constructor_sound (fun a => shrimm a n)
(fun x => Val.shr x (Vint n)).
Lemma eval_mulimm_base:
forall n, unary_constructor_sound (mulimm_base n) (fun x => Val.mul x (Vint n)).
Theorem eval_mulimm:
forall n, unary_constructor_sound (mulimm n) (fun x => Val.mul x (Vint n)).
Theorem eval_mul: binary_constructor_sound mul Val.mul.
Theorem eval_mulhs: binary_constructor_sound mulhs Val.mulhs.
Theorem eval_mulhu: binary_constructor_sound mulhu Val.mulhu.
Theorem eval_andimm:
forall n, unary_constructor_sound (andimm n) (fun x => Val.and x (Vint n)).
Theorem eval_and: binary_constructor_sound and Val.and.
Theorem eval_orimm:
forall n, unary_constructor_sound (orimm n) (fun x => Val.or x (Vint n)).
Theorem eval_or: binary_constructor_sound or Val.or.
Theorem eval_xorimm:
forall n, unary_constructor_sound (xorimm n) (fun x => Val.xor x (Vint n)).
Theorem eval_xor: binary_constructor_sound xor Val.xor.
Theorem eval_notint: unary_constructor_sound notint Val.notint.
Theorem eval_divs_base:
forall le a b x y z,
eval_expr ge sp e m le a x ->
eval_expr ge sp e m le b y ->
Val.divs x y = Some z ->
exists v, eval_expr ge sp e m le (divs_base a b) v /\ Val.lessdef z v.
Theorem eval_mods_base:
forall le a b x y z,
eval_expr ge sp e m le a x ->
eval_expr ge sp e m le b y ->
Val.mods x y = Some z ->
exists v, eval_expr ge sp e m le (mods_base a b) v /\ Val.lessdef z v.
Theorem eval_divu_base:
forall le a b x y z,
eval_expr ge sp e m le a x ->
eval_expr ge sp e m le b y ->
Val.divu x y = Some z ->
exists v, eval_expr ge sp e m le (divu_base a b) v /\ Val.lessdef z v.
Theorem eval_modu_base:
forall le a b x y z,
eval_expr ge sp e m le a x ->
eval_expr ge sp e m le b y ->
Val.modu x y = Some z ->
exists v, eval_expr ge sp e m le (modu_base a b) v /\ Val.lessdef z v.
Theorem eval_shrximm:
forall le a n x z,
eval_expr ge sp e m le a x ->
Val.shrx x (Vint n) = Some z ->
exists v, eval_expr ge sp e m le (shrximm a n) v /\ Val.lessdef z v.
Theorem eval_shl: binary_constructor_sound shl Val.shl.
Theorem eval_shr: binary_constructor_sound shr Val.shr.
Theorem eval_shru: binary_constructor_sound shru Val.shru.
Theorem eval_negf: unary_constructor_sound negf Val.negf.
Theorem eval_absf: unary_constructor_sound absf Val.absf.
Theorem eval_addf: binary_constructor_sound addf Val.addf.
Theorem eval_subf: binary_constructor_sound subf Val.subf.
Theorem eval_mulf: binary_constructor_sound mulf Val.mulf.
Theorem eval_negfs: unary_constructor_sound negfs Val.negfs.
Theorem eval_absfs: unary_constructor_sound absfs Val.absfs.
Theorem eval_addfs: binary_constructor_sound addfs Val.addfs.
Theorem eval_subfs: binary_constructor_sound subfs Val.subfs.
Theorem eval_mulfs: binary_constructor_sound mulfs Val.mulfs.
Section COMP_IMM.