Commit b6376565 authored by Heiko Becker's avatar Heiko Becker

Show stronger IV soundnes in HOL4

parent f4caeb89
......@@ -259,7 +259,7 @@ Inductive eval_exp (E:env) (Gamma: nat -> option mType) :(exp R) -> R -> mType -
Hint Constructors eval_exp.
(**
Show some simpler rule lemmata
Show some simpler (more general) rule lemmata
**)
Lemma Const_dist' m n delta v m' E Gamma:
Rle (Rabs delta) (Q2R (mTypeToQ m)) ->
......@@ -276,7 +276,7 @@ Lemma Unop_neg' m f1 v1 v m' E Gamma:
eval_exp E Gamma f1 v1 m ->
v = evalUnop Neg v1 ->
m' = m ->
eval_exp E Gamma (Unop Neg f1) (evalUnop Neg v1) m'.
eval_exp E Gamma (Unop Neg f1) v m'.
Proof.
intros; subst; auto.
Qed.
......
......@@ -370,7 +370,7 @@ Proof.
lra.
Qed.
Lemma test3 Gamma n m:
Lemma Rmap_updVars_comm Gamma n m:
forall x,
updDefVars n M0 (toRMap Gamma) x = toRMap (updDefVars n m Gamma) x.
Proof.
......@@ -378,25 +378,25 @@ Proof.
intros x; destruct (x =? n); try auto.
Qed.
Lemma test2 e n Gamma E v:
eval_exp E (toRMap (updDefVars n M0 Gamma)) (toREval (toRExp e)) v M0 ->
eval_exp E (updDefVars n M0 (toRMap Gamma)) (toREval (toRExp e)) v M0.
Proof.
revert v;
induction e; intros * eval_e; inversion eval_e; subst; simpl in *;
auto.
- constructor; try auto.
erewrite test3; eauto.
- rewrite H2 in *.
apply M0_join_is_M0 in H2.
destruct H2; subst.
eauto.
- apply M0_least_precision in H1; subst.
econstructor; try eauto.
apply isMorePrecise_refl.
Qed.
(* Lemma eval_exp_Rmap_updVars_comm e n Gamma E v: *)
(* eval_exp E (toRMap (updDefVars n M0 Gamma)) (toREval (toRExp e)) v M0 -> *)
(* eval_exp E (updDefVars n M0 (toRMap Gamma)) (toREval (toRExp e)) v M0. *)
(* Proof. *)
(* revert v; *)
(* induction e; intros * eval_e; inversion eval_e; subst; simpl in *; *)
(* auto. *)
(* - constructor; try auto. *)
(* erewrite test3; eauto. *)
(* - rewrite H2 in *. *)
(* apply M0_join_is_M0 in H2. *)
(* destruct H2; subst. *)
(* eauto. *)
(* - apply M0_least_precision in H1; subst. *)
(* econstructor; try eauto. *)
(* apply isMorePrecise_refl. *)
(* Qed. *)
Lemma test5 e E vR m Gamma1 Gamma2:
Lemma swap_Gamma_eval_exp e E vR m Gamma1 Gamma2:
(forall n, Gamma1 n = Gamma2 n) ->
eval_exp E Gamma1 e vR m ->
eval_exp E Gamma2 e vR m.
......@@ -409,7 +409,7 @@ Proof.
rewrite <- Gamma_eq; auto.
Qed.
Lemma test4 f E vR m Gamma1 Gamma2 :
Lemma swap_Gamma_bstep f E vR m Gamma1 Gamma2 :
(forall n, Gamma1 n = Gamma2 n) ->
bstep f E Gamma1 vR m ->
bstep f E Gamma2 vR m.
......@@ -418,14 +418,14 @@ Proof.
induction f; intros * Gamma_eq eval_f.
- inversion eval_f; subst.
econstructor; try eauto.
+ eapply test5; eauto.
+ eapply swap_Gamma_eval_exp; eauto.
+ apply (IHf _ (updDefVars n m0 Gamma1) _); try eauto.
intros n1.
unfold updDefVars.
case (n1 =? n); auto.
- inversion eval_f; subst.
econstructor; try eauto.
eapply test5; eauto.
eapply swap_Gamma_eval_exp; eauto.
Qed.
Theorem validIntervalboundsCmd_sound (f:cmd Q) (absenv:analysisResult) Gamma:
......@@ -474,7 +474,7 @@ Proof.
rewrite NatSet.union_spec, NatSet.add_spec in in_set.
destruct in_set as [P1 | [ P2 | P3]]; auto.
+ edestruct IHf as [vR [eval_f valid_bounds_f]]; try eauto.
{ eapply ssa_equal_set. symmetry in H. apply H. apply H7. }
eapply ssa_equal_set. symmetry in H. apply H. apply H7. }
* intros v0 mem_v0.
unfold updEnv.
case_eq (v0 =? n); intros v0_eq.
......@@ -533,7 +533,7 @@ Proof.
apply a_no_dVar.
rewrite NatSet.add_spec; auto. }
* simpl. exists vR; split; [econstructor; eauto | auto].
eapply test4 with (Gamma1 := toRMap (updDefVars n M0 Gamma)) ; try eauto.
eapply swap_Gamma_bstep with (Gamma1 := toRMap (updDefVars n M0 Gamma)) ; try eauto.
intros n1; rewrite <- test3; auto.
- unfold validIntervalboundsCmd in valid_bounds_f.
pose proof (validIntervalbounds_sound e absenv P E Gamma valid_bounds_f dVars_sound usedVars_subset) as valid_iv_e.
......
......@@ -28,14 +28,13 @@ val toREvalCmd_def = Define `
result value
**)
val (bstep_rules, bstep_ind, bstep_cases) = Hol_reln `
(!m m' x e s E v res defVars.
eval_exp E defVars e v m /\
(defVars x = SOME m) /\
bstep s (updEnv x v E) defVars res m' ==>
bstep (Let m x e s) E defVars res m') /\
(!m e E v defVars.
eval_exp E defVars e v m ==>
bstep (Ret e) E defVars v m)`;
(!m m' x e s E v res Gamma.
eval_exp E Gamma e v m /\
bstep s (updEnv x v E) (updDefVars x m Gamma) res m' ==>
bstep (Let m x e s) E Gamma res m') /\
(!m e E v Gamma.
eval_exp E Gamma e v m ==>
bstep (Ret e) E Gamma v m)`;
(**
Generate a better case lemma again
......
......@@ -80,13 +80,14 @@ val (eval_exp_rules, eval_exp_ind, eval_exp_cases) = Hol_reln `
E x = SOME v ==>
eval_exp E defVars (Var x) v m) /\
(!E defVars m n delta.
abs delta <= (mTypeToQ m) ==>
abs delta <= (mTypeToQ m) ==>
eval_exp E defVars (Const m n) (perturb n delta) m) /\
(!E defVars m f1 v1.
eval_exp E defVars f1 v1 m ==>
eval_exp E defVars (Unop Neg f1) (evalUnop Neg v1) m) /\
(!E defVars m f1 v1 delta.
abs delta <= (mTypeToQ m) /\
(v1 <> 0) /\
eval_exp E defVars f1 v1 m ==>
eval_exp E defVars (Unop Inv f1) (perturb (evalUnop Inv v1) delta) m) /\
(!E defVars m m1 f1 v1 delta.
......@@ -109,10 +110,10 @@ val eval_exp_cases_old = save_thm ("eval_exp_cases_old", eval_exp_cases);
val eval_exp_cases =
map (GEN_ALL o SIMP_CONV (srw_ss()) [Once eval_exp_cases])
[``eval_exp E defVars (Var v) res m``,
``eval_exp E defVars (Const m n) res m``,
``eval_exp E defVars (Const m1 n) res m2``,
``eval_exp E defVars (Unop u e) res m``,
``eval_exp E defVars (Binop n e1 e2) res m``,
``eval_exp E defVars (Downcast m e1) res m``]
``eval_exp E defVars (Downcast m1 e1) res m2``]
|> LIST_CONJ |> curry save_thm "eval_exp_cases";
val [Var_load, Const_dist, Unop_neg, Unop_inv, Downcast_dist, Binop_dist] = CONJ_LIST 6 eval_exp_rules;
......
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