Module CSSAval
Require Import Coqlib.
Require Import Errors.
Require Import Maps.
Require Import AST.
Require Import Globalenvs.
Require Import Smallstep.
Require Import Dom.
Require Import Op.
Require Import SSA.
Require Import SSAutils.
Require Import Utils.
Require Import CSSA.
Require Import DLib.
Require Import RTLpargen.
Require Import CSSAutils.
Require Import Classical.
Require Import Kildall.
Require Import KildallComp.
Require Import CSSAdef.
Require Import Registers.
Unset Allow StrictProp.
Definition cssaval_ins_spec (
get_cssaval :
reg ->
reg) (
ins :
instruction) :=
match ins with
|
Iop Omove (
src ::
nil)
dst _ =>
get_cssaval src =
get_cssaval dst
|
Iop _ _ dst _ =>
get_cssaval dst =
dst
|
Iload _ _ _ dst _ =>
get_cssaval dst =
dst
|
Icall _ _ _ dst _ =>
get_cssaval dst =
dst
|
Ibuiltin _ _ (
BR dst)
_ =>
get_cssaval dst =
dst
|
_ =>
True
end.
Variant cssaval_spec (
f :
function) (
get_cssaval :
reg ->
reg) :
Prop :=
|
check_cssaval_spec_intro :
(
forall pc parcb src dst,
(
fn_parcopycode f) !
pc =
Some parcb ->
In (
Iparcopy src dst)
parcb ->
get_cssaval dst =
get_cssaval src) ->
(
forall pc phib args dst,
(
fn_phicode f) !
pc =
Some phib ->
In (
Iphi args dst)
phib ->
get_cssaval dst =
dst) ->
(
forall pc ins,
(
fn_code f) !
pc =
Some ins ->
cssaval_ins_spec get_cssaval ins) ->
(
forall param,
ext_params f param ->
get_cssaval param =
param) ->
cssaval_spec f get_cssaval.
Lemma cssaval_transfer_in_parcopy :
forall src dst f parcb pc get_cssaval,
In (
Iparcopy src dst)
parcb ->
(
fn_parcopycode f) !
pc =
Some parcb ->
cssaval_spec f get_cssaval ->
get_cssaval dst =
get_cssaval src.
Proof.
intros. inv H1; go.
Qed.
Definition check_cssaval_ins_r
(
elems :
list (
node *
instruction))
(
get_cssaval :
reg ->
reg) :
bool :=
fold_right
(
fun pcins acc =>
if negb acc then false
else match snd pcins with
|
Iop Omove (
src ::
nil)
dst _ =>
peq (
get_cssaval src) (
get_cssaval dst)
|
Iop _ _ dst _ =>
peq (
get_cssaval dst)
dst
|
Iload _ _ _ dst _ =>
peq (
get_cssaval dst)
dst
|
Icall _ _ _ dst _ =>
peq (
get_cssaval dst)
dst
|
Ibuiltin _ _ (
BR dst)
_ =>
peq (
get_cssaval dst)
dst
|
_ =>
true
end)
true elems.
Definition check_cssaval_parcb_r
(
parcbs :
list (
node *
parcopyblock))
(
get_cssaval :
reg ->
reg) :
bool :=
fold_right
(
fun pcparcb acc =>
if negb acc then false
else forallb
(
fun parc =>
match parc with
|
Iparcopy src dst =>
peq (
get_cssaval src) (
get_cssaval dst)
end)
(
snd pcparcb))
true parcbs.
Definition check_cssaval_phib_r
(
phibs :
list (
node *
phiblock))
(
get_cssaval :
reg ->
reg) :
bool :=
fold_right
(
fun pcphib acc =>
if negb acc then false
else forallb
(
fun phi =>
match phi with
|
Iphi args dst =>
peq (
get_cssaval dst)
dst
end)
(
snd pcphib))
true phibs.
Lemma check_cssaval_ins_cons :
forall elems elt get_cssaval,
check_cssaval_ins_r (
elt ::
elems)
get_cssaval =
true ->
check_cssaval_ins_r elems get_cssaval =
true.
Proof.
Lemma check_cssaval_parcb_cons :
forall pcparcbs elt get_cssaval,
check_cssaval_parcb_r (
elt ::
pcparcbs)
get_cssaval =
true ->
check_cssaval_parcb_r pcparcbs get_cssaval =
true.
Proof.
Lemma check_cssaval_phib_cons :
forall pcphibs elt get_cssaval,
check_cssaval_phib_r (
elt ::
pcphibs)
get_cssaval =
true ->
check_cssaval_phib_r pcphibs get_cssaval =
true.
Proof.
Lemma check_cssaval_ins_correct_r :
forall elems get_cssaval,
check_cssaval_ins_r elems get_cssaval =
true ->
forall pc ins,
In (
pc,
ins)
elems ->
cssaval_ins_spec get_cssaval ins.
Proof.
Lemma check_cssaval_parcb_correct_r :
forall pcparcbs get_cssaval,
check_cssaval_parcb_r pcparcbs get_cssaval =
true ->
forall pc parcb src dst,
In (
pc,
parcb)
pcparcbs ->
In (
Iparcopy src dst)
parcb ->
get_cssaval src =
get_cssaval dst.
Proof.
Lemma check_cssaval_phib_correct_r :
forall pcphibs get_cssaval,
check_cssaval_phib_r pcphibs get_cssaval =
true ->
forall pc phib args dst,
In (
pc,
phib)
pcphibs ->
In (
Iphi args dst)
phib ->
get_cssaval dst =
dst.
Proof.
Lemma check_cssaval_ins_correct :
forall elems get_cssaval,
check_cssaval_ins elems get_cssaval =
true ->
check_cssaval_ins_r (
rev elems)
get_cssaval =
true.
Proof.
Lemma check_cssaval_parcb_correct :
forall pcparcbs get_cssaval,
check_cssaval_parcb pcparcbs get_cssaval =
true ->
check_cssaval_parcb_r (
rev pcparcbs)
get_cssaval =
true.
Proof.
Lemma check_cssaval_phib_correct :
forall pcphibs get_cssaval,
check_cssaval_phib pcphibs get_cssaval =
true ->
check_cssaval_phib_r (
rev pcphibs)
get_cssaval =
true.
Proof.
Lemma check_cssaval_correct :
forall f get_cssaval all_defs ext_params,
wf_cssa_function f ->
get_all_def f =
all_defs ->
get_ext_params f all_defs =
ext_params ->
check_cssaval f get_cssaval ext_params =
true ->
cssaval_spec f get_cssaval.
Proof.
Definition reachable (
prog:
program) (
s:
state) :=
exists s0,
exists t,
initial_state prog s0
/\
star step (
Genv.globalenv prog)
s0 t s.
Section PATH.
Variable f :
function.
Variable R :
reg ->
reg.
Hypothesis WF:
wf_cssa_function f.
Hypothesis SPEC:
cssaval_spec f R.
Inductive path (
f :
function) :
list node -> (@
pstate positive) ->
Prop :=
path0 :
path f nil (
PState (
fn_entrypoint f))
|
path1 :
forall (
p :
list node) (
pc :
positive)
(
i :
instruction) (
pc' :
node),
path f p (
PState pc) ->
(
fn_code f) !
pc =
Some i ->
reached f pc ->
In pc' (
successors_instr i) ->
path f (
pc ::
p) (
PState pc')
|
path2 :
forall (
p :
list node) (
pc :
positive) (
i :
instruction),
path f p (
PState pc) ->
(
fn_code f) !
pc =
Some i ->
reached f pc ->
successors_instr i =
nil ->
path f (
pc ::
p)
PStop
.
Lemma rev_cons_app_end:
forall A (
p:
list A)
a,
(
rev (
a::
p) = (
rev p) ++
a::
nil).
Proof.
induction p; go.
Qed.
Lemma path_dom_path :
forall p n,
path f p n ->
Dom.path (
cfg f) (
exit f) (
entry f) (
PState (
fn_entrypoint f)) (
rev p)
n.
Proof.
induction 1 ;
eauto.
-
simpl;
go.
-
assert (
rev (
pc::
p) = (
rev p) ++
pc::
nil)
by (
eapply rev_cons_app_end;
eauto).
rewrite H3 at 1.
eapply path_app;
eauto.
econstructor;
eauto.
constructor;
eauto;
go.
go.
-
assert (
rev (
pc::
p) = (
rev p) ++
pc::
nil)
by (
eapply rev_cons_app_end;
eauto).
rewrite H3 at 1.
eapply path_app;
eauto.
econstructor 2;
eauto; [
idtac|
go].
unfold exit;
destruct i;
simpl in *;
go.
Qed.
Lemma dom_path_path_aux :
forall n1 p n2,
Dom.path (
cfg f) (
exit f) (
entry f)
n1 p n2 ->
forall p',
path f p'
n1 ->
path f (
rev_append p p')
n2.
Proof.
simpl.
induction 1;
simpl;
intros;
auto.
destruct t.
-
simpl.
inv H.
inv STEP.
inv STEP0.
econstructor;
eauto.
destruct ((
fn_code f) !
pc)
eqn:
Heq;
unfold exit in *;
rewrite Heq in *;
go.
econstructor;
eauto.
flatten NOSTEP;
go.
-
apply IHpath.
destruct s2.
inv STEP.
inv STEP0.
econstructor;
eauto.
inv STEP.
destruct ((
fn_code f) !
pc)
eqn:
Heq;
unfold exit in *;
rewrite Heq in *;
go.
econstructor;
eauto.
flatten NOSTEP;
go.
Qed.
Lemma dom_path_path :
forall p n,
Dom.path (
cfg f) (
exit f) (
entry f) (
PState (
entry f))
p n ->
path f (
rev p)
n.
Proof.
Lemma cssaval_path :
forall p s,
path f p s ->
match s with
|
PStop =>
True
|
PState pc =>
forall r d d',
def f r d ->
def f (
R r)
d' ->
(
In d p ->
In d'
p)
\/ (
d =
pc /\
In d'
p)
end.
Proof.
End PATH.
Lemma cssaval_dom :
forall f r pc pc'
R,
wf_cssa_function f ->
cssaval_spec f R ->
def f (
R r)
pc ->
def f r pc' ->
dom f pc pc'.
Proof.
Global Hint Resolve ident_eq:
core.
Lemma cssaval_spec_jp_until_phi :
forall f pc parcb pc'
pc''
phib parcb'
rs get_cssaval k,
wf_cssa_function f ->
cssaval_spec f get_cssaval ->
(
reached f pc) ->
(
fn_parcopycode f) !
pc =
Some parcb ->
(
fn_code f) !
pc =
Some (
Inop pc') ->
(
fn_code f) !
pc' =
Some (
Inop pc'') ->
(
fn_phicode f) !
pc' =
Some phib ->
(
fn_parcopycode f) !
pc' =
Some parcb' ->
(
join_point pc'
f) ->
(
forall r, ~
assigned_phi_spec (
fn_phicode f)
pc r) ->
(~
join_point pc f) ->
index_pred (
get_preds f)
pc pc' =
Some k ->
(
forall r,
cssadom f r pc ->
rs #
r =
rs # (
get_cssaval r)) ->
forall r',
cssadom f r'
pc' ->
(
cssadom f r'
pc
/\ ~
assigned_phi_spec (
fn_phicode f)
pc'
r'
/\ ~
assigned_parcopy_spec (
fn_parcopycode f)
pc r'
/\ ~
assigned_parcopy_spec (
fn_parcopycode f)
pc'
r')
\/ (
assigned_parcopy_spec (
fn_parcopycode f)
pc r')
\/ (
assigned_phi_spec (
fn_phicode f)
pc'
r')
->
(
phi_store k phib (
parcopy_store parcb rs)) #
r' =
(
phi_store k phib (
parcopy_store parcb rs)) # (
get_cssaval r').
Proof.
intros until k.
intros WF REACH Hcssavalspec Hparcb Hinop Hinop'
Hphib
Hparcb'
Hjp Hjp'
Hjp''
Hpred Hcssaval r'
Hdom Hcases.
repeat invh or;
repeat invh and.
-
inv Hdom ;
try congruence.
rewrite <-
phi_store_other.
rewrite parcb_other.
* {
rewrite <-
phi_store_other.
rewrite parcb_other;
auto.
+
intros ;
intro;
subst.
assert (
def f (
get_cssaval r')
pc)
by go.
invh cssadom;
try congruence ;
normalized.
exploit cssaval_dom;
eauto.
intros.
contradict H0.
eapply sdom_not_dom;
eauto.
+
intros;
intro;
subst.
assert (
def f (
get_cssaval r')
pc')
by go.
exploit cssaval_dom;
eauto.
intros.
assert(
Hdd:
Dom.sdom (
cfg f) (
exit f) (
entry f)
def_r def_r).
eapply sdom_dom_trans ;
eauto.
inv Hdd;
go.
}
*
intros;
intro;
subst;
go.
eelim H1;
go.
*
intros;
intro;
subst;
go.
-
rewrite <-
phi_store_other.
+
invh assigned_parcopy_spec;
invh ex;
allinv.
erewrite parcb_store_in;
eauto;
ssa.
rewrite <-
phi_store_other.
* {
erewrite parcb_other;
eauto.
-
assert (
get_cssaval r' =
get_cssaval x)
by (
invh cssaval_spec;
go).
rewrite H.
eapply Hcssaval;
eauto.
exploit (
exists_def f x pc);
eauto;
go.
intros [
d Hd].
econstructor;
eauto.
constructor.
+
exploit (
fn_strict f WF x pc);
go.
+
intro ;
subst.
invh cssadom;
try congruence;
normalized;
ssa.
*
assert (
def_r =
pc)
by (
eapply def_def_eq;
eauto;
go);
subst.
inv Hd;
try congruence;
normalized.
eelim fn_strict_use_parcb with (
x:=
x);
eauto;
go.
*
assert (
pc' =
pc)
by (
eapply def_def_eq;
eauto;
go);
subst.
congruence.
*
assert (
pc' =
pc)
by (
eapply def_def_eq;
eauto;
go);
subst.
congruence.
-
exploit (
exists_def f x pc);
eauto;
go.
intros [
Dx HDx].
exploit (
fn_strict f WF x pc);
eauto;
go.
intros Hdom'.
intros;
intro;
subst.
eapply dom_eq_sdom in Hdom'.
destruct Hdom'
as [
HdomEQ |
Hsdom].
+
invh cssadom;
try congruence;
normalized;
ssa.
*
assert (
def_r =
pc)
by (
eapply def_def_eq;
eauto;
go);
subst.
inv HDx;
try congruence;
normalized;
ssa.
eelim fn_strict_use_parcb with (
x:=
x);
eauto;
go.
*
assert (
pc' =
pc)
by (
eapply def_def_eq;
eauto;
go);
subst.
congruence.
*
assert (
pc' =
pc)
by (
eapply def_def_eq;
eauto;
go);
subst.
congruence.
+
assert (
get_cssaval r' =
get_cssaval x)
by (
invh cssaval_spec;
go).
rewrite H1 in *.
exploit (
cssaval_dom f x pc Dx);
go.
intros.
eelim sdom_not_dom;
eauto.
+
auto.
}
*
intros;
intro;
subst.
exploit (
cssaval_dom f r'
pc'
pc) ;
eauto;
go.
intros Hdom'.
{
invh cssadom;
try congruence;
normalized.
-
assert (
def_r =
pc)
by (
eapply def_def_eq;
eauto;
go);
subst.
eelim sdom_not_dom;
eauto.
-
exploit (
wf_cssa_def_phi_parcopy f WF r'
pc'
pc);
eauto;
go.
-
assert (
pc =
pc')
by (
eapply def_def_eq;
eauto;
go);
subst.
normalized;
eauto.
}
+
intros;
intro;
subst;
ssa.
-
invh assigned_phi_spec;
invh ex;
allinv.
assert (
get_cssaval r' =
r')
by (
invh cssaval_spec;
go).
congruence.
Unshelve.
auto.
Qed.
Lemma cssaval_spec_jp :
forall f pc parcb pc'
pc''
phib parcb'
rs get_cssaval k,
wf_cssa_function f ->
cssaval_spec f get_cssaval ->
(
reached f pc) ->
(
fn_parcopycode f) !
pc =
Some parcb ->
(
fn_code f) !
pc =
Some (
Inop pc') ->
(
fn_code f) !
pc' =
Some (
Inop pc'') ->
(
fn_phicode f) !
pc' =
Some phib ->
(
fn_parcopycode f) !
pc' =
Some parcb' ->
(
join_point pc'
f) ->
(
forall r, ~
assigned_phi_spec (
fn_phicode f)
pc r) ->
(~
join_point pc f) ->
index_pred (
get_preds f)
pc pc' =
Some k ->
(
forall r,
cssadom f r pc ->
rs #
r =
rs # (
get_cssaval r)) ->
forall r',
cssadom f r'
pc' ->
(
cssadom f r'
pc /\ ~
assigned_phi_spec (
fn_phicode f)
pc'
r')
\/ (
def f r'
pc /\ ~
assigned_phi_spec (
fn_phicode f)
pc r' /\ ~
ext_params f r')
\/ (
assigned_phi_spec (
fn_phicode f)
pc'
r' /\ ~
ext_params f r')
\/
assigned_parcopy_spec (
fn_parcopycode f)
pc'
r' /\ ~
ext_params f r' ->
(
parcopy_store parcb' (
phi_store k phib (
parcopy_store parcb rs))) !!
r' =
(
parcopy_store parcb' (
phi_store k phib (
parcopy_store parcb rs))) !! (
get_cssaval r').
Proof.
Definition cssaval (
f:
function) :
reg ->
reg :=
let cssaval :=
compute_cssaval_function f in
if (
check_cssaval f cssaval (
get_ext_params f (
get_all_def f)))
then cssaval
else (
fun r =>
r).
Lemma cssaval_correct :
forall f,
wf_cssa_function f ->
cssaval_spec f (
cssaval f) \/ (
cssaval f =
fun r =>
r).
Proof.
Variant sf_inv (
ge:
genv) :
stackframe ->
Prop :=
|
sf_inv_intro:
forall res f sp pc rs pred sig ros args
(
WFF:
wf_cssa_function f)
(
REACHED:
reached f pc)
(
SFINV:
forall r,
cssadom f r pc ->
r <>
res ->
rs #
r =
rs # (
cssaval f r))
(
SINS: (
fn_code f) !
pred =
Some (
Icall sig ros args res pc)),
sf_inv ge (
Stackframe res f sp pc rs).
Global Hint Constructors sf_inv:
core.
Inductive sfl_inv (
ge:
genv) :
list stackframe ->
Prop :=
|
sfl_nil :
sfl_inv ge nil
|
sfl_cons :
forall s sl,
sf_inv ge s ->
sfl_inv ge sl ->
sfl_inv ge (
s::
sl).
Variant s_inv (
ge:
genv) :
state ->
Prop :=
|
si_State :
forall s f sp pc rs m
(
WFF:
wf_cssa_function f)
(
REACHED:
reached f pc)
(
SINV:
forall r,
cssadom f r pc ->
rs #
r =
rs # (
cssaval f r))
(
SFINV:
sfl_inv ge s),
s_inv ge (
State s f sp pc rs m)
|
si_Callstate :
forall s f args m
(
WFF:
wf_cssa_fundef f)
(
SFINV:
sfl_inv ge s),
s_inv ge (
Callstate s f args m)
|
si_Returnstate:
forall s v m
(
SFINV:
sfl_inv ge s),
s_inv ge (
Returnstate s v m).
Global Hint Constructors s_inv:
core.
Section INV.
Variable prog :
program.
Hypothesis HWF:
wf_cssa_program prog.
Let ge_prog :=
Genv.globalenv prog.
Lemma wf_cssa_prog_find_function:
forall ros rs fd,
find_function ge_prog ros rs =
Some fd ->
wf_cssa_fundef fd.
Proof.
Lemma s_inv_initial :
forall s,
initial_state prog s ->
s_inv ge_prog s.
Proof.
Lemma subj_red :
forall s s'
t,
s_inv ge_prog s ->
step ge_prog s t s' ->
s_inv ge_prog s'.
Proof.
Lemma ssa_inv1_aux :
forall s s'
t,
s_inv ge_prog s ->
star step ge_prog s t s' ->
s_inv ge_prog s'.
Proof.
induction 2 ;
intros.
auto.
eapply IHstar ;
eauto.
eapply subj_red ;
eauto.
Qed.
Theorem ssa_inv1 :
forall s s'
t,
initial_state prog s ->
star step ge_prog s t s' ->
s_inv ge_prog s'.
Proof.
Lemma cssaval_spec_correct :
forall f r pc s sp rs m,
reachable prog (
State s f sp pc rs m) ->
cssadom f r pc ->
rs #
r =
rs # (
cssaval f r).
Proof.
intros.
destruct H as [
s0 [
t [
IS Hstar]]].
eapply ssa_inv1 in Hstar;
eauto.
invh s_inv;
go.
Qed.
Lemma cssaval_spec_correct_2 :
forall f r1 r2 pc s sp rs m,
cssadom f r1 pc ->
cssadom f r2 pc ->
cssaval f r1 =
cssaval f r2 ->
reachable prog (
State s f sp pc rs m) ->
rs #
r1 =
rs #
r2.
Proof.
End INV.