Commit 934d48f0 authored by Nikita Zyuzin's avatar Nikita Zyuzin

Update proofs for FMA

parent 4eebe12b
...@@ -102,22 +102,16 @@ Definition teropEq (o1: terop) (o2: terop) := ...@@ -102,22 +102,16 @@ Definition teropEq (o1: terop) (o2: terop) :=
| Fma, Fma => true | Fma, Fma => true
end. end.
Lemma teropEq_refl b: Lemma teropEq_refl t:
teropEq b b = true. teropEq t t = true.
Proof. Proof.
now destruct b. now destruct t.
Qed. Qed.
Lemma teropEq_compat_eq b1 b2: Lemma teropEq_compat_eq t1 t2:
teropEq b1 b2 = true <-> b1 = b2. teropEq t1 t2 = true <-> t1 = t2.
Proof. Proof.
now destruct b1, b2. now destruct t1, t2.
Qed.
Lemma teropEq_compat_eq_false b1 b2:
teropEq b1 b2 = false <-> ~ (b1 = b2).
Proof.
now destruct b1, b2.
Qed. Qed.
Definition evalTerop (o: terop) (v1: R) (v2: R) (v3: R) := Definition evalTerop (o: terop) (v1: R) (v2: R) (v3: R) :=
...@@ -306,7 +300,15 @@ Inductive eval_exp (E:env) (Gamma: nat -> option mType) :(exp R) -> R -> mType - ...@@ -306,7 +300,15 @@ Inductive eval_exp (E:env) (Gamma: nat -> option mType) :(exp R) -> R -> mType -
eval_exp E Gamma f1 v1 m1 -> eval_exp E Gamma f1 v1 m1 ->
eval_exp E Gamma f2 v2 m2 -> eval_exp E Gamma f2 v2 m2 ->
((op = Div) -> (~ v2 = 0)%R) -> ((op = Div) -> (~ v2 = 0)%R) ->
eval_exp E Gamma (Binop op f1 f2) (perturb (evalBinop op v1 v2) delta) (join m1 m2). eval_exp E Gamma (Binop op f1 f2) (perturb (evalBinop op v1 v2) delta) (join m1 m2)
| Terop_dist m1 m2 m3 op f1 f2 f3 v1 v2 v3 delta:
Rle (Rabs delta) (Q2R (mTypeToQ (join3 m1 m2 m3))) ->
eval_exp E Gamma f1 v1 m1 ->
eval_exp E Gamma f2 v2 m2 ->
eval_exp E Gamma f3 v3 m3 ->
eval_exp E Gamma (Terop op f1 f2 f3)
(perturb (evalTerop op v1 v2 v3) delta)
(join3 m1 m2 m3).
Hint Constructors eval_exp. Hint Constructors eval_exp.
...@@ -375,6 +377,20 @@ Qed. ...@@ -375,6 +377,20 @@ Qed.
Hint Resolve Binop_dist'. Hint Resolve Binop_dist'.
Lemma Terop_dist' m1 m2 m3 op f1 f2 f3 v1 v2 v3 delta v m' E Gamma:
Rle (Rabs delta) (Q2R (mTypeToQ m')) ->
eval_exp E Gamma f1 v1 m1 ->
eval_exp E Gamma f2 v2 m2 ->
eval_exp E Gamma f3 v3 m3 ->
v = perturb (evalTerop op v1 v2 v3) delta ->
m' = join3 m1 m2 m3 ->
eval_exp E Gamma (Terop op f1 f2 f3) v m'.
Proof.
intros; subst; auto.
Qed.
Hint Resolve Terop_dist'.
(** (**
Define the set of "used" variables of an expression to be the set of variables Define the set of "used" variables of an expression to be the set of variables
occuring in it occuring in it
...@@ -384,6 +400,7 @@ Fixpoint usedVars (V:Type) (e:exp V) :NatSet.t := ...@@ -384,6 +400,7 @@ Fixpoint usedVars (V:Type) (e:exp V) :NatSet.t :=
| Var _ x => NatSet.singleton x | Var _ x => NatSet.singleton x
| Unop u e1 => usedVars e1 | Unop u e1 => usedVars e1
| Binop b e1 e2 => NatSet.union (usedVars e1) (usedVars e2) | Binop b e1 e2 => NatSet.union (usedVars e1) (usedVars e2)
| Terop t e1 e2 e3 => NatSet.union (usedVars e1) (NatSet.union (usedVars e2) (usedVars e3))
| Downcast _ e1 => usedVars e1 | Downcast _ e1 => usedVars e1
| _ => NatSet.empty | _ => NatSet.empty
end. end.
...@@ -407,6 +424,13 @@ Proof. ...@@ -407,6 +424,13 @@ Proof.
assert (m2 = M0) assert (m2 = M0)
by (eapply IHf2; eauto); by (eapply IHf2; eauto);
subst; auto. subst; auto.
- assert (m1 = M0)
by (eapply IHf1; eauto).
assert (m2 = M0)
by (eapply IHf2; eauto).
assert (m3 = M0)
by (eapply IHf3; eauto);
subst; auto.
Qed. Qed.
(** (**
...@@ -455,6 +479,20 @@ Proof. ...@@ -455,6 +479,20 @@ Proof.
simpl in *. simpl in *.
rewrite Q2R0_is_0 in *. rewrite Q2R0_is_0 in *.
repeat (rewrite delta_0_deterministic; try auto). repeat (rewrite delta_0_deterministic; try auto).
- inversion ev1; inversion ev2; subst.
assert (m0 = M0) by (eapply toRMap_eval_M0; eauto).
assert (m1 = M0) by (eapply toRMap_eval_M0; eauto).
assert (m2 = M0) by (eapply toRMap_eval_M0; eauto).
assert (m3 = M0) by (eapply toRMap_eval_M0; eauto).
assert (m4 = M0) by (eapply toRMap_eval_M0; eauto).
assert (m5 = M0) by (eapply toRMap_eval_M0; eauto).
subst.
rewrite (IHf1 v0 v5); try auto.
rewrite (IHf2 v3 v6); try auto.
rewrite (IHf3 v4 v7); try auto.
simpl in *.
rewrite Q2R0_is_0 in *.
repeat (rewrite delta_0_deterministic; try auto).
- inversion ev1; inversion ev2; subst. - inversion ev1; inversion ev2; subst.
apply M0_least_precision in H1; apply M0_least_precision in H1;
apply M0_least_precision in H7; subst. apply M0_least_precision in H7; subst.
......
...@@ -138,6 +138,9 @@ Qed. ...@@ -138,6 +138,9 @@ Qed.
Definition join (m1:mType) (m2:mType) := Definition join (m1:mType) (m2:mType) :=
if (isMorePrecise m1 m2) then m1 else m2. if (isMorePrecise m1 m2) then m1 else m2.
Definition join3 (m1:mType) (m2:mType) (m3:mType) :=
join m1 (join m2 m3).
(* Lemma M0_join_is_M0 m1 m2: *) (* Lemma M0_join_is_M0 m1 m2: *)
(* join m1 m2 = M0 -> m1 = M0 /\ m2 = M0. *) (* join m1 m2 = M0 -> m1 = M0 /\ m2 = M0. *)
(* Proof. *) (* Proof. *)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment