Skip to content

GitLab

F
FloVer
Commit 7bd27dc4 authored by Heiko Becker's avatar Heiko Becker
Browse files
Options

Fix errors introduced by merge with subdivision checks

parent 36ce0269
Show whitespace changes
Inline Side-by-side
Showing with 199 additions and 1244 deletions
coq/AffineValidation.v
View file @ 7bd27dc4
......@@ -110,6 +110,7 @@ Fixpoint validAffineBounds (e: expr Q) (A: analysisResult) P (validVars: NatSet.
if (isSupersetIntv intv iv) && (isSupersetIntv iv intv) then
Some (FloverMap.add e af' exprsAf', n')
else None
| Let _ _ _ _ => None
end
end.
......@@ -522,7 +523,8 @@ Qed.
Definition checked_expressions (A: analysisResult) E Gamma fVars dVars e iexpmap
inoise map1 :=
exists af vR aiv aerr,
NatSet.Subset (usedVars e) (NatSet.union fVars dVars) /\
(* WAS: usedVars e *)
NatSet.Subset (freeVars e) (NatSet.union fVars dVars) /\
FloverMap.find e A = Some (aiv, aerr) /\
isSupersetIntv (toIntv af) aiv = true /\
FloverMap.find e iexpmap = Some af /\
......@@ -677,6 +679,7 @@ Proof.
lra.
Qed.
(*
Lemma validAffineBounds_sound_var A P E Gamma fVars dVars n:
forall (noise : nat) (exprAfs : expressionsAffine) (inoise : nat)
(iexpmap : FloverMap.t (affine_form Q)) (map1 : nat -> option noise_type),
......@@ -2597,3 +2600,4 @@ Proof.
split; eauto using Rle_trans.
+ destruct vtyped; auto.
Qed.
*)
\ No newline at end of file
coq/CertificateChecker.v
View file @ 7bd27dc4
......@@ -30,7 +30,6 @@ Theorem Certificate_checking_is_sound_general (e:expr Q) (absenv:analysisResult)
forall (E1 E2:env) DeltaMap,
(forall (v : R) (m' : mType),
exists d : R, DeltaMap v m' = Some d /\ (Rabs d <= mTypeToR m')%R) ->
eval_precond E1 P ->
unsat_queries Qmap ->
(forall Qmap, In Qmap (queriesInSubdivs subdivs) -> unsat_queries Qmap) ->
......@@ -45,6 +44,7 @@ Theorem Certificate_checking_is_sound_general (e:expr Q) (absenv:analysisResult)
eval_expr E2 (toRExpMap Gamma) DeltaMap (toRExp e) vF m ->
(Rabs (vR - vF) <= Q2R err))%R /\
validTypes e Gamma /\
getValidMap defVars e (FloverMap.empty mType) = Succes Gamma /\
validRanges e absenv E1 (toRTMap (toRExpMap Gamma)) /\
validErrorBounds e E1 E2 absenv Gamma /\
validFPRanges e E2 Gamma absenv.
......
coq/Checker_extraction.v
View file @ 7bd27dc4
Require Import Flover.CertificateChecker Flover.floverParser.
Require Import Coq.extraction.ExtrOcamlString Coq.extraction.ExtrOcamlBasic Coq.extraction.ExtrOcamlNatBigInt Coq.extraction.ExtrOcamlZBigInt.
Require Import Coq.extraction.ExtrOcamlString Coq.extraction.ExtrOcamlBasic
Coq.extraction.ExtrOcamlNatBigInt Coq.extraction.ExtrOcamlZBigInt.
Extraction Language Ocaml.
Extraction Language OCaml.
(*
Extraction "./binary/CoqChecker.ml" runChecker.
*)
coq/ErrorValidationAA.v
View file @ 7bd27dc4
......@@ -12,9 +12,9 @@ From Coq
From Flover
Require Import Infra.Abbrevs Infra.RationalSimps Infra.RealRationalProps
Infra.RealSimps Infra.Ltacs Commands Environments ErrorAnalysis ErrorValidationAAutil
Infra.RealSimps Infra.Ltacs Environments ErrorAnalysis ErrorValidationAAutil
ExpressionSemantics IntervalValidation TypeValidator RealRangeValidator ErrorBounds
ErrorValidation AffineForm AffineArithQ AffineArith.
ErrorValidation AffineForm AffineArithQ AffineArith AffineValidation.
(** Error bound validator **)
Fixpoint validErrorboundAA (e:expr Q) (* analyzed expression *)
......@@ -206,9 +206,11 @@ Fixpoint validErrorboundAA (e:expr Q) (* analyzed expression *)
Some (FloverMap.add e errPoly newErrorMap1, (maxNoise1 + 1)%nat)
else
None
| Let _ _ _ _ => None
end.
(** Error bound command validator **)
(*
Fixpoint validErrorboundAACmd (f: cmd Q) (* analyzed cmd with let's *)
(typeMap: FloverMap.t mType) (* derived types for e *)
(A: analysisResult) (* encoded result of Flover *)
......@@ -235,6 +237,7 @@ Fixpoint validErrorboundAACmd (f: cmd Q) (* analyzed cmd with let's *)
end
| Ret e => validErrorboundAA e typeMap A dVars currNoise errMap
end.
*)
(* Notation for the universal case of the soundness statement, to help reason
about memoization cases. This allows us to show several monotonicity lemmas
......@@ -313,6 +316,7 @@ Fixpoint contained_subexpr (e: expr Q) (expr_map: FloverMap.t (affine_form Q)):
| Fma e1 e2 e3 => contained_subexpr e1 expr_map /\ contained_subexpr e2 expr_map /\
contained_subexpr e3 expr_map
| Downcast m e' => contained_subexpr e' expr_map
| Let _ _ _ _ => False (* FIXME *)
end /\ FloverMap.In e expr_map.
Lemma contained_subexpr_map_extension e expr_map1 expr_map2:
......@@ -415,6 +419,8 @@ Proof.
rewrite andb_true_l in e5.
apply Ndec.Ncompare_Neqb in Hexpeq.
now rewrite Hexpeq in e5.
- simpl in *. destruct Hcont; contradiction.
- simpl in *. destruct Hcont; contradiction.
Qed.
Lemma validErrorboundAA_contained_subexpr e Gamma A dVars noise1 noise2 expr_map1 expr_map2:
......@@ -780,6 +786,11 @@ Proof.
intuition.
* apply contained_subexpr_add_compat; auto.
* apply flover_map_in_add.
- destruct (FloverMap.mem (elt:=affine_form Q) (Let m n e1 e2) expr_map1) eqn:Hmem.
+ inversion Hvalidbounds; subst.
apply FloverMap.mem_2 in Hmem.
intuition.
+ Flover_compute. destruct (negb (Qleb 0 e)) eqn:?; congruence.
Qed.
(* The soundness statements starts off with assumption that the checking
......@@ -797,7 +808,8 @@ Definition validErrorboundAA_sound_statement e E1 E2 A Gamma DeltaMap fVars dVar
eval_expr E1 (toRTMap (toRExpMap Gamma)) DeltaMapR (toREval (toRExp e)) v__R REAL ->
validRanges e A E1 (toRTMap (toRExpMap Gamma)) ->
validErrorboundAA e Gamma A dVars noise1 expr_map1 = Some (expr_map2, noise2) ->
NatSet.Subset (usedVars e -- dVars) fVars ->
(* WAS: usedVars *)
NatSet.Subset (freeVars e -- dVars) fVars ->
validTypes e Gamma ->
FloverMap.find e A = Some (iv__A, err__A) ->
(* Starting noise index is greater than 0 and the noise mapping doesn't
......@@ -813,7 +825,8 @@ Definition validErrorboundAA_sound_statement e E1 E2 A Gamma DeltaMap fVars dVar
(forall e' : FloverMap.key,
FloverMap.In e' expr_map1 ->
(* Assumption needed for Cmd_sound proof *)
NatSet.Subset (usedVars e') (NatSet.union fVars dVars) /\
(* WAS: usedVars *)
NatSet.Subset (freeVars e') (NatSet.union fVars dVars) /\
(exists iv__A' err__A', FloverMap.find e' A = Some (iv__A', err__A')) /\
exists (v__FP' : R) (m__FP' : mType),
eval_expr E2 (toRExpMap Gamma) DeltaMap (toRExp e') v__FP' m__FP') ->
......@@ -834,7 +847,8 @@ Definition validErrorboundAA_sound_statement e E1 E2 A Gamma DeltaMap fVars dVar
the existential part holds *)
(forall e' : FloverMap.key,
~ FloverMap.In e' expr_map1 -> FloverMap.In e' expr_map2 ->
NatSet.Subset (usedVars e') (NatSet.union fVars dVars) /\
(* WAS: usedVars *)
NatSet.Subset (freeVars e') (NatSet.union fVars dVars) /\
(exists iv__A' err__A', FloverMap.find e' A = Some (iv__A', err__A')) /\
exists (v__FP' : R) (m__FP' : mType),
eval_expr E2 (toRExpMap Gamma) DeltaMap (toRExp e') v__FP' m__FP')) /\
......@@ -933,10 +947,10 @@ Proof.
intros e' Hnin Hin.
destruct (flover_map_el_eq_extension Hnin Hin) as [Heq Hexpeq].
split; [|split; [|now rewrite Hexpeq]].
1: rewrite usedVars_eq_compat; unfold Q_orderedExps.eq;
* rewrite freeVars_eq_compat;
try eapply Q_orderedExps.exprCompare_eq_sym; eauto.
1: now apply subset_diff_to_subset_union.
erewrite FloverMapFacts.P.F.find_o in Hcert; eauto.
simpl. set_tac. subst; auto.
* erewrite FloverMapFacts.P.F.find_o in Hcert; eauto.
+ intros v__FP m__FP Heval__FP.
rewrite Qle_bool_iff in Herrle.
apply Qle_Rle in Herrle.
......@@ -1062,10 +1076,10 @@ Proof.
intros e' Hnin Hin.
destruct (flover_map_el_eq_extension Hnin Hin) as [Heq Hexpeq].
split; [|split; [|now rewrite Hexpeq]].
1: rewrite usedVars_eq_compat; unfold Q_orderedExps.eq;
* rewrite freeVars_eq_compat;
try eapply Q_orderedExps.exprCompare_eq_sym; eauto.
1: now apply subset_diff_to_subset_union.
erewrite FloverMapFacts.P.F.find_o in Hcert; eauto.
simpl. set_tac.
* erewrite FloverMapFacts.P.F.find_o in Hcert; eauto.
- rewrite Qle_bool_iff in Herrle.
apply Qle_Rle in Herrle.
intros * Heval__FP.
......@@ -1216,10 +1230,10 @@ Proof.
+ edestruct IHcheckedex as (? & ? & ?); eauto.
+ destruct (flover_map_el_eq_extension Hnin1 Hin) as [Heq Hexpeq]; auto.
split; [|split; [|now rewrite Hexpeq]].
1: rewrite usedVars_eq_compat; unfold Q_orderedExps.eq;
* rewrite freeVars_eq_compat; unfold Q_orderedExps.eq;
try eapply Q_orderedExps.exprCompare_eq_sym; eauto.
1: now apply subset_diff_to_subset_union.
erewrite FloverMapFacts.P.F.find_o in Hcert; eauto.
now apply subset_diff_to_subset_union.
* erewrite FloverMapFacts.P.F.find_o in Hcert; eauto.
- intros v__FP m__FP Heval__FPdet.
inversion Heval__FPdet; subst.
pose proof H5 as H5det.
......@@ -1417,10 +1431,10 @@ Proof.
[specialize (IHchecked2 e' Hnin1 Hin2); intuition|].
destruct (flover_map_el_eq_extension Hnin2 Hin) as [Heq Hexpeq]; auto.
split; [|split; [|now rewrite Hexpeq]].
1: rewrite usedVars_eq_compat; unfold Q_orderedExps.eq;
{ rewrite freeVars_eq_compat; unfold Q_orderedExps.eq;
try eapply Q_orderedExps.exprCompare_eq_sym; eauto.
1: now apply subset_diff_to_subset_union.
erewrite FloverMapFacts.P.F.find_o in Hcert; eauto.
now apply subset_diff_to_subset_union. }
{ erewrite FloverMapFacts.P.F.find_o in Hcert; eauto. }
* intros * Heval__FPdet.
inversion Heval__R; subst.
rename v1 into v__R1; rename v2 into v__R2.
......@@ -1674,9 +1688,9 @@ Proof.
destruct (flover_map_in_dec e' subexpr_map2) as [Hin2|Hnin2]; [apply IHchecked2; auto|].
destruct (flover_map_el_eq_extension Hnin2 Hin) as [Heq Hexpeq]; auto.
split; [|split; [|now rewrite Hexpeq]].
1: rewrite usedVars_eq_compat; unfold Q_orderedExps.eq;
{ rewrite freeVars_eq_compat; unfold Q_orderedExps.eq;
try eapply Q_orderedExps.exprCompare_eq_sym; eauto.
1: now apply subset_diff_to_subset_union.
now apply subset_diff_to_subset_union. }
erewrite FloverMapFacts.P.F.find_o in Hcert; eauto.
* intros * Heval__FPdet.
inversion Heval__R; subst.
......@@ -1926,7 +1940,7 @@ Proof.
destruct (flover_map_in_dec e' subexpr_map2) as [Hin2|Hnin2]; [apply IHchecked2; auto|].
destruct (flover_map_el_eq_extension Hnin2 Hin) as [Heq Hexpeq]; auto.
split; [|split; [|now rewrite Hexpeq]].
1: rewrite usedVars_eq_compat; unfold Q_orderedExps.eq;
1: rewrite freeVars_eq_compat; unfold Q_orderedExps.eq;
try eapply Q_orderedExps.exprCompare_eq_sym; eauto.
1: now apply subset_diff_to_subset_union.
erewrite FloverMapFacts.P.F.find_o in Hcert; eauto.
......@@ -2251,7 +2265,7 @@ Proof.
destruct (flover_map_in_dec e' subexpr_map2) as [Hin2|Hnin2]; [apply IHchecked2; auto|].
destruct (flover_map_el_eq_extension Hnin2 Hin) as [Heq Hexpeq]; auto.
split; [|split; [|now rewrite Hexpeq]].
1: rewrite usedVars_eq_compat; unfold Q_orderedExps.eq;
1: rewrite freeVars_eq_compat; unfold Q_orderedExps.eq;
try eapply Q_orderedExps.exprCompare_eq_sym; eauto.
1: now apply subset_diff_to_subset_union.
erewrite FloverMapFacts.P.F.find_o in Hcert; eauto.
......@@ -2639,7 +2653,7 @@ Proof.
destruct (flover_map_in_dec e' subexpr_map3) as [Hin3|Hnin3]; [apply IHchecked3; auto|].
destruct (flover_map_el_eq_extension Hnin3 Hin) as [Heq Hexpeq]; auto.
split; [|split; [|now rewrite Hexpeq]].
1: rewrite usedVars_eq_compat; unfold Q_orderedExps.eq;
1: rewrite freeVars_eq_compat; unfold Q_orderedExps.eq;
try eapply Q_orderedExps.exprCompare_eq_sym; eauto.
1: now apply subset_diff_to_subset_union.
erewrite FloverMapFacts.P.F.find_o in Hcert; eauto.
......@@ -2942,7 +2956,7 @@ Proof.
destruct (flover_map_in_dec e' subexpr_map) as [Hin1|Hnin1]; [apply IHchecked; auto|].
destruct (flover_map_el_eq_extension Hnin1 Hin) as [Heq Hexpeq]; auto.
split; [|split; [|now rewrite Hexpeq]].
1: rewrite usedVars_eq_compat; unfold Q_orderedExps.eq;
1: rewrite freeVars_eq_compat; unfold Q_orderedExps.eq;
try eapply Q_orderedExps.exprCompare_eq_sym; eauto.
1: now apply subset_diff_to_subset_union.
erewrite FloverMapFacts.P.F.find_o in Hcert; eauto.
......@@ -3059,7 +3073,8 @@ Proof.
- apply validErrorboundAA_sound_binop; auto.
- apply validErrorboundAA_sound_fma; auto.
- apply validErrorboundAA_sound_downcast; auto.
Qed.
- admit.
Admitted.
Corollary validErrorbound_sound_validErrorBounds e E1 E2 A Gamma DeltaMap expr_map noise noise_map:
(forall e' : FloverMap.key,
......@@ -3182,8 +3197,10 @@ Proof.
end.
cbn in Hiv.
now rewrite Rabs_Rle_condition.
Qed.
- admit.
Admitted.
(*
Definition checked_error_commands c E1 E2 A Gamma DeltaMap noise_map noise expr_map :=
match c with
| Let m x e k =>
......@@ -3512,7 +3529,7 @@ Proof.
specialize (flover_map_el_eq_extension Hvarnew Hin) as [Heq Heqexp].
rewrite Heqexp.
split.
+ rewrite usedVars_eq_compat; unfold Q_orderedExps.eq;
+ rewrite freeVars_eq_compat; unfold Q_orderedExps.eq;
try eapply Q_orderedExps.exprCompare_eq_sym; eauto.
cbn; set_tac.
+ split.
......@@ -3798,3 +3815,4 @@ Proof.
cbn in H12.
now rewrite Rabs_Rle_condition.
Qed.
*)
\ No newline at end of file
coq/ErrorValidationAAutil.v
View file @ 7bd27dc4
......@@ -4,9 +4,9 @@ From Coq
From Flover
Require Import Infra.Abbrevs Infra.RationalSimps Infra.RealRationalProps
Infra.RealSimps Infra.Ltacs Commands Environments ErrorAnalysis
Infra.RealSimps Infra.Ltacs Environments ErrorAnalysis
ExpressionSemantics IntervalValidation TypeValidator RealRangeValidator ErrorBounds
ErrorValidation AffineForm AffineArithQ AffineArith.
ErrorValidation AffineForm AffineArithQ AffineArith AffineValidation.
Definition mkErrorPolyQ (err: Q) noise :=
if Qeq_bool err 0 then
......
coq/IEEE_connection.v
View file @ 7bd27dc4
......@@ -14,13 +14,17 @@ From Flocq
From Flocq.Prop
Require Import Relative.
(* Appli.Fappli_IEEE_bits Appli.Fappli_IEEE Core.Fcore_Raux
Fprop_relative Fcore_generic_fmt. *)
(**
Definitions of static values.
dmode is the rounding mode used for the proofs;
fl64 specifies the type of binary, 64-bit floating-point words;
flt_exp_64 is the Flocq library function FLT_exp for 64-bit floats
**)
Definition dmode := mode_NE.
Definition fl64:Type := binary_float 53 1024.
Definition flt_exp_64 := FLT_exp (3 - 1024 - 53) 53.
(* Additional assumptions necessary to obtain relative error later *)
Lemma valid_flt_64:
Valid_exp flt_exp_64.
Proof.
......@@ -38,12 +42,18 @@ Proof.
destruct (Z.max_spec_le (k - 53) (-1074)); omega.
Qed.
(** Flocq relative error theorem instantiated for 64-bit floats *)
Definition relative_error_64_ex :=
@relative_error_N_ex radix2 flt_exp_64
valid_flt_64
(-1022) 53 valid_flt_64_assum
(fun x => negb (Z.even x)).
(**
Our deterministic semantics uses a map to define roundoff errors.
We define an IEEE-754 correct delta map and show that it correctly
provides a roundoff error
**)
Definition IeeeDeltaMap (x:R) (m:mType): option R :=
match m with
| M64 => if (Raux.Rle_bool (Raux.bpow radix2 (-1022)) (Rabs x))
......@@ -104,6 +114,9 @@ Definition updFlEnv x v E :=
then Some (A:=(binary_float 53 1024)) v
else E y.
(**
Definition of IEEE 754 evaluation for FloVer expressions
**)
Fixpoint eval_expr_float (e:expr (binary_float 53 1024)) (E:nat -> option fl64):=
match e with
| Var _ x => E x
......@@ -136,16 +149,6 @@ Fixpoint eval_expr_float (e:expr (binary_float 53 1024)) (E:nat -> option fl64):
| _ => None
end.
(*
Fixpoint bstep_float f E :option fl64 :=
match f with
| Let m x e g =>
olet res := eval_expr_float e E in
bstep_float g (updFlEnv x res E)
| Ret e => eval_expr_float e E
end.
*)
Definition isValid e :=
plet v := e in
normal_or_zero (B2R 53 1024 v).
......@@ -153,7 +156,8 @@ Definition isValid e :=
Fixpoint eval_expr_valid (e:expr fl64) E :=
match e with
| Var _ x => True (*isValid (eval_expr_float (Var n) E)*)
| Const m v => True (*isValid (eval_expr_float (Const m v) E)*)
| Const m v => plet v := eval_expr_float (Const m v) E in
if is_finite 53 1024 v then True else False
| Unop u e => eval_expr_valid e E
| Binop b e1 e2 =>
(eval_expr_valid e1 E) /\ (eval_expr_valid e2 E) /\
......@@ -265,78 +269,6 @@ Fixpoint B2Qexpr (e: expr fl64) :=
(* | Cond e1 e2 e3 => Cond (B2Qexpr e1) (B2Qexpr e2) (B2Qexpr e3) *)
end.
(*
Fixpoint B2Qcmd (f:cmd fl64) :=
match f with
| Let m x e g => Let m x (B2Qexpr e) (B2Qcmd g)
| Ret e => Ret (B2Qexpr e)
end.
*)
Definition isValid e :=
plet v := e in
normal_or_zero (B2R 53 1024 v).
Fixpoint eval_expr_valid (e:expr fl64) E :=
match e with
| Var _ x => True (*isValid (eval_expr_float (Var n) E)*)
(* We need this assumption here otherwise we cannot prove constants having 0 roundoff error *)
| Const m v => plet v := eval_expr_float (Const m v) E in
if is_finite 53 1024 v then True else False
| Unop u e => eval_expr_valid e E
| Binop b e1 e2 =>
(eval_expr_valid e1 E) /\ (eval_expr_valid e2 E) /\
(let e1_res := eval_expr_float e1 E in
let e2_res := eval_expr_float e2 E in
match e1_res with
| None => True
| Some v1 =>
let v1_real := B2R 53 1024 v1 in
match e2_res with
| None => True
| Some v2 =>
let v2_real := B2R 53 1024 v2 in
let op_real := evalBinop b v1_real v2_real in
(* plet delta := IeeeDeltaMap op_real M64 in
normal_or_zero (perturb op_real M64 delta) *)
normal_or_zero op_real
end
end)
| Fma e1 e2 e3 =>
(eval_expr_valid e1 E) /\ (eval_expr_valid e2 E) /\ (eval_expr_valid e3 E) /\
(let e1_res := eval_expr_float e1 E in
let e2_res := eval_expr_float e2 E in
let e3_res := eval_expr_float e3 E in
match e1_res with
| None => True
| Some v1 =>
let v1_real := B2R 53 1024 v1 in
match e2_res with
| None => True
| Some v2 =>
let v2_real := B2R 53 1024 v2 in
match e3_res with
| None => True
| Some v3 =>
let v3_real := B2R 53 1024 v3 in
False (* No support for fma yet; ideally this would be
normal_or_zero (evalFma v1_real v2_real v3_real) *)
end
end
end)
| Downcast m e => eval_expr_valid e E
end.
Fixpoint bstep_valid f E :=
match f with
| Let m x e g =>
eval_expr_valid e E /\
(optionBind (eval_expr_float e E)
(fun v_e => bstep_valid g (updFlEnv x v_e E))
True)
| Ret e => eval_expr_valid e E
end.
Definition toREnv (E: nat -> option fl64) (x:nat):option R :=
match E x with
|Some v => Some (Q2R (B2Q v))
......@@ -360,14 +292,6 @@ Fixpoint is64BitEval (V:Type) (e:expr V) :=
(* | Cond e1 e2 e3 => is64BitEval e1 /\ is64BitEval e2 /\ is64BitEval e3 *)
end.
(*
Fixpoint is64BitBstep (V:Type) (f:cmd V) :=
match f with
| Let m x e g => is64BitEval e /\ m = M64 /\ is64BitBstep g
| Ret e => is64BitEval e
end.
*)
Fixpoint noDowncast (V:Type) (e:expr V) :=
match e with
| Var _ x => True
......@@ -380,14 +304,6 @@ Fixpoint noDowncast (V:Type) (e:expr V) :=
(* | Cond e1 e2 e3 => noDowncast e1 /\ noDowncast e2 /\ noDowncast e3 *)
end.
(*
Fixpoint noDowncastFun (V:Type) (f:cmd V) :=
match f with
| Let m x e g => noDowncast e /\ noDowncastFun g
| Ret e => noDowncast e
end.
*)
Opaque mTypeToQ.
Lemma validValue_is_finite v:
......@@ -454,20 +370,6 @@ Proof.
erewrite <- Gamma_64Bit; eauto.
Qed.
(*
Lemma typing_cmd_64_bit f:
forall Gamma,
is64BitEnv Gamma ->
validTypesCmd f Gamma ->
FloverMap.find (getRetExp f) Gamma = Some M64.
Proof.
induction f; intros * Gamma_64BitEnv valid_f.
- destruct valid_f as [(? & ? & ? & ? & ? & ?) ?].
eapply IHf; eauto.
- destruct valid_f; simpl in *; eapply typing_expr_64_bit; eauto.
Qed.
*)
Lemma round_0_zero:
(round radix2 flt_exp_64 (round_mode mode_NE) 0) = 0%R.
Proof.
......@@ -620,8 +522,45 @@ Proof.
+ Flover_compute; inversion getMap_succeeds; subst.
find_cases; try (eapply IHe with (akk:=akk); eauto).
congruence.
- destruct (getValidMap defVars e1 akk) eqn:?;
simpl in *; try congruence.
destruct (FloverMap.find e1 t) eqn:?; [ | congruence].
destruct is64Bit_e as (? & ? & ?); subst.
assert (m1 = M64).
{ eapply IHe1 with (akk:=akk); eauto. }
subst. cbn in getMap_succeeds.
unfold addMono, isMonotone in *.
destruct (FloverMap.find (Var Q n) t) eqn:?;
simpl in *; [ congruence | ].
destruct (getValidMap defVars e2 (FloverMap.add (Var Q n) M64 t)) eqn:?;
simpl in *; try congruence.
destruct (FloverMap.find e2 t0) eqn:?;
try congruence.
assert (forall e m, FloverMap.find e t = Some m -> m = M64)
as valid_t
by (eapply IHe1 with (akk:=akk); eauto).
assert (forall e m, FloverMap.find e t0 = Some m -> m = M64)
as valid_t0.
{ eapply IHe2 with (akk:=(FloverMap.add (Var Q n) M64 t)); try eauto.
intros. rewrite map_find_add in H0.
destruct (Q_orderedExps.compare (Var Q n) e0) eqn:?; [ congruence | | ];
eapply valid_t; eauto. }
clear IHe1 IHe2.
assert (m = M64) by (eapply valid_t0; eauto).
subst.
destruct (FloverMap.find (Let M64 n e1 e2) defVars) eqn:?.
+ destruct (mTypeEq m M64) eqn:?; try congruence; type_conv; subst.
Flover_compute.
inversion getMap_succeeds; subst.
find_cases; try (eapply valid_t0; now eauto).
congruence.
+ Flover_compute.
inversion getMap_succeeds; subst.
find_cases; try (eapply valid_t0; now eauto).
congruence.
Qed.
(*
Lemma getValidMapCmd_preserving f:
forall defVars akk res,
(forall e m, FloverMap.find e akk = Some m -> m = M64) ->
......@@ -644,6 +583,7 @@ Proof.
destruct (mTypeEq M64 m1) eqn:?; congruence.
- eapply getValidMap_preserving with (akk:=akk); eauto.
Qed.
*)
Lemma validValue_bounded v delta:
(Normal v M64\/ (v = 0)%R) ->
......@@ -769,24 +709,10 @@ Lemma eval_expr_gives_IEEE (e:expr fl64) :
validTypes (B2Qexpr e) Gamma ->
approxEnv E1 (toRExpMap Gamma) A fVars dVars E2_real ->
validRanges (B2Qexpr e) A E1 (toRTMap (toRExpMap Gamma)) ->
(*
<<<<<<< HEAD
validErrorBoundsRec (B2Qexpr e) E1 E2_real A Gamma IeeeDeltaMap ->
validFPRanges (B2Qexpr e) E2_real Gamma A ->
eval_expr (toREnv E2) (toRExpMap Gamma) IeeeDeltaMap (toRExp (B2Qexpr e)) vR M64 ->
NatSet.Subset ((usedVars (B2Qexpr e)) -- dVars) fVars ->
||||||| merged common ancestors
validErrorBounds (B2Qexpr e) E1 E2_real A Gamma DeltaMap ->
FPRangeValidator (B2Qexpr e) A Gamma dVars = true ->
eval_expr (toREnv E2) (toRExpMap Gamma) DeltaMap (toRExp (B2Qexpr e)) vR M64 ->
NatSet.Subset ((usedVars (B2Qexpr e)) -- dVars) fVars ->
=======
validErrorBounds (B2Qexpr e) E1 E2_real A Gamma DeltaMap ->
FPRangeValidator (B2Qexpr e) A Gamma dVars = true ->
eval_expr (toREnv E2) (toRExpMap Gamma) DeltaMap (toRExp (B2Qexpr e)) vR M64 ->
NatSet.Subset ((freeVars (B2Qexpr e)) -- dVars) fVars ->
>>>>>>> exprMerge
*)
is64BitEval (B2Qexpr e) ->
is64BitEnv Gamma ->
noDowncast (B2Qexpr e) ->
......@@ -799,8 +725,7 @@ Lemma eval_expr_gives_IEEE (e:expr fl64) :
exists (v:binary_float 53 1024),
eval_expr_float e E2 = Some v /\
is_finite 53 1024 v = true /\
(B2R 53 1024 v = vR). (* /\ *)
(* eval_expr (toREnv E2) (toRExpMap Gamma) IeeeDeltaMap (toRExp (B2Qexpr e)) (Q2R (B2Q v)) M64 *)
(B2R 53 1024 v = vR).
Proof.
Opaque validTypes mTypeToQ mTypeToR.
induction e; simpl in *;
......@@ -813,10 +738,8 @@ Proof.
Flover_compute_asm; try congruence; type_conv; subst;
unfold optionBind;
intros eval_IEEE_valid_e.
(*
<<<<<<< HEAD
Transparent validTypes.
all:validTypes_split.
all:try validTypes_split.
- unfold toREnv in *.
destruct (E2 n) eqn:HE2; try congruence.
exists f; split; try eauto.
......@@ -828,16 +751,18 @@ Proof.
inversion H1; subst. unfold toREnv; auto. }
split; [ auto |].
rewrite B2Q_B2R_eq; auto.
- destruct (is_finite 53 1024 v) eqn:v_finite; try contradiction.
- destruct (is_finite 53 1024 v) eqn:v_finite; [ | contradiction].
rewrite B2Q_B2R_eq in *; auto.
assert (delta = 0%R).
{ destruct (Raux.Rle_bool (/ IZR (Z.pow_pos 2 1022)) (Rabs (B2R 53 1024 v))) eqn:case_val.
2: {
inversion H1; subst; lra. }
inversion H1; subst. clear H1 H3.
pose proof (round_generic radix2 flt_exp_64 (round_mode dmode) (B2R 53 1024 v)) as round_id.
simpl in round_id.
rewrite round_id; [ f_equal; lra | ].
{ destruct (Raux.Rle_bool (/ IZR (Z.pow_pos 2 1022))
(Rabs (B2R 53 1024 v)))
eqn:case_val;
inversion H1; subst; [ | lra ].
clear H1 H3.
pose proof (round_generic radix2 flt_exp_64 (round_mode dmode)
(B2R 53 1024 v))
as round_id.
simpl in round_id. rewrite round_id; [ f_equal; lra | ].
apply generic_format_B2R. }
subst. exists v; repeat split; try auto.
lra.
......@@ -855,68 +780,6 @@ Proof.
admit.
- repeat (match goal with
|H: _ /\ _ |- _ => destruct H
||||||| merged common ancestors
Transparent validTypes.
all:validTypes_split.
- unfold toREnv in *.
destruct (E2 n) eqn:HE2; try congruence.
exists f; split; try eauto.
eapply Var_load; try auto. rewrite HE2; auto.
- eexists; split; try eauto.
eapply (Const_dist') with (delta := delta); eauto.
cbn.
admit.
- destruct valid_rangebounds as [valid_e valid_intv].
destruct m eqn:?; cbn in *; try congruence.
subst.
edestruct IHe as [v_e [eval_float_e eval_rel_e]]; eauto; [intuition|].
assert (is_finite 53 1024 v_e = true).
{ apply validValue_is_finite.
eapply FPRangeValidator_sound with (e:=B2Qexpr e); eauto.
2: intuition.
eapply eval_eq_env; eauto. }
rewrite eval_float_e.
exists (b64_opp v_e); split; try auto.
unfold b64_opp. rewrite <- (is_finite_Bopp _ _ pair) in H.
rewrite B2Q_B2R_eq; auto. rewrite B2R_Bopp.
eapply Unop_neg'; eauto.
unfold evalUnop. rewrite is_finite_Bopp in H. rewrite B2Q_B2R_eq; auto.
- admit.
- repeat (match goal with
|H: _ /\ _ |- _ => destruct H
=======
Transparent validTypes.
(*
all:validTypes_split.
- unfold toREnv in *.
destruct (E2 n) eqn:HE2; try congruence.
exists f; split; try eauto.