Commit c3d56410 authored by ='s avatar =

Typing of expressions is done. However, there are still some admits in the...

Typing of expressions is done. However, there are still some admits in the proofs, to be fixed in the following days.
parent 783b5d4a
......@@ -14,7 +14,7 @@ Require Export Daisy.Infra.ExpressionAbbrevs.
(** Certificate checking function **)
Definition CertificateChecker (e:exp Q) (absenv:analysisResult) (P:precond) :=
if (validIntervalbounds e absenv P NatSet.empty)
then (validErrorbound e (typeExpression e) absenv NatSet.empty)
then (validErrorbound e (fun (e:exp Q) => typeExpression e) absenv NatSet.empty)
else false.
(**
......@@ -47,20 +47,20 @@ Proof.
destruct iv as [ivlo ivhi].
rewrite absenv_eq; simpl.
eapply validErrorbound_sound; eauto.
- eapply typeExpressionIsSound; eauto.
- admit. (*eapply validTypeMap; eauto. *)
- hnf. intros a in_diff.
rewrite NatSet.diff_spec in in_diff.
apply fVars_subset.
destruct in_diff; auto.
- apply stupid; rewrite expEqBool_refl; auto.
- intros e0 v m0 v_in_empty.
- intros v m0 v_in_empty.
rewrite NatSet.mem_spec in v_in_empty.
inversion v_in_empty.
Qed.
Admitted.
(* Qed. *)
Definition CertificateCheckerCmd (f:cmd Q) (absenv:analysisResult) (P:precond) :=
if (validIntervalboundsCmd f absenv P NatSet.empty)
then (validErrorboundCmd f absenv NatSet.empty)
then (validErrorboundCmd f (fun e => typeExpression e) absenv NatSet.empty)
else false.
Theorem Certificate_checking_cmds_is_sound (f:cmd Q) (absenv:analysisResult) P:
......@@ -90,6 +90,7 @@ Proof.
destruct iv as [ivlo ivhi].
rewrite absenv_eq; simpl.
eapply (validErrorboundCmd_sound); eauto.
- admit. (* eapply typeMapCmdValid; eauto.*)
- instantiate (1 := outVars).
eapply ssa_equal_set; try eauto.
hnf.
......@@ -105,4 +106,4 @@ Proof.
- intros v m1 v_in_empty.
rewrite NatSet.mem_spec in v_in_empty.
inversion v_in_empty.
Qed.
\ No newline at end of file
Admitted.
\ No newline at end of file
......@@ -118,18 +118,17 @@ Qed.
Lemma validErrorboundCorrectVariable:
forall E1 E2 absenv (v:nat) nR nF e nlo nhi P fVars dVars m f,
(typeMap f) (Var Q m v) = Some m ->
forall E1 E2 absenv (v:nat) nR nF e nlo nhi P fVars dVars m Gamma,
validType Gamma (Var Q m v) m ->
approxEnv E1 absenv fVars dVars E2 ->
eval_exp E1 (toREval (toRExp (Var Q m v))) nR M0 ->
eval_exp E2 (toRExp (Var Q m v)) nF m ->
validIntervalbounds (Var Q m v) absenv P dVars = true ->
validErrorbound (Var Q m v) (typeMap f) absenv dVars = true ->
validErrorbound (Var Q m v) Gamma absenv dVars = true ->
(forall v1 m1,
NatSet.mem v1 dVars = true ->
(typeMap f) (Var Q m1 v1) = Some m1 ->
exists r : R,
E1 v1 = Some (r, M0) /\
exists r mv1,
E1 v1 = Some (r, M0) /\ Gamma (Var Q mv1 v1) = Some m1 /\
(Q2R (fst (fst (absenv (Var Q m1 v1)))) <= r <= Q2R (snd (fst (absenv (Var Q m1 v1)))))%R) ->
(forall v1, NatSet.mem v1 fVars= true ->
exists r, E1 v1 = Some (r, M0) /\
......@@ -137,7 +136,7 @@ Lemma validErrorboundCorrectVariable:
absenv (Var Q m v) = ((nlo, nhi), e) ->
(Rabs (nR - nF) <= (Q2R e))%R.
Proof.
intros * typing_ok approxCEnv eval_real eval_float bounds_valid subexpr_ok error_valid dVars_sound P_valid absenv_var.
intros * typing_ok approxCEnv eval_real eval_float bounds_valid error_valid dVars_sound P_valid absenv_var.
simpl in eval_real; inversion eval_real; inversion eval_float; subst.
rename H2 into E1_v;
rename H7 into E2_v.
......@@ -150,7 +149,7 @@ Proof.
(* congruence. *)
simpl in error_valid.
rewrite absenv_var in error_valid; simpl in error_valid; subst.
case_eq (typeExpression f (Var Q m v)); intros; rewrite H in error_valid; [ | inversion error_valid].
case_eq (Gamma (Var Q m v)); intros; rewrite H in error_valid; [ | inversion error_valid].
(* assert (mTypeEqBool m m && (v =? v) = true). *)
(* apply andb_true_iff; split; [ rewrite EquivEqBoolEq | apply beq_nat_true_iff ]; auto. *)
......@@ -184,7 +183,9 @@ Proof.
apply Qle_Rle in error_valid.
eapply Rle_trans; eauto.
rewrite Q2R_mult.
pose proof (typingVarDet _ _ _ H). symmetry in H2; subst.
inversion typing_ok; subst.
rewrite H in H5; inversion H5; subst.
clear H5 H3.
apply Rmult_le_compat_r.
{ apply inj_eps_posR. }
{ rewrite <- maxAbs_impl_RmaxAbs.
......@@ -192,22 +193,9 @@ Proof.
unfold contained; simpl.
assert ((toRExp (Var Q m x)) = Var R m x) by (simpl; auto).
rewrite <- H2 in eval_float.
pose proof (typeExpressionIsSound _ eval_float).
pose proof (validIntervalbounds_sound (Var Q m x) A P (E:=fun y : nat => if y =? x then Some (nR, M0) else E1 y) (vR:=nR) H3 bounds_valid (fVars := (NatSet.add x fVars))) as valid_bounds_prf.
pose proof (validIntervalbounds_sound A P (E:=fun y : nat => if y =? x then Some (nR, M0) else E1 y) (vR:=nR) typing_ok bounds_valid (fVars := (NatSet.add x fVars))) as valid_bounds_prf.
rewrite absenv_var in valid_bounds_prf; simpl in valid_bounds_prf.
apply valid_bounds_prf; try auto.
- intros v m0 v_mem_diff typing.
case_eq (mTypeEqBool m m0 && (x =? v)); intros; auto; rewrite H4 in typing; inversion typing; subst.
apply andb_true_iff in H4; destruct H4 as [H4m H4x]; rewrite Nat.eqb_eq in H4x; subst.
specialize (dVars_sound v m0 v_mem_diff).
apply dVars_sound; auto.
(* assert (mTypeEqBool m0 m0 && (v =? v) = true) by (apply andb_true_iff; split; [ apply mTypeEqBool_refl | rewrite <- beq_nat_refl ]; auto). *)
(* assert (isSubExpression (Var Q m0 v) (Var Q m0 v) = true) by (simpl; rewrite H4; auto). *)
(* specialize (dVars_sound H5). *)
(* simpl typeExpression in dVars_sound. *)
(* rewrite H4 in dVars_sound. *)
(* specialize (dVars_sound typing). *)
(* apply dVars_sound. *)
- intros v v_mem_diff.
rewrite NatSet.diff_spec, NatSet.singleton_spec in v_mem_diff.
destruct v_mem_diff as [v_eq v_no_dVar].
......@@ -216,18 +204,18 @@ Proof.
+ apply IHapproxCEnv; try auto.
* constructor; auto.
* constructor; auto.
* intros v0 m2 (*overVar*) mem_dVars (*isSubExpr*) typing.
specialize (dVars_sound v0 m2 (*overVar*) mem_dVars (*isSubExpr*) typing).
destruct dVars_sound as [vR0 [val_def iv_sound_val]].
* intros v0 m2 (*overVar*) mem_dVars (*isSubExpr*).
specialize (dVars_sound v0 m2 (*overVar*) mem_dVars (*isSubExpr*)).
destruct dVars_sound as [vR0 [mR0 iv_sound_val]].
case_eq (v0 =? x); intros case_mem;
rewrite case_mem in val_def; simpl in val_def.
rewrite case_mem in iv_sound_val; simpl in iv_sound_val.
{ rewrite Nat.eqb_eq in case_mem; subst.
rewrite NatSet.mem_spec in mem_dVars.
assert (NatSet.In x (NatSet.union fVars dVars))
as x_in_union by (rewrite NatSet.union_spec; auto).
rewrite <- NatSet.mem_spec in x_in_union;
rewrite x_in_union in *; congruence. }
{ exists vR0; split; auto. }
{ exists vR0, mR0; split; auto; destruct iv_sound_val as [E1_v0 iv_sound_val]; auto. }
* intros v0 v0_fVar.
assert (NatSet.mem v0 (NatSet.add x fVars) = true)
as v0_in_add by (rewrite NatSet.mem_spec, NatSet.add_spec; rewrite NatSet.mem_spec in v0_fVar; auto).
......@@ -273,16 +261,16 @@ Proof.
+ rewrite <- NatSet.mem_spec in v_dVar. rewrite v_dVar in case_dVars.
inversion case_dVars. }
{ rewrite not_in_add in error_valid; auto. }
* intros v0 m2 (*overVar*) mem_dVars (*isSubExpr*) typing.
* intros v0 m2 (*overVar*) mem_dVars (*isSubExpr*).
specialize (dVars_sound v0 m2 (*overVar*)).
rewrite absenv_var in *; simpl in *.
rewrite NatSet.mem_spec in mem_dVars.
assert (NatSet.In v0 (NatSet.add x dVars)) as v0_in_add.
{ rewrite NatSet.add_spec. right; auto. }
{ rewrite <- NatSet.mem_spec in v0_in_add.
specialize (dVars_sound v0_in_add (*isSubExpr*) typing).
destruct dVars_sound as [vR0 [val_def iv_sound_val]].
exists vR0; split; auto.
specialize (dVars_sound v0_in_add).
destruct dVars_sound as [vR0 [mR0 [val_def iv_sound_val]]].
exists vR0, mR0; split; auto.
unfold updEnv in val_def; simpl in val_def.
case_eq (v0 =? x); intros case_mem;
rewrite case_mem in val_def; simpl in val_def.
......@@ -303,192 +291,12 @@ Proof.
rewrite x_in_union in *; congruence.
Qed.
(* Lemma validErrorboundCorrectVariable: *)
(* forall E1 E2 absenv (v:nat) nR nF e nlo nhi P fVars dVars m, *)
(* approxEnv E1 absenv fVars dVars E2 -> *)
(* eval_exp E1 (toREval (toRExp (Var Q m v))) nR M0 -> *)
(* eval_exp E2 (toRExp (Var Q m v)) nF m -> *)
(* validIntervalbounds (Var Q m v) absenv P dVars = true -> *)
(* validErrorbound (Var Q m v) (typeExpression (Var Q m v)) absenv dVars = true -> *)
(* (forall v1 m1, *)
(* NatSet.mem v1 dVars = true -> *)
(* (typeExpression (Var Q m1 v1)) (Var Q m1 v1) = Some m1 -> *)
(* exists r : R, *)
(* E1 v1 = Some (r, M0) /\ *)
(* (Q2R (fst (fst (absenv (Var Q m1 v1)))) <= r <= Q2R (snd (fst (absenv (Var Q m1 v1)))))%R) -> *)
(* (forall v1, NatSet.mem v1 fVars= true -> *)
(* exists r, E1 v1 = Some (r, M0) /\ *)
(* (Q2R (fst (P v1)) <= r <= Q2R (snd (P v1)))%R) -> *)
(* absenv (Var Q m v) = ((nlo, nhi), e) -> *)
(* (Rabs (nR - nF) <= (Q2R e))%R. *)
(* Proof. *)
(* intros * approxCEnv eval_real eval_float bounds_valid error_valid dVars_sound P_valid absenv_var. *)
(* simpl in eval_real; inversion eval_real; inversion eval_float; subst. *)
(* rename H2 into E1_v; *)
(* rename H7 into E2_v. *)
(* (* assert ((typeExpression (Var Q m v)) (Var Q m v) = Some m) as tEv. *) *)
(* (* unfold typeExpression. unfold expEqBool. *) *)
(* (* case_eq (mTypeEqBool m m && (v =? v)); intros; auto. *) *)
(* (* apply andb_false_iff in H. destruct H. assert (mTypeEqBool m m = true) by (apply EquivEqBoolEq; auto). *) *)
(* (* congruence. *) *)
(* (* assert (v =? v = true) by (apply beq_nat_true_iff; auto). *) *)
(* (* congruence. *) *)
(* simpl in error_valid. *)
(* rewrite absenv_var in error_valid; simpl in error_valid. *)
(* assert (mTypeEqBool m m && (v =? v) = true). *)
(* apply andb_true_iff; split; [ rewrite EquivEqBoolEq | apply beq_nat_true_iff ]; auto. *)
(* rewrite H in error_valid. *)
(* rewrite <- andb_lazy_alt in error_valid. *)
(* andb_to_prop error_valid. *)
(* rename L into error_pos. *)
(* rename R into error_valid. *)
(* (* induction on the approximation relation to do a case distinction on whether *)
(* we argue currently about a free or a let bound variable *) *)
(* induction approxCEnv. *)
(* (* empty environment case, contradiction *) *)
(* - unfold emptyEnv in *; simpl in *. *)
(* congruence. *)
(* - unfold updEnv in *; simpl in *. *)
(* case_eq (v =? x); intros eq_case; rewrite eq_case in *. *)
(* + rewrite Nat.eqb_eq in eq_case; subst. *)
(* assert (NatSet.mem x dVars = false) as x_not_bound. *)
(* * case_eq (NatSet.mem x dVars); intros case_mem; try auto. *)
(* rewrite NatSet.mem_spec in case_mem. *)
(* assert (NatSet.In x (NatSet.union fVars dVars)) *)
(* as x_in_union by (rewrite NatSet.union_spec; auto). *)
(* rewrite <- NatSet.mem_spec in x_in_union. *)
(* rewrite x_in_union in *. *)
(* congruence. *)
(* * rewrite x_not_bound in error_valid. *)
(* inversion E1_v; inversion E2_v; subst. *)
(* eapply Rle_trans; try eauto. *)
(* apply Qle_bool_iff in error_valid. *)
(* apply Qle_Rle in error_valid. *)
(* eapply Rle_trans; eauto. *)
(* rewrite Q2R_mult. *)
(* apply Rmult_le_compat_r. *)
(* { apply inj_eps_posR. } *)
(* { rewrite <- maxAbs_impl_RmaxAbs. *)
(* apply contained_leq_maxAbs. *)
(* unfold contained; simpl. *)
(* assert ((toRExp (Var Q m x)) = Var R m x) by (simpl; auto). *)
(* rewrite <- H2 in eval_float. *)
(* pose proof (typeExpressionIsSound _ eval_float). *)
(* pose proof (validIntervalbounds_sound (Var Q m x) A P (E:=fun y : nat => if y =? x then Some (nR, M0) else E1 y) (vR:=nR) H3 bounds_valid (fVars := (NatSet.add x fVars))) as valid_bounds_prf. *)
(* rewrite absenv_var in valid_bounds_prf; simpl in valid_bounds_prf. *)
(* apply valid_bounds_prf; try auto. *)
(* - intros v m0 v_mem_diff typing. *)
(* case_eq (mTypeEqBool m m0 && (x =? v)); intros; auto; rewrite H4 in typing; inversion typing; subst. *)
(* apply andb_true_iff in H4; destruct H4 as [H4m H4x]; rewrite Nat.eqb_eq in H4x; subst. *)
(* specialize (dVars_sound v m0 v_mem_diff). *)
(* assert (mTypeEqBool m0 m0 && (v =? v) = true) by (apply andb_true_iff; split; [ apply mTypeEqBool_refl | rewrite <- beq_nat_refl ]; auto). *)
(* rewrite H4 in dVars_sound. *)
(* specialize (dVars_sound typing). *)
(* apply dVars_sound. *)
(* - intros v v_mem_diff. *)
(* rewrite NatSet.diff_spec, NatSet.singleton_spec in v_mem_diff. *)
(* destruct v_mem_diff as [v_eq v_no_dVar]. *)
(* subst. *)
(* rewrite NatSet.add_spec; auto. } *)
(* + apply IHapproxCEnv; try auto. *)
(* * constructor; auto. *)
(* * constructor; auto. *)
(* * intros v0 m1 mem_dVars typing. *)
(* specialize (dVars_sound v0 m1 mem_dVars typing). *)
(* destruct dVars_sound as [vR0 [val_def iv_sound_val]]. *)
(* case_eq (v0 =? x); intros case_mem; *)
(* rewrite case_mem in val_def; simpl in val_def. *)
(* { rewrite Nat.eqb_eq in case_mem; subst. *)
(* rewrite NatSet.mem_spec in mem_dVars. *)
(* assert (NatSet.In x (NatSet.union fVars dVars)) *)
(* as x_in_union by (rewrite NatSet.union_spec; auto). *)
(* rewrite <- NatSet.mem_spec in x_in_union; *)
(* rewrite x_in_union in *; congruence. } *)
(* { exists vR0; split; auto. } *)
(* * intros v0 v0_fVar. *)
(* assert (NatSet.mem v0 (NatSet.add x fVars) = true) *)
(* as v0_in_add by (rewrite NatSet.mem_spec, NatSet.add_spec; rewrite NatSet.mem_spec in v0_fVar; auto). *)
(* specialize (P_valid v0 v0_in_add). *)
(* case_eq (v0 =? x); intros case_v0; rewrite case_v0 in *; try auto. *)
(* rewrite Nat.eqb_eq in case_v0; subst. *)
(* assert (NatSet.mem x (NatSet.union fVars dVars) = true) *)
(* as x_in_union *)
(* by (rewrite NatSet.mem_spec, NatSet.union_spec; rewrite NatSet.mem_spec in v0_fVar; auto). *)
(* rewrite x_in_union in *; congruence. *)
(* - unfold updEnv in E1_v, E2_v; simpl in *. *)
(* case_eq (v =? x); intros eq_case; rewrite eq_case in *. *)
(* + rewrite Nat.eqb_eq in eq_case; subst. *)
(* inversion E1_v; inversion E2_v; subst. *)
(* rewrite absenv_var in *; auto. *)
(* + apply IHapproxCEnv; try auto. *)
(* * constructor; auto. *)
(* * constructor; auto. *)
(* * rewrite absenv_var. *)
(* case_eq (NatSet.mem v dVars); *)
(* intros case_dVars; rewrite case_dVars in *; simpl in *; try auto. *)
(* assert (NatSet.mem v (NatSet.add x dVars) = false) as not_in_add. *)
(* { case_eq (NatSet.mem v (NatSet.add x dVars)); *)
(* intros case_add; rewrite case_add in *; simpl in *; try auto. *)
(* - rewrite NatSet.mem_spec in case_add. *)
(* rewrite NatSet.add_spec in case_add. *)
(* destruct case_add as [v_eq_x | v_dVar]; subst. *)
(* + rewrite Nat.eqb_neq in eq_case. exfalso; apply eq_case; auto. *)
(* + rewrite <- NatSet.mem_spec in v_dVar. rewrite v_dVar in case_dVars. *)
(* inversion case_dVars. } *)
(* { rewrite absenv_var in bounds_valid. rewrite not_in_add in bounds_valid. *)
(* auto. } *)
(* * rewrite absenv_var in bounds_valid; simpl in *. *)
(* case_eq (NatSet.mem v dVars); *)
(* intros case_dVars; rewrite case_dVars in *; simpl in *; try auto. *)
(* assert (NatSet.mem v (NatSet.add x dVars) = false) as not_in_add. *)
(* { case_eq (NatSet.mem v (NatSet.add x dVars)); *)
(* intros case_add; rewrite case_add in *; simpl in *; try auto. *)
(* - rewrite NatSet.mem_spec in case_add. *)
(* rewrite NatSet.add_spec in case_add. *)
(* destruct case_add as [v_eq_x | v_dVar]; subst. *)
(* + rewrite Nat.eqb_neq in eq_case. exfalso; apply eq_case; auto. *)
(* + rewrite <- NatSet.mem_spec in v_dVar. rewrite v_dVar in case_dVars. *)
(* inversion case_dVars. } *)
(* { rewrite not_in_add in error_valid; auto. } *)
(* * intros v0 m1 mem_dVars typing. *)
(* specialize (dVars_sound v0 m1). *)
(* rewrite absenv_var in *; simpl in *. *)
(* rewrite NatSet.mem_spec in mem_dVars. *)
(* assert (NatSet.In v0 (NatSet.add x dVars)) as v0_in_add. *)
(* { rewrite NatSet.add_spec. right; auto. } *)
(* { rewrite <- NatSet.mem_spec in v0_in_add. *)
(* specialize (dVars_sound v0_in_add typing). *)
(* destruct dVars_sound as [vR0 [val_def iv_sound_val]]. *)
(* exists vR0; split; auto. *)
(* unfold updEnv in val_def; simpl in val_def. *)
(* case_eq (v0 =? x); intros case_mem; *)
(* rewrite case_mem in val_def; simpl in val_def. *)
(* - rewrite Nat.eqb_eq in case_mem; subst. *)
(* apply (NatSetProps.Dec.F.union_3 fVars) in mem_dVars. *)
(* rewrite <- NatSet.mem_spec in mem_dVars. *)
(* rewrite mem_dVars in *; congruence. *)
(* - auto. } *)
(* * rewrite absenv_var in bounds_valid. *)
(* intros v0 v0_fVar. *)
(* specialize (P_valid v0 v0_fVar). *)
(* unfold updEnv in P_valid; simpl in *. *)
(* case_eq (v0 =? x); intros case_v0; rewrite case_v0 in *; try auto. *)
(* rewrite Nat.eqb_eq in case_v0; subst. *)
(* assert (NatSet.mem x (NatSet.union fVars dVars) = true) *)
(* as x_in_union *)
(* by (rewrite NatSet.mem_spec, NatSet.union_spec; rewrite NatSet.mem_spec in v0_fVar; auto). *)
(* rewrite x_in_union in *; congruence. *)
(* Qed. *)
Lemma validErrorboundCorrectConstant:
forall E1 E2 absenv (n:Q) nR nF e nlo nhi dVars m f,
forall E1 E2 absenv (n:Q) nR nF e nlo nhi dVars m Gamma,
eval_exp E1 (toREval (toRExp (Const m n))) nR M0 ->
eval_exp E2 (toRExp (Const m n)) nF m ->
isSubExpression (Const m n) f = true ->
validErrorbound (Const m n) (typeExpression f) absenv dVars = true ->
validType Gamma (Const m n) m ->
validErrorbound (Const m n) Gamma absenv dVars = true ->
(Q2R nlo <= nR <= Q2R nhi)%R ->
absenv (Const m n) = ((nlo,nhi),e) ->
(Rabs (nR - nF) <= (Q2R e))%R.
......@@ -499,7 +307,7 @@ Proof.
eapply const_abs_err_bounded; eauto.
unfold validErrorbound in error_valid.
rewrite absenv_const in *; simpl in *.
case_eq (typeExpression f (Const m n)); intros; rewrite H in error_valid; [ | inversion error_valid ].
case_eq (Gamma (Const m n)); intros; rewrite H in error_valid; [ | inversion error_valid ].
andb_to_prop error_valid.
rename R into error_valid.
inversion eval_real; subst.
......@@ -514,73 +322,13 @@ Proof.
apply RmaxAbs; eauto.
- rewrite Q2R_mult in error_valid.
rewrite <- maxAbs_impl_RmaxAbs in error_valid; auto.
pose proof (typingConstDet _ _ _ H); subst; auto.
inversion subexpr_ok; subst.
rewrite H in H6; inversion H6; subst; auto.
Qed.
(*
Lemma validErrorboundCorrectParam:
forall E1 E2 absenv (v:nat) nR nF e P plo phi,
eval_exp 0%R E1 P (toRExp (Param Q v)) nR ->
eval_exp (Q2R RationalSimps.machineEpsilon) E2 P (toRExp (Param Q v)) nF ->
validErrorbound (Param Q v) absenv = true ->
(Q2R plo <= nR <= Q2R phi)%R ->
(forall n : nat, NatSet.In n (Expressions.freeVars (Param Q v)) ->
Is_true (isSupersetIntv (P n) (fst (absenv (Param Q n))))) ->
absenv (Param Q v) = ((plo,phi),e) ->
(Rabs (nR - nF) <= (Q2R e))%R.
Proof.
intros E1 E2 absenv v nR nF e P plo phi
eval_real eval_float error_valid intv_valid absenv_approx_p absenv_param.
inversion eval_real; subst.
rewrite delta_0_deterministic in *; auto.
unfold validErrorbound in error_valid.
rewrite absenv_param in error_valid.
specialize (absenv_approx_p v).
assert (exists ivlo ivhi, (ivlo,ivhi) = P v) by (destruct (P v) as [ivlo ivhi]; repeat eexists).
destruct H as [ivlo [ivhi P_eq]].
rewrite <- P_eq in absenv_approx_p, H4.
rewrite absenv_param in absenv_approx_p.
unfold freeVars in absenv_approx_p; simpl in absenv_approx_p.
assert (v = v \/ False) by auto.
specialize (absenv_approx_p H).
unfold isSupersetIntv in absenv_approx_p.
apply andb_prop_elim in absenv_approx_p.
destruct absenv_approx_p as [plo_le_ivlo ivhi_le_phi].
apply Is_true_eq_true, Qle_bool_iff in plo_le_ivlo.
apply Is_true_eq_true, Qle_bool_iff in ivhi_le_phi.
simpl in H4; destruct H4.
apply Qle_Rle in plo_le_ivlo; apply Qle_Rle in ivhi_le_phi.
andb_to_prop error_valid.
rename R into error_valid.
apply Qle_bool_iff in error_valid.
apply Qle_Rle in error_valid.
rewrite Q2R_mult in error_valid.
eapply Rle_trans;[ | apply error_valid].
simpl in *.
inversion eval_float; subst.
unfold perturb; simpl.
assert (Q2R plo <= v0)%R as lower_bound_v0 by lra.
assert (v0 <= Q2R phi)%R as upper_bound_v0 by lra.
rewrite Rsub_eq_Ropp_Rplus.
eapply Rle_trans.
apply Rabs_triang.
eapply Rle_trans.
apply Rplus_le_compat.
apply RmaxAbs.
apply lower_bound_v0.
apply upper_bound_v0.
rewrite Rmult_plus_distr_l.
rewrite Rmult_1_r.
apply Rmult_le_compat_r;try (apply Rabs_pos).
apply inj_eps_posR.
rewrite <- maxAbs_impl_RmaxAbs.
destruct intv_valid.
eapply RmaxAbs; auto.
Qed.*)
Lemma validErrorboundCorrectAddition E1 E2 absenv
(e1:exp Q) (e2:exp Q) (nR nR1 nR2 nF nF1 nF2 :R) (e err1 err2 :error)
(alo ahi e1lo e1hi e2lo e2hi:Q) dVars m m1 m2 f:
(alo ahi e1lo e1hi e2lo e2hi:Q) dVars m m1 m2 Gamma:
m = computeJoin m1 m2 ->
eval_exp E1 (toREval (toRExp e1)) nR1 M0 ->
eval_exp E1 (toREval (toRExp e2)) nR2 M0 ->
......@@ -588,8 +336,8 @@ Lemma validErrorboundCorrectAddition E1 E2 absenv
eval_exp E2 (toRExp e1) nF1 m1 ->
eval_exp E2 (toRExp e2) nF2 m2 ->
eval_exp (updEnv 2 m2 nF2 (updEnv 1 m1 nF1 emptyEnv)) (toRExp (Binop Plus (Var Q m1 1) (Var Q m2 2))) nF m ->
isSubExpression (Binop Plus e1 e2) f = true ->
validErrorbound (Binop Plus e1 e2) (typeExpression f) absenv dVars = true ->
validType Gamma (Binop Plus e1 e2) m ->
validErrorbound (Binop Plus e1 e2) Gamma absenv dVars = true ->
(Q2R e1lo <= nR1 <= Q2R e1hi)%R ->
(Q2R e2lo <= nR2 <= Q2R e2hi)%R ->
absenv e1 = ((e1lo,e1hi),err1) ->
......@@ -608,14 +356,14 @@ Proof.
try eauto.
unfold validErrorbound in valid_error.
rewrite absenv_add,absenv_e1,absenv_e2 in valid_error.
assert (typeExpression (Binop Plus e1 e2) (Binop Plus e1 e2) = Some m) as type_add.
{ simpl typeExpression; repeat rewrite expEqBool_refl; simpl.
pose proof (typeExpressionIsSound _ e1_float) as type_e1.
pose proof (typeExpressionIsSound _ e2_float) as type_e2.
rewrite type_e1,type_e2.
rewrite mIsJoin; auto. }
case_eq (typeExpression f (Binop Plus e1 e2)); intros; rewrite H in valid_error; [ | inversion valid_error ].
pose proof (typingBinopDet _ _ _ _ type_add H). subst.
(* assert (typeExpression (Binop Plus e1 e2) (Binop Plus e1 e2) = Some m) as type_add. *)
(* { simpl typeExpression; repeat rewrite expEqBool_refl; simpl. *)
(* pose proof (typeExpressionIsSound _ e1_float) as type_e1. *)
(* pose proof (typeExpressionIsSound _ e2_float) as type_e2. *)
(* rewrite type_e1,type_e2. *)
(* rewrite mIsJoin; auto. } *)
case_eq (Gamma (Binop Plus e1 e2)); intros; rewrite H in valid_error; [ | inversion valid_error ].
inversion subexpr_ok; subst. rewrite H in H7; inversion H7; subst. clear m4 m5 H3 H4 H7 H6.
andb_to_prop valid_error.
rename R0 into valid_error.
eapply Rle_trans.
......@@ -661,7 +409,7 @@ Qed.
(*Modify errorbounds first. *)
Lemma validErrorboundCorrectSubtraction E1 E2 absenv
(e1:exp Q) (e2:exp Q) (nR nR1 nR2 nF nF1 nF2 :R) (e err1 err2 :error)
(alo ahi e1lo e1hi e2lo e2hi:Q) dVars (m m1 m2:mType) f:
(alo ahi e1lo e1hi e2lo e2hi:Q) dVars (m m1 m2:mType) Gamma:
m = computeJoin m1 m2 ->
eval_exp E1 (toREval (toRExp e1)) nR1 M0 ->
eval_exp E1 (toREval (toRExp e2)) nR2 M0 ->
......@@ -669,8 +417,8 @@ Lemma validErrorboundCorrectSubtraction E1 E2 absenv
eval_exp E2 (toRExp e1) nF1 m1->
eval_exp E2 (toRExp e2) nF2 m2 ->
eval_exp (updEnv 2 m2 nF2 (updEnv 1 m1 nF1 emptyEnv)) (toRExp (Binop Sub (Var Q m1 1) (Var Q m2 2))) nF m ->
isSubExpression (Binop Sub e1 e2) f = true ->
validErrorbound (Binop Sub e1 e2) (typeExpression f) absenv dVars = true ->
validType Gamma (Binop Sub e1 e2) m ->
validErrorbound (Binop Sub e1 e2) Gamma absenv dVars = true ->
(Q2R e1lo <= nR1 <= Q2R e1hi)%R ->
(Q2R e2lo <= nR2 <= Q2R e2hi)%R ->
absenv e1 = ((e1lo,e1hi),err1) ->
......@@ -687,14 +435,8 @@ Proof.
eapply (subtract_abs_err_bounded e1 e2); try eauto.
unfold validErrorbound in valid_error.
rewrite absenv_sub,absenv_e1,absenv_e2 in valid_error.
assert (typeExpression (Binop Sub e1 e2) (Binop Sub e1 e2) = Some m) as type_sub.
{ simpl typeExpression; repeat rewrite expEqBool_refl; simpl.
pose proof (typeExpressionIsSound _ e1_float) as type_e1.
pose proof (typeExpressionIsSound _ e2_float) as type_e2.
rewrite type_e1,type_e2.
rewrite mIsJoin; auto. }
case_eq (typeExpression f (Binop Sub e1 e2)); intros; rewrite H in valid_error; [ | inversion valid_error ].
pose proof (typingBinopDet _ _ _ _ type_sub H). subst.
case_eq (Gamma (Binop Sub e1 e2)); intros; rewrite H in valid_error; [ | inversion valid_error ].
inversion subexpr_ok; subst. rewrite H in H7; inversion H7; subst. clear m4 m5 H3 H4 H7 H6.
andb_to_prop valid_error.
rename R0 into valid_error.
apply Qle_bool_iff in valid_error.
......@@ -744,7 +486,7 @@ Qed.
Lemma validErrorboundCorrectMult E1 E2 absenv
(e1:exp Q) (e2:exp Q) (nR nR1 nR2 nF nF1 nF2 :R) (e err1 err2 :error)
(alo ahi e1lo e1hi e2lo e2hi:Q) dVars (m m1 m2:mType) f:
(alo ahi e1lo e1hi e2lo e2hi:Q) dVars (m m1 m2:mType) Gamma:
m = computeJoin m1 m2 ->
eval_exp E1 (toREval (toRExp e1)) nR1 M0 ->
eval_exp E1 (toREval (toRExp e2)) nR2 M0 ->
......@@ -752,8 +494,8 @@ Lemma validErrorboundCorrectMult E1 E2 absenv
eval_exp E2 (toRExp e1) nF1 m1 ->
eval_exp E2 (toRExp e2) nF2 m2 ->
eval_exp (updEnv 2 m2 nF2 (updEnv 1 m1 nF1 emptyEnv)) (toRExp (Binop Mult (Var Q m1 1) (Var Q m2 2))) nF m ->
isSubExpression (Binop Mult e1 e2) f = true ->
validErrorbound (Binop Mult e1 e2) (typeExpression f) absenv dVars = true ->
validType Gamma (Binop Mult e1 e2) m ->
validErrorbound (Binop Mult e1 e2) Gamma absenv dVars = true ->
(Q2R e1lo <= nR1 <= Q2R e1hi)%R ->
(Q2R e2lo <= nR2 <= Q2R e2hi)%R ->
absenv e1 = ((e1lo,e1hi),err1) ->
......@@ -770,18 +512,12 @@ Proof.
eapply (mult_abs_err_bounded e1 e2); eauto.
unfold validErrorbound in valid_error.
rewrite absenv_mult,absenv_e1,absenv_e2 in valid_error.
assert (typeExpression (Binop Mult e1 e2) (Binop Mult e1 e2) = Some m) as type_mult.
{ simpl typeExpression; repeat rewrite expEqBool_refl; simpl.
pose proof (typeExpressionIsSound _ e1_float) as type_e1.
pose proof (typeExpressionIsSound _ e2_float) as type_e2.
rewrite type_e1,type_e2.
rewrite mIsJoin; auto. }
case_eq (typeExpression f (Binop Mult e1 e2)); intros; rewrite H in valid_error; [ | inversion valid_error ].
pose proof (typingBinopDet _ _ _ _ type_mult H). subst.
case_eq (Gamma (Binop Mult e1 e2)); intros; rewrite H in valid_error; [ | inversion valid_error ].
inversion subexpr_ok; subst. rewrite H in H7; inversion H7; subst. clear m4 m5 H3 H4 H7 H6.
andb_to_prop valid_error.
rename R0 into valid_error.
assert (0 <= Q2R err1)%R as err1_pos by (eapply (err_always_positive e1 (typeExpression f) absenv dVars); eauto).
assert (0 <= Q2R err2)%R as err2_pos by (eapply (err_always_positive e2 (typeExpression f) absenv dVars); eauto).
assert (0 <= Q2R err1)%R as err1_pos by (eapply (err_always_positive e1 Gamma absenv dVars); eauto).
assert (0 <= Q2R err2)%R as err2_pos by (eapply (err_always_positive e2 Gamma absenv dVars); eauto).
clear R L1.
apply Qle_bool_iff in valid_error.
apply Qle_Rle in valid_error.
......@@ -1280,16 +1016,16 @@ Qed.