Postorder renumbering of RTL control-flow graphs.
Require Import Coqlib.
Require Import Maps.
Require Import Postorder.
Require Import Events.
Require Import Globalenvs.
Require Import Smallstep.
Require Import Op.
Require Import Registers.
Require Import RTL.
Require Import Errors.
Require Import Renumber2.
Open Scope error_monad_scope.
Section PRESERVATION.
Variable prog tprog:
program.
Hypothesis TRANSF:
transf_program prog =
OK tprog.
Let ge :=
Genv.globalenv prog.
Let tge :=
Genv.globalenv tprog.
Lemma functions_translated:
forall v f,
Genv.find_funct ge v =
Some f ->
exists f',
Genv.find_funct tge v =
Some f' /\
transf_fundef f =
OK f'.
Proof (@
Genv.find_funct_transf_partial _ _ _ transf_fundef prog _ TRANSF).
Lemma function_ptr_translated:
forall v f,
Genv.find_funct_ptr ge v =
Some f ->
exists f',
Genv.find_funct_ptr tge v =
Some f' /\
transf_fundef f =
OK f'.
Proof (@
Genv.find_funct_ptr_transf_partial _ _ _ transf_fundef prog _ TRANSF).
Lemma symbols_preserved:
forall id,
Genv.find_symbol tge id =
Genv.find_symbol ge id.
Proof (@
Genv.find_symbol_transf_partial _ _ _ transf_fundef prog _ TRANSF).
Lemma public_preserved:
forall id,
Genv.public_symbol tge id =
Genv.public_symbol ge id.
Proof (@
Genv.public_symbol_transf_partial _ _ _ transf_fundef prog _ TRANSF).
Lemma varinfo_preserved:
forall b,
Genv.find_var_info tge b =
Genv.find_var_info ge b.
Proof (@
Genv.find_var_info_transf_partial _ _ _ transf_fundef prog _ TRANSF).
Lemma sig_preserved:
forall f tf,
transf_fundef f =
OK tf ->
funsig tf =
funsig f.
Proof.
intros; destruct f; monadInv H; try reflexivity.
monadInv EQ. simpl; reflexivity.
Qed.
Lemma find_function_translated:
forall ros rs fd,
find_function ge ros rs =
Some fd ->
exists tfd,
find_function tge ros rs =
Some tfd /\
transf_fundef fd =
OK tfd.
Proof.
Effect of an injective renaming of nodes on a CFG.
Section RENUMBER.
Variable f:
PTree.t positive.
Hypothesis f_inj:
forall x1 x2 y,
f!
x1 =
Some y ->
f!
x2 =
Some y ->
x1 =
x2.
Lemma renum_cfg_nodes:
forall c c'
x y i,
c!
x =
Some i ->
f!
x =
Some y ->
renum_cfg f c =
OK c' ->
exists i',
renum_instr f i =
OK i' /\
c'!
y =
Some i'.
Proof.
Lemma renum_cfg_nodes_inv:
forall c c'
x y i',
c'!
y =
Some i' ->
f!
x =
Some y ->
renum_cfg f c =
OK c' ->
exists i,
renum_instr f i =
OK i' /\
c!
x =
Some i.
Proof.
End RENUMBER.
Definition pnum (
f:
function) :=
postorder (
successors_map f)
f.(
fn_entrypoint).
Definition reach (
f:
function) (
pc:
node) :=
reachable (
successors_map f)
f.(
fn_entrypoint)
pc.
Lemma transf_function_at:
forall f tf pc pc'
i,
f.(
fn_code)!
pc =
Some i ->
reach f pc ->
transf_function f =
OK tf ->
renum_pc (
pnum f)
pc =
OK pc' ->
exists i',
renum_instr (
pnum f)
i =
OK i' /\
(
fn_code tf)!
pc' =
Some i'.
Proof.
Lemma transf_function_at_inv:
forall f tf pc pc'
i',
(
fn_code tf)!
pc' =
Some i' ->
reach f pc ->
transf_function f =
OK tf ->
renum_pc (
pnum f)
pc =
OK pc' ->
exists i,
f.(
fn_code)!
pc =
Some i /\
renum_instr (
pnum f)
i =
OK i'.
Proof.
Ltac TR_AT :=
match goal with
| [
A: (
fn_code _)!
_ =
Some _ ,
B:
reach _ _,
C:
transf_function _ =
OK _,
D:
renum_pc _ _ =
OK _ |-
_ ] =>
generalize (
transf_function_at _ _ _ _ _ A B C D);
simpl renum_instr;
intros
end.
Lemma reach_succ:
forall f pc i s,
f.(
fn_code)!
pc =
Some i ->
In s (
successors_instr i) ->
reach f pc ->
reach f s.
Proof.
Inductive match_frames:
RTL.stackframe ->
RTL.stackframe ->
Prop :=
|
match_frames_intro:
forall res f tf sp pc pc'
rs
(
TRANSF':
transf_function f =
OK tf)
(
PC:
renum_pc (
pnum f)
pc =
OK pc')
(
REACH:
reach f pc),
match_frames (
Stackframe res f sp pc rs)
(
Stackframe res tf sp pc'
rs).
Inductive match_states:
RTL.state ->
RTL.state ->
Prop :=
|
match_regular_states:
forall stk f tf sp pc pc'
rs m stk'
(
TRANSF':
transf_function f =
OK tf)
(
PC:
renum_pc (
pnum f)
pc =
OK pc')
(
STACKS:
list_forall2 match_frames stk stk')
(
REACH:
reach f pc),
match_states (
State stk f sp pc rs m)
(
State stk'
tf sp pc'
rs m)
|
match_callstates:
forall stk f tf args m stk'
(
TRANSF':
transf_fundef f =
OK tf)
(
STACKS:
list_forall2 match_frames stk stk'),
match_states (
Callstate stk f args m)
(
Callstate stk'
tf args m)
|
match_returnstates:
forall stk v m stk'
(
STACKS:
list_forall2 match_frames stk stk'),
match_states (
Returnstate stk v m)
(
Returnstate stk'
v m).
Lemma list_nth_z_mmap:
forall (
A B :
Type) (
f :
A ->
res B) (
l :
list A) (
l':
list B) (
n :
Z),
mmap f l =
OK l' ->
(
forall x,
list_nth_z l'
n =
Some x <->
option_map f (
list_nth_z l n) =
Some (
OK x)).
Proof.
induction l;
intros.
-
simpl in H;
inv H.
split;
simpl;
intros;
congruence.
-
simpl in H.
monadInv H.
simpl.
destruct (
zeq n 0);
split;
intros.
+
subst n.
inv H.
unfold option_map.
congruence.
+
unfold option_map in H.
subst n.
congruence.
+
eapply (
proj1 (
IHl _ (
Z.pred n)
EQ1 x)
H).
+
eapply (
proj2 (
IHl _ (
Z.pred n)
EQ1 x)
H).
Qed.
Lemma list_forall2_in_1:
forall (
A B:
Type) (
P:
A ->
B ->
Prop) (
l1:
list A) (
l2:
list B) (
a:
A),
list_forall2 P l1 l2 ->
In a l1 ->
exists b,
In b l2 /\
P a b.
Proof.
induction l1;
intros.
-
inv H0.
-
destruct H0 as [
H0 |
H0].
+
subst a0.
inv H.
exists b1;
split;
eauto.
eapply in_eq.
+
inv H.
generalize (
IHl1 _ _ H5 H0).
intros [
b [
HA HB]].
exists b;
split;
eauto.
eapply in_cons;
auto.
Qed.
Lemma step_simulation:
forall S1 t S2,
RTL.step ge S1 t S2 ->
forall S1',
match_states S1 S1' ->
exists S2',
RTL.step tge S1'
t S2' /\
match_states S2 S2'.
Proof.
Lemma transf_initial_states:
forall S1,
RTL.initial_state prog S1 ->
exists S2,
RTL.initial_state tprog S2 /\
match_states S1 S2.
Proof.
Lemma transf_final_states:
forall S1 S2 r,
match_states S1 S2 ->
RTL.final_state S1 r ->
RTL.final_state S2 r.
Proof.
intros. inv H0. inv H. inv STACKS. constructor.
Qed.
Theorem transf_program_correct:
forward_simulation (
RTL.semantics prog) (
RTL.semantics tprog).
Proof.
Lemma renumber_match_genvs:
Genv.match_genvs (
fun fd1 fd2 =>
transf_fundef fd1 =
OK fd2) (
fun gv1 gv2 =>
OK gv1 =
OK gv2)
nil (
Genv.globalenv prog) (
Genv.globalenv tprog).
Proof.
Lemma renumber_match_program:
AST.match_program (
fun fd tfd =>
transf_fundef fd =
OK tfd) (
fun gv1 gv2 =>
OK gv1 =
OK gv2)
nil (
AST.prog_main prog)
prog tprog.
Proof.
Lemma store_init_data_symbols_preserved:
forall A B (
ge ge':
Genv.t A B)
id m b p,
(
forall s,
Genv.find_symbol ge s =
Genv.find_symbol ge'
s) ->
Genv.store_init_data ge m b p id =
Genv.store_init_data ge'
m b p id.
Proof.
destruct id; intros; auto.
simpl. rewrite H; auto.
Qed.
Lemma store_init_data_list_symbols_preserved:
forall A B (
ge ge':
Genv.t A B)
id m b p,
(
forall s,
Genv.find_symbol ge s =
Genv.find_symbol ge'
s) ->
Genv.store_init_data_list ge m b p id =
Genv.store_init_data_list ge'
m b p id.
Proof.
Lemma alloc_globals_invariant_if_var_untouched:
forall ge ge'
gl gl'
m m',
Genv.alloc_globals ge m gl' =
Some m' ->
list_forall2 (
AST.match_globdef (
fun fd tfd :
fundef =>
transf_fundef fd =
OK tfd) (
fun gv1 gv2 :
unit =>
OK gv1 =
OK gv2))
gl gl' ->
(
forall id,
Genv.find_symbol ge id =
Genv.find_symbol ge'
id) ->
Genv.alloc_globals ge'
m gl =
Some m'.
Proof.
Lemma find_function_translated':
forall ros rs tfd,
find_function tge ros rs =
Some tfd ->
exists fd,
find_function ge ros rs =
Some fd /\
transf_fundef fd =
OK tfd.
Proof.
Theorem transf_program_backward_simulation:
backward_simulation (
RTL.semantics tprog) (
RTL.semantics prog).
Proof.
End PRESERVATION.