Commit ddc04b14 authored by Heiko Becker's avatar Heiko Becker

Merge branch 'fixed_point_checking' into 'master'

Add fixed-point checking to FloVer's coq development

See merge request AVA/FloVer!1
parents 4c0b242a 40a32997
......@@ -38,7 +38,7 @@ Theorem Certificate_checking_is_sound (e:expr Q) (absenv:analysisResult) P defVa
CertificateChecker e absenv P defVars = true ->
exists iv err vR vF m,
FloverMap.find e absenv = Some (iv, err) /\
eval_expr E1 (toRMap defVars) (toREval (toRExp e)) vR M0 /\
eval_expr E1 (toRMap defVars) (toREval (toRExp e)) vR REAL /\
eval_expr E2 defVars (toRExp e) vF m /\
(forall vF m,
eval_expr E2 defVars (toRExp e) vF m ->
......@@ -93,7 +93,7 @@ Theorem Certificate_checking_cmds_is_sound (f:cmd Q) (absenv:analysisResult) P d
CertificateCheckerCmd f absenv P defVars = true ->
exists iv err vR vF m,
FloverMap.find (getRetExp f) absenv = Some (iv,err) /\
bstep (toREvalCmd (toRCmd f)) E1 (toRMap defVars) vR M0 /\
bstep (toREvalCmd (toRCmd f)) E1 (toRMap defVars) vR REAL /\
bstep (toRCmd f) E2 defVars vF m /\
(forall vF m,
bstep (toRCmd f) E2 defVars vF m ->
......
......@@ -29,7 +29,7 @@ Fixpoint toRCmd (f:cmd Q) :=
Fixpoint toREvalCmd (f:cmd R) :=
match f with
|Let m x e g => Let M0 x (toREval e) (toREvalCmd g)
|Let m x e g => Let REAL x (toREval e) (toREvalCmd g)
|Ret e => Ret (toREval e)
end.
......
(**
Environment library.
Defines the environment type for the Flover framework and a simulation relation between environments.
Defines the environment type for the Flover framework and a simulation relation
between environments.
**)
Require Import Coq.Reals.Reals Coq.micromega.Psatz Coq.QArith.Qreals.
Require Import Flover.Infra.ExpressionAbbrevs Flover.Infra.RationalSimps Flover.Commands.
From Coq
Require Import Reals.Reals micromega.Psatz QArith.Qreals.
From Flover
Require Import Infra.ExpressionAbbrevs Infra.RationalSimps Commands.
(**
Define an approximation relation between two environments.
......@@ -12,20 +16,25 @@ It is necessary to have this relation, since two evaluations of the very same
exprression may yield different values for different machine epsilons
(or environments that already only approximate each other)
**)
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 defVars A:
approxEnv emptyEnv defVars A NatSet.empty NatSet.empty emptyEnv
|approxUpdFree E1 E2 defVars A v1 v2 x fVars dVars m:
approxEnv E1 defVars A fVars dVars E2 ->
(Rabs (v1 - v2) <= (Rabs v1) * Q2R (mTypeToQ m))%R ->
(Rabs (v1 - v2) <= computeErrorR v1 m)%R ->
NatSet.mem x (NatSet.union fVars dVars) = false ->
approxEnv (updEnv x v1 E1) (updDefVars x m defVars) A (NatSet.add x fVars) dVars (updEnv x v2 E2)
approxEnv (updEnv x v1 E1)
(updDefVars x m defVars) A (NatSet.add x fVars) dVars
(updEnv x v2 E2)
|approxUpdBound E1 E2 defVars A v1 v2 x fVars dVars m iv err:
approxEnv E1 defVars A fVars dVars E2 ->
FloverMap.find (Var Q x) A = Some (iv, err) ->
(Rabs (v1 - v2) <= Q2R err)%R ->
NatSet.mem x (NatSet.union fVars dVars) = false ->
approxEnv (updEnv x v1 E1) (updDefVars x m defVars) A fVars (NatSet.add x dVars) (updEnv x v2 E2).
approxEnv (updEnv x v1 E1)
(updDefVars x m defVars) A fVars (NatSet.add x dVars)
(updEnv x v2 E2).
Section RelationProperties.
......@@ -68,7 +77,7 @@ Section RelationProperties.
E2 x = Some v2 ->
NatSet.In x fVars ->
Gamma x = Some m ->
(Rabs (v - v2) <= (Rabs v) * Q2R (mTypeToQ m))%R.
(Rabs (v - v2) <= computeErrorR v m)%R.
Proof.
induction approxEnvs;
intros E1_def E2_def x_free x_typed.
......
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
(* TODO: Flocq ops open machine_ieeeTheory binary_ieeeTheory lift_ieeeTheory realTheory *)
Require Import Coq.QArith.QArith Coq.QArith.Qreals Coq.Reals.Reals Coq.micromega.Psatz.
Require Import Flover.Infra.MachineType Flover.Typing Flover.Infra.RealSimps Flover.IntervalValidation Flover.ErrorValidation Flover.Commands Flover.Environments Flover.ssaPrgs Flover.Infra.Ltacs Flover.Infra.RealRationalProps.
From Flover
Require Import Expressions Commands Environments ssaPrgs Typing
IntervalValidation ErrorValidation Infra.Ltacs Infra.RealRationalProps.
Fixpoint FPRangeValidator (e:expr Q) (A:analysisResult) typeMap dVars {struct e} : bool :=
match FloverMap.find e typeMap, FloverMap.find e A with
......@@ -67,7 +64,7 @@ Ltac prove_fprangeval m v L1 R:=
|H: _ = true |- _ => andb_to_prop H
end);
destruct (Req_dec v 0); try auto;
destruct (Rle_lt_dec (Rabs v) (Q2R (minValue m)))%R (* denormal case *);
destruct (Rle_lt_dec (Rabs v) (Q2R (minValue_pos m)))%R (* denormal case *);
try auto;
destruct (Rle_lt_dec (Rabs v) (Q2R (maxValue m)))%R; lra.
......@@ -199,7 +196,7 @@ Proof.
- rewrite NatSet.add_spec, NatSet.union_spec in in_set;
rewrite NatSet.union_spec, NatSet.add_spec.
destruct in_set as [P1 | [ P2 | P3]]; auto. }
{ eapply (swap_Gamma_bstep (Gamma1 := updDefVars n M0 (toRMap Gamma))); eauto.
{ eapply (swap_Gamma_bstep (Gamma1 := updDefVars n REAL (toRMap Gamma))); eauto.
eauto using Rmap_updVars_comm. }
{ set_tac; split.
- split; try auto.
......
This diff is collapsed.
......@@ -6,7 +6,7 @@ Require Import Coq.QArith.QArith Coq.Reals.Reals Coq.QArith.Qreals Coq.QArith.QO
Require Export Flover.Infra.Abbrevs Flover.Expressions Flover.OrderedExpressions.
Module Q_orderedExps := ExpOrderedType (Q_as_OT).
Module Q_orderedExps := ExprOrderedType (Q_as_OT).
Module legacy_OrderedQExps := Structures.OrdersAlt.Backport_OT (Q_orderedExps).
Module FloverMap := FMapAVL.Make(legacy_OrderedQExps).
......
......@@ -17,6 +17,15 @@ Ltac andb_to_prop H :=
try andb_to_prop Left;
try andb_to_prop Right.
Ltac split_bool :=
match goal with
| [|- (_ && _) = true ] => apply Is_true_eq_true;
apply andb_prop_intro;
split;
apply Is_true_eq_left
| _ => fail "Cannot case split on non-boolean conjunction"
end.
Ltac canonize_Q_prop :=
match goal with
| [ H: Qle_bool ?a ?b = true |- _] => rewrite Qle_bool_iff in H
......@@ -159,3 +168,15 @@ Ltac telling_rewrite pat hyp :=
Tactic Notation "unify asm" open_constr(pat) hyp(H):=
telling_rewrite pat H.
Ltac destruct_ex H pat :=
match type of H with
| exists v, ?H' =>
let vFresh:=fresh v in
let fN := fresh "ex" in
destruct H as [vFresh fN];
destruct_ex fN pat
| _ => destruct H as pat
end.
Tactic Notation "destruct_smart" simple_intropattern(pat) hyp(H) := destruct_ex H pat.
\ No newline at end of file
This diff is collapsed.
(**
Some simplification properties of rationals, not proven in the Standard Library
**)
Require Import Coq.QArith.QArith Coq.QArith.Qminmax Coq.QArith.Qabs.
Require Import Coq.micromega.Psatz.
**)
From Coq.QArith
Require Export QArith Qminmax Qabs Qround.
From Coq
Require Export micromega.Psatz.
Definition Qleb := Qle_bool.
Definition Qeqb := Qeq_bool.
(* Definition machineEpsilon := (1#(2^53)). *)
Definition maxAbs (iv:Q*Q) :=
Qmax (Qabs (fst iv)) (Qabs (snd iv)).
......@@ -80,9 +80,16 @@ Proof.
+ auto.
Qed.
Lemma Qeq_bool_refl v:
(Qeq_bool v v = true).
Proof.
apply Qeq_bool_iff; lra.
Qed.
Lemma Qabs_0_impl_eq (d:Q):
Qabs d <= 0 -> d == 0.
Proof.
intros abs_leq_0.
rewrite Qabs_Qle_condition in abs_leq_0.
lra.
Qed.
(**
Some rewriting properties for translating between rationals and real numbers.
These are used in the soundness proofs since we want to have the final theorem on the real valued evaluation.
**)
Require Import Coq.QArith.QArith Coq.QArith.Qminmax Coq.QArith.Qabs
Coq.QArith.Qreals Coq.Reals.Reals Coq.micromega.Psatz.
Require Import Flover.Infra.RationalSimps Flover.Infra.RealSimps.
**)
From Coq.QArith
Require Export Qreals.
From Flover.Infra
Require Export RationalSimps RealSimps.
Lemma Q2R0_is_0:
Q2R 0 = 0%R.
......
......@@ -2,7 +2,11 @@
Some simplification properties of real numbers, not proven in the Standard Library
**)
Require Import Coq.Reals.Reals Coq.micromega.Psatz Coq.Setoids.Setoid.
From Coq
Require Import Setoids.Setoid.
From Coq
Require Export Reals.Reals micromega.Psatz.
(** Define the maxAbs function on R and prove some minor properties of it.
TODO: Make use of IVLO and IVhi
......@@ -73,7 +77,7 @@ Qed.
Prove that using eps = 0 makes the evaluation deterministic
**)
Lemma Rabs_0_impl_eq (d:R):
Rle (Rabs d) R0 -> d = R0.
Rle (Rabs d) 0 -> d = 0%R.
Proof.
intros abs_leq_0.
pose proof (Rabs_pos d) as abs_geq_0.
......
......@@ -163,7 +163,7 @@ Theorem validIntervalbounds_sound (f:expr Q) (A:analysisResult) (P:precond)
vars_typed (NatSet.union fVars dVars) Gamma ->
exists iv err vR,
FloverMap.find f A = Some (iv, err) /\
eval_expr E (toRMap Gamma) (toREval (toRExp f)) vR M0 /\
eval_expr E (toRMap Gamma) (toREval (toRExp f)) vR REAL /\
(Q2R (fst iv) <= vR <= Q2R (snd iv))%R.
Proof.
induction f;
......@@ -196,9 +196,9 @@ Proof.
* lra.
- Flover_compute; canonize_hyps; simpl in *.
kill_trivial_exists.
exists (perturb (Q2R v) 0).
split; [auto| split].
+ econstructor; try eauto. apply Rabs_0_equiv.
exists (perturb (Q2R v) REAL 0).
split; [eauto| split].
+ econstructor; try eauto. cbn. rewrite Rabs_R0; lra.
+ unfold perturb; simpl; lra.
- Flover_compute; simpl in *; try congruence.
destruct IHf as [iv_f [err_f [vF [iveq_f [eval_f valid_bounds_f]]]]];
......@@ -215,16 +215,16 @@ Proof.
+ rename L0 into nodiv0.
apply le_neq_bool_to_lt_prop in nodiv0.
kill_trivial_exists.
exists (perturb (evalUnop Inv vF) 0); split;
exists (perturb (evalUnop Inv vF) REAL 0); split;
[destruct i; auto | split].
* econstructor; eauto; try apply Rabs_0_equiv.
* econstructor; eauto.
{ simpl. rewrite Rabs_R0; lra. }
(* Absence of division by zero *)
hnf. destruct nodiv0 as [nodiv0 | nodiv0]; apply Qlt_Rlt in nodiv0;
rewrite Q2R0_is_0 in nodiv0; lra.
{ hnf. destruct nodiv0 as [nodiv0 | nodiv0]; apply Qlt_Rlt in nodiv0;
rewrite Q2R0_is_0 in nodiv0; lra. }
* canonize_hyps.
pose proof (interval_inversion_valid ((Q2R (fst iv_f)),(Q2R (snd iv_f))) (a :=vF)) as inv_valid.
unfold invertInterval in inv_valid; simpl in *.
rewrite delta_0_deterministic; [| rewrite Rbasic_fun.Rabs_R0; lra].
destruct inv_valid; try auto.
{ destruct nodiv0; rewrite <- Q2R0_is_0; [left | right]; apply Qlt_Rlt; auto. }
{ split; eapply Rle_trans.
......@@ -259,15 +259,16 @@ Proof.
try auto; set_tac.
destruct IHf2 as [iv_f2 [err2 [vF2 [env2 [eval_f2 valid_f2]]]]];
try auto; set_tac.
assert (M0 = join M0 M0) as M0_join by (cbv; auto);
rewrite M0_join.
assert (REAL = join REAL REAL) as REAL_join by (cbv; auto);
rewrite REAL_join.
kill_trivial_exists.
exists (perturb (evalBinop b vF1 vF2) 0);
exists (perturb (evalBinop b vF1 vF2) REAL 0);
split; [destruct i; auto | ].
inversion env1; inversion env2; subst.
destruct b; simpl in *.
* split;
[econstructor; try congruence; apply Rabs_0_equiv | ].
[eapply Binop_dist' with (delta := 0%R); eauto; try congruence;
rewrite Rabs_R0; cbn; lra|].
pose proof (interval_addition_valid ((Q2R (fst iv_f1)), Q2R (snd iv_f1))
(Q2R (fst iv_f2), Q2R (snd iv_f2)))
as valid_add.
......@@ -279,7 +280,8 @@ Proof.
rewrite <- Q2R_min4, <- Q2R_max4 in *.
unfold perturb. lra.
* split;
[econstructor; try congruence; apply Rabs_0_equiv |].
[eapply Binop_dist' with (delta := 0%R); eauto; try congruence;
rewrite Rabs_R0; cbn; lra|].
pose proof (interval_subtraction_valid ((Q2R (fst iv_f1)), Q2R (snd iv_f1))
(Q2R (fst iv_f2), Q2R (snd iv_f2)))
as valid_sub.
......@@ -292,7 +294,8 @@ Proof.
rewrite <- Q2R_min4, <- Q2R_max4 in *.
unfold perturb; lra.
* split;
[ econstructor; try congruence; apply Rabs_0_equiv |].
[eapply Binop_dist' with (delta := 0%R); eauto; try congruence;
rewrite Rabs_R0; cbn; lra|].
pose proof (interval_multiplication_valid ((Q2R (fst iv_f1)), Q2R (snd iv_f1))
(Q2R (fst iv_f2), Q2R (snd iv_f2)))
as valid_mul.
......@@ -307,7 +310,8 @@ Proof.
canonize_hyps.
apply le_neq_bool_to_lt_prop in L.
split;
[ econstructor; try congruence; try apply Rabs_0_equiv | ].
[eapply Binop_dist' with (delta := 0%R); eauto; try congruence;
try rewrite Rabs_R0; cbn; try lra|].
(* No division by zero proof *)
{ hnf; intros.
destruct L as [L | L]; apply Qlt_Rlt in L; rewrite Q2R0_is_0 in L; lra. }
......@@ -336,13 +340,13 @@ Proof.
destruct IHf1 as [iv_f1 [err1 [vF1 [env1 [eval_f1 valid_f1]]]]]; try auto; set_tac.
destruct IHf2 as [iv_f2 [err2 [vF2 [env2 [eval_f2 valid_f2]]]]]; try auto; set_tac.
destruct IHf3 as [iv_f3 [err3 [vF3 [env3 [eval_f3 valid_f3]]]]]; try auto; set_tac.
assert (M0 = join3 M0 M0 M0) as M0_join by (cbv; auto);
rewrite M0_join.
assert (REAL = join3 REAL REAL REAL) as REAL_join by (cbv; auto);
rewrite REAL_join.
kill_trivial_exists.
exists (perturb (evalFma vF1 vF2 vF3) 0); split; try auto.
exists (perturb (evalFma vF1 vF2 vF3) REAL 0); split; try auto.
inversion env1; inversion env2; inversion env3; subst.
split; [auto | ].
* econstructor; try congruence; apply Rabs_0_equiv.
* eapply Fma_dist' with (delta := 0%R); eauto; try congruence; cbn; rewrite Rabs_R0; lra.
* pose proof (interval_multiplication_valid (Q2R (fst iv_f2),Q2R (snd iv_f2)) (Q2R (fst iv_f3), Q2R (snd iv_f3))) as valid_mul.
specialize (valid_mul vF2 vF3 valid_f2 valid_f3).
remember (multInterval (Q2R (fst iv_f2), Q2R (snd iv_f2)) (Q2R (fst iv_f3), Q2R (snd iv_f3))) as iv_f23prod.
......@@ -365,9 +369,10 @@ Proof.
try auto.
inversion env_f; subst.
kill_trivial_exists.
exists (perturb vF 0).
exists (perturb vF REAL 0).
split; [destruct i; try auto |].
split; [try econstructor; try eauto; try apply Rabs_0_equiv; unfold isMorePrecise; auto |].
split; [eapply Downcast_dist'; try eauto; cbn; try rewrite Rabs_R0 |];
try lra; try auto.
unfold isSupersetIntv in *; andb_to_prop R.
canonize_hyps; simpl in *.
unfold perturb; lra.
......@@ -375,7 +380,7 @@ Qed.
Lemma Rmap_updVars_comm Gamma n m:
forall x,
updDefVars n M0 (toRMap Gamma) x = toRMap (updDefVars n m Gamma) x.
updDefVars n REAL (toRMap Gamma) x = toRMap (updDefVars n m Gamma) x.
Proof.
unfold updDefVars, toRMap; simpl.
intros x; destruct (x =? n); try auto.
......@@ -423,7 +428,7 @@ Theorem validIntervalboundsCmd_sound (f:cmd Q) (A:analysisResult):
validIntervalboundsCmd f A P dVars = true ->
exists iv_e err_e vR,
FloverMap.find (getRetExp f) A = Some (iv_e, err_e) /\
bstep (toREvalCmd (toRCmd f)) E (toRMap Gamma) vR M0 /\
bstep (toREvalCmd (toRCmd f)) E (toRMap Gamma) vR REAL /\
(Q2R (fst iv_e) <= vR <= Q2R (snd iv_e))%R.
Proof.
induction f;
......@@ -439,7 +444,7 @@ Proof.
hnf; intros; subst.
set_tac. }
rewrite find_v in *; inversion Heqo; subst.
specialize (IHf (updDefVars n M0 Gamma) (updEnv n v E) fVars (NatSet.add n dVars)).
specialize (IHf (updDefVars n REAL Gamma) (updEnv n v E) fVars (NatSet.add n dVars)).
assert (NatSet.Equal (NatSet.add n (NatSet.union fVars dVars)) (NatSet.union fVars (NatSet.add n dVars))).
+ hnf. intros a; split; intros in_set; set_tac.
* destruct in_set as [ ? | [? ?]]; try auto; set_tac.
......@@ -478,7 +483,7 @@ Proof.
exfalso; apply H6; set_tac. }
{ set_tac.
destruct x_def as [x_n | x_def]; subst.
- exists M0; unfold updDefVars; rewrite Nat.eqb_refl; auto.
- exists REAL; unfold updDefVars; rewrite Nat.eqb_refl; auto.
- destruct x_def. destruct (types_valid x) as [m_x Gamma_x].
+ rewrite NatSet.union_spec; auto.
+ exists m_x.
......@@ -501,7 +506,7 @@ Proof.
rewrite NatSet.add_spec; auto. }
* simpl. exists iv_f, err_f, vR; repeat split; try auto; try lra.
econstructor; try eauto.
eapply swap_Gamma_bstep with (Gamma1 := toRMap (updDefVars n M0 Gamma)) ; try eauto.
eapply swap_Gamma_bstep with (Gamma1 := toRMap (updDefVars n REAL Gamma)) ; try eauto.
intros n1; erewrite Rmap_updVars_comm; eauto.
- unfold validIntervalboundsCmd in valid_bounds_f.
pose proof (validIntervalbounds_sound e (E:=E) (Gamma:=Gamma) valid_bounds_f dVars_sound usedVars_subset) as valid_iv_e.
......
This diff is collapsed.
......@@ -21,7 +21,7 @@ Theorem RangeValidator_sound (f : expr Q) (A : analysisResult) (P : precond)
vars_typed (usedVars f) Gamma ->
exists (iv : intv) (err : error) (vR : R),
FloverMap.find (elt:=intv * error) f A = Some (iv, err) /\
eval_expr E (toRMap Gamma) (toREval (toRExp f)) vR M0 /\ (Q2R (fst iv) <= vR <= Q2R (snd iv))%R.
eval_expr E (toRMap Gamma) (toREval (toRExp f)) vR REAL /\ (Q2R (fst iv) <= vR <= Q2R (snd iv))%R.
Proof.
intros.
unfold RangeValidator in *.
......
......@@ -45,8 +45,8 @@ Qed.
Lemma validVars_non_stuck (e:expr Q) inVars E:
NatSet.Subset (usedVars e) inVars ->
(forall v, NatSet.In v (usedVars e) ->
exists r, (toREvalEnv E) v = Some (r, M0))%R ->
exists vR, eval_expr (toREvalEnv E) (toREval (toRExp e)) vR M0.
exists r, (toREvalEnv E) v = Some (r, REAL))%R ->
exists vR, eval_expr (toREvalEnv E) (toREval (toRExp e)) vR REAL.
Proof.
revert inVars E; induction e;
intros inVars E vars_valid fVars_live.
......@@ -56,16 +56,16 @@ Proof.
destruct fVars_live as [vR E_def].
exists vR; econstructor; eauto.
- exists (perturb (Q2R v) 0); constructor.
simpl (meps M0); rewrite Rabs_R0; rewrite Q2R0_is_0; lra.
- assert (exists vR, eval_expr (toREvalEnv E) (toREval (toRExp e)) vR M0)
simpl (meps REAL); rewrite Rabs_R0; rewrite Q2R0_is_0; lra.
- assert (exists vR, eval_expr (toREvalEnv E) (toREval (toRExp e)) vR REAL)
as eval_e_def by (eapply IHe; eauto).
destruct eval_e_def as [ve eval_e_def].
case_eq u; intros; subst.
+ exists (evalUnop Neg ve); constructor; auto.
+ exists (perturb (evalUnop Inv ve) 0); constructor; auto.
simpl (meps M0); rewrite Q2R0_is_0; rewrite Rabs_R0; lra.
simpl (meps REAL); rewrite Q2R0_is_0; rewrite Rabs_R0; lra.
- repeat rewrite NatSet.subset_spec in *; simpl in *.
assert (exists vR1, eval_expr (toREvalEnv E) (toREval (toRExp e1)) vR1 M0) as eval_e1_def.
assert (exists vR1, eval_expr (toREvalEnv E) (toREval (toRExp e1)) vR1 REAL) as eval_e1_def.
+ eapply IHe1; eauto.
* hnf; intros.
apply vars_valid.
......@@ -73,7 +73,7 @@ Proof.
* intros.
destruct (fVars_live v) as [vR E_def]; try eauto.
apply NatSet.union_spec; auto.
+ assert (exists vR2, eval_expr (toREvalEnv E) (toREval (toRExp e2)) vR2 M0) as eval_e2_def.
+ assert (exists vR2, eval_expr (toREvalEnv E) (toREval (toRExp e2)) vR2 REAL) as eval_e2_def.
* eapply IHe2; eauto.
{ hnf; intros.
apply vars_valid.
......@@ -84,10 +84,10 @@ Proof.
* destruct eval_e1_def as [vR1 eval_e1_def];
destruct eval_e2_def as [vR2 eval_e2_def].
exists (perturb (evalBinop b vR1 vR2) 0).
replace M0 with (computeJoin M0 M0) by auto.
replace REAL with (computeJoin REAL REAL) by auto.
constructor; auto.
simpl meps; rewrite Q2R0_is_0. rewrite Rabs_R0; lra.
- assert (exists vR, eval_expr (toREvalEnv E) (toREval (toRExp e)) vR M0) as eval_r_def by (eapply IHe; eauto).
- assert (exists vR, eval_expr (toREvalEnv E) (toREval (toRExp e)) vR REAL) as eval_r_def by (eapply IHe; eauto).
destruct eval_r_def as [vr eval_r_def].
exists vr.
simpl toREval.
......@@ -181,7 +181,7 @@ Qed.
Lemma ssa_shadowing_free m x y v v' e f inVars outVars E defVars:
ssa (Let m x (toREval (toRExp e)) (toREvalCmd (toRCmd f))) inVars outVars ->
NatSet.In y inVars ->
eval_expr E defVars (toREval (toRExp e)) v M0 ->
eval_expr E defVars (toREval (toRExp e)) v REAL ->
forall E n, updEnv x v (updEnv y v' E) n = updEnv y v' (updEnv x v E) n.
Proof.
intros ssa_let y_free eval_e.
......@@ -204,8 +204,8 @@ Qed.
(*
Lemma shadowing_free_rewriting_expr e v E1 E2 defVars:
(forall n, E1 n = E2 n)->
eval_expr E1 defVars (toREval e) v M0 <->
eval_expr E2 defVars (toREval e) v M0.
eval_expr E1 defVars (toREval e) v REAL <->
eval_expr E2 defVars (toREval e) v REAL.
Proof.
revert v E1 E2.
induction e; intros v' E1 E2 agree_on_vars.
......@@ -231,8 +231,8 @@ Qed.
Lemma shadowing_free_rewriting_cmd f E1 E2 vR defVars:
(forall n, E1 n = E2 n) ->
bstep (toREvalCmd f) E1 defVars vR M0 <->
bstep (toREvalCmd f) E2 defVars vR M0.
bstep (toREvalCmd f) E1 defVars vR REAL <->
bstep (toREvalCmd f) E2 defVars vR REAL.
Proof.
revert E1 E2 defVars vR.
induction f; intros E1 E2 vR agree_on_vars.
......@@ -259,8 +259,8 @@ Qed.
Lemma dummy_bind_ok e v x v' inVars E defVars:
NatSet.Subset (usedVars e) inVars ->
NatSet.mem x inVars = false ->
eval_expr E defVars (toREval (toRExp e)) v M0 ->
eval_expr (updEnv x v' E) defVars (toREval (toRExp e)) v M0.
eval_expr E defVars (toREval (toRExp e)) v REAL ->
eval_expr (updEnv x v' E) defVars (toREval (toRExp e)) v REAL.
Proof.
revert v x v' inVars E.
induction e; intros v1 x v2 inVars E valid_vars x_not_free eval_e.
......@@ -307,9 +307,9 @@ Fixpoint expr_subst (e:expr Q) x e_new :=
end.
*)
(* Lemma expr_subst_correct e e_sub E x v v_res defVars: *)
(* eval_expr E defVars (toREval (toRExp e_sub)) v M0 -> *)
(* eval_expr (updEnv x v E) defVars (toREval (toRExp e)) v_res M0 <-> *)
(* eval_expr E defVars (toREval (toRExp (expr_subst e x e_sub))) v_res M0. *)
(* eval_expr E defVars (toREval (toRExp e_sub)) v REAL -> *)
(* eval_expr (updEnv x v E) defVars (toREval (toRExp e)) v_res REAL <-> *)
(* eval_expr E defVars (toREval (toRExp (expr_subst e x e_sub))) v_res REAL. *)
(* Proof. *)
(* intros eval_e. *)
(* revert v_res. *)
......@@ -368,9 +368,9 @@ Fixpoint expr_subst (e:expr Q) x e_new :=
(* ssa (toREvalCmd (toRCmd f)) inVars outVars -> *)
(* NatSet.In x inVars -> *)
(* NatSet.Subset (usedVars e) inVars -> *)
(* eval_expr E defVars (toREval (toRExp e)) v M0 -> *)
(* bstep (toREvalCmd (toRCmd f)) (updEnv x v E) (fun n => if (n =? x) then Some M0 else defVars n) vR M0 <-> *)
(* bstep (toREvalCmd (toRCmd (map_subst f x e))) E defVars vR M0. *)
(* eval_expr E defVars (toREval (toRExp e)) v REAL -> *)
(* bstep (toREvalCmd (toRCmd f)) (updEnv x v E) (fun n => if (n =? x) then Some REAL else defVars n) vR REAL <-> *)
(* bstep (toREvalCmd (toRCmd (map_subst f x e))) E defVars vR REAL. *)
(* Proof. *)
(* revert E e x vR inVars outVars defVars. *)
(* induction f; intros E e0 x vR inVars outVars defVars ssa_f x_free valid_vars_e eval_e. *)
......@@ -424,8 +424,8 @@ Fixpoint expr_subst (e:expr Q) x e_new :=
(* Lemma eval_subst_subexpr E e' n e vR defVars: *)
(* NatSet.In n (usedVars e) -> *)
(* eval_expr E defVars (toREval (toRExp (expr_subst e n e'))) vR M0 -> *)
(* exists v, eval_expr E defVars (toREval (toRExp e')) v M0. *)
(* eval_expr E defVars (toREval (toRExp (expr_subst e n e'))) vR REAL -> *)
(* exists v, eval_expr E defVars (toREval (toRExp e')) v REAL. *)
(* Proof. *)
(* revert E e' n vR. *)
(* induction e; *)
......@@ -447,8 +447,8 @@ Fixpoint expr_subst (e:expr Q) x e_new :=
(* Lemma bstep_subst_subexpr_any E e x f vR defVars: *)
(* NatSet.In x (liveVars f) -> *)
(* bstep (toREvalCmd (toRCmd (map_subst f x e))) E defVars vR M0 -> *)
(* exists E' v, eval_expr E' defVars (toREval (toRExp e)) v M0. *)
(* bstep (toREvalCmd (toRCmd (map_subst f x e))) E defVars vR REAL -> *)
(* exists E' v, eval_expr E' defVars (toREval (toRExp e)) v REAL. *)
(* Proof. *)
(* revert E e x vR defVars; *)
(* induction f; *)
......@@ -467,8 +467,8 @@ Fixpoint expr_subst (e:expr Q) x e_new :=
(* Lemma bstep_subst_subexpr_ret E e x e' vR defVars: *)
(* NatSet.In x (liveVars (Ret e')) -> *)
(* bstep (toREvalCmd (toRCmd (map_subst (Ret e') x e))) E defVars vR M0 -> *)
(* exists v, eval_expr E defVars (toREval (toRExp e)) v M0. *)
(* bstep (toREvalCmd (toRCmd (map_subst (Ret e') x e))) E defVars vR REAL -> *)
(* exists v, eval_expr E defVars (toREval (toRExp e)) v REAL. *)
(* Proof. *)
(* simpl; intros x_live bstep_ret. *)
(* inversion bstep_ret; subst. *)
......@@ -496,8 +496,8 @@ Fixpoint expr_subst (e:expr Q) x e_new :=
(* NatSet.In x (liveVars (Let m y e' g)) -> *)
(* (forall x, NatSet.In x (usedVars e) -> *)
(* exists v, E x = v) -> *)
(* bstep (toREvalCmd (toRCmd (map_subst (Let m y e' g) x e))) E defVars vR M0 -> *)
(* exists v, eval_expr E defVars (toREval (toRExp e)) v M0. *)
(* bstep (toREvalCmd (toRCmd (map_subst (Let m y e' g) x e))) E defVars vR REAL -> *)
(* exists v, eval_expr E defVars (toREval (toRExp e)) v REAL. *)
(* Proof. *)
(* revert E e x y e' vR; *)
(* induction g; *)
......@@ -516,8 +516,8 @@ Fixpoint expr_subst (e:expr Q) x e_new :=
(* (forall v, NatSet.In v (definedVars f) -> *)
(* NatSet.In v (liveVars f)) -> *)
(* let_subst f = e -> *)
(* bstep (toREvalCmd (toRCmd (Ret e))) E defVars vR M0 -> *)
(* bstep (toREvalCmd (toRCmd f)) E defVars vR M0. *)
(* bstep (toREvalCmd (toRCmd (Ret e))) E defVars vR REAL -> *)
(* bstep (toREvalCmd (toRCmd f)) E defVars vR REAL. *)
(* Proof. *)
(* intros ssa_f. *)
(* revert E vR e; *)
......@@ -548,9 +548,9 @@ Fixpoint expr_subst (e:expr Q) x e_new :=
(* Theorem let_free_form f E vR inVars outVars e defVars: *)
(* ssa f inVars outVars -> *)
(* bstep (toREvalCmd (toRCmd f)) E defVars vR M0 -> *)
(* bstep (toREvalCmd (toRCmd f)) E defVars vR REAL -> *)
(* let_subst f = e -> *)
(* bstep (toREvalCmd (toRCmd (Ret e))) E defVars vR M0. *)
(* bstep (toREvalCmd (toRCmd (Ret e))) E defVars vR REAL. *)
(* Proof. *)
(* revert E vR inVars outVars e; *)
(* induction f; *)
......@@ -561,7 +561,7 @@ Fixpoint expr_subst (e:expr Q) x e_new :=
(* Admitted. *)
(* (* case_eq (let_subst f). *)