Commit ea7e921d authored by Heiko Becker's avatar Heiko Becker
Browse files

WIP: Port to finite maps in Coq

parent 5beeaad7
......@@ -13,9 +13,11 @@ Require Export Daisy.Infra.ExpressionAbbrevs Daisy.Commands.
(** Certificate checking function **)
Definition CertificateChecker (e:exp Q) (absenv:analysisResult) (P:precond) (defVars:nat -> option mType) :=
if (typeCheck e defVars (typeMap defVars e)) then
if (validIntervalbounds e absenv P NatSet.empty) && FPRangeValidator e absenv (typeMap defVars e) NatSet.empty
then (validErrorbound e (typeMap defVars e) absenv NatSet.empty)
let tMap := (typeMap defVars e (DaisyMap.empty mType)) in
if (typeCheck e defVars tMap)
then
if (validIntervalbounds e absenv P NatSet.empty) && FPRangeValidator e absenv tMap NatSet.empty
then (validErrorbound e tMap absenv NatSet.empty)
else false
else false.
......@@ -27,19 +29,20 @@ Definition CertificateChecker (e:exp Q) (absenv:analysisResult) (P:precond) (def
Theorem Certificate_checking_is_sound (e:exp Q) (absenv:analysisResult) P defVars:
forall (E1 E2:env),
approxEnv E1 defVars absenv (usedVars e) NatSet.empty E2 ->
(forall v, NatSet.mem v (Expressions.usedVars e) = true ->
(forall v, NatSet.In v (Expressions.usedVars e) ->
exists vR, E1 v = Some vR /\
(Q2R (fst (P v)) <= vR <= Q2R (snd (P v)))%R) ->
(forall v, (v) mem (usedVars e) = true ->
(forall v, NatSet.In v (usedVars e) ->
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 /\
(forall vF m,
eval_exp E2 defVars (toRExp e) vF m ->
(Rabs (vR - vF) <= Q2R (snd (absenv e))))%R.
exists iv err vR vF m,
DaisyMap.find e absenv = Some (iv, err) /\
eval_exp E1 (toRMap defVars) (toREval (toRExp e)) vR M0 /\
eval_exp E2 defVars (toRExp e) vF m /\
(forall vF m,
eval_exp E2 defVars (toRExp e) vF m ->
(Rabs (vR - vF) <= Q2R err))%R.
(**
The proofs is a simple composition of the soundness proofs for the range
validator and the error bound validator.
......@@ -49,55 +52,52 @@ Proof.
unfold CertificateChecker in certificate_valid.
rewrite <- andb_lazy_alt in certificate_valid.
andb_to_prop certificate_valid.
env_assert absenv e env_e.
destruct env_e as [iv [err absenv_eq]].
destruct iv as [ivlo ivhi].
rewrite absenv_eq; simpl.
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 (dVars_range_valid NatSet.empty E1 absenv).
{ unfold dVars_range_valid.
intros; set_tac. }
assert (NatSet.Subset (usedVars e -- NatSet.empty) (Expressions.usedVars e)).
{ hnf; intros a in_empty.
set_tac. }
assert (vars_typed (usedVars e NatSet.empty) defVars).
{ unfold vars_typed. intros; apply types_defined. set_tac. destruct H1; set_tac.
split; try auto. hnf; intros; set_tac. }
rename R into validFPRanges.
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. }
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 L1 H1 P_valid H absenv_eq) as [[vF [mF eval_float]] err_bounded]; auto.
exists vR; exists vF; exists mF; split; auto.
edestruct (validIntervalbounds_sound e (A:=absenv) (P:=P) (fVars:=usedVars e) (dVars:=NatSet.empty) (Gamma:=defVars) (E:=E1))
as [iv_e [ err_e [vR [ map_e [eval_real real_bounds_e]]]]]; eauto.
destruct iv_e as [elo ehi].
edestruct (validErrorbound_sound e (typeMap defVars e (DaisyMap.empty mType)) L approxE1E2 H0 eval_real R0 L1 H P_valid H1 map_e) as [[vF [mF eval_float]] err_bounded]; auto.
exists (elo, ehi), err_e, vR, vF, mF; split; auto.
Qed.
Definition CertificateCheckerCmd (f:cmd Q) (absenv:analysisResult) (P:precond) defVars:=
if (typeCheckCmd f defVars (typeMapCmd defVars f) && validSSA f (freeVars f))
let tMap := typeMapCmd defVars f (DaisyMap.empty mType) in
if (typeCheckCmd f defVars tMap && validSSA f (freeVars f))
then
if (validIntervalboundsCmd f absenv P NatSet.empty) &&
FPRangeValidatorCmd f absenv (typeMapCmd defVars f) NatSet.empty
then (validErrorboundCmd f (typeMapCmd defVars f) absenv NatSet.empty)
FPRangeValidatorCmd f absenv tMap NatSet.empty
then (validErrorboundCmd f tMap absenv NatSet.empty)
else false
else false.
Theorem Certificate_checking_cmds_is_sound (f:cmd Q) (absenv:analysisResult) P defVars:
forall (E1 E2:env),
approxEnv E1 defVars absenv (freeVars f) NatSet.empty E2 ->
(forall v, NatSet.mem v (freeVars f)= true ->
(forall v, NatSet.In v (freeVars f) ->
exists vR, E1 v = Some vR /\
(Q2R (fst (P v)) <= vR <= Q2R (snd (P v)))%R) ->
(forall v, (v) mem (freeVars f) = true ->
(forall v, NatSet.In v (freeVars f) ->
exists m : mType,
defVars v = Some m) ->
CertificateCheckerCmd f absenv P defVars = true ->
exists vR vF m,
exists iv err vR vF m,
DaisyMap.find (getRetExp f) absenv = Some (iv,err) /\
bstep (toREvalCmd (toRCmd f)) E1 (toRMap defVars) vR M0 /\
bstep (toRCmd f) E2 defVars vF m /\
(forall vF m,
bstep (toRCmd f) E2 defVars vF m ->
(Rabs (vR - vF) <= Q2R (snd (absenv (getRetExp f))))%R).
(Rabs (vR - vF) <= Q2R (err))%R).
(**
The proofs is a simple composition of the soundness proofs for the range
validator and the error bound validator.
......@@ -109,32 +109,25 @@ Proof.
andb_to_prop certificate_valid.
apply validSSA_sound in R0.
destruct R0 as [outVars ssa_f].
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. }
rename R into validFPRanges.
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 (dVars_range_valid NatSet.empty E1 absenv).
{ unfold dVars_range_valid.
intros; set_tac. }
assert (vars_typed (freeVars f NatSet.empty) defVars).
{ unfold vars_typed. intros; apply types_defined. set_tac.
destruct H0; set_tac. }
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.
edestruct (validIntervalboundsCmd_sound)
as [iv [ err [vR [map_f [eval_real bounded_real_f]]]]]; eauto.
destruct iv as [f_lo f_hi].
edestruct validErrorboundCmd_gives_eval as [vF [mF eval_float]]; eauto.
exists vR; exists vF; exists mF; split; try auto.
split; try auto.
exists (f_lo, f_hi), err, vR, vF, mF; split; try auto.
split; try auto; split; try auto.
intros.
eapply validErrorboundCmd_sound; eauto.
Qed.
\ No newline at end of file
This diff is collapsed.
......@@ -168,29 +168,19 @@ Lemma expEq_trans e f g:
Proof.
revert e f g; induction e;
destruct f; intros g eq1 eq2;
destruct g; simpl in *; try congruence;
destruct g; cbn in *;
try rewrite Nat.eqb_eq in *;
subst; try auto.
- andb_to_prop eq1;
andb_to_prop eq2.
rewrite mTypeEq_compat_eq in L, L0; subst.
rewrite mTypeEq_refl; simpl.
Daisy_compute; try congruence; type_conv; subst; try auto.
- rewrite mTypeEq_refl; simpl.
rewrite Qeq_bool_iff in *; lra.
- andb_to_prop eq1;
andb_to_prop eq2.
rewrite unopEq_compat_eq in *; subst.
- rewrite unopEq_compat_eq in *; subst.
rewrite unopEq_refl; simpl.
eapply IHe; eauto.
- andb_to_prop eq1;
andb_to_prop eq2.
rewrite binopEq_compat_eq in *; subst.
- rewrite binopEq_compat_eq in *; subst.
rewrite binopEq_refl; simpl.
apply andb_true_iff.
split; [eapply IHe1; eauto | eapply IHe2; eauto].
- andb_to_prop eq1;
andb_to_prop eq2.
rewrite mTypeEq_compat_eq in *; subst.
rewrite mTypeEq_refl; simpl.
- rewrite mTypeEq_refl; simpl.
eapply IHe; eauto.
Qed.
......
......@@ -6,40 +6,40 @@ Require Import Coq.QArith.QArith Coq.QArith.Qreals Coq.Reals.Reals Coq.micromega
Require Import Daisy.Infra.MachineType Daisy.Typing Daisy.Infra.RealSimps Daisy.IntervalValidation Daisy.ErrorValidation Daisy.Commands Daisy.Environments Daisy.ssaPrgs Daisy.Infra.Ltacs Daisy.Infra.RealRationalProps.
Fixpoint FPRangeValidator (e:exp Q) (A:analysisResult) typeMap dVars {struct e} : bool :=
match typeMap e with
|Some m =>
let (iv_e, err_e) := A e in
let iv_e_float := widenIntv iv_e err_e in
let recRes :=
match e with
| Binop b e1 e2 =>
FPRangeValidator e1 A typeMap dVars &&
FPRangeValidator e2 A typeMap dVars
| Unop u e =>
FPRangeValidator e A typeMap dVars
| Downcast m e => FPRangeValidator e A typeMap dVars
| _ => true
end
in
match e with
| Var _ v =>
if NatSet.mem v dVars
then true
else
if (validValue (ivhi iv_e_float) m &&
validValue (ivlo iv_e_float) m)
then ((normal (ivlo iv_e_float) m) || (Qeq_bool (ivlo iv_e_float) 0)) &&
(normal (ivhi iv_e_float) m || (Qeq_bool (ivhi iv_e_float) 0)) && recRes
else
false
| _ => if (validValue (ivhi iv_e_float) m &&
validValue (ivlo iv_e_float) m)
then ((normal (ivlo iv_e_float) m) || (Qeq_bool (ivlo iv_e_float) 0)) &&
(normal (ivhi iv_e_float) m || (Qeq_bool (ivhi iv_e_float) 0)) && recRes
else
false
end
| None => false
match DaisyMap.find e typeMap, DaisyMap.find e A with
|Some m, Some (iv_e, err_e) =>
let iv_e_float := widenIntv iv_e err_e in
let recRes :=
match e with
| Binop b e1 e2 =>
FPRangeValidator e1 A typeMap dVars &&
FPRangeValidator e2 A typeMap dVars
| Unop u e =>
FPRangeValidator e A typeMap dVars
| Downcast m e => FPRangeValidator e A typeMap dVars
| _ => true
end
in
match e with
| Var _ v =>
if NatSet.mem v dVars
then true
else
if (validValue (ivhi iv_e_float) m &&
validValue (ivlo iv_e_float) m)
then ((normal (ivlo iv_e_float) m) || (Qeq_bool (ivlo iv_e_float) 0)) &&
(normal (ivhi iv_e_float) m || (Qeq_bool (ivhi iv_e_float) 0)) &&
recRes
else
false
| _ => if (validValue (ivhi iv_e_float) m &&
validValue (ivlo iv_e_float) m)
then ((normal (ivlo iv_e_float) m) || (Qeq_bool (ivlo iv_e_float) 0)) &&
(normal (ivhi iv_e_float) m || (Qeq_bool (ivhi iv_e_float) 0)) && recRes
else
false
end
| _, _ => false
end.
Fixpoint FPRangeValidatorCmd (f:cmd Q) (A:analysisResult) typeMap dVars :=
......@@ -77,77 +77,54 @@ Theorem FPRangeValidator_sound:
validErrorbound e tMap A dVars = true ->
FPRangeValidator e A tMap dVars = true ->
NatSet.Subset (NatSet.diff (usedVars e) dVars) fVars ->
(forall v, NatSet.In v fVars ->
exists vR, E1 v = Some vR /\ Q2R (fst (P v)) <= vR <= Q2R (snd (P v)))%R ->
(forall v, NatSet.In v fVars \/ NatSet.In v dVars ->
exists m, Gamma v = Some m) ->
(forall v, NatSet.In v dVars ->
exists vR, E1 v = Some vR /\
Q2R (fst (fst (A (Var Q v)))) <= vR <= Q2R (snd (fst (A (Var Q v)))))%R ->
(forall v, NatSet.In v dVars ->
exists vF m, E2 v = Some vF /\ tMap (Var Q v) = Some m /\ validFloatValue vF m) ->
dVars_range_valid dVars E1 A ->
fVars_P_sound fVars E1 P ->
vars_typed (NatSet.union fVars dVars) Gamma ->
(forall v, NatSet.In v dVars ->
exists vF m, E2 v = Some vF /\ DaisyMap.find (Var Q v) tMap = Some m /\ validFloatValue vF m) ->
validFloatValue v m.
Proof.
intros *.
unfold FPRangeValidator.
intros.
destruct (A e) as [iv_e err_e] eqn:?;
destruct iv_e as [e_lo e_hi] eqn:?; simpl in *.
assert (tMap e = Some m)
assert (DaisyMap.find e tMap = Some m)
as type_e
by (eapply typingSoundnessExp; eauto).
subst; simpl in *.
unfold validFloatValue.
assert (exists vR, eval_exp E1 (toRMap Gamma) (toREval (toRExp e)) vR M0 /\
Q2R (fst (fst (A e))) <= vR <= Q2R (snd (fst (A e))))%R
as eval_real_exists.
{ eapply validIntervalbounds_sound; eauto.
- intros; apply H8.
rewrite <- NatSet.mem_spec; auto.
- intros. apply H6.
rewrite <- NatSet.mem_spec; auto.
- intros. apply H7.
set_tac.
rewrite <- NatSet.union_spec; auto. }
destruct eval_real_exists as [vR [eval_real vR_bounded]].
assert (Rabs (vR - v) <= Q2R (snd (A e)))%R.
{ eapply validErrorbound_sound; eauto.
- intros * v1_dVar.
apply H8; set_tac.
- intros * v0_fVar.
apply H6. rewrite <- NatSet.mem_spec; auto.
- intros * v1_in_union.
apply H7; set_tac.
rewrite NatSet.union_spec in v1_in_union; auto.
- eauto ; instantiate (1:= e_hi).
instantiate (1:=e_lo). rewrite Heqp. reflexivity. }
rewrite Heqp in *; simpl in *.
edestruct (validIntervalbounds_sound e (A:=A) (P:=P))
as [iv_e [err_e [vR[ map_e[eval_real vR_bounded]]]]]; eauto.
destruct iv_e as [e_lo e_hi].
assert (Rabs (vR - v) <= Q2R (err_e))%R.
{ eapply validErrorbound_sound; eauto. }
destruct (distance_gives_iv (a:=vR) v (e:=Q2R err_e) (Q2R e_lo, Q2R e_hi))
as [v_in_errIv];
try auto.
unfold IVlo, IVhi in *; simpl in *.
simpl in *.
assert (Rabs v <= Rabs (Q2R e_hi + Q2R err_e) \/
Rabs v <= Rabs (Q2R e_lo - Q2R err_e))%R
as abs_bounded
by (apply bounded_inAbs; auto).
destruct e;
unfold validFloatValue in *; simpl in *;
rewrite type_e, Heqp in *; simpl in *.
unfold validFloatValue in *; cbn in *;
rewrite type_e in *; cbn in *.
- destruct (n mem dVars) eqn:?; simpl in *.
+ destruct (H9 n); try set_tac.
destruct H12 as [m2 [env_eq [map_eq validVal]]].
inversion H0; subst.
rewrite env_eq in H14; inversion H14; subst.
rewrite map_eq in type_e; inversion type_e; subst; auto.
+ andb_to_prop H4.
+ Daisy_compute.
prove_fprangeval m v L1 R.
- andb_to_prop H4.
- Daisy_compute.
prove_fprangeval m v L1 R.
- andb_to_prop H4.
prove_fprangeval m v L1 R.
- andb_to_prop H4.
prove_fprangeval m v L1 R.
- andb_to_prop H4.
- Daisy_compute; try congruence.
type_conv; subst.
prove_fprangeval m0 v L1 R.
- Daisy_compute; try congruence.
type_conv; subst.
prove_fprangeval (join m0 m1) v L1 R.
- Daisy_compute; try congruence.
type_conv; subst.
prove_fprangeval m v L1 R.
Qed.
......@@ -162,22 +139,11 @@ Lemma FPRangeValidatorCmd_sound (f:cmd Q):
validErrorboundCmd f tMap A dVars = true ->
FPRangeValidatorCmd f A tMap dVars = true ->
NatSet.Subset (NatSet.diff (freeVars f) dVars) fVars ->
(forall v,
NatSet.In v fVars ->
exists vR, E1 v = Some vR /\ Q2R (fst (P v)) <= vR <= Q2R (snd (P v)))%R ->
(forall v,
NatSet.In v fVars \/ NatSet.In v dVars ->
exists m, Gamma v = Some m) ->
(forall v,
NatSet.In v dVars ->
exists vR,
E1 v = Some vR /\ Q2R (ivlo (fst (A (Var Q v)))) <= vR /\
vR <= Q2R (ivhi(fst (A (Var Q v)))))%R ->
(forall v,
NatSet.In v dVars ->
exists vF m,
E2 v = Some vF /\ tMap (Var Q v) = Some m /\
validFloatValue vF m) ->
dVars_range_valid dVars E1 A ->
fVars_P_sound fVars E1 P ->
vars_typed (NatSet.union fVars dVars) Gamma ->
(forall v, NatSet.In v dVars ->
exists vF m, E2 v = Some vF /\ DaisyMap.find (Var Q v) tMap = Some m /\ validFloatValue vF m) ->
validFloatValue v m.
Proof.
induction f; intros;
......@@ -187,45 +153,38 @@ Proof.
repeat match goal with
| H : _ = true |- _ => andb_to_prop H
end.
- assert (tMap e = Some m)
- assert (DaisyMap.find e tMap = Some m)
by(eapply typingSoundnessExp; eauto).
match_pat (ssa _ _ _) (fun H => inversion H; subst; simpl in *).
destruct (A e) as [iv_e err_e] eqn:?;
destruct iv_e as [e_lo e_hi] eqn:?.
edestruct (validErrorbound_sound e (E1:=E1) (E2:=E2) (fVars:=fVars) (dVars := dVars) P (absenv:=A) (nR:=v0) (err:=err_e)) as [[vF_e [m_e eval_float_e]] err_bounded_e]; eauto.
Daisy_compute.
edestruct (validIntervalbounds_sound e L1 (Gamma := Gamma)(P:= P) (A:=A)
(fVars:=fVars) (dVars:=dVars)
(E:=E1))
as [iv_e [err_e [vR_e [map_e [eval_e_real bounded_vR_e]]]]]; eauto.
+ set_tac. split; try auto.
rewrite NatSet.remove_spec, NatSet.union_spec; split; try auto.
hnf; intros; subst.
set_tac.
+ intros. apply H10; auto; set_tac.
+ intros; apply H8; auto. rewrite <- NatSet.mem_spec; auto.
+ intros. apply H9; set_tac. rewrite <- NatSet.union_spec; auto.
+ edestruct (validIntervalbounds_sound e A P (fVars:=fVars) (dVars:=dVars) E1); eauto.
* intros. apply H10; auto; set_tac.
split; try auto.
hnf; intros; subst; set_tac.
+ destr_factorize.
edestruct (validErrorbound_sound e (E1:=E1) (E2:=E2) (fVars:=fVars)
(dVars := dVars) (A:=A) (P:=P) tMap
(nR:=v0) (err:=err_e) (elo:=q) (ehi:=q0))
as [[vF_e [m_e eval_float_e]] err_bounded_e]; eauto.
* set_tac. split; try auto.
rewrite NatSet.remove_spec, NatSet.union_spec; split; try auto.
hnf; intros; subst.
set_tac.
* intros. apply H8. rewrite NatSet.mem_spec in *; auto.
* intros. instantiate (1:= Gamma); apply H9. set_tac.
rewrite NatSet.union_spec in *; auto.
* rewrite H3 in *.
destruct (tMap (Var Q n)) eqn:?; simpl in *; try congruence.
rename x into vR_e.
destruct H4 as [eval_e_real bounded_vR_e].
rewrite <- (meps_0_deterministic (toRExp e) eval_e_real H20) in *; try auto.
andb_to_prop R5.
split; try auto.
hnf; intros; subst; set_tac.
* rewrite <- (meps_0_deterministic (toRExp e) eval_e_real H20) in *; try auto.
apply (IHf (updEnv n vR_e E1) (updEnv n v1 E2)
(updDefVars n m Gamma) v vR m0 A tMap P fVars
(NatSet.add n dVars) (outVars)); eauto.
{ apply approxUpdBound; auto.
{ eapply approxUpdBound; eauto.
simpl in *.
apply Rle_trans with (r2:= Q2R err_e); try lra.
rewrite Heqp in *; simpl in *.
eapply err_bounded_e. eauto.
apply Qle_Rle.
rewrite Qeq_bool_iff in *.
rewrite R1. lra. }
destruct i; inversion Heqo0; subst.
rewrite R2.
lra. }
{ eapply ssa_equal_set; eauto.
hnf. intros a; split; intros in_set.
- rewrite NatSet.add_spec, NatSet.union_spec;
......@@ -237,8 +196,7 @@ Proof.
{ eapply (swap_Gamma_bstep (Gamma1 := updDefVars n M0 (toRMap Gamma))); eauto.
eauto using Rmap_updVars_comm. }
{ set_tac; split.
- rewrite NatSet.remove_spec, NatSet.union_spec.
split; try auto.
- split; try auto.
hnf; intros; subst.
apply H5; rewrite NatSet.add_spec; auto.
- hnf; intros.
......@@ -248,28 +206,25 @@ Proof.
case_eq (v2 =? n); intros v2_eq.
- apply Nat.eqb_eq in v2_eq; subst.
set_tac.
exfalso; apply H16; set_tac.
- apply H8; auto. }
{ intros. unfold updDefVars.
destruct v2_fVar as [? |[? ?]]; try congruence.
exists vR_e, (q1,q2), e1; split; try auto. split; try auto.
simpl; canonize_hyps. rewrite <- R4, <- R5. auto.
- apply H8; try auto.
set_tac. destruct v2_fVar as [v2_n | [? ?]]; try auto.
rewrite Nat.eqb_neq in v2_eq; congruence. }
{ unfold fVars_P_sound. intros. unfold updEnv.
destruct (v2 =? n) eqn:?; eauto.
apply H9. destruct H4; try auto.
rewrite Nat.eqb_eq in *; subst.
set_tac.
exfalso; apply H18; set_tac. }
{ unfold vars_typed. intros.
unfold updDefVars.
destruct (v2 =? n) eqn:?; eauto.
apply H10. rewrite NatSet.union_spec in *.
destruct H4; try auto.
rewrite NatSet.add_spec in H4.
rewrite Nat.eqb_neq in *.
destruct H4; subst; try congruence; auto. }
{ intros. unfold updEnv.
destruct (v2 =? n) eqn:?.
- exists vR_e. rewrite Nat.eqb_eq in *; subst.
split; try auto.
destruct bounded_vR_e;
rewrite Heqp in *; simpl in *.
split.
+ apply Rle_trans with (r2:=Q2R e_lo); try lra.
apply Qle_Rle. rewrite Qeq_bool_iff in *; rewrite R4; lra.
+ apply Rle_trans with (r2:=Q2R e_hi); try lra.
apply Qle_Rle; rewrite Qeq_bool_iff in *; rewrite R3; lra.
- apply H10. rewrite Nat.eqb_neq in *.
rewrite NatSet.add_spec in H4.
destruct H4; try auto; subst; congruence. }
{ intros. unfold updEnv.
type_conv; subst.
destruct (v2 =? n) eqn:?; try rewrite Nat.eqb_eq in *;
......@@ -277,7 +232,6 @@ Proof.
- exists v1; subst. exists m1; repeat split; try auto.
eapply FPRangeValidator_sound; eauto.
set_tac. split; try auto.
rewrite NatSet.remove_spec, NatSet.union_spec.
split; try auto.
hnf; intros; subst; set_tac.
- apply H11.
......
......@@ -265,34 +265,26 @@ Lemma typing_exp_64_bit e:
typeCheck e Gamma tMap = true ->
(forall v,
NatSet.In v (usedVars e) -> Gamma v = Some M64) ->
tMap e = Some M64.
DaisyMap.find e tMap = Some M64.
Proof.
induction e; intros * noDowncast_e is64BitEval_e typecheck_e types_valid;
simpl in *; try inversion noDowncast_e;
subst.
- destruct (tMap (Var Q n)); try congruence.
rewrite types_valid in *; try set_tac.
type_conv; subst; auto.
- destruct (tMap (Const M64 v)) eqn:?; try congruence; type_conv; subst; auto.
- destruct (tMap (Unop u e)) eqn:?; try congruence.
erewrite IHe in *; eauto.
+ andb_to_prop typecheck_e; type_conv; subst; auto.
+ destruct (tMap e); try congruence; andb_to_prop typecheck_e; auto.
cbn in *; try inversion noDowncast_e;
subst; Daisy_compute; try congruence;
type_conv; subst.
- rewrite types_valid in *; try set_tac.
- destruct m; try congruence.
- erewrite IHe in *; eauto.
- repeat (match goal with
|H: _ /\ _ |- _=> destruct H
end).
destruct (tMap (Binop b e1 e2)) eqn:?; try congruence;
erewrite IHe1 in *; eauto.
+ erewrite IHe2 in *; eauto.
* unfold join in typecheck_e.
rewrite isMorePrecise_refl in typecheck_e; andb_to_prop typecheck_e;
type_conv; subst; auto.
* destruct (tMap e2); try congruence.
andb_to_prop typecheck_e; eauto.
* unfold join in *.
destr_factorize.
rewrite <- isMorePrecise_morePrecise.