Prove soundness of FPRangeValidator, start working on Cmd soundness

coq/IEEE_connection.v

@@ -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 -> *)

coq/Infra/Ltacs.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

coq/Infra/MachineType.v

@@ -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.

coq/Infra/RealRationalProps.v

@@ -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