Prove full IEEE connection in HOL4

hol4/CertificateCheckerScript.sml

@@ -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)) ==>

hol4/CommandsScript.sml

@@ -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 ();

hol4/ExpressionsScript.sml

@@ -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 *)
 (* **) *)