Skip to content

GitLab

F
FloVer
Commit 3d6185b5 authored by Heiko Becker's avatar Heiko Becker
Browse files
Options

Add fixed-point precision to HOL4, fix minor bug in configure script

parent 2dd19d8d
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 782 additions and 664 deletions
hol4/CertificateCheckerScript.sml
View file @ 3d6185b5
...@@ -44,7 +44,7 @@ val Certificate_checking_is_sound = store_thm ("Certificate_checking_is_sound", ...@@ -44,7 +44,7 @@ val Certificate_checking_is_sound = store_thm ("Certificate_checking_is_sound",
CertificateChecker e A P defVars ==> CertificateChecker e A P defVars ==>
?iv err vR vF m. ?iv err vR vF m.
FloverMapTree_find e A = SOME (iv,err) /\ FloverMapTree_find e A = SOME (iv,err) /\
eval_exp E1 (toRMap defVars) (toREval e) vR M0 /\ eval_exp E1 (toRMap defVars) (toREval e) vR REAL /\
eval_exp E2 defVars e vF m /\ eval_exp E2 defVars e vF m /\
(!vF m. (!vF m.
eval_exp E2 defVars e vF m ==> eval_exp E2 defVars e vF m ==>
...@@ -99,7 +99,7 @@ val CertificateCmd_checking_is_sound = store_thm ("CertificateCmd_checking_is_so ...@@ -99,7 +99,7 @@ val CertificateCmd_checking_is_sound = store_thm ("CertificateCmd_checking_is_so
CertificateCheckerCmd f A P defVars ==> CertificateCheckerCmd f A P defVars ==>
?iv err vR vF m. ?iv err vR vF m.
FloverMapTree_find (getRetExp f) A = SOME (iv, err) /\ FloverMapTree_find (getRetExp f) A = SOME (iv, err) /\
bstep (toREvalCmd f) E1 (toRMap defVars) vR M0 /\ bstep (toREvalCmd f) E1 (toRMap defVars) vR REAL /\
bstep f E2 defVars vF m /\ bstep f E2 defVars vF m /\
(!vF m. bstep f E2 defVars vF m ==> abs (vR - vF) <= err)``, (!vF m. bstep f E2 defVars vF m ==> abs (vR - vF) <= err)``,
simp [CertificateCheckerCmd_def] simp [CertificateCheckerCmd_def]
......
hol4/CommandsScript.sml
View file @ 3d6185b5
...@@ -20,7 +20,7 @@ val _ = Datatype ` ...@@ -20,7 +20,7 @@ val _ = Datatype `
val toREvalCmd_def = Define ` val toREvalCmd_def = Define `
toREvalCmd (f:real cmd) : real cmd = toREvalCmd (f:real cmd) : real cmd =
case f of case f of
| Let m x e g => Let M0 x (toREval e) (toREvalCmd g) | Let m x e g => Let REAL x (toREval e) (toREvalCmd g)
| Ret e => Ret (toREval e)`; | Ret e => Ret (toREval e)`;
(** (**
......
hol4/EnvironmentsScript.sml
View file @ 3d6185b5
...@@ -12,7 +12,7 @@ val (approxEnv_rules, approxEnv_ind, approxEnv_cases) = Hol_reln ` ...@@ -12,7 +12,7 @@ val (approxEnv_rules, approxEnv_ind, approxEnv_cases) = Hol_reln `
(!(E1:env) (E2:env) (defVars: num -> mType option) (A:analysisResult) (fVars:num_set) (dVars:num_set) v1 v2 x. (!(E1:env) (E2:env) (defVars: num -> mType option) (A:analysisResult) (fVars:num_set) (dVars:num_set) v1 v2 x.
approxEnv E1 defVars A fVars dVars E2 /\ approxEnv E1 defVars A fVars dVars E2 /\
(defVars x = SOME m) /\ (defVars x = SOME m) /\
(abs (v1 - v2) <= abs v1 * (mTypeToR m)) /\ (abs (v1 - v2) <= computeError v1 m) /\
(lookup x (union fVars dVars) = NONE) ==> (lookup x (union fVars dVars) = NONE) ==>
approxEnv (updEnv x v1 E1) (updDefVars x m defVars) A (insert x () fVars) dVars (updEnv x v2 E2)) /\ approxEnv (updEnv x v1 E1) (updDefVars x m defVars) A (insert x () fVars) dVars (updEnv x v2 E2)) /\
(!(E1:env) (E2:env) (defVars: num -> mType option) (A:analysisResult) (!(E1:env) (E2:env) (defVars: num -> mType option) (A:analysisResult)
...@@ -58,7 +58,7 @@ val approxEnv_fVar_bounded = store_thm ( ...@@ -58,7 +58,7 @@ val approxEnv_fVar_bounded = store_thm (
E2 x = SOME v2 /\ E2 x = SOME v2 /\
x IN (domain fVars) /\ x IN (domain fVars) /\
Gamma x = SOME m ==> Gamma x = SOME m ==>
abs (v - v2) <= (abs v) * (mTypeToR m)``, abs (v - v2) <= computeError v m``,
rpt strip_tac rpt strip_tac
\\ qspec_then \\ qspec_then
`\E1 Gamma absenv fVars dVars E2. `\E1 Gamma absenv fVars dVars E2.
...@@ -67,7 +67,7 @@ val approxEnv_fVar_bounded = store_thm ( ...@@ -67,7 +67,7 @@ val approxEnv_fVar_bounded = store_thm (
E2 x = SOME v2 /\ E2 x = SOME v2 /\
x IN (domain fVars) /\ x IN (domain fVars) /\
Gamma x = SOME m ==> Gamma x = SOME m ==>
abs (v - v2) <= (abs v) * (mTypeToR m)` abs (v - v2) <= computeError v m`
(fn thm => irule (SIMP_RULE std_ss [] thm)) (fn thm => irule (SIMP_RULE std_ss [] thm))
approxEnv_ind approxEnv_ind
\\ rpt strip_tac \\ rpt strip_tac
......
hol4/ErrorBoundsScript.sml
View file @ 3d6185b5
This diff is collapsed.
hol4/ErrorValidationScript.sml
View file @ 3d6185b5
This diff is collapsed.
hol4/ExpressionsScript.sml
View file @ 3d6185b5
...@@ -61,7 +61,7 @@ val evalFma_def = Define ` ...@@ -61,7 +61,7 @@ val evalFma_def = Define `
val toREval_def = Define ` val toREval_def = Define `
(toREval (Var n) = Var n) /\ (toREval (Var n) = Var n) /\
(toREval (Const m n) = Const M0 n) /\ (toREval (Const m n) = Const REAL n) /\
(toREval (Unop u e1) = Unop u (toREval e1)) /\ (toREval (Unop u e1) = Unop u (toREval e1)) /\
(toREval (Binop b e1 e2) = Binop b (toREval e1) (toREval e2)) /\ (toREval (Binop b e1 e2) = Binop b (toREval e1) (toREval e2)) /\
(toREval (Fma e1 e2 e3) = Fma (toREval e1) (toREval e2) (toREval e3)) /\ (toREval (Fma e1 e2 e3) = Fma (toREval e1) (toREval e2) (toREval e3)) /\
...@@ -71,7 +71,9 @@ val toREval_def = Define ` ...@@ -71,7 +71,9 @@ val toREval_def = Define `
Define a perturbation function to ease writing of basic definitions Define a perturbation function to ease writing of basic definitions
**) **)
val perturb_def = Define ` val perturb_def = Define `
perturb (r:real) (e:real) = r * (1 + e)` perturb (rVal:real) (REAL) (delta:real) = rVal /\
perturb rVal (F w f) delta = rVal + delta /\
perturb rVal _ delta = rVal * (1 + delta)`;
(** (**
Define expression evaluation relation parametric by an "error" epsilon. Define expression evaluation relation parametric by an "error" epsilon.
...@@ -80,38 +82,38 @@ using a perturbation of the real valued computation by (1 + delta), where ...@@ -80,38 +82,38 @@ using a perturbation of the real valued computation by (1 + delta), where
|delta| <= machine epsilon. |delta| <= machine epsilon.
**) **)
val (eval_exp_rules, eval_exp_ind, eval_exp_cases) = Hol_reln ` val (eval_exp_rules, eval_exp_ind, eval_exp_cases) = Hol_reln `
(!E defVars m x v. (!E Gamma m x v.
defVars x = SOME m /\ Gamma x = SOME m /\
E x = SOME v ==> E x = SOME v ==>
eval_exp E defVars (Var x) v m) /\ eval_exp E Gamma (Var x) v m) /\
(!E defVars m n delta. (!E Gamma m n delta.
abs delta <= (mTypeToR m) ==> abs delta <= (mTypeToR m) ==>
eval_exp E defVars (Const m n) (perturb n delta) m) /\ eval_exp E Gamma (Const m n) (perturb n m delta) m) /\
(!E defVars m f1 v1. (!E Gamma m f1 v1.
eval_exp E defVars f1 v1 m ==> eval_exp E Gamma f1 v1 m ==>
eval_exp E defVars (Unop Neg f1) (evalUnop Neg v1) m) /\ eval_exp E Gamma (Unop Neg f1) (evalUnop Neg v1) m) /\
(!E defVars m f1 v1 delta. (!E Gamma m f1 v1 delta.
abs delta <= (mTypeToR m) /\ abs delta <= (mTypeToR m) /\
(v1 <> 0) /\ eval_exp E Gamma f1 v1 m /\
eval_exp E defVars f1 v1 m ==> (v1 <> 0) ==>
eval_exp E defVars (Unop Inv f1) (perturb (evalUnop Inv v1) delta) m) /\ eval_exp E Gamma (Unop Inv f1) (perturb (evalUnop Inv v1) m delta) m) /\
(!E defVars m m1 f1 v1 delta. (!E Gamma m m1 f1 v1 delta.
isMorePrecise m1 m /\ isMorePrecise m1 m /\
abs delta <= (mTypeToR m) /\ abs delta <= (mTypeToR m) /\
eval_exp E defVars f1 v1 m1 ==> eval_exp E Gamma f1 v1 m1 ==>
eval_exp E defVars (Downcast m f1) (perturb v1 delta) m) /\ eval_exp E Gamma (Downcast m f1) (perturb v1 m delta) m) /\
(!E defVars m1 m2 b f1 f2 v1 v2 delta. (!E Gamma m1 m2 b f1 f2 v1 v2 delta.
abs delta <= (mTypeToR (join m1 m2)) /\ abs delta <= (mTypeToR (join m1 m2)) /\
eval_exp E defVars f1 v1 m1 /\ eval_exp E Gamma f1 v1 m1 /\
eval_exp E defVars f2 v2 m2 /\ eval_exp E Gamma f2 v2 m2 /\
((b = Div) ==> (v2 <> 0)) ==> ((b = Div) ==> (v2 <> 0)) ==>
eval_exp E defVars (Binop b f1 f2) (perturb (evalBinop b v1 v2) delta) (join m1 m2)) /\ eval_exp E Gamma (Binop b f1 f2) (perturb (evalBinop b v1 v2) (join m1 m2) delta) (join m1 m2)) /\
(!E defVars m1 m2 m3 f1 f2 f3 v1 v2 v3 delta. (!E Gamma m1 m2 m3 f1 f2 f3 v1 v2 v3 delta.
abs delta <= (mTypeToR (join3 m1 m2 m3)) /\ abs delta <= (mTypeToR (join3 m1 m2 m3)) /\
eval_exp E defVars f1 v1 m1 /\ eval_exp E Gamma f1 v1 m1 /\
eval_exp E defVars f2 v2 m2 /\ eval_exp E Gamma f2 v2 m2 /\
eval_exp E defVars f3 v3 m3 ==> eval_exp E Gamma f3 v3 m3 ==>
eval_exp E defVars (Fma f1 f2 f3) (perturb (evalFma v1 v2 v3) delta) (join3 m1 m2 m3))`; eval_exp E Gamma (Fma f1 f2 f3) (perturb (evalFma v1 v2 v3) (join3 m1 m2 m3) delta) (join3 m1 m2 m3))`;
val eval_exp_cases_old = save_thm ("eval_exp_cases_old", eval_exp_cases); val eval_exp_cases_old = save_thm ("eval_exp_cases_old", eval_exp_cases);
...@@ -145,7 +147,7 @@ val Const_dist' = store_thm ( ...@@ -145,7 +147,7 @@ val Const_dist' = store_thm (
"Const_dist'", "Const_dist'",
``!m n delta v m' E Gamma. ``!m n delta v m' E Gamma.
(abs delta) <= (mTypeToR m) /\ (abs delta) <= (mTypeToR m) /\
v = perturb n delta /\ v = perturb n m delta /\
m' = m ==> m' = m ==>
eval_exp E Gamma (Const m n) v m'``, eval_exp E Gamma (Const m n) v m'``,
fs [Const_dist]); fs [Const_dist]);
...@@ -165,7 +167,7 @@ val Unop_inv' = store_thm ( ...@@ -165,7 +167,7 @@ val Unop_inv' = store_thm (
(abs delta) <= (mTypeToR m) /\ (abs delta) <= (mTypeToR m) /\
eval_exp E Gamma f1 v1 m /\ eval_exp E Gamma f1 v1 m /\
(v1 <> 0) /\ (v1 <> 0) /\
v = perturb (evalUnop Inv v1) delta /\ v = perturb (evalUnop Inv v1) m delta /\
m' = m ==> m' = m ==>
eval_exp E Gamma (Unop Inv f1) v m'``, eval_exp E Gamma (Unop Inv f1) v m'``,
fs [Unop_inv]); fs [Unop_inv]);
...@@ -175,7 +177,7 @@ val Downcast_dist' = store_thm ("Downcast_dist'", ...@@ -175,7 +177,7 @@ val Downcast_dist' = store_thm ("Downcast_dist'",
isMorePrecise m1 m /\ isMorePrecise m1 m /\
(abs delta) <= (mTypeToR m) /\ (abs delta) <= (mTypeToR m) /\
eval_exp E Gamma f1 v1 m1 /\ eval_exp E Gamma f1 v1 m1 /\
v = perturb v1 delta /\ v = perturb v1 m delta /\
m' = m ==> m' = m ==>
eval_exp E Gamma (Downcast m f1) v m'``, eval_exp E Gamma (Downcast m f1) v m'``,
rpt strip_tac rpt strip_tac
...@@ -189,7 +191,7 @@ val Binop_dist' = store_thm ("Binop_dist'", ...@@ -189,7 +191,7 @@ val Binop_dist' = store_thm ("Binop_dist'",
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)) /\ ((op = Div) ==> (v2 <> 0)) /\
v = perturb (evalBinop op v1 v2) delta /\ v = perturb (evalBinop op v1 v2) m' delta /\
m' = join m1 m2 ==> m' = join m1 m2 ==>
eval_exp E Gamma (Binop op f1 f2) v m'``, eval_exp E Gamma (Binop op f1 f2) v m'``,
fs [Binop_dist]); fs [Binop_dist]);
...@@ -200,7 +202,7 @@ val Fma_dist' = store_thm ("Fma_dist'", ...@@ -200,7 +202,7 @@ val Fma_dist' = store_thm ("Fma_dist'",
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 /\
eval_exp E Gamma f3 v3 m3 /\ eval_exp E Gamma f3 v3 m3 /\
v = perturb (evalFma v1 v2 v3) delta /\ v = perturb (evalFma v1 v2 v3) m' delta /\
m' = join3 m1 m2 m3 ==> m' = join3 m1 m2 m3 ==>
eval_exp E Gamma (Fma f1 f2 f3) v m'``, eval_exp E Gamma (Fma f1 f2 f3) v m'``,
fs [Fma_dist]); fs [Fma_dist]);
...@@ -222,35 +224,40 @@ val usedVars_def = Define ` ...@@ -222,35 +224,40 @@ val usedVars_def = Define `
(** (**
If |delta| <= 0 then perturb v delta is exactly v. If |delta| <= 0 then perturb v delta is exactly v.
**) **)
val delta_0_deterministic = store_thm("delta_0_deterministic", val delta_0_deterministic = store_thm(
``!(v:real) (delta:real). abs delta <= 0 ==> perturb v delta = v``, "delta_0_deterministic",
``!(v:real) (m:mType) (delta:real).
abs delta <= 0 ==> perturb v m delta = v``,
Cases_on `m` \\
fs [perturb_def,ABS_BOUNDS,REAL_LE_ANTISYM]); fs [perturb_def,ABS_BOUNDS,REAL_LE_ANTISYM]);
val delta_M0_deterministic = store_thm("delta_M0_deterministic", val delta_REAL_deterministic = store_thm(
``!(v:real) (delta:real). abs delta <= mTypeToR M0 ==> perturb v delta = v``, "delta_REAL_deterministic",
fs [mTypeToR_def,perturb_def,ABS_BOUNDS,REAL_LE_ANTISYM]); ``!(v:real) (m:mType) (delta:real).
abs delta <= mTypeToR REAL ==> perturb v m delta = v``,
Cases_on `m` \\ fs[mTypeToR_def, delta_0_deterministic]);
val toRMap_def = Define ` val toRMap_def = Define `
toRMap (d:num -> mType option) (n:num) : mType option = toRMap (d:num -> mType option) (n:num) : mType option =
case d n of case d n of
| SOME m => SOME M0 | SOME m => SOME REAL
| NONE => NONE`; | NONE => NONE`;
val toRMap_eval_M0 = store_thm ( val toRMap_eval_REAL = store_thm (
"toRMap_eval_M0", "toRMap_eval_REAL",
``!f v E Gamma m. ``!f v E Gamma m.
eval_exp E (toRMap Gamma) (toREval f) v m ==> m = M0``, eval_exp E (toRMap Gamma) (toREval f) v m ==> m = REAL``,
Induct \\ fs[toREval_def] \\ fs[eval_exp_cases, toRMap_def] Induct \\ fs[toREval_def] \\ fs[eval_exp_cases, toRMap_def]
\\ rpt strip_tac \\ fs[] \\ rpt strip_tac \\ fs[]
>- (every_case_tac \\ fs[]) >- (every_case_tac \\ fs[])
>- (rveq \\ first_x_assum drule \\ strip_tac \\ fs[]) >- (rveq \\ first_x_assum drule \\ strip_tac \\ fs[])
>- (rveq \\ first_x_assum drule \\ strip_tac \\ fs[]) >- (rveq \\ first_x_assum drule \\ strip_tac \\ fs[])
>- (`m1 = M0` by (rpt (first_x_assum drule \\ strip_tac) \\ fs[]) >- (`m1 = REAL` by (rpt (first_x_assum drule \\ strip_tac) \\ fs[])
\\ `m2 = M0` by (rpt (first_x_assum drule \\ strip_tac) \\ fs[]) \\ `m2 = REAL` by (rpt (first_x_assum drule \\ strip_tac) \\ fs[])
\\ rveq \\ fs[join_def]) \\ rveq \\ fs[join_def])
>- (`m1 = M0` by (rpt (first_x_assum drule \\ strip_tac) \\ fs[]) >- (`m1 = REAL` by (rpt (first_x_assum drule \\ strip_tac) \\ fs[])
\\ `m2 = M0` by (rpt (first_x_assum drule \\ strip_tac) \\ fs[]) \\ `m2 = REAL` by (rpt (first_x_assum drule \\ strip_tac) \\ fs[])
\\ `m3 = M0` by (rpt (first_x_assum drule \\ strip_tac) \\ fs[]) \\ `m3 = REAL` by (rpt (first_x_assum drule \\ strip_tac) \\ fs[])
\\ rveq \\ fs[join3_def] \\ fs[join_def])); \\ rveq \\ fs[join3_def] \\ fs[join_def]));
(** (**
...@@ -258,8 +265,8 @@ Evaluation with 0 as machine epsilon is deterministic ...@@ -258,8 +265,8 @@ Evaluation with 0 as machine epsilon is deterministic
**) **)
val meps_0_deterministic = store_thm("meps_0_deterministic", val meps_0_deterministic = store_thm("meps_0_deterministic",
``!(f: real exp) v1:real v2:real E defVars. ``!(f: real exp) v1:real v2:real E defVars.
eval_exp E (toRMap defVars) (toREval f) v1 M0 /\ eval_exp E (toRMap defVars) (toREval f) v1 REAL /\
eval_exp E (toRMap defVars) (toREval f) v2 M0 ==> eval_exp E (toRMap defVars) (toREval f) v2 REAL ==>
v1 = v2``, v1 = v2``,
Induct_on `f` Induct_on `f`
>- (rw [toREval_def] \\ fs [eval_exp_cases]) >- (rw [toREval_def] \\ fs [eval_exp_cases])
...@@ -279,13 +286,13 @@ val meps_0_deterministic = store_thm("meps_0_deterministic", ...@@ -279,13 +286,13 @@ val meps_0_deterministic = store_thm("meps_0_deterministic",
qpat_x_assum `eval_exp _ _ (toREval _) _ _` qpat_x_assum `eval_exp _ _ (toREval _) _ _`
(fn thm => assume_tac (ONCE_REWRITE_RULE [toREval_def] thm))) (fn thm => assume_tac (ONCE_REWRITE_RULE [toREval_def] thm)))
\\ Cases_on `b` \\ fs [eval_exp_cases] \\ Cases_on `b` \\ fs [eval_exp_cases]
\\ `m1 = M0 /\ m2 = M0` by (conj_tac \\ irule toRMap_eval_M0 \\ asm_exists_tac \\ fs []) \\ `m1 = REAL /\ m2 = REAL` by (conj_tac \\ irule toRMap_eval_REAL \\ asm_exists_tac \\ fs [])
\\ rw[] \\ rw[]
\\ rename1 `eval_exp E _ (toREval f1) vf11 M0` \\ rename1 `eval_exp E _ (toREval f1) vf11 REAL`
\\ rename1 `eval_exp E _ (toREval f1) vf12 m1` \\ rename1 `eval_exp E _ (toREval f1) vf12 m1`
\\ rename1 `eval_exp E _ (toREval f2) vf21 M0` \\ rename1 `eval_exp E _ (toREval f2) vf21 REAL`
\\ rename1 `eval_exp _ _ (toREval f2) vf22 m2` \\ rename1 `eval_exp _ _ (toREval f2) vf22 m2`
\\ `m1 = M0 /\ m2 = M0` by (conj_tac \\ irule toRMap_eval_M0 \\ asm_exists_tac \\ fs []) \\ `m1 = REAL /\ m2 = REAL` by (conj_tac \\ irule toRMap_eval_REAL \\ asm_exists_tac \\ fs [])
\\ rw [] \\ rw []
\\ fs [join_def, mTypeToR_def, delta_0_deterministic] \\ fs [join_def, mTypeToR_def, delta_0_deterministic]
\\ qpat_x_assum `!v1 v2 E defVars. _ /\ _ ==> v1 = v2` (fn thm =>qspecl_then [`vf21`,`vf22`] ASSUME_TAC thm) \\ qpat_x_assum `!v1 v2 E defVars. _ /\ _ ==> v1 = v2` (fn thm =>qspecl_then [`vf21`,`vf22`] ASSUME_TAC thm)
...@@ -297,10 +304,10 @@ val meps_0_deterministic = store_thm("meps_0_deterministic", ...@@ -297,10 +304,10 @@ val meps_0_deterministic = store_thm("meps_0_deterministic",
qpat_x_assum `eval_exp _ _ (toREval _) _ _` qpat_x_assum `eval_exp _ _ (toREval _) _ _`
(fn thm => assume_tac (ONCE_REWRITE_RULE [toREval_def] thm))) (fn thm => assume_tac (ONCE_REWRITE_RULE [toREval_def] thm)))
\\ fs [eval_exp_cases] \\ fs [eval_exp_cases]
\\ `m1 = M0 /\ m2 = M0` by (conj_tac \\ irule toRMap_eval_M0 \\ asm_exists_tac \\ fs []) \\ `m1 = REAL /\ m2 = REAL` by (conj_tac \\ irule toRMap_eval_REAL \\ asm_exists_tac \\ fs [])
\\ `m3 = M0` by (irule toRMap_eval_M0 \\ asm_exists_tac \\ fs []) \\ `m3 = REAL` by (irule toRMap_eval_REAL \\ asm_exists_tac \\ fs [])
\\ `m1' = M0 /\ m2' = M0` by (conj_tac \\ irule toRMap_eval_M0 \\ asm_exists_tac \\ fs []) \\ `m1' = REAL /\ m2' = REAL` by (conj_tac \\ irule toRMap_eval_REAL \\ asm_exists_tac \\ fs [])
\\ `m3' = M0` by (irule toRMap_eval_M0 \\ asm_exists_tac \\ fs []) \\ `m3' = REAL` by (irule toRMap_eval_REAL \\ asm_exists_tac \\ fs [])
\\ rw[] \\ rw[]
\\ qpat_x_assum `!v1 v2 E defVars. _ /\ _ ==> v1 = v2` (fn thm =>qspecl_then [`v3`,`v3'`, `E`, `defVars`] ASSUME_TAC thm) \\ qpat_x_assum `!v1 v2 E defVars. _ /\ _ ==> v1 = v2` (fn thm =>qspecl_then [`v3`,`v3'`, `E`, `defVars`] ASSUME_TAC thm)
\\ qpat_x_assum `!v1 v2 E defVars. _ /\ _ ==> v1 = v2` (fn thm =>qspecl_then [`v2'`,`v2''`, `E`, `defVars`] ASSUME_TAC thm) \\ qpat_x_assum `!v1 v2 E defVars. _ /\ _ ==> v1 = v2` (fn thm =>qspecl_then [`v2'`,`v2''`, `E`, `defVars`] ASSUME_TAC thm)
...@@ -325,10 +332,10 @@ val binary_unfolding = store_thm("binary_unfolding", ...@@ -325,10 +332,10 @@ val binary_unfolding = store_thm("binary_unfolding",
(abs delta) <= (mTypeToR (join m1 m2)) /\ (abs delta) <= (mTypeToR (join m1 m2)) /\
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 /\
eval_exp E Gamma (Binop b f1 f2) (perturb (evalBinop b v1 v2) delta) (join m1 m2) ==> eval_exp E Gamma (Binop b f1 f2) (perturb (evalBinop b v1 v2) (join m1 m2) delta) (join m1 m2) ==>
eval_exp (updEnv 2 v2 (updEnv 1 v1 emptyEnv)) eval_exp (updEnv 2 v2 (updEnv 1 v1 emptyEnv))
(updDefVars 2 m2 (updDefVars 1 m1 Gamma)) (updDefVars 2 m2 (updDefVars 1 m1 Gamma))
(Binop b (Var 1) (Var 2)) (perturb (evalBinop b v1 v2) delta) (join m1 m2)``, (Binop b (Var 1) (Var 2)) (perturb (evalBinop b v1 v2) (join m1 m2) delta) (join m1 m2)``,
fs [updEnv_def,updDefVars_def,join_def,eval_exp_cases,APPLY_UPDATE_THM,PULL_EXISTS] fs [updEnv_def,updDefVars_def,join_def,eval_exp_cases,APPLY_UPDATE_THM,PULL_EXISTS]
\\ metis_tac []); \\ metis_tac []);
...@@ -338,10 +345,10 @@ val fma_unfolding = store_thm("fma_unfolding", ...@@ -338,10 +345,10 @@ val fma_unfolding = store_thm("fma_unfolding",
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 /\
eval_exp E Gamma f3 v3 m3 /\ eval_exp E Gamma f3 v3 m3 /\
eval_exp E Gamma (Fma f1 f2 f3) (perturb (evalFma v1 v2 v3) delta) (join3 m1 m2 m3) ==> eval_exp E Gamma (Fma f1 f2 f3) (perturb (evalFma v1 v2 v3) (join3 m1 m2 m3) delta) (join3 m1 m2 m3) ==>
eval_exp (updEnv 3 v3 (updEnv 2 v2 (updEnv 1 v1 emptyEnv))) eval_exp (updEnv 3 v3 (updEnv 2 v2 (updEnv 1 v1 emptyEnv)))
(updDefVars 3 m3 (updDefVars 2 m2 (updDefVars 1 m1 Gamma))) (updDefVars 3 m3 (updDefVars 2 m2 (updDefVars 1 m1 Gamma)))
(Fma (Var 1) (Var 2) (Var 3)) (perturb (evalFma v1 v2 v3) delta) (join3 m1 m2 m3)``, (Fma (Var 1) (Var 2) (Var 3)) (perturb (evalFma v1 v2 v3) (join3 m1 m2 m3) delta) (join3 m1 m2 m3)``,
fs [updEnv_def,updDefVars_def,join3_def,join_def,eval_exp_cases,APPLY_UPDATE_THM,PULL_EXISTS] fs [updEnv_def,updDefVars_def,join3_def,join_def,eval_exp_cases,APPLY_UPDATE_THM,PULL_EXISTS]
\\ rpt strip_tac \\ rpt strip_tac
\\ qexists_tac `delta'` \\ qexists_tac `delta'`
......
hol4/FPRangeValidatorScript.sml
View file @ 3d6185b5
...@@ -150,7 +150,7 @@ val FPRangeValidator_sound = store_thm ( ...@@ -150,7 +150,7 @@ val FPRangeValidator_sound = store_thm (
\\ disch_then drule \\ fs[]) \\ disch_then drule \\ fs[])
\\ once_rewrite_tac [validFloatValue_def] \\ once_rewrite_tac [validFloatValue_def]
\\ `?iv err vR. FloverMapTree_find e A = SOME (iv, err) /\ \\ `?iv err vR. FloverMapTree_find e A = SOME (iv, err) /\
eval_exp E1 (toRMap Gamma) (toREval e) vR M0 /\ eval_exp E1 (toRMap Gamma) (toREval e) vR REAL /\
FST iv <= vR /\ vR <= SND iv` FST iv <= vR /\ vR <= SND iv`
by (drule validIntervalbounds_sound by (drule validIntervalbounds_sound
\\ disch_then (qspecl_then [`fVars`, `E1`, `Gamma`] impl_subgoal_tac) \\ disch_then (qspecl_then [`fVars`, `E1`, `Gamma`] impl_subgoal_tac)
...@@ -256,7 +256,7 @@ val FPRangeValidatorCmd_sound = store_thm ( ...@@ -256,7 +256,7 @@ val FPRangeValidatorCmd_sound = store_thm (
\\ rpt strip_tac \\ rpt strip_tac
\\ metis_tac[]) \\ metis_tac[])
>- (irule swap_Gamma_bstep >- (irule swap_Gamma_bstep
\\ qexists_tac `updDefVars n M0 (toRMap Gamma)` \\ fs[] \\ qexists_tac `updDefVars n REAL (toRMap Gamma)` \\ fs[]
\\ fs [updDefVars_def, REWRITE_RULE [updDefVars_def] Rmap_updVars_comm]) \\ fs [updDefVars_def, REWRITE_RULE [updDefVars_def] Rmap_updVars_comm])
>- (fs[DIFF_DEF, domain_insert, SUBSET_DEF] >- (fs[DIFF_DEF, domain_insert, SUBSET_DEF]
\\ rpt strip_tac \\ first_x_assum irule \\ rpt strip_tac \\ first_x_assum irule
......
hol4/IEEE_connectionScript.sml
View file @ 3d6185b5
...@@ -51,7 +51,7 @@ val bstep_float_def = Define ` ...@@ -51,7 +51,7 @@ val bstep_float_def = Define `
val normal_or_zero_def = Define ` val normal_or_zero_def = Define `
normal_or_zero (v:real) = normal_or_zero (v:real) =
(minValue M64 <= abs v \/ v = 0)`; (minValue_pos M64 <= abs v \/ v = 0)`;
val isValid_def = Define ` val isValid_def = Define `
isValid e = isValid e =
...@@ -155,7 +155,7 @@ val normalValue_implies_normalization = store_thm ("validFloatValue_implies_norm ...@@ -155,7 +155,7 @@ val normalValue_implies_normalization = store_thm ("validFloatValue_implies_norm
normal v M64 ==> normal v M64 ==>
normalizes (:52 #11) v``, normalizes (:52 #11) v``,
rpt strip_tac rpt strip_tac
\\ fs[normal_def, normalizes_def, wordsTheory.INT_MAX_def, minValue_def, \\ fs[normal_def, normalizes_def, wordsTheory.INT_MAX_def, minValue_pos_def,
minExponentPos_def, wordsTheory.INT_MIN_def, wordsTheory.dimindex_11, minExponentPos_def, wordsTheory.INT_MIN_def, wordsTheory.dimindex_11,
wordsTheory.UINT_MAX_def, wordsTheory.dimword_11] wordsTheory.UINT_MAX_def, wordsTheory.dimword_11]
\\ irule REAL_LET_TRANS \\ irule REAL_LET_TRANS
...@@ -179,11 +179,11 @@ val denormalValue_implies_finiteness = store_thm ("normalValue_implies_finitenes ...@@ -179,11 +179,11 @@ val denormalValue_implies_finiteness = store_thm ("normalValue_implies_finitenes
\\ fs [real_to_float_def, denormal_def, dmode_def] \\ fs [real_to_float_def, denormal_def, dmode_def]
\\ irule float_round_finite \\ irule float_round_finite
\\ irule REAL_LT_TRANS \\ irule REAL_LT_TRANS
\\ qexists_tac `minValue M64` \\ fs[] \\ qexists_tac `minValue_pos M64` \\ fs[]
\\ irule REAL_LET_TRANS \\ qexists_tac `maxValue M64` \\ irule REAL_LET_TRANS \\ qexists_tac `maxValue M64`
\\ `minValue M64 <= 1` \\ `minValue_pos M64 <= 1`
by (once_rewrite_tac [GSYM REAL_INV1] by (once_rewrite_tac [GSYM REAL_INV1]
\\ fs[minValue_def, minExponentPos_def] \\ fs[minValue_pos_def, minExponentPos_def]
\\ irule REAL_INV_LE_ANTIMONO_IMPR \\ fs[]) \\ irule REAL_INV_LE_ANTIMONO_IMPR \\ fs[])
\\ fs[threshold_64_bit_lt_maxValue] \\ fs[threshold_64_bit_lt_maxValue]
\\ irule REAL_LE_TRANS \\ qexists_tac `1` \\ irule REAL_LE_TRANS \\ qexists_tac `1`
...@@ -198,7 +198,7 @@ val normal_value_is_float_value = store_thm ( ...@@ -198,7 +198,7 @@ val normal_value_is_float_value = store_thm (
\\rewrite_tac[float_value_def] \\rewrite_tac[float_value_def]
\\rw_thm_asm `normal _ _` normal_def \\rw_thm_asm `normal _ _` normal_def
\\fs[float_to_real_def] \\fs[float_to_real_def]
\\ every_case_tac \\ fs[maxValue_def, maxExponent_def, minValue_def, minExponentPos_def] \\ every_case_tac \\ fs[maxValue_def, maxExponent_def, minValue_pos_def, minExponentPos_def]
>-( Cases_on `ff.Sign` \\ fs[] >-( Cases_on `ff.Sign` \\ fs[]
\\ Cases_on `n` \\ fs[] \\ Cases_on `n` \\ fs[]
\\ Cases_on `n'` \\ fs[]) \\ Cases_on `n'` \\ fs[])
...@@ -275,7 +275,7 @@ val denormal_value_is_float_value = store_thm ("denormal_value_is_float_value", ...@@ -275,7 +275,7 @@ val denormal_value_is_float_value = store_thm ("denormal_value_is_float_value",
\\ `w2n (-1w:word11) = 2047` by EVAL_TAC \\ `w2n (-1w:word11) = 2047` by EVAL_TAC
\\ `w2n c0 = 2047` by fs[] \\ `w2n c0 = 2047` by fs[]
\\ fs[] \\ fs[]
\\ TOP_CASE_TAC \\ fs[minValue_def, minExponentPos_def] \\ TOP_CASE_TAC \\ fs[minValue_pos_def, minExponentPos_def]
\\ fs[REAL_ABS_MUL, POW_M1] \\ fs[REAL_ABS_MUL, POW_M1]
>- (`44942328371557897693232629769725618340449424473557664318357520289433168951375240783177119330601884005280028469967848339414697442203604155623211857659868531094441973356216371319075554900311523529863270738021251442209537670585615720368478277635206809290837627671146574559986811484619929076208839082406056034304⁻¹ <= inv 1` >- (`44942328371557897693232629769725618340449424473557664318357520289433168951375240783177119330601884005280028469967848339414697442203604155623211857659868531094441973356216371319075554900311523529863270738021251442209537670585615720368478277635206809290837627671146574559986811484619929076208839082406056034304⁻¹ <= inv 1`
by (irule REAL_INV_LE_ANTIMONO_IMPR \\ fs[]) by (irule REAL_INV_LE_ANTIMONO_IMPR \\ fs[])
...@@ -638,7 +638,7 @@ val eval_exp_gives_IEEE = store_thm ("eval_exp_gives_IEEE", ...@@ -638,7 +638,7 @@ val eval_exp_gives_IEEE = store_thm ("eval_exp_gives_IEEE",
\\ fs[eval_exp_float_def, optionLift_def] \\ fs[eval_exp_float_def, optionLift_def]
\\ Cases_on `E2 n` \\ fs[optionLift_def, normal_or_zero_def]) \\ Cases_on `E2 n` \\ fs[optionLift_def, normal_or_zero_def])
>- (rveq \\ fs[eval_exp_cases] >- (rveq \\ fs[eval_exp_cases]
\\ fs[optionLift_def, normal_or_zero_def, minValue_def, \\ fs[optionLift_def, normal_or_zero_def, minValue_pos_def,
minExponentPos_def, REAL_LT_INV_EQ] minExponentPos_def, REAL_LT_INV_EQ]
\\ qexists_tac `0:real` \\ qexists_tac `0:real`
\\ fs[mTypeToR_pos, perturb_def, fp64_to_float_float_to_fp64, \\ fs[mTypeToR_pos, perturb_def, fp64_to_float_float_to_fp64,
...@@ -721,7 +721,7 @@ val eval_exp_gives_IEEE = store_thm ("eval_exp_gives_IEEE", ...@@ -721,7 +721,7 @@ val eval_exp_gives_IEEE = store_thm ("eval_exp_gives_IEEE",
\\ rename1 `eval_exp_float e1 _ = SOME vF1` \\ rename1 `eval_exp_float e1 _ = SOME vF1`
\\ rename1 `eval_exp_float e2 _ = SOME vF2` \\ rename1 `eval_exp_float e2 _ = SOME vF2`
\\ `?iv err nR2. FloverMapTree_find (toRExp e2) A = SOME (iv, err) /\ \\ `?iv err nR2. FloverMapTree_find (toRExp e2) A = SOME (iv, err) /\
eval_exp E1 (toRMap Gamma) (toREval (toRExp e2)) nR2 M0 /\ eval_exp E1 (toRMap Gamma) (toREval (toRExp e2)) nR2 REAL /\
FST iv <= nR2 /\ nR2 <= SND iv` FST iv <= nR2 /\ nR2 <= SND iv`
by (irule validIntervalbounds_sound by (irule validIntervalbounds_sound
\\ qexistsl_tac [`P`, `dVars`, `fVars`] \\ qexistsl_tac [`P`, `dVars`, `fVars`]
...@@ -769,24 +769,23 @@ val eval_exp_gives_IEEE = store_thm ("eval_exp_gives_IEEE", ...@@ -769,24 +769,23 @@ val eval_exp_gives_IEEE = store_thm ("eval_exp_gives_IEEE",
\\ `validFloatValue \\ `validFloatValue
(evalBinop b (float_to_real (fp64_to_float vF1)) (evalBinop b (float_to_real (fp64_to_float vF1))
(float_to_real (fp64_to_float vF2))) M64` (float_to_real (fp64_to_float vF2))) M64`
by (drule FPRangeValidator_sound by (drule FPRangeValidator_sound
\\ disch_then \\ disch_then
(qspecl_then (qspecl_then
[`(Binop b (toRExp e1) (toRExp e2))`, [`(Binop b (toRExp e1) (toRExp e2))`,
`evalBinop b (float_to_real (fp64_to_float vF1)) `evalBinop b (float_to_real (fp64_to_float vF1))
(float_to_real (fp64_to_float vF2))`, (float_to_real (fp64_to_float vF2))`,
`M64`, `tMap`, `P`] irule) `M64`, `tMap`, `P`] irule)
\\ fs[] \\ fs[]
\\ qexistsl_tac [`P`, `e1`, `e2`, `tMap`] \\ qexistsl_tac [`P`, `e1`, `e2`, `tMap`]
\\ fs[] \\ fs[]
\\ irule eval_eq_env \\ irule eval_eq_env
\\ asm_exists_tac \\ fs[eval_exp_cases] \\ asm_exists_tac \\ fs[eval_exp_cases]
\\ rewrite_tac [CONJ_ASSOC] \\ rewrite_tac [CONJ_ASSOC]
\\ rpt (once_rewrite_tac [CONJ_COMM] \\ rpt (once_rewrite_tac [CONJ_COMM] \\ asm_exists_tac \\ fs[])
\\ asm_exists_tac \\ fs[]) \\ qexists_tac ` 0:real`
\\ qexists_tac ` 0:real` \\ Cases_on `b`
\\ Cases_on `b` \\ fs[perturb_def, evalBinop_def, mTypeToR_pos, join_def])
\\ fs[perturb_def, evalBinop_def, mTypeToR_pos, join_def])