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. ...@@ -425,6 +425,34 @@ Proof.
rewrite <- (H n); auto. rewrite <- (H n); auto.
Qed. 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. Analogous lemma for unary expressions.
......
This diff is collapsed.
(** Ltac definitions **) (** Ltac definitions **)
Require Import Coq.Bool.Bool Coq.Reals.Reals Coq.QArith.QArith Coq.QArith.Qreals. Require Import Coq.Bool.Bool Coq.Reals.Reals Coq.QArith.QArith Coq.QArith.Qreals Coq.micromega.Psatz.
Require Import Flover.Infra.RealSimps Flover.Infra.NatSet Flover.Infra.RationalSimps Flover.Infra.RealRationalProps. Require Import Flover.Infra.RealSimps Flover.Infra.NatSet Flover.Infra.RationalSimps Flover.Infra.RealRationalProps.
Global Set Implicit Arguments. Global Set Implicit Arguments.
...@@ -186,6 +186,9 @@ Ltac telling_rewrite pat hyp := ...@@ -186,6 +186,9 @@ Ltac telling_rewrite pat hyp :=
Tactic Notation "unify asm" open_constr(pat) hyp(H):= Tactic Notation "unify asm" open_constr(pat) hyp(H):=
telling_rewrite pat H. telling_rewrite pat H.
Ltac Qrewrite H :=
assert H as tmp by (try field; try lra); rewrite tmp; clear tmp.
Ltac destruct_ex H pat := Ltac destruct_ex H pat :=
match type of H with match type of H with
| exists v, ?H' => | exists v, ?H' =>
......
This diff is collapsed.
This diff is collapsed.
...@@ -50,6 +50,29 @@ Qed. ...@@ -50,6 +50,29 @@ Qed.
Definition isEqIntv (iv1:intv) (iv2:intv) := Definition isEqIntv (iv1:intv) (iv2:intv) :=
(ivlo iv1 == ivlo iv2) /\ (ivhi iv1 == ivhi iv2). (ivlo iv1 == ivlo iv2) /\ (ivhi iv1 == ivhi iv2).
Lemma isEqIntv_refl iv:
isEqIntv iv iv.
Proof.
now trivial.
Qed.
Lemma isEqIntv_sym iv1 iv2:
isEqIntv iv1 iv2 -> isEqIntv iv2 iv1.
Proof.
unfold isEqIntv; lra.
Qed.
Lemma isEqIntv_trans iv1 iv2 iv3:
isEqIntv iv1 iv2 -> isEqIntv iv2 iv3 -> isEqIntv iv1 iv3.
Proof.
unfold isEqIntv; lra.
Qed.
Instance isEqIntv_Equivalence : Equivalence isEqIntv.
Proof.
constructor; eauto using isEqIntv_refl, isEqIntv_sym, isEqIntv_trans.
Qed.
Lemma supIntvAntisym (iv1:intv) (iv2:intv) : Lemma supIntvAntisym (iv1:intv) (iv2:intv) :
isSupersetIntv iv1 iv2 = true -> isSupersetIntv iv1 iv2 = true ->
isSupersetIntv iv2 iv1 = true -> isSupersetIntv iv2 iv1 = true ->
...@@ -379,4 +402,4 @@ Proof. ...@@ -379,4 +402,4 @@ Proof.
pose proof (intv_inversion_valid nodiv0 c_b). pose proof (intv_inversion_valid nodiv0 c_b).
unfold divideIntv, Qdiv. unfold divideIntv, Qdiv.
apply intv_multiplication_valid; auto. apply intv_multiplication_valid; auto.
Qed. Qed.
\ No newline at end of file
From Coq From Coq
Require Import QArith.QArith Structures.Orders. Require Import QArith.QArith Structures.Orders Recdef.
From Flover From Flover
Require Import Infra.RealRationalProps Infra.RationalSimps Infra.Ltacs Require Import Infra.RealRationalProps Infra.RationalSimps Infra.Ltacs
...@@ -914,4 +914,4 @@ Module ExprOrderedType (V_ordered:OrderType) <: OrderType. ...@@ -914,4 +914,4 @@ Module ExprOrderedType (V_ordered:OrderType) <: OrderType.
Close Scope positive_scope. Close Scope positive_scope.
End ExprOrderedType. End ExprOrderedType.
\ No newline at end of file
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