Commit 2cb96884 authored by Heiko Becker's avatar Heiko Becker

WIP port to finite maps

parent fcf368ba
......@@ -20,9 +20,10 @@ Inductive approxEnv : env -> (nat -> option mType) -> analysisResult -> NatSet.t
(Rabs (v1 - v2) <= (Rabs v1) * Q2R (mTypeToQ m))%R ->
NatSet.mem x (NatSet.union fVars dVars) = false ->
approxEnv (updEnv x v1 E1) (updDefVars x m defVars) A (NatSet.add x fVars) dVars (updEnv x v2 E2)
|approxUpdBound E1 E2 defVars A v1 v2 x fVars dVars m:
|approxUpdBound E1 E2 defVars A v1 v2 x fVars dVars m iv err:
approxEnv E1 defVars A fVars dVars E2 ->
(Rabs (v1 - v2) <= Q2R (snd (A (Var Q x))))%R ->
DaisyMap.find (Var Q x) A = Some (iv, err) ->
(Rabs (v1 - v2) <= Q2R err)%R ->
NatSet.mem x (NatSet.union fVars dVars) = false ->
approxEnv (updEnv x v1 E1) (updDefVars x m defVars) A fVars (NatSet.add x dVars) (updEnv x v2 E2).
......@@ -66,8 +67,8 @@ Proof.
set_tac.
rewrite NatSet.union_spec in x_valid.
destruct x_valid; set_tac.
rewrite NatSet.add_spec in H1.
destruct H1; subst; try auto.
rewrite NatSet.add_spec in H2.
destruct H2; subst; try auto.
rewrite Nat.eqb_refl in eq_case; congruence.
Qed.
......@@ -100,7 +101,7 @@ Proof.
- assert (x =? x0 = false) as x_x0_neq.
{ rewrite Nat.eqb_neq; hnf; intros; subst.
set_tac.
apply H0.
apply H1.
set_tac. }
unfold updEnv in *; rewrite x_x0_neq in *.
apply IHa; auto.
......@@ -108,12 +109,12 @@ Proof.
rewrite x_x0_neq in x_typed; auto.
Qed.
Lemma approxEnv_dVar_bounded v2 m e:
Lemma approxEnv_dVar_bounded v2 m iv e:
E1 x = Some v ->
E2 x = Some v2 ->
NatSet.In x dVars ->
Gamma x = Some m ->
snd (A (Var Q x)) = e ->
DaisyMap.find (Var Q x) A = Some (iv, e) ->
(Rabs (v - v2) <= Q2R e)%R.
Proof.
induction approxEnvs;
......@@ -132,7 +133,8 @@ Proof.
destruct x_def as [x_x0 | [x_neq x_def]]; subst.
+ unfold updEnv in *;
rewrite Nat.eqb_refl in *; simpl in *.
inversion E1_def; inversion E2_def; subst; auto.
inversion E1_def; inversion E2_def; subst.
rewrite A_e in *; inversion H; auto.
+ unfold updEnv in *; simpl in *.
rewrite <- Nat.eqb_neq in x_neq.
rewrite x_neq in *; simpl in *.
......
(**
Formalization of the base expression language for the daisy framework
**)
Require Import Coq.Reals.Reals Coq.micromega.Psatz Coq.QArith.QArith
Coq.QArith.Qreals Coq.Structures.Orders Coq.Structures.OrderedType
Coq.Structures.OrdersFacts.
From Coq
Require Import Reals.Reals micromega.Psatz QArith.QArith QArith.Qreals
Structures.Orders.
Require Import Daisy.Infra.RealRationalProps Daisy.Infra.RationalSimps
Daisy.Infra.Ltacs.
Require Export Daisy.Infra.Abbrevs Daisy.Infra.RealSimps Daisy.Infra.NatSet
......@@ -194,8 +194,10 @@ Proof.
eapply IHe; eauto.
Qed.
Module ExpOrderedType (V_ordered:OrderedType) <: OrderedType.
Module V_orderedFacts := OrderedTypeFacts (V_ordered).
Module Type OrderType := Coq.Structures.Orders.OrderedType.
Module ExpOrderedType (V_ordered:OrderType) <: OrderType.
Module V_orderedFacts := OrdersFacts.OrderedTypeFacts (V_ordered).
Definition V := V_ordered.t.
Definition t := exp V.
......
......@@ -62,3 +62,15 @@ Definition updEnv (x:nat) (v: R) (E:env) (y:nat) :=
Definition updDefVars (x:nat) (m:mType) (defVars:nat -> option mType) (y:nat) :=
if (y =? x) then Some m else defVars y.
Definition optionLift (V T:Type) (v:option V) default (f: V -> T) :=
match v with
| None => default
| Some val => f val
end.
Ltac optionD :=
match goal with
|H: context[optionLift ?v ?default ?f] |- _ =>
destruct ?v eqn:?
end.
\ No newline at end of file
......@@ -2,11 +2,20 @@
Some abbreviations that require having defined expressions 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.
Require Import Coq.QArith.QArith Coq.Reals.Reals Coq.QArith.Qreals Coq.QArith.QOrderedType Coq.FSets.FMapAVL Coq.FSets.FMapFacts.
Require Export Daisy.Infra.Abbrevs Daisy.Expressions.
Module Q_orderedExps := ExpOrderedType (Q_as_OT).
Module legacy_OrderedQExps := Structures.OrdersAlt.Backport_OT (Q_orderedExps).
Module DaisyMap := FMapAVL.Make(legacy_OrderedQExps).
Module DaisyMapFacts := OrdProperties (DaisyMap).
Definition analysisResult :Type := DaisyMap.t (intv * error).
(**
We treat a function mapping an expression arguing on fractions as value type
to pairs of intervals on rationals and rational errors as the analysis result
**)
Definition analysisResult :Type := exp Q -> intv * error.
\ No newline at end of file
(* Definition analysisResult :Type := exp Q -> intv * error. *)
\ No newline at end of file
......@@ -55,26 +55,6 @@ Proof.
congruence.
Qed.
(** TODO: Merge with NatSet_prop tactic in Ltacs file **)
Ltac set_hnf_tac :=
match goal with
| [ H: NatSet.mem ?x _ = true |- _ ] => rewrite NatSet.mem_spec in H; set_hnf_tac
| [ H: NatSet.mem ?x _ = false |- _] => apply not_in_not_mem in H; set_hnf_tac
| [ |- context [NatSet.mem ?x _]] => rewrite NatSet.mem_spec; set_hnf_tac
| [ |- context [NatSet.In ?x (NatSet.union ?SA ?SB)]] => rewrite NatSet.union_spec; set_hnf_tac
| [ |- context [NatSet.In ?x (NatSet.diff ?A ?B)]] => rewrite NatSet.diff_spec; set_hnf_tac
| [ H: context [NatSet.In ?x (NatSet.diff ?A ?B)] |- _] => rewrite NatSet.diff_spec in H; destruct H; set_hnf_tac
| [ |- context [NatSet.In ?x (NatSet.singleton ?y)]] => rewrite NatSet.singleton_spec
| [ |- context [NatSet.Subset ?SA ?SB]] => hnf; intros; set_hnf_tac
| [ H: NatSet.Subset ?SA ?SB |- NatSet.In ?v ?SB] => apply H; set_hnf_tac
| _ => idtac
end.
Ltac set_tac :=
set_hnf_tac;
simpl in *; try auto.
Lemma add_spec_strong:
forall x y S,
(x (NatSet.add y S)) <-> x = y \/ ((~ (x = y)) /\ (x S)).
......@@ -91,3 +71,24 @@ Proof.
- rewrite NatSet.add_spec.
destruct x_in_add as [ x_eq | [x_neq x_in_S]]; auto.
Qed.
(** TODO: Merge with NatSet_prop tactic in Ltacs file **)
Ltac set_hnf_tac :=
match goal with
| [ H: NatSet.mem ?x _ = true |- _ ] => rewrite NatSet.mem_spec in H
| [ H: NatSet.mem ?x _ = false |- _] => apply not_in_not_mem in H
| [ H: context [NatSet.In ?x (NatSet.diff ?A ?B)] |- _] => rewrite NatSet.diff_spec in H; destruct H
| [ H: NatSet.Subset ?SA ?SB |- NatSet.In ?v ?SB] => apply H
| [ H: NatSet.In ?x (NatSet.singleton ?y) |- _] => apply NatSetProps.Dec.F.singleton_1 in H
| [ H: NatSet.In ?x NatSet.empty |- _ ] => inversion H
| [ H: NatSet.In ?x (NatSet.union ?S1 ?S2) |- _ ] => rewrite NatSet.union_spec in H
| [ |- context [NatSet.mem ?x _]] => rewrite NatSet.mem_spec
| [ |- context [NatSet.In ?x (NatSet.union ?SA ?SB)]] => rewrite NatSet.union_spec
| [ |- context [NatSet.In ?x (NatSet.diff ?A ?B)]] => rewrite NatSet.diff_spec
| [ |- context [NatSet.In ?x (NatSet.singleton ?y)]] => rewrite NatSet.singleton_spec
| [ |- context [NatSet.Subset ?SA ?SB]] => hnf; intros
end.
Ltac set_tac :=
repeat set_hnf_tac;
simpl in *; try auto.
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