Module Injectproof
Require Import Coqlib Maps Errors Integers Floats Lattice Kildall.
Require Import AST Linking.
Require Import Memory Registers Op RTL Globalenvs Values Events.
Require Import Inject.
Require Import Lia.
Local Open Scope positive.
Lemma inject_list_preserves:
forall l prog pc dst pc0,
pc0 <
pc ->
PTree.get pc0 (
snd (
inject_list prog pc dst l)) =
PTree.get pc0 prog.
Proof.
induction l;
intros;
simpl.
-
apply PTree.gso.
lia.
-
rewrite IHl by lia.
apply PTree.gso.
lia.
Qed.
Fixpoint pos_add_nat x n :=
match n with
|
O =>
x
|
S n' =>
Pos.succ (
pos_add_nat x n')
end.
Lemma pos_add_nat_increases :
forall x n,
x <= (
pos_add_nat x n).
Proof.
induction n; simpl; lia.
Qed.
Lemma pos_add_nat_succ :
forall n x,
Pos.succ (
pos_add_nat x n) =
pos_add_nat (
Pos.succ x)
n.
Proof.
induction n; simpl; intros; trivial.
rewrite IHn.
reflexivity.
Qed.
Lemma pos_add_nat_monotone :
forall x n1 n2,
(
n1 <
n2) %
nat ->
(
pos_add_nat x n1) < (
pos_add_nat x n2).
Proof.
induction n1;
destruct n2;
intros.
-
lia.
-
simpl.
pose proof (
pos_add_nat_increases x n2).
lia.
-
lia.
-
simpl.
specialize IHn1 with n2.
lia.
Qed.
Lemma inject_list_increases:
forall l prog pc dst,
(
fst (
inject_list prog pc dst l)) =
pos_add_nat pc (
S (
List.length l)).
Proof.
induction l;
simpl;
intros;
trivial.
rewrite IHl.
simpl.
rewrite <-
pos_add_nat_succ.
reflexivity.
Qed.
Program Fixpoint bounded_nth
{
T :
Type} (
k :
nat) (
l :
list T) (
BOUND : (
k <
List.length l)%
nat) :
T :=
match k,
l with
|
O,
h::
_ =>
h
| (
S k'),
_::
l' =>
bounded_nth k'
l'
_
|
_,
nil =>
_
end.
Obligation 1.
Proof.
simpl in BOUND.
lia.
Qed.
Obligation 2.
Proof.
simpl in BOUND.
lia.
Qed.
Program Definition bounded_nth_S_statement :
Prop :=
forall (
T :
Type) (
k :
nat) (
h :
T) (
l :
list T) (
BOUND : (
k <
List.length l)%
nat),
bounded_nth (
S k) (
h::
l)
_ =
bounded_nth k l BOUND.
Obligation 1.
lia.
Qed.
Lemma bounded_nth_proof_irr :
forall {T : Type} (k : nat) (l : list T)
(BOUND1 BOUND2 : (k < List.length l)%nat),
(bounded_nth k l BOUND1) = (bounded_nth k l BOUND2).
Proof.
induction k; destruct l; simpl; intros; trivial; lia.
Qed.
Lemma bounded_nth_S : bounded_nth_S_statement.
Proof.
Lemma inject_list_injected:
forall l prog pc dst k (BOUND : (k < (List.length l))%nat),
PTree.get (pos_add_nat pc k) (snd (inject_list prog pc dst l)) =
Some (inject_instr (bounded_nth k l BOUND) (Pos.succ (pos_add_nat pc k))).
Proof.
Lemma inject_list_injected_end:
forall l prog pc dst,
PTree.get (pos_add_nat pc (List.length l))
(snd (inject_list prog pc dst l)) =
Some (Inop dst).
Proof.
Lemma inject_at_preserves :
forall prog pc extra_pc l pc0,
pc0 < extra_pc ->
pc0 <> pc ->
PTree.get pc0 (snd (inject_at prog pc extra_pc l)) = PTree.get pc0 prog.
Proof.
Lemma inject_at_redirects:
forall prog pc extra_pc l i,
pc < extra_pc ->
PTree.get pc prog = Some i ->
PTree.get pc (snd (inject_at prog pc extra_pc l)) =
Some (alter_successor i extra_pc).
Proof.
Lemma inject_at_redirects_none:
forall prog pc extra_pc l,
pc < extra_pc ->
PTree.get pc prog = None ->
PTree.get pc (snd (inject_at prog pc extra_pc l)) = None.
Proof.
Lemma inject_at_increases:
forall prog pc extra_pc l,
(fst (inject_at prog pc extra_pc l)) = pos_add_nat extra_pc (S (List.length l)).
Proof.
Lemma inject_at_injected:
forall l prog pc extra_pc k (BOUND : (k < (List.length l))%nat),
PTree.get (pos_add_nat extra_pc k) (snd (inject_at prog pc extra_pc l)) =
Some (inject_instr (bounded_nth k l BOUND) (Pos.succ (pos_add_nat extra_pc k))).
Proof.
Lemma inject_at_injected_end:
forall l prog pc extra_pc i,
PTree.get pc prog = Some i ->
PTree.get (pos_add_nat extra_pc (List.length l))
(snd (inject_at prog pc extra_pc l)) =
Some (Inop (successor i)).
Proof.
Lemma pair_expand:
forall { A B : Type } (p : A*B),
p = ((fst p), (snd p)).
Proof.
destruct p; simpl; trivial.
Qed.
Fixpoint inject_l_position extra_pc
(injections : list (node * (list inj_instr)))
(k : nat) {struct injections} : node :=
match injections with
| nil => extra_pc
| (pc,l)::l' =>
match k with
| O => extra_pc
| S k' =>
inject_l_position
(Pos.succ (pos_add_nat extra_pc (List.length l))) l' k'
end
end.
Lemma inject_l_position_increases : forall injections pc k,
pc <= inject_l_position pc injections k.
Proof.
Definition inject_l (prog : code) extra_pc injections :=
List.fold_left (fun already (injection : node * (list inj_instr)) =>
inject_at' already (fst injection) (snd injection))
injections
(extra_pc, prog).
Lemma inject_l_preserves :
forall injections prog extra_pc pc0,
pc0 < extra_pc ->
List.forallb (fun injection => if peq (fst injection) pc0 then false else true) injections = true ->
PTree.get pc0 (snd (inject_l prog extra_pc injections)) = PTree.get pc0 prog.
Proof.
Lemma nth_error_nil : forall { T : Type} k,
nth_error (@nil T) k = None.
Proof.
destruct k; simpl; trivial.
Qed.
Lemma inject_l_injected:
forall injections prog injnum pc l extra_pc k
(BELOW : forallb (fun injection => (fst injection) <? extra_pc) injections = true)
(NUMBER : nth_error injections injnum = Some (pc, l))
(BOUND : (k < (List.length l))%nat),
PTree.get (pos_add_nat (inject_l_position extra_pc injections injnum) k)
(snd (inject_l prog extra_pc injections)) =
Some (inject_instr (bounded_nth k l BOUND)
(Pos.succ (pos_add_nat (inject_l_position extra_pc injections injnum) k))).
Proof.
Lemma inject_l_injected_end:
forall injections prog injnum pc i l extra_pc
(BEFORE : PTree.get pc prog = Some i)
(DISTINCT : list_norepet (map fst injections))
(BELOW : forallb (fun injection => (fst injection) <? extra_pc) injections = true)
(NUMBER : nth_error injections injnum = Some (pc, l)),
PTree.get (pos_add_nat (inject_l_position extra_pc injections injnum)
(List.length l))
(snd (inject_l prog extra_pc injections)) =
Some (Inop (successor i)).
Proof.
Lemma inject_l_redirects:
forall injections prog injnum pc i l extra_pc
(BEFORE : PTree.get pc prog = Some i)
(DISTINCT : list_norepet (map fst injections))
(BELOW : forallb (fun injection => (fst injection) <? extra_pc) injections = true)
(NUMBER : nth_error injections injnum = Some (pc, l)),
PTree.get pc (snd (inject_l prog extra_pc injections)) =
Some (alter_successor i (inject_l_position extra_pc injections injnum)).
Proof.
Section INJECTOR.
Variable gen_injections : function -> node -> reg -> PTree.t (list inj_instr).
Definition match_prog (p tp: RTL.program) :=
match_program (fun ctx f tf => transf_fundef gen_injections f = OK tf) eq p tp.
Lemma transf_program_match:
forall p tp, transf_program gen_injections p = OK tp -> match_prog p tp.
Proof.
Section PRESERVATION.
Variables prog tprog: program.
Hypothesis TRANSF: match_prog prog tprog.
Let ge := Genv.globalenv prog.
Let tge := Genv.globalenv tprog.
Definition match_regs (f : function) (rs rs' : regset) :=
forall r, r <= max_reg_function f -> (rs'#r = rs#r).
Lemma match_regs_refl : forall f rs, match_regs f rs rs.
Proof.
Lemma match_regs_trans : forall f rs1 rs2 rs3,
match_regs f rs1 rs2 -> match_regs f rs2 rs3 -> match_regs f rs1 rs3.
Proof.
unfold match_regs.
intros until rs3.
intros M12 M23 r.
specialize M12 with r.
specialize M23 with r.
intuition congruence.
Qed.
Inductive match_frames: RTL.stackframe -> RTL.stackframe -> Prop :=
| match_frames_intro: forall res f tf sp pc pc' rs trs
(FUN : transf_function gen_injections f = OK tf)
(REGS : match_regs f rs trs)
(STAR:
forall ts m trs1,
exists trs2,
(match_regs f trs1 trs2) /\
Smallstep.star RTL.step tge
(State ts tf sp pc' trs1 m) E0
(State ts tf sp pc trs2 m)),
match_frames (Stackframe res f sp pc rs)
(Stackframe res tf sp pc' trs).
Inductive match_states: state -> state -> Prop :=
| match_states_intro:
forall s f tf sp pc rs trs m ts
(FUN : transf_function gen_injections f = OK tf)
(STACKS: list_forall2 match_frames s ts)
(REGS: match_regs f rs trs),
match_states (State s f sp pc rs m) (State ts tf sp pc trs m)
| match_states_call:
forall s fd tfd args m ts
(FUN : transf_fundef gen_injections fd = OK tfd)
(STACKS: list_forall2 match_frames s ts),
match_states (Callstate s fd args m) (Callstate ts tfd args m)
| match_states_return:
forall s res m ts
(STACKS: list_forall2 match_frames s ts),
match_states (Returnstate s res m)
(Returnstate ts res m).
Lemma functions_translated:
forall (v: val) (f: RTL.fundef),
Genv.find_funct ge v = Some f ->
exists tf,
Genv.find_funct tge v = Some tf /\
transf_fundef gen_injections f = OK tf.
Proof.
Lemma function_ptr_translated:
forall (b: block) (f: RTL.fundef),
Genv.find_funct_ptr ge b = Some f ->
exists tf,
Genv.find_funct_ptr tge b = Some tf /\
transf_fundef gen_injections f = OK tf.
Proof.
Lemma symbols_preserved:
forall id,
Genv.find_symbol tge id = Genv.find_symbol ge id.
Proof.
Lemma senv_preserved:
Senv.equiv ge tge.
Proof.
Lemma sig_preserved:
forall f tf, transf_fundef gen_injections f = OK tf
-> funsig tf = funsig f.
Proof.
Lemma stacksize_preserved:
forall f tf, transf_function gen_injections f = OK tf ->
fn_stacksize tf = fn_stacksize f.
Proof.
Lemma params_preserved:
forall f tf, transf_function gen_injections f = OK tf ->
fn_params tf = fn_params f.
Proof.
Lemma entrypoint_preserved:
forall f tf, transf_function gen_injections f = OK tf ->
fn_entrypoint tf = fn_entrypoint f.
Proof.
Lemma sig_preserved2:
forall f tf, transf_function gen_injections f = OK tf ->
fn_sig tf = fn_sig f.
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 ->
final_state S1 r -> final_state S2 r.
Proof.
intros. inv H0. inv H. inv STACKS. constructor.
Qed.
Lemma assign_above:
forall f trs res v,
(max_reg_function f) < res ->
match_regs f trs trs # res <- v.
Proof.
Lemma transf_function_inj_step:
forall ts f tf sp pc trs m ii
(FUN : transf_function gen_injections f = OK tf)
(GET : (fn_code tf) ! pc = Some (inject_instr ii (Pos.succ pc)))
(VALID : valid_injection_instr (max_reg_function f) ii = true),
exists trs',
RTL.step tge
(State ts tf sp pc trs m) E0
(State ts tf sp (Pos.succ pc) trs' m) /\
match_regs (f : function) trs trs'.
Proof.
Lemma bounded_nth_In: forall {T : Type} (l : list T) k LESS,
In (bounded_nth k l LESS) l.
Proof.
induction l; simpl; intros.
lia.
destruct k; simpl.
- left; trivial.
- right. apply IHl.
Qed.
Lemma transf_function_inj_starstep_rec :
forall ts f tf sp m inj_n src_pc inj_pc inj_code
(FUN : transf_function gen_injections f = OK tf)
(INJ : nth_error (PTree.elements (gen_injections f (max_pc_function f) (max_reg_function f))) inj_n =
Some (src_pc, inj_code))
(POSITION : inject_l_position (Pos.succ (max_pc_function f))
(PTree.elements (gen_injections f (max_pc_function f) (max_reg_function f))) inj_n = inj_pc)
(k : nat)
(CUR : (k <= (List.length inj_code))%nat)
(trs : regset),
exists trs',
match_regs (f : function) trs trs' /\
Smallstep.star RTL.step tge
(State ts tf sp (pos_add_nat inj_pc
((List.length inj_code) - k)%nat) trs m) E0
(State ts tf sp (pos_add_nat inj_pc (List.length inj_code)) trs' m).
Proof.
Lemma transf_function_inj_starstep :
forall ts f tf sp m inj_n src_pc inj_pc inj_code
(FUN : transf_function gen_injections f = OK tf)
(INJ : nth_error (PTree.elements (gen_injections f (max_pc_function f) (max_reg_function f))) inj_n =
Some (src_pc, inj_code))
(POSITION : inject_l_position (Pos.succ (max_pc_function f))
(PTree.elements (gen_injections f (max_pc_function f) (max_reg_function f))) inj_n = inj_pc)
(trs : regset),
exists trs',
match_regs (f : function) trs trs' /\
Smallstep.star RTL.step tge
(State ts tf sp inj_pc trs m) E0
(State ts tf sp (pos_add_nat inj_pc (List.length inj_code)) trs' m).
Proof.
Lemma transf_function_inj_end :
forall ts f tf sp m inj_n src_pc inj_pc inj_code i
(FUN : transf_function gen_injections f = OK tf)
(INJ : nth_error (PTree.elements (gen_injections f (max_pc_function f) (max_reg_function f))) inj_n =
Some (src_pc, inj_code))
(SRC: (fn_code f) ! src_pc = Some i)
(POSITION : inject_l_position (Pos.succ (max_pc_function f))
(PTree.elements (gen_injections f (max_pc_function f) (max_reg_function f))) inj_n = inj_pc)
(trs : regset),
RTL.step tge
(State ts tf sp (pos_add_nat inj_pc (List.length inj_code)) trs m) E0
(State ts tf sp (successor i) trs m).
Proof.
Lemma transf_function_inj_plusstep :
forall ts f tf sp m inj_n src_pc inj_pc inj_code i
(FUN : transf_function gen_injections f = OK tf)
(INJ : nth_error (PTree.elements (gen_injections f (max_pc_function f) (max_reg_function f))) inj_n =
Some (src_pc, inj_code))
(SRC: (fn_code f) ! src_pc = Some i)
(POSITION : inject_l_position (Pos.succ (max_pc_function f))
(PTree.elements (gen_injections f (max_pc_function f) (max_reg_function f))) inj_n = inj_pc)
(trs : regset),
exists trs',
match_regs (f : function) trs trs' /\
Smallstep.plus RTL.step tge
(State ts tf sp inj_pc trs m) E0
(State ts tf sp (successor i) trs' m).
Proof.
Lemma transf_function_preserves:
forall f tf pc
(FUN : transf_function gen_injections f = OK tf)
(LESS : pc <= max_pc_function f)
(NOCHANGE : (gen_injections f (max_pc_function f) (max_reg_function f)) ! pc = None),
(fn_code tf) ! pc = (fn_code f) ! pc.
Proof.
Lemma transf_function_redirects:
forall f tf pc injl ii
(FUN : transf_function gen_injections f = OK tf)
(LESS : pc <= max_pc_function f)
(INJECTION : (gen_injections f (max_pc_function f) (max_reg_function f)) ! pc = Some injl)
(INSTR: (fn_code f) ! pc = Some ii),
exists pc' : node,
(fn_code tf) ! pc = Some (alter_successor ii pc') /\
(forall ts sp m trs,
exists trs',
match_regs f trs trs' /\
Smallstep.plus RTL.step tge
(State ts tf sp pc' trs m) E0
(State ts tf sp (successor ii) trs' m)).
Proof.
Lemma transf_function_preserves_uses:
forall f tf pc rs trs ii
(FUN : transf_function gen_injections f = OK tf)
(MATCH : match_regs f rs trs)
(INSTR : (fn_code f) ! pc = Some ii),
trs ## (instr_uses ii) = rs ## (instr_uses ii).
Proof.
intros.
assert (
forall r,
In r (
instr_uses ii) ->
trs #
r =
rs #
r)
as SAME.
{
intros r INr.
apply MATCH.
apply (
max_reg_function_use f pc ii);
auto.
}
induction (
instr_uses ii);
simpl;
trivial.
f_equal.
-
apply SAME.
constructor;
trivial.
-
apply IHl.
intros.
apply SAME.
right.
assumption.
Qed.
Set Apply With Renaming.
Lemma transf_function_preserves_builtin_args_rec:
forall rs trs ef res sp m pc'
(args : list (builtin_arg reg))
(SAME : (forall r,
In r (instr_uses (Ibuiltin ef args res pc')) ->
trs # r = rs # r) )
(vargs : list val)
(EVAL : eval_builtin_args ge (fun r => rs#r) sp m args vargs),
eval_builtin_args ge (fun r => trs#r) sp m args vargs.
Proof.
unfold eval_builtin_args.
induction args;
intros;
inv EVAL.
-
constructor.
-
constructor.
+
induction H1.
all:
try (
constructor;
auto;
fail).
*
rewrite <-
SAME.
apply eval_BA.
simpl.
left.
reflexivity.
*
constructor.
**
apply IHeval_builtin_arg1.
intros r INr.
apply SAME.
simpl.
simpl in INr.
rewrite in_app in INr.
rewrite in_app.
rewrite in_app.
tauto.
**
apply IHeval_builtin_arg2.
intros r INr.
apply SAME.
simpl.
simpl in INr.
rewrite in_app in INr.
rewrite in_app.
rewrite in_app.
tauto.
*
constructor.
**
apply IHeval_builtin_arg1.
intros r INr.
apply SAME.
simpl.
simpl in INr.
rewrite in_app in INr.
rewrite in_app.
rewrite in_app.
tauto.
**
apply IHeval_builtin_arg2.
intros r INr.
apply SAME.
simpl.
simpl in INr.
rewrite in_app in INr.
rewrite in_app.
rewrite in_app.
tauto.
+
apply IHargs.
2:
assumption.
intros r INr.
apply SAME.
simpl.
apply in_or_app.
right.
exact INr.
Qed.
Lemma transf_function_preserves_builtin_args:
forall f tf pc rs trs ef res sp m pc'
(args : list (builtin_arg reg))
(FUN : transf_function gen_injections f = OK tf)
(MATCH : match_regs f rs trs)
(INSTR : (fn_code f) ! pc = Some (Ibuiltin ef args res pc'))
(vargs : list val)
(EVAL : eval_builtin_args ge (fun r => rs#r) sp m args vargs),
eval_builtin_args ge (fun r => trs#r) sp m args vargs.
Proof.
Lemma match_regs_write:
forall f rs trs res v
(MATCH : match_regs f rs trs),
match_regs f (rs # res <- v) (trs # res <- v).
Proof.
Lemma match_regs_setres:
forall f res rs trs vres
(MATCH : match_regs f rs trs),
match_regs f (regmap_setres res vres rs) (regmap_setres res vres trs).
Proof.
Lemma transf_function_preserves_ros:
forall f tf pc rs trs ros args res fd pc' sig
(FUN : transf_function gen_injections f = OK tf)
(MATCH : match_regs f rs trs)
(INSTR : (fn_code f) ! pc = Some (Icall sig ros args res pc'))
(FIND : find_function ge ros rs = Some fd),
exists tfd, find_function tge ros trs = Some tfd
/\ transf_fundef gen_injections fd = OK tfd.
Proof.
Lemma transf_function_preserves_ros_tail:
forall f tf pc rs trs ros args fd sig
(FUN : transf_function gen_injections f = OK tf)
(MATCH : match_regs f rs trs)
(INSTR : (fn_code f) ! pc = Some (Itailcall sig ros args))
(FIND : find_function ge ros rs = Some fd),
exists tfd, find_function tge ros trs = Some tfd
/\ transf_fundef gen_injections fd = OK tfd.
Proof.
Theorem transf_step_correct:
forall s1 t s2, step ge s1 t s2 ->
forall ts1 (MS: match_states s1 ts1),
exists ts2, Smallstep.plus step tge ts1 t ts2 /\ match_states s2 ts2.
Proof.
Theorem transf_program_correct:
Smallstep.forward_simulation (semantics prog) (semantics tprog).
Proof.
End PRESERVATION.
End INJECTOR.