Commit 712ea61c authored by Heiko Becker's avatar Heiko Becker

Prove full IEEE connection in HOL4

parent 4ef8e1a3
......@@ -82,7 +82,7 @@ val Certificate_checking_is_sound = store_thm ("Certificate_checking_is_sound",
val CertificateCmd_checking_is_sound = store_thm ("CertificateCmd_checking_is_sound",
``!(f:real cmd) (absenv:analysisResult) (P:precond) defVars
(E1 E2:env) (outVars:num_set) fVars.
(E1 E2:env) (fVars:num_set).
approxEnv E1 defVars absenv (freeVars f) LN E2 /\
(!v.
v IN (domain (freeVars f)) ==>
......
......@@ -3,7 +3,7 @@
**)
open preamble
open simpLib realTheory realLib RealArith
open AbbrevsTheory ExpressionAbbrevsTheory MachineTypeTheory
open AbbrevsTheory ExpressionsTheory ExpressionAbbrevsTheory MachineTypeTheory
val _ = new_theory "Commands";
......@@ -68,4 +68,17 @@ val definedVars_def = Define `
|Let m (x:num) e g => insert x () (definedVars g)
|Ret e => LN`;
val bstep_eq_env = store_thm (
"bstep_eq_env",
``!f E1 E2 Gamma v m.
(!x. E1 x = E2 x) /\
bstep f E1 Gamma v m ==>
bstep f E2 Gamma v m``,
Induct \\ rpt strip_tac \\ fs[bstep_cases]
>- (qexists_tac `v'` \\ conj_tac
\\ TRY (drule eval_eq_env \\ disch_then drule \\ fs[] \\ FAIL_TAC"")
\\ first_x_assum irule \\ qexists_tac `updEnv n v' E1` \\ fs[]
\\ rpt strip_tac \\ fs[updEnv_def])
\\ irule eval_eq_env \\ asm_exists_tac \\ fs[]);
val _ = export_theory ();
......@@ -290,6 +290,26 @@ val binary_unfolding = store_thm("binary_unfolding",
fs [updEnv_def,updDefVars_def,join_def,eval_exp_cases,APPLY_UPDATE_THM,PULL_EXISTS]
\\ metis_tac []);
val eval_eq_env = store_thm (
"eval_eq_env",
``!e E1 E2 Gamma v m.
(!x. E1 x = E2 x) /\
eval_exp E1 Gamma e v m ==>
eval_exp E2 Gamma e v m``,
Induct \\ rpt strip_tac \\ fs[eval_exp_cases]
>- (`E1 n = E2 n` by (first_x_assum irule)
\\ fs[])
>- (qexists_tac `delta'` \\ fs[])
>- (rveq \\ qexists_tac `v1` \\ fs[]
\\ first_x_assum drule \\ disch_then irule \\ fs[])
>- (rveq \\ qexists_tac `v1` \\ fs[]
\\ qexists_tac `delta'` \\ fs[]
\\ first_x_assum drule \\ disch_then irule \\ fs[])
>- (rveq \\ qexistsl_tac [`m1`, `m2`, `v1`, `v2`, `delta'`]
\\ fs[] \\ conj_tac \\ first_x_assum irule \\ asm_exists_tac \\ fs[])
>- (rveq \\ qexistsl_tac [`m1'`, `v1`, `delta'`] \\ fs[]
\\ first_x_assum drule \\ disch_then irule \\ fs[]));
(* (** *)
(* Analogous lemma for unary expressions *)
(* **) *)
......
This diff is collapsed.
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