Commit d85672b8 authored by Joachim Bard's avatar Joachim Bard

moving old versions of subdiv checker to attic

parent 834f8c6e
From Flover
Require Import Infra.RealSimps Infra.RationalSimps Infra.RealRationalProps
Infra.Ltacs RealRangeArith RealRangeValidator RoundoffErrorValidator
Environments TypeValidator FPRangeValidator ExpressionAbbrevs ResultChecker
IntervalArithQ.
Environments TypeValidator FPRangeValidator ExpressionAbbrevs ResultChecker.
(*
From Flover
Require Import Infra.RealRationalProps Environments ExpressionSemantics
IntervalArithQ SMTArith RealRangeArith RealRangeValidator RoundoffErrorValidator
ssaPrgs TypeValidator ErrorAnalysis ResultChecker.
*)
Require Import List.
Require Import FunInd.
Fixpoint resultLeq e (A1 A2: analysisResult) :=
match e with
......@@ -89,276 +93,108 @@ Proof.
rewrite checkSubdivs_false_fp in H. discriminate H.
Qed.
Fixpoint coverIntv iv intvs :=
match intvs with
| nil => false
| intv :: nil => isSupersetIntv iv intv
| intv :: intvs =>
Qleb (ivlo intv) (ivlo iv) && coverIntv (ivhi intv, ivhi iv) intvs
end.
Lemma coverIntv_sound iv intvs v :
coverIntv iv intvs = true ->
(Q2R (ivlo iv) <= v <= Q2R (ivhi iv))%R ->
exists intv, In intv intvs /\ (Q2R (ivlo intv) <= v <= Q2R (ivhi intv))%R.
Proof.
induction intvs as [|intv0 intvs] in iv |- *; [intros H; discriminate H|].
destruct intvs as [|intv1 intvs]; cbn; intros H Hin.
- exists intv0. split; auto. andb_to_prop H. canonize_hyps. cbn in *. lra.
- destruct (Rle_or_lt v (Q2R (ivhi intv0))) as [Hle|Hlt].
+ andb_to_prop H.
canonize_hyps.
exists intv0. split; cbn; auto.
cbn in *. lra.
+ andb_to_prop H.
destruct (IHintvs (ivhi intv0, ivhi iv)) as [intv [inl Hin1]]; eauto.
cbn in *. lra.
Qed.
Fixpoint getBucket x iv Ps :=
match Ps with
| nil => (nil, nil)
| P :: Ps' =>
match P with
| nil => (nil, Ps) (* fail *)
| (e, ivE) :: P' =>
match Q_orderedExps.compare e (Var Q x) with
| Eq =>
if isSupersetIntv iv ivE then
let (b, rest) := getBucket x iv Ps' in (P' :: b, rest)
else (nil, Ps)
| _ => (nil, Ps) (* fail *)
end
(*
Fixpoint merge_subdivs_step (e: expr Q) (acc A1 A2: analysisResult) :=
match FloverMap.find e A1, FloverMap.find e A2 with
| Some (iv1, err1), Some (iv2, err2) =>
let acc1 := FloverMap.add e (unionIntv iv1 iv2, Qmax err1 err2) acc in
match e with
| Unop _ e1 | Downcast _ e1 => merge_subdivs_step e1 acc1 A1 A2
| Binop _ e1 e2 | Let _ _ e1 e2 => let acc2 := merge_subdivs_step e1 acc1 A1 A2 in
merge_subdivs_step e2 acc2 A1 A2
| Fma e1 e2 e3 => let acc2 := merge_subdivs_step e1 acc1 A1 A2 in
let acc3 := merge_subdivs_step e2 acc2 A1 A2 in
merge_subdivs_step e3 acc3 A1 A2
| _ => acc1
end
| _, _ => FloverMap.empty (intv * error)
end.
Lemma getBucket_length x iv Ps b rest :
getBucket x iv Ps = (b, rest) ->
length Ps = length (b ++ rest).
Proof with try now injection 1; intros; subst.
induction Ps as [|P Ps] in b |- *; cbn...
destruct P as [|[e ivE] P]...
destruct (Q_orderedExps.compare e (Var Q x)) eqn:?...
destruct (isSupersetIntv iv ivE) eqn:?...
destruct (getBucket x iv Ps) eqn:?...
injection 1; intros; subst.
cbn. now rewrite <- IHPs.
Qed.
Lemma getBucket_sound x iv Ps b rest :
getBucket x iv Ps = (b, rest) ->
forall P, In P b ->
exists ivx, In ((Var Q x, ivx) :: P) Ps /\ isSupersetIntv iv ivx = true.
Proof with try now injection 1; intros; subst.
induction Ps as [|P1 Ps] in b |- *; cbn...
destruct P1 as [|[e ivE] P1]...
cbn.
destruct (Q_orderedExps.compare e (Var Q x)) eqn:Heqc...
destruct (isSupersetIntv iv ivE) eqn:?...
destruct (getBucket x iv Ps) eqn:?...
injection 1; intros; subst.
destruct H2 as [-> | Hin].
- assert (e = Var Q x)
by (destruct e; try discriminate Heqc;
now rewrite (nat_compare_eq _ _ Heqc)).
exists ivE. subst. split; auto.
- edestruct IHPs as [ivx [inPs sub]]; eauto.
Qed.
(* TODO: it might be better to merge all results for one specific expression,
instead of merging 2 results for all expressions *)
Definition merge_subdivs e hd tl : analysisResult :=
fold_left (merge_subdivs_step e (FloverMap.empty (intv * error))) tl hd.
*)
Lemma getBucket_rest_sound x iv Ps b rest :
getBucket x iv Ps = (b, rest) ->
forall P, In P rest -> In P Ps.
Proof with try now injection 1; intros; subst.
induction Ps as [|P Ps] in b |- *; cbn...
destruct P as [|[e ivE] P]...
destruct (Q_orderedExps.compare e (Var Q x)) eqn:?...
destruct (isSupersetIntv iv ivE) eqn:?...
destruct (getBucket x iv Ps) eqn:?...
injection 1; intros; subst.
right. eapply IHPs; eauto.
Qed.
(*
Function checkDim cov x iv Ps {measure length Ps} :=
match Ps with
| nil => false
| P :: _ =>
match FloverMap.find (Var Q x) P with
| Some ivx =>
let (b, rest) := getBucket_aux x ivx Ps in
let covb := cov b in
covb && match rest with
| nil => isSupersetIntv iv ivx
| _ => checkDim cov x (snd ivx, snd iv) rest
end
| None => false
end
(* TODO: joining of subintervals *)
Definition joinIntv iv1 iv2 : result (option intv) :=
if isSupersetIntv iv2 iv1 then Succes (Some iv1) else
if Qeqb (ivhi iv1) (ivlo iv2) then Succes (Some (ivlo iv1, ivhi iv2)) else Fail _ "intervals don't align".
Definition checkDimensionStep x (ivAcc: result (option intv)) P (* (ivNew: option intv) *) :=
let ivNew := FloverMap.find (Var Q x) P in
match ivAcc with
| Succes ivAcc => match ivNew with
| Some ivNew => optionBind ivAcc (fun iv => joinIntv iv ivNew) (Succes (Some ivNew))
| None => Fail _ "var not found in precond"
end
| f => f
end.
intros cov x iv Ps P Ps' HPs ivx Hfind b rest P' rest' Hrest.
rewrite <- Hrest.
rewrite <- HPs at 2.
cbn.
unfold addToBucket.
rewrite Hfind.
unfold isSupersetIntv, Qleb, Qle_bool.
rewrite !Z.leb_refl.
rewrite <- HPs.
cbn.
destruct (getBucket_aux x ivx Ps') eqn:Heq.
apply getBucket_aux_sound in Heq.
clear Hrest rest'.
injection 1; intros; subst.
cbn.
rewrite Heq, app_length.
apply le_lt_n_Sm, le_plus_r.
Defined.
*)
Function checkDim cov x iv Ps {measure length Ps} :=
match Ps with
| nil => false
| P :: _ =>
match P with
| (e, ivx) :: _ =>
match Q_orderedExps.compare e (Var Q x) with
| Eq =>
let (b, rest) := getBucket x ivx Ps in
if isSupersetIntv iv ivx then cov b
else cov b && Qleb (fst ivx) (fst iv) && checkDim cov x (snd ivx, snd iv) rest
| _ => false
end
| _ => false
end
Definition checkDimension x iv Ps :=
match fold_left (checkDimensionStep x) Ps (Succes None) with
| Succes (Some ivU) => if isSupersetIntv iv ivU then Succes true else Fail _ "var not covered"
| Succes None => Fail _ "no subdivisions given"
| Fail _ msg | FailDet msg _ => Fail _ msg
end.
intros cov x iv Ps P rest [e ivE] b e' ivx H HP HPs Heq b' rest'.
rewrite <- HPs at 2.
cbn.
rewrite Heq.
unfold isSupersetIntv, Qleb, Qle_bool.
rewrite !Z.leb_refl.
rewrite <- HPs.
destruct (getBucket x ivx rest) eqn:Hb.
injection 1; intros; subst.
cbn.
rewrite (getBucket_length _ _ _ Hb); eauto.
rewrite app_length.
apply le_lt_n_Sm, le_plus_r.
Defined.
Fixpoint covers (P: list (expr Q * intv)) Ps :=
match P with
| nil => match Ps with nil::nil => true | _ => false end
| (Var _ x, iv) :: P =>
checkDim (covers P) x iv Ps
| _ :: P => false
Definition checkAllDimensionsStep Ps b (p: expr Q * intv) :=
match p with
| (Var _ x, iv) => resultBind b (fun _ => checkDimension x iv Ps) (* b && checkDimension x iv Ps *)
| _ => b
end.
Lemma covers_sound P Ps E :
covers P Ps = true ->
eval_preIntv E P ->
exists P', In P' Ps /\ eval_preIntv E P'.
Proof.
induction P as [|[e iv] P] in Ps |- *.
- cbn. destruct Ps as [|[|? ?] [|? ?]] eqn:Heq; try discriminate 1.
intros _ _.
exists nil; split; try now constructor.
intros x iv H. exfalso. apply (in_nil H).
- destruct e; cbn; intros H; try discriminate H.
intros HPl.
assert (exists vR : R, E n = Some vR /\ (Q2R (fst iv) <= vR <= Q2R (snd iv))%R)
as [v [inE iniv]]
by (apply HPl; now constructor).
functional induction checkDim (covers P) n iv Ps; try discriminate H.
+ destruct (IHP _ H) as [P' [inb HP']].
{ hnf. intros. apply HPl. now constructor. }
destruct (getBucket_sound _ _ _ e3 _ inb) as [iv1 [Hin1 Hsub1]].
eexists; split; eauto.
intros x iv' [Heq | inP']; auto.
injection Heq. intros; subst.
cbn in *.
Flover_compute.
canonize_hyps.
cbn in *; subst.
exists v. split; [auto | lra].
+ Flover_compute.
destruct (Rle_or_lt v (Q2R (snd ivx))) as [Hle|Hlt].
* destruct (IHP _ L0) as [P' [inb HP']].
{ hnf. intros. apply HPl. now constructor. }
destruct (getBucket_sound _ _ _ e3 _ inb) as [iv1 [Hin1 Hsub1]].
eexists; split; eauto.
intros x iv' [Heq | inP']; auto.
injection Heq. intros; subst.
cbn in *.
Flover_compute.
canonize_hyps.
cbn in *; subst.
exists v. split; [auto | lra].
* assert (Q2R (snd ivx) <= v <= Q2R (snd iv))%R as Hv.
{ unfold isSupersetIntv in *. cbn in *.
rewrite R0 in *. cbn in *.
canonize_hyps. split; lra. }
destruct IHb0 as [P' [inrest H]]; auto.
{ intros x iv' [Heq | inP]; auto.
injection Heq; intros; subst.
cbn. exists v. split; auto. apply HPl; cbn; auto. }
exists P'; split; auto.
eapply getBucket_rest_sound; eauto.
Qed.
Definition checkAllDimensions P Ps :=
fold_left (checkAllDimensionsStep Ps) P (Succes false).
Lemma covers_preVars P Ps :
covers P Ps = true ->
forall P1, In P1 Ps -> NatSet.Equal (preIntvVars P1) (preIntvVars P).
Lemma checkAllDimensionsStep_fail_fp Ps P s :
fold_left (checkAllDimensionsStep Ps) P (Fail bool s) = Fail bool s.
Proof.
induction P as [|[e iv] P] in Ps |- *.
- cbn. destruct Ps as [|[|? ?] [|? ?]] eqn:Heq; try discriminate 1.
intros _ P [H|[]].
rewrite <- H. cbn. apply NatSetProps.equal_refl.
- cbn. destruct e; try discriminate 1.
Admitted.
Definition checkPreconds (subdivs: list precond) (P: precond) :=
let Piv := FloverMap.elements (fst P) in
let Ps := map (fun P => FloverMap.elements (fst P)) subdivs in
let S_qs := map snd subdivs in
covers Piv Ps && forallb (fun q => SMTLogic_eqb q (snd P)) S_qs.
induction P as [|p P]; auto.
destruct p as [e iv]. destruct e; auto.
Qed.
Lemma checkPreconds_sound (subdivs: list precond) E P :
checkPreconds subdivs P = true ->
eval_precond E P ->
exists P1, In P1 subdivs /\ eval_precond E P1.
Lemma checkAllDimensionsStep_faildet_fp Ps P s b :
fold_left (checkAllDimensionsStep Ps) P (FailDet s b) = FailDet s b.
Proof.
intros H [Pintv Hq].
apply andb_true_iff in H as [cov Hqs].
eapply covers_sound in cov; eauto.
destruct cov as [Pl1 [Hin H]].
apply in_map_iff in Hin as [P1 [Heq1 Hin]].
exists P1. split; auto.
rewrite <- Heq1 in H.
split; auto.
eapply forallb_forall in Hqs.
- eapply SMTLogic_eqb_sound; eauto.
- apply in_map_iff; eauto.
induction P as [|p P]; auto.
destruct p as [e iv]. destruct e; auto.
Qed.
Lemma checkPreconds_preVars subdivs P :
checkPreconds subdivs P = true ->
forall P1, In P1 subdivs -> NatSet.Equal (preVars P1) (preVars P).
Lemma in_subdivs_intv (Ps: list precondIntv) E (P: precondIntv) :
checkAllDimensions (FloverMap.elements P) Ps = Succes true ->
P_intv_sound E P ->
exists P', In P' Ps /\ P_intv_sound E P'.
Proof.
intros chk P1 Hin. Flover_compute.
unfold preVars.
eapply forallb_forall in R.
2: apply in_map_iff; eauto.
erewrite SMTLogic_eqb_varsLogic; eauto.
apply NatSetProps.union_equal_1.
eapply covers_preVars; eauto.
apply in_map_iff; eauto.
Qed.
intros chk H.
unfold P_intv_sound in H.
induction (FloverMap.elements P).
- cbn in chk. discriminate chk.
- cbn in chk.
destruct (checkAllDimensionsStep Ps (Succes false) a) eqn:Heq;
try (rewrite ?checkAllDimensionsStep_fail_fp, ?checkAllDimensionsStep_faildet_fp in chk;
discriminate chk).
destruct b.
+ destruct a as [e iv].
destruct e; try discriminate Heq.
cbn in Heq.
admit. (* this might not work *)
+ apply IHl; auto.
intros x iv inl. apply H. now right.
Abort.
(* TODO: needs more assumptions, i.e. checker for precond *)
Lemma in_subdivs (subdivs: list (precond * analysisResult)) E P :
eval_precond E P ->
exists P' A, In (P', A) subdivs /\ eval_precond E P'.
Admitted.
(* TODO: check precond sound wrt. subdivs *)
(* TODO: merge hd and tl again *)
(** Interval subdivisions checking function **)
Definition SubdivsChecker (e: expr Q) (absenv: analysisResult)
(P: precond) hd tl (defVars: FloverMap.t mType) Gamma :=
validSSA e (preVars P) &&
checkPreconds (map fst (hd :: tl)) P &&
checkSubdivs e absenv (hd :: tl) defVars Gamma.
(**
......@@ -381,16 +217,15 @@ Theorem subdivs_checking_sound (e: expr Q) (absenv: analysisResult) P hd_subdivs
eval_expr E2 (toRExpMap Gamma) DeltaMap (toRExp e) vF m ->
(Rabs (vR - vF) <= Q2R err))%R.
Proof.
intros * deltas_matched P_valid valid_typeMap chk.
apply andb_prop in chk as [chk valid_subdivs].
apply andb_prop in chk as [valid_ssa valid_cover].
eapply (checkPreconds_sound (* (hd_subdivs :: tl_subdivs) *)) in P_valid as [P1 [in_subdivs P_valid]]; eauto.
assert (validSSA e (preVars P1) = true) as valid_ssa'.
{ eapply validSSA_eq_set; eauto. eapply checkPreconds_preVars; eauto. }
apply in_map_iff in in_subdivs as [[P2 A] [Heq in_subdivs]].
cbn in Heq; subst.
intros * deltas_matched P_valid valid_typeMap subdivs_valid.
andb_to_prop subdivs_valid.
rename L into valid_ssa.
rename R into valid_subdivs.
apply (in_subdivs (hd_subdivs :: tl_subdivs)) in P_valid as [P' [A [in_subdivs P_valid]]].
(* preVars P == preVars P' should hold *)
assert (validSSA e (preVars P') = true) as valid_ssa' by admit.
pose proof (checkSubdivs_sound e _ _ _ _ _ _ valid_subdivs in_subdivs) as [range_err_check A_leq].
assert (ResultChecker e A P1 (FloverMap.empty(SMTLogic * SMTLogic)) defVars Gamma = true) as res_check
assert (ResultChecker e A P' (FloverMap.empty(SMTLogic * SMTLogic)) defVars Gamma = true) as res_check
by (unfold ResultChecker; now rewrite valid_ssa', range_err_check).
exists Gamma; intros approxE1E2.
assert (approxEnv E1 (toRExpMap Gamma) A (freeVars e) NatSet.empty E2) as approxE1E2'
......
......@@ -6,7 +6,7 @@
**)
From Flover
Require Import Infra.RealRationalProps Environments TypeValidator
ResultChecker SubdivsChecker3.
ResultChecker SubdivsChecker.
Require Export List ExpressionSemantics Coq.QArith.QArith Flover.SMTArith.
Export ListNotations.
......
From Flover
Require Import Infra.RealSimps Infra.RationalSimps Infra.RealRationalProps
Infra.Ltacs RealRangeArith RealRangeValidator RoundoffErrorValidator
Environments TypeValidator FPRangeValidator ExpressionAbbrevs ResultChecker.
(*
From Flover
Require Import Infra.RealRationalProps Environments ExpressionSemantics
IntervalArithQ SMTArith RealRangeArith RealRangeValidator RoundoffErrorValidator
ssaPrgs TypeValidator ErrorAnalysis ResultChecker.
*)
Environments TypeValidator FPRangeValidator ExpressionAbbrevs ResultChecker
IntervalArithQ.
Require Import List.
Require Import FunInd.
Fixpoint resultLeq e (A1 A2: analysisResult) :=
match e with
......@@ -93,108 +89,276 @@ Proof.
rewrite checkSubdivs_false_fp in H. discriminate H.
Qed.
(*
Fixpoint merge_subdivs_step (e: expr Q) (acc A1 A2: analysisResult) :=
match FloverMap.find e A1, FloverMap.find e A2 with
| Some (iv1, err1), Some (iv2, err2) =>
let acc1 := FloverMap.add e (unionIntv iv1 iv2, Qmax err1 err2) acc in
match e with
| Unop _ e1 | Downcast _ e1 => merge_subdivs_step e1 acc1 A1 A2
| Binop _ e1 e2 | Let _ _ e1 e2 => let acc2 := merge_subdivs_step e1 acc1 A1 A2 in
merge_subdivs_step e2 acc2 A1 A2
| Fma e1 e2 e3 => let acc2 := merge_subdivs_step e1 acc1 A1 A2 in
let acc3 := merge_subdivs_step e2 acc2 A1 A2 in
merge_subdivs_step e3 acc3 A1 A2
| _ => acc1
end
| _, _ => FloverMap.empty (intv * error)
Fixpoint coverIntv iv intvs :=
match intvs with
| nil => false
| intv :: nil => isSupersetIntv iv intv
| intv :: intvs =>
Qleb (ivlo intv) (ivlo iv) && coverIntv (ivhi intv, ivhi iv) intvs
end.
(* TODO: it might be better to merge all results for one specific expression,
instead of merging 2 results for all expressions *)
Definition merge_subdivs e hd tl : analysisResult :=
fold_left (merge_subdivs_step e (FloverMap.empty (intv * error))) tl hd.
*)
Lemma coverIntv_sound iv intvs v :
coverIntv iv intvs = true ->
(Q2R (ivlo iv) <= v <= Q2R (ivhi iv))%R ->
exists intv, In intv intvs /\ (Q2R (ivlo intv) <= v <= Q2R (ivhi intv))%R.
Proof.
induction intvs as [|intv0 intvs] in iv |- *; [intros H; discriminate H|].
destruct intvs as [|intv1 intvs]; cbn; intros H Hin.
- exists intv0. split; auto. andb_to_prop H. canonize_hyps. cbn in *. lra.
- destruct (Rle_or_lt v (Q2R (ivhi intv0))) as [Hle|Hlt].
+ andb_to_prop H.
canonize_hyps.
exists intv0. split; cbn; auto.
cbn in *. lra.
+ andb_to_prop H.
destruct (IHintvs (ivhi intv0, ivhi iv)) as [intv [inl Hin1]]; eauto.
cbn in *. lra.
Qed.
(* TODO: joining of subintervals *)
Definition joinIntv iv1 iv2 : result (option intv) :=
if isSupersetIntv iv2 iv1 then Succes (Some iv1) else
if Qeqb (ivhi iv1) (ivlo iv2) then Succes (Some (ivlo iv1, ivhi iv2)) else Fail _ "intervals don't align".
Definition checkDimensionStep x (ivAcc: result (option intv)) P (* (ivNew: option intv) *) :=
let ivNew := FloverMap.find (Var Q x) P in
match ivAcc with
| Succes ivAcc => match ivNew with
| Some ivNew => optionBind ivAcc (fun iv => joinIntv iv ivNew) (Succes (Some ivNew))
| None => Fail _ "var not found in precond"
end
| f => f
Fixpoint getBucket x iv Ps :=
match Ps with
| nil => (nil, nil)
| P :: Ps' =>
match P with
| nil => (nil, Ps) (* fail *)
| (e, ivE) :: P' =>
match Q_orderedExps.compare e (Var Q x) with
| Eq =>
if isSupersetIntv iv ivE then
let (b, rest) := getBucket x iv Ps' in (P' :: b, rest)
else (nil, Ps)
| _ => (nil, Ps) (* fail *)
end
end
end.
Definition checkDimension x iv Ps :=
match fold_left (checkDimensionStep x) Ps (Succes None) with
| Succes (Some ivU) => if isSupersetIntv iv ivU then Succes true else Fail _ "var not covered"
| Succes None => Fail _ "no subdivisions given"
| Fail _ msg | FailDet msg _ => Fail _ msg
Lemma getBucket_length x iv Ps b rest :
getBucket x iv Ps = (b, rest) ->
length Ps = length (b ++ rest).
Proof with try now injection 1; intros; subst.
induction Ps as [|P Ps] in b |- *; cbn...
destruct P as [|[e ivE] P]...
destruct (Q_orderedExps.compare e (Var Q x)) eqn:?...
destruct (isSupersetIntv iv ivE) eqn:?...
destruct (getBucket x iv Ps) eqn:?...
injection 1; intros; subst.
cbn. now rewrite <- IHPs.
Qed.
Lemma getBucket_sound x iv Ps b rest :
getBucket x iv Ps = (b, rest) ->
forall P, In P b ->
exists ivx, In ((Var Q x, ivx) :: P) Ps /\ isSupersetIntv iv ivx = true.
Proof with try now injection 1; intros; subst.
induction Ps as [|P1 Ps] in b |- *; cbn...
destruct P1 as [|[e ivE] P1]...
cbn.
destruct (Q_orderedExps.compare e (Var Q x)) eqn:Heqc...
destruct (isSupersetIntv iv ivE) eqn:?...
destruct (getBucket x iv Ps) eqn:?...
injection 1; intros; subst.
destruct H2 as [-> | Hin].
- assert (e = Var Q x)
by (destruct e; try discriminate Heqc;
now rewrite (nat_compare_eq _ _ Heqc)).
exists ivE. subst. split; auto.
- edestruct IHPs as [ivx [inPs sub]]; eauto.
Qed.
Lemma getBucket_rest_sound x iv Ps b rest :
getBucket x iv Ps = (b, rest) ->
forall P, In P rest -> In P Ps.
Proof with try now injection 1; intros; subst.
induction Ps as [|P Ps] in b |- *; cbn...
destruct P as [|[e ivE] P]...
destruct (Q_orderedExps.compare e (Var Q x)) eqn:?...
destruct (isSupersetIntv iv ivE) eqn:?...
destruct (getBucket x iv Ps) eqn:?...
injection 1; intros; subst.
right. eapply IHPs; eauto.
Qed.
(*
Function checkDim cov x iv Ps {measure length Ps} :=
match Ps with
| nil => false
| P :: _ =>
match FloverMap.find (Var Q x) P with
| Some ivx =>
let (b, rest) := getBucket_aux x ivx Ps in
let covb := cov b in
covb && match rest with
| nil => isSupersetIntv iv ivx
| _ => checkDim cov x (snd ivx, snd iv) rest
end
| None => false
end
end.
intros cov x iv Ps P Ps' HPs ivx Hfind b rest P' rest' Hrest.
rewrite <- Hrest.
rewrite <- HPs at 2.
cbn.
unfold addToBucket.
rewrite Hfind.
unfold isSupersetIntv, Qleb, Qle_bool.
rewrite !Z.leb_refl.
rewrite <- HPs.
cbn.
destruct (getBucket_aux x ivx Ps') eqn:Heq.
apply getBucket_aux_sound in Heq.