CompilerCorrectness: a new simulation condition to get trace equivalence for free

This commit is contained in:
Adam Chlipala 2017-03-18 14:50:55 -04:00
parent 2832696faa
commit 7c705bb2fb

View file

@ -174,6 +174,74 @@ Fixpoint cfoldExprs (c : cmd) : cmd :=
| Output e => Output (cfoldArith e) | Output e => Output (cfoldArith e)
end. end.
Theorem skip_or_step : forall v c,
c = Skip
\/ exists v' l c', cstep (v, c) l (v', c').
Proof.
induct c; simplify; first_order; subst;
try match goal with
| [ H : cstep _ _ _ |- _ ] => invert H
end;
try match goal with
| [ |- context[cstep (?v, If ?e _ _)] ] => cases (interp e v ==n 0)
| [ |- context[cstep (?v, While ?e _)] ] => cases (interp e v ==n 0)
end; eauto 10.
Qed.
Lemma deterministic0 : forall vc l vc',
step0 vc l vc'
-> forall l' vc'', step0 vc l' vc''
-> l = l' /\ vc'' = vc'.
Proof.
invert 1; invert 1; simplify; propositional.
Qed.
Theorem plug_function : forall C c1 c2, plug C c1 c2
-> forall c2', plug C c1 c2'
-> c2 = c2'.
Proof.
induct 1; invert 1; eauto.
apply IHplug in H5.
equality.
Qed.
Lemma peel_cseq : forall C1 C2 c (c1 c2 : cmd),
C1 = C2 /\ c1 = c2
-> CSeq C1 c = CSeq C2 c /\ c1 = c2.
Proof.
equality.
Qed.
Hint Resolve peel_cseq.
Lemma plug_deterministic : forall v C c1 c2, plug C c1 c2
-> forall l vc1, step0 (v, c1) l vc1
-> forall C' c1', plug C' c1' c2
-> forall l' vc1', step0 (v, c1') l' vc1'
-> C' = C /\ c1' = c1.
Proof.
induct 1; invert 1; invert 1; invert 1; auto;
try match goal with
| [ H : plug _ _ _ |- _ ] => invert1 H
end; eauto.
Qed.
Theorem deterministic : forall vc l vc',
cstep vc l vc'
-> forall l' vc'', cstep vc l' vc''
-> l = l' /\ vc' = vc''.
Proof.
invert 1; invert 1; simplify.
eapply plug_deterministic in H0; eauto.
invert H0.
eapply deterministic0 in H1; eauto.
propositional; subst; auto.
invert H0.
auto.
eapply plug_function in H2; eauto.
equality.
Qed.
Section simulation. Section simulation.
Variable R : valuation * cmd -> valuation * cmd -> Prop. Variable R : valuation * cmd -> valuation * cmd -> Prop.
@ -181,7 +249,10 @@ Section simulation.
-> forall vc1' l, cstep vc1 l vc1' -> forall vc1' l, cstep vc1 l vc1'
-> exists vc2', cstep vc2 l vc2' /\ R vc1' vc2'. -> exists vc2', cstep vc2 l vc2' /\ R vc1' vc2'.
Lemma simulation' : forall vc1 ns, generate vc1 ns Hypothesis agree_on_termination : forall v1 v2 c2, R (v1, Skip) (v2, c2)
-> c2 = Skip.
Lemma simulation_fwd' : forall vc1 ns, generate vc1 ns
-> forall vc2, R vc1 vc2 -> forall vc2, R vc1 vc2
-> generate vc2 ns. -> generate vc2 ns.
Proof. Proof.
@ -196,14 +267,59 @@ Section simulation.
eauto. eauto.
Qed. Qed.
Theorem simulation : forall vc1 vc2, R vc1 vc2 Theorem simulation_fwd : forall vc1 vc2, R vc1 vc2
-> vc1 <| vc2. -> vc1 <| vc2.
Proof. Proof.
unfold traceInclusion; eauto using simulation'. unfold traceInclusion; eauto using simulation_fwd'.
Qed.
Lemma simulation_bwd' : forall vc2 ns, generate vc2 ns
-> forall vc1, R vc1 vc2
-> generate vc1 ns.
Proof.
induct 1; simplify; eauto.
cases vc1; cases vc.
assert (c = Skip \/ exists v' l c', cstep (v, c) l (v', c')) by apply skip_or_step.
first_order; subst.
apply agree_on_termination in H1; subst.
invert H.
invert H3.
invert H4.
specialize (one_step H1 H2).
first_order.
eapply deterministic in H; eauto.
propositional; subst.
eauto.
cases vc1; cases vc.
assert (c = Skip \/ exists v' l c', cstep (v, c) l (v', c')) by apply skip_or_step.
first_order; subst.
apply agree_on_termination in H1; subst.
invert H.
invert H3.
invert H4.
specialize (one_step H1 H2).
first_order.
eapply deterministic in H; eauto.
propositional; subst.
eauto.
Qed.
Theorem simulation_bwd : forall vc1 vc2, R vc1 vc2
-> vc2 <| vc1.
Proof.
unfold traceInclusion; eauto using simulation_bwd'.
Qed.
Theorem simulation : forall vc1 vc2, R vc1 vc2
-> vc1 =| vc2.
Proof.
simplify; split; auto using simulation_fwd, simulation_bwd.
Qed. Qed.
End simulation. End simulation.
Lemma cfoldExprs_ok1' : forall v1 c1 l v2 c2, Lemma cfoldExprs_ok' : forall v1 c1 l v2 c2,
step0 (v1, c1) l (v2, c2) step0 (v1, c1) l (v2, c2)
-> step0 (v1, cfoldExprs c1) l (v2, cfoldExprs c2). -> step0 (v1, cfoldExprs c1) l (v2, cfoldExprs c2).
Proof. Proof.
@ -214,7 +330,7 @@ Proof.
end; eauto. end; eauto.
Qed. Qed.
Hint Resolve cfoldExprs_ok1'. Hint Resolve cfoldExprs_ok'.
Fixpoint cfoldExprsContext (C : context) : context := Fixpoint cfoldExprsContext (C : context) : context :=
match C with match C with
@ -230,8 +346,8 @@ Qed.
Hint Resolve plug_cfoldExprs1. Hint Resolve plug_cfoldExprs1.
Lemma cfoldExprs_ok1 : forall v c, Lemma cfoldExprs_ok : forall v c,
(v, c) <| (v, cfoldExprs c). (v, c) =| (v, cfoldExprs c).
Proof. Proof.
simplify. simplify.
apply simulation with (R := fun vc1 vc2 => fst vc1 = fst vc2 apply simulation with (R := fun vc1 vc2 => fst vc1 = fst vc2
@ -239,74 +355,7 @@ Proof.
simplify; propositional. simplify; propositional.
invert H0; simplify; subst. invert H0; simplify; subst.
apply cfoldExprs_ok1' in H3. apply cfoldExprs_ok' in H3.
cases vc2; simplify; subst. cases vc2; simplify; subst.
eauto 7. eauto 7.
Qed. Qed.
Lemma cfoldExprs_ok2' : forall v1 c1 l v2 c2,
step0 (v1, cfoldExprs c1) l (v2, c2)
-> exists c2', step0 (v1, c1) l (v2, c2') /\ c2 = cfoldExprs c2'.
Proof.
invert 1;
repeat match goal with
| [ H : _ = cfoldExprs ?c |- _ ] => cases c; invert H
end; repeat rewrite cfoldArith_ok in *; eauto.
Qed.
Hint Resolve cfoldExprs_ok2'.
Lemma plug_cfoldExprs2 : forall C c1 c2, plug C c1 (cfoldExprs c2)
-> exists C' c1', plug C' c1' c2
/\ C = cfoldExprsContext C'
/\ c1 = cfoldExprs c1'.
Proof.
induct 1; simplify; eauto.
cases c2; simplify; invert x.
specialize (IHplug _ eq_refl).
first_order; subst.
eauto 7.
Qed.
Lemma plug_cfoldExprs2' : forall C c1 c2, plug (cfoldExprsContext C) (cfoldExprs c1) c2
-> exists c2', plug C c1 c2'
/\ c2 = cfoldExprs c2'.
Proof.
induct 1; simplify; eauto.
cases C; invert x.
eauto.
cases C; invert x.
specialize (IHplug _ _ eq_refl eq_refl).
first_order; subst.
eauto.
Qed.
Lemma cfoldExprs_ok2 : forall v c,
(v, cfoldExprs c) <| (v, c).
Proof.
simplify.
apply simulation with (R := fun vc1 vc2 => fst vc1 = fst vc2
/\ snd vc1 = cfoldExprs (snd vc2));
simplify; propositional.
invert H0; simplify; subst.
eapply plug_cfoldExprs2 in H.
first_order; subst.
apply cfoldExprs_ok2' in H3.
first_order; subst.
cases vc2; simplify; subst.
apply plug_cfoldExprs2' in H4.
first_order; subst.
eauto.
Qed.
Theorem cfoldExprs_ok : forall v c,
(v, cfoldExprs c) =| (v, c).
Proof.
simplify.
split.
apply cfoldExprs_ok2.
apply cfoldExprs_ok1.
Qed.