From 3ef7797ef6fc605dfafb32523261fe1b023aeecb Mon Sep 17 00:00:00 2001 From: Samuel Mimram Date: Fri, 28 Apr 2006 14:59:16 +0000 Subject: Imported Upstream version 8.0pl3+8.1alpha --- theories7/IntMap/Adalloc.v | 339 ------------------- theories7/IntMap/Addec.v | 179 ---------- theories7/IntMap/Addr.v | 456 ------------------------- theories7/IntMap/Adist.v | 321 ------------------ theories7/IntMap/Allmaps.v | 26 -- theories7/IntMap/Fset.v | 338 ------------------- theories7/IntMap/Lsort.v | 537 ----------------------------- theories7/IntMap/Map.v | 786 ------------------------------------------- theories7/IntMap/Mapaxioms.v | 670 ------------------------------------ theories7/IntMap/Mapc.v | 457 ------------------------- theories7/IntMap/Mapcanon.v | 376 --------------------- theories7/IntMap/Mapcard.v | 670 ------------------------------------ theories7/IntMap/Mapfold.v | 381 --------------------- theories7/IntMap/Mapiter.v | 527 ----------------------------- theories7/IntMap/Maplists.v | 399 ---------------------- theories7/IntMap/Mapsubset.v | 554 ------------------------------ 16 files changed, 7016 deletions(-) delete mode 100644 theories7/IntMap/Adalloc.v delete mode 100644 theories7/IntMap/Addec.v delete mode 100644 theories7/IntMap/Addr.v delete mode 100644 theories7/IntMap/Adist.v delete mode 100644 theories7/IntMap/Allmaps.v delete mode 100644 theories7/IntMap/Fset.v delete mode 100644 theories7/IntMap/Lsort.v delete mode 100644 theories7/IntMap/Map.v delete mode 100644 theories7/IntMap/Mapaxioms.v delete mode 100644 theories7/IntMap/Mapc.v delete mode 100644 theories7/IntMap/Mapcanon.v delete mode 100644 theories7/IntMap/Mapcard.v delete mode 100644 theories7/IntMap/Mapfold.v delete mode 100644 theories7/IntMap/Mapiter.v delete mode 100644 theories7/IntMap/Maplists.v delete mode 100644 theories7/IntMap/Mapsubset.v (limited to 'theories7/IntMap') diff --git a/theories7/IntMap/Adalloc.v b/theories7/IntMap/Adalloc.v deleted file mode 100644 index 9e8dd1b3..00000000 --- a/theories7/IntMap/Adalloc.v +++ /dev/null @@ -1,339 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* O - | (ad_x p) => (convert p) - end. - - Fixpoint nat_le [m:nat] : nat -> bool := - Cases m of - O => [_:nat] true - | (S m') => [n:nat] Cases n of - O => false - | (S n') => (nat_le m' n') - end - end. - - Lemma nat_le_correct : (m,n:nat) (le m n) -> (nat_le m n)=true. - Proof. - NewInduction m as [|m IHm]. Trivial. - NewDestruct n. Intro H. Elim (le_Sn_O ? H). - Intros. Simpl. Apply IHm. Apply le_S_n. Assumption. - Qed. - - Lemma nat_le_complete : (m,n:nat) (nat_le m n)=true -> (le m n). - Proof. - NewInduction m. Trivial with arith. - NewDestruct n. Intro H. Discriminate H. - Auto with arith. - Qed. - - Lemma nat_le_correct_conv : (m,n:nat) (lt m n) -> (nat_le n m)=false. - Proof. - Intros. Elim (sumbool_of_bool (nat_le n m)). Intro H0. - Elim (lt_n_n ? (lt_le_trans ? ? ? H (nat_le_complete ? ? H0))). - Trivial. - Qed. - - Lemma nat_le_complete_conv : (m,n:nat) (nat_le n m)=false -> (lt m n). - Proof. - Intros. Elim (le_or_lt n m). Intro. Conditional Trivial Rewrite nat_le_correct in H. Discriminate H. - Trivial. - Qed. - - Definition ad_of_nat := [n:nat] Cases n of - O => ad_z - | (S n') => (ad_x (anti_convert n')) - end. - - Lemma ad_of_nat_of_ad : (a:ad) (ad_of_nat (nat_of_ad a))=a. - Proof. - NewDestruct a as [|p]. Reflexivity. - Simpl. Elim (ZL4 p). Intros n H. Rewrite H. Simpl. Rewrite <- bij1 in H. - Rewrite convert_intro with 1:=H. Reflexivity. - Qed. - - Lemma nat_of_ad_of_nat : (n:nat) (nat_of_ad (ad_of_nat n))=n. - Proof. - NewInduction n. Trivial. - Intros. Simpl. Apply bij1. - Qed. - - Definition ad_le := [a,b:ad] (nat_le (nat_of_ad a) (nat_of_ad b)). - - Lemma ad_le_refl : (a:ad) (ad_le a a)=true. - Proof. - Intro. Unfold ad_le. Apply nat_le_correct. Apply le_n. - Qed. - - Lemma ad_le_antisym : (a,b:ad) (ad_le a b)=true -> (ad_le b a)=true -> a=b. - Proof. - Unfold ad_le. Intros. Rewrite <- (ad_of_nat_of_ad a). Rewrite <- (ad_of_nat_of_ad b). - Rewrite (le_antisym ? ? (nat_le_complete ? ? H) (nat_le_complete ? ? H0)). Reflexivity. - Qed. - - Lemma ad_le_trans : (a,b,c:ad) (ad_le a b)=true -> (ad_le b c)=true -> - (ad_le a c)=true. - Proof. - Unfold ad_le. Intros. Apply nat_le_correct. Apply le_trans with m:=(nat_of_ad b). - Apply nat_le_complete. Assumption. - Apply nat_le_complete. Assumption. - Qed. - - Lemma ad_le_lt_trans : (a,b,c:ad) (ad_le a b)=true -> (ad_le c b)=false -> - (ad_le c a)=false. - Proof. - Unfold ad_le. Intros. Apply nat_le_correct_conv. Apply le_lt_trans with m:=(nat_of_ad b). - Apply nat_le_complete. Assumption. - Apply nat_le_complete_conv. Assumption. - Qed. - - Lemma ad_lt_le_trans : (a,b,c:ad) (ad_le b a)=false -> (ad_le b c)=true -> - (ad_le c a)=false. - Proof. - Unfold ad_le. Intros. Apply nat_le_correct_conv. Apply lt_le_trans with m:=(nat_of_ad b). - Apply nat_le_complete_conv. Assumption. - Apply nat_le_complete. Assumption. - Qed. - - Lemma ad_lt_trans : (a,b,c:ad) (ad_le b a)=false -> (ad_le c b)=false -> - (ad_le c a)=false. - Proof. - Unfold ad_le. Intros. Apply nat_le_correct_conv. Apply lt_trans with m:=(nat_of_ad b). - Apply nat_le_complete_conv. Assumption. - Apply nat_le_complete_conv. Assumption. - Qed. - - Lemma ad_lt_le_weak : (a,b:ad) (ad_le b a)=false -> (ad_le a b)=true. - Proof. - Unfold ad_le. Intros. Apply nat_le_correct. Apply lt_le_weak. - Apply nat_le_complete_conv. Assumption. - Qed. - - Definition ad_min := [a,b:ad] if (ad_le a b) then a else b. - - Lemma ad_min_choice : (a,b:ad) {(ad_min a b)=a}+{(ad_min a b)=b}. - Proof. - Unfold ad_min. Intros. Elim (sumbool_of_bool (ad_le a b)). Intro H. Left . Rewrite H. - Reflexivity. - Intro H. Right . Rewrite H. Reflexivity. - Qed. - - Lemma ad_min_le_1 : (a,b:ad) (ad_le (ad_min a b) a)=true. - Proof. - Unfold ad_min. Intros. Elim (sumbool_of_bool (ad_le a b)). Intro H. Rewrite H. - Apply ad_le_refl. - Intro H. Rewrite H. Apply ad_lt_le_weak. Assumption. - Qed. - - Lemma ad_min_le_2 : (a,b:ad) (ad_le (ad_min a b) b)=true. - Proof. - Unfold ad_min. Intros. Elim (sumbool_of_bool (ad_le a b)). Intro H. Rewrite H. Assumption. - Intro H. Rewrite H. Apply ad_le_refl. - Qed. - - Lemma ad_min_le_3 : (a,b,c:ad) (ad_le a (ad_min b c))=true -> (ad_le a b)=true. - Proof. - Unfold ad_min. Intros. Elim (sumbool_of_bool (ad_le b c)). Intro H0. Rewrite H0 in H. - Assumption. - Intro H0. Rewrite H0 in H. Apply ad_lt_le_weak. Apply ad_le_lt_trans with b:=c; Assumption. - Qed. - - Lemma ad_min_le_4 : (a,b,c:ad) (ad_le a (ad_min b c))=true -> (ad_le a c)=true. - Proof. - Unfold ad_min. Intros. Elim (sumbool_of_bool (ad_le b c)). Intro H0. Rewrite H0 in H. - Apply ad_le_trans with b:=b; Assumption. - Intro H0. Rewrite H0 in H. Assumption. - Qed. - - Lemma ad_min_le_5 : (a,b,c:ad) (ad_le a b)=true -> (ad_le a c)=true -> - (ad_le a (ad_min b c))=true. - Proof. - Intros. Elim (ad_min_choice b c). Intro H1. Rewrite H1. Assumption. - Intro H1. Rewrite H1. Assumption. - Qed. - - Lemma ad_min_lt_3 : (a,b,c:ad) (ad_le (ad_min b c) a)=false -> (ad_le b a)=false. - Proof. - Unfold ad_min. Intros. Elim (sumbool_of_bool (ad_le b c)). Intro H0. Rewrite H0 in H. - Assumption. - Intro H0. Rewrite H0 in H. Apply ad_lt_trans with b:=c; Assumption. - Qed. - - Lemma ad_min_lt_4 : (a,b,c:ad) (ad_le (ad_min b c) a)=false -> (ad_le c a)=false. - Proof. - Unfold ad_min. Intros. Elim (sumbool_of_bool (ad_le b c)). Intro H0. Rewrite H0 in H. - Apply ad_lt_le_trans with b:=b; Assumption. - Intro H0. Rewrite H0 in H. Assumption. - Qed. - - (** 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 := - Cases m of - M0 => ad_z - | (M1 a _) => if (ad_eq a ad_z) - then (ad_x xH) - else ad_z - | (M2 m1 m2) => (ad_min (ad_double (ad_alloc_opt m1)) - (ad_double_plus_un (ad_alloc_opt m2))) - end. - - Lemma ad_alloc_opt_allocates_1 : (m:(Map A)) (MapGet A m (ad_alloc_opt m))=(NONE A). - Proof. - NewInduction m as [|a|m0 H m1 H0]. Reflexivity. - Simpl. Elim (sumbool_of_bool (ad_eq a ad_z)). Intro H. Rewrite H. - Rewrite (ad_eq_complete ? ? H). Reflexivity. - Intro H. Rewrite H. Rewrite H. Reflexivity. - Intros. Change (ad_alloc_opt (M2 A m0 m1)) with - (ad_min (ad_double (ad_alloc_opt m0)) (ad_double_plus_un (ad_alloc_opt m1))). - Elim (ad_min_choice (ad_double (ad_alloc_opt m0)) (ad_double_plus_un (ad_alloc_opt m1))). - Intro H1. Rewrite H1. Rewrite MapGet_M2_bit_0_0. Rewrite ad_double_div_2. Assumption. - Apply ad_double_bit_0. - Intro H1. Rewrite H1. Rewrite MapGet_M2_bit_0_1. Rewrite ad_double_plus_un_div_2. Assumption. - Apply ad_double_plus_un_bit_0. - Qed. - - Lemma ad_alloc_opt_allocates : (m:(Map A)) (in_dom A (ad_alloc_opt m) m)=false. - Proof. - Unfold in_dom. 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 nat_of_ad_double : (a:ad) (nat_of_ad (ad_double a))=(mult (2) (nat_of_ad a)). - Proof. - NewDestruct a as [|p]. Trivial. - Exact (convert_xO p). - Qed. - - Lemma nat_of_ad_double_plus_un : (a:ad) - (nat_of_ad (ad_double_plus_un a))=(S (mult (2) (nat_of_ad a))). - Proof. - NewDestruct a as [|p]. Trivial. - Exact (convert_xI p). - Qed. - - Lemma ad_le_double_mono : (a,b:ad) (ad_le a b)=true -> - (ad_le (ad_double a) (ad_double b))=true. - Proof. - Unfold ad_le. Intros. Rewrite nat_of_ad_double. Rewrite nat_of_ad_double. Apply nat_le_correct. - Simpl. Apply le_plus_plus. Apply nat_le_complete. Assumption. - Apply le_plus_plus. Apply nat_le_complete. Assumption. - Apply le_n. - Qed. - - Lemma ad_le_double_plus_un_mono : (a,b:ad) (ad_le a b)=true -> - (ad_le (ad_double_plus_un a) (ad_double_plus_un b))=true. - Proof. - Unfold ad_le. Intros. Rewrite nat_of_ad_double_plus_un. Rewrite nat_of_ad_double_plus_un. - Apply nat_le_correct. Apply le_n_S. Simpl. Apply le_plus_plus. Apply nat_le_complete. - Assumption. - Apply le_plus_plus. Apply nat_le_complete. Assumption. - Apply le_n. - Qed. - - Lemma ad_le_double_mono_conv : (a,b:ad) (ad_le (ad_double a) (ad_double b))=true -> - (ad_le a b)=true. - Proof. - Unfold ad_le. Intros a b. Rewrite nat_of_ad_double. Rewrite nat_of_ad_double. Intro. - Apply nat_le_correct. Apply (mult_le_conv_1 (1)). Apply nat_le_complete. Assumption. - Qed. - - Lemma ad_le_double_plus_un_mono_conv : (a,b:ad) - (ad_le (ad_double_plus_un a) (ad_double_plus_un b))=true -> (ad_le a b)=true. - Proof. - Unfold ad_le. Intros a b. Rewrite nat_of_ad_double_plus_un. Rewrite nat_of_ad_double_plus_un. - Intro. Apply nat_le_correct. Apply (mult_le_conv_1 (1)). Apply le_S_n. Apply nat_le_complete. - Assumption. - Qed. - - Lemma ad_lt_double_mono : (a,b:ad) (ad_le a b)=false -> - (ad_le (ad_double a) (ad_double b))=false. - Proof. - Intros. Elim (sumbool_of_bool (ad_le (ad_double a) (ad_double b))). Intro H0. - Rewrite (ad_le_double_mono_conv ? ? H0) in H. Discriminate H. - Trivial. - Qed. - - Lemma ad_lt_double_plus_un_mono : (a,b:ad) (ad_le a b)=false -> - (ad_le (ad_double_plus_un a) (ad_double_plus_un b))=false. - Proof. - Intros. Elim (sumbool_of_bool (ad_le (ad_double_plus_un a) (ad_double_plus_un b))). Intro H0. - Rewrite (ad_le_double_plus_un_mono_conv ? ? H0) in H. Discriminate H. - Trivial. - Qed. - - Lemma ad_lt_double_mono_conv : (a,b:ad) (ad_le (ad_double a) (ad_double b))=false -> - (ad_le a b)=false. - Proof. - Intros. Elim (sumbool_of_bool (ad_le a b)). Intro H0. Rewrite (ad_le_double_mono ? ? H0) in H. - Discriminate H. - Trivial. - Qed. - - Lemma ad_lt_double_plus_un_mono_conv : (a,b:ad) - (ad_le (ad_double_plus_un a) (ad_double_plus_un b))=false -> (ad_le a b)=false. - Proof. - Intros. Elim (sumbool_of_bool (ad_le a b)). Intro H0. - Rewrite (ad_le_double_plus_un_mono ? ? H0) in H. Discriminate H. - Trivial. - Qed. - - Lemma ad_alloc_opt_optimal_1 : (m:(Map A)) (a:ad) (ad_le (ad_alloc_opt m) a)=false -> - {y:A | (MapGet A m a)=(SOME A y)}. - Proof. - NewInduction m as [|a y|m0 H m1 H0]. Simpl. Unfold ad_le. Simpl. Intros. Discriminate H. - Simpl. Intros b H. Elim (sumbool_of_bool (ad_eq a ad_z)). Intro H0. Rewrite H0 in H. - Unfold ad_le in H. Cut ad_z=b. Intro. Split with y. Rewrite <- H1. Rewrite H0. Reflexivity. - Rewrite <- (ad_of_nat_of_ad b). - Rewrite <- (le_n_O_eq ? (le_S_n ? ? (nat_le_complete_conv ? ? H))). Reflexivity. - Intro H0. Rewrite H0 in H. Discriminate H. - Intros. Simpl in H1. Elim (ad_double_or_double_plus_un a). Intro H2. Elim H2. Intros a0 H3. - Rewrite H3 in H1. Elim (H ? (ad_lt_double_mono_conv ? ? (ad_min_lt_3 ? ? ? H1))). Intros y H4. - Split with y. Rewrite H3. Rewrite MapGet_M2_bit_0_0. Rewrite ad_double_div_2. Assumption. - Apply ad_double_bit_0. - Intro H2. Elim H2. Intros a0 H3. Rewrite H3 in H1. - Elim (H0 ? (ad_lt_double_plus_un_mono_conv ? ? (ad_min_lt_4 ? ? ? H1))). Intros y H4. - Split with y. Rewrite H3. Rewrite MapGet_M2_bit_0_1. Rewrite ad_double_plus_un_div_2. - Assumption. - Apply ad_double_plus_un_bit_0. - Qed. - - Lemma ad_alloc_opt_optimal : (m:(Map A)) (a:ad) (ad_le (ad_alloc_opt m) a)=false -> - (in_dom A a m)=true. - Proof. - Intros. Unfold in_dom. Elim (ad_alloc_opt_optimal_1 m a H). Intros y H0. Rewrite H0. - Reflexivity. - Qed. - -End AdAlloc. - -V7only [ -(* Moved to NArith *) -Notation positive_to_nat_2 := positive_to_nat_2. -Notation positive_to_nat_4 := positive_to_nat_4. -]. diff --git a/theories7/IntMap/Addec.v b/theories7/IntMap/Addec.v deleted file mode 100644 index 50dc1480..00000000 --- a/theories7/IntMap/Addec.v +++ /dev/null @@ -1,179 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* true - | (xO p'1) (xO p'2) => (ad_eq_1 p'1 p'2) - | (xI p'1) (xI p'2) => (ad_eq_1 p'1 p'2) - | _ _ => false - end. - -Definition ad_eq := [a,a':ad] - Cases a a' of - ad_z ad_z => true - | (ad_x p) (ad_x p') => (ad_eq_1 p p') - | _ _ => false - end. - -Lemma ad_eq_correct : (a:ad) (ad_eq a a)=true. -Proof. - NewDestruct a; Trivial. - NewInduction p; Trivial. -Qed. - -Lemma ad_eq_complete : (a,a':ad) (ad_eq a a')=true -> a=a'. -Proof. - NewDestruct a. NewDestruct a'; Trivial. NewDestruct p. - Discriminate 1. - Discriminate 1. - Discriminate 1. - NewDestruct a'. Intros. Discriminate H. - Unfold ad_eq. Intros. Cut p=p0. Intros. Rewrite H0. Reflexivity. - Generalize Dependent p0. - NewInduction p as [p IHp|p IHp|]. NewDestruct p0; Intro H. - Rewrite (IHp p0). Reflexivity. - Exact H. - Discriminate H. - Discriminate H. - NewDestruct p0; Intro H. Discriminate H. - Rewrite (IHp p0 H). Reflexivity. - Discriminate H. - NewDestruct p0; Intro H. Discriminate H. - Discriminate H. - Trivial. -Qed. - -Lemma ad_eq_comm : (a,a':ad) (ad_eq a a')=(ad_eq a' a). -Proof. - Intros. Cut (b,b':bool)(ad_eq a a')=b->(ad_eq a' a)=b'->b=b'. - Intros. Apply H. Reflexivity. - Reflexivity. - NewDestruct b. Intros. Cut a=a'. - Intro. Rewrite H1 in H0. Rewrite (ad_eq_correct a') in H0. Exact H0. - Apply ad_eq_complete. Exact H. - NewDestruct b'. Intros. Cut a'=a. - Intro. Rewrite H1 in H. Rewrite H1 in H0. Rewrite <- H. Exact H0. - Apply ad_eq_complete. Exact H0. - Trivial. -Qed. - -Lemma ad_xor_eq_true : (a,a':ad) (ad_xor a a')=ad_z -> (ad_eq a a')=true. -Proof. - Intros. Rewrite (ad_xor_eq a a' H). Apply ad_eq_correct. -Qed. - -Lemma ad_xor_eq_false : - (a,a':ad) (p:positive) (ad_xor a a')=(ad_x p) -> (ad_eq a a')=false. -Proof. - Intros. Elim (sumbool_of_bool (ad_eq a a')). Intro H0. - Rewrite (ad_eq_complete a a' H0) in H. Rewrite (ad_xor_nilpotent a') in H. Discriminate H. - Trivial. -Qed. - -Lemma ad_bit_0_1_not_double : (a:ad) (ad_bit_0 a)=true -> - (a0:ad) (ad_eq (ad_double a0) a)=false. -Proof. - Intros. Elim (sumbool_of_bool (ad_eq (ad_double a0) a)). Intro H0. - Rewrite <- (ad_eq_complete ? ? H0) in H. Rewrite (ad_double_bit_0 a0) in H. Discriminate H. - Trivial. -Qed. - -Lemma ad_not_div_2_not_double : (a,a0:ad) (ad_eq (ad_div_2 a) a0)=false -> - (ad_eq a (ad_double a0))=false. -Proof. - Intros. Elim (sumbool_of_bool (ad_eq (ad_double a0) a)). Intro H0. - Rewrite <- (ad_eq_complete ? ? H0) in H. Rewrite (ad_double_div_2 a0) in H. - Rewrite (ad_eq_correct a0) in H. Discriminate H. - Intro. Rewrite ad_eq_comm. Assumption. -Qed. - -Lemma ad_bit_0_0_not_double_plus_un : (a:ad) (ad_bit_0 a)=false -> - (a0:ad) (ad_eq (ad_double_plus_un a0) a)=false. -Proof. - Intros. Elim (sumbool_of_bool (ad_eq (ad_double_plus_un a0) a)). Intro H0. - Rewrite <- (ad_eq_complete ? ? H0) in H. Rewrite (ad_double_plus_un_bit_0 a0) in H. - Discriminate H. - Trivial. -Qed. - -Lemma ad_not_div_2_not_double_plus_un : (a,a0:ad) (ad_eq (ad_div_2 a) a0)=false -> - (ad_eq (ad_double_plus_un a0) a)=false. -Proof. - Intros. Elim (sumbool_of_bool (ad_eq a (ad_double_plus_un a0))). Intro H0. - Rewrite (ad_eq_complete ? ? H0) in H. Rewrite (ad_double_plus_un_div_2 a0) in H. - Rewrite (ad_eq_correct a0) in H. Discriminate H. - Intro H0. Rewrite ad_eq_comm. Assumption. -Qed. - -Lemma ad_bit_0_neq : - (a,a':ad) (ad_bit_0 a)=false -> (ad_bit_0 a')=true -> (ad_eq a a')=false. -Proof. - Intros. Elim (sumbool_of_bool (ad_eq a a')). Intro H1. Rewrite (ad_eq_complete ? ? H1) in H. - Rewrite H in H0. Discriminate H0. - Trivial. -Qed. - -Lemma ad_div_eq : - (a,a':ad) (ad_eq a a')=true -> (ad_eq (ad_div_2 a) (ad_div_2 a'))=true. -Proof. - Intros. Cut a=a'. Intros. Rewrite H0. Apply ad_eq_correct. - Apply ad_eq_complete. Exact H. -Qed. - -Lemma ad_div_neq : (a,a':ad) (ad_eq (ad_div_2 a) (ad_div_2 a'))=false -> - (ad_eq a a')=false. -Proof. - Intros. Elim (sumbool_of_bool (ad_eq a a')). Intro H0. - Rewrite (ad_eq_complete ? ? H0) in H. Rewrite (ad_eq_correct (ad_div_2 a')) in H. Discriminate H. - Trivial. -Qed. - -Lemma ad_div_bit_eq : (a,a':ad) (ad_bit_0 a)=(ad_bit_0 a') -> - (ad_div_2 a)=(ad_div_2 a') -> a=a'. -Proof. - Intros. Apply ad_faithful. Unfold eqf. NewDestruct n. - Rewrite ad_bit_0_correct. Rewrite ad_bit_0_correct. Assumption. - Rewrite <- ad_div_2_correct. Rewrite <- ad_div_2_correct. - Rewrite H0. Reflexivity. -Qed. - -Lemma ad_div_bit_neq : (a,a':ad) (ad_eq a a')=false -> (ad_bit_0 a)=(ad_bit_0 a') -> - (ad_eq (ad_div_2 a) (ad_div_2 a'))=false. -Proof. - Intros. Elim (sumbool_of_bool (ad_eq (ad_div_2 a) (ad_div_2 a'))). Intro H1. - Rewrite (ad_div_bit_eq ? ? H0 (ad_eq_complete ? ? H1)) in H. - Rewrite (ad_eq_correct a') in H. Discriminate H. - Trivial. -Qed. - -Lemma ad_neq : (a,a':ad) (ad_eq a a')=false -> - (ad_bit_0 a)=(negb (ad_bit_0 a')) \/ (ad_eq (ad_div_2 a) (ad_div_2 a'))=false. -Proof. - Intros. Cut (ad_bit_0 a)=(ad_bit_0 a')\/(ad_bit_0 a)=(negb (ad_bit_0 a')). - Intros. Elim H0. Intro. Right . Apply ad_div_bit_neq. Assumption. - Assumption. - Intro. Left . Assumption. - Case (ad_bit_0 a); Case (ad_bit_0 a'); Auto. -Qed. - -Lemma ad_double_or_double_plus_un : (a:ad) - {a0:ad | a=(ad_double a0)}+{a1:ad | a=(ad_double_plus_un a1)}. -Proof. - Intro. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H. Right . Split with (ad_div_2 a). - Rewrite (ad_div_2_double_plus_un a H). Reflexivity. - Intro H. Left . Split with (ad_div_2 a). Rewrite (ad_div_2_double a H). Reflexivity. -Qed. diff --git a/theories7/IntMap/Addr.v b/theories7/IntMap/Addr.v deleted file mode 100644 index 9f362772..00000000 --- a/theories7/IntMap/Addr.v +++ /dev/null @@ -1,456 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* ad. - -Lemma ad_sum : (a:ad) {p:positive | a=(ad_x p)}+{a=ad_z}. -Proof. - NewDestruct a; Auto. - Left; Exists p; Trivial. -Qed. - -Fixpoint p_xor [p:positive] : positive -> ad := - [p2] Cases p of - xH => Cases p2 of - xH => ad_z - | (xO p'2) => (ad_x (xI p'2)) - | (xI p'2) => (ad_x (xO p'2)) - end - | (xO p') => Cases p2 of - xH => (ad_x (xI p')) - | (xO p'2) => Cases (p_xor p' p'2) of - ad_z => ad_z - | (ad_x p'') => (ad_x (xO p'')) - end - | (xI p'2) => Cases (p_xor p' p'2) of - ad_z => (ad_x xH) - | (ad_x p'') => (ad_x (xI p'')) - end - end - | (xI p') => Cases p2 of - xH => (ad_x (xO p')) - | (xO p'2) => Cases (p_xor p' p'2) of - ad_z => (ad_x xH) - | (ad_x p'') => (ad_x (xI p'')) - end - | (xI p'2) => Cases (p_xor p' p'2) of - ad_z => ad_z - | (ad_x p'') => (ad_x (xO p'')) - end - end - end. - -Definition ad_xor := [a,a':ad] - Cases a of - ad_z => a' - | (ad_x p) => Cases a' of - ad_z => a - | (ad_x p') => (p_xor p p') - end - end. - -Lemma ad_xor_neutral_left : (a:ad) (ad_xor ad_z a)=a. -Proof. - Trivial. -Qed. - -Lemma ad_xor_neutral_right : (a:ad) (ad_xor a ad_z)=a. -Proof. - NewDestruct a; Trivial. -Qed. - -Lemma ad_xor_comm : (a,a':ad) (ad_xor a a')=(ad_xor a' a). -Proof. - NewDestruct a; NewDestruct a'; Simpl; Auto. - Generalize p0; Clear p0; NewInduction p as [p Hrecp|p Hrecp|]; Simpl; Auto. - NewDestruct p0; Simpl; Trivial; Intros. - Rewrite Hrecp; Trivial. - Rewrite Hrecp; Trivial. - NewDestruct p0; Simpl; Trivial; Intros. - Rewrite Hrecp; Trivial. - Rewrite Hrecp; Trivial. - NewDestruct p0; Simpl; Auto. -Qed. - -Lemma ad_xor_nilpotent : (a:ad) (ad_xor a a)=ad_z. -Proof. - NewDestruct a; Trivial. - Simpl. NewInduction p as [p IHp|p IHp|]; Trivial. - Simpl. Rewrite IHp; Reflexivity. - Simpl. Rewrite IHp; Reflexivity. -Qed. - -Fixpoint ad_bit_1 [p:positive] : nat -> bool := - Cases p of - xH => [n:nat] Cases n of - O => true - | (S _) => false - end - | (xO p) => [n:nat] Cases n of - O => false - | (S n') => (ad_bit_1 p n') - end - | (xI p) => [n:nat] Cases n of - O => true - | (S n') => (ad_bit_1 p n') - end - end. - -Definition ad_bit := [a:ad] - Cases a of - ad_z => [_:nat] false - | (ad_x p) => (ad_bit_1 p) - end. - -Definition eqf := [f,g:nat->bool] (n:nat) (f n)=(g n). - -Lemma ad_faithful_1 : (a:ad) (eqf (ad_bit ad_z) (ad_bit a)) -> ad_z=a. -Proof. - NewDestruct a. Trivial. - NewInduction p as [p IHp|p IHp|];Intro H. Absurd ad_z=(ad_x p). Discriminate. - Exact (IHp [n:nat](H (S n))). - Absurd ad_z=(ad_x p). Discriminate. - Exact (IHp [n:nat](H (S n))). - Absurd false=true. Discriminate. - Exact (H O). -Qed. - -Lemma ad_faithful_2 : (a:ad) (eqf (ad_bit (ad_x xH)) (ad_bit a)) -> (ad_x xH)=a. -Proof. - NewDestruct a. Intros. Absurd true=false. Discriminate. - Exact (H O). - NewDestruct p. Intro H. Absurd ad_z=(ad_x p). Discriminate. - Exact (ad_faithful_1 (ad_x p) [n:nat](H (S n))). - Intros. Absurd true=false. Discriminate. - Exact (H O). - Trivial. -Qed. - -Lemma ad_faithful_3 : - (a:ad) (p:positive) - ((p':positive) (eqf (ad_bit (ad_x p)) (ad_bit (ad_x p'))) -> p=p') -> - (eqf (ad_bit (ad_x (xO p))) (ad_bit a)) -> - (ad_x (xO p))=a. -Proof. - NewDestruct a. Intros. Cut (eqf (ad_bit ad_z) (ad_bit (ad_x (xO p)))). - Intro. Rewrite (ad_faithful_1 (ad_x (xO p)) H1). Reflexivity. - Unfold eqf. Intro. Unfold eqf in H0. Rewrite H0. Reflexivity. - Case p. Intros. Absurd false=true. Discriminate. - Exact (H0 O). - Intros. Rewrite (H p0 [n:nat](H0 (S n))). Reflexivity. - Intros. Absurd false=true. Discriminate. - Exact (H0 O). -Qed. - -Lemma ad_faithful_4 : - (a:ad) (p:positive) - ((p':positive) (eqf (ad_bit (ad_x p)) (ad_bit (ad_x p'))) -> p=p') -> - (eqf (ad_bit (ad_x (xI p))) (ad_bit a)) -> - (ad_x (xI p))=a. -Proof. - NewDestruct a. Intros. Cut (eqf (ad_bit ad_z) (ad_bit (ad_x (xI p)))). - Intro. Rewrite (ad_faithful_1 (ad_x (xI p)) H1). Reflexivity. - Unfold eqf. Intro. Unfold eqf in H0. Rewrite H0. Reflexivity. - Case p. Intros. Rewrite (H p0 [n:nat](H0 (S n))). Reflexivity. - Intros. Absurd true=false. Discriminate. - Exact (H0 O). - Intros. Absurd ad_z=(ad_x p0). Discriminate. - Cut (eqf (ad_bit (ad_x xH)) (ad_bit (ad_x (xI p0)))). - Intro. Exact (ad_faithful_1 (ad_x p0) [n:nat](H1 (S n))). - Unfold eqf. Unfold eqf in H0. Intro. Rewrite H0. Reflexivity. -Qed. - -Lemma ad_faithful : (a,a':ad) (eqf (ad_bit a) (ad_bit a')) -> a=a'. -Proof. - NewDestruct a. Exact ad_faithful_1. - NewInduction p. Intros a' H. Apply ad_faithful_4. Intros. Cut (ad_x p)=(ad_x p'). - Intro. Inversion H1. Reflexivity. - Exact (IHp (ad_x p') H0). - Assumption. - Intros. Apply ad_faithful_3. Intros. Cut (ad_x p)=(ad_x p'). Intro. Inversion H1. Reflexivity. - Exact (IHp (ad_x p') H0). - Assumption. - Exact ad_faithful_2. -Qed. - -Definition adf_xor := [f,g:nat->bool; n:nat] (xorb (f n) (g n)). - -Lemma ad_xor_sem_1 : (a':ad) (ad_bit (ad_xor ad_z a') O)=(ad_bit a' O). -Proof. - Trivial. -Qed. - -Lemma ad_xor_sem_2 : (a':ad) (ad_bit (ad_xor (ad_x xH) a') O)=(negb (ad_bit a' O)). -Proof. - Intro. Case a'. Trivial. - Simpl. Intro. - Case p; Trivial. -Qed. - -Lemma ad_xor_sem_3 : - (p:positive) (a':ad) (ad_bit (ad_xor (ad_x (xO p)) a') O)=(ad_bit a' O). -Proof. - Intros. Case a'. Trivial. - Simpl. Intro. - Case p0; Trivial. Intro. - Case (p_xor p p1); Trivial. - Intro. Case (p_xor p p1); Trivial. -Qed. - -Lemma ad_xor_sem_4 : (p:positive) (a':ad) - (ad_bit (ad_xor (ad_x (xI p)) a') O)=(negb (ad_bit a' O)). -Proof. - Intros. Case a'. Trivial. - Simpl. Intro. Case p0; Trivial. Intro. - Case (p_xor p p1); Trivial. - Intro. - Case (p_xor p p1); Trivial. -Qed. - -Lemma ad_xor_sem_5 : - (a,a':ad) (ad_bit (ad_xor a a') O)=(adf_xor (ad_bit a) (ad_bit a') O). -Proof. - NewDestruct a. Intro. Change (ad_bit a' O)=(xorb false (ad_bit a' O)). Rewrite false_xorb. Trivial. - Case p. Exact ad_xor_sem_4. - Intros. Change (ad_bit (ad_xor (ad_x (xO p0)) a') O)=(xorb false (ad_bit a' O)). - Rewrite false_xorb. Apply ad_xor_sem_3. Exact ad_xor_sem_2. -Qed. - -Lemma ad_xor_sem_6 : (n:nat) - ((a,a':ad) (ad_bit (ad_xor a a') n)=(adf_xor (ad_bit a) (ad_bit a') n)) -> - (a,a':ad) (ad_bit (ad_xor a a') (S n))=(adf_xor (ad_bit a) (ad_bit a') (S n)). -Proof. - Intros. Case a. Unfold adf_xor. Unfold 2 ad_bit. Rewrite false_xorb. Reflexivity. - Case a'. Unfold adf_xor. Unfold 3 ad_bit. Intro. Rewrite xorb_false. Reflexivity. - Intros. Case p0. Case p. Intros. - Change (ad_bit (ad_xor (ad_x (xI p2)) (ad_x (xI p1))) (S n)) - =(adf_xor (ad_bit (ad_x p2)) (ad_bit (ad_x p1)) n). - Rewrite <- H. Simpl. - Case (p_xor p2 p1); Trivial. - Intros. - Change (ad_bit (ad_xor (ad_x (xI p2)) (ad_x (xO p1))) (S n)) - =(adf_xor (ad_bit (ad_x p2)) (ad_bit (ad_x p1)) n). - Rewrite <- H. Simpl. - Case (p_xor p2 p1); Trivial. - Intro. Unfold adf_xor. Unfold 3 ad_bit. Unfold ad_bit_1. Rewrite xorb_false. Reflexivity. - Case p. Intros. - Change (ad_bit (ad_xor (ad_x (xO p2)) (ad_x (xI p1))) (S n)) - =(adf_xor (ad_bit (ad_x p2)) (ad_bit (ad_x p1)) n). - Rewrite <- H. Simpl. - Case (p_xor p2 p1); Trivial. - Intros. - Change (ad_bit (ad_xor (ad_x (xO p2)) (ad_x (xO p1))) (S n)) - =(adf_xor (ad_bit (ad_x p2)) (ad_bit (ad_x p1)) n). - Rewrite <- H. Simpl. - Case (p_xor p2 p1); Trivial. - Intro. Unfold adf_xor. Unfold 3 ad_bit. Unfold ad_bit_1. Rewrite xorb_false. Reflexivity. - Unfold adf_xor. Unfold 2 ad_bit. Unfold ad_bit_1. Rewrite false_xorb. Simpl. Case p; Trivial. -Qed. - -Lemma ad_xor_semantics : - (a,a':ad) (eqf (ad_bit (ad_xor a a')) (adf_xor (ad_bit a) (ad_bit a'))). -Proof. - Unfold eqf. Intros. Generalize a a'. Elim n. Exact ad_xor_sem_5. - Exact ad_xor_sem_6. -Qed. - -Lemma eqf_sym : (f,f':nat->bool) (eqf f f') -> (eqf f' f). -Proof. - Unfold eqf. Intros. Rewrite H. Reflexivity. -Qed. - -Lemma eqf_refl : (f:nat->bool) (eqf f f). -Proof. - Unfold eqf. Trivial. -Qed. - -Lemma eqf_trans : (f,f',f'':nat->bool) (eqf f f') -> (eqf f' f'') -> (eqf f f''). -Proof. - Unfold eqf. Intros. Rewrite H. Exact (H0 n). -Qed. - -Lemma adf_xor_eq : (f,f':nat->bool) (eqf (adf_xor f f') [n:nat] false) -> (eqf f f'). -Proof. - Unfold eqf. Unfold adf_xor. Intros. Apply xorb_eq. Apply H. -Qed. - -Lemma ad_xor_eq : (a,a':ad) (ad_xor a a')=ad_z -> a=a'. -Proof. - Intros. Apply ad_faithful. Apply adf_xor_eq. Apply eqf_trans with f':=(ad_bit (ad_xor a a')). - Apply eqf_sym. Apply ad_xor_semantics. - Rewrite H. Unfold eqf. Trivial. -Qed. - -Lemma adf_xor_assoc : (f,f',f'':nat->bool) - (eqf (adf_xor (adf_xor f f') f'') (adf_xor f (adf_xor f' f''))). -Proof. - Unfold eqf. Unfold adf_xor. Intros. Apply xorb_assoc. -Qed. - -Lemma eqf_xor_1 : (f,f',f'',f''':nat->bool) (eqf f f') -> (eqf f'' f''') -> - (eqf (adf_xor f f'') (adf_xor f' f''')). -Proof. - Unfold eqf. Intros. Unfold adf_xor. Rewrite H. Rewrite H0. Reflexivity. -Qed. - -Lemma ad_xor_assoc : - (a,a',a'':ad) (ad_xor (ad_xor a a') a'')=(ad_xor a (ad_xor a' a'')). -Proof. - Intros. Apply ad_faithful. - Apply eqf_trans with f':=(adf_xor (adf_xor (ad_bit a) (ad_bit a')) (ad_bit a'')). - Apply eqf_trans with f':=(adf_xor (ad_bit (ad_xor a a')) (ad_bit a'')). - Apply ad_xor_semantics. - Apply eqf_xor_1. Apply ad_xor_semantics. - Apply eqf_refl. - Apply eqf_trans with f':=(adf_xor (ad_bit a) (adf_xor (ad_bit a') (ad_bit a''))). - Apply adf_xor_assoc. - Apply eqf_trans with f':=(adf_xor (ad_bit a) (ad_bit (ad_xor a' a''))). - Apply eqf_xor_1. Apply eqf_refl. - Apply eqf_sym. Apply ad_xor_semantics. - Apply eqf_sym. Apply ad_xor_semantics. -Qed. - -Definition ad_double := [a:ad] - Cases a of - ad_z => ad_z - | (ad_x p) => (ad_x (xO p)) - end. - -Definition ad_double_plus_un := [a:ad] - Cases a of - ad_z => (ad_x xH) - | (ad_x p) => (ad_x (xI p)) - end. - -Definition ad_div_2 := [a:ad] - Cases a of - ad_z => ad_z - | (ad_x xH) => ad_z - | (ad_x (xO p)) => (ad_x p) - | (ad_x (xI p)) => (ad_x p) - end. - -Lemma ad_double_div_2 : (a:ad) (ad_div_2 (ad_double a))=a. -Proof. - NewDestruct a; Trivial. -Qed. - -Lemma ad_double_plus_un_div_2 : (a:ad) (ad_div_2 (ad_double_plus_un a))=a. -Proof. - NewDestruct a; Trivial. -Qed. - -Lemma ad_double_inj : (a0,a1:ad) (ad_double a0)=(ad_double a1) -> a0=a1. -Proof. - Intros. Rewrite <- (ad_double_div_2 a0). Rewrite H. Apply ad_double_div_2. -Qed. - -Lemma ad_double_plus_un_inj : - (a0,a1:ad) (ad_double_plus_un a0)=(ad_double_plus_un a1) -> a0=a1. -Proof. - Intros. Rewrite <- (ad_double_plus_un_div_2 a0). Rewrite H. Apply ad_double_plus_un_div_2. -Qed. - -Definition ad_bit_0 := [a:ad] - Cases a of - ad_z => false - | (ad_x (xO _)) => false - | _ => true - end. - -Lemma ad_double_bit_0 : (a:ad) (ad_bit_0 (ad_double a))=false. -Proof. - NewDestruct a; Trivial. -Qed. - -Lemma ad_double_plus_un_bit_0 : (a:ad) (ad_bit_0 (ad_double_plus_un a))=true. -Proof. - NewDestruct a; Trivial. -Qed. - -Lemma ad_div_2_double : (a:ad) (ad_bit_0 a)=false -> (ad_double (ad_div_2 a))=a. -Proof. - NewDestruct a. Trivial. NewDestruct p. Intro H. Discriminate H. - Intros. Reflexivity. - Intro H. Discriminate H. -Qed. - -Lemma ad_div_2_double_plus_un : - (a:ad) (ad_bit_0 a)=true -> (ad_double_plus_un (ad_div_2 a))=a. -Proof. - NewDestruct a. Intro. Discriminate H. - NewDestruct p. Intros. Reflexivity. - Intro H. Discriminate H. - Intro. Reflexivity. -Qed. - -Lemma ad_bit_0_correct : (a:ad) (ad_bit a O)=(ad_bit_0 a). -Proof. - NewDestruct a; Trivial. - NewDestruct p; Trivial. -Qed. - -Lemma ad_div_2_correct : (a:ad) (n:nat) (ad_bit (ad_div_2 a) n)=(ad_bit a (S n)). -Proof. - NewDestruct a; Trivial. - NewDestruct p; Trivial. -Qed. - -Lemma ad_xor_bit_0 : - (a,a':ad) (ad_bit_0 (ad_xor a a'))=(xorb (ad_bit_0 a) (ad_bit_0 a')). -Proof. - Intros. Rewrite <- ad_bit_0_correct. Rewrite (ad_xor_semantics a a' O). - Unfold adf_xor. Rewrite ad_bit_0_correct. Rewrite ad_bit_0_correct. Reflexivity. -Qed. - -Lemma ad_xor_div_2 : - (a,a':ad) (ad_div_2 (ad_xor a a'))=(ad_xor (ad_div_2 a) (ad_div_2 a')). -Proof. - Intros. Apply ad_faithful. Unfold eqf. Intro. - Rewrite (ad_xor_semantics (ad_div_2 a) (ad_div_2 a') n). - Rewrite ad_div_2_correct. - Rewrite (ad_xor_semantics a a' (S n)). - Unfold adf_xor. Rewrite ad_div_2_correct. Rewrite ad_div_2_correct. - Reflexivity. -Qed. - -Lemma ad_neg_bit_0 : (a,a':ad) (ad_bit_0 (ad_xor a a'))=true -> - (ad_bit_0 a)=(negb (ad_bit_0 a')). -Proof. - Intros. Rewrite <- true_xorb. Rewrite <- H. Rewrite ad_xor_bit_0. - Rewrite xorb_assoc. Rewrite xorb_nilpotent. Rewrite xorb_false. Reflexivity. -Qed. - -Lemma ad_neg_bit_0_1 : - (a,a':ad) (ad_xor a a')=(ad_x xH) -> (ad_bit_0 a)=(negb (ad_bit_0 a')). -Proof. - Intros. Apply ad_neg_bit_0. Rewrite H. Reflexivity. -Qed. - -Lemma ad_neg_bit_0_2 : (a,a':ad) (p:positive) (ad_xor a a')=(ad_x (xI p)) -> - (ad_bit_0 a)=(negb (ad_bit_0 a')). -Proof. - Intros. Apply ad_neg_bit_0. Rewrite H. Reflexivity. -Qed. - -Lemma ad_same_bit_0 : (a,a':ad) (p:positive) (ad_xor a a')=(ad_x (xO p)) -> - (ad_bit_0 a)=(ad_bit_0 a'). -Proof. - Intros. Rewrite <- (xorb_false (ad_bit_0 a)). Cut (ad_bit_0 (ad_x (xO p)))=false. - Intro. Rewrite <- H0. Rewrite <- H. Rewrite ad_xor_bit_0. Rewrite <- xorb_assoc. - Rewrite xorb_nilpotent. Rewrite false_xorb. Reflexivity. - Reflexivity. -Qed. diff --git a/theories7/IntMap/Adist.v b/theories7/IntMap/Adist.v deleted file mode 100644 index a7948c72..00000000 --- a/theories7/IntMap/Adist.v +++ /dev/null @@ -1,321 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* O - | (xI _) => O - | (xO p') => (S (ad_plength_1 p')) - end. - -Inductive natinf : Set := - infty : natinf - | ni : nat -> natinf. - -Definition ad_plength := [a:ad] - Cases a of - ad_z => infty - | (ad_x p) => (ni (ad_plength_1 p)) - end. - -Lemma ad_plength_infty : (a:ad) (ad_plength a)=infty -> a=ad_z. -Proof. - Induction a; Trivial. - Unfold ad_plength; Intros; Discriminate H. -Qed. - -Lemma ad_plength_zeros : (a:ad) (n:nat) (ad_plength a)=(ni n) -> - (k:nat) (lt k n) -> (ad_bit a k)=false. -Proof. - Induction a; Trivial. - Induction p. Induction n. Intros. Inversion H1. - Induction k. Simpl in H1. Discriminate H1. - Intros. Simpl in H1. Discriminate H1. - Induction k. Trivial. - Generalize H0. Case n. Intros. Inversion H3. - Intros. Simpl. Unfold ad_bit in H. Apply (H n0). Simpl in H1. Inversion H1. Reflexivity. - Exact (lt_S_n n1 n0 H3). - Simpl. Intros n H. Inversion H. Intros. Inversion H0. -Qed. - -Lemma ad_plength_one : (a:ad) (n:nat) (ad_plength a)=(ni n) -> (ad_bit a n)=true. -Proof. - Induction a. Intros. Inversion H. - Induction p. Intros. Simpl in H0. Inversion H0. Reflexivity. - Intros. Simpl in H0. Inversion H0. Simpl. Unfold ad_bit in H. Apply H. Reflexivity. - Intros. Simpl in H. Inversion H. Reflexivity. -Qed. - -Lemma ad_plength_first_one : (a:ad) (n:nat) - ((k:nat) (lt k n) -> (ad_bit a k)=false) -> (ad_bit a n)=true -> - (ad_plength a)=(ni n). -Proof. - Induction a. Intros. Simpl in H0. Discriminate H0. - Induction p. Intros. Generalize H0. Case n. Intros. Reflexivity. - Intros. Absurd (ad_bit (ad_x (xI p0)) O)=false. Trivial with bool. - Auto with bool arith. - Intros. Generalize H0 H1. Case n. Intros. Simpl in H3. Discriminate H3. - Intros. Simpl. Unfold ad_plength in H. - Cut (ni (ad_plength_1 p0))=(ni n0). Intro. Inversion H4. Reflexivity. - Apply H. Intros. Change (ad_bit (ad_x (xO p0)) (S k))=false. Apply H2. Apply lt_n_S. Exact H4. - Exact H3. - Intro. Case n. Trivial. - Intros. Simpl in H0. Discriminate H0. -Qed. - -Definition ni_min := [d,d':natinf] - Cases d of - infty => d' - | (ni n) => Cases d' of - infty => d - | (ni n') => (ni (min n n')) - end - end. - -Lemma ni_min_idemp : (d:natinf) (ni_min d d)=d. -Proof. - Induction d; Trivial. - Unfold ni_min. - Induction n; Trivial. - Intros. - Simpl. - Inversion H. - Rewrite H1. - Rewrite H1. - Reflexivity. -Qed. - -Lemma ni_min_comm : (d,d':natinf) (ni_min d d')=(ni_min d' d). -Proof. - Induction d. Induction d'; Trivial. - Induction d'; Trivial. Elim n. Induction n0; Trivial. - Intros. Elim n1; Trivial. Intros. Unfold ni_min in H. Cut (min n0 n2)=(min n2 n0). - Intro. Unfold ni_min. Simpl. Rewrite H1. Reflexivity. - Cut (ni (min n0 n2))=(ni (min n2 n0)). Intros. - Inversion H1; Trivial. - Exact (H n2). -Qed. - -Lemma ni_min_assoc : (d,d',d'':natinf) (ni_min (ni_min d d') d'')=(ni_min d (ni_min d' d'')). -Proof. - Induction d; Trivial. Induction d'; Trivial. - Induction d''; Trivial. - Unfold ni_min. Intro. Cut (min (min n n0) n1)=(min n (min n0 n1)). - Intro. Rewrite H. Reflexivity. - Generalize n0 n1. Elim n; Trivial. - Induction n3; Trivial. Induction n5; Trivial. - Intros. Simpl. Auto. -Qed. - -Lemma ni_min_O_l : (d:natinf) (ni_min (ni O) d)=(ni O). -Proof. - Induction d; Trivial. -Qed. - -Lemma ni_min_O_r : (d:natinf) (ni_min d (ni O))=(ni O). -Proof. - Intros. Rewrite ni_min_comm. Apply ni_min_O_l. -Qed. - -Lemma ni_min_inf_l : (d:natinf) (ni_min infty d)=d. -Proof. - Trivial. -Qed. - -Lemma ni_min_inf_r : (d:natinf) (ni_min d infty)=d. -Proof. - Induction d; Trivial. -Qed. - -Definition ni_le := [d,d':natinf] (ni_min d d')=d. - -Lemma ni_le_refl : (d:natinf) (ni_le d d). -Proof. - Exact ni_min_idemp. -Qed. - -Lemma ni_le_antisym : (d,d':natinf) (ni_le d d') -> (ni_le d' d) -> d=d'. -Proof. - Unfold ni_le. Intros d d'. Rewrite ni_min_comm. Intro H. Rewrite H. Trivial. -Qed. - -Lemma ni_le_trans : (d,d',d'':natinf) (ni_le d d') -> (ni_le d' d'') -> (ni_le d d''). -Proof. - Unfold ni_le. Intros. Rewrite <- H. Rewrite ni_min_assoc. Rewrite H0. Reflexivity. -Qed. - -Lemma ni_le_min_1 : (d,d':natinf) (ni_le (ni_min d d') d). -Proof. - Unfold ni_le. Intros. Rewrite (ni_min_comm d d'). Rewrite ni_min_assoc. - Rewrite ni_min_idemp. Reflexivity. -Qed. - -Lemma ni_le_min_2 : (d,d':natinf) (ni_le (ni_min d d') d'). -Proof. - Unfold ni_le. Intros. Rewrite ni_min_assoc. Rewrite ni_min_idemp. Reflexivity. -Qed. - -Lemma ni_min_case : (d,d':natinf) (ni_min d d')=d \/ (ni_min d d')=d'. -Proof. - Induction d. Intro. Right . Exact (ni_min_inf_l d'). - Induction d'. Left . Exact (ni_min_inf_r (ni n)). - Unfold ni_min. Cut (n0:nat)(min n n0)=n\/(min n n0)=n0. - Intros. Case (H n0). Intro. Left . Rewrite H0. Reflexivity. - Intro. Right . Rewrite H0. Reflexivity. - Elim n. Intro. Left . Reflexivity. - Induction n1. Right . Reflexivity. - Intros. Case (H n2). Intro. Left . Simpl. Rewrite H1. Reflexivity. - Intro. Right . Simpl. Rewrite H1. Reflexivity. -Qed. - -Lemma ni_le_total : (d,d':natinf) (ni_le d d') \/ (ni_le d' d). -Proof. - Unfold ni_le. Intros. Rewrite (ni_min_comm d' d). Apply ni_min_case. -Qed. - -Lemma ni_le_min_induc : (d,d',dm:natinf) (ni_le dm d) -> (ni_le dm d') -> - ((d'':natinf) (ni_le d'' d) -> (ni_le d'' d') -> (ni_le d'' dm)) -> - (ni_min d d')=dm. -Proof. - Intros. Case (ni_min_case d d'). Intro. Rewrite H2. - Apply ni_le_antisym. Apply H1. Apply ni_le_refl. - Exact H2. - Exact H. - Intro. Rewrite H2. Apply ni_le_antisym. Apply H1. Unfold ni_le. Rewrite ni_min_comm. Exact H2. - Apply ni_le_refl. - Exact H0. -Qed. - -Lemma le_ni_le : (m,n:nat) (le m n) -> (ni_le (ni m) (ni n)). -Proof. - Cut (m,n:nat)(le m n)->(min m n)=m. - Intros. Unfold ni_le ni_min. Rewrite (H m n H0). Reflexivity. - Induction m. Trivial. - Induction n0. Intro. Inversion H0. - Intros. Simpl. Rewrite (H n1 (le_S_n n n1 H1)). Reflexivity. -Qed. - -Lemma ni_le_le : (m,n:nat) (ni_le (ni m) (ni n)) -> (le m n). -Proof. - Unfold ni_le. Unfold ni_min. Intros. Inversion H. Apply le_min_r. -Qed. - -Lemma ad_plength_lb : (a:ad) (n:nat) ((k:nat) (lt k n) -> (ad_bit a k)=false) -> - (ni_le (ni n) (ad_plength a)). -Proof. - Induction a. Intros. Exact (ni_min_inf_r (ni n)). - Intros. Unfold ad_plength. Apply le_ni_le. Case (le_or_lt n (ad_plength_1 p)). Trivial. - Intro. Absurd (ad_bit (ad_x p) (ad_plength_1 p))=false. - Rewrite (ad_plength_one (ad_x p) (ad_plength_1 p) - (refl_equal natinf (ad_plength (ad_x p)))). - Discriminate. - Apply H. Exact H0. -Qed. - -Lemma ad_plength_ub : (a:ad) (n:nat) (ad_bit a n)=true -> - (ni_le (ad_plength a) (ni n)). -Proof. - Induction a. Intros. Discriminate H. - Intros. Unfold ad_plength. Apply le_ni_le. Case (le_or_lt (ad_plength_1 p) n). Trivial. - Intro. Absurd (ad_bit (ad_x p) n)=true. - Rewrite (ad_plength_zeros (ad_x p) (ad_plength_1 p) - (refl_equal natinf (ad_plength (ad_x p))) n H0). - Discriminate. - Exact H. -Qed. - - -(** We define an ultrametric distance between addresses: - $d(a,a')=1/2^pd(a,a')$, - where $pd(a,a')$ is the number of identical bits at the beginning - of $a$ and $a'$ (infinity if $a=a'$). - Instead of working with $d$, we work with $pd$, namely - [ad_pdist]: *) - -Definition ad_pdist := [a,a':ad] (ad_plength (ad_xor a a')). - -(** d is a distance, so $d(a,a')=0$ iff $a=a'$; this means that - $pd(a,a')=infty$ iff $a=a'$: *) - -Lemma ad_pdist_eq_1 : (a:ad) (ad_pdist a a)=infty. -Proof. - Intros. Unfold ad_pdist. Rewrite ad_xor_nilpotent. Reflexivity. -Qed. - -Lemma ad_pdist_eq_2 : (a,a':ad) (ad_pdist a a')=infty -> a=a'. -Proof. - Intros. Apply ad_xor_eq. Apply ad_plength_infty. Exact H. -Qed. - -(** $d$ is a distance, so $d(a,a')=d(a',a)$: *) - -Lemma ad_pdist_comm : (a,a':ad) (ad_pdist a a')=(ad_pdist a' a). -Proof. - Unfold ad_pdist. Intros. Rewrite ad_xor_comm. Reflexivity. -Qed. - -(** $d$ is an ultrametric distance, that is, not only $d(a,a')\leq - d(a,a'')+d(a'',a')$, - but in fact $d(a,a')\leq max(d(a,a''),d(a'',a'))$. - This means that $min(pd(a,a''),pd(a'',a'))<=pd(a,a')$ (lemma [ad_pdist_ultra] below). - This follows from the fact that $a ~Ra~|a| = 1/2^{\texttt{ad\_plength}}(a))$ - is an ultrametric norm, i.e. that $|a-a'| \leq max (|a-a''|, |a''-a'|)$, - or equivalently that $|a+b|<=max(|a|,|b|)$, i.e. that - min $(\texttt{ad\_plength}(a), \texttt{ad\_plength}(b)) \leq - \texttt{ad\_plength} (a~\texttt{xor}~ b)$ - (lemma [ad_plength_ultra]). -*) - -Lemma ad_plength_ultra_1 : (a,a':ad) - (ni_le (ad_plength a) (ad_plength a')) -> - (ni_le (ad_plength a) (ad_plength (ad_xor a a'))). -Proof. - Induction a. Intros. Unfold ni_le in H. Unfold 1 3 ad_plength in H. - Rewrite (ni_min_inf_l (ad_plength a')) in H. - Rewrite (ad_plength_infty a' H). Simpl. Apply ni_le_refl. - Intros. Unfold 1 ad_plength. Apply ad_plength_lb. Intros. - Cut (a'':ad)(ad_xor (ad_x p) a')=a''->(ad_bit a'' k)=false. - Intros. Apply H1. Reflexivity. - Intro a''. Case a''. Intro. Reflexivity. - Intros. Rewrite <- H1. Rewrite (ad_xor_semantics (ad_x p) a' k). Unfold adf_xor. - Rewrite (ad_plength_zeros (ad_x p) (ad_plength_1 p) - (refl_equal natinf (ad_plength (ad_x p))) k H0). - Generalize H. Case a'. Trivial. - Intros. Cut (ad_bit (ad_x p1) k)=false. Intros. Rewrite H3. Reflexivity. - Apply ad_plength_zeros with n:=(ad_plength_1 p1). Reflexivity. - Apply (lt_le_trans k (ad_plength_1 p) (ad_plength_1 p1)). Exact H0. - Apply ni_le_le. Exact H2. -Qed. - -Lemma ad_plength_ultra : (a,a':ad) - (ni_le (ni_min (ad_plength a) (ad_plength a')) (ad_plength (ad_xor a a'))). -Proof. - Intros. Case (ni_le_total (ad_plength a) (ad_plength a')). Intro. - Cut (ni_min (ad_plength a) (ad_plength a'))=(ad_plength a). - Intro. Rewrite H0. Apply ad_plength_ultra_1. Exact H. - Exact H. - Intro. Cut (ni_min (ad_plength a) (ad_plength a'))=(ad_plength a'). - Intro. Rewrite H0. Rewrite ad_xor_comm. Apply ad_plength_ultra_1. Exact H. - Rewrite ni_min_comm. Exact H. -Qed. - -Lemma ad_pdist_ultra : (a,a',a'':ad) - (ni_le (ni_min (ad_pdist a a'') (ad_pdist a'' a')) (ad_pdist a a')). -Proof. - Intros. Unfold ad_pdist. Cut (ad_xor (ad_xor a a'') (ad_xor a'' a'))=(ad_xor a a'). - Intro. Rewrite <- H. Apply ad_plength_ultra. - Rewrite ad_xor_assoc. Rewrite <- (ad_xor_assoc a'' a'' a'). Rewrite ad_xor_nilpotent. - Rewrite ad_xor_neutral_left. Reflexivity. -Qed. diff --git a/theories7/IntMap/Allmaps.v b/theories7/IntMap/Allmaps.v deleted file mode 100644 index e76e210f..00000000 --- a/theories7/IntMap/Allmaps.v +++ /dev/null @@ -1,26 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* (Map A) := - Cases m of - M0 => [_:(Map B)] (M0 A) - | (M1 a y) => [m':(Map B)] Cases (MapGet B m' a) of - NONE => (M0 A) - | _ => m - end - | (M2 m1 m2) => [m':(Map B)] Cases m' of - M0 => (M0 A) - | (M1 a' y') => Cases (MapGet A m a') of - 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 : (m:(Map A)) (m':(Map B)) - (eqm A (MapGet A (MapDomRestrTo m m')) - [a0:ad] Cases (MapGet B m' a0) of - NONE => (NONE A) - | _ => (MapGet A m a0) - end). - Proof. - Unfold eqm. Induction m. Simpl. Intros. Case (MapGet B m' a); Trivial. - Intros. Simpl. Elim (sumbool_of_bool (ad_eq a a1)). Intro H. Rewrite H. - Rewrite <- (ad_eq_complete ? ? H). Case (MapGet B m' a). Reflexivity. - Intro. Apply M1_semantics_1. - Intro H. Rewrite H. Case (MapGet B m' a). - Case (MapGet B m' a1); Reflexivity. - Case (MapGet B m' a1); Intros; Exact (M1_semantics_2 A a a1 a0 H). - Induction m'. Trivial. - Unfold MapDomRestrTo. Intros. Elim (sumbool_of_bool (ad_eq a a1)). - Intro H1. - Rewrite (ad_eq_complete ? ? H1). Rewrite (M1_semantics_1 B a1 a0). - Case (MapGet A (M2 A m0 m1) a1). 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). Reflexivity. - Intro. Exact (M1_semantics_2 A a a1 a2 H1). - Intros. Change (MapGet A (makeM2 A (MapDomRestrTo m0 m2) (MapDomRestrTo m1 m3)) a) - =(Cases (MapGet B (M2 B m2 m3) a) of - NONE => (NONE A) - | (SOME _) => (MapGet A (M2 A m0 m1) a) - end). - Rewrite (makeM2_M2 A (MapDomRestrTo m0 m2) (MapDomRestrTo m1 m3) a). - Rewrite MapGet_M2_bit_0_if. Rewrite (H0 m3 (ad_div_2 a)). Rewrite (H m2 (ad_div_2 a)). - Rewrite (MapGet_M2_bit_0_if B m2 m3 a). Rewrite (MapGet_M2_bit_0_if A m0 m1 a). - Case (ad_bit_0 a); Reflexivity. - Qed. - - Fixpoint MapDomRestrBy [m:(Map A)] : (Map B) -> (Map A) := - Cases m of - M0 => [_:(Map B)] (M0 A) - | (M1 a y) => [m':(Map B)] Cases (MapGet B m' a) of - NONE => m - | _ => (M0 A) - end - | (M2 m1 m2) => [m':(Map B)] Cases m' of - 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 : (m:(Map A)) (m':(Map B)) - (eqm A (MapGet A (MapDomRestrBy m m')) - [a0:ad] Cases (MapGet B m' a0) of - NONE => (MapGet A m a0) - | _ => (NONE A) - end). - Proof. - Unfold eqm. Induction m. Simpl. Intros. Case (MapGet B m' a); Trivial. - Intros. Simpl. Elim (sumbool_of_bool (ad_eq a a1)). Intro H. Rewrite H. - Rewrite (ad_eq_complete ? ? H). Case (MapGet B m' a1). Apply M1_semantics_1. - Trivial. - Intro H. Rewrite H. Case (MapGet B m' a). Rewrite (M1_semantics_2 A a a1 a0 H). - Case (MapGet B m' a1); Trivial. - Case (MapGet B m' a1); Trivial. - Induction m'. Trivial. - Unfold MapDomRestrBy. Intros. Rewrite (MapRemove_semantics A (M2 A m0 m1) a a1). - Elim (sumbool_of_bool (ad_eq a a1)). Intro H1. Rewrite H1. Rewrite (ad_eq_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) - =(Cases (MapGet B (M2 B m2 m3) a) of - NONE => (MapGet A (M2 A m0 m1) a) - | (SOME _) => (NONE A) - end). - Rewrite (makeM2_M2 A (MapDomRestrBy m0 m2) (MapDomRestrBy m1 m3) a). - Rewrite MapGet_M2_bit_0_if. Rewrite (H0 m3 (ad_div_2 a)). Rewrite (H m2 (ad_div_2 a)). - Rewrite (MapGet_M2_bit_0_if B m2 m3 a). Rewrite (MapGet_M2_bit_0_if A m0 m1 a). - Case (ad_bit_0 a); Reflexivity. - Qed. - - Definition in_dom := [a:ad; m:(Map A)] - Cases (MapGet A m a) of - NONE => false - | _ => true - end. - - Lemma in_dom_M0 : (a:ad) (in_dom a (M0 A))=false. - Proof. - Trivial. - Qed. - - Lemma in_dom_M1 : (a,a0:ad) (y:A) (in_dom a0 (M1 A a y))=(ad_eq a a0). - Proof. - Unfold in_dom. Intros. Simpl. Case (ad_eq a a0); Reflexivity. - Qed. - - Lemma in_dom_M1_1 : (a:ad) (y:A) (in_dom a (M1 A a y))=true. - Proof. - Intros. Rewrite in_dom_M1. Apply ad_eq_correct. - Qed. - - Lemma in_dom_M1_2 : (a,a0:ad) (y:A) (in_dom a0 (M1 A a y))=true -> a=a0. - Proof. - Intros. Apply (ad_eq_complete a a0). Rewrite (in_dom_M1 a a0 y) in H. Assumption. - Qed. - - Lemma in_dom_some : (m:(Map A)) (a:ad) (in_dom a m)=true -> - {y:A | (MapGet A m a)=(SOME A y)}. - Proof. - Unfold in_dom. Intros. Elim (option_sum ? (MapGet A m a)). Trivial. - Intro H0. Rewrite H0 in H. Discriminate H. - Qed. - - Lemma in_dom_none : (m:(Map A)) (a:ad) (in_dom a m)=false -> - (MapGet A m a)=(NONE A). - Proof. - Unfold in_dom. 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 : (m:(Map A)) (a0:ad) (y0:A) (a:ad) - (in_dom a (MapPut A m a0 y0))=(orb (ad_eq a a0) (in_dom a m)). - Proof. - Unfold in_dom. Intros. Rewrite (MapPut_semantics A m a0 y0 a). - Elim (sumbool_of_bool (ad_eq a a0)). Intro H. Rewrite H. Rewrite (ad_eq_comm a a0) in H. - Rewrite H. Rewrite orb_true_b. Reflexivity. - Intro H. Rewrite H. Rewrite (ad_eq_comm a a0) in H. Rewrite H. Rewrite orb_false_b. - Reflexivity. - Qed. - - Lemma in_dom_put_behind : (m:(Map A)) (a0:ad) (y0:A) (a:ad) - (in_dom a (MapPut_behind A m a0 y0))=(orb (ad_eq a a0) (in_dom a m)). - Proof. - Unfold in_dom. Intros. Rewrite (MapPut_behind_semantics A m a0 y0 a). - Elim (sumbool_of_bool (ad_eq a a0)). Intro H. Rewrite H. Rewrite (ad_eq_comm a a0) in H. - Rewrite H. Case (MapGet A m a); Reflexivity. - Intro H. Rewrite H. Rewrite (ad_eq_comm a a0) in H. Rewrite H. Case (MapGet A m a); Trivial. - Qed. - - Lemma in_dom_remove : (m:(Map A)) (a0:ad) (a:ad) - (in_dom a (MapRemove A m a0))=(andb (negb (ad_eq a a0)) (in_dom a m)). - Proof. - Unfold in_dom. Intros. Rewrite (MapRemove_semantics A m a0 a). - Elim (sumbool_of_bool (ad_eq a a0)). Intro H. Rewrite H. Rewrite (ad_eq_comm a a0) in H. - Rewrite H. Reflexivity. - Intro H. Rewrite H. Rewrite (ad_eq_comm a a0) in H. Rewrite H. - Case (MapGet A m a); Reflexivity. - Qed. - - Lemma in_dom_merge : (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. 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 : (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. 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. - - Variable A, B : Set. - - Lemma in_dom_restrto : (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. 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 : (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. 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. Rewrite andb_b_false. Reflexivity. - Intro H. Rewrite H. Unfold negb. 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 := - Cases m of - M0 => (M0 unit) - | (M1 a _) => (M1 unit a tt) - | (M2 m m') => (M2 unit (MapDom m) (MapDom m')) - end. - - Lemma MapDom_semantics_1 : (m:(Map A)) (a:ad) - (y:A) (MapGet A m a)=(SOME A y) -> (in_FSet a (MapDom m))=true. - Proof. - Induction m. Intros. Discriminate H. - Unfold MapDom. Unfold in_FSet. Unfold in_dom. Unfold MapGet. Intros a y a0 y0. - Case (ad_eq a a0). Trivial. - Intro. Discriminate H. - Intros m0 H m1 H0 a y. Rewrite (MapGet_M2_bit_0_if A m0 m1 a). Simpl. Unfold in_FSet. - Unfold in_dom. Rewrite (MapGet_M2_bit_0_if unit (MapDom m0) (MapDom m1) a). - Case (ad_bit_0 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 : (m:(Map A)) (a:ad) - (in_FSet a (MapDom m))=true -> {y:A | (MapGet A m a)=(SOME A y)}. - Proof. - Induction m. Intros. Discriminate H. - Unfold MapDom. Unfold in_FSet. Unfold in_dom. Unfold MapGet. Intros a y a0. Case (ad_eq 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. Unfold in_FSet. - Unfold in_dom. Rewrite (MapGet_M2_bit_0_if unit (MapDom m0) (MapDom m1) a). - Case (ad_bit_0 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 : (m:(Map A)) (a:ad) - (MapGet A m a)=(NONE A) -> (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 : (m:(Map A)) (a:ad) - (in_FSet a (MapDom m))=false -> (MapGet A m a)=(NONE A). - 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 : (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. Rewrite H0. - Reflexivity. - Intro H. Rewrite H. Unfold in_dom. Rewrite (MapDom_semantics_4 m a H). Reflexivity. - Qed. - - Definition FSetUnion : FSet -> FSet -> FSet := [s,s':FSet] (MapMerge unit s s'). - - Lemma in_FSet_union : (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 : FSet -> FSet -> FSet := [s,s':FSet] (MapDomRestrTo unit unit s s'). - - Lemma in_FSet_inter : (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 : FSet -> FSet -> FSet := [s,s':FSet] (MapDomRestrBy unit unit s s'). - - Lemma in_FSet_diff : (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 : FSet -> FSet -> FSet := [s,s':FSet] (MapDelta unit s s'). - - Lemma in_FSet_delta : (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 : (s:FSet) (MapDom unit s)=s. -Proof. - Induction s. Trivial. - Simpl. Intros a t. Elim t. Reflexivity. - Intros. Simpl. Rewrite H. Rewrite H0. Reflexivity. -Qed. diff --git a/theories7/IntMap/Lsort.v b/theories7/IntMap/Lsort.v deleted file mode 100644 index 31b71c62..00000000 --- a/theories7/IntMap/Lsort.v +++ /dev/null @@ -1,537 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* (ad_less_1 (ad_div_2 a) (ad_div_2 a') p') - | _ => (andb (negb (ad_bit_0 a)) (ad_bit_0 a')) - end. - - Definition ad_less := [a,a':ad] Cases (ad_xor a a') of - ad_z => false - | (ad_x p) => (ad_less_1 a a' p) - end. - - Lemma ad_bit_0_less : (a,a':ad) (ad_bit_0 a)=false -> (ad_bit_0 a')=true -> - (ad_less a a')=true. - Proof. - Intros. Elim (ad_sum (ad_xor a a')). Intro H1. Elim H1. Intros p H2. Unfold ad_less. - Rewrite H2. Generalize H2. Elim p. Intros. Simpl. Rewrite H. Rewrite H0. Reflexivity. - Intros. Cut (ad_bit_0 (ad_xor a a'))=false. Intro. Rewrite (ad_xor_bit_0 a a') in H5. - Rewrite H in H5. Rewrite H0 in H5. Discriminate H5. - Rewrite H4. Reflexivity. - Intro. Simpl. Rewrite H. Rewrite H0. Reflexivity. - Intro H1. Cut (ad_bit_0 (ad_xor a a'))=false. Intro. Rewrite (ad_xor_bit_0 a a') in H2. - Rewrite H in H2. Rewrite H0 in H2. Discriminate H2. - Rewrite H1. Reflexivity. - Qed. - - Lemma ad_bit_0_gt : (a,a':ad) (ad_bit_0 a)=true -> (ad_bit_0 a')=false -> - (ad_less a a')=false. - Proof. - Intros. Elim (ad_sum (ad_xor a a')). Intro H1. Elim H1. Intros p H2. Unfold ad_less. - Rewrite H2. Generalize H2. Elim p. Intros. Simpl. Rewrite H. Rewrite H0. Reflexivity. - Intros. Cut (ad_bit_0 (ad_xor a a'))=false. Intro. Rewrite (ad_xor_bit_0 a a') in H5. - Rewrite H in H5. Rewrite H0 in H5. Discriminate H5. - Rewrite H4. Reflexivity. - Intro. Simpl. Rewrite H. Rewrite H0. Reflexivity. - Intro H1. Unfold ad_less. Rewrite H1. Reflexivity. - Qed. - - Lemma ad_less_not_refl : (a:ad) (ad_less a a)=false. - Proof. - Intro. Unfold ad_less. Rewrite (ad_xor_nilpotent a). Reflexivity. - Qed. - - Lemma ad_ind_double : - (a:ad)(P:ad->Prop) (P ad_z) -> - ((a:ad) (P a) -> (P (ad_double a))) -> - ((a:ad) (P a) -> (P (ad_double_plus_un a))) -> (P a). - Proof. - Intros; Elim a. Trivial. - Induction p. Intros. - Apply (H1 (ad_x p0)); Trivial. - Intros; Apply (H0 (ad_x p0)); Trivial. - Intros; Apply (H1 ad_z); Assumption. - Qed. - - Lemma ad_rec_double : - (a:ad)(P:ad->Set) (P ad_z) -> - ((a:ad) (P a) -> (P (ad_double a))) -> - ((a:ad) (P a) -> (P (ad_double_plus_un a))) -> (P a). - Proof. - Intros; Elim a. Trivial. - Induction p. Intros. - Apply (H1 (ad_x p0)); Trivial. - Intros; Apply (H0 (ad_x p0)); Trivial. - Intros; Apply (H1 ad_z); Assumption. - Qed. - - Lemma ad_less_def_1 : (a,a':ad) (ad_less (ad_double a) (ad_double a'))=(ad_less a a'). - Proof. - Induction a. Induction a'. Reflexivity. - Trivial. - Induction a'. Unfold ad_less. Simpl. (Elim p; Trivial). - Unfold ad_less. Simpl. Intro. Case (p_xor p p0). Reflexivity. - Trivial. - Qed. - - Lemma ad_less_def_2 : (a,a':ad) - (ad_less (ad_double_plus_un a) (ad_double_plus_un a'))=(ad_less a a'). - Proof. - Induction a. Induction a'. Reflexivity. - Trivial. - Induction a'. Unfold ad_less. Simpl. (Elim p; Trivial). - Unfold ad_less. Simpl. Intro. Case (p_xor p p0). Reflexivity. - Trivial. - Qed. - - Lemma ad_less_def_3 : (a,a':ad) (ad_less (ad_double a) (ad_double_plus_un a'))=true. - Proof. - Intros. Apply ad_bit_0_less. Apply ad_double_bit_0. - Apply ad_double_plus_un_bit_0. - Qed. - - Lemma ad_less_def_4 : (a,a':ad) (ad_less (ad_double_plus_un a) (ad_double a'))=false. - Proof. - Intros. Apply ad_bit_0_gt. Apply ad_double_plus_un_bit_0. - Apply ad_double_bit_0. - Qed. - - Lemma ad_less_z : (a:ad) (ad_less a ad_z)=false. - Proof. - Induction a. Reflexivity. - Unfold ad_less. Intro. Rewrite (ad_xor_neutral_right (ad_x p)). (Elim p; Trivial). - Qed. - - Lemma ad_z_less_1 : (a:ad) (ad_less ad_z a)=true -> {p:positive | a=(ad_x p)}. - Proof. - Induction a. Intro. Discriminate H. - Intros. Split with p. Reflexivity. - Qed. - - Lemma ad_z_less_2 : (a:ad) (ad_less ad_z a)=false -> a=ad_z. - Proof. - Induction a. Trivial. - Unfold ad_less. Simpl. Cut (p:positive)(ad_less_1 ad_z (ad_x p) p)=false->False. - Intros. Elim (H p H0). - Induction p. Intros. Discriminate H0. - Intros. Exact (H H0). - Intro. Discriminate H. - Qed. - - Lemma ad_less_trans : (a,a',a'':ad) - (ad_less a a')=true -> (ad_less a' a'')=true -> (ad_less a a'')=true. - Proof. - Intro a. Apply ad_ind_double with P:=[a:ad] - (a',a'':ad) - (ad_less a a')=true - ->(ad_less a' a'')=true->(ad_less a a'')=true. - Intros. Elim (sumbool_of_bool (ad_less ad_z a'')). Trivial. - Intro H1. Rewrite (ad_z_less_2 a'' H1) in H0. Rewrite (ad_less_z a') in H0. Discriminate H0. - Intros a0 H a'. Apply ad_ind_double with P:=[a':ad] - (a'':ad) - (ad_less (ad_double a0) a')=true - ->(ad_less a' a'')=true->(ad_less (ad_double a0) a'')=true. - Intros. Rewrite (ad_less_z (ad_double a0)) in H0. Discriminate H0. - Intros a1 H0 a'' H1. Rewrite (ad_less_def_1 a0 a1) in H1. - Apply ad_ind_double with P:=[a'':ad] - (ad_less (ad_double a1) a'')=true - ->(ad_less (ad_double a0) a'')=true. - Intro. Rewrite (ad_less_z (ad_double a1)) in H2. Discriminate H2. - Intros. Rewrite (ad_less_def_1 a1 a2) in H3. Rewrite (ad_less_def_1 a0 a2). - Exact (H a1 a2 H1 H3). - Intros. Apply ad_less_def_3. - Intros a1 H0 a'' H1. Apply ad_ind_double with P:=[a'':ad] - (ad_less (ad_double_plus_un a1) a'')=true - ->(ad_less (ad_double a0) a'')=true. - Intro. Rewrite (ad_less_z (ad_double_plus_un a1)) in H2. Discriminate H2. - Intros. Rewrite (ad_less_def_4 a1 a2) in H3. Discriminate H3. - Intros. Apply ad_less_def_3. - Intros a0 H a'. Apply ad_ind_double with P:=[a':ad] - (a'':ad) - (ad_less (ad_double_plus_un a0) a')=true - ->(ad_less a' a'')=true - ->(ad_less (ad_double_plus_un a0) a'')=true. - Intros. Rewrite (ad_less_z (ad_double_plus_un a0)) in H0. Discriminate H0. - Intros. Rewrite (ad_less_def_4 a0 a1) in H1. Discriminate H1. - Intros a1 H0 a'' H1. Apply ad_ind_double with P:=[a'':ad] - (ad_less (ad_double_plus_un a1) a'')=true - ->(ad_less (ad_double_plus_un a0) a'')=true. - Intro. Rewrite (ad_less_z (ad_double_plus_un a1)) in H2. Discriminate H2. - Intros. Rewrite (ad_less_def_4 a1 a2) in H3. Discriminate H3. - Rewrite (ad_less_def_2 a0 a1) in H1. Intros. Rewrite (ad_less_def_2 a1 a2) in H3. - Rewrite (ad_less_def_2 a0 a2). Exact (H a1 a2 H1 H3). - Qed. - - Fixpoint alist_sorted [l:(alist A)] : bool := - Cases l of - nil => true - | (cons (a, _) l') => Cases l' of - nil => true - | (cons (a', y') l'') => (andb (ad_less a a') - (alist_sorted l')) - end - end. - - Fixpoint alist_nth_ad [n:nat; l:(alist A)] : ad := - Cases l of - nil => ad_z (* dummy *) - | (cons (a, y) l') => Cases n of - O => a - | (S n') => (alist_nth_ad n' l') - end - end. - - Definition alist_sorted_1 := [l:(alist A)] - (n:nat) (le (S (S n)) (length l)) -> - (ad_less (alist_nth_ad n l) (alist_nth_ad (S n) l))=true. - - Lemma alist_sorted_imp_1 : (l:(alist A)) (alist_sorted l)=true -> (alist_sorted_1 l). - Proof. - Unfold alist_sorted_1. Induction l. Intros. Elim (le_Sn_O (S n) H0). - Intro r. Elim r. Intros a y. Induction l0. Intros. Simpl in H1. - Elim (le_Sn_O n (le_S_n (S n) O H1)). - Intro r0. Elim r0. Intros a0 y0. Induction n. Intros. Simpl. Simpl in H1. - Exact (proj1 ? ? (andb_prop ? ? H1)). - Intros. Change (ad_less (alist_nth_ad n0 (cons (a0,y0) l1)) - (alist_nth_ad (S n0) (cons (a0,y0) l1)))=true. - Apply H0. Exact (proj2 ? ? (andb_prop ? ? H1)). - Apply le_S_n. Exact H3. - Qed. - - Definition alist_sorted_2 := [l:(alist A)] - (m,n:nat) (lt m n) -> (le (S n) (length l)) -> - (ad_less (alist_nth_ad m l) (alist_nth_ad n l))=true. - - Lemma alist_sorted_1_imp_2 : (l:(alist A)) (alist_sorted_1 l) -> (alist_sorted_2 l). - Proof. - Unfold alist_sorted_1 alist_sorted_2 lt. Intros l H m n H0. Elim H0. Exact (H m). - Intros. Apply ad_less_trans with a':=(alist_nth_ad m0 l). Apply H2. Apply le_trans_S. - Assumption. - Apply H. Assumption. - Qed. - - Lemma alist_sorted_2_imp : (l:(alist A)) (alist_sorted_2 l) -> (alist_sorted l)=true. - Proof. - Unfold alist_sorted_2 lt. Induction l. Trivial. - Intro r. Elim r. Intros a y. Induction l0. Trivial. - Intro r0. Elim r0. Intros a0 y0. Intros. - Change (andb (ad_less a a0) (alist_sorted (cons (a0,y0) l1)))=true. - Apply andb_true_intro. Split. Apply (H1 (0) (1)). Apply le_n. - Simpl. 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 : (C:Set) (l,l':(list C)) (length (app l l'))=(plus (length l) (length l')). - Proof. - Induction l. Trivial. - Intros. Simpl. Rewrite (H l'). Reflexivity. - Qed. - - Lemma aapp_length : (l,l':(alist A)) (length (aapp A l l'))=(plus (length l) (length l')). - Proof. - Exact (app_length ad*A). - Qed. - - Lemma alist_nth_ad_aapp_1 : (l,l':(alist A)) (n:nat) - (le (S n) (length l)) -> (alist_nth_ad n (aapp A l l'))=(alist_nth_ad n l). - Proof. - Induction l. Intros. Elim (le_Sn_O n H). - Intro r. Elim r. Intros a y l' H l''. Induction n. Trivial. - Intros. Simpl. Apply H. Apply le_S_n. Exact H1. - Qed. - - Lemma alist_nth_ad_aapp_2 : (l,l':(alist A)) (n:nat) - (le (S n) (length l')) -> - (alist_nth_ad (plus (length l) n) (aapp A l l'))=(alist_nth_ad n l'). - Proof. - Induction l. Trivial. - Intro r. Elim r. Intros a y l' H l'' n H0. Simpl. Apply H. Exact H0. - Qed. - - Lemma interval_split : (p,q,n:nat) (le (S n) (plus p q)) -> - {n' : nat | (le (S n') q) /\ n=(plus p n')}+{(le (S n) p)}. - Proof. - Induction p. Simpl. Intros. Left . Split with n. (Split; [ Assumption | Reflexivity ]). - Intros p' H q. 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 : (l,l':(alist A)) (alist_sorted_2 l) -> (alist_sorted_2 l') -> - ((n,n':nat) (le (S n) (length l)) -> (le (S n') (length l')) -> - (ad_less (alist_nth_ad n l) (alist_nth_ad n' l'))=true) -> - (alist_sorted_2 (aapp A l l')). - Proof. - Unfold alist_sorted_2 lt. 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 (le (plus (S (length l)) m') (plus (length l) n')) in H2. - Rewrite (plus_Snm_nSm (length l) m') in H2. Exact (simpl_le_plus_l (length l) (S m') n' H2). - Exact H10. - Intro H8. Rewrite H7 in H2. Cut (le (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 (plus (length l) m')). - Apply le_trans with m:=(plus (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 : (l:(alist A)) (n:nat) (le (S n) (length l)) -> - {y:A | (alist_semantics A l (alist_nth_ad n l))=(SOME A y)}. - Proof. - Induction l. Intros. Elim (le_Sn_O ? H). - Intro r. Elim r. Intros a y l0 H. Induction n. Simpl. Intro. Split with y. - Rewrite (ad_eq_correct a). Reflexivity. - Intros. Elim (H ? (le_S_n ? ? H1)). Intros y0 H2. - Elim (sumbool_of_bool (ad_eq a (alist_nth_ad n0 l0))). Intro H3. Split with y. - Rewrite (ad_eq_complete ? ? H3). Simpl. Rewrite (ad_eq_correct (alist_nth_ad n0 l0)). - Reflexivity. - Intro H3. Split with y0. Simpl. Rewrite H3. Assumption. - Qed. - - Lemma alist_of_Map_nth_ad : (m:(Map A)) (pf:ad->ad) - (l:(alist A)) l=(MapFold1 A (alist A) (anil A) (aapp A) - [a0:ad][y:A](acons A (a0,y) (anil A)) pf m) -> - (n:nat) (le (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] (a,a':ad) - (ad_less a a')=true -> (ad_less (pf a) (pf a'))=true. - - Lemma ad_double_monotonic : (ad_monotonic ad_double). - Proof. - Unfold ad_monotonic. Intros. Rewrite ad_less_def_1. Assumption. - Qed. - - Lemma ad_double_plus_un_monotonic : (ad_monotonic ad_double_plus_un). - Proof. - Unfold ad_monotonic. Intros. Rewrite ad_less_def_2. Assumption. - Qed. - - Lemma ad_comp_monotonic : (pf,pf':ad->ad) (ad_monotonic pf) -> (ad_monotonic pf') -> - (ad_monotonic [a0:ad] (pf (pf' a0))). - Proof. - Unfold ad_monotonic. Intros. Apply H. Apply H0. Exact H1. - Qed. - - Lemma ad_comp_double_monotonic : (pf:ad->ad) (ad_monotonic pf) -> - (ad_monotonic [a0:ad] (pf (ad_double a0))). - Proof. - Intros. Apply ad_comp_monotonic. Assumption. - Exact ad_double_monotonic. - Qed. - - Lemma ad_comp_double_plus_un_monotonic : (pf:ad->ad) (ad_monotonic pf) -> - (ad_monotonic [a0:ad] (pf (ad_double_plus_un a0))). - Proof. - Intros. Apply ad_comp_monotonic. Assumption. - Exact ad_double_plus_un_monotonic. - Qed. - - Lemma alist_of_Map_sorts_1 : (m:(Map A)) (pf:ad->ad) (ad_monotonic pf) -> - (alist_sorted_2 (MapFold1 A (alist A) (anil A) (aapp A) - [a:ad][y:A](acons A (a,y) (anil A)) pf m)). - Proof. - Induction m. Simpl. Intros. Apply alist_sorted_1_imp_2. Apply alist_sorted_imp_1. Reflexivity. - Intros. Simpl. Apply alist_sorted_1_imp_2. Apply alist_sorted_imp_1. Reflexivity. - Intros. Simpl. Apply alist_conc_sorted. - Exact (H [a0:ad](pf (ad_double a0)) (ad_comp_double_monotonic pf H1)). - Exact (H0 [a0:ad](pf (ad_double_plus_un a0)) (ad_comp_double_plus_un_monotonic pf H1)). - Intros. Elim (alist_of_Map_nth_ad m0 [a0:ad](pf (ad_double a0)) - (MapFold1 A (alist A) (anil A) (aapp A) - [a0:ad][y:A](acons A (a0,y) (anil A)) - [a0:ad](pf (ad_double a0)) m0) (refl_equal ? ?) n H2). - Intros a H4. Rewrite H4. Elim (alist_of_Map_nth_ad m1 [a0:ad](pf (ad_double_plus_un a0)) - (MapFold1 A (alist A) (anil A) (aapp A) - [a0:ad][y:A](acons A (a0,y) (anil A)) - [a0:ad](pf (ad_double_plus_un a0)) m1) (refl_equal ? ?) n' H3). - Intros a' H5. Rewrite H5. Unfold ad_monotonic in H1. Apply H1. Apply ad_less_def_3. - Qed. - - Lemma alist_of_Map_sorts : (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 [a0:ad]a0 [a,a':ad][p:(ad_less a a')=true]p). - Qed. - - Lemma alist_of_Map_sorts1 : (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 : (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 ad_less_total : (a,a':ad) {(ad_less a a')=true}+{(ad_less a' a)=true}+{a=a'}. - Proof. - Intro a. Refine (ad_rec_double a [a:ad] (a':ad){(ad_less a a')=true}+{(ad_less a' a)=true}+{a=a'} - ? ? ?). - Intro. Elim (sumbool_of_bool (ad_less ad_z a')). Intro H. Left . Left . Assumption. - Intro H. Right . Rewrite (ad_z_less_2 a' H). Reflexivity. - Intros a0 H a'. Refine (ad_rec_double a' [a':ad] {(ad_less (ad_double a0) a')=true} - +{(ad_less a' (ad_double a0))=true}+{(ad_double a0)=a'} ? ? ?). - Elim (sumbool_of_bool (ad_less ad_z (ad_double a0))). Intro H0. Left . Right . Assumption. - Intro H0. Right . Exact (ad_z_less_2 ? H0). - Intros a1 H0. Rewrite ad_less_def_1. Rewrite ad_less_def_1. Elim (H a1). Intro H1. - Left . Assumption. - Intro H1. Right . Rewrite H1. Reflexivity. - Intros a1 H0. Left . Left . Apply ad_less_def_3. - Intros a0 H a'. Refine (ad_rec_double a' [a':ad] {(ad_less (ad_double_plus_un a0) a')=true} - +{(ad_less a' (ad_double_plus_un a0))=true} - +{(ad_double_plus_un a0)=a'} ? ? ?). - Left . Right . (Case a0; Reflexivity). - Intros a1 H0. Left . Right . Apply ad_less_def_3. - Intros a1 H0. Rewrite ad_less_def_2. Rewrite ad_less_def_2. Elim (H a1). Intro H1. - Left . Assumption. - Intro H1. Right . Rewrite H1. Reflexivity. - Qed. - - Lemma alist_too_low : (l:(alist A)) (a,a':ad) (y:A) - (ad_less a a')=true -> (alist_sorted_2 (cons (a',y) l)) -> - (alist_semantics A (cons (a',y) l) a)=(NONE A). - Proof. - Induction l. Intros. Simpl. Elim (sumbool_of_bool (ad_eq a' a)). Intro H1. - Rewrite (ad_eq_complete ? ? H1) in H. Rewrite (ad_less_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 (Case (ad_eq a1 a0) of - (SOME A y0) - (alist_semantics A (cons (a,y) l0) a0) - end)=(NONE A). - Elim (sumbool_of_bool (ad_eq a1 a0)). Intro H2. Rewrite (ad_eq_complete ? ? H2) in H0. - Rewrite (ad_less_not_refl a0) in H0. Discriminate H0. - Intro H2. Rewrite H2. Apply H. Apply ad_less_trans with a':=a1. Assumption. - Unfold alist_sorted_2 in H1. Apply (H1 (0) (1)). Apply lt_n_Sn. - Simpl. 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 (cons (a1,y0) (cons (a,y) l0)))=true. Intro H3. - Exact (proj2 ? ? (andb_prop ? ? H3)). - Apply alist_sorted_2_imp. Assumption. - Qed. - - Lemma alist_semantics_nth_ad : (l:(alist A)) (a:ad) (y:A) - (alist_semantics A l a)=(SOME A y) -> - {n:nat | (le (S n) (length l)) /\ (alist_nth_ad n l)=a}. - Proof. - Induction l. Intros. Discriminate H. - Intro r. Elim r. Intros a y l0 H a0 y0 H0. Simpl in H0. Elim (sumbool_of_bool (ad_eq a a0)). - Intro H1. Rewrite H1 in H0. Split with O. Split. Simpl. Apply le_n_S. Apply le_O_n. - Simpl. Exact (ad_eq_complete ? ? H1). - Intro H1. Rewrite H1 in H0. Elim (H a0 y0 H0). Intros n' H2. Split with (S n'). Split. - Simpl. Apply le_n_S. Exact (proj1 ? ? H2). - Exact (proj2 ? ? H2). - Qed. - - Lemma alist_semantics_tail : (l:(alist A)) (a:ad) (y:A) - (alist_sorted_2 (cons (a,y) l)) -> - (eqm A (alist_semantics A l) [a0:ad] if (ad_eq a a0) - then (NONE A) - else (alist_semantics A (cons (a,y) l) a0)). - Proof. - Unfold eqm. Intros. Elim (sumbool_of_bool (ad_eq a a0)). Intro H0. Rewrite H0. - Rewrite <- (ad_eq_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 (ad_less (alist_nth_ad (0) (cons (a,y) l)) (alist_nth_ad (S n) (cons (a,y) l)))=true. - Intro. Simpl in H6. Rewrite H5 in H6. Rewrite (ad_less_not_refl a) in H6. Discriminate H6. - Apply H. Apply lt_O_Sn. - Simpl. Apply le_n_S. Assumption. - Trivial. - Intro H0. Simpl. Rewrite H0. Reflexivity. - Qed. - - Lemma alist_semantics_same_tail : (l,l':(alist A)) (a:ad) (y:A) - (alist_sorted_2 (cons (a,y) l)) -> (alist_sorted_2 (cons (a,y) l')) -> - (eqm A (alist_semantics A (cons (a,y) l)) (alist_semantics A (cons (a,y) l'))) -> - (eqm A (alist_semantics A l) (alist_semantics A l')). - Proof. - Unfold eqm. Intros. Rewrite (alist_semantics_tail ? ? ? H a0). - Rewrite (alist_semantics_tail ? ? ? H0 a0). Case (ad_eq a a0). Reflexivity. - Exact (H1 a0). - Qed. - - Lemma alist_sorted_tail : (l:(alist A)) (a:ad) (y:A) - (alist_sorted_2 (cons (a,y) l)) -> (alist_sorted_2 l). - Proof. - Unfold alist_sorted_2. Intros. Apply (H (S m) (S n)). Apply lt_n_S. Assumption. - Simpl. Apply le_n_S. Assumption. - Qed. - - Lemma alist_canonical : (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. Induction l. Induction l'. Trivial. - Intro r. Elim r. Intros a y l0 H H0 H1 H2. Simpl in H0. - Cut (NONE A)=(Case (ad_eq a a) of (SOME A y) - (alist_semantics A l0 a) - end). - Rewrite (ad_eq_correct a). Intro. Discriminate H3. - Exact (H0 a). - Intro r. Elim r. Intros a y l0 H. Induction l'. Intros. Simpl in H0. - Cut (Case (ad_eq a a) of (SOME A y) - (alist_semantics A l0 a) - end)=(NONE A). - Rewrite (ad_eq_correct a). Intro. Discriminate H3. - Exact (H0 a). - Intro r'. Elim r'. Intros a' y' l'0 H0 H1 H2 H3. Elim (ad_less_total a a'). Intro H4. - Elim H4. Intro H5. - Cut (alist_semantics A (cons (a,y) l0) a)=(alist_semantics A (cons (a',y') l'0) a). - Intro. Rewrite (alist_too_low l'0 a a' y' H5 H3) in H6. Simpl in H6. - Rewrite (ad_eq_correct a) in H6. Discriminate H6. - Exact (H1 a). - Intro H5. Cut (alist_semantics A (cons (a,y) l0) a')=(alist_semantics A (cons (a',y') l'0) a'). - Intro. Rewrite (alist_too_low l0 a' a y H5 H2) in H6. Simpl in H6. - Rewrite (ad_eq_correct a') in H6. Discriminate H6. - Exact (H1 a'). - Intro H4. Rewrite H4. - Cut (alist_semantics A (cons (a,y) l0) a)=(alist_semantics A (cons (a',y') l'0) a). - Intro. Simpl in H5. Rewrite H4 in H5. Rewrite (ad_eq_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. diff --git a/theories7/IntMap/Map.v b/theories7/IntMap/Map.v deleted file mode 100644 index 00ba3f8a..00000000 --- a/theories7/IntMap/Map.v +++ /dev/null @@ -1,786 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* A -> Map - | M2 : Map -> Map -> Map. - - Inductive option : Set := - NONE : option - | SOME : A -> option. - - Lemma option_sum : (o:option) {y:A | o=(SOME y)}+{o=NONE}. - Proof. - Induction o. Right . Reflexivity. - Left . Split with a. 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 := - Cases m of - M0 => [a:ad] NONE - | (M1 x y) => [a:ad] - if (ad_eq x a) - then (SOME y) - else NONE - | (M2 m1 m2) => [a:ad] - Cases a of - ad_z => (MapGet m1 ad_z) - | (ad_x xH) => (MapGet m2 ad_z) - | (ad_x (xO p)) => (MapGet m1 (ad_x p)) - | (ad_x (xI p)) => (MapGet m2 (ad_x p)) - end - end. - - Definition newMap := M0. - - Definition MapSingleton := M1. - - Definition eqm := [g,g':ad->option] (a:ad) (g a)=(g' a). - - Lemma newMap_semantics : (eqm (MapGet newMap) [a:ad] NONE). - Proof. - Simpl. Unfold eqm. Trivial. - Qed. - - Lemma MapSingleton_semantics : (a:ad) (y:A) - (eqm (MapGet (MapSingleton a y)) [a':ad] if (ad_eq a a') then (SOME y) else NONE). - Proof. - Simpl. Unfold eqm. Trivial. - Qed. - - Lemma M1_semantics_1 : (a:ad) (y:A) (MapGet (M1 a y) a)=(SOME y). - Proof. - Unfold MapGet. Intros. Rewrite (ad_eq_correct a). Reflexivity. - Qed. - - Lemma M1_semantics_2 : - (a,a':ad) (y:A) (ad_eq a a')=false -> (MapGet (M1 a y) a')=NONE. - Proof. - Intros. Simpl. Rewrite H. Reflexivity. - Qed. - - Lemma Map2_semantics_1 : - (m,m':Map) (eqm (MapGet m) [a:ad] (MapGet (M2 m m') (ad_double a))). - Proof. - Unfold eqm. Induction a; Trivial. - Qed. - - Lemma Map2_semantics_1_eq : (m,m':Map) (f:ad->option) (eqm (MapGet (M2 m m')) f) - -> (eqm (MapGet m) [a:ad] (f (ad_double a))). - Proof. - Unfold eqm. - Intros. - Rewrite <- (H (ad_double a)). - Exact (Map2_semantics_1 m m' a). - Qed. - - Lemma Map2_semantics_2 : - (m,m':Map) (eqm (MapGet m') [a:ad] (MapGet (M2 m m') (ad_double_plus_un a))). - Proof. - Unfold eqm. Induction a; Trivial. - Qed. - - Lemma Map2_semantics_2_eq : (m,m':Map) (f:ad->option) (eqm (MapGet (M2 m m')) f) - -> (eqm (MapGet m') [a:ad] (f (ad_double_plus_un a))). - Proof. - Unfold eqm. - Intros. - Rewrite <- (H (ad_double_plus_un a)). - Exact (Map2_semantics_2 m m' a). - Qed. - - Lemma MapGet_M2_bit_0_0 : (a:ad) (ad_bit_0 a)=false - -> (m,m':Map) (MapGet (M2 m m') a)=(MapGet m (ad_div_2 a)). - Proof. - Induction a; Trivial. Induction p. Intros. Discriminate H0. - Trivial. - Intros. Discriminate H. - Qed. - - Lemma MapGet_M2_bit_0_1 : (a:ad) (ad_bit_0 a)=true - -> (m,m':Map) (MapGet (M2 m m') a)=(MapGet m' (ad_div_2 a)). - Proof. - Induction a. Intros. Discriminate H. - Induction p. Trivial. - Intros. Discriminate H0. - Trivial. - Qed. - - Lemma MapGet_M2_bit_0_if : (m,m':Map) (a:ad) (MapGet (M2 m m') a)= - (if (ad_bit_0 a) then (MapGet m' (ad_div_2 a)) else (MapGet m (ad_div_2 a))). - Proof. - Intros. Elim (sumbool_of_bool (ad_bit_0 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 : (m,m',m'':Map) - (a:ad) (if (ad_bit_0 a) then (MapGet (M2 m' m) a) else (MapGet (M2 m m'') a))= - (MapGet m (ad_div_2 a)). - Proof. - Intros. Elim (sumbool_of_bool (ad_bit_0 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 : (m,m':Map) (eqm (MapGet (M2 m m')) - [a:ad] Cases (ad_bit_0 a) of - false => (MapGet m (ad_div_2 a)) - | true => (MapGet m' (ad_div_2 a)) - end). - Proof. - Unfold eqm. - Induction a; Trivial. - Induction p; Trivial. - Qed. - - Lemma Map2_semantics_3_eq : (m,m':Map) (f,f':ad->option) - (eqm (MapGet m) f) -> (eqm (MapGet m') f') -> (eqm (MapGet (M2 m m')) - [a:ad] Cases (ad_bit_0 a) of - false => (f (ad_div_2 a)) - | true => (f' (ad_div_2 a)) - end). - Proof. - Unfold eqm. - Intros. - Rewrite <- (H (ad_div_2 a)). - Rewrite <- (H0 (ad_div_2 a)). - Exact (Map2_semantics_3 m m' a). - Qed. - - Fixpoint MapPut1 [a:ad; y:A; a':ad; y':A; p:positive] : Map := - Cases p of - (xO p') => let m = (MapPut1 (ad_div_2 a) y (ad_div_2 a') y' p') in - Cases (ad_bit_0 a) of - false => (M2 m M0) - | true => (M2 M0 m) - end - | _ => Cases (ad_bit_0 a) of - false => (M2 (M1 (ad_div_2 a) y) (M1 (ad_div_2 a') y')) - | true => (M2 (M1 (ad_div_2 a') y') (M1 (ad_div_2 a) y)) - end - end. - - Lemma MapGet_if_commute : (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 (ad_bit_0 a) then (M2 m m') else (M2 m'' m''')) a)= - (MapGet (if (ad_bit_0 a) then m' else m'') (ad_div_2 a)). - Proof. - Intros. Rewrite (MapGet_if_commute (ad_bit_0 a)). Rewrite (MapGet_if_commute (ad_bit_0 a)). - Cut (ad_bit_0 a)=false\/(ad_bit_0 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 (ad_bit_0 a); Auto. - Qed. - i*) - - Lemma MapGet_if_same : (m:Map) (b:bool) (a:ad) - (MapGet (if b then m else m) a)=(MapGet m a). - Proof. - Induction b;Trivial. - Qed. - - Lemma MapGet_M2_bit_0_2 : (m,m',m'':Map) - (a:ad) (MapGet (if (ad_bit_0 a) then (M2 m m') else (M2 m' m'')) a)= - (MapGet m' (ad_div_2 a)). - Proof. - Intros. Rewrite MapGet_if_commute. Apply MapGet_M2_bit_0. - Qed. - - Lemma MapPut1_semantics_1 : (p:positive) (a,a':ad) (y,y':A) - (ad_xor a a')=(ad_x p) - -> (MapGet (MapPut1 a y a' y' p) a)=(SOME y). - Proof. - Induction p. Intros. Unfold MapPut1. Rewrite MapGet_M2_bit_0_2. Apply M1_semantics_1. - Intros. Simpl. Rewrite MapGet_M2_bit_0_2. Apply H. Rewrite <- ad_xor_div_2. Rewrite H0. - Reflexivity. - Intros. Unfold MapPut1. Rewrite MapGet_M2_bit_0_2. Apply M1_semantics_1. - Qed. - - Lemma MapPut1_semantics_2 : (p:positive) (a,a':ad) (y,y':A) - (ad_xor a a')=(ad_x p) - -> (MapGet (MapPut1 a y a' y' p) a')=(SOME y'). - Proof. - Induction p. Intros. Unfold MapPut1. Rewrite (ad_neg_bit_0_2 a a' p0 H0). - Rewrite if_negb. Rewrite MapGet_M2_bit_0_2. Apply M1_semantics_1. - Intros. Simpl. Rewrite (ad_same_bit_0 a a' p0 H0). Rewrite MapGet_M2_bit_0_2. - Apply H. Rewrite <- ad_xor_div_2. Rewrite H0. Reflexivity. - Intros. Unfold MapPut1. Rewrite (ad_neg_bit_0_1 a a' H). Rewrite if_negb. - Rewrite MapGet_M2_bit_0_2. Apply M1_semantics_1. - Qed. - - Lemma MapGet_M2_both_NONE : (m,m':Map) (a:ad) - (MapGet m (ad_div_2 a))=NONE -> (MapGet m' (ad_div_2 a))=NONE -> - (MapGet (M2 m m') a)=NONE. - Proof. - Intros. Rewrite (Map2_semantics_3 m m' a). - Case (ad_bit_0 a); Assumption. - Qed. - - Lemma MapPut1_semantics_3 : (p:positive) (a,a',a0:ad) (y,y':A) - (ad_xor a a')=(ad_x p) -> (ad_eq a a0)=false -> (ad_eq a' a0)=false -> - (MapGet (MapPut1 a y a' y' p) a0)=NONE. - Proof. - Induction p. Intros. Unfold MapPut1. Elim (ad_neq a a0 H1). Intro. Rewrite H3. Rewrite if_negb. - Rewrite MapGet_M2_bit_0_2. Apply M1_semantics_2. Apply ad_div_bit_neq. Assumption. - Rewrite (ad_neg_bit_0_2 a a' p0 H0) in H3. Rewrite (negb_intro (ad_bit_0 a')). - Rewrite (negb_intro (ad_bit_0 a0)). Rewrite H3. Reflexivity. - Intro. Elim (ad_neq a' a0 H2). Intro. Rewrite (ad_neg_bit_0_2 a a' p0 H0). Rewrite H4. - Rewrite (negb_elim (ad_bit_0 a0)). Rewrite MapGet_M2_bit_0_2. - Apply M1_semantics_2; Assumption. - Intro; Case (ad_bit_0 a); Apply MapGet_M2_both_NONE; - Apply M1_semantics_2; Assumption. - Intros. Simpl. Elim (ad_neq a a0 H1). Intro. Rewrite H3. Rewrite if_negb. - Rewrite MapGet_M2_bit_0_2. Reflexivity. - Intro. Elim (ad_neq a' a0 H2). Intro. Rewrite (ad_same_bit_0 a a' p0 H0). Rewrite H4. - Rewrite if_negb. Rewrite MapGet_M2_bit_0_2. Reflexivity. - Intro. Cut (ad_xor (ad_div_2 a) (ad_div_2 a'))=(ad_x p0). Intro. - Case (ad_bit_0 a); Apply MapGet_M2_both_NONE; Trivial; - Apply H; Assumption. - Rewrite <- ad_xor_div_2. Rewrite H0. Reflexivity. - Intros. Simpl. Elim (ad_neq a a0 H0). Intro. Rewrite H2. Rewrite if_negb. - Rewrite MapGet_M2_bit_0_2. Apply M1_semantics_2. Apply ad_div_bit_neq. Assumption. - Rewrite (ad_neg_bit_0_1 a a' H) in H2. Rewrite (negb_intro (ad_bit_0 a')). - Rewrite (negb_intro (ad_bit_0 a0)). Rewrite H2. Reflexivity. - Intro. Elim (ad_neq a' a0 H1). Intro. Rewrite (ad_neg_bit_0_1 a a' H). Rewrite H3. - Rewrite (negb_elim (ad_bit_0 a0)). Rewrite MapGet_M2_bit_0_2. - Apply M1_semantics_2; Assumption. - Intro. Case (ad_bit_0 a); Apply MapGet_M2_both_NONE; Apply M1_semantics_2; Assumption. - Qed. - - Lemma MapPut1_semantics : (p:positive) (a,a':ad) (y,y':A) - (ad_xor a a')=(ad_x p) - -> (eqm (MapGet (MapPut1 a y a' y' p)) - [a0:ad] if (ad_eq a a0) then (SOME y) - else if (ad_eq a' a0) then (SOME y') else NONE). - Proof. - Unfold eqm. Intros. Elim (sumbool_of_bool (ad_eq a a0)). Intro H0. Rewrite H0. - Rewrite <- (ad_eq_complete ? ? H0). Exact (MapPut1_semantics_1 p a a' y y' H). - Intro H0. Rewrite H0. Elim (sumbool_of_bool (ad_eq a' a0)). Intro H1. - Rewrite <- (ad_eq_complete ? ? H1). Rewrite (ad_eq_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' : (p:positive) (a,a':ad) (y,y':A) - (ad_xor a a')=(ad_x p) - -> (eqm (MapGet (MapPut1 a y a' y' p)) - [a0:ad] if (ad_eq a' a0) then (SOME y') - else if (ad_eq a a0) then (SOME y) else NONE). - Proof. - Unfold eqm. Intros. Rewrite (MapPut1_semantics p a a' y y' H a0). - Elim (sumbool_of_bool (ad_eq a a0)). Intro H0. Rewrite H0. - Rewrite <- (ad_eq_complete a a0 H0). Rewrite (ad_eq_comm a' a). - Rewrite (ad_xor_eq_false a a' p H). Reflexivity. - Intro H0. Rewrite H0. Reflexivity. - Qed. - - Fixpoint MapPut [m:Map] : ad -> A -> Map := - Cases m of - M0 => M1 - | (M1 a y) => [a':ad; y':A] - Cases (ad_xor a a') of - ad_z => (M1 a' y') - | (ad_x p) => (MapPut1 a y a' y' p) - end - | (M2 m1 m2) => [a:ad; y:A] - Cases a of - ad_z => (M2 (MapPut m1 ad_z y) m2) - | (ad_x xH) => (M2 m1 (MapPut m2 ad_z y)) - | (ad_x (xO p)) => (M2 (MapPut m1 (ad_x p) y) m2) - | (ad_x (xI p)) => (M2 m1 (MapPut m2 (ad_x p) y)) - end - end. - - Lemma MapPut_semantics_1 : (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 : (a:ad) (y,y':A) (a0:ad) - (MapGet (MapPut (M1 a y) a y') a0)=(if (ad_eq a a0) then (SOME y') else NONE). - Proof. - Simpl. Intros. Rewrite (ad_xor_nilpotent a). Trivial. - Qed. - - Lemma MapPut_semantics_2_2 : (a,a':ad) (y,y':A) (a0:ad) (a'':ad) (ad_xor a a')=a'' -> - (MapGet (MapPut (M1 a y) a' y') a0)= - (if (ad_eq a' a0) then (SOME y') else - if (ad_eq a a0) then (SOME y) else NONE). - Proof. - Induction a''. Intro. Rewrite (ad_xor_eq ? ? H). Rewrite MapPut_semantics_2_1. - Case (ad_eq a' a0); Trivial. - Intros. Simpl. Rewrite H. Rewrite (MapPut1_semantics p a a' y y' H a0). - Elim (sumbool_of_bool (ad_eq a a0)). Intro H0. Rewrite H0. Rewrite <- (ad_eq_complete ? ? H0). - Rewrite (ad_eq_comm a' a). Rewrite (ad_xor_eq_false ? ? ? H). Reflexivity. - Intro H0. Rewrite H0. Reflexivity. - Qed. - - Lemma MapPut_semantics_2 : (a,a':ad) (y,y':A) (a0:ad) - (MapGet (MapPut (M1 a y) a' y') a0)= - (if (ad_eq a' a0) then (SOME y') else - if (ad_eq a a0) then (SOME y) else NONE). - Proof. - Intros. Apply MapPut_semantics_2_2 with a'':=(ad_xor a a'); Trivial. - Qed. - - Lemma MapPut_semantics_3_1 : (m,m':Map) (a:ad) (y:A) - (MapPut (M2 m m') a y)=(if (ad_bit_0 a) then (M2 m (MapPut m' (ad_div_2 a) y)) - else (M2 (MapPut m (ad_div_2 a) y) m')). - Proof. - Induction a. Trivial. - Induction p; Trivial. - Qed. - - Lemma MapPut_semantics : (m:Map) (a:ad) (y:A) - (eqm (MapGet (MapPut m a y)) [a':ad] if (ad_eq a a') then (SOME y) else (MapGet m a')). - Proof. - Unfold eqm. Induction m. Exact MapPut_semantics_1. - Intros. Unfold 2 MapGet. Apply MapPut_semantics_2; Assumption. - Intros. Rewrite MapPut_semantics_3_1. Rewrite (MapGet_M2_bit_0_if m0 m1 a0). - Elim (sumbool_of_bool (ad_bit_0 a)). Intro H1. Rewrite H1. Rewrite MapGet_M2_bit_0_if. - Elim (sumbool_of_bool (ad_bit_0 a0)). Intro H2. Rewrite H2. - Rewrite (H0 (ad_div_2 a) y (ad_div_2 a0)). Elim (sumbool_of_bool (ad_eq a a0)). - Intro H3. Rewrite H3. Rewrite (ad_div_eq ? ? H3). Reflexivity. - Intro H3. Rewrite H3. Rewrite <- H2 in H1. Rewrite (ad_div_bit_neq ? ? H3 H1). Reflexivity. - Intro H2. Rewrite H2. Rewrite (ad_eq_comm a a0). Rewrite (ad_bit_0_neq a0 a H2 H1). - Reflexivity. - Intro H1. Rewrite H1. Rewrite MapGet_M2_bit_0_if. Elim (sumbool_of_bool (ad_bit_0 a0)). - Intro H2. Rewrite H2. Rewrite (ad_bit_0_neq a a0 H1 H2). Reflexivity. - Intro H2. Rewrite H2. Rewrite (H (ad_div_2 a) y (ad_div_2 a0)). - Elim (sumbool_of_bool (ad_eq a a0)). Intro H3. Rewrite H3. - Rewrite (ad_div_eq a a0 H3). Reflexivity. - Intro H3. Rewrite H3. Rewrite <- H2 in H1. Rewrite (ad_div_bit_neq a a0 H3 H1). Reflexivity. - Qed. - - Fixpoint MapPut_behind [m:Map] : ad -> A -> Map := - Cases m of - M0 => M1 - | (M1 a y) => [a':ad; y':A] - Cases (ad_xor a a') of - ad_z => m - | (ad_x p) => (MapPut1 a y a' y' p) - end - | (M2 m1 m2) => [a:ad; y:A] - Cases a of - ad_z => (M2 (MapPut_behind m1 ad_z y) m2) - | (ad_x xH) => (M2 m1 (MapPut_behind m2 ad_z y)) - | (ad_x (xO p)) => (M2 (MapPut_behind m1 (ad_x p) y) m2) - | (ad_x (xI p)) => (M2 m1 (MapPut_behind m2 (ad_x p) y)) - end - end. - - Lemma MapPut_behind_semantics_3_1 : (m,m':Map) (a:ad) (y:A) - (MapPut_behind (M2 m m') a y)= - (if (ad_bit_0 a) then (M2 m (MapPut_behind m' (ad_div_2 a) y)) - else (M2 (MapPut_behind m (ad_div_2 a) y) m')). - Proof. - Induction a. Trivial. - Induction p; Trivial. - Qed. - - Lemma MapPut_behind_as_before_1 : (a,a',a0:ad) (ad_eq a' a0)=false -> - (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. Intros H y y'. Elim (ad_sum (ad_xor a a')). Intro H0. Elim H0. - Intros p H1. Rewrite H1. Reflexivity. - Intro H0. Rewrite H0. Rewrite (ad_xor_eq ? ? H0). Rewrite (M1_semantics_2 a' a0 y H). - Exact (M1_semantics_2 a' a0 y' H). - Qed. - - Lemma MapPut_behind_as_before : (m:Map) (a:ad) (y:A) - (a0:ad) (ad_eq a a0)=false -> - (MapGet (MapPut m a y) a0)=(MapGet (MapPut_behind m a y) a0). - Proof. - 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 (ad_bit_0 a)). Intro H2. Rewrite H2. Rewrite MapGet_M2_bit_0_if. - Rewrite MapGet_M2_bit_0_if. Elim (sumbool_of_bool (ad_bit_0 a0)). Intro H3. - Rewrite H3. Apply H0. Rewrite <- H3 in H2. Exact (ad_div_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 (ad_bit_0 a0)). Intro H3. Rewrite H3. Reflexivity. - Intro H3. Rewrite H3. Apply H. Rewrite <- H3 in H2. Exact (ad_div_bit_neq a a0 H1 H2). - Qed. - - Lemma MapPut_behind_new : (m:Map) (a:ad) (y:A) - (MapGet (MapPut_behind m a y) a)=(Cases (MapGet m a) of - (SOME y') => (SOME y') - | _ => (SOME y) - end). - Proof. - Induction m. Simpl. Intros. Rewrite (ad_eq_correct a). Reflexivity. - Intros. Elim (ad_sum (ad_xor a a1)). Intro H. Elim H. Intros p H0. Simpl. - Rewrite H0. Rewrite (ad_xor_eq_false a a1 p). Exact (MapPut1_semantics_2 p a a1 a0 y H0). - Assumption. - Intro H. Simpl. Rewrite H. Rewrite <- (ad_xor_eq ? ? H). Rewrite (ad_eq_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 (ad_bit_0 a)). Intro H1. Rewrite H1. Rewrite (MapGet_M2_bit_0_1 a H1). - Exact (H0 (ad_div_2 a) y). - Intro H1. Rewrite H1. Rewrite (MapGet_M2_bit_0_0 a H1). Exact (H (ad_div_2 a) y). - Qed. - - Lemma MapPut_behind_semantics : (m:Map) (a:ad) (y:A) - (eqm (MapGet (MapPut_behind m a y)) - [a':ad] Cases (MapGet m a') of - (SOME y') => (SOME y') - | _ => if (ad_eq a a') then (SOME y) else NONE - end). - Proof. - Unfold eqm. Intros. Elim (sumbool_of_bool (ad_eq a a0)). Intro H. Rewrite H. - Rewrite (ad_eq_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] Cases m m' of - M0 M0 => M0 - | M0 (M1 a y) => (M1 (ad_double_plus_un a) y) - | (M1 a y) M0 => (M1 (ad_double a) y) - | _ _ => (M2 m m') - end. - - Lemma makeM2_M2 : (m,m':Map) (eqm (MapGet (makeM2 m m')) (MapGet (M2 m m'))). - Proof. - Unfold eqm. Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H. - Rewrite (MapGet_M2_bit_0_1 a H m m'). Case m'. Case m. Reflexivity. - Intros a0 y. Simpl. Rewrite (ad_bit_0_1_not_double a H a0). Reflexivity. - Intros m1 m2. Unfold makeM2. Rewrite MapGet_M2_bit_0_1. Reflexivity. - Assumption. - Case m. Intros a0 y. Simpl. Elim (sumbool_of_bool (ad_eq a0 (ad_div_2 a))). - Intro H0. Rewrite H0. Rewrite (ad_eq_complete ? ? H0). Rewrite (ad_div_2_double_plus_un a H). - Rewrite (ad_eq_correct a). Reflexivity. - Intro H0. Rewrite H0. Rewrite (ad_eq_comm a0 (ad_div_2 a)) in H0. - Rewrite (ad_not_div_2_not_double_plus_un a a0 H0). Reflexivity. - Intros a0 y0 a1 y1. Unfold makeM2. Rewrite MapGet_M2_bit_0_1. Reflexivity. - Assumption. - Intros m1 m2 a0 y. Unfold makeM2. Rewrite MapGet_M2_bit_0_1. Reflexivity. - Assumption. - Intros m1 m2. Unfold makeM2. - Cut (MapGet (M2 m (M2 m1 m2)) a)=(MapGet (M2 m1 m2) (ad_div_2 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. Rewrite (ad_bit_0_0_not_double_plus_un a H a0). Reflexivity. - Intros m1 m2. Unfold makeM2. Rewrite MapGet_M2_bit_0_0. Reflexivity. - Assumption. - Case m'. Intros a0 y. Simpl. Elim (sumbool_of_bool (ad_eq a0 (ad_div_2 a))). Intro H0. - Rewrite H0. Rewrite (ad_eq_complete ? ? H0). Rewrite (ad_div_2_double a H). - Rewrite (ad_eq_correct a). Reflexivity. - Intro H0. Rewrite H0. Rewrite (ad_eq_comm (ad_double a0) a). - Rewrite (ad_eq_comm a0 (ad_div_2 a)) in H0. Rewrite (ad_not_div_2_not_double a a0 H0). - Reflexivity. - Intros a0 y0 a1 y1. Unfold makeM2. Rewrite MapGet_M2_bit_0_0. Reflexivity. - Assumption. - Intros m1 m2 a0 y. Unfold makeM2. Rewrite MapGet_M2_bit_0_0. Reflexivity. - Assumption. - Intros m1 m2. Unfold makeM2. Exact (MapGet_M2_bit_0_0 a H (M2 m1 m2) m'). - Qed. - - Fixpoint MapRemove [m:Map] : ad -> Map := - Cases m of - M0 => [_:ad] M0 - | (M1 a y) => [a':ad] - Cases (ad_eq a a') of - true => M0 - | false => m - end - | (M2 m1 m2) => [a:ad] - if (ad_bit_0 a) - then (makeM2 m1 (MapRemove m2 (ad_div_2 a))) - else (makeM2 (MapRemove m1 (ad_div_2 a)) m2) - end. - - Lemma MapRemove_semantics : (m:Map) (a:ad) - (eqm (MapGet (MapRemove m a)) [a':ad] if (ad_eq a a') then NONE else (MapGet m a')). - Proof. - Unfold eqm. Induction m. Simpl. Intros. Case (ad_eq a a0); Trivial. - Intros. Simpl. Elim (sumbool_of_bool (ad_eq a1 a2)). Intro H. Rewrite H. - Elim (sumbool_of_bool (ad_eq a a1)). Intro H0. Rewrite H0. Reflexivity. - Intro H0. Rewrite H0. Rewrite (ad_eq_complete ? ? H) in H0. Exact (M1_semantics_2 a a2 a0 H0). - Intro H. Elim (sumbool_of_bool (ad_eq a a1)). Intro H0. Rewrite H0. Rewrite H. - Rewrite <- (ad_eq_complete ? ? H0) in H. Rewrite H. Reflexivity. - Intro H0. Rewrite H0. Rewrite H. Reflexivity. - Intros. Change (MapGet (if (ad_bit_0 a) - then (makeM2 m0 (MapRemove m1 (ad_div_2 a))) - else (makeM2 (MapRemove m0 (ad_div_2 a)) m1)) - a0) - =(if (ad_eq a a0) then NONE else (MapGet (M2 m0 m1) a0)). - Elim (sumbool_of_bool (ad_bit_0 a)). Intro H1. Rewrite H1. - Rewrite (makeM2_M2 m0 (MapRemove m1 (ad_div_2 a)) a0). Elim (sumbool_of_bool (ad_bit_0 a0)). - Intro H2. Rewrite MapGet_M2_bit_0_1. Rewrite (H0 (ad_div_2 a) (ad_div_2 a0)). - Elim (sumbool_of_bool (ad_eq a a0)). Intro H3. Rewrite H3. Rewrite (ad_div_eq ? ? H3). - Reflexivity. - Intro H3. Rewrite H3. Rewrite <- H2 in H1. Rewrite (ad_div_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 (ad_div_2 a))). - Rewrite (ad_eq_comm a a0). Rewrite (ad_bit_0_neq ? ? H2 H1). - Rewrite (MapGet_M2_bit_0_0 a0 H2 m0 m1). Reflexivity. - Intro H1. Rewrite H1. Rewrite (makeM2_M2 (MapRemove m0 (ad_div_2 a)) m1 a0). - Elim (sumbool_of_bool (ad_bit_0 a0)). Intro H2. Rewrite MapGet_M2_bit_0_1. - Rewrite (MapGet_M2_bit_0_1 a0 H2 m0 m1). Rewrite (ad_bit_0_neq a a0 H1 H2). Reflexivity. - Assumption. - Intro H2. Rewrite MapGet_M2_bit_0_0. Rewrite (H (ad_div_2 a) (ad_div_2 a0)). - Rewrite (MapGet_M2_bit_0_0 a0 H2 m0 m1). Elim (sumbool_of_bool (ad_eq a a0)). Intro H3. - Rewrite H3. Rewrite (ad_div_eq ? ? H3). Reflexivity. - Intro H3. Rewrite H3. Rewrite <- H2 in H1. Rewrite (ad_div_bit_neq ? ? H3 H1). Reflexivity. - Assumption. - Qed. - - Fixpoint MapCard [m:Map] : nat := - Cases m of - M0 => O - | (M1 _ _) => (S O) - | (M2 m m') => (plus (MapCard m) (MapCard m')) - end. - - Fixpoint MapMerge [m:Map] : Map -> Map := - Cases m of - M0 => [m':Map] m' - | (M1 a y) => [m':Map] (MapPut_behind m' a y) - | (M2 m1 m2) => [m':Map] Cases m' of - 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 : (m,m':Map) - (eqm (MapGet (MapMerge m m')) - [a0:ad] Cases (MapGet m' a0) of - (SOME y') => (SOME y') - | NONE => (MapGet m a0) - end). - Proof. - Unfold eqm. Induction m. Intros. Simpl. Case (MapGet m' a); Trivial. - Intros. Simpl. Rewrite (MapPut_behind_semantics m' a a0 a1). Reflexivity. - Induction m'. Trivial. - Intros. Unfold MapMerge. Rewrite (MapPut_semantics (M2 m0 m1) a a0 a1). - Elim (sumbool_of_bool (ad_eq a a1)). Intro H1. Rewrite H1. Rewrite (ad_eq_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 (ad_div_2 a)). - Rewrite (H m2 (ad_div_2 a)). Rewrite (MapGet_M2_bit_0_if m2 m3 a). - Rewrite (MapGet_M2_bit_0_if m0 m1 a). Case (ad_bit_0 a); Trivial. - Reflexivity. - Qed. - - (** [MapInter], [MapRngRestrTo], [MapRngRestrBy], [MapInverse] - not implemented: need a decidable equality on [A]. *) - - Fixpoint MapDelta [m:Map] : Map -> Map := - Cases m of - M0 => [m':Map] m' - | (M1 a y) => [m':Map] Cases (MapGet m' a) of - NONE => (MapPut m' a y) - | _ => (MapRemove m' a) - end - | (M2 m1 m2) => [m':Map] Cases m' of - M0 => m - | (M1 a' y') => Cases (MapGet m a') of - 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 : (m,m':Map) - (eqm (MapGet (MapDelta m m')) (MapGet (MapDelta m' m))). - Proof. - Unfold eqm. Induction m. Induction m'; Reflexivity. - Induction m'. Reflexivity. - Unfold MapDelta. Intros. Elim (sumbool_of_bool (ad_eq a a1)). Intro H. - Rewrite <- (ad_eq_complete ? ? H). Rewrite (M1_semantics_1 a a2). - Rewrite (M1_semantics_1 a a0). Simpl. Rewrite (ad_eq_correct a). Reflexivity. - Intro H. Rewrite (M1_semantics_2 a a1 a0 H). Rewrite (ad_eq_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 (ad_eq a a3)). - Intro H0. Rewrite H0. Rewrite (ad_eq_complete ? ? H0) in H. Rewrite H. - Rewrite (ad_eq_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 (ad_eq a1 a3)). Intro H1. Rewrite H1. - Rewrite (ad_eq_complete ? ? H1). Exact (M1_semantics_1 a3 a2). - Intro H1. Rewrite H1. Exact (M1_semantics_2 a1 a3 a2 H1). - Intros. Reflexivity. - Induction m'. Reflexivity. - Reflexivity. - Intros. Simpl. 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 (ad_div_2 a)). Rewrite (H m2 (ad_div_2 a)). Reflexivity. - Qed. - - Lemma MapDelta_semantics_1_1 : (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. Elim (sumbool_of_bool (ad_eq a a0)). Intro H1. - Rewrite (ad_eq_complete ? ? H1) in H. Rewrite (M1_semantics_1 a0 y) in H. Discriminate H. - Intro H1. Case (MapGet m' a). Rewrite (MapPut_semantics m' a y a0). Rewrite H1. Assumption. - Rewrite (MapRemove_semantics m' a a0). Rewrite H1. Trivial. - Qed. - - Lemma MapDelta_semantics_1 : (m,m':Map) (a:ad) - (MapGet m a)=NONE -> (MapGet m' a)=NONE -> - (MapGet (MapDelta m m') a)=NONE. - Proof. - Induction m. Trivial. - Exact MapDelta_semantics_1_1. - Induction m'. Trivial. - Intros. Rewrite (MapDelta_semantics_comm (M2 m0 m1) (M1 a a0) a1). - Apply MapDelta_semantics_1_1; Trivial. - Intros. Simpl. Rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a). - Rewrite MapGet_M2_bit_0_if. Elim (sumbool_of_bool (ad_bit_0 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 : (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. Elim (sumbool_of_bool (ad_eq a a0)). Intro H1. - Rewrite (ad_eq_complete ? ? H1) in H. Rewrite (M1_semantics_1 a0 y) in H. Discriminate H. - Intro H1. Case (MapGet m' a). Rewrite (MapPut_semantics m' a y a0). Rewrite H1. Assumption. - Rewrite (MapRemove_semantics m' a a0). Rewrite H1. Trivial. - Qed. - - Lemma MapDelta_semantics_2_2 : (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. Elim (sumbool_of_bool (ad_eq a a0)). Intro H1. - Rewrite (ad_eq_complete ? ? H1) in H. Rewrite (ad_eq_complete ? ? H1). - Rewrite H0. Rewrite (MapPut_semantics m' a0 y a0). Rewrite (ad_eq_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 : (m,m':Map) (a:ad) (y:A) - (MapGet m a)=NONE -> (MapGet m' a)=(SOME y) -> - (MapGet (MapDelta m m') a)=(SOME y). - Proof. - Induction m. Trivial. - Exact MapDelta_semantics_2_1. - 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. Rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a). - Rewrite MapGet_M2_bit_0_if. Elim (sumbool_of_bool (ad_bit_0 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 : (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. Elim (sumbool_of_bool (ad_eq a0 a)). Intro H1. - Rewrite (ad_eq_complete a0 a H1). Rewrite H0. Rewrite (MapRemove_semantics m' a a). - Rewrite (ad_eq_correct a). Reflexivity. - Intro H1. Rewrite (M1_semantics_2 a0 a y0 H1) in H. Discriminate H. - Qed. - - Lemma MapDelta_semantics_3 : (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. - Induction m. Intros. Discriminate H. - Exact MapDelta_semantics_3_1. - 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. Rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a). - Rewrite MapGet_M2_bit_0_if. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H5. Rewrite H5. - Apply (H0 m3 (ad_div_2 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 (ad_div_2 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 : (m,m':Map) - (eqm (MapGet (MapDelta m m')) - [a0:ad] Cases (MapGet m a0) (MapGet m' a0) of - NONE (SOME y') => (SOME y') - | (SOME y) NONE => (SOME y) - | _ _ => NONE - end). - Proof. - Unfold eqm. 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] - Cases m of - M0 => true - | _ => false - end. - - Lemma MapEmptyp_correct : (MapEmptyp M0)=true. - Proof. - Reflexivity. - Qed. - - Lemma MapEmptyp_complete : (m:Map) (MapEmptyp m)=true -> m=M0. - Proof. - 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. diff --git a/theories7/IntMap/Mapaxioms.v b/theories7/IntMap/Mapaxioms.v deleted file mode 100644 index 085afd69..00000000 --- a/theories7/IntMap/Mapaxioms.v +++ /dev/null @@ -1,670 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* (option A)) (eqm A f f') -> (eqm A f' f). - Proof. - Unfold eqm. Intros. Rewrite H. Reflexivity. - Qed. - - Lemma eqm_refl : (f:ad->(option A)) (eqm A f f). - Proof. - Unfold eqm. Trivial. - Qed. - - Lemma eqm_trans : (f,f',f'':ad->(option A)) (eqm A f f') -> (eqm A f' f'') -> (eqm A f f''). - Proof. - Unfold eqm. Intros. Rewrite H. Exact (H0 a). - Qed. - - Definition eqmap := [m,m':(Map A)] (eqm A (MapGet A m) (MapGet A m')). - - Lemma eqmap_sym : (m,m':(Map A)) (eqmap m m') -> (eqmap m' m). - Proof. - Intros. Unfold eqmap. Apply eqm_sym. Assumption. - Qed. - - Lemma eqmap_refl : (m:(Map A)) (eqmap m m). - Proof. - Intros. Unfold eqmap. Apply eqm_refl. - Qed. - - Lemma eqmap_trans : (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 : (m:(Map A)) (a:ad) (y:A) - (eqmap (MapPut A m a y) (MapMerge A m (M1 A a y))). - Proof. - Unfold eqmap eqm. Intros. Rewrite (MapPut_semantics A m a y a0). - Rewrite (MapMerge_semantics A m (M1 A a y) a0). Unfold 2 MapGet. - Elim (sumbool_of_bool (ad_eq a a0)); Intro H; Rewrite H; Reflexivity. - Qed. - - Lemma MapPut_ext : (m,m':(Map A)) (eqmap m m') -> - (a:ad) (y:A) (eqmap (MapPut A m a y) (MapPut A m' a y)). - Proof. - Unfold eqmap eqm. Intros. Rewrite (MapPut_semantics A m' a y a0). - Rewrite (MapPut_semantics A m a y a0). - Case (ad_eq a a0); [ Reflexivity | Apply H ]. - Qed. - - Lemma MapPut_behind_as_Merge : (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. 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 : (m,m':(Map A)) (eqmap m m') -> - (a:ad) (y:A) (eqmap (MapPut_behind A m a y) (MapPut_behind A m' a y)). - Proof. - Unfold eqmap eqm. 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 : (m:(Map A)) (MapMerge A (M0 A) m)=m. - Proof. - Trivial. - Qed. - - Lemma MapMerge_empty_m : (m:(Map A)) (eqmap (MapMerge A (M0 A) m) m). - Proof. - Unfold eqmap eqm. Trivial. - Qed. - - Lemma MapMerge_m_empty_1 : (m:(Map A)) (MapMerge A m (M0 A))=m. - Proof. - Induction m;Trivial. - Qed. - - Lemma MapMerge_m_empty : (m:(Map A)) (eqmap (MapMerge A m (M0 A)) m). - Proof. - Unfold eqmap eqm. Intros. Rewrite MapMerge_m_empty_1. Reflexivity. - Qed. - - Lemma MapMerge_empty_l : (m,m':(Map A)) (eqmap (MapMerge A m m') (M0 A)) -> - (eqmap m (M0 A)). - Proof. - Unfold eqmap eqm. 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 : (m,m':(Map A)) (eqmap (MapMerge A m m') (M0 A)) -> - (eqmap m' (M0 A)). - Proof. - Unfold eqmap eqm. 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_assoc : (m,m',m'':(Map A)) (eqmap - (MapMerge A (MapMerge A m m') m'') - (MapMerge A m (MapMerge A m' m''))). - Proof. - Unfold eqmap eqm. 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 : (m:(Map A)) (eqmap (MapMerge A m m) m). - Proof. - Unfold eqmap eqm. Intros. Rewrite (MapMerge_semantics A m m a). - Case (MapGet A m a); Trivial. - Qed. - - Lemma MapMerge_ext : (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. 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 : (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 : (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 : (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. 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 : (m:(Map A)) (a:ad) (y:B) - (eqmap (MapRemove A m a) (MapDomRestrBy A B m (M1 B a y))). - Proof. - Unfold eqmap eqm. Intros. Rewrite (MapRemove_semantics A m a a0). - Rewrite (MapDomRestrBy_semantics A B m (M1 B a y) a0). Elim (sumbool_of_bool (ad_eq a a0)). - Intro H. Rewrite H. Rewrite (ad_eq_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 : (m,m':(Map A)) (eqmap m m') -> - (a:ad) (eqmap (MapRemove A m a) (MapRemove A m' a)). - Proof. - Unfold eqmap eqm. Intros. Rewrite (MapRemove_semantics A m' a a0). - Rewrite (MapRemove_semantics A m a a0). - Case (ad_eq a a0); [ Reflexivity | Apply H ]. - Qed. - - Lemma MapDomRestrTo_empty_m_1 : - (m:(Map B)) (MapDomRestrTo A B (M0 A) m)=(M0 A). - Proof. - Trivial. - Qed. - - Lemma MapDomRestrTo_empty_m : - (m:(Map B)) (eqmap (MapDomRestrTo A B (M0 A) m) (M0 A)). - Proof. - Unfold eqmap eqm. Trivial. - Qed. - - Lemma MapDomRestrTo_m_empty_1 : - (m:(Map A)) (MapDomRestrTo A B m (M0 B))=(M0 A). - Proof. - Induction m;Trivial. - Qed. - - Lemma MapDomRestrTo_m_empty : - (m:(Map A)) (eqmap (MapDomRestrTo A B m (M0 B)) (M0 A)). - Proof. - Unfold eqmap eqm. Intros. Rewrite (MapDomRestrTo_m_empty_1 m). Reflexivity. - Qed. - - Lemma MapDomRestrTo_assoc : (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. 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 : (m:(Map A)) (eqmap (MapDomRestrTo A A m m) m). - Proof. - Unfold eqmap eqm. Intros. Rewrite (MapDomRestrTo_semantics A A m m a). - Case (MapGet A m a); Trivial. - Qed. - - Lemma MapDomRestrTo_Dom : (m:(Map A)) (m':(Map B)) - (eqmap (MapDomRestrTo A B m m') (MapDomRestrTo A unit m (MapDom B m'))). - Proof. - Unfold eqmap eqm. 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 : - (m:(Map B)) (MapDomRestrBy A B (M0 A) m)=(M0 A). - Proof. - Trivial. - Qed. - - Lemma MapDomRestrBy_empty_m : - (m:(Map B)) (eqmap (MapDomRestrBy A B (M0 A) m) (M0 A)). - Proof. - Unfold eqmap eqm. Trivial. - Qed. - - Lemma MapDomRestrBy_m_empty_1 : (m:(Map A)) (MapDomRestrBy A B m (M0 B))=m. - Proof. - Induction m;Trivial. - Qed. - - Lemma MapDomRestrBy_m_empty : (m:(Map A)) (eqmap (MapDomRestrBy A B m (M0 B)) m). - Proof. - Unfold eqmap eqm. Intros. Rewrite (MapDomRestrBy_m_empty_1 m). Reflexivity. - Qed. - - Lemma MapDomRestrBy_Dom : (m:(Map A)) (m':(Map B)) - (eqmap (MapDomRestrBy A B m m') (MapDomRestrBy A unit m (MapDom B m'))). - Proof. - Unfold eqmap eqm. 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 : (m:(Map A)) (eqmap (MapDomRestrBy A A m m) (M0 A)). - Proof. - Unfold eqmap eqm. Intros. Rewrite (MapDomRestrBy_semantics A A m m a). - Case (MapGet A m a); Trivial. - Qed. - - Lemma MapDomRestrBy_By : (m:(Map A)) (m':(Map B)) (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. 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 : (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. 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 : (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. 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 : (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. 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 : (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. 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 : (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. 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 : (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. 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 : (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. 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 : (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. 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 : (m:(Map A)) (MapDelta A (M0 A) m)=m. - Proof. - Trivial. - Qed. - - Lemma MapDelta_empty_m : (m:(Map A)) (eqmap (MapDelta A (M0 A) m) m). - Proof. - Unfold eqmap eqm. Trivial. - Qed. - - Lemma MapDelta_m_empty_1 : (m:(Map A)) (MapDelta A m (M0 A))=m. - Proof. - Induction m;Trivial. - Qed. - - Lemma MapDelta_m_empty : (m:(Map A)) (eqmap (MapDelta A m (M0 A)) m). - Proof. - Unfold eqmap eqm. Intros. Rewrite MapDelta_m_empty_1. Reflexivity. - Qed. - - Lemma MapDelta_nilpotent : (m:(Map A)) (eqmap (MapDelta A m m) (M0 A)). - Proof. - Unfold eqmap eqm. Intros. Rewrite (MapDelta_semantics A m m a). - Case (MapGet A m a); Trivial. - Qed. - - Lemma MapDelta_as_Merge : (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. 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 : (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. 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 : (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. 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 : (m,m':(Map A)) (eqmap (MapDelta A m m') (MapDelta A m' m)). - Proof. - Unfold eqmap eqm. 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 : (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. 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 : (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 : (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 : (m:(Map A)) (m':(Map B)) - (eqmap m (MapMerge A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m'))). - Proof. - Unfold eqmap eqm. 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 : (m:(Map A)) (m':(Map B)) - (eqmap m (MapMerge A (MapDomRestrBy A B m m') (MapDomRestrTo A B m m'))). - Proof. - Unfold eqmap eqm. 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 : (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. 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 : (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. 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 : (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 : (A,B:Set) (m1:(Map A)) (m2:(Map B)) (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 : (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. 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 : (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 : (A,B:Set) (m1:(Map A)) (m2:(Map B)) (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 : (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 : (s,s',s'':FSet) - (eqmap unit (MapDelta ? (MapDelta ? s s') s'') (MapDelta ? s (MapDelta ? s' s''))). -Proof. - Unfold eqmap eqm. 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 : (s,s':FSet) ((a:ad) (in_FSet a s)=(in_FSet a s')) -> (eqmap unit s s'). -Proof. - Unfold in_FSet eqmap eqm. 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 : (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_sym. -Qed. - -Lemma FSetUnion_assoc : (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 : (s:FSet) (eqmap unit (FSetUnion (M0 unit) s) s). -Proof. - Exact (MapMerge_empty_m unit). -Qed. - -Lemma FSetUnion_s_M0 : (s:FSet) (eqmap unit (FSetUnion s (M0 unit)) s). -Proof. - Exact (MapMerge_m_empty unit). -Qed. - -Lemma FSetUnion_idempotent : (s:FSet) (eqmap unit (FSetUnion s s) s). -Proof. - Exact (MapMerge_idempotent unit). -Qed. - -Lemma FSetInter_comm : (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_sym. -Qed. - -Lemma FSetInter_assoc : (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 : (s:FSet) (eqmap unit (FSetInter (M0 unit) s) (M0 unit)). -Proof. - Exact (MapDomRestrTo_empty_m unit unit). -Qed. - -Lemma FSetInter_s_M0 : (s:FSet) (eqmap unit (FSetInter s (M0 unit)) (M0 unit)). -Proof. - Exact (MapDomRestrTo_m_empty unit unit). -Qed. - -Lemma FSetInter_idempotent : (s:FSet) (eqmap unit (FSetInter s s) s). -Proof. - Exact (MapDomRestrTo_idempotent unit). -Qed. - -Lemma FSetUnion_Inter_l : (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 : (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 : (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 : (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. diff --git a/theories7/IntMap/Mapc.v b/theories7/IntMap/Mapc.v deleted file mode 100644 index 181050b1..00000000 --- a/theories7/IntMap/Mapc.v +++ /dev/null @@ -1,457 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* - (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 : (m:(Map A)) (mapcanon A m) -> - (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 : (m:(Map A)) (MapMerge A (M0 A) m)=m. - Proof. - Trivial. - Qed. - - Lemma MapMerge_assoc_c : (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 : (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 : (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 : (m:(Map A)) (mapcanon A m) -> - (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 : (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 : (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 : (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 : (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 : (m:(Map A)) (m':(Map B)) (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 : (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 : (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 : (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 : (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 : (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 : (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 : (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 : (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 : (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 : (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 : (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 : (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 : (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 : (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 : (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 : (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 : (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 : (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 : (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 : (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 : (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 : (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 : (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 : (s,s':FSet) (mapcanon unit s) -> (mapcanon unit s') -> - ((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 : (s,s':FSet) (mapcanon unit s) -> (mapcanon unit s') -> - (FSetUnion s s')=(FSetUnion s' s). -Proof. - Intros. - Apply (mapcanon_unique unit); Try (Unfold FSetUnion; Apply MapMerge_canon; Assumption). - Apply FSetUnion_comm. -Qed. - -Lemma FSetUnion_assoc_c : (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 : (s:FSet) (FSetUnion (M0 unit) s)=s. -Proof. - Exact (MapMerge_empty_m_c unit). -Qed. - -Lemma FSetUnion_s_M0_c : (s:FSet) (FSetUnion s (M0 unit))=s. -Proof. - Exact (MapMerge_m_empty_1 unit). -Qed. - -Lemma FSetUnion_idempotent : (s:FSet) (mapcanon unit s) -> (FSetUnion s s)=s. -Proof. - Exact (MapMerge_idempotent_c unit). -Qed. - -Lemma FSetInter_comm_c : (s,s':FSet) (mapcanon unit s) -> (mapcanon unit s') -> - (FSetInter s s')=(FSetInter s' s). -Proof. - Intros. - Apply (mapcanon_unique unit); Try (Unfold FSetInter; Apply MapDomRestrTo_canon; Assumption). - Apply FSetInter_comm. -Qed. - -Lemma FSetInter_assoc_c : (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 : (s:FSet) (FSetInter (M0 unit) s)=(M0 unit). -Proof. - Trivial. -Qed. - -Lemma FSetInter_s_M0_c : (s:FSet) (FSetInter s (M0 unit))=(M0 unit). -Proof. - Exact (MapDomRestrTo_m_empty_1 unit unit). -Qed. - -Lemma FSetInter_idempotent : (s:FSet) (mapcanon unit s) -> (FSetInter s s)=s. -Proof. - Exact (MapDomRestrTo_idempotent_c unit). -Qed. - -Lemma FSetUnion_Inter_l_c : (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. (Apply MapMerge_canon; Try Assumption). - Unfold FSetInter. (Apply MapDomRestrTo_canon; Assumption). - Unfold FSetInter; Unfold FSetUnion; Apply MapDomRestrTo_canon; Apply MapMerge_canon; Assumption. - Apply FSetUnion_Inter_l. -Qed. - -Lemma FSetUnion_Inter_r : (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. (Apply MapMerge_canon; Try Assumption). - Unfold FSetInter. (Apply MapDomRestrTo_canon; Assumption). - Unfold FSetInter; Unfold FSetUnion; Apply MapDomRestrTo_canon; Apply MapMerge_canon; Assumption. - Apply FSetUnion_Inter_r. -Qed. - -Lemma FSetInter_Union_l_c : (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. - Apply MapDomRestrTo_canon; Try Assumption. Unfold FSetUnion. - Apply MapMerge_canon; Assumption. - Unfold FSetUnion; Unfold FSetInter; Apply MapMerge_canon; Apply MapDomRestrTo_canon; - Assumption. - Apply FSetInter_Union_l. -Qed. - -Lemma FSetInter_Union_r : (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. - Apply MapDomRestrTo_canon; Try Assumption. - Unfold FSetUnion. Apply MapMerge_canon; Unfold FSetInter; Apply MapDomRestrTo_canon; Assumption. - Apply FSetInter_Union_r. -Qed. diff --git a/theories7/IntMap/Mapcanon.v b/theories7/IntMap/Mapcanon.v deleted file mode 100644 index 7beb1fd4..00000000 --- a/theories7/IntMap/Mapcanon.v +++ /dev/null @@ -1,376 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* Prop := - M0_canon : (mapcanon (M0 A)) - | M1_canon : (a:ad) (y:A) (mapcanon (M1 A a y)) - | M2_canon : (m1,m2:(Map A)) (mapcanon m1) -> (mapcanon m2) -> - (le (2) (MapCard A (M2 A m1 m2))) -> (mapcanon (M2 A m1 m2)). - - Lemma mapcanon_M2 : - (m1,m2:(Map A)) (mapcanon (M2 A m1 m2)) -> (le (2) (MapCard A (M2 A m1 m2))). - Proof. - Intros. Inversion H. Assumption. - Qed. - - Lemma mapcanon_M2_1 : (m1,m2:(Map A)) (mapcanon (M2 A m1 m2)) -> (mapcanon m1). - Proof. - Intros. Inversion H. Assumption. - Qed. - - Lemma mapcanon_M2_2 : (m1,m2:(Map A)) (mapcanon (M2 A m1 m2)) -> (mapcanon m2). - Proof. - Intros. Inversion H. Assumption. - Qed. - - Lemma M2_eqmap_1 : (m0,m1,m2,m3:(Map A)) - (eqmap A (M2 A m0 m1) (M2 A m2 m3)) -> (eqmap A m0 m2). - Proof. - Unfold eqmap eqm. Intros. Rewrite <- (ad_double_div_2 a). - Rewrite <- (MapGet_M2_bit_0_0 A ? (ad_double_bit_0 a) m0 m1). - Rewrite <- (MapGet_M2_bit_0_0 A ? (ad_double_bit_0 a) m2 m3). - Exact (H (ad_double a)). - Qed. - - Lemma M2_eqmap_2 : (m0,m1,m2,m3:(Map A)) - (eqmap A (M2 A m0 m1) (M2 A m2 m3)) -> (eqmap A m1 m3). - Proof. - Unfold eqmap eqm. Intros. Rewrite <- (ad_double_plus_un_div_2 a). - Rewrite <- (MapGet_M2_bit_0_1 A ? (ad_double_plus_un_bit_0 a) m0 m1). - Rewrite <- (MapGet_M2_bit_0_1 A ? (ad_double_plus_un_bit_0 a) m2 m3). - Exact (H (ad_double_plus_un a)). - Qed. - - Lemma mapcanon_unique : (m,m':(Map A)) (mapcanon m) -> (mapcanon m') -> - (eqmap A m m') -> m=m'. - Proof. - Induction m. Induction m'. Trivial. - Intros a y H H0 H1. Cut (NONE A)=(MapGet A (M1 A a y) a). Simpl. Rewrite (ad_eq_correct a). - Intro. Discriminate H2. - Exact (H1 a). - Intros. Cut (le (2) (MapCard A (M0 A))). Intro. Elim (le_Sn_O ? H4). - Rewrite (MapCard_ext A ? ? H3). Exact (mapcanon_M2 ? ? H2). - Intros a y. Induction m'. Intros. Cut (MapGet A (M1 A a y) a)=(NONE A). Simpl. - Rewrite (ad_eq_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. - Rewrite (ad_eq_correct a). Intro. Elim (sumbool_of_bool (ad_eq a0 a)). Intro H3. - Rewrite H3 in H2. Inversion H2. Rewrite (ad_eq_complete ? ? H3). Reflexivity. - Intro H3. Rewrite H3 in H2. Discriminate H2. - Exact (H1 a). - Intros. Cut (le (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). - Induction m'. Intros. Cut (le (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 (le (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 : - (p:positive) (a,a':ad) (y,y':A) (mapcanon (MapPut1 A a y a' y' p)). - Proof. - Induction p. Simpl. Intros. Case (ad_bit_0 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. Intros. Case (ad_bit_0 a). Apply M2_canon. Apply M0_canon. - Apply H. - Simpl. Rewrite MapCard_Put1_equals_2. Apply le_n. - Apply M2_canon. Apply H. - Apply M0_canon. - Simpl. Rewrite MapCard_Put1_equals_2. Apply le_n. - Simpl. Simpl. Intros. Case (ad_bit_0 a). Apply M2_canon. Apply M1_canon. - Apply M1_canon. - Simpl. Apply le_n. - Apply M2_canon. Apply M1_canon. - Apply M1_canon. - Simpl. Apply le_n. - Qed. - - Lemma MapPut_canon : - (m:(Map A)) (mapcanon m) -> (a:ad) (y:A) (mapcanon (MapPut A m a y)). - Proof. - Induction m. Intros. Simpl. Apply M1_canon. - Intros a0 y0 H a y. Simpl. Case (ad_xor a0 a). Apply M1_canon. - Intro. Apply MapPut1_canon. - Intros. Simpl. Elim a. Apply M2_canon. Apply H. Exact (mapcanon_M2_1 m0 m1 H1). - Exact (mapcanon_M2_2 m0 m1 H1). - Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)). Exact (mapcanon_M2 ? ? H1). - Apply le_plus_plus. Exact (MapCard_Put_lb A m0 ad_z 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. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)). - Exact (mapcanon_M2 m0 m1 H1). - Apply le_reg_l. Exact (MapCard_Put_lb A m1 (ad_x p0) y). - Intro. Apply M2_canon. Apply H. Exact (mapcanon_M2_1 m0 m1 H1). - Exact (mapcanon_M2_2 m0 m1 H1). - Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)). - Exact (mapcanon_M2 m0 m1 H1). - Apply le_reg_r. Exact (MapCard_Put_lb A m0 (ad_x p0) y). - Apply M2_canon. Apply (mapcanon_M2_1 m0 m1 H1). - Apply H0. Apply (mapcanon_M2_2 m0 m1 H1). - Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)). - Exact (mapcanon_M2 m0 m1 H1). - Apply le_reg_l. Exact (MapCard_Put_lb A m1 ad_z y). - Qed. - - Lemma MapPut_behind_canon : (m:(Map A)) (mapcanon m) -> - (a:ad) (y:A) (mapcanon (MapPut_behind A m a y)). - Proof. - Induction m. Intros. Simpl. Apply M1_canon. - Intros a0 y0 H a y. Simpl. Case (ad_xor a0 a). Apply M1_canon. - Intro. Apply MapPut1_canon. - Intros. Simpl. Elim a. Apply M2_canon. Apply H. Exact (mapcanon_M2_1 m0 m1 H1). - Exact (mapcanon_M2_2 m0 m1 H1). - Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)). Exact (mapcanon_M2 ? ? H1). - Apply le_plus_plus. Rewrite MapCard_Put_behind_Put. Exact (MapCard_Put_lb A m0 ad_z 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. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)). - Exact (mapcanon_M2 m0 m1 H1). - Apply le_reg_l. Rewrite MapCard_Put_behind_Put. Exact (MapCard_Put_lb A m1 (ad_x p0) y). - Intro. Apply M2_canon. Apply H. Exact (mapcanon_M2_1 m0 m1 H1). - Exact (mapcanon_M2_2 m0 m1 H1). - Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)). - Exact (mapcanon_M2 m0 m1 H1). - Apply le_reg_r. Rewrite MapCard_Put_behind_Put. Exact (MapCard_Put_lb A m0 (ad_x p0) y). - Apply M2_canon. Apply (mapcanon_M2_1 m0 m1 H1). - Apply H0. Apply (mapcanon_M2_2 m0 m1 H1). - Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)). - Exact (mapcanon_M2 m0 m1 H1). - Apply le_reg_l. Rewrite MapCard_Put_behind_Put. Exact (MapCard_Put_lb A m1 ad_z y). - Qed. - - Lemma makeM2_canon : - (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 (ad_double_plus_un a) y). - Intros. Simpl. (Apply M2_canon; Try Assumption). Exact (mapcanon_M2 m0 m1 H0). - Intros a y m'. Case m'. Intros. Exact (M1_canon (ad_double a) y). - Intros a0 y0 H H0. Simpl. (Apply M2_canon; Try Assumption). Apply le_n. - Intros. Simpl. (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. 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) := - Cases m of - (M2 m0 m1) => (makeM2 A (MapCanonicalize m0) (MapCanonicalize m1)) - | _ => m - end. - - Lemma mapcanon_exists_1 : (m:(Map A)) (eqmap A m (MapCanonicalize m)). - Proof. - Induction m. Apply eqmap_refl. - Intros. Apply eqmap_refl. - Intros. Simpl. Unfold eqmap eqm. Intro. - Rewrite (makeM2_M2 A (MapCanonicalize m0) (MapCanonicalize m1) a). - Rewrite MapGet_M2_bit_0_if. Rewrite MapGet_M2_bit_0_if. - Rewrite <- (H (ad_div_2 a)). Rewrite <- (H0 (ad_div_2 a)). Reflexivity. - Qed. - - Lemma mapcanon_exists_2 : (m:(Map A)) (mapcanon (MapCanonicalize m)). - Proof. - Induction m. Apply M0_canon. - Intros. Simpl. Apply M1_canon. - Intros. Simpl. (Apply makeM2_canon; Assumption). - Qed. - - Lemma mapcanon_exists : - (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 : - (m:(Map A)) (mapcanon m) -> (a:ad) (mapcanon (MapRemove A m a)). - Proof. - Induction m. Intros. Exact M0_canon. - Intros a y H a0. Simpl. Case (ad_eq a a0). Exact M0_canon. - Assumption. - Intros. Simpl. Case (ad_bit_0 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 : (m,m':(Map A)) (mapcanon m) -> (mapcanon m') -> - (mapcanon (MapMerge A m m')). - Proof. - Induction m. Intros. Exact H0. - Simpl. Intros a y m' H H0. Exact (MapPut_behind_canon m' H0 a y). - Induction m'. Intros. Exact H1. - Intros a y H1 H2. Unfold MapMerge. Exact (MapPut_canon ? H1 a y). - Intros. Simpl. 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 (le (2) (MapCard A (MapMerge A (M2 A m0 m1) (M2 A m2 m3)))). - 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 : (m,m':(Map A)) (mapcanon m) -> (mapcanon m') -> - (mapcanon (MapDelta A m m')). - Proof. - Induction m. Intros. Exact H0. - Simpl. Intros a y m' H H0. Case (MapGet A m' a). Exact (MapPut_canon m' H0 a y). - Intro. Exact (MapRemove_canon m' H0 a). - Induction m'. Intros. Exact H1. - Unfold MapDelta. Intros a y H1 H2. Case (MapGet A (M2 A m0 m1) a). - Exact (MapPut_canon ? H1 a y). - Intro. Exact (MapRemove_canon ? H1 a). - Intros. Simpl. 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 : (m:(Map A)) (mapcanon m) -> - (m':(Map B)) (mapcanon (MapDomRestrTo A B m m')). - Proof. - Induction m. Intros. Exact M0_canon. - Simpl. Intros a y H m'. Case (MapGet B m' a). Exact M0_canon. - Intro. Apply M1_canon. - Induction m'. Exact M0_canon. - Unfold MapDomRestrTo. Intros a y. Case (MapGet A (M2 A m0 m1) a). Exact M0_canon. - Intro. Apply M1_canon. - Intros. Simpl. 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 : (m:(Map A)) (mapcanon m) -> - (m':(Map B)) (mapcanon (MapDomRestrBy A B m m')). - Proof. - Induction m. Intros. Exact M0_canon. - Simpl. Intros a y H m'. Case (MapGet B m' a). Assumption. - Intro. Exact M0_canon. - Induction m'. Exact H1. - Intros a y. Simpl. Case (ad_bit_0 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. Apply makeM2_canon. Apply H. Exact (mapcanon_M2_1 ? ? H1). - Apply H0. Exact (mapcanon_M2_2 ? ? H1). - Qed. - - Lemma Map_of_alist_canon : (l:(alist A)) (mapcanon (Map_of_alist A l)). - Proof. - Induction l. Exact M0_canon. - Intro r. Elim r. Intros a y l0 H. Simpl. Apply MapPut_canon. Assumption. - Qed. - - Lemma MapSubset_c_1 : (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 : (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. Rewrite H. Apply eqmap_refl. - Qed. - -End MapCanon. - -Section FSetCanon. - - Variable A : Set. - - Lemma MapDom_canon : (m:(Map A)) (mapcanon A m) -> (mapcanon unit (MapDom A m)). - Proof. - Induction m. Intro. Exact (M0_canon unit). - Intros a y H. Exact (M1_canon unit a ?). - Intros. Simpl. Apply M2_canon. Apply H. Exact (mapcanon_M2_1 A ? ? H1). - Apply H0. Exact (mapcanon_M2_2 A ? ? H1). - Change (le (2) (MapCard unit (MapDom A (M2 A m0 m1)))). Rewrite <- MapCard_Dom. - Exact (mapcanon_M2 A ? ? H1). - Qed. - -End FSetCanon. - -Section MapFoldCanon. - - Variable A, B : Set. - - Lemma MapFold_canon_1 : (m0:(Map B)) (mapcanon B m0) -> - (op : (Map B) -> (Map B) -> (Map B)) - ((m1:(Map B)) (mapcanon B m1) -> (m2:(Map B)) (mapcanon B m2) -> - (mapcanon B (op m1 m2))) -> - (f : ad->A->(Map B)) ((a:ad) (y:A) (mapcanon B (f a y))) -> - (m:(Map A)) (pf : ad->ad) (mapcanon B (MapFold1 A (Map B) m0 op f pf m)). - Proof. - Induction m. Intro. Exact H. - Intros a y pf. Simpl. Apply H1. - Intros. Simpl. Apply H0. Apply H2. - Apply H3. - Qed. - - Lemma MapFold_canon : (m0:(Map B)) (mapcanon B m0) -> - (op : (Map B) -> (Map B) -> (Map B)) - ((m1:(Map B)) (mapcanon B m1) -> (m2:(Map B)) (mapcanon B m2) -> - (mapcanon B (op m1 m2))) -> - (f : ad->A->(Map B)) ((a:ad) (y:A) (mapcanon B (f a y))) -> - (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 [a:ad]a). - Qed. - - Lemma MapCollect_canon : - (f : ad->A->(Map B)) ((a:ad) (y:A) (mapcanon B (f a y))) -> - (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. diff --git a/theories7/IntMap/Mapcard.v b/theories7/IntMap/Mapcard.v deleted file mode 100644 index 5c5e2a93..00000000 --- a/theories7/IntMap/Mapcard.v +++ /dev/null @@ -1,670 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* - (a:ad) (MapGet A m a)=(NONE A). - Proof. - 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 (ad_bit_0 a). Apply H0. Assumption. - Apply H. Assumption. - Qed. - - Lemma MapCard_is_not_O : (m:(Map A)) (a:ad) (y:A) (MapGet A m a)=(SOME A y) -> - {n:nat | (MapCard A m)=(S n)}. - Proof. - Induction m. Intros. Discriminate H. - Intros a y a0 y0 H. Simpl in H. Elim (sumbool_of_bool (ad_eq a a0)). Intro H0. Split with O. - Reflexivity. - Intro H0. Rewrite H0 in H. Discriminate H. - Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H2. - Rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1) in H1. Elim (H0 (ad_div_2 a) y H1). Intros n H3. - Simpl. Rewrite H3. Split with (plus (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 (ad_div_2 a) y H1). - Intros n H3. Simpl. Rewrite H3. Split with (plus n (MapCard A m1)). Reflexivity. - Qed. - - Lemma MapCard_is_one : (m:(Map A)) (MapCard A m)=(1) -> - {a:ad & {y:A | (MapGet A m a)=(SOME A y)}}. - Proof. - 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 (ad_double_plus_un a). - Rewrite (MapGet_M2_bit_0_1 A ? (ad_double_plus_un_bit_0 a) m0 m1). - Rewrite ad_double_plus_un_div_2. Exact H5. - Intro H2. Elim H2. Intros. Elim (H H3). Intros a H5. Split with (ad_double a). - Rewrite (MapGet_M2_bit_0_0 A ? (ad_double_bit_0 a) m0 m1). - Rewrite ad_double_div_2. Exact H5. - Qed. - - Lemma MapCard_is_one_unique : (m:(Map A)) (MapCard A m)=(1) -> (a,a':ad) (y,y':A) - (MapGet A m a)=(SOME A y) -> (MapGet A m a')=(SOME A y') -> - a=a' /\ y=y'. - Proof. - Induction m. Intro. Discriminate H. - Intros. Elim (sumbool_of_bool (ad_eq a a1)). Intro H2. Rewrite (ad_eq_complete ? ? H2) in H0. - Rewrite (M1_semantics_1 A a1 a0) in H0. Inversion H0. Elim (sumbool_of_bool (ad_eq a a')). - Intro H5. Rewrite (ad_eq_complete ? ? H5) in H1. Rewrite (M1_semantics_1 A a' a0) in H1. - Inversion H1. Rewrite <- (ad_eq_complete ? ? H2). Rewrite <- (ad_eq_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 (ad_bit_0 a)). - Intro H7. Rewrite H7 in H2. Rewrite (MapGet_M2_bit_0_if A m0 m1 a') in H3. - Elim (sumbool_of_bool (ad_bit_0 a')). Intro H8. Rewrite H8 in H3. Elim (H0 H6 ? ? ? ? H2 H3). - Intros. Split. Rewrite <- (ad_div_2_double_plus_un a H7). - Rewrite <- (ad_div_2_double_plus_un a' H8). Rewrite H9. Reflexivity. - Assumption. - Intro H8. Rewrite H8 in H3. Rewrite (MapCard_is_O m0 H5 (ad_div_2 a')) in H3. - Discriminate H3. - Intro H7. Rewrite H7 in H2. Rewrite (MapCard_is_O m0 H5 (ad_div_2 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 (ad_bit_0 a)). Intro H7. Rewrite H7 in H2. - Rewrite (MapCard_is_O m1 H6 (ad_div_2 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 (ad_bit_0 a')). Intro H8. Rewrite H8 in H3. - Rewrite (MapCard_is_O m1 H6 (ad_div_2 a')) in H3. Discriminate H3. - Intro H8. Rewrite H8 in H3. Elim (H H5 ? ? ? ? H2 H3). Intros. Split. - Rewrite <- (ad_div_2_double a H7). Rewrite <- (ad_div_2_double a' H8). - Rewrite H9. Reflexivity. - Assumption. - Qed. - - Lemma length_as_fold : (C:Set) (l:(list C)) - (length l)=(fold_right [_:C][n:nat](S n) O l). - Proof. - Induction l. Reflexivity. - Intros. Simpl. Rewrite H. Reflexivity. - Qed. - - Lemma length_as_fold_2 : (l:(alist A)) - (length l)=(fold_right [r:ad*A][n:nat]let (a,y)=r in (plus (1) n) O l). - Proof. - Induction l. Reflexivity. - Intros. Simpl. Rewrite H. (Elim a; Reflexivity). - Qed. - - Lemma MapCard_as_Fold_1 : (m:(Map A)) (pf:ad->ad) - (MapCard A m)=(MapFold1 A nat O plus [_:ad][_:A](1) pf m). - Proof. - Induction m. Trivial. - Trivial. - Intros. Simpl. Rewrite <- (H [a0:ad](pf (ad_double a0))). - Rewrite <- (H0 [a0:ad](pf (ad_double_plus_un a0))). Reflexivity. - Qed. - - Lemma MapCard_as_Fold : - (m:(Map A)) (MapCard A m)=(MapFold A nat O plus [_:ad][_:A](1) m). - Proof. - Intro. Exact (MapCard_as_Fold_1 m [a0:ad]a0). - Qed. - - Lemma MapCard_as_length : (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:=O f:=[_:ad][_:A](1). Exact plus_assoc_r. - Trivial. - Intro. Rewrite <- plus_n_O. Reflexivity. - Qed. - - Lemma MapCard_Put1_equals_2 : (p:positive) (a,a':ad) (y,y':A) - (MapCard A (MapPut1 A a y a' y' p))=(2). - Proof. - Induction p. Intros. Simpl. (Case (ad_bit_0 a); Reflexivity). - Intros. Simpl. Case (ad_bit_0 a). Exact (H (ad_div_2 a) (ad_div_2 a') y y'). - Simpl. Rewrite <- plus_n_O. Exact (H (ad_div_2 a) (ad_div_2 a') y y'). - Intros. Simpl. (Case (ad_bit_0 a); Reflexivity). - Qed. - - Lemma MapCard_Put_sum : (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. - Induction m. Simpl. 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 (ad_sum (ad_xor 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 (ad_bit_0 a)). Intro H4. Rewrite H4 in H1. - Elim (H0 (MapPut A m1 (ad_div_2 a) y) (ad_div_2 a) y (MapCard A m1) - (MapCard A (MapPut A m1 (ad_div_2 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 (ad_div_2 a) y) (ad_div_2 a) y (MapCard A m0) - (MapCard A (MapPut A m0 (ad_div_2 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 : (m:(Map A)) (a:ad) (y:A) - (ge (MapCard A (MapPut A m a y)) (MapCard A m)). - Proof. - Unfold ge. 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 : (m:(Map A)) (a:ad) (y:A) - (le (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 : (m:(Map A)) (a:ad) (y:A) - (MapCard A (MapPut A m a y))=(MapCard A m) -> - {y:A | (MapGet A m a)=(SOME A y)}. - Proof. - Induction m. Intros. Discriminate H. - Intros a y a0 y0 H. Simpl in H. Elim (ad_sum (ad_xor 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 (ad_xor_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 (ad_bit_0 a)). - Intro H2. Rewrite H2 in H1. Simpl in H1. Elim (H0 (ad_div_2 a) y (simpl_plus_l ? ? ? 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_sym (MapCard A (MapPut A m0 (ad_div_2 a) y)) (MapCard A m1)) in H1. - Rewrite (plus_sym (MapCard A m0) (MapCard A m1)) in H1. - Elim (H (ad_div_2 a) y (simpl_plus_l ? ? ? 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 : (m:(Map A)) (a:ad) (y:A) - (MapCard A (MapPut A m a y))=(S (MapCard A m)) -> (MapGet A m a)=(NONE A). - Proof. - Induction m. Trivial. - Intros. Simpl in H. Elim (sumbool_of_bool (ad_eq a a1)). Intro H0. - Rewrite (ad_eq_complete ? ? H0) in H. Rewrite (ad_xor_nilpotent a1) in H. Discriminate H. - Intro H0. Exact (M1_semantics_2 A a a1 a0 H0). - Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H2. - Rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1). Apply (H0 (ad_div_2 a) y). - Apply simpl_plus_l with n:=(MapCard A m0). - Rewrite <- (plus_Snm_nSm (MapCard A m0) (MapCard A m1)). Simpl in H1. Simpl. Rewrite <- H1. - Clear H1. - NewInduction a. Discriminate H2. - NewInduction p. Reflexivity. - Discriminate H2. - Reflexivity. - Intro H2. Rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1). Apply (H (ad_div_2 a) y). - Cut (plus (MapCard A (MapPut A m0 (ad_div_2 a) y)) (MapCard A m1)) - =(plus (S (MapCard A m0)) (MapCard A m1)). - Intro. Rewrite (plus_sym (MapCard A (MapPut A m0 (ad_div_2 a) y)) (MapCard A m1)) in H3. - Rewrite (plus_sym (S (MapCard A m0)) (MapCard A m1)) in H3. Exact (simpl_plus_l ? ? ? H3). - Simpl. Simpl in H1. Rewrite <- H1. NewInduction a. Trivial. - NewInduction p. Discriminate H2. - Reflexivity. - Discriminate H2. - Qed. - - Lemma MapCard_Put_1_conv : (m:(Map A)) (a:ad) (y,y':A) - (MapGet A m a)=(SOME A 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 : (m:(Map A)) (a:ad) (y:A) - (MapGet A m a)=(NONE 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 H0. Elim (MapCard_Put_1 m a y H0). Intros y' H1. Rewrite H1 in H. Discriminate H. - Trivial. - Qed. - - Lemma MapCard_ext : (m,m':(Map A)) - (eqm A (MapGet A m) (MapGet A m')) -> (MapCard A m)=(MapCard A m'). - Proof. - Unfold eqm. 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. 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 : (m:(Map A)) (MapCard A m)=(MapCard unit (MapDom A m)). - Proof. - (Induction m; Trivial). Intros. Simpl. Rewrite H. Rewrite H0. Reflexivity. - Qed. - - Lemma MapCard_Dom_Put_behind : (m:(Map A)) (a:ad) (y:A) - (MapDom A (MapPut_behind A m a y))=(MapDom A (MapPut A m a y)). - Proof. - Induction m. Trivial. - Intros a y a0 y0. Simpl. Elim (ad_sum (ad_xor a a0)). Intro H. Elim H. - Intros p H0. Rewrite H0. Reflexivity. - Intro H. Rewrite H. Rewrite (ad_xor_eq ? ? H). Reflexivity. - Intros. Simpl. Elim (ad_sum a). Intro H1. Elim H1. Intros p H2. Rewrite H2. Case p. - Intro p0. Simpl. Rewrite H0. Reflexivity. - Intro p0. Simpl. Rewrite H. Reflexivity. - Simpl. Rewrite H0. Reflexivity. - Intro H1. Rewrite H1. Simpl. Rewrite H. Reflexivity. - Qed. - - Lemma MapCard_Put_behind_Put : (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 : (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 : (m,m':(Map A)) - (MapCard A (makeM2 A m m'))=(plus (MapCard A m) (MapCard A m')). - Proof. - Intros. Rewrite (MapCard_ext ? ? (makeM2_M2 A m m')). Reflexivity. - Qed. - - Lemma MapCard_Remove_sum : (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. - Induction m. Simpl. Intros. Rewrite H in H1. Simpl in H1. Left . Rewrite H1. Assumption. - Simpl. Intros. Elim (sumbool_of_bool (ad_eq 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 (ad_bit_0 a)). Intro H4. - Rewrite H4 in H1. Rewrite H1 in H3. - Rewrite (MapCard_makeM2 m0 (MapRemove A m1 (ad_div_2 a))) in H3. - Elim (H0 (MapRemove A m1 (ad_div_2 a)) (ad_div_2 a) (MapCard A m1) - (MapCard A (MapRemove A m1 (ad_div_2 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 (ad_div_2 a)))) in H2. - Right . Rewrite H3. Exact H2. - Intro H4. Rewrite H4 in H1. Rewrite H1 in H3. - Rewrite (MapCard_makeM2 (MapRemove A m0 (ad_div_2 a)) m1) in H3. - Elim (H (MapRemove A m0 (ad_div_2 a)) (ad_div_2 a) (MapCard A m0) - (MapCard A (MapRemove A m0 (ad_div_2 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 : (m:(Map A)) (a:ad) - (le (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 : (m:(Map A)) (a:ad) - (ge (S (MapCard A (MapRemove A m a))) (MapCard A m)). - Proof. - Unfold ge. 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 : (m:(Map A)) (a:ad) - (MapCard A (MapRemove A m a))=(MapCard A m) -> (MapGet A m a)=(NONE A). - Proof. - Induction m. Trivial. - Simpl. Intros a y a0 H. Elim (sumbool_of_bool (ad_eq a a0)). Intro H0. - Rewrite H0 in H. Discriminate H. - Intro H0. Rewrite H0. Reflexivity. - Intros. Simpl in H1. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H2. Rewrite H2 in H1. - Rewrite (MapCard_makeM2 m0 (MapRemove A m1 (ad_div_2 a))) in H1. - Rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1). Apply H0. Exact (simpl_plus_l ? ? ? H1). - Intro H2. Rewrite H2 in H1. - Rewrite (MapCard_makeM2 (MapRemove A m0 (ad_div_2 a)) m1) in H1. - Rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1). Apply H. - Rewrite (plus_sym (MapCard A (MapRemove A m0 (ad_div_2 a))) (MapCard A m1)) in H1. - Rewrite (plus_sym (MapCard A m0) (MapCard A m1)) in H1. Exact (simpl_plus_l ? ? ? H1). - Qed. - - Lemma MapCard_Remove_2 : (m:(Map A)) (a:ad) - (S (MapCard A (MapRemove A m a)))=(MapCard A m) -> - {y:A | (MapGet A m a)=(SOME A y)}. - Proof. - Induction m. Intros. Discriminate H. - Intros a y a0 H. Simpl in H. Elim (sumbool_of_bool (ad_eq a a0)). Intro H0. - Rewrite (ad_eq_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 (ad_bit_0 a)). Intro H2. Rewrite H2 in H1. - Rewrite (MapCard_makeM2 m0 (MapRemove A m1 (ad_div_2 a))) in H1. - Rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1). Apply H0. - Change (plus (S (MapCard A m0)) (MapCard A (MapRemove A m1 (ad_div_2 a)))) - =(plus (MapCard A m0) (MapCard A m1)) in H1. - Rewrite (plus_Snm_nSm (MapCard A m0) (MapCard A (MapRemove A m1 (ad_div_2 a)))) in H1. - Exact (simpl_plus_l ? ? ? 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 (ad_div_2 a)) m1) in H1. - Change (plus (S (MapCard A (MapRemove A m0 (ad_div_2 a)))) (MapCard A m1)) - =(plus (MapCard A m0) (MapCard A m1)) in H1. - Rewrite (plus_sym (S (MapCard A (MapRemove A m0 (ad_div_2 a)))) (MapCard A m1)) in H1. - Rewrite (plus_sym (MapCard A m0) (MapCard A m1)) in H1. Exact (simpl_plus_l ? ? ? H1). - Qed. - - Lemma MapCard_Remove_1_conv : (m:(Map A)) (a:ad) - (MapGet A m a)=(NONE A) -> (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 : (m:(Map A)) (a:ad) (y:A) - (MapGet A m a)=(SOME A 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 : (m,m':(Map A)) - (plus (MapCard A m) (MapCard A m'))= - (plus (MapCard A (MapMerge A m m')) (MapCard A (MapDomRestrTo A A m m'))). - Proof. - Induction m. Simpl. Intro. Apply plus_n_O. - Simpl. 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. 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 (plus (plus (MapCard A m0) (MapCard A m1)) (MapCard A m')) - =(plus (MapCard A (MapMerge A (M2 A m0 m1) m')) - (MapCard A (MapDomRestrTo A A (M2 A m0 m1) m'))). - Elim m'. Reflexivity. - Intros a y. Unfold MapMerge. Unfold MapDomRestrTo. - 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. - Rewrite <- (plus_Snm_nSm (plus (MapCard A m0) (MapCard A m1)) O). Reflexivity. - Intros. Simpl. - 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 : (m,m':(Map A)) (MapDisjoint A A m m') -> - (MapCard A (MapMerge A m m'))=(plus (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 : (m:(Map A)) (m':(Map B)) - (MapCard A m)=(plus (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. Apply MapDom_Split_3. - Qed. - - Lemma MapMerge_Card_ub : (m,m':(Map A)) - (le (MapCard A (MapMerge A m m')) (plus (MapCard A m) (MapCard A m'))). - Proof. - Intros. Rewrite MapMerge_Restr_Card. Apply le_plus_l. - Qed. - - Lemma MapDomRestrTo_Card_ub_l : (m:(Map A)) (m':(Map B)) - (le (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 : (m:(Map A)) (m':(Map B)) - (le (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 : (m,m':(Map A)) - (MapCard A (MapMerge A m m'))=(plus (MapCard A m) (MapCard A m')) -> - (MapDisjoint A A m m'). - Proof. - Induction m. Intros. Apply Map_M0_disjoint. - Simpl. Intros. Rewrite (MapCard_Put_behind_Put m' a a0) in H. Unfold MapDisjoint in_dom. - Simpl. Intros. Elim (sumbool_of_bool (ad_eq a a1)). Intro H2. - Rewrite (ad_eq_complete ? ? H2) in H. Rewrite (MapCard_Put_2 m' a1 a0 H) in H1. - Discriminate H1. - Intro H2. Rewrite H2 in H0. Discriminate H0. - 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 3 MapCard in H1. Rewrite <- (plus_Snm_nSm (MapCard A (M2 A m0 m1)) O) in H1. - Rewrite <- (plus_n_O (S (MapCard A (M2 A m0 m1)))) in H1. Unfold MapDisjoint in_dom. - Unfold 2 MapGet. Intros. Elim (sumbool_of_bool (ad_eq a a0)). Intro H4. - Rewrite <- (ad_eq_complete ? ? H4) in H2. Rewrite (MapCard_Put_2 ? ? ? H1) in H2. - Discriminate H2. - Intro H4. Rewrite H4 in H3. Discriminate H3. - Intros. Unfold MapDisjoint. Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H6. - Unfold MapDisjoint in H0. Apply H0 with m':=m3 a:=(ad_div_2 a). Apply le_antisym. - Apply MapMerge_Card_ub. - Apply simpl_le_plus_l with p:=(plus (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))) - =(plus (plus (MapCard A m0) (MapCard A m1)) (plus (MapCard A m2) (MapCard A m3))) in H3. - Rewrite <- H3. Simpl. Apply le_reg_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. 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. Rewrite H7. Reflexivity. - Intro H6. Unfold MapDisjoint in H. Apply H with m':=m2 a:=(ad_div_2 a). Apply le_antisym. - Apply MapMerge_Card_ub. - Apply simpl_le_plus_l with p:=(plus (MapCard A m1) (MapCard A m3)). - Rewrite (plus_sym (plus (MapCard A m1) (MapCard A m3)) (plus (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_sym (plus (MapCard A m1) (MapCard A m3)) (MapCard A (MapMerge A m0 m2))). - Change (plus (MapCard A (MapMerge A m0 m2)) (MapCard A (MapMerge A m1 m3))) - =(plus (plus (MapCard A m0) (MapCard A m1)) (plus (MapCard A m2) (MapCard A m3))) in H3. - Rewrite <- H3. Apply le_reg_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. 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. Rewrite H7. Reflexivity. - Qed. - - Lemma MapCard_is_Sn : (m:(Map A)) (n:nat) (MapCard ? m)=(S n) -> - {a:ad | (in_dom ? a m)=true}. - Proof. - Induction m. Intros. Discriminate H. - Intros a y n H. Split with a. Unfold in_dom. 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 (ad_double a). Unfold in_dom. - Rewrite (MapGet_M2_bit_0_0 A (ad_double a) (ad_double_bit_0 a) m0 m1). - Rewrite (ad_double_div_2 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 (ad_double_plus_un a). Unfold in_dom. - Rewrite (MapGet_M2_bit_0_1 A (ad_double_plus_un a) (ad_double_plus_un_bit_0 a) m0 m1). - Rewrite (ad_double_plus_un_div_2 a). Elim (in_dom_some ? ? ? H3). Intros y H4. Rewrite H4. - Reflexivity. - Qed. - -End MapCard. - -Section MapCard2. - - Variable A, B : Set. - - Lemma MapSubset_card_eq_1 : (n:nat) (m:(Map A)) (m':(Map B)) - (MapSubset ? ? m m') -> (MapCard ? m)=n -> (MapCard ? m')=n -> - (MapSubset ? ? m' m). - Proof. - Induction n. Intros. Unfold MapSubset in_dom. 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. Intro. Rewrite (MapPut_semantics ? (MapRemove B m' a) a y' a0). - Elim (sumbool_of_bool (ad_eq a a0)). Intro H7. Rewrite H7. Rewrite <- (ad_eq_complete ? ? H7). - Apply sym_eq. Assumption. - Intro H7. Rewrite H7. Rewrite (MapRemove_semantics ? m' a a0). Rewrite H7. Reflexivity. - Unfold eqmap eqm. Intro. Rewrite (MapPut_semantics ? (MapRemove A m a) a y a0). - Elim (sumbool_of_bool (ad_eq a a0)). Intro H7. Rewrite H7. Rewrite <- (ad_eq_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 : (m:(Map A)) (m':(Map B)) - (le (MapCard A (MapDomRestrTo A B m m')) (MapCard B m')). - Proof. - Induction m. Intro. Simpl. Apply le_O_n. - Intros a y m'. Simpl. 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. - Apply le_n_S. Apply le_O_n. - Intro H. Rewrite H. Simpl. Apply le_O_n. - Induction m'. Simpl. Apply le_O_n. - - Intros a y. Unfold MapDomRestrTo. Case (MapGet A (M2 A m0 m1) a). Simpl. Apply le_O_n. - Intro. Simpl. Apply le_n. - Intros. Simpl. Rewrite (MapCard_makeM2 A (MapDomRestrTo A B m0 m2) (MapDomRestrTo A B m1 m3)). - Apply le_plus_plus. Apply H. - Apply H0. - Qed. - -End MapCard2. - -Section MapCard3. - - Variable A, B : Set. - - Lemma MapMerge_Card_lb_l : (m,m':(Map A)) - (ge (MapCard A (MapMerge A m m')) (MapCard A m)). - Proof. - Unfold ge. Intros. Apply (simpl_le_plus_l (MapCard A m')). - Rewrite (plus_sym (MapCard A m') (MapCard A m)). - Rewrite (plus_sym (MapCard A m') (MapCard A (MapMerge A m m'))). - Rewrite (MapMerge_Restr_Card A m m'). Apply le_reg_l. Apply MapDomRestrTo_Card_ub_r. - Qed. - - Lemma MapMerge_Card_lb_r : (m,m':(Map A)) - (ge (MapCard A (MapMerge A m m')) (MapCard A m')). - Proof. - Unfold ge. Intros. Apply (simpl_le_plus_l (MapCard A m)). Rewrite (MapMerge_Restr_Card A m m'). - Rewrite (plus_sym (MapCard A (MapMerge A m m')) (MapCard A (MapDomRestrTo A A m m'))). - Apply le_reg_r. Apply MapDomRestrTo_Card_ub_l. - Qed. - - Lemma MapDomRestrBy_Card_lb : (m:(Map A)) (m':(Map B)) - (ge (plus (MapCard B m') (MapCard A (MapDomRestrBy A B m m'))) (MapCard A m)). - Proof. - Unfold ge. Intros. Rewrite (MapSplit_Card A B m m'). Apply le_reg_r. - Apply MapDomRestrTo_Card_ub_r. - Qed. - - Lemma MapSubset_Card_le : (m:(Map A)) (m':(Map B)) - (MapSubset A B m m') -> (le (MapCard A m) (MapCard B m')). - Proof. - Intros. Apply le_trans with m:=(plus (MapCard B m') (MapCard A (MapDomRestrBy A B m m'))). - Exact (MapDomRestrBy_Card_lb m m'). - Rewrite (MapCard_ext ? ? ? (MapSubset_imp_2 ? ? ? ? H)). Simpl. Rewrite <- plus_n_O. - Apply le_n. - Qed. - - Lemma MapSubset_card_eq : (m:(Map A)) (m':(Map B)) - (MapSubset ? ? m m') -> (le (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. diff --git a/theories7/IntMap/Mapfold.v b/theories7/IntMap/Mapfold.v deleted file mode 100644 index 8061f253..00000000 --- a/theories7/IntMap/Mapfold.v +++ /dev/null @@ -1,381 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* M -> M. - - Variable nleft : (a:M) (op neutral a)=a. - Variable nright : (a:M) (op a neutral)=a. - Variable assoc : (a,b,c:M) (op (op a b) c)=(op a (op b c)). - - Lemma MapFold_ext : (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 : (m:(Map A)) (f,g:ad->A->M) (pf:ad->ad) - ((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. - Induction m. Trivial. - Simpl. Intros. Apply H. Rewrite (ad_eq_correct a). Reflexivity. - Intros. Simpl. Rewrite (H f g [a0:ad](pf (ad_double a0))). - Rewrite (H0 f g [a0:ad](pf (ad_double_plus_un a0))). Reflexivity. - Intros. Apply H1. Rewrite MapGet_M2_bit_0_1. Rewrite ad_double_plus_un_div_2. Assumption. - Apply ad_double_plus_un_bit_0. - Intros. Apply H1. Rewrite MapGet_M2_bit_0_0. Rewrite ad_double_div_2. Assumption. - Apply ad_double_bit_0. - Qed. - - Lemma MapFold_ext_f : (f,g:ad->A->M) (m:(Map A)) - ((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 [a0:ad]a0 H). - Qed. - - Lemma MapFold1_as_Fold_1 : (m:(Map A)) (f,f':ad->A->M) (pf, pf':ad->ad) - ((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. - Induction m. Trivial. - Intros. Simpl. Apply H. - Intros. Simpl. - Rewrite (H f f' [a0:ad](pf (ad_double a0)) [a0:ad](pf' (ad_double a0))). - Rewrite (H0 f f' [a0:ad](pf (ad_double_plus_un a0)) [a0:ad](pf' (ad_double_plus_un a0))). - Reflexivity. - Intros. Apply H1. - Intros. Apply H1. - Qed. - - Lemma MapFold1_as_Fold : (f:ad->A->M) (pf:ad->ad) (m:(Map A)) - (MapFold1 ? ? neutral op f pf m)=(MapFold ? ? neutral op [a:ad][y:A] (f (pf a) y) m). - Proof. - Intros. Unfold MapFold. Apply MapFold1_as_Fold_1. Trivial. - Qed. - - Lemma MapFold1_ext : (f:ad->A->M) (m,m':(Map A)) (eqmap A m m') -> (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 : (a,b:M) (op a b)=(op b a). - - Lemma MapFold_Put_disjoint_1 : (p:positive) - (f:ad->A->M) (pf:ad->ad) (a1,a2:ad) (y1,y2:A) - (ad_xor a1 a2)=(ad_x 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. - Induction p. Intros. Simpl. Elim (sumbool_of_bool (ad_bit_0 a1)). Intro H1. Rewrite H1. - Simpl. Rewrite ad_div_2_double_plus_un. Rewrite ad_div_2_double. Apply comm. - Change (ad_bit_0 a2)=(negb true). Rewrite <- H1. Rewrite (ad_neg_bit_0_2 ? ? ? H0). - Rewrite negb_elim. Reflexivity. - Assumption. - Intro H1. Rewrite H1. Simpl. Rewrite ad_div_2_double. Rewrite ad_div_2_double_plus_un. - Reflexivity. - Change (ad_bit_0 a2)=(negb false). Rewrite <- H1. Rewrite (ad_neg_bit_0_2 ? ? ? H0). - Rewrite negb_elim. Reflexivity. - Assumption. - Simpl. Intros. Elim (sumbool_of_bool (ad_bit_0 a1)). Intro H1. Rewrite H1. Simpl. - Rewrite nleft. - Rewrite (H f [a0:ad](pf (ad_double_plus_un a0)) (ad_div_2 a1) (ad_div_2 a2) y1 y2). - Rewrite ad_div_2_double_plus_un. Rewrite ad_div_2_double_plus_un. Reflexivity. - Rewrite <- (ad_same_bit_0 ? ? ? H0). Assumption. - Assumption. - Rewrite <- ad_xor_div_2. Rewrite H0. Reflexivity. - Intro H1. Rewrite H1. Simpl. Rewrite nright. - Rewrite (H f [a0:ad](pf (ad_double a0)) (ad_div_2 a1) (ad_div_2 a2) y1 y2). - Rewrite ad_div_2_double. Rewrite ad_div_2_double. Reflexivity. - Rewrite <- (ad_same_bit_0 ? ? ? H0). Assumption. - Assumption. - Rewrite <- ad_xor_div_2. Rewrite H0. Reflexivity. - Intros. Simpl. Elim (sumbool_of_bool (ad_bit_0 a1)). Intro H0. Rewrite H0. Simpl. - Rewrite ad_div_2_double. Rewrite ad_div_2_double_plus_un. Apply comm. - Assumption. - Change (ad_bit_0 a2)=(negb true). Rewrite <- H0. Rewrite (ad_neg_bit_0_1 ? ? H). - Rewrite negb_elim. Reflexivity. - Intro H0. Rewrite H0. Simpl. Rewrite ad_div_2_double. Rewrite ad_div_2_double_plus_un. - Reflexivity. - Change (ad_bit_0 a2)=(negb false). Rewrite <- H0. Rewrite (ad_neg_bit_0_1 ? ? H). - Rewrite negb_elim. Reflexivity. - Assumption. - Qed. - - Lemma MapFold_Put_disjoint_2 : - (f:ad->A->M) (m:(Map A)) (a:ad) (y:A) (pf:ad->ad) - (MapGet A m a)=(NONE A) -> - (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. - Induction m. Intros. Simpl. Rewrite (nright (f (pf a) y)). Reflexivity. - Intros a1 y1 a2 y2 pf H. Simpl. Elim (ad_sum (ad_xor 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 (ad_eq_complete ? ? (ad_xor_eq_true ? ? H0)) in H. - Rewrite (M1_semantics_1 A a2 y1) in H. Discriminate H. - Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H2. - Cut (MapPut A (M2 A m0 m1) a y)=(M2 A m0 (MapPut A m1 (ad_div_2 a) y)). Intro. - Rewrite H3. Simpl. Rewrite (H0 (ad_div_2 a) y [a0:ad](pf (ad_double_plus_un a0))). - Rewrite ad_div_2_double_plus_un. Rewrite <- assoc. - Rewrite (comm (MapFold1 A M neutral op f [a0:ad](pf (ad_double 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. Elim (ad_sum 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 (ad_div_2 a) y) m1). - Intro. Rewrite H3. Simpl. Rewrite (H (ad_div_2 a) y [a0:ad](pf (ad_double a0))). - Rewrite ad_div_2_double. Rewrite <- assoc. Reflexivity. - Assumption. - Rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1) in H1. Assumption. - Simpl. Elim (ad_sum 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 : - (f:ad->A->M) (m:(Map A)) (a:ad) (y:A) - (MapGet A m a)=(NONE A) -> - (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 [a0:ad]a0 H). - Qed. - - Lemma MapFold_Put_behind_disjoint_2 : - (f:ad->A->M) (m:(Map A)) (a:ad) (y:A) (pf:ad->ad) - (MapGet A m a)=(NONE A) -> - (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. Unfold in_dom. Simpl. Intros. Elim (sumbool_of_bool (ad_eq a a0)). - Intro H2. Rewrite (ad_eq_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. Unfold in_dom. Simpl. Intros. - Elim (sumbool_of_bool (ad_eq a a0)). Intro H2. Rewrite (ad_eq_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 : - (f:ad->A->M) (m:(Map A)) (a:ad) (y:A) - (MapGet A m a)=(NONE A) -> - (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 [a0:ad]a0 H). - Qed. - - Lemma MapFold_Merge_disjoint_1 : - (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. - Induction m1. Simpl. Intros. Rewrite nleft. Reflexivity. - Intros. Unfold MapMerge. Apply (MapFold_Put_behind_disjoint_2 f m2 a a0 pf). - Apply in_dom_none. Exact (MapDisjoint_M1_l ? ? m2 a a0 H). - Induction m2. Intros. Simpl. Rewrite nright. Reflexivity. - Intros. Unfold MapMerge. 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. Rewrite (H m3 [a0:ad](pf (ad_double a0))). - Rewrite (H0 m4 [a0:ad](pf (ad_double_plus_un a0))). - Cut (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 : - (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 [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 : (c:N)(times neutral c)=neutral'. - Variable distr : (a,b:M) (c:N) (times (op a b) c) = (op' (times a c) (times b c)). - - Lemma MapFold_distr_r_1 : (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' [a:ad][y:A] (times (f a y) c) pf m). - Proof. - Induction m. Intros. Exact (absorb c). - Trivial. - Intros. Simpl. Rewrite distr. Rewrite H. Rewrite H0. Reflexivity. - Qed. - - Lemma MapFold_distr_r : (f:ad->A->M) (m:(Map A)) (c:N) - (times (MapFold A M neutral op f m) c)= - (MapFold A M' neutral' op' [a:ad][y:A] (times (f a y) c) m). - Proof. - Intros. Exact (MapFold_distr_r_1 f m c [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 : (c:N)(times c neutral)=neutral'. - Variable distr : (a,b:M) (c:N) (times c (op a b)) = (op' (times c a) (times c b)). - - Lemma MapFold_distr_l : (f:ad->A->M) (m:(Map A)) (c:N) - (times c (MapFold A M neutral op f m))= - (MapFold A M' neutral' op' [a:ad][y:A] (times c (f a y)) m). - Proof. - Intros. Apply MapFold_distr_r with times:=[a:M][b:N](times b a); Assumption. - Qed. - -End MapFoldDistrL. - -Section MapFoldExists. - - Variable A : Set. - - Lemma MapFold_orb_1 : (f:ad->A->bool) (m:(Map A)) (pf:ad->ad) - (MapFold1 A bool false orb f pf m)= - (Cases (MapSweep1 A f pf m) of - (SOME _) => true - | _ => false - end). - Proof. - Induction m. Trivial. - Intros a y pf. Simpl. Unfold MapSweep2. (Case (f (pf a) y); Reflexivity). - Intros. Simpl. Rewrite (H [a0:ad](pf (ad_double a0))). - Rewrite (H0 [a0:ad](pf (ad_double_plus_un a0))). - Case (MapSweep1 A f [a0:ad](pf (ad_double a0)) m0); Reflexivity. - Qed. - - Lemma MapFold_orb : (f:ad->A->bool) (m:(Map A)) (MapFold A bool false orb f m)= - (Cases (MapSweep A f m) of - (SOME _) => true - | _ => false - end). - Proof. - Intros. Exact (MapFold_orb_1 f m [a:ad]a). - Qed. - -End MapFoldExists. - -Section DMergeDef. - - Variable A : Set. - - Definition DMerge := (MapFold (Map A) (Map A) (M0 A) (MapMerge A) [_:ad][m:(Map A)] m). - - Lemma in_dom_DMerge_1 : (m:(Map (Map A))) (a:ad) (in_dom A a (DMerge m))= - (Cases (MapSweep ? [_:ad][m0:(Map A)] (in_dom A a m0) m) of - (SOME _) => true - | _ => false - end). - Proof. - Unfold DMerge. Intros. - Rewrite (MapFold_distr_l (Map A) (Map A) (M0 A) (MapMerge A) bool false - orb ad (in_dom A) [c:ad](refl_equal ? ?) (in_dom_merge A)). - Apply MapFold_orb. - Qed. - - Lemma in_dom_DMerge_2 : (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) [_: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 : (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 ? [_: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. diff --git a/theories7/IntMap/Mapiter.v b/theories7/IntMap/Mapiter.v deleted file mode 100644 index 144572fd..00000000 --- a/theories7/IntMap/Mapiter.v +++ /dev/null @@ -1,527 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* 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)] : (option (ad * A)) := - Cases m of - M0 => (NONE ?) - | (M1 a y) => (MapSweep2 (pf a) y) - | (M2 m m') => Cases (MapSweep1 ([a:ad] (pf (ad_double a))) m) of - (SOME r) => (SOME ? r) - | NONE => (MapSweep1 ([a:ad] (pf (ad_double_plus_un a))) m') - end - end. - - Definition MapSweep := [m:(Map A)] (MapSweep1 ([a:ad] a) m). - - Lemma MapSweep_semantics_1_1 : (m:(Map A)) (pf:ad->ad) (a:ad) (y:A) - (MapSweep1 pf m)=(SOME ? (a, y)) -> (f a y)=true. - Proof. - Induction m. Intros. Discriminate H. - Simpl. Intros a y pf a0 y0. Elim (sumbool_of_bool (f (pf a) y)). Intro H. Unfold MapSweep2. - Rewrite H. Intro H0. Inversion H0. Rewrite <- H3. Assumption. - Intro H. Unfold MapSweep2. Rewrite H. Intro H0. Discriminate H0. - Simpl. Intros. Elim (option_sum ad*A (MapSweep1 [a0:ad](pf (ad_double a0)) m0)). - Intro H2. Elim H2. Intros r H3. Rewrite H3 in H1. Inversion H1. Rewrite H5 in H3. - Exact (H [a0:ad](pf (ad_double a0)) a y H3). - Intro H2. Rewrite H2 in H1. Exact (H0 [a0:ad](pf (ad_double_plus_un a0)) a y H1). - Qed. - - Lemma MapSweep_semantics_1 : (m:(Map A)) (a:ad) (y:A) - (MapSweep m)=(SOME ? (a, y)) -> (f a y)=true. - Proof. - Intros. Exact (MapSweep_semantics_1_1 m [a:ad]a a y H). - Qed. - - Lemma MapSweep_semantics_2_1 : (m:(Map A)) (pf:ad->ad) (a:ad) (y:A) - (MapSweep1 pf m)=(SOME ? (a, y)) -> {a':ad | a=(pf a')}. - Proof. - Induction m. Intros. Discriminate H. - Simpl. Unfold MapSweep2. 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. - Elim (option_sum ad*A (MapSweep1 [a0:ad](pf (ad_double a0)) m0)). Intro H1. Elim H1. - Intros r H2. Rewrite H2. Intro H3. Inversion H3. Rewrite H5 in H2. - Elim (H [a0:ad](pf (ad_double a0)) a y H2). Intros a0 H6. Split with (ad_double a0). - Assumption. - Intro H1. Rewrite H1. Intro H2. Elim (H0 [a0:ad](pf (ad_double_plus_un a0)) a y H2). - Intros a0 H3. Split with (ad_double_plus_un a0). Assumption. - Qed. - - Lemma MapSweep_semantics_2_2 : (m:(Map A)) - (pf,fp:ad->ad) ((a0:ad) (fp (pf a0))=a0) -> (a:ad) (y:A) - (MapSweep1 pf m)=(SOME ? (a, y)) -> (MapGet A m (fp a))=(SOME ? y). - Proof. - Induction m. Intros. Discriminate H0. - Simpl. Intros a y pf fp H a0 y0. Unfold MapSweep2. Elim (sumbool_of_bool (f (pf a) y)). - Intro H0. Rewrite H0. Intro H1. Inversion H1. Rewrite (H a). Rewrite (ad_eq_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 (ad_bit_0 (fp a))). - Intro H3. Rewrite H3. Elim (option_sum ad*A (MapSweep1 [a0:ad](pf (ad_double a0)) m0)). - Intro H4. Simpl in H2. Apply (H0 [a0:ad](pf (ad_double_plus_un a0)) [a0:ad](ad_div_2 (fp a0))). - Intro. Rewrite H1. Apply ad_double_plus_un_div_2. - Elim (option_sum ad*A (MapSweep1 [a0:ad](pf (ad_double 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 [a0:ad](pf (ad_double a0)) a y H6). Intros a0 H9. - Rewrite H9 in H3. Rewrite (H1 (ad_double a0)) in H3. Rewrite (ad_double_bit_0 a0) in H3. - Discriminate H3. - Intro H5. Rewrite H5 in H2. Assumption. - Intro H4. Simpl in H2. Rewrite H4 in H2. - Apply (H0 [a0:ad](pf (ad_double_plus_un a0)) [a0:ad](ad_div_2 (fp a0))). Intro. - Rewrite H1. Apply ad_double_plus_un_div_2. - Assumption. - Intro H3. Rewrite H3. Simpl in H2. - Elim (option_sum ad*A (MapSweep1 [a0:ad](pf (ad_double a0)) m0)). Intro H4. Elim H4. - Intros r H5. Rewrite H5 in H2. Inversion H2. Rewrite H7 in H5. - Apply (H [a0:ad](pf (ad_double a0)) [a0:ad](ad_div_2 (fp a0))). Intro. Rewrite H1. - Apply ad_double_div_2. - Assumption. - Intro H4. Rewrite H4 in H2. - Elim (MapSweep_semantics_2_1 m1 [a0:ad](pf (ad_double_plus_un a0)) a y H2). - Intros a0 H5. Rewrite H5 in H3. Rewrite (H1 (ad_double_plus_un a0)) in H3. - Rewrite (ad_double_plus_un_bit_0 a0) in H3. Discriminate H3. - Qed. - - Lemma MapSweep_semantics_2 : (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 [a0:ad]a0 [a0:ad]a0 [a0:ad](refl_equal ad a0) a y H). - Qed. - - Lemma MapSweep_semantics_3_1 : (m:(Map A)) (pf:ad->ad) - (MapSweep1 pf m)=(NONE ?) -> - (a:ad) (y:A) (MapGet A m a)=(SOME ? y) -> (f (pf a) y)=false. - Proof. - Induction m. Intros. Discriminate H0. - Simpl. Unfold MapSweep2. 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 (ad_eq a a0)). Intro H1. Rewrite H1. - Intro H2. Inversion H2. Rewrite <- H4. Rewrite <- (ad_eq_complete ? ? H1). Assumption. - Intro H1. Rewrite H1. Intro. Discriminate H2. - Intros. Simpl in H1. Elim (option_sum ad*A (MapSweep1 [a:ad](pf (ad_double 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 (ad_bit_0 a)). Intro H4. - Rewrite (MapGet_M2_bit_0_1 A a H4 m0 m1) in H2. Rewrite <- (ad_div_2_double_plus_un a H4). - Exact (H0 [a:ad](pf (ad_double_plus_un a)) H1 (ad_div_2 a) y H2). - Intro H4. Rewrite (MapGet_M2_bit_0_0 A a H4 m0 m1) in H2. Rewrite <- (ad_div_2_double a H4). - Exact (H [a:ad](pf (ad_double a)) H3 (ad_div_2 a) y H2). - Qed. - - Lemma MapSweep_semantics_3 : (m:(Map A)) - (MapSweep m)=(NONE ?) -> (a:ad) (y:A) (MapGet A m a)=(SOME ? y) -> - (f a y)=false. - Proof. - Intros. - Exact (MapSweep_semantics_3_1 m [a0:ad]a0 H a y H0). - Qed. - - Lemma MapSweep_semantics_4_1 : (m:(Map A)) (pf:ad->ad) (a:ad) (y:A) - (MapGet A m a)=(SOME A y) -> (f (pf a) y)=true -> - {a':ad & {y':A | (MapSweep1 pf m)=(SOME ? (a', y'))}}. - Proof. - Induction m. Intros. Discriminate H. - Intros. Elim (sumbool_of_bool (ad_eq a a1)). Intro H1. Split with (pf a1). Split with y. - Rewrite (ad_eq_complete ? ? H1). Unfold MapSweep1 MapSweep2. - Rewrite (ad_eq_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 (ad_bit_0 a)). Intro H3. - Rewrite (MapGet_M2_bit_0_1 ? ? H3 m0 m1) in H1. - Rewrite <- (ad_div_2_double_plus_un a H3) in H2. - Elim (H0 [a0:ad](pf (ad_double_plus_un a0)) (ad_div_2 a) y H1 H2). Intros a'' H4. Elim H4. - Intros y'' H5. Simpl. Elim (option_sum ? (MapSweep1 [a:ad](pf (ad_double 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 <- (ad_div_2_double a H3) in H2. - Elim (H [a0:ad](pf (ad_double a0)) (ad_div_2 a) y H1 H2). Intros a'' H4. Elim H4. - Intros y'' H5. Split with a''. Split with y''. Simpl. Rewrite H5. Reflexivity. - Qed. - - Lemma MapSweep_semantics_4 : (m:(Map A)) (a:ad) (y:A) - (MapGet A m a)=(SOME A y) -> (f a y)=true -> - {a':ad & {y':A | (MapSweep m)=(SOME ? (a', y'))}}. - Proof. - Intros. Exact (MapSweep_semantics_4_1 m [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)] : (Map B) := - Cases m of - M0 => (M0 B) - | (M1 a y) => (f (pf a) y) - | (M2 m1 m2) => (MapMerge B (MapCollect1 f [a0:ad] (pf (ad_double a0)) m1) - (MapCollect1 f [a0:ad] (pf (ad_double_plus_un a0)) m2)) - end. - - Definition MapCollect := [f:ad->A->(Map B); m:(Map A)] (MapCollect1 f [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)] : M := - Cases m of - M0 => neutral - | (M1 a y) => (f (pf a) y) - | (M2 m1 m2) => (op (MapFold1 f [a0:ad] (pf (ad_double a0)) m1) - (MapFold1 f [a0:ad] (pf (ad_double_plus_un a0)) m2)) - end. - - Definition MapFold := [f:ad->A->M; m:(Map A)] (MapFold1 f [a:ad]a m). - - Lemma MapFold_empty : (f:ad->A->M) (MapFold f (M0 A))=neutral. - Proof. - Trivial. - Qed. - - Lemma MapFold_M1 : (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)] - : State * M := - Cases m of - M0 => (state, neutral) - | (M1 a y) => (f state (pf a) y) - | (M2 m1 m2) => - Cases (MapFold1_state state [a0:ad] (pf (ad_double a0)) m1) of - (state1, x1) => - Cases (MapFold1_state state1 [a0:ad] (pf (ad_double_plus_un a0)) m2) of - (state2, x2) => (state2, (op x1 x2)) - end - end - end. - - Definition MapFold_state := [state:State] (MapFold1_state state [a:ad]a). - - Lemma pair_sp : (B,C:Set) (x:B*C) x=(Fst x, Snd x). - Proof. - Induction x. Trivial. - Qed. - - Lemma MapFold_state_stateless_1 : (m:(Map A)) (g:ad->A->M) (pf:ad->ad) - ((state:State) (a:ad) (y:A) (Snd (f state a y))=(g a y)) -> - (state:State) - (Snd (MapFold1_state state pf m))=(MapFold1 g pf m). - Proof. - Induction m. Trivial. - Intros. Simpl. Apply H. - Intros. Simpl. Rewrite (pair_sp ? ? - (MapFold1_state state [a0:ad](pf (ad_double a0)) m0)). - Rewrite (H g [a0:ad](pf (ad_double a0)) H1 state). - Rewrite (pair_sp ? ? - (MapFold1_state - (Fst (MapFold1_state state [a0:ad](pf (ad_double a0)) m0)) - [a0:ad](pf (ad_double_plus_un a0)) m1)). - Simpl. - Rewrite (H0 g [a0:ad](pf (ad_double_plus_un a0)) H1 - (Fst (MapFold1_state state [a0:ad](pf (ad_double a0)) m0))). - Reflexivity. - Qed. - - Lemma MapFold_state_stateless : (g:ad->A->M) - ((state:State) (a:ad) (y:A) (Snd (f state a y))=(g a y)) -> - (state:State) (m:(Map A)) - (Snd (MapFold_state state m))=(MapFold g m). - Proof. - Intros. Exact (MapFold_state_stateless_1 m g [a0:ad]a0 H state). - Qed. - - End MapFoldDef. - - Lemma MapCollect_as_Fold : (f:ad->A->(Map B)) (m:(Map A)) - (MapCollect f m)=(MapFold (Map B) (M0 B) (MapMerge B) f m). - Proof. - Induction m;Trivial. - Qed. - - Definition alist := (list (ad*A)). - Definition anil := (nil (ad*A)). - Definition acons := (!cons (ad*A)). - Definition aapp := (!app (ad*A)). - - Definition alist_of_Map := (MapFold alist anil aapp [a:ad;y:A] (acons (pair ? ? a y) anil)). - - Fixpoint alist_semantics [l:alist] : ad -> (option A) := - Cases l of - nil => [_:ad] (NONE A) - | (cons (a, y) l') => [a0:ad] if (ad_eq a a0) then (SOME A y) else (alist_semantics l' a0) - end. - - Lemma alist_semantics_app : (l,l':alist) (a:ad) - (alist_semantics (aapp l l') a)= - (Cases (alist_semantics l a) of - NONE => (alist_semantics l' a) - | (SOME y) => (SOME A y) - end). - Proof. - Unfold aapp. Induction l. Trivial. - Intros. Elim a. Intros a1 y1. Simpl. Case (ad_eq a1 a0). Reflexivity. - Apply H. - Qed. - - Lemma alist_of_Map_semantics_1_1 : (m:(Map A)) (pf:ad->ad) (a:ad) (y:A) - (alist_semantics (MapFold1 alist anil aapp [a0:ad][y:A](acons (a0,y) anil) pf m) a) - =(SOME A y) -> {a':ad | a=(pf a')}. - Proof. - Induction m. Simpl. Intros. Discriminate H. - Simpl. Intros a y pf a0 y0. Elim (sumbool_of_bool (ad_eq (pf a) a0)). Intro H. Rewrite H. - Intro H0. Split with a. Rewrite (ad_eq_complete ? ? H). Reflexivity. - Intro H. Rewrite H. Intro H0. Discriminate H0. - Intros. Change (alist_semantics - (aapp - (MapFold1 alist anil aapp [a0:ad][y:A](acons (a0,y) anil) - [a0:ad](pf (ad_double a0)) m0) - (MapFold1 alist anil aapp [a0:ad][y:A](acons (a0,y) anil) - [a0:ad](pf (ad_double_plus_un a0)) m1)) a)=(SOME A y) in H1. - Rewrite (alist_semantics_app - (MapFold1 alist anil aapp [a0:ad][y0:A](acons (a0,y0) anil) - [a0:ad](pf (ad_double a0)) m0) - (MapFold1 alist anil aapp [a0:ad][y0:A](acons (a0,y0) anil) - [a0:ad](pf (ad_double_plus_un a0)) m1) a) in H1. - Elim (option_sum A - (alist_semantics - (MapFold1 alist anil aapp [a0:ad][y0:A](acons (a0,y0) anil) - [a0:ad](pf (ad_double a0)) m0) a)). - Intro H2. Elim H2. Intros y0 H3. Elim (H [a0:ad](pf (ad_double a0)) a y0 H3). Intros a0 H4. - Split with (ad_double a0). Assumption. - Intro H2. Rewrite H2 in H1. Elim (H0 [a0:ad](pf (ad_double_plus_un a0)) a y H1). - Intros a0 H3. Split with (ad_double_plus_un a0). Assumption. - Qed. - - Definition ad_inj := [pf:ad->ad] (a0,a1:ad) (pf a0)=(pf a1) -> a0=a1. - - Lemma ad_comp_double_inj : - (pf:ad->ad) (ad_inj pf) -> (ad_inj [a0:ad] (pf (ad_double a0))). - Proof. - Unfold ad_inj. Intros. Apply ad_double_inj. Exact (H ? ? H0). - Qed. - - Lemma ad_comp_double_plus_un_inj : (pf:ad->ad) (ad_inj pf) -> - (ad_inj [a0:ad] (pf (ad_double_plus_un a0))). - Proof. - Unfold ad_inj. Intros. Apply ad_double_plus_un_inj. Exact (H ? ? H0). - Qed. - - Lemma alist_of_Map_semantics_1 : (m:(Map A)) (pf:ad->ad) (ad_inj pf) -> - (a:ad) (MapGet A m a)=(alist_semantics (MapFold1 alist anil aapp - [a0:ad;y:A] (acons (pair ? ? a0 y) anil) pf m) - (pf a)). - Proof. - Induction m. Trivial. - Simpl. Intros. Elim (sumbool_of_bool (ad_eq a a1)). Intro H0. Rewrite H0. - Rewrite (ad_eq_complete ? ? H0). Rewrite (ad_eq_correct (pf a1)). Reflexivity. - Intro H0. Rewrite H0. Elim (sumbool_of_bool (ad_eq (pf a) (pf a1))). Intro H1. - Rewrite (H a a1 (ad_eq_complete ? ? H1)) in H0. Rewrite (ad_eq_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 [a0:ad][y:A](acons (a0,y) anil) - [a0:ad](pf (ad_double a0)) m0) - (MapFold1 alist anil aapp [a0:ad][y:A](acons (a0,y) anil) - [a0:ad](pf (ad_double_plus_un a0)) m1)) (pf a)). - Rewrite alist_semantics_app. Rewrite (MapGet_M2_bit_0_if A m0 m1 a). - Elim (ad_double_or_double_plus_un a). Intro H2. Elim H2. Intros a0 H3. Rewrite H3. - Rewrite (ad_double_bit_0 a0). - Rewrite <- (H [a1:ad](pf (ad_double a1)) (ad_comp_double_inj pf H1) a0). - Rewrite ad_double_div_2. Case (MapGet A m0 a0). - Elim (option_sum A - (alist_semantics - (MapFold1 alist anil aapp [a1:ad][y:A](acons (a1,y) anil) - [a1:ad](pf (ad_double_plus_un a1)) m1) (pf (ad_double a0)))). - Intro H4. Elim H4. Intros y H5. - Elim (alist_of_Map_semantics_1_1 m1 [a1:ad](pf (ad_double_plus_un a1)) - (pf (ad_double a0)) y H5). - Intros a1 H6. Cut (ad_bit_0 (ad_double a0))=(ad_bit_0 (ad_double_plus_un a1)). - Intro. Rewrite (ad_double_bit_0 a0) in H7. Rewrite (ad_double_plus_un_bit_0 a1) in H7. - Discriminate H7. - Rewrite (H1 (ad_double a0) (ad_double_plus_un a1) H6). Reflexivity. - Intro H4. Rewrite H4. Reflexivity. - Trivial. - Intro H2. Elim H2. Intros a0 H3. Rewrite H3. Rewrite (ad_double_plus_un_bit_0 a0). - Rewrite <- (H0 [a1:ad](pf (ad_double_plus_un a1)) (ad_comp_double_plus_un_inj pf H1) a0). - Rewrite ad_double_plus_un_div_2. - Elim (option_sum A - (alist_semantics - (MapFold1 alist anil aapp [a1:ad][y:A](acons (a1,y) anil) - [a1:ad](pf (ad_double a1)) m0) (pf (ad_double_plus_un a0)))). - Intro H4. Elim H4. Intros y H5. - Elim (alist_of_Map_semantics_1_1 m0 [a1:ad](pf (ad_double a1)) - (pf (ad_double_plus_un a0)) y H5). - Intros a1 H6. Cut (ad_bit_0 (ad_double_plus_un a0))=(ad_bit_0 (ad_double a1)). - Intro H7. Rewrite (ad_double_plus_un_bit_0 a0) in H7. Rewrite (ad_double_bit_0 a1) in H7. - Discriminate H7. - Rewrite (H1 (ad_double_plus_un a0) (ad_double a1) H6). Reflexivity. - Intro H4. Rewrite H4. Reflexivity. - Qed. - - Lemma alist_of_Map_semantics : (m:(Map A)) - (eqm A (MapGet A m) (alist_semantics (alist_of_Map m))). - Proof. - Unfold eqm. Intros. Exact (alist_of_Map_semantics_1 m [a0:ad]a0 [a0,a1:ad][p:a0=a1]p a). - Qed. - - Fixpoint Map_of_alist [l:alist] : (Map A) := - Cases l of - nil => (M0 A) - | (cons (a, y) l') => (MapPut A (Map_of_alist l') a y) - end. - - Lemma Map_of_alist_semantics : (l:alist) - (eqm A (alist_semantics l) (MapGet A (Map_of_alist l))). - Proof. - Unfold eqm. Induction l. Trivial. - Intros r l0 H a. Elim r. Intros a0 y0. Simpl. Elim (sumbool_of_bool (ad_eq a0 a)). - Intro H0. Rewrite H0. Rewrite (ad_eq_complete ? ? H0). - Rewrite (MapPut_semantics A (Map_of_alist l0) a y0 a). Rewrite (ad_eq_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 : (m:(Map A)) (eqmap A (Map_of_alist (alist_of_Map m)) m). - Proof. - Unfold eqmap. 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 : (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 : (M:Set) (neutral:M) (op:M->M->M) - ((a,b,c:M) (op (op a b) c)=(op a (op b c))) -> - ((a:M) (op neutral a)=a) -> - (f:ad->A->M) (l,l':alist) - (fold_right [r:ad*A][m:M] let (a,y)=r in (op (f a y) m) neutral - (aapp l l'))= - (op (fold_right [r:ad*A][m:M] let (a,y)=r in (op (f a y) m) neutral l) - (fold_right [r:ad*A][m:M] let (a,y)=r in (op (f a y) m) neutral l')) -. - Proof. - Induction l. Simpl. Intro. Rewrite H0. Reflexivity. - Intros r l0 H1 l'. Elim r. Intros a y. Simpl. Rewrite H. Rewrite (H1 l'). Reflexivity. - Qed. - - Lemma MapFold_as_fold_1 : (M:Set) (neutral:M) (op:M->M->M) - ((a,b,c:M) (op (op a b) c)=(op a (op b c))) -> - ((a:M) (op neutral a)=a) -> - ((a:M) (op a neutral)=a) -> - (f:ad->A->M) (m:(Map A)) (pf:ad->ad) - (MapFold1 M neutral op f pf m)= - (fold_right [r:(ad*A)][m:M] let (a,y)=r in (op (f a y) m) neutral - (MapFold1 alist anil aapp [a:ad;y:A] (acons (pair ? ? -a y) anil) pf m)). - Proof. - Induction m. Trivial. - Intros. Simpl. Rewrite H1. Reflexivity. - Intros. Simpl. Rewrite (fold_right_aapp M neutral op H H0 f). - Rewrite (H2 [a0:ad](pf (ad_double a0))). Rewrite (H3 [a0:ad](pf (ad_double_plus_un a0))). - Reflexivity. - Qed. - - Lemma MapFold_as_fold : (M:Set) (neutral:M) (op:M->M->M) - ((a,b,c:M) (op (op a b) c)=(op a (op b c))) -> - ((a:M) (op neutral a)=a) -> - ((a:M) (op a neutral)=a) -> - (f:ad->A->M) (m:(Map A)) - (MapFold M neutral op f m)= - (fold_right [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 [a0:ad]a0). - Qed. - - Lemma alist_MapMerge_semantics : (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. 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 : (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. 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 A). - 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 : (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. 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/theories7/IntMap/Maplists.v b/theories7/IntMap/Maplists.v deleted file mode 100644 index f01ee3d8..00000000 --- a/theories7/IntMap/Maplists.v +++ /dev/null @@ -1,399 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* false - | (cons a' l') => (orb (ad_eq a a') (ad_in_list a l')) - end. - - Fixpoint ad_list_stutters [l:(list ad)] : bool := - Cases l of - nil => false - | (cons a l') => (orb (ad_in_list a l') (ad_list_stutters l')) - end. - - Lemma ad_in_list_forms_circuit : (x:ad) (l:(list ad)) (ad_in_list x l)=true -> - {l1 : (list ad) & {l2 : (list ad) | l=(app l1 (cons x l2))}}. - Proof. - Induction l. Intro. Discriminate H. - Intros. Elim (sumbool_of_bool (ad_eq x a)). Intro H1. Simpl in H0. Split with (nil ad). - Split with l0. Rewrite (ad_eq_complete ? ? H1). Reflexivity. - Intro H2. Simpl in H0. Rewrite H2 in H0. Simpl in H0. Elim (H H0). Intros l'1 H3. - Split with (cons a l'1). Elim H3. Intros l2 H4. Split with l2. Rewrite H4. Reflexivity. - Qed. - - Lemma ad_list_stutters_has_circuit : (l:(list ad)) (ad_list_stutters l)=true -> - {x:ad & {l0 : (list ad) & {l1 : (list ad) & {l2 : (list ad) | - l=(app l0 (cons x (app l1 (cons x l2))))}}}}. - Proof. - Induction l. Intro. Discriminate H. - Intros. Simpl in H0. Elim (orb_true_elim ? ? H0). Intro H1. Split with a. - Split with (nil ad). Simpl. 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 (cons 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 := - Cases l of - nil => (M0 unit) - | (cons a l') => (MapPut ? (Elems l') a tt) - end. - - Lemma Elems_canon : (l:(list ad)) (mapcanon ? (Elems l)). - Proof. - Induction l. Exact (M0_canon unit). - Intros. Simpl. Apply MapPut_canon. Assumption. - Qed. - - Lemma Elems_app : (l,l':(list ad)) (Elems (app l l'))=(FSetUnion (Elems l) (Elems l')). - Proof. - Induction l. Trivial. - Intros. Simpl. Rewrite (MapPut_as_Merge_c unit (Elems l0)). - Rewrite (MapPut_as_Merge_c unit (Elems (app l0 l'))). - Change (FSetUnion (Elems (app l0 l')) (M1 unit a tt)) - =(FSetUnion (FSetUnion (Elems l0) (M1 unit a tt)) (Elems l')). - 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 : (l:(list ad)) (Elems (rev l))=(Elems l). - Proof. - Induction l. Trivial. - Intros. Simpl. Rewrite Elems_app. Simpl. Rewrite (MapPut_as_Merge_c unit (Elems l0)). - Rewrite H. Reflexivity. - Apply Elems_canon. - Qed. - - Lemma ad_in_elems_in_list : (l:(list ad)) (a:ad) (in_FSet a (Elems l))=(ad_in_list a l). - Proof. - Induction l. Trivial. - Simpl. Unfold in_FSet. Intros. Rewrite (in_dom_put ? (Elems l0) a tt a0). - Rewrite (H a0). Reflexivity. - Qed. - - Lemma ad_list_not_stutters_card : (l:(list ad)) (ad_list_stutters l)=false -> - (length l)=(MapCard ? (Elems l)). - Proof. - Induction l. Trivial. - Simpl. 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 : (l:(list ad)) (le (MapCard ? (Elems l)) (length l)). - Proof. - Induction l. Trivial. - Intros. Simpl. Apply le_trans with m:=(S (MapCard ? (Elems l0))). Apply MapCard_Put_ub. - Apply le_n_S. Assumption. - Qed. - - Lemma ad_list_stutters_card : (l:(list ad)) (ad_list_stutters l)=true -> - (lt (MapCard ? (Elems l)) (length l)). - Proof. - Induction l. Intro. Discriminate H. - Intros. Simpl. 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 : (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 (lt (MapCard ? (Elems l)) (length l)). Intro. Rewrite H in H1. Elim (lt_n_n ? H1). - Exact (ad_list_stutters_card ? H0). - Trivial. - Qed. - - Lemma ad_list_stutters_card_conv : (l:(list ad)) (lt (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_n_n ? H). - Qed. - - Lemma ad_in_list_l : (l,l':(list ad)) (a:ad) (ad_in_list a l)=true -> - (ad_in_list a (app l l'))=true. - Proof. - Induction l. Intros. Discriminate H. - Intros. Simpl. 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 : (l,l':(list ad)) (ad_list_stutters l)=true -> - (ad_list_stutters (app l l'))=true. - Proof. - Induction l. Intros. Discriminate H. - Intros. Simpl. 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 : (l,l':(list ad)) (a:ad) (ad_in_list a l')=true -> - (ad_in_list a (app l l'))=true. - Proof. - Induction l. Trivial. - Intros. Simpl. Rewrite (H l' a0 H0). Apply orb_b_true. - Qed. - - Lemma ad_list_stutters_app_r : (l,l':(list ad)) (ad_list_stutters l')=true -> - (ad_list_stutters (app l l'))=true. - Proof. - Induction l. Trivial. - Intros. Simpl. Rewrite (H l' H0). Apply orb_b_true. - Qed. - - Lemma ad_list_stutters_app_conv_l : (l,l':(list ad)) (ad_list_stutters (app 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 : (l,l':(list ad)) (ad_list_stutters (app 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 : (l,l':(list ad)) (x:ad) (ad_in_list x (app l (cons x l')))=true. - Proof. - Induction l. Simpl. Intros. Rewrite (ad_eq_correct x). Reflexivity. - Intros. Simpl. Rewrite (H l' x). Apply orb_b_true. - Qed. - - Lemma ad_in_list_app : (l,l':(list ad)) (x:ad) - (ad_in_list x (app l l'))=(orb (ad_in_list x l) (ad_in_list x l')). - Proof. - Induction l. Trivial. - Intros. Simpl. Rewrite <- orb_assoc. Rewrite (H l' x). Reflexivity. - Qed. - - Lemma ad_in_list_rev : (l:(list ad)) (x:ad) - (ad_in_list x (rev l))=(ad_in_list x l). - Proof. - Induction l. Trivial. - Intros. Simpl. Rewrite ad_in_list_app. Rewrite (H x). Simpl. Rewrite orb_b_false. - Apply orb_sym. - Qed. - - Lemma ad_list_has_circuit_stutters : (l0,l1,l2:(list ad)) (x:ad) - (ad_list_stutters (app l0 (cons x (app l1 (cons x l2)))))=true. - Proof. - Induction l0. Simpl. Intros. Rewrite (ad_in_list_app_1 l1 l2 x). Reflexivity. - Intros. Simpl. Rewrite (H l1 l2 x). Apply orb_b_true. - Qed. - - Lemma ad_list_stutters_prev_l : (l,l':(list ad)) (x:ad) (ad_in_list x l)=true -> - (ad_list_stutters (app l (cons 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. Apply ad_list_has_circuit_stutters. - Qed. - - Lemma ad_list_stutters_prev_conv_l : (l,l':(list ad)) (x:ad) - (ad_list_stutters (app l (cons 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 : (l,l':(list ad)) (x:ad) (ad_in_list x l')=true -> - (ad_list_stutters (app l (cons 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 : (l,l':(list ad)) (x:ad) - (ad_list_stutters (app l (cons 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 : (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 : (l,l':(list ad)) (length (app l l'))=(plus (length l) (length l')). - Proof. - Induction l. Trivial. - Intros. Simpl. Rewrite (H l'). Reflexivity. - Qed. - - Lemma ad_list_stutters_permute : (l,l':(list ad)) - (ad_list_stutters (app l l'))=(ad_list_stutters (app 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_sym. - Qed. - - Lemma ad_list_rev_length : (l:(list ad)) (length (rev l))=(length l). - Proof. - Induction l. Trivial. - Intros. Simpl. Rewrite ad_list_app_length. Simpl. Rewrite H. Rewrite <- plus_Snm_nSm. - Rewrite <- plus_n_O. Reflexivity. - Qed. - - Lemma ad_list_stutters_rev : (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 : (l,l':(list ad)) (x:ad) - (app (rev l) (cons x l'))=(app (rev (cons x l)) l'). - Proof. - Induction l. Trivial. - Intros. Simpl. Rewrite (app_ass (rev l0) (cons a (nil ad)) (cons x l')). Simpl. - Rewrite (H (cons x l') a). Simpl. - Rewrite (app_ass (rev l0) (cons a (nil ad)) (cons x (nil ad))). Simpl. - Rewrite app_ass. Simpl. Rewrite app_ass. Reflexivity. - Qed. - - Section ListOfDomDef. - - Variable A : Set. - - Definition ad_list_of_dom := - (MapFold A (list ad) (nil ad) (!app ad) [a:ad][_:A] (cons a (nil ad))). - - Lemma ad_in_list_of_dom_in_dom : (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. Intros. - Rewrite (MapFold_distr_l A (list ad) (nil ad) (!app ad) bool false orb - ad [a:ad][l:(list ad)](ad_in_list a l) [c:ad](refl_equal ? ?) - ad_in_list_app [a0:ad][_:A](cons a0 (nil ad)) m a). - Simpl. Rewrite (MapFold_orb A [a0:ad][_:A](orb (ad_eq a a0) false) m). - Elim (option_sum ? (MapSweep A [a0:ad][_:A](orb (ad_eq a a0) false) m)). Intro H. Elim H. - Intro r. Elim r. Intros a0 y H0. Rewrite H0. Unfold in_dom. - Elim (orb_prop ? ? (MapSweep_semantics_1 ? ? ? ? ? H0)). Intro H1. - Rewrite (ad_eq_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 (ad_eq_correct a) in H2. Discriminate H2. - Exact (sym_eq ? ? ?). - Qed. - - Lemma Elems_of_list_of_dom : - (m:(Map A)) (eqmap unit (Elems (ad_list_of_dom m)) (MapDom A m)). - Proof. - Unfold eqmap eqm. 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 : (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 : (m:(Map A)) (pf:ad->ad) - (length (MapFold1 A (list ad) (nil ad) (app 1!ad) [a:ad][_:A](cons a (nil ad)) pf m))= - (MapCard A m). - Proof. - Induction m; Try Trivial. Simpl. Intros. Rewrite ad_list_app_length. - Rewrite (H [a0:ad](pf (ad_double a0))). Rewrite (H0 [a0:ad](pf (ad_double_plus_un a0))). - Reflexivity. - Qed. - - Lemma ad_list_of_dom_card : (m:(Map A)) (length (ad_list_of_dom m))=(MapCard A m). - Proof. - Exact [m:(Map A)](ad_list_of_dom_card_1 m [a:ad]a). - Qed. - - Lemma ad_list_of_dom_not_stutters : - (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 : (A:Set) - (m:(Map A)) (pf:ad->ad) - (MapFold1 A (list ad) (nil ad) (app 1!ad) - [a:ad][_:A](cons a (nil ad)) pf m)= - (MapFold1 unit (list ad) (nil ad) (app 1!ad) - [a:ad][_:unit](cons a (nil ad)) pf (MapDom A m)). - Proof. - Induction m; Try Trivial. Simpl. Intros. Rewrite (H [a0:ad](pf (ad_double a0))). - Rewrite (H0 [a0:ad](pf (ad_double_plus_un a0))). Reflexivity. - Qed. - - Lemma ad_list_of_dom_Dom : (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 [a0:ad]a0). - Qed. - -End MapLists. diff --git a/theories7/IntMap/Mapsubset.v b/theories7/IntMap/Mapsubset.v deleted file mode 100644 index c0b1cccd..00000000 --- a/theories7/IntMap/Mapsubset.v +++ /dev/null @@ -1,554 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* (in_dom B a m')=true. - - Definition MapSubset_1 := [m:(Map A)] [m':(Map B)] - Cases (MapSweep A [a:ad][_:A] (negb (in_dom B a m')) m) of - 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 : (m:(Map A)) (m':(Map B)) - (MapSubset m m') -> (MapSubset_1 m m')=true. - Proof. - Unfold MapSubset MapSubset_1. Intros. - Elim (option_sum ? (MapSweep A [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 : (m:(Map A)) (m':(Map B)) - (MapSubset_1 m m')=true -> (MapSubset m m'). - Proof. - Unfold MapSubset MapSubset_1. Unfold 2 in_dom. Intros. Elim (option_sum ? (MapGet A m a)). - Intro H1. Elim H1. Intros y H2. - Elim (option_sum ? (MapSweep A [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 : - (m:(Map A)) (eqmap A m (M0 A)) -> (a:ad) (in_dom ? a m)=false. - Proof. - Unfold eqmap eqm in_dom. Intros. Rewrite (H a). Reflexivity. - Qed. - - Lemma map_dom_empty_2 : - (m:(Map A)) ((a:ad) (in_dom ? a m)=false) -> (eqmap A m (M0 A)). - Proof. - Unfold eqmap eqm in_dom. Intros. - Cut (Cases (MapGet A m a) of NONE => false | (SOME _) => true end)=false. - Case (MapGet A m a). Trivial. - Intros. Discriminate H0. - Exact (H a). - Qed. - - Lemma MapSubset_imp_2 : - (m:(Map A)) (m':(Map B)) (MapSubset m m') -> (MapSubset_2 m m'). - Proof. - Unfold MapSubset MapSubset_2. 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 : - (m:(Map A)) (m':(Map B)) (MapSubset_2 m m') -> (MapSubset m m'). - Proof. - Unfold MapSubset MapSubset_2. 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. - - Variable A, B, C : Set. - - Lemma MapSubset_refl : (m:(Map A)) (MapSubset A A m m). - Proof. - Unfold MapSubset. Trivial. - Qed. - - Lemma MapSubset_antisym : (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. 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. 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. Rewrite H3. Reflexivity. - Intro H2. Rewrite H2. Exact H1. - Qed. - - Lemma MapSubset_trans : (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. Intros. Apply H0. Apply H. Assumption. - Qed. - -End MapSubsetOrder. - -Section FSubsetOrder. - - Lemma FSubset_refl : (s:FSet) (MapSubset ? ? s s). - Proof. - Exact (MapSubset_refl unit). - Qed. - - Lemma FSubset_antisym : (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 : (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. - - Variable A, B : Set. - - Lemma MapSubset_Dom_1 : (m:(Map A)) (m':(Map B)) - (MapSubset A B m m') -> (MapSubset unit unit (MapDom A m) (MapDom B m')). - Proof. - Unfold MapSubset. 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 : (m:(Map A)) (m':(Map B)) - (MapSubset unit unit (MapDom A m) (MapDom B m')) -> (MapSubset A B m m'). - Proof. - Unfold MapSubset. 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. Rewrite H3. Reflexivity. - Intro H1. Rewrite H1 in H0. Discriminate H0. - Qed. - - Lemma MapSubset_1_Dom : (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 : (m:(Map A)) (a:ad) (y:A) (MapSubset A A m (MapPut A m a y)). - Proof. - Unfold MapSubset. Intros. Rewrite in_dom_put. Rewrite H. Apply orb_b_true. - Qed. - - Lemma MapSubset_Put_mono : (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. 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 : - (m:(Map A)) (a:ad) (y:A) (MapSubset A A m (MapPut_behind A m a y)). - Proof. - Unfold MapSubset. Intros. Rewrite in_dom_put_behind. Rewrite H. Apply orb_b_true. - Qed. - - Lemma MapSubset_Put_behind_mono : (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. 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 : (m:(Map A)) (a:ad) (MapSubset A A (MapRemove A m a) m). - Proof. - Unfold MapSubset. Intros. Unfold MapSubset. Intros. Rewrite (in_dom_remove ? m a a0) in H. - Elim (andb_prop ? ? H). Trivial. - Qed. - - Lemma MapSubset_Remove_mono : (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. 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 : (m,m':(Map A)) (MapSubset A A m (MapMerge A m m')). - Proof. - Unfold MapSubset. Intros. Rewrite in_dom_merge. Rewrite H. Reflexivity. - Qed. - - Lemma MapSubset_Merge_r : (m,m':(Map A)) (MapSubset A A m' (MapMerge A m m')). - Proof. - Unfold MapSubset. Intros. Rewrite in_dom_merge. Rewrite H. Apply orb_b_true. - Qed. - - Lemma MapSubset_Merge_mono : (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. 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 : (m:(Map A)) (m':(Map B)) - (MapSubset A A (MapDomRestrTo A B m m') m). - Proof. - Unfold MapSubset. Intros. Rewrite (in_dom_restrto ? ? m m' a) in H. Elim (andb_prop ? ? H). - Trivial. - Qed. - - Lemma MapSubset_DomRestrTo_r: (m:(Map A)) (m':(Map B)) - (MapSubset A B (MapDomRestrTo A B m m') m'). - Proof. - Unfold MapSubset. Intros. Rewrite (in_dom_restrto ? ? m m' a) in H. Elim (andb_prop ? ? H). - Trivial. - Qed. - - Lemma MapSubset_ext : (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. - 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. - - Variable C, D : Set. - - Lemma MapSubset_DomRestrTo_mono : - (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. 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 : (m:(Map A)) (m':(Map B)) - (MapSubset A A (MapDomRestrBy A B m m') m). - Proof. - Unfold MapSubset. Intros. Rewrite (in_dom_restrby ? ? m m' a) in H. Elim (andb_prop ? ? H). - Trivial. - Qed. - - Lemma MapSubset_DomRestrBy_mono : - (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. 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. - - Variable A, B : Set. - - Definition MapDisjoint := [m:(Map A)] [m':(Map B)] - (a:ad) (in_dom A a m)=true -> (in_dom B a m')=true -> False. - - Definition MapDisjoint_1 := [m:(Map A)] [m':(Map B)] - Cases (MapSweep A [a:ad][_:A] (in_dom B a m') m) of - 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 : (m:(Map A)) (m':(Map B)) - (MapDisjoint m m') -> (MapDisjoint_1 m m')=true. - Proof. - Unfold MapDisjoint MapDisjoint_1. Intros. - Elim (option_sum ? (MapSweep A [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 1 in_dom 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 : (m:(Map A)) (m':(Map B)) - (MapDisjoint_1 m m')=true -> (MapDisjoint m m'). - Proof. - Unfold MapDisjoint MapDisjoint_1. Intros. - Elim (option_sum ? (MapSweep A [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 : (m:(Map A)) (m':(Map B)) (MapDisjoint m m') -> - (MapDisjoint_2 m m'). - Proof. - Unfold MapDisjoint MapDisjoint_2. Unfold eqmap eqm. 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 1 in_dom in H0. - Elim (option_sum ? (MapGet B m' a)). Intro H3. Elim H3. Intros y' H4. Unfold 1 in_dom 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 : (m:(Map A)) (m':(Map B)) (MapDisjoint_2 m m') -> - (MapDisjoint m m'). - Proof. - Unfold MapDisjoint MapDisjoint_2. Unfold eqmap eqm. 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 A). 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 : (m:(Map B)) (MapDisjoint (M0 A) m). - Proof. - Unfold MapDisjoint in_dom. Intros. Discriminate H. - Qed. - - Lemma Map_disjoint_M0 : (m:(Map A)) (MapDisjoint m (M0 B)). - Proof. - Unfold MapDisjoint in_dom. Intros. Discriminate H0. - Qed. - -End MapDisjointDef. - -Section MapDisjointExtra. - - Variable A, B : Set. - - Lemma MapDisjoint_ext : (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. - 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 : (m,m':(Map A)) (MapDisjoint A A m m') -> - (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. 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. Rewrite andb_b_true. Reflexivity. - Qed. - - Lemma MapDisjoint_M2_l : (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. 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 (ad_double a)). - Rewrite (MapGet_M2_bit_0_0 ? (ad_double a) (ad_double_bit_0 a) m0 m1). - Rewrite (ad_double_div_2 a). Rewrite H3. Reflexivity. - Rewrite (MapGet_M2_bit_0_0 ? (ad_double a) (ad_double_bit_0 a) m2 m3). - Rewrite (ad_double_div_2 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 : (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. 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 (ad_double_plus_un a)). - Rewrite (MapGet_M2_bit_0_1 ? (ad_double_plus_un a) (ad_double_plus_un_bit_0 a) m0 m1). - Rewrite (ad_double_plus_un_div_2 a). Rewrite H3. Reflexivity. - Rewrite (MapGet_M2_bit_0_1 ? (ad_double_plus_un a) (ad_double_plus_un_bit_0 a) m2 m3). - Rewrite (ad_double_plus_un_div_2 a). Rewrite H5. Reflexivity. - Intro H4. Rewrite H4 in H1. Discriminate H1. - Intro H2. Rewrite H2 in H0. Discriminate H0. - Qed. - - Lemma MapDisjoint_M2 : (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. Intros. Elim (sumbool_of_bool (ad_bit_0 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 (ad_div_2 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 (ad_div_2 a) H1 H2). - Qed. - - Lemma MapDisjoint_M1_l : (m:(Map A)) (a:ad) (y:B) - (MapDisjoint B A (M1 B a y) m) -> (in_dom A a m)=false. - Proof. - Unfold MapDisjoint. 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 : (m:(Map A)) (a:ad) (y:B) - (MapDisjoint A B m (M1 B a y)) -> (in_dom A a m)=false. - Proof. - Unfold MapDisjoint. 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 : (m:(Map A)) (a:ad) (y:B) - (in_dom A a m)=false -> (MapDisjoint B A (M1 B a y) m). - Proof. - Unfold MapDisjoint. 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 : (m:(Map A)) (a:ad) (y:B) - (in_dom A a m)=false -> (MapDisjoint A B m (M1 B a y)). - Proof. - Unfold MapDisjoint. Intros. Rewrite (in_dom_M1_2 B a a0 y H1) in H. Rewrite H0 in H. - Discriminate H. - Qed. - - Lemma MapDisjoint_sym : (m:(Map A)) (m':(Map B)) - (MapDisjoint A B m m') -> (MapDisjoint B A m' m). - Proof. - Unfold MapDisjoint. Intros. Exact (H ? H1 H0). - Qed. - - Lemma MapDisjoint_empty : (m:(Map A)) (MapDisjoint A A m m) -> (eqmap A m (M0 A)). - Proof. - Unfold eqmap eqm. Intros. Rewrite <- (MapDomRestrTo_idempotent A m a). - Exact (MapDisjoint_imp_2 A A m m H a). - Qed. - - Lemma MapDelta_disjoint : (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 : (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. 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 : (m,m':(Map A)) - (MapDisjoint A A (MapDelta A m m') (MapDomRestrTo A A m m')). - Proof. - Unfold MapDisjoint. 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 : (m,m':(Map A)) - (MapDisjoint A A (MapDelta A m m') (MapDomRestrTo A A m' m)). - Proof. - Unfold MapDisjoint. 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 : (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. Intros. Exact (H1 ? (H ? H2) (H0 ? H3)). - Qed. - - Lemma MapSubset_Disjoint_l : (m:(Map A)) (m':(Map B)) (m'':(Map C)) - (MapSubset ? ? m m') -> (MapDisjoint ? ? m' m'') -> - (MapDisjoint ? ? m m''). - Proof. - Unfold MapSubset MapDisjoint. Intros. Exact (H0 ? (H ? H1) H2). - Qed. - - Lemma MapSubset_Disjoint_r : (m:(Map A)) (m'':(Map C)) (m''':(Map D)) - (MapSubset ? ? m'' m''') -> (MapDisjoint ? ? m m''') -> - (MapDisjoint ? ? m m''). - Proof. - Unfold MapSubset MapDisjoint. Intros. Exact (H0 ? H1 (H ? H2)). - Qed. - -End MapDisjointExtra. -- cgit v1.2.3