Skip to content

GitLab

F
FloVer
Commit 5bbb6b4a authored by Heiko Becker's avatar Heiko Becker
Browse files
Options

Merge branch 'certificates' into 'fma_proofs' 

hol4 FMA proofs

See merge request AVA/daisy!167
parents 423830ed eb84cd10
Hide whitespace changes
Inline Side-by-side
Showing with 1295 additions and 588 deletions
hol4/ErrorBoundsScript.sml
View file @ 5bbb6b4a
......@@ -201,6 +201,52 @@ val div_abs_err_bounded = store_thm ("div_abs_err_bounded",
\\ once_rewrite_tac[REAL_ABS_MUL]
\\ match_mp_tac REAL_LE_MUL2 \\ fs[REAL_ABS_POS]));
val fma_abs_err_bounded = store_thm ("fma_abs_err_bounded",
``!(e1:real exp) (e1R:real) (e1F:real) (e2:real exp) (e2R:real) (e2F:real) (e3:real exp) (e3R:real) (e3F:real) (err1:real) (err2:real) (err3:real)
(vR:real) (vF:real) (E1 E2 :env) (m m1 m2 m3:mType) (defVars: num -> mType option).
eval_exp E1 (toRMap defVars) (toREval e1) e1R M0 /\
eval_exp E2 defVars e1 e1F m1 /\
eval_exp E1 (toRMap defVars) (toREval e2) e2R M0 /\
eval_exp E2 defVars e2 e2F m2 /\
eval_exp E1 (toRMap defVars) (toREval e3) e3R M0 /\
eval_exp E2 defVars e3 e3F m3 /\
eval_exp E1 (toRMap defVars) (toREval (Fma e1 e2 e3)) vR M0 /\
eval_exp (updEnv 3 e3F (updEnv 2 e2F (updEnv 1 e1F emptyEnv))) (updDefVars 3 m3 (updDefVars 2 m2 (updDefVars 1 m1 defVars))) (Fma (Var 1) (Var 2) (Var 3)) vF m /\
abs (e1R - e1F) <= err1 /\
abs (e2R - e2F) <= err2 /\
abs (e3R - e3F) <= err3 ==>
abs (vR - vF) <= abs ((e1R - e1F) + (e2R * e3R - e2F * e3F)) + abs (e1F + e2F * e3F) * (mTypeToQ m)``,
rpt strip_tac
\\ qpat_x_assum `eval_exp E1 _ (toREval (Fma e1 e2 e3)) _ _` (fn thm => assume_tac (ONCE_REWRITE_RULE [toREval_def] thm))
\\ fs []
\\ inversion `eval_exp E1 _ (Fma _ _ _) _ _` eval_exp_cases
\\ rename1 `vR = perturb (evalFma v1R v2R v3R) deltaR`
\\ inversion `eval_exp _ _ (Fma (Var 1) (Var 2) (Var 3)) _ _` eval_exp_cases
\\ rename1 `vF = perturb (evalFma v1F v2F v3F) deltaF`
\\ `(m1' = M0) /\ (m2' = M0) /\ (m3' = M0)` by (rpt conj_tac \\ irule toRMap_eval_M0\\ asm_exists_tac \\ fs[]) \\ fs []
\\ rpt (qpat_x_assum `M0 = _` (fn thm => fs [GSYM thm]))
\\ `perturb (evalFma v1R v2R v3R) deltaR = evalFma v1R v2R v3R` by (match_mp_tac delta_M0_deterministic \\ fs[])
\\ `vR = evalFma v1R v2R v3R` by simp[]
\\ `v1R = e1R` by metis_tac[meps_0_deterministic]
\\ `v2R = e2R` by metis_tac[meps_0_deterministic]
\\ `v3R = e3R` by metis_tac[meps_0_deterministic]
\\ fs[evalFma_def, evalBinop_def, perturb_def]
\\ rpt (inversion `eval_exp (updEnv 3 e3F (updEnv 2 e2F (updEnv 1 e1F emptyEnv))) _ _ _ _` eval_exp_cases)
\\ fs [updEnv_def] \\ rveq
\\ fs [updDefVars_def] \\ rveq
\\ rewrite_tac [real_sub]
\\ `e1R + e2R * e3R + -((e1F + e2F * e3F) * (1 + deltaF)) = (e1R + e2R * e3R + -(e1F + e2F * e3F)) + (- (e1F + e2F * e3F) * deltaF)` by REAL_ASM_ARITH_TAC
\\ simp[]
\\ qspecl_then [`abs (e1R + e2R * e3R + -(e1F + e2F * e3F)) + abs (-(e1F + e2F * e3F) * deltaF)`] match_mp_tac real_le_trans2
\\ conj_tac
>- (REAL_ASM_ARITH_TAC)
>- (match_mp_tac REAL_LE_ADD2
\\ conj_tac \\ TRY (REAL_ASM_ARITH_TAC)
\\ once_rewrite_tac[REAL_ABS_MUL]
\\ match_mp_tac REAL_LE_MUL2 \\ fs[REAL_ABS_POS]
\\ once_rewrite_tac[GSYM REAL_NEG_LMUL, REAL_ABS_MUL]
\\ once_rewrite_tac[ABS_NEG] \\ fs[]));
val round_abs_err_bounded = store_thm ("round_abs_err_bounded",
``!(e:real exp) (nR:real) (nF1:real) (nF:real) (E1:env) (E2:env) (err:real) (machineEpsilon:mType) (m:mType) (defVars: num -> mType option).
eval_exp E1 (toRMap defVars) (toREval e) nR M0 /\
......
hol4/ErrorValidationScript.sml
View file @ 5bbb6b4a
......@@ -55,6 +55,23 @@ val validErrorbound_def = Define `
((upperBoundE1 * errInv + upperBoundInvE2 * err1 + err1 * errInv) + (maxAbs (divideInterval errIve1 errIve2) * (mTypeToQ m)) <= err)
else F)
else F)
| Fma f1 f2 f3 =>
(if (validErrorbound f1 typeMap absenv dVars /\
validErrorbound f2 typeMap absenv dVars /\
validErrorbound f3 typeMap absenv dVars) then
let (ive1, err1) = absenv f1 in
let (ive2, err2) = absenv f2 in
let (ive3, err3) = absenv f3 in
let errIve1 = widenInterval ive1 err1 in
let errIve2 = widenInterval ive2 err2 in
let errIve3 = widenInterval ive3 err3 in
let upperBoundE1 = maxAbs ive1 in
let upperBoundE2 = maxAbs ive2 in
let upperBoundE3 = maxAbs ive3 in
let errIntv_prod = multInterval errIve2 errIve3 in
let mult_error_bound = (upperBoundE2 * err3 + upperBoundE3 * err2 + err2 * err3) in
(err1 + mult_error_bound + (maxAbs (addInterval errIve1 errIntv_prod)) * (mTypeToQ m)) <= err
else F)
| Downcast m1 e1 =>
let (ive1, err1) = absenv e1 in
let rec_res = validErrorbound e1 typeMap absenv dVars in
......@@ -85,6 +102,7 @@ val err_always_positive = store_thm (
>- (Cases_on `tmap (Const m v)` \\ fs [])
>- (Cases_on `tmap (Unop u e')` \\ fs [])
>- (Cases_on `tmap (Binop b e' e0)` \\ fs [])
>- (Cases_on `tmap (Fma e' e0 e1)` \\ fs [])
>- (Cases_on `tmap (Downcast m e')` \\ fs []));
val validErrorboundCorrectVariable_eval = store_thm (
......@@ -362,6 +380,597 @@ val validErrorboundCorrectSubtraction = store_thm ("validErrorboundCorrectSubtra
\\ rule_assum_tac (fn thm => REWRITE_RULE [contained_def, IVlo_def, IVhi_def] thm)
\\ simp[]));
val multiplicationErroBounded = store_thm ("multiplicationErrorBounded",
``!(nR1 nR2 nF1 nF2: real) (err1 err2: real) (e1lo e1hi e2lo e2hi: real).
e1lo ≤ nR1 /\
nR1 ≤ e1hi /\
e2lo ≤ nR2 /\
nR2 ≤ e2hi /\
abs (nR1 − nF1) ≤ err1 /\
abs (nR2 − nF2) ≤ err2 /\
0 ≤ err1 /\
0 ≤ err2 ==>
abs (nR1 * nR2 − nF1 * nF2) ≤
maxAbs (e1lo,e1hi) * err2 + maxAbs (e2lo,e2hi) * err1 + err1 * err2``,
(rpt strip_tac
\\`nR1 <= maxAbs (e1lo, e1hi)`
by (match_mp_tac contained_leq_maxAbs_val
\\ fs[contained_def, IVlo_def, IVhi_def])
\\ `nR2 <= maxAbs (e2lo, e2hi)`
by (match_mp_tac contained_leq_maxAbs_val
\\ fs[contained_def, IVlo_def, IVhi_def])
\\`-nR1 <= maxAbs (e1lo, e1hi)`
by (match_mp_tac contained_leq_maxAbs_neg_val
\\ fs[contained_def, IVlo_def, IVhi_def])
\\ `-nR2 <= maxAbs (e2lo, e2hi)`
by (match_mp_tac contained_leq_maxAbs_neg_val
\\ fs[contained_def, IVlo_def, IVhi_def])
\\ `nR1 * err2 <= maxAbs (e1lo, e1hi) * err2`
by (match_mp_tac REAL_LE_RMUL_IMP \\ fs[])
\\ `-nR1 * err2 <= maxAbs (e1lo, e1hi) * err2`
by (match_mp_tac REAL_LE_RMUL_IMP \\ fs[])
\\ `nR2 * err1 <= maxAbs (e2lo, e2hi) * err1`
by (match_mp_tac REAL_LE_RMUL_IMP \\ fs[])
\\ `-nR2 * err1 <= maxAbs (e2lo, e2hi) * err1`
by (match_mp_tac REAL_LE_RMUL_IMP \\ fs[])
\\ `- (err1 * err2) <= err1 * err2`
by (fs[REAL_NEG_LMUL] \\ match_mp_tac REAL_LE_RMUL_IMP \\ REAL_ASM_ARITH_TAC)
\\ `0 <= maxAbs (e1lo, e1hi) * err2` by REAL_ASM_ARITH_TAC
\\ `maxAbs (e1lo, e1hi) * err2 <= maxAbs (e1lo, e1hi) * err2 + maxAbs (e2lo, e2hi) * err1`
by REAL_ASM_ARITH_TAC
\\ `maxAbs (e1lo, e1hi) * err2 + maxAbs (e2lo, e2hi) * err1 <=
maxAbs (e1lo, e1hi) * err2 + maxAbs (e2lo, e2hi) * err1 + err1 * err2`
by REAL_ASM_ARITH_TAC
\\ rpt (qpat_x_assum `eval_exp _ _ _ _ _` kall_tac)
\\ rpt (qpat_x_assum `validErrorbound _ _` kall_tac)
\\ `! (x:real). ((abs x = x) /\ 0 < x) \/ ((abs x = - x) /\ x <= 0)` by REAL_ASM_ARITH_TAC
(* Large case distinction for
a) different cases of the value of Rabs (...) and
b) wether arguments of multiplication in (nf1 * nF2) are < or >= 0 *)
\\ qpat_assum `!x. (A /\ B) \/ C` (fn thm => qspecl_then [`nR1 - nF1` ] DISJ_CASES_TAC thm)
\\ qpat_assum `!x. (A /\ B) \/ C` (fn thm => qspecl_then [`nR2 - nF2` ] DISJ_CASES_TAC thm)
\\ fs[]
\\ rpt (qpat_x_assum `abs _ = _` (fn thm => RULE_ASSUM_TAC (fn thm2 => ONCE_REWRITE_RULE [thm] thm2)))
(* All positive *)
>- (`nF1 <= nR1 + err1` by (match_mp_tac err_up \\ simp[])
\\ `nF2 <= nR2 + err2` by (match_mp_tac err_up \\ simp[])
\\ qpat_assum `!x. (A /\ B) \/ C`
(fn thm => qspecl_then [`nR1 * nR2 - nF1 * nF2` ] DISJ_CASES_TAC thm)
\\ fs[real_sub]
(* Absolute value positive *)
>-(qspecl_then [`nF1`, `0`] DISJ_CASES_TAC REAL_LTE_TOTAL
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `nR1 * nR2 + nF1 * (- (nR2 + err2))` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ match_mp_tac REAL_MUL_LE_COMPAT_NEG_L \\ conj_tac
>- (match_mp_tac REAL_LT_IMP_LE \\ simp[])
>- (simp[REAL_LE_NEG]))
>- (qspecl_then [`- (nR2 + err2)`, `0`] DISJ_CASES_TAC REAL_LTE_TOTAL
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `nR1 * nR2 + (nR1 - err1) * - (nR2 + err2)` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ once_rewrite_tac [REAL_MUL_COMM] \\
match_mp_tac REAL_MUL_LE_COMPAT_NEG_L \\ conj_tac
>- (fs[] \\ match_mp_tac REAL_LT_IMP_LE \\ simp[])
>- (match_mp_tac REAL_LE_ADD_FLIP \\ simp[real_sub]))
>- (`nR1 * nR2 + (nR1 - err1) * - (nR2 + err2) = - nR1 * err2 + nR2 * err1 + err1 * err2`
by (fs[real_sub,REAL_RDISTRIB] \\
fs [GSYM REAL_SUB_LNEG, real_sub, REAL_LDISTRIB, REAL_NEG_MUL2, REAL_ADD_ASSOC] \\
fs [GSYM real_sub, REAL_SUB_REFL, GSYM REAL_NEG_RMUL, REAL_MUL_COMM]) \\
simp[] \\ match_mp_tac REAL_LE_ADD2 \\ conj_tac \\simp[]))
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `nR1 * nR2 + (nR1 + err1) * - (nR2 + err2)` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ once_rewrite_tac [REAL_MUL_COMM] \\
match_mp_tac REAL_LE_LMUL_IMP \\ conj_tac \\ fs[])
>- (`nR1 * nR2 + (nR1 + err1) * - (nR2 + err2) = - nR1 * err2 + - nR2 * err1 + - err1 * err2`
by (fs[real_sub,REAL_RDISTRIB] \\
fs [GSYM REAL_SUB_LNEG, real_sub, REAL_LDISTRIB, REAL_NEG_MUL2, REAL_ADD_ASSOC] \\
fs [GSYM real_sub, REAL_SUB_REFL, GSYM REAL_NEG_RMUL, REAL_MUL_COMM]) \\
simp[] \\ match_mp_tac REAL_LE_ADD2 \\ conj_tac \\ TRY(simp[GSYM REAL_NEG_LMUL]) \\
match_mp_tac REAL_LE_ADD2 \\ conj_tac \\ simp[REAL_NEG_LMUL]))))
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `nR1 * nR2 + nF1 * - (nR2 - err2)` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ match_mp_tac REAL_LE_LMUL_IMP \\ conj_tac \\ simp[REAL_LE_NEG] \\
match_mp_tac REAL_LE_ADD_FLIP \\ simp[real_sub])
>- (qspecl_then [`- (nR2 - err2)`, `0`] DISJ_CASES_TAC REAL_LTE_TOTAL
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `nR1 * nR2 + (nR1 - err1) * - (nR2 - err2)` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ once_rewrite_tac [REAL_MUL_COMM] \\
match_mp_tac REAL_MUL_LE_COMPAT_NEG_L \\ conj_tac
>- (fs[] \\ match_mp_tac REAL_LT_IMP_LE \\ simp[])
>- (match_mp_tac REAL_LE_ADD_FLIP \\ simp[real_sub]))
>- (`nR1 * nR2 + (nR1 - err1) * - (nR2 - err2) = nR1 * err2 + nR2 * err1 + - err1 * err2`
by (fs[real_sub,REAL_RDISTRIB] \\
fs [GSYM REAL_SUB_LNEG, real_sub, REAL_LDISTRIB, REAL_NEG_MUL2, REAL_ADD_ASSOC] \\
fs [GSYM real_sub, REAL_SUB_REFL, GSYM REAL_NEG_RMUL, REAL_MUL_COMM]) \\
simp[] \\ match_mp_tac REAL_LE_ADD2 \\ conj_tac \\ simp[GSYM REAL_NEG_LMUL] \\
match_mp_tac REAL_LE_ADD2 \\ conj_tac \\ simp[REAL_NEG_LMUL]))
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `nR1 * nR2 + (nR1 + err1) * - (nR2 - err2)` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ once_rewrite_tac [REAL_MUL_COMM] \\
match_mp_tac REAL_LE_LMUL_IMP \\ conj_tac \\ fs[])
>- (`nR1 * nR2 + (nR1 + err1) * - (nR2 - err2) = nR1 * err2 + - nR2 * err1 + err1 * err2`
by (fs[real_sub,REAL_RDISTRIB] \\
fs [GSYM REAL_SUB_LNEG, real_sub, REAL_LDISTRIB, REAL_NEG_MUL2, REAL_ADD_ASSOC] \\
fs [GSYM real_sub, REAL_SUB_REFL, GSYM REAL_NEG_RMUL, REAL_MUL_COMM]) \\
simp[] \\ match_mp_tac REAL_LE_ADD2 \\ conj_tac \\ simp[GSYM REAL_NEG_LMUL] )))))
(* Absolute value negative *)
>- (simp[REAL_NEG_ADD] \\
qspecl_then [`nF1`, `0`] DISJ_CASES_TAC REAL_LTE_TOTAL
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `-(nR1 * nR2) + nF1 * (nR2 - err2)` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ match_mp_tac REAL_MUL_LE_COMPAT_NEG_L \\ conj_tac
>- (match_mp_tac REAL_LT_IMP_LE \\ simp[])
>- (match_mp_tac REAL_LE_ADD_FLIP \\ simp[real_sub]))
>- (qspecl_then [`nR2 - err2`, `0`] DISJ_CASES_TAC REAL_LTE_TOTAL
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `-(nR1 * nR2) + (nR1 - err1) * (nR2 - err2)` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ once_rewrite_tac [REAL_MUL_COMM] \\
match_mp_tac REAL_MUL_LE_COMPAT_NEG_L \\ conj_tac
>- (fs[] \\ match_mp_tac REAL_LT_IMP_LE \\ simp[])
>- (match_mp_tac REAL_LE_ADD_FLIP \\ simp[real_sub]))
>- (`-(nR1 * nR2) + (nR1 - err1) * (nR2 - err2) = - nR1 * err2 + - nR2 * err1 + err1 * err2`
by (fs[real_sub,REAL_RDISTRIB] \\
fs [GSYM REAL_SUB_LNEG, real_sub, REAL_LDISTRIB, REAL_NEG_MUL2, REAL_ADD_ASSOC] \\
fs [GSYM real_sub, REAL_SUB_REFL, GSYM REAL_NEG_RMUL, REAL_MUL_COMM]) \\
simp[] \\ match_mp_tac REAL_LE_ADD2 \\ conj_tac \\simp[]))
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `-(nR1 * nR2) + (nR1 + err1) * (nR2 - err2)` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ once_rewrite_tac [REAL_MUL_COMM] \\
match_mp_tac REAL_LE_LMUL_IMP \\ conj_tac \\ fs[])
>- (`-(nR1 * nR2) + (nR1 + err1) * (nR2 - err2) = - nR1 * err2 + nR2 * err1 + - err1 * err2`
by (fs[real_sub,REAL_RDISTRIB] \\
fs [GSYM REAL_SUB_LNEG, real_sub, REAL_LDISTRIB, REAL_NEG_MUL2, REAL_ADD_ASSOC] \\
fs [GSYM real_sub, REAL_SUB_REFL, GSYM REAL_NEG_RMUL, REAL_MUL_COMM]) \\
simp[] \\ match_mp_tac REAL_LE_ADD2 \\ conj_tac \\ TRY(simp[GSYM REAL_NEG_LMUL]) \\
match_mp_tac REAL_LE_ADD2 \\ conj_tac \\ simp[REAL_NEG_LMUL]))))
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `-(nR1 * nR2) + nF1 * (nR2 + err2)` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ match_mp_tac REAL_LE_LMUL_IMP \\ conj_tac \\ simp[REAL_LE_NEG])
>- (qspecl_then [`nR2 + err2`, `0`] DISJ_CASES_TAC REAL_LTE_TOTAL
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `-(nR1 * nR2) + (nR1 - err1) * (nR2 + err2)` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ once_rewrite_tac [REAL_MUL_COMM] \\
match_mp_tac REAL_MUL_LE_COMPAT_NEG_L \\ conj_tac
>- (fs[] \\ match_mp_tac REAL_LT_IMP_LE \\ simp[])
>- (match_mp_tac REAL_LE_ADD_FLIP \\ simp[real_sub]))
>- (`-(nR1 * nR2) + (nR1 - err1) * (nR2 + err2) = nR1 * err2 + - nR2 * err1 + - err1 * err2`
by (fs[real_sub,REAL_RDISTRIB] \\
fs [GSYM REAL_SUB_LNEG, real_sub, REAL_LDISTRIB, REAL_NEG_MUL2, REAL_ADD_ASSOC] \\
fs [GSYM real_sub, REAL_SUB_REFL, GSYM REAL_NEG_RMUL, REAL_MUL_COMM]) \\
simp[] \\ match_mp_tac REAL_LE_ADD2 \\ conj_tac \\ simp[GSYM REAL_NEG_LMUL] \\
match_mp_tac REAL_LE_ADD2 \\ conj_tac \\ simp[REAL_NEG_LMUL]))
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `-(nR1 * nR2) + (nR1 + err1) * (nR2 + err2)` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ once_rewrite_tac [REAL_MUL_COMM] \\
match_mp_tac REAL_LE_LMUL_IMP \\ conj_tac \\ fs[])
>- (`-(nR1 * nR2) + (nR1 + err1) * (nR2 + err2) = nR1 * err2 + nR2 * err1 + err1 * err2`
by (fs[real_sub,REAL_RDISTRIB] \\
fs [GSYM REAL_SUB_LNEG, real_sub, REAL_LDISTRIB, REAL_NEG_MUL2, REAL_ADD_ASSOC] \\
fs [GSYM real_sub, REAL_SUB_REFL, GSYM REAL_NEG_RMUL, REAL_MUL_COMM]) \\
simp[] \\ match_mp_tac REAL_LE_ADD2 \\ conj_tac \\ simp[GSYM REAL_NEG_LMUL]))))))
(* First positive, second negative *)
>- (`nF1 <= nR1 + err1` by (match_mp_tac err_up \\ simp[]) \\
`nF2 <= nR2 + err2`
by (once_rewrite_tac[REAL_ADD_COMM] \\ simp [GSYM REAL_LE_SUB_RADD] \\
once_rewrite_tac [REAL_ADD_COMM, GSYM REAL_NEG_SUB] \\ simp[] ) \\
qpat_assum `!x. (A /\ B) \/ C` (fn thm => qspecl_then [`nR1 * nR2 - nF1 * nF2` ] DISJ_CASES_TAC thm) \\
fs[real_sub]
(* Absolute value positive *)
>-(qspecl_then [`nF1`, `0`] DISJ_CASES_TAC REAL_LTE_TOTAL
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `nR1 * nR2 + nF1 * (- (nR2 + err2))` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ match_mp_tac REAL_MUL_LE_COMPAT_NEG_L \\ conj_tac
>- (match_mp_tac REAL_LT_IMP_LE \\ simp[])
>- (simp[REAL_LE_NEG]))
>- (qspecl_then [`- (nR2 + err2)`, `0`] DISJ_CASES_TAC REAL_LTE_TOTAL
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `nR1 * nR2 + (nR1 - err1) * - (nR2 + err2)` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ once_rewrite_tac [REAL_MUL_COMM] \\
match_mp_tac REAL_MUL_LE_COMPAT_NEG_L \\ conj_tac
>- (fs[] \\ match_mp_tac REAL_LT_IMP_LE \\ simp[])
>- (match_mp_tac REAL_LE_ADD_FLIP \\ simp[real_sub]))
>- (`nR1 * nR2 + (nR1 - err1) * - (nR2 + err2) = - nR1 * err2 + nR2 * err1 + err1 * err2`
by (fs[real_sub,REAL_RDISTRIB] \\
fs [GSYM REAL_SUB_LNEG, real_sub, REAL_LDISTRIB, REAL_NEG_MUL2, REAL_ADD_ASSOC] \\
fs [GSYM real_sub, REAL_SUB_REFL, GSYM REAL_NEG_RMUL, REAL_MUL_COMM]) \\
simp[] \\ match_mp_tac REAL_LE_ADD2 \\ conj_tac \\simp[]))
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `nR1 * nR2 + (nR1 + err1) * - (nR2 + err2)` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ once_rewrite_tac [REAL_MUL_COMM] \\
match_mp_tac REAL_LE_LMUL_IMP \\ conj_tac \\ fs[])
>- (`nR1 * nR2 + (nR1 + err1) * - (nR2 + err2) = - nR1 * err2 + - nR2 * err1 + - err1 * err2`
by (fs[real_sub,REAL_RDISTRIB] \\
fs [GSYM REAL_SUB_LNEG, real_sub, REAL_LDISTRIB, REAL_NEG_MUL2, REAL_ADD_ASSOC] \\
fs [GSYM real_sub, REAL_SUB_REFL, GSYM REAL_NEG_RMUL, REAL_MUL_COMM]) \\
simp[] \\ match_mp_tac REAL_LE_ADD2 \\ conj_tac \\ TRY(simp[GSYM REAL_NEG_LMUL]) \\
match_mp_tac REAL_LE_ADD2 \\ conj_tac \\ simp[REAL_NEG_LMUL]))))
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `nR1 * nR2 + nF1 * -nR2` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ match_mp_tac REAL_LE_LMUL_IMP \\ conj_tac \\ simp[REAL_LE_NEG] \\
qpat_x_assum `nR2 + - nF2 <= _ `
(fn thm => assume_tac (SIMP_RULE bool_ss [GSYM real_sub, REAL_LE_SUB_RADD, REAL_ADD_LID] thm))\\
simp[])
>- (qspecl_then [`- nR2`, `0`] DISJ_CASES_TAC REAL_LTE_TOTAL
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `nR1 * nR2 + (nR1 - err1) * - nR2` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ once_rewrite_tac [REAL_MUL_COMM] \\
match_mp_tac REAL_MUL_LE_COMPAT_NEG_L \\ conj_tac
>- (fs[] \\ match_mp_tac REAL_LT_IMP_LE \\ simp[])
>- (match_mp_tac REAL_LE_ADD_FLIP \\ simp[real_sub]))
>- (`nR1 * nR2 + (nR1 - err1) * - nR2 = nR2 * err1`
by (fs[real_sub,REAL_RDISTRIB]
\\ fs [GSYM REAL_SUB_LNEG, real_sub, REAL_LDISTRIB, REAL_NEG_MUL2, REAL_ADD_ASSOC]
\\ fs [GSYM real_sub, REAL_SUB_REFL, GSYM REAL_NEG_RMUL, REAL_MUL_COMM])
\\ simp[] \\ match_mp_tac REAL_LE_TRANS
\\ qexists_tac `maxAbs (e2lo,e2hi) * err1` \\ conj_tac \\ simp[]
\\ match_mp_tac REAL_LE_TRANS
\\ qexists_tac `maxAbs (e1lo, e1hi) * err2 + maxAbs (e2lo, e2hi) * err1`
\\ conj_tac \\ simp[]
\\ once_rewrite_tac [REAL_ADD_COMM]
\\ simp [REAL_LE_ADDR]))
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `nR1 * nR2 + (nR1 + err1) * - nR2` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ once_rewrite_tac [REAL_MUL_COMM] \\
match_mp_tac REAL_LE_LMUL_IMP \\ conj_tac \\ fs[])
>- (`nR1 * nR2 + (nR1 + err1) * - nR2 = - nR2 * err1`
by (fs[real_sub,REAL_RDISTRIB]
\\ fs [GSYM REAL_SUB_LNEG, real_sub, REAL_LDISTRIB, REAL_NEG_MUL2, REAL_ADD_ASSOC]
\\ fs [GSYM real_sub, REAL_SUB_REFL, GSYM REAL_NEG_RMUL, REAL_MUL_COMM])
\\ simp[] \\ match_mp_tac REAL_LE_TRANS
\\ qexists_tac `maxAbs (e2lo,e2hi) * err1` \\ conj_tac \\ simp[]
\\ match_mp_tac REAL_LE_TRANS
\\ qexists_tac `maxAbs (e1lo, e1hi) * err2 + maxAbs (e2lo, e2hi) * err1`
\\ conj_tac \\ simp[]
\\ once_rewrite_tac [REAL_ADD_COMM]
\\ simp [REAL_LE_ADDR])))))
(* Absolute value negative *)
>- (simp[REAL_NEG_ADD] \\
qspecl_then [`nF1`, `0`] DISJ_CASES_TAC REAL_LTE_TOTAL
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `-(nR1 * nR2) + nF1 * nR2` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ match_mp_tac REAL_MUL_LE_COMPAT_NEG_L \\ conj_tac
>- (match_mp_tac REAL_LT_IMP_LE \\ simp[])
>- (qpat_x_assum `nR2 + - nF2 <= _ `
(fn thm =>
assume_tac
(SIMP_RULE bool_ss [GSYM real_sub, REAL_LE_SUB_RADD, REAL_ADD_LID] thm))
\\ simp[]))
>- (qspecl_then [`nR2`, `0`] DISJ_CASES_TAC REAL_LTE_TOTAL
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `-(nR1 * nR2) + (nR1 - err1) * nR2` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ once_rewrite_tac [REAL_MUL_COMM] \\
match_mp_tac REAL_MUL_LE_COMPAT_NEG_L \\ conj_tac
>- (fs[] \\ match_mp_tac REAL_LT_IMP_LE \\ simp[])
>- (match_mp_tac REAL_LE_ADD_FLIP \\ simp[real_sub]))
>- (`-(nR1 * nR2) + (nR1 - err1) * nR2 = - nR2 * err1`
by (fs[real_sub,REAL_RDISTRIB]
\\ fs [GSYM REAL_SUB_LNEG, real_sub, REAL_LDISTRIB, REAL_NEG_MUL2, REAL_ADD_ASSOC]
\\ fs [GSYM real_sub, REAL_SUB_REFL, GSYM REAL_NEG_RMUL, REAL_MUL_COMM])
\\ simp[] \\ match_mp_tac REAL_LE_TRANS
\\ qexists_tac `maxAbs (e2lo,e2hi) * err1` \\ conj_tac \\ simp[]
\\ match_mp_tac REAL_LE_TRANS
\\ qexists_tac `maxAbs (e1lo, e1hi) * err2 + maxAbs (e2lo, e2hi) * err1`
\\ conj_tac \\ simp[]
\\ once_rewrite_tac [REAL_ADD_COMM]
\\ simp [REAL_LE_ADDR]))
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `-(nR1 * nR2) + (nR1 + err1) * nR2` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ once_rewrite_tac [REAL_MUL_COMM] \\
match_mp_tac REAL_LE_LMUL_IMP \\ conj_tac \\ fs[])
>- (`-(nR1 * nR2) + (nR1 + err1) * nR2 = nR2 * err1`
by (fs[real_sub,REAL_RDISTRIB]
\\ fs [GSYM REAL_SUB_LNEG, real_sub, REAL_LDISTRIB, REAL_NEG_MUL2, REAL_ADD_ASSOC]
\\ fs [GSYM real_sub, REAL_SUB_REFL, GSYM REAL_NEG_RMUL, REAL_MUL_COMM])
\\ simp[] \\ match_mp_tac REAL_LE_TRANS
\\ qexists_tac `maxAbs (e2lo,e2hi) * err1` \\ conj_tac \\ simp[]
\\ match_mp_tac REAL_LE_TRANS
\\ qexists_tac `maxAbs (e1lo, e1hi) * err2 + maxAbs (e2lo, e2hi) * err1`
\\ conj_tac \\ simp[]
\\ once_rewrite_tac [REAL_ADD_COMM]
\\ simp [REAL_LE_ADDR]))))
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `-(nR1 * nR2) + nF1 * (nR2 + err2)` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ match_mp_tac REAL_LE_LMUL_IMP \\ conj_tac \\ simp[REAL_LE_NEG])
>- (qspecl_then [`nR2 + err2`, `0`] DISJ_CASES_TAC REAL_LTE_TOTAL
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `-(nR1 * nR2) + (nR1 - err1) * (nR2 + err2)` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ once_rewrite_tac [REAL_MUL_COMM] \\
match_mp_tac REAL_MUL_LE_COMPAT_NEG_L \\ conj_tac
>- (fs[] \\ match_mp_tac REAL_LT_IMP_LE \\ simp[])
>- (match_mp_tac REAL_LE_ADD_FLIP \\ simp[real_sub]))
>- (`-(nR1 * nR2) + (nR1 - err1) * (nR2 + err2) = nR1 * err2 + - nR2 * err1 + - err1 * err2`
by (fs[real_sub,REAL_RDISTRIB] \\
fs [GSYM REAL_SUB_LNEG, real_sub, REAL_LDISTRIB, REAL_NEG_MUL2, REAL_ADD_ASSOC] \\
fs [GSYM real_sub, REAL_SUB_REFL, GSYM REAL_NEG_RMUL, REAL_MUL_COMM]) \\
simp[] \\ match_mp_tac REAL_LE_ADD2 \\ conj_tac \\ simp[GSYM REAL_NEG_LMUL] \\
match_mp_tac REAL_LE_ADD2 \\ conj_tac \\ simp[REAL_NEG_LMUL]))
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `-(nR1 * nR2) + (nR1 + err1) * (nR2 + err2)` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ once_rewrite_tac [REAL_MUL_COMM] \\
match_mp_tac REAL_LE_LMUL_IMP \\ conj_tac \\ fs[])
>- (`-(nR1 * nR2) + (nR1 + err1) * (nR2 + err2) = nR1 * err2 + nR2 * err1 + err1 * err2`
by (fs[real_sub,REAL_RDISTRIB] \\
fs [GSYM REAL_SUB_LNEG, real_sub, REAL_LDISTRIB, REAL_NEG_MUL2, REAL_ADD_ASSOC] \\
fs [GSYM real_sub, REAL_SUB_REFL, GSYM REAL_NEG_RMUL, REAL_MUL_COMM]) \\
simp[] \\ match_mp_tac REAL_LE_ADD2 \\ conj_tac \\ simp[GSYM REAL_NEG_LMUL]))))))
(* First negative, second positive *)
>- (`nF2 <= nR2 + err2` by (match_mp_tac err_up \\ simp[]) \\
`nF1 <= nR1 + err1`
by (once_rewrite_tac[REAL_ADD_COMM] \\ simp [GSYM REAL_LE_SUB_RADD] \\
once_rewrite_tac [REAL_ADD_COMM, GSYM REAL_NEG_SUB] \\ simp[]) \\
qpat_assum `!x. (A /\ B) \/ C` (fn thm => qspecl_then [`nR1 * nR2 - nF1 * nF2` ] DISJ_CASES_TAC thm) \\
fs[real_sub]
(* Absolute value positive *)
>-(qspecl_then [`nF1`, `0`] DISJ_CASES_TAC REAL_LTE_TOTAL
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `nR1 * nR2 + nF1 * - (nR2 + err2)` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ match_mp_tac REAL_MUL_LE_COMPAT_NEG_L \\ conj_tac
>- (match_mp_tac REAL_LT_IMP_LE \\ simp[])
>- (simp[REAL_LE_NEG]))
>- (qspecl_then [`- (nR2 + err2)`, `0`] DISJ_CASES_TAC REAL_LTE_TOTAL
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `nR1 * nR2 + nR1 * - (nR2 + err2)` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ once_rewrite_tac [REAL_MUL_COMM] \\
match_mp_tac REAL_MUL_LE_COMPAT_NEG_L \\ conj_tac
>- (fs[] \\ match_mp_tac REAL_LT_IMP_LE \\ simp[])
>- (qpat_x_assum `nR1 + - nF1 <= _ `
(fn thm => assume_tac (SIMP_RULE bool_ss [GSYM real_sub, REAL_LE_SUB_RADD, REAL_ADD_LID] thm))\\
simp[]))
>- (`nR1 * nR2 + nR1 * - (nR2 + err2) = - nR1 * err2`
by (fs[real_sub,REAL_RDISTRIB]
\\ fs [GSYM REAL_SUB_LNEG, real_sub, REAL_LDISTRIB, REAL_NEG_MUL2, REAL_ADD_ASSOC]
\\ fs [GSYM real_sub, REAL_SUB_REFL, GSYM REAL_NEG_RMUL, REAL_MUL_COMM])
\\ simp[] \\ match_mp_tac REAL_LE_TRANS
\\ qexists_tac `maxAbs (e1lo, e1hi) * err2` \\ conj_tac \\ simp[]
\\ match_mp_tac REAL_LE_TRANS
\\ qexists_tac `maxAbs (e1lo, e1hi) * err2 + maxAbs (e2lo, e2hi) * err1`
\\ conj_tac \\ simp[]))
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `nR1 * nR2 + (nR1 + err1) * - (nR2 + err2)` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ once_rewrite_tac [REAL_MUL_COMM] \\
match_mp_tac REAL_LE_LMUL_IMP \\ conj_tac \\ fs[])
>- (`nR1 * nR2 + (nR1 + err1) * - (nR2 + err2) = - nR1 * err2 + - nR2 * err1 + - err1 * err2`
by (fs[real_sub,REAL_RDISTRIB]
\\ fs [GSYM REAL_SUB_LNEG, real_sub, REAL_LDISTRIB, REAL_NEG_MUL2, REAL_ADD_ASSOC]
\\ fs [GSYM real_sub, REAL_SUB_REFL, GSYM REAL_NEG_RMUL, REAL_MUL_COMM])
\\ simp[] \\ match_mp_tac REAL_LE_ADD2 \\ conj_tac \\ TRY(simp[GSYM REAL_NEG_LMUL])
\\ match_mp_tac REAL_LE_ADD2 \\ conj_tac \\ simp[REAL_NEG_LMUL]))))
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `nR1 * nR2 + nF1 * - (nR2 - err2)` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ match_mp_tac REAL_LE_LMUL_IMP \\ conj_tac \\ simp[REAL_LE_NEG] \\
match_mp_tac REAL_LE_ADD_FLIP \\ simp[real_sub])
>- (qspecl_then [`- (nR2 - err2)`, `0`] DISJ_CASES_TAC REAL_LTE_TOTAL
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `nR1 * nR2 + nR1 * - (nR2 - err2)` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ once_rewrite_tac [REAL_MUL_COMM] \\
match_mp_tac REAL_MUL_LE_COMPAT_NEG_L \\ conj_tac
>- (fs[] \\ match_mp_tac REAL_LT_IMP_LE \\ simp[])
>- (qpat_x_assum `nR1 + - nF1 <= _ `
(fn thm =>
assume_tac
(SIMP_RULE bool_ss [GSYM real_sub, REAL_LE_SUB_RADD, REAL_ADD_LID] thm))
\\ simp[]))
>- (`nR1 * nR2 + nR1 * - (nR2 - err2) = nR1 * err2`
by (fs[real_sub,REAL_RDISTRIB]
\\ fs [GSYM REAL_SUB_LNEG, real_sub, REAL_LDISTRIB, REAL_NEG_MUL2, REAL_ADD_ASSOC]
\\ fs [GSYM real_sub, REAL_SUB_REFL, GSYM REAL_NEG_RMUL, REAL_MUL_COMM])
\\ simp[] \\ match_mp_tac REAL_LE_TRANS
\\ qexists_tac `maxAbs (e1lo, e1hi) * err2` \\ conj_tac \\ simp[]
\\ match_mp_tac REAL_LE_TRANS
\\ qexists_tac `maxAbs (e1lo, e1hi) * err2 + maxAbs (e2lo, e2hi) * err1`
\\ conj_tac \\ simp[]))
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `nR1 * nR2 + (nR1 + err1) * - (nR2 - err2)` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ once_rewrite_tac [REAL_MUL_COMM] \\
match_mp_tac REAL_LE_LMUL_IMP \\ conj_tac \\ fs[])
>- (`nR1 * nR2 + (nR1 + err1) * - (nR2 - err2) = nR1 * err2 + - nR2 * err1 + err1 * err2`
by (fs[real_sub,REAL_RDISTRIB]
\\ fs [GSYM REAL_SUB_LNEG, real_sub, REAL_LDISTRIB, REAL_NEG_MUL2, REAL_ADD_ASSOC]
\\ fs [GSYM real_sub, REAL_SUB_REFL, GSYM REAL_NEG_RMUL, REAL_MUL_COMM])
\\ simp[] \\ match_mp_tac REAL_LE_ADD2 \\ conj_tac \\ simp[GSYM REAL_NEG_LMUL] )))))
(* Absolute value negative *)
>- (simp[REAL_NEG_ADD] \\
qspecl_then [`nF1`, `0`] DISJ_CASES_TAC REAL_LTE_TOTAL
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `-(nR1 * nR2) + nF1 * (nR2 - err2)` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ match_mp_tac REAL_MUL_LE_COMPAT_NEG_L \\ conj_tac
>- (match_mp_tac REAL_LT_IMP_LE \\ simp[])
>- (match_mp_tac REAL_LE_ADD_FLIP \\ simp[real_sub]))
>- (qspecl_then [`nR2 - err2`, `0`] DISJ_CASES_TAC REAL_LTE_TOTAL
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `-(nR1 * nR2) + nR1 * (nR2 - err2)` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ once_rewrite_tac [REAL_MUL_COMM] \\
match_mp_tac REAL_MUL_LE_COMPAT_NEG_L \\ conj_tac
>- (fs[] \\ match_mp_tac REAL_LT_IMP_LE \\ simp[])
>- (qpat_x_assum `nR1 + - nF1 <= _ `
(fn thm =>
assume_tac
(SIMP_RULE bool_ss [GSYM real_sub, REAL_LE_SUB_RADD, REAL_ADD_LID] thm))
\\ simp[]))
>- (`-(nR1 * nR2) + nR1 * (nR2 - err2) = - nR1 * err2`
by (fs[real_sub,REAL_RDISTRIB]
\\ fs [GSYM REAL_SUB_LNEG, real_sub, REAL_LDISTRIB, REAL_NEG_MUL2, REAL_ADD_ASSOC]
\\ fs [GSYM real_sub, REAL_SUB_REFL, GSYM REAL_NEG_RMUL, REAL_MUL_COMM])
\\ simp[] \\ match_mp_tac REAL_LE_TRANS
\\ qexists_tac `maxAbs (e1lo, e1hi) * err2` \\ conj_tac \\ simp[]
\\ match_mp_tac REAL_LE_TRANS
\\ qexists_tac `maxAbs (e1lo, e1hi) * err2 + maxAbs (e2lo, e2hi) * err1`
\\ conj_tac \\ simp[]))
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `-(nR1 * nR2) + (nR1 + err1) * (nR2 - err2)` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ once_rewrite_tac [REAL_MUL_COMM] \\
match_mp_tac REAL_LE_LMUL_IMP \\ conj_tac \\ fs[])
>- (`-(nR1 * nR2) + (nR1 + err1) * (nR2 - err2) = - nR1 * err2 + nR2 * err1 + - err1 * err2`
by (fs[real_sub,REAL_RDISTRIB]
\\ fs [GSYM REAL_SUB_LNEG, real_sub, REAL_LDISTRIB, REAL_NEG_MUL2, REAL_ADD_ASSOC]
\\ fs [GSYM real_sub, REAL_SUB_REFL, GSYM REAL_NEG_RMUL, REAL_MUL_COMM])
\\ simp[] \\ match_mp_tac REAL_LE_ADD2
\\ conj_tac \\ TRY(simp[GSYM REAL_NEG_LMUL])
\\ match_mp_tac REAL_LE_ADD2 \\ conj_tac \\ simp[REAL_NEG_LMUL]))))
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `-(nR1 * nR2) + nF1 * (nR2 + err2)` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ match_mp_tac REAL_LE_LMUL_IMP \\ conj_tac \\ simp[REAL_LE_NEG])
>- (qspecl_then [`nR2 + err2`, `0`] DISJ_CASES_TAC REAL_LTE_TOTAL
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `-(nR1 * nR2) + nR1 * (nR2 + err2)` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ once_rewrite_tac [REAL_MUL_COMM] \\
match_mp_tac REAL_MUL_LE_COMPAT_NEG_L \\ conj_tac
>- (fs[] \\ match_mp_tac REAL_LT_IMP_LE \\ simp[])
>- (qpat_x_assum `nR1 + - nF1 <= _ `
(fn thm =>
assume_tac
(SIMP_RULE bool_ss [GSYM real_sub, REAL_LE_SUB_RADD, REAL_ADD_LID] thm))
\\ simp[]))
>- (`-(nR1 * nR2) + nR1 * (nR2 + err2) = nR1 * err2`
by (fs[real_sub,REAL_RDISTRIB]
\\ fs [GSYM REAL_SUB_LNEG, real_sub, REAL_LDISTRIB, REAL_NEG_MUL2, REAL_ADD_ASSOC]
\\ fs [GSYM real_sub, REAL_SUB_REFL, GSYM REAL_NEG_RMUL, REAL_MUL_COMM])
\\ simp[] \\ match_mp_tac REAL_LE_TRANS
\\ qexists_tac `maxAbs (e1lo, e1hi) * err2` \\ conj_tac \\ simp[]
\\ match_mp_tac REAL_LE_TRANS
\\ qexists_tac `maxAbs (e1lo, e1hi) * err2 + maxAbs (e2lo, e2hi) * err1`
\\ conj_tac \\ simp[]))
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `-(nR1 * nR2) + (nR1 + err1) * (nR2 + err2)` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ once_rewrite_tac [REAL_MUL_COMM] \\
match_mp_tac REAL_LE_LMUL_IMP \\ conj_tac \\ fs[])
>- (`-(nR1 * nR2) + (nR1 + err1) * (nR2 + err2) = nR1 * err2 + nR2 * err1 + err1 * err2`
by (fs[real_sub,REAL_RDISTRIB] \\
fs [GSYM REAL_SUB_LNEG, real_sub, REAL_LDISTRIB, REAL_NEG_MUL2, REAL_ADD_ASSOC] \\
fs [GSYM real_sub, REAL_SUB_REFL, GSYM REAL_NEG_RMUL, REAL_MUL_COMM]) \\
simp[] \\ match_mp_tac REAL_LE_ADD2 \\ conj_tac \\ simp[GSYM REAL_NEG_LMUL]))))))
(* Both negative *)
>- (`nF1 <= nR1 + err1`
by (once_rewrite_tac[REAL_ADD_COMM]
\\ simp [GSYM REAL_LE_SUB_RADD]
\\ once_rewrite_tac [REAL_ADD_COMM, GSYM REAL_NEG_SUB] \\ simp[])
\\ `nF2 <= nR2 + err2`
by (once_rewrite_tac[REAL_ADD_COMM]
\\ simp [GSYM REAL_LE_SUB_RADD]
\\ once_rewrite_tac [REAL_ADD_COMM, GSYM REAL_NEG_SUB] \\ simp[])
\\ `nR1 <= nF1`
by (qpat_x_assum `nR1 - nF1 <= _ `
(fn thm =>
assume_tac
(SIMP_RULE bool_ss [GSYM real_sub, REAL_LE_SUB_RADD, REAL_ADD_LID] thm))
\\ simp[])
\\ `nR2 <= nF2`
by (qpat_x_assum `nR2 - nF2 <= _ `
(fn thm =>
assume_tac (SIMP_RULE bool_ss [GSYM real_sub, REAL_LE_SUB_RADD, REAL_ADD_LID] thm))
\\ simp[])
\\ qpat_assum `!x. (A /\ B) \/ C`
(fn thm => qspecl_then [`nR1 * nR2 - nF1 * nF2` ] DISJ_CASES_TAC thm)
\\ fs[real_sub]
(* Absolute value positive *)
>-(qspecl_then [`nF1`, `0`] DISJ_CASES_TAC REAL_LTE_TOTAL
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `nR1 * nR2 + nF1 * - (nR2 + err2)` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ match_mp_tac REAL_MUL_LE_COMPAT_NEG_L \\ conj_tac
>- (match_mp_tac REAL_LT_IMP_LE \\ simp[])
>- (simp[REAL_LE_NEG]))
>- (qspecl_then [`- (nR2 + err2)`, `0`] DISJ_CASES_TAC REAL_LTE_TOTAL
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `nR1 * nR2 + nR1 * - (nR2 + err2)` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ once_rewrite_tac [REAL_MUL_COMM] \\
match_mp_tac REAL_MUL_LE_COMPAT_NEG_L \\ conj_tac
>- (fs[] \\ match_mp_tac REAL_LT_IMP_LE \\ simp[])
>- (qpat_x_assum `nR1 + - nF1 <= _ `
(fn thm =>
assume_tac
(SIMP_RULE bool_ss [GSYM real_sub, REAL_LE_SUB_RADD, REAL_ADD_LID] thm))
\\ simp[]))
>- (`nR1 * nR2 + nR1 * - (nR2 + err2) = - nR1 * err2`
by (fs[real_sub,REAL_RDISTRIB]
\\ fs [GSYM REAL_SUB_LNEG, real_sub, REAL_LDISTRIB, REAL_NEG_MUL2, REAL_ADD_ASSOC]
\\ fs [GSYM real_sub, REAL_SUB_REFL, GSYM REAL_NEG_RMUL, REAL_MUL_COMM])
\\ simp[] \\ match_mp_tac REAL_LE_TRANS
\\ qexists_tac `maxAbs (e1lo, e1hi) * err2`
\\ conj_tac \\ simp[]
\\ match_mp_tac REAL_LE_TRANS
\\ qexists_tac `maxAbs (e1lo, e1hi) * err2 + maxAbs (e2lo, e2hi) * err1`
\\ conj_tac \\ simp[]))
>- (match_mp_tac REAL_LE_TRANS
\\ qexists_tac `nR1 * nR2 + (nR1 + err1) * - (nR2 + err2)`
\\ conj_tac
>- (fs [REAL_NEG_RMUL]
\\ once_rewrite_tac [REAL_MUL_COMM]
\\ match_mp_tac REAL_LE_LMUL_IMP
\\ conj_tac \\ fs[])
>- (`nR1 * nR2 + (nR1 + err1) * - (nR2 + err2) = - nR1 * err2 + - nR2 * err1 + - err1 * err2`
by (fs[real_sub,REAL_RDISTRIB]
\\ fs [GSYM REAL_SUB_LNEG, real_sub, REAL_LDISTRIB, REAL_NEG_MUL2, REAL_ADD_ASSOC]
\\ fs [GSYM real_sub, REAL_SUB_REFL, GSYM REAL_NEG_RMUL, REAL_MUL_COMM])
\\ simp[] \\ match_mp_tac REAL_LE_ADD2
\\ conj_tac \\ TRY(simp[GSYM REAL_NEG_LMUL])
\\ match_mp_tac REAL_LE_ADD2
\\ conj_tac \\ simp[REAL_NEG_LMUL]))))
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `nR1 * nR2 + nF1 * - nR2` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ match_mp_tac REAL_LE_LMUL_IMP \\ conj_tac \\ simp[REAL_LE_NEG] \\
match_mp_tac REAL_LE_ADD_FLIP \\ simp[real_sub])
>- (qspecl_then [`- nR2`, `0`] DISJ_CASES_TAC REAL_LTE_TOTAL
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `nR1 * nR2 + nR1 * - nR2` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ once_rewrite_tac [REAL_MUL_COMM] \\
match_mp_tac REAL_MUL_LE_COMPAT_NEG_L \\ conj_tac
>- (fs[] \\ match_mp_tac REAL_LT_IMP_LE \\ simp[])
>- (simp[]))
>- (`nR1 * nR2 + nR1 * - nR2 = 0`
by (fs[real_sub,REAL_RDISTRIB]
\\ fs [GSYM REAL_SUB_LNEG, real_sub, REAL_LDISTRIB, REAL_NEG_MUL2, REAL_ADD_ASSOC]
\\ fs [GSYM real_sub, REAL_SUB_REFL, GSYM REAL_NEG_RMUL, REAL_MUL_COMM])
\\ simp[] \\ match_mp_tac REAL_LE_TRANS
\\ qexists_tac `maxAbs (e1lo, e1hi) * err2`
\\ conj_tac \\ simp[]
\\ match_mp_tac REAL_LE_TRANS
\\ qexists_tac `maxAbs (e1lo, e1hi) * err2 + maxAbs (e2lo, e2hi) * err1`
\\ conj_tac \\ simp[]))
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `nR1 * nR2 + (nR1 + err1) * - nR2` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ once_rewrite_tac [REAL_MUL_COMM] \\
match_mp_tac REAL_LE_LMUL_IMP \\ conj_tac \\ fs[])
>- (`nR1 * nR2 + (nR1 + err1) * - nR2 = - nR2 * err1`
by (fs[real_sub,REAL_RDISTRIB]
\\ fs [GSYM REAL_SUB_LNEG, real_sub, REAL_LDISTRIB, REAL_NEG_MUL2, REAL_ADD_ASSOC]
\\ fs [GSYM real_sub, REAL_SUB_REFL, GSYM REAL_NEG_RMUL, REAL_MUL_COMM])
\\ simp[] \\ match_mp_tac REAL_LE_TRANS
\\ qexists_tac `maxAbs (e2lo, e2hi) * err1` \\ conj_tac \\ simp[]
\\ match_mp_tac REAL_LE_TRANS
\\ qexists_tac `maxAbs (e1lo, e1hi) * err2 + maxAbs (e2lo, e2hi) * err1`
\\ conj_tac \\ simp[]
\\ once_rewrite_tac [REAL_ADD_COMM]
\\ simp[REAL_LE_ADDR])))))
(* Absolute value negative *)
>- (simp[REAL_NEG_ADD] \\
qspecl_then [`nF1`, `0`] DISJ_CASES_TAC REAL_LTE_TOTAL
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `-(nR1 * nR2) + nF1 * nR2` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ match_mp_tac REAL_MUL_LE_COMPAT_NEG_L \\ conj_tac
>- (match_mp_tac REAL_LT_IMP_LE \\ simp[])
>- (simp[]))
>- (qspecl_then [`nR2`, `0`] DISJ_CASES_TAC REAL_LTE_TOTAL
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `-(nR1 * nR2) + nR1 * nR2` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ once_rewrite_tac [REAL_MUL_COMM] \\
match_mp_tac REAL_MUL_LE_COMPAT_NEG_L \\ conj_tac
>- (fs[] \\ match_mp_tac REAL_LT_IMP_LE \\ simp[])
>- (simp[]))
>- (`-(nR1 * nR2) + nR1 * nR2 = 0`
by (fs[real_sub,REAL_RDISTRIB]
\\ fs [GSYM REAL_SUB_LNEG, real_sub, REAL_LDISTRIB, REAL_NEG_MUL2, REAL_ADD_ASSOC]
\\ fs [GSYM real_sub, REAL_SUB_REFL, GSYM REAL_NEG_RMUL, REAL_MUL_COMM])
\\ simp[] \\ match_mp_tac REAL_LE_TRANS
\\ qexists_tac `maxAbs (e1lo, e1hi) * err2` \\ conj_tac \\ simp[]
\\ match_mp_tac REAL_LE_TRANS
\\ qexists_tac `maxAbs (e1lo, e1hi) * err2 + maxAbs (e2lo, e2hi) * err1`
\\ conj_tac \\ simp[]))
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `-(nR1 * nR2) + (nR1 + err1) * nR2` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ once_rewrite_tac [REAL_MUL_COMM] \\
match_mp_tac REAL_LE_LMUL_IMP \\ conj_tac \\ fs[])
>- (`-(nR1 * nR2) + (nR1 + err1) * nR2 = nR2 * err1`
by (fs[real_sub,REAL_RDISTRIB]
\\ fs [GSYM REAL_SUB_LNEG, real_sub, REAL_LDISTRIB, REAL_NEG_MUL2, REAL_ADD_ASSOC]
\\ fs [GSYM real_sub, REAL_SUB_REFL, GSYM REAL_NEG_RMUL, REAL_MUL_COMM])
\\ simp[] \\ match_mp_tac REAL_LE_TRANS
\\ qexists_tac `maxAbs (e2lo, e2hi) * err1`
\\ conj_tac \\ simp[]
\\ match_mp_tac REAL_LE_TRANS
\\ qexists_tac `maxAbs (e1lo, e1hi) * err2 + maxAbs (e2lo, e2hi) * err1`
\\ conj_tac \\ simp[]
\\ once_rewrite_tac [REAL_ADD_COMM]
\\ simp[REAL_LE_ADDR]))))
>- (match_mp_tac REAL_LE_TRANS \\ qexists_tac `-(nR1 * nR2) + nF1 * (nR2 + err2)` \\ conj_tac
>- (fs [REAL_NEG_RMUL] \\ match_mp_tac REAL_LE_LMUL_IMP \\ conj_tac \\ simp[REAL_LE_NEG])