diff options
Diffstat (limited to 'theories/IntMap')
| -rw-r--r-- | theories/IntMap/.depend | 48 | ||||
| -rw-r--r-- | theories/IntMap/Adalloc.v | 94 | ||||
| -rw-r--r-- | theories/IntMap/Allmaps.v | 21 | ||||
| -rw-r--r-- | theories/IntMap/Fset.v | 371 | ||||
| -rw-r--r-- | theories/IntMap/Lsort.v | 413 | ||||
| -rw-r--r-- | theories/IntMap/Map.v | 869 | ||||
| -rw-r--r-- | theories/IntMap/Mapaxioms.v | 761 | ||||
| -rw-r--r-- | theories/IntMap/Mapc.v | 539 | ||||
| -rw-r--r-- | theories/IntMap/Mapcanon.v | 401 | ||||
| -rw-r--r-- | theories/IntMap/Mapcard.v | 764 | ||||
| -rw-r--r-- | theories/IntMap/Mapfold.v | 425 | ||||
| -rw-r--r-- | theories/IntMap/Mapiter.v | 618 | ||||
| -rw-r--r-- | theories/IntMap/Maplists.v | 438 | ||||
| -rw-r--r-- | theories/IntMap/Mapsubset.v | 605 | ||||
| -rw-r--r-- | theories/IntMap/intro.tex | 6 |
15 files changed, 0 insertions, 6373 deletions
diff --git a/theories/IntMap/.depend b/theories/IntMap/.depend deleted file mode 100644 index 8c90ac99..00000000 --- a/theories/IntMap/.depend +++ /dev/null @@ -1,48 +0,0 @@ -Mapsubset.vo: Mapsubset.v Addr.vo Adist.vo Addec.vo Map.vo Fset.vo Mapaxioms.vo Mapiter.vo -Mapsubset.vi: Mapsubset.v Addr.vo Adist.vo Addec.vo Map.vo Fset.vo Mapaxioms.vo Mapiter.vo -Maplists.vo: Maplists.v Addr.vo Addec.vo Map.vo Fset.vo Mapaxioms.vo Mapsubset.vo Mapcard.vo Mapcanon.vo Mapc.vo Mapiter.vo Mapfold.vo -Maplists.vi: Maplists.v Addr.vo Addec.vo Map.vo Fset.vo Mapaxioms.vo Mapsubset.vo Mapcard.vo Mapcanon.vo Mapc.vo Mapiter.vo Mapfold.vo -Mapiter.vo: Mapiter.v Addr.vo Adist.vo Addec.vo Map.vo Mapaxioms.vo Fset.vo -Mapiter.vi: Mapiter.v Addr.vo Adist.vo Addec.vo Map.vo Mapaxioms.vo Fset.vo -Mapfold.vo: Mapfold.v Addr.vo Adist.vo Addec.vo Map.vo Fset.vo Mapaxioms.vo Mapiter.vo Lsort.vo Mapsubset.vo -Mapfold.vi: Mapfold.v Addr.vo Adist.vo Addec.vo Map.vo Fset.vo Mapaxioms.vo Mapiter.vo Lsort.vo Mapsubset.vo -Mapcard.vo: Mapcard.v Addr.vo Adist.vo Addec.vo Map.vo Mapaxioms.vo Mapiter.vo Fset.vo Mapsubset.vo Lsort.vo -Mapcard.vi: Mapcard.v Addr.vo Adist.vo Addec.vo Map.vo Mapaxioms.vo Mapiter.vo Fset.vo Mapsubset.vo Lsort.vo -Mapcanon.vo: Mapcanon.v Addr.vo Adist.vo Addec.vo Map.vo Mapaxioms.vo Mapiter.vo Fset.vo Lsort.vo Mapsubset.vo Mapcard.vo -Mapcanon.vi: Mapcanon.v Addr.vo Adist.vo Addec.vo Map.vo Mapaxioms.vo Mapiter.vo Fset.vo Lsort.vo Mapsubset.vo Mapcard.vo -Mapc.vo: Mapc.v Addr.vo Adist.vo Addec.vo Map.vo Mapaxioms.vo Fset.vo Mapiter.vo Mapsubset.vo Lsort.vo Mapcard.vo Mapcanon.vo -Mapc.vi: Mapc.v Addr.vo Adist.vo Addec.vo Map.vo Mapaxioms.vo Fset.vo Mapiter.vo Mapsubset.vo Lsort.vo Mapcard.vo Mapcanon.vo -Mapaxioms.vo: Mapaxioms.v Addr.vo Adist.vo Addec.vo Map.vo Fset.vo -Mapaxioms.vi: Mapaxioms.v Addr.vo Adist.vo Addec.vo Map.vo Fset.vo -Map.vo: Map.v Addr.vo Adist.vo Addec.vo -Map.vi: Map.v Addr.vo Adist.vo Addec.vo -Lsort.vo: Lsort.v Addr.vo Adist.vo Addec.vo Map.vo Mapiter.vo -Lsort.vi: Lsort.v Addr.vo Adist.vo Addec.vo Map.vo Mapiter.vo -Fset.vo: Fset.v Addr.vo Adist.vo Addec.vo Map.vo -Fset.vi: Fset.v Addr.vo Adist.vo Addec.vo Map.vo -Allmaps.vo: Allmaps.v Addr.vo Adist.vo Addec.vo Map.vo Fset.vo Mapaxioms.vo Mapiter.vo Mapsubset.vo Lsort.vo Mapfold.vo Mapcard.vo Mapcanon.vo Mapc.vo Maplists.vo Adalloc.vo -Allmaps.vi: Allmaps.v Addr.vo Adist.vo Addec.vo Map.vo Fset.vo Mapaxioms.vo Mapiter.vo Mapsubset.vo Lsort.vo Mapfold.vo Mapcard.vo Mapcanon.vo Mapc.vo Maplists.vo Adalloc.vo -Adist.vo: Adist.v Addr.vo -Adist.vi: Adist.v Addr.vo -Addr.vo: Addr.v -Addr.vi: Addr.v -Addec.vo: Addec.v Addr.vo -Addec.vi: Addec.v Addr.vo -Adalloc.vo: Adalloc.v Addr.vo Adist.vo Addec.vo Map.vo Fset.vo -Adalloc.vi: Adalloc.v Addr.vo Adist.vo Addec.vo Map.vo Fset.vo -Mapsubset.html: Mapsubset.v Addr.html Adist.html Addec.html Map.html Fset.html Mapaxioms.html Mapiter.html -Maplists.html: Maplists.v Addr.html Addec.html Map.html Fset.html Mapaxioms.html Mapsubset.html Mapcard.html Mapcanon.html Mapc.html Mapiter.html Mapfold.html -Mapiter.html: Mapiter.v Addr.html Adist.html Addec.html Map.html Mapaxioms.html Fset.html -Mapfold.html: Mapfold.v Addr.html Adist.html Addec.html Map.html Fset.html Mapaxioms.html Mapiter.html Lsort.html Mapsubset.html -Mapcard.html: Mapcard.v Addr.html Adist.html Addec.html Map.html Mapaxioms.html Mapiter.html Fset.html Mapsubset.html Lsort.html -Mapcanon.html: Mapcanon.v Addr.html Adist.html Addec.html Map.html Mapaxioms.html Mapiter.html Fset.html Lsort.html Mapsubset.html Mapcard.html -Mapc.html: Mapc.v Addr.html Adist.html Addec.html Map.html Mapaxioms.html Fset.html Mapiter.html Mapsubset.html Lsort.html Mapcard.html Mapcanon.html -Mapaxioms.html: Mapaxioms.v Addr.html Adist.html Addec.html Map.html Fset.html -Map.html: Map.v Addr.html Adist.html Addec.html -Lsort.html: Lsort.v Addr.html Adist.html Addec.html Map.html Mapiter.html -Fset.html: Fset.v Addr.html Adist.html Addec.html Map.html -Allmaps.html: Allmaps.v Addr.html Adist.html Addec.html Map.html Fset.html Mapaxioms.html Mapiter.html Mapsubset.html Lsort.html Mapfold.html Mapcard.html Mapcanon.html Mapc.html Maplists.html Adalloc.html -Adist.html: Adist.v Addr.html -Addr.html: Addr.v -Addec.html: Addec.v Addr.html -Adalloc.html: Adalloc.v Addr.html Adist.html Addec.html Map.html Fset.html diff --git a/theories/IntMap/Adalloc.v b/theories/IntMap/Adalloc.v deleted file mode 100644 index ca8e7eeb..00000000 --- a/theories/IntMap/Adalloc.v +++ /dev/null @@ -1,94 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) -(*i $Id: Adalloc.v 8733 2006-04-25 22:52:18Z letouzey $ i*) - -Require Import Bool. -Require Import Sumbool. -Require Import Arith. -Require Import NArith. -Require Import Ndigits. -Require Import Ndec. -Require Import Nnat. -Require Import Map. -Require Import Fset. - -Section AdAlloc. - - Variable A : Set. - - (** Allocator: returns an address not in the domain of [m]. - This allocator is optimal in that it returns the lowest possible address, - in the usual ordering on integers. It is not the most efficient, however. *) - Fixpoint ad_alloc_opt (m:Map A) : ad := - match m with - | M0 => N0 - | M1 a _ => if Neqb a N0 then Npos 1 else N0 - | M2 m1 m2 => - Nmin (Ndouble (ad_alloc_opt m1)) - (Ndouble_plus_one (ad_alloc_opt m2)) - end. - - Lemma ad_alloc_opt_allocates_1 : - forall m:Map A, MapGet A m (ad_alloc_opt m) = None. - Proof. - induction m as [| a| m0 H m1 H0]. reflexivity. - simpl in |- *. elim (sumbool_of_bool (Neqb a N0)). intro H. rewrite H. - rewrite (Neqb_complete _ _ H). reflexivity. - intro H. rewrite H. rewrite H. reflexivity. - intros. change - (ad_alloc_opt (M2 A m0 m1)) with (Nmin (Ndouble (ad_alloc_opt m0)) - (Ndouble_plus_one (ad_alloc_opt m1))) - in |- *. - elim - (Nmin_choice (Ndouble (ad_alloc_opt m0)) - (Ndouble_plus_one (ad_alloc_opt m1))). - intro H1. rewrite H1. rewrite MapGet_M2_bit_0_0. rewrite Ndouble_div2. assumption. - apply Ndouble_bit0. - intro H1. rewrite H1. rewrite MapGet_M2_bit_0_1. rewrite Ndouble_plus_one_div2. assumption. - apply Ndouble_plus_one_bit0. - Qed. - - Lemma ad_alloc_opt_allocates : - forall m:Map A, in_dom A (ad_alloc_opt m) m = false. - Proof. - unfold in_dom in |- *. intro. rewrite (ad_alloc_opt_allocates_1 m). reflexivity. - Qed. - - (** Moreover, this is optimal: all addresses below [(ad_alloc_opt m)] - are in [dom m]: *) - - Lemma ad_alloc_opt_optimal_1 : - forall (m:Map A) (a:ad), - Nle (ad_alloc_opt m) a = false -> {y : A | MapGet A m a = Some y}. - Proof. - induction m as [| a y| m0 H m1 H0]. simpl in |- *. unfold Nle in |- *. simpl in |- *. intros. discriminate H. - simpl in |- *. intros b H. elim (sumbool_of_bool (Neqb a N0)). intro H0. rewrite H0 in H. - unfold Nle in H. cut (N0 = b). intro. split with y. rewrite <- H1. rewrite H0. reflexivity. - rewrite <- (N_of_nat_of_N b). - rewrite <- (le_n_O_eq _ (le_S_n _ _ (leb_complete_conv _ _ H))). reflexivity. - intro H0. rewrite H0 in H. discriminate H. - intros. simpl in H1. elim (Ndouble_or_double_plus_un a). intro H2. elim H2. intros a0 H3. - rewrite H3 in H1. elim (H _ (Nlt_double_mono_conv _ _ (Nmin_lt_3 _ _ _ H1))). intros y H4. - split with y. rewrite H3. rewrite MapGet_M2_bit_0_0. rewrite Ndouble_div2. assumption. - apply Ndouble_bit0. - intro H2. elim H2. intros a0 H3. rewrite H3 in H1. - elim (H0 _ (Nlt_double_plus_one_mono_conv _ _ (Nmin_lt_4 _ _ _ H1))). intros y H4. - split with y. rewrite H3. rewrite MapGet_M2_bit_0_1. rewrite Ndouble_plus_one_div2. - assumption. - apply Ndouble_plus_one_bit0. - Qed. - - Lemma ad_alloc_opt_optimal : - forall (m:Map A) (a:ad), - Nle (ad_alloc_opt m) a = false -> in_dom A a m = true. - Proof. - intros. unfold in_dom in |- *. elim (ad_alloc_opt_optimal_1 m a H). intros y H0. rewrite H0. - reflexivity. - Qed. - -End AdAlloc. diff --git a/theories/IntMap/Allmaps.v b/theories/IntMap/Allmaps.v deleted file mode 100644 index d5af8f80..00000000 --- a/theories/IntMap/Allmaps.v +++ /dev/null @@ -1,21 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) -(*i $Id: Allmaps.v 8733 2006-04-25 22:52:18Z letouzey $ i*) - -Require Export Map. -Require Export Fset. -Require Export Mapaxioms. -Require Export Mapiter. -Require Export Mapsubset. -Require Export Lsort. -Require Export Mapfold. -Require Export Mapcard. -Require Export Mapcanon. -Require Export Mapc. -Require Export Maplists. -Require Export Adalloc.
\ No newline at end of file diff --git a/theories/IntMap/Fset.v b/theories/IntMap/Fset.v deleted file mode 100644 index 5b46c969..00000000 --- a/theories/IntMap/Fset.v +++ /dev/null @@ -1,371 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) -(*i $Id: Fset.v 8733 2006-04-25 22:52:18Z letouzey $ i*) - -(*s Sets operations on maps *) - -Require Import Bool. -Require Import Sumbool. -Require Import NArith. -Require Import Ndigits. -Require Import Ndec. -Require Import Map. - -Section Dom. - - Variables A B : Set. - - Fixpoint MapDomRestrTo (m:Map A) : Map B -> Map A := - match m with - | M0 => fun _:Map B => M0 A - | M1 a y => - fun m':Map B => match MapGet B m' a with - | None => M0 A - | _ => m - end - | M2 m1 m2 => - fun m':Map B => - match m' with - | M0 => M0 A - | M1 a' y' => - match MapGet A m a' with - | None => M0 A - | Some y => M1 A a' y - end - | M2 m'1 m'2 => - makeM2 A (MapDomRestrTo m1 m'1) (MapDomRestrTo m2 m'2) - end - end. - - Lemma MapDomRestrTo_semantics : - forall (m:Map A) (m':Map B), - eqm A (MapGet A (MapDomRestrTo m m')) - (fun a0:ad => - match MapGet B m' a0 with - | None => None - | _ => MapGet A m a0 - end). - Proof. - unfold eqm in |- *. simple induction m. simpl in |- *. intros. case (MapGet B m' a); trivial. - intros. simpl in |- *. elim (sumbool_of_bool (Neqb a a1)). intro H. rewrite H. - rewrite <- (Neqb_complete _ _ H). case (MapGet B m' a); try reflexivity. - intro. apply M1_semantics_1. - intro H. rewrite H. case (MapGet B m' a). - case (MapGet B m' a1); intros; exact (M1_semantics_2 A a a1 a0 H). - case (MapGet B m' a1); reflexivity. - simple induction m'. trivial. - unfold MapDomRestrTo in |- *. intros. elim (sumbool_of_bool (Neqb a a1)). - intro H1. - rewrite (Neqb_complete _ _ H1). rewrite (M1_semantics_1 B a1 a0). - case (MapGet A (M2 A m0 m1) a1); try reflexivity. - intro. apply M1_semantics_1. - intro H1. rewrite (M1_semantics_2 B a a1 a0 H1). case (MapGet A (M2 A m0 m1) a); try reflexivity. - intro. exact (M1_semantics_2 A a a1 a2 H1). - intros. change - (MapGet A (makeM2 A (MapDomRestrTo m0 m2) (MapDomRestrTo m1 m3)) a = - match MapGet B (M2 B m2 m3) a with - | None => None - | Some _ => MapGet A (M2 A m0 m1) a - end) in |- *. - rewrite (makeM2_M2 A (MapDomRestrTo m0 m2) (MapDomRestrTo m1 m3) a). - rewrite MapGet_M2_bit_0_if. rewrite (H0 m3 (Ndiv2 a)). rewrite (H m2 (Ndiv2 a)). - rewrite (MapGet_M2_bit_0_if B m2 m3 a). rewrite (MapGet_M2_bit_0_if A m0 m1 a). - case (Nbit0 a); reflexivity. - Qed. - - Fixpoint MapDomRestrBy (m:Map A) : Map B -> Map A := - match m with - | M0 => fun _:Map B => M0 A - | M1 a y => - fun m':Map B => match MapGet B m' a with - | None => m - | _ => M0 A - end - | M2 m1 m2 => - fun m':Map B => - match m' with - | M0 => m - | M1 a' y' => MapRemove A m a' - | M2 m'1 m'2 => - makeM2 A (MapDomRestrBy m1 m'1) (MapDomRestrBy m2 m'2) - end - end. - - Lemma MapDomRestrBy_semantics : - forall (m:Map A) (m':Map B), - eqm A (MapGet A (MapDomRestrBy m m')) - (fun a0:ad => - match MapGet B m' a0 with - | None => MapGet A m a0 - | _ => None - end). - Proof. - unfold eqm in |- *. simple induction m. simpl in |- *. intros. case (MapGet B m' a); trivial. - intros. simpl in |- *. elim (sumbool_of_bool (Neqb a a1)). intro H. rewrite H. - rewrite (Neqb_complete _ _ H). case (MapGet B m' a1). trivial. - apply M1_semantics_1. - intro H. rewrite H. case (MapGet B m' a). - case (MapGet B m' a1); trivial. - rewrite (M1_semantics_2 A a a1 a0 H). - case (MapGet B m' a1); trivial. - simple induction m'. trivial. - unfold MapDomRestrBy in |- *. intros. rewrite (MapRemove_semantics A (M2 A m0 m1) a a1). - elim (sumbool_of_bool (Neqb a a1)). intro H1. rewrite H1. rewrite (Neqb_complete _ _ H1). - rewrite (M1_semantics_1 B a1 a0). reflexivity. - intro H1. rewrite H1. rewrite (M1_semantics_2 B a a1 a0 H1). reflexivity. - intros. change - (MapGet A (makeM2 A (MapDomRestrBy m0 m2) (MapDomRestrBy m1 m3)) a = - match MapGet B (M2 B m2 m3) a with - | None => MapGet A (M2 A m0 m1) a - | Some _ => None - end) in |- *. - rewrite (makeM2_M2 A (MapDomRestrBy m0 m2) (MapDomRestrBy m1 m3) a). - rewrite MapGet_M2_bit_0_if. rewrite (H0 m3 (Ndiv2 a)). rewrite (H m2 (Ndiv2 a)). - rewrite (MapGet_M2_bit_0_if B m2 m3 a). rewrite (MapGet_M2_bit_0_if A m0 m1 a). - case (Nbit0 a); reflexivity. - Qed. - - Definition in_dom (a:ad) (m:Map A) := - match MapGet A m a with - | None => false - | _ => true - end. - - Lemma in_dom_M0 : forall a:ad, in_dom a (M0 A) = false. - Proof. - trivial. - Qed. - - Lemma in_dom_M1 : forall (a a0:ad) (y:A), in_dom a0 (M1 A a y) = Neqb a a0. - Proof. - unfold in_dom in |- *. intros. simpl in |- *. case (Neqb a a0); reflexivity. - Qed. - - Lemma in_dom_M1_1 : forall (a:ad) (y:A), in_dom a (M1 A a y) = true. - Proof. - intros. rewrite in_dom_M1. apply Neqb_correct. - Qed. - - Lemma in_dom_M1_2 : - forall (a a0:ad) (y:A), in_dom a0 (M1 A a y) = true -> a = a0. - Proof. - intros. apply (Neqb_complete a a0). rewrite (in_dom_M1 a a0 y) in H. assumption. - Qed. - - Lemma in_dom_some : - forall (m:Map A) (a:ad), - in_dom a m = true -> {y : A | MapGet A m a = Some y}. - Proof. - unfold in_dom in |- *. intros. elim (option_sum _ (MapGet A m a)). trivial. - intro H0. rewrite H0 in H. discriminate H. - Qed. - - Lemma in_dom_none : - forall (m:Map A) (a:ad), in_dom a m = false -> MapGet A m a = None. - Proof. - unfold in_dom in |- *. intros. elim (option_sum _ (MapGet A m a)). intro H0. elim H0. - intros y H1. rewrite H1 in H. discriminate H. - trivial. - Qed. - - Lemma in_dom_put : - forall (m:Map A) (a0:ad) (y0:A) (a:ad), - in_dom a (MapPut A m a0 y0) = orb (Neqb a a0) (in_dom a m). - Proof. - unfold in_dom in |- *. intros. rewrite (MapPut_semantics A m a0 y0 a). - elim (sumbool_of_bool (Neqb a a0)). intro H. rewrite H. rewrite (Neqb_comm a a0) in H. - rewrite H. rewrite orb_true_b. reflexivity. - intro H. rewrite H. rewrite (Neqb_comm a a0) in H. rewrite H. rewrite orb_false_b. - reflexivity. - Qed. - - Lemma in_dom_put_behind : - forall (m:Map A) (a0:ad) (y0:A) (a:ad), - in_dom a (MapPut_behind A m a0 y0) = orb (Neqb a a0) (in_dom a m). - Proof. - unfold in_dom in |- *. intros. rewrite (MapPut_behind_semantics A m a0 y0 a). - elim (sumbool_of_bool (Neqb a a0)). intro H. rewrite H. rewrite (Neqb_comm a a0) in H. - rewrite H. case (MapGet A m a); reflexivity. - intro H. rewrite H. rewrite (Neqb_comm a a0) in H. rewrite H. case (MapGet A m a); trivial. - Qed. - - Lemma in_dom_remove : - forall (m:Map A) (a0 a:ad), - in_dom a (MapRemove A m a0) = andb (negb (Neqb a a0)) (in_dom a m). - Proof. - unfold in_dom in |- *. intros. rewrite (MapRemove_semantics A m a0 a). - elim (sumbool_of_bool (Neqb a a0)). intro H. rewrite H. rewrite (Neqb_comm a a0) in H. - rewrite H. reflexivity. - intro H. rewrite H. rewrite (Neqb_comm a a0) in H. rewrite H. - case (MapGet A m a); reflexivity. - Qed. - - Lemma in_dom_merge : - forall (m m':Map A) (a:ad), - in_dom a (MapMerge A m m') = orb (in_dom a m) (in_dom a m'). - Proof. - unfold in_dom in |- *. intros. rewrite (MapMerge_semantics A m m' a). - elim (option_sum A (MapGet A m' a)). intro H. elim H. intros y H0. rewrite H0. - case (MapGet A m a); reflexivity. - intro H. rewrite H. rewrite orb_b_false. reflexivity. - Qed. - - Lemma in_dom_delta : - forall (m m':Map A) (a:ad), - in_dom a (MapDelta A m m') = xorb (in_dom a m) (in_dom a m'). - Proof. - unfold in_dom in |- *. intros. rewrite (MapDelta_semantics A m m' a). - elim (option_sum A (MapGet A m' a)). intro H. elim H. intros y H0. rewrite H0. - case (MapGet A m a); reflexivity. - intro H. rewrite H. case (MapGet A m a); reflexivity. - Qed. - -End Dom. - -Section InDom. - - Variables A B : Set. - - Lemma in_dom_restrto : - forall (m:Map A) (m':Map B) (a:ad), - in_dom A a (MapDomRestrTo A B m m') = - andb (in_dom A a m) (in_dom B a m'). - Proof. - unfold in_dom in |- *. intros. rewrite (MapDomRestrTo_semantics A B m m' a). - elim (option_sum B (MapGet B m' a)). intro H. elim H. intros y H0. rewrite H0. - rewrite andb_b_true. reflexivity. - intro H. rewrite H. rewrite andb_b_false. reflexivity. - Qed. - - Lemma in_dom_restrby : - forall (m:Map A) (m':Map B) (a:ad), - in_dom A a (MapDomRestrBy A B m m') = - andb (in_dom A a m) (negb (in_dom B a m')). - Proof. - unfold in_dom in |- *. intros. rewrite (MapDomRestrBy_semantics A B m m' a). - elim (option_sum B (MapGet B m' a)). intro H. elim H. intros y H0. rewrite H0. - unfold negb in |- *. rewrite andb_b_false. reflexivity. - intro H. rewrite H. unfold negb in |- *. rewrite andb_b_true. reflexivity. - Qed. - -End InDom. - -Definition FSet := Map unit. - -Section FSetDefs. - - Variable A : Set. - - Definition in_FSet : ad -> FSet -> bool := in_dom unit. - - Fixpoint MapDom (m:Map A) : FSet := - match m with - | M0 => M0 unit - | M1 a _ => M1 unit a tt - | M2 m m' => M2 unit (MapDom m) (MapDom m') - end. - - Lemma MapDom_semantics_1 : - forall (m:Map A) (a:ad) (y:A), - MapGet A m a = Some y -> in_FSet a (MapDom m) = true. - Proof. - simple induction m. intros. discriminate H. - unfold MapDom in |- *. unfold in_FSet in |- *. unfold in_dom in |- *. unfold MapGet in |- *. intros a y a0 y0. - case (Neqb a a0). trivial. - intro. discriminate H. - intros m0 H m1 H0 a y. rewrite (MapGet_M2_bit_0_if A m0 m1 a). simpl in |- *. unfold in_FSet in |- *. - unfold in_dom in |- *. rewrite (MapGet_M2_bit_0_if unit (MapDom m0) (MapDom m1) a). - case (Nbit0 a). unfold in_FSet, in_dom in H0. intro. apply H0 with (y := y). assumption. - unfold in_FSet, in_dom in H. intro. apply H with (y := y). assumption. - Qed. - - Lemma MapDom_semantics_2 : - forall (m:Map A) (a:ad), - in_FSet a (MapDom m) = true -> {y : A | MapGet A m a = Some y}. - Proof. - simple induction m. intros. discriminate H. - unfold MapDom in |- *. unfold in_FSet in |- *. unfold in_dom in |- *. unfold MapGet in |- *. intros a y a0. case (Neqb a a0). - intro. split with y. reflexivity. - intro. discriminate H. - intros m0 H m1 H0 a. rewrite (MapGet_M2_bit_0_if A m0 m1 a). simpl in |- *. unfold in_FSet in |- *. - unfold in_dom in |- *. rewrite (MapGet_M2_bit_0_if unit (MapDom m0) (MapDom m1) a). - case (Nbit0 a). unfold in_FSet, in_dom in H0. intro. apply H0. assumption. - unfold in_FSet, in_dom in H. intro. apply H. assumption. - Qed. - - Lemma MapDom_semantics_3 : - forall (m:Map A) (a:ad), - MapGet A m a = None -> in_FSet a (MapDom m) = false. - Proof. - intros. elim (sumbool_of_bool (in_FSet a (MapDom m))). intro H0. - elim (MapDom_semantics_2 m a H0). intros y H1. rewrite H in H1. discriminate H1. - trivial. - Qed. - - Lemma MapDom_semantics_4 : - forall (m:Map A) (a:ad), - in_FSet a (MapDom m) = false -> MapGet A m a = None. - Proof. - intros. elim (option_sum A (MapGet A m a)). intro H0. elim H0. intros y H1. - rewrite (MapDom_semantics_1 m a y H1) in H. discriminate H. - trivial. - Qed. - - Lemma MapDom_Dom : - forall (m:Map A) (a:ad), in_dom A a m = in_FSet a (MapDom m). - Proof. - intros. elim (sumbool_of_bool (in_FSet a (MapDom m))). intro H. - elim (MapDom_semantics_2 m a H). intros y H0. rewrite H. unfold in_dom in |- *. rewrite H0. - reflexivity. - intro H. rewrite H. unfold in_dom in |- *. rewrite (MapDom_semantics_4 m a H). reflexivity. - Qed. - - Definition FSetUnion (s s':FSet) : FSet := MapMerge unit s s'. - - Lemma in_FSet_union : - forall (s s':FSet) (a:ad), - in_FSet a (FSetUnion s s') = orb (in_FSet a s) (in_FSet a s'). - Proof. - exact (in_dom_merge unit). - Qed. - - Definition FSetInter (s s':FSet) : FSet := MapDomRestrTo unit unit s s'. - - Lemma in_FSet_inter : - forall (s s':FSet) (a:ad), - in_FSet a (FSetInter s s') = andb (in_FSet a s) (in_FSet a s'). - Proof. - exact (in_dom_restrto unit unit). - Qed. - - Definition FSetDiff (s s':FSet) : FSet := MapDomRestrBy unit unit s s'. - - Lemma in_FSet_diff : - forall (s s':FSet) (a:ad), - in_FSet a (FSetDiff s s') = andb (in_FSet a s) (negb (in_FSet a s')). - Proof. - exact (in_dom_restrby unit unit). - Qed. - - Definition FSetDelta (s s':FSet) : FSet := MapDelta unit s s'. - - Lemma in_FSet_delta : - forall (s s':FSet) (a:ad), - in_FSet a (FSetDelta s s') = xorb (in_FSet a s) (in_FSet a s'). - Proof. - exact (in_dom_delta unit). - Qed. - -End FSetDefs. - -Lemma FSet_Dom : forall s:FSet, MapDom unit s = s. -Proof. - simple induction s. trivial. - simpl in |- *. intros a t. elim t. reflexivity. - intros. simpl in |- *. rewrite H. rewrite H0. reflexivity. -Qed.
\ No newline at end of file diff --git a/theories/IntMap/Lsort.v b/theories/IntMap/Lsort.v deleted file mode 100644 index c8d793a1..00000000 --- a/theories/IntMap/Lsort.v +++ /dev/null @@ -1,413 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) -(*i $Id: Lsort.v 8733 2006-04-25 22:52:18Z letouzey $ i*) - -Require Import Bool. -Require Import Sumbool. -Require Import Arith. -Require Import NArith. -Require Import Ndigits. -Require Import Ndec. -Require Import Map. -Require Import List. -Require Import Mapiter. - -Section LSort. - - Variable A : Set. - - Fixpoint alist_sorted (l:alist A) : bool := - match l with - | nil => true - | (a, _) :: l' => - match l' with - | nil => true - | (a', y') :: l'' => andb (Nless a a') (alist_sorted l') - end - end. - - Fixpoint alist_nth_ad (n:nat) (l:alist A) {struct l} : ad := - match l with - | nil => N0 (* dummy *) - | (a, y) :: l' => match n with - | O => a - | S n' => alist_nth_ad n' l' - end - end. - - Definition alist_sorted_1 (l:alist A) := - forall n:nat, - S (S n) <= length l -> - Nless (alist_nth_ad n l) (alist_nth_ad (S n) l) = true. - - Lemma alist_sorted_imp_1 : - forall l:alist A, alist_sorted l = true -> alist_sorted_1 l. - Proof. - unfold alist_sorted_1 in |- *. simple induction l. intros. elim (le_Sn_O (S n) H0). - intro r. elim r. intros a y. simple induction l0. intros. simpl in H1. - elim (le_Sn_O n (le_S_n (S n) 0 H1)). - intro r0. elim r0. intros a0 y0. simple induction n. intros. simpl in |- *. simpl in H1. - exact (proj1 (andb_prop _ _ H1)). - intros. change - (Nless (alist_nth_ad n0 ((a0, y0) :: l1)) - (alist_nth_ad (S n0) ((a0, y0) :: l1)) = true) - in |- *. - apply H0. exact (proj2 (andb_prop _ _ H1)). - apply le_S_n. exact H3. - Qed. - - Definition alist_sorted_2 (l:alist A) := - forall m n:nat, - m < n -> - S n <= length l -> Nless (alist_nth_ad m l) (alist_nth_ad n l) = true. - - Lemma alist_sorted_1_imp_2 : - forall l:alist A, alist_sorted_1 l -> alist_sorted_2 l. - Proof. - unfold alist_sorted_1, alist_sorted_2, lt in |- *. intros l H m n H0. elim H0. exact (H m). - intros. apply Nless_trans with (a' := alist_nth_ad m0 l). apply H2. apply le_Sn_le. - assumption. - apply H. assumption. - Qed. - - Lemma alist_sorted_2_imp : - forall l:alist A, alist_sorted_2 l -> alist_sorted l = true. - Proof. - unfold alist_sorted_2, lt in |- *. simple induction l. trivial. - intro r. elim r. intros a y. simple induction l0. trivial. - intro r0. elim r0. intros a0 y0. intros. - change (andb (Nless a a0) (alist_sorted ((a0, y0) :: l1)) = true) - in |- *. - apply andb_true_intro. split. apply (H1 0 1). apply le_n. - simpl in |- *. apply le_n_S. apply le_n_S. apply le_O_n. - apply H0. intros. apply (H1 (S m) (S n)). apply le_n_S. assumption. - exact (le_n_S _ _ H3). - Qed. - - Lemma app_length : - forall (C:Set) (l l':list C), length (l ++ l') = length l + length l'. - Proof. - simple induction l. trivial. - intros. simpl in |- *. rewrite (H l'). reflexivity. - Qed. - - Lemma aapp_length : - forall l l':alist A, length (aapp A l l') = length l + length l'. - Proof. - exact (app_length (ad * A)). - Qed. - - Lemma alist_nth_ad_aapp_1 : - forall (l l':alist A) (n:nat), - S n <= length l -> alist_nth_ad n (aapp A l l') = alist_nth_ad n l. - Proof. - simple induction l. intros. elim (le_Sn_O n H). - intro r. elim r. intros a y l' H l''. simple induction n. trivial. - intros. simpl in |- *. apply H. apply le_S_n. exact H1. - Qed. - - Lemma alist_nth_ad_aapp_2 : - forall (l l':alist A) (n:nat), - S n <= length l' -> - alist_nth_ad (length l + n) (aapp A l l') = alist_nth_ad n l'. - Proof. - simple induction l. trivial. - intro r. elim r. intros a y l' H l'' n H0. simpl in |- *. apply H. exact H0. - Qed. - - Lemma interval_split : - forall p q n:nat, - S n <= p + q -> {n' : nat | S n' <= q /\ n = p + n'} + {S n <= p}. - Proof. - simple induction p. simpl in |- *. intros. left. split with n. split; [ assumption | reflexivity ]. - intros p' H q. simple induction n. intros. right. apply le_n_S. apply le_O_n. - intros. elim (H _ _ (le_S_n _ _ H1)). intro H2. left. elim H2. intros n' H3. - elim H3. intros H4 H5. split with n'. split; [ assumption | rewrite H5; reflexivity ]. - intro H2. right. apply le_n_S. assumption. - Qed. - - Lemma alist_conc_sorted : - forall l l':alist A, - alist_sorted_2 l -> - alist_sorted_2 l' -> - (forall n n':nat, - S n <= length l -> - S n' <= length l' -> - Nless (alist_nth_ad n l) (alist_nth_ad n' l') = true) -> - alist_sorted_2 (aapp A l l'). - Proof. - unfold alist_sorted_2, lt in |- *. intros. rewrite (aapp_length l l') in H3. - elim - (interval_split (length l) (length l') m - (le_trans _ _ _ (le_n_S _ _ (lt_le_weak m n H2)) H3)). - intro H4. elim H4. intros m' H5. elim H5. intros. rewrite H7. - rewrite (alist_nth_ad_aapp_2 l l' m' H6). elim (interval_split (length l) (length l') n H3). - intro H8. elim H8. intros n' H9. elim H9. intros. rewrite H11. - rewrite (alist_nth_ad_aapp_2 l l' n' H10). apply H0. rewrite H7 in H2. rewrite H11 in H2. - change (S (length l) + m' <= length l + n') in H2. - rewrite (plus_Snm_nSm (length l) m') in H2. exact ((fun p n m:nat => plus_le_reg_l n m p) (length l) (S m') n' H2). - exact H10. - intro H8. rewrite H7 in H2. cut (S (length l) <= length l). intros. elim (le_Sn_n _ H9). - apply le_trans with (m := S n). apply le_n_S. apply le_trans with (m := S (length l + m')). - apply le_trans with (m := length l + m'). apply le_plus_l. - apply le_n_Sn. - exact H2. - exact H8. - intro H4. rewrite (alist_nth_ad_aapp_1 l l' m H4). - elim (interval_split (length l) (length l') n H3). intro H5. elim H5. intros n' H6. elim H6. - intros. rewrite H8. rewrite (alist_nth_ad_aapp_2 l l' n' H7). exact (H1 m n' H4 H7). - intro H5. rewrite (alist_nth_ad_aapp_1 l l' n H5). exact (H m n H2 H5). - Qed. - - Lemma alist_nth_ad_semantics : - forall (l:alist A) (n:nat), - S n <= length l -> - {y : A | alist_semantics A l (alist_nth_ad n l) = Some y}. - Proof. - simple induction l. intros. elim (le_Sn_O _ H). - intro r. elim r. intros a y l0 H. simple induction n. simpl in |- *. intro. split with y. - rewrite (Neqb_correct a). reflexivity. - intros. elim (H _ (le_S_n _ _ H1)). intros y0 H2. - elim (sumbool_of_bool (Neqb a (alist_nth_ad n0 l0))). intro H3. split with y. - rewrite (Neqb_complete _ _ H3). simpl in |- *. rewrite (Neqb_correct (alist_nth_ad n0 l0)). - reflexivity. - intro H3. split with y0. simpl in |- *. rewrite H3. assumption. - Qed. - - Lemma alist_of_Map_nth_ad : - forall (m:Map A) (pf:ad -> ad) (l:alist A), - l = - MapFold1 A (alist A) (anil A) (aapp A) - (fun (a0:ad) (y:A) => acons A (a0, y) (anil A)) pf m -> - forall n:nat, S n <= length l -> {a' : ad | alist_nth_ad n l = pf a'}. - Proof. - intros. elim (alist_nth_ad_semantics l n H0). intros y H1. - apply (alist_of_Map_semantics_1_1 A m pf (alist_nth_ad n l) y). - rewrite <- H. assumption. - Qed. - - Definition ad_monotonic (pf:ad -> ad) := - forall a a':ad, Nless a a' = true -> Nless (pf a) (pf a') = true. - - Lemma Ndouble_monotonic : ad_monotonic Ndouble. - Proof. - unfold ad_monotonic in |- *. intros. rewrite Nless_def_1. assumption. - Qed. - - Lemma Ndouble_plus_one_monotonic : ad_monotonic Ndouble_plus_one. - Proof. - unfold ad_monotonic in |- *. intros. rewrite Nless_def_2. assumption. - Qed. - - Lemma ad_comp_monotonic : - forall pf pf':ad -> ad, - ad_monotonic pf -> - ad_monotonic pf' -> ad_monotonic (fun a0:ad => pf (pf' a0)). - Proof. - unfold ad_monotonic in |- *. intros. apply H. apply H0. exact H1. - Qed. - - Lemma ad_comp_double_monotonic : - forall pf:ad -> ad, - ad_monotonic pf -> ad_monotonic (fun a0:ad => pf (Ndouble a0)). - Proof. - intros. apply ad_comp_monotonic. assumption. - exact Ndouble_monotonic. - Qed. - - Lemma ad_comp_double_plus_un_monotonic : - forall pf:ad -> ad, - ad_monotonic pf -> ad_monotonic (fun a0:ad => pf (Ndouble_plus_one a0)). - Proof. - intros. apply ad_comp_monotonic. assumption. - exact Ndouble_plus_one_monotonic. - Qed. - - Lemma alist_of_Map_sorts_1 : - forall (m:Map A) (pf:ad -> ad), - ad_monotonic pf -> - alist_sorted_2 - (MapFold1 A (alist A) (anil A) (aapp A) - (fun (a:ad) (y:A) => acons A (a, y) (anil A)) pf m). - Proof. - simple induction m. simpl in |- *. intros. apply alist_sorted_1_imp_2. apply alist_sorted_imp_1. reflexivity. - intros. simpl in |- *. apply alist_sorted_1_imp_2. apply alist_sorted_imp_1. reflexivity. - intros. simpl in |- *. apply alist_conc_sorted. - exact - (H (fun a0:ad => pf (Ndouble a0)) (ad_comp_double_monotonic pf H1)). - exact - (H0 (fun a0:ad => pf (Ndouble_plus_one a0)) - (ad_comp_double_plus_un_monotonic pf H1)). - intros. elim - (alist_of_Map_nth_ad m0 (fun a0:ad => pf (Ndouble a0)) - (MapFold1 A (alist A) (anil A) (aapp A) - (fun (a0:ad) (y:A) => acons A (a0, y) (anil A)) - (fun a0:ad => pf (Ndouble a0)) m0) (refl_equal _) n H2). - intros a H4. rewrite H4. elim - (alist_of_Map_nth_ad m1 (fun a0:ad => pf (Ndouble_plus_one a0)) - (MapFold1 A (alist A) (anil A) (aapp A) - (fun (a0:ad) (y:A) => acons A (a0, y) (anil A)) - (fun a0:ad => pf (Ndouble_plus_one a0)) m1) ( - refl_equal _) n' H3). - intros a' H5. rewrite H5. unfold ad_monotonic in H1. apply H1. apply Nless_def_3. - Qed. - - Lemma alist_of_Map_sorts : - forall m:Map A, alist_sorted (alist_of_Map A m) = true. - Proof. - intro. apply alist_sorted_2_imp. - exact - (alist_of_Map_sorts_1 m (fun a0:ad => a0) - (fun (a a':ad) (p:Nless a a' = true) => p)). - Qed. - - Lemma alist_of_Map_sorts1 : - forall m:Map A, alist_sorted_1 (alist_of_Map A m). - Proof. - intro. apply alist_sorted_imp_1. apply alist_of_Map_sorts. - Qed. - - Lemma alist_of_Map_sorts2 : - forall m:Map A, alist_sorted_2 (alist_of_Map A m). - Proof. - intro. apply alist_sorted_1_imp_2. apply alist_of_Map_sorts1. - Qed. - - Lemma alist_too_low : - forall (l:alist A) (a a':ad) (y:A), - Nless a a' = true -> - alist_sorted_2 ((a', y) :: l) -> - alist_semantics A ((a', y) :: l) a = None. - Proof. - simple induction l. intros. simpl in |- *. elim (sumbool_of_bool (Neqb a' a)). intro H1. - rewrite (Neqb_complete _ _ H1) in H. rewrite (Nless_not_refl a) in H. discriminate H. - intro H1. rewrite H1. reflexivity. - intro r. elim r. intros a y l0 H a0 a1 y0 H0 H1. - change - (match Neqb a1 a0 with - | true => Some y0 - | false => alist_semantics A ((a, y) :: l0) a0 - end = None) in |- *. - elim (sumbool_of_bool (Neqb a1 a0)). intro H2. rewrite (Neqb_complete _ _ H2) in H0. - rewrite (Nless_not_refl a0) in H0. discriminate H0. - intro H2. rewrite H2. apply H. apply Nless_trans with (a' := a1). assumption. - unfold alist_sorted_2 in H1. apply (H1 0 1). apply lt_n_Sn. - simpl in |- *. apply le_n_S. apply le_n_S. apply le_O_n. - apply alist_sorted_1_imp_2. apply alist_sorted_imp_1. - cut (alist_sorted ((a1, y0) :: (a, y) :: l0) = true). intro H3. - exact (proj2 (andb_prop _ _ H3)). - apply alist_sorted_2_imp. assumption. - Qed. - - Lemma alist_semantics_nth_ad : - forall (l:alist A) (a:ad) (y:A), - alist_semantics A l a = Some y -> - {n : nat | S n <= length l /\ alist_nth_ad n l = a}. - Proof. - simple induction l. intros. discriminate H. - intro r. elim r. intros a y l0 H a0 y0 H0. simpl in H0. elim (sumbool_of_bool (Neqb a a0)). - intro H1. rewrite H1 in H0. split with 0. split. simpl in |- *. apply le_n_S. apply le_O_n. - simpl in |- *. exact (Neqb_complete _ _ H1). - intro H1. rewrite H1 in H0. elim (H a0 y0 H0). intros n' H2. split with (S n'). split. - simpl in |- *. apply le_n_S. exact (proj1 H2). - exact (proj2 H2). - Qed. - - Lemma alist_semantics_tail : - forall (l:alist A) (a:ad) (y:A), - alist_sorted_2 ((a, y) :: l) -> - eqm A (alist_semantics A l) - (fun a0:ad => - if Neqb a a0 then None else alist_semantics A ((a, y) :: l) a0). - Proof. - unfold eqm in |- *. intros. elim (sumbool_of_bool (Neqb a a0)). intro H0. rewrite H0. - rewrite <- (Neqb_complete _ _ H0). unfold alist_sorted_2 in H. - elim (option_sum A (alist_semantics A l a)). intro H1. elim H1. intros y0 H2. - elim (alist_semantics_nth_ad l a y0 H2). intros n H3. elim H3. intros. - cut - (Nless (alist_nth_ad 0 ((a, y) :: l)) - (alist_nth_ad (S n) ((a, y) :: l)) = true). - intro. simpl in H6. rewrite H5 in H6. rewrite (Nless_not_refl a) in H6. discriminate H6. - apply H. apply lt_O_Sn. - simpl in |- *. apply le_n_S. assumption. - trivial. - intro H0. simpl in |- *. rewrite H0. reflexivity. - Qed. - - Lemma alist_semantics_same_tail : - forall (l l':alist A) (a:ad) (y:A), - alist_sorted_2 ((a, y) :: l) -> - alist_sorted_2 ((a, y) :: l') -> - eqm A (alist_semantics A ((a, y) :: l)) - (alist_semantics A ((a, y) :: l')) -> - eqm A (alist_semantics A l) (alist_semantics A l'). - Proof. - unfold eqm in |- *. intros. rewrite (alist_semantics_tail _ _ _ H a0). - rewrite (alist_semantics_tail _ _ _ H0 a0). case (Neqb a a0). reflexivity. - exact (H1 a0). - Qed. - - Lemma alist_sorted_tail : - forall (l:alist A) (a:ad) (y:A), - alist_sorted_2 ((a, y) :: l) -> alist_sorted_2 l. - Proof. - unfold alist_sorted_2 in |- *. intros. apply (H (S m) (S n)). apply lt_n_S. assumption. - simpl in |- *. apply le_n_S. assumption. - Qed. - - Lemma alist_canonical : - forall l l':alist A, - eqm A (alist_semantics A l) (alist_semantics A l') -> - alist_sorted_2 l -> alist_sorted_2 l' -> l = l'. - Proof. - unfold eqm in |- *. simple induction l. simple induction l'. trivial. - intro r. elim r. intros a y l0 H H0 H1 H2. simpl in H0. - cut - (None = - match Neqb a a with - | true => Some y - | false => alist_semantics A l0 a - end). - rewrite (Neqb_correct a). intro. discriminate H3. - exact (H0 a). - intro r. elim r. intros a y l0 H. simple induction l'. intros. simpl in H0. - cut - (match Neqb a a with - | true => Some y - | false => alist_semantics A l0 a - end = None). - rewrite (Neqb_correct a). intro. discriminate H3. - exact (H0 a). - intro r'. elim r'. intros a' y' l'0 H0 H1 H2 H3. elim (Nless_total a a'). intro H4. - elim H4. intro H5. - cut - (alist_semantics A ((a, y) :: l0) a = - alist_semantics A ((a', y') :: l'0) a). - intro. rewrite (alist_too_low l'0 a a' y' H5 H3) in H6. simpl in H6. - rewrite (Neqb_correct a) in H6. discriminate H6. - exact (H1 a). - intro H5. cut - (alist_semantics A ((a, y) :: l0) a' = - alist_semantics A ((a', y') :: l'0) a'). - intro. rewrite (alist_too_low l0 a' a y H5 H2) in H6. simpl in H6. - rewrite (Neqb_correct a') in H6. discriminate H6. - exact (H1 a'). - intro H4. rewrite H4. - cut - (alist_semantics A ((a, y) :: l0) a = - alist_semantics A ((a', y') :: l'0) a). - intro. simpl in H5. rewrite H4 in H5. rewrite (Neqb_correct a') in H5. inversion H5. - rewrite H4 in H1. rewrite H7 in H1. cut (l0 = l'0). intro. rewrite H6. reflexivity. - apply H. rewrite H4 in H2. rewrite H7 in H2. - exact (alist_semantics_same_tail l0 l'0 a' y' H2 H3 H1). - exact (alist_sorted_tail _ _ _ H2). - exact (alist_sorted_tail _ _ _ H3). - exact (H1 a). - Qed. - -End LSort.
\ No newline at end of file diff --git a/theories/IntMap/Map.v b/theories/IntMap/Map.v deleted file mode 100644 index 2be6de04..00000000 --- a/theories/IntMap/Map.v +++ /dev/null @@ -1,869 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) -(*i $Id: Map.v 8733 2006-04-25 22:52:18Z letouzey $ i*) - -(** Definition of finite sets as trees indexed by adresses *) - -Require Import Bool. -Require Import Sumbool. -Require Import NArith. -Require Import Ndigits. -Require Import Ndec. - -(* The type [ad] of addresses is now [N] in [BinNat]. *) - -Definition ad := N. - -(* a Notation or complete replacement would be nice, - but that would changes hyps names *) - -Section MapDefs. - -(** We now define maps from ad to A. *) - Variable A : Set. - - Inductive Map : Set := - | M0 : Map - | M1 : ad -> A -> Map - | M2 : Map -> Map -> Map. - - Lemma option_sum : forall o:option A, {y : A | o = Some y} + {o = None}. - Proof. - simple induction o. - left. split with a. reflexivity. - right. reflexivity. - Qed. - - (** The semantics of maps is given by the function [MapGet]. - The semantics of a map [m] is a partial, finite function from - [ad] to [A]: *) - - Fixpoint MapGet (m:Map) : ad -> option A := - match m with - | M0 => fun a:ad => None - | M1 x y => fun a:ad => if Neqb x a then Some y else None - | M2 m1 m2 => - fun a:ad => - match a with - | N0 => MapGet m1 N0 - | Npos xH => MapGet m2 N0 - | Npos (xO p) => MapGet m1 (Npos p) - | Npos (xI p) => MapGet m2 (Npos p) - end - end. - - Definition newMap := M0. - - Definition MapSingleton := M1. - - Definition eqm (g g':ad -> option A) := forall a:ad, g a = g' a. - - Lemma newMap_semantics : eqm (MapGet newMap) (fun a:ad => None). - Proof. - simpl in |- *. unfold eqm in |- *. trivial. - Qed. - - Lemma MapSingleton_semantics : - forall (a:ad) (y:A), - eqm (MapGet (MapSingleton a y)) - (fun a':ad => if Neqb a a' then Some y else None). - Proof. - simpl in |- *. unfold eqm in |- *. trivial. - Qed. - - Lemma M1_semantics_1 : forall (a:ad) (y:A), MapGet (M1 a y) a = Some y. - Proof. - unfold MapGet in |- *. intros. rewrite (Neqb_correct a). reflexivity. - Qed. - - Lemma M1_semantics_2 : - forall (a a':ad) (y:A), Neqb a a' = false -> MapGet (M1 a y) a' = None. - Proof. - intros. simpl in |- *. rewrite H. reflexivity. - Qed. - - Lemma Map2_semantics_1 : - forall m m':Map, - eqm (MapGet m) (fun a:ad => MapGet (M2 m m') (Ndouble a)). - Proof. - unfold eqm in |- *. simple induction a; trivial. - Qed. - - Lemma Map2_semantics_1_eq : - forall (m m':Map) (f:ad -> option A), - eqm (MapGet (M2 m m')) f -> eqm (MapGet m) (fun a:ad => f (Ndouble a)). - Proof. - unfold eqm in |- *. - intros. - rewrite <- (H (Ndouble a)). - exact (Map2_semantics_1 m m' a). - Qed. - - Lemma Map2_semantics_2 : - forall m m':Map, - eqm (MapGet m') (fun a:ad => MapGet (M2 m m') (Ndouble_plus_one a)). - Proof. - unfold eqm in |- *. simple induction a; trivial. - Qed. - - Lemma Map2_semantics_2_eq : - forall (m m':Map) (f:ad -> option A), - eqm (MapGet (M2 m m')) f -> - eqm (MapGet m') (fun a:ad => f (Ndouble_plus_one a)). - Proof. - unfold eqm in |- *. - intros. - rewrite <- (H (Ndouble_plus_one a)). - exact (Map2_semantics_2 m m' a). - Qed. - - Lemma MapGet_M2_bit_0_0 : - forall a:ad, - Nbit0 a = false -> - forall m m':Map, MapGet (M2 m m') a = MapGet m (Ndiv2 a). - Proof. - simple induction a; trivial. simple induction p. intros. discriminate H0. - trivial. - intros. discriminate H. - Qed. - - Lemma MapGet_M2_bit_0_1 : - forall a:ad, - Nbit0 a = true -> - forall m m':Map, MapGet (M2 m m') a = MapGet m' (Ndiv2 a). - Proof. - simple induction a. intros. discriminate H. - simple induction p. trivial. - intros. discriminate H0. - trivial. - Qed. - - Lemma MapGet_M2_bit_0_if : - forall (m m':Map) (a:ad), - MapGet (M2 m m') a = - (if Nbit0 a then MapGet m' (Ndiv2 a) else MapGet m (Ndiv2 a)). - Proof. - intros. elim (sumbool_of_bool (Nbit0 a)). intro H. rewrite H. - apply MapGet_M2_bit_0_1; assumption. - intro H. rewrite H. apply MapGet_M2_bit_0_0; assumption. - Qed. - - Lemma MapGet_M2_bit_0 : - forall (m m' m'':Map) (a:ad), - (if Nbit0 a then MapGet (M2 m' m) a else MapGet (M2 m m'') a) = - MapGet m (Ndiv2 a). - Proof. - intros. elim (sumbool_of_bool (Nbit0 a)). intro H. rewrite H. - apply MapGet_M2_bit_0_1; assumption. - intro H. rewrite H. apply MapGet_M2_bit_0_0; assumption. - Qed. - - Lemma Map2_semantics_3 : - forall m m':Map, - eqm (MapGet (M2 m m')) - (fun a:ad => - match Nbit0 a with - | false => MapGet m (Ndiv2 a) - | true => MapGet m' (Ndiv2 a) - end). - Proof. - unfold eqm in |- *. - simple induction a; trivial. - simple induction p; trivial. - Qed. - - Lemma Map2_semantics_3_eq : - forall (m m':Map) (f f':ad -> option A), - eqm (MapGet m) f -> - eqm (MapGet m') f' -> - eqm (MapGet (M2 m m')) - (fun a:ad => - match Nbit0 a with - | false => f (Ndiv2 a) - | true => f' (Ndiv2 a) - end). - Proof. - unfold eqm in |- *. - intros. - rewrite <- (H (Ndiv2 a)). - rewrite <- (H0 (Ndiv2 a)). - exact (Map2_semantics_3 m m' a). - Qed. - - Fixpoint MapPut1 (a:ad) (y:A) (a':ad) (y':A) (p:positive) {struct p} : - Map := - match p with - | xO p' => - let m := MapPut1 (Ndiv2 a) y (Ndiv2 a') y' p' in - match Nbit0 a with - | false => M2 m M0 - | true => M2 M0 m - end - | _ => - match Nbit0 a with - | false => M2 (M1 (Ndiv2 a) y) (M1 (Ndiv2 a') y') - | true => M2 (M1 (Ndiv2 a') y') (M1 (Ndiv2 a) y) - end - end. - - Lemma MapGet_if_commute : - forall (b:bool) (m m':Map) (a:ad), - MapGet (if b then m else m') a = (if b then MapGet m a else MapGet m' a). - Proof. - intros. case b; trivial. - Qed. - - (*i - Lemma MapGet_M2_bit_0_1' : (m,m',m'',m''':Map) - (a:ad) (MapGet (if (Nbit0 a) then (M2 m m') else (M2 m'' m''')) a)= - (MapGet (if (Nbit0 a) then m' else m'') (Ndiv2 a)). - Proof. - Intros. Rewrite (MapGet_if_commute (Nbit0 a)). Rewrite (MapGet_if_commute (Nbit0 a)). - Cut (Nbit0 a)=false\/(Nbit0 a)=true. Intros. Elim H. Intros. Rewrite H0. - Apply MapGet_M2_bit_0_0. Assumption. - Intros. Rewrite H0. Apply MapGet_M2_bit_0_1. Assumption. - Case (Nbit0 a); Auto. - Qed. - i*) - - Lemma MapGet_if_same : - forall (m:Map) (b:bool) (a:ad), MapGet (if b then m else m) a = MapGet m a. - Proof. - simple induction b; trivial. - Qed. - - Lemma MapGet_M2_bit_0_2 : - forall (m m' m'':Map) (a:ad), - MapGet (if Nbit0 a then M2 m m' else M2 m' m'') a = - MapGet m' (Ndiv2 a). - Proof. - intros. rewrite MapGet_if_commute. apply MapGet_M2_bit_0. - Qed. - - Lemma MapPut1_semantics_1 : - forall (p:positive) (a a':ad) (y y':A), - Nxor a a' = Npos p -> MapGet (MapPut1 a y a' y' p) a = Some y. - Proof. - simple induction p. intros. unfold MapPut1 in |- *. rewrite MapGet_M2_bit_0_2. apply M1_semantics_1. - intros. simpl in |- *. rewrite MapGet_M2_bit_0_2. apply H. rewrite <- Nxor_div2. rewrite H0. - reflexivity. - intros. unfold MapPut1 in |- *. rewrite MapGet_M2_bit_0_2. apply M1_semantics_1. - Qed. - - Lemma MapPut1_semantics_2 : - forall (p:positive) (a a':ad) (y y':A), - Nxor a a' = Npos p -> MapGet (MapPut1 a y a' y' p) a' = Some y'. - Proof. - simple induction p. intros. unfold MapPut1 in |- *. rewrite (Nneg_bit0_2 a a' p0 H0). - rewrite if_negb. rewrite MapGet_M2_bit_0_2. apply M1_semantics_1. - intros. simpl in |- *. rewrite (Nsame_bit0 a a' p0 H0). rewrite MapGet_M2_bit_0_2. - apply H. rewrite <- Nxor_div2. rewrite H0. reflexivity. - intros. unfold MapPut1 in |- *. rewrite (Nneg_bit0_1 a a' H). rewrite if_negb. - rewrite MapGet_M2_bit_0_2. apply M1_semantics_1. - Qed. - - Lemma MapGet_M2_both_None : - forall (m m':Map) (a:ad), - MapGet m (Ndiv2 a) = None -> - MapGet m' (Ndiv2 a) = None -> MapGet (M2 m m') a = None. - Proof. - intros. rewrite (Map2_semantics_3 m m' a). - case (Nbit0 a); assumption. - Qed. - - Lemma MapPut1_semantics_3 : - forall (p:positive) (a a' a0:ad) (y y':A), - Nxor a a' = Npos p -> - Neqb a a0 = false -> - Neqb a' a0 = false -> MapGet (MapPut1 a y a' y' p) a0 = None. - Proof. - simple induction p. intros. unfold MapPut1 in |- *. elim (Nneq_elim a a0 H1). intro. rewrite H3. rewrite if_negb. - rewrite MapGet_M2_bit_0_2. apply M1_semantics_2. apply Ndiv2_bit_neq. assumption. - rewrite (Nneg_bit0_2 a a' p0 H0) in H3. rewrite (negb_intro (Nbit0 a')). - rewrite (negb_intro (Nbit0 a0)). rewrite H3. reflexivity. - intro. elim (Nneq_elim a' a0 H2). intro. rewrite (Nneg_bit0_2 a a' p0 H0). rewrite H4. - rewrite (negb_elim (Nbit0 a0)). rewrite MapGet_M2_bit_0_2. - apply M1_semantics_2; assumption. - intro; case (Nbit0 a); apply MapGet_M2_both_None; apply M1_semantics_2; - assumption. - intros. simpl in |- *. elim (Nneq_elim a a0 H1). intro. rewrite H3. rewrite if_negb. - rewrite MapGet_M2_bit_0_2. reflexivity. - intro. elim (Nneq_elim a' a0 H2). intro. rewrite (Nsame_bit0 a a' p0 H0). rewrite H4. - rewrite if_negb. rewrite MapGet_M2_bit_0_2. reflexivity. - intro. cut (Nxor (Ndiv2 a) (Ndiv2 a') = Npos p0). intro. - case (Nbit0 a); apply MapGet_M2_both_None; trivial; apply H; - assumption. - rewrite <- Nxor_div2. rewrite H0. reflexivity. - intros. simpl in |- *. elim (Nneq_elim a a0 H0). intro. rewrite H2. rewrite if_negb. - rewrite MapGet_M2_bit_0_2. apply M1_semantics_2. apply Ndiv2_bit_neq. assumption. - rewrite (Nneg_bit0_1 a a' H) in H2. rewrite (negb_intro (Nbit0 a')). - rewrite (negb_intro (Nbit0 a0)). rewrite H2. reflexivity. - intro. elim (Nneq_elim a' a0 H1). intro. rewrite (Nneg_bit0_1 a a' H). rewrite H3. - rewrite (negb_elim (Nbit0 a0)). rewrite MapGet_M2_bit_0_2. - apply M1_semantics_2; assumption. - intro. case (Nbit0 a); apply MapGet_M2_both_None; apply M1_semantics_2; - assumption. - Qed. - - Lemma MapPut1_semantics : - forall (p:positive) (a a':ad) (y y':A), - Nxor a a' = Npos p -> - eqm (MapGet (MapPut1 a y a' y' p)) - (fun a0:ad => - if Neqb a a0 - then Some y - else if Neqb a' a0 then Some y' else None). - Proof. - unfold eqm in |- *. intros. elim (sumbool_of_bool (Neqb a a0)). intro H0. rewrite H0. - rewrite <- (Neqb_complete _ _ H0). exact (MapPut1_semantics_1 p a a' y y' H). - intro H0. rewrite H0. elim (sumbool_of_bool (Neqb a' a0)). intro H1. - rewrite <- (Neqb_complete _ _ H1). rewrite (Neqb_correct a'). - exact (MapPut1_semantics_2 p a a' y y' H). - intro H1. rewrite H1. exact (MapPut1_semantics_3 p a a' a0 y y' H H0 H1). - Qed. - - Lemma MapPut1_semantics' : - forall (p:positive) (a a':ad) (y y':A), - Nxor a a' = Npos p -> - eqm (MapGet (MapPut1 a y a' y' p)) - (fun a0:ad => - if Neqb a' a0 - then Some y' - else if Neqb a a0 then Some y else None). - Proof. - unfold eqm in |- *. intros. rewrite (MapPut1_semantics p a a' y y' H a0). - elim (sumbool_of_bool (Neqb a a0)). intro H0. rewrite H0. - rewrite <- (Neqb_complete a a0 H0). rewrite (Neqb_comm a' a). - rewrite (Nxor_eq_false a a' p H). reflexivity. - intro H0. rewrite H0. reflexivity. - Qed. - - Fixpoint MapPut (m:Map) : ad -> A -> Map := - match m with - | M0 => M1 - | M1 a y => - fun (a':ad) (y':A) => - match Nxor a a' with - | N0 => M1 a' y' - | Npos p => MapPut1 a y a' y' p - end - | M2 m1 m2 => - fun (a:ad) (y:A) => - match a with - | N0 => M2 (MapPut m1 N0 y) m2 - | Npos xH => M2 m1 (MapPut m2 N0 y) - | Npos (xO p) => M2 (MapPut m1 (Npos p) y) m2 - | Npos (xI p) => M2 m1 (MapPut m2 (Npos p) y) - end - end. - - Lemma MapPut_semantics_1 : - forall (a:ad) (y:A) (a0:ad), - MapGet (MapPut M0 a y) a0 = MapGet (M1 a y) a0. - Proof. - trivial. - Qed. - - Lemma MapPut_semantics_2_1 : - forall (a:ad) (y y':A) (a0:ad), - MapGet (MapPut (M1 a y) a y') a0 = - (if Neqb a a0 then Some y' else None). - Proof. - simpl in |- *. intros. rewrite (Nxor_nilpotent a). trivial. - Qed. - - Lemma MapPut_semantics_2_2 : - forall (a a':ad) (y y':A) (a0 a'':ad), - Nxor a a' = a'' -> - MapGet (MapPut (M1 a y) a' y') a0 = - (if Neqb a' a0 then Some y' else if Neqb a a0 then Some y else None). - Proof. - simple induction a''. intro. rewrite (Nxor_eq _ _ H). rewrite MapPut_semantics_2_1. - case (Neqb a' a0); trivial. - intros. simpl in |- *. rewrite H. rewrite (MapPut1_semantics p a a' y y' H a0). - elim (sumbool_of_bool (Neqb a a0)). intro H0. rewrite H0. rewrite <- (Neqb_complete _ _ H0). - rewrite (Neqb_comm a' a). rewrite (Nxor_eq_false _ _ _ H). reflexivity. - intro H0. rewrite H0. reflexivity. - Qed. - - Lemma MapPut_semantics_2 : - forall (a a':ad) (y y':A) (a0:ad), - MapGet (MapPut (M1 a y) a' y') a0 = - (if Neqb a' a0 then Some y' else if Neqb a a0 then Some y else None). - Proof. - intros. apply MapPut_semantics_2_2 with (a'' := Nxor a a'); trivial. - Qed. - - Lemma MapPut_semantics_3_1 : - forall (m m':Map) (a:ad) (y:A), - MapPut (M2 m m') a y = - (if Nbit0 a - then M2 m (MapPut m' (Ndiv2 a) y) - else M2 (MapPut m (Ndiv2 a) y) m'). - Proof. - simple induction a. trivial. - simple induction p; trivial. - Qed. - - Lemma MapPut_semantics : - forall (m:Map) (a:ad) (y:A), - eqm (MapGet (MapPut m a y)) - (fun a':ad => if Neqb a a' then Some y else MapGet m a'). - Proof. - unfold eqm in |- *. simple induction m. exact MapPut_semantics_1. - intros. unfold MapGet at 2 in |- *. apply MapPut_semantics_2; assumption. - intros. rewrite MapPut_semantics_3_1. rewrite (MapGet_M2_bit_0_if m0 m1 a0). - elim (sumbool_of_bool (Nbit0 a)). intro H1. rewrite H1. rewrite MapGet_M2_bit_0_if. - elim (sumbool_of_bool (Nbit0 a0)). intro H2. rewrite H2. - rewrite (H0 (Ndiv2 a) y (Ndiv2 a0)). elim (sumbool_of_bool (Neqb a a0)). - intro H3. rewrite H3. rewrite (Ndiv2_eq _ _ H3). reflexivity. - intro H3. rewrite H3. rewrite <- H2 in H1. rewrite (Ndiv2_bit_neq _ _ H3 H1). reflexivity. - intro H2. rewrite H2. rewrite (Neqb_comm a a0). rewrite (Nbit0_neq a0 a H2 H1). - reflexivity. - intro H1. rewrite H1. rewrite MapGet_M2_bit_0_if. elim (sumbool_of_bool (Nbit0 a0)). - intro H2. rewrite H2. rewrite (Nbit0_neq a a0 H1 H2). reflexivity. - intro H2. rewrite H2. rewrite (H (Ndiv2 a) y (Ndiv2 a0)). - elim (sumbool_of_bool (Neqb a a0)). intro H3. rewrite H3. - rewrite (Ndiv2_eq a a0 H3). reflexivity. - intro H3. rewrite H3. rewrite <- H2 in H1. rewrite (Ndiv2_bit_neq a a0 H3 H1). reflexivity. - Qed. - - Fixpoint MapPut_behind (m:Map) : ad -> A -> Map := - match m with - | M0 => M1 - | M1 a y => - fun (a':ad) (y':A) => - match Nxor a a' with - | N0 => m - | Npos p => MapPut1 a y a' y' p - end - | M2 m1 m2 => - fun (a:ad) (y:A) => - match a with - | N0 => M2 (MapPut_behind m1 N0 y) m2 - | Npos xH => M2 m1 (MapPut_behind m2 N0 y) - | Npos (xO p) => M2 (MapPut_behind m1 (Npos p) y) m2 - | Npos (xI p) => M2 m1 (MapPut_behind m2 (Npos p) y) - end - end. - - Lemma MapPut_behind_semantics_3_1 : - forall (m m':Map) (a:ad) (y:A), - MapPut_behind (M2 m m') a y = - (if Nbit0 a - then M2 m (MapPut_behind m' (Ndiv2 a) y) - else M2 (MapPut_behind m (Ndiv2 a) y) m'). - Proof. - simple induction a. trivial. - simple induction p; trivial. - Qed. - - Lemma MapPut_behind_as_before_1 : - forall a a' a0:ad, - Neqb a' a0 = false -> - forall y y':A, - MapGet (MapPut (M1 a y) a' y') a0 = - MapGet (MapPut_behind (M1 a y) a' y') a0. - Proof. - intros a a' a0. simpl in |- *. intros H y y'. elim (Ndiscr (Nxor a a')). intro H0. elim H0. - intros p H1. rewrite H1. reflexivity. - intro H0. rewrite H0. rewrite (Nxor_eq _ _ H0). rewrite (M1_semantics_2 a' a0 y H). - exact (M1_semantics_2 a' a0 y' H). - Qed. - - Lemma MapPut_behind_as_before : - forall (m:Map) (a:ad) (y:A) (a0:ad), - Neqb a a0 = false -> - MapGet (MapPut m a y) a0 = MapGet (MapPut_behind m a y) a0. - Proof. - simple induction m. trivial. - intros a y a' y' a0 H. exact (MapPut_behind_as_before_1 a a' a0 H y y'). - intros. rewrite MapPut_semantics_3_1. rewrite MapPut_behind_semantics_3_1. - elim (sumbool_of_bool (Nbit0 a)). intro H2. rewrite H2. rewrite MapGet_M2_bit_0_if. - rewrite MapGet_M2_bit_0_if. elim (sumbool_of_bool (Nbit0 a0)). intro H3. - rewrite H3. apply H0. rewrite <- H3 in H2. exact (Ndiv2_bit_neq a a0 H1 H2). - intro H3. rewrite H3. reflexivity. - intro H2. rewrite H2. rewrite MapGet_M2_bit_0_if. rewrite MapGet_M2_bit_0_if. - elim (sumbool_of_bool (Nbit0 a0)). intro H3. rewrite H3. reflexivity. - intro H3. rewrite H3. apply H. rewrite <- H3 in H2. exact (Ndiv2_bit_neq a a0 H1 H2). - Qed. - - Lemma MapPut_behind_new : - forall (m:Map) (a:ad) (y:A), - MapGet (MapPut_behind m a y) a = - match MapGet m a with - | Some y' => Some y' - | _ => Some y - end. - Proof. - simple induction m. simpl in |- *. intros. rewrite (Neqb_correct a). reflexivity. - intros. elim (Ndiscr (Nxor a a1)). intro H. elim H. intros p H0. simpl in |- *. - rewrite H0. rewrite (Nxor_eq_false a a1 p). exact (MapPut1_semantics_2 p a a1 a0 y H0). - assumption. - intro H. simpl in |- *. rewrite H. rewrite <- (Nxor_eq _ _ H). rewrite (Neqb_correct a). - exact (M1_semantics_1 a a0). - intros. rewrite MapPut_behind_semantics_3_1. rewrite (MapGet_M2_bit_0_if m0 m1 a). - elim (sumbool_of_bool (Nbit0 a)). intro H1. rewrite H1. rewrite (MapGet_M2_bit_0_1 a H1). - exact (H0 (Ndiv2 a) y). - intro H1. rewrite H1. rewrite (MapGet_M2_bit_0_0 a H1). exact (H (Ndiv2 a) y). - Qed. - - Lemma MapPut_behind_semantics : - forall (m:Map) (a:ad) (y:A), - eqm (MapGet (MapPut_behind m a y)) - (fun a':ad => - match MapGet m a' with - | Some y' => Some y' - | _ => if Neqb a a' then Some y else None - end). - Proof. - unfold eqm in |- *. intros. elim (sumbool_of_bool (Neqb a a0)). intro H. rewrite H. - rewrite (Neqb_complete _ _ H). apply MapPut_behind_new. - intro H. rewrite H. rewrite <- (MapPut_behind_as_before m a y a0 H). - rewrite (MapPut_semantics m a y a0). rewrite H. case (MapGet m a0); trivial. - Qed. - - Definition makeM2 (m m':Map) := - match m, m' with - | M0, M0 => M0 - | M0, M1 a y => M1 (Ndouble_plus_one a) y - | M1 a y, M0 => M1 (Ndouble a) y - | _, _ => M2 m m' - end. - - Lemma makeM2_M2 : - forall m m':Map, eqm (MapGet (makeM2 m m')) (MapGet (M2 m m')). - Proof. - unfold eqm in |- *. intros. elim (sumbool_of_bool (Nbit0 a)). intro H. - rewrite (MapGet_M2_bit_0_1 a H m m'). case m'. case m. reflexivity. - intros a0 y. simpl in |- *. rewrite (Nodd_not_double a H a0). reflexivity. - intros m1 m2. unfold makeM2 in |- *. rewrite MapGet_M2_bit_0_1. reflexivity. - assumption. - case m. intros a0 y. simpl in |- *. elim (sumbool_of_bool (Neqb a0 (Ndiv2 a))). - intro H0. rewrite H0. rewrite (Neqb_complete _ _ H0). rewrite (Ndiv2_double_plus_one a H). - rewrite (Neqb_correct a). reflexivity. - intro H0. rewrite H0. rewrite (Neqb_comm a0 (Ndiv2 a)) in H0. - rewrite (Nnot_div2_not_double_plus_one a a0 H0). reflexivity. - intros a0 y0 a1 y1. unfold makeM2 in |- *. rewrite MapGet_M2_bit_0_1. reflexivity. - assumption. - intros m1 m2 a0 y. unfold makeM2 in |- *. rewrite MapGet_M2_bit_0_1. reflexivity. - assumption. - intros m1 m2. unfold makeM2 in |- *. - cut (MapGet (M2 m (M2 m1 m2)) a = MapGet (M2 m1 m2) (Ndiv2 a)). - case m; trivial. - exact (MapGet_M2_bit_0_1 a H m (M2 m1 m2)). - intro H. rewrite (MapGet_M2_bit_0_0 a H m m'). case m. case m'. reflexivity. - intros a0 y. simpl in |- *. rewrite (Neven_not_double_plus_one a H a0). reflexivity. - intros m1 m2. unfold makeM2 in |- *. rewrite MapGet_M2_bit_0_0. reflexivity. - assumption. - case m'. intros a0 y. simpl in |- *. elim (sumbool_of_bool (Neqb a0 (Ndiv2 a))). intro H0. - rewrite H0. rewrite (Neqb_complete _ _ H0). rewrite (Ndiv2_double a H). - rewrite (Neqb_correct a). reflexivity. - intro H0. rewrite H0. rewrite (Neqb_comm (Ndouble a0) a). - rewrite (Neqb_comm a0 (Ndiv2 a)) in H0. rewrite (Nnot_div2_not_double a a0 H0). - reflexivity. - intros a0 y0 a1 y1. unfold makeM2 in |- *. rewrite MapGet_M2_bit_0_0. reflexivity. - assumption. - intros m1 m2 a0 y. unfold makeM2 in |- *. rewrite MapGet_M2_bit_0_0. reflexivity. - assumption. - intros m1 m2. unfold makeM2 in |- *. exact (MapGet_M2_bit_0_0 a H (M2 m1 m2) m'). - Qed. - - Fixpoint MapRemove (m:Map) : ad -> Map := - match m with - | M0 => fun _:ad => M0 - | M1 a y => - fun a':ad => match Neqb a a' with - | true => M0 - | false => m - end - | M2 m1 m2 => - fun a:ad => - if Nbit0 a - then makeM2 m1 (MapRemove m2 (Ndiv2 a)) - else makeM2 (MapRemove m1 (Ndiv2 a)) m2 - end. - - Lemma MapRemove_semantics : - forall (m:Map) (a:ad), - eqm (MapGet (MapRemove m a)) - (fun a':ad => if Neqb a a' then None else MapGet m a'). - Proof. - unfold eqm in |- *. simple induction m. simpl in |- *. intros. case (Neqb a a0); trivial. - intros. simpl in |- *. elim (sumbool_of_bool (Neqb a1 a2)). intro H. rewrite H. - elim (sumbool_of_bool (Neqb a a1)). intro H0. rewrite H0. reflexivity. - intro H0. rewrite H0. rewrite (Neqb_complete _ _ H) in H0. exact (M1_semantics_2 a a2 a0 H0). - intro H. elim (sumbool_of_bool (Neqb a a1)). intro H0. rewrite H0. rewrite H. - rewrite <- (Neqb_complete _ _ H0) in H. rewrite H. reflexivity. - intro H0. rewrite H0. rewrite H. reflexivity. - intros. change - (MapGet - (if Nbit0 a - then makeM2 m0 (MapRemove m1 (Ndiv2 a)) - else makeM2 (MapRemove m0 (Ndiv2 a)) m1) a0 = - (if Neqb a a0 then None else MapGet (M2 m0 m1) a0)) - in |- *. - elim (sumbool_of_bool (Nbit0 a)). intro H1. rewrite H1. - rewrite (makeM2_M2 m0 (MapRemove m1 (Ndiv2 a)) a0). elim (sumbool_of_bool (Nbit0 a0)). - intro H2. rewrite MapGet_M2_bit_0_1. rewrite (H0 (Ndiv2 a) (Ndiv2 a0)). - elim (sumbool_of_bool (Neqb a a0)). intro H3. rewrite H3. rewrite (Ndiv2_eq _ _ H3). - reflexivity. - intro H3. rewrite H3. rewrite <- H2 in H1. rewrite (Ndiv2_bit_neq _ _ H3 H1). - rewrite (MapGet_M2_bit_0_1 a0 H2 m0 m1). reflexivity. - assumption. - intro H2. rewrite (MapGet_M2_bit_0_0 a0 H2 m0 (MapRemove m1 (Ndiv2 a))). - rewrite (Neqb_comm a a0). rewrite (Nbit0_neq _ _ H2 H1). - rewrite (MapGet_M2_bit_0_0 a0 H2 m0 m1). reflexivity. - intro H1. rewrite H1. rewrite (makeM2_M2 (MapRemove m0 (Ndiv2 a)) m1 a0). - elim (sumbool_of_bool (Nbit0 a0)). intro H2. rewrite MapGet_M2_bit_0_1. - rewrite (MapGet_M2_bit_0_1 a0 H2 m0 m1). rewrite (Nbit0_neq a a0 H1 H2). reflexivity. - assumption. - intro H2. rewrite MapGet_M2_bit_0_0. rewrite (H (Ndiv2 a) (Ndiv2 a0)). - rewrite (MapGet_M2_bit_0_0 a0 H2 m0 m1). elim (sumbool_of_bool (Neqb a a0)). intro H3. - rewrite H3. rewrite (Ndiv2_eq _ _ H3). reflexivity. - intro H3. rewrite H3. rewrite <- H2 in H1. rewrite (Ndiv2_bit_neq _ _ H3 H1). reflexivity. - assumption. - Qed. - - Fixpoint MapCard (m:Map) : nat := - match m with - | M0 => 0 - | M1 _ _ => 1 - | M2 m m' => MapCard m + MapCard m' - end. - - Fixpoint MapMerge (m:Map) : Map -> Map := - match m with - | M0 => fun m':Map => m' - | M1 a y => fun m':Map => MapPut_behind m' a y - | M2 m1 m2 => - fun m':Map => - match m' with - | M0 => m - | M1 a' y' => MapPut m a' y' - | M2 m'1 m'2 => M2 (MapMerge m1 m'1) (MapMerge m2 m'2) - end - end. - - Lemma MapMerge_semantics : - forall m m':Map, - eqm (MapGet (MapMerge m m')) - (fun a0:ad => - match MapGet m' a0 with - | Some y' => Some y' - | None => MapGet m a0 - end). - Proof. - unfold eqm in |- *. simple induction m. intros. simpl in |- *. case (MapGet m' a); trivial. - intros. simpl in |- *. rewrite (MapPut_behind_semantics m' a a0 a1). reflexivity. - simple induction m'. trivial. - intros. unfold MapMerge in |- *. rewrite (MapPut_semantics (M2 m0 m1) a a0 a1). - elim (sumbool_of_bool (Neqb a a1)). intro H1. rewrite H1. rewrite (Neqb_complete _ _ H1). - rewrite (M1_semantics_1 a1 a0). reflexivity. - intro H1. rewrite H1. rewrite (M1_semantics_2 a a1 a0 H1). reflexivity. - intros. cut (MapMerge (M2 m0 m1) (M2 m2 m3) = M2 (MapMerge m0 m2) (MapMerge m1 m3)). - intro. rewrite H3. rewrite MapGet_M2_bit_0_if. rewrite (H0 m3 (Ndiv2 a)). - rewrite (H m2 (Ndiv2 a)). rewrite (MapGet_M2_bit_0_if m2 m3 a). - rewrite (MapGet_M2_bit_0_if m0 m1 a). case (Nbit0 a); trivial. - reflexivity. - Qed. - - (** [MapInter], [MapRngRestrTo], [MapRngRestrBy], [MapInverse] - not implemented: need a decidable equality on [A]. *) - - Fixpoint MapDelta (m:Map) : Map -> Map := - match m with - | M0 => fun m':Map => m' - | M1 a y => - fun m':Map => - match MapGet m' a with - | None => MapPut m' a y - | _ => MapRemove m' a - end - | M2 m1 m2 => - fun m':Map => - match m' with - | M0 => m - | M1 a' y' => - match MapGet m a' with - | None => MapPut m a' y' - | _ => MapRemove m a' - end - | M2 m'1 m'2 => makeM2 (MapDelta m1 m'1) (MapDelta m2 m'2) - end - end. - - Lemma MapDelta_semantics_comm : - forall m m':Map, eqm (MapGet (MapDelta m m')) (MapGet (MapDelta m' m)). - Proof. - unfold eqm in |- *. simple induction m. simple induction m'; reflexivity. - simple induction m'. reflexivity. - unfold MapDelta in |- *. intros. elim (sumbool_of_bool (Neqb a a1)). intro H. - rewrite <- (Neqb_complete _ _ H). rewrite (M1_semantics_1 a a2). - rewrite (M1_semantics_1 a a0). simpl in |- *. rewrite (Neqb_correct a). reflexivity. - intro H. rewrite (M1_semantics_2 a a1 a0 H). rewrite (Neqb_comm a a1) in H. - rewrite (M1_semantics_2 a1 a a2 H). rewrite (MapPut_semantics (M1 a a0) a1 a2 a3). - rewrite (MapPut_semantics (M1 a1 a2) a a0 a3). elim (sumbool_of_bool (Neqb a a3)). - intro H0. rewrite H0. rewrite (Neqb_complete _ _ H0) in H. rewrite H. - rewrite (Neqb_complete _ _ H0). rewrite (M1_semantics_1 a3 a0). reflexivity. - intro H0. rewrite H0. rewrite (M1_semantics_2 a a3 a0 H0). - elim (sumbool_of_bool (Neqb a1 a3)). intro H1. rewrite H1. - rewrite (Neqb_complete _ _ H1). exact (M1_semantics_1 a3 a2). - intro H1. rewrite H1. exact (M1_semantics_2 a1 a3 a2 H1). - intros. reflexivity. - simple induction m'. reflexivity. - reflexivity. - intros. simpl in |- *. rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a). - rewrite (makeM2_M2 (MapDelta m2 m0) (MapDelta m3 m1) a). - rewrite (MapGet_M2_bit_0_if (MapDelta m0 m2) (MapDelta m1 m3) a). - rewrite (MapGet_M2_bit_0_if (MapDelta m2 m0) (MapDelta m3 m1) a). - rewrite (H0 m3 (Ndiv2 a)). rewrite (H m2 (Ndiv2 a)). reflexivity. - Qed. - - Lemma MapDelta_semantics_1_1 : - forall (a:ad) (y:A) (m':Map) (a0:ad), - MapGet (M1 a y) a0 = None -> - MapGet m' a0 = None -> MapGet (MapDelta (M1 a y) m') a0 = None. - Proof. - intros. unfold MapDelta in |- *. elim (sumbool_of_bool (Neqb a a0)). intro H1. - rewrite (Neqb_complete _ _ H1) in H. rewrite (M1_semantics_1 a0 y) in H. discriminate H. - intro H1. case (MapGet m' a). - rewrite (MapRemove_semantics m' a a0). rewrite H1. trivial. - rewrite (MapPut_semantics m' a y a0). rewrite H1. assumption. - Qed. - - Lemma MapDelta_semantics_1 : - forall (m m':Map) (a:ad), - MapGet m a = None -> - MapGet m' a = None -> MapGet (MapDelta m m') a = None. - Proof. - simple induction m. trivial. - exact MapDelta_semantics_1_1. - simple induction m'. trivial. - intros. rewrite (MapDelta_semantics_comm (M2 m0 m1) (M1 a a0) a1). - apply MapDelta_semantics_1_1; trivial. - intros. simpl in |- *. rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a). - rewrite MapGet_M2_bit_0_if. elim (sumbool_of_bool (Nbit0 a)). intro H5. rewrite H5. - apply H0. rewrite (MapGet_M2_bit_0_1 a H5 m0 m1) in H3. exact H3. - rewrite (MapGet_M2_bit_0_1 a H5 m2 m3) in H4. exact H4. - intro H5. rewrite H5. apply H. rewrite (MapGet_M2_bit_0_0 a H5 m0 m1) in H3. exact H3. - rewrite (MapGet_M2_bit_0_0 a H5 m2 m3) in H4. exact H4. - Qed. - - Lemma MapDelta_semantics_2_1 : - forall (a:ad) (y:A) (m':Map) (a0:ad) (y0:A), - MapGet (M1 a y) a0 = None -> - MapGet m' a0 = Some y0 -> MapGet (MapDelta (M1 a y) m') a0 = Some y0. - Proof. - intros. unfold MapDelta in |- *. elim (sumbool_of_bool (Neqb a a0)). intro H1. - rewrite (Neqb_complete _ _ H1) in H. rewrite (M1_semantics_1 a0 y) in H. discriminate H. - intro H1. case (MapGet m' a). - rewrite (MapRemove_semantics m' a a0). rewrite H1. trivial. - rewrite (MapPut_semantics m' a y a0). rewrite H1. assumption. - Qed. - - Lemma MapDelta_semantics_2_2 : - forall (a:ad) (y:A) (m':Map) (a0:ad) (y0:A), - MapGet (M1 a y) a0 = Some y0 -> - MapGet m' a0 = None -> MapGet (MapDelta (M1 a y) m') a0 = Some y0. - Proof. - intros. unfold MapDelta in |- *. elim (sumbool_of_bool (Neqb a a0)). intro H1. - rewrite (Neqb_complete _ _ H1) in H. rewrite (Neqb_complete _ _ H1). - rewrite H0. rewrite (MapPut_semantics m' a0 y a0). rewrite (Neqb_correct a0). - rewrite (M1_semantics_1 a0 y) in H. simple inversion H. assumption. - intro H1. rewrite (M1_semantics_2 a a0 y H1) in H. discriminate H. - Qed. - - Lemma MapDelta_semantics_2 : - forall (m m':Map) (a:ad) (y:A), - MapGet m a = None -> - MapGet m' a = Some y -> MapGet (MapDelta m m') a = Some y. - Proof. - simple induction m. trivial. - exact MapDelta_semantics_2_1. - simple induction m'. intros. discriminate H2. - intros. rewrite (MapDelta_semantics_comm (M2 m0 m1) (M1 a a0) a1). - apply MapDelta_semantics_2_2; assumption. - intros. simpl in |- *. rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a). - rewrite MapGet_M2_bit_0_if. elim (sumbool_of_bool (Nbit0 a)). intro H5. rewrite H5. - apply H0. rewrite <- (MapGet_M2_bit_0_1 a H5 m0 m1). assumption. - rewrite <- (MapGet_M2_bit_0_1 a H5 m2 m3). assumption. - intro H5. rewrite H5. apply H. rewrite <- (MapGet_M2_bit_0_0 a H5 m0 m1). assumption. - rewrite <- (MapGet_M2_bit_0_0 a H5 m2 m3). assumption. - Qed. - - Lemma MapDelta_semantics_3_1 : - forall (a0:ad) (y0:A) (m':Map) (a:ad) (y y':A), - MapGet (M1 a0 y0) a = Some y -> - MapGet m' a = Some y' -> MapGet (MapDelta (M1 a0 y0) m') a = None. - Proof. - intros. unfold MapDelta in |- *. elim (sumbool_of_bool (Neqb a0 a)). intro H1. - rewrite (Neqb_complete a0 a H1). rewrite H0. rewrite (MapRemove_semantics m' a a). - rewrite (Neqb_correct a). reflexivity. - intro H1. rewrite (M1_semantics_2 a0 a y0 H1) in H. discriminate H. - Qed. - - Lemma MapDelta_semantics_3 : - forall (m m':Map) (a:ad) (y y':A), - MapGet m a = Some y -> - MapGet m' a = Some y' -> MapGet (MapDelta m m') a = None. - Proof. - simple induction m. intros. discriminate H. - exact MapDelta_semantics_3_1. - simple induction m'. intros. discriminate H2. - intros. rewrite (MapDelta_semantics_comm (M2 m0 m1) (M1 a a0) a1). - exact (MapDelta_semantics_3_1 a a0 (M2 m0 m1) a1 y' y H2 H1). - intros. simpl in |- *. rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a). - rewrite MapGet_M2_bit_0_if. elim (sumbool_of_bool (Nbit0 a)). intro H5. rewrite H5. - apply (H0 m3 (Ndiv2 a) y y'). rewrite <- (MapGet_M2_bit_0_1 a H5 m0 m1). assumption. - rewrite <- (MapGet_M2_bit_0_1 a H5 m2 m3). assumption. - intro H5. rewrite H5. apply (H m2 (Ndiv2 a) y y'). - rewrite <- (MapGet_M2_bit_0_0 a H5 m0 m1). assumption. - rewrite <- (MapGet_M2_bit_0_0 a H5 m2 m3). assumption. - Qed. - - Lemma MapDelta_semantics : - forall m m':Map, - eqm (MapGet (MapDelta m m')) - (fun a0:ad => - match MapGet m a0, MapGet m' a0 with - | None, Some y' => Some y' - | Some y, None => Some y - | _, _ => None - end). - Proof. - unfold eqm in |- *. intros. elim (option_sum (MapGet m' a)). intro H. elim H. intros a0 H0. - rewrite H0. elim (option_sum (MapGet m a)). intro H1. elim H1. intros a1 H2. rewrite H2. - exact (MapDelta_semantics_3 m m' a a1 a0 H2 H0). - intro H1. rewrite H1. exact (MapDelta_semantics_2 m m' a a0 H1 H0). - intro H. rewrite H. elim (option_sum (MapGet m a)). intro H0. elim H0. intros a0 H1. - rewrite H1. rewrite (MapDelta_semantics_comm m m' a). - exact (MapDelta_semantics_2 m' m a a0 H H1). - intro H0. rewrite H0. exact (MapDelta_semantics_1 m m' a H0 H). - Qed. - - Definition MapEmptyp (m:Map) := match m with - | M0 => true - | _ => false - end. - - Lemma MapEmptyp_correct : MapEmptyp M0 = true. - Proof. - reflexivity. - Qed. - - Lemma MapEmptyp_complete : forall m:Map, MapEmptyp m = true -> m = M0. - Proof. - simple induction m; trivial. intros. discriminate H. - intros. discriminate H1. - Qed. - - (** [MapSplit] not implemented: not the preferred way of recursing over Maps - (use [MapSweep], [MapCollect], or [MapFold] in Mapiter.v. *) - -End MapDefs.
\ No newline at end of file diff --git a/theories/IntMap/Mapaxioms.v b/theories/IntMap/Mapaxioms.v deleted file mode 100644 index 0722bcfa..00000000 --- a/theories/IntMap/Mapaxioms.v +++ /dev/null @@ -1,761 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) -(*i $Id: Mapaxioms.v 8733 2006-04-25 22:52:18Z letouzey $ i*) - -Require Import Bool. -Require Import Sumbool. -Require Import NArith. -Require Import Ndigits. -Require Import Ndec. -Require Import Map. -Require Import Fset. - -Section MapAxioms. - - Variables A B C : Set. - - Lemma eqm_sym : forall f f':ad -> option A, eqm A f f' -> eqm A f' f. - Proof. - unfold eqm in |- *. intros. rewrite H. reflexivity. - Qed. - - Lemma eqm_refl : forall f:ad -> option A, eqm A f f. - Proof. - unfold eqm in |- *. trivial. - Qed. - - Lemma eqm_trans : - forall f f' f'':ad -> option A, eqm A f f' -> eqm A f' f'' -> eqm A f f''. - Proof. - unfold eqm in |- *. intros. rewrite H. exact (H0 a). - Qed. - - Definition eqmap (m m':Map A) := eqm A (MapGet A m) (MapGet A m'). - - Lemma eqmap_sym : forall m m':Map A, eqmap m m' -> eqmap m' m. - Proof. - intros. unfold eqmap in |- *. apply eqm_sym. assumption. - Qed. - - Lemma eqmap_refl : forall m:Map A, eqmap m m. - Proof. - intros. unfold eqmap in |- *. apply eqm_refl. - Qed. - - Lemma eqmap_trans : - forall m m' m'':Map A, eqmap m m' -> eqmap m' m'' -> eqmap m m''. - Proof. - intros. exact (eqm_trans (MapGet A m) (MapGet A m') (MapGet A m'') H H0). - Qed. - - Lemma MapPut_as_Merge : - forall (m:Map A) (a:ad) (y:A), - eqmap (MapPut A m a y) (MapMerge A m (M1 A a y)). - Proof. - unfold eqmap, eqm in |- *. intros. rewrite (MapPut_semantics A m a y a0). - rewrite (MapMerge_semantics A m (M1 A a y) a0). unfold MapGet at 2. - elim (sumbool_of_bool (Neqb a a0)); intro H; rewrite H; reflexivity. - Qed. - - Lemma MapPut_ext : - forall m m':Map A, - eqmap m m' -> - forall (a:ad) (y:A), eqmap (MapPut A m a y) (MapPut A m' a y). - Proof. - unfold eqmap, eqm in |- *. intros. rewrite (MapPut_semantics A m' a y a0). - rewrite (MapPut_semantics A m a y a0). - case (Neqb a a0); [ reflexivity | apply H ]. - Qed. - - Lemma MapPut_behind_as_Merge : - forall (m:Map A) (a:ad) (y:A), - eqmap (MapPut_behind A m a y) (MapMerge A (M1 A a y) m). - Proof. - unfold eqmap, eqm in |- *. intros. rewrite (MapPut_behind_semantics A m a y a0). - rewrite (MapMerge_semantics A (M1 A a y) m a0). reflexivity. - Qed. - - Lemma MapPut_behind_ext : - forall m m':Map A, - eqmap m m' -> - forall (a:ad) (y:A), - eqmap (MapPut_behind A m a y) (MapPut_behind A m' a y). - Proof. - unfold eqmap, eqm in |- *. intros. rewrite (MapPut_behind_semantics A m' a y a0). - rewrite (MapPut_behind_semantics A m a y a0). rewrite (H a0). reflexivity. - Qed. - - Lemma MapMerge_empty_m_1 : forall m:Map A, MapMerge A (M0 A) m = m. - Proof. - trivial. - Qed. - - Lemma MapMerge_empty_m : forall m:Map A, eqmap (MapMerge A (M0 A) m) m. - Proof. - unfold eqmap, eqm in |- *. trivial. - Qed. - - Lemma MapMerge_m_empty_1 : forall m:Map A, MapMerge A m (M0 A) = m. - Proof. - simple induction m; trivial. - Qed. - - Lemma MapMerge_m_empty : forall m:Map A, eqmap (MapMerge A m (M0 A)) m. - Proof. - unfold eqmap, eqm in |- *. intros. rewrite MapMerge_m_empty_1. reflexivity. - Qed. - - Lemma MapMerge_empty_l : - forall m m':Map A, eqmap (MapMerge A m m') (M0 A) -> eqmap m (M0 A). - Proof. - unfold eqmap, eqm in |- *. intros. cut (MapGet A (MapMerge A m m') a = MapGet A (M0 A) a). - rewrite (MapMerge_semantics A m m' a). case (MapGet A m' a); trivial. - intros. discriminate H0. - exact (H a). - Qed. - - Lemma MapMerge_empty_r : - forall m m':Map A, eqmap (MapMerge A m m') (M0 A) -> eqmap m' (M0 A). - Proof. - unfold eqmap, eqm in |- *. intros. cut (MapGet A (MapMerge A m m') a = MapGet A (M0 A) a). - rewrite (MapMerge_semantics A m m' a). case (MapGet A m' a); trivial. - exact (H a). - Qed. - - Lemma MapMerge_assoc : - forall m m' m'':Map A, - eqmap (MapMerge A (MapMerge A m m') m'') - (MapMerge A m (MapMerge A m' m'')). - Proof. - unfold eqmap, eqm in |- *. intros. rewrite (MapMerge_semantics A (MapMerge A m m') m'' a). - rewrite (MapMerge_semantics A m (MapMerge A m' m'') a). rewrite (MapMerge_semantics A m m' a). - rewrite (MapMerge_semantics A m' m'' a). - case (MapGet A m'' a); case (MapGet A m' a); trivial. - Qed. - - Lemma MapMerge_idempotent : forall m:Map A, eqmap (MapMerge A m m) m. - Proof. - unfold eqmap, eqm in |- *. intros. rewrite (MapMerge_semantics A m m a). - case (MapGet A m a); trivial. - Qed. - - Lemma MapMerge_ext : - forall m1 m2 m'1 m'2:Map A, - eqmap m1 m'1 -> - eqmap m2 m'2 -> eqmap (MapMerge A m1 m2) (MapMerge A m'1 m'2). - Proof. - unfold eqmap, eqm in |- *. intros. rewrite (MapMerge_semantics A m1 m2 a). - rewrite (MapMerge_semantics A m'1 m'2 a). rewrite (H a). rewrite (H0 a). reflexivity. - Qed. - - Lemma MapMerge_ext_l : - forall m1 m'1 m2:Map A, - eqmap m1 m'1 -> eqmap (MapMerge A m1 m2) (MapMerge A m'1 m2). - Proof. - intros. apply MapMerge_ext. assumption. - apply eqmap_refl. - Qed. - - Lemma MapMerge_ext_r : - forall m1 m2 m'2:Map A, - eqmap m2 m'2 -> eqmap (MapMerge A m1 m2) (MapMerge A m1 m'2). - Proof. - intros. apply MapMerge_ext. apply eqmap_refl. - assumption. - Qed. - - Lemma MapMerge_RestrTo_l : - forall m m' m'':Map A, - eqmap (MapMerge A (MapDomRestrTo A A m m') m'') - (MapDomRestrTo A A (MapMerge A m m'') (MapMerge A m' m'')). - Proof. - unfold eqmap, eqm in |- *. intros. rewrite (MapMerge_semantics A (MapDomRestrTo A A m m') m'' a). - rewrite (MapDomRestrTo_semantics A A m m' a). - rewrite - (MapDomRestrTo_semantics A A (MapMerge A m m'') (MapMerge A m' m'') a) - . - rewrite (MapMerge_semantics A m' m'' a). rewrite (MapMerge_semantics A m m'' a). - case (MapGet A m'' a); case (MapGet A m' a); reflexivity. - Qed. - - Lemma MapRemove_as_RestrBy : - forall (m:Map A) (a:ad) (y:B), - eqmap (MapRemove A m a) (MapDomRestrBy A B m (M1 B a y)). - Proof. - unfold eqmap, eqm in |- *. intros. rewrite (MapRemove_semantics A m a a0). - rewrite (MapDomRestrBy_semantics A B m (M1 B a y) a0). elim (sumbool_of_bool (Neqb a a0)). - intro H. rewrite H. rewrite (Neqb_complete a a0 H). rewrite (M1_semantics_1 B a0 y). - reflexivity. - intro H. rewrite H. rewrite (M1_semantics_2 B a a0 y H). reflexivity. - Qed. - - Lemma MapRemove_ext : - forall m m':Map A, - eqmap m m' -> forall a:ad, eqmap (MapRemove A m a) (MapRemove A m' a). - Proof. - unfold eqmap, eqm in |- *. intros. rewrite (MapRemove_semantics A m' a a0). - rewrite (MapRemove_semantics A m a a0). - case (Neqb a a0); [ reflexivity | apply H ]. - Qed. - - Lemma MapDomRestrTo_empty_m_1 : - forall m:Map B, MapDomRestrTo A B (M0 A) m = M0 A. - Proof. - trivial. - Qed. - - Lemma MapDomRestrTo_empty_m : - forall m:Map B, eqmap (MapDomRestrTo A B (M0 A) m) (M0 A). - Proof. - unfold eqmap, eqm in |- *. trivial. - Qed. - - Lemma MapDomRestrTo_m_empty_1 : - forall m:Map A, MapDomRestrTo A B m (M0 B) = M0 A. - Proof. - simple induction m; trivial. - Qed. - - Lemma MapDomRestrTo_m_empty : - forall m:Map A, eqmap (MapDomRestrTo A B m (M0 B)) (M0 A). - Proof. - unfold eqmap, eqm in |- *. intros. rewrite (MapDomRestrTo_m_empty_1 m). reflexivity. - Qed. - - Lemma MapDomRestrTo_assoc : - forall (m:Map A) (m':Map B) (m'':Map C), - eqmap (MapDomRestrTo A C (MapDomRestrTo A B m m') m'') - (MapDomRestrTo A B m (MapDomRestrTo B C m' m'')). - Proof. - unfold eqmap, eqm in |- *. intros. - rewrite (MapDomRestrTo_semantics A C (MapDomRestrTo A B m m') m'' a). - rewrite (MapDomRestrTo_semantics A B m m' a). - rewrite (MapDomRestrTo_semantics A B m (MapDomRestrTo B C m' m'') a). - rewrite (MapDomRestrTo_semantics B C m' m'' a). - case (MapGet C m'' a); case (MapGet B m' a); trivial. - Qed. - - Lemma MapDomRestrTo_idempotent : - forall m:Map A, eqmap (MapDomRestrTo A A m m) m. - Proof. - unfold eqmap, eqm in |- *. intros. rewrite (MapDomRestrTo_semantics A A m m a). - case (MapGet A m a); trivial. - Qed. - - Lemma MapDomRestrTo_Dom : - forall (m:Map A) (m':Map B), - eqmap (MapDomRestrTo A B m m') (MapDomRestrTo A unit m (MapDom B m')). - Proof. - unfold eqmap, eqm in |- *. intros. rewrite (MapDomRestrTo_semantics A B m m' a). - rewrite (MapDomRestrTo_semantics A unit m (MapDom B m') a). - elim (sumbool_of_bool (in_FSet a (MapDom B m'))). intro H. - elim (MapDom_semantics_2 B m' a H). intros y H0. rewrite H0. unfold in_FSet, in_dom in H. - generalize H. case (MapGet unit (MapDom B m') a); trivial. intro H1. discriminate H1. - intro H. rewrite (MapDom_semantics_4 B m' a H). unfold in_FSet, in_dom in H. - generalize H. case (MapGet unit (MapDom B m') a); trivial. - intros H0 H1. discriminate H1. - Qed. - - Lemma MapDomRestrBy_empty_m_1 : - forall m:Map B, MapDomRestrBy A B (M0 A) m = M0 A. - Proof. - trivial. - Qed. - - Lemma MapDomRestrBy_empty_m : - forall m:Map B, eqmap (MapDomRestrBy A B (M0 A) m) (M0 A). - Proof. - unfold eqmap, eqm in |- *. trivial. - Qed. - - Lemma MapDomRestrBy_m_empty_1 : - forall m:Map A, MapDomRestrBy A B m (M0 B) = m. - Proof. - simple induction m; trivial. - Qed. - - Lemma MapDomRestrBy_m_empty : - forall m:Map A, eqmap (MapDomRestrBy A B m (M0 B)) m. - Proof. - unfold eqmap, eqm in |- *. intros. rewrite (MapDomRestrBy_m_empty_1 m). reflexivity. - Qed. - - Lemma MapDomRestrBy_Dom : - forall (m:Map A) (m':Map B), - eqmap (MapDomRestrBy A B m m') (MapDomRestrBy A unit m (MapDom B m')). - Proof. - unfold eqmap, eqm in |- *. intros. rewrite (MapDomRestrBy_semantics A B m m' a). - rewrite (MapDomRestrBy_semantics A unit m (MapDom B m') a). - elim (sumbool_of_bool (in_FSet a (MapDom B m'))). intro H. - elim (MapDom_semantics_2 B m' a H). intros y H0. rewrite H0. - unfold in_FSet, in_dom in H. generalize H. case (MapGet unit (MapDom B m') a); trivial. - intro H1. discriminate H1. - intro H. rewrite (MapDom_semantics_4 B m' a H). unfold in_FSet, in_dom in H. - generalize H. case (MapGet unit (MapDom B m') a); trivial. - intros H0 H1. discriminate H1. - Qed. - - Lemma MapDomRestrBy_m_m_1 : - forall m:Map A, eqmap (MapDomRestrBy A A m m) (M0 A). - Proof. - unfold eqmap, eqm in |- *. intros. rewrite (MapDomRestrBy_semantics A A m m a). - case (MapGet A m a); trivial. - Qed. - - Lemma MapDomRestrBy_By : - forall (m:Map A) (m' m'':Map B), - eqmap (MapDomRestrBy A B (MapDomRestrBy A B m m') m'') - (MapDomRestrBy A B m (MapMerge B m' m'')). - Proof. - unfold eqmap, eqm in |- *. intros. - rewrite (MapDomRestrBy_semantics A B (MapDomRestrBy A B m m') m'' a). - rewrite (MapDomRestrBy_semantics A B m m' a). - rewrite (MapDomRestrBy_semantics A B m (MapMerge B m' m'') a). - rewrite (MapMerge_semantics B m' m'' a). - case (MapGet B m'' a); case (MapGet B m' a); trivial. - Qed. - - Lemma MapDomRestrBy_By_comm : - forall (m:Map A) (m':Map B) (m'':Map C), - eqmap (MapDomRestrBy A C (MapDomRestrBy A B m m') m'') - (MapDomRestrBy A B (MapDomRestrBy A C m m'') m'). - Proof. - unfold eqmap, eqm in |- *. intros. - rewrite (MapDomRestrBy_semantics A C (MapDomRestrBy A B m m') m'' a). - rewrite (MapDomRestrBy_semantics A B m m' a). - rewrite (MapDomRestrBy_semantics A B (MapDomRestrBy A C m m'') m' a). - rewrite (MapDomRestrBy_semantics A C m m'' a). - case (MapGet C m'' a); case (MapGet B m' a); trivial. - Qed. - - Lemma MapDomRestrBy_To : - forall (m:Map A) (m':Map B) (m'':Map C), - eqmap (MapDomRestrBy A C (MapDomRestrTo A B m m') m'') - (MapDomRestrTo A B m (MapDomRestrBy B C m' m'')). - Proof. - unfold eqmap, eqm in |- *. intros. - rewrite (MapDomRestrBy_semantics A C (MapDomRestrTo A B m m') m'' a). - rewrite (MapDomRestrTo_semantics A B m m' a). - rewrite (MapDomRestrTo_semantics A B m (MapDomRestrBy B C m' m'') a). - rewrite (MapDomRestrBy_semantics B C m' m'' a). - case (MapGet C m'' a); case (MapGet B m' a); trivial. - Qed. - - Lemma MapDomRestrBy_To_comm : - forall (m:Map A) (m':Map B) (m'':Map C), - eqmap (MapDomRestrBy A C (MapDomRestrTo A B m m') m'') - (MapDomRestrTo A B (MapDomRestrBy A C m m'') m'). - Proof. - unfold eqmap, eqm in |- *. intros. - rewrite (MapDomRestrBy_semantics A C (MapDomRestrTo A B m m') m'' a). - rewrite (MapDomRestrTo_semantics A B m m' a). - rewrite (MapDomRestrTo_semantics A B (MapDomRestrBy A C m m'') m' a). - rewrite (MapDomRestrBy_semantics A C m m'' a). - case (MapGet C m'' a); case (MapGet B m' a); trivial. - Qed. - - Lemma MapDomRestrTo_By : - forall (m:Map A) (m':Map B) (m'':Map C), - eqmap (MapDomRestrTo A C (MapDomRestrBy A B m m') m'') - (MapDomRestrTo A C m (MapDomRestrBy C B m'' m')). - Proof. - unfold eqmap, eqm in |- *. intros. - rewrite (MapDomRestrTo_semantics A C (MapDomRestrBy A B m m') m'' a). - rewrite (MapDomRestrBy_semantics A B m m' a). - rewrite (MapDomRestrTo_semantics A C m (MapDomRestrBy C B m'' m') a). - rewrite (MapDomRestrBy_semantics C B m'' m' a). - case (MapGet C m'' a); case (MapGet B m' a); trivial. - Qed. - - Lemma MapDomRestrTo_By_comm : - forall (m:Map A) (m':Map B) (m'':Map C), - eqmap (MapDomRestrTo A C (MapDomRestrBy A B m m') m'') - (MapDomRestrBy A B (MapDomRestrTo A C m m'') m'). - Proof. - unfold eqmap, eqm in |- *. intros. - rewrite (MapDomRestrTo_semantics A C (MapDomRestrBy A B m m') m'' a). - rewrite (MapDomRestrBy_semantics A B m m' a). - rewrite (MapDomRestrBy_semantics A B (MapDomRestrTo A C m m'') m' a). - rewrite (MapDomRestrTo_semantics A C m m'' a). - case (MapGet C m'' a); case (MapGet B m' a); trivial. - Qed. - - Lemma MapDomRestrTo_To_comm : - forall (m:Map A) (m':Map B) (m'':Map C), - eqmap (MapDomRestrTo A C (MapDomRestrTo A B m m') m'') - (MapDomRestrTo A B (MapDomRestrTo A C m m'') m'). - Proof. - unfold eqmap, eqm in |- *. intros. - rewrite (MapDomRestrTo_semantics A C (MapDomRestrTo A B m m') m'' a). - rewrite (MapDomRestrTo_semantics A B m m' a). - rewrite (MapDomRestrTo_semantics A B (MapDomRestrTo A C m m'') m' a). - rewrite (MapDomRestrTo_semantics A C m m'' a). - case (MapGet C m'' a); case (MapGet B m' a); trivial. - Qed. - - Lemma MapMerge_DomRestrTo : - forall (m m':Map A) (m'':Map B), - eqmap (MapDomRestrTo A B (MapMerge A m m') m'') - (MapMerge A (MapDomRestrTo A B m m'') (MapDomRestrTo A B m' m'')). - Proof. - unfold eqmap, eqm in |- *. intros. - rewrite (MapDomRestrTo_semantics A B (MapMerge A m m') m'' a). - rewrite (MapMerge_semantics A m m' a). - rewrite - (MapMerge_semantics A (MapDomRestrTo A B m m'') - (MapDomRestrTo A B m' m'') a). - rewrite (MapDomRestrTo_semantics A B m' m'' a). - rewrite (MapDomRestrTo_semantics A B m m'' a). - case (MapGet B m'' a); case (MapGet A m' a); trivial. - Qed. - - Lemma MapMerge_DomRestrBy : - forall (m m':Map A) (m'':Map B), - eqmap (MapDomRestrBy A B (MapMerge A m m') m'') - (MapMerge A (MapDomRestrBy A B m m'') (MapDomRestrBy A B m' m'')). - Proof. - unfold eqmap, eqm in |- *. intros. - rewrite (MapDomRestrBy_semantics A B (MapMerge A m m') m'' a). - rewrite (MapMerge_semantics A m m' a). - rewrite - (MapMerge_semantics A (MapDomRestrBy A B m m'') - (MapDomRestrBy A B m' m'') a). - rewrite (MapDomRestrBy_semantics A B m' m'' a). - rewrite (MapDomRestrBy_semantics A B m m'' a). - case (MapGet B m'' a); case (MapGet A m' a); trivial. - Qed. - - Lemma MapDelta_empty_m_1 : forall m:Map A, MapDelta A (M0 A) m = m. - Proof. - trivial. - Qed. - - Lemma MapDelta_empty_m : forall m:Map A, eqmap (MapDelta A (M0 A) m) m. - Proof. - unfold eqmap, eqm in |- *. trivial. - Qed. - - Lemma MapDelta_m_empty_1 : forall m:Map A, MapDelta A m (M0 A) = m. - Proof. - simple induction m; trivial. - Qed. - - Lemma MapDelta_m_empty : forall m:Map A, eqmap (MapDelta A m (M0 A)) m. - Proof. - unfold eqmap, eqm in |- *. intros. rewrite MapDelta_m_empty_1. reflexivity. - Qed. - - Lemma MapDelta_nilpotent : forall m:Map A, eqmap (MapDelta A m m) (M0 A). - Proof. - unfold eqmap, eqm in |- *. intros. rewrite (MapDelta_semantics A m m a). - case (MapGet A m a); trivial. - Qed. - - Lemma MapDelta_as_Merge : - forall m m':Map A, - eqmap (MapDelta A m m') - (MapMerge A (MapDomRestrBy A A m m') (MapDomRestrBy A A m' m)). - Proof. - unfold eqmap, eqm in |- *. intros. - rewrite (MapDelta_semantics A m m' a). - rewrite - (MapMerge_semantics A (MapDomRestrBy A A m m') ( - MapDomRestrBy A A m' m) a). - rewrite (MapDomRestrBy_semantics A A m' m a). - rewrite (MapDomRestrBy_semantics A A m m' a). - case (MapGet A m a); case (MapGet A m' a); trivial. - Qed. - - Lemma MapDelta_as_DomRestrBy : - forall m m':Map A, - eqmap (MapDelta A m m') - (MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m m')). - Proof. - unfold eqmap, eqm in |- *. intros. rewrite (MapDelta_semantics A m m' a). - rewrite - (MapDomRestrBy_semantics A A (MapMerge A m m') ( - MapDomRestrTo A A m m') a). - rewrite (MapDomRestrTo_semantics A A m m' a). rewrite (MapMerge_semantics A m m' a). - case (MapGet A m a); case (MapGet A m' a); trivial. - Qed. - - Lemma MapDelta_as_DomRestrBy_2 : - forall m m':Map A, - eqmap (MapDelta A m m') - (MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m' m)). - Proof. - unfold eqmap, eqm in |- *. intros. rewrite (MapDelta_semantics A m m' a). - rewrite - (MapDomRestrBy_semantics A A (MapMerge A m m') ( - MapDomRestrTo A A m' m) a). - rewrite (MapDomRestrTo_semantics A A m' m a). rewrite (MapMerge_semantics A m m' a). - case (MapGet A m a); case (MapGet A m' a); trivial. - Qed. - - Lemma MapDelta_sym : - forall m m':Map A, eqmap (MapDelta A m m') (MapDelta A m' m). - Proof. - unfold eqmap, eqm in |- *. intros. rewrite (MapDelta_semantics A m m' a). - rewrite (MapDelta_semantics A m' m a). - case (MapGet A m a); case (MapGet A m' a); trivial. - Qed. - - Lemma MapDelta_ext : - forall m1 m2 m'1 m'2:Map A, - eqmap m1 m'1 -> - eqmap m2 m'2 -> eqmap (MapDelta A m1 m2) (MapDelta A m'1 m'2). - Proof. - unfold eqmap, eqm in |- *. intros. rewrite (MapDelta_semantics A m1 m2 a). - rewrite (MapDelta_semantics A m'1 m'2 a). rewrite (H a). rewrite (H0 a). reflexivity. - Qed. - - Lemma MapDelta_ext_l : - forall m1 m'1 m2:Map A, - eqmap m1 m'1 -> eqmap (MapDelta A m1 m2) (MapDelta A m'1 m2). - Proof. - intros. apply MapDelta_ext. assumption. - apply eqmap_refl. - Qed. - - Lemma MapDelta_ext_r : - forall m1 m2 m'2:Map A, - eqmap m2 m'2 -> eqmap (MapDelta A m1 m2) (MapDelta A m1 m'2). - Proof. - intros. apply MapDelta_ext. apply eqmap_refl. - assumption. - Qed. - - Lemma MapDom_Split_1 : - forall (m:Map A) (m':Map B), - eqmap m (MapMerge A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m')). - Proof. - unfold eqmap, eqm in |- *. intros. - rewrite - (MapMerge_semantics A (MapDomRestrTo A B m m') ( - MapDomRestrBy A B m m') a). - rewrite (MapDomRestrBy_semantics A B m m' a). - rewrite (MapDomRestrTo_semantics A B m m' a). - case (MapGet B m' a); case (MapGet A m a); trivial. - Qed. - - Lemma MapDom_Split_2 : - forall (m:Map A) (m':Map B), - eqmap m (MapMerge A (MapDomRestrBy A B m m') (MapDomRestrTo A B m m')). - Proof. - unfold eqmap, eqm in |- *. intros. - rewrite - (MapMerge_semantics A (MapDomRestrBy A B m m') ( - MapDomRestrTo A B m m') a). - rewrite (MapDomRestrBy_semantics A B m m' a). - rewrite (MapDomRestrTo_semantics A B m m' a). - case (MapGet B m' a); case (MapGet A m a); trivial. - Qed. - - Lemma MapDom_Split_3 : - forall (m:Map A) (m':Map B), - eqmap - (MapDomRestrTo A A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m')) - (M0 A). - Proof. - unfold eqmap, eqm in |- *. intros. - rewrite - (MapDomRestrTo_semantics A A (MapDomRestrTo A B m m') - (MapDomRestrBy A B m m') a). - rewrite (MapDomRestrBy_semantics A B m m' a). - rewrite (MapDomRestrTo_semantics A B m m' a). - case (MapGet B m' a); case (MapGet A m a); trivial. - Qed. - -End MapAxioms. - -Lemma MapDomRestrTo_ext : - forall (A B:Set) (m1:Map A) (m2:Map B) (m'1:Map A) - (m'2:Map B), - eqmap A m1 m'1 -> - eqmap B m2 m'2 -> - eqmap A (MapDomRestrTo A B m1 m2) (MapDomRestrTo A B m'1 m'2). -Proof. - unfold eqmap, eqm in |- *. intros. rewrite (MapDomRestrTo_semantics A B m1 m2 a). - rewrite (MapDomRestrTo_semantics A B m'1 m'2 a). rewrite (H a). rewrite (H0 a). reflexivity. -Qed. - -Lemma MapDomRestrTo_ext_l : - forall (A B:Set) (m1:Map A) (m2:Map B) (m'1:Map A), - eqmap A m1 m'1 -> - eqmap A (MapDomRestrTo A B m1 m2) (MapDomRestrTo A B m'1 m2). -Proof. - intros. apply MapDomRestrTo_ext; [ assumption | apply eqmap_refl ]. -Qed. - -Lemma MapDomRestrTo_ext_r : - forall (A B:Set) (m1:Map A) (m2 m'2:Map B), - eqmap B m2 m'2 -> - eqmap A (MapDomRestrTo A B m1 m2) (MapDomRestrTo A B m1 m'2). -Proof. - intros. apply MapDomRestrTo_ext; [ apply eqmap_refl | assumption ]. -Qed. - -Lemma MapDomRestrBy_ext : - forall (A B:Set) (m1:Map A) (m2:Map B) (m'1:Map A) - (m'2:Map B), - eqmap A m1 m'1 -> - eqmap B m2 m'2 -> - eqmap A (MapDomRestrBy A B m1 m2) (MapDomRestrBy A B m'1 m'2). -Proof. - unfold eqmap, eqm in |- *. intros. rewrite (MapDomRestrBy_semantics A B m1 m2 a). - rewrite (MapDomRestrBy_semantics A B m'1 m'2 a). rewrite (H a). rewrite (H0 a). reflexivity. -Qed. - -Lemma MapDomRestrBy_ext_l : - forall (A B:Set) (m1:Map A) (m2:Map B) (m'1:Map A), - eqmap A m1 m'1 -> - eqmap A (MapDomRestrBy A B m1 m2) (MapDomRestrBy A B m'1 m2). -Proof. - intros. apply MapDomRestrBy_ext; [ assumption | apply eqmap_refl ]. -Qed. - -Lemma MapDomRestrBy_ext_r : - forall (A B:Set) (m1:Map A) (m2 m'2:Map B), - eqmap B m2 m'2 -> - eqmap A (MapDomRestrBy A B m1 m2) (MapDomRestrBy A B m1 m'2). -Proof. - intros. apply MapDomRestrBy_ext; [ apply eqmap_refl | assumption ]. -Qed. - -Lemma MapDomRestrBy_m_m : - forall (A:Set) (m:Map A), - eqmap A (MapDomRestrBy A unit m (MapDom A m)) (M0 A). -Proof. - intros. apply eqmap_trans with (m' := MapDomRestrBy A A m m). apply eqmap_sym. - apply MapDomRestrBy_Dom. - apply MapDomRestrBy_m_m_1. -Qed. - -Lemma FSetDelta_assoc : - forall s s' s'':FSet, - eqmap unit (MapDelta _ (MapDelta _ s s') s'') - (MapDelta _ s (MapDelta _ s' s'')). -Proof. - unfold eqmap, eqm in |- *. intros. rewrite (MapDelta_semantics unit (MapDelta unit s s') s'' a). - rewrite (MapDelta_semantics unit s s' a). - rewrite (MapDelta_semantics unit s (MapDelta unit s' s'') a). - rewrite (MapDelta_semantics unit s' s'' a). - case (MapGet _ s a); case (MapGet _ s' a); case (MapGet _ s'' a); trivial. - intros. elim u. elim u1. reflexivity. -Qed. - -Lemma FSet_ext : - forall s s':FSet, - (forall a:ad, in_FSet a s = in_FSet a s') -> eqmap unit s s'. -Proof. - unfold in_FSet, eqmap, eqm in |- *. intros. elim (sumbool_of_bool (in_dom _ a s)). intro H0. - elim (in_dom_some _ s a H0). intros y H1. rewrite (H a) in H0. elim (in_dom_some _ s' a H0). - intros y' H2. rewrite H1. rewrite H2. elim y. elim y'. reflexivity. - intro H0. rewrite (in_dom_none _ s a H0). rewrite (H a) in H0. rewrite (in_dom_none _ s' a H0). - reflexivity. -Qed. - -Lemma FSetUnion_comm : - forall s s':FSet, eqmap unit (FSetUnion s s') (FSetUnion s' s). -Proof. - intros. apply FSet_ext. intro. rewrite in_FSet_union. rewrite in_FSet_union. apply orb_comm. -Qed. - -Lemma FSetUnion_assoc : - forall s s' s'':FSet, - eqmap unit (FSetUnion (FSetUnion s s') s'') - (FSetUnion s (FSetUnion s' s'')). -Proof. - exact (MapMerge_assoc unit). -Qed. - -Lemma FSetUnion_M0_s : forall s:FSet, eqmap unit (FSetUnion (M0 unit) s) s. -Proof. - exact (MapMerge_empty_m unit). -Qed. - -Lemma FSetUnion_s_M0 : forall s:FSet, eqmap unit (FSetUnion s (M0 unit)) s. -Proof. - exact (MapMerge_m_empty unit). -Qed. - -Lemma FSetUnion_idempotent : forall s:FSet, eqmap unit (FSetUnion s s) s. -Proof. - exact (MapMerge_idempotent unit). -Qed. - -Lemma FSetInter_comm : - forall s s':FSet, eqmap unit (FSetInter s s') (FSetInter s' s). -Proof. - intros. apply FSet_ext. intro. rewrite in_FSet_inter. rewrite in_FSet_inter. apply andb_comm. -Qed. - -Lemma FSetInter_assoc : - forall s s' s'':FSet, - eqmap unit (FSetInter (FSetInter s s') s'') - (FSetInter s (FSetInter s' s'')). -Proof. - exact (MapDomRestrTo_assoc unit unit unit). -Qed. - -Lemma FSetInter_M0_s : - forall s:FSet, eqmap unit (FSetInter (M0 unit) s) (M0 unit). -Proof. - exact (MapDomRestrTo_empty_m unit unit). -Qed. - -Lemma FSetInter_s_M0 : - forall s:FSet, eqmap unit (FSetInter s (M0 unit)) (M0 unit). -Proof. - exact (MapDomRestrTo_m_empty unit unit). -Qed. - -Lemma FSetInter_idempotent : forall s:FSet, eqmap unit (FSetInter s s) s. -Proof. - exact (MapDomRestrTo_idempotent unit). -Qed. - -Lemma FSetUnion_Inter_l : - forall s s' s'':FSet, - eqmap unit (FSetUnion (FSetInter s s') s'') - (FSetInter (FSetUnion s s'') (FSetUnion s' s'')). -Proof. - intros. apply FSet_ext. intro. rewrite in_FSet_union. rewrite in_FSet_inter. - rewrite in_FSet_inter. rewrite in_FSet_union. rewrite in_FSet_union. - case (in_FSet a s); case (in_FSet a s'); case (in_FSet a s''); reflexivity. -Qed. - -Lemma FSetUnion_Inter_r : - forall s s' s'':FSet, - eqmap unit (FSetUnion s (FSetInter s' s'')) - (FSetInter (FSetUnion s s') (FSetUnion s s'')). -Proof. - intros. apply FSet_ext. intro. rewrite in_FSet_union. rewrite in_FSet_inter. - rewrite in_FSet_inter. rewrite in_FSet_union. rewrite in_FSet_union. - case (in_FSet a s); case (in_FSet a s'); case (in_FSet a s''); reflexivity. -Qed. - -Lemma FSetInter_Union_l : - forall s s' s'':FSet, - eqmap unit (FSetInter (FSetUnion s s') s'') - (FSetUnion (FSetInter s s'') (FSetInter s' s'')). -Proof. - intros. apply FSet_ext. intro. rewrite in_FSet_inter. rewrite in_FSet_union. - rewrite in_FSet_union. rewrite in_FSet_inter. rewrite in_FSet_inter. - case (in_FSet a s); case (in_FSet a s'); case (in_FSet a s''); reflexivity. -Qed. - -Lemma FSetInter_Union_r : - forall s s' s'':FSet, - eqmap unit (FSetInter s (FSetUnion s' s'')) - (FSetUnion (FSetInter s s') (FSetInter s s'')). -Proof. - intros. apply FSet_ext. intro. rewrite in_FSet_inter. rewrite in_FSet_union. - rewrite in_FSet_union. rewrite in_FSet_inter. rewrite in_FSet_inter. - case (in_FSet a s); case (in_FSet a s'); case (in_FSet a s''); reflexivity. -Qed.
\ No newline at end of file diff --git a/theories/IntMap/Mapc.v b/theories/IntMap/Mapc.v deleted file mode 100644 index 163373bf..00000000 --- a/theories/IntMap/Mapc.v +++ /dev/null @@ -1,539 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) -(*i $Id: Mapc.v 8733 2006-04-25 22:52:18Z letouzey $ i*) - -Require Import Bool. -Require Import Sumbool. -Require Import Arith. -Require Import NArith. -Require Import Map. -Require Import Mapaxioms. -Require Import Fset. -Require Import Mapiter. -Require Import Mapsubset. -Require Import List. -Require Import Lsort. -Require Import Mapcard. -Require Import Mapcanon. - -Section MapC. - - Variables A B C : Set. - - Lemma MapPut_as_Merge_c : - forall m:Map A, - mapcanon A m -> - forall (a:ad) (y:A), MapPut A m a y = MapMerge A m (M1 A a y). - Proof. - intros. apply mapcanon_unique. exact (MapPut_canon A m H a y). - apply MapMerge_canon. assumption. - apply M1_canon. - apply MapPut_as_Merge. - Qed. - - Lemma MapPut_behind_as_Merge_c : - forall m:Map A, - mapcanon A m -> - forall (a:ad) (y:A), MapPut_behind A m a y = MapMerge A (M1 A a y) m. - Proof. - intros. apply mapcanon_unique. exact (MapPut_behind_canon A m H a y). - apply MapMerge_canon. apply M1_canon. - assumption. - apply MapPut_behind_as_Merge. - Qed. - - Lemma MapMerge_empty_m_c : forall m:Map A, MapMerge A (M0 A) m = m. - Proof. - trivial. - Qed. - - Lemma MapMerge_assoc_c : - forall m m' m'':Map A, - mapcanon A m -> - mapcanon A m' -> - mapcanon A m'' -> - MapMerge A (MapMerge A m m') m'' = MapMerge A m (MapMerge A m' m''). - Proof. - intros. apply mapcanon_unique. - apply MapMerge_canon; try assumption. apply MapMerge_canon; try assumption. - apply MapMerge_canon; try assumption. apply MapMerge_canon; try assumption. - apply MapMerge_assoc. - Qed. - - Lemma MapMerge_idempotent_c : - forall m:Map A, mapcanon A m -> MapMerge A m m = m. - Proof. - intros. apply mapcanon_unique. apply MapMerge_canon; assumption. - assumption. - apply MapMerge_idempotent. - Qed. - - Lemma MapMerge_RestrTo_l_c : - forall m m' m'':Map A, - mapcanon A m -> - mapcanon A m'' -> - MapMerge A (MapDomRestrTo A A m m') m'' = - MapDomRestrTo A A (MapMerge A m m'') (MapMerge A m' m''). - Proof. - intros. apply mapcanon_unique. apply MapMerge_canon. apply MapDomRestrTo_canon; assumption. - assumption. - apply MapDomRestrTo_canon; apply MapMerge_canon; assumption. - apply MapMerge_RestrTo_l. - Qed. - - Lemma MapRemove_as_RestrBy_c : - forall m:Map A, - mapcanon A m -> - forall (a:ad) (y:B), MapRemove A m a = MapDomRestrBy A B m (M1 B a y). - Proof. - intros. apply mapcanon_unique. apply MapRemove_canon; assumption. - apply MapDomRestrBy_canon; assumption. - apply MapRemove_as_RestrBy. - Qed. - - Lemma MapDomRestrTo_assoc_c : - forall (m:Map A) (m':Map B) (m'':Map C), - mapcanon A m -> - MapDomRestrTo A C (MapDomRestrTo A B m m') m'' = - MapDomRestrTo A B m (MapDomRestrTo B C m' m''). - Proof. - intros. apply mapcanon_unique. apply MapDomRestrTo_canon; try assumption. - apply MapDomRestrTo_canon; try assumption. - apply MapDomRestrTo_canon; try assumption. - apply MapDomRestrTo_assoc. - Qed. - - Lemma MapDomRestrTo_idempotent_c : - forall m:Map A, mapcanon A m -> MapDomRestrTo A A m m = m. - Proof. - intros. apply mapcanon_unique. apply MapDomRestrTo_canon; assumption. - assumption. - apply MapDomRestrTo_idempotent. - Qed. - - Lemma MapDomRestrTo_Dom_c : - forall (m:Map A) (m':Map B), - mapcanon A m -> - MapDomRestrTo A B m m' = MapDomRestrTo A unit m (MapDom B m'). - Proof. - intros. apply mapcanon_unique. apply MapDomRestrTo_canon; assumption. - apply MapDomRestrTo_canon; assumption. - apply MapDomRestrTo_Dom. - Qed. - - Lemma MapDomRestrBy_Dom_c : - forall (m:Map A) (m':Map B), - mapcanon A m -> - MapDomRestrBy A B m m' = MapDomRestrBy A unit m (MapDom B m'). - Proof. - intros. apply mapcanon_unique. apply MapDomRestrBy_canon; assumption. - apply MapDomRestrBy_canon; assumption. - apply MapDomRestrBy_Dom. - Qed. - - Lemma MapDomRestrBy_By_c : - forall (m:Map A) (m' m'':Map B), - mapcanon A m -> - MapDomRestrBy A B (MapDomRestrBy A B m m') m'' = - MapDomRestrBy A B m (MapMerge B m' m''). - Proof. - intros. apply mapcanon_unique. apply MapDomRestrBy_canon; try assumption. - apply MapDomRestrBy_canon; try assumption. - apply MapDomRestrBy_canon; try assumption. - apply MapDomRestrBy_By. - Qed. - - Lemma MapDomRestrBy_By_comm_c : - forall (m:Map A) (m':Map B) (m'':Map C), - mapcanon A m -> - MapDomRestrBy A C (MapDomRestrBy A B m m') m'' = - MapDomRestrBy A B (MapDomRestrBy A C m m'') m'. - Proof. - intros. apply mapcanon_unique. apply MapDomRestrBy_canon. - apply MapDomRestrBy_canon; assumption. - apply MapDomRestrBy_canon. apply MapDomRestrBy_canon; assumption. - apply MapDomRestrBy_By_comm. - Qed. - - Lemma MapDomRestrBy_To_c : - forall (m:Map A) (m':Map B) (m'':Map C), - mapcanon A m -> - MapDomRestrBy A C (MapDomRestrTo A B m m') m'' = - MapDomRestrTo A B m (MapDomRestrBy B C m' m''). - Proof. - intros. apply mapcanon_unique. apply MapDomRestrBy_canon. - apply MapDomRestrTo_canon; assumption. - apply MapDomRestrTo_canon; assumption. - apply MapDomRestrBy_To. - Qed. - - Lemma MapDomRestrBy_To_comm_c : - forall (m:Map A) (m':Map B) (m'':Map C), - mapcanon A m -> - MapDomRestrBy A C (MapDomRestrTo A B m m') m'' = - MapDomRestrTo A B (MapDomRestrBy A C m m'') m'. - Proof. - intros. apply mapcanon_unique. apply MapDomRestrBy_canon. - apply MapDomRestrTo_canon; assumption. - apply MapDomRestrTo_canon. apply MapDomRestrBy_canon; assumption. - apply MapDomRestrBy_To_comm. - Qed. - - Lemma MapDomRestrTo_By_c : - forall (m:Map A) (m':Map B) (m'':Map C), - mapcanon A m -> - MapDomRestrTo A C (MapDomRestrBy A B m m') m'' = - MapDomRestrTo A C m (MapDomRestrBy C B m'' m'). - Proof. - intros. apply mapcanon_unique. apply MapDomRestrTo_canon. - apply MapDomRestrBy_canon; assumption. - apply MapDomRestrTo_canon; assumption. - apply MapDomRestrTo_By. - Qed. - - Lemma MapDomRestrTo_By_comm_c : - forall (m:Map A) (m':Map B) (m'':Map C), - mapcanon A m -> - MapDomRestrTo A C (MapDomRestrBy A B m m') m'' = - MapDomRestrBy A B (MapDomRestrTo A C m m'') m'. - Proof. - intros. apply mapcanon_unique. apply MapDomRestrTo_canon. - apply MapDomRestrBy_canon; assumption. - apply MapDomRestrBy_canon. apply MapDomRestrTo_canon; assumption. - apply MapDomRestrTo_By_comm. - Qed. - - Lemma MapDomRestrTo_To_comm_c : - forall (m:Map A) (m':Map B) (m'':Map C), - mapcanon A m -> - MapDomRestrTo A C (MapDomRestrTo A B m m') m'' = - MapDomRestrTo A B (MapDomRestrTo A C m m'') m'. - Proof. - intros. apply mapcanon_unique. apply MapDomRestrTo_canon. - apply MapDomRestrTo_canon; assumption. - apply MapDomRestrTo_canon. apply MapDomRestrTo_canon; assumption. - apply MapDomRestrTo_To_comm. - Qed. - - Lemma MapMerge_DomRestrTo_c : - forall (m m':Map A) (m'':Map B), - mapcanon A m -> - mapcanon A m' -> - MapDomRestrTo A B (MapMerge A m m') m'' = - MapMerge A (MapDomRestrTo A B m m'') (MapDomRestrTo A B m' m''). - Proof. - intros. apply mapcanon_unique. apply MapDomRestrTo_canon. - apply MapMerge_canon; assumption. - apply MapMerge_canon. apply MapDomRestrTo_canon; assumption. - apply MapDomRestrTo_canon; assumption. - apply MapMerge_DomRestrTo. - Qed. - - Lemma MapMerge_DomRestrBy_c : - forall (m m':Map A) (m'':Map B), - mapcanon A m -> - mapcanon A m' -> - MapDomRestrBy A B (MapMerge A m m') m'' = - MapMerge A (MapDomRestrBy A B m m'') (MapDomRestrBy A B m' m''). - Proof. - intros. apply mapcanon_unique. apply MapDomRestrBy_canon. apply MapMerge_canon; assumption. - apply MapMerge_canon. apply MapDomRestrBy_canon; assumption. - apply MapDomRestrBy_canon; assumption. - apply MapMerge_DomRestrBy. - Qed. - - Lemma MapDelta_nilpotent_c : - forall m:Map A, mapcanon A m -> MapDelta A m m = M0 A. - Proof. - intros. apply mapcanon_unique. apply MapDelta_canon; assumption. - apply M0_canon. - apply MapDelta_nilpotent. - Qed. - - Lemma MapDelta_as_Merge_c : - forall m m':Map A, - mapcanon A m -> - mapcanon A m' -> - MapDelta A m m' = - MapMerge A (MapDomRestrBy A A m m') (MapDomRestrBy A A m' m). - Proof. - intros. apply mapcanon_unique. apply MapDelta_canon; assumption. - apply MapMerge_canon; apply MapDomRestrBy_canon; assumption. - apply MapDelta_as_Merge. - Qed. - - Lemma MapDelta_as_DomRestrBy_c : - forall m m':Map A, - mapcanon A m -> - mapcanon A m' -> - MapDelta A m m' = - MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m m'). - Proof. - intros. apply mapcanon_unique. apply MapDelta_canon; assumption. - apply MapDomRestrBy_canon. apply MapMerge_canon; assumption. - apply MapDelta_as_DomRestrBy. - Qed. - - Lemma MapDelta_as_DomRestrBy_2_c : - forall m m':Map A, - mapcanon A m -> - mapcanon A m' -> - MapDelta A m m' = - MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m' m). - Proof. - intros. apply mapcanon_unique. apply MapDelta_canon; assumption. - apply MapDomRestrBy_canon. apply MapMerge_canon; assumption. - apply MapDelta_as_DomRestrBy_2. - Qed. - - Lemma MapDelta_sym_c : - forall m m':Map A, - mapcanon A m -> mapcanon A m' -> MapDelta A m m' = MapDelta A m' m. - Proof. - intros. apply mapcanon_unique. apply MapDelta_canon; assumption. - apply MapDelta_canon; assumption. apply MapDelta_sym. - Qed. - - Lemma MapDom_Split_1_c : - forall (m:Map A) (m':Map B), - mapcanon A m -> - m = MapMerge A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m'). - Proof. - intros. apply mapcanon_unique. assumption. - apply MapMerge_canon. apply MapDomRestrTo_canon; assumption. - apply MapDomRestrBy_canon; assumption. - apply MapDom_Split_1. - Qed. - - Lemma MapDom_Split_2_c : - forall (m:Map A) (m':Map B), - mapcanon A m -> - m = MapMerge A (MapDomRestrBy A B m m') (MapDomRestrTo A B m m'). - Proof. - intros. apply mapcanon_unique. assumption. - apply MapMerge_canon. apply MapDomRestrBy_canon; assumption. - apply MapDomRestrTo_canon; assumption. - apply MapDom_Split_2. - Qed. - - Lemma MapDom_Split_3_c : - forall (m:Map A) (m':Map B), - mapcanon A m -> - MapDomRestrTo A A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m') = - M0 A. - Proof. - intros. apply mapcanon_unique. apply MapDomRestrTo_canon. - apply MapDomRestrTo_canon; assumption. - apply M0_canon. - apply MapDom_Split_3. - Qed. - - Lemma Map_of_alist_of_Map_c : - forall m:Map A, mapcanon A m -> Map_of_alist A (alist_of_Map A m) = m. - Proof. - intros. apply mapcanon_unique; try assumption. apply Map_of_alist_canon. - apply Map_of_alist_of_Map. - Qed. - - Lemma alist_of_Map_of_alist_c : - forall l:alist A, - alist_sorted_2 A l -> alist_of_Map A (Map_of_alist A l) = l. - Proof. - intros. apply alist_canonical. apply alist_of_Map_of_alist. - apply alist_of_Map_sorts2. - assumption. - Qed. - - Lemma MapSubset_antisym_c : - forall (m:Map A) (m':Map B), - mapcanon A m -> - mapcanon B m' -> - MapSubset A B m m' -> MapSubset B A m' m -> MapDom A m = MapDom B m'. - Proof. - intros. apply (mapcanon_unique unit). apply MapDom_canon; assumption. - apply MapDom_canon; assumption. - apply MapSubset_antisym; assumption. - Qed. - - Lemma FSubset_antisym_c : - forall s s':FSet, - mapcanon unit s -> - mapcanon unit s' -> MapSubset _ _ s s' -> MapSubset _ _ s' s -> s = s'. - Proof. - intros. apply (mapcanon_unique unit); try assumption. apply FSubset_antisym; assumption. - Qed. - - Lemma MapDisjoint_empty_c : - forall m:Map A, mapcanon A m -> MapDisjoint A A m m -> m = M0 A. - Proof. - intros. apply mapcanon_unique; try assumption; try apply M0_canon. - apply MapDisjoint_empty; assumption. - Qed. - - Lemma MapDelta_disjoint_c : - forall m m':Map A, - mapcanon A m -> - mapcanon A m' -> - MapDisjoint A A m m' -> MapDelta A m m' = MapMerge A m m'. - Proof. - intros. apply mapcanon_unique. apply MapDelta_canon; assumption. - apply MapMerge_canon; assumption. apply MapDelta_disjoint; assumption. - Qed. - -End MapC. - -Lemma FSetDelta_assoc_c : - forall s s' s'':FSet, - mapcanon unit s -> - mapcanon unit s' -> - mapcanon unit s'' -> - MapDelta _ (MapDelta _ s s') s'' = MapDelta _ s (MapDelta _ s' s''). -Proof. - intros. apply (mapcanon_unique unit). apply MapDelta_canon. apply MapDelta_canon; assumption. - assumption. - apply MapDelta_canon. assumption. - apply MapDelta_canon; assumption. - apply FSetDelta_assoc; assumption. -Qed. - -Lemma FSet_ext_c : - forall s s':FSet, - mapcanon unit s -> - mapcanon unit s' -> (forall a:ad, in_FSet a s = in_FSet a s') -> s = s'. -Proof. - intros. apply (mapcanon_unique unit); try assumption. apply FSet_ext. assumption. -Qed. - -Lemma FSetUnion_comm_c : - forall s s':FSet, - mapcanon unit s -> mapcanon unit s' -> FSetUnion s s' = FSetUnion s' s. -Proof. - intros. - apply (mapcanon_unique unit); - try (unfold FSetUnion in |- *; apply MapMerge_canon; assumption). - apply FSetUnion_comm. -Qed. - -Lemma FSetUnion_assoc_c : - forall s s' s'':FSet, - mapcanon unit s -> - mapcanon unit s' -> - mapcanon unit s'' -> - FSetUnion (FSetUnion s s') s'' = FSetUnion s (FSetUnion s' s''). -Proof. - exact (MapMerge_assoc_c unit). -Qed. - -Lemma FSetUnion_M0_s_c : forall s:FSet, FSetUnion (M0 unit) s = s. -Proof. - exact (MapMerge_empty_m_c unit). -Qed. - -Lemma FSetUnion_s_M0_c : forall s:FSet, FSetUnion s (M0 unit) = s. -Proof. - exact (MapMerge_m_empty_1 unit). -Qed. - -Lemma FSetUnion_idempotent : - forall s:FSet, mapcanon unit s -> FSetUnion s s = s. -Proof. - exact (MapMerge_idempotent_c unit). -Qed. - -Lemma FSetInter_comm_c : - forall s s':FSet, - mapcanon unit s -> mapcanon unit s' -> FSetInter s s' = FSetInter s' s. -Proof. - intros. - apply (mapcanon_unique unit); - try (unfold FSetInter in |- *; apply MapDomRestrTo_canon; assumption). - apply FSetInter_comm. -Qed. - -Lemma FSetInter_assoc_c : - forall s s' s'':FSet, - mapcanon unit s -> - FSetInter (FSetInter s s') s'' = FSetInter s (FSetInter s' s''). -Proof. - exact (MapDomRestrTo_assoc_c unit unit unit). -Qed. - -Lemma FSetInter_M0_s_c : forall s:FSet, FSetInter (M0 unit) s = M0 unit. -Proof. - trivial. -Qed. - -Lemma FSetInter_s_M0_c : forall s:FSet, FSetInter s (M0 unit) = M0 unit. -Proof. - exact (MapDomRestrTo_m_empty_1 unit unit). -Qed. - -Lemma FSetInter_idempotent : - forall s:FSet, mapcanon unit s -> FSetInter s s = s. -Proof. - exact (MapDomRestrTo_idempotent_c unit). -Qed. - -Lemma FSetUnion_Inter_l_c : - forall s s' s'':FSet, - mapcanon unit s -> - mapcanon unit s'' -> - FSetUnion (FSetInter s s') s'' = - FSetInter (FSetUnion s s'') (FSetUnion s' s''). -Proof. - intros. apply (mapcanon_unique unit). unfold FSetUnion in |- *. apply MapMerge_canon; try assumption. - unfold FSetInter in |- *. apply MapDomRestrTo_canon; assumption. - unfold FSetInter in |- *; unfold FSetUnion in |- *; - apply MapDomRestrTo_canon; apply MapMerge_canon; - assumption. - apply FSetUnion_Inter_l. -Qed. - -Lemma FSetUnion_Inter_r : - forall s s' s'':FSet, - mapcanon unit s -> - mapcanon unit s' -> - FSetUnion s (FSetInter s' s'') = - FSetInter (FSetUnion s s') (FSetUnion s s''). -Proof. - intros. apply (mapcanon_unique unit). unfold FSetUnion in |- *. apply MapMerge_canon; try assumption. - unfold FSetInter in |- *. apply MapDomRestrTo_canon; assumption. - unfold FSetInter in |- *; unfold FSetUnion in |- *; - apply MapDomRestrTo_canon; apply MapMerge_canon; - assumption. - apply FSetUnion_Inter_r. -Qed. - -Lemma FSetInter_Union_l_c : - forall s s' s'':FSet, - mapcanon unit s -> - mapcanon unit s' -> - FSetInter (FSetUnion s s') s'' = - FSetUnion (FSetInter s s'') (FSetInter s' s''). -Proof. - intros. apply (mapcanon_unique unit). unfold FSetInter in |- *. - apply MapDomRestrTo_canon; try assumption. unfold FSetUnion in |- *. - apply MapMerge_canon; assumption. - unfold FSetUnion in |- *; unfold FSetInter in |- *; apply MapMerge_canon; - apply MapDomRestrTo_canon; assumption. - apply FSetInter_Union_l. -Qed. - -Lemma FSetInter_Union_r : - forall s s' s'':FSet, - mapcanon unit s -> - mapcanon unit s' -> - FSetInter s (FSetUnion s' s'') = - FSetUnion (FSetInter s s') (FSetInter s s''). -Proof. - intros. apply (mapcanon_unique unit). unfold FSetInter in |- *. - apply MapDomRestrTo_canon; try assumption. - unfold FSetUnion in |- *. apply MapMerge_canon; unfold FSetInter in |- *; apply MapDomRestrTo_canon; - assumption. - apply FSetInter_Union_r. -Qed.
\ No newline at end of file diff --git a/theories/IntMap/Mapcanon.v b/theories/IntMap/Mapcanon.v deleted file mode 100644 index 33741b98..00000000 --- a/theories/IntMap/Mapcanon.v +++ /dev/null @@ -1,401 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) -(*i $Id: Mapcanon.v 8733 2006-04-25 22:52:18Z letouzey $ i*) - -Require Import Bool. -Require Import Sumbool. -Require Import Arith. -Require Import NArith. -Require Import Ndigits. -Require Import Ndec. -Require Import Map. -Require Import Mapaxioms. -Require Import Mapiter. -Require Import Fset. -Require Import List. -Require Import Lsort. -Require Import Mapsubset. -Require Import Mapcard. - -Section MapCanon. - - Variable A : Set. - - Inductive mapcanon : Map A -> Prop := - | M0_canon : mapcanon (M0 A) - | M1_canon : forall (a:ad) (y:A), mapcanon (M1 A a y) - | M2_canon : - forall m1 m2:Map A, - mapcanon m1 -> - mapcanon m2 -> 2 <= MapCard A (M2 A m1 m2) -> mapcanon (M2 A m1 m2). - - Lemma mapcanon_M2 : - forall m1 m2:Map A, mapcanon (M2 A m1 m2) -> 2 <= MapCard A (M2 A m1 m2). - Proof. - intros. inversion H. assumption. - Qed. - - Lemma mapcanon_M2_1 : - forall m1 m2:Map A, mapcanon (M2 A m1 m2) -> mapcanon m1. - Proof. - intros. inversion H. assumption. - Qed. - - Lemma mapcanon_M2_2 : - forall m1 m2:Map A, mapcanon (M2 A m1 m2) -> mapcanon m2. - Proof. - intros. inversion H. assumption. - Qed. - - Lemma M2_eqmap_1 : - forall m0 m1 m2 m3:Map A, - eqmap A (M2 A m0 m1) (M2 A m2 m3) -> eqmap A m0 m2. - Proof. - unfold eqmap, eqm in |- *. intros. rewrite <- (Ndouble_div2 a). - rewrite <- (MapGet_M2_bit_0_0 A _ (Ndouble_bit0 a) m0 m1). - rewrite <- (MapGet_M2_bit_0_0 A _ (Ndouble_bit0 a) m2 m3). - exact (H (Ndouble a)). - Qed. - - Lemma M2_eqmap_2 : - forall m0 m1 m2 m3:Map A, - eqmap A (M2 A m0 m1) (M2 A m2 m3) -> eqmap A m1 m3. - Proof. - unfold eqmap, eqm in |- *. intros. rewrite <- (Ndouble_plus_one_div2 a). - rewrite <- (MapGet_M2_bit_0_1 A _ (Ndouble_plus_one_bit0 a) m0 m1). - rewrite <- (MapGet_M2_bit_0_1 A _ (Ndouble_plus_one_bit0 a) m2 m3). - exact (H (Ndouble_plus_one a)). - Qed. - - Lemma mapcanon_unique : - forall m m':Map A, mapcanon m -> mapcanon m' -> eqmap A m m' -> m = m'. - Proof. - simple induction m. simple induction m'. trivial. - intros a y H H0 H1. cut (None = MapGet A (M1 A a y) a). simpl in |- *. rewrite (Neqb_correct a). - intro. discriminate H2. - exact (H1 a). - intros. cut (2 <= MapCard A (M0 A)). intro. elim (le_Sn_O _ H4). - rewrite (MapCard_ext A _ _ H3). exact (mapcanon_M2 _ _ H2). - intros a y. simple induction m'. intros. cut (MapGet A (M1 A a y) a = None). simpl in |- *. - rewrite (Neqb_correct a). intro. discriminate H2. - exact (H1 a). - intros a0 y0 H H0 H1. cut (MapGet A (M1 A a y) a = MapGet A (M1 A a0 y0) a). simpl in |- *. - rewrite (Neqb_correct a). intro. elim (sumbool_of_bool (Neqb a0 a)). intro H3. - rewrite H3 in H2. inversion H2. rewrite (Neqb_complete _ _ H3). reflexivity. - intro H3. rewrite H3 in H2. discriminate H2. - exact (H1 a). - intros. cut (2 <= MapCard A (M1 A a y)). intro. elim (le_Sn_O _ (le_S_n _ _ H4)). - rewrite (MapCard_ext A _ _ H3). exact (mapcanon_M2 _ _ H2). - simple induction m'. intros. cut (2 <= MapCard A (M0 A)). intro. elim (le_Sn_O _ H4). - rewrite <- (MapCard_ext A _ _ H3). exact (mapcanon_M2 _ _ H1). - intros a y H1 H2 H3. cut (2 <= MapCard A (M1 A a y)). intro. - elim (le_Sn_O _ (le_S_n _ _ H4)). - rewrite <- (MapCard_ext A _ _ H3). exact (mapcanon_M2 _ _ H1). - intros. rewrite (H m2). rewrite (H0 m3). reflexivity. - exact (mapcanon_M2_2 _ _ H3). - exact (mapcanon_M2_2 _ _ H4). - exact (M2_eqmap_2 _ _ _ _ H5). - exact (mapcanon_M2_1 _ _ H3). - exact (mapcanon_M2_1 _ _ H4). - exact (M2_eqmap_1 _ _ _ _ H5). - Qed. - - Lemma MapPut1_canon : - forall (p:positive) (a a':ad) (y y':A), mapcanon (MapPut1 A a y a' y' p). - Proof. - simple induction p. simpl in |- *. intros. case (Nbit0 a). apply M2_canon. apply M1_canon. - apply M1_canon. - apply le_n. - apply M2_canon. apply M1_canon. - apply M1_canon. - apply le_n. - simpl in |- *. intros. case (Nbit0 a). apply M2_canon. apply M0_canon. - apply H. - simpl in |- *. rewrite MapCard_Put1_equals_2. apply le_n. - apply M2_canon. apply H. - apply M0_canon. - simpl in |- *. rewrite MapCard_Put1_equals_2. apply le_n. - simpl in |- *. simpl in |- *. intros. case (Nbit0 a). apply M2_canon. apply M1_canon. - apply M1_canon. - simpl in |- *. apply le_n. - apply M2_canon. apply M1_canon. - apply M1_canon. - simpl in |- *. apply le_n. - Qed. - - Lemma MapPut_canon : - forall m:Map A, - mapcanon m -> forall (a:ad) (y:A), mapcanon (MapPut A m a y). - Proof. - simple induction m. intros. simpl in |- *. apply M1_canon. - intros a0 y0 H a y. simpl in |- *. case (Nxor a0 a). apply M1_canon. - intro. apply MapPut1_canon. - intros. simpl in |- *. elim a. apply M2_canon. apply H. exact (mapcanon_M2_1 m0 m1 H1). - exact (mapcanon_M2_2 m0 m1 H1). - simpl in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1). exact (mapcanon_M2 _ _ H1). - apply plus_le_compat. exact (MapCard_Put_lb A m0 N0 y). - apply le_n. - intro. case p. intro. apply M2_canon. exact (mapcanon_M2_1 m0 m1 H1). - apply H0. exact (mapcanon_M2_2 m0 m1 H1). - simpl in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1). - exact (mapcanon_M2 m0 m1 H1). - apply plus_le_compat_l. exact (MapCard_Put_lb A m1 (Npos p0) y). - intro. apply M2_canon. apply H. exact (mapcanon_M2_1 m0 m1 H1). - exact (mapcanon_M2_2 m0 m1 H1). - simpl in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1). - exact (mapcanon_M2 m0 m1 H1). - apply plus_le_compat_r. exact (MapCard_Put_lb A m0 (Npos p0) y). - apply M2_canon. apply (mapcanon_M2_1 m0 m1 H1). - apply H0. apply (mapcanon_M2_2 m0 m1 H1). - simpl in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1). - exact (mapcanon_M2 m0 m1 H1). - apply plus_le_compat_l. exact (MapCard_Put_lb A m1 N0 y). - Qed. - - Lemma MapPut_behind_canon : - forall m:Map A, - mapcanon m -> forall (a:ad) (y:A), mapcanon (MapPut_behind A m a y). - Proof. - simple induction m. intros. simpl in |- *. apply M1_canon. - intros a0 y0 H a y. simpl in |- *. case (Nxor a0 a). apply M1_canon. - intro. apply MapPut1_canon. - intros. simpl in |- *. elim a. apply M2_canon. apply H. exact (mapcanon_M2_1 m0 m1 H1). - exact (mapcanon_M2_2 m0 m1 H1). - simpl in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1). exact (mapcanon_M2 _ _ H1). - apply plus_le_compat. rewrite MapCard_Put_behind_Put. exact (MapCard_Put_lb A m0 N0 y). - apply le_n. - intro. case p. intro. apply M2_canon. exact (mapcanon_M2_1 m0 m1 H1). - apply H0. exact (mapcanon_M2_2 m0 m1 H1). - simpl in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1). - exact (mapcanon_M2 m0 m1 H1). - apply plus_le_compat_l. rewrite MapCard_Put_behind_Put. exact (MapCard_Put_lb A m1 (Npos p0) y). - intro. apply M2_canon. apply H. exact (mapcanon_M2_1 m0 m1 H1). - exact (mapcanon_M2_2 m0 m1 H1). - simpl in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1). - exact (mapcanon_M2 m0 m1 H1). - apply plus_le_compat_r. rewrite MapCard_Put_behind_Put. exact (MapCard_Put_lb A m0 (Npos p0) y). - apply M2_canon. apply (mapcanon_M2_1 m0 m1 H1). - apply H0. apply (mapcanon_M2_2 m0 m1 H1). - simpl in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1). - exact (mapcanon_M2 m0 m1 H1). - apply plus_le_compat_l. rewrite MapCard_Put_behind_Put. exact (MapCard_Put_lb A m1 N0 y). - Qed. - - Lemma makeM2_canon : - forall m m':Map A, mapcanon m -> mapcanon m' -> mapcanon (makeM2 A m m'). - Proof. - intro. case m. intro. case m'. intros. exact M0_canon. - intros a y H H0. exact (M1_canon (Ndouble_plus_one a) y). - intros. simpl in |- *. apply M2_canon; try assumption. exact (mapcanon_M2 m0 m1 H0). - intros a y m'. case m'. intros. exact (M1_canon (Ndouble a) y). - intros a0 y0 H H0. simpl in |- *. apply M2_canon; try assumption. apply le_n. - intros. simpl in |- *. apply M2_canon; try assumption. - apply le_trans with (m := MapCard A (M2 A m0 m1)). exact (mapcanon_M2 _ _ H0). - exact (le_plus_r (MapCard A (M1 A a y)) (MapCard A (M2 A m0 m1))). - simpl in |- *. intros. apply M2_canon; try assumption. - apply le_trans with (m := MapCard A (M2 A m0 m1)). exact (mapcanon_M2 _ _ H). - exact (le_plus_l (MapCard A (M2 A m0 m1)) (MapCard A m')). - Qed. - - Fixpoint MapCanonicalize (m:Map A) : Map A := - match m with - | M2 m0 m1 => makeM2 A (MapCanonicalize m0) (MapCanonicalize m1) - | _ => m - end. - - Lemma mapcanon_exists_1 : forall m:Map A, eqmap A m (MapCanonicalize m). - Proof. - simple induction m. apply eqmap_refl. - intros. apply eqmap_refl. - intros. simpl in |- *. unfold eqmap, eqm in |- *. intro. - rewrite (makeM2_M2 A (MapCanonicalize m0) (MapCanonicalize m1) a). - rewrite MapGet_M2_bit_0_if. rewrite MapGet_M2_bit_0_if. - rewrite <- (H (Ndiv2 a)). rewrite <- (H0 (Ndiv2 a)). reflexivity. - Qed. - - Lemma mapcanon_exists_2 : forall m:Map A, mapcanon (MapCanonicalize m). - Proof. - simple induction m. apply M0_canon. - intros. simpl in |- *. apply M1_canon. - intros. simpl in |- *. apply makeM2_canon; assumption. - Qed. - - Lemma mapcanon_exists : - forall m:Map A, {m' : Map A | eqmap A m m' /\ mapcanon m'}. - Proof. - intro. split with (MapCanonicalize m). split. apply mapcanon_exists_1. - apply mapcanon_exists_2. - Qed. - - Lemma MapRemove_canon : - forall m:Map A, mapcanon m -> forall a:ad, mapcanon (MapRemove A m a). - Proof. - simple induction m. intros. exact M0_canon. - intros a y H a0. simpl in |- *. case (Neqb a a0). exact M0_canon. - assumption. - intros. simpl in |- *. case (Nbit0 a). apply makeM2_canon. exact (mapcanon_M2_1 _ _ H1). - apply H0. exact (mapcanon_M2_2 _ _ H1). - apply makeM2_canon. apply H. exact (mapcanon_M2_1 _ _ H1). - exact (mapcanon_M2_2 _ _ H1). - Qed. - - Lemma MapMerge_canon : - forall m m':Map A, mapcanon m -> mapcanon m' -> mapcanon (MapMerge A m m'). - Proof. - simple induction m. intros. exact H0. - simpl in |- *. intros a y m' H H0. exact (MapPut_behind_canon m' H0 a y). - simple induction m'. intros. exact H1. - intros a y H1 H2. unfold MapMerge in |- *. exact (MapPut_canon _ H1 a y). - intros. simpl in |- *. apply M2_canon. apply H. exact (mapcanon_M2_1 _ _ H3). - exact (mapcanon_M2_1 _ _ H4). - apply H0. exact (mapcanon_M2_2 _ _ H3). - exact (mapcanon_M2_2 _ _ H4). - change (2 <= MapCard A (MapMerge A (M2 A m0 m1) (M2 A m2 m3))) in |- *. - apply le_trans with (m := MapCard A (M2 A m0 m1)). exact (mapcanon_M2 _ _ H3). - exact (MapMerge_Card_lb_l A (M2 A m0 m1) (M2 A m2 m3)). - Qed. - - Lemma MapDelta_canon : - forall m m':Map A, mapcanon m -> mapcanon m' -> mapcanon (MapDelta A m m'). - Proof. - simple induction m. intros. exact H0. - simpl in |- *. intros a y m' H H0. case (MapGet A m' a). - intro. exact (MapRemove_canon m' H0 a). - exact (MapPut_canon m' H0 a y). - simple induction m'. intros. exact H1. - unfold MapDelta in |- *. intros a y H1 H2. case (MapGet A (M2 A m0 m1) a). - intro. exact (MapRemove_canon _ H1 a). - exact (MapPut_canon _ H1 a y). - intros. simpl in |- *. apply makeM2_canon. apply H. exact (mapcanon_M2_1 _ _ H3). - exact (mapcanon_M2_1 _ _ H4). - apply H0. exact (mapcanon_M2_2 _ _ H3). - exact (mapcanon_M2_2 _ _ H4). - Qed. - - Variable B : Set. - - Lemma MapDomRestrTo_canon : - forall m:Map A, - mapcanon m -> forall m':Map B, mapcanon (MapDomRestrTo A B m m'). - Proof. - simple induction m. intros. exact M0_canon. - simpl in |- *. intros a y H m'. case (MapGet B m' a). - intro. apply M1_canon. - exact M0_canon. - simple induction m'. exact M0_canon. - unfold MapDomRestrTo in |- *. intros a y. case (MapGet A (M2 A m0 m1) a). - intro. apply M1_canon. - exact M0_canon. - intros. simpl in |- *. apply makeM2_canon. apply H. exact (mapcanon_M2_1 m0 m1 H1). - apply H0. exact (mapcanon_M2_2 m0 m1 H1). - Qed. - - Lemma MapDomRestrBy_canon : - forall m:Map A, - mapcanon m -> forall m':Map B, mapcanon (MapDomRestrBy A B m m'). - Proof. - simple induction m. intros. exact M0_canon. - simpl in |- *. intros a y H m'. case (MapGet B m' a); try assumption. - intro. exact M0_canon. - simple induction m'. exact H1. - intros a y. simpl in |- *. case (Nbit0 a). apply makeM2_canon. exact (mapcanon_M2_1 _ _ H1). - apply MapRemove_canon. exact (mapcanon_M2_2 _ _ H1). - apply makeM2_canon. apply MapRemove_canon. exact (mapcanon_M2_1 _ _ H1). - exact (mapcanon_M2_2 _ _ H1). - intros. simpl in |- *. apply makeM2_canon. apply H. exact (mapcanon_M2_1 _ _ H1). - apply H0. exact (mapcanon_M2_2 _ _ H1). - Qed. - - Lemma Map_of_alist_canon : forall l:alist A, mapcanon (Map_of_alist A l). - Proof. - simple induction l. exact M0_canon. - intro r. elim r. intros a y l0 H. simpl in |- *. apply MapPut_canon. assumption. - Qed. - - Lemma MapSubset_c_1 : - forall (m:Map A) (m':Map B), - mapcanon m -> MapSubset A B m m' -> MapDomRestrBy A B m m' = M0 A. - Proof. - intros. apply mapcanon_unique. apply MapDomRestrBy_canon. assumption. - apply M0_canon. - exact (MapSubset_imp_2 _ _ m m' H0). - Qed. - - Lemma MapSubset_c_2 : - forall (m:Map A) (m':Map B), - MapDomRestrBy A B m m' = M0 A -> MapSubset A B m m'. - Proof. - intros. apply MapSubset_2_imp. unfold MapSubset_2 in |- *. rewrite H. apply eqmap_refl. - Qed. - -End MapCanon. - -Section FSetCanon. - - Variable A : Set. - - Lemma MapDom_canon : - forall m:Map A, mapcanon A m -> mapcanon unit (MapDom A m). - Proof. - simple induction m. intro. exact (M0_canon unit). - intros a y H. exact (M1_canon unit a _). - intros. simpl in |- *. apply M2_canon. apply H. exact (mapcanon_M2_1 A _ _ H1). - apply H0. exact (mapcanon_M2_2 A _ _ H1). - change (2 <= MapCard unit (MapDom A (M2 A m0 m1))) in |- *. rewrite <- MapCard_Dom. - exact (mapcanon_M2 A _ _ H1). - Qed. - -End FSetCanon. - -Section MapFoldCanon. - - Variables A B : Set. - - Lemma MapFold_canon_1 : - forall m0:Map B, - mapcanon B m0 -> - forall op:Map B -> Map B -> Map B, - (forall m1:Map B, - mapcanon B m1 -> - forall m2:Map B, mapcanon B m2 -> mapcanon B (op m1 m2)) -> - forall f:ad -> A -> Map B, - (forall (a:ad) (y:A), mapcanon B (f a y)) -> - forall (m:Map A) (pf:ad -> ad), - mapcanon B (MapFold1 A (Map B) m0 op f pf m). - Proof. - simple induction m. intro. exact H. - intros a y pf. simpl in |- *. apply H1. - intros. simpl in |- *. apply H0. apply H2. - apply H3. - Qed. - - Lemma MapFold_canon : - forall m0:Map B, - mapcanon B m0 -> - forall op:Map B -> Map B -> Map B, - (forall m1:Map B, - mapcanon B m1 -> - forall m2:Map B, mapcanon B m2 -> mapcanon B (op m1 m2)) -> - forall f:ad -> A -> Map B, - (forall (a:ad) (y:A), mapcanon B (f a y)) -> - forall m:Map A, mapcanon B (MapFold A (Map B) m0 op f m). - Proof. - intros. exact (MapFold_canon_1 m0 H op H0 f H1 m (fun a:ad => a)). - Qed. - - Lemma MapCollect_canon : - forall f:ad -> A -> Map B, - (forall (a:ad) (y:A), mapcanon B (f a y)) -> - forall m:Map A, mapcanon B (MapCollect A B f m). - Proof. - intros. rewrite MapCollect_as_Fold. apply MapFold_canon. apply M0_canon. - intros. exact (MapMerge_canon B m1 m2 H0 H1). - assumption. - Qed. - -End MapFoldCanon.
\ No newline at end of file diff --git a/theories/IntMap/Mapcard.v b/theories/IntMap/Mapcard.v deleted file mode 100644 index 36be9bf9..00000000 --- a/theories/IntMap/Mapcard.v +++ /dev/null @@ -1,764 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) -(*i $Id: Mapcard.v 8733 2006-04-25 22:52:18Z letouzey $ i*) - -Require Import Bool. -Require Import Sumbool. -Require Import Arith. -Require Import NArith. -Require Import Ndigits. -Require Import Ndec. -Require Import Map. -Require Import Mapaxioms. -Require Import Mapiter. -Require Import Fset. -Require Import Mapsubset. -Require Import List. -Require Import Lsort. -Require Import Peano_dec. - -Section MapCard. - - Variables A B : Set. - - Lemma MapCard_M0 : MapCard A (M0 A) = 0. - Proof. - trivial. - Qed. - - Lemma MapCard_M1 : forall (a:ad) (y:A), MapCard A (M1 A a y) = 1. - Proof. - trivial. - Qed. - - Lemma MapCard_is_O : - forall m:Map A, MapCard A m = 0 -> forall a:ad, MapGet A m a = None. - Proof. - simple induction m. trivial. - intros a y H. discriminate H. - intros. simpl in H1. elim (plus_is_O _ _ H1). intros. rewrite (MapGet_M2_bit_0_if A m0 m1 a). - case (Nbit0 a). apply H0. assumption. - apply H. assumption. - Qed. - - Lemma MapCard_is_not_O : - forall (m:Map A) (a:ad) (y:A), - MapGet A m a = Some y -> {n : nat | MapCard A m = S n}. - Proof. - simple induction m. intros. discriminate H. - intros a y a0 y0 H. simpl in H. elim (sumbool_of_bool (Neqb a a0)). intro H0. split with 0. - reflexivity. - intro H0. rewrite H0 in H. discriminate H. - intros. elim (sumbool_of_bool (Nbit0 a)). intro H2. - rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1) in H1. elim (H0 (Ndiv2 a) y H1). intros n H3. - simpl in |- *. rewrite H3. split with (MapCard A m0 + n). - rewrite <- (plus_Snm_nSm (MapCard A m0) n). reflexivity. - intro H2. rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1) in H1. elim (H (Ndiv2 a) y H1). - intros n H3. simpl in |- *. rewrite H3. split with (n + MapCard A m1). reflexivity. - Qed. - - Lemma MapCard_is_one : - forall m:Map A, - MapCard A m = 1 -> {a : ad & {y : A | MapGet A m a = Some y}}. - Proof. - simple induction m. intro. discriminate H. - intros a y H. split with a. split with y. apply M1_semantics_1. - intros. simpl in H1. elim (plus_is_one (MapCard A m0) (MapCard A m1) H1). - intro H2. elim H2. intros. elim (H0 H4). intros a H5. split with (Ndouble_plus_one a). - rewrite (MapGet_M2_bit_0_1 A _ (Ndouble_plus_one_bit0 a) m0 m1). - rewrite Ndouble_plus_one_div2. exact H5. - intro H2. elim H2. intros. elim (H H3). intros a H5. split with (Ndouble a). - rewrite (MapGet_M2_bit_0_0 A _ (Ndouble_bit0 a) m0 m1). - rewrite Ndouble_div2. exact H5. - Qed. - - Lemma MapCard_is_one_unique : - forall m:Map A, - MapCard A m = 1 -> - forall (a a':ad) (y y':A), - MapGet A m a = Some y -> - MapGet A m a' = Some y' -> a = a' /\ y = y'. - Proof. - simple induction m. intro. discriminate H. - intros. elim (sumbool_of_bool (Neqb a a1)). intro H2. rewrite (Neqb_complete _ _ H2) in H0. - rewrite (M1_semantics_1 A a1 a0) in H0. inversion H0. elim (sumbool_of_bool (Neqb a a')). - intro H5. rewrite (Neqb_complete _ _ H5) in H1. rewrite (M1_semantics_1 A a' a0) in H1. - inversion H1. rewrite <- (Neqb_complete _ _ H2). rewrite <- (Neqb_complete _ _ H5). - rewrite <- H4. rewrite <- H6. split; reflexivity. - intro H5. rewrite (M1_semantics_2 A a a' a0 H5) in H1. discriminate H1. - intro H2. rewrite (M1_semantics_2 A a a1 a0 H2) in H0. discriminate H0. - intros. simpl in H1. elim (plus_is_one _ _ H1). intro H4. elim H4. intros. - rewrite (MapGet_M2_bit_0_if A m0 m1 a) in H2. elim (sumbool_of_bool (Nbit0 a)). - intro H7. rewrite H7 in H2. rewrite (MapGet_M2_bit_0_if A m0 m1 a') in H3. - elim (sumbool_of_bool (Nbit0 a')). intro H8. rewrite H8 in H3. elim (H0 H6 _ _ _ _ H2 H3). - intros. split. rewrite <- (Ndiv2_double_plus_one a H7). - rewrite <- (Ndiv2_double_plus_one a' H8). rewrite H9. reflexivity. - assumption. - intro H8. rewrite H8 in H3. rewrite (MapCard_is_O m0 H5 (Ndiv2 a')) in H3. - discriminate H3. - intro H7. rewrite H7 in H2. rewrite (MapCard_is_O m0 H5 (Ndiv2 a)) in H2. - discriminate H2. - intro H4. elim H4. intros. rewrite (MapGet_M2_bit_0_if A m0 m1 a) in H2. - elim (sumbool_of_bool (Nbit0 a)). intro H7. rewrite H7 in H2. - rewrite (MapCard_is_O m1 H6 (Ndiv2 a)) in H2. discriminate H2. - intro H7. rewrite H7 in H2. rewrite (MapGet_M2_bit_0_if A m0 m1 a') in H3. - elim (sumbool_of_bool (Nbit0 a')). intro H8. rewrite H8 in H3. - rewrite (MapCard_is_O m1 H6 (Ndiv2 a')) in H3. discriminate H3. - intro H8. rewrite H8 in H3. elim (H H5 _ _ _ _ H2 H3). intros. split. - rewrite <- (Ndiv2_double a H7). rewrite <- (Ndiv2_double a' H8). - rewrite H9. reflexivity. - assumption. - Qed. - - Lemma length_as_fold : - forall (C:Set) (l:list C), - length l = fold_right (fun (_:C) (n:nat) => S n) 0 l. - Proof. - simple induction l. reflexivity. - intros. simpl in |- *. rewrite H. reflexivity. - Qed. - - Lemma length_as_fold_2 : - forall l:alist A, - length l = - fold_right (fun (r:ad * A) (n:nat) => let (a, y) := r in 1 + n) 0 l. - Proof. - simple induction l. reflexivity. - intros. simpl in |- *. rewrite H. elim a; reflexivity. - Qed. - - Lemma MapCard_as_Fold_1 : - forall (m:Map A) (pf:ad -> ad), - MapCard A m = MapFold1 A nat 0 plus (fun (_:ad) (_:A) => 1) pf m. - Proof. - simple induction m. trivial. - trivial. - intros. simpl in |- *. rewrite <- (H (fun a0:ad => pf (Ndouble a0))). - rewrite <- (H0 (fun a0:ad => pf (Ndouble_plus_one a0))). reflexivity. - Qed. - - Lemma MapCard_as_Fold : - forall m:Map A, - MapCard A m = MapFold A nat 0 plus (fun (_:ad) (_:A) => 1) m. - Proof. - intro. exact (MapCard_as_Fold_1 m (fun a0:ad => a0)). - Qed. - - Lemma MapCard_as_length : - forall m:Map A, MapCard A m = length (alist_of_Map A m). - Proof. - intro. rewrite MapCard_as_Fold. rewrite length_as_fold_2. - apply MapFold_as_fold with - (op := plus) (neutral := 0) (f := fun (_:ad) (_:A) => 1). exact plus_assoc_reverse. - trivial. - intro. rewrite <- plus_n_O. reflexivity. - Qed. - - Lemma MapCard_Put1_equals_2 : - forall (p:positive) (a a':ad) (y y':A), - MapCard A (MapPut1 A a y a' y' p) = 2. - Proof. - simple induction p. intros. simpl in |- *. case (Nbit0 a); reflexivity. - intros. simpl in |- *. case (Nbit0 a). exact (H (Ndiv2 a) (Ndiv2 a') y y'). - simpl in |- *. rewrite <- plus_n_O. exact (H (Ndiv2 a) (Ndiv2 a') y y'). - intros. simpl in |- *. case (Nbit0 a); reflexivity. - Qed. - - Lemma MapCard_Put_sum : - forall (m m':Map A) (a:ad) (y:A) (n n':nat), - m' = MapPut A m a y -> - n = MapCard A m -> n' = MapCard A m' -> {n' = n} + {n' = S n}. - Proof. - simple induction m. simpl in |- *. intros. rewrite H in H1. simpl in H1. right. - rewrite H0. rewrite H1. reflexivity. - intros a y m' a0 y0 n n' H H0 H1. simpl in H. elim (Ndiscr (Nxor a a0)). intro H2. - elim H2. intros p H3. rewrite H3 in H. rewrite H in H1. - rewrite (MapCard_Put1_equals_2 p a a0 y y0) in H1. simpl in H0. right. - rewrite H0. rewrite H1. reflexivity. - intro H2. rewrite H2 in H. rewrite H in H1. simpl in H1. simpl in H0. left. - rewrite H0. rewrite H1. reflexivity. - intros. simpl in H2. rewrite (MapPut_semantics_3_1 A m0 m1 a y) in H1. - elim (sumbool_of_bool (Nbit0 a)). intro H4. rewrite H4 in H1. - elim - (H0 (MapPut A m1 (Ndiv2 a) y) (Ndiv2 a) y ( - MapCard A m1) (MapCard A (MapPut A m1 (Ndiv2 a) y)) ( - refl_equal _) (refl_equal _) (refl_equal _)). - intro H5. rewrite H1 in H3. simpl in H3. rewrite H5 in H3. rewrite <- H2 in H3. left. - assumption. - intro H5. rewrite H1 in H3. simpl in H3. rewrite H5 in H3. - rewrite <- (plus_Snm_nSm (MapCard A m0) (MapCard A m1)) in H3. - simpl in H3. rewrite <- H2 in H3. right. assumption. - intro H4. rewrite H4 in H1. - elim - (H (MapPut A m0 (Ndiv2 a) y) (Ndiv2 a) y ( - MapCard A m0) (MapCard A (MapPut A m0 (Ndiv2 a) y)) ( - refl_equal _) (refl_equal _) (refl_equal _)). - intro H5. rewrite H1 in H3. simpl in H3. rewrite H5 in H3. rewrite <- H2 in H3. - left. assumption. - intro H5. rewrite H1 in H3. simpl in H3. rewrite H5 in H3. simpl in H3. rewrite <- H2 in H3. - right. assumption. - Qed. - - Lemma MapCard_Put_lb : - forall (m:Map A) (a:ad) (y:A), MapCard A (MapPut A m a y) >= MapCard A m. - Proof. - unfold ge in |- *. intros. - elim - (MapCard_Put_sum m (MapPut A m a y) a y (MapCard A m) - (MapCard A (MapPut A m a y)) (refl_equal _) ( - refl_equal _) (refl_equal _)). - intro H. rewrite H. apply le_n. - intro H. rewrite H. apply le_n_Sn. - Qed. - - Lemma MapCard_Put_ub : - forall (m:Map A) (a:ad) (y:A), - MapCard A (MapPut A m a y) <= S (MapCard A m). - Proof. - intros. - elim - (MapCard_Put_sum m (MapPut A m a y) a y (MapCard A m) - (MapCard A (MapPut A m a y)) (refl_equal _) ( - refl_equal _) (refl_equal _)). - intro H. rewrite H. apply le_n_Sn. - intro H. rewrite H. apply le_n. - Qed. - - Lemma MapCard_Put_1 : - forall (m:Map A) (a:ad) (y:A), - MapCard A (MapPut A m a y) = MapCard A m -> - {y : A | MapGet A m a = Some y}. - Proof. - simple induction m. intros. discriminate H. - intros a y a0 y0 H. simpl in H. elim (Ndiscr (Nxor a a0)). intro H0. elim H0. - intros p H1. rewrite H1 in H. rewrite (MapCard_Put1_equals_2 p a a0 y y0) in H. - discriminate H. - intro H0. rewrite H0 in H. rewrite (Nxor_eq _ _ H0). split with y. apply M1_semantics_1. - intros. rewrite (MapPut_semantics_3_1 A m0 m1 a y) in H1. elim (sumbool_of_bool (Nbit0 a)). - intro H2. rewrite H2 in H1. simpl in H1. elim (H0 (Ndiv2 a) y ((fun n m p:nat => plus_reg_l m p n) _ _ _ H1)). - intros y0 H3. split with y0. rewrite <- H3. exact (MapGet_M2_bit_0_1 A a H2 m0 m1). - intro H2. rewrite H2 in H1. simpl in H1. - rewrite - (plus_comm (MapCard A (MapPut A m0 (Ndiv2 a) y)) (MapCard A m1)) - in H1. - rewrite (plus_comm (MapCard A m0) (MapCard A m1)) in H1. - elim (H (Ndiv2 a) y ((fun n m p:nat => plus_reg_l m p n) _ _ _ H1)). intros y0 H3. split with y0. - rewrite <- H3. exact (MapGet_M2_bit_0_0 A a H2 m0 m1). - Qed. - - Lemma MapCard_Put_2 : - forall (m:Map A) (a:ad) (y:A), - MapCard A (MapPut A m a y) = S (MapCard A m) -> MapGet A m a = None. - Proof. - simple induction m. trivial. - intros. simpl in H. elim (sumbool_of_bool (Neqb a a1)). intro H0. - rewrite (Neqb_complete _ _ H0) in H. rewrite (Nxor_nilpotent a1) in H. discriminate H. - intro H0. exact (M1_semantics_2 A a a1 a0 H0). - intros. elim (sumbool_of_bool (Nbit0 a)). intro H2. - rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1). apply (H0 (Ndiv2 a) y). - apply (fun n m p:nat => plus_reg_l m p n) with (n := MapCard A m0). - rewrite <- (plus_Snm_nSm (MapCard A m0) (MapCard A m1)). simpl in H1. simpl in |- *. rewrite <- H1. - clear H1. - induction a. discriminate H2. - induction p. reflexivity. - discriminate H2. - reflexivity. - intro H2. rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1). apply (H (Ndiv2 a) y). - cut - (MapCard A (MapPut A m0 (Ndiv2 a) y) + MapCard A m1 = - S (MapCard A m0) + MapCard A m1). - intro. rewrite (plus_comm (MapCard A (MapPut A m0 (Ndiv2 a) y)) (MapCard A m1)) - in H3. - rewrite (plus_comm (S (MapCard A m0)) (MapCard A m1)) in H3. exact ((fun n m p:nat => plus_reg_l m p n) _ _ _ H3). - simpl in |- *. simpl in H1. rewrite <- H1. induction a. trivial. - induction p. discriminate H2. - reflexivity. - discriminate H2. - Qed. - - Lemma MapCard_Put_1_conv : - forall (m:Map A) (a:ad) (y y':A), - MapGet A m a = Some y -> MapCard A (MapPut A m a y') = MapCard A m. - Proof. - intros. - elim - (MapCard_Put_sum m (MapPut A m a y') a y' (MapCard A m) - (MapCard A (MapPut A m a y')) (refl_equal _) ( - refl_equal _) (refl_equal _)). - trivial. - intro H0. rewrite (MapCard_Put_2 m a y' H0) in H. discriminate H. - Qed. - - Lemma MapCard_Put_2_conv : - forall (m:Map A) (a:ad) (y:A), - MapGet A m a = None -> MapCard A (MapPut A m a y) = S (MapCard A m). - Proof. - intros. - elim - (MapCard_Put_sum m (MapPut A m a y) a y (MapCard A m) - (MapCard A (MapPut A m a y)) (refl_equal _) ( - refl_equal _) (refl_equal _)). - intro H0. elim (MapCard_Put_1 m a y H0). intros y' H1. rewrite H1 in H. discriminate H. - trivial. - Qed. - - Lemma MapCard_ext : - forall m m':Map A, - eqm A (MapGet A m) (MapGet A m') -> MapCard A m = MapCard A m'. - Proof. - unfold eqm in |- *. intros. rewrite (MapCard_as_length m). rewrite (MapCard_as_length m'). - rewrite (alist_canonical A (alist_of_Map A m) (alist_of_Map A m')). reflexivity. - unfold eqm in |- *. intro. rewrite (Map_of_alist_semantics A (alist_of_Map A m) a). - rewrite (Map_of_alist_semantics A (alist_of_Map A m') a). rewrite (Map_of_alist_of_Map A m' a). - rewrite (Map_of_alist_of_Map A m a). exact (H a). - apply alist_of_Map_sorts2. - apply alist_of_Map_sorts2. - Qed. - - Lemma MapCard_Dom : forall m:Map A, MapCard A m = MapCard unit (MapDom A m). - Proof. - simple induction m; trivial. intros. simpl in |- *. rewrite H. rewrite H0. reflexivity. - Qed. - - Lemma MapCard_Dom_Put_behind : - forall (m:Map A) (a:ad) (y:A), - MapDom A (MapPut_behind A m a y) = MapDom A (MapPut A m a y). - Proof. - simple induction m. trivial. - intros a y a0 y0. simpl in |- *. elim (Ndiscr (Nxor a a0)). intro H. elim H. - intros p H0. rewrite H0. reflexivity. - intro H. rewrite H. rewrite (Nxor_eq _ _ H). reflexivity. - intros. simpl in |- *. elim (Ndiscr a). intro H1. elim H1. intros p H2. rewrite H2. case p. - intro p0. simpl in |- *. rewrite H0. reflexivity. - intro p0. simpl in |- *. rewrite H. reflexivity. - simpl in |- *. rewrite H0. reflexivity. - intro H1. rewrite H1. simpl in |- *. rewrite H. reflexivity. - Qed. - - Lemma MapCard_Put_behind_Put : - forall (m:Map A) (a:ad) (y:A), - MapCard A (MapPut_behind A m a y) = MapCard A (MapPut A m a y). - Proof. - intros. rewrite MapCard_Dom. rewrite MapCard_Dom. rewrite MapCard_Dom_Put_behind. - reflexivity. - Qed. - - Lemma MapCard_Put_behind_sum : - forall (m m':Map A) (a:ad) (y:A) (n n':nat), - m' = MapPut_behind A m a y -> - n = MapCard A m -> n' = MapCard A m' -> {n' = n} + {n' = S n}. - Proof. - intros. apply (MapCard_Put_sum m (MapPut A m a y) a y n n'); trivial. - rewrite <- MapCard_Put_behind_Put. rewrite <- H. assumption. - Qed. - - Lemma MapCard_makeM2 : - forall m m':Map A, MapCard A (makeM2 A m m') = MapCard A m + MapCard A m'. - Proof. - intros. rewrite (MapCard_ext _ _ (makeM2_M2 A m m')). reflexivity. - Qed. - - Lemma MapCard_Remove_sum : - forall (m m':Map A) (a:ad) (n n':nat), - m' = MapRemove A m a -> - n = MapCard A m -> n' = MapCard A m' -> {n = n'} + {n = S n'}. - Proof. - simple induction m. simpl in |- *. intros. rewrite H in H1. simpl in H1. left. rewrite H1. assumption. - simpl in |- *. intros. elim (sumbool_of_bool (Neqb a a1)). intro H2. rewrite H2 in H. - rewrite H in H1. simpl in H1. right. rewrite H1. assumption. - intro H2. rewrite H2 in H. rewrite H in H1. simpl in H1. left. rewrite H1. assumption. - intros. simpl in H1. simpl in H2. elim (sumbool_of_bool (Nbit0 a)). intro H4. - rewrite H4 in H1. rewrite H1 in H3. - rewrite (MapCard_makeM2 m0 (MapRemove A m1 (Ndiv2 a))) in H3. - elim - (H0 (MapRemove A m1 (Ndiv2 a)) (Ndiv2 a) ( - MapCard A m1) (MapCard A (MapRemove A m1 (Ndiv2 a))) - (refl_equal _) (refl_equal _) (refl_equal _)). - intro H5. rewrite H5 in H2. left. rewrite H3. exact H2. - intro H5. rewrite H5 in H2. - rewrite <- - (plus_Snm_nSm (MapCard A m0) (MapCard A (MapRemove A m1 (Ndiv2 a)))) - in H2. - right. rewrite H3. exact H2. - intro H4. rewrite H4 in H1. rewrite H1 in H3. - rewrite (MapCard_makeM2 (MapRemove A m0 (Ndiv2 a)) m1) in H3. - elim - (H (MapRemove A m0 (Ndiv2 a)) (Ndiv2 a) ( - MapCard A m0) (MapCard A (MapRemove A m0 (Ndiv2 a))) - (refl_equal _) (refl_equal _) (refl_equal _)). - intro H5. rewrite H5 in H2. left. rewrite H3. exact H2. - intro H5. rewrite H5 in H2. right. rewrite H3. exact H2. - Qed. - - Lemma MapCard_Remove_ub : - forall (m:Map A) (a:ad), MapCard A (MapRemove A m a) <= MapCard A m. - Proof. - intros. - elim - (MapCard_Remove_sum m (MapRemove A m a) a (MapCard A m) - (MapCard A (MapRemove A m a)) (refl_equal _) ( - refl_equal _) (refl_equal _)). - intro H. rewrite H. apply le_n. - intro H. rewrite H. apply le_n_Sn. - Qed. - - Lemma MapCard_Remove_lb : - forall (m:Map A) (a:ad), S (MapCard A (MapRemove A m a)) >= MapCard A m. - Proof. - unfold ge in |- *. intros. - elim - (MapCard_Remove_sum m (MapRemove A m a) a (MapCard A m) - (MapCard A (MapRemove A m a)) (refl_equal _) ( - refl_equal _) (refl_equal _)). - intro H. rewrite H. apply le_n_Sn. - intro H. rewrite H. apply le_n. - Qed. - - Lemma MapCard_Remove_1 : - forall (m:Map A) (a:ad), - MapCard A (MapRemove A m a) = MapCard A m -> MapGet A m a = None. - Proof. - simple induction m. trivial. - simpl in |- *. intros a y a0 H. elim (sumbool_of_bool (Neqb a a0)). intro H0. - rewrite H0 in H. discriminate H. - intro H0. rewrite H0. reflexivity. - intros. simpl in H1. elim (sumbool_of_bool (Nbit0 a)). intro H2. rewrite H2 in H1. - rewrite (MapCard_makeM2 m0 (MapRemove A m1 (Ndiv2 a))) in H1. - rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1). apply H0. exact ((fun n m p:nat => plus_reg_l m p n) _ _ _ H1). - intro H2. rewrite H2 in H1. - rewrite (MapCard_makeM2 (MapRemove A m0 (Ndiv2 a)) m1) in H1. - rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1). apply H. - rewrite - (plus_comm (MapCard A (MapRemove A m0 (Ndiv2 a))) (MapCard A m1)) - in H1. - rewrite (plus_comm (MapCard A m0) (MapCard A m1)) in H1. exact ((fun n m p:nat => plus_reg_l m p n) _ _ _ H1). - Qed. - - Lemma MapCard_Remove_2 : - forall (m:Map A) (a:ad), - S (MapCard A (MapRemove A m a)) = MapCard A m -> - {y : A | MapGet A m a = Some y}. - Proof. - simple induction m. intros. discriminate H. - intros a y a0 H. simpl in H. elim (sumbool_of_bool (Neqb a a0)). intro H0. - rewrite (Neqb_complete _ _ H0). split with y. exact (M1_semantics_1 A a0 y). - intro H0. rewrite H0 in H. discriminate H. - intros. simpl in H1. elim (sumbool_of_bool (Nbit0 a)). intro H2. rewrite H2 in H1. - rewrite (MapCard_makeM2 m0 (MapRemove A m1 (Ndiv2 a))) in H1. - rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1). apply H0. - change - (S (MapCard A m0) + MapCard A (MapRemove A m1 (Ndiv2 a)) = - MapCard A m0 + MapCard A m1) in H1. - rewrite - (plus_Snm_nSm (MapCard A m0) (MapCard A (MapRemove A m1 (Ndiv2 a)))) - in H1. - exact ((fun n m p:nat => plus_reg_l m p n) _ _ _ H1). - intro H2. rewrite H2 in H1. rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1). apply H. - rewrite (MapCard_makeM2 (MapRemove A m0 (Ndiv2 a)) m1) in H1. - change - (S (MapCard A (MapRemove A m0 (Ndiv2 a))) + MapCard A m1 = - MapCard A m0 + MapCard A m1) in H1. - rewrite - (plus_comm (S (MapCard A (MapRemove A m0 (Ndiv2 a)))) (MapCard A m1)) - in H1. - rewrite (plus_comm (MapCard A m0) (MapCard A m1)) in H1. exact ((fun n m p:nat => plus_reg_l m p n) _ _ _ H1). - Qed. - - Lemma MapCard_Remove_1_conv : - forall (m:Map A) (a:ad), - MapGet A m a = None -> MapCard A (MapRemove A m a) = MapCard A m. - Proof. - intros. - elim - (MapCard_Remove_sum m (MapRemove A m a) a (MapCard A m) - (MapCard A (MapRemove A m a)) (refl_equal _) ( - refl_equal _) (refl_equal _)). - intro H0. rewrite H0. reflexivity. - intro H0. elim (MapCard_Remove_2 m a (sym_eq H0)). intros y H1. rewrite H1 in H. - discriminate H. - Qed. - - Lemma MapCard_Remove_2_conv : - forall (m:Map A) (a:ad) (y:A), - MapGet A m a = Some y -> S (MapCard A (MapRemove A m a)) = MapCard A m. - Proof. - intros. - elim - (MapCard_Remove_sum m (MapRemove A m a) a (MapCard A m) - (MapCard A (MapRemove A m a)) (refl_equal _) ( - refl_equal _) (refl_equal _)). - intro H0. rewrite (MapCard_Remove_1 m a (sym_eq H0)) in H. discriminate H. - intro H0. rewrite H0. reflexivity. - Qed. - - Lemma MapMerge_Restr_Card : - forall m m':Map A, - MapCard A m + MapCard A m' = - MapCard A (MapMerge A m m') + MapCard A (MapDomRestrTo A A m m'). - Proof. - simple induction m. simpl in |- *. intro. apply plus_n_O. - simpl in |- *. intros a y m'. elim (option_sum A (MapGet A m' a)). intro H. elim H. intros y0 H0. - rewrite H0. rewrite MapCard_Put_behind_Put. rewrite (MapCard_Put_1_conv m' a y0 y H0). - simpl in |- *. rewrite <- plus_Snm_nSm. apply plus_n_O. - intro H. rewrite H. rewrite MapCard_Put_behind_Put. rewrite (MapCard_Put_2_conv m' a y H). - apply plus_n_O. - intros. - change - (MapCard A m0 + MapCard A m1 + MapCard A m' = - MapCard A (MapMerge A (M2 A m0 m1) m') + - MapCard A (MapDomRestrTo A A (M2 A m0 m1) m')) - in |- *. - elim m'. reflexivity. - intros a y. unfold MapMerge in |- *. unfold MapDomRestrTo in |- *. - elim (option_sum A (MapGet A (M2 A m0 m1) a)). intro H1. elim H1. intros y0 H2. rewrite H2. - rewrite (MapCard_Put_1_conv (M2 A m0 m1) a y0 y H2). reflexivity. - intro H1. rewrite H1. rewrite (MapCard_Put_2_conv (M2 A m0 m1) a y H1). simpl in |- *. - rewrite <- (plus_Snm_nSm (MapCard A m0 + MapCard A m1) 0). reflexivity. - intros. simpl in |- *. - rewrite - (plus_permute_2_in_4 (MapCard A m0) (MapCard A m1) ( - MapCard A m2) (MapCard A m3)). - rewrite (H m2). rewrite (H0 m3). - rewrite - (MapCard_makeM2 (MapDomRestrTo A A m0 m2) (MapDomRestrTo A A m1 m3)) - . - apply plus_permute_2_in_4. - Qed. - - Lemma MapMerge_disjoint_Card : - forall m m':Map A, - MapDisjoint A A m m' -> - MapCard A (MapMerge A m m') = MapCard A m + MapCard A m'. - Proof. - intros. rewrite (MapMerge_Restr_Card m m'). - rewrite (MapCard_ext _ _ (MapDisjoint_imp_2 _ _ _ _ H)). apply plus_n_O. - Qed. - - Lemma MapSplit_Card : - forall (m:Map A) (m':Map B), - MapCard A m = - MapCard A (MapDomRestrTo A B m m') + MapCard A (MapDomRestrBy A B m m'). - Proof. - intros. rewrite (MapCard_ext _ _ (MapDom_Split_1 A B m m')). apply MapMerge_disjoint_Card. - apply MapDisjoint_2_imp. unfold MapDisjoint_2 in |- *. apply MapDom_Split_3. - Qed. - - Lemma MapMerge_Card_ub : - forall m m':Map A, - MapCard A (MapMerge A m m') <= MapCard A m + MapCard A m'. - Proof. - intros. rewrite MapMerge_Restr_Card. apply le_plus_l. - Qed. - - Lemma MapDomRestrTo_Card_ub_l : - forall (m:Map A) (m':Map B), - MapCard A (MapDomRestrTo A B m m') <= MapCard A m. - Proof. - intros. rewrite (MapSplit_Card m m'). apply le_plus_l. - Qed. - - Lemma MapDomRestrBy_Card_ub_l : - forall (m:Map A) (m':Map B), - MapCard A (MapDomRestrBy A B m m') <= MapCard A m. - Proof. - intros. rewrite (MapSplit_Card m m'). apply le_plus_r. - Qed. - - Lemma MapMerge_Card_disjoint : - forall m m':Map A, - MapCard A (MapMerge A m m') = MapCard A m + MapCard A m' -> - MapDisjoint A A m m'. - Proof. - simple induction m. intros. apply Map_M0_disjoint. - simpl in |- *. intros. rewrite (MapCard_Put_behind_Put m' a a0) in H. unfold MapDisjoint, in_dom in |- *. - simpl in |- *. intros. elim (sumbool_of_bool (Neqb a a1)). intro H2. - rewrite (Neqb_complete _ _ H2) in H. rewrite (MapCard_Put_2 m' a1 a0 H) in H1. - discriminate H1. - intro H2. rewrite H2 in H0. discriminate H0. - simple induction m'. intros. apply Map_disjoint_M0. - intros a y H1. rewrite <- (MapCard_ext _ _ (MapPut_as_Merge A (M2 A m0 m1) a y)) in H1. - unfold MapCard at 3 in H1. rewrite <- (plus_Snm_nSm (MapCard A (M2 A m0 m1)) 0) in H1. - rewrite <- (plus_n_O (S (MapCard A (M2 A m0 m1)))) in H1. unfold MapDisjoint, in_dom in |- *. - unfold MapGet at 2 in |- *. intros. elim (sumbool_of_bool (Neqb a a0)). intro H4. - rewrite <- (Neqb_complete _ _ H4) in H2. rewrite (MapCard_Put_2 _ _ _ H1) in H2. - discriminate H2. - intro H4. rewrite H4 in H3. discriminate H3. - intros. unfold MapDisjoint in |- *. intros. elim (sumbool_of_bool (Nbit0 a)). intro H6. - unfold MapDisjoint in H0. apply H0 with (m' := m3) (a := Ndiv2 a). apply le_antisym. - apply MapMerge_Card_ub. - apply (fun p n m:nat => plus_le_reg_l n m p) with - (p := MapCard A m0 + MapCard A m2). - rewrite - (plus_permute_2_in_4 (MapCard A m0) (MapCard A m2) ( - MapCard A m1) (MapCard A m3)). - change - (MapCard A (M2 A (MapMerge A m0 m2) (MapMerge A m1 m3)) = - MapCard A m0 + MapCard A m1 + (MapCard A m2 + MapCard A m3)) - in H3. - rewrite <- H3. simpl in |- *. apply plus_le_compat_r. apply MapMerge_Card_ub. - elim (in_dom_some _ _ _ H4). intros y H7. rewrite (MapGet_M2_bit_0_1 _ a H6 m0 m1) in H7. - unfold in_dom in |- *. rewrite H7. reflexivity. - elim (in_dom_some _ _ _ H5). intros y H7. rewrite (MapGet_M2_bit_0_1 _ a H6 m2 m3) in H7. - unfold in_dom in |- *. rewrite H7. reflexivity. - intro H6. unfold MapDisjoint in H. apply H with (m' := m2) (a := Ndiv2 a). apply le_antisym. - apply MapMerge_Card_ub. - apply (fun p n m:nat => plus_le_reg_l n m p) with - (p := MapCard A m1 + MapCard A m3). - rewrite - (plus_comm (MapCard A m1 + MapCard A m3) (MapCard A m0 + MapCard A m2)) - . - rewrite - (plus_permute_2_in_4 (MapCard A m0) (MapCard A m2) ( - MapCard A m1) (MapCard A m3)). - rewrite - (plus_comm (MapCard A m1 + MapCard A m3) (MapCard A (MapMerge A m0 m2))) - . - change - (MapCard A (MapMerge A m0 m2) + MapCard A (MapMerge A m1 m3) = - MapCard A m0 + MapCard A m1 + (MapCard A m2 + MapCard A m3)) - in H3. - rewrite <- H3. apply plus_le_compat_l. apply MapMerge_Card_ub. - elim (in_dom_some _ _ _ H4). intros y H7. rewrite (MapGet_M2_bit_0_0 _ a H6 m0 m1) in H7. - unfold in_dom in |- *. rewrite H7. reflexivity. - elim (in_dom_some _ _ _ H5). intros y H7. rewrite (MapGet_M2_bit_0_0 _ a H6 m2 m3) in H7. - unfold in_dom in |- *. rewrite H7. reflexivity. - Qed. - - Lemma MapCard_is_Sn : - forall (m:Map A) (n:nat), - MapCard _ m = S n -> {a : ad | in_dom _ a m = true}. - Proof. - simple induction m. intros. discriminate H. - intros a y n H. split with a. unfold in_dom in |- *. rewrite (M1_semantics_1 _ a y). reflexivity. - intros. simpl in H1. elim (O_or_S (MapCard _ m0)). intro H2. elim H2. intros m2 H3. - elim (H _ (sym_eq H3)). intros a H4. split with (Ndouble a). unfold in_dom in |- *. - rewrite (MapGet_M2_bit_0_0 A (Ndouble a) (Ndouble_bit0 a) m0 m1). - rewrite (Ndouble_div2 a). elim (in_dom_some _ _ _ H4). intros y H5. rewrite H5. reflexivity. - intro H2. rewrite <- H2 in H1. simpl in H1. elim (H0 _ H1). intros a H3. - split with (Ndouble_plus_one a). unfold in_dom in |- *. - rewrite - (MapGet_M2_bit_0_1 A (Ndouble_plus_one a) (Ndouble_plus_one_bit0 a) - m0 m1). - rewrite (Ndouble_plus_one_div2 a). elim (in_dom_some _ _ _ H3). intros y H4. rewrite H4. - reflexivity. - Qed. - -End MapCard. - -Section MapCard2. - - Variables A B : Set. - - Lemma MapSubset_card_eq_1 : - forall (n:nat) (m:Map A) (m':Map B), - MapSubset _ _ m m' -> - MapCard _ m = n -> MapCard _ m' = n -> MapSubset _ _ m' m. - Proof. - simple induction n. intros. unfold MapSubset, in_dom in |- *. intro. rewrite (MapCard_is_O _ m H0 a). - rewrite (MapCard_is_O _ m' H1 a). intro H2. discriminate H2. - intros. elim (MapCard_is_Sn A m n0 H1). intros a H3. elim (in_dom_some _ _ _ H3). - intros y H4. elim (in_dom_some _ _ _ (H0 _ H3)). intros y' H6. - cut (eqmap _ (MapPut _ (MapRemove _ m a) a y) m). intro. - cut (eqmap _ (MapPut _ (MapRemove _ m' a) a y') m'). intro. - apply MapSubset_ext with - (m0 := MapPut _ (MapRemove _ m' a) a y') - (m2 := MapPut _ (MapRemove _ m a) a y). - assumption. - assumption. - apply MapSubset_Put_mono. apply H. apply MapSubset_Remove_mono. assumption. - rewrite <- (MapCard_Remove_2_conv _ m a y H4) in H1. inversion_clear H1. reflexivity. - rewrite <- (MapCard_Remove_2_conv _ m' a y' H6) in H2. inversion_clear H2. reflexivity. - unfold eqmap, eqm in |- *. intro. rewrite (MapPut_semantics _ (MapRemove B m' a) a y' a0). - elim (sumbool_of_bool (Neqb a a0)). intro H7. rewrite H7. rewrite <- (Neqb_complete _ _ H7). - apply sym_eq. assumption. - intro H7. rewrite H7. rewrite (MapRemove_semantics _ m' a a0). rewrite H7. reflexivity. - unfold eqmap, eqm in |- *. intro. rewrite (MapPut_semantics _ (MapRemove A m a) a y a0). - elim (sumbool_of_bool (Neqb a a0)). intro H7. rewrite H7. rewrite <- (Neqb_complete _ _ H7). - apply sym_eq. assumption. - intro H7. rewrite H7. rewrite (MapRemove_semantics A m a a0). rewrite H7. reflexivity. - Qed. - - Lemma MapDomRestrTo_Card_ub_r : - forall (m:Map A) (m':Map B), - MapCard A (MapDomRestrTo A B m m') <= MapCard B m'. - Proof. - simple induction m. intro. simpl in |- *. apply le_O_n. - intros a y m'. simpl in |- *. elim (option_sum B (MapGet B m' a)). intro H. elim H. intros y0 H0. - rewrite H0. elim (MapCard_is_not_O B m' a y0 H0). intros n H1. rewrite H1. simpl in |- *. - apply le_n_S. apply le_O_n. - intro H. rewrite H. simpl in |- *. apply le_O_n. - simple induction m'. simpl in |- *. apply le_O_n. - - intros a y. unfold MapDomRestrTo in |- *. case (MapGet A (M2 A m0 m1) a). simpl in |- *. - intro. simpl in |- *. apply le_n. - apply le_O_n. - intros. simpl in |- *. rewrite - (MapCard_makeM2 A (MapDomRestrTo A B m0 m2) (MapDomRestrTo A B m1 m3)) - . - apply plus_le_compat. apply H. - apply H0. - Qed. - -End MapCard2. - -Section MapCard3. - - Variables A B : Set. - - Lemma MapMerge_Card_lb_l : - forall m m':Map A, MapCard A (MapMerge A m m') >= MapCard A m. - Proof. - unfold ge in |- *. intros. apply ((fun p n m:nat => plus_le_reg_l n m p) (MapCard A m')). - rewrite (plus_comm (MapCard A m') (MapCard A m)). - rewrite (plus_comm (MapCard A m') (MapCard A (MapMerge A m m'))). - rewrite (MapMerge_Restr_Card A m m'). apply plus_le_compat_l. apply MapDomRestrTo_Card_ub_r. - Qed. - - Lemma MapMerge_Card_lb_r : - forall m m':Map A, MapCard A (MapMerge A m m') >= MapCard A m'. - Proof. - unfold ge in |- *. intros. apply ((fun p n m:nat => plus_le_reg_l n m p) (MapCard A m)). rewrite (MapMerge_Restr_Card A m m'). - rewrite - (plus_comm (MapCard A (MapMerge A m m')) - (MapCard A (MapDomRestrTo A A m m'))). - apply plus_le_compat_r. apply MapDomRestrTo_Card_ub_l. - Qed. - - Lemma MapDomRestrBy_Card_lb : - forall (m:Map A) (m':Map B), - MapCard B m' + MapCard A (MapDomRestrBy A B m m') >= MapCard A m. - Proof. - unfold ge in |- *. intros. rewrite (MapSplit_Card A B m m'). apply plus_le_compat_r. - apply MapDomRestrTo_Card_ub_r. - Qed. - - Lemma MapSubset_Card_le : - forall (m:Map A) (m':Map B), - MapSubset A B m m' -> MapCard A m <= MapCard B m'. - Proof. - intros. apply le_trans with (m := MapCard B m' + MapCard A (MapDomRestrBy A B m m')). - exact (MapDomRestrBy_Card_lb m m'). - rewrite (MapCard_ext _ _ _ (MapSubset_imp_2 _ _ _ _ H)). simpl in |- *. rewrite <- plus_n_O. - apply le_n. - Qed. - - Lemma MapSubset_card_eq : - forall (m:Map A) (m':Map B), - MapSubset _ _ m m' -> - MapCard _ m' <= MapCard _ m -> eqmap _ (MapDom _ m) (MapDom _ m'). - Proof. - intros. apply MapSubset_antisym. assumption. - cut (MapCard B m' = MapCard A m). intro. apply (MapSubset_card_eq_1 A B (MapCard A m)). - assumption. - reflexivity. - assumption. - apply le_antisym. assumption. - apply MapSubset_Card_le. assumption. - Qed. - -End MapCard3.
\ No newline at end of file diff --git a/theories/IntMap/Mapfold.v b/theories/IntMap/Mapfold.v deleted file mode 100644 index eb58cb64..00000000 --- a/theories/IntMap/Mapfold.v +++ /dev/null @@ -1,425 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) -(*i $Id: Mapfold.v 8733 2006-04-25 22:52:18Z letouzey $ i*) - -Require Import Bool. -Require Import Sumbool. -Require Import NArith. -Require Import Ndigits. -Require Import Ndec. -Require Import Map. -Require Import Fset. -Require Import Mapaxioms. -Require Import Mapiter. -Require Import Lsort. -Require Import Mapsubset. -Require Import List. - -Section MapFoldResults. - - Variable A : Set. - - Variable M : Set. - Variable neutral : M. - Variable op : M -> M -> M. - - Variable nleft : forall a:M, op neutral a = a. - Variable nright : forall a:M, op a neutral = a. - Variable assoc : forall a b c:M, op (op a b) c = op a (op b c). - - Lemma MapFold_ext : - forall (f:ad -> A -> M) (m m':Map A), - eqmap A m m' -> MapFold _ _ neutral op f m = MapFold _ _ neutral op f m'. - Proof. - intros. rewrite (MapFold_as_fold A M neutral op assoc nleft nright f m). - rewrite (MapFold_as_fold A M neutral op assoc nleft nright f m'). - cut (alist_of_Map A m = alist_of_Map A m'). intro. rewrite H0. reflexivity. - apply alist_canonical. unfold eqmap in H. apply eqm_trans with (f' := MapGet A m). - apply eqm_sym. apply alist_of_Map_semantics. - apply eqm_trans with (f' := MapGet A m'). assumption. - apply alist_of_Map_semantics. - apply alist_of_Map_sorts2. - apply alist_of_Map_sorts2. - Qed. - - Lemma MapFold_ext_f_1 : - forall (m:Map A) (f g:ad -> A -> M) (pf:ad -> ad), - (forall (a:ad) (y:A), MapGet _ m a = Some y -> f (pf a) y = g (pf a) y) -> - MapFold1 _ _ neutral op f pf m = MapFold1 _ _ neutral op g pf m. - Proof. - simple induction m. trivial. - simpl in |- *. intros. apply H. rewrite (Neqb_correct a). reflexivity. - intros. simpl in |- *. rewrite (H f g (fun a0:ad => pf (Ndouble a0))). - rewrite (H0 f g (fun a0:ad => pf (Ndouble_plus_one a0))). reflexivity. - intros. apply H1. rewrite MapGet_M2_bit_0_1. rewrite Ndouble_plus_one_div2. assumption. - apply Ndouble_plus_one_bit0. - intros. apply H1. rewrite MapGet_M2_bit_0_0. rewrite Ndouble_div2. assumption. - apply Ndouble_bit0. - Qed. - - Lemma MapFold_ext_f : - forall (f g:ad -> A -> M) (m:Map A), - (forall (a:ad) (y:A), MapGet _ m a = Some y -> f a y = g a y) -> - MapFold _ _ neutral op f m = MapFold _ _ neutral op g m. - Proof. - intros. exact (MapFold_ext_f_1 m f g (fun a0:ad => a0) H). - Qed. - - Lemma MapFold1_as_Fold_1 : - forall (m:Map A) (f f':ad -> A -> M) (pf pf':ad -> ad), - (forall (a:ad) (y:A), f (pf a) y = f' (pf' a) y) -> - MapFold1 _ _ neutral op f pf m = MapFold1 _ _ neutral op f' pf' m. - Proof. - simple induction m. trivial. - intros. simpl in |- *. apply H. - intros. simpl in |- *. - rewrite - (H f f' (fun a0:ad => pf (Ndouble a0)) - (fun a0:ad => pf' (Ndouble a0))). - rewrite - (H0 f f' (fun a0:ad => pf (Ndouble_plus_one a0)) - (fun a0:ad => pf' (Ndouble_plus_one a0))). - reflexivity. - intros. apply H1. - intros. apply H1. - Qed. - - Lemma MapFold1_as_Fold : - forall (f:ad -> A -> M) (pf:ad -> ad) (m:Map A), - MapFold1 _ _ neutral op f pf m = - MapFold _ _ neutral op (fun (a:ad) (y:A) => f (pf a) y) m. - Proof. - intros. unfold MapFold in |- *. apply MapFold1_as_Fold_1. trivial. - Qed. - - Lemma MapFold1_ext : - forall (f:ad -> A -> M) (m m':Map A), - eqmap A m m' -> - forall pf:ad -> ad, - MapFold1 _ _ neutral op f pf m = MapFold1 _ _ neutral op f pf m'. - Proof. - intros. rewrite MapFold1_as_Fold. rewrite MapFold1_as_Fold. apply MapFold_ext. assumption. - Qed. - - Variable comm : forall a b:M, op a b = op b a. - - Lemma MapFold_Put_disjoint_1 : - forall (p:positive) (f:ad -> A -> M) (pf:ad -> ad) - (a1 a2:ad) (y1 y2:A), - Nxor a1 a2 = Npos p -> - MapFold1 A M neutral op f pf (MapPut1 A a1 y1 a2 y2 p) = - op (f (pf a1) y1) (f (pf a2) y2). - Proof. - simple induction p. intros. simpl in |- *. elim (sumbool_of_bool (Nbit0 a1)). intro H1. rewrite H1. - simpl in |- *. rewrite Ndiv2_double_plus_one. rewrite Ndiv2_double. apply comm. - change (Nbit0 a2 = negb true) in |- *. rewrite <- H1. rewrite (Nneg_bit0_2 _ _ _ H0). - rewrite negb_elim. reflexivity. - assumption. - intro H1. rewrite H1. simpl in |- *. rewrite Ndiv2_double. rewrite Ndiv2_double_plus_one. - reflexivity. - change (Nbit0 a2 = negb false) in |- *. rewrite <- H1. rewrite (Nneg_bit0_2 _ _ _ H0). - rewrite negb_elim. reflexivity. - assumption. - simpl in |- *. intros. elim (sumbool_of_bool (Nbit0 a1)). intro H1. rewrite H1. simpl in |- *. - rewrite nleft. - rewrite - (H f (fun a0:ad => pf (Ndouble_plus_one a0)) ( - Ndiv2 a1) (Ndiv2 a2) y1 y2). - rewrite Ndiv2_double_plus_one. rewrite Ndiv2_double_plus_one. reflexivity. - unfold Nodd. - rewrite <- (Nsame_bit0 _ _ _ H0). assumption. - assumption. - rewrite <- Nxor_div2. rewrite H0. reflexivity. - intro H1. rewrite H1. simpl in |- *. rewrite nright. - rewrite - (H f (fun a0:ad => pf (Ndouble a0)) (Ndiv2 a1) (Ndiv2 a2) y1 y2) - . - rewrite Ndiv2_double. rewrite Ndiv2_double. reflexivity. - unfold Neven. - rewrite <- (Nsame_bit0 _ _ _ H0). assumption. - assumption. - rewrite <- Nxor_div2. rewrite H0. reflexivity. - intros. simpl in |- *. elim (sumbool_of_bool (Nbit0 a1)). intro H0. rewrite H0. simpl in |- *. - rewrite Ndiv2_double. rewrite Ndiv2_double_plus_one. apply comm. - assumption. - change (Nbit0 a2 = negb true) in |- *. rewrite <- H0. rewrite (Nneg_bit0_1 _ _ H). - rewrite negb_elim. reflexivity. - intro H0. rewrite H0. simpl in |- *. rewrite Ndiv2_double. rewrite Ndiv2_double_plus_one. - reflexivity. - change (Nbit0 a2 = negb false) in |- *. rewrite <- H0. rewrite (Nneg_bit0_1 _ _ H). - rewrite negb_elim. reflexivity. - assumption. - Qed. - - Lemma MapFold_Put_disjoint_2 : - forall (f:ad -> A -> M) (m:Map A) (a:ad) (y:A) (pf:ad -> ad), - MapGet A m a = None -> - MapFold1 A M neutral op f pf (MapPut A m a y) = - op (f (pf a) y) (MapFold1 A M neutral op f pf m). - Proof. - simple induction m. intros. simpl in |- *. rewrite (nright (f (pf a) y)). reflexivity. - intros a1 y1 a2 y2 pf H. simpl in |- *. elim (Ndiscr (Nxor a1 a2)). intro H0. elim H0. - intros p H1. rewrite H1. rewrite comm. exact (MapFold_Put_disjoint_1 p f pf a1 a2 y1 y2 H1). - intro H0. rewrite (Neqb_complete _ _ (Nxor_eq_true _ _ H0)) in H. - rewrite (M1_semantics_1 A a2 y1) in H. discriminate H. - intros. elim (sumbool_of_bool (Nbit0 a)). intro H2. - cut (MapPut A (M2 A m0 m1) a y = M2 A m0 (MapPut A m1 (Ndiv2 a) y)). intro. - rewrite H3. simpl in |- *. rewrite (H0 (Ndiv2 a) y (fun a0:ad => pf (Ndouble_plus_one a0))). - rewrite Ndiv2_double_plus_one. rewrite <- assoc. - rewrite - (comm (MapFold1 A M neutral op f (fun a0:ad => pf (Ndouble a0)) m0) - (f (pf a) y)). - rewrite assoc. reflexivity. - assumption. - rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1) in H1. assumption. - simpl in |- *. elim (Ndiscr a). intro H3. elim H3. intro p. elim p. intros p0 H4 H5. rewrite H5. - reflexivity. - intros p0 H4 H5. rewrite H5 in H2. discriminate H2. - intro H4. rewrite H4. reflexivity. - intro H3. rewrite H3 in H2. discriminate H2. - intro H2. cut (MapPut A (M2 A m0 m1) a y = M2 A (MapPut A m0 (Ndiv2 a) y) m1). - intro. rewrite H3. simpl in |- *. rewrite (H (Ndiv2 a) y (fun a0:ad => pf (Ndouble a0))). - rewrite Ndiv2_double. rewrite <- assoc. reflexivity. - assumption. - rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1) in H1. assumption. - simpl in |- *. elim (Ndiscr a). intro H3. elim H3. intro p. elim p. intros p0 H4 H5. rewrite H5 in H2. - discriminate H2. - intros p0 H4 H5. rewrite H5. reflexivity. - intro H4. rewrite H4 in H2. discriminate H2. - intro H3. rewrite H3. reflexivity. - Qed. - - Lemma MapFold_Put_disjoint : - forall (f:ad -> A -> M) (m:Map A) (a:ad) (y:A), - MapGet A m a = None -> - MapFold A M neutral op f (MapPut A m a y) = - op (f a y) (MapFold A M neutral op f m). - Proof. - intros. exact (MapFold_Put_disjoint_2 f m a y (fun a0:ad => a0) H). - Qed. - - Lemma MapFold_Put_behind_disjoint_2 : - forall (f:ad -> A -> M) (m:Map A) (a:ad) (y:A) (pf:ad -> ad), - MapGet A m a = None -> - MapFold1 A M neutral op f pf (MapPut_behind A m a y) = - op (f (pf a) y) (MapFold1 A M neutral op f pf m). - Proof. - intros. cut (eqmap A (MapPut_behind A m a y) (MapPut A m a y)). intro. - rewrite (MapFold1_ext f _ _ H0 pf). apply MapFold_Put_disjoint_2. assumption. - apply eqmap_trans with (m' := MapMerge A (M1 A a y) m). apply MapPut_behind_as_Merge. - apply eqmap_trans with (m' := MapMerge A m (M1 A a y)). - apply eqmap_trans with (m' := MapDelta A (M1 A a y) m). apply eqmap_sym. apply MapDelta_disjoint. - unfold MapDisjoint in |- *. unfold in_dom in |- *. simpl in |- *. intros. elim (sumbool_of_bool (Neqb a a0)). - intro H2. rewrite (Neqb_complete _ _ H2) in H. rewrite H in H1. discriminate H1. - intro H2. rewrite H2 in H0. discriminate H0. - apply eqmap_trans with (m' := MapDelta A m (M1 A a y)). apply MapDelta_sym. - apply MapDelta_disjoint. unfold MapDisjoint in |- *. unfold in_dom in |- *. simpl in |- *. intros. - elim (sumbool_of_bool (Neqb a a0)). intro H2. rewrite (Neqb_complete _ _ H2) in H. - rewrite H in H0. discriminate H0. - intro H2. rewrite H2 in H1. discriminate H1. - apply eqmap_sym. apply MapPut_as_Merge. - Qed. - - Lemma MapFold_Put_behind_disjoint : - forall (f:ad -> A -> M) (m:Map A) (a:ad) (y:A), - MapGet A m a = None -> - MapFold A M neutral op f (MapPut_behind A m a y) = - op (f a y) (MapFold A M neutral op f m). - Proof. - intros. exact (MapFold_Put_behind_disjoint_2 f m a y (fun a0:ad => a0) H). - Qed. - - Lemma MapFold_Merge_disjoint_1 : - forall (f:ad -> A -> M) (m1 m2:Map A) (pf:ad -> ad), - MapDisjoint A A m1 m2 -> - MapFold1 A M neutral op f pf (MapMerge A m1 m2) = - op (MapFold1 A M neutral op f pf m1) (MapFold1 A M neutral op f pf m2). - Proof. - simple induction m1. simpl in |- *. intros. rewrite nleft. reflexivity. - intros. unfold MapMerge in |- *. apply (MapFold_Put_behind_disjoint_2 f m2 a a0 pf). - apply in_dom_none. exact (MapDisjoint_M1_l _ _ m2 a a0 H). - simple induction m2. intros. simpl in |- *. rewrite nright. reflexivity. - intros. unfold MapMerge in |- *. rewrite (MapFold_Put_disjoint_2 f (M2 A m m0) a a0 pf). apply comm. - apply in_dom_none. exact (MapDisjoint_M1_r _ _ (M2 A m m0) a a0 H1). - intros. simpl in |- *. rewrite (H m3 (fun a0:ad => pf (Ndouble a0))). - rewrite (H0 m4 (fun a0:ad => pf (Ndouble_plus_one a0))). - cut (forall a b c d:M, op (op a b) (op c d) = op (op a c) (op b d)). intro. apply H4. - intros. rewrite assoc. rewrite <- (assoc b c d). rewrite (comm b c). rewrite (assoc c b d). - rewrite assoc. reflexivity. - exact (MapDisjoint_M2_r _ _ _ _ _ _ H3). - exact (MapDisjoint_M2_l _ _ _ _ _ _ H3). - Qed. - - Lemma MapFold_Merge_disjoint : - forall (f:ad -> A -> M) (m1 m2:Map A), - MapDisjoint A A m1 m2 -> - MapFold A M neutral op f (MapMerge A m1 m2) = - op (MapFold A M neutral op f m1) (MapFold A M neutral op f m2). - Proof. - intros. exact (MapFold_Merge_disjoint_1 f m1 m2 (fun a0:ad => a0) H). - Qed. - -End MapFoldResults. - -Section MapFoldDistr. - - Variable A : Set. - - Variable M : Set. - Variable neutral : M. - Variable op : M -> M -> M. - - Variable M' : Set. - Variable neutral' : M'. - Variable op' : M' -> M' -> M'. - - Variable N : Set. - - Variable times : M -> N -> M'. - - Variable absorb : forall c:N, times neutral c = neutral'. - Variable - distr : - forall (a b:M) (c:N), times (op a b) c = op' (times a c) (times b c). - - Lemma MapFold_distr_r_1 : - forall (f:ad -> A -> M) (m:Map A) (c:N) (pf:ad -> ad), - times (MapFold1 A M neutral op f pf m) c = - MapFold1 A M' neutral' op' (fun (a:ad) (y:A) => times (f a y) c) pf m. - Proof. - simple induction m. intros. exact (absorb c). - trivial. - intros. simpl in |- *. rewrite distr. rewrite H. rewrite H0. reflexivity. - Qed. - - Lemma MapFold_distr_r : - forall (f:ad -> A -> M) (m:Map A) (c:N), - times (MapFold A M neutral op f m) c = - MapFold A M' neutral' op' (fun (a:ad) (y:A) => times (f a y) c) m. - Proof. - intros. exact (MapFold_distr_r_1 f m c (fun a:ad => a)). - Qed. - -End MapFoldDistr. - -Section MapFoldDistrL. - - Variable A : Set. - - Variable M : Set. - Variable neutral : M. - Variable op : M -> M -> M. - - Variable M' : Set. - Variable neutral' : M'. - Variable op' : M' -> M' -> M'. - - Variable N : Set. - - Variable times : N -> M -> M'. - - Variable absorb : forall c:N, times c neutral = neutral'. - Variable - distr : - forall (a b:M) (c:N), times c (op a b) = op' (times c a) (times c b). - - Lemma MapFold_distr_l : - forall (f:ad -> A -> M) (m:Map A) (c:N), - times c (MapFold A M neutral op f m) = - MapFold A M' neutral' op' (fun (a:ad) (y:A) => times c (f a y)) m. - Proof. - intros. apply MapFold_distr_r with (times := fun (a:M) (b:N) => times b a); - assumption. - Qed. - -End MapFoldDistrL. - -Section MapFoldExists. - - Variable A : Set. - - Lemma MapFold_orb_1 : - forall (f:ad -> A -> bool) (m:Map A) (pf:ad -> ad), - MapFold1 A bool false orb f pf m = - match MapSweep1 A f pf m with - | Some _ => true - | _ => false - end. - Proof. - simple induction m. trivial. - intros a y pf. simpl in |- *. unfold MapSweep2 in |- *. case (f (pf a) y); reflexivity. - intros. simpl in |- *. rewrite (H (fun a0:ad => pf (Ndouble a0))). - rewrite (H0 (fun a0:ad => pf (Ndouble_plus_one a0))). - case (MapSweep1 A f (fun a0:ad => pf (Ndouble a0)) m0); reflexivity. - Qed. - - Lemma MapFold_orb : - forall (f:ad -> A -> bool) (m:Map A), - MapFold A bool false orb f m = - match MapSweep A f m with - | Some _ => true - | _ => false - end. - Proof. - intros. exact (MapFold_orb_1 f m (fun a:ad => a)). - Qed. - -End MapFoldExists. - -Section DMergeDef. - - Variable A : Set. - - Definition DMerge := - MapFold (Map A) (Map A) (M0 A) (MapMerge A) (fun (_:ad) (m:Map A) => m). - - Lemma in_dom_DMerge_1 : - forall (m:Map (Map A)) (a:ad), - in_dom A a (DMerge m) = - match MapSweep _ (fun (_:ad) (m0:Map A) => in_dom A a m0) m with - | Some _ => true - | _ => false - end. - Proof. - unfold DMerge in |- *. intros. - rewrite - (MapFold_distr_l (Map A) (Map A) (M0 A) (MapMerge A) bool false orb ad - (in_dom A) (fun c:ad => refl_equal _) (in_dom_merge A)) - . - apply MapFold_orb. - Qed. - - Lemma in_dom_DMerge_2 : - forall (m:Map (Map A)) (a:ad), - in_dom A a (DMerge m) = true -> - {b : ad & - {m0 : Map A | MapGet _ m b = Some m0 /\ in_dom A a m0 = true}}. - Proof. - intros m a. rewrite in_dom_DMerge_1. - elim - (option_sum _ - (MapSweep (Map A) (fun (_:ad) (m0:Map A) => in_dom A a m0) m)). - intro H. elim H. intro r. elim r. intros b m0 H0. intro. split with b. split with m0. - split. exact (MapSweep_semantics_2 _ _ _ _ _ H0). - exact (MapSweep_semantics_1 _ _ _ _ _ H0). - intro H. rewrite H. intro. discriminate H0. - Qed. - - Lemma in_dom_DMerge_3 : - forall (m:Map (Map A)) (a b:ad) (m0:Map A), - MapGet _ m a = Some m0 -> - in_dom A b m0 = true -> in_dom A b (DMerge m) = true. - Proof. - intros m a b m0 H H0. rewrite in_dom_DMerge_1. - elim - (MapSweep_semantics_4 _ (fun (_:ad) (m'0:Map A) => in_dom A b m'0) _ _ _ - H H0). - intros a' H1. elim H1. intros m'0 H2. rewrite H2. reflexivity. - Qed. - -End DMergeDef.
\ No newline at end of file diff --git a/theories/IntMap/Mapiter.v b/theories/IntMap/Mapiter.v deleted file mode 100644 index a8ba7e39..00000000 --- a/theories/IntMap/Mapiter.v +++ /dev/null @@ -1,618 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) -(*i $Id: Mapiter.v 8733 2006-04-25 22:52:18Z letouzey $ i*) - -Require Import Bool. -Require Import Sumbool. -Require Import NArith. -Require Import Ndigits. -Require Import Ndec. -Require Import Map. -Require Import Mapaxioms. -Require Import Fset. -Require Import List. - -Section MapIter. - - Variable A : Set. - - Section MapSweepDef. - - Variable f : ad -> A -> bool. - - Definition MapSweep2 (a0:ad) (y:A) := - if f a0 y then Some (a0, y) else None. - - Fixpoint MapSweep1 (pf:ad -> ad) (m:Map A) {struct m} : - option (ad * A) := - match m with - | M0 => None - | M1 a y => MapSweep2 (pf a) y - | M2 m m' => - match MapSweep1 (fun a:ad => pf (Ndouble a)) m with - | Some r => Some r - | None => MapSweep1 (fun a:ad => pf (Ndouble_plus_one a)) m' - end - end. - - Definition MapSweep (m:Map A) := MapSweep1 (fun a:ad => a) m. - - Lemma MapSweep_semantics_1_1 : - forall (m:Map A) (pf:ad -> ad) (a:ad) (y:A), - MapSweep1 pf m = Some (a, y) -> f a y = true. - Proof. - simple induction m. intros. discriminate H. - simpl in |- *. intros a y pf a0 y0. elim (sumbool_of_bool (f (pf a) y)). intro H. unfold MapSweep2 in |- *. - rewrite H. intro H0. inversion H0. rewrite <- H3. assumption. - intro H. unfold MapSweep2 in |- *. rewrite H. intro H0. discriminate H0. - simpl in |- *. intros. elim (option_sum (ad * A) (MapSweep1 (fun a0:ad => pf (Ndouble a0)) m0)). - intro H2. elim H2. intros r H3. rewrite H3 in H1. inversion H1. rewrite H5 in H3. - exact (H (fun a0:ad => pf (Ndouble a0)) a y H3). - intro H2. rewrite H2 in H1. exact (H0 (fun a0:ad => pf (Ndouble_plus_one a0)) a y H1). - Qed. - - Lemma MapSweep_semantics_1 : - forall (m:Map A) (a:ad) (y:A), MapSweep m = Some (a, y) -> f a y = true. - Proof. - intros. exact (MapSweep_semantics_1_1 m (fun a:ad => a) a y H). - Qed. - - Lemma MapSweep_semantics_2_1 : - forall (m:Map A) (pf:ad -> ad) (a:ad) (y:A), - MapSweep1 pf m = Some (a, y) -> {a' : ad | a = pf a'}. - Proof. - simple induction m. intros. discriminate H. - simpl in |- *. unfold MapSweep2 in |- *. intros a y pf a0 y0. case (f (pf a) y). intros. split with a. - inversion H. reflexivity. - intro. discriminate H. - intros m0 H m1 H0 pf a y. simpl in |- *. - elim - (option_sum (ad * A) (MapSweep1 (fun a0:ad => pf (Ndouble a0)) m0)). intro H1. elim H1. - intros r H2. rewrite H2. intro H3. inversion H3. rewrite H5 in H2. - elim (H (fun a0:ad => pf (Ndouble a0)) a y H2). intros a0 H6. split with (Ndouble a0). - assumption. - intro H1. rewrite H1. intro H2. elim (H0 (fun a0:ad => pf (Ndouble_plus_one a0)) a y H2). - intros a0 H3. split with (Ndouble_plus_one a0). assumption. - Qed. - - Lemma MapSweep_semantics_2_2 : - forall (m:Map A) (pf fp:ad -> ad), - (forall a0:ad, fp (pf a0) = a0) -> - forall (a:ad) (y:A), - MapSweep1 pf m = Some (a, y) -> MapGet A m (fp a) = Some y. - Proof. - simple induction m. intros. discriminate H0. - simpl in |- *. intros a y pf fp H a0 y0. unfold MapSweep2 in |- *. elim (sumbool_of_bool (f (pf a) y)). - intro H0. rewrite H0. intro H1. inversion H1. rewrite (H a). rewrite (Neqb_correct a). - reflexivity. - intro H0. rewrite H0. intro H1. discriminate H1. - intros. rewrite (MapGet_M2_bit_0_if A m0 m1 (fp a)). elim (sumbool_of_bool (Nbit0 (fp a))). - intro H3. rewrite H3. elim (option_sum (ad * A) (MapSweep1 (fun a0:ad => pf (Ndouble a0)) m0)). - intro H4. simpl in H2. apply - (H0 (fun a0:ad => pf (Ndouble_plus_one a0)) - (fun a0:ad => Ndiv2 (fp a0))). - intro. rewrite H1. apply Ndouble_plus_one_div2. - elim - (option_sum (ad * A) (MapSweep1 (fun a0:ad => pf (Ndouble a0)) m0)). intro H5. elim H5. - intros r H6. rewrite H6 in H2. inversion H2. rewrite H8 in H6. - elim (MapSweep_semantics_2_1 m0 (fun a0:ad => pf (Ndouble a0)) a y H6). intros a0 H9. - rewrite H9 in H3. rewrite (H1 (Ndouble a0)) in H3. rewrite (Ndouble_bit0 a0) in H3. - discriminate H3. - intro H5. rewrite H5 in H2. assumption. - intro H4. simpl in H2. rewrite H4 in H2. - apply - (H0 (fun a0:ad => pf (Ndouble_plus_one a0)) - (fun a0:ad => Ndiv2 (fp a0))). intro. - rewrite H1. apply Ndouble_plus_one_div2. - assumption. - intro H3. rewrite H3. simpl in H2. - elim - (option_sum (ad * A) (MapSweep1 (fun a0:ad => pf (Ndouble a0)) m0)). intro H4. elim H4. - intros r H5. rewrite H5 in H2. inversion H2. rewrite H7 in H5. - apply - (H (fun a0:ad => pf (Ndouble a0)) (fun a0:ad => Ndiv2 (fp a0))). intro. rewrite H1. - apply Ndouble_div2. - assumption. - intro H4. rewrite H4 in H2. - elim - (MapSweep_semantics_2_1 m1 (fun a0:ad => pf (Ndouble_plus_one a0)) a y - H2). - intros a0 H5. rewrite H5 in H3. rewrite (H1 (Ndouble_plus_one a0)) in H3. - rewrite (Ndouble_plus_one_bit0 a0) in H3. discriminate H3. - Qed. - - Lemma MapSweep_semantics_2 : - forall (m:Map A) (a:ad) (y:A), - MapSweep m = Some (a, y) -> MapGet A m a = Some y. - Proof. - intros. - exact - (MapSweep_semantics_2_2 m (fun a0:ad => a0) (fun a0:ad => a0) - (fun a0:ad => refl_equal a0) a y H). - Qed. - - Lemma MapSweep_semantics_3_1 : - forall (m:Map A) (pf:ad -> ad), - MapSweep1 pf m = None -> - forall (a:ad) (y:A), MapGet A m a = Some y -> f (pf a) y = false. - Proof. - simple induction m. intros. discriminate H0. - simpl in |- *. unfold MapSweep2 in |- *. intros a y pf. elim (sumbool_of_bool (f (pf a) y)). intro H. - rewrite H. intro. discriminate H0. - intro H. rewrite H. intros H0 a0 y0. elim (sumbool_of_bool (Neqb a a0)). intro H1. rewrite H1. - intro H2. inversion H2. rewrite <- H4. rewrite <- (Neqb_complete _ _ H1). assumption. - intro H1. rewrite H1. intro. discriminate H2. - intros. simpl in H1. elim (option_sum (ad * A) (MapSweep1 (fun a:ad => pf (Ndouble a)) m0)). - intro H3. elim H3. intros r H4. rewrite H4 in H1. discriminate H1. - intro H3. rewrite H3 in H1. elim (sumbool_of_bool (Nbit0 a)). intro H4. - rewrite (MapGet_M2_bit_0_1 A a H4 m0 m1) in H2. rewrite <- (Ndiv2_double_plus_one a H4). - exact (H0 (fun a:ad => pf (Ndouble_plus_one a)) H1 (Ndiv2 a) y H2). - intro H4. rewrite (MapGet_M2_bit_0_0 A a H4 m0 m1) in H2. rewrite <- (Ndiv2_double a H4). - exact (H (fun a:ad => pf (Ndouble a)) H3 (Ndiv2 a) y H2). - Qed. - - Lemma MapSweep_semantics_3 : - forall m:Map A, - MapSweep m = None -> - forall (a:ad) (y:A), MapGet A m a = Some y -> f a y = false. - Proof. - intros. - exact (MapSweep_semantics_3_1 m (fun a0:ad => a0) H a y H0). - Qed. - - Lemma MapSweep_semantics_4_1 : - forall (m:Map A) (pf:ad -> ad) (a:ad) (y:A), - MapGet A m a = Some y -> - f (pf a) y = true -> - {a' : ad & {y' : A | MapSweep1 pf m = Some (a', y')}}. - Proof. - simple induction m. intros. discriminate H. - intros. elim (sumbool_of_bool (Neqb a a1)). intro H1. split with (pf a1). split with y. - rewrite (Neqb_complete _ _ H1). unfold MapSweep1, MapSweep2 in |- *. - rewrite (Neqb_complete _ _ H1) in H. rewrite (M1_semantics_1 _ a1 a0) in H. - inversion H. rewrite H0. reflexivity. - - intro H1. rewrite (M1_semantics_2 _ a a1 a0 H1) in H. discriminate H. - - intros. elim (sumbool_of_bool (Nbit0 a)). intro H3. - rewrite (MapGet_M2_bit_0_1 _ _ H3 m0 m1) in H1. - rewrite <- (Ndiv2_double_plus_one a H3) in H2. - elim (H0 (fun a0:ad => pf (Ndouble_plus_one a0)) (Ndiv2 a) y H1 H2). intros a'' H4. elim H4. - intros y'' H5. simpl in |- *. elim (option_sum _ (MapSweep1 (fun a:ad => pf (Ndouble a)) m0)). - intro H6. elim H6. intro r. elim r. intros a''' y''' H7. rewrite H7. split with a'''. - split with y'''. reflexivity. - intro H6. rewrite H6. split with a''. split with y''. assumption. - intro H3. rewrite (MapGet_M2_bit_0_0 _ _ H3 m0 m1) in H1. - rewrite <- (Ndiv2_double a H3) in H2. - elim (H (fun a0:ad => pf (Ndouble a0)) (Ndiv2 a) y H1 H2). intros a'' H4. elim H4. - intros y'' H5. split with a''. split with y''. simpl in |- *. rewrite H5. reflexivity. - Qed. - - Lemma MapSweep_semantics_4 : - forall (m:Map A) (a:ad) (y:A), - MapGet A m a = Some y -> - f a y = true -> {a' : ad & {y' : A | MapSweep m = Some (a', y')}}. - Proof. - intros. exact (MapSweep_semantics_4_1 m (fun a0:ad => a0) a y H H0). - Qed. - - End MapSweepDef. - - Variable B : Set. - - Fixpoint MapCollect1 (f:ad -> A -> Map B) (pf:ad -> ad) - (m:Map A) {struct m} : Map B := - match m with - | M0 => M0 B - | M1 a y => f (pf a) y - | M2 m1 m2 => - MapMerge B (MapCollect1 f (fun a0:ad => pf (Ndouble a0)) m1) - (MapCollect1 f (fun a0:ad => pf (Ndouble_plus_one a0)) m2) - end. - - Definition MapCollect (f:ad -> A -> Map B) (m:Map A) := - MapCollect1 f (fun a:ad => a) m. - - Section MapFoldDef. - - Variable M : Set. - Variable neutral : M. - Variable op : M -> M -> M. - - Fixpoint MapFold1 (f:ad -> A -> M) (pf:ad -> ad) - (m:Map A) {struct m} : M := - match m with - | M0 => neutral - | M1 a y => f (pf a) y - | M2 m1 m2 => - op (MapFold1 f (fun a0:ad => pf (Ndouble a0)) m1) - (MapFold1 f (fun a0:ad => pf (Ndouble_plus_one a0)) m2) - end. - - Definition MapFold (f:ad -> A -> M) (m:Map A) := - MapFold1 f (fun a:ad => a) m. - - Lemma MapFold_empty : forall f:ad -> A -> M, MapFold f (M0 A) = neutral. - Proof. - trivial. - Qed. - - Lemma MapFold_M1 : - forall (f:ad -> A -> M) (a:ad) (y:A), MapFold f (M1 A a y) = f a y. - Proof. - trivial. - Qed. - - Variable State : Set. - Variable f : State -> ad -> A -> State * M. - - Fixpoint MapFold1_state (state:State) (pf:ad -> ad) - (m:Map A) {struct m} : State * M := - match m with - | M0 => (state, neutral) - | M1 a y => f state (pf a) y - | M2 m1 m2 => - match MapFold1_state state (fun a0:ad => pf (Ndouble a0)) m1 with - | (state1, x1) => - match - MapFold1_state state1 - (fun a0:ad => pf (Ndouble_plus_one a0)) m2 - with - | (state2, x2) => (state2, op x1 x2) - end - end - end. - - Definition MapFold_state (state:State) := - MapFold1_state state (fun a:ad => a). - - Lemma pair_sp : forall (B C:Set) (x:B * C), x = (fst x, snd x). - Proof. - simple induction x. trivial. - Qed. - - Lemma MapFold_state_stateless_1 : - forall (m:Map A) (g:ad -> A -> M) (pf:ad -> ad), - (forall (state:State) (a:ad) (y:A), snd (f state a y) = g a y) -> - forall state:State, snd (MapFold1_state state pf m) = MapFold1 g pf m. - Proof. - simple induction m. trivial. - intros. simpl in |- *. apply H. - intros. simpl in |- *. rewrite - (pair_sp _ _ (MapFold1_state state (fun a0:ad => pf (Ndouble a0)) m0)) - . - rewrite (H g (fun a0:ad => pf (Ndouble a0)) H1 state). - rewrite - (pair_sp _ _ - (MapFold1_state - (fst (MapFold1_state state (fun a0:ad => pf (Ndouble a0)) m0)) - (fun a0:ad => pf (Ndouble_plus_one a0)) m1)) - . - simpl in |- *. - rewrite - (H0 g (fun a0:ad => pf (Ndouble_plus_one a0)) H1 - (fst (MapFold1_state state (fun a0:ad => pf (Ndouble a0)) m0))) - . - reflexivity. - Qed. - - Lemma MapFold_state_stateless : - forall g:ad -> A -> M, - (forall (state:State) (a:ad) (y:A), snd (f state a y) = g a y) -> - forall (state:State) (m:Map A), - snd (MapFold_state state m) = MapFold g m. - Proof. - intros. exact (MapFold_state_stateless_1 m g (fun a0:ad => a0) H state). - Qed. - - End MapFoldDef. - - Lemma MapCollect_as_Fold : - forall (f:ad -> A -> Map B) (m:Map A), - MapCollect f m = MapFold (Map B) (M0 B) (MapMerge B) f m. - Proof. - simple induction m; trivial. - Qed. - - Definition alist := list (ad * A). - Definition anil := nil (A:=(ad * A)). - Definition acons := cons (A:=(ad * A)). - Definition aapp := app (A:=(ad * A)). - - Definition alist_of_Map := - MapFold alist anil aapp (fun (a:ad) (y:A) => acons (a, y) anil). - - Fixpoint alist_semantics (l:alist) : ad -> option A := - match l with - | nil => fun _:ad => None - | (a, y) :: l' => - fun a0:ad => if Neqb a a0 then Some y else alist_semantics l' a0 - end. - - Lemma alist_semantics_app : - forall (l l':alist) (a:ad), - alist_semantics (aapp l l') a = - match alist_semantics l a with - | None => alist_semantics l' a - | Some y => Some y - end. - Proof. - unfold aapp in |- *. simple induction l. trivial. - intros. elim a. intros a1 y1. simpl in |- *. case (Neqb a1 a0). reflexivity. - apply H. - Qed. - - Lemma alist_of_Map_semantics_1_1 : - forall (m:Map A) (pf:ad -> ad) (a:ad) (y:A), - alist_semantics - (MapFold1 alist anil aapp (fun (a0:ad) (y:A) => acons (a0, y) anil) pf - m) a = Some y -> {a' : ad | a = pf a'}. - Proof. - simple induction m. simpl in |- *. intros. discriminate H. - simpl in |- *. intros a y pf a0 y0. elim (sumbool_of_bool (Neqb (pf a) a0)). intro H. rewrite H. - intro H0. split with a. rewrite (Neqb_complete _ _ H). reflexivity. - intro H. rewrite H. intro H0. discriminate H0. - intros. change - (alist_semantics - (aapp - (MapFold1 alist anil aapp (fun (a0:ad) (y:A) => acons (a0, y) anil) - (fun a0:ad => pf (Ndouble a0)) m0) - (MapFold1 alist anil aapp (fun (a0:ad) (y:A) => acons (a0, y) anil) - (fun a0:ad => pf (Ndouble_plus_one a0)) m1)) a = - Some y) in H1. - rewrite - (alist_semantics_app - (MapFold1 alist anil aapp (fun (a0:ad) (y0:A) => acons (a0, y0) anil) - (fun a0:ad => pf (Ndouble a0)) m0) - (MapFold1 alist anil aapp (fun (a0:ad) (y0:A) => acons (a0, y0) anil) - (fun a0:ad => pf (Ndouble_plus_one a0)) m1) a) - in H1. - elim - (option_sum A - (alist_semantics - (MapFold1 alist anil aapp - (fun (a0:ad) (y0:A) => acons (a0, y0) anil) - (fun a0:ad => pf (Ndouble a0)) m0) a)). - intro H2. elim H2. intros y0 H3. elim (H (fun a0:ad => pf (Ndouble a0)) a y0 H3). intros a0 H4. - split with (Ndouble a0). assumption. - intro H2. rewrite H2 in H1. elim (H0 (fun a0:ad => pf (Ndouble_plus_one a0)) a y H1). - intros a0 H3. split with (Ndouble_plus_one a0). assumption. - Qed. - - Definition ad_inj (pf:ad -> ad) := - forall a0 a1:ad, pf a0 = pf a1 -> a0 = a1. - - Lemma ad_comp_double_inj : - forall pf:ad -> ad, ad_inj pf -> ad_inj (fun a0:ad => pf (Ndouble a0)). - Proof. - unfold ad_inj in |- *. intros. apply Ndouble_inj. exact (H _ _ H0). - Qed. - - Lemma ad_comp_double_plus_un_inj : - forall pf:ad -> ad, - ad_inj pf -> ad_inj (fun a0:ad => pf (Ndouble_plus_one a0)). - Proof. - unfold ad_inj in |- *. intros. apply Ndouble_plus_one_inj. exact (H _ _ H0). - Qed. - - Lemma alist_of_Map_semantics_1 : - forall (m:Map A) (pf:ad -> ad), - ad_inj pf -> - forall a:ad, - MapGet A m a = - alist_semantics - (MapFold1 alist anil aapp (fun (a0:ad) (y:A) => acons (a0, y) anil) - pf m) (pf a). - Proof. - simple induction m. trivial. - simpl in |- *. intros. elim (sumbool_of_bool (Neqb a a1)). intro H0. rewrite H0. - rewrite (Neqb_complete _ _ H0). rewrite (Neqb_correct (pf a1)). reflexivity. - intro H0. rewrite H0. elim (sumbool_of_bool (Neqb (pf a) (pf a1))). intro H1. - rewrite (H a a1 (Neqb_complete _ _ H1)) in H0. rewrite (Neqb_correct a1) in H0. - discriminate H0. - intro H1. rewrite H1. reflexivity. - intros. change - (MapGet A (M2 A m0 m1) a = - alist_semantics - (aapp - (MapFold1 alist anil aapp (fun (a0:ad) (y:A) => acons (a0, y) anil) - (fun a0:ad => pf (Ndouble a0)) m0) - (MapFold1 alist anil aapp (fun (a0:ad) (y:A) => acons (a0, y) anil) - (fun a0:ad => pf (Ndouble_plus_one a0)) m1)) ( - pf a)) in |- *. - rewrite alist_semantics_app. rewrite (MapGet_M2_bit_0_if A m0 m1 a). - elim (Ndouble_or_double_plus_un a). intro H2. elim H2. intros a0 H3. rewrite H3. - rewrite (Ndouble_bit0 a0). - rewrite <- - (H (fun a1:ad => pf (Ndouble a1)) (ad_comp_double_inj pf H1) a0) - . - rewrite Ndouble_div2. case (MapGet A m0 a0); trivial. - elim - (option_sum A - (alist_semantics - (MapFold1 alist anil aapp - (fun (a1:ad) (y:A) => acons (a1, y) anil) - (fun a1:ad => pf (Ndouble_plus_one a1)) m1) - (pf (Ndouble a0)))). - intro H4. elim H4. intros y H5. - elim - (alist_of_Map_semantics_1_1 m1 (fun a1:ad => pf (Ndouble_plus_one a1)) - (pf (Ndouble a0)) y H5). - intros a1 H6. cut (Nbit0 (Ndouble a0) = Nbit0 (Ndouble_plus_one a1)). - intro. rewrite (Ndouble_bit0 a0) in H7. rewrite (Ndouble_plus_one_bit0 a1) in H7. - discriminate H7. - rewrite (H1 (Ndouble a0) (Ndouble_plus_one a1) H6). reflexivity. - intro H4. rewrite H4. reflexivity. - intro H2. elim H2. intros a0 H3. rewrite H3. rewrite (Ndouble_plus_one_bit0 a0). - rewrite <- - (H0 (fun a1:ad => pf (Ndouble_plus_one a1)) - (ad_comp_double_plus_un_inj pf H1) a0). - rewrite Ndouble_plus_one_div2. - elim - (option_sum A - (alist_semantics - (MapFold1 alist anil aapp - (fun (a1:ad) (y:A) => acons (a1, y) anil) - (fun a1:ad => pf (Ndouble a1)) m0) - (pf (Ndouble_plus_one a0)))). - intro H4. elim H4. intros y H5. - elim - (alist_of_Map_semantics_1_1 m0 (fun a1:ad => pf (Ndouble a1)) - (pf (Ndouble_plus_one a0)) y H5). - intros a1 H6. cut (Nbit0 (Ndouble_plus_one a0) = Nbit0 (Ndouble a1)). - intro H7. rewrite (Ndouble_plus_one_bit0 a0) in H7. rewrite (Ndouble_bit0 a1) in H7. - discriminate H7. - rewrite (H1 (Ndouble_plus_one a0) (Ndouble a1) H6). reflexivity. - intro H4. rewrite H4. reflexivity. - Qed. - - Lemma alist_of_Map_semantics : - forall m:Map A, eqm A (MapGet A m) (alist_semantics (alist_of_Map m)). - Proof. - unfold eqm in |- *. intros. exact - (alist_of_Map_semantics_1 m (fun a0:ad => a0) - (fun (a0 a1:ad) (p:a0 = a1) => p) a). - Qed. - - Fixpoint Map_of_alist (l:alist) : Map A := - match l with - | nil => M0 A - | (a, y) :: l' => MapPut A (Map_of_alist l') a y - end. - - Lemma Map_of_alist_semantics : - forall l:alist, eqm A (alist_semantics l) (MapGet A (Map_of_alist l)). - Proof. - unfold eqm in |- *. simple induction l. trivial. - intros r l0 H a. elim r. intros a0 y0. simpl in |- *. elim (sumbool_of_bool (Neqb a0 a)). - intro H0. rewrite H0. rewrite (Neqb_complete _ _ H0). - rewrite (MapPut_semantics A (Map_of_alist l0) a y0 a). rewrite (Neqb_correct a). - reflexivity. - intro H0. rewrite H0. rewrite (MapPut_semantics A (Map_of_alist l0) a0 y0 a). - rewrite H0. apply H. - Qed. - - Lemma Map_of_alist_of_Map : - forall m:Map A, eqmap A (Map_of_alist (alist_of_Map m)) m. - Proof. - unfold eqmap in |- *. intro. apply eqm_trans with (f' := alist_semantics (alist_of_Map m)). - apply eqm_sym. apply Map_of_alist_semantics. - apply eqm_sym. apply alist_of_Map_semantics. - Qed. - - Lemma alist_of_Map_of_alist : - forall l:alist, - eqm A (alist_semantics (alist_of_Map (Map_of_alist l))) - (alist_semantics l). - Proof. - intro. apply eqm_trans with (f' := MapGet A (Map_of_alist l)). - apply eqm_sym. apply alist_of_Map_semantics. - apply eqm_sym. apply Map_of_alist_semantics. - Qed. - - Lemma fold_right_aapp : - forall (M:Set) (neutral:M) (op:M -> M -> M), - (forall a b c:M, op (op a b) c = op a (op b c)) -> - (forall a:M, op neutral a = a) -> - forall (f:ad -> A -> M) (l l':alist), - fold_right (fun (r:ad * A) (m:M) => let (a, y) := r in op (f a y) m) - neutral (aapp l l') = - op - (fold_right - (fun (r:ad * A) (m:M) => let (a, y) := r in op (f a y) m) neutral - l) - (fold_right - (fun (r:ad * A) (m:M) => let (a, y) := r in op (f a y) m) neutral - l'). - Proof. - simple induction l. simpl in |- *. intro. rewrite H0. reflexivity. - intros r l0 H1 l'. elim r. intros a y. simpl in |- *. rewrite H. rewrite (H1 l'). reflexivity. - Qed. - - Lemma MapFold_as_fold_1 : - forall (M:Set) (neutral:M) (op:M -> M -> M), - (forall a b c:M, op (op a b) c = op a (op b c)) -> - (forall a:M, op neutral a = a) -> - (forall a:M, op a neutral = a) -> - forall (f:ad -> A -> M) (m:Map A) (pf:ad -> ad), - MapFold1 M neutral op f pf m = - fold_right (fun (r:ad * A) (m:M) => let (a, y) := r in op (f a y) m) - neutral - (MapFold1 alist anil aapp (fun (a:ad) (y:A) => acons (a, y) anil) pf - m). - Proof. - simple induction m. trivial. - intros. simpl in |- *. rewrite H1. reflexivity. - intros. simpl in |- *. rewrite (fold_right_aapp M neutral op H H0 f). - rewrite (H2 (fun a0:ad => pf (Ndouble a0))). rewrite (H3 (fun a0:ad => pf (Ndouble_plus_one a0))). - reflexivity. - Qed. - - Lemma MapFold_as_fold : - forall (M:Set) (neutral:M) (op:M -> M -> M), - (forall a b c:M, op (op a b) c = op a (op b c)) -> - (forall a:M, op neutral a = a) -> - (forall a:M, op a neutral = a) -> - forall (f:ad -> A -> M) (m:Map A), - MapFold M neutral op f m = - fold_right (fun (r:ad * A) (m:M) => let (a, y) := r in op (f a y) m) - neutral (alist_of_Map m). - Proof. - intros. exact (MapFold_as_fold_1 M neutral op H H0 H1 f m (fun a0:ad => a0)). - Qed. - - Lemma alist_MapMerge_semantics : - forall m m':Map A, - eqm A (alist_semantics (aapp (alist_of_Map m') (alist_of_Map m))) - (alist_semantics (alist_of_Map (MapMerge A m m'))). - Proof. - unfold eqm in |- *. intros. rewrite alist_semantics_app. rewrite <- (alist_of_Map_semantics m a). - rewrite <- (alist_of_Map_semantics m' a). - rewrite <- (alist_of_Map_semantics (MapMerge A m m') a). - rewrite (MapMerge_semantics A m m' a). reflexivity. - Qed. - - Lemma alist_MapMerge_semantics_disjoint : - forall m m':Map A, - eqmap A (MapDomRestrTo A A m m') (M0 A) -> - eqm A (alist_semantics (aapp (alist_of_Map m) (alist_of_Map m'))) - (alist_semantics (alist_of_Map (MapMerge A m m'))). - Proof. - unfold eqm in |- *. intros. rewrite alist_semantics_app. rewrite <- (alist_of_Map_semantics m a). - rewrite <- (alist_of_Map_semantics m' a). - rewrite <- (alist_of_Map_semantics (MapMerge A m m') a). rewrite (MapMerge_semantics A m m' a). - elim (option_sum _ (MapGet A m a)). intro H0. elim H0. intros y H1. rewrite H1. - elim (option_sum _ (MapGet A m' a)). intro H2. elim H2. intros y' H3. - cut (MapGet A (MapDomRestrTo A A m m') a = None). - rewrite (MapDomRestrTo_semantics A A m m' a). rewrite H3. rewrite H1. intro. discriminate H4. - exact (H a). - intro H2. rewrite H2. reflexivity. - intro H0. rewrite H0. case (MapGet A m' a); trivial. - Qed. - - Lemma alist_semantics_disjoint_comm : - forall l l':alist, - eqmap A (MapDomRestrTo A A (Map_of_alist l) (Map_of_alist l')) (M0 A) -> - eqm A (alist_semantics (aapp l l')) (alist_semantics (aapp l' l)). - Proof. - unfold eqm in |- *. intros. rewrite (alist_semantics_app l l' a). rewrite (alist_semantics_app l' l a). - rewrite <- (alist_of_Map_of_alist l a). rewrite <- (alist_of_Map_of_alist l' a). - rewrite <- - (alist_semantics_app (alist_of_Map (Map_of_alist l)) - (alist_of_Map (Map_of_alist l')) a). - rewrite <- - (alist_semantics_app (alist_of_Map (Map_of_alist l')) - (alist_of_Map (Map_of_alist l)) a). - rewrite (alist_MapMerge_semantics (Map_of_alist l) (Map_of_alist l') a). - rewrite - (alist_MapMerge_semantics_disjoint (Map_of_alist l) ( - Map_of_alist l') H a). - reflexivity. - Qed. - -End MapIter. diff --git a/theories/IntMap/Maplists.v b/theories/IntMap/Maplists.v deleted file mode 100644 index 56a3c160..00000000 --- a/theories/IntMap/Maplists.v +++ /dev/null @@ -1,438 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) -(*i $Id: Maplists.v 8733 2006-04-25 22:52:18Z letouzey $ i*) - -Require Import BinNat. -Require Import Ndigits. -Require Import Ndec. -Require Import Map. -Require Import Fset. -Require Import Mapaxioms. -Require Import Mapsubset. -Require Import Mapcard. -Require Import Mapcanon. -Require Import Mapc. -Require Import Bool. -Require Import Sumbool. -Require Import List. -Require Import Arith. -Require Import Mapiter. -Require Import Mapfold. - -Section MapLists. - - Fixpoint ad_in_list (a:ad) (l:list ad) {struct l} : bool := - match l with - | nil => false - | a' :: l' => orb (Neqb a a') (ad_in_list a l') - end. - - Fixpoint ad_list_stutters (l:list ad) : bool := - match l with - | nil => false - | a :: l' => orb (ad_in_list a l') (ad_list_stutters l') - end. - - Lemma ad_in_list_forms_circuit : - forall (x:ad) (l:list ad), - ad_in_list x l = true -> - {l1 : list ad & {l2 : list ad | l = l1 ++ x :: l2}}. - Proof. - simple induction l. intro. discriminate H. - intros. elim (sumbool_of_bool (Neqb x a)). intro H1. simpl in H0. split with (nil (A:=ad)). - split with l0. rewrite (Neqb_complete _ _ H1). reflexivity. - intro H2. simpl in H0. rewrite H2 in H0. simpl in H0. elim (H H0). intros l'1 H3. - split with (a :: l'1). elim H3. intros l2 H4. split with l2. rewrite H4. reflexivity. - Qed. - - Lemma ad_list_stutters_has_circuit : - forall l:list ad, - ad_list_stutters l = true -> - {x : ad & - {l0 : list ad & - {l1 : list ad & {l2 : list ad | l = l0 ++ x :: l1 ++ x :: l2}}}}. - Proof. - simple induction l. intro. discriminate H. - intros. simpl in H0. elim (orb_true_elim _ _ H0). intro H1. split with a. - split with (nil (A:=ad)). simpl in |- *. elim (ad_in_list_forms_circuit a l0 H1). intros l1 H2. - split with l1. elim H2. intros l2 H3. split with l2. rewrite H3. reflexivity. - intro H1. elim (H H1). intros x H2. split with x. elim H2. intros l1 H3. - split with (a :: l1). elim H3. intros l2 H4. split with l2. elim H4. intros l3 H5. - split with l3. rewrite H5. reflexivity. - Qed. - - Fixpoint Elems (l:list ad) : FSet := - match l with - | nil => M0 unit - | a :: l' => MapPut _ (Elems l') a tt - end. - - Lemma Elems_canon : forall l:list ad, mapcanon _ (Elems l). - Proof. - simple induction l. exact (M0_canon unit). - intros. simpl in |- *. apply MapPut_canon. assumption. - Qed. - - Lemma Elems_app : - forall l l':list ad, Elems (l ++ l') = FSetUnion (Elems l) (Elems l'). - Proof. - simple induction l. trivial. - intros. simpl in |- *. rewrite (MapPut_as_Merge_c unit (Elems l0)). - rewrite (MapPut_as_Merge_c unit (Elems (l0 ++ l'))). - change - (FSetUnion (Elems (l0 ++ l')) (M1 unit a tt) = - FSetUnion (FSetUnion (Elems l0) (M1 unit a tt)) (Elems l')) - in |- *. - rewrite FSetUnion_comm_c. rewrite (FSetUnion_comm_c (Elems l0) (M1 unit a tt)). - rewrite FSetUnion_assoc_c. rewrite (H l'). reflexivity. - apply M1_canon. - apply Elems_canon. - apply Elems_canon. - apply Elems_canon. - apply M1_canon. - apply Elems_canon. - apply M1_canon. - apply Elems_canon. - apply Elems_canon. - Qed. - - Lemma Elems_rev : forall l:list ad, Elems (rev l) = Elems l. - Proof. - simple induction l. trivial. - intros. simpl in |- *. rewrite Elems_app. simpl in |- *. rewrite (MapPut_as_Merge_c unit (Elems l0)). - rewrite H. reflexivity. - apply Elems_canon. - Qed. - - Lemma ad_in_elems_in_list : - forall (l:list ad) (a:ad), in_FSet a (Elems l) = ad_in_list a l. - Proof. - simple induction l. trivial. - simpl in |- *. unfold in_FSet in |- *. intros. rewrite (in_dom_put _ (Elems l0) a tt a0). - rewrite (H a0). reflexivity. - Qed. - - Lemma ad_list_not_stutters_card : - forall l:list ad, - ad_list_stutters l = false -> length l = MapCard _ (Elems l). - Proof. - simple induction l. trivial. - simpl in |- *. intros. rewrite MapCard_Put_2_conv. rewrite H. reflexivity. - elim (orb_false_elim _ _ H0). trivial. - elim (sumbool_of_bool (in_FSet a (Elems l0))). rewrite ad_in_elems_in_list. - intro H1. rewrite H1 in H0. discriminate H0. - exact (in_dom_none unit (Elems l0) a). - Qed. - - Lemma ad_list_card : forall l:list ad, MapCard _ (Elems l) <= length l. - Proof. - simple induction l. trivial. - intros. simpl in |- *. apply le_trans with (m := S (MapCard _ (Elems l0))). apply MapCard_Put_ub. - apply le_n_S. assumption. - Qed. - - Lemma ad_list_stutters_card : - forall l:list ad, - ad_list_stutters l = true -> MapCard _ (Elems l) < length l. - Proof. - simple induction l. intro. discriminate H. - intros. simpl in |- *. simpl in H0. elim (orb_true_elim _ _ H0). intro H1. - rewrite <- (ad_in_elems_in_list l0 a) in H1. elim (in_dom_some _ _ _ H1). intros y H2. - rewrite (MapCard_Put_1_conv _ _ _ _ tt H2). apply le_lt_trans with (m := length l0). - apply ad_list_card. - apply lt_n_Sn. - intro H1. apply le_lt_trans with (m := S (MapCard _ (Elems l0))). apply MapCard_Put_ub. - apply lt_n_S. apply H. assumption. - Qed. - - Lemma ad_list_not_stutters_card_conv : - forall l:list ad, - length l = MapCard _ (Elems l) -> ad_list_stutters l = false. - Proof. - intros. elim (sumbool_of_bool (ad_list_stutters l)). intro H0. - cut (MapCard _ (Elems l) < length l). intro. rewrite H in H1. elim (lt_irrefl _ H1). - exact (ad_list_stutters_card _ H0). - trivial. - Qed. - - Lemma ad_list_stutters_card_conv : - forall l:list ad, - MapCard _ (Elems l) < length l -> ad_list_stutters l = true. - Proof. - intros. elim (sumbool_of_bool (ad_list_stutters l)). trivial. - intro H0. rewrite (ad_list_not_stutters_card _ H0) in H. elim (lt_irrefl _ H). - Qed. - - Lemma ad_in_list_l : - forall (l l':list ad) (a:ad), - ad_in_list a l = true -> ad_in_list a (l ++ l') = true. - Proof. - simple induction l. intros. discriminate H. - intros. simpl in |- *. simpl in H0. elim (orb_true_elim _ _ H0). intro H1. rewrite H1. reflexivity. - intro H1. rewrite (H l' a0 H1). apply orb_b_true. - Qed. - - Lemma ad_list_stutters_app_l : - forall l l':list ad, - ad_list_stutters l = true -> ad_list_stutters (l ++ l') = true. - Proof. - simple induction l. intros. discriminate H. - intros. simpl in |- *. simpl in H0. elim (orb_true_elim _ _ H0). intro H1. - rewrite (ad_in_list_l l0 l' a H1). reflexivity. - intro H1. rewrite (H l' H1). apply orb_b_true. - Qed. - - Lemma ad_in_list_r : - forall (l l':list ad) (a:ad), - ad_in_list a l' = true -> ad_in_list a (l ++ l') = true. - Proof. - simple induction l. trivial. - intros. simpl in |- *. rewrite (H l' a0 H0). apply orb_b_true. - Qed. - - Lemma ad_list_stutters_app_r : - forall l l':list ad, - ad_list_stutters l' = true -> ad_list_stutters (l ++ l') = true. - Proof. - simple induction l. trivial. - intros. simpl in |- *. rewrite (H l' H0). apply orb_b_true. - Qed. - - Lemma ad_list_stutters_app_conv_l : - forall l l':list ad, - ad_list_stutters (l ++ l') = false -> ad_list_stutters l = false. - Proof. - intros. elim (sumbool_of_bool (ad_list_stutters l)). intro H0. - rewrite (ad_list_stutters_app_l l l' H0) in H. discriminate H. - trivial. - Qed. - - Lemma ad_list_stutters_app_conv_r : - forall l l':list ad, - ad_list_stutters (l ++ l') = false -> ad_list_stutters l' = false. - Proof. - intros. elim (sumbool_of_bool (ad_list_stutters l')). intro H0. - rewrite (ad_list_stutters_app_r l l' H0) in H. discriminate H. - trivial. - Qed. - - Lemma ad_in_list_app_1 : - forall (l l':list ad) (x:ad), ad_in_list x (l ++ x :: l') = true. - Proof. - simple induction l. simpl in |- *. intros. rewrite (Neqb_correct x). reflexivity. - intros. simpl in |- *. rewrite (H l' x). apply orb_b_true. - Qed. - - Lemma ad_in_list_app : - forall (l l':list ad) (x:ad), - ad_in_list x (l ++ l') = orb (ad_in_list x l) (ad_in_list x l'). - Proof. - simple induction l. trivial. - intros. simpl in |- *. rewrite <- orb_assoc. rewrite (H l' x). reflexivity. - Qed. - - Lemma ad_in_list_rev : - forall (l:list ad) (x:ad), ad_in_list x (rev l) = ad_in_list x l. - Proof. - simple induction l. trivial. - intros. simpl in |- *. rewrite ad_in_list_app. rewrite (H x). simpl in |- *. rewrite orb_b_false. - apply orb_comm. - Qed. - - Lemma ad_list_has_circuit_stutters : - forall (l0 l1 l2:list ad) (x:ad), - ad_list_stutters (l0 ++ x :: l1 ++ x :: l2) = true. - Proof. - simple induction l0. simpl in |- *. intros. rewrite (ad_in_list_app_1 l1 l2 x). reflexivity. - intros. simpl in |- *. rewrite (H l1 l2 x). apply orb_b_true. - Qed. - - Lemma ad_list_stutters_prev_l : - forall (l l':list ad) (x:ad), - ad_in_list x l = true -> ad_list_stutters (l ++ x :: l') = true. - Proof. - intros. elim (ad_in_list_forms_circuit _ _ H). intros l0 H0. elim H0. intros l1 H1. - rewrite H1. rewrite app_ass. simpl in |- *. apply ad_list_has_circuit_stutters. - Qed. - - Lemma ad_list_stutters_prev_conv_l : - forall (l l':list ad) (x:ad), - ad_list_stutters (l ++ x :: l') = false -> ad_in_list x l = false. - Proof. - intros. elim (sumbool_of_bool (ad_in_list x l)). intro H0. - rewrite (ad_list_stutters_prev_l l l' x H0) in H. discriminate H. - trivial. - Qed. - - Lemma ad_list_stutters_prev_r : - forall (l l':list ad) (x:ad), - ad_in_list x l' = true -> ad_list_stutters (l ++ x :: l') = true. - Proof. - intros. elim (ad_in_list_forms_circuit _ _ H). intros l0 H0. elim H0. intros l1 H1. - rewrite H1. apply ad_list_has_circuit_stutters. - Qed. - - Lemma ad_list_stutters_prev_conv_r : - forall (l l':list ad) (x:ad), - ad_list_stutters (l ++ x :: l') = false -> ad_in_list x l' = false. - Proof. - intros. elim (sumbool_of_bool (ad_in_list x l')). intro H0. - rewrite (ad_list_stutters_prev_r l l' x H0) in H. discriminate H. - trivial. - Qed. - - Lemma ad_list_Elems : - forall l l':list ad, - MapCard _ (Elems l) = MapCard _ (Elems l') -> - length l = length l' -> ad_list_stutters l = ad_list_stutters l'. - Proof. - intros. elim (sumbool_of_bool (ad_list_stutters l)). intro H1. rewrite H1. apply sym_eq. - apply ad_list_stutters_card_conv. rewrite <- H. rewrite <- H0. apply ad_list_stutters_card. - assumption. - intro H1. rewrite H1. apply sym_eq. apply ad_list_not_stutters_card_conv. rewrite <- H. - rewrite <- H0. apply ad_list_not_stutters_card. assumption. - Qed. - - Lemma ad_list_app_length : - forall l l':list ad, length (l ++ l') = length l + length l'. - Proof. - simple induction l. trivial. - intros. simpl in |- *. rewrite (H l'). reflexivity. - Qed. - - Lemma ad_list_stutters_permute : - forall l l':list ad, - ad_list_stutters (l ++ l') = ad_list_stutters (l' ++ l). - Proof. - intros. apply ad_list_Elems. rewrite Elems_app. rewrite Elems_app. - rewrite (FSetUnion_comm_c _ _ (Elems_canon l) (Elems_canon l')). reflexivity. - rewrite ad_list_app_length. rewrite ad_list_app_length. apply plus_comm. - Qed. - - Lemma ad_list_rev_length : forall l:list ad, length (rev l) = length l. - Proof. - simple induction l. trivial. - intros. simpl in |- *. rewrite ad_list_app_length. simpl in |- *. rewrite H. rewrite <- plus_Snm_nSm. - rewrite <- plus_n_O. reflexivity. - Qed. - - Lemma ad_list_stutters_rev : - forall l:list ad, ad_list_stutters (rev l) = ad_list_stutters l. - Proof. - intros. apply ad_list_Elems. rewrite Elems_rev. reflexivity. - apply ad_list_rev_length. - Qed. - - Lemma ad_list_app_rev : - forall (l l':list ad) (x:ad), rev l ++ x :: l' = rev (x :: l) ++ l'. - Proof. - simple induction l. trivial. - intros. simpl in |- *. rewrite (app_ass (rev l0) (a :: nil) (x :: l')). simpl in |- *. - rewrite (H (x :: l') a). simpl in |- *. - rewrite (app_ass (rev l0) (a :: nil) (x :: nil)). simpl in |- *. - rewrite app_ass. simpl in |- *. rewrite app_ass. reflexivity. - Qed. - - Section ListOfDomDef. - - Variable A : Set. - - Definition ad_list_of_dom := - MapFold A (list ad) nil (app (A:=ad)) (fun (a:ad) (_:A) => a :: nil). - - Lemma ad_in_list_of_dom_in_dom : - forall (m:Map A) (a:ad), ad_in_list a (ad_list_of_dom m) = in_dom A a m. - Proof. - unfold ad_list_of_dom in |- *. intros. - rewrite - (MapFold_distr_l A (list ad) nil (app (A:=ad)) bool false orb ad - (fun (a:ad) (l:list ad) => ad_in_list a l) ( - fun c:ad => refl_equal _) ad_in_list_app - (fun (a0:ad) (_:A) => a0 :: nil) m a). - simpl in |- *. rewrite (MapFold_orb A (fun (a0:ad) (_:A) => orb (Neqb a a0) false) m). - elim - (option_sum _ - (MapSweep A (fun (a0:ad) (_:A) => orb (Neqb a a0) false) m)). intro H. elim H. - intro r. elim r. intros a0 y H0. rewrite H0. unfold in_dom in |- *. - elim (orb_prop _ _ (MapSweep_semantics_1 _ _ _ _ _ H0)). intro H1. - rewrite (Neqb_complete _ _ H1). rewrite (MapSweep_semantics_2 A _ _ _ _ H0). reflexivity. - intro H1. discriminate H1. - intro H. rewrite H. elim (sumbool_of_bool (in_dom A a m)). intro H0. - elim (in_dom_some A m a H0). intros y H1. - elim (orb_false_elim _ _ (MapSweep_semantics_3 _ _ _ H _ _ H1)). intro H2. - rewrite (Neqb_correct a) in H2. discriminate H2. - exact (sym_eq (y:=_)). - Qed. - - Lemma Elems_of_list_of_dom : - forall m:Map A, eqmap unit (Elems (ad_list_of_dom m)) (MapDom A m). - Proof. - unfold eqmap, eqm in |- *. intros. elim (sumbool_of_bool (in_FSet a (Elems (ad_list_of_dom m)))). - intro H. elim (in_dom_some _ _ _ H). intro t. elim t. intro H0. - rewrite (ad_in_elems_in_list (ad_list_of_dom m) a) in H. - rewrite (ad_in_list_of_dom_in_dom m a) in H. rewrite (MapDom_Dom A m a) in H. - elim (in_dom_some _ _ _ H). intro t'. elim t'. intro H1. rewrite H1. assumption. - intro H. rewrite (in_dom_none _ _ _ H). - rewrite (ad_in_elems_in_list (ad_list_of_dom m) a) in H. - rewrite (ad_in_list_of_dom_in_dom m a) in H. rewrite (MapDom_Dom A m a) in H. - rewrite (in_dom_none _ _ _ H). reflexivity. - Qed. - - Lemma Elems_of_list_of_dom_c : - forall m:Map A, mapcanon A m -> Elems (ad_list_of_dom m) = MapDom A m. - Proof. - intros. apply (mapcanon_unique unit). apply Elems_canon. - apply MapDom_canon. assumption. - apply Elems_of_list_of_dom. - Qed. - - Lemma ad_list_of_dom_card_1 : - forall (m:Map A) (pf:ad -> ad), - length - (MapFold1 A (list ad) nil (app (A:=ad)) (fun (a:ad) (_:A) => a :: nil) - pf m) = MapCard A m. - Proof. - simple induction m; try trivial. simpl in |- *. intros. rewrite ad_list_app_length. - rewrite (H (fun a0:ad => pf (Ndouble a0))). rewrite (H0 (fun a0:ad => pf (Ndouble_plus_one a0))). - reflexivity. - Qed. - - Lemma ad_list_of_dom_card : - forall m:Map A, length (ad_list_of_dom m) = MapCard A m. - Proof. - exact (fun m:Map A => ad_list_of_dom_card_1 m (fun a:ad => a)). - Qed. - - Lemma ad_list_of_dom_not_stutters : - forall m:Map A, ad_list_stutters (ad_list_of_dom m) = false. - Proof. - intro. apply ad_list_not_stutters_card_conv. rewrite ad_list_of_dom_card. apply sym_eq. - rewrite (MapCard_Dom A m). apply MapCard_ext. exact (Elems_of_list_of_dom m). - Qed. - - End ListOfDomDef. - - Lemma ad_list_of_dom_Dom_1 : - forall (A:Set) (m:Map A) (pf:ad -> ad), - MapFold1 A (list ad) nil (app (A:=ad)) (fun (a:ad) (_:A) => a :: nil) pf - m = - MapFold1 unit (list ad) nil (app (A:=ad)) - (fun (a:ad) (_:unit) => a :: nil) pf (MapDom A m). - Proof. - simple induction m; try trivial. simpl in |- *. intros. rewrite (H (fun a0:ad => pf (Ndouble a0))). - rewrite (H0 (fun a0:ad => pf (Ndouble_plus_one a0))). reflexivity. - Qed. - - Lemma ad_list_of_dom_Dom : - forall (A:Set) (m:Map A), - ad_list_of_dom A m = ad_list_of_dom unit (MapDom A m). - Proof. - intros. exact (ad_list_of_dom_Dom_1 A m (fun a0:ad => a0)). - Qed. - -End MapLists.
\ No newline at end of file diff --git a/theories/IntMap/Mapsubset.v b/theories/IntMap/Mapsubset.v deleted file mode 100644 index 6771c03e..00000000 --- a/theories/IntMap/Mapsubset.v +++ /dev/null @@ -1,605 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) -(*i $Id: Mapsubset.v 8733 2006-04-25 22:52:18Z letouzey $ i*) - -Require Import Bool. -Require Import Sumbool. -Require Import Arith. -Require Import NArith. -Require Import Ndigits. -Require Import Ndec. -Require Import Map. -Require Import Fset. -Require Import Mapaxioms. -Require Import Mapiter. - -Section MapSubsetDef. - - Variables A B : Set. - - Definition MapSubset (m:Map A) (m':Map B) := - forall a:ad, in_dom A a m = true -> in_dom B a m' = true. - - Definition MapSubset_1 (m:Map A) (m':Map B) := - match MapSweep A (fun (a:ad) (_:A) => negb (in_dom B a m')) m with - | None => true - | _ => false - end. - - Definition MapSubset_2 (m:Map A) (m':Map B) := - eqmap A (MapDomRestrBy A B m m') (M0 A). - - Lemma MapSubset_imp_1 : - forall (m:Map A) (m':Map B), MapSubset m m' -> MapSubset_1 m m' = true. - Proof. - unfold MapSubset, MapSubset_1 in |- *. intros. - elim - (option_sum _ (MapSweep A (fun (a:ad) (_:A) => negb (in_dom B a m')) m)). - intro H0. elim H0. intro r. elim r. intros a y H1. cut (negb (in_dom B a m') = true). - intro. cut (in_dom A a m = false). intro. unfold in_dom in H3. - rewrite (MapSweep_semantics_2 _ _ m a y H1) in H3. discriminate H3. - elim (sumbool_of_bool (in_dom A a m)). intro H3. rewrite (H a H3) in H2. discriminate H2. - trivial. - exact (MapSweep_semantics_1 _ _ m a y H1). - intro H0. rewrite H0. reflexivity. - Qed. - - Lemma MapSubset_1_imp : - forall (m:Map A) (m':Map B), MapSubset_1 m m' = true -> MapSubset m m'. - Proof. - unfold MapSubset, MapSubset_1 in |- *. unfold in_dom at 2 in |- *. intros. elim (option_sum _ (MapGet A m a)). - intro H1. elim H1. intros y H2. - elim - (option_sum _ (MapSweep A (fun (a:ad) (_:A) => negb (in_dom B a m')) m)). intro H3. - elim H3. intro r. elim r. intros a' y' H4. rewrite H4 in H. discriminate H. - intro H3. cut (negb (in_dom B a m') = false). intro. rewrite (negb_intro (in_dom B a m')). - rewrite H4. reflexivity. - exact (MapSweep_semantics_3 _ _ m H3 a y H2). - intro H1. rewrite H1 in H0. discriminate H0. - Qed. - - Lemma map_dom_empty_1 : - forall m:Map A, eqmap A m (M0 A) -> forall a:ad, in_dom _ a m = false. - Proof. - unfold eqmap, eqm, in_dom in |- *. intros. rewrite (H a). reflexivity. - Qed. - - Lemma map_dom_empty_2 : - forall m:Map A, (forall a:ad, in_dom _ a m = false) -> eqmap A m (M0 A). - Proof. - unfold eqmap, eqm, in_dom in |- *. intros. - cut - (match MapGet A m a with - | None => false - | Some _ => true - end = false). - case (MapGet A m a); trivial. - intros. discriminate H0. - exact (H a). - Qed. - - Lemma MapSubset_imp_2 : - forall (m:Map A) (m':Map B), MapSubset m m' -> MapSubset_2 m m'. - Proof. - unfold MapSubset, MapSubset_2 in |- *. intros. apply map_dom_empty_2. intro. rewrite in_dom_restrby. - elim (sumbool_of_bool (in_dom A a m)). intro H0. rewrite H0. rewrite (H a H0). reflexivity. - intro H0. rewrite H0. reflexivity. - Qed. - - Lemma MapSubset_2_imp : - forall (m:Map A) (m':Map B), MapSubset_2 m m' -> MapSubset m m'. - Proof. - unfold MapSubset, MapSubset_2 in |- *. intros. cut (in_dom _ a (MapDomRestrBy A B m m') = false). - rewrite in_dom_restrby. intro. elim (andb_false_elim _ _ H1). rewrite H0. - intro H2. discriminate H2. - intro H2. rewrite (negb_intro (in_dom B a m')). rewrite H2. reflexivity. - exact (map_dom_empty_1 _ H a). - Qed. - -End MapSubsetDef. - -Section MapSubsetOrder. - - Variables A B C : Set. - - Lemma MapSubset_refl : forall m:Map A, MapSubset A A m m. - Proof. - unfold MapSubset in |- *. trivial. - Qed. - - Lemma MapSubset_antisym : - forall (m:Map A) (m':Map B), - MapSubset A B m m' -> - MapSubset B A m' m -> eqmap unit (MapDom A m) (MapDom B m'). - Proof. - unfold MapSubset, eqmap, eqm in |- *. intros. elim (option_sum _ (MapGet _ (MapDom A m) a)). - intro H1. elim H1. intro t. elim t. intro H2. elim (option_sum _ (MapGet _ (MapDom B m') a)). - intro H3. elim H3. intro t'. elim t'. intro H4. rewrite H4. exact H2. - intro H3. cut (in_dom B a m' = true). intro. rewrite (MapDom_Dom B m' a) in H4. - unfold in_FSet, in_dom in H4. rewrite H3 in H4. discriminate H4. - apply H. rewrite (MapDom_Dom A m a). unfold in_FSet, in_dom in |- *. rewrite H2. reflexivity. - intro H1. elim (option_sum _ (MapGet _ (MapDom B m') a)). intro H2. elim H2. intros t H3. - cut (in_dom A a m = true). intro. rewrite (MapDom_Dom A m a) in H4. unfold in_FSet, in_dom in H4. - rewrite H1 in H4. discriminate H4. - apply H0. rewrite (MapDom_Dom B m' a). unfold in_FSet, in_dom in |- *. rewrite H3. reflexivity. - intro H2. rewrite H2. exact H1. - Qed. - - Lemma MapSubset_trans : - forall (m:Map A) (m':Map B) (m'':Map C), - MapSubset A B m m' -> MapSubset B C m' m'' -> MapSubset A C m m''. - Proof. - unfold MapSubset in |- *. intros. apply H0. apply H. assumption. - Qed. - -End MapSubsetOrder. - -Section FSubsetOrder. - - Lemma FSubset_refl : forall s:FSet, MapSubset _ _ s s. - Proof. - exact (MapSubset_refl unit). - Qed. - - Lemma FSubset_antisym : - forall s s':FSet, - MapSubset _ _ s s' -> MapSubset _ _ s' s -> eqmap unit s s'. - Proof. - intros. rewrite <- (FSet_Dom s). rewrite <- (FSet_Dom s'). - exact (MapSubset_antisym _ _ s s' H H0). - Qed. - - Lemma FSubset_trans : - forall s s' s'':FSet, - MapSubset _ _ s s' -> MapSubset _ _ s' s'' -> MapSubset _ _ s s''. - Proof. - exact (MapSubset_trans unit unit unit). - Qed. - -End FSubsetOrder. - -Section MapSubsetExtra. - - Variables A B : Set. - - Lemma MapSubset_Dom_1 : - forall (m:Map A) (m':Map B), - MapSubset A B m m' -> MapSubset unit unit (MapDom A m) (MapDom B m'). - Proof. - unfold MapSubset in |- *. intros. elim (MapDom_semantics_2 _ m a H0). intros y H1. - cut (in_dom A a m = true -> in_dom B a m' = true). intro. unfold in_dom in H2. - rewrite H1 in H2. elim (option_sum _ (MapGet B m' a)). intro H3. elim H3. - intros y' H4. exact (MapDom_semantics_1 _ m' a y' H4). - intro H3. rewrite H3 in H2. cut (false = true). intro. discriminate H4. - apply H2. reflexivity. - exact (H a). - Qed. - - Lemma MapSubset_Dom_2 : - forall (m:Map A) (m':Map B), - MapSubset unit unit (MapDom A m) (MapDom B m') -> MapSubset A B m m'. - Proof. - unfold MapSubset in |- *. intros. unfold in_dom in H0. elim (option_sum _ (MapGet A m a)). - intro H1. elim H1. intros y H2. - elim (MapDom_semantics_2 _ _ _ (H a (MapDom_semantics_1 _ _ _ _ H2))). intros y' H3. - unfold in_dom in |- *. rewrite H3. reflexivity. - intro H1. rewrite H1 in H0. discriminate H0. - Qed. - - Lemma MapSubset_1_Dom : - forall (m:Map A) (m':Map B), - MapSubset_1 A B m m' = MapSubset_1 unit unit (MapDom A m) (MapDom B m'). - Proof. - intros. elim (sumbool_of_bool (MapSubset_1 A B m m')). intro H. rewrite H. - apply sym_eq. apply MapSubset_imp_1. apply MapSubset_Dom_1. exact (MapSubset_1_imp _ _ _ _ H). - intro H. rewrite H. elim (sumbool_of_bool (MapSubset_1 unit unit (MapDom A m) (MapDom B m'))). - intro H0. - rewrite - (MapSubset_imp_1 _ _ _ _ - (MapSubset_Dom_2 _ _ (MapSubset_1_imp _ _ _ _ H0))) - in H. - discriminate H. - intro. apply sym_eq. assumption. - Qed. - - Lemma MapSubset_Put : - forall (m:Map A) (a:ad) (y:A), MapSubset A A m (MapPut A m a y). - Proof. - unfold MapSubset in |- *. intros. rewrite in_dom_put. rewrite H. apply orb_b_true. - Qed. - - Lemma MapSubset_Put_mono : - forall (m:Map A) (m':Map B) (a:ad) (y:A) (y':B), - MapSubset A B m m' -> MapSubset A B (MapPut A m a y) (MapPut B m' a y'). - Proof. - unfold MapSubset in |- *. intros. rewrite in_dom_put. rewrite (in_dom_put A m a y a0) in H0. - elim (orb_true_elim _ _ H0). intro H1. rewrite H1. reflexivity. - intro H1. rewrite (H _ H1). apply orb_b_true. - Qed. - - Lemma MapSubset_Put_behind : - forall (m:Map A) (a:ad) (y:A), MapSubset A A m (MapPut_behind A m a y). - Proof. - unfold MapSubset in |- *. intros. rewrite in_dom_put_behind. rewrite H. apply orb_b_true. - Qed. - - Lemma MapSubset_Put_behind_mono : - forall (m:Map A) (m':Map B) (a:ad) (y:A) (y':B), - MapSubset A B m m' -> - MapSubset A B (MapPut_behind A m a y) (MapPut_behind B m' a y'). - Proof. - unfold MapSubset in |- *. intros. rewrite in_dom_put_behind. - rewrite (in_dom_put_behind A m a y a0) in H0. - elim (orb_true_elim _ _ H0). intro H1. rewrite H1. reflexivity. - intro H1. rewrite (H _ H1). apply orb_b_true. - Qed. - - Lemma MapSubset_Remove : - forall (m:Map A) (a:ad), MapSubset A A (MapRemove A m a) m. - Proof. - unfold MapSubset in |- *. intros. unfold MapSubset in |- *. intros. rewrite (in_dom_remove _ m a a0) in H. - elim (andb_prop _ _ H). trivial. - Qed. - - Lemma MapSubset_Remove_mono : - forall (m:Map A) (m':Map B) (a:ad), - MapSubset A B m m' -> MapSubset A B (MapRemove A m a) (MapRemove B m' a). - Proof. - unfold MapSubset in |- *. intros. rewrite in_dom_remove. rewrite (in_dom_remove A m a a0) in H0. - elim (andb_prop _ _ H0). intros. rewrite H1. rewrite (H _ H2). reflexivity. - Qed. - - Lemma MapSubset_Merge_l : - forall m m':Map A, MapSubset A A m (MapMerge A m m'). - Proof. - unfold MapSubset in |- *. intros. rewrite in_dom_merge. rewrite H. reflexivity. - Qed. - - Lemma MapSubset_Merge_r : - forall m m':Map A, MapSubset A A m' (MapMerge A m m'). - Proof. - unfold MapSubset in |- *. intros. rewrite in_dom_merge. rewrite H. apply orb_b_true. - Qed. - - Lemma MapSubset_Merge_mono : - forall (m m':Map A) (m'' m''':Map B), - MapSubset A B m m'' -> - MapSubset A B m' m''' -> - MapSubset A B (MapMerge A m m') (MapMerge B m'' m'''). - Proof. - unfold MapSubset in |- *. intros. rewrite in_dom_merge. rewrite (in_dom_merge A m m' a) in H1. - elim (orb_true_elim _ _ H1). intro H2. rewrite (H _ H2). reflexivity. - intro H2. rewrite (H0 _ H2). apply orb_b_true. - Qed. - - Lemma MapSubset_DomRestrTo_l : - forall (m:Map A) (m':Map B), MapSubset A A (MapDomRestrTo A B m m') m. - Proof. - unfold MapSubset in |- *. intros. rewrite (in_dom_restrto _ _ m m' a) in H. elim (andb_prop _ _ H). - trivial. - Qed. - - Lemma MapSubset_DomRestrTo_r : - forall (m:Map A) (m':Map B), MapSubset A B (MapDomRestrTo A B m m') m'. - Proof. - unfold MapSubset in |- *. intros. rewrite (in_dom_restrto _ _ m m' a) in H. elim (andb_prop _ _ H). - trivial. - Qed. - - Lemma MapSubset_ext : - forall (m0 m1:Map A) (m2 m3:Map B), - eqmap A m0 m1 -> - eqmap B m2 m3 -> MapSubset A B m0 m2 -> MapSubset A B m1 m3. - Proof. - intros. apply MapSubset_2_imp. unfold MapSubset_2 in |- *. - apply eqmap_trans with (m' := MapDomRestrBy A B m0 m2). apply MapDomRestrBy_ext. apply eqmap_sym. - assumption. - apply eqmap_sym. assumption. - exact (MapSubset_imp_2 _ _ _ _ H1). - Qed. - - Variables C D : Set. - - Lemma MapSubset_DomRestrTo_mono : - forall (m:Map A) (m':Map B) (m'':Map C) (m''':Map D), - MapSubset _ _ m m'' -> - MapSubset _ _ m' m''' -> - MapSubset _ _ (MapDomRestrTo _ _ m m') (MapDomRestrTo _ _ m'' m'''). - Proof. - unfold MapSubset in |- *. intros. rewrite in_dom_restrto. rewrite (in_dom_restrto A B m m' a) in H1. - elim (andb_prop _ _ H1). intros. rewrite (H _ H2). rewrite (H0 _ H3). reflexivity. - Qed. - - Lemma MapSubset_DomRestrBy_l : - forall (m:Map A) (m':Map B), MapSubset A A (MapDomRestrBy A B m m') m. - Proof. - unfold MapSubset in |- *. intros. rewrite (in_dom_restrby _ _ m m' a) in H. elim (andb_prop _ _ H). - trivial. - Qed. - - Lemma MapSubset_DomRestrBy_mono : - forall (m:Map A) (m':Map B) (m'':Map C) (m''':Map D), - MapSubset _ _ m m'' -> - MapSubset _ _ m''' m' -> - MapSubset _ _ (MapDomRestrBy _ _ m m') (MapDomRestrBy _ _ m'' m'''). - Proof. - unfold MapSubset in |- *. intros. rewrite in_dom_restrby. rewrite (in_dom_restrby A B m m' a) in H1. - elim (andb_prop _ _ H1). intros. rewrite (H _ H2). elim (sumbool_of_bool (in_dom D a m''')). - intro H4. rewrite (H0 _ H4) in H3. discriminate H3. - intro H4. rewrite H4. reflexivity. - Qed. - -End MapSubsetExtra. - -Section MapDisjointDef. - - Variables A B : Set. - - Definition MapDisjoint (m:Map A) (m':Map B) := - forall a:ad, in_dom A a m = true -> in_dom B a m' = true -> False. - - Definition MapDisjoint_1 (m:Map A) (m':Map B) := - match MapSweep A (fun (a:ad) (_:A) => in_dom B a m') m with - | None => true - | _ => false - end. - - Definition MapDisjoint_2 (m:Map A) (m':Map B) := - eqmap A (MapDomRestrTo A B m m') (M0 A). - - Lemma MapDisjoint_imp_1 : - forall (m:Map A) (m':Map B), MapDisjoint m m' -> MapDisjoint_1 m m' = true. - Proof. - unfold MapDisjoint, MapDisjoint_1 in |- *. intros. - elim (option_sum _ (MapSweep A (fun (a:ad) (_:A) => in_dom B a m') m)). intro H0. elim H0. - intro r. elim r. intros a y H1. cut (in_dom A a m = true -> in_dom B a m' = true -> False). - intro. unfold in_dom at 1 in H2. rewrite (MapSweep_semantics_2 _ _ _ _ _ H1) in H2. - rewrite (MapSweep_semantics_1 _ _ _ _ _ H1) in H2. elim (H2 (refl_equal _) (refl_equal _)). - exact (H a). - intro H0. rewrite H0. reflexivity. - Qed. - - Lemma MapDisjoint_1_imp : - forall (m:Map A) (m':Map B), MapDisjoint_1 m m' = true -> MapDisjoint m m'. - Proof. - unfold MapDisjoint, MapDisjoint_1 in |- *. intros. - elim (option_sum _ (MapSweep A (fun (a:ad) (_:A) => in_dom B a m') m)). intro H2. elim H2. - intro r. elim r. intros a' y' H3. rewrite H3 in H. discriminate H. - intro H2. unfold in_dom in H0. elim (option_sum _ (MapGet A m a)). intro H3. elim H3. - intros y H4. rewrite (MapSweep_semantics_3 _ _ _ H2 a y H4) in H1. discriminate H1. - intro H3. rewrite H3 in H0. discriminate H0. - Qed. - - Lemma MapDisjoint_imp_2 : - forall (m:Map A) (m':Map B), MapDisjoint m m' -> MapDisjoint_2 m m'. - Proof. - unfold MapDisjoint, MapDisjoint_2 in |- *. unfold eqmap, eqm in |- *. intros. - rewrite (MapDomRestrTo_semantics A B m m' a). - cut (in_dom A a m = true -> in_dom B a m' = true -> False). intro. - elim (option_sum _ (MapGet A m a)). intro H1. elim H1. intros y H2. unfold in_dom at 1 in H0. - elim (option_sum _ (MapGet B m' a)). intro H3. elim H3. intros y' H4. unfold in_dom at 1 in H0. - rewrite H4 in H0. rewrite H2 in H0. elim (H0 (refl_equal _) (refl_equal _)). - intro H3. rewrite H3. reflexivity. - intro H1. rewrite H1. case (MapGet B m' a); reflexivity. - exact (H a). - Qed. - - Lemma MapDisjoint_2_imp : - forall (m:Map A) (m':Map B), MapDisjoint_2 m m' -> MapDisjoint m m'. - Proof. - unfold MapDisjoint, MapDisjoint_2 in |- *. unfold eqmap, eqm in |- *. intros. elim (in_dom_some _ _ _ H0). - intros y H2. elim (in_dom_some _ _ _ H1). intros y' H3. - cut (MapGet A (MapDomRestrTo A B m m') a = None). intro. - rewrite (MapDomRestrTo_semantics _ _ m m' a) in H4. rewrite H3 in H4. rewrite H2 in H4. - discriminate H4. - exact (H a). - Qed. - - Lemma Map_M0_disjoint : forall m:Map B, MapDisjoint (M0 A) m. - Proof. - unfold MapDisjoint, in_dom in |- *. intros. discriminate H. - Qed. - - Lemma Map_disjoint_M0 : forall m:Map A, MapDisjoint m (M0 B). - Proof. - unfold MapDisjoint, in_dom in |- *. intros. discriminate H0. - Qed. - -End MapDisjointDef. - -Section MapDisjointExtra. - - Variables A B : Set. - - Lemma MapDisjoint_ext : - forall (m0 m1:Map A) (m2 m3:Map B), - eqmap A m0 m1 -> - eqmap B m2 m3 -> MapDisjoint A B m0 m2 -> MapDisjoint A B m1 m3. - Proof. - intros. apply MapDisjoint_2_imp. unfold MapDisjoint_2 in |- *. - apply eqmap_trans with (m' := MapDomRestrTo A B m0 m2). apply eqmap_sym. apply MapDomRestrTo_ext. - assumption. - assumption. - exact (MapDisjoint_imp_2 _ _ _ _ H1). - Qed. - - Lemma MapMerge_disjoint : - forall m m':Map A, - MapDisjoint A A m m' -> - forall a:ad, - in_dom A a (MapMerge A m m') = - orb (andb (in_dom A a m) (negb (in_dom A a m'))) - (andb (in_dom A a m') (negb (in_dom A a m))). - Proof. - unfold MapDisjoint in |- *. intros. rewrite in_dom_merge. elim (sumbool_of_bool (in_dom A a m)). - intro H0. rewrite H0. elim (sumbool_of_bool (in_dom A a m')). intro H1. elim (H a H0 H1). - intro H1. rewrite H1. reflexivity. - intro H0. rewrite H0. simpl in |- *. rewrite andb_b_true. reflexivity. - Qed. - - Lemma MapDisjoint_M2_l : - forall (m0 m1:Map A) (m2 m3:Map B), - MapDisjoint A B (M2 A m0 m1) (M2 B m2 m3) -> MapDisjoint A B m0 m2. - Proof. - unfold MapDisjoint, in_dom in |- *. intros. elim (option_sum _ (MapGet A m0 a)). intro H2. - elim H2. intros y H3. elim (option_sum _ (MapGet B m2 a)). intro H4. elim H4. - intros y' H5. apply (H (Ndouble a)). - rewrite (MapGet_M2_bit_0_0 _ (Ndouble a) (Ndouble_bit0 a) m0 m1). - rewrite (Ndouble_div2 a). rewrite H3. reflexivity. - rewrite (MapGet_M2_bit_0_0 _ (Ndouble a) (Ndouble_bit0 a) m2 m3). - rewrite (Ndouble_div2 a). rewrite H5. reflexivity. - intro H4. rewrite H4 in H1. discriminate H1. - intro H2. rewrite H2 in H0. discriminate H0. - Qed. - - Lemma MapDisjoint_M2_r : - forall (m0 m1:Map A) (m2 m3:Map B), - MapDisjoint A B (M2 A m0 m1) (M2 B m2 m3) -> MapDisjoint A B m1 m3. - Proof. - unfold MapDisjoint, in_dom in |- *. intros. elim (option_sum _ (MapGet A m1 a)). intro H2. - elim H2. intros y H3. elim (option_sum _ (MapGet B m3 a)). intro H4. elim H4. - intros y' H5. apply (H (Ndouble_plus_one a)). - rewrite - (MapGet_M2_bit_0_1 _ (Ndouble_plus_one a) (Ndouble_plus_one_bit0 a) - m0 m1). - rewrite (Ndouble_plus_one_div2 a). rewrite H3. reflexivity. - rewrite - (MapGet_M2_bit_0_1 _ (Ndouble_plus_one a) (Ndouble_plus_one_bit0 a) - m2 m3). - rewrite (Ndouble_plus_one_div2 a). rewrite H5. reflexivity. - intro H4. rewrite H4 in H1. discriminate H1. - intro H2. rewrite H2 in H0. discriminate H0. - Qed. - - Lemma MapDisjoint_M2 : - forall (m0 m1:Map A) (m2 m3:Map B), - MapDisjoint A B m0 m2 -> - MapDisjoint A B m1 m3 -> MapDisjoint A B (M2 A m0 m1) (M2 B m2 m3). - Proof. - unfold MapDisjoint, in_dom in |- *. intros. elim (sumbool_of_bool (Nbit0 a)). intro H3. - rewrite (MapGet_M2_bit_0_1 A a H3 m0 m1) in H1. - rewrite (MapGet_M2_bit_0_1 B a H3 m2 m3) in H2. exact (H0 (Ndiv2 a) H1 H2). - intro H3. rewrite (MapGet_M2_bit_0_0 A a H3 m0 m1) in H1. - rewrite (MapGet_M2_bit_0_0 B a H3 m2 m3) in H2. exact (H (Ndiv2 a) H1 H2). - Qed. - - Lemma MapDisjoint_M1_l : - forall (m:Map A) (a:ad) (y:B), - MapDisjoint B A (M1 B a y) m -> in_dom A a m = false. - Proof. - unfold MapDisjoint in |- *. intros. elim (sumbool_of_bool (in_dom A a m)). intro H0. - elim (H a (in_dom_M1_1 B a y) H0). - trivial. - Qed. - - Lemma MapDisjoint_M1_r : - forall (m:Map A) (a:ad) (y:B), - MapDisjoint A B m (M1 B a y) -> in_dom A a m = false. - Proof. - unfold MapDisjoint in |- *. intros. elim (sumbool_of_bool (in_dom A a m)). intro H0. - elim (H a H0 (in_dom_M1_1 B a y)). - trivial. - Qed. - - Lemma MapDisjoint_M1_conv_l : - forall (m:Map A) (a:ad) (y:B), - in_dom A a m = false -> MapDisjoint B A (M1 B a y) m. - Proof. - unfold MapDisjoint in |- *. intros. rewrite (in_dom_M1_2 B a a0 y H0) in H. rewrite H1 in H. - discriminate H. - Qed. - - Lemma MapDisjoint_M1_conv_r : - forall (m:Map A) (a:ad) (y:B), - in_dom A a m = false -> MapDisjoint A B m (M1 B a y). - Proof. - unfold MapDisjoint in |- *. intros. rewrite (in_dom_M1_2 B a a0 y H1) in H. rewrite H0 in H. - discriminate H. - Qed. - - Lemma MapDisjoint_sym : - forall (m:Map A) (m':Map B), MapDisjoint A B m m' -> MapDisjoint B A m' m. - Proof. - unfold MapDisjoint in |- *. intros. exact (H _ H1 H0). - Qed. - - Lemma MapDisjoint_empty : - forall m:Map A, MapDisjoint A A m m -> eqmap A m (M0 A). - Proof. - unfold eqmap, eqm in |- *. intros. rewrite <- (MapDomRestrTo_idempotent A m a). - exact (MapDisjoint_imp_2 A A m m H a). - Qed. - - Lemma MapDelta_disjoint : - forall m m':Map A, - MapDisjoint A A m m' -> eqmap A (MapDelta A m m') (MapMerge A m m'). - Proof. - intros. - apply eqmap_trans with - (m' := MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m m')). - apply MapDelta_as_DomRestrBy. - apply eqmap_trans with (m' := MapDomRestrBy A A (MapMerge A m m') (M0 A)). - apply MapDomRestrBy_ext. apply eqmap_refl. - exact (MapDisjoint_imp_2 A A m m' H). - apply MapDomRestrBy_m_empty. - Qed. - - Variable C : Set. - - Lemma MapDomRestr_disjoint : - forall (m:Map A) (m':Map B) (m'':Map C), - MapDisjoint A B (MapDomRestrTo A C m m'') (MapDomRestrBy B C m' m''). - Proof. - unfold MapDisjoint in |- *. intros m m' m'' a. rewrite in_dom_restrto. rewrite in_dom_restrby. - intros. elim (andb_prop _ _ H). elim (andb_prop _ _ H0). intros. rewrite H4 in H2. - discriminate H2. - Qed. - - Lemma MapDelta_RestrTo_disjoint : - forall m m':Map A, - MapDisjoint A A (MapDelta A m m') (MapDomRestrTo A A m m'). - Proof. - unfold MapDisjoint in |- *. intros m m' a. rewrite in_dom_delta. rewrite in_dom_restrto. - intros. elim (andb_prop _ _ H0). intros. rewrite H1 in H. rewrite H2 in H. discriminate H. - Qed. - - Lemma MapDelta_RestrTo_disjoint_2 : - forall m m':Map A, - MapDisjoint A A (MapDelta A m m') (MapDomRestrTo A A m' m). - Proof. - unfold MapDisjoint in |- *. intros m m' a. rewrite in_dom_delta. rewrite in_dom_restrto. - intros. elim (andb_prop _ _ H0). intros. rewrite H1 in H. rewrite H2 in H. discriminate H. - Qed. - - Variable D : Set. - - Lemma MapSubset_Disjoint : - forall (m:Map A) (m':Map B) (m'':Map C) (m''':Map D), - MapSubset _ _ m m' -> - MapSubset _ _ m'' m''' -> - MapDisjoint _ _ m' m''' -> MapDisjoint _ _ m m''. - Proof. - unfold MapSubset, MapDisjoint in |- *. intros. exact (H1 _ (H _ H2) (H0 _ H3)). - Qed. - - Lemma MapSubset_Disjoint_l : - forall (m:Map A) (m':Map B) (m'':Map C), - MapSubset _ _ m m' -> MapDisjoint _ _ m' m'' -> MapDisjoint _ _ m m''. - Proof. - unfold MapSubset, MapDisjoint in |- *. intros. exact (H0 _ (H _ H1) H2). - Qed. - - Lemma MapSubset_Disjoint_r : - forall (m:Map A) (m'':Map C) (m''':Map D), - MapSubset _ _ m'' m''' -> - MapDisjoint _ _ m m''' -> MapDisjoint _ _ m m''. - Proof. - unfold MapSubset, MapDisjoint in |- *. intros. exact (H0 _ H1 (H _ H2)). - Qed. - -End MapDisjointExtra.
\ No newline at end of file diff --git a/theories/IntMap/intro.tex b/theories/IntMap/intro.tex deleted file mode 100644 index 9ad93050..00000000 --- a/theories/IntMap/intro.tex +++ /dev/null @@ -1,6 +0,0 @@ -\section{Maps indexed by binary integers : IntMap}\label{IntMap} - -This library contains a data structure for finite sets implemented by -an efficient structure of map (trees indexed by binary integers). -It was initially developed by Jean Goubault. - |