Commit b93f1500 authored by Heiko Becker's avatar Heiko Becker

Merge branch 'affine_arithmetic' into 'affine_arithmetic'

Affine arithmetic

See merge request AVA/FloVer!6
parents 2f5806c3 c5a76189
This diff is collapsed.
This diff is collapsed.
Require Import Coq.ZArith.ZArith Coq.ZArith.Zbool Coq.micromega.Psatz Recdef.
Require Import Flover.Infra.Abbrevs.
Inductive affine_form (V: Type): Type :=
| Const: V -> affine_form V
| Noise: nat -> V -> affine_form V -> affine_form V.
Fixpoint get_const V (a: affine_form V): V := match a with
| Const v => v
| Noise n c a' => get_const a'
end.
(* Helper function to serve as a measure for fixpoint termination *)
Fixpoint aff_length (V: Type) (a: affine_form V): nat := match a with
| Const _ => 0
| Noise _ _ a' => 1 + aff_length a'
end.
Definition aff_length_tuple V (a: affine_form V * affine_form V) :=
(aff_length (fst a) + aff_length (snd a))%nat.
Definition aff_tuple_order V (a b:affine_form V * affine_form V):=
(aff_length_tuple a < aff_length_tuple b)%nat.
Fixpoint get_max_index_aux V (current_max: nat) (a: affine_form V): nat := match a with
| Const _ => current_max
| Noise n v a' => if (Nat.leb current_max n) then
get_max_index_aux n a'
else
get_max_index_aux current_max a'
end.
Functional Scheme get_max_index_aux_ind := Induction for get_max_index_aux Sort Prop.
Definition get_max_index V (a: affine_form V) := get_max_index_aux 0 a.
Definition fresh V (n: nat) (a: affine_form V) :=
(n > get_max_index a)%nat.
Lemma get_mia_monotonic V (a: affine_form V) (n: nat):
(get_max_index_aux n a >= n)%nat.
Proof.
functional induction get_max_index_aux V n a.
- lia.
- apply Nat.leb_le in e0.
unfold Peano.ge; auto.
eapply Nat.le_trans; eauto.
- lia.
Qed.
Lemma get_mia_monotonic2 V (a: affine_form V) (p q: nat):
(p >= q)%nat ->
(get_max_index_aux p a >= get_max_index_aux q a)%nat.
Proof.
revert p q; induction a; intros p q pgeqq; simpl in *.
- auto.
- case_eq (p <=? n)%nat; intros pleqn.
+ assert ((q <=? n)%nat = true) as qleqn by (apply Nat.leb_le; apply Nat.leb_le in pleqn; lia).
rewrite qleqn.
lia.
+ case_eq (q <=? n)%nat; intros qleqn.
* apply leb_complete_conv in pleqn.
assert (p >= n)%nat by lia.
specialize (IHa p n H); auto.
* specialize (IHa p q pgeqq); auto.
Qed.
Lemma fresh_noise_compat V (a: affine_form V) m n v:
fresh m (Noise n v a) -> fresh m a.
Proof.
unfold fresh, get_max_index in *; destruct a; intros.
rewrite get_max_index_aux_equation.
- simpl in H. lia.
- simpl in H.
case_eq (n <=? n0); intros; rewrite H0 in H.
+ apply Nat.leb_le in H0.
simpl.
auto.
+ simpl.
apply leb_complete_conv in H0.
assert (get_max_index_aux n a >= get_max_index_aux n0 a)%nat
by (apply get_mia_monotonic2; lia).
lia.
Qed.
Lemma fresh_noise_gt V (a: affine_form V) m n v:
fresh m (Noise n v a) -> (m > n)%nat.
Proof.
intros A.
unfold fresh, get_max_index in *; induction a.
- rewrite get_max_index_aux_equation in A.
now simpl in A.
- simpl in A.
destruct (n <=? n0) eqn: Hn.
+ apply Nat.leb_le in Hn.
pose proof (get_mia_monotonic a n0) as mono.
apply (le_lt_trans _ _ _ mono) in A.
lia.
+ apply leb_complete_conv in Hn.
auto.
Qed.
Lemma fresh_noise V (a: affine_form V) m n v:
(m > n)%nat -> fresh m a -> fresh m (Noise n v a).
Proof.
intros A B.
unfold fresh, get_max_index in *; induction a.
- trivial.
- simpl in *.
destruct (n <=? n0) eqn: Hn.
+ assumption.
+ apply leb_complete_conv in Hn.
apply IHa.
clear IHa A Hn n v v0.
assert ((get_max_index_aux n0 a >= get_max_index_aux 0 a)%nat)
by (eapply get_mia_monotonic2; omega).
apply (le_lt_trans _ _ _ H B).
Qed.
Lemma fresh_monotonic V (a: affine_form V) m n:
(m >= n)%nat -> fresh n a -> fresh m a.
Proof.
unfold fresh; lia.
Qed.
Lemma fresh_inc V (a: affine_form V) n:
fresh n a ->
fresh (n + 1) a.
Proof.
unfold fresh.
lia.
Qed.
Lemma fresh_n_gt_O V (a: affine_form V) n:
fresh n a ->
(n > 0)%nat.
Proof.
destruct a.
- unfold fresh, get_max_index; rewrite get_max_index_aux_equation; auto.
- intros ? % fresh_noise_gt; lia.
Qed.
This diff is collapsed.
......@@ -425,6 +425,34 @@ Proof.
rewrite <- (H n); auto.
Qed.
Lemma eval_expr_ignore_bind e:
forall x v m Gamma E,
eval_expr E Gamma e v m ->
~ NatSet.In x (usedVars e) ->
forall m_new v_new,
eval_expr (updEnv x v_new E) (updDefVars x m_new Gamma) e v m.
Proof.
induction e; intros * eval_e no_usedVar *; cbn in *;
inversion eval_e; subst; try eauto.
- assert (n <> x).
{ hnf. intros. subst. apply no_usedVar; set_tac. }
rewrite <- Nat.eqb_neq in H.
eapply Var_load.
+ unfold updDefVars.
rewrite H; auto.
+ unfold updEnv.
rewrite H; auto.
- eapply Binop_dist'; eauto;
[ eapply IHe1 | eapply IHe2];
eauto;
hnf; intros; eapply no_usedVar;
set_tac.
- eapply Fma_dist'; eauto;
[eapply IHe1 | eapply IHe2 | eapply IHe3];
eauto;
hnf; intros; eapply no_usedVar;
set_tac.
Qed.
(*
(**
Analogous lemma for unary expressions.
......
......@@ -2,17 +2,71 @@
Some abbreviations that require having defined exprressions beforehand
If we would put them in the Abbrevs file, this would create a circular dependency which Coq cannot resolve.
**)
Require Import Coq.QArith.QArith Coq.Reals.Reals Coq.QArith.Qreals Coq.QArith.QOrderedType Coq.FSets.FMapAVL Coq.FSets.FMapFacts.
Require Import Coq.QArith.QArith Coq.Reals.Reals Coq.QArith.Qreals Coq.QArith.QOrderedType Coq.FSets.FMapAVL Coq.FSets.FMapFacts Recdef.
Require Import Flover.AffineForm.
Require Export Flover.Infra.Abbrevs Flover.Expressions Flover.OrderedExpressions.
Module Q_orderedExps := ExprOrderedType (Q_as_OT).
Module legacy_OrderedQExps := Structures.OrdersAlt.Backport_OT (Q_orderedExps).
Functional Scheme exprCompare_ind := Induction for Q_orderedExps.exprCompare Sort Prop.
Lemma expr_compare_eq_eval_compat (e1 e2: expr Q):
Q_orderedExps.exprCompare e1 e2 = Eq -> (toRExp e1) = (toRExp e2).
Proof.
intros Heq.
functional induction (Q_orderedExps.exprCompare e1 e2); simpl in Heq;
try congruence; try (simpl; f_equal; auto); try (now rewrite <- mTypeEq_compat_eq);
try now apply Nat.compare_eq.
all: admit.
(* - rewrite Q_orderedExps.V_orderedFacts.compare_eq_iff in Heq. *)
(* now apply Qeq_eqR in Heq. *)
(* - now rewrite <- unopEq_compat_eq. *)
Admitted.
Module FloverMap := FMapAVL.Make(legacy_OrderedQExps).
Module FloverMapFacts := OrdProperties (FloverMap).
Definition analysisResult :Type := FloverMap.t (intv * error).
Definition expressionsAffine: Type := FloverMap.t (affine_form Q).
Definition contained_flover_map V expmap1 expmap2 :=
forall (e: expr Q) (v: V), FloverMap.find e expmap1 = Some v -> FloverMap.find e expmap2 = Some v.
Instance contained_flover_map_preorder (V: Type) : PreOrder (@contained_flover_map V).
Proof.
constructor; unfold Reflexive, Transitive, contained_flover_map; eauto.
Qed.
Lemma contained_flover_map_extension V (expmap: FloverMap.t V) e v:
FloverMap.find e expmap = None ->
contained_flover_map expmap (FloverMap.add e v expmap).
Proof.
intros Hnone e' v' Hcont.
rewrite <- Hcont.
destruct (Q_orderedExps.exprCompare e e') eqn: Hcomp.
- assert (FloverMap.find e expmap = FloverMap.find e' expmap) by (apply FloverMapFacts.P.F.find_o; auto); congruence.
- apply FloverMapFacts.P.F.add_neq_o; congruence.
- apply FloverMapFacts.P.F.add_neq_o; congruence.
Qed.
Lemma contained_flover_map_add_compat V (expmap1 expmap2: FloverMap.t V) e v:
contained_flover_map expmap1 expmap2 ->
contained_flover_map (FloverMap.add e v expmap1) (FloverMap.add e v expmap2).
Proof.
unfold contained_flover_map.
intros A e' v' B.
destruct (Q_orderedExps.exprCompare e e') eqn: Hcomp.
- rewrite FloverMapFacts.P.F.add_eq_o in B; auto.
rewrite FloverMapFacts.P.F.add_eq_o; auto.
- rewrite FloverMapFacts.P.F.add_neq_o in B; try congruence.
rewrite FloverMapFacts.P.F.add_neq_o; try congruence.
auto.
- rewrite FloverMapFacts.P.F.add_neq_o in B; try congruence.
rewrite FloverMapFacts.P.F.add_neq_o; try congruence.
auto.
Qed.
(**
We treat a function mapping an exprression arguing on fractions as value type
......
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
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