(* *********************************************************************)
(*                                                                     *)
(*              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.     *)
(*                                                                     *)
(* *********************************************************************)
(** RTL function inlining: relational specification *)
(** ** Soundness of function environments. *)
(** A compile-time function environment is compatible with a whole program if the following condition holds. *)
Definition fenv_compat (p: program) (fenv: funenv) : Prop :=
forall id f,
fenv!id = Some f -> (prog_defmap p)!id = Some (Gfun (Internal f)).
(** ** Properties of shifting *)
(** ** Working with the state monad *)
Remark bind_inversion:
forall (A B: Type) (f: mon A) (g: A -> mon B)
(y: B) (s1 s3: state) (i: sincr s1 s3),
bind f g s1 = R y s3 i ->
exists x, exists s2, exists i1, exists i2,
f s1 = R x s2 i1 /\ g x s2 = R y s3 i2.
Ltac monadInv1 H :=
match type of H with
| (R _ _ _ = R _ _ _) =>
inversion H; clear H; try subst
| (ret _ _ = R _ _ _) =>
inversion H; clear H; try subst
| (bind ?F ?G ?S = R ?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)))))))
end.
Ltac monadInv H :=
match type of H with
| (ret _ _ = R _ _ _) => monadInv1 H
| (bind ?F ?G ?S = R ?X ?S' ?I) => monadInv1 H
| (?F _ _ _ _ _ _ _ _ = R _ _ _) =>
((progress simpl in H) || unfold F in H); monadInv1 H
| (?F _ _ _ _ _ _ _ = R _ _ _) =>
((progress simpl in H) || unfold F in H); monadInv1 H
| (?F _ _ _ _ _ _ = R _ _ _) =>
((progress simpl in H) || unfold F in H); monadInv1 H
| (?F _ _ _ _ _ = R _ _ _) =>
((progress simpl in H) || unfold F in H); monadInv1 H
| (?F _ _ _ _ = R _ _ _) =>
((progress simpl in H) || unfold F in H); monadInv1 H
| (?F _ _ _ = R _ _ _) =>
((progress simpl in H) || unfold F in H); monadInv1 H
| (?F _ _ = R _ _ _) =>
((progress simpl in H) || unfold F in H); monadInv1 H
| (?F _ = R _ _ _) =>
((progress simpl in H) || unfold F in H); monadInv1 H
end.
Fixpoint mlist_iter2 {A B: Type} (f: A -> B -> mon unit) (l: list (A*B)): mon unit :=
match l with
| nil => ret tt
| (x,y) :: l' => do z <- f x y; mlist_iter2 f l'
end.
Remark mlist_iter2_fold:
forall (A B: Type) (f: A -> B -> mon unit) l s,
exists i,
mlist_iter2 f l s =
R tt (fold_left (fun a p => match f (fst p) (snd p) a with R _ s2 _ => s2 end) l s) i.
(** ** Relational specification of the translation of moves *)
Inductive tr_moves (c: code) : node -> list reg -> list reg -> node -> Prop :=
| tr_moves_cons: forall pc1 src srcs dst dsts pc2 pc3,
tr_moves c pc1 srcs dsts pc2 ->
c!pc2 = Some(Iop Omove (src :: nil) dst pc3) ->
tr_moves c pc1 (src :: srcs) (dst :: dsts) pc3
| tr_moves_nil: forall srcs dsts pc,
srcs = nil \/ dsts = nil ->
tr_moves c pc srcs dsts pc.

Lemma add_moves_spec:
forall srcs dsts pc2 s pc1 s' i c,
add_moves srcs dsts pc2 s = R pc1 s' i ->
(forall pc, Ple s.(st_nextnode) pc -> Plt pc s'.(st_nextnode) -> c!pc = s'.(st_code)!pc) ->
tr_moves c pc1 srcs dsts pc2.