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