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 ->
......
......@@ -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