(* *********************************************************************)
(*                                                                     *)
(*              The Compcert verified compiler                         *)
(*                                                                     *)
(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
(*                                                                     *)
(*  Copyright Institut National de Recherche en Informatique et en     *)
(*  Automatique.  All rights reserved.  This file is distributed       *)
(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
(*                                                                     *)
(* *********************************************************************)
(** Abstract specification of RTL generation *)
(** In this module, we define inductive predicates that specify the translations from Cminor to RTL performed by the functions in module [RTLgen].  We then show that these functions satisfy these relational specifications.  The relational specifications will then be used instead of the actual functions to show semantic equivalence between the source Cminor code and the the generated RTL code (see module [RTLgenproof]). *)
Require Errors.
(** * Reasoning about monadic computations *)
(** The tactics below simplify hypotheses of the form [f ... = OK x s i] where [f] is a monadic computation.  For instance, the hypothesis [(do x <- a; b) s = OK y s' i] will generate the additional witnesses [x], [s1], [i1], [i'] and the additional hypotheses [a s = OK x s1 i1] and [b x s1 = OK y s' i'], reflecting the fact that both monadic computations [a] and [b] succeeded. *)
Remark bind_inversion:
forall (A B: Type) (f: mon A) (g: A -> mon B)
(y: B) (s1 s3: state) (i: state_incr s1 s3),
bind f g s1 = OK y s3 i ->
exists x, exists s2, exists i1, exists i2,
f s1 = OK x s2 i1 /\ g x s2 = OK y s3 i2.
Remark bind2_inversion:
forall (A B C: Type) (f: mon (A*B)) (g: A -> B -> mon C)
(z: C) (s1 s3: state) (i: state_incr s1 s3),
bind2 f g s1 = OK z s3 i ->
exists x, exists y, exists s2, exists i1, exists i2,
f s1 = OK (x, y) s2 i1 /\ g x y s2 = OK z s3 i2.
Ltac monadInv1 H :=
match type of H with
| (OK _ _ _ = OK _ _ _) =>
inversion H; clear H; try subst
| (Error _ _ = OK _ _ _) =>
discriminate
| (ret _ _ = OK _ _ _) =>
inversion H; clear H; try subst
| (error _ _ = OK _ _ _) =>
discriminate
| (bind ?F ?G ?S = OK ?X ?S' ?I) =>
let x := fresh "x" in (
let s := fresh "s" in (
let i1 := fresh "INCR" in (
let i2 := fresh "INCR" in (
let EQ1 := fresh "EQ" in (
let EQ2 := fresh "EQ" in (
destruct (bind_inversion _ _ F G X S S' I H) as [x [s [i1 [i2 [EQ1 EQ2]]]]];
clear H;
try (monadInv1 EQ2)))))))
| (bind2 ?F ?G ?S = OK ?X ?S' ?I) =>
let x1 := fresh "x" in (
let x2 := fresh "x" in (
let s := fresh "s" in (
let i1 := fresh "INCR" in (
let i2 := fresh "INCR" in (
let EQ1 := fresh "EQ" in (
let EQ2 := fresh "EQ" in (
destruct (bind2_inversion _ _ _ F G X S S' I H) as [x1 [x2 [s [i1 [i2 [EQ1 EQ2]]]]]];
clear H;
try (monadInv1 EQ2))))))))
end.
Ltac monadInv H :=
match type of H with
| (ret _ _ = OK _ _ _) => monadInv1 H
| (error _ _ = OK _ _ _) => monadInv1 H
| (bind ?F ?G ?S = OK ?X ?S' ?I) => monadInv1 H
| (bind2 ?F ?G ?S = OK ?X ?S' ?I) => monadInv1 H
| (?F _ _ _ _ _ _ _ _ = OK _ _ _) =>
((progress simpl in H) || unfold F in H); monadInv1 H
| (?F _ _ _ _ _ _ _ = OK _ _ _) =>
((progress simpl in H) || unfold F in H); monadInv1 H
| (?F _ _ _ _ _ _ = OK _ _ _) =>
((progress simpl in H) || unfold F in H); monadInv1 H
| (?F _ _ _ _ _ = OK _ _ _) =>
((progress simpl in H) || unfold F in H); monadInv1 H
| (?F _ _ _ _ = OK _ _ _) =>
((progress simpl in H) || unfold F in H); monadInv1 H
| (?F _ _ _ = OK _ _ _) =>
((progress simpl in H) || unfold F in H); monadInv1 H
| (?F _ _ = OK _ _ _) =>
((progress simpl in H) || unfold F in H); monadInv1 H
| (?F _ = OK _ _ _) =>
((progress simpl in H) || unfold F in H); monadInv1 H
end.
(** * Monotonicity properties of the state *)
Hint Resolve state_incr_refl: rtlg.

Lemma instr_at_incr:
forall s1 s2 n i,
state_incr s1 s2 -> s1.(st_code)!n = Some i -> s2.(st_code)!n = Some i.