Commit dac0edc4 authored by Heiko Becker's avatar Heiko Becker
Browse files

Some cleanup and progress on Error Validator soundness

parent 9325d322
This diff is collapsed.
...@@ -117,6 +117,7 @@ val cond_simpl = store_thm ( ...@@ -117,6 +117,7 @@ val cond_simpl = store_thm (
val real_prove = val real_prove =
rpt (qpat_x_assum `!x. _` kall_tac) rpt (qpat_x_assum `!x. _` kall_tac)
\\ rpt (qpat_x_assum `_ ==> ! x. _` kall_tac)
\\ REAL_ASM_ARITH_TAC; \\ REAL_ASM_ARITH_TAC;
val validIntervalbounds_sound = store_thm ("validIntervalbounds_sound", val validIntervalbounds_sound = store_thm ("validIntervalbounds_sound",
...@@ -328,75 +329,31 @@ val validIntervalbounds_sound = store_thm ("validIntervalbounds_sound", ...@@ -328,75 +329,31 @@ val validIntervalbounds_sound = store_thm ("validIntervalbounds_sound",
\\ `SND iv = SND intv` by (metis_tac [REAL_LE_ANTISYM]) \\ `SND iv = SND intv` by (metis_tac [REAL_LE_ANTISYM])
\\ fs[])); \\ fs[]));
val Rmap_updVars_comm = store_thm (
"Rmap_updVars_comm",
``!Gamma n m x.
updDefVars n REAL (toRMap Gamma) x = toRMap (updDefVars n m Gamma) x``,
fs [updDefVars_def, toRMap_def]
\\ rpt strip_tac
\\ Cases_on `x = n` \\ fs[]);
val swap_Gamma_eval_expr = store_thm (
"swap_Gamma_expr_expr",
``!e E vR m Gamma1 Gamma2 fBits.
(!n. Gamma1 n = Gamma2 n) /\
eval_expr E Gamma1 fBits e vR m ==>
eval_expr E Gamma2 fBits e vR m``,
Induct_on `e`
\\ rpt strip_tac
\\ inversion `eval_expr _ _ _ _ _ _` eval_expr_cases
\\ fs[eval_expr_cases] \\ res_tac
>- (qpat_x_assum `!n. _ = _` (fn thm => fs [GSYM thm]))
>- (qexists_tac `delta` \\ fs[])
>- (qexists_tac `v1` \\ fs[])
>- (qexistsl_tac [`v1`, `delta`] \\ fs[])
>- (qexistsl_tac [`m1`, `m2`, `v1`, `v2`, `delta`, `fBit`] \\ fs[])
>- (qexistsl_tac [`m1`, `m2`, `m3`, `v1`, `v2`, `v3`, `delta`, `fBit`] \\ fs[])
>- (qexistsl_tac [`m1'`, `v1`, `delta`] \\ fs[]));
val swap_Gamma_bstep = store_thm (
"swap_Gamma_bstep",
``!f E vR m Gamma1 Gamma2 fBits.
(!n. Gamma1 n = Gamma2 n) /\
bstep f E Gamma1 fBits vR m ==>
bstep f E Gamma2 fBits vR m``,
Induct_on `f`
\\ rpt strip_tac \\ inversion `bstep _ _ _ _ _ _` bstep_cases
\\ fs[bstep_cases]
>- (qexists_tac `v` \\ conj_tac
>- (irule swap_Gamma_eval_expr \\ qexists_tac `Gamma1` \\ fs[])
>- (res_tac \\ first_x_assum irule
\\ fs [updDefVars_def]))
>- (irule swap_Gamma_eval_expr \\ qexists_tac `Gamma1` \\ fs[]));
val validIntervalboundsCmd_sound = store_thm ( val validIntervalboundsCmd_sound = store_thm (
"validIntervalboundsCmd_sound", "validIntervalboundsCmd_sound",
``!f A E fVars dVars outVars P Gamma fBits. ``!f A E fVars dVars outVars P Gamma.
ssa f (union fVars dVars) outVars /\ ssa f (union fVars dVars) outVars /\
dVars_range_valid dVars E A /\ dVars_range_valid dVars E A /\
fVars_P_sound fVars E P /\ fVars_P_sound fVars E P /\
vars_typed ((domain fVars) UNION (domain dVars)) Gamma /\
(((domain (freeVars f)) DIFF (domain dVars)) SUBSET (domain fVars)) /\ (((domain (freeVars f)) DIFF (domain dVars)) SUBSET (domain fVars)) /\
validIntervalboundsCmd f A P dVars ==> validIntervalboundsCmd f A P dVars /\
?iv err vR. validTypesCmd f Gamma ==>
FloverMapTree_find (getRetExp f) A = SOME (iv, err) /\ validRangesCmd f A E (toRTMap (toRExpMap Gamma))``,
(bstep (toREvalCmd f) E (toRMap Gamma) fBits vR REAL /\
FST iv <= vR /\ vR <= SND iv)``,
Induct_on `f` Induct_on `f`
\\ rpt gen_tac \\ once_rewrite_tac [toREvalCmd_def, getRetExp_def, validTypesCmd_def]
\\ once_rewrite_tac [toREvalCmd_def, getRetExp_def]
\\ rpt strip_tac \\ rpt strip_tac
\\ Flover_compute ``validIntervalboundsCmd`` \\ Flover_compute ``validIntervalboundsCmd``
>- (inversion `ssa _ _ _` ssa_cases \\ rveq >- (inversion `ssa _ _ _` ssa_cases \\ rveq
\\ drule validIntervalbounds_sound \\ drule validIntervalbounds_sound
\\ rpt (disch_then drule) \\ rpt (disch_then drule)
\\ disch_then (qspecl_then [`fVars`, `Gamma`, `fBits`] destruct) \\ disch_then (qspecl_then [`fVars`, `Gamma`] destruct)
>- (fs [SUBSET_DEF, domain_union] >- (fs [SUBSET_DEF, domain_union]
\\ rpt strip_tac \\ res_tac) \\ rpt strip_tac \\ res_tac)
\\ IMP_RES_TAC validRanges_single
\\ rename1 `FloverMapTree_find e A = SOME (iv_e, err_e)` \\ rename1 `FloverMapTree_find e A = SOME (iv_e, err_e)`
\\ first_x_assum \\ first_x_assum
(qspecl_then [`A`, `updEnv n vR E`, `fVars`, `insert n () dVars`, (qspecl_then [`A`, `updEnv n vR E`, `fVars`, `insert n () dVars`,
`outVars`, `P`, `updDefVars n REAL Gamma`, `fBits`] `outVars`, `P`, `Gamma`]
destruct) destruct)
>- (fs [domain_insert] >- (fs [domain_insert]
\\ rpt conj_tac \\ rpt conj_tac
...@@ -415,30 +372,31 @@ val validIntervalboundsCmd_sound = store_thm ( ...@@ -415,30 +372,31 @@ val validIntervalboundsCmd_sound = store_thm (
\\ rpt strip_tac \\ fs[updEnv_def] \\ rpt strip_tac \\ fs[updEnv_def]
\\ rename1 `v2 IN domain fVars` \\ rename1 `v2 IN domain fVars`
\\ Cases_on `v2 = n` \\ rveq \\ fs[domain_union]) \\ Cases_on `v2 = n` \\ rveq \\ fs[domain_union])
>- (fs[vars_typed_def] \\ fs [domain_insert, SUBSET_DEF]
\\ rpt strip_tac \\ rveq \\ fs [updDefVars_def] \\ rpt strip_tac
\\ rename1 `v2 IN domain _` \\ Cases_on `v2 = n` \\ fs[]) \\ first_x_assum match_mp_tac
>- (fs [domain_insert, SUBSET_DEF] \\ once_rewrite_tac [freeVars_def, domain_union]
\\ rpt strip_tac \\ fs [domain_union])
\\ first_x_assum match_mp_tac \\ simp[Once validRangesCmd_def]
\\ once_rewrite_tac [freeVars_def, domain_union] \\ conj_tac
\\ fs [domain_union])) >- (rpt strip_tac
\\ asm_exists_tac \\ `vR = vR'` by (metis_tac [meps_0_deterministic])
\\ rename1 `FST iv_f <= vR_f` \\ qexists_tac `vR_f` \\ rveq \\ fs[])
\\ fs[] \\ IMP_RES_TAC validRangesCmd_single
\\ irule let_b \\ qexists_tac `vR` \\ fs[] \\ fs[getRetExp_def]
\\ irule swap_Gamma_bstep \\ find_exists_tac \\ simp[Once toREvalCmd_def]
\\ qexists_tac `(toRMap (updDefVars n REAL Gamma))` \\ irule let_b \\ find_exists_tac \\ fs[])
\\ fs[Rmap_updVars_comm]) \\ inversion `ssa _ _ _` ssa_cases
>- (inversion `ssa _ _ _` ssa_cases \\ drule validIntervalbounds_sound
\\ drule validIntervalbounds_sound \\ rpt (disch_then drule)
\\ rpt (disch_then drule) \\ disch_then (qspecl_then [`fVars`, `Gamma`] destruct)
\\ disch_then (qspecl_then [`fVars`, `Gamma`, `fBits`] destruct) >- (fs [freeVars_def])
>- (fs [freeVars_def]) \\ simp[Once validRangesCmd_def]
\\ asm_exists_tac \\ IMP_RES_TAC validRanges_single
\\ qexists_tac `vR` \\ fs[] \\ simp[Once getRetExp_def, Once toREvalCmd_def]
\\ irule ret_b \\ fs[])); \\ fs[] \\ find_exists_tac \\ fs[ret_b]);
(*
val validIntervalbounds_noDivzero_real = store_thm("validIntervalbounds_noDivzero_real", val validIntervalbounds_noDivzero_real = store_thm("validIntervalbounds_noDivzero_real",
``!(f1 f2:real expr) A (P:precond) (dVars:num_set). ``!(f1 f2:real expr) A (P:precond) (dVars:num_set).
validIntervalbounds (Binop Div f1 f2) A P dVars ==> validIntervalbounds (Binop Div f1 f2) A P dVars ==>
...@@ -447,104 +405,17 @@ val validIntervalbounds_noDivzero_real = store_thm("validIntervalbounds_noDivzer ...@@ -447,104 +405,17 @@ val validIntervalbounds_noDivzero_real = store_thm("validIntervalbounds_noDivzer
noDivzero (SND iv) (FST iv)``, noDivzero (SND iv) (FST iv)``,
rpt strip_tac \\ Flover_compute ``validIntervalbounds`` rpt strip_tac \\ Flover_compute ``validIntervalbounds``
\\ fs[noDivzero_def, IVhi_def, IVlo_def]); \\ fs[noDivzero_def, IVhi_def, IVlo_def]);
*)
val validIntervalbounds_validates_iv = store_thm ("validIntervalbounds_validates_iv", val validRanges_validates_iv = store_thm (
``!(f:real expr) (A:analysisResult) (P:precond) (dVars:num_set). "validRanges_validates_iv",
(!v. v IN domain dVars ==> ``! e Gamma E A.
? iv err. FloverMapTree_find (Var v) A = SOME (iv,err) /\ validRanges e A E Gamma ==>
valid iv) /\
validIntervalbounds f A P dVars ==>
? iv err. ? iv err.
FloverMapTree_find f A = SOME (iv, err) /\ FloverMapTree_find e A = SOME (iv, err) /\
valid iv``, valid iv``,
Induct_on `f` Induct_on `e` \\ simp[Once validRanges_def]
\\ rpt strip_tac \\ rpt strip_tac
\\ Flover_compute ``validIntervalbounds`` \\ fs[valid_def] \\ real_prove);
>- (first_x_assum (qspecl_then [`n`] destruct)
\\ fs[domain_lookup, valid_def, isSupersetInterval_def, validIntervalbounds_def]
\\ rveq \\ fs[])
>- (fs[isSupersetInterval_def, valid_def, validIntervalbounds_def]
\\ irule REAL_LE_TRANS
\\ asm_exists_tac \\ conj_tac \\ fs[IVlo_def, IVhi_def]
\\ irule REAL_LE_TRANS \\ asm_exists_tac \\ fs[])
>- (fs[valid_def, IVlo_def, IVhi_def]
\\ irule REAL_LE_TRANS \\ asm_exists_tac \\ fs[])
>- (first_x_assum (qspecl_then [`A`, `P`, `dVars`] destruct)
\\ fs[]
\\ rveq \\ Cases_on `u`
>- (`valid (negateInterval iv)`
by (irule iv_neg_preserves_valid \\ fs[])
\\ fs[valid_def, isSupersetInterval_def]
\\ irule REAL_LE_TRANS
\\ asm_exists_tac \\ fs[]
\\ irule REAL_LE_TRANS
\\ asm_exists_tac \\ fs[])
>- (`valid (invertInterval iv)`
by (irule iv_inv_preserves_valid \\ fs[])
\\ fs[valid_def, isSupersetInterval_def]
>- (irule REAL_LE_TRANS
\\ asm_exists_tac \\ fs[]
\\ irule REAL_LE_TRANS
\\ asm_exists_tac \\ fs[])
\\ irule REAL_LE_TRANS
\\ asm_exists_tac \\ fs[]
\\ irule REAL_LE_TRANS
\\ asm_exists_tac \\ fs[]))
>- (rename1 `Binop b f1 f2`
\\ rpt (first_x_assum (qspecl_then [`A`, `P`, `dVars`] destruct) \\ fs[])
\\ rveq \\ fs[]
\\ rename1 `FloverMapTree_find f1 A = SOME (iv_f1, err_f1)`
\\ rename1 `FloverMapTree_find f2 A = SOME (iv_f2, err_f2)`
\\ fs[]
\\ Cases_on `b`
>- (`valid (addInterval iv_f1 iv_f2)`
by (irule iv_add_preserves_valid \\ fs[])
\\ fs[valid_def, isSupersetInterval_def]
\\ irule REAL_LE_TRANS
\\ asm_exists_tac \\ fs []
\\ irule REAL_LE_TRANS
\\ asm_exists_tac \\ fs [])
>- (`valid (subtractInterval iv_f1 iv_f2)`
by (irule iv_sub_preserves_valid \\ fs[])
\\ fs[valid_def, isSupersetInterval_def]
\\ irule REAL_LE_TRANS
\\ asm_exists_tac \\ fs []
\\ irule REAL_LE_TRANS
\\ asm_exists_tac \\ fs [])
>- (`valid (multInterval iv_f1 iv_f2)`
by (irule iv_mult_preserves_valid \\ fs[])
\\ fs[valid_def, isSupersetInterval_def]
\\ irule REAL_LE_TRANS
\\ asm_exists_tac \\ fs []
\\ irule REAL_LE_TRANS
\\ asm_exists_tac \\ fs [])
>- (`valid (divideInterval iv_f1 iv_f2)`
by (match_mp_tac iv_div_preserves_valid \\ fs[])
\\ fs[valid_def, isSupersetInterval_def]
\\ match_mp_tac REAL_LE_TRANS
\\ asm_exists_tac \\ fs []
\\ match_mp_tac REAL_LE_TRANS
\\ asm_exists_tac \\ fs []))
>- (rename1 `Fma f1 f2 f3`
\\ rpt (first_x_assum (qspecl_then [`A`, `P`, `dVars`] destruct) \\ fs[])
\\ rveq \\ fs[]
\\ rename1 `FloverMapTree_find f1 A = SOME (iv_f1, err_f1)`
\\ rename1 `FloverMapTree_find f2 A = SOME (iv_f2, err_f2)`
\\ rename1 `FloverMapTree_find f3 A = SOME (iv_f3, err_f3)`
\\ fs[]
\\ `valid (addInterval iv_f1 (multInterval iv_f2 iv_f3))`
by (irule iv_add_preserves_valid \\ fs[]
\\ irule iv_mult_preserves_valid \\ fs[])
\\ fs[valid_def, isSupersetInterval_def]
\\ irule REAL_LE_TRANS
\\ asm_exists_tac \\ fs []
\\ irule REAL_LE_TRANS
\\ asm_exists_tac \\ fs [])
>- (first_x_assum (qspecl_then [`A`, `P`, `dVars`] destruct) \\ fs[]
\\ fs[isSupersetInterval_def, IVlo_def, IVhi_def]
\\ rveq
\\ `FST iv = FST intv` by (metis_tac[REAL_LE_ANTISYM])
\\ `SND iv = SND intv` by (metis_tac[REAL_LE_ANTISYM])
\\ fs[valid_def, IVlo_def, IVhi_def]));
val _ = export_theory(); val _ = export_theory();
...@@ -11,7 +11,6 @@ val _ = Datatype ` ...@@ -11,7 +11,6 @@ val _ = Datatype `
| DABS | DABS
| DCOND | DCOND
| DGAMMA | DGAMMA
| DFBITS
| DTYPE mType | DTYPE mType
| DFIXED | DFIXED
| DVAR | DVAR
...@@ -81,7 +80,6 @@ val lex_def = tDefine "lex" ` ...@@ -81,7 +80,6 @@ val lex_def = tDefine "lex" `
| "PRE" => DPRE :: lex input'' | "PRE" => DPRE :: lex input''
| "ABS" => DABS :: lex input'' | "ABS" => DABS :: lex input''
| "GAMMA" => DGAMMA :: lex input'' | "GAMMA" => DGAMMA :: lex input''
| "FBITS" => DFBITS :: lex input''
| "Var" => DVAR :: lex input'' | "Var" => DVAR :: lex input''
| "Cast" => DCAST :: lex input'' | "Cast" => DCAST :: lex input''
| "F" => DFIXED :: lex input'' | "F" => DFIXED :: lex input''
...@@ -147,7 +145,6 @@ val pp_token_def = Define ` ...@@ -147,7 +145,6 @@ val pp_token_def = Define `
| DVAR => "Var" | DVAR => "Var"
| DCONST num => str_of_num num | DCONST num => str_of_num num
| DGAMMA => "GAMMA" | DGAMMA => "GAMMA"
| DFBITS => "FBITS"
| DTYPE m => type_to_string m | DTYPE m => type_to_string m
| DFIXED => "" | DFIXED => ""
| DNEG => "~" | DNEG => "~"
...@@ -433,16 +430,23 @@ val parseAbsEnv_def = Define ` ...@@ -433,16 +430,23 @@ val parseAbsEnv_def = Define `
| _ => NONE`; | _ => NONE`;
val defaultGamma_def = Define ` val defaultGamma_def = Define `
defaultGamma:num -> mType option = \n. NONE`; defaultGamma:mType fMap = FloverMapTree_empty`;
val parseGammaRec_def = Define ` val parseGammaRec_def = tDefine "parseGammaRec"
parseGammaRec (input: Token list) : ((num -> mType option) # Token list) option = `parseGammaRec (input: Token list) : (typeMap # Token list) option =
(case input of (case parseExp input of
| DVAR :: DCONST n :: DTYPE m :: inputRest => |NONE => SOME (defaultGamma, input)
|SOME (e,residual) =>
(case residual of
| DCONST n :: DTYPE m :: inputRest =>
(case parseGammaRec inputRest of (case parseGammaRec inputRest of
| SOME (Gamma, rest) => SOME (updDefVars n m Gamma, rest) | SOME (Gamma, rest) =>
SOME (FloverMapTree_insert e m Gamma, rest)
| NONE => NONE) | NONE => NONE)
| _ => SOME (defaultGamma, input))`; | _ => SOME (defaultGamma, input)))`
(WF_REL_TAC `measure LENGTH` \\ rw[]
\\ IMP_RES_TAC parseExp_LESS_EQ
\\ fs[]);
val parseGamma_def = Define ` val parseGamma_def = Define `
parseGamma (input:Token list) = parseGamma (input:Token list) =
...@@ -450,30 +454,6 @@ val parseGamma_def = Define ` ...@@ -450,30 +454,6 @@ val parseGamma_def = Define `
| DGAMMA :: tokenRest => parseGammaRec tokenRest | DGAMMA :: tokenRest => parseGammaRec tokenRest
| _ => NONE`; | _ => NONE`;
val defaultFBits = Define `
defaultFBits = FloverMapTree_empty`;
val parseFBitsRec_def = tDefine "parseFBitsRec" `
parseFBitsRec (input: Token list) akk =
(case input of
| [] => SOME (akk, [])
| _ =>
(case parseExp input of
|NONE => SOME (akk, input)
|SOME (e, res1) =>
(case res1 of
|DCONST n :: res2 => parseFBitsRec res2 (FloverMapTree_insert e n akk)
| _ => SOME (akk, input))))`
(WF_REL_TAC `measure (LENGTH o FST)` \\ fs[]
\\ rpt strip_tac
\\ IMP_RES_TAC parseExp_LESS_EQ \\ fs[]);
val parseFBits_def = Define `
parseFBits input =
(case input of
|DFBITS:: tokRest => parseFBitsRec tokRest defaultFBits
|_ => NONE)`;
(* Global parsing function*) (* Global parsing function*)
val dParse_def = Define ` val dParse_def = Define `
dParse (input:Token list) = dParse (input:Token list) =
...@@ -494,9 +474,6 @@ val dParse_def = Define ` ...@@ -494,9 +474,6 @@ val dParse_def = Define `
(case parseAbsEnv residual of (case parseAbsEnv residual of
|NONE => NONE |NONE => NONE
|SOME (A, residual) => |SOME (A, residual) =>
(case parseFBits residual of SOME ((dCmd, P, A, Gamma), residual))))`;
|NONE => NONE
|SOME (fBits, residual) =>
SOME ((dCmd, P, A, Gamma, fBits), residual)))))`;
val _ = export_theory(); val _ = export_theory();
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment