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

Fix soundness proof for roundoff error valdator

parent c056a2d9
...@@ -18,22 +18,24 @@ exprression may yield different values for different machine epsilons ...@@ -18,22 +18,24 @@ exprression may yield different values for different machine epsilons
**) **)
Inductive approxEnv : env -> (expr R -> option mType) -> analysisResult -> NatSet.t Inductive approxEnv : env -> (expr R -> option mType) -> analysisResult -> NatSet.t
-> NatSet.t -> env -> Prop := -> NatSet.t -> env -> Prop :=
|approxRefl defVars A: |approxRefl Gamma A:
approxEnv emptyEnv defVars A NatSet.empty NatSet.empty emptyEnv approxEnv emptyEnv Gamma A NatSet.empty NatSet.empty emptyEnv
|approxUpdFree E1 E2 defVars A v1 v2 x fVars dVars m: |approxUpdFree E1 E2 Gamma A v1 v2 x fVars dVars m:
approxEnv E1 defVars A fVars dVars E2 -> approxEnv E1 Gamma A fVars dVars E2 ->
Gamma (Var R x) = Some m ->
(Rabs (v1 - v2) <= computeErrorR v1 m)%R -> (Rabs (v1 - v2) <= computeErrorR v1 m)%R ->
NatSet.mem x (NatSet.union fVars dVars) = false -> NatSet.mem x (NatSet.union fVars dVars) = false ->
approxEnv (updEnv x v1 E1) approxEnv (updEnv x v1 E1)
(updDefVars (Var R x) m defVars) A (NatSet.add x fVars) dVars (updDefVars (Var R x) m Gamma) A (NatSet.add x fVars) dVars
(updEnv x v2 E2) (updEnv x v2 E2)
|approxUpdBound E1 E2 defVars A v1 v2 x fVars dVars m iv err: |approxUpdBound E1 E2 Gamma A v1 v2 x fVars dVars m iv err:
approxEnv E1 defVars A fVars dVars E2 -> approxEnv E1 Gamma A fVars dVars E2 ->
Gamma (Var R x) = Some m ->
FloverMap.find (Var Q x) A = Some (iv, err) -> FloverMap.find (Var Q x) A = Some (iv, err) ->
(Rabs (v1 - v2) <= Q2R err)%R -> (Rabs (v1 - v2) <= Q2R err)%R ->
NatSet.mem x (NatSet.union fVars dVars) = false -> NatSet.mem x (NatSet.union fVars dVars) = false ->
approxEnv (updEnv x v1 E1) approxEnv (updEnv x v1 E1)
(updDefVars (Var R x) m defVars) A fVars (NatSet.add x dVars) Gamma A fVars (NatSet.add x dVars)
(updEnv x v2 E2). (updEnv x v2 E2).
Section RelationProperties. Section RelationProperties.
...@@ -58,7 +60,7 @@ Section RelationProperties. ...@@ -58,7 +60,7 @@ Section RelationProperties.
+ eapply IHa; eauto. + eapply IHa; eauto.
set_tac. set_tac.
destruct x_valid; set_tac. destruct x_valid; set_tac.
destruct H1 as [? | [? ?]]; subst; try auto. destruct H2 as [? | [? ?]]; subst; try auto.
rewrite Nat.eqb_refl in eq_case; congruence. rewrite Nat.eqb_refl in eq_case; congruence.
- unfold updEnv in *. - unfold updEnv in *.
case_eq (x =? x0); intros eq_case; rewrite eq_case in *. case_eq (x =? x0); intros eq_case; rewrite eq_case in *.
...@@ -66,7 +68,7 @@ Section RelationProperties. ...@@ -66,7 +68,7 @@ Section RelationProperties.
+ eapply IHa; auto. + eapply IHa; auto.
set_tac. set_tac.
destruct x_valid; set_tac. destruct x_valid; set_tac.
destruct H2 as [? | [ ? ?]]; subst; try auto. destruct H3 as [? | [ ? ?]]; subst; try auto.
rewrite Nat.eqb_refl in eq_case; congruence. rewrite Nat.eqb_refl in eq_case; congruence.
Qed. Qed.
...@@ -104,7 +106,7 @@ Section RelationProperties. ...@@ -104,7 +106,7 @@ Section RelationProperties.
- assert (x =? x0 = false) as x_x0_neq. - assert (x =? x0 = false) as x_x0_neq.
{ rewrite Nat.eqb_neq; hnf; intros; subst. { rewrite Nat.eqb_neq; hnf; intros; subst.
set_tac. set_tac.
apply H1. apply H2.
set_tac. } set_tac. }
unfold updEnv in *; rewrite x_x0_neq in *. unfold updEnv in *; rewrite x_x0_neq in *.
unfold updDefVars in x_typed. unfold updDefVars in x_typed.
...@@ -130,7 +132,7 @@ Section RelationProperties. ...@@ -130,7 +132,7 @@ Section RelationProperties.
- assert (x =? x0 = false) as x_x0_neq. - assert (x =? x0 = false) as x_x0_neq.
{ rewrite Nat.eqb_neq; hnf; intros; subst. { rewrite Nat.eqb_neq; hnf; intros; subst.
set_tac. set_tac.
apply H0; set_tac. apply H1; set_tac.
} }
unfold updEnv in *; rewrite x_x0_neq in *. unfold updEnv in *; rewrite x_x0_neq in *.
unfold updDefVars in x_typed; cbn in x_typed. unfold updDefVars in x_typed; cbn in x_typed.
...@@ -144,7 +146,7 @@ Section RelationProperties. ...@@ -144,7 +146,7 @@ Section RelationProperties.
+ unfold updEnv in *; + unfold updEnv in *;
rewrite Nat.eqb_refl in *; simpl in *. rewrite Nat.eqb_refl in *; simpl in *.
inversion E1_def; inversion E2_def; subst. inversion E1_def; inversion E2_def; subst.
rewrite A_e in *; inversion H; auto. rewrite A_e in *; inversion H0; auto.
+ unfold updEnv in *; simpl in *. + unfold updEnv in *; simpl in *.
rewrite <- Nat.eqb_neq in x_neq. rewrite <- Nat.eqb_neq in x_neq.
rewrite x_neq in *; simpl in *. rewrite x_neq in *; simpl in *.
......
...@@ -362,7 +362,8 @@ Lemma round_abs_err_bounded (e:expr R) (nR nF1 nF:R) (E1 E2: env) (err:R) ...@@ -362,7 +362,8 @@ Lemma round_abs_err_bounded (e:expr R) (nR nF1 nF:R) (E1 E2: env) (err:R)
eval_expr E1 (toRTMap defVars) (toREval e) nR REAL -> eval_expr E1 (toRTMap defVars) (toREval e) nR REAL ->
eval_expr E2 defVars e nF1 m -> eval_expr E2 defVars e nF1 m ->
eval_expr (updEnv 1 nF1 emptyEnv) eval_expr (updEnv 1 nF1 emptyEnv)
(updDefVars (Var R 1) m defVars) (updDefVars (Downcast mEps (Var R 1)) mEps
(updDefVars (Var R 1) m defVars))
(toRExp (Downcast mEps (Var Q 1))) nF mEps-> (toRExp (Downcast mEps (Var Q 1))) nF mEps->
(Rabs (nR - nF1) <= err)%R -> (Rabs (nR - nF1) <= err)%R ->
(Rabs (nR - nF) <= err + computeErrorR nF1 mEps)%R. (Rabs (nR - nF) <= err + computeErrorR nF1 mEps)%R.
......
This diff is collapsed.
...@@ -5,53 +5,54 @@ From Flover ...@@ -5,53 +5,54 @@ From Flover
Require Export Infra.ExpressionAbbrevs ErrorValidation RealRangeValidator Require Export Infra.ExpressionAbbrevs ErrorValidation RealRangeValidator
TypeValidator Environments. TypeValidator Environments.
Definition RoundoffErrorValidator (e:expr Q) (tMap:FloverMap.t mType) (A:analysisResult) (dVars:NatSet.t) := Definition RoundoffErrorValidator (e:expr Q) (tMap:FloverMap.t mType)
(A:analysisResult) (dVars:NatSet.t) :=
(* if *) (* if *)
validErrorbound e tMap A dVars. validErrorbound e tMap A dVars.
(*then true *) (*then true *)
(* else validAffineErrorBounds e A tMap dVars *) (* else validAffineErrorBounds e A tMap dVars *)
Theorem RoundoffErrorValidator_sound: Theorem RoundoffErrorValidator_sound:
forall (e : expr Q) (E1 E2 : env) (fVars dVars : NatSet.t) (A : analysisResult) forall (e : expr Q) (E1 E2 : env) (fVars dVars : NatSet.t) (A : analysisResult)
(nR : R) (err : error) (elo ehi : Q) (Gamma : FloverMap.t mType) (nR : R) (err : error) (elo ehi : Q) (Gamma : FloverMap.t mType),
(defVars : nat -> option mType), validTypes e Gamma ->
validTypes e Gamma -> approxEnv E1 (toRExpMap Gamma) A fVars dVars E2 ->
approxEnv E1 (toRExpMap Gamma) A fVars dVars E2 -> NatSet.Subset (usedVars e -- dVars) fVars ->
NatSet.Subset (usedVars e -- dVars) fVars -> eval_expr E1 (toRTMap (toRExpMap Gamma)) (toREval (toRExp e)) nR REAL ->
eval_expr E1 (toRMap (toRExpMap Gamma)) (toREval (toRExp e)) nR REAL -> RoundoffErrorValidator e Gamma A dVars = true ->
RoundoffErrorValidator e Gamma A dVars = true -> validRanges e A E1 (toRTMap (toRExpMap Gamma)) ->
validRanges e A E1 (toRExpMap Gamma) -> FloverMap.find (elt:=intv * error) e A = Some (elo, ehi, err) ->
FloverMap.find (elt:=intv * error) e A = Some (elo, ehi, err) -> (exists (nF : R) (m : mType),
(exists (nF : R) (m : mType), eval_expr E2 (toRExpMap Gamma) (toRExp e) nF m) /\
eval_expr E2 (toRExpMap Gamma) (toRExp e) nF m) /\ (forall (nF : R) (m : mType),
(forall (nF : R) (m : mType), eval_expr E2 (toRExpMap Gamma) (toRExp e) nF m ->
eval_expr E2 (toRExpMap Gamma) (toRExp e) nF m -> (Rabs (nR - nF) <= Q2R err)%R).
(Rabs (nR - nF) <= Q2R err)%R).
Proof. Proof.
intros. cbn in *. intros. cbn in *.
eapply validErrorbound_sound; eauto. eapply validErrorbound_sound; eauto.
Qed. Qed.
Definition RoundoffErrorValidatorCmd (f:cmd Q) (tMap:FloverMap.t mType) (A:analysisResult) (dVars:NatSet.t) := Definition RoundoffErrorValidatorCmd (f:cmd Q) (tMap:FloverMap.t mType)
(A:analysisResult) (dVars:NatSet.t) :=
(* if *) (* if *)
validErrorboundCmd f tMap A dVars. validErrorboundCmd f tMap A dVars.
(*then true *) (*then true *)
(* else validAffineErrorboundsCmd e A tMap dVars ... *) (* else validAffineErrorboundsCmd e A tMap dVars ... *)
Theorem RoundoffErrorValidatorCmd_sound f: Theorem RoundoffErrorValidatorCmd_sound f:
forall A E1 E2 outVars fVars dVars vR elo ehi err Gamma defVars, forall A E1 E2 outVars fVars dVars vR elo ehi err Gamma,
(* TODO: Types *) approxEnv E1 (toRExpMap Gamma) A fVars dVars E2 ->
approxEnv E1 defVars A fVars dVars E2 ->
ssa f (NatSet.union fVars dVars) outVars -> ssa f (NatSet.union fVars dVars) outVars ->
NatSet.Subset (NatSet.diff (Commands.freeVars f) dVars) fVars -> NatSet.Subset (NatSet.diff (Commands.freeVars f) dVars) fVars ->
bstep (toREvalCmd (toRCmd f)) E1 (toRMap defVars) vR REAL -> bstep (toREvalCmd (toRCmd f)) E1 (toRTMap (toRExpMap Gamma)) vR REAL ->
validErrorboundCmd f Gamma A dVars = true -> validErrorboundCmd f Gamma A dVars = true ->
validRangesCmd f A E1 defVars -> validRangesCmd f A E1 (toRTMap (toRExpMap Gamma)) ->
validTypesCmd f Gamma ->
FloverMap.find (getRetExp f) A = Some ((elo,ehi),err) -> FloverMap.find (getRetExp f) A = Some ((elo,ehi),err) ->
(exists vF m, (exists vF m,
bstep (toRCmd f) E2 defVars vF m) /\ bstep (toRCmd f) E2 (toRExpMap Gamma) vF m) /\
(forall vF mF, (forall vF mF,
bstep (toRCmd f) E2 defVars vF mF -> bstep (toRCmd f) E2 (toRExpMap Gamma) vF mF ->
(Rabs (vR - vF) <= (Q2R err))%R). (Rabs (vR - vF) <= (Q2R err))%R).
Proof. Proof.
intros. intros.
......
...@@ -29,7 +29,7 @@ Fixpoint validTypes e (Gamma:FloverMap.t mType) :Prop := ...@@ -29,7 +29,7 @@ Fixpoint validTypes e (Gamma:FloverMap.t mType) :Prop :=
| Var _ x => True | Var _ x => True
| Const m v => m = mG | Const m v => m = mG
| Unop u e1 => | Unop u e1 =>
validTypes e1 Gamma /\ FloverMap.find e Gamma = Some mG validTypes e1 Gamma /\ exists me, FloverMap.find e1 Gamma = Some me /\ isCompat me mG = true
| Binop b e1 e2 => | Binop b e1 e2 =>
validTypes e1 Gamma /\ validTypes e2 Gamma /\ validTypes e1 Gamma /\ validTypes e2 Gamma /\
exists m1 m2, FloverMap.find e1 Gamma = Some m1 /\ FloverMap.find e2 Gamma = Some m2 /\ exists m1 m2, FloverMap.find e1 Gamma = Some m1 /\ FloverMap.find e2 Gamma = Some m2 /\
...@@ -63,6 +63,20 @@ Proof. ...@@ -63,6 +63,20 @@ Proof.
destruct e; intros * [? [defined_m [check_t valid_top]]]; simpl in *; eauto. destruct e; intros * [? [defined_m [check_t valid_top]]]; simpl in *; eauto.
Qed. Qed.
Corollary validTypes_exec e Gamma m:
validTypes e Gamma ->
FloverMap.find e Gamma = Some m ->
forall E v mR,
eval_expr E (toRExpMap Gamma) (toRExp e) v mR ->
m = mR.
Proof.
intros * valid_e find_e * eval_e.
apply validTypes_single in valid_e.
destruct valid_e as [? [find_e_new valid_exec]].
erewrite valid_exec; eauto.
congruence.
Qed.
Ltac validTypes_split := Ltac validTypes_split :=
match goal with match goal with
| [ H: validTypes (Const ?m ?v) ?Gamma |- _] => idtac | [ H: validTypes (Const ?m ?v) ?Gamma |- _] => idtac
...@@ -133,13 +147,16 @@ Fixpoint getValidMap (Gamma:FloverMap.t mType) (e:expr Q) ...@@ -133,13 +147,16 @@ Fixpoint getValidMap (Gamma:FloverMap.t mType) (e:expr Q)
then Succes (FloverMap.add e m akk) then Succes (FloverMap.add e m akk)
else Fail _ "Wrong type annotation for Constant" else Fail _ "Wrong type annotation for Constant"
| Unop u e1 => | Unop u e1 =>
let akk_new := getTypeMap (getValidMap Gamma e1 akk) in rlet akk_new := getValidMap Gamma e1 akk in
match FloverMap.find e1 akk_new with match FloverMap.find e1 akk_new with
| Some m_e1 => | Some m_e1 =>
if (isFixedPointB m_e1) if (isFixedPointB m_e1)
then then
match mOldO with match mOldO with
|Some mFix => addMono e mFix akk_new |Some mFix =>
if (isCompat m_e1 mFix)
then addMono e mFix akk_new
else Fail _ "Incompatible type assignment"
|None => Fail _ "Undefined fixed-point type" |None => Fail _ "Undefined fixed-point type"
end end
else else
...@@ -370,16 +387,15 @@ Proof. ...@@ -370,16 +387,15 @@ Proof.
by_monotonicity find_akk Hmem. by_monotonicity find_akk Hmem.
+ inversion getMap_succeeds; subst. + inversion getMap_succeeds; subst.
by_monotonicity find_akk Hmem. by_monotonicity find_akk Hmem.
- destruct (getValidMap Gamma e akk) eqn:?; cbn in *; try congruence. - specialize (IHe Gamma akk t Heqr).
simpl in IHe. specialize (IHe Gamma akk t Heqr).
destruct (isFixedPointB m0) eqn:?. destruct (isFixedPointB m0) eqn:?.
+ unfold_addMono; try eauto using IHe. + destruct (isCompat m0 m1) eqn:?; try congruence.
unfold_addMono; try eauto using IHe.
by_monotonicity find_akk Hmem. by_monotonicity find_akk Hmem.
+ destruct (mTypeEq m1 m0) eqn:?; try congruence. + destruct (mTypeEq m1 m0) eqn:?; try congruence.
unfold_addMono; try eauto using IHe. unfold_addMono; try eauto using IHe.
by_monotonicity find_akk Hmem. by_monotonicity find_akk Hmem.
- destruct (isFixedPointB m0) eqn:?; try congruence. - destruct (isFixedPointB m0) eqn:?; try congruence.
destruct (getValidMap Gamma e akk) eqn:?; cbn in *; try congruence.
simpl in IHe. specialize (IHe Gamma akk t Heqr). simpl in IHe. specialize (IHe Gamma akk t Heqr).
unfold_addMono; try eauto using IHe. unfold_addMono; try eauto using IHe.
by_monotonicity find_akk Hmem. by_monotonicity find_akk Hmem.
...@@ -440,6 +456,8 @@ Proof. ...@@ -440,6 +456,8 @@ Proof.
pose proof (maps_mono _ _ find_map1) as find_mono; eexists; split; try eauto. pose proof (maps_mono _ _ find_map1) as find_mono; eexists; split; try eauto.
- repeat split; try eauto. - repeat split; try eauto.
destruct check_top as [valid_e1 check_top]; eapply IHe; eauto. destruct check_top as [valid_e1 check_top]; eapply IHe; eauto.
destruct check_top as [? [? [? ?]]].
eexists; split; eauto.
- destruct check_top as [valid_e1 [valid_e2 validJoin]]; - destruct check_top as [valid_e1 [valid_e2 validJoin]];
repeat split; try eauto. repeat split; try eauto.
destruct validJoin as [m1 [m2 [find_m1 [find_m2 join_true]]]]. destruct validJoin as [m1 [m2 [find_m1 [find_m2 join_true]]]].
...@@ -493,14 +511,16 @@ Proof. ...@@ -493,14 +511,16 @@ Proof.
apply Pos.compare_eq in Heqc; subst. apply Pos.compare_eq in Heqc; subst.
apply N.compare_eq in Heqc0; subst; congruence. apply N.compare_eq in Heqc0; subst; congruence.
- destruct (unopEq u u0) eqn:?; [ | destruct (unopEq u Neg) eqn:?; congruence ]. - destruct (unopEq u u0) eqn:?; [ | destruct (unopEq u Neg) eqn:?; congruence ].
destruct valid_e1 as [mG [find_mG [[valid_e1 _] valid_exec]]]. destruct valid_e1 as [mG [find_mG [[valid_e1 [? ?]] valid_exec]]].
specialize (IHe1 _ _ eq_exp valid_e1). specialize (IHe1 _ _ eq_exp valid_e1).
rewrite unopEq_compat_eq in Heqb; subst. rewrite unopEq_compat_eq in Heqb; subst.
erewrite FloverMapFacts.P.F.find_o with (y:=Unop u0 e2) in find_mG; eauto. erewrite FloverMapFacts.P.F.find_o with (y:=Unop u0 e2) in find_mG; eauto.
exists mG; repeat split; try auto. exists mG; repeat split; try auto.
intros. + destruct H. eexists; split; try eauto.
pose proof (expr_compare_eq_eval_compat (Unop u0 e1) (Unop u0 e2)). erewrite <- FloverMapFacts.P.F.find_o; eauto.
simpl in *; rewrite <- H1 in H0; eauto. + intros.
pose proof (expr_compare_eq_eval_compat (Unop u0 e1) (Unop u0 e2)).
simpl in *; rewrite <- H2 in H1; eauto.
- destruct valid_e1 as [mG [find_mG [[valid_esub1 [valid_esub2 join_valid]] valid_exec]]]. - destruct valid_e1 as [mG [find_mG [[valid_esub1 [valid_esub2 join_valid]] valid_exec]]].
assert (b = b0) by (destruct b; destruct b0; cbn in *; congruence). assert (b = b0) by (destruct b; destruct b0; cbn in *; congruence).
subst. subst.
...@@ -624,14 +644,15 @@ Proof. ...@@ -624,14 +644,15 @@ Proof.
eapply validTypes_eq_compat; eauto. eapply validTypes_eq_compat; eauto.
eexists; split; [eauto using tMap_def | split; try auto]. eexists; split; [eauto using tMap_def | split; try auto].
intros * map_mono eval_const; inversion eval_const; subst; auto. intros * map_mono eval_const; inversion eval_const; subst; auto.
- destruct (FloverMap.find (elt:=mType) e (getTypeMap (getValidMap Gamma e akk))) eqn:?; - destruct (getValidMap Gamma e akk) eqn:?; simpl in *; try congruence.
destruct (FloverMap.find (elt:=mType) e t) eqn:?; simpl in *;
try congruence. try congruence.
intros * mem_add. intros * mem_add.
destruct (getValidMap Gamma e akk) eqn:?; cbn in Heqo; try congruence.
assert (forall e, FloverMap.mem e t = true -> validTypes e t) as valid_rec. assert (forall e, FloverMap.mem e t = true -> validTypes e t) as valid_rec.
{ eapply IHe; eauto. } { eapply IHe; eauto. }
destruct (isFixedPointB m) eqn:?. destruct (isFixedPointB m) eqn:?.
+ Flover_compute. + Flover_compute.
destruct (isCompat m m0) eqn:?; try congruence.
unfold addMono in *; Flover_compute. unfold addMono in *; Flover_compute.
(* { destruct (mTypeEq m0 m1) eqn:?; try congruence. *) (* { destruct (mTypeEq m0 m1) eqn:?; try congruence. *)
(* inversion validMap_succ; subst. *) (* inversion validMap_succ; subst. *)
...@@ -652,6 +673,8 @@ Proof. ...@@ -652,6 +673,8 @@ Proof.
* assert (FloverMap.mem e t = true) * assert (FloverMap.mem e t = true)
by (rewrite FloverMapFacts.P.F.mem_find_b; rewrite Heqo; eauto). by (rewrite FloverMapFacts.P.F.mem_find_b; rewrite Heqo; eauto).
eapply validTypes_mono with (map1:= t); eauto using map_find_mono. eapply validTypes_mono with (map1:= t); eauto using map_find_mono.
* exists m; split; try auto.
eapply map_find_mono; try auto.
* intros * map_mono eval_unop. * intros * map_mono eval_unop.
assert (FloverMap.find (elt:=mType) (Unop u e) (FloverMap.add (Unop u e) m0 t) = Some m0) assert (FloverMap.find (elt:=mType) (Unop u e) (FloverMap.add (Unop u e) m0 t) = Some m0)
as find_unop_t as find_unop_t
...@@ -684,6 +707,9 @@ Proof. ...@@ -684,6 +707,9 @@ Proof.
* assert (FloverMap.mem e t = true) * assert (FloverMap.mem e t = true)
by (rewrite FloverMapFacts.P.F.mem_find_b; rewrite Heqo; auto). by (rewrite FloverMapFacts.P.F.mem_find_b; rewrite Heqo; auto).
eapply (validTypes_mono _) with (map1:= t); eauto using map_find_mono. eapply (validTypes_mono _) with (map1:= t); eauto using map_find_mono.
* exists m; split.
{ eapply map_find_mono; auto. }
{ unfold isCompat; destruct m; auto using morePrecise_refl. }
* intros * map_mono eval_unop. * intros * map_mono eval_unop.
assert (FloverMap.find (elt:=mType) (Unop u e) (FloverMap.add (Unop u e) m t) = Some m) assert (FloverMap.find (elt:=mType) (Unop u e) (FloverMap.add (Unop u e) m t) = Some m)
by (eauto using tMap_def). by (eauto using tMap_def).
...@@ -1037,7 +1063,7 @@ Fixpoint validTypesCmd f (Gamma:FloverMap.t mType) :Prop := ...@@ -1037,7 +1063,7 @@ Fixpoint validTypesCmd f (Gamma:FloverMap.t mType) :Prop :=
exists mG, exists mG,
FloverMap.find e Gamma = Some mG /\ FloverMap.find e Gamma = Some mG /\
FloverMap.find (Var Q x) Gamma = Some m /\ FloverMap.find (Var Q x) Gamma = Some m /\
morePrecise m mG = true /\ mTypeEq m mG = true /\
validTypes e Gamma /\ validTypes e Gamma /\
validTypesCmd g Gamma validTypesCmd g Gamma
| Ret e => validTypes e Gamma | Ret e => validTypes e Gamma
...@@ -1068,7 +1094,7 @@ Fixpoint getValidMapCmd Gamma f akk := ...@@ -1068,7 +1094,7 @@ Fixpoint getValidMapCmd Gamma f akk :=
match FloverMap.find e res_e with match FloverMap.find e res_e with
| None => Fail _ "No type computed for argument" | None => Fail _ "No type computed for argument"
| Some m_e => | Some m_e =>
if (morePrecise m m_e) if (mTypeEq m m_e)
then then
rlet newMap := addMono (Var Q x) m res_e in rlet newMap := addMono (Var Q x) m res_e in
getValidMapCmd Gamma g newMap getValidMapCmd Gamma g newMap
...@@ -1089,7 +1115,7 @@ Proof. ...@@ -1089,7 +1115,7 @@ Proof.
destruct (getValidMap Gamma e akk) eqn:?; simpl in getMap_succeeds; destruct (getValidMap Gamma e akk) eqn:?; simpl in getMap_succeeds;
try congruence. try congruence.
destruct (FloverMap.find e t) eqn:?; try congruence. destruct (FloverMap.find e t) eqn:?; try congruence.
destruct (morePrecise m m1) eqn:?; try congruence. destruct (mTypeEq m m1) eqn:?; try congruence.
unfold addMono in *; Flover_compute. unfold addMono in *; Flover_compute.
specialize (IHf _ _ _ getMap_succeeds). specialize (IHf _ _ _ getMap_succeeds).
eapply IHf. eapply IHf.
...@@ -1118,7 +1144,7 @@ Proof. ...@@ -1118,7 +1144,7 @@ Proof.
- destruct (getValidMap Gamma e akk) eqn:?; simpl in getMap_succeeds; - destruct (getValidMap Gamma e akk) eqn:?; simpl in getMap_succeeds;
try congruence. try congruence.
destruct (FloverMap.find e t) eqn:?; try congruence. destruct (FloverMap.find e t) eqn:?; try congruence.
destruct (morePrecise m m0) eqn:?; try congruence. destruct (mTypeEq m m0) eqn:?; try congruence.
pose proof (getValidMap_correct _ _ _ akk_sound Heqr) as t_sound. pose proof (getValidMap_correct _ _ _ akk_sound Heqr) as t_sound.
unfold addMono in getMap_succeeds; Flover_compute. unfold addMono in getMap_succeeds; Flover_compute.
assert (FloverMap.mem (Var Q n) t = false) assert (FloverMap.mem (Var Q n) t = false)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment