Commit 29624021 authored by Heiko Becker's avatar Heiko Becker

Prove soundness of FPRangeValidator, start working on Cmd soundness

parent 712ea61c
This diff is collapsed.
......@@ -5,33 +5,38 @@ Require Import Daisy.Expressions Daisy.Infra.RationalSimps
Require Import Flocq.Appli.Fappli_IEEE_bits Flocq.Appli.Fappli_IEEE
Flocq.Core.Fcore_Raux Flocq.Prop.Fprop_relative.
Definition valid_div a b (f:binary_float a b):=
match f with
|B754_finite _ _ _ _ _ _ => true
|_ => false
Fixpoint eval_exp_float (e:exp (binary_float 53 1024)) (E:nat -> option (binary_float 53 1024)):=
match e with
| Var _ x => E x
| Const m v => Some v
| Unop Neg e =>
match eval_exp_float e E with
|Some v1 => Some (b64_opp v1)
|_ => None
end
| Unop Inv e => None
| Binop b e1 e2 =>
match eval_exp_float e1 E, eval_exp_float e2 E with
| Some f1, Some f2 =>
match b with
| Plus => Some (b64_plus mode_NE f1 f2)
| Sub => Some (b64_minus mode_NE f1 f2)
| Mult => Some (b64_mult mode_NE f1 f2)
| Div => Some (b64_div mode_NE f1 f2)
end
|_ , _ => None
end
| _ => None
end.
(* Fixpoint eval_exp_float (e:exp (binary_float 53 1024)) (E:nat -> option (binary_float 53 1024)):= *)
(* match e with *)
(* |Const c => if (is_finite 53 1024 c) then Some c else None *)
(* |Var _ x => E x *)
(* |Binop b e1 e2 => *)
(* match eval_exp_float e1 E, eval_exp_float e2 E with *)
(* |Some f1, Some f2 => *)
(* if (is_finite 53 1024 f1 && is_finite 53 1024 f2) *)
(* then *)
(* match b with *)
(* |Plus => Some (b64_plus mode_NE f1 f2) *)
(* |Sub => Some (b64_minus mode_NE f1 f2) *)
(* |Mult => Some (b64_mult mode_NE f1 f2) *)
(* |Div => if (valid_div f2) then Some (b64_div mode_NE f1 f2) else None *)
(* end *)
(* else *)
(* None *)
(* |_ , _ => None *)
(* end *)
(* | _ => None *)
(* end. *)
Definition optionLift (A B:Type) (e:option A) (some_cont:A -> B) (none_cont:B) :=
match e with
| Some v => some_cont v
| None => none_cont
end.
Definition normal_or_zero v :=
Qeq_bool v 0 || Qle_bool (minValue M64) (Qabs v).
(* Lemma eval_exp_float_finite e E: *)
(* forall v, eval_exp_float e E = Some v -> *)
......
......@@ -32,6 +32,18 @@ Ltac canonize_Q_to_R :=
Ltac canonize_hyps := repeat canonize_Q_prop; repeat canonize_Q_to_R.
Ltac Q2R_to_head_step :=
match goal with
| [ H: context[Q2R ?a + Q2R ?b] |- _] => rewrite <- Q2R_plus in H
| [ H: context[Q2R ?a - Q2R ?b] |- _] => rewrite <- Q2R_minus in H
| [ H: context[Q2R ?a * Q2R ?b] |- _] => rewrite <- Q2R_minus in H
| [ |- context[Q2R ?a + Q2R ?b]] => rewrite <- Q2R_plus
| [ |- context[Q2R ?a - Q2R ?b]] => rewrite <- Q2R_minus
| [ |- context[Q2R ?a * Q2R ?b]] => rewrite <- Q2R_minus
end.
Ltac Q2R_to_head := repeat Q2R_to_head_step.
Ltac NatSet_simp hyp :=
try rewrite NatSet.mem_spec in hyp;
try rewrite NatSet.equal_spec in hyp;
......@@ -66,4 +78,13 @@ Ltac destruct_if :=
intros name;
rewrite name in *;
try congruence
end .
\ No newline at end of file
end.
(* HOL4 Style patter matching tactics *)
Tactic Notation "lift " tactic(t) :=
fun H => t H.
Tactic Notation "match_pat" open_constr(pat) tactic(t) :=
match goal with
| [H: ?ty |- _ ] => unify pat ty; t H
end.
\ No newline at end of file
......@@ -184,13 +184,13 @@ Definition normal (v:Q) (m:mType) :=
Qle_bool (minValue m) (Qabs v) && Qle_bool (Qabs v) (maxValue m).
Definition denormal (v:Q) (m:mType) :=
Qle_bool (minValue m) (Qabs v) && Qle_bool (Qabs v) (maxValue m).
Qle_bool (Qabs v) (minValue m) && negb (Qeq_bool v 0).
Definition Normal (v:R) (m:mType) :=
(Q2R (minValue m) <= (Rabs v) /\ (Rabs v) <= Q2R (maxValue m))%R.
Definition Denormal (v:R) (m:mType) :=
(Q2R (minValue m) <= (Rabs v) /\ (Rabs v) <= Q2R (maxValue m))%R.
((Rabs v) <= Q2R (minValue m) /\ ~ (v = 0))%R.
(**
Predicate that is true if and only if the given value v is a valid
floating-point value according to the the type m.
......
......@@ -149,4 +149,13 @@ Lemma Rabs_0_equiv:
(Rbasic_fun.Rabs 0 <= Q2R 0)%R.
Proof.
rewrite Q2R0_is_0, Rbasic_fun.Rabs_R0; lra.
Qed.
Lemma bounded_inAbs a b c:
(a <= b <= c -> (Rabs b <= Rabs c) \/ Rabs b <= Rabs a)%R.
Proof.
intros.
unfold Rabs.
destruct (Rcase_abs b); destruct (Rcase_abs c); destruct (Rcase_abs a);
lra.
Qed.
\ No newline at end of file
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