Commit 8c1d9348 authored by Heiko Becker's avatar Heiko Becker

Rework typing to get the semantics and typing work closer together.

Using this new typing, prove the stronger soundness statement, moving the evaluation to the conclusion of the theorems.
parent 0cc8a44b
......@@ -25,22 +25,25 @@ Definition CertificateChecker (e:exp Q) (absenv:analysisResult) (P:precond) (def
the real valued execution respects the precondition.
**)
Theorem Certificate_checking_is_sound (e:exp Q) (absenv:analysisResult) P defVars:
forall (E1 E2:env) (vR:R) (vF:R) fVars m,
approxEnv E1 defVars absenv fVars NatSet.empty E2 ->
(forall v, NatSet.mem v fVars = true ->
forall (E1 E2:env),
approxEnv E1 defVars absenv (usedVars e) NatSet.empty E2 ->
(forall v, NatSet.mem v (Expressions.usedVars e) = true ->
exists vR, E1 v = Some vR /\
(Q2R (fst (P v)) <= vR <= Q2R (snd (P v)))%R) ->
NatSet.Subset (Expressions.usedVars e) fVars ->
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e)) vR M0 ->
eval_exp E2 defVars (toRExp e) vF m ->
(forall v, (v) mem (usedVars e) = true ->
exists m : mType,
defVars v = Some m) ->
CertificateChecker e absenv P defVars = true ->
exists vR vF m,
eval_exp E1 (toRMap defVars) (toREval (toRExp e)) vR M0 /\
eval_exp E2 defVars (toRExp e) vF m /\
(Rabs (vR - vF) <= Q2R (snd (absenv e)))%R.
(**
The proofs is a simple composition of the soundness proofs for the range
validator and the error bound validator.
**)
Proof.
intros * approxE1E2 P_valid fVars_subset eval_real eval_float certificate_valid.
intros * approxE1E2 P_valid types_defined certificate_valid.
unfold CertificateChecker in certificate_valid.
rewrite <- andb_lazy_alt in certificate_valid.
andb_to_prop certificate_valid.
......@@ -48,14 +51,23 @@ Proof.
destruct env_e as [iv [err absenv_eq]].
destruct iv as [ivlo ivhi].
rewrite absenv_eq; simpl.
eapply validErrorbound_sound; eauto.
- hnf. intros a in_diff.
rewrite NatSet.diff_spec in in_diff.
apply fVars_subset.
destruct in_diff; auto.
- intros v v_in_empty.
pose proof (NatSetProps.empty_union_2 (Expressions.usedVars e) NatSet.empty_spec) as union_empty.
hnf in union_empty.
assert (forall v1, (v1) mem (Expressions.usedVars e NatSet.empty) = true ->
exists m0 : mType, defVars v1 = Some m0).
{ intros; eapply types_defined.
rewrite NatSet.mem_spec in *.
rewrite <- union_empty; eauto. }
assert (NatSet.Subset (usedVars e -- NatSet.empty) (Expressions.usedVars e)).
{ hnf; intros a in_empty.
set_tac. }
assert (forall v, (v) mem (NatSet.empty) = true -> exists vR : R, E1 v = Some vR /\ (Q2R (fst (fst (absenv (Var Q v)))) <= vR <= Q2R (snd (fst (absenv (Var Q v)))))%R).
{ intros v v_in_empty.
rewrite NatSet.mem_spec in v_in_empty.
inversion v_in_empty.
inversion v_in_empty. }
edestruct validIntervalbounds_sound as [vR [eval_real real_bounds_e]]; eauto.
destruct (validErrorbound_sound e P (typeMap defVars e) L approxE1E2 H0 eval_real R0 L0 H1 P_valid H absenv_eq) as [vF [mF [eval_float err_bounded]]]; auto.
exists vR; exists vF; exists mF; split; auto.
Qed.
Definition CertificateCheckerCmd (f:cmd Q) (absenv:analysisResult) (P:precond) defVars:=
......@@ -66,21 +78,25 @@ Definition CertificateCheckerCmd (f:cmd Q) (absenv:analysisResult) (P:precond) d
else false.
Theorem Certificate_checking_cmds_is_sound (f:cmd Q) (absenv:analysisResult) P defVars:
forall (E1 E2:env) vR vF m,
forall (E1 E2:env),
approxEnv E1 defVars absenv (freeVars f) NatSet.empty E2 ->
(forall v, NatSet.mem v (freeVars f)= true ->
exists vR, E1 v = Some vR /\
(Q2R (fst (P v)) <= vR <= Q2R (snd (P v)))%R) ->
bstep (toREvalCmd (toRCmd f)) E1 (toREvalVars defVars) vR M0 ->
bstep (toRCmd f) E2 defVars vF m ->
(forall v, (v) mem (freeVars f) = true ->
exists m : mType,
defVars v = Some m) ->
CertificateCheckerCmd f absenv P defVars = true ->
exists vR vF m,
bstep (toREvalCmd (toRCmd f)) E1 (toRMap defVars) vR M0 /\
bstep (toRCmd f) E2 defVars vF m /\
(Rabs (vR - vF) <= Q2R (snd (absenv (getRetExp f))))%R.
(**
The proofs is a simple composition of the soundness proofs for the range
validator and the error bound validator.
**)
Proof.
intros * approxE1E2 P_valid eval_real eval_float certificate_valid.
intros * approxE1E2 P_valid types_defined certificate_valid.
unfold CertificateCheckerCmd in certificate_valid.
repeat rewrite <- andb_lazy_alt in certificate_valid.
andb_to_prop certificate_valid.
......@@ -89,20 +105,25 @@ Proof.
env_assert absenv (getRetExp f) env_f.
destruct env_f as [iv [err absenv_eq]].
destruct iv as [ivlo ivhi].
assert (ssa f (freeVars f NatSet.empty) outVars) as ssa_valid.
{ eapply ssa_equal_set; try eauto.
apply NatSetProps.empty_union_2.
apply NatSet.empty_spec. }
assert (forall v, (v) mem (NatSet.empty) = true ->
exists vR : R,
E1 v = Some vR /\ (Q2R (fst (fst (absenv (Var Q v)))) <= vR <= Q2R (snd (fst (absenv (Var Q v)))))%R) as no_dVars_valid.
{ intros v v_in_empty.
set_tac. inversion v_in_empty. }
assert (forall v, (v) mem (freeVars f NatSet.empty) = true ->
exists m : mType, defVars v = Some m) as types_valid.
{ intros v v_mem; apply types_defined.
set_tac. rewrite NatSet.union_spec in v_mem.
destruct v_mem; try auto.
inversion H. }
assert (NatSet.Subset (freeVars f -- NatSet.empty) (freeVars f))
as freeVars_contained by set_tac.
edestruct (validIntervalboundsCmd_sound) as [vR [eval_real bounded_real_f]] ; eauto.
rewrite absenv_eq; simpl.
eapply (validErrorboundCmd_sound); eauto.
- instantiate (1 := outVars).
eapply ssa_equal_set; try eauto.
hnf.
intros a; split; intros in_union.
+ rewrite NatSet.union_spec in in_union.
destruct in_union as [in_fVars | in_empty]; try auto.
inversion in_empty.
+ rewrite NatSet.union_spec; auto.
- hnf; intros a in_diff.
rewrite NatSet.diff_spec in in_diff.
destruct in_diff; auto.
- intros v v_in_empty.
rewrite NatSet.mem_spec in v_in_empty.
inversion v_in_empty.
Qed.y
edestruct (validErrorboundCmd_sound) as [vF [mF [eval_float bounded_float]]]; eauto.
exists vR; exists vF; exists mF; split; auto.
Qed.
\ No newline at end of file
......@@ -52,15 +52,12 @@ Inductive sstep : cmd R -> env -> R -> cmd R -> env -> Prop :=
Inductive bstep : cmd R -> env -> (nat -> option mType) -> R -> mType -> Prop :=
let_b m m' x e s E v res defVars:
eval_exp E defVars e v m ->
defVars x = Some m ->
bstep s (updEnv x v E) defVars res m' ->
bstep s (updEnv x v E) (updDefVars x m defVars) res m' ->
bstep (Let m x e s) E defVars res m'
|ret_b m e E v defVars:
eval_exp E defVars e v m ->
bstep (Ret e) E defVars v m.
(**
The free variables of a command are all used variables of expressions
without the let bound variables
......
......@@ -17,15 +17,14 @@ Inductive approxEnv : env -> (nat -> option mType) -> analysisResult -> NatSet.t
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 ->
defVars x = Some m ->
(Rabs (v1 - v2) <= (Rabs v1) * Q2R (meps m))%R ->
(Rabs (v1 - v2) <= (Rabs v1) * Q2R (mTypeToQ m))%R ->
NatSet.mem x (NatSet.union fVars dVars) = false ->
approxEnv (updEnv x v1 E1) defVars A (NatSet.add x fVars) dVars (updEnv x v2 E2)
|approxUpdBound E1 E2 defVars A v1 v2 x fVars dVars:
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:
approxEnv E1 defVars A fVars dVars E2 ->
(Rabs (v1 - v2) <= Q2R (snd (A (Var Q x))))%R ->
NatSet.mem x (NatSet.union fVars dVars) = false ->
approxEnv (updEnv x v1 E1) 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).
(* Inductive approxParams :env -> env -> Prop := *)
(* |approxParamRefl: *)
......@@ -34,3 +33,110 @@ Inductive approxEnv : env -> (nat -> option mType) -> analysisResult -> NatSet.t
(* approxParams E1 E2 -> *)
(* (Rabs (v1 - v2) <= Q2R (meps m))%R -> *)
(* approxParams (updEnv x M0 v1 E1) (updEnv x m v2 E2). *)
Section RelationProperties.
Variable (x:nat) (v:R) (E1 E2:env) (Gamma:nat -> option mType) (A:analysisResult) (fVars dVars: NatSet.t).
Hypothesis approxEnvs: approxEnv E1 Gamma A fVars dVars E2.
Lemma approxEnv_gives_value:
E1 x = Some v ->
NatSet.In x (NatSet.union fVars dVars) ->
exists v',
E2 x = Some v'.
Proof.
induction approxEnvs;
intros E1_def x_valid.
- unfold emptyEnv in E1_def; simpl in E1_def. congruence.
- unfold updEnv in *.
case_eq (x =? x0); intros eq_case; rewrite eq_case in *.
+ eexists; eauto.
+ eapply IHa; auto.
set_tac.
rewrite NatSet.union_spec in x_valid.
destruct x_valid; set_tac.
rewrite NatSet.add_spec in H1.
destruct H1; subst; try auto.
rewrite Nat.eqb_refl in eq_case; congruence.
- unfold updEnv in *.
case_eq (x =? x0); intros eq_case; rewrite eq_case in *.
+ eexists; eauto.
+ eapply IHa; auto.
set_tac.
rewrite NatSet.union_spec in x_valid.
destruct x_valid; set_tac.
rewrite NatSet.add_spec in H1.
destruct H1; subst; try auto.
rewrite Nat.eqb_refl in eq_case; congruence.
Qed.
Arguments mTypeToQ _ : simpl nomatch.
Lemma approxEnv_fVar_bounded v2 m:
E1 x = Some v ->
E2 x = Some v2 ->
NatSet.In x fVars ->
Gamma x = Some m ->
(Rabs (v - v2) <= (Rabs v) * Q2R (mTypeToQ m))%R.
Proof.
induction approxEnvs;
intros E1_def E2_def x_free x_typed.
- unfold emptyEnv in *; simpl in *; congruence.
- set_tac.
rewrite add_spec_strong in x_free.
destruct x_free as [x_x0 | [x_neq x_free]]; subst.
+ unfold updEnv in *;
rewrite Nat.eqb_refl in *; simpl in *.
unfold updDefVars in x_typed.
rewrite Nat.eqb_refl in x_typed.
inversion x_typed; subst.
inversion E1_def; inversion E2_def; subst; auto.
+ unfold updEnv in *; simpl in *.
rewrite <- Nat.eqb_neq in x_neq.
rewrite x_neq in *; simpl in *.
unfold updDefVars in x_typed; rewrite x_neq in x_typed.
apply IHa; auto.
- assert (x =? x0 = false) as x_x0_neq.
{ rewrite Nat.eqb_neq; hnf; intros; subst.
set_tac.
apply H0.
set_tac. }
unfold updEnv in *; rewrite x_x0_neq in *.
apply IHa; auto.
unfold updDefVars in x_typed;
rewrite x_x0_neq in x_typed; auto.
Qed.
Lemma approxEnv_dVar_bounded v2 m:
E1 x = Some v ->
E2 x = Some v2 ->
NatSet.In x dVars ->
Gamma x = Some m ->
(Rabs (v - v2) <= Q2R (snd (A (Var Q x))))%R.
Proof.
induction approxEnvs;
intros E1_def E2_def x_def x_typed.
- unfold emptyEnv in *; simpl in *; congruence.
- assert (x =? x0 = false) as x_x0_neq.
{ rewrite Nat.eqb_neq; hnf; intros; subst.
set_tac.
apply H0; set_tac.
}
unfold updEnv in *; rewrite x_x0_neq in *.
unfold updDefVars in x_typed; rewrite x_x0_neq in x_typed.
apply IHa; auto.
- set_tac.
rewrite add_spec_strong in x_def.
destruct x_def as [x_x0 | [x_neq x_def]]; subst.
+ unfold updEnv in *;
rewrite Nat.eqb_refl in *; simpl in *.
inversion E1_def; inversion E2_def; subst; auto.
+ unfold updEnv in *; simpl in *.
rewrite <- Nat.eqb_neq in x_neq.
rewrite x_neq in *; simpl in *.
unfold updDefVars in x_typed; rewrite x_neq in x_typed.
apply IHa; auto.
Qed.
End RelationProperties.
\ No newline at end of file
......@@ -9,9 +9,9 @@ Require Import Daisy.Environments Daisy.Infra.ExpressionAbbrevs.
Lemma const_abs_err_bounded (n:R) (nR:R) (nF:R) (E1 E2:env) (m:mType) defVars:
eval_exp E1 (toREvalVars defVars) (Const M0 n) nR M0 ->
eval_exp E1 (toRMap defVars) (Const M0 n) nR M0 ->
eval_exp E2 defVars (Const m n) nF m ->
(Rabs (nR - nF) <= Rabs n * (Q2R (meps m)))%R.
(Rabs (nR - nF) <= Rabs n * (Q2R (mTypeToQ m)))%R.
Proof.
intros eval_real eval_float.
inversion eval_real; subst.
......@@ -20,24 +20,24 @@ Proof.
unfold perturb; simpl.
rewrite Rabs_err_simpl, Rabs_mult.
apply Rmult_le_compat_l; [apply Rabs_pos | auto].
simpl (meps M0) in *.
simpl (mTypeToQ M0) in *.
apply (Rle_trans _ (Q2R 0) _); try auto.
rewrite Q2R0_is_0; lra.
Qed.
Lemma add_abs_err_bounded (e1:exp Q) (e1R:R) (e1F:R) (e2:exp Q) (e2R:R) (e2F:R)
(vR:R) (vF:R) (E1 E2:env) (err1 err2 :Q) (m m1 m2:mType) defVars:
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e1)) e1R M0 ->
eval_exp E1 (toRMap defVars) (toREval (toRExp e1)) e1R M0 ->
eval_exp E2 defVars (toRExp e1) e1F m1->
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e2)) e2R M0 ->
eval_exp E1 (toRMap defVars) (toREval (toRExp e2)) e2R M0 ->
eval_exp E2 defVars (toRExp e2) e2F m2 ->
eval_exp E1 (toREvalVars defVars) (toREval (Binop Plus (toRExp e1) (toRExp e2))) vR M0 ->
eval_exp E1 (toRMap defVars) (toREval (Binop Plus (toRExp e1) (toRExp e2))) vR M0 ->
eval_exp (updEnv 2 e2F (updEnv 1 e1F emptyEnv))
(updDefVars 2 m2 (updDefVars 1 m1 defVars))
(Binop Plus (Var R 1) (Var R 2)) vF m ->
(Rabs (e1R - e1F) <= Q2R err1)%R ->
(Rabs (e2R - e2F) <= Q2R err2)%R ->
(Rabs (vR - vF) <= Q2R err1 + Q2R err2 + (Rabs (e1F + e2F) * (Q2R (meps m))))%R.
(Rabs (vR - vF) <= Q2R err1 + Q2R err2 + (Rabs (e1F + e2F) * (Q2R (mTypeToQ m))))%R.
Proof.
intros e1_real e1_float e2_real e2_float plus_real plus_float bound_e1 bound_e2.
(* Prove that e1R and e2R are the correct values and that vR is e1R + e2R *)
......@@ -94,17 +94,17 @@ Qed.
**)
Lemma subtract_abs_err_bounded (e1:exp Q) (e1R:R) (e1F:R) (e2:exp Q) (e2R:R)
(e2F:R) (vR:R) (vF:R) (E1 E2:env) err1 err2 (m m1 m2:mType) defVars:
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e1)) e1R M0 ->
eval_exp E1 (toRMap defVars) (toREval (toRExp e1)) e1R M0 ->
eval_exp E2 defVars (toRExp e1) e1F m1 ->
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e2)) e2R M0 ->
eval_exp E1 (toRMap defVars) (toREval (toRExp e2)) e2R M0 ->
eval_exp E2 defVars (toRExp e2) e2F m2 ->
eval_exp E1 (toREvalVars defVars) (toREval (Binop Sub (toRExp e1) (toRExp e2))) vR M0 ->
eval_exp E1 (toRMap defVars) (toREval (Binop Sub (toRExp e1) (toRExp e2))) vR M0 ->
eval_exp (updEnv 2 e2F (updEnv 1 e1F emptyEnv))
(updDefVars 2 m2 (updDefVars 1 m1 defVars))
(Binop Sub (Var R 1) (Var R 2)) vF m ->
(Rabs (e1R - e1F) <= Q2R err1)%R ->
(Rabs (e2R - e2F) <= Q2R err2)%R ->
(Rabs (vR - vF) <= Q2R err1 + Q2R err2 + ((Rabs (e1F - e2F)) * (Q2R (meps m))))%R.
(Rabs (vR - vF) <= Q2R err1 + Q2R err2 + ((Rabs (e1F - e2F)) * (Q2R (mTypeToQ m))))%R.
Proof.
intros e1_real e1_float e2_real e2_float sub_real sub_float bound_e1 bound_e2.
(* Prove that e1R and e2R are the correct values and that vR is e1R + e2R *)
......@@ -155,15 +155,15 @@ Qed.
Lemma mult_abs_err_bounded (e1:exp Q) (e1R:R) (e1F:R) (e2:exp Q) (e2R:R) (e2F:R)
(vR:R) (vF:R) (E1 E2:env) (m m1 m2:mType) defVars:
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e1)) e1R M0 ->
eval_exp E1 (toRMap defVars) (toREval (toRExp e1)) e1R M0 ->
eval_exp E2 defVars (toRExp e1) e1F m1 ->
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e2)) e2R M0 ->
eval_exp E1 (toRMap defVars) (toREval (toRExp e2)) e2R M0 ->
eval_exp E2 defVars (toRExp e2) e2F m2 ->
eval_exp E1 (toREvalVars defVars) (toREval (Binop Mult (toRExp e1) (toRExp e2))) vR M0 ->
eval_exp E1 (toRMap defVars) (toREval (Binop Mult (toRExp e1) (toRExp e2))) vR M0 ->
eval_exp (updEnv 2 e2F (updEnv 1 e1F emptyEnv))
(updDefVars 2 m2 (updDefVars 1 m1 defVars))
(Binop Mult (Var R 1) (Var R 2)) vF m ->
(Rabs (vR - vF) <= Rabs (e1R * e2R - e1F * e2F) + Rabs (e1F * e2F) * (Q2R (meps m)))%R.
(Rabs (vR - vF) <= Rabs (e1R * e2R - e1F * e2F) + Rabs (e1F * e2F) * (Q2R (mTypeToQ m)))%R.
Proof.
intros e1_real e1_float e2_real e2_float mult_real mult_float.
(* Prove that e1R and e2R are the correct values and that vR is e1R * e2R *)
......@@ -206,15 +206,15 @@ Qed.
Lemma div_abs_err_bounded (e1:exp Q) (e1R:R) (e1F:R) (e2:exp Q) (e2R:R) (e2F:R)
(vR:R) (vF:R) (E1 E2:env) (m m1 m2:mType) defVars:
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e1)) e1R M0 ->
eval_exp E1 (toRMap defVars) (toREval (toRExp e1)) e1R M0 ->
eval_exp E2 defVars (toRExp e1) e1F m1 ->
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e2)) e2R M0 ->
eval_exp E1 (toRMap defVars) (toREval (toRExp e2)) e2R M0 ->
eval_exp E2 defVars (toRExp e2) e2F m2 ->
eval_exp E1 (toREvalVars defVars) (toREval (Binop Div (toRExp e1) (toRExp e2))) vR M0 ->
eval_exp E1 (toRMap defVars) (toREval (Binop Div (toRExp e1) (toRExp e2))) vR M0 ->
eval_exp (updEnv 2 e2F (updEnv 1 e1F emptyEnv))
(updDefVars 2 m2 (updDefVars 1 m1 defVars))
(Binop Div (Var R 1) (Var R 2)) vF m ->
(Rabs (vR - vF) <= Rabs (e1R / e2R - e1F / e2F) + Rabs (e1F / e2F) * (Q2R (meps m)))%R.
(Rabs (vR - vF) <= Rabs (e1R / e2R - e1F / e2F) + Rabs (e1F / e2F) * (Q2R (mTypeToQ m)))%R.
Proof.
intros e1_real e1_float e2_real e2_float div_real div_float.
(* Prove that e1R and e2R are the correct values and that vR is e1R * e2R *)
......@@ -433,13 +433,13 @@ Proof.
Qed.
Lemma round_abs_err_bounded (e:exp R) (nR nF1 nF:R) (E1 E2: env) (err:R) (machineEpsilon m:mType) defVars:
eval_exp E1 (toREvalVars defVars) (toREval e) nR M0 ->
eval_exp E1 (toRMap defVars) (toREval e) nR M0 ->
eval_exp E2 defVars e nF1 m ->
eval_exp (updEnv 1 nF1 emptyEnv)
(updDefVars 1 m defVars)
(toRExp (Downcast machineEpsilon (Var Q 1))) nF machineEpsilon->
(Rabs (nR - nF1) <= err)%R ->
(Rabs (nR - nF) <= err + (Rabs nF1) * Q2R (meps machineEpsilon))%R.
(Rabs (nR - nF) <= err + (Rabs nF1) * Q2R (mTypeToQ machineEpsilon))%R.
Proof.
intros eval_real eval_float eval_float_rnd err_bounded.
replace (nR - nF)%R with ((nR - nF1) + (nF1 - nF))%R by lra.
......
This diff is collapsed.
(**
Formalization of the base expression language for the daisy framework
**)
Require Import Coq.Reals.Reals Coq.micromega.Psatz Coq.QArith.QArith Coq.QArith.Qreals.
Require Import Daisy.Infra.RealRationalProps Daisy.Infra.RationalSimps Daisy.Infra.Ltacs.
Require Export Daisy.Infra.Abbrevs Daisy.Infra.RealSimps Daisy.Infra.NatSet Daisy.IntervalArithQ Daisy.IntervalArith Daisy.Infra.MachineType.
Require Import Coq.Reals.Reals Coq.micromega.Psatz Coq.QArith.QArith
Coq.QArith.Qreals.
Require Import Daisy.Infra.RealRationalProps Daisy.Infra.RationalSimps
Daisy.Infra.Ltacs.
Require Export Daisy.Infra.Abbrevs Daisy.Infra.RealSimps Daisy.Infra.NatSet
Daisy.IntervalArithQ Daisy.IntervalArith Daisy.Infra.MachineType.
(**
Expressions will use binary operators.
......@@ -11,7 +14,7 @@ Require Export Daisy.Infra.Abbrevs Daisy.Infra.RealSimps Daisy.Infra.NatSet Dais
**)
Inductive binop : Type := Plus | Sub | Mult | Div.
Definition binopEqBool (b1:binop) (b2:binop) :=
Definition binopEq (b1:binop) (b2:binop) :=
match b1, b2 with
| Plus, Plus => true
| Sub, Sub => true
......@@ -32,16 +35,25 @@ Definition evalBinop (o:binop) (v1:R) (v2:R) :=
| Div => Rdiv v1 v2
end.
Lemma binopEqBool_refl b:
binopEqBool b b = true.
Lemma binopEq_refl b:
binopEq b b = true.
Proof.
case b; auto.
Qed.
Lemma binopEqBool_prop b1 b2:
binopEqBool b1 b2 = true <-> b1 = b2.
Lemma binopEq_compat_eq b1 b2:
binopEq b1 b2 = true <-> b1 = b2.
Proof.
split; case b1; case b2; intros; simpl in *; try congruence; auto.
split; case b1; case b2; intros; simpl in *; congruence.
Qed.
Lemma binopEq_compat_eq_false b1 b2:
binopEq b1 b2 = false <-> ~ (b1 = b2).
Proof.
split; intros neq.
- hnf; intros; subst. rewrite binopEq_refl in neq.
congruence.
- destruct b1; destruct b2; cbv; congruence.
Qed.
(**
......@@ -50,23 +62,23 @@ Qed.
**)
Inductive unop: Type := Neg | Inv.
Definition unopEqBool (o1:unop) (o2:unop) :=
Definition unopEq (o1:unop) (o2:unop) :=
match o1, o2 with
| Neg, Neg => true
| Inv, Inv => true
| _ , _ => false
end.
Lemma unopEqBool_refl b:
unopEqBool b b = true.
Lemma unopEq_refl b:
unopEq b b = true.
Proof.
case b; auto.
Qed.
Lemma unopEqBool_prop b1 b2:
unopEqBool b1 b2 = true <-> b1 = b2.
Lemma unopEq_compat_eq b1 b2:
unopEq b1 b2 = true <-> b1 = b2.
Proof.
split; case b1; case b2; intros; simpl in *; try congruence; auto.
split; case b1; case b2; intros; simpl in *; congruence.
Qed.
(**
......@@ -94,54 +106,58 @@ Inductive exp (V:Type): Type :=
Boolean equality function on expressions.
Used in certificates to define the analysis result as function
**)
Fixpoint expEqBool (e1:exp Q) (e2:exp Q) :=
Fixpoint expEq (e1:exp Q) (e2:exp Q) :=
match e1, e2 with
| Var _ v1, Var _ v2 => (v1 =? v2)
| Const m1 n1, Const m2 n2 => andb (mTypeEqBool m1 m2) (Qeq_bool n1 n2)
| Unop o1 e11, Unop o2 e22 => andb (unopEqBool o1 o2) (expEqBool e11 e22)
| Binop o1 e11 e12, Binop o2 e21 e22 => andb (binopEqBool o1 o2) (andb (expEqBool e11 e21) (expEqBool e12 e22))
| Downcast m1 f1, Downcast m2 f2 => andb (mTypeEqBool m1 m2) (expEqBool f1 f2)
| Const m1 n1, Const m2 n2 =>
(mTypeEq m1 m2) && (Qeq_bool n1 n2)
| Unop o1 e11, Unop o2 e22 =>
(unopEq o1 o2) && (expEq e11 e22)
| Binop o1 e11 e12, Binop o2 e21 e22 =>
(binopEq o1 o2) && (expEq e11 e21) && (expEq e12 e22)
| Downcast m1 f1, Downcast m2 f2 =>
(mTypeEq m1 m2) && (expEq f1 f2)
| _, _ => false
end.
Lemma expEqBool_refl e:
expEqBool e e = true.
Lemma expEq_refl e:
expEq 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 .
- symmetry; apply beq_nat_refl.
- apply mTypeEq_refl.
- apply Qeq_bool_iff; lra.
- case u; auto.
- case b; auto.
- apply andb_true_iff; split.
apply IHe1. apply IHe2.
- apply mTypeEq_refl.
Qed.
Lemma expEqBool_sym e e':
expEqBool e e' = expEqBool e' e.
Lemma expEq_sym e e':
expEq e e' = expEq e' e.
Proof.
revert e'.
induction e; intros e'; destruct e'; simpl; try auto.
- apply beq_nat_sym.
- apply Nat.eqb_sym.
- f_equal.
+ apply mTypeEqBool_sym; auto.
+ apply mTypeEq_sym; auto.
+ apply Qeq_bool_sym.
- f_equal.
+ destruct u; auto.
+ apply IHe.
- f_equal.
+ destruct b; auto.
+ f_equal.
* destruct b; auto.
* apply IHe1.
* apply IHe2.
+ apply IHe2.
- f_equal.
+ apply mTypeEqBool_sym; auto.
+ apply mTypeEq_sym; auto.
+ apply IHe.
Qed.
Lemma expEqBool_trans e f g:
expEqBool e f = true ->
expEqBool f g = true ->
expEqBool e g = true.
Lemma expEq_trans e f g:
expEq e f = true ->
expEq f g = true ->
expEq e g = true.
Proof.
revert e f g; induction e;
destruct f; intros g eq1 eq2;
......@@ -150,25 +166,24 @@ Proof.
subst; try auto.
- andb_to_prop eq1;
andb_to_prop eq2.
apply EquivEqBoolEq in L.
apply EquivEqBoolEq in L0; subst.
rewrite mTypeEqBool_refl; simpl.
rewrite mTypeEq_compat_eq in L, L0; subst.
rewrite