Commit 7f36eb27 authored by ='s avatar =
Browse files

Continuing the Port of errorvalidation

parent 4d669498
...@@ -14,6 +14,7 @@ expression may yield different values for different machine epsilons ...@@ -14,6 +14,7 @@ expression may yield different values for different machine epsilons
**) **)
Inductive approxEnv : env -> (nat -> option mType) -> analysisResult -> NatSet.t -> NatSet.t -> env -> Prop := Inductive approxEnv : env -> (nat -> option mType) -> analysisResult -> NatSet.t -> NatSet.t -> env -> Prop :=
|approxRefl A: |approxRefl A:
(* TODO: this is weird. why not start with defVars?*)
approxEnv emptyEnv (fun n => None) A NatSet.empty NatSet.empty emptyEnv approxEnv emptyEnv (fun n => None) A NatSet.empty NatSet.empty emptyEnv
|approxUpdFree E1 E2 defVars A v1 v2 x fVars dVars m: |approxUpdFree E1 E2 defVars A v1 v2 x fVars dVars m:
approxEnv E1 defVars A fVars dVars E2 -> approxEnv E1 defVars A fVars dVars E2 ->
......
...@@ -98,7 +98,7 @@ Fixpoint expEqBool (e1:exp Q) (e2:exp Q) := ...@@ -98,7 +98,7 @@ Fixpoint expEqBool (e1:exp Q) (e2:exp Q) :=
Lemma expEqBool_refl e: Lemma expEqBool_refl e:
expEqBool e e = true. expEqBool e e = true.
Proof. Proof.
induction e; try (apply andb_true_iff; split); simpl in *; auto; try (apply EquivEqBoolEq; auto). induction e; try (apply andb_true_iff; split); simpl in *; auto; try (apply EquivEqBoolEq; auto).
- symmetry; apply beq_nat_refl. - symmetry; apply beq_nat_refl.
- apply Qeq_bool_iff; lra. - apply Qeq_bool_iff; lra.
- case u; auto. - case u; auto.
...@@ -113,14 +113,14 @@ Proof. ...@@ -113,14 +113,14 @@ Proof.
case_eq (a =? b); intros. case_eq (a =? b); intros.
- apply beq_nat_true in H. - apply beq_nat_true in H.
rewrite H. rewrite H.
apply beq_nat_refl. apply beq_nat_refl.
- apply beq_nat_false in H. - apply beq_nat_false in H.
case_eq (b =? a); intros. case_eq (b =? a); intros.
+ apply beq_nat_true in H0. + apply beq_nat_true in H0.
rewrite H0 in H. rewrite H0 in H.
auto. auto.
+ auto. + auto.
Qed. Qed.
Lemma expEqBool_sym e e': Lemma expEqBool_sym e e':
expEqBool e e' = expEqBool e' e. expEqBool e e' = expEqBool e' e.
...@@ -134,7 +134,7 @@ Proof. ...@@ -134,7 +134,7 @@ Proof.
- f_equal. - f_equal.
+ destruct u; auto. + destruct u; auto.
+ apply IHe. + apply IHe.
- f_equal. - f_equal.
+ destruct b; auto. + destruct b; auto.
+ f_equal. + f_equal.
* apply IHe1. * apply IHe1.
...@@ -154,7 +154,7 @@ Proof. ...@@ -154,7 +154,7 @@ Proof.
apply beq_nat_true in H1. apply beq_nat_true in H1.
subst. subst.
unfold expEqBool. unfold expEqBool.
rewrite <- beq_nat_refl. rewrite <- beq_nat_refl.
auto. auto.
- apply EquivEqBoolEq in H1. - apply EquivEqBoolEq in H1.
apply EquivEqBoolEq in H. apply EquivEqBoolEq in H.
...@@ -184,7 +184,7 @@ Proof. ...@@ -184,7 +184,7 @@ Proof.
eapply IHe; eauto. eapply IHe; eauto.
Qed. Qed.
Fixpoint toRExp (e:exp Q) := Fixpoint toRExp (e:exp Q) :=
match e with match e with
...@@ -289,7 +289,7 @@ Proof. ...@@ -289,7 +289,7 @@ Proof.
try repeat (repeat rewrite delta_0_deterministic; simpl in *; rewrite Q2R0_is_0 in *; subst; auto); simpl. try repeat (repeat rewrite delta_0_deterministic; simpl in *; rewrite Q2R0_is_0 in *; subst; auto); simpl.
- inversion eval_v1; inversion eval_v2; subst; auto; - inversion eval_v1; inversion eval_v2; subst; auto;
try repeat (repeat rewrite delta_0_deterministic; simpl in *; rewrite Q2R0_is_0 in *; subst; auto); simpl. try repeat (repeat rewrite delta_0_deterministic; simpl in *; rewrite Q2R0_is_0 in *; subst; auto); simpl.
+ apply Ropp_eq_compat. apply (IHf v0 v3 M0); auto. + apply Ropp_eq_compat. apply (IHf v0 v3 M0); auto.
+ inversion H4. + inversion H4.
+ inversion H5. + inversion H5.
+ rewrite (IHf v0 v3 M0); auto. + rewrite (IHf v0 v3 M0); auto.
...@@ -317,7 +317,7 @@ Qed. ...@@ -317,7 +317,7 @@ Qed.
(* - simpl; auto. *) (* - simpl; auto. *)
(* Qed. *) (* Qed. *)
(** (**
Evaluation with 0 as machine epsilon is deterministic Evaluation with 0 as machine epsilon is deterministic
**) **)
...@@ -329,7 +329,7 @@ Lemma meps_0_deterministic (f:exp R) (E:env) defVars: ...@@ -329,7 +329,7 @@ Lemma meps_0_deterministic (f:exp R) (E:env) defVars:
Proof. Proof.
intros v1 v2 ev1 ev2. intros v1 v2 ev1 ev2.
assert (M0 = M0) by auto. assert (M0 = M0) by auto.
apply (general_meps_0_deterministic f H ev1 ev2). apply (general_meps_0_deterministic f H ev1 ev2).
Qed. Qed.
......
...@@ -45,7 +45,7 @@ Fixpoint typeCmd (defVars:nat -> option mType) (f:cmd Q): option mType := ...@@ -45,7 +45,7 @@ Fixpoint typeCmd (defVars:nat -> option mType) (f:cmd Q): option mType :=
else None else None
|None => None |None => None
end end
|Ret e => typeExpression defVars e |Ret e => typeExpression defVars e
end. end.
Fixpoint typeMapCmd (defVars:nat -> option mType) (f:cmd Q) (f':exp Q) : option mType := Fixpoint typeMapCmd (defVars:nat -> option mType) (f:cmd Q) (f':exp Q) : option mType :=
...@@ -106,84 +106,84 @@ Fixpoint typeCheckCmd (c:cmd Q) (defVars:nat -> option mType) (tMap:exp Q -> opt ...@@ -106,84 +106,84 @@ Fixpoint typeCheckCmd (c:cmd Q) (defVars:nat -> option mType) (tMap:exp Q -> opt
| Ret e => typeCheck e defVars tMap | Ret e => typeCheck e defVars tMap
end. end.
Lemma eqTypeExpression e m defVars: (* Lemma eqTypeExpression e m defVars: *)
typeMap defVars e e = Some m <-> typeExpression defVars e = Some m. (* typeMap defVars e e = Some m <-> typeExpression defVars e = Some m. *)
Proof. (* Proof. *)
revert m defVars; induction e; intros. (* revert m defVars; induction e; intros. *)
- split; intros. (* - split; intros. *)
+ simpl in *. (* + simpl in *. *)
rewrite <- beq_nat_refl in H; simpl in H; auto. (* rewrite <- beq_nat_refl in H; simpl in H; auto. *)
+ simpl in *. (* + simpl in *. *)
rewrite <- beq_nat_refl; simpl; auto. (* rewrite <- beq_nat_refl; simpl; auto. *)
- split; intros; simpl in *. (* - split; intros; simpl in *. *)
+ rewrite mTypeEqBool_refl,Qeq_bool_refl in H; simpl in H; auto. (* + rewrite mTypeEqBool_refl,Qeq_bool_refl in H; simpl in H; auto. *)
+ rewrite mTypeEqBool_refl,Qeq_bool_refl; simpl; auto. (* + rewrite mTypeEqBool_refl,Qeq_bool_refl; simpl; auto. *)
- split; intros; simpl in *. (* - split; intros; simpl in *. *)
+ rewrite unopEqBool_refl,expEqBool_refl in H; simpl in H; auto. (* + rewrite unopEqBool_refl,expEqBool_refl in H; simpl in H; auto. *)
+ rewrite unopEqBool_refl,expEqBool_refl; simpl; auto. (* + rewrite unopEqBool_refl,expEqBool_refl; simpl; auto. *)
- split; intros; simpl in *. (* - split; intros; simpl in *. *)
+ rewrite binopEqBool_refl,expEqBool_refl,expEqBool_refl in H; simpl in H; auto. (* + rewrite binopEqBool_refl,expEqBool_refl,expEqBool_refl in H; simpl in H; auto. *)
+ rewrite binopEqBool_refl,expEqBool_refl,expEqBool_refl; simpl; auto. (* + rewrite binopEqBool_refl,expEqBool_refl,expEqBool_refl; simpl; auto. *)
- split; intros; simpl in *. (* - split; intros; simpl in *. *)
+ rewrite mTypeEqBool_refl,expEqBool_refl in H; simpl in H; auto. (* + rewrite mTypeEqBool_refl,expEqBool_refl in H; simpl in H; auto. *)
+ rewrite mTypeEqBool_refl,expEqBool_refl; simpl; auto. (* + rewrite mTypeEqBool_refl,expEqBool_refl; simpl; auto. *)
Qed. (* Qed. *)
Definition Gamma_stronger (Gamma1 Gamma2: exp Q -> option mType):= (* Definition Gamma_stronger (Gamma1 Gamma2: exp Q -> option mType):= *)
(forall e m, Gamma1 e = Some m -> Gamma2 e = Some m). (* (forall e m, Gamma1 e = Some m -> Gamma2 e = Some m). *)
Lemma Gamma_stronger_trans Gamma1 Gamma2 Gamma3 : (* Lemma Gamma_stronger_trans Gamma1 Gamma2 Gamma3 : *)
Gamma_stronger Gamma1 Gamma2 -> (* Gamma_stronger Gamma1 Gamma2 -> *)
Gamma_stronger Gamma2 Gamma3 -> (* Gamma_stronger Gamma2 Gamma3 -> *)
Gamma_stronger Gamma1 Gamma3. (* Gamma_stronger Gamma1 Gamma3. *)
Proof. (* Proof. *)
intros g12 g23 e m hyp. (* intros g12 g23 e m hyp. *)
unfold Gamma_stronger in g12,g23. (* unfold Gamma_stronger in g12,g23. *)
apply g23; apply g12; auto. (* apply g23; apply g12; auto. *)
Qed. (* Qed. *)
Lemma Gamma_strengthening e Gamma1 Gamma2 defVars:
Gamma_stronger Gamma1 Gamma2 -> (* Lemma Gamma_strengthening e Gamma1 Gamma2 defVars: *)
typeCheck e defVars Gamma1 = true -> (* Gamma_stronger Gamma1 Gamma2 -> *)
typeCheck e defVars Gamma2 = true. (* typeCheck e defVars Gamma1 = true -> *)
Proof. (* typeCheck e defVars Gamma2 = true. *)
revert Gamma1 Gamma2; induction e; intros. (* Proof. *)
- simpl in *. (* revert Gamma1 Gamma2; induction e; intros. *)
case_eq (Gamma1 (Var Q n)); intros; rewrite H1 in H0; [ | inversion H0 ]. (* - simpl in *. *)
specialize (H _ _ H1); rewrite H. (* case_eq (Gamma1 (Var Q n)); intros; rewrite H1 in H0; [ | inversion H0 ]. *)
auto. (* specialize (H _ _ H1); rewrite H. *)
- simpl in *. (* auto. *)
case_eq (Gamma1 (Const m v)); intros; rewrite H1 in H0; [ | inversion H0 ]. (* - simpl in *. *)
specialize (H _ _ H1); rewrite H. (* case_eq (Gamma1 (Const m v)); intros; rewrite H1 in H0; [ | inversion H0 ]. *)
auto. (* specialize (H _ _ H1); rewrite H. *)
- simpl in *. (* auto. *)
case_eq (Gamma1 (Unop u e)); intros; rewrite H1 in H0; [ | inversion H0 ]. (* - simpl in *. *)
rewrite (H _ _ H1). (* case_eq (Gamma1 (Unop u e)); intros; rewrite H1 in H0; [ | inversion H0 ]. *)
case_eq (Gamma1 e); intros; rewrite H2 in H0; [ | inversion H0 ]. (* rewrite (H _ _ H1). *)
apply andb_true_iff in H0; destruct H0. (* case_eq (Gamma1 e); intros; rewrite H2 in H0; [ | inversion H0 ]. *)
apply EquivEqBoolEq in H0; subst. (* apply andb_true_iff in H0; destruct H0. *)
rewrite (H _ _ H2). (* apply EquivEqBoolEq in H0; subst. *)
rewrite mTypeEqBool_refl; simpl. (* rewrite (H _ _ H2). *)
eapply IHe; eauto. (* rewrite mTypeEqBool_refl; simpl. *)
- simpl in *. (* eapply IHe; eauto. *)
case_eq (Gamma1 (Binop b e1 e2)); intros; rewrite H1 in H0; [ | inversion H0 ]. (* - simpl in *. *)
case_eq (Gamma1 e1); intros; rewrite H2 in H0; [ | inversion H0 ]. (* case_eq (Gamma1 (Binop b e1 e2)); intros; rewrite H1 in H0; [ | inversion H0 ]. *)
case_eq (Gamma1 e2); intros; rewrite H3 in H0; [ | inversion H0 ]. (* case_eq (Gamma1 e1); intros; rewrite H2 in H0; [ | inversion H0 ]. *)
rewrite (H _ _ H1), (H _ _ H2), (H _ _ H3). (* case_eq (Gamma1 e2); intros; rewrite H3 in H0; [ | inversion H0 ]. *)
andb_to_prop H0. (* rewrite (H _ _ H1), (H _ _ H2), (H _ _ H3). *)
rewrite L0; simpl. (* andb_to_prop H0. *)
apply andb_true_iff; split. (* rewrite L0; simpl. *)
+ eapply IHe1; eauto. (* apply andb_true_iff; split. *)
+ eapply IHe2; eauto. (* + eapply IHe1; eauto. *)
- simpl in *. (* + eapply IHe2; eauto. *)
case_eq (Gamma1 (Downcast m e)); intros; rewrite H1 in H0; [ | inversion H0 ]. (* - simpl in *. *)
case_eq (Gamma1 e); intros; rewrite H2 in H0; [ | inversion H0 ]. (* case_eq (Gamma1 (Downcast m e)); intros; rewrite H1 in H0; [ | inversion H0 ]. *)
rewrite (H _ _ H1), (H _ _ H2). (* case_eq (Gamma1 e); intros; rewrite H2 in H0; [ | inversion H0 ]. *)
andb_to_prop H0. (* rewrite (H _ _ H1), (H _ _ H2). *)
rewrite L0, R0; simpl. (* andb_to_prop H0. *)
eapply IHe; eauto. (* rewrite L0, R0; simpl. *)
Qed. (* eapply IHe; eauto. *)
(* Qed. *)
Theorem typingSoundnessExp e defVars E: Theorem typingSoundnessExp e defVars E:
......
...@@ -5,18 +5,19 @@ open AbbrevsTheory ExpressionAbbrevsTheory RealSimpsTheory CommandsTheory ...@@ -5,18 +5,19 @@ open AbbrevsTheory ExpressionAbbrevsTheory RealSimpsTheory CommandsTheory
val _ = new_theory "Environments"; val _ = new_theory "Environments";
val (approxEnv_rules, approxEnv_ind, approxEnv_cases) = Hol_reln ` val (approxEnv_rules, approxEnv_ind, approxEnv_cases) = Hol_reln `
(!(A:analysisResult). (!(defVars: num -> mType option) (A:analysisResult).
approxEnv emptyEnv A LN LN emptyEnv) /\ approxEnv emptyEnv defVars A LN LN emptyEnv) /\
(!(E1:env) (E2:env) (A:analysisResult) (fVars:num_set) (dVars:num_set) v1 v2 x. (!(E1:env) (E2:env) (defVars: num -> mType option) (A:analysisResult) (fVars:num_set) (dVars:num_set) v1 v2 x.
approxEnv E1 A fVars dVars E2 /\ approxEnv E1 defVars A fVars dVars E2 /\
(abs (v1 - v2) <= abs v1 * machineEpsilon) /\ (defVars x = SOME m) /\
(abs (v1 - v2) <= abs v1 * (meps m)) /\
(lookup x (union fVars dVars) = NONE) ==> (lookup x (union fVars dVars) = NONE) ==>
approxEnv (updEnv x v1 E1) A (insert x () fVars) dVars (updEnv x v2 E2)) /\ approxEnv (updEnv x v1 E1) defVars A (insert x () fVars) dVars (updEnv x v2 E2)) /\
(!(E1:env) (E2:env) (A:analysisResult) (fVars:num_set) (dVars:num_set) v1 v2 x. (!(E1:env) (E2:env) (defVars: num -> mType option) (A:analysisResult) (fVars:num_set) (dVars:num_set) v1 v2 x.
approxEnv E1 A fVars dVars E2 /\ approxEnv E1 defVars A fVars dVars E2 /\
(abs (v1 - v2) <= SND (A (Var x))) /\ (abs (v1 - v2) <= SND (A (Var x))) /\
(lookup x (union fVars dVars) = NONE) ==> (lookup x (union fVars dVars) = NONE) ==>
approxEnv (updEnv x v1 E1) A fVars (insert x () dVars) (updEnv x v2 E2))`; approxEnv (updEnv x v1 E1) defVars A fVars (insert x () dVars) (updEnv x v2 E2))`;
val [approxRefl, approxUpdFree, approxUpdBound] = CONJ_LIST 3 approxEnv_rules; val [approxRefl, approxUpdFree, approxUpdBound] = CONJ_LIST 3 approxEnv_rules;
save_thm ("approxRefl", approxRefl); save_thm ("approxRefl", approxRefl);
......
This diff is collapsed.
...@@ -121,6 +121,10 @@ save_thm ("Unop_inv", Unop_inv); ...@@ -121,6 +121,10 @@ save_thm ("Unop_inv", Unop_inv);
save_thm ("Binop_dist", Binop_dist); save_thm ("Binop_dist", Binop_dist);
save_thm ("Downcast_dist", Downcast_dist); save_thm ("Downcast_dist", Downcast_dist);
(* ``!E defVars m m' n delta. *)
(* eval_exp E defVars (Const m n) (perturb n delta) m' ==> m = m'`` *)
(* rpt strip_tac \\ inversion `eval_exp _ _ _ _ _` eval_exp_cases *)
(** (**
Define the set of "used" variables of an expression to be the set of variables Define the set of "used" variables of an expression to be the set of variables
occuring in it occuring in it
......
...@@ -99,7 +99,7 @@ val typeCheckCmd_def = Define ` ...@@ -99,7 +99,7 @@ val typeCheckCmd_def = Define `
val typingSoundnessExp = store_thm("typingSoundnessExp", val typingSoundnessExp = store_thm("typingSoundnessExp",
``!(v:real) (m:mType) (Gamma:real exp -> mType option). ``!(v:real) (m:mType) (Gamma:real exp -> mType option) E e defVars.
typeCheck e defVars Gamma /\ typeCheck e defVars Gamma /\
eval_exp E defVars e v m ==> eval_exp E defVars e v m ==>
(Gamma e = SOME m)``, (Gamma e = SOME m)``,
......
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