Require Import Classical.
Require Import Coqlib.
Require Import Maps.
Require Import AST.
Require Import Integers.
Require Import Values.
Require Import Memory.
Require Import Globalenvs.
Require Import Smallstep.
Require Import Op.
Require Import Events.
Require Import Registers.
Require Import Floats.
Require Import Utils.
Require Import Dom.
Require Import SSA.
Require Import SSAutils.
Require Import SSAinv.
Require Import Utilsvalidproof.
Require Import DomCompute.
Require Import Axioms.
Require Import KildallComp.
Require Import OrderedType.
Require Import Ordered.
Require Import FSets.
Require FSetAVL.
Require Import Opt.
Require Import OptInv.
Require Import DLib.
Require Import GVNopt.
Require Import Dsd.
Unset Allow StrictProp.
Instantiating the generic analysis in Opt to the GVN-CSE case
The dominance based analysis
Section DsdAnalysis.
Definition approx :=
reg.
Definition result :=
reg ->
approx.
Variant G :
genv ->
val ->
regset ->
approx ->
val ->
Prop :=
|
G_intro :
forall ge sp rs r v,
forall (
EQ:
v =
rs#
r),
G ge sp rs r v.
Variant is_at_Top :
result ->
reg ->
Prop :=
|
is_at_Top_intro :
forall R r,
R r =
r ->
(
forall r',
R r' =
r ->
r' =
r) ->
is_at_Top R r.
Definition A f := ((
fun x =>
fst (
get_extern_gvn f x)),
P2Map.init true).
Let A_r f :=
fst (
A f).
Lemma list_top_at_Top :
forall (
f:
function)
r,
In r (
dst_at_top (
fn_ext_params f) (
fn_code f)) ->
is_at_Top (
A_r f)
r.
Proof.
Lemma params_Top :
forall (
f:
function)
r,
wf_ssa_function f ->
ext_params f r ->
is_at_Top (
A_r f)
r.
Proof.
Lemma G_top :
forall f r ge sp rs,
is_at_Top (
A_r f)
r ->
G ge sp rs (
A_r f r) (
rs#
r).
Proof.
intros.
invh is_at_Top.
econstructor;
eauto.
rewrite H0 at 1;
auto.
Qed.
Lemma is_at_Top_eq_is_at_Top :
forall f dst x,
is_at_Top (
A_r f)
dst ->
A_r f x =
A_r f dst ->
is_at_Top (
A_r f)
x.
Proof.
induction 1; intros.
rewrite H in H1.
assert (x = r) by (eapply H0; eauto).
rewrite <- H2 in H1.
constructor; auto.
intros. rewrite H2. eapply H0; eauto.
congruence.
Qed.
Definition exec :
function ->
node ->
Prop := (
fun _ _ =>
True).
Lemma exec_fn_entrypoint :
forall f,
exec f (
fn_entrypoint f).
Proof.
go.
Qed.
Definition GVN :=
(
Build_DsdAnalysis approx G is_at_Top A exec exec_fn_entrypoint
is_at_Top_eq_is_at_Top params_Top G_top).
Auxiliary properties about the GVN checker
Inductive same_repr (
repr :
reg ->
reg) :
list reg ->
list reg ->
Prop :=
|
same_repr_nil:
same_repr repr nil nil
|
same_repr_cons:
forall x1 l1 x2 l2,
same_repr repr l1 l2 ->
repr x1 =
repr x2 ->
same_repr repr (
x1::
l1) (
x2::
l2).
Lemma same_repr_nth_error :
forall repr args args',
same_repr repr args args' ->
forall k x x',
nth_error args k =
Some x ->
nth_error args'
k =
Some x' ->
repr x =
repr x'.
Proof.
induction 1; destruct k; simpl; intros; try congruence.
inv H1; inv H2; auto.
eauto.
Qed.
Lemma same_repr_map :
forall R rl rl',
same_repr R rl rl' ->
map R rl =
map R rl'.
Proof.
induction 1 ; go.
Qed.
Definition repr_spec_code (
f:
function) (
pc:
node) (
R:
reg ->
reg) :
Prop :=
match (
fn_code f) !
pc with
|
Some i =>
match i with
|
Iop op args r _ =>
R r =
r
\/
(
exists pc_r pc_r'
args_r,
(
fn_code f) !
pc_r =
Some (
Iop op args_r (
R r)
pc_r')
/\
same_repr R args args_r
/\ (
r <>
R r)
/\
sdom f pc_r pc
/\
op_depends_on_memory op =
false)
|
Iload _ _ _ r _
|
Icall _ _ _ r _
|
Ibuiltin _ _ (
BR r)
_ =>
is_at_Top R r
|
_ =>
True
end
|
None =>
True
end.
Definition repr_spec_phicode (
f:
function) (
pc:
node) (
R:
reg ->
reg) :
Prop :=
match (
fn_phicode f) !
pc with
|
None =>
True
|
Some phib =>
forall r args,
In (
Iphi args r)
phib ->
R r =
r
\/
exists args_r,
In (
Iphi args_r (
R r))
phib /\
same_repr R args args_r
end.
Record GVN_spec (
f:
function) :
Prop := {
GVN_spec_code :
forall pc,
repr_spec_code f pc (
A_r f);
GVN_spec_phicode :
forall pc,
repr_spec_phicode f pc (
A_r f);
GVN_spec_idempotence :
forall r,
A_r f (
A_r f r) =
A_r f r
}.
Lemma repr_spec_code_id :
forall f pc,
repr_spec_code f pc (
fun x :
reg =>
x).
Proof.
Hint Resolve repr_spec_code_id:
core.
Lemma repr_spec_phicode_id :
forall f pc,
repr_spec_phicode f pc (
fun x :
reg =>
x).
Proof.
Hint Resolve repr_spec_phicode_id:
core.
Lemma peq_true_iff :
forall x y,
proj_sumbool (
peq x y) =
true <->
x =
y.
Proof.
Ltac boolInv :=
match goal with
| [
H:
context[
op_eq _ _ =
true] |-
_ ] =>
rewrite op_eq_true_iff in H;
boolInv
| [
H:
context[
proj_sumbool (
peq _ _) =
true] |-
_ ] =>
rewrite peq_true_iff in H;
boolInv
| [
H:
context[
_ ||
_ =
true] |-
_ ] =>
rewrite orb_true_iff in H;
boolInv
| [
H:
context[
_ &&
_ =
true] |-
_ ] =>
rewrite andb_true_iff in H;
boolInv
|
_ =>
idtac
end.
Lemma forall_list2_same_repr :
forall R l args,
forall_list2 (
fun x y :
reg =>
peq (
R x) (
R y))
l args =
true ->
same_repr R l args.
Proof.
induction l; destruct args; simpl; go.
intros; boolInv.
destruct H; go.
Qed.
Lemma repr_idempotent :
forall f,
let R:=
make_repr f (
extern_gvn f) (
dst_at_top (
fn_ext_params f) (
fn_code f))
in
forall r,
fst (
R (
fst (
R r))) =
fst (
R r).
Proof.
Lemma G_unique :
forall ge sp rs r v v',
G ge sp rs r v ->
G ge sp rs r v' ->
v =
v'.
Proof.
intros until v'.
intros HGv HGv'.
repeat invh G.
auto.
Qed.
Lemma G_list_eval_op_helper :
forall rs ge sp al vl vl',
G_list GVN ge sp rs al vl ->
G_list GVN ge sp rs al vl' ->
vl =
vl'.
Proof.
induction al ;
intros.
-
repeat invh G_list;
auto.
-
inv H.
inv H0.
assert (
v0 =
v)
by (
erewrite G_unique ;
eauto);
subst.
exploit (
IHal vl0 vl);
eauto.
intros Heq;
subst.
auto.
Qed.
Lemma G_list_eval_op :
forall rs ge sp op m al vl vl',
G_list GVN ge sp rs al vl ->
G_list GVN ge sp rs al vl' ->
eval_operation ge sp op vl m =
eval_operation ge sp op vl'
m.
Proof.
The checker satisfies its specification
Lemma GVN_spec_True :
forall f
(
WFF:
wf_ssa_function f),
GVN_spec f.
Proof.
intros f;
constructor.
-
generalize (
list_top_at_Top f).
unfold A_r.
unfold A_r,
A,
get_extern_gvn,
get_repr,
check_GVN;
simpl.
flatten;
simpl;
auto.
flatten Eq.
edestruct andb_prop as (
T1 &
T2);
eauto;
clear Eq0.
edestruct andb_prop as (
T3 &
T4);
eauto;
clear T1.
unfold repr_spec_code;
flatten;
auto.
exploit ptree_forall;
eauto;
clear T4.
simpl.
set (
R:=
make_repr f (
extern_gvn f) (
dst_at_top (
fn_ext_params f) (
fn_code f))).
flatten.
+
flatten Eq3.
boolInv.
destruct (
peq (
fst (
R r))
r);
auto.
destruct H3; [
elim n1;
auto|
right].
repeat invh and;
subst.
do 3
econstructor;
split; [
eauto|
idtac].
repeat split;
auto.
*
eapply forall_list2_same_repr;
eauto.
*
eapply fn_dom_test_correct;
eauto.
*
unfold fn_code in *;
congruence.
*
destruct (
op_depends_on_memory op);
simpl in *;
congruence.
+
flatten Eq3.
+
intros H;
boolInv;
destruct H;
auto;
go.
+
intros H;
boolInv;
destruct H;
auto;
go.
+
intros H;
boolInv;
destruct H;
auto;
go.
+
apply H0;
auto.
generalize (
dst_at_top_prop1 (
fn_code f) (
fn_ext_params f)
pc).
flatten.
+
apply H0;
auto.
generalize (
dst_at_top_prop1 (
fn_code f) (
fn_ext_params f)
pc).
flatten.
+
apply H0;
auto.
generalize (
dst_at_top_prop1 (
fn_code f) (
fn_ext_params f)
pc).
flatten.
-
unfold A_r,
A,
get_extern_gvn,
get_repr,
check_GVN;
simpl.
flatten;
simpl;
auto.
flatten Eq.
edestruct andb_prop as (
T1 &
T2);
eauto;
clear Eq0.
edestruct andb_prop as (
T3 &
T4);
eauto;
clear T1.
unfold repr_spec_phicode;
flatten;
auto.
clear T3 T4.
exploit ptree_forall;
eauto;
clear T2.
match goal with
| |- ?
x =>
match x with
|
context [ (
make_repr ?
f ?
p1 ?
p2 )] =>
set (
R:=
make_repr f p1 p2)
end
end.
unfold check_GVN_phiblock.
rewrite forallb_forall.
intros.
exploit H;
eauto;
clear H;
simpl;
intros.
boolInv.
destruct H;
auto.
right.
flatten H.
*
boolInv.
repeat invh and.
assert (
p0=
p)
by congruence;
subst.
econstructor;
split.
--
eapply nth_error_in;
eauto.
--
eapply forall_list2_same_repr;
eauto.
*
destruct peq;
inv H.
*
destruct peq;
inv H.
-
intros r.
unfold A_r,
A,
get_extern_gvn,
get_repr,
check_GVN;
simpl.
flatten;
auto.
flatten Eq;
auto.
rewrite repr_idempotent;
auto.
Qed.
End DsdAnalysis.
Proof that GVN preserves the wf_ssa_function predicate
This is only provable here, where we have the specification
GVN_spec of the checker
Section WFSSA.
Lemma check_def_correct:
forall f pc x,
check_def (
fn_code f)
pc x =
true ->
def f x pc.
Proof.
intros;
constructor 2.
unfold check_def in H.
case_eq ((
fn_code f)!
pc);
intros;
rewrite H0 in *;
try congruence.
destruct i;
try destruct b ;
try congruence;
try destruct peq;
go.
Qed.
Lemma new_code_same_or_Iop :
forall (
f:
function) (
WF:
wf_ssa_function f)
pc ins,
(
fn_code f) !
pc =
Some ins ->
transf_instr (
fst (
analysis f))
pc ins =
ins
\/
match ins with
|
Iop _ _ dst pc'
|
Iload _ _ _ dst pc'
|
Icall _ _ _ dst pc'
|
Ibuiltin _ _ (
BR dst)
pc' =>
exists op'
args',
transf_instr (
fst (
analysis f))
pc ins =
Iop op'
args'
dst pc'
/\
forall x,
In x args' ->
exists d :
node,
def f x d /\
sdom f d pc
|
_ =>
False
end.
Proof.
destruct ins;
simpl;
flatten;
eauto.
right.
edestruct andb_prop;
eauto;
clear Eq1.
edestruct andb_prop;
eauto;
clear H0.
econstructor;
econstructor;
split;
eauto.
simpl.
destruct 1
as [
HH|
HH]; [
subst|
elim HH].
exists n0;
split.
-
eapply check_def_correct;
eauto.
-
split.
+
generalize (
GVN_spec_code f (
GVN_spec_True f WF)) ;
eauto.
intros Hc.
specialize Hc with pc.
unfold repr_spec_code in Hc;
flatten Hc.
destruct Hc.
*
unfold A in *.
simpl in H.
assert (
x=
r)
by (
rewrite Eq0 in H;
simpl in H;
congruence).
subst x.
destruct (
peq r r);
go.
*
destruct H as (
pc0 &
pc' &
args' &
T1 &
T2 &
T3 &
T4 &
T5).
assert (
fst (
A f)
r =
x).
unfold A;
simpl;
rewrite Eq0;
auto.
rewrite H in *.
apply check_def_correct in H3.
assert (
def f x pc0)
by go.
assert (
n0=
pc0)
by (
eapply ssa_def_unique;
eauto).
subst.
destruct T4;
auto.
+
intro;
subst.
destruct peq in H1;
simpl in *;
congruence.
Qed.
End WFSSA.
Local correctness obligation proofs about the analysis
Notation A_r f := (
fst (
A f)).
Notation A_e f := (
snd (
A f)).
Lemma same_fn_code3 :
forall (
f:
function) (
WF:
wf_ssa_function f)
res,
(
ext_params f res) ->
forall x dx,
def f x dx ->
A_r f x =
res ->
x =
res.
Proof.
intros.
generalize (
GVN_spec_code f (
GVN_spec_True f WF)) ;
eauto.
intros Hcode.
generalize (
GVN_spec_phicode f (
GVN_spec_True f WF)) ;
eauto.
intros Hphicode.
specialize Hcode with dx.
specialize Hphicode with dx.
subst.
invh def.
-
exploit params_Top;
eauto.
intros.
invh is_at_Top.
congruence.
-
unfold repr_spec_code in *.
unfold fn_code in *.
invh assigned_code_spec;
try match goal with
|
id : (
SSA.fn_code f) !
_ =
Some _ |-
_ =>
rewrite id in *;
go
end;
try solve [
invh is_at_Top;
congruence];
rewrite H0 in Hcode;
repeat invh or ;
repeat invh ex ;
repeat invh and.
+
congruence.
+
inv H.
eelim fn_ssa_params;
eauto.
*
intros.
eelim H;
go.
*
eelim H8;
go.
+
destruct Hcode;
auto.
+
destruct Hcode;
auto.
+
destruct Hcode;
auto.
-
unfold repr_spec_phicode in *.
invh assigned_phi_spec;
try match goal with
|
id : (
fn_phicode f) !
_ =
Some _ |-
_ =>
rewrite id in *;
go
end.
specialize (
Hphicode x).
repeat invh or ;
repeat invh ex ;
repeat invh and.
+
inv H.
*
eelim fn_ssa_params;
eauto.
intros.
eelim (
Hphicode x0);
eauto.
intros [
args' [
Hin Hsame]].
eelim H3;
eauto.
*
eelim (
Hphicode x0);
eauto.
intros [
args' [
Hin Hsame]].
eelim H3;
eauto.
Qed.
Lemma gamma_step_phi:
forall (
f:
function) (
WFF:
wf_ssa_function f)
ge sp pc pc'
phib k rs,
reached f pc ->
exec f pc ->
(
fn_code f) !
pc =
Some (
Inop pc') ->
(
fn_phicode f) !
pc' =
Some phib ->
index_pred (
Kildall.make_predecessors (
fn_code f)
successors_instr)
pc pc' =
Some k ->
gamma GVN f ge sp pc rs ->
gamma GVN f ge sp pc' (
phi_store k phib rs).
Proof.
Lemma same_fn_code1 :
forall f (
WFF:
wf_ssa_function f)
pc res,
(
forall op args res pc', (
fn_code f) !
pc <>
Some (
Iop op args res pc')) ->
assigned_code_spec (
fn_code f)
pc res ->
is_at_Top (
A_r f)
res.
Proof.
Lemma def_not_top_dsd :
forall f (
WFF:
wf_ssa_function f)
x dx,
assigned_code_spec (
fn_code f)
dx x ->
x <>
A_r f x ->
dsd f (
A_r f x)
dx.
Proof.
Lemma Iop_correct :
forall f (
WF:
wf_ssa_function f)
pc sf op args res pc'
v rs ge sp m x,
forall (
SINV:
s_inv ge (
State sf f sp pc rs m)),
(
fn_code f) !
pc =
Some (
Iop op args res pc') ->
eval_operation ge sp op rs ##
args m =
Some v ->
gamma GVN f ge sp pc rs ->
exec f pc ->
dsd f x pc' ->
G ge sp rs #
res <-
v (
A_r f x) (
rs #
res <-
v) !!
x.
Proof.
Lemma G_upd_diff_help :
forall f ge sp rs dst x v,
x <>
dst ->
(
G ge sp rs (
A_r f x)
rs !!
x) ->
G ge sp rs #
dst <-
v (
A_r f x)
rs !!
x \/
~
is_at_Top (
A_r f)
x.
Proof.
intros.
destruct (
peq (
A_r f x)
dst).
-
subst.
right.
intro Hcont.
inv Hcont.
congruence.
-
left.
econstructor;
eauto.
rewrite PMap.gso;
auto.
invh G;
auto.
Qed.
Lemma G_upd_diff :
forall f (
WF:
wf_ssa_function f)
ge sp rs dst x v,
x <>
dst ->
A_r f x <>
A_r f dst ->
(
G ge sp rs (
A_r f x)
rs !!
x) ->
G ge sp rs #
dst <-
v (
A_r f x)
rs !!
x.
Proof.