diff options
Diffstat (limited to 'theories/IntMap')
| -rw-r--r-- | theories/IntMap/Adalloc.v | 438 | ||||
| -rw-r--r-- | theories/IntMap/Addec.v | 248 | ||||
| -rw-r--r-- | theories/IntMap/Addr.v | 637 | ||||
| -rw-r--r-- | theories/IntMap/Adist.v | 397 | ||||
| -rw-r--r-- | theories/IntMap/Allmaps.v | 2 | ||||
| -rw-r--r-- | theories/IntMap/Fset.v | 481 | ||||
| -rw-r--r-- | theories/IntMap/Lsort.v | 1007 | ||||
| -rw-r--r-- | theories/IntMap/Map.v | 1415 | ||||
| -rw-r--r-- | theories/IntMap/Mapaxioms.v | 909 | ||||
| -rw-r--r-- | theories/IntMap/Mapc.v | 673 | ||||
| -rw-r--r-- | theories/IntMap/Mapcanon.v | 569 | ||||
| -rw-r--r-- | theories/IntMap/Mapcard.v | 1316 | ||||
| -rw-r--r-- | theories/IntMap/Mapfold.v | 533 | ||||
| -rw-r--r-- | theories/IntMap/Mapiter.v | 865 | ||||
| -rw-r--r-- | theories/IntMap/Maplists.v | 562 | ||||
| -rw-r--r-- | theories/IntMap/Mapsubset.v | 740 |
16 files changed, 5803 insertions, 4989 deletions
diff --git a/theories/IntMap/Adalloc.v b/theories/IntMap/Adalloc.v index 5dcd41c84a..550633a212 100644 --- a/theories/IntMap/Adalloc.v +++ b/theories/IntMap/Adalloc.v @@ -7,333 +7,359 @@ (***********************************************************************) (*i $Id$ i*) -Require Bool. -Require Sumbool. -Require ZArith. -Require Arith. -Require Addr. -Require Adist. -Require Addec. -Require Map. -Require Fset. +Require Import Bool. +Require Import Sumbool. +Require Import ZArith. +Require Import Arith. +Require Import Addr. +Require Import Adist. +Require Import Addec. +Require Import Map. +Require Import Fset. Section AdAlloc. Variable A : Set. - Definition nat_of_ad := [a:ad] Cases a of - ad_z => 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 + Definition nat_of_ad (a:ad) := + match a with + | ad_z => 0 + | ad_x p => nat_of_P p end. - Lemma nat_le_correct : (m,n:nat) (le m n) -> (nat_le m n)=true. + Fixpoint nat_le (m:nat) : nat -> bool := + match m with + | O => fun _:nat => true + | S m' => + fun n:nat => match n with + | O => false + | S n' => nat_le m' n' + end + end. + + Lemma nat_le_correct : forall m n:nat, 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. + induction m as [| m IHm]. trivial. + destruct n. intro H. elim (le_Sn_O _ H). + intros. simpl in |- *. apply IHm. apply le_S_n. assumption. Qed. - Lemma nat_le_complete : (m,n:nat) (nat_le m n)=true -> (le m n). + Lemma nat_le_complete : forall m n:nat, nat_le m n = true -> m <= n. Proof. - NewInduction m. Trivial with arith. - NewDestruct n. Intro H. Discriminate H. - Auto with arith. + induction m. trivial with arith. + destruct 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. + Lemma nat_le_correct_conv : forall m n:nat, 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. + intros. elim (sumbool_of_bool (nat_le n m)). intro H0. + elim (lt_irrefl _ (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). + Lemma nat_le_complete_conv : forall m n:nat, nat_le n m = false -> m < n. Proof. - Intros. Elim (le_or_lt n m). Intro. Conditional Trivial Rewrite nat_le_correct in H. Discriminate H. - Trivial. + 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. + Definition ad_of_nat (n:nat) := + match n with + | O => ad_z + | S n' => ad_x (P_of_succ_nat n') + end. - Lemma ad_of_nat_of_ad : (a:ad) (ad_of_nat (nat_of_ad a))=a. + Lemma ad_of_nat_of_ad : forall 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. + destruct a as [| p]. reflexivity. + simpl in |- *. elim (ZL4 p). intros n H. rewrite H. simpl in |- *. rewrite <- nat_of_P_o_P_of_succ_nat_eq_succ in H. + rewrite nat_of_P_inj with (1 := H). reflexivity. Qed. - Lemma nat_of_ad_of_nat : (n:nat) (nat_of_ad (ad_of_nat n))=n. + Lemma nat_of_ad_of_nat : forall n:nat, nat_of_ad (ad_of_nat n) = n. Proof. - NewInduction n. Trivial. - Intros. Simpl. Apply bij1. + induction n. trivial. + intros. simpl in |- *. apply nat_of_P_o_P_of_succ_nat_eq_succ. Qed. - Definition ad_le := [a,b:ad] (nat_le (nat_of_ad a) (nat_of_ad b)). + 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. + Lemma ad_le_refl : forall a:ad, ad_le a a = true. Proof. - Intro. Unfold ad_le. Apply nat_le_correct. Apply le_n. + intro. unfold ad_le in |- *. 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. + Lemma ad_le_antisym : + forall 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. + unfold ad_le in |- *. 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. + Lemma ad_le_trans : + forall 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. + unfold ad_le in |- *. 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. + Lemma ad_le_lt_trans : + forall 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. + unfold ad_le in |- *. 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. + Lemma ad_lt_le_trans : + forall 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. + unfold ad_le in |- *. 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. + Lemma ad_lt_trans : + forall 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. + unfold ad_le in |- *. 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. + Lemma ad_lt_le_weak : forall 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. + unfold ad_le in |- *. 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. + 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}. + Lemma ad_min_choice : forall 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. + unfold ad_min in |- *. 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. + Lemma ad_min_le_1 : forall 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. + unfold ad_min in |- *. 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. + Lemma ad_min_le_2 : forall 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. + unfold ad_min in |- *. 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. + Lemma ad_min_le_3 : + forall 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. + unfold ad_min in |- *. 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. + Lemma ad_min_le_4 : + forall 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. + unfold ad_min in |- *. 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. + Lemma ad_min_le_5 : + forall 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. + 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. + Lemma ad_min_lt_3 : + forall 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. + unfold ad_min in |- *. 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. + Lemma ad_min_lt_4 : + forall 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. + unfold ad_min in |- *. 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))) + Fixpoint ad_alloc_opt (m:Map A) : ad := + match m with + | M0 => ad_z + | M1 a _ => if ad_eq a ad_z then ad_x 1 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). + Lemma ad_alloc_opt_allocates_1 : + forall 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. + induction m as [| a| m0 H m1 H0]. reflexivity. + simpl in |- *. 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))) + in |- *. + 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. + Lemma ad_alloc_opt_allocates : + forall 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. + unfold in_dom in |- *. intro. rewrite (ad_alloc_opt_allocates_1 m). reflexivity. Qed. (** Moreover, this is optimal: all addresses below [(ad_alloc_opt m)] are in [dom m]: *) - Lemma nat_of_ad_double : (a:ad) (nat_of_ad (ad_double a))=(mult (2) (nat_of_ad a)). + Lemma nat_of_ad_double : + forall a:ad, nat_of_ad (ad_double a) = 2 * nat_of_ad a. Proof. - NewDestruct a as [|p]. Trivial. - Exact (convert_xO p). + destruct a as [| p]. trivial. + exact (nat_of_P_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))). + Lemma nat_of_ad_double_plus_un : + forall a:ad, nat_of_ad (ad_double_plus_un a) = S (2 * nat_of_ad a). Proof. - NewDestruct a as [|p]. Trivial. - Exact (convert_xI p). + destruct a as [| p]. trivial. + exact (nat_of_P_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. + Lemma ad_le_double_mono : + forall 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. + unfold ad_le in |- *. intros. rewrite nat_of_ad_double. rewrite nat_of_ad_double. apply nat_le_correct. + simpl in |- *. apply plus_le_compat. apply nat_le_complete. assumption. + apply plus_le_compat. 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. + Lemma ad_le_double_plus_un_mono : + forall 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. + unfold ad_le in |- *. intros. rewrite nat_of_ad_double_plus_un. rewrite nat_of_ad_double_plus_un. + apply nat_le_correct. apply le_n_S. simpl in |- *. apply plus_le_compat. apply nat_le_complete. + assumption. + apply plus_le_compat. 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. + Lemma ad_le_double_mono_conv : + forall 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. + unfold ad_le in |- *. intros a b. rewrite nat_of_ad_double. rewrite nat_of_ad_double. intro. + apply nat_le_correct. apply (mult_S_le_reg_l 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. + Lemma ad_le_double_plus_un_mono_conv : + forall 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. + unfold ad_le in |- *. intros a b. rewrite nat_of_ad_double_plus_un. rewrite nat_of_ad_double_plus_un. + intro. apply nat_le_correct. apply (mult_S_le_reg_l 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. + Lemma ad_lt_double_mono : + forall 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. + 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. + Lemma ad_lt_double_plus_un_mono : + forall 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. + 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. + Lemma ad_lt_double_mono_conv : + forall 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. + 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. + Lemma ad_lt_double_plus_un_mono_conv : + forall 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. + 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)}. + Lemma ad_alloc_opt_optimal_1 : + forall (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. + induction m as [| a y| m0 H m1 H0]. simpl in |- *. unfold ad_le in |- *. simpl in |- *. intros. discriminate H. + simpl in |- *. 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. + Lemma ad_alloc_opt_optimal : + forall (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. + intros. unfold in_dom in |- *. 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/theories/IntMap/Addec.v b/theories/IntMap/Addec.v index f0ec7b37d2..5ad2ea852b 100644 --- a/theories/IntMap/Addec.v +++ b/theories/IntMap/Addec.v @@ -9,171 +9,185 @@ (** Equality on adresses *) -Require Bool. -Require Sumbool. -Require ZArith. -Require Addr. - -Fixpoint ad_eq_1 [p1,p2:positive] : bool := - Cases p1 p2 of - xH xH => 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 +Require Import Bool. +Require Import Sumbool. +Require Import ZArith. +Require Import Addr. + +Fixpoint ad_eq_1 (p1 p2:positive) {struct p2} : bool := + match p1, p2 with + | xH, xH => 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 +Definition ad_eq (a a':ad) := + match a, a' with + | 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. +Lemma ad_eq_correct : forall a:ad, ad_eq a a = true. Proof. - NewDestruct a; Trivial. - NewInduction p; Trivial. + destruct a; trivial. + induction 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. +Lemma ad_eq_complete : forall a a':ad, ad_eq a a' = true -> a = a'. +Proof. + destruct a. destruct a'; trivial. destruct p. + discriminate 1. + discriminate 1. + discriminate 1. + destruct a'. intros. discriminate H. + unfold ad_eq in |- *. intros. cut (p = p0). intros. rewrite H0. reflexivity. + generalize dependent p0. + induction p as [p IHp| p IHp| ]. destruct p0; intro H. + rewrite (IHp p0). reflexivity. + exact H. + discriminate H. + discriminate H. + destruct p0; intro H. discriminate H. + rewrite (IHp p0 H). reflexivity. + discriminate H. + destruct p0 as [p| p| ]; 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. +Lemma ad_eq_comm : forall a a':ad, ad_eq a a' = ad_eq a' a. +Proof. + intros. cut (forall b b':bool, ad_eq a a' = b -> ad_eq a' a = b' -> b = b'). + intros. apply H. reflexivity. + reflexivity. + destruct 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. + destruct 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. +Lemma ad_xor_eq_true : + forall 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. + 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. + forall (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. + 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. +Lemma ad_bit_0_1_not_double : + forall a:ad, + ad_bit_0 a = true -> forall 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. + 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. +Lemma ad_not_div_2_not_double : + forall 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. + 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. +Lemma ad_bit_0_0_not_double_plus_un : + forall a:ad, + ad_bit_0 a = false -> forall 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. + 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. +Lemma ad_not_div_2_not_double_plus_un : + forall 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. + 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. + forall 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. + 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. + forall 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. + 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. +Lemma ad_div_neq : + forall 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. + 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'. +Lemma ad_div_bit_eq : + forall 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. + intros. apply ad_faithful. unfold eqf in |- *. destruct 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. +Lemma ad_div_bit_neq : + forall 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. + 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. +Lemma ad_neq : + forall 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. + 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)}. +Lemma ad_double_or_double_plus_un : + forall 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. + 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.
\ No newline at end of file diff --git a/theories/IntMap/Addr.v b/theories/IntMap/Addr.v index cff8936b6f..fcab8b565c 100644 --- a/theories/IntMap/Addr.v +++ b/theories/IntMap/Addr.v @@ -9,448 +9,483 @@ (** Representation of adresses by the [positive] type of binary numbers *) -Require Bool. -Require ZArith. +Require Import Bool. +Require Import ZArith. Inductive ad : Set := - ad_z : ad + | ad_z : ad | ad_x : positive -> 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 +Lemma ad_sum : forall a:ad, {p : positive | a = ad_x p} + {a = ad_z}. +Proof. + destruct a; auto. + left; exists p; trivial. +Qed. + +Fixpoint p_xor (p p2:positive) {struct p} : ad := + match p with + | xH => + match p2 with + | xH => ad_z + | xO p'2 => ad_x (xI p'2) + | xI p'2 => ad_x (xO p'2) + end + | xO p' => + match p2 with + | xH => ad_x (xI p') + | xO p'2 => + match p_xor p' p'2 with + | ad_z => ad_z + | ad_x p'' => ad_x (xO p'') + end + | xI p'2 => + match p_xor p' p'2 with + | ad_z => ad_x 1 + | ad_x p'' => ad_x (xI p'') + end + end + | xI p' => + match p2 with + | xH => ad_x (xO p') + | xO p'2 => + match p_xor p' p'2 with + | ad_z => ad_x 1 + | ad_x p'' => ad_x (xI p'') + end + | xI p'2 => + match p_xor p' p'2 with + | 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 +Definition ad_xor (a a':ad) := + match a with + | ad_z => a' + | ad_x p => match a' with + | 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. +Lemma ad_xor_neutral_left : forall a:ad, ad_xor ad_z a = a. Proof. - Trivial. + trivial. Qed. -Lemma ad_xor_neutral_right : (a:ad) (ad_xor a ad_z)=a. +Lemma ad_xor_neutral_right : forall a:ad, ad_xor a ad_z = a. Proof. - NewDestruct a; Trivial. + destruct a; trivial. Qed. -Lemma ad_xor_comm : (a,a':ad) (ad_xor a a')=(ad_xor a' a). +Lemma ad_xor_comm : forall 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. + destruct a; destruct a'; simpl in |- *; auto. + generalize p0; clear p0; induction p as [p Hrecp| p Hrecp| ]; simpl in |- *; + auto. + destruct p0; simpl in |- *; trivial; intros. + rewrite Hrecp; trivial. + rewrite Hrecp; trivial. + destruct p0; simpl in |- *; trivial; intros. + rewrite Hrecp; trivial. + rewrite Hrecp; trivial. + destruct p0 as [p| p| ]; simpl in |- *; auto. Qed. -Lemma ad_xor_nilpotent : (a:ad) (ad_xor a a)=ad_z. +Lemma ad_xor_nilpotent : forall 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. + destruct a; trivial. + simpl in |- *. induction p as [p IHp| p IHp| ]; trivial. + simpl in |- *. rewrite IHp; reflexivity. + simpl in |- *. 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 +Fixpoint ad_bit_1 (p:positive) : nat -> bool := + match p with + | xH => fun n:nat => match n with + | O => true + | S _ => false + end + | xO p => + fun n:nat => match n with + | O => false + | S n' => ad_bit_1 p n' + end + | xI p => fun n:nat => match n with + | 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) +Definition ad_bit (a:ad) := + match a with + | ad_z => fun _:nat => false + | ad_x p => ad_bit_1 p end. -Definition eqf := [f,g:nat->bool] (n:nat) (f n)=(g n). +Definition eqf (f g:nat -> bool) := forall n:nat, f n = g n. -Lemma ad_faithful_1 : (a:ad) (eqf (ad_bit ad_z) (ad_bit a)) -> ad_z=a. +Lemma ad_faithful_1 : forall 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). + destruct a. trivial. + induction p as [p IHp| p IHp| ]; intro H. absurd (ad_z = ad_x p). discriminate. + exact (IHp (fun n:nat => H (S n))). + absurd (ad_z = ad_x p). discriminate. + exact (IHp (fun n:nat => H (S n))). + absurd (false = true). discriminate. + exact (H 0). Qed. -Lemma ad_faithful_2 : (a:ad) (eqf (ad_bit (ad_x xH)) (ad_bit a)) -> (ad_x xH)=a. +Lemma ad_faithful_2 : + forall a:ad, eqf (ad_bit (ad_x 1)) (ad_bit a) -> ad_x 1 = 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. + destruct a. intros. absurd (true = false). discriminate. + exact (H 0). + destruct p. intro H. absurd (ad_z = ad_x p). discriminate. + exact (ad_faithful_1 (ad_x p) (fun n:nat => H (S n))). + intros. absurd (true = false). discriminate. + exact (H 0). + 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. + forall (a:ad) (p:positive), + (forall 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). + destruct 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 in |- *. intro. unfold eqf in H0. rewrite H0. reflexivity. + case p. intros. absurd (false = true). discriminate. + exact (H0 0). + intros. rewrite (H p0 (fun n:nat => H0 (S n))). reflexivity. + intros. absurd (false = true). discriminate. + exact (H0 0). 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. + forall (a:ad) (p:positive), + (forall 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. + destruct 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 in |- *. intro. unfold eqf in H0. rewrite H0. reflexivity. + case p. intros. rewrite (H p0 (fun n:nat => H0 (S n))). reflexivity. + intros. absurd (true = false). discriminate. + exact (H0 0). + intros. absurd (ad_z = ad_x p0). discriminate. + cut (eqf (ad_bit (ad_x 1)) (ad_bit (ad_x (xI p0)))). + intro. exact (ad_faithful_1 (ad_x p0) (fun n:nat => H1 (S n))). + unfold eqf in |- *. unfold eqf in H0. intro. rewrite H0. reflexivity. Qed. -Lemma ad_faithful : (a,a':ad) (eqf (ad_bit a) (ad_bit a')) -> a=a'. +Lemma ad_faithful : forall 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. + destruct a. exact ad_faithful_1. + induction 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)). +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). +Lemma ad_xor_sem_1 : forall a':ad, ad_bit (ad_xor ad_z a') 0 = ad_bit a' 0. Proof. - Trivial. + trivial. Qed. -Lemma ad_xor_sem_2 : (a':ad) (ad_bit (ad_xor (ad_x xH) a') O)=(negb (ad_bit a' O)). +Lemma ad_xor_sem_2 : + forall a':ad, ad_bit (ad_xor (ad_x 1) a') 0 = negb (ad_bit a' 0). Proof. - Intro. Case a'. Trivial. - Simpl. Intro. - Case p; Trivial. + intro. case a'. trivial. + simpl in |- *. 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). + forall (p:positive) (a':ad), + ad_bit (ad_xor (ad_x (xO p)) a') 0 = ad_bit a' 0. Proof. - Intros. Case a'. Trivial. - Simpl. Intro. - Case p0; Trivial. Intro. - Case (p_xor p p1); Trivial. - Intro. Case (p_xor p p1); Trivial. + intros. case a'. trivial. + simpl in |- *. 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)). +Lemma ad_xor_sem_4 : + forall (p:positive) (a':ad), + ad_bit (ad_xor (ad_x (xI p)) a') 0 = negb (ad_bit a' 0). Proof. - Intros. Case a'. Trivial. - Simpl. Intro. Case p0; Trivial. Intro. - Case (p_xor p p1); Trivial. - Intro. - Case (p_xor p p1); Trivial. + intros. case a'. trivial. + simpl in |- *. 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. + forall a a':ad, ad_bit (ad_xor a a') 0 = adf_xor (ad_bit a) (ad_bit a') 0. +Proof. + destruct a. intro. change (ad_bit a' 0 = xorb false (ad_bit a' 0)) in |- *. rewrite false_xorb. trivial. + case p. exact ad_xor_sem_4. + intros. change (ad_bit (ad_xor (ad_x (xO p0)) a') 0 = xorb false (ad_bit a' 0)) + in |- *. + rewrite false_xorb. apply ad_xor_sem_3. exact ad_xor_sem_2. +Qed. + +Lemma ad_xor_sem_6 : + forall n:nat, + (forall a a':ad, ad_bit (ad_xor a a') n = adf_xor (ad_bit a) (ad_bit a') n) -> + forall 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 in |- *. unfold ad_bit at 2 in |- *. rewrite false_xorb. reflexivity. + case a'. unfold adf_xor in |- *. unfold ad_bit at 3 in |- *. 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) + in |- *. + rewrite <- H. simpl in |- *. + 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) + in |- *. + rewrite <- H. simpl in |- *. + case (p_xor p2 p1); trivial. + intro. unfold adf_xor in |- *. unfold ad_bit at 3 in |- *. unfold ad_bit_1 in |- *. 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) + in |- *. + rewrite <- H. simpl in |- *. + 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) + in |- *. + rewrite <- H. simpl in |- *. + case (p_xor p2 p1); trivial. + intro. unfold adf_xor in |- *. unfold ad_bit at 3 in |- *. unfold ad_bit_1 in |- *. rewrite xorb_false. reflexivity. + unfold adf_xor in |- *. unfold ad_bit at 2 in |- *. unfold ad_bit_1 in |- *. rewrite false_xorb. simpl in |- *. 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'))). + forall 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. + unfold eqf in |- *. 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). +Lemma eqf_sym : forall f f':nat -> bool, eqf f f' -> eqf f' f. Proof. - Unfold eqf. Intros. Rewrite H. Reflexivity. + unfold eqf in |- *. intros. rewrite H. reflexivity. Qed. -Lemma eqf_refl : (f:nat->bool) (eqf f f). +Lemma eqf_refl : forall f:nat -> bool, eqf f f. Proof. - Unfold eqf. Trivial. + unfold eqf in |- *. trivial. Qed. -Lemma eqf_trans : (f,f',f'':nat->bool) (eqf f f') -> (eqf f' f'') -> (eqf f f''). +Lemma eqf_trans : + forall f f' f'':nat -> bool, eqf f f' -> eqf f' f'' -> eqf f f''. Proof. - Unfold eqf. Intros. Rewrite H. Exact (H0 n). + unfold eqf in |- *. 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'). +Lemma adf_xor_eq : + forall f f':nat -> bool, eqf (adf_xor f f') (fun n:nat => false) -> eqf f f'. Proof. - Unfold eqf. Unfold adf_xor. Intros. Apply xorb_eq. Apply H. + unfold eqf in |- *. unfold adf_xor in |- *. intros. apply xorb_eq. apply H. Qed. -Lemma ad_xor_eq : (a,a':ad) (ad_xor a a')=ad_z -> a=a'. +Lemma ad_xor_eq : forall 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. + 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 in |- *. 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''))). +Lemma adf_xor_assoc : + forall 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. + unfold eqf in |- *. unfold adf_xor in |- *. 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''')). +Lemma eqf_xor_1 : + forall 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. + unfold eqf in |- *. intros. unfold adf_xor in |- *. 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)) + forall 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) := + match a with + | 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)) +Definition ad_double_plus_un (a:ad) := + match a with + | ad_z => ad_x 1 + | 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) +Definition ad_div_2 (a:ad) := + match a with + | 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. +Lemma ad_double_div_2 : forall a:ad, ad_div_2 (ad_double a) = a. Proof. - NewDestruct a; Trivial. + destruct a; trivial. Qed. -Lemma ad_double_plus_un_div_2 : (a:ad) (ad_div_2 (ad_double_plus_un a))=a. +Lemma ad_double_plus_un_div_2 : + forall a:ad, ad_div_2 (ad_double_plus_un a) = a. Proof. - NewDestruct a; Trivial. + destruct a; trivial. Qed. -Lemma ad_double_inj : (a0,a1:ad) (ad_double a0)=(ad_double a1) -> a0=a1. +Lemma ad_double_inj : forall 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. + 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. + forall 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. + 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 +Definition ad_bit_0 (a:ad) := + match a with + | ad_z => false + | ad_x (xO _) => false + | _ => true end. -Lemma ad_double_bit_0 : (a:ad) (ad_bit_0 (ad_double a))=false. +Lemma ad_double_bit_0 : forall a:ad, ad_bit_0 (ad_double a) = false. Proof. - NewDestruct a; Trivial. + destruct a; trivial. Qed. -Lemma ad_double_plus_un_bit_0 : (a:ad) (ad_bit_0 (ad_double_plus_un a))=true. +Lemma ad_double_plus_un_bit_0 : + forall a:ad, ad_bit_0 (ad_double_plus_un a) = true. Proof. - NewDestruct a; Trivial. + destruct a; trivial. Qed. -Lemma ad_div_2_double : (a:ad) (ad_bit_0 a)=false -> (ad_double (ad_div_2 a))=a. +Lemma ad_div_2_double : + forall 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. + destruct a. trivial. destruct 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. + forall 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. + destruct a. intro. discriminate H. + destruct 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). +Lemma ad_bit_0_correct : forall a:ad, ad_bit a 0 = ad_bit_0 a. Proof. - NewDestruct a; Trivial. - NewDestruct p; Trivial. + destruct a; trivial. + destruct p; trivial. Qed. -Lemma ad_div_2_correct : (a:ad) (n:nat) (ad_bit (ad_div_2 a) n)=(ad_bit a (S n)). +Lemma ad_div_2_correct : + forall (a:ad) (n:nat), ad_bit (ad_div_2 a) n = ad_bit a (S n). Proof. - NewDestruct a; Trivial. - NewDestruct p; Trivial. + destruct a; trivial. + destruct 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')). + forall 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. + intros. rewrite <- ad_bit_0_correct. rewrite (ad_xor_semantics a a' 0). + unfold adf_xor in |- *. 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')). + forall 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. + intros. apply ad_faithful. unfold eqf in |- *. 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 in |- *. 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')). +Lemma ad_neg_bit_0 : + forall 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. + 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')). + forall a a':ad, ad_xor a a' = ad_x 1 -> ad_bit_0 a = negb (ad_bit_0 a'). Proof. - Intros. Apply ad_neg_bit_0. Rewrite H. Reflexivity. + 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')). +Lemma ad_neg_bit_0_2 : + forall (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. + 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'). +Lemma ad_same_bit_0 : + forall (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. + 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.
\ No newline at end of file diff --git a/theories/IntMap/Adist.v b/theories/IntMap/Adist.v index fbc2870f16..30b54ac14f 100644 --- a/theories/IntMap/Adist.v +++ b/theories/IntMap/Adist.v @@ -7,233 +7,244 @@ (***********************************************************************) (*i $Id$ i*) -Require Bool. -Require ZArith. -Require Arith. -Require Min. -Require Addr. - -Fixpoint ad_plength_1 [p:positive] : nat := - Cases p of - xH => O - | (xI _) => O - | (xO p') => (S (ad_plength_1 p')) +Require Import Bool. +Require Import ZArith. +Require Import Arith. +Require Import Min. +Require Import Addr. + +Fixpoint ad_plength_1 (p:positive) : nat := + match p with + | xH => 0 + | xI _ => 0 + | xO p' => S (ad_plength_1 p') end. Inductive natinf : Set := - infty : natinf + | infty : natinf | ni : nat -> natinf. -Definition ad_plength := [a:ad] - Cases a of - ad_z => infty - | (ad_x p) => (ni (ad_plength_1 p)) +Definition ad_plength (a:ad) := + match a with + | 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. +Lemma ad_plength_infty : forall a:ad, ad_plength a = infty -> a = ad_z. Proof. - Induction a; Trivial. - Unfold ad_plength; Intros; Discriminate H. + simple induction a; trivial. + unfold ad_plength in |- *; 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. +Lemma ad_plength_zeros : + forall (a:ad) (n:nat), + ad_plength a = ni n -> forall k:nat, 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. + simple induction a; trivial. + simple induction p. simple induction n. intros. inversion H1. + simple induction k. simpl in H1. discriminate H1. + intros. simpl in H1. discriminate H1. + simple induction k. trivial. + generalize H0. case n. intros. inversion H3. + intros. simpl in |- *. unfold ad_bit in H. apply (H n0). simpl in H1. inversion H1. reflexivity. + exact (lt_S_n n1 n0 H3). + simpl in |- *. 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. +Lemma ad_plength_one : + forall (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. + simple induction a. intros. inversion H. + simple induction p. intros. simpl in H0. inversion H0. reflexivity. + intros. simpl in H0. inversion H0. simpl in |- *. 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). +Lemma ad_plength_first_one : + forall (a:ad) (n:nat), + (forall k:nat, 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. + simple induction a. intros. simpl in H0. discriminate H0. + simple induction p. intros. generalize H0. case n. intros. reflexivity. + intros. absurd (ad_bit (ad_x (xI p0)) 0 = false). trivial with bool. + auto with bool arith. + intros. generalize H0 H1. case n. intros. simpl in H3. discriminate H3. + intros. simpl in |- *. 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) in |- *. 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 +Definition ni_min (d d':natinf) := + match d with + | infty => d' + | ni n => match d' with + | infty => d + | ni n' => ni (min n n') + end end. -Lemma ni_min_idemp : (d:natinf) (ni_min d d)=d. +Lemma ni_min_idemp : forall 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. + simple induction d; trivial. + unfold ni_min in |- *. + simple induction n; trivial. + intros. + simpl in |- *. + inversion H. + rewrite H1. + rewrite H1. + reflexivity. Qed. -Lemma ni_min_comm : (d,d':natinf) (ni_min d d')=(ni_min d' d). +Lemma ni_min_comm : forall 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). + simple induction d. simple induction d'; trivial. + simple induction d'; trivial. elim n. simple induction n0; trivial. + intros. elim n1; trivial. intros. unfold ni_min in H. cut (min n0 n2 = min n2 n0). + intro. unfold ni_min in |- *. simpl in |- *. 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'')). +Lemma ni_min_assoc : + forall 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. + simple induction d; trivial. simple induction d'; trivial. + simple induction d''; trivial. + unfold ni_min in |- *. intro. cut (min (min n n0) n1 = min n (min n0 n1)). + intro. rewrite H. reflexivity. + generalize n0 n1. elim n; trivial. + simple induction n3; trivial. simple induction n5; trivial. + intros. simpl in |- *. auto. Qed. -Lemma ni_min_O_l : (d:natinf) (ni_min (ni O) d)=(ni O). +Lemma ni_min_O_l : forall d:natinf, ni_min (ni 0) d = ni 0. Proof. - Induction d; Trivial. + simple induction d; trivial. Qed. -Lemma ni_min_O_r : (d:natinf) (ni_min d (ni O))=(ni O). +Lemma ni_min_O_r : forall d:natinf, ni_min d (ni 0) = ni 0. Proof. - Intros. Rewrite ni_min_comm. Apply ni_min_O_l. + intros. rewrite ni_min_comm. apply ni_min_O_l. Qed. -Lemma ni_min_inf_l : (d:natinf) (ni_min infty d)=d. +Lemma ni_min_inf_l : forall d:natinf, ni_min infty d = d. Proof. - Trivial. + trivial. Qed. -Lemma ni_min_inf_r : (d:natinf) (ni_min d infty)=d. +Lemma ni_min_inf_r : forall d:natinf, ni_min d infty = d. Proof. - Induction d; Trivial. + simple induction d; trivial. Qed. -Definition ni_le := [d,d':natinf] (ni_min d d')=d. +Definition ni_le (d d':natinf) := ni_min d d' = d. -Lemma ni_le_refl : (d:natinf) (ni_le d d). +Lemma ni_le_refl : forall d:natinf, ni_le d d. Proof. - Exact ni_min_idemp. + exact ni_min_idemp. Qed. -Lemma ni_le_antisym : (d,d':natinf) (ni_le d d') -> (ni_le d' d) -> d=d'. +Lemma ni_le_antisym : forall 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. + unfold ni_le in |- *. 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''). +Lemma ni_le_trans : + forall 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. + unfold ni_le in |- *. 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). +Lemma ni_le_min_1 : forall 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. + unfold ni_le in |- *. 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'). +Lemma ni_le_min_2 : forall d d':natinf, ni_le (ni_min d d') d'. Proof. - Unfold ni_le. Intros. Rewrite ni_min_assoc. Rewrite ni_min_idemp. Reflexivity. + unfold ni_le in |- *. 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'. +Lemma ni_min_case : forall 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. + simple induction d. intro. right. exact (ni_min_inf_l d'). + simple induction d'. left. exact (ni_min_inf_r (ni n)). + unfold ni_min in |- *. cut (forall 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. + simple induction n1. right. reflexivity. + intros. case (H n2). intro. left. simpl in |- *. rewrite H1. reflexivity. + intro. right. simpl in |- *. rewrite H1. reflexivity. Qed. -Lemma ni_le_total : (d,d':natinf) (ni_le d d') \/ (ni_le d' d). +Lemma ni_le_total : forall 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. + unfold ni_le in |- *. 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. +Lemma ni_le_min_induc : + forall d d' dm:natinf, + ni_le dm d -> + ni_le dm d' -> + (forall 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. + 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 in |- *. 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)). +Lemma le_ni_le : forall m n:nat, 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. + cut (forall m n:nat, m <= n -> min m n = m). + intros. unfold ni_le, ni_min in |- *. rewrite (H m n H0). reflexivity. + simple induction m. trivial. + simple induction n0. intro. inversion H0. + intros. simpl in |- *. 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). +Lemma ni_le_le : forall m n:nat, ni_le (ni m) (ni n) -> m <= n. Proof. - Unfold ni_le. Unfold ni_min. Intros. Inversion H. Apply le_min_r. + unfold ni_le in |- *. unfold ni_min in |- *. 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)). +Lemma ad_plength_lb : + forall (a:ad) (n:nat), + (forall k:nat, 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. + simple induction a. intros. exact (ni_min_inf_r (ni n)). + intros. unfold ad_plength in |- *. 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 (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)). +Lemma ad_plength_ub : + forall (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. + simple induction a. intros. discriminate H. + intros. unfold ad_plength in |- *. 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 (ad_plength (ad_x p))) n H0). + discriminate. + exact H. Qed. @@ -244,26 +255,26 @@ Qed. Instead of working with $d$, we work with $pd$, namely [ad_pdist]: *) -Definition ad_pdist := [a,a':ad] (ad_plength (ad_xor a a')). +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. +Lemma ad_pdist_eq_1 : forall a:ad, ad_pdist a a = infty. Proof. - Intros. Unfold ad_pdist. Rewrite ad_xor_nilpotent. Reflexivity. + intros. unfold ad_pdist in |- *. rewrite ad_xor_nilpotent. reflexivity. Qed. -Lemma ad_pdist_eq_2 : (a,a':ad) (ad_pdist a a')=infty -> a=a'. +Lemma ad_pdist_eq_2 : forall a a':ad, ad_pdist a a' = infty -> a = a'. Proof. - Intros. Apply ad_xor_eq. Apply ad_plength_infty. Exact H. + 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). +Lemma ad_pdist_comm : forall a a':ad, ad_pdist a a' = ad_pdist a' a. Proof. - Unfold ad_pdist. Intros. Rewrite ad_xor_comm. Reflexivity. + unfold ad_pdist in |- *. intros. rewrite ad_xor_comm. reflexivity. Qed. (** $d$ is an ultrametric distance, that is, not only $d(a,a')\leq @@ -278,44 +289,48 @@ Qed. (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'))). +Lemma ad_plength_ultra_1 : + forall 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. + simple induction a. intros. unfold ni_le in H. unfold ad_plength at 1 3 in H. + rewrite (ni_min_inf_l (ad_plength a')) in H. + rewrite (ad_plength_infty a' H). simpl in |- *. apply ni_le_refl. + intros. unfold ad_plength at 1 in |- *. apply ad_plength_lb. intros. + cut (forall 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 in |- *. + rewrite + (ad_plength_zeros (ad_x p) (ad_plength_1 p) + (refl_equal (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'))). +Lemma ad_plength_ultra : + forall 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. + 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')). +Lemma ad_pdist_ultra : + forall 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. + intros. unfold ad_pdist in |- *. 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.
\ No newline at end of file diff --git a/theories/IntMap/Allmaps.v b/theories/IntMap/Allmaps.v index fcd111694d..0020219d00 100644 --- a/theories/IntMap/Allmaps.v +++ b/theories/IntMap/Allmaps.v @@ -23,4 +23,4 @@ Require Export Mapcard. Require Export Mapcanon. Require Export Mapc. Require Export Maplists. -Require Export Adalloc. +Require Export Adalloc.
\ No newline at end of file diff --git a/theories/IntMap/Fset.v b/theories/IntMap/Fset.v index 3c00c21e09..8a2ab00c35 100644 --- a/theories/IntMap/Fset.v +++ b/theories/IntMap/Fset.v @@ -9,330 +9,363 @@ (*s Sets operations on maps *) -Require Bool. -Require Sumbool. -Require ZArith. -Require Addr. -Require Adist. -Require Addec. -Require Map. +Require Import Bool. +Require Import Sumbool. +Require Import ZArith. +Require Import Addr. +Require Import Adist. +Require Import Addec. +Require Import Map. Section Dom. - Variable A, B : Set. - - Fixpoint MapDomRestrTo [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 => (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 + Variables A B : Set. + + Fixpoint MapDomRestrTo (m:Map A) : Map B -> Map A := + match m with + | M0 => fun _:Map B => M0 A + | M1 a y => + fun m':Map B => match MapGet B m' a with + | NONE => M0 A + | _ => m + end + | M2 m1 m2 => + fun m':Map B => + match m' with + | M0 => M0 A + | M1 a' y' => + match MapGet A m a' with + | NONE => M0 A + | SOME y => M1 A a' y + end + | M2 m'1 m'2 => + makeM2 A (MapDomRestrTo m1 m'1) (MapDomRestrTo m2 m'2) + end end. - Lemma MapDomRestrTo_semantics : (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) + Lemma MapDomRestrTo_semantics : + forall (m:Map A) (m':Map B), + eqm A (MapGet A (MapDomRestrTo m m')) + (fun a0:ad => + match MapGet B m' a0 with + | NONE => NONE A + | _ => MapGet A m a0 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. + Proof. + unfold eqm in |- *. simple induction m. simpl in |- *. intros. case (MapGet B m' a); trivial. + intros. simpl in |- *. 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). + simple induction m'. trivial. + unfold MapDomRestrTo in |- *. 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 = + match MapGet B (M2 B m2 m3) a with + | NONE => NONE A + | SOME _ => MapGet A (M2 A m0 m1) a + end) in |- *. + rewrite (makeM2_M2 A (MapDomRestrTo m0 m2) (MapDomRestrTo m1 m3) a). + rewrite MapGet_M2_bit_0_if. rewrite (H0 m3 (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 + Fixpoint MapDomRestrBy (m:Map A) : Map B -> Map A := + match m with + | M0 => fun _:Map B => M0 A + | M1 a y => + fun m':Map B => match MapGet B m' a with + | NONE => m + | _ => M0 A + end + | M2 m1 m2 => + fun m':Map B => + match m' with + | M0 => m + | M1 a' y' => MapRemove A m a' + | M2 m'1 m'2 => + makeM2 A (MapDomRestrBy m1 m'1) (MapDomRestrBy m2 m'2) + end end. - Lemma MapDomRestrBy_semantics : (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) + Lemma MapDomRestrBy_semantics : + forall (m:Map A) (m':Map B), + eqm A (MapGet A (MapDomRestrBy m m')) + (fun a0:ad => + match MapGet B m' a0 with + | NONE => MapGet A m a0 + | _ => NONE 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. + Proof. + unfold eqm in |- *. simple induction m. simpl in |- *. intros. case (MapGet B m' a); trivial. + intros. simpl in |- *. 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. + simple induction m'. trivial. + unfold MapDomRestrBy in |- *. 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 = + match MapGet B (M2 B m2 m3) a with + | NONE => MapGet A (M2 A m0 m1) a + | SOME _ => NONE A + end) in |- *. + 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 + Definition in_dom (a:ad) (m:Map A) := + match MapGet A m a with + | NONE => false + | _ => true end. - Lemma in_dom_M0 : (a:ad) (in_dom a (M0 A))=false. + Lemma in_dom_M0 : forall a:ad, in_dom a (M0 A) = false. Proof. - Trivial. + trivial. Qed. - Lemma in_dom_M1 : (a,a0:ad) (y:A) (in_dom a0 (M1 A a y))=(ad_eq a a0). + Lemma in_dom_M1 : forall (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. + unfold in_dom in |- *. intros. simpl in |- *. case (ad_eq a a0); reflexivity. Qed. - Lemma in_dom_M1_1 : (a:ad) (y:A) (in_dom a (M1 A a y))=true. + Lemma in_dom_M1_1 : forall (a:ad) (y:A), in_dom a (M1 A a y) = true. Proof. - Intros. Rewrite in_dom_M1. Apply ad_eq_correct. + 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. + Lemma in_dom_M1_2 : + forall (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. + 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)}. + Lemma in_dom_some : + forall (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. + unfold in_dom in |- *. intros. elim (option_sum _ (MapGet A m a)). trivial. + intro H0. rewrite H0 in H. discriminate H. Qed. - Lemma in_dom_none : (m:(Map A)) (a:ad) (in_dom a m)=false -> - (MapGet A m a)=(NONE A). + Lemma in_dom_none : + forall (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. + unfold in_dom in |- *. intros. elim (option_sum _ (MapGet A m a)). intro H0. elim H0. + intros y H1. rewrite H1 in H. discriminate H. + trivial. Qed. - Lemma in_dom_put : (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)). + Lemma in_dom_put : + forall (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. + unfold in_dom in |- *. 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)). + Lemma in_dom_put_behind : + forall (m:Map A) (a0:ad) (y0:A) (a:ad), + in_dom a (MapPut_behind A m a0 y0) = orb (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. + unfold in_dom in |- *. 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)). + Lemma in_dom_remove : + forall (m:Map A) (a0 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. + unfold in_dom in |- *. 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')). + Lemma in_dom_merge : + forall (m m':Map A) (a:ad), + in_dom a (MapMerge A m m') = orb (in_dom a m) (in_dom a m'). Proof. - Unfold in_dom. 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. + unfold in_dom in |- *. intros. rewrite (MapMerge_semantics A m m' a). + elim (option_sum A (MapGet A m' a)). intro H. elim H. intros y H0. rewrite H0. + case (MapGet A m a); reflexivity. + intro H. rewrite H. rewrite orb_b_false. reflexivity. Qed. - Lemma in_dom_delta : (m,m':(Map A)) (a:ad) - (in_dom a (MapDelta A m m'))=(xorb (in_dom a m) (in_dom a m')). + Lemma in_dom_delta : + forall (m m':Map A) (a:ad), + in_dom a (MapDelta A m m') = xorb (in_dom a m) (in_dom a m'). Proof. - Unfold in_dom. 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. + unfold in_dom in |- *. intros. rewrite (MapDelta_semantics A m m' a). + elim (option_sum A (MapGet A m' a)). intro H. elim H. intros y H0. rewrite H0. + case (MapGet A m a); reflexivity. + intro H. rewrite H. case (MapGet A m a); reflexivity. Qed. End Dom. Section InDom. - Variable A, B : Set. + Variables 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')). + Lemma in_dom_restrto : + forall (m:Map A) (m':Map B) (a:ad), + in_dom A a (MapDomRestrTo A B m m') = + andb (in_dom A a m) (in_dom B a m'). Proof. - Unfold in_dom. 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. + unfold in_dom in |- *. intros. rewrite (MapDomRestrTo_semantics A B m m' a). + elim (option_sum B (MapGet B m' a)). intro H. elim H. intros y H0. rewrite H0. + rewrite andb_b_true. reflexivity. + intro H. rewrite H. rewrite andb_b_false. reflexivity. Qed. - Lemma in_dom_restrby : (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'))). + Lemma in_dom_restrby : + forall (m:Map A) (m':Map B) (a:ad), + in_dom A a (MapDomRestrBy A B m m') = + andb (in_dom A a m) (negb (in_dom B a m')). Proof. - Unfold in_dom. 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. + unfold in_dom in |- *. intros. rewrite (MapDomRestrBy_semantics A B m m' a). + elim (option_sum B (MapGet B m' a)). intro H. elim H. intros y H0. rewrite H0. + unfold negb in |- *. rewrite andb_b_false. reflexivity. + intro H. rewrite H. unfold negb in |- *. rewrite andb_b_true. reflexivity. Qed. End InDom. -Definition FSet := (Map unit). +Definition FSet := Map unit. Section FSetDefs. Variable A : Set. - Definition in_FSet : ad -> FSet -> bool := (in_dom unit). + 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')) + Fixpoint MapDom (m:Map A) : FSet := + match m with + | M0 => M0 unit + | M1 a _ => M1 unit a tt + | M2 m m' => M2 unit (MapDom m) (MapDom m') end. - Lemma MapDom_semantics_1 : (m:(Map A)) (a:ad) - (y:A) (MapGet A m a)=(SOME A y) -> (in_FSet a (MapDom m))=true. + Lemma MapDom_semantics_1 : + forall (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. + simple induction m. intros. discriminate H. + unfold MapDom in |- *. unfold in_FSet in |- *. unfold in_dom in |- *. unfold MapGet in |- *. intros a y a0 y0. + case (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 in |- *. unfold in_FSet in |- *. + unfold in_dom in |- *. 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)}. + Lemma MapDom_semantics_2 : + forall (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. + simple induction m. intros. discriminate H. + unfold MapDom in |- *. unfold in_FSet in |- *. unfold in_dom in |- *. unfold MapGet in |- *. intros a y a0. case (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 in |- *. unfold in_FSet in |- *. + unfold in_dom in |- *. 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. + Lemma MapDom_semantics_3 : + forall (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. + 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). + Lemma MapDom_semantics_4 : + forall (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. + 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)). + Lemma MapDom_Dom : + forall (m:Map A) (a:ad), in_dom A a m = in_FSet a (MapDom m). Proof. - Intros. Elim (sumbool_of_bool (in_FSet a (MapDom m))). Intro H. - Elim (MapDom_semantics_2 m a H). Intros y H0. Rewrite H. Unfold in_dom. Rewrite H0. - Reflexivity. - Intro H. Rewrite H. Unfold in_dom. Rewrite (MapDom_semantics_4 m a H). Reflexivity. + intros. elim (sumbool_of_bool (in_FSet a (MapDom m))). intro H. + elim (MapDom_semantics_2 m a H). intros y H0. rewrite H. unfold in_dom in |- *. rewrite H0. + reflexivity. + intro H. rewrite H. unfold in_dom in |- *. rewrite (MapDom_semantics_4 m a H). reflexivity. Qed. - Definition FSetUnion : FSet -> FSet -> FSet := [s,s':FSet] (MapMerge unit s s'). + Definition FSetUnion (s s':FSet) : 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')). + Lemma in_FSet_union : + forall (s s':FSet) (a:ad), + in_FSet a (FSetUnion s s') = orb (in_FSet a s) (in_FSet a s'). Proof. - Exact (in_dom_merge unit). + exact (in_dom_merge unit). Qed. - Definition FSetInter : FSet -> FSet -> FSet := [s,s':FSet] (MapDomRestrTo unit unit s s'). + Definition FSetInter (s s':FSet) : 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')). + Lemma in_FSet_inter : + forall (s s':FSet) (a:ad), + in_FSet a (FSetInter s s') = andb (in_FSet a s) (in_FSet a s'). Proof. - Exact (in_dom_restrto unit unit). + exact (in_dom_restrto unit unit). Qed. - Definition FSetDiff : FSet -> FSet -> FSet := [s,s':FSet] (MapDomRestrBy unit unit s s'). + Definition FSetDiff (s s':FSet) : 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'))). + Lemma in_FSet_diff : + forall (s s':FSet) (a:ad), + in_FSet a (FSetDiff s s') = andb (in_FSet a s) (negb (in_FSet a s')). Proof. - Exact (in_dom_restrby unit unit). + exact (in_dom_restrby unit unit). Qed. - Definition FSetDelta : FSet -> FSet -> FSet := [s,s':FSet] (MapDelta unit s s'). + Definition FSetDelta (s s':FSet) : 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')). + Lemma in_FSet_delta : + forall (s s':FSet) (a:ad), + in_FSet a (FSetDelta s s') = xorb (in_FSet a s) (in_FSet a s'). Proof. - Exact (in_dom_delta unit). + exact (in_dom_delta unit). Qed. End FSetDefs. -Lemma FSet_Dom : (s:FSet) (MapDom unit s)=s. +Lemma FSet_Dom : forall 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. + simple induction s. trivial. + simpl in |- *. intros a t. elim t. reflexivity. + intros. simpl in |- *. rewrite H. rewrite H0. reflexivity. +Qed.
\ No newline at end of file diff --git a/theories/IntMap/Lsort.v b/theories/IntMap/Lsort.v index 80ab704de3..3399eaad24 100644 --- a/theories/IntMap/Lsort.v +++ b/theories/IntMap/Lsort.v @@ -7,531 +7,622 @@ (***********************************************************************) (*i $Id$ i*) -Require Bool. -Require Sumbool. -Require Arith. -Require ZArith. -Require Addr. -Require Adist. -Require Addec. -Require Map. -Require PolyList. -Require Mapiter. +Require Import Bool. +Require Import Sumbool. +Require Import Arith. +Require Import ZArith. +Require Import Addr. +Require Import Adist. +Require Import Addec. +Require Import Map. +Require Import List. +Require Import Mapiter. Section LSort. Variable A : Set. - Fixpoint ad_less_1 [a,a':ad; p:positive] : bool := - Cases p of - (xO p') => (ad_less_1 (ad_div_2 a) (ad_div_2 a') p') - | _ => (andb (negb (ad_bit_0 a)) (ad_bit_0 a')) + Fixpoint ad_less_1 (a a':ad) (p:positive) {struct p} : bool := + match p with + | xO p' => 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. + Definition ad_less (a a':ad) := + match ad_xor a a' with + | ad_z => false + | ad_x p => ad_less_1 a a' p + end. - Lemma ad_less_def_3 : (a,a':ad) (ad_less (ad_double a) (ad_double_plus_un a'))=true. + Lemma ad_bit_0_less : + forall a a':ad, + ad_bit_0 a = false -> ad_bit_0 a' = true -> ad_less a a' = true. Proof. - Intros. Apply ad_bit_0_less. Apply ad_double_bit_0. - Apply ad_double_plus_un_bit_0. + intros. elim (ad_sum (ad_xor a a')). intro H1. elim H1. intros p H2. unfold ad_less in |- *. + rewrite H2. generalize H2. elim p. intros. simpl in |- *. 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 in |- *. 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_less_def_4 : (a,a':ad) (ad_less (ad_double_plus_un a) (ad_double a'))=false. + Lemma ad_bit_0_gt : + forall a a':ad, + ad_bit_0 a = true -> ad_bit_0 a' = false -> ad_less a a' = false. Proof. - Intros. Apply ad_bit_0_gt. Apply ad_double_plus_un_bit_0. - Apply ad_double_bit_0. + intros. elim (ad_sum (ad_xor a a')). intro H1. elim H1. intros p H2. unfold ad_less in |- *. + rewrite H2. generalize H2. elim p. intros. simpl in |- *. 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 in |- *. rewrite H. rewrite H0. reflexivity. + intro H1. unfold ad_less in |- *. rewrite H1. reflexivity. Qed. - Lemma ad_less_z : (a:ad) (ad_less a ad_z)=false. + Lemma ad_less_not_refl : forall a:ad, ad_less a a = false. Proof. - Induction a. Reflexivity. - Unfold ad_less. Intro. Rewrite (ad_xor_neutral_right (ad_x p)). (Elim p; Trivial). + intro. unfold ad_less in |- *. rewrite (ad_xor_nilpotent a). reflexivity. Qed. - Lemma ad_z_less_1 : (a:ad) (ad_less ad_z a)=true -> {p:positive | a=(ad_x p)}. + Lemma ad_ind_double : + forall (a:ad) (P:ad -> Prop), + P ad_z -> + (forall a:ad, P a -> P (ad_double a)) -> + (forall a:ad, P a -> P (ad_double_plus_un a)) -> P a. 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. + intros; elim a. trivial. + simple 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_trans : (a,a',a'':ad) - (ad_less a a')=true -> (ad_less a' a'')=true -> (ad_less a a'')=true. + Lemma ad_rec_double : + forall (a:ad) (P:ad -> Set), + P ad_z -> + (forall a:ad, P a -> P (ad_double a)) -> + (forall a:ad, P a -> P (ad_double_plus_un a)) -> P a. 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 + intros; elim a. trivial. + simple 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 : + forall a a':ad, ad_less (ad_double a) (ad_double a') = ad_less a a'. + Proof. + simple induction a. simple induction a'. reflexivity. + trivial. + simple induction a'. unfold ad_less in |- *. simpl in |- *. elim p; trivial. + unfold ad_less in |- *. simpl in |- *. intro. case (p_xor p p0). reflexivity. + trivial. + Qed. + + Lemma ad_less_def_2 : + forall a a':ad, + ad_less (ad_double_plus_un a) (ad_double_plus_un a') = ad_less a a'. + Proof. + simple induction a. simple induction a'. reflexivity. + trivial. + simple induction a'. unfold ad_less in |- *. simpl in |- *. elim p; trivial. + unfold ad_less in |- *. simpl in |- *. intro. case (p_xor p p0). reflexivity. + trivial. + Qed. + + Lemma ad_less_def_3 : + forall 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 : + forall 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 : forall a:ad, ad_less a ad_z = false. + Proof. + simple induction a. reflexivity. + unfold ad_less in |- *. intro. rewrite (ad_xor_neutral_right (ad_x p)). elim p; trivial. + Qed. + + Lemma ad_z_less_1 : + forall a:ad, ad_less ad_z a = true -> {p : positive | a = ad_x p}. + Proof. + simple induction a. intro. discriminate H. + intros. split with p. reflexivity. + Qed. + + Lemma ad_z_less_2 : forall a:ad, ad_less ad_z a = false -> a = ad_z. + Proof. + simple induction a. trivial. + unfold ad_less in |- *. simpl in |- *. cut (forall p:positive, ad_less_1 ad_z (ad_x p) p = false -> False). + intros. elim (H p H0). + simple induction p. intros. discriminate H0. + intros. exact (H H0). + intro. discriminate H. + Qed. + + Lemma ad_less_trans : + forall 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 := fun a:ad => + forall 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 := fun a':ad => + forall 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 := fun 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 := fun 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 := fun a':ad => + forall 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 := fun 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 := + match l with + | nil => true + | (a, _) :: l' => + match l' with + | nil => true + | (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 + Fixpoint alist_nth_ad (n:nat) (l:alist A) {struct l} : ad := + match l with + | nil => ad_z (* dummy *) + | (a, y) :: l' => match n with + | O => a + | S n' => alist_nth_ad n' l' + end end. - Definition alist_sorted_1 := [l:(alist A)] - (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. + Definition alist_sorted_1 (l:alist A) := + forall n:nat, + S (S n) <= length l -> + ad_less (alist_nth_ad n l) (alist_nth_ad (S n) l) = true. - Lemma app_length : (C:Set) (l,l':(list C)) (length (app l l'))=(plus (length l) (length l')). + Lemma alist_sorted_imp_1 : + forall l:alist A, alist_sorted l = true -> alist_sorted_1 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')). + unfold alist_sorted_1 in |- *. simple induction l. intros. elim (le_Sn_O (S n) H0). + intro r. elim r. intros a y. simple induction l0. intros. simpl in H1. + elim (le_Sn_O n (le_S_n (S n) 0 H1)). + intro r0. elim r0. intros a0 y0. simple induction n. intros. simpl in |- *. simpl in H1. + exact (proj1 (andb_prop _ _ H1)). + intros. change + (ad_less (alist_nth_ad n0 ((a0, y0) :: l1)) + (alist_nth_ad (S n0) ((a0, y0) :: l1)) = true) + in |- *. + apply H0. exact (proj2 (andb_prop _ _ H1)). + apply le_S_n. exact H3. + Qed. + + Definition alist_sorted_2 (l:alist A) := + forall m n:nat, + m < n -> + S n <= length l -> ad_less (alist_nth_ad m l) (alist_nth_ad n l) = true. + + Lemma alist_sorted_1_imp_2 : + forall l:alist A, alist_sorted_1 l -> alist_sorted_2 l. + Proof. + unfold alist_sorted_1, alist_sorted_2, lt in |- *. intros l H m n H0. elim H0. exact (H m). + intros. apply ad_less_trans with (a' := alist_nth_ad m0 l). apply H2. apply le_Sn_le. + assumption. + apply H. assumption. + Qed. + + Lemma alist_sorted_2_imp : + forall l:alist A, alist_sorted_2 l -> alist_sorted l = true. + Proof. + unfold alist_sorted_2, lt in |- *. simple induction l. trivial. + intro r. elim r. intros a y. simple induction l0. trivial. + intro r0. elim r0. intros a0 y0. intros. + change (andb (ad_less a a0) (alist_sorted ((a0, y0) :: l1)) = true) + in |- *. + apply andb_true_intro. split. apply (H1 0 1). apply le_n. + simpl in |- *. apply le_n_S. apply le_n_S. apply le_O_n. + apply H0. intros. apply (H1 (S m) (S n)). apply le_n_S. assumption. + exact (le_n_S _ _ H3). + Qed. + + Lemma app_length : + forall (C:Set) (l l':list C), length (l ++ l') = length l + length l'. + Proof. + simple induction l. trivial. + intros. simpl in |- *. rewrite (H l'). reflexivity. + Qed. + + Lemma aapp_length : + forall l l':alist A, length (aapp A l l') = length l + length l'. Proof. - Exact (app_length ad*A). + 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). + Lemma alist_nth_ad_aapp_1 : + forall (l l':alist A) (n:nat), + S n <= length l -> alist_nth_ad n (aapp A l l') = alist_nth_ad n l. Proof. - 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. + simple induction l. intros. elim (le_Sn_O n H). + intro r. elim r. intros a y l' H l''. simple induction n. trivial. + intros. simpl in |- *. apply H. apply le_S_n. exact H1. Qed. - Lemma alist_nth_ad_aapp_2 : (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'). + Lemma alist_nth_ad_aapp_2 : + forall (l l':alist A) (n:nat), + S n <= length l' -> + alist_nth_ad (length l + n) (aapp A l l') = alist_nth_ad n l'. Proof. - Induction l. Trivial. - Intro r. Elim r. Intros a y l' H l'' n H0. Simpl. Apply H. Exact H0. + simple induction l. trivial. + intro r. elim r. intros a y l' H l'' n H0. simpl in |- *. apply H. exact H0. Qed. - Lemma interval_split : (p,q,n:nat) (le (S n) (plus p q)) -> - {n' : nat | (le (S n') q) /\ n=(plus p n')}+{(le (S n) p)}. + Lemma interval_split : + forall p q n:nat, + S n <= p + q -> {n' : nat | S n' <= q /\ n = p + n'} + {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. + simple induction p. simpl in |- *. intros. left. split with n. split; [ assumption | reflexivity ]. + intros p' H q. simple induction n. intros. right. apply le_n_S. apply le_O_n. + intros. elim (H _ _ (le_S_n _ _ H1)). intro H2. left. elim H2. intros n' H3. + elim H3. intros H4 H5. split with n'. split; [ assumption | rewrite H5; reflexivity ]. + intro H2. right. apply le_n_S. assumption. Qed. - Lemma alist_conc_sorted : (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')). + Lemma alist_conc_sorted : + forall l l':alist A, + alist_sorted_2 l -> + alist_sorted_2 l' -> + (forall n n':nat, + S n <= length l -> + S n' <= length l' -> + 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). + unfold alist_sorted_2, lt in |- *. intros. rewrite (aapp_length l l') in H3. + elim + (interval_split (length l) (length l') m + (le_trans _ _ _ (le_n_S _ _ (lt_le_weak m n H2)) H3)). + intro H4. elim H4. intros m' H5. elim H5. intros. rewrite H7. + rewrite (alist_nth_ad_aapp_2 l l' m' H6). elim (interval_split (length l) (length l') n H3). + intro H8. elim H8. intros n' H9. elim H9. intros. rewrite H11. + rewrite (alist_nth_ad_aapp_2 l l' n' H10). apply H0. rewrite H7 in H2. rewrite H11 in H2. + change (S (length l) + m' <= length l + n') in H2. + rewrite (plus_Snm_nSm (length l) m') in H2. exact ((fun p n m:nat => plus_le_reg_l n m p) (length l) (S m') n' H2). + exact H10. + intro H8. rewrite H7 in H2. cut (S (length l) <= length l). intros. elim (le_Sn_n _ H9). + apply le_trans with (m := S n). apply le_n_S. apply le_trans with (m := S (length l + m')). + apply le_trans with (m := length l + m'). apply le_plus_l. + apply le_n_Sn. + exact H2. + exact H8. + intro H4. rewrite (alist_nth_ad_aapp_1 l l' m H4). + elim (interval_split (length l) (length l') n H3). intro H5. elim H5. intros n' H6. elim H6. + intros. rewrite H8. rewrite (alist_nth_ad_aapp_2 l l' n' H7). exact (H1 m n' H4 H7). + intro H5. rewrite (alist_nth_ad_aapp_1 l l' n H5). exact (H m n H2 H5). Qed. - Lemma alist_nth_ad_semantics : (l:(alist A)) (n:nat) (le (S n) (length l)) -> - {y:A | (alist_semantics A l (alist_nth_ad n l))=(SOME A y)}. + Lemma alist_nth_ad_semantics : + forall (l:alist A) (n:nat), + S n <= length l -> + {y : A | alist_semantics A l (alist_nth_ad n l) = SOME 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. + simple induction l. intros. elim (le_Sn_O _ H). + intro r. elim r. intros a y l0 H. simple induction n. simpl in |- *. intro. split with y. + rewrite (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 in |- *. rewrite (ad_eq_correct (alist_nth_ad n0 l0)). + reflexivity. + intro H3. split with y0. simpl in |- *. 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')}. + Lemma alist_of_Map_nth_ad : + forall (m:Map A) (pf:ad -> ad) (l:alist A), + l = + MapFold1 A (alist A) (anil A) (aapp A) + (fun (a0:ad) (y:A) => acons A (a0, y) (anil A)) pf m -> + forall n:nat, S n <= length l -> {a' : ad | alist_nth_ad n l = pf a'}. Proof. - Intros. Elim (alist_nth_ad_semantics l n H0). Intros y H1. - Apply (alist_of_Map_semantics_1_1 A m pf (alist_nth_ad n l) y). - Rewrite <- H. Assumption. + 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. + Definition ad_monotonic (pf:ad -> ad) := + forall a a':ad, ad_less a a' = true -> ad_less (pf a) (pf a') = true. - Lemma ad_double_monotonic : (ad_monotonic ad_double). + Lemma ad_double_monotonic : ad_monotonic ad_double. Proof. - Unfold ad_monotonic. Intros. Rewrite ad_less_def_1. Assumption. + unfold ad_monotonic in |- *. intros. rewrite ad_less_def_1. assumption. Qed. - Lemma ad_double_plus_un_monotonic : (ad_monotonic ad_double_plus_un). + Lemma ad_double_plus_un_monotonic : ad_monotonic ad_double_plus_un. Proof. - Unfold ad_monotonic. Intros. Rewrite ad_less_def_2. Assumption. + unfold ad_monotonic in |- *. 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))). + Lemma ad_comp_monotonic : + forall pf pf':ad -> ad, + ad_monotonic pf -> + ad_monotonic pf' -> ad_monotonic (fun a0:ad => pf (pf' a0)). Proof. - Unfold ad_monotonic. Intros. Apply H. Apply H0. Exact H1. + unfold ad_monotonic in |- *. 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))). + Lemma ad_comp_double_monotonic : + forall pf:ad -> ad, + ad_monotonic pf -> ad_monotonic (fun a0:ad => pf (ad_double a0)). Proof. - Intros. Apply ad_comp_monotonic. Assumption. - Exact ad_double_monotonic. + 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))). + Lemma ad_comp_double_plus_un_monotonic : + forall pf:ad -> ad, + ad_monotonic pf -> ad_monotonic (fun a0:ad => pf (ad_double_plus_un a0)). Proof. - Intros. Apply ad_comp_monotonic. Assumption. - Exact ad_double_plus_un_monotonic. + 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)) + Lemma alist_of_Map_sorts_1 : + forall (m:Map A) (pf:ad -> ad), + ad_monotonic pf -> + alist_sorted_2 (MapFold1 A (alist A) (anil A) (aapp A) - [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. + (fun (a:ad) (y:A) => acons A (a, y) (anil A)) pf m). + Proof. + simple induction m. simpl in |- *. intros. apply alist_sorted_1_imp_2. apply alist_sorted_imp_1. reflexivity. + intros. simpl in |- *. apply alist_sorted_1_imp_2. apply alist_sorted_imp_1. reflexivity. + intros. simpl in |- *. apply alist_conc_sorted. + exact + (H (fun a0:ad => pf (ad_double a0)) (ad_comp_double_monotonic pf H1)). + exact + (H0 (fun a0:ad => pf (ad_double_plus_un a0)) + (ad_comp_double_plus_un_monotonic pf H1)). + intros. elim + (alist_of_Map_nth_ad m0 (fun a0:ad => pf (ad_double a0)) + (MapFold1 A (alist A) (anil A) (aapp A) + (fun (a0:ad) (y:A) => acons A (a0, y) (anil A)) + (fun a0:ad => pf (ad_double a0)) m0) (refl_equal _) n H2). + intros a H4. rewrite H4. elim + (alist_of_Map_nth_ad m1 (fun a0:ad => pf (ad_double_plus_un a0)) + (MapFold1 A (alist A) (anil A) (aapp A) + (fun (a0:ad) (y:A) => acons A (a0, y) (anil A)) + (fun 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 : + forall m:Map A, alist_sorted (alist_of_Map A m) = true. + Proof. + intro. apply alist_sorted_2_imp. + exact + (alist_of_Map_sorts_1 m (fun a0:ad => a0) + (fun (a a':ad) (p:ad_less a a' = true) => p)). + Qed. + + Lemma alist_of_Map_sorts1 : + forall m:Map A, alist_sorted_1 (alist_of_Map A m). + Proof. + intro. apply alist_sorted_imp_1. apply alist_of_Map_sorts. Qed. - Lemma alist_of_Map_sorts2 : (m:(Map A)) (alist_sorted_2 (alist_of_Map A m)). + Lemma alist_of_Map_sorts2 : + forall m:Map A, alist_sorted_2 (alist_of_Map A m). Proof. - Intro. Apply alist_sorted_1_imp_2. Apply alist_of_Map_sorts1. + 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. + Lemma ad_less_total : + forall a a':ad, {ad_less a a' = true} + {ad_less a' a = true} + {a = a'}. + Proof. + intro a. refine + (ad_rec_double a + (fun a:ad => + forall 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' + (fun 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' + (fun 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 : + forall (l:alist A) (a a':ad) (y:A), + ad_less a a' = true -> + alist_sorted_2 ((a', y) :: l) -> + alist_semantics A ((a', y) :: l) a = NONE A. + Proof. + simple induction l. intros. simpl in |- *. 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 + (match ad_eq a1 a0 with + | true => SOME A y0 + | false => alist_semantics A ((a, y) :: l0) a0 + end = NONE A) in |- *. + 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 in |- *. apply le_n_S. apply le_n_S. apply le_O_n. + apply alist_sorted_1_imp_2. apply alist_sorted_imp_1. + cut (alist_sorted ((a1, y0) :: (a, y) :: l0) = true). intro H3. + exact (proj2 (andb_prop _ _ H3)). + apply alist_sorted_2_imp. assumption. + Qed. + + Lemma alist_semantics_nth_ad : + forall (l:alist A) (a:ad) (y:A), + alist_semantics A l a = SOME A y -> + {n : nat | S n <= length l /\ alist_nth_ad n l = a}. + Proof. + simple induction l. intros. discriminate H. + intro r. elim r. intros a y l0 H a0 y0 H0. simpl in H0. elim (sumbool_of_bool (ad_eq a a0)). + intro H1. rewrite H1 in H0. split with 0. split. simpl in |- *. apply le_n_S. apply le_O_n. + simpl in |- *. exact (ad_eq_complete _ _ H1). + intro H1. rewrite H1 in H0. elim (H a0 y0 H0). intros n' H2. split with (S n'). split. + simpl in |- *. apply le_n_S. exact (proj1 H2). + exact (proj2 H2). + Qed. + + Lemma alist_semantics_tail : + forall (l:alist A) (a:ad) (y:A), + alist_sorted_2 ((a, y) :: l) -> + eqm A (alist_semantics A l) + (fun a0:ad => + if ad_eq a a0 then NONE A else alist_semantics A ((a, y) :: l) a0). + Proof. + unfold eqm in |- *. 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 ((a, y) :: l)) + (alist_nth_ad (S n) ((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 in |- *. apply le_n_S. assumption. + trivial. + intro H0. simpl in |- *. rewrite H0. reflexivity. + Qed. + + Lemma alist_semantics_same_tail : + forall (l l':alist A) (a:ad) (y:A), + alist_sorted_2 ((a, y) :: l) -> + alist_sorted_2 ((a, y) :: l') -> + eqm A (alist_semantics A ((a, y) :: l)) + (alist_semantics A ((a, y) :: l')) -> + eqm A (alist_semantics A l) (alist_semantics A l'). + Proof. + unfold eqm in |- *. intros. rewrite (alist_semantics_tail _ _ _ H a0). + rewrite (alist_semantics_tail _ _ _ H0 a0). case (ad_eq a a0). reflexivity. + exact (H1 a0). + Qed. + + Lemma alist_sorted_tail : + forall (l:alist A) (a:ad) (y:A), + alist_sorted_2 ((a, y) :: l) -> alist_sorted_2 l. + Proof. + unfold alist_sorted_2 in |- *. intros. apply (H (S m) (S n)). apply lt_n_S. assumption. + simpl in |- *. apply le_n_S. assumption. + Qed. + + Lemma alist_canonical : + forall l l':alist A, + eqm A (alist_semantics A l) (alist_semantics A l') -> + alist_sorted_2 l -> alist_sorted_2 l' -> l = l'. + Proof. + unfold eqm in |- *. simple induction l. simple induction l'. trivial. + intro r. elim r. intros a y l0 H H0 H1 H2. simpl in H0. + cut + (NONE A = + match ad_eq a a with + | true => SOME A y + | false => 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. simple induction l'. intros. simpl in H0. + cut + (match ad_eq a a with + | true => SOME A y + | false => 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 ((a, y) :: l0) a = + alist_semantics A ((a', y') :: l'0) a). + intro. rewrite (alist_too_low l'0 a a' y' H5 H3) in H6. simpl in H6. + rewrite (ad_eq_correct a) in H6. discriminate H6. + exact (H1 a). + intro H5. cut + (alist_semantics A ((a, y) :: l0) a' = + alist_semantics A ((a', y') :: l'0) a'). + intro. rewrite (alist_too_low l0 a' a y H5 H2) in H6. simpl in H6. + rewrite (ad_eq_correct a') in H6. discriminate H6. + exact (H1 a'). + intro H4. rewrite H4. + cut + (alist_semantics A ((a, y) :: l0) a = + alist_semantics A ((a', y') :: l'0) a). + intro. simpl in H5. rewrite H4 in H5. rewrite (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.
\ No newline at end of file diff --git a/theories/IntMap/Map.v b/theories/IntMap/Map.v index b89f610421..68091d6f0b 100644 --- a/theories/IntMap/Map.v +++ b/theories/IntMap/Map.v @@ -9,12 +9,12 @@ (** Definition of finite sets as trees indexed by adresses *) -Require Bool. -Require Sumbool. -Require ZArith. -Require Addr. -Require Adist. -Require Addec. +Require Import Bool. +Require Import Sumbool. +Require Import ZArith. +Require Import Addr. +Require Import Adist. +Require Import Addec. Section MapDefs. @@ -23,174 +23,197 @@ Section MapDefs. Variable A : Set. Inductive Map : Set := - M0 : Map + | M0 : Map | M1 : ad -> A -> Map | M2 : Map -> Map -> Map. Inductive option : Set := - NONE : option + | NONE : option | SOME : A -> option. - Lemma option_sum : (o:option) {y:A | o=(SOME y)}+{o=NONE}. + Lemma option_sum : forall o:option, {y : A | o = SOME y} + {o = NONE}. Proof. - Induction o. Right . Reflexivity. - Left . Split with a. Reflexivity. + simple 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 + Fixpoint MapGet (m:Map) : ad -> option := + match m with + | M0 => fun a:ad => NONE + | M1 x y => fun a:ad => if ad_eq x a then SOME y else NONE + | M2 m1 m2 => + fun a:ad => + match a with + | 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). + Definition eqm (g g':ad -> option) := forall a:ad, g a = g' a. - Lemma newMap_semantics : (eqm (MapGet newMap) [a:ad] NONE). + Lemma newMap_semantics : eqm (MapGet newMap) (fun a:ad => NONE). Proof. - Simpl. Unfold eqm. Trivial. + simpl in |- *. unfold eqm in |- *. 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). + Lemma MapSingleton_semantics : + forall (a:ad) (y:A), + eqm (MapGet (MapSingleton a y)) + (fun a':ad => if ad_eq a a' then SOME y else NONE). Proof. - Simpl. Unfold eqm. Trivial. + simpl in |- *. unfold eqm in |- *. trivial. Qed. - Lemma M1_semantics_1 : (a:ad) (y:A) (MapGet (M1 a y) a)=(SOME y). + Lemma M1_semantics_1 : forall (a:ad) (y:A), MapGet (M1 a y) a = SOME y. Proof. - Unfold MapGet. Intros. Rewrite (ad_eq_correct a). Reflexivity. + unfold MapGet in |- *. 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. + forall (a a':ad) (y:A), ad_eq a a' = false -> MapGet (M1 a y) a' = NONE. Proof. - Intros. Simpl. Rewrite H. Reflexivity. + intros. simpl in |- *. rewrite H. reflexivity. Qed. Lemma Map2_semantics_1 : - (m,m':Map) (eqm (MapGet m) [a:ad] (MapGet (M2 m m') (ad_double a))). + forall m m':Map, + eqm (MapGet m) (fun a:ad => MapGet (M2 m m') (ad_double a)). Proof. - Unfold eqm. Induction a; Trivial. + unfold eqm in |- *. simple 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))). + Lemma Map2_semantics_1_eq : + forall (m m':Map) (f:ad -> option), + eqm (MapGet (M2 m m')) f -> eqm (MapGet m) (fun a:ad => f (ad_double a)). Proof. - Unfold eqm. - Intros. - Rewrite <- (H (ad_double a)). - Exact (Map2_semantics_1 m m' a). + unfold eqm in |- *. + 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 + forall m m':Map, + eqm (MapGet m') (fun a:ad => MapGet (M2 m m') (ad_double_plus_un a)). + Proof. + unfold eqm in |- *. simple induction a; trivial. + Qed. + + Lemma Map2_semantics_2_eq : + forall (m m':Map) (f:ad -> option), + eqm (MapGet (M2 m m')) f -> + eqm (MapGet m') (fun a:ad => f (ad_double_plus_un a)). + Proof. + unfold eqm in |- *. + intros. + rewrite <- (H (ad_double_plus_un a)). + exact (Map2_semantics_2 m m' a). + Qed. + + Lemma MapGet_M2_bit_0_0 : + forall a:ad, + ad_bit_0 a = false -> + forall m m':Map, MapGet (M2 m m') a = MapGet m (ad_div_2 a). + Proof. + simple induction a; trivial. simple induction p. intros. discriminate H0. + trivial. + intros. discriminate H. + Qed. + + Lemma MapGet_M2_bit_0_1 : + forall a:ad, + ad_bit_0 a = true -> + forall m m':Map, MapGet (M2 m m') a = MapGet m' (ad_div_2 a). + Proof. + simple induction a. intros. discriminate H. + simple induction p. trivial. + intros. discriminate H0. + trivial. + Qed. + + Lemma MapGet_M2_bit_0_if : + forall (m m':Map) (a:ad), + MapGet (M2 m m') a = + (if 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 : + forall (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 : + forall m m':Map, + eqm (MapGet (M2 m m')) + (fun a:ad => + match ad_bit_0 a with + | false => MapGet m (ad_div_2 a) + | true => MapGet m' (ad_div_2 a) + end). + Proof. + unfold eqm in |- *. + simple induction a; trivial. + simple induction p; trivial. + Qed. + + Lemma Map2_semantics_3_eq : + forall (m m':Map) (f f':ad -> option), + eqm (MapGet m) f -> + eqm (MapGet m') f' -> + eqm (MapGet (M2 m m')) + (fun a:ad => + match ad_bit_0 a with + | false => f (ad_div_2 a) + | true => f' (ad_div_2 a) + end). + Proof. + unfold eqm in |- *. + 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) {struct p} : + Map := + match p with + | xO p' => + let m := MapPut1 (ad_div_2 a) y (ad_div_2 a') y' p' in + match ad_bit_0 a with + | false => M2 m M0 + | true => M2 M0 m + end + | _ => + match ad_bit_0 a with + | 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)). + Lemma MapGet_if_commute : + forall (b:bool) (m m':Map) (a:ad), + MapGet (if b then m else m') a = (if b then MapGet m a else MapGet m' a). Proof. - Intros. Case b; Trivial. + intros. case b; trivial. Qed. (*i @@ -206,581 +229,637 @@ Section MapDefs. Qed. i*) - Lemma MapGet_if_same : (m:Map) (b:bool) (a:ad) - (MapGet (if b then m else m) a)=(MapGet m a). + Lemma MapGet_if_same : + forall (m:Map) (b:bool) (a:ad), MapGet (if b then m else m) a = MapGet m a. Proof. - Induction b;Trivial. + simple 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)). + Lemma MapGet_M2_bit_0_2 : + forall (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. + 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). + Lemma MapPut1_semantics_1 : + forall (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. + simple induction p. intros. unfold MapPut1 in |- *. rewrite MapGet_M2_bit_0_2. apply M1_semantics_1. + intros. simpl in |- *. rewrite MapGet_M2_bit_0_2. apply H. rewrite <- ad_xor_div_2. rewrite H0. + reflexivity. + intros. unfold MapPut1 in |- *. 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'). + Lemma MapPut1_semantics_2 : + forall (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. + simple induction p. intros. unfold MapPut1 in |- *. 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 in |- *. 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 in |- *. 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. + Lemma MapGet_M2_both_NONE : + forall (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. + 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) + Lemma MapPut1_semantics_3 : + forall (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. + simple induction p. intros. unfold MapPut1 in |- *. 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 in |- *. 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 in |- *. 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 : + forall (p:positive) (a a':ad) (y y':A), + ad_xor a a' = ad_x p -> + eqm (MapGet (MapPut1 a y a' y' p)) + (fun a0:ad => + if ad_eq a a0 + then SOME y + else if ad_eq a' a0 then SOME y' else NONE). + Proof. + unfold eqm in |- *. 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' : + forall (p:positive) (a a':ad) (y y':A), + ad_xor a a' = ad_x p -> + eqm (MapGet (MapPut1 a y a' y' p)) + (fun a0:ad => + if ad_eq a' a0 + then SOME y' + else if ad_eq a a0 then SOME y else NONE). + Proof. + unfold eqm in |- *. intros. rewrite (MapPut1_semantics p a a' y y' H a0). + elim (sumbool_of_bool (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 := + match m with + | M0 => M1 + | M1 a y => + fun (a':ad) (y':A) => + match ad_xor a a' with + | ad_z => M1 a' y' + | ad_x p => MapPut1 a y a' y' p + end + | M2 m1 m2 => + fun (a:ad) (y:A) => + match a with + | 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 - | (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) + Lemma MapPut_semantics_1 : + forall (a:ad) (y:A) (a0:ad), + MapGet (MapPut M0 a y) a0 = MapGet (M1 a y) a0. + Proof. + trivial. + Qed. + + Lemma MapPut_semantics_2_1 : + forall (a:ad) (y y':A) (a0:ad), + MapGet (MapPut (M1 a y) a y') a0 = + (if ad_eq a a0 then SOME y' else NONE). + Proof. + simpl in |- *. intros. rewrite (ad_xor_nilpotent a). trivial. + Qed. + + Lemma MapPut_semantics_2_2 : + forall (a a':ad) (y y':A) (a0 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. + simple induction a''. intro. rewrite (ad_xor_eq _ _ H). rewrite MapPut_semantics_2_1. + case (ad_eq a' a0); trivial. + intros. simpl in |- *. 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 : + forall (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 : + forall (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. + simple induction a. trivial. + simple induction p; trivial. + Qed. + + Lemma MapPut_semantics : + forall (m:Map) (a:ad) (y:A), + eqm (MapGet (MapPut m a y)) + (fun a':ad => if ad_eq a a' then SOME y else MapGet m a'). + Proof. + unfold eqm in |- *. simple induction m. exact MapPut_semantics_1. + intros. unfold MapGet at 2 in |- *. apply MapPut_semantics_2; assumption. + intros. rewrite MapPut_semantics_3_1. rewrite (MapGet_M2_bit_0_if m0 m1 a0). + elim (sumbool_of_bool (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 := + match m with + | M0 => M1 + | M1 a y => + fun (a':ad) (y':A) => + match ad_xor a a' with + | ad_z => m + | ad_x p => MapPut1 a y a' y' p + end + | M2 m1 m2 => + fun (a:ad) (y:A) => + match a with + | 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 - | (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) + Lemma MapPut_behind_semantics_3_1 : + forall (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. + simple induction a. trivial. + simple induction p; trivial. + Qed. + + Lemma MapPut_behind_as_before_1 : + forall a a' a0:ad, + ad_eq a' a0 = false -> + forall y y':A, + MapGet (MapPut (M1 a y) a' y') a0 = + MapGet (MapPut_behind (M1 a y) a' y') a0. + Proof. + intros a a' a0. simpl in |- *. intros H y y'. elim (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 : + forall (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. + simple induction m. trivial. + intros a y a' y' a0 H. exact (MapPut_behind_as_before_1 a a' a0 H y y'). + intros. rewrite MapPut_semantics_3_1. rewrite MapPut_behind_semantics_3_1. + elim (sumbool_of_bool (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 : + forall (m:Map) (a:ad) (y:A), + MapGet (MapPut_behind m a y) a = + match MapGet m a with + | SOME y' => SOME y' + | _ => SOME y + end. + Proof. + simple induction m. simpl in |- *. intros. rewrite (ad_eq_correct a). reflexivity. + intros. elim (ad_sum (ad_xor a a1)). intro H. elim H. intros p H0. simpl in |- *. + rewrite H0. rewrite (ad_xor_eq_false a a1 p). exact (MapPut1_semantics_2 p a a1 a0 y H0). + assumption. + intro H. simpl in |- *. 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 : + forall (m:Map) (a:ad) (y:A), + eqm (MapGet (MapPut_behind m a y)) + (fun a':ad => + match MapGet m a' with + | SOME y' => SOME y' + | _ => if ad_eq a a' then SOME y else NONE + end). + Proof. + unfold eqm in |- *. 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) := + match m, m' with + | 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 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')) + Lemma makeM2_M2 : + forall m m':Map, eqm (MapGet (makeM2 m m')) (MapGet (M2 m m')). + Proof. + unfold eqm in |- *. intros. elim (sumbool_of_bool (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 in |- *. rewrite (ad_bit_0_1_not_double a H a0). reflexivity. + intros m1 m2. unfold makeM2 in |- *. rewrite MapGet_M2_bit_0_1. reflexivity. + assumption. + case m. intros a0 y. simpl in |- *. elim (sumbool_of_bool (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 in |- *. rewrite MapGet_M2_bit_0_1. reflexivity. + assumption. + intros m1 m2 a0 y. unfold makeM2 in |- *. rewrite MapGet_M2_bit_0_1. reflexivity. + assumption. + intros m1 m2. unfold makeM2 in |- *. + cut (MapGet (M2 m (M2 m1 m2)) a = MapGet (M2 m1 m2) (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 in |- *. rewrite (ad_bit_0_0_not_double_plus_un a H a0). reflexivity. + intros m1 m2. unfold makeM2 in |- *. rewrite MapGet_M2_bit_0_0. reflexivity. + assumption. + case m'. intros a0 y. simpl in |- *. elim (sumbool_of_bool (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 in |- *. rewrite MapGet_M2_bit_0_0. reflexivity. + assumption. + intros m1 m2 a0 y. unfold makeM2 in |- *. rewrite MapGet_M2_bit_0_0. reflexivity. + assumption. + intros m1 m2. unfold makeM2 in |- *. exact (MapGet_M2_bit_0_0 a H (M2 m1 m2) m'). + Qed. + + Fixpoint MapRemove (m:Map) : ad -> Map := + match m with + | M0 => fun _:ad => M0 + | M1 a y => + fun a':ad => match ad_eq a a' with + | true => M0 + | false => m + end + | M2 m1 m2 => + fun 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. - 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 + Lemma MapRemove_semantics : + forall (m:Map) (a:ad), + eqm (MapGet (MapRemove m a)) + (fun a':ad => if ad_eq a a' then NONE else MapGet m a'). + Proof. + unfold eqm in |- *. simple induction m. simpl in |- *. intros. case (ad_eq a a0); trivial. + intros. simpl in |- *. 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)) + in |- *. + 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 := + match m with + | M0 => 0 + | M1 _ _ => 1 + | M2 m m' => MapCard m + MapCard m' + end. + + Fixpoint MapMerge (m:Map) : Map -> Map := + match m with + | M0 => fun m':Map => m' + | M1 a y => fun m':Map => MapPut_behind m' a y + | M2 m1 m2 => + fun m':Map => + match m' with + | M0 => m + | M1 a' y' => MapPut m a' y' + | M2 m'1 m'2 => M2 (MapMerge m1 m'1) (MapMerge m2 m'2) + end end. - Lemma MapMerge_semantics : (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. + Lemma MapMerge_semantics : + forall m m':Map, + eqm (MapGet (MapMerge m m')) + (fun a0:ad => + match MapGet m' a0 with + | SOME y' => SOME y' + | NONE => MapGet m a0 + end). + Proof. + unfold eqm in |- *. simple induction m. intros. simpl in |- *. case (MapGet m' a); trivial. + intros. simpl in |- *. rewrite (MapPut_behind_semantics m' a a0 a1). reflexivity. + simple induction m'. trivial. + intros. unfold MapMerge in |- *. rewrite (MapPut_semantics (M2 m0 m1) a a0 a1). + elim (sumbool_of_bool (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 + Fixpoint MapDelta (m:Map) : Map -> Map := + match m with + | M0 => fun m':Map => m' + | M1 a y => + fun m':Map => + match MapGet m' a with + | NONE => MapPut m' a y + | _ => MapRemove m' a + end + | M2 m1 m2 => + fun m':Map => + match m' with + | M0 => m + | M1 a' y' => + match MapGet m a' with + | NONE => MapPut m a' y' + | _ => MapRemove m a' + end + | M2 m'1 m'2 => makeM2 (MapDelta m1 m'1) (MapDelta m2 m'2) + end end. - Lemma MapEmptyp_correct : (MapEmptyp M0)=true. - Proof. - Reflexivity. - Qed. - - Lemma MapEmptyp_complete : (m:Map) (MapEmptyp m)=true -> m=M0. + Lemma MapDelta_semantics_comm : + forall m m':Map, eqm (MapGet (MapDelta m m')) (MapGet (MapDelta m' m)). + Proof. + unfold eqm in |- *. simple induction m. simple induction m'; reflexivity. + simple induction m'. reflexivity. + unfold MapDelta in |- *. intros. elim (sumbool_of_bool (ad_eq a a1)). intro H. + rewrite <- (ad_eq_complete _ _ H). rewrite (M1_semantics_1 a a2). + rewrite (M1_semantics_1 a a0). simpl in |- *. 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. + simple induction m'. reflexivity. + reflexivity. + intros. simpl in |- *. rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a). + rewrite (makeM2_M2 (MapDelta m2 m0) (MapDelta m3 m1) a). + rewrite (MapGet_M2_bit_0_if (MapDelta m0 m2) (MapDelta m1 m3) a). + rewrite (MapGet_M2_bit_0_if (MapDelta m2 m0) (MapDelta m3 m1) a). + rewrite (H0 m3 (ad_div_2 a)). rewrite (H m2 (ad_div_2 a)). reflexivity. + Qed. + + Lemma MapDelta_semantics_1_1 : + forall (a:ad) (y:A) (m':Map) (a0:ad), + MapGet (M1 a y) a0 = NONE -> + MapGet m' a0 = NONE -> MapGet (MapDelta (M1 a y) m') a0 = NONE. + Proof. + intros. unfold MapDelta in |- *. elim (sumbool_of_bool (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 : + forall (m m':Map) (a:ad), + MapGet m a = NONE -> + MapGet m' a = NONE -> MapGet (MapDelta m m') a = NONE. + Proof. + simple induction m. trivial. + exact MapDelta_semantics_1_1. + simple induction m'. trivial. + intros. rewrite (MapDelta_semantics_comm (M2 m0 m1) (M1 a a0) a1). + apply MapDelta_semantics_1_1; trivial. + intros. simpl in |- *. rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a). + rewrite MapGet_M2_bit_0_if. elim (sumbool_of_bool (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 : + forall (a:ad) (y:A) (m':Map) (a0:ad) (y0:A), + MapGet (M1 a y) a0 = NONE -> + MapGet m' a0 = SOME y0 -> MapGet (MapDelta (M1 a y) m') a0 = SOME y0. + Proof. + intros. unfold MapDelta in |- *. elim (sumbool_of_bool (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 : + forall (a:ad) (y:A) (m':Map) (a0:ad) (y0:A), + MapGet (M1 a y) a0 = SOME y0 -> + MapGet m' a0 = NONE -> MapGet (MapDelta (M1 a y) m') a0 = SOME y0. + Proof. + intros. unfold MapDelta in |- *. elim (sumbool_of_bool (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 : + forall (m m':Map) (a:ad) (y:A), + MapGet m a = NONE -> + MapGet m' a = SOME y -> MapGet (MapDelta m m') a = SOME y. + Proof. + simple induction m. trivial. + exact MapDelta_semantics_2_1. + simple induction m'. intros. discriminate H2. + intros. rewrite (MapDelta_semantics_comm (M2 m0 m1) (M1 a a0) a1). + apply MapDelta_semantics_2_2; assumption. + intros. simpl in |- *. rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a). + rewrite MapGet_M2_bit_0_if. elim (sumbool_of_bool (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 : + forall (a0:ad) (y0:A) (m':Map) (a:ad) (y y':A), + MapGet (M1 a0 y0) a = SOME y -> + MapGet m' a = SOME y' -> MapGet (MapDelta (M1 a0 y0) m') a = NONE. + Proof. + intros. unfold MapDelta in |- *. elim (sumbool_of_bool (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 : + forall (m m':Map) (a:ad) (y y':A), + MapGet m a = SOME y -> + MapGet m' a = SOME y' -> MapGet (MapDelta m m') a = NONE. + Proof. + simple induction m. intros. discriminate H. + exact MapDelta_semantics_3_1. + simple induction m'. intros. discriminate H2. + intros. rewrite (MapDelta_semantics_comm (M2 m0 m1) (M1 a a0) a1). + exact (MapDelta_semantics_3_1 a a0 (M2 m0 m1) a1 y' y H2 H1). + intros. simpl in |- *. rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a). + rewrite MapGet_M2_bit_0_if. elim (sumbool_of_bool (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 : + forall m m':Map, + eqm (MapGet (MapDelta m m')) + (fun a0:ad => + match MapGet m a0, MapGet m' a0 with + | NONE, SOME y' => SOME y' + | SOME y, NONE => SOME y + | _, _ => NONE + end). + Proof. + unfold eqm in |- *. intros. elim (option_sum (MapGet m' a)). intro H. elim H. intros a0 H0. + rewrite H0. elim (option_sum (MapGet m a)). intro H1. elim H1. intros a1 H2. rewrite H2. + exact (MapDelta_semantics_3 m m' a a1 a0 H2 H0). + intro H1. rewrite H1. exact (MapDelta_semantics_2 m m' a a0 H1 H0). + intro H. rewrite H. elim (option_sum (MapGet m a)). intro H0. elim H0. intros a0 H1. + rewrite H1. rewrite (MapDelta_semantics_comm m m' a). + exact (MapDelta_semantics_2 m' m a a0 H H1). + intro H0. rewrite H0. exact (MapDelta_semantics_1 m m' a H0 H). + Qed. + + Definition MapEmptyp (m:Map) := match m with + | M0 => true + | _ => false + end. + + Lemma MapEmptyp_correct : MapEmptyp M0 = true. Proof. - Induction m; Trivial. Intros. Discriminate H. - Intros. Discriminate H1. + reflexivity. + Qed. + + Lemma MapEmptyp_complete : forall m:Map, MapEmptyp m = true -> m = M0. + Proof. + simple induction m; trivial. intros. discriminate H. + intros. discriminate H1. Qed. (** [MapSplit] not implemented: not the preferred way of recursing over Maps (use [MapSweep], [MapCollect], or [MapFold] in Mapiter.v. *) -End MapDefs. +End MapDefs.
\ No newline at end of file diff --git a/theories/IntMap/Mapaxioms.v b/theories/IntMap/Mapaxioms.v index 7ab131c77b..874a4b9ef3 100644 --- a/theories/IntMap/Mapaxioms.v +++ b/theories/IntMap/Mapaxioms.v @@ -7,664 +7,757 @@ (***********************************************************************) (*i $Id$ i*) -Require Bool. -Require Sumbool. -Require ZArith. -Require Addr. -Require Adist. -Require Addec. -Require Map. -Require Fset. +Require Import Bool. +Require Import Sumbool. +Require Import ZArith. +Require Import Addr. +Require Import Adist. +Require Import Addec. +Require Import Map. +Require Import Fset. Section MapAxioms. - Variable A, B, C : Set. + Variables A B C : Set. - Lemma eqm_sym : (f,f':ad->(option A)) (eqm A f f') -> (eqm A f' f). + Lemma eqm_sym : forall f f':ad -> option A, eqm A f f' -> eqm A f' f. Proof. - Unfold eqm. Intros. Rewrite H. Reflexivity. + unfold eqm in |- *. intros. rewrite H. reflexivity. Qed. - Lemma eqm_refl : (f:ad->(option A)) (eqm A f f). + Lemma eqm_refl : forall f:ad -> option A, eqm A f f. Proof. - Unfold eqm. Trivial. + unfold eqm in |- *. trivial. Qed. - Lemma eqm_trans : (f,f',f'':ad->(option A)) (eqm A f f') -> (eqm A f' f'') -> (eqm A f f''). + Lemma eqm_trans : + forall f f' f'':ad -> option A, eqm A f f' -> eqm A f' f'' -> eqm A f f''. Proof. - Unfold eqm. Intros. Rewrite H. Exact (H0 a). + unfold eqm in |- *. intros. rewrite H. exact (H0 a). Qed. - Definition eqmap := [m,m':(Map A)] (eqm A (MapGet A m) (MapGet A m')). + 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). + Lemma eqmap_sym : forall m m':Map A, eqmap m m' -> eqmap m' m. Proof. - Intros. Unfold eqmap. Apply eqm_sym. Assumption. + intros. unfold eqmap in |- *. apply eqm_sym. assumption. Qed. - Lemma eqmap_refl : (m:(Map A)) (eqmap m m). + Lemma eqmap_refl : forall m:Map A, eqmap m m. Proof. - Intros. Unfold eqmap. Apply eqm_refl. + intros. unfold eqmap in |- *. apply eqm_refl. Qed. - Lemma eqmap_trans : (m,m',m'':(Map A)) (eqmap m m') -> (eqmap m' m'') -> (eqmap m m''). + Lemma eqmap_trans : + forall m m' m'':Map A, eqmap m m' -> eqmap m' m'' -> eqmap m m''. Proof. - Intros. Exact (eqm_trans (MapGet A m) (MapGet A m') (MapGet A m'') H H0). + 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))). + Lemma MapPut_as_Merge : + forall (m:Map A) (a:ad) (y:A), + eqmap (MapPut A m a y) (MapMerge A m (M1 A a y)). Proof. - Unfold eqmap eqm. 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. + unfold eqmap, eqm in |- *. intros. rewrite (MapPut_semantics A m a y a0). + rewrite (MapMerge_semantics A m (M1 A a y) a0). unfold MapGet at 2 in |- *. + 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)). + Lemma MapPut_ext : + forall m m':Map A, + eqmap m m' -> + forall (a:ad) (y:A), eqmap (MapPut A m a y) (MapPut A m' a y). Proof. - Unfold eqmap eqm. 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 ]. + unfold eqmap, eqm in |- *. 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)). + Lemma MapPut_behind_as_Merge : + forall (m:Map A) (a:ad) (y:A), + eqmap (MapPut_behind A m a y) (MapMerge A (M1 A a y) m). Proof. - Unfold eqmap eqm. Intros. Rewrite (MapPut_behind_semantics A m a y a0). - Rewrite (MapMerge_semantics A (M1 A a y) m a0). Reflexivity. + unfold eqmap, eqm in |- *. intros. rewrite (MapPut_behind_semantics A m a y a0). + rewrite (MapMerge_semantics A (M1 A a y) m a0). reflexivity. Qed. - Lemma MapPut_behind_ext : (m,m':(Map A)) (eqmap m m') -> - (a:ad) (y:A) (eqmap (MapPut_behind A m a y) (MapPut_behind A m' a y)). + Lemma MapPut_behind_ext : + forall m m':Map A, + eqmap m m' -> + forall (a:ad) (y:A), + eqmap (MapPut_behind A m a y) (MapPut_behind A m' a y). Proof. - Unfold eqmap eqm. Intros. Rewrite (MapPut_behind_semantics A m' a y a0). - Rewrite (MapPut_behind_semantics A m a y a0). Rewrite (H a0). Reflexivity. + unfold eqmap, eqm in |- *. intros. rewrite (MapPut_behind_semantics A m' a y a0). + rewrite (MapPut_behind_semantics A m a y a0). rewrite (H a0). reflexivity. Qed. - Lemma MapMerge_empty_m_1 : (m:(Map A)) (MapMerge A (M0 A) m)=m. + Lemma MapMerge_empty_m_1 : forall m:Map A, MapMerge A (M0 A) m = m. Proof. - Trivial. + trivial. Qed. - Lemma MapMerge_empty_m : (m:(Map A)) (eqmap (MapMerge A (M0 A) m) m). + Lemma MapMerge_empty_m : forall m:Map A, eqmap (MapMerge A (M0 A) m) m. Proof. - Unfold eqmap eqm. Trivial. + unfold eqmap, eqm in |- *. trivial. Qed. - Lemma MapMerge_m_empty_1 : (m:(Map A)) (MapMerge A m (M0 A))=m. + Lemma MapMerge_m_empty_1 : forall m:Map A, MapMerge A m (M0 A) = m. Proof. - Induction m;Trivial. + simple induction m; trivial. Qed. - Lemma MapMerge_m_empty : (m:(Map A)) (eqmap (MapMerge A m (M0 A)) m). + Lemma MapMerge_m_empty : forall m:Map A, eqmap (MapMerge A m (M0 A)) m. Proof. - Unfold eqmap eqm. Intros. Rewrite MapMerge_m_empty_1. Reflexivity. + unfold eqmap, eqm in |- *. 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)). + Lemma MapMerge_empty_l : + forall 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). + unfold eqmap, eqm in |- *. intros. cut (MapGet A (MapMerge A m m') a = MapGet A (M0 A) a). + rewrite (MapMerge_semantics A m m' a). case (MapGet A m' a). trivial. + intros. discriminate H0. + exact (H a). Qed. - Lemma MapMerge_empty_r : (m,m':(Map A)) (eqmap (MapMerge A m m') (M0 A)) -> - (eqmap m' (M0 A)). + Lemma MapMerge_empty_r : + forall 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). + unfold eqmap, eqm in |- *. intros. cut (MapGet A (MapMerge A m m') a = MapGet A (M0 A) a). + rewrite (MapMerge_semantics A m m' a). case (MapGet A m' a). trivial. + intros. discriminate H0. + exact (H a). Qed. - Lemma MapMerge_assoc : (m,m',m'':(Map A)) (eqmap - (MapMerge A (MapMerge A m m') m'') - (MapMerge A m (MapMerge A m' m''))). + Lemma MapMerge_assoc : + forall m m' m'':Map A, + eqmap (MapMerge A (MapMerge A m m') m'') + (MapMerge A m (MapMerge A m' m'')). Proof. - Unfold eqmap eqm. 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. + unfold eqmap, eqm in |- *. intros. rewrite (MapMerge_semantics A (MapMerge A m m') m'' a). + rewrite (MapMerge_semantics A m (MapMerge A m' m'') a). rewrite (MapMerge_semantics A m m' a). + rewrite (MapMerge_semantics A m' m'' a). + case (MapGet A m'' a); case (MapGet A m' a); trivial. Qed. - Lemma MapMerge_idempotent : (m:(Map A)) (eqmap (MapMerge A m m) m). + Lemma MapMerge_idempotent : forall 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. + unfold eqmap, eqm in |- *. 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)). + Lemma MapMerge_ext : + forall m1 m2 m'1 m'2:Map A, + eqmap m1 m'1 -> + eqmap m2 m'2 -> eqmap (MapMerge A m1 m2) (MapMerge A m'1 m'2). Proof. - Unfold eqmap eqm. Intros. Rewrite (MapMerge_semantics A m1 m2 a). - Rewrite (MapMerge_semantics A m'1 m'2 a). Rewrite (H a). Rewrite (H0 a). Reflexivity. + unfold eqmap, eqm in |- *. intros. rewrite (MapMerge_semantics A m1 m2 a). + rewrite (MapMerge_semantics A m'1 m'2 a). rewrite (H a). rewrite (H0 a). reflexivity. Qed. - Lemma MapMerge_ext_l : (m1,m'1,m2:(Map A)) - (eqmap m1 m'1) -> (eqmap (MapMerge A m1 m2) (MapMerge A m'1 m2)). + Lemma MapMerge_ext_l : + forall m1 m'1 m2:Map A, + eqmap m1 m'1 -> eqmap (MapMerge A m1 m2) (MapMerge A m'1 m2). Proof. - Intros. Apply MapMerge_ext. Assumption. - Apply eqmap_refl. + 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)). + Lemma MapMerge_ext_r : + forall m1 m2 m'2:Map A, + eqmap m2 m'2 -> eqmap (MapMerge A m1 m2) (MapMerge A m1 m'2). Proof. - Intros. Apply MapMerge_ext. Apply eqmap_refl. - Assumption. + 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''))). + Lemma MapMerge_RestrTo_l : + forall m m' m'':Map A, + eqmap (MapMerge A (MapDomRestrTo A A m m') m'') + (MapDomRestrTo A A (MapMerge A m m'') (MapMerge A m' m'')). Proof. - Unfold eqmap eqm. 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. + unfold eqmap, eqm in |- *. intros. rewrite (MapMerge_semantics A (MapDomRestrTo A A m m') m'' a). + rewrite (MapDomRestrTo_semantics A A m m' a). + rewrite + (MapDomRestrTo_semantics A A (MapMerge A m m'') (MapMerge A m' m'') a) + . + rewrite (MapMerge_semantics A m' m'' a). rewrite (MapMerge_semantics A m m'' a). + case (MapGet A m'' a); case (MapGet A m' a); reflexivity. Qed. - Lemma MapRemove_as_RestrBy : (m:(Map A)) (a:ad) (y:B) - (eqmap (MapRemove A m a) (MapDomRestrBy A B m (M1 B a y))). + Lemma MapRemove_as_RestrBy : + forall (m:Map A) (a:ad) (y:B), + eqmap (MapRemove A m a) (MapDomRestrBy A B m (M1 B a y)). Proof. - Unfold eqmap eqm. 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. + unfold eqmap, eqm in |- *. intros. rewrite (MapRemove_semantics A m a a0). + rewrite (MapDomRestrBy_semantics A B m (M1 B a y) a0). elim (sumbool_of_bool (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)). + Lemma MapRemove_ext : + forall m m':Map A, + eqmap m m' -> forall a:ad, eqmap (MapRemove A m a) (MapRemove A m' a). Proof. - Unfold eqmap eqm. Intros. Rewrite (MapRemove_semantics A m' a a0). - Rewrite (MapRemove_semantics A m a a0). - Case (ad_eq a a0); [ Reflexivity | Apply H ]. + unfold eqmap, eqm in |- *. 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). + Lemma MapDomRestrTo_empty_m_1 : + forall m:Map B, MapDomRestrTo A B (M0 A) m = M0 A. Proof. - Trivial. + trivial. Qed. - Lemma MapDomRestrTo_empty_m : - (m:(Map B)) (eqmap (MapDomRestrTo A B (M0 A) m) (M0 A)). + Lemma MapDomRestrTo_empty_m : + forall m:Map B, eqmap (MapDomRestrTo A B (M0 A) m) (M0 A). Proof. - Unfold eqmap eqm. Trivial. + unfold eqmap, eqm in |- *. trivial. Qed. - Lemma MapDomRestrTo_m_empty_1 : - (m:(Map A)) (MapDomRestrTo A B m (M0 B))=(M0 A). + Lemma MapDomRestrTo_m_empty_1 : + forall m:Map A, MapDomRestrTo A B m (M0 B) = M0 A. Proof. - Induction m;Trivial. + simple induction m; trivial. Qed. - Lemma MapDomRestrTo_m_empty : - (m:(Map A)) (eqmap (MapDomRestrTo A B m (M0 B)) (M0 A)). + Lemma MapDomRestrTo_m_empty : + forall m:Map A, eqmap (MapDomRestrTo A B m (M0 B)) (M0 A). Proof. - Unfold eqmap eqm. Intros. Rewrite (MapDomRestrTo_m_empty_1 m). Reflexivity. + unfold eqmap, eqm in |- *. 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''))). + Lemma MapDomRestrTo_assoc : + forall (m:Map A) (m':Map B) (m'':Map C), + eqmap (MapDomRestrTo A C (MapDomRestrTo A B m m') m'') + (MapDomRestrTo A B m (MapDomRestrTo B C m' m'')). Proof. - Unfold eqmap eqm. 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. + unfold eqmap, eqm in |- *. intros. + rewrite (MapDomRestrTo_semantics A C (MapDomRestrTo A B m m') m'' a). + rewrite (MapDomRestrTo_semantics A B m m' a). + rewrite (MapDomRestrTo_semantics A B m (MapDomRestrTo B C m' m'') a). + rewrite (MapDomRestrTo_semantics B C m' m'' a). + case (MapGet C m'' a); case (MapGet B m' a); trivial. Qed. - Lemma MapDomRestrTo_idempotent : (m:(Map A)) (eqmap (MapDomRestrTo A A m m) m). + Lemma MapDomRestrTo_idempotent : + forall 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. + unfold eqmap, eqm in |- *. 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'))). + Lemma MapDomRestrTo_Dom : + forall (m:Map A) (m':Map B), + eqmap (MapDomRestrTo A B m m') (MapDomRestrTo A unit m (MapDom B m')). Proof. - Unfold eqmap eqm. 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. + unfold eqmap, eqm in |- *. intros. rewrite (MapDomRestrTo_semantics A B m m' a). + rewrite (MapDomRestrTo_semantics A unit m (MapDom B m') a). + elim (sumbool_of_bool (in_FSet a (MapDom B m'))). intro H. + elim (MapDom_semantics_2 B m' a H). intros y H0. rewrite H0. unfold in_FSet, in_dom in H. + generalize H. case (MapGet unit (MapDom B m') a); trivial. intro H1. discriminate H1. + intro H. rewrite (MapDom_semantics_4 B m' a H). unfold in_FSet, in_dom in H. + generalize H. case (MapGet unit (MapDom B m') a). trivial. + intros H0 H1. discriminate H1. Qed. - Lemma MapDomRestrBy_empty_m_1 : - (m:(Map B)) (MapDomRestrBy A B (M0 A) m)=(M0 A). + Lemma MapDomRestrBy_empty_m_1 : + forall m:Map B, MapDomRestrBy A B (M0 A) m = M0 A. Proof. - Trivial. + trivial. Qed. - Lemma MapDomRestrBy_empty_m : - (m:(Map B)) (eqmap (MapDomRestrBy A B (M0 A) m) (M0 A)). + Lemma MapDomRestrBy_empty_m : + forall m:Map B, eqmap (MapDomRestrBy A B (M0 A) m) (M0 A). Proof. - Unfold eqmap eqm. Trivial. + unfold eqmap, eqm in |- *. trivial. Qed. - Lemma MapDomRestrBy_m_empty_1 : (m:(Map A)) (MapDomRestrBy A B m (M0 B))=m. + Lemma MapDomRestrBy_m_empty_1 : + forall m:Map A, MapDomRestrBy A B m (M0 B) = m. Proof. - Induction m;Trivial. + simple induction m; trivial. Qed. - Lemma MapDomRestrBy_m_empty : (m:(Map A)) (eqmap (MapDomRestrBy A B m (M0 B)) m). + Lemma MapDomRestrBy_m_empty : + forall m:Map A, eqmap (MapDomRestrBy A B m (M0 B)) m. Proof. - Unfold eqmap eqm. Intros. Rewrite (MapDomRestrBy_m_empty_1 m). Reflexivity. + unfold eqmap, eqm in |- *. 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'))). + Lemma MapDomRestrBy_Dom : + forall (m:Map A) (m':Map B), + eqmap (MapDomRestrBy A B m m') (MapDomRestrBy A unit m (MapDom B m')). Proof. - Unfold eqmap eqm. 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. + unfold eqmap, eqm in |- *. intros. rewrite (MapDomRestrBy_semantics A B m m' a). + rewrite (MapDomRestrBy_semantics A unit m (MapDom B m') a). + elim (sumbool_of_bool (in_FSet a (MapDom B m'))). intro H. + elim (MapDom_semantics_2 B m' a H). intros y H0. rewrite H0. + unfold in_FSet, in_dom in H. generalize H. case (MapGet unit (MapDom B m') a); trivial. + intro H1. discriminate H1. + intro H. rewrite (MapDom_semantics_4 B m' a H). unfold in_FSet, in_dom in H. + generalize H. case (MapGet unit (MapDom B m') a). trivial. + intros H0 H1. discriminate H1. Qed. - Lemma MapDomRestrBy_m_m_1 : (m:(Map A)) (eqmap (MapDomRestrBy A A m m) (M0 A)). + Lemma MapDomRestrBy_m_m_1 : + forall 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. + unfold eqmap, eqm in |- *. 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''))). + Lemma MapDomRestrBy_By : + forall (m:Map A) (m' m'':Map B), + eqmap (MapDomRestrBy A B (MapDomRestrBy A B m m') m'') + (MapDomRestrBy A B m (MapMerge B m' m'')). Proof. - Unfold eqmap eqm. 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. + unfold eqmap, eqm in |- *. intros. + rewrite (MapDomRestrBy_semantics A B (MapDomRestrBy A B m m') m'' a). + rewrite (MapDomRestrBy_semantics A B m m' a). + rewrite (MapDomRestrBy_semantics A B m (MapMerge B m' m'') a). + rewrite (MapMerge_semantics B m' m'' a). + case (MapGet B m'' a); case (MapGet B m' a); trivial. Qed. - Lemma MapDomRestrBy_By_comm : (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')). + Lemma MapDomRestrBy_By_comm : + forall (m:Map A) (m':Map B) (m'':Map C), + eqmap (MapDomRestrBy A C (MapDomRestrBy A B m m') m'') + (MapDomRestrBy A B (MapDomRestrBy A C m m'') m'). Proof. - Unfold eqmap eqm. 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. + unfold eqmap, eqm in |- *. intros. + rewrite (MapDomRestrBy_semantics A C (MapDomRestrBy A B m m') m'' a). + rewrite (MapDomRestrBy_semantics A B m m' a). + rewrite (MapDomRestrBy_semantics A B (MapDomRestrBy A C m m'') m' a). + rewrite (MapDomRestrBy_semantics A C m m'' a). + case (MapGet C m'' a); case (MapGet B m' a); trivial. Qed. - Lemma MapDomRestrBy_To : (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''))). + Lemma MapDomRestrBy_To : + forall (m:Map A) (m':Map B) (m'':Map C), + eqmap (MapDomRestrBy A C (MapDomRestrTo A B m m') m'') + (MapDomRestrTo A B m (MapDomRestrBy B C m' m'')). Proof. - Unfold eqmap eqm. 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. + unfold eqmap, eqm in |- *. intros. + rewrite (MapDomRestrBy_semantics A C (MapDomRestrTo A B m m') m'' a). + rewrite (MapDomRestrTo_semantics A B m m' a). + rewrite (MapDomRestrTo_semantics A B m (MapDomRestrBy B C m' m'') a). + rewrite (MapDomRestrBy_semantics B C m' m'' a). + case (MapGet C m'' a); case (MapGet B m' a); trivial. Qed. - Lemma MapDomRestrBy_To_comm : (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')). + Lemma MapDomRestrBy_To_comm : + forall (m:Map A) (m':Map B) (m'':Map C), + eqmap (MapDomRestrBy A C (MapDomRestrTo A B m m') m'') + (MapDomRestrTo A B (MapDomRestrBy A C m m'') m'). Proof. - Unfold eqmap eqm. 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. + unfold eqmap, eqm in |- *. intros. + rewrite (MapDomRestrBy_semantics A C (MapDomRestrTo A B m m') m'' a). + rewrite (MapDomRestrTo_semantics A B m m' a). + rewrite (MapDomRestrTo_semantics A B (MapDomRestrBy A C m m'') m' a). + rewrite (MapDomRestrBy_semantics A C m m'' a). + case (MapGet C m'' a); case (MapGet B m' a); trivial. Qed. - Lemma MapDomRestrTo_By : (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'))). + Lemma MapDomRestrTo_By : + forall (m:Map A) (m':Map B) (m'':Map C), + eqmap (MapDomRestrTo A C (MapDomRestrBy A B m m') m'') + (MapDomRestrTo A C m (MapDomRestrBy C B m'' m')). Proof. - Unfold eqmap eqm. 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. + unfold eqmap, eqm in |- *. intros. + rewrite (MapDomRestrTo_semantics A C (MapDomRestrBy A B m m') m'' a). + rewrite (MapDomRestrBy_semantics A B m m' a). + rewrite (MapDomRestrTo_semantics A C m (MapDomRestrBy C B m'' m') a). + rewrite (MapDomRestrBy_semantics C B m'' m' a). + case (MapGet C m'' a); case (MapGet B m' a); trivial. Qed. - Lemma MapDomRestrTo_By_comm : (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')). + Lemma MapDomRestrTo_By_comm : + forall (m:Map A) (m':Map B) (m'':Map C), + eqmap (MapDomRestrTo A C (MapDomRestrBy A B m m') m'') + (MapDomRestrBy A B (MapDomRestrTo A C m m'') m'). Proof. - Unfold eqmap eqm. 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. + unfold eqmap, eqm in |- *. intros. + rewrite (MapDomRestrTo_semantics A C (MapDomRestrBy A B m m') m'' a). + rewrite (MapDomRestrBy_semantics A B m m' a). + rewrite (MapDomRestrBy_semantics A B (MapDomRestrTo A C m m'') m' a). + rewrite (MapDomRestrTo_semantics A C m m'' a). + case (MapGet C m'' a); case (MapGet B m' a); trivial. Qed. - Lemma MapDomRestrTo_To_comm : (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')). + Lemma MapDomRestrTo_To_comm : + forall (m:Map A) (m':Map B) (m'':Map C), + eqmap (MapDomRestrTo A C (MapDomRestrTo A B m m') m'') + (MapDomRestrTo A B (MapDomRestrTo A C m m'') m'). Proof. - Unfold eqmap eqm. 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. + unfold eqmap, eqm in |- *. intros. + rewrite (MapDomRestrTo_semantics A C (MapDomRestrTo A B m m') m'' a). + rewrite (MapDomRestrTo_semantics A B m m' a). + rewrite (MapDomRestrTo_semantics A B (MapDomRestrTo A C m m'') m' a). + rewrite (MapDomRestrTo_semantics A C m m'' a). + case (MapGet C m'' a); case (MapGet B m' a); trivial. Qed. - Lemma MapMerge_DomRestrTo : (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''))). + Lemma MapMerge_DomRestrTo : + forall (m m':Map A) (m'':Map B), + eqmap (MapDomRestrTo A B (MapMerge A m m') m'') + (MapMerge A (MapDomRestrTo A B m m'') (MapDomRestrTo A B m' m'')). Proof. - Unfold eqmap eqm. 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. + unfold eqmap, eqm in |- *. intros. + rewrite (MapDomRestrTo_semantics A B (MapMerge A m m') m'' a). + rewrite (MapMerge_semantics A m m' a). + rewrite + (MapMerge_semantics A (MapDomRestrTo A B m m'') + (MapDomRestrTo A B m' m'') a). + rewrite (MapDomRestrTo_semantics A B m' m'' a). + rewrite (MapDomRestrTo_semantics A B m m'' a). + case (MapGet B m'' a); case (MapGet A m' a); trivial. Qed. - Lemma MapMerge_DomRestrBy : (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''))). + Lemma MapMerge_DomRestrBy : + forall (m m':Map A) (m'':Map B), + eqmap (MapDomRestrBy A B (MapMerge A m m') m'') + (MapMerge A (MapDomRestrBy A B m m'') (MapDomRestrBy A B m' m'')). Proof. - Unfold eqmap eqm. 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. + unfold eqmap, eqm in |- *. intros. + rewrite (MapDomRestrBy_semantics A B (MapMerge A m m') m'' a). + rewrite (MapMerge_semantics A m m' a). + rewrite + (MapMerge_semantics A (MapDomRestrBy A B m m'') + (MapDomRestrBy A B m' m'') a). + rewrite (MapDomRestrBy_semantics A B m' m'' a). + rewrite (MapDomRestrBy_semantics A B m m'' a). + case (MapGet B m'' a); case (MapGet A m' a); trivial. Qed. - Lemma MapDelta_empty_m_1 : (m:(Map A)) (MapDelta A (M0 A) m)=m. + Lemma MapDelta_empty_m_1 : forall m:Map A, MapDelta A (M0 A) m = m. Proof. - Trivial. + trivial. Qed. - Lemma MapDelta_empty_m : (m:(Map A)) (eqmap (MapDelta A (M0 A) m) m). + Lemma MapDelta_empty_m : forall m:Map A, eqmap (MapDelta A (M0 A) m) m. Proof. - Unfold eqmap eqm. Trivial. + unfold eqmap, eqm in |- *. trivial. Qed. - Lemma MapDelta_m_empty_1 : (m:(Map A)) (MapDelta A m (M0 A))=m. + Lemma MapDelta_m_empty_1 : forall m:Map A, MapDelta A m (M0 A) = m. Proof. - Induction m;Trivial. + simple induction m; trivial. Qed. - Lemma MapDelta_m_empty : (m:(Map A)) (eqmap (MapDelta A m (M0 A)) m). + Lemma MapDelta_m_empty : forall m:Map A, eqmap (MapDelta A m (M0 A)) m. Proof. - Unfold eqmap eqm. Intros. Rewrite MapDelta_m_empty_1. Reflexivity. + unfold eqmap, eqm in |- *. intros. rewrite MapDelta_m_empty_1. reflexivity. Qed. - Lemma MapDelta_nilpotent : (m:(Map A)) (eqmap (MapDelta A m m) (M0 A)). + Lemma MapDelta_nilpotent : forall 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. + unfold eqmap, eqm in |- *. 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))). + Lemma MapDelta_as_Merge : + forall m m':Map A, + eqmap (MapDelta A m m') + (MapMerge A (MapDomRestrBy A A m m') (MapDomRestrBy A A m' m)). Proof. - Unfold eqmap eqm. 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. + unfold eqmap, eqm in |- *. intros. + rewrite (MapDelta_semantics A m m' a). + rewrite + (MapMerge_semantics A (MapDomRestrBy A A m m') ( + MapDomRestrBy A A m' m) a). + rewrite (MapDomRestrBy_semantics A A m' m a). + rewrite (MapDomRestrBy_semantics A A m m' a). + case (MapGet A m a); case (MapGet A m' a); trivial. Qed. - Lemma MapDelta_as_DomRestrBy : (m,m':(Map A)) (eqmap (MapDelta A m m') - (MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m m'))). + Lemma MapDelta_as_DomRestrBy : + forall m m':Map A, + eqmap (MapDelta A m m') + (MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m m')). Proof. - Unfold eqmap eqm. 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. + unfold eqmap, eqm in |- *. intros. rewrite (MapDelta_semantics A m m' a). + rewrite + (MapDomRestrBy_semantics A A (MapMerge A m m') ( + MapDomRestrTo A A m m') a). + rewrite (MapDomRestrTo_semantics A A m m' a). rewrite (MapMerge_semantics A m m' a). + case (MapGet A m a); case (MapGet A m' a); trivial. Qed. - Lemma MapDelta_as_DomRestrBy_2 : (m,m':(Map A)) (eqmap (MapDelta A m m') - (MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m' m))). + Lemma MapDelta_as_DomRestrBy_2 : + forall m m':Map A, + eqmap (MapDelta A m m') + (MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m' m)). Proof. - Unfold eqmap eqm. 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. + unfold eqmap, eqm in |- *. intros. rewrite (MapDelta_semantics A m m' a). + rewrite + (MapDomRestrBy_semantics A A (MapMerge A m m') ( + MapDomRestrTo A A m' m) a). + rewrite (MapDomRestrTo_semantics A A m' m a). rewrite (MapMerge_semantics A m m' a). + case (MapGet A m a); case (MapGet A m' a); trivial. Qed. - Lemma MapDelta_sym : (m,m':(Map A)) (eqmap (MapDelta A m m') (MapDelta A m' m)). + Lemma MapDelta_sym : + forall 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. + unfold eqmap, eqm in |- *. intros. rewrite (MapDelta_semantics A m m' a). + rewrite (MapDelta_semantics A m' m a). + case (MapGet A m a); case (MapGet A m' a); trivial. Qed. - Lemma MapDelta_ext : (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)). + Lemma MapDelta_ext : + forall m1 m2 m'1 m'2:Map A, + eqmap m1 m'1 -> + eqmap m2 m'2 -> eqmap (MapDelta A m1 m2) (MapDelta A m'1 m'2). Proof. - Unfold eqmap eqm. Intros. Rewrite (MapDelta_semantics A m1 m2 a). - Rewrite (MapDelta_semantics A m'1 m'2 a). Rewrite (H a). Rewrite (H0 a). Reflexivity. + unfold eqmap, eqm in |- *. intros. rewrite (MapDelta_semantics A m1 m2 a). + rewrite (MapDelta_semantics A m'1 m'2 a). rewrite (H a). rewrite (H0 a). reflexivity. Qed. - Lemma MapDelta_ext_l : (m1,m'1,m2:(Map A)) - (eqmap m1 m'1) -> (eqmap (MapDelta A m1 m2) (MapDelta A m'1 m2)). + Lemma MapDelta_ext_l : + forall m1 m'1 m2:Map A, + eqmap m1 m'1 -> eqmap (MapDelta A m1 m2) (MapDelta A m'1 m2). Proof. - Intros. Apply MapDelta_ext. Assumption. - Apply eqmap_refl. + 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)). + Lemma MapDelta_ext_r : + forall m1 m2 m'2:Map A, + eqmap m2 m'2 -> eqmap (MapDelta A m1 m2) (MapDelta A m1 m'2). Proof. - Intros. Apply MapDelta_ext. Apply eqmap_refl. - Assumption. + 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'))). + Lemma MapDom_Split_1 : + forall (m:Map A) (m':Map B), + eqmap m (MapMerge A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m')). Proof. - Unfold eqmap eqm. 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. + unfold eqmap, eqm in |- *. intros. + rewrite + (MapMerge_semantics A (MapDomRestrTo A B m m') ( + MapDomRestrBy A B m m') a). + rewrite (MapDomRestrBy_semantics A B m m' a). + rewrite (MapDomRestrTo_semantics A B m m' a). + case (MapGet B m' a); case (MapGet A m a); trivial. Qed. - Lemma MapDom_Split_2 : (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. + Lemma MapDom_Split_2 : + forall (m:Map A) (m':Map B), + eqmap m (MapMerge A (MapDomRestrBy A B m m') (MapDomRestrTo A B m m')). + Proof. + unfold eqmap, eqm in |- *. intros. + rewrite + (MapMerge_semantics A (MapDomRestrBy A B m m') ( + MapDomRestrTo A B m m') a). + rewrite (MapDomRestrBy_semantics A B m m' a). + rewrite (MapDomRestrTo_semantics A B m m' a). + case (MapGet B m' a); case (MapGet A m a); trivial. + Qed. + + Lemma MapDom_Split_3 : + forall (m:Map A) (m':Map B), + eqmap + (MapDomRestrTo A A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m')) + (M0 A). + Proof. + unfold eqmap, eqm in |- *. intros. + rewrite + (MapDomRestrTo_semantics A A (MapDomRestrTo A B m m') + (MapDomRestrBy A B m m') a). + rewrite (MapDomRestrBy_semantics A B m m' a). + rewrite (MapDomRestrTo_semantics A B m m' a). + case (MapGet B m' a); case (MapGet A m a); trivial. Qed. End MapAxioms. -Lemma MapDomRestrTo_ext : (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)). +Lemma MapDomRestrTo_ext : + forall (A B:Set) (m1:Map A) (m2:Map B) (m'1:Map A) + (m'2:Map B), + eqmap A m1 m'1 -> + eqmap B m2 m'2 -> + eqmap A (MapDomRestrTo A B m1 m2) (MapDomRestrTo A B m'1 m'2). Proof. - Unfold eqmap eqm. 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. + unfold eqmap, eqm in |- *. intros. rewrite (MapDomRestrTo_semantics A B m1 m2 a). + rewrite (MapDomRestrTo_semantics A B m'1 m'2 a). rewrite (H a). rewrite (H0 a). reflexivity. Qed. -Lemma MapDomRestrTo_ext_l : (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)). +Lemma MapDomRestrTo_ext_l : + forall (A B:Set) (m1:Map A) (m2:Map B) (m'1:Map A), + eqmap A m1 m'1 -> + eqmap A (MapDomRestrTo A B m1 m2) (MapDomRestrTo A B m'1 m2). Proof. - Intros. Apply MapDomRestrTo_ext; [ Assumption | Apply eqmap_refl ]. + 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)). +Lemma MapDomRestrTo_ext_r : + forall (A B:Set) (m1:Map A) (m2 m'2:Map B), + eqmap B m2 m'2 -> + eqmap A (MapDomRestrTo A B m1 m2) (MapDomRestrTo A B m1 m'2). Proof. - Intros. Apply MapDomRestrTo_ext; [ Apply eqmap_refl | Assumption ]. + 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)). +Lemma MapDomRestrBy_ext : + forall (A B:Set) (m1:Map A) (m2:Map B) (m'1:Map A) + (m'2:Map B), + eqmap A m1 m'1 -> + eqmap B m2 m'2 -> + eqmap A (MapDomRestrBy A B m1 m2) (MapDomRestrBy A B m'1 m'2). Proof. - Unfold eqmap eqm. 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. + unfold eqmap, eqm in |- *. intros. rewrite (MapDomRestrBy_semantics A B m1 m2 a). + rewrite (MapDomRestrBy_semantics A B m'1 m'2 a). rewrite (H a). rewrite (H0 a). reflexivity. Qed. -Lemma MapDomRestrBy_ext_l : (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)). +Lemma MapDomRestrBy_ext_l : + forall (A B:Set) (m1:Map A) (m2:Map B) (m'1:Map A), + eqmap A m1 m'1 -> + eqmap A (MapDomRestrBy A B m1 m2) (MapDomRestrBy A B m'1 m2). Proof. - Intros. Apply MapDomRestrBy_ext; [ Assumption | Apply eqmap_refl ]. + 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)). +Lemma MapDomRestrBy_ext_r : + forall (A B:Set) (m1:Map A) (m2 m'2:Map B), + eqmap B m2 m'2 -> + eqmap A (MapDomRestrBy A B m1 m2) (MapDomRestrBy A B m1 m'2). Proof. - Intros. Apply MapDomRestrBy_ext; [ Apply eqmap_refl | Assumption ]. + 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)). +Lemma MapDomRestrBy_m_m : + forall (A:Set) (m:Map A), + eqmap A (MapDomRestrBy A unit m (MapDom A m)) (M0 A). Proof. - Intros. Apply eqmap_trans with m':=(MapDomRestrBy A A m m). Apply eqmap_sym. - Apply MapDomRestrBy_Dom. - Apply MapDomRestrBy_m_m_1. + 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''))). +Lemma FSetDelta_assoc : + forall 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. + unfold eqmap, eqm in |- *. intros. rewrite (MapDelta_semantics unit (MapDelta unit s s') s'' a). + rewrite (MapDelta_semantics unit s s' a). + rewrite (MapDelta_semantics unit s (MapDelta unit s' s'') a). + rewrite (MapDelta_semantics unit s' s'' a). + case (MapGet _ s a); case (MapGet _ s' a); case (MapGet _ s'' a); trivial. + intros. elim u. elim u1. reflexivity. Qed. -Lemma FSet_ext : (s,s':FSet) ((a:ad) (in_FSet a s)=(in_FSet a s')) -> (eqmap unit s s'). +Lemma FSet_ext : + forall s s':FSet, + (forall a:ad, in_FSet a s = in_FSet a s') -> eqmap unit s s'. Proof. - Unfold in_FSet eqmap eqm. 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. + unfold in_FSet, eqmap, eqm in |- *. intros. elim (sumbool_of_bool (in_dom _ a s)). intro H0. + elim (in_dom_some _ s a H0). intros y H1. rewrite (H a) in H0. elim (in_dom_some _ s' a H0). + intros y' H2. rewrite H1. rewrite H2. elim y. elim y'. reflexivity. + intro H0. rewrite (in_dom_none _ s a H0). rewrite (H a) in H0. rewrite (in_dom_none _ s' a H0). + reflexivity. Qed. -Lemma FSetUnion_comm : (s,s':FSet) (eqmap unit (FSetUnion s s') (FSetUnion s' s)). +Lemma FSetUnion_comm : + forall s s':FSet, eqmap unit (FSetUnion s s') (FSetUnion s' s). Proof. - Intros. Apply FSet_ext. Intro. Rewrite in_FSet_union. Rewrite in_FSet_union. Apply orb_sym. + intros. apply FSet_ext. intro. rewrite in_FSet_union. rewrite in_FSet_union. apply orb_comm. Qed. -Lemma FSetUnion_assoc : (s,s',s'':FSet) (eqmap unit - (FSetUnion (FSetUnion s s') s'') (FSetUnion s (FSetUnion s' s''))). +Lemma FSetUnion_assoc : + forall s s' s'':FSet, + eqmap unit (FSetUnion (FSetUnion s s') s'') + (FSetUnion s (FSetUnion s' s'')). Proof. - Exact (MapMerge_assoc unit). + exact (MapMerge_assoc unit). Qed. -Lemma FSetUnion_M0_s : (s:FSet) (eqmap unit (FSetUnion (M0 unit) s) s). +Lemma FSetUnion_M0_s : forall s:FSet, eqmap unit (FSetUnion (M0 unit) s) s. Proof. - Exact (MapMerge_empty_m unit). + exact (MapMerge_empty_m unit). Qed. -Lemma FSetUnion_s_M0 : (s:FSet) (eqmap unit (FSetUnion s (M0 unit)) s). +Lemma FSetUnion_s_M0 : forall s:FSet, eqmap unit (FSetUnion s (M0 unit)) s. Proof. - Exact (MapMerge_m_empty unit). + exact (MapMerge_m_empty unit). Qed. -Lemma FSetUnion_idempotent : (s:FSet) (eqmap unit (FSetUnion s s) s). +Lemma FSetUnion_idempotent : forall s:FSet, eqmap unit (FSetUnion s s) s. Proof. - Exact (MapMerge_idempotent unit). + exact (MapMerge_idempotent unit). Qed. -Lemma FSetInter_comm : (s,s':FSet) (eqmap unit (FSetInter s s') (FSetInter s' s)). +Lemma FSetInter_comm : + forall s s':FSet, eqmap unit (FSetInter s s') (FSetInter s' s). Proof. - Intros. Apply FSet_ext. Intro. Rewrite in_FSet_inter. Rewrite in_FSet_inter. Apply andb_sym. + intros. apply FSet_ext. intro. rewrite in_FSet_inter. rewrite in_FSet_inter. apply andb_comm. Qed. -Lemma FSetInter_assoc : (s,s',s'':FSet) (eqmap unit - (FSetInter (FSetInter s s') s'') (FSetInter s (FSetInter s' s''))). +Lemma FSetInter_assoc : + forall s s' s'':FSet, + eqmap unit (FSetInter (FSetInter s s') s'') + (FSetInter s (FSetInter s' s'')). Proof. - Exact (MapDomRestrTo_assoc unit unit unit). + exact (MapDomRestrTo_assoc unit unit unit). Qed. -Lemma FSetInter_M0_s : (s:FSet) (eqmap unit (FSetInter (M0 unit) s) (M0 unit)). +Lemma FSetInter_M0_s : + forall s:FSet, eqmap unit (FSetInter (M0 unit) s) (M0 unit). Proof. - Exact (MapDomRestrTo_empty_m unit unit). + exact (MapDomRestrTo_empty_m unit unit). Qed. -Lemma FSetInter_s_M0 : (s:FSet) (eqmap unit (FSetInter s (M0 unit)) (M0 unit)). +Lemma FSetInter_s_M0 : + forall s:FSet, eqmap unit (FSetInter s (M0 unit)) (M0 unit). Proof. - Exact (MapDomRestrTo_m_empty unit unit). + exact (MapDomRestrTo_m_empty unit unit). Qed. -Lemma FSetInter_idempotent : (s:FSet) (eqmap unit (FSetInter s s) s). +Lemma FSetInter_idempotent : forall s:FSet, eqmap unit (FSetInter s s) s. Proof. - Exact (MapDomRestrTo_idempotent unit). + 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''))). +Lemma FSetUnion_Inter_l : + forall s s' s'':FSet, + eqmap unit (FSetUnion (FSetInter s s') s'') + (FSetInter (FSetUnion s s'') (FSetUnion s' s'')). Proof. - Intros. Apply FSet_ext. Intro. Rewrite in_FSet_union. Rewrite in_FSet_inter. - Rewrite in_FSet_inter. Rewrite in_FSet_union. Rewrite in_FSet_union. - Case (in_FSet a s); Case (in_FSet a s'); Case (in_FSet a s''); Reflexivity. + 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''))). +Lemma FSetUnion_Inter_r : + forall s s' s'':FSet, + eqmap unit (FSetUnion s (FSetInter s' s'')) + (FSetInter (FSetUnion s s') (FSetUnion s s'')). Proof. - Intros. Apply FSet_ext. Intro. Rewrite in_FSet_union. Rewrite in_FSet_inter. - Rewrite in_FSet_inter. Rewrite in_FSet_union. Rewrite in_FSet_union. - Case (in_FSet a s); Case (in_FSet a s'); Case (in_FSet a s''); Reflexivity. + 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''))). +Lemma FSetInter_Union_l : + forall s s' s'':FSet, + eqmap unit (FSetInter (FSetUnion s s') s'') + (FSetUnion (FSetInter s s'') (FSetInter s' s'')). Proof. - Intros. Apply FSet_ext. Intro. Rewrite in_FSet_inter. Rewrite in_FSet_union. - Rewrite in_FSet_union. Rewrite in_FSet_inter. Rewrite in_FSet_inter. - Case (in_FSet a s); Case (in_FSet a s'); Case (in_FSet a s''); Reflexivity. + 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''))). +Lemma FSetInter_Union_r : + forall s s' s'':FSet, + eqmap unit (FSetInter s (FSetUnion s' s'')) + (FSetUnion (FSetInter s s') (FSetInter s s'')). Proof. - Intros. Apply FSet_ext. Intro. Rewrite in_FSet_inter. Rewrite in_FSet_union. - Rewrite in_FSet_union. Rewrite in_FSet_inter. Rewrite in_FSet_inter. - Case (in_FSet a s); Case (in_FSet a s'); Case (in_FSet a s''); Reflexivity. -Qed. + intros. apply FSet_ext. intro. rewrite in_FSet_inter. rewrite in_FSet_union. + rewrite in_FSet_union. rewrite in_FSet_inter. rewrite in_FSet_inter. + case (in_FSet a s); case (in_FSet a s'); case (in_FSet a s''); reflexivity. +Qed.
\ No newline at end of file diff --git a/theories/IntMap/Mapc.v b/theories/IntMap/Mapc.v index b7cede9440..8420ba381a 100644 --- a/theories/IntMap/Mapc.v +++ b/theories/IntMap/Mapc.v @@ -7,451 +7,536 @@ (***********************************************************************) (*i $Id$ i*) -Require Bool. -Require Sumbool. -Require Arith. -Require ZArith. -Require Addr. -Require Adist. -Require Addec. -Require Map. -Require Mapaxioms. -Require Fset. -Require Mapiter. -Require Mapsubset. -Require PolyList. -Require Lsort. -Require Mapcard. -Require Mapcanon. +Require Import Bool. +Require Import Sumbool. +Require Import Arith. +Require Import ZArith. +Require Import Addr. +Require Import Adist. +Require Import Addec. +Require Import Map. +Require Import Mapaxioms. +Require Import Fset. +Require Import Mapiter. +Require Import Mapsubset. +Require Import List. +Require Import Lsort. +Require Import Mapcard. +Require Import Mapcanon. Section MapC. - Variable A, B, C : Set. + Variables A B C : Set. - Lemma MapPut_as_Merge_c : (m:(Map A)) (mapcanon A m) -> - (a:ad) (y:A) (MapPut A m a y)=(MapMerge A m (M1 A a y)). + Lemma MapPut_as_Merge_c : + forall m:Map A, + mapcanon A m -> + forall (a:ad) (y:A), MapPut A m a y = MapMerge A m (M1 A a y). Proof. - Intros. Apply mapcanon_unique. Exact (MapPut_canon A m H a y). - Apply MapMerge_canon. Assumption. - Apply M1_canon. - Apply MapPut_as_Merge. + 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). + Lemma MapPut_behind_as_Merge_c : + forall m:Map A, + mapcanon A m -> + forall (a:ad) (y:A), MapPut_behind A m a y = MapMerge A (M1 A a y) m. Proof. - Intros. Apply mapcanon_unique. Exact (MapPut_behind_canon A m H a y). - Apply MapMerge_canon. Apply M1_canon. - Assumption. - Apply MapPut_behind_as_Merge. + 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. + Lemma MapMerge_empty_m_c : forall m:Map A, MapMerge A (M0 A) m = m. Proof. - Trivial. + 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'')). + Lemma MapMerge_assoc_c : + forall m m' m'':Map A, + mapcanon A m -> + mapcanon A m' -> + mapcanon A m'' -> + MapMerge A (MapMerge A m m') m'' = MapMerge A m (MapMerge A m' m''). Proof. - Intros. Apply mapcanon_unique. - (Apply MapMerge_canon; Try Assumption). (Apply MapMerge_canon; Try Assumption). - (Apply MapMerge_canon; Try Assumption). (Apply MapMerge_canon; Try Assumption). - Apply MapMerge_assoc. + 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. + Lemma MapMerge_idempotent_c : + forall m:Map A, mapcanon A m -> MapMerge A m m = m. Proof. - Intros. Apply mapcanon_unique. (Apply MapMerge_canon; Assumption). - Assumption. - Apply MapMerge_idempotent. + 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'')). + Lemma MapMerge_RestrTo_l_c : + forall m m' m'':Map A, + mapcanon A m -> + mapcanon A m'' -> + MapMerge A (MapDomRestrTo A A m m') m'' = + MapDomRestrTo A A (MapMerge A m m'') (MapMerge A m' m''). Proof. - Intros. Apply mapcanon_unique. Apply MapMerge_canon. Apply MapDomRestrTo_canon; Assumption. - Assumption. - Apply MapDomRestrTo_canon; Apply MapMerge_canon; Assumption. - Apply MapMerge_RestrTo_l. + 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)). + Lemma MapRemove_as_RestrBy_c : + forall m:Map A, + mapcanon A m -> + forall (a:ad) (y:B), MapRemove A m a = MapDomRestrBy A B m (M1 B a y). Proof. - Intros. Apply mapcanon_unique. (Apply MapRemove_canon; Assumption). - (Apply MapDomRestrBy_canon; Assumption). - Apply MapRemove_as_RestrBy. + 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'')). + Lemma MapDomRestrTo_assoc_c : + forall (m:Map A) (m':Map B) (m'':Map C), + mapcanon A m -> + MapDomRestrTo A C (MapDomRestrTo A B m m') m'' = + MapDomRestrTo A B m (MapDomRestrTo B C m' m''). Proof. - Intros. Apply mapcanon_unique. (Apply MapDomRestrTo_canon; Try Assumption). - (Apply MapDomRestrTo_canon; Try Assumption). - (Apply MapDomRestrTo_canon; Try Assumption). - Apply MapDomRestrTo_assoc. + 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. + Lemma MapDomRestrTo_idempotent_c : + forall m:Map A, mapcanon A m -> MapDomRestrTo A A m m = m. Proof. - Intros. Apply mapcanon_unique. (Apply MapDomRestrTo_canon; Assumption). - Assumption. - Apply MapDomRestrTo_idempotent. + 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')). + Lemma MapDomRestrTo_Dom_c : + forall (m:Map A) (m':Map B), + mapcanon A m -> + MapDomRestrTo A B m m' = MapDomRestrTo A unit m (MapDom B m'). Proof. - Intros. Apply mapcanon_unique. (Apply MapDomRestrTo_canon; Assumption). - (Apply MapDomRestrTo_canon; Assumption). - Apply MapDomRestrTo_Dom. + 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')). + Lemma MapDomRestrBy_Dom_c : + forall (m:Map A) (m':Map B), + mapcanon A m -> + MapDomRestrBy A B m m' = MapDomRestrBy A unit m (MapDom B m'). Proof. - Intros. Apply mapcanon_unique. Apply MapDomRestrBy_canon; Assumption. - Apply MapDomRestrBy_canon; Assumption. - Apply MapDomRestrBy_Dom. + 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'')). + Lemma MapDomRestrBy_By_c : + forall (m:Map A) (m' m'':Map B), + mapcanon A m -> + MapDomRestrBy A B (MapDomRestrBy A B m m') m'' = + MapDomRestrBy A B m (MapMerge B m' m''). Proof. - Intros. Apply mapcanon_unique. (Apply MapDomRestrBy_canon; Try Assumption). - (Apply MapDomRestrBy_canon; Try Assumption). - (Apply MapDomRestrBy_canon; Try Assumption). - Apply MapDomRestrBy_By. + 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'). + Lemma MapDomRestrBy_By_comm_c : + forall (m:Map A) (m':Map B) (m'':Map C), + mapcanon A m -> + MapDomRestrBy A C (MapDomRestrBy A B m m') m'' = + MapDomRestrBy A B (MapDomRestrBy A C m m'') m'. Proof. - Intros. Apply mapcanon_unique. Apply MapDomRestrBy_canon. - (Apply MapDomRestrBy_canon; Assumption). - Apply MapDomRestrBy_canon. (Apply MapDomRestrBy_canon; Assumption). - Apply MapDomRestrBy_By_comm. + 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'')). + Lemma MapDomRestrBy_To_c : + forall (m:Map A) (m':Map B) (m'':Map C), + mapcanon A m -> + MapDomRestrBy A C (MapDomRestrTo A B m m') m'' = + MapDomRestrTo A B m (MapDomRestrBy B C m' m''). Proof. - Intros. Apply mapcanon_unique. Apply MapDomRestrBy_canon. - (Apply MapDomRestrTo_canon; Assumption). - (Apply MapDomRestrTo_canon; Assumption). - Apply MapDomRestrBy_To. + 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'). + Lemma MapDomRestrBy_To_comm_c : + forall (m:Map A) (m':Map B) (m'':Map C), + mapcanon A m -> + MapDomRestrBy A C (MapDomRestrTo A B m m') m'' = + MapDomRestrTo A B (MapDomRestrBy A C m m'') m'. Proof. - Intros. Apply mapcanon_unique. Apply MapDomRestrBy_canon. - Apply MapDomRestrTo_canon; Assumption. - Apply MapDomRestrTo_canon. Apply MapDomRestrBy_canon; Assumption. - Apply MapDomRestrBy_To_comm. + 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')). + Lemma MapDomRestrTo_By_c : + forall (m:Map A) (m':Map B) (m'':Map C), + mapcanon A m -> + MapDomRestrTo A C (MapDomRestrBy A B m m') m'' = + MapDomRestrTo A C m (MapDomRestrBy C B m'' m'). Proof. - Intros. Apply mapcanon_unique. Apply MapDomRestrTo_canon. - Apply MapDomRestrBy_canon; Assumption. - Apply MapDomRestrTo_canon; Assumption. - Apply MapDomRestrTo_By. + 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'). + Lemma MapDomRestrTo_By_comm_c : + forall (m:Map A) (m':Map B) (m'':Map C), + mapcanon A m -> + MapDomRestrTo A C (MapDomRestrBy A B m m') m'' = + MapDomRestrBy A B (MapDomRestrTo A C m m'') m'. Proof. - Intros. Apply mapcanon_unique. Apply MapDomRestrTo_canon. - (Apply MapDomRestrBy_canon; Assumption). - Apply MapDomRestrBy_canon. (Apply MapDomRestrTo_canon; Assumption). - Apply MapDomRestrTo_By_comm. + 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'). + Lemma MapDomRestrTo_To_comm_c : + forall (m:Map A) (m':Map B) (m'':Map C), + mapcanon A m -> + MapDomRestrTo A C (MapDomRestrTo A B m m') m'' = + MapDomRestrTo A B (MapDomRestrTo A C m m'') m'. Proof. - Intros. Apply mapcanon_unique. Apply MapDomRestrTo_canon. - Apply MapDomRestrTo_canon; Assumption. - Apply MapDomRestrTo_canon. Apply MapDomRestrTo_canon; Assumption. - Apply MapDomRestrTo_To_comm. + 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'')). + Lemma MapMerge_DomRestrTo_c : + forall (m m':Map A) (m'':Map B), + mapcanon A m -> + mapcanon A m' -> + MapDomRestrTo A B (MapMerge A m m') m'' = + MapMerge A (MapDomRestrTo A B m m'') (MapDomRestrTo A B m' m''). Proof. - Intros. Apply mapcanon_unique. Apply MapDomRestrTo_canon. - (Apply MapMerge_canon; Assumption). - Apply MapMerge_canon. (Apply MapDomRestrTo_canon; Assumption). - (Apply MapDomRestrTo_canon; Assumption). - Apply MapMerge_DomRestrTo. + 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'')). + Lemma MapMerge_DomRestrBy_c : + forall (m m':Map A) (m'':Map B), + mapcanon A m -> + mapcanon A m' -> + MapDomRestrBy A B (MapMerge A m m') m'' = + MapMerge A (MapDomRestrBy A B m m'') (MapDomRestrBy A B m' m''). Proof. - Intros. Apply mapcanon_unique. Apply MapDomRestrBy_canon. Apply MapMerge_canon; Assumption. - Apply MapMerge_canon. Apply MapDomRestrBy_canon; Assumption. - Apply MapDomRestrBy_canon; Assumption. - Apply MapMerge_DomRestrBy. + 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). + Lemma MapDelta_nilpotent_c : + forall m:Map A, mapcanon A m -> MapDelta A m m = M0 A. Proof. - Intros. Apply mapcanon_unique. (Apply MapDelta_canon; Assumption). - Apply M0_canon. - Apply MapDelta_nilpotent. + 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)). + Lemma MapDelta_as_Merge_c : + forall m m':Map A, + mapcanon A m -> + mapcanon A m' -> + MapDelta A m m' = + MapMerge A (MapDomRestrBy A A m m') (MapDomRestrBy A A m' m). Proof. - Intros. Apply mapcanon_unique. (Apply MapDelta_canon; Assumption). - (Apply MapMerge_canon; Apply MapDomRestrBy_canon; Assumption). - Apply MapDelta_as_Merge. + 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')). + Lemma MapDelta_as_DomRestrBy_c : + forall m m':Map A, + mapcanon A m -> + mapcanon A m' -> + MapDelta A m m' = + MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m m'). Proof. - Intros. Apply mapcanon_unique. Apply MapDelta_canon; Assumption. - Apply MapDomRestrBy_canon. (Apply MapMerge_canon; Assumption). - Apply MapDelta_as_DomRestrBy. + 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)). + Lemma MapDelta_as_DomRestrBy_2_c : + forall m m':Map A, + mapcanon A m -> + mapcanon A m' -> + MapDelta A m m' = + MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m' m). Proof. - Intros. Apply mapcanon_unique. (Apply MapDelta_canon; Assumption). - Apply MapDomRestrBy_canon. Apply MapMerge_canon; Assumption. - Apply MapDelta_as_DomRestrBy_2. + 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). + Lemma MapDelta_sym_c : + forall m m':Map A, + mapcanon A m -> mapcanon A m' -> MapDelta A m m' = MapDelta A m' m. Proof. - Intros. Apply mapcanon_unique. (Apply MapDelta_canon; Assumption). - (Apply MapDelta_canon; Assumption). Apply MapDelta_sym. + 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')). + Lemma MapDom_Split_1_c : + forall (m:Map A) (m':Map B), + mapcanon A m -> + m = MapMerge A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m'). Proof. - Intros. Apply mapcanon_unique. Assumption. - Apply MapMerge_canon. Apply MapDomRestrTo_canon; Assumption. - Apply MapDomRestrBy_canon; Assumption. - Apply MapDom_Split_1. + 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')). + Lemma MapDom_Split_2_c : + forall (m:Map A) (m':Map B), + mapcanon A m -> + m = MapMerge A (MapDomRestrBy A B m m') (MapDomRestrTo A B m m'). Proof. - Intros. Apply mapcanon_unique. Assumption. - Apply MapMerge_canon. (Apply MapDomRestrBy_canon; Assumption). - (Apply MapDomRestrTo_canon; Assumption). - Apply MapDom_Split_2. + 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). + Lemma MapDom_Split_3_c : + forall (m:Map A) (m':Map B), + mapcanon A m -> + MapDomRestrTo A A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m') = + M0 A. Proof. - Intros. Apply mapcanon_unique. Apply MapDomRestrTo_canon. - Apply MapDomRestrTo_canon; Assumption. - Apply M0_canon. - Apply MapDom_Split_3. + 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. + Lemma Map_of_alist_of_Map_c : + forall m:Map A, mapcanon A m -> Map_of_alist A (alist_of_Map A m) = m. Proof. - Intros. (Apply mapcanon_unique; Try Assumption). Apply Map_of_alist_canon. - Apply Map_of_alist_of_Map. + 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. + Lemma alist_of_Map_of_alist_c : + forall l:alist A, + alist_sorted_2 A l -> alist_of_Map A (Map_of_alist A l) = l. Proof. - Intros. Apply alist_canonical. Apply alist_of_Map_of_alist. - Apply alist_of_Map_sorts2. - Assumption. + 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'). + Lemma MapSubset_antisym_c : + forall (m:Map A) (m':Map B), + mapcanon A m -> + mapcanon B m' -> + MapSubset A B m m' -> MapSubset B A m' m -> MapDom A m = MapDom B m'. Proof. - Intros. Apply (mapcanon_unique unit). (Apply MapDom_canon; Assumption). - (Apply MapDom_canon; Assumption). - (Apply MapSubset_antisym; Assumption). + 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'. + Lemma FSubset_antisym_c : + forall s s':FSet, + mapcanon unit s -> + mapcanon unit s' -> MapSubset _ _ s s' -> MapSubset _ _ s' s -> s = s'. Proof. - Intros. Apply (mapcanon_unique unit); Try Assumption. Apply FSubset_antisym; Assumption. + 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). + Lemma MapDisjoint_empty_c : + forall m:Map A, mapcanon A m -> MapDisjoint A A m m -> m = M0 A. Proof. - Intros. Apply mapcanon_unique; Try Assumption; Try Apply M0_canon. - Apply MapDisjoint_empty; Assumption. + 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'). + Lemma MapDelta_disjoint_c : + forall m m':Map A, + mapcanon A m -> + mapcanon A m' -> + MapDisjoint A A m m' -> MapDelta A m m' = MapMerge A m m'. Proof. - Intros. Apply mapcanon_unique. (Apply MapDelta_canon; Assumption). - (Apply MapMerge_canon; Assumption). Apply MapDelta_disjoint; Assumption. + 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'')). +Lemma FSetDelta_assoc_c : + forall s s' s'':FSet, + mapcanon unit s -> + mapcanon unit s' -> + mapcanon unit s'' -> + MapDelta _ (MapDelta _ s s') s'' = MapDelta _ s (MapDelta _ s' s''). Proof. - Intros. Apply (mapcanon_unique unit). Apply MapDelta_canon. (Apply MapDelta_canon; Assumption). - Assumption. - Apply MapDelta_canon. Assumption. - (Apply MapDelta_canon; Assumption). - Apply FSetDelta_assoc; Assumption. + 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'. +Lemma FSet_ext_c : + forall s s':FSet, + mapcanon unit s -> + mapcanon unit s' -> (forall a:ad, in_FSet a s = in_FSet a s') -> s = s'. Proof. - Intros. (Apply (mapcanon_unique unit); Try Assumption). Apply FSet_ext. Assumption. + 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). +Lemma FSetUnion_comm_c : + forall s s':FSet, + mapcanon unit s -> mapcanon unit s' -> FSetUnion s s' = FSetUnion s' s. Proof. - Intros. - Apply (mapcanon_unique unit); Try (Unfold FSetUnion; Apply MapMerge_canon; Assumption). - Apply FSetUnion_comm. + intros. + apply (mapcanon_unique unit); + try (unfold FSetUnion in |- *; 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'')). +Lemma FSetUnion_assoc_c : + forall s s' s'':FSet, + mapcanon unit s -> + mapcanon unit s' -> + mapcanon unit s'' -> + FSetUnion (FSetUnion s s') s'' = FSetUnion s (FSetUnion s' s''). Proof. - Exact (MapMerge_assoc_c unit). + exact (MapMerge_assoc_c unit). Qed. -Lemma FSetUnion_M0_s_c : (s:FSet) (FSetUnion (M0 unit) s)=s. +Lemma FSetUnion_M0_s_c : forall s:FSet, FSetUnion (M0 unit) s = s. Proof. - Exact (MapMerge_empty_m_c unit). + exact (MapMerge_empty_m_c unit). Qed. -Lemma FSetUnion_s_M0_c : (s:FSet) (FSetUnion s (M0 unit))=s. +Lemma FSetUnion_s_M0_c : forall s:FSet, FSetUnion s (M0 unit) = s. Proof. - Exact (MapMerge_m_empty_1 unit). + exact (MapMerge_m_empty_1 unit). Qed. -Lemma FSetUnion_idempotent : (s:FSet) (mapcanon unit s) -> (FSetUnion s s)=s. +Lemma FSetUnion_idempotent : + forall s:FSet, mapcanon unit s -> FSetUnion s s = s. Proof. - Exact (MapMerge_idempotent_c unit). + 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). +Lemma FSetInter_comm_c : + forall s s':FSet, + mapcanon unit s -> mapcanon unit s' -> FSetInter s s' = FSetInter s' s. Proof. - Intros. - Apply (mapcanon_unique unit); Try (Unfold FSetInter; Apply MapDomRestrTo_canon; Assumption). - Apply FSetInter_comm. + intros. + apply (mapcanon_unique unit); + try (unfold FSetInter in |- *; 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'')). +Lemma FSetInter_assoc_c : + forall s s' s'':FSet, + mapcanon unit s -> + FSetInter (FSetInter s s') s'' = FSetInter s (FSetInter s' s''). Proof. - Exact (MapDomRestrTo_assoc_c unit unit unit). + exact (MapDomRestrTo_assoc_c unit unit unit). Qed. -Lemma FSetInter_M0_s_c : (s:FSet) (FSetInter (M0 unit) s)=(M0 unit). +Lemma FSetInter_M0_s_c : forall s:FSet, FSetInter (M0 unit) s = M0 unit. Proof. - Trivial. + trivial. Qed. -Lemma FSetInter_s_M0_c : (s:FSet) (FSetInter s (M0 unit))=(M0 unit). +Lemma FSetInter_s_M0_c : forall s:FSet, FSetInter s (M0 unit) = M0 unit. Proof. - Exact (MapDomRestrTo_m_empty_1 unit unit). + exact (MapDomRestrTo_m_empty_1 unit unit). Qed. -Lemma FSetInter_idempotent : (s:FSet) (mapcanon unit s) -> (FSetInter s s)=s. +Lemma FSetInter_idempotent : + forall s:FSet, mapcanon unit s -> FSetInter s s = s. Proof. - Exact (MapDomRestrTo_idempotent_c unit). + 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'')). +Lemma FSetUnion_Inter_l_c : + forall s s' s'':FSet, + mapcanon unit s -> + mapcanon unit s'' -> + FSetUnion (FSetInter s s') s'' = + FSetInter (FSetUnion s s'') (FSetUnion s' s''). Proof. - Intros. Apply (mapcanon_unique unit). Unfold FSetUnion. (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. + intros. apply (mapcanon_unique unit). unfold FSetUnion in |- *. apply MapMerge_canon; try assumption. + unfold FSetInter in |- *. apply MapDomRestrTo_canon; assumption. + unfold FSetInter in |- *; unfold FSetUnion in |- *; + apply MapDomRestrTo_canon; apply MapMerge_canon; + assumption. + apply FSetUnion_Inter_l. Qed. -Lemma FSetUnion_Inter_r : (s,s',s'':FSet) (mapcanon unit s) -> (mapcanon unit s') -> - (FSetUnion s (FSetInter s' s''))=(FSetInter (FSetUnion s s') (FSetUnion s s'')). +Lemma FSetUnion_Inter_r : + forall s s' s'':FSet, + mapcanon unit s -> + mapcanon unit s' -> + FSetUnion s (FSetInter s' s'') = + FSetInter (FSetUnion s s') (FSetUnion s s''). Proof. - Intros. Apply (mapcanon_unique unit). Unfold FSetUnion. (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. + intros. apply (mapcanon_unique unit). unfold FSetUnion in |- *. apply MapMerge_canon; try assumption. + unfold FSetInter in |- *. apply MapDomRestrTo_canon; assumption. + unfold FSetInter in |- *; unfold FSetUnion in |- *; + apply MapDomRestrTo_canon; apply MapMerge_canon; + assumption. + apply FSetUnion_Inter_r. Qed. -Lemma FSetInter_Union_l_c : (s,s',s'':FSet) (mapcanon unit s) -> (mapcanon unit s') -> - (FSetInter (FSetUnion s s') s'')=(FSetUnion (FSetInter s s'') (FSetInter s' s'')). +Lemma FSetInter_Union_l_c : + forall s s' s'':FSet, + mapcanon unit s -> + mapcanon unit s' -> + FSetInter (FSetUnion s s') s'' = + FSetUnion (FSetInter s s'') (FSetInter s' s''). Proof. - Intros. Apply (mapcanon_unique unit). Unfold FSetInter. - 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. + intros. apply (mapcanon_unique unit). unfold FSetInter in |- *. + apply MapDomRestrTo_canon; try assumption. unfold FSetUnion in |- *. + apply MapMerge_canon; assumption. + unfold FSetUnion in |- *; unfold FSetInter in |- *; apply MapMerge_canon; + apply MapDomRestrTo_canon; assumption. + apply FSetInter_Union_l. Qed. -Lemma FSetInter_Union_r : (s,s',s'':FSet) (mapcanon unit s) -> (mapcanon unit s') -> - (FSetInter s (FSetUnion s' s''))=(FSetUnion (FSetInter s s') (FSetInter s s'')). +Lemma FSetInter_Union_r : + forall s s' s'':FSet, + mapcanon unit s -> + mapcanon unit s' -> + FSetInter s (FSetUnion s' s'') = + FSetUnion (FSetInter s s') (FSetInter s s''). Proof. - Intros. Apply (mapcanon_unique unit). Unfold FSetInter. - Apply MapDomRestrTo_canon; Try Assumption. - Unfold FSetUnion. Apply MapMerge_canon; Unfold FSetInter; Apply MapDomRestrTo_canon; Assumption. - Apply FSetInter_Union_r. -Qed. + intros. apply (mapcanon_unique unit). unfold FSetInter in |- *. + apply MapDomRestrTo_canon; try assumption. + unfold FSetUnion in |- *. apply MapMerge_canon; unfold FSetInter in |- *; apply MapDomRestrTo_canon; + assumption. + apply FSetInter_Union_r. +Qed.
\ No newline at end of file diff --git a/theories/IntMap/Mapcanon.v b/theories/IntMap/Mapcanon.v index b98e9b233a..70966c60db 100644 --- a/theories/IntMap/Mapcanon.v +++ b/theories/IntMap/Mapcanon.v @@ -7,316 +7,328 @@ (***********************************************************************) (*i $Id$ i*) -Require Bool. -Require Sumbool. -Require Arith. -Require ZArith. -Require Addr. -Require Adist. -Require Addec. -Require Map. -Require Mapaxioms. -Require Mapiter. -Require Fset. -Require PolyList. -Require Lsort. -Require Mapsubset. -Require Mapcard. +Require Import Bool. +Require Import Sumbool. +Require Import Arith. +Require Import ZArith. +Require Import Addr. +Require Import Adist. +Require Import Addec. +Require Import Map. +Require Import Mapaxioms. +Require Import Mapiter. +Require Import Fset. +Require Import List. +Require Import Lsort. +Require Import Mapsubset. +Require Import Mapcard. Section MapCanon. Variable A : Set. - Inductive mapcanon : (Map A) -> Prop := - M0_canon : (mapcanon (M0 A)) - | M1_canon : (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)). + Inductive mapcanon : Map A -> Prop := + | M0_canon : mapcanon (M0 A) + | M1_canon : forall (a:ad) (y:A), mapcanon (M1 A a y) + | M2_canon : + forall m1 m2:Map A, + mapcanon m1 -> + mapcanon m2 -> 2 <= MapCard A (M2 A m1 m2) -> mapcanon (M2 A m1 m2). - Lemma mapcanon_M2 : - (m1,m2:(Map A)) (mapcanon (M2 A m1 m2)) -> (le (2) (MapCard A (M2 A m1 m2))). + Lemma mapcanon_M2 : + forall m1 m2:Map A, mapcanon (M2 A m1 m2) -> 2 <= MapCard A (M2 A m1 m2). Proof. - Intros. Inversion H. Assumption. + intros. inversion H. assumption. Qed. - Lemma mapcanon_M2_1 : (m1,m2:(Map A)) (mapcanon (M2 A m1 m2)) -> (mapcanon m1). + Lemma mapcanon_M2_1 : + forall m1 m2:Map A, mapcanon (M2 A m1 m2) -> mapcanon m1. Proof. - Intros. Inversion H. Assumption. + intros. inversion H. assumption. Qed. - Lemma mapcanon_M2_2 : (m1,m2:(Map A)) (mapcanon (M2 A m1 m2)) -> (mapcanon m2). + Lemma mapcanon_M2_2 : + forall m1 m2:Map A, mapcanon (M2 A m1 m2) -> mapcanon m2. Proof. - Intros. Inversion H. Assumption. + 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). + Lemma M2_eqmap_1 : + forall m0 m1 m2 m3:Map A, + eqmap A (M2 A m0 m1) (M2 A m2 m3) -> eqmap A m0 m2. Proof. - Unfold eqmap eqm. 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)). + unfold eqmap, eqm in |- *. 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). + Lemma M2_eqmap_2 : + forall m0 m1 m2 m3:Map A, + eqmap A (M2 A m0 m1) (M2 A m2 m3) -> eqmap A m1 m3. Proof. - Unfold eqmap eqm. 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)). + unfold eqmap, eqm in |- *. 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'. + Lemma mapcanon_unique : + forall 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). + simple induction m. simple induction m'. trivial. + intros a y H H0 H1. cut (NONE A = MapGet A (M1 A a y) a). simpl in |- *. rewrite (ad_eq_correct a). + intro. discriminate H2. + exact (H1 a). + intros. cut (2 <= MapCard A (M0 A)). intro. elim (le_Sn_O _ H4). + rewrite (MapCard_ext A _ _ H3). exact (mapcanon_M2 _ _ H2). + intros a y. simple induction m'. intros. cut (MapGet A (M1 A a y) a = NONE A). simpl in |- *. + 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 in |- *. + 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 (2 <= MapCard A (M1 A a y)). intro. elim (le_Sn_O _ (le_S_n _ _ H4)). + rewrite (MapCard_ext A _ _ H3). exact (mapcanon_M2 _ _ H2). + simple induction m'. intros. cut (2 <= MapCard A (M0 A)). intro. elim (le_Sn_O _ H4). + rewrite <- (MapCard_ext A _ _ H3). exact (mapcanon_M2 _ _ H1). + intros a y H1 H2 H3. cut (2 <= MapCard A (M1 A a y)). intro. + elim (le_Sn_O _ (le_S_n _ _ H4)). + rewrite <- (MapCard_ext A _ _ H3). exact (mapcanon_M2 _ _ H1). + intros. rewrite (H m2). rewrite (H0 m3). reflexivity. + exact (mapcanon_M2_2 _ _ H3). + exact (mapcanon_M2_2 _ _ H4). + exact (M2_eqmap_2 _ _ _ _ H5). + exact (mapcanon_M2_1 _ _ H3). + exact (mapcanon_M2_1 _ _ H4). + exact (M2_eqmap_1 _ _ _ _ H5). Qed. - Lemma MapPut1_canon : - (p:positive) (a,a':ad) (y,y':A) (mapcanon (MapPut1 A a y a' y' p)). + Lemma MapPut1_canon : + forall (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. + simple induction p. simpl in |- *. 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 in |- *. intros. case (ad_bit_0 a). apply M2_canon. apply M0_canon. + apply H. + simpl in |- *. rewrite MapCard_Put1_equals_2. apply le_n. + apply M2_canon. apply H. + apply M0_canon. + simpl in |- *. rewrite MapCard_Put1_equals_2. apply le_n. + simpl in |- *. simpl in |- *. intros. case (ad_bit_0 a). apply M2_canon. apply M1_canon. + apply M1_canon. + simpl in |- *. apply le_n. + apply M2_canon. apply M1_canon. + apply M1_canon. + simpl in |- *. apply le_n. Qed. - Lemma MapPut_canon : - (m:(Map A)) (mapcanon m) -> (a:ad) (y:A) (mapcanon (MapPut A m a y)). + Lemma MapPut_canon : + forall m:Map A, + mapcanon m -> forall (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). + simple induction m. intros. simpl in |- *. apply M1_canon. + intros a0 y0 H a y. simpl in |- *. case (ad_xor a0 a). apply M1_canon. + intro. apply MapPut1_canon. + intros. simpl in |- *. elim a. apply M2_canon. apply H. exact (mapcanon_M2_1 m0 m1 H1). + exact (mapcanon_M2_2 m0 m1 H1). + simpl in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1). exact (mapcanon_M2 _ _ H1). + apply plus_le_compat. exact (MapCard_Put_lb A m0 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 in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1). + exact (mapcanon_M2 m0 m1 H1). + apply plus_le_compat_l. exact (MapCard_Put_lb A m1 (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 in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1). + exact (mapcanon_M2 m0 m1 H1). + apply plus_le_compat_r. exact (MapCard_Put_lb A m0 (ad_x p0) y). + apply M2_canon. apply (mapcanon_M2_1 m0 m1 H1). + apply H0. apply (mapcanon_M2_2 m0 m1 H1). + simpl in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1). + exact (mapcanon_M2 m0 m1 H1). + apply plus_le_compat_l. exact (MapCard_Put_lb A m1 ad_z y). Qed. - Lemma MapPut_behind_canon : (m:(Map A)) (mapcanon m) -> - (a:ad) (y:A) (mapcanon (MapPut_behind A m a y)). + Lemma MapPut_behind_canon : + forall m:Map A, + mapcanon m -> forall (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). + simple induction m. intros. simpl in |- *. apply M1_canon. + intros a0 y0 H a y. simpl in |- *. case (ad_xor a0 a). apply M1_canon. + intro. apply MapPut1_canon. + intros. simpl in |- *. elim a. apply M2_canon. apply H. exact (mapcanon_M2_1 m0 m1 H1). + exact (mapcanon_M2_2 m0 m1 H1). + simpl in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1). exact (mapcanon_M2 _ _ H1). + apply plus_le_compat. rewrite MapCard_Put_behind_Put. exact (MapCard_Put_lb A m0 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 in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1). + exact (mapcanon_M2 m0 m1 H1). + apply plus_le_compat_l. rewrite MapCard_Put_behind_Put. exact (MapCard_Put_lb A m1 (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 in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1). + exact (mapcanon_M2 m0 m1 H1). + apply plus_le_compat_r. rewrite MapCard_Put_behind_Put. exact (MapCard_Put_lb A m0 (ad_x p0) y). + apply M2_canon. apply (mapcanon_M2_1 m0 m1 H1). + apply H0. apply (mapcanon_M2_2 m0 m1 H1). + simpl in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1). + exact (mapcanon_M2 m0 m1 H1). + apply plus_le_compat_l. rewrite MapCard_Put_behind_Put. exact (MapCard_Put_lb A m1 ad_z y). Qed. - Lemma makeM2_canon : - (m,m':(Map A)) (mapcanon m) -> (mapcanon m') -> (mapcanon (makeM2 A m m')). + Lemma makeM2_canon : + forall m m':Map A, mapcanon m -> mapcanon m' -> mapcanon (makeM2 A m m'). Proof. - Intro. Case m. Intro. Case m'. Intros. Exact M0_canon. - Intros a y H H0. Exact (M1_canon (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')). + 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 in |- *. 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 in |- *. apply M2_canon; try assumption. apply le_n. + intros. simpl in |- *. apply M2_canon; try assumption. + apply le_trans with (m := MapCard A (M2 A m0 m1)). exact (mapcanon_M2 _ _ H0). + exact (le_plus_r (MapCard A (M1 A a y)) (MapCard A (M2 A m0 m1))). + simpl in |- *. intros. apply M2_canon; try assumption. + apply le_trans with (m := MapCard A (M2 A m0 m1)). exact (mapcanon_M2 _ _ H). + exact (le_plus_l (MapCard A (M2 A m0 m1)) (MapCard A m')). Qed. - Fixpoint MapCanonicalize [m:(Map A)] : (Map A) := - Cases m of - (M2 m0 m1) => (makeM2 A (MapCanonicalize m0) (MapCanonicalize m1)) - | _ => m - end. + Fixpoint MapCanonicalize (m:Map A) : Map A := + match m with + | M2 m0 m1 => makeM2 A (MapCanonicalize m0) (MapCanonicalize m1) + | _ => m + end. - Lemma mapcanon_exists_1 : (m:(Map A)) (eqmap A m (MapCanonicalize m)). + Lemma mapcanon_exists_1 : forall 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. + simple induction m. apply eqmap_refl. + intros. apply eqmap_refl. + intros. simpl in |- *. unfold eqmap, eqm in |- *. intro. + rewrite (makeM2_M2 A (MapCanonicalize m0) (MapCanonicalize m1) a). + rewrite MapGet_M2_bit_0_if. rewrite MapGet_M2_bit_0_if. + rewrite <- (H (ad_div_2 a)). rewrite <- (H0 (ad_div_2 a)). reflexivity. Qed. - Lemma mapcanon_exists_2 : (m:(Map A)) (mapcanon (MapCanonicalize m)). + Lemma mapcanon_exists_2 : forall m:Map A, mapcanon (MapCanonicalize m). Proof. - Induction m. Apply M0_canon. - Intros. Simpl. Apply M1_canon. - Intros. Simpl. (Apply makeM2_canon; Assumption). + simple induction m. apply M0_canon. + intros. simpl in |- *. apply M1_canon. + intros. simpl in |- *. apply makeM2_canon; assumption. Qed. - Lemma mapcanon_exists : - (m:(Map A)) {m':(Map A) | (eqmap A m m') /\ (mapcanon m')}. + Lemma mapcanon_exists : + forall m:Map A, {m' : Map A | eqmap A m m' /\ mapcanon m'}. Proof. - Intro. Split with (MapCanonicalize m). Split. Apply mapcanon_exists_1. - Apply mapcanon_exists_2. + 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)). + Lemma MapRemove_canon : + forall m:Map A, mapcanon m -> forall 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). + simple induction m. intros. exact M0_canon. + intros a y H a0. simpl in |- *. case (ad_eq a a0). exact M0_canon. + assumption. + intros. simpl in |- *. 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')). + Lemma MapMerge_canon : + forall 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)). + simple induction m. intros. exact H0. + simpl in |- *. intros a y m' H H0. exact (MapPut_behind_canon m' H0 a y). + simple induction m'. intros. exact H1. + intros a y H1 H2. unfold MapMerge in |- *. exact (MapPut_canon _ H1 a y). + intros. simpl in |- *. apply M2_canon. apply H. exact (mapcanon_M2_1 _ _ H3). + exact (mapcanon_M2_1 _ _ H4). + apply H0. exact (mapcanon_M2_2 _ _ H3). + exact (mapcanon_M2_2 _ _ H4). + change (2 <= MapCard A (MapMerge A (M2 A m0 m1) (M2 A m2 m3))) in |- *. + apply le_trans with (m := MapCard A (M2 A m0 m1)). exact (mapcanon_M2 _ _ H3). + exact (MapMerge_Card_lb_l A (M2 A m0 m1) (M2 A m2 m3)). Qed. - Lemma MapDelta_canon : (m,m':(Map A)) (mapcanon m) -> (mapcanon m') -> - (mapcanon (MapDelta A m m')). + Lemma MapDelta_canon : + forall 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). + simple induction m. intros. exact H0. + simpl in |- *. 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). + simple induction m'. intros. exact H1. + unfold MapDelta in |- *. 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 in |- *. apply makeM2_canon. apply H. exact (mapcanon_M2_1 _ _ H3). + exact (mapcanon_M2_1 _ _ H4). + apply H0. exact (mapcanon_M2_2 _ _ H3). + exact (mapcanon_M2_2 _ _ H4). Qed. Variable B : Set. - Lemma MapDomRestrTo_canon : (m:(Map A)) (mapcanon m) -> - (m':(Map B)) (mapcanon (MapDomRestrTo A B m m')). + Lemma MapDomRestrTo_canon : + forall m:Map A, + mapcanon m -> forall 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). + simple induction m. intros. exact M0_canon. + simpl in |- *. intros a y H m'. case (MapGet B m' a). exact M0_canon. + intro. apply M1_canon. + simple induction m'. exact M0_canon. + unfold MapDomRestrTo in |- *. intros a y. case (MapGet A (M2 A m0 m1) a). exact M0_canon. + intro. apply M1_canon. + intros. simpl in |- *. apply makeM2_canon. apply H. exact (mapcanon_M2_1 m0 m1 H1). + apply H0. exact (mapcanon_M2_2 m0 m1 H1). Qed. - Lemma MapDomRestrBy_canon : (m:(Map A)) (mapcanon m) -> - (m':(Map B)) (mapcanon (MapDomRestrBy A B m m')). + Lemma MapDomRestrBy_canon : + forall m:Map A, + mapcanon m -> forall 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). + simple induction m. intros. exact M0_canon. + simpl in |- *. intros a y H m'. case (MapGet B m' a). assumption. + intro. exact M0_canon. + simple induction m'. exact H1. + intros a y. simpl in |- *. 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 in |- *. 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)). + Lemma Map_of_alist_canon : forall 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. + simple induction l. exact M0_canon. + intro r. elim r. intros a y l0 H. simpl in |- *. apply MapPut_canon. assumption. Qed. - Lemma MapSubset_c_1 : (m:(Map A)) (m':(Map B)) (mapcanon m) -> - (MapSubset A B m m') -> (MapDomRestrBy A B m m')=(M0 A). + Lemma MapSubset_c_1 : + forall (m:Map A) (m':Map B), + mapcanon m -> MapSubset A B m m' -> MapDomRestrBy A B m m' = M0 A. Proof. - Intros. Apply mapcanon_unique. Apply MapDomRestrBy_canon. Assumption. - Apply M0_canon. - Exact (MapSubset_imp_2 ? ? m m' H0). + 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'). + Lemma MapSubset_c_2 : + forall (m:Map A) (m':Map B), + MapDomRestrBy A B m m' = M0 A -> MapSubset A B m m'. Proof. - Intros. Apply MapSubset_2_imp. Unfold MapSubset_2. Rewrite H. Apply eqmap_refl. + intros. apply MapSubset_2_imp. unfold MapSubset_2 in |- *. rewrite H. apply eqmap_refl. Qed. End MapCanon. @@ -325,52 +337,63 @@ Section FSetCanon. Variable A : Set. - Lemma MapDom_canon : (m:(Map A)) (mapcanon A m) -> (mapcanon unit (MapDom A m)). + Lemma MapDom_canon : + forall 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). + simple induction m. intro. exact (M0_canon unit). + intros a y H. exact (M1_canon unit a _). + intros. simpl in |- *. apply M2_canon. apply H. exact (mapcanon_M2_1 A _ _ H1). + apply H0. exact (mapcanon_M2_2 A _ _ H1). + change (2 <= MapCard unit (MapDom A (M2 A m0 m1))) in |- *. rewrite <- MapCard_Dom. + exact (mapcanon_M2 A _ _ H1). Qed. End FSetCanon. Section MapFoldCanon. - 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)). + Variables A B : Set. + + Lemma MapFold_canon_1 : + forall m0:Map B, + mapcanon B m0 -> + forall op:Map B -> Map B -> Map B, + (forall m1:Map B, + mapcanon B m1 -> + forall m2:Map B, mapcanon B m2 -> mapcanon B (op m1 m2)) -> + forall f:ad -> A -> Map B, + (forall (a:ad) (y:A), mapcanon B (f a y)) -> + forall (m:Map A) (pf:ad -> ad), + mapcanon B (MapFold1 A (Map B) m0 op f pf m). Proof. - Induction m. Intro. Exact H. - Intros a y pf. Simpl. Apply H1. - Intros. Simpl. Apply H0. Apply H2. - Apply H3. + simple induction m. intro. exact H. + intros a y pf. simpl in |- *. apply H1. + intros. simpl in |- *. apply H0. apply H2. + apply H3. Qed. - Lemma MapFold_canon : (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)). + Lemma MapFold_canon : + forall m0:Map B, + mapcanon B m0 -> + forall op:Map B -> Map B -> Map B, + (forall m1:Map B, + mapcanon B m1 -> + forall m2:Map B, mapcanon B m2 -> mapcanon B (op m1 m2)) -> + forall f:ad -> A -> Map B, + (forall (a:ad) (y:A), mapcanon B (f a y)) -> + forall m:Map A, mapcanon B (MapFold A (Map B) m0 op f m). Proof. - Intros. Exact (MapFold_canon_1 m0 H op H0 f H1 m [a:ad]a). + intros. exact (MapFold_canon_1 m0 H op H0 f H1 m (fun 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)). + Lemma MapCollect_canon : + forall f:ad -> A -> Map B, + (forall (a:ad) (y:A), mapcanon B (f a y)) -> + forall m:Map A, mapcanon B (MapCollect A B f m). Proof. - Intros. Rewrite MapCollect_as_Fold. Apply MapFold_canon. Apply M0_canon. - Intros. Exact (MapMerge_canon B m1 m2 H0 H1). - Assumption. + intros. rewrite MapCollect_as_Fold. apply MapFold_canon. apply M0_canon. + intros. exact (MapMerge_canon B m1 m2 H0 H1). + assumption. Qed. -End MapFoldCanon. +End MapFoldCanon.
\ No newline at end of file diff --git a/theories/IntMap/Mapcard.v b/theories/IntMap/Mapcard.v index e124a11f6b..fe598c4128 100644 --- a/theories/IntMap/Mapcard.v +++ b/theories/IntMap/Mapcard.v @@ -7,664 +7,758 @@ (***********************************************************************) (*i $Id$ i*) -Require Bool. -Require Sumbool. -Require Arith. -Require ZArith. -Require Addr. -Require Adist. -Require Addec. -Require Map. -Require Mapaxioms. -Require Mapiter. -Require Fset. -Require Mapsubset. -Require PolyList. -Require Lsort. -Require Peano_dec. +Require Import Bool. +Require Import Sumbool. +Require Import Arith. +Require Import ZArith. +Require Import Addr. +Require Import Adist. +Require Import Addec. +Require Import Map. +Require Import Mapaxioms. +Require Import Mapiter. +Require Import Fset. +Require Import Mapsubset. +Require Import List. +Require Import Lsort. +Require Import Peano_dec. Section MapCard. - Variable A, B : Set. + Variables A B : Set. + + Lemma MapCard_M0 : MapCard A (M0 A) = 0. + Proof. + trivial. + Qed. + + Lemma MapCard_M1 : forall (a:ad) (y:A), MapCard A (M1 A a y) = 1. + Proof. + trivial. + Qed. + + Lemma MapCard_is_O : + forall m:Map A, MapCard A m = 0 -> forall a:ad, MapGet A m a = NONE A. + Proof. + simple induction m. trivial. + intros a y H. discriminate H. + intros. simpl in H1. elim (plus_is_O _ _ H1). intros. rewrite (MapGet_M2_bit_0_if A m0 m1 a). + case (ad_bit_0 a). apply H0. assumption. + apply H. assumption. + Qed. - Lemma MapCard_M0 : (MapCard A (M0 A))=O. + Lemma MapCard_is_not_O : + forall (m:Map A) (a:ad) (y:A), + MapGet A m a = SOME A y -> {n : nat | MapCard A m = S n}. Proof. - Trivial. + simple 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 0. + 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 in |- *. rewrite H3. split with (MapCard A m0 + n). + rewrite <- (plus_Snm_nSm (MapCard A m0) n). reflexivity. + intro H2. rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1) in H1. elim (H (ad_div_2 a) y H1). + intros n H3. simpl in |- *. rewrite H3. split with (n + MapCard A m1). reflexivity. Qed. - Lemma MapCard_M1 : (a:ad) (y:A) (MapCard A (M1 A a y))=(1). + Lemma MapCard_is_one : + forall m:Map A, + MapCard A m = 1 -> {a : ad & {y : A | MapGet A m a = SOME A y}}. Proof. - Trivial. + simple induction m. intro. discriminate H. + intros a y H. split with a. split with y. apply M1_semantics_1. + intros. simpl in H1. elim (plus_is_one (MapCard A m0) (MapCard A m1) H1). + intro H2. elim H2. intros. elim (H0 H4). intros a H5. split with (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_O : (m:(Map A)) (MapCard A m)=O -> - (a:ad) (MapGet A m a)=(NONE A). + Lemma MapCard_is_one_unique : + forall m:Map A, + MapCard A m = 1 -> + forall (a a':ad) (y y':A), + MapGet A m a = SOME A y -> + MapGet A m a' = SOME A y' -> a = a' /\ y = y'. 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. + simple 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 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)}. + Lemma length_as_fold : + forall (C:Set) (l:list C), + length l = fold_right (fun (_:C) (n:nat) => S n) 0 l. 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. + simple induction l. reflexivity. + intros. simpl in |- *. rewrite H. 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). + Lemma length_as_fold_2 : + forall l:alist A, + length l = + fold_right (fun (r:ad * A) (n:nat) => let (a, y) := r in 1 + n) 0 l. + Proof. + simple induction l. reflexivity. + intros. simpl in |- *. rewrite H. elim a; reflexivity. + Qed. + + Lemma MapCard_as_Fold_1 : + forall (m:Map A) (pf:ad -> ad), + MapCard A m = MapFold1 A nat 0 plus (fun (_:ad) (_:A) => 1) pf m. + Proof. + simple induction m. trivial. + trivial. + intros. simpl in |- *. rewrite <- (H (fun a0:ad => pf (ad_double a0))). + rewrite <- (H0 (fun a0:ad => pf (ad_double_plus_un a0))). reflexivity. + Qed. + + Lemma MapCard_as_Fold : + forall m:Map A, + MapCard A m = MapFold A nat 0 plus (fun (_:ad) (_:A) => 1) m. + Proof. + intro. exact (MapCard_as_Fold_1 m (fun a0:ad => a0)). Qed. - Lemma MapCard_as_length : (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_as_length : + forall m:Map A, MapCard A m = length (alist_of_Map A m). + Proof. + intro. rewrite MapCard_as_Fold. rewrite length_as_fold_2. + apply MapFold_as_fold with + (op := plus) (neutral := 0) (f := fun (_:ad) (_:A) => 1). exact plus_assoc_reverse. + trivial. + intro. rewrite <- plus_n_O. reflexivity. + Qed. + + Lemma MapCard_Put1_equals_2 : + forall (p:positive) (a a':ad) (y y':A), + MapCard A (MapPut1 A a y a' y' p) = 2. + Proof. + simple induction p. intros. simpl in |- *. case (ad_bit_0 a); reflexivity. + intros. simpl in |- *. case (ad_bit_0 a). exact (H (ad_div_2 a) (ad_div_2 a') y y'). + simpl in |- *. rewrite <- plus_n_O. exact (H (ad_div_2 a) (ad_div_2 a') y y'). + intros. simpl in |- *. case (ad_bit_0 a); reflexivity. + Qed. + + Lemma MapCard_Put_sum : + forall (m m':Map A) (a:ad) (y:A) (n n':nat), + m' = MapPut A m a y -> + n = MapCard A m -> n' = MapCard A m' -> {n' = n} + {n' = S n}. + Proof. + simple induction m. simpl in |- *. intros. rewrite H in H1. simpl in H1. right. + rewrite H0. rewrite H1. reflexivity. + intros a y m' a0 y0 n n' H H0 H1. simpl in H. elim (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 : + forall (m:Map A) (a:ad) (y:A), MapCard A (MapPut A m a y) >= MapCard A m. + Proof. + unfold ge in |- *. intros. + elim + (MapCard_Put_sum m (MapPut A m a y) a y (MapCard A m) + (MapCard A (MapPut A m a y)) (refl_equal _) ( + refl_equal _) (refl_equal _)). + intro H. rewrite H. apply le_n. + intro H. rewrite H. apply le_n_Sn. + Qed. + + Lemma MapCard_Put_ub : + forall (m:Map A) (a:ad) (y:A), + MapCard A (MapPut A m a y) <= S (MapCard A m). + Proof. + intros. + elim + (MapCard_Put_sum m (MapPut A m a y) a y (MapCard A m) + (MapCard A (MapPut A m a y)) (refl_equal _) ( + refl_equal _) (refl_equal _)). + intro H. rewrite H. apply le_n_Sn. + intro H. rewrite H. apply le_n. + Qed. + + Lemma MapCard_Put_1 : + forall (m:Map A) (a:ad) (y:A), + MapCard A (MapPut A m a y) = MapCard A m -> + {y : A | MapGet A m a = SOME A y}. + Proof. + simple 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 ((fun n m p:nat => plus_reg_l m p n) _ _ _ H1)). + intros y0 H3. split with y0. rewrite <- H3. exact (MapGet_M2_bit_0_1 A a H2 m0 m1). + intro H2. rewrite H2 in H1. simpl in H1. + rewrite + (plus_comm (MapCard A (MapPut A m0 (ad_div_2 a) y)) (MapCard A m1)) + in H1. + rewrite (plus_comm (MapCard A m0) (MapCard A m1)) in H1. + elim (H (ad_div_2 a) y ((fun n m p:nat => plus_reg_l m p n) _ _ _ H1)). intros y0 H3. split with y0. + rewrite <- H3. exact (MapGet_M2_bit_0_0 A a H2 m0 m1). + Qed. + + Lemma MapCard_Put_2 : + forall (m:Map A) (a:ad) (y:A), + MapCard A (MapPut A m a y) = S (MapCard A m) -> MapGet A m a = NONE A. + Proof. + simple 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 (fun n m p:nat => plus_reg_l m p n) with (n := MapCard A m0). + rewrite <- (plus_Snm_nSm (MapCard A m0) (MapCard A m1)). simpl in H1. simpl in |- *. rewrite <- H1. + clear H1. + induction a. discriminate H2. + induction p. reflexivity. + discriminate H2. + reflexivity. + intro H2. rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1). apply (H (ad_div_2 a) y). + cut + (MapCard A (MapPut A m0 (ad_div_2 a) y) + MapCard A m1 = + S (MapCard A m0) + MapCard A m1). + intro. rewrite (plus_comm (MapCard A (MapPut A m0 (ad_div_2 a) y)) (MapCard A m1)) + in H3. + rewrite (plus_comm (S (MapCard A m0)) (MapCard A m1)) in H3. exact ((fun n m p:nat => plus_reg_l m p n) _ _ _ H3). + simpl in |- *. simpl in H1. rewrite <- H1. induction a. trivial. + induction p. discriminate H2. + reflexivity. + discriminate H2. + Qed. + + Lemma MapCard_Put_1_conv : + forall (m:Map A) (a:ad) (y y':A), + MapGet A m a = SOME 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 : + forall (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 : + forall m m':Map A, + eqm A (MapGet A m) (MapGet A m') -> MapCard A m = MapCard A m'. + Proof. + unfold eqm in |- *. intros. rewrite (MapCard_as_length m). rewrite (MapCard_as_length m'). + rewrite (alist_canonical A (alist_of_Map A m) (alist_of_Map A m')). reflexivity. + unfold eqm in |- *. intro. rewrite (Map_of_alist_semantics A (alist_of_Map A m) a). + rewrite (Map_of_alist_semantics A (alist_of_Map A m') a). rewrite (Map_of_alist_of_Map A m' a). + rewrite (Map_of_alist_of_Map A m a). exact (H a). + apply alist_of_Map_sorts2. + apply alist_of_Map_sorts2. + Qed. + + Lemma MapCard_Dom : forall m:Map A, MapCard A m = MapCard unit (MapDom A m). + Proof. + simple induction m; trivial. intros. simpl in |- *. rewrite H. rewrite H0. reflexivity. + Qed. + + Lemma MapCard_Dom_Put_behind : + forall (m:Map A) (a:ad) (y:A), + MapDom A (MapPut_behind A m a y) = MapDom A (MapPut A m a y). + Proof. + simple induction m. trivial. + intros a y a0 y0. simpl in |- *. elim (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 in |- *. elim (ad_sum a). intro H1. elim H1. intros p H2. rewrite H2. case p. + intro p0. simpl in |- *. rewrite H0. reflexivity. + intro p0. simpl in |- *. rewrite H. reflexivity. + simpl in |- *. rewrite H0. reflexivity. + intro H1. rewrite H1. simpl in |- *. rewrite H. reflexivity. + Qed. + + Lemma MapCard_Put_behind_Put : + forall (m:Map A) (a:ad) (y:A), + MapCard A (MapPut_behind A m a y) = MapCard A (MapPut A m a y). + Proof. + intros. rewrite MapCard_Dom. rewrite MapCard_Dom. rewrite MapCard_Dom_Put_behind. + reflexivity. + Qed. - Lemma MapCard_makeM2 : (m,m':(Map A)) - (MapCard A (makeM2 A m m'))=(plus (MapCard A m) (MapCard A m')). + Lemma MapCard_Put_behind_sum : + forall (m m':Map A) (a:ad) (y:A) (n n':nat), + m' = MapPut_behind A m a y -> + n = MapCard A m -> n' = MapCard A m' -> {n' = n} + {n' = S n}. + Proof. + intros. apply (MapCard_Put_sum m (MapPut A m a y) a y n n'); trivial. + rewrite <- MapCard_Put_behind_Put. rewrite <- H. assumption. + Qed. + + Lemma MapCard_makeM2 : + forall m m':Map A, MapCard A (makeM2 A m m') = MapCard A m + MapCard A m'. Proof. - Intros. Rewrite (MapCard_ext ? ? (makeM2_M2 A m m')). Reflexivity. + 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. + Lemma MapCard_Remove_sum : + forall (m m':Map A) (a:ad) (n n':nat), + m' = MapRemove A m a -> + n = MapCard A m -> n' = MapCard A m' -> {n = n'} + {n = S n'}. + Proof. + simple induction m. simpl in |- *. intros. rewrite H in H1. simpl in H1. left. rewrite H1. assumption. + simpl in |- *. intros. elim (sumbool_of_bool (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 : + forall (m:Map A) (a:ad), MapCard A (MapRemove A m a) <= MapCard A m. + Proof. + intros. + elim + (MapCard_Remove_sum m (MapRemove A m a) a (MapCard A m) + (MapCard A (MapRemove A m a)) (refl_equal _) ( + refl_equal _) (refl_equal _)). + intro H. rewrite H. apply le_n. + intro H. rewrite H. apply le_n_Sn. + Qed. + + Lemma MapCard_Remove_lb : + forall (m:Map A) (a:ad), S (MapCard A (MapRemove A m a)) >= MapCard A m. + Proof. + unfold ge in |- *. intros. + elim + (MapCard_Remove_sum m (MapRemove A m a) a (MapCard A m) + (MapCard A (MapRemove A m a)) (refl_equal _) ( + refl_equal _) (refl_equal _)). + intro H. rewrite H. apply le_n_Sn. + intro H. rewrite H. apply le_n. + Qed. + + Lemma MapCard_Remove_1 : + forall (m:Map A) (a:ad), + MapCard A (MapRemove A m a) = MapCard A m -> MapGet A m a = NONE A. + Proof. + simple induction m. trivial. + simpl in |- *. 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 ((fun n m p:nat => plus_reg_l m p n) _ _ _ 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_comm (MapCard A (MapRemove A m0 (ad_div_2 a))) (MapCard A m1)) + in H1. + rewrite (plus_comm (MapCard A m0) (MapCard A m1)) in H1. exact ((fun n m p:nat => plus_reg_l m p n) _ _ _ H1). + Qed. + + Lemma MapCard_Remove_2 : + forall (m:Map A) (a:ad), + S (MapCard A (MapRemove A m a)) = MapCard A m -> + {y : A | MapGet A m a = SOME A y}. + Proof. + simple 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 + (S (MapCard A m0) + MapCard A (MapRemove A m1 (ad_div_2 a)) = + 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 ((fun n m p:nat => plus_reg_l m p n) _ _ _ H1). + intro H2. rewrite H2 in H1. rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1). apply H. + rewrite (MapCard_makeM2 (MapRemove A m0 (ad_div_2 a)) m1) in H1. + change + (S (MapCard A (MapRemove A m0 (ad_div_2 a))) + MapCard A m1 = + MapCard A m0 + MapCard A m1) in H1. + rewrite + (plus_comm (S (MapCard A (MapRemove A m0 (ad_div_2 a)))) (MapCard A m1)) + in H1. + rewrite (plus_comm (MapCard A m0) (MapCard A m1)) in H1. exact ((fun n m p:nat => plus_reg_l m p n) _ _ _ H1). + Qed. + + Lemma MapCard_Remove_1_conv : + forall (m:Map A) (a:ad), + MapGet A m a = NONE 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 : + forall (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 : + forall m m':Map A, + MapCard A m + MapCard A m' = + MapCard A (MapMerge A m m') + MapCard A (MapDomRestrTo A A m m'). + Proof. + simple induction m. simpl in |- *. intro. apply plus_n_O. + simpl in |- *. intros a y m'. elim (option_sum A (MapGet A m' a)). intro H. elim H. intros y0 H0. + rewrite H0. rewrite MapCard_Put_behind_Put. rewrite (MapCard_Put_1_conv m' a y0 y H0). + simpl in |- *. rewrite <- plus_Snm_nSm. apply plus_n_O. + intro H. rewrite H. rewrite MapCard_Put_behind_Put. rewrite (MapCard_Put_2_conv m' a y H). + apply plus_n_O. + intros. + change + (MapCard A m0 + MapCard A m1 + MapCard A m' = + MapCard A (MapMerge A (M2 A m0 m1) m') + + MapCard A (MapDomRestrTo A A (M2 A m0 m1) m')) + in |- *. + elim m'. reflexivity. + intros a y. unfold MapMerge in |- *. unfold MapDomRestrTo in |- *. + elim (option_sum A (MapGet A (M2 A m0 m1) a)). intro H1. elim H1. intros y0 H2. rewrite H2. + rewrite (MapCard_Put_1_conv (M2 A m0 m1) a y0 y H2). reflexivity. + intro H1. rewrite H1. rewrite (MapCard_Put_2_conv (M2 A m0 m1) a y H1). simpl in |- *. + rewrite <- (plus_Snm_nSm (MapCard A m0 + MapCard A m1) 0). reflexivity. + intros. simpl in |- *. + rewrite + (plus_permute_2_in_4 (MapCard A m0) (MapCard A m1) ( + MapCard A m2) (MapCard A m3)). + rewrite (H m2). rewrite (H0 m3). + rewrite + (MapCard_makeM2 (MapDomRestrTo A A m0 m2) (MapDomRestrTo A A m1 m3)) + . + apply plus_permute_2_in_4. + Qed. + + Lemma MapMerge_disjoint_Card : + forall m m':Map A, + MapDisjoint A A m m' -> + MapCard A (MapMerge A m m') = MapCard A m + MapCard A m'. + Proof. + intros. rewrite (MapMerge_Restr_Card m m'). + rewrite (MapCard_ext _ _ (MapDisjoint_imp_2 _ _ _ _ H)). apply plus_n_O. + Qed. + + Lemma MapSplit_Card : + forall (m:Map A) (m':Map B), + MapCard A m = + MapCard A (MapDomRestrTo A B m m') + MapCard A (MapDomRestrBy A B m m'). + Proof. + intros. rewrite (MapCard_ext _ _ (MapDom_Split_1 A B m m')). apply MapMerge_disjoint_Card. + apply MapDisjoint_2_imp. unfold MapDisjoint_2 in |- *. apply MapDom_Split_3. + Qed. + + Lemma MapMerge_Card_ub : + forall m m':Map A, + MapCard A (MapMerge A m m') <= MapCard A m + MapCard A m'. + Proof. + intros. rewrite MapMerge_Restr_Card. apply le_plus_l. + Qed. + + Lemma MapDomRestrTo_Card_ub_l : + forall (m:Map A) (m':Map B), + MapCard A (MapDomRestrTo A B m m') <= MapCard A m. + Proof. + intros. rewrite (MapSplit_Card m m'). apply le_plus_l. + Qed. + + Lemma MapDomRestrBy_Card_ub_l : + forall (m:Map A) (m':Map B), + MapCard A (MapDomRestrBy A B m m') <= MapCard A m. + Proof. + intros. rewrite (MapSplit_Card m m'). apply le_plus_r. + Qed. + + Lemma MapMerge_Card_disjoint : + forall m m':Map A, + MapCard A (MapMerge A m m') = MapCard A m + MapCard A m' -> + MapDisjoint A A m m'. + Proof. + simple induction m. intros. apply Map_M0_disjoint. + simpl in |- *. intros. rewrite (MapCard_Put_behind_Put m' a a0) in H. unfold MapDisjoint, in_dom in |- *. + simpl in |- *. intros. elim (sumbool_of_bool (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. + simple induction m'. intros. apply Map_disjoint_M0. + intros a y H1. rewrite <- (MapCard_ext _ _ (MapPut_as_Merge A (M2 A m0 m1) a y)) in H1. + unfold MapCard at 3 in H1. rewrite <- (plus_Snm_nSm (MapCard A (M2 A m0 m1)) 0) in H1. + rewrite <- (plus_n_O (S (MapCard A (M2 A m0 m1)))) in H1. unfold MapDisjoint, in_dom in |- *. + unfold MapGet at 2 in |- *. intros. elim (sumbool_of_bool (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 in |- *. 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 (fun p n m:nat => plus_le_reg_l n m p) with + (p := MapCard A m0 + MapCard A m2). + rewrite + (plus_permute_2_in_4 (MapCard A m0) (MapCard A m2) ( + MapCard A m1) (MapCard A m3)). + change + (MapCard A (M2 A (MapMerge A m0 m2) (MapMerge A m1 m3)) = + MapCard A m0 + MapCard A m1 + (MapCard A m2 + MapCard A m3)) + in H3. + rewrite <- H3. simpl in |- *. apply plus_le_compat_r. apply MapMerge_Card_ub. + elim (in_dom_some _ _ _ H4). intros y H7. rewrite (MapGet_M2_bit_0_1 _ a H6 m0 m1) in H7. + unfold in_dom in |- *. rewrite H7. reflexivity. + elim (in_dom_some _ _ _ H5). intros y H7. rewrite (MapGet_M2_bit_0_1 _ a H6 m2 m3) in H7. + unfold in_dom in |- *. rewrite H7. reflexivity. + intro H6. unfold MapDisjoint in H. apply H with (m' := m2) (a := ad_div_2 a). apply le_antisym. + apply MapMerge_Card_ub. + apply (fun p n m:nat => plus_le_reg_l n m p) with + (p := MapCard A m1 + MapCard A m3). + rewrite + (plus_comm (MapCard A m1 + MapCard A m3) (MapCard A m0 + MapCard A m2)) + . + rewrite + (plus_permute_2_in_4 (MapCard A m0) (MapCard A m2) ( + MapCard A m1) (MapCard A m3)). + rewrite + (plus_comm (MapCard A m1 + MapCard A m3) (MapCard A (MapMerge A m0 m2))) + . + change + (MapCard A (MapMerge A m0 m2) + MapCard A (MapMerge A m1 m3) = + MapCard A m0 + MapCard A m1 + (MapCard A m2 + MapCard A m3)) + in H3. + rewrite <- H3. apply plus_le_compat_l. apply MapMerge_Card_ub. + elim (in_dom_some _ _ _ H4). intros y H7. rewrite (MapGet_M2_bit_0_0 _ a H6 m0 m1) in H7. + unfold in_dom in |- *. rewrite H7. reflexivity. + elim (in_dom_some _ _ _ H5). intros y H7. rewrite (MapGet_M2_bit_0_0 _ a H6 m2 m3) in H7. + unfold in_dom in |- *. rewrite H7. reflexivity. + Qed. + + Lemma MapCard_is_Sn : + forall (m:Map A) (n:nat), + MapCard _ m = S n -> {a : ad | in_dom _ a m = true}. + Proof. + simple induction m. intros. discriminate H. + intros a y n H. split with a. unfold in_dom in |- *. rewrite (M1_semantics_1 _ a y). reflexivity. + intros. simpl in H1. elim (O_or_S (MapCard _ m0)). intro H2. elim H2. intros m2 H3. + elim (H _ (sym_eq H3)). intros a H4. split with (ad_double a). unfold in_dom in |- *. + 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 in |- *. + 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. + Variables A B : Set. + + Lemma MapSubset_card_eq_1 : + forall (n:nat) (m:Map A) (m':Map B), + MapSubset _ _ m m' -> + MapCard _ m = n -> MapCard _ m' = n -> MapSubset _ _ m' m. + Proof. + simple induction n. intros. unfold MapSubset, in_dom in |- *. intro. rewrite (MapCard_is_O _ m H0 a). + rewrite (MapCard_is_O _ m' H1 a). intro H2. discriminate H2. + intros. elim (MapCard_is_Sn A m n0 H1). intros a H3. elim (in_dom_some _ _ _ H3). + intros y H4. elim (in_dom_some _ _ _ (H0 _ H3)). intros y' H6. + cut (eqmap _ (MapPut _ (MapRemove _ m a) a y) m). intro. + cut (eqmap _ (MapPut _ (MapRemove _ m' a) a y') m'). intro. + apply MapSubset_ext with + (m0 := MapPut _ (MapRemove _ m' a) a y') + (m2 := MapPut _ (MapRemove _ m a) a y). + assumption. + assumption. + apply MapSubset_Put_mono. apply H. apply MapSubset_Remove_mono. assumption. + rewrite <- (MapCard_Remove_2_conv _ m a y H4) in H1. inversion_clear H1. reflexivity. + rewrite <- (MapCard_Remove_2_conv _ m' a y' H6) in H2. inversion_clear H2. reflexivity. + unfold eqmap, eqm in |- *. intro. rewrite (MapPut_semantics _ (MapRemove B m' a) a y' a0). + elim (sumbool_of_bool (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 in |- *. 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 : + forall (m:Map A) (m':Map B), + MapCard A (MapDomRestrTo A B m m') <= MapCard B m'. + Proof. + simple induction m. intro. simpl in |- *. apply le_O_n. + intros a y m'. simpl in |- *. elim (option_sum B (MapGet B m' a)). intro H. elim H. intros y0 H0. + rewrite H0. elim (MapCard_is_not_O B m' a y0 H0). intros n H1. rewrite H1. simpl in |- *. + apply le_n_S. apply le_O_n. + intro H. rewrite H. simpl in |- *. apply le_O_n. + simple induction m'. simpl in |- *. apply le_O_n. + + intros a y. unfold MapDomRestrTo in |- *. case (MapGet A (M2 A m0 m1) a). simpl in |- *. apply le_O_n. + intro. simpl in |- *. apply le_n. + intros. simpl in |- *. rewrite + (MapCard_makeM2 A (MapDomRestrTo A B m0 m2) (MapDomRestrTo A B m1 m3)) + . + apply plus_le_compat. apply H. + apply H0. Qed. End MapCard2. Section MapCard3. - Variable A, B : Set. + Variables A B : Set. - Lemma MapMerge_Card_lb_l : (m,m':(Map A)) - (ge (MapCard A (MapMerge A m m')) (MapCard A m)). + Lemma MapMerge_Card_lb_l : + forall m m':Map A, 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. + unfold ge in |- *. intros. apply ((fun p n m:nat => plus_le_reg_l n m p) (MapCard A m')). + rewrite (plus_comm (MapCard A m') (MapCard A m)). + rewrite (plus_comm (MapCard A m') (MapCard A (MapMerge A m m'))). + rewrite (MapMerge_Restr_Card A m m'). apply plus_le_compat_l. apply MapDomRestrTo_Card_ub_r. Qed. - Lemma MapMerge_Card_lb_r : (m,m':(Map A)) - (ge (MapCard A (MapMerge A m m')) (MapCard A m')). + Lemma MapMerge_Card_lb_r : + forall m m':Map A, 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. + unfold ge in |- *. intros. apply ((fun p n m:nat => plus_le_reg_l n m p) (MapCard A m)). rewrite (MapMerge_Restr_Card A m m'). + rewrite + (plus_comm (MapCard A (MapMerge A m m')) + (MapCard A (MapDomRestrTo A A m m'))). + apply plus_le_compat_r. apply MapDomRestrTo_Card_ub_l. Qed. - Lemma MapDomRestrBy_Card_lb : (m:(Map A)) (m':(Map B)) - (ge (plus (MapCard B m') (MapCard A (MapDomRestrBy A B m m'))) (MapCard A m)). + Lemma MapDomRestrBy_Card_lb : + forall (m:Map A) (m':Map B), + MapCard B m' + MapCard A (MapDomRestrBy A B m m') >= MapCard A m. Proof. - Unfold ge. Intros. Rewrite (MapSplit_Card A B m m'). Apply le_reg_r. - Apply MapDomRestrTo_Card_ub_r. + unfold ge in |- *. intros. rewrite (MapSplit_Card A B m m'). apply plus_le_compat_r. + apply MapDomRestrTo_Card_ub_r. Qed. - Lemma MapSubset_Card_le : (m:(Map A)) (m':(Map B)) - (MapSubset A B m m') -> (le (MapCard A m) (MapCard B m')). + Lemma MapSubset_Card_le : + forall (m:Map A) (m':Map B), + MapSubset A B m m' -> MapCard A m <= MapCard B m'. Proof. - Intros. Apply le_trans with m:=(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. + intros. apply le_trans with (m := MapCard B m' + MapCard A (MapDomRestrBy A B m m')). + exact (MapDomRestrBy_Card_lb m m'). + rewrite (MapCard_ext _ _ _ (MapSubset_imp_2 _ _ _ _ H)). simpl in |- *. rewrite <- plus_n_O. + apply le_n. Qed. - Lemma MapSubset_card_eq : (m:(Map A)) (m':(Map B)) - (MapSubset ? ? m m') -> (le (MapCard ? m') (MapCard ? m)) -> - (eqmap ? (MapDom ? m) (MapDom ? m')). + Lemma MapSubset_card_eq : + forall (m:Map A) (m':Map B), + MapSubset _ _ m m' -> + MapCard _ m' <= MapCard _ m -> eqmap _ (MapDom _ m) (MapDom _ m'). Proof. - Intros. Apply MapSubset_antisym. Assumption. - Cut (MapCard B m')=(MapCard A m). Intro. Apply (MapSubset_card_eq_1 A B (MapCard A m)). - Assumption. - Reflexivity. - Assumption. - Apply le_antisym. Assumption. - Apply MapSubset_Card_le. Assumption. + 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. +End MapCard3.
\ No newline at end of file diff --git a/theories/IntMap/Mapfold.v b/theories/IntMap/Mapfold.v index 1e59e42b22..f14b072610 100644 --- a/theories/IntMap/Mapfold.v +++ b/theories/IntMap/Mapfold.v @@ -7,19 +7,19 @@ (***********************************************************************) (*i $Id$ i*) -Require Bool. -Require Sumbool. -Require ZArith. -Require Addr. -Require Adist. -Require Addec. -Require Map. -Require Fset. -Require Mapaxioms. -Require Mapiter. -Require Lsort. -Require Mapsubset. -Require PolyList. +Require Import Bool. +Require Import Sumbool. +Require Import ZArith. +Require Import Addr. +Require Import Adist. +Require Import Addec. +Require Import Map. +Require Import Fset. +Require Import Mapaxioms. +Require Import Mapiter. +Require Import Lsort. +Require Import Mapsubset. +Require Import List. Section MapFoldResults. @@ -29,218 +29,238 @@ Section MapFoldResults. Variable neutral : M. Variable op : M -> 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)). + Variable nleft : forall a:M, op neutral a = a. + Variable nright : forall a:M, op a neutral = a. + Variable assoc : forall a b c:M, op (op a b) c = op a (op b c). - Lemma MapFold_ext : (f:ad->A->M) (m,m':(Map A)) (eqmap A m m') -> - (MapFold ? ? neutral op f m)=(MapFold ? ? neutral op f m'). + Lemma MapFold_ext : + forall (f:ad -> A -> M) (m m':Map A), + eqmap A m m' -> MapFold _ _ neutral op f m = MapFold _ _ neutral op f m'. Proof. - Intros. Rewrite (MapFold_as_fold A M neutral op assoc nleft nright f m). - Rewrite (MapFold_as_fold A M neutral op assoc nleft nright f m'). - Cut (alist_of_Map A m)=(alist_of_Map A m'). Intro. Rewrite H0. Reflexivity. - Apply alist_canonical. Unfold eqmap in H. Apply eqm_trans with f':=(MapGet A m). - Apply eqm_sym. Apply alist_of_Map_semantics. - Apply eqm_trans with f':=(MapGet A m'). Assumption. - Apply alist_of_Map_semantics. - Apply alist_of_Map_sorts2. - Apply alist_of_Map_sorts2. + 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). + Lemma MapFold_ext_f_1 : + forall (m:Map A) (f g:ad -> A -> M) (pf:ad -> ad), + (forall (a:ad) (y:A), MapGet _ m a = SOME _ y -> f (pf a) y = g (pf a) y) -> + MapFold1 _ _ neutral op f pf m = MapFold1 _ _ neutral op g pf m. Proof. - 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. + simple induction m. trivial. + simpl in |- *. intros. apply H. rewrite (ad_eq_correct a). reflexivity. + intros. simpl in |- *. rewrite (H f g (fun a0:ad => pf (ad_double a0))). + rewrite (H0 f g (fun 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). + Lemma MapFold_ext_f : + forall (f g:ad -> A -> M) (m:Map A), + (forall (a:ad) (y:A), MapGet _ m a = SOME _ y -> f a y = g a y) -> + MapFold _ _ neutral op f m = MapFold _ _ neutral op g m. Proof. - Intros. Exact (MapFold_ext_f_1 m f g [a0:ad]a0 H). + intros. exact (MapFold_ext_f_1 m f g (fun 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). + Lemma MapFold1_as_Fold_1 : + forall (m:Map A) (f f':ad -> A -> M) (pf pf':ad -> ad), + (forall (a:ad) (y:A), f (pf a) y = f' (pf' a) y) -> + MapFold1 _ _ neutral op f pf m = MapFold1 _ _ neutral op f' pf' m. Proof. - 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. + simple induction m. trivial. + intros. simpl in |- *. apply H. + intros. simpl in |- *. + rewrite + (H f f' (fun a0:ad => pf (ad_double a0)) + (fun a0:ad => pf' (ad_double a0))). + rewrite + (H0 f f' (fun a0:ad => pf (ad_double_plus_un a0)) + (fun 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). + Lemma MapFold1_as_Fold : + forall (f:ad -> A -> M) (pf:ad -> ad) (m:Map A), + MapFold1 _ _ neutral op f pf m = + MapFold _ _ neutral op (fun (a:ad) (y:A) => f (pf a) y) m. Proof. - Intros. Unfold MapFold. Apply MapFold1_as_Fold_1. Trivial. + intros. unfold MapFold in |- *. 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'). + Lemma MapFold1_ext : + forall (f:ad -> A -> M) (m m':Map A), + eqmap A m m' -> + forall pf:ad -> ad, + MapFold1 _ _ neutral op f pf m = MapFold1 _ _ neutral op f pf m'. Proof. - Intros. Rewrite MapFold1_as_Fold. Rewrite MapFold1_as_Fold. Apply MapFold_ext. Assumption. + 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). + Variable comm : forall 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)). + Lemma MapFold_Put_disjoint_1 : + forall (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. + simple induction p. intros. simpl in |- *. elim (sumbool_of_bool (ad_bit_0 a1)). intro H1. rewrite H1. + simpl in |- *. rewrite ad_div_2_double_plus_un. rewrite ad_div_2_double. apply comm. + change (ad_bit_0 a2 = negb true) in |- *. rewrite <- H1. rewrite (ad_neg_bit_0_2 _ _ _ H0). + rewrite negb_elim. reflexivity. + assumption. + intro H1. rewrite H1. simpl in |- *. rewrite ad_div_2_double. rewrite ad_div_2_double_plus_un. + reflexivity. + change (ad_bit_0 a2 = negb false) in |- *. rewrite <- H1. rewrite (ad_neg_bit_0_2 _ _ _ H0). + rewrite negb_elim. reflexivity. + assumption. + simpl in |- *. intros. elim (sumbool_of_bool (ad_bit_0 a1)). intro H1. rewrite H1. simpl in |- *. + rewrite nleft. + rewrite + (H f (fun 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 in |- *. rewrite nright. + rewrite + (H f (fun 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 in |- *. elim (sumbool_of_bool (ad_bit_0 a1)). intro H0. rewrite H0. simpl in |- *. + rewrite ad_div_2_double. rewrite ad_div_2_double_plus_un. apply comm. + assumption. + change (ad_bit_0 a2 = negb true) in |- *. rewrite <- H0. rewrite (ad_neg_bit_0_1 _ _ H). + rewrite negb_elim. reflexivity. + intro H0. rewrite H0. simpl in |- *. rewrite ad_div_2_double. rewrite ad_div_2_double_plus_un. + reflexivity. + change (ad_bit_0 a2 = negb false) in |- *. 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)). + Lemma MapFold_Put_disjoint_2 : + forall (f:ad -> A -> M) (m:Map A) (a:ad) (y:A) (pf:ad -> ad), + MapGet A m a = NONE 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. + simple induction m. intros. simpl in |- *. rewrite (nright (f (pf a) y)). reflexivity. + intros a1 y1 a2 y2 pf H. simpl in |- *. 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 in |- *. rewrite (H0 (ad_div_2 a) y (fun 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 (fun 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 in |- *. 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 in |- *. rewrite (H (ad_div_2 a) y (fun 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 in |- *. 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)). + Lemma MapFold_Put_disjoint : + forall (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). + intros. exact (MapFold_Put_disjoint_2 f m a y (fun 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)). + Lemma MapFold_Put_behind_disjoint_2 : + forall (f:ad -> A -> M) (m:Map A) (a:ad) (y:A) (pf:ad -> ad), + MapGet A m a = NONE 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. + intros. cut (eqmap A (MapPut_behind A m a y) (MapPut A m a y)). intro. + rewrite (MapFold1_ext f _ _ H0 pf). apply MapFold_Put_disjoint_2. assumption. + apply eqmap_trans with (m' := MapMerge A (M1 A a y) m). apply MapPut_behind_as_Merge. + apply eqmap_trans with (m' := MapMerge A m (M1 A a y)). + apply eqmap_trans with (m' := MapDelta A (M1 A a y) m). apply eqmap_sym. apply MapDelta_disjoint. + unfold MapDisjoint in |- *. unfold in_dom in |- *. simpl in |- *. intros. elim (sumbool_of_bool (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 in |- *. unfold in_dom in |- *. simpl in |- *. 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)). + Lemma MapFold_Put_behind_disjoint : + forall (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). + intros. exact (MapFold_Put_behind_disjoint_2 f m a y (fun 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)). + forall (f:ad -> A -> M) (m1 m2:Map A) (pf:ad -> ad), + MapDisjoint A A m1 m2 -> + MapFold1 A M neutral op f pf (MapMerge A m1 m2) = + op (MapFold1 A M neutral op f pf m1) (MapFold1 A M neutral op f pf m2). Proof. - 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). + simple induction m1. simpl in |- *. intros. rewrite nleft. reflexivity. + intros. unfold MapMerge in |- *. apply (MapFold_Put_behind_disjoint_2 f m2 a a0 pf). + apply in_dom_none. exact (MapDisjoint_M1_l _ _ m2 a a0 H). + simple induction m2. intros. simpl in |- *. rewrite nright. reflexivity. + intros. unfold MapMerge in |- *. rewrite (MapFold_Put_disjoint_2 f (M2 A m m0) a a0 pf). apply comm. + apply in_dom_none. exact (MapDisjoint_M1_r _ _ (M2 A m m0) a a0 H1). + intros. simpl in |- *. rewrite (H m3 (fun a0:ad => pf (ad_double a0))). + rewrite (H0 m4 (fun a0:ad => pf (ad_double_plus_un a0))). + cut (forall a b c d:M, op (op a b) (op c d) = op (op a c) (op b d)). intro. apply H4. + intros. rewrite assoc. rewrite <- (assoc b c d). rewrite (comm b c). rewrite (assoc c b d). + rewrite assoc. reflexivity. + exact (MapDisjoint_M2_r _ _ _ _ _ _ H3). + exact (MapDisjoint_M2_l _ _ _ _ _ _ H3). Qed. Lemma MapFold_Merge_disjoint : - (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)). + forall (f:ad -> A -> M) (m1 m2:Map A), + MapDisjoint A A m1 m2 -> + MapFold A M neutral op f (MapMerge A m1 m2) = + op (MapFold A M neutral op f m1) (MapFold A M neutral op f m2). Proof. - Intros. Exact (MapFold_Merge_disjoint_1 f m1 m2 [a0:ad]a0 H). + intros. exact (MapFold_Merge_disjoint_1 f m1 m2 (fun a0:ad => a0) H). Qed. End MapFoldResults. @@ -261,23 +281,27 @@ Section MapFoldDistr. 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)). + Variable absorb : forall c:N, times neutral c = neutral'. + Variable + distr : + forall (a b:M) (c:N), times (op a b) c = op' (times a c) (times b c). - Lemma MapFold_distr_r_1 : (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). + Lemma MapFold_distr_r_1 : + forall (f:ad -> A -> M) (m:Map A) (c:N) (pf:ad -> ad), + times (MapFold1 A M neutral op f pf m) c = + MapFold1 A M' neutral' op' (fun (a:ad) (y:A) => times (f a y) c) pf m. Proof. - Induction m. Intros. Exact (absorb c). - Trivial. - Intros. Simpl. Rewrite distr. Rewrite H. Rewrite H0. Reflexivity. + simple induction m. intros. exact (absorb c). + trivial. + intros. simpl in |- *. 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). + Lemma MapFold_distr_r : + forall (f:ad -> A -> M) (m:Map A) (c:N), + times (MapFold A M neutral op f m) c = + MapFold A M' neutral' op' (fun (a:ad) (y:A) => times (f a y) c) m. Proof. - Intros. Exact (MapFold_distr_r_1 f m c [a:ad]a). + intros. exact (MapFold_distr_r_1 f m c (fun a:ad => a)). Qed. End MapFoldDistr. @@ -298,14 +322,18 @@ Section MapFoldDistrL. 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)). + Variable absorb : forall c:N, times c neutral = neutral'. + Variable + distr : + forall (a b:M) (c:N), times c (op a b) = op' (times c a) (times c b). - Lemma MapFold_distr_l : (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). + Lemma MapFold_distr_l : + forall (f:ad -> A -> M) (m:Map A) (c:N), + times c (MapFold A M neutral op f m) = + MapFold A M' neutral' op' (fun (a:ad) (y:A) => times c (f a y)) m. Proof. - Intros. Apply MapFold_distr_r with times:=[a:M][b:N](times b a); Assumption. + intros. apply MapFold_distr_r with (times := fun (a:M) (b:N) => times b a); + assumption. Qed. End MapFoldDistrL. @@ -314,27 +342,30 @@ 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). + Lemma MapFold_orb_1 : + forall (f:ad -> A -> bool) (m:Map A) (pf:ad -> ad), + MapFold1 A bool false orb f pf m = + match MapSweep1 A f pf m with + | SOME _ => true + | _ => false + end. Proof. - 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. + simple induction m. trivial. + intros a y pf. simpl in |- *. unfold MapSweep2 in |- *. case (f (pf a) y); reflexivity. + intros. simpl in |- *. rewrite (H (fun a0:ad => pf (ad_double a0))). + rewrite (H0 (fun a0:ad => pf (ad_double_plus_un a0))). + case (MapSweep1 A f (fun 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). + Lemma MapFold_orb : + forall (f:ad -> A -> bool) (m:Map A), + MapFold A bool false orb f m = + match MapSweep A f m with + | SOME _ => true + | _ => false + end. Proof. - Intros. Exact (MapFold_orb_1 f m [a:ad]a). + intros. exact (MapFold_orb_1 f m (fun a:ad => a)). Qed. End MapFoldExists. @@ -343,39 +374,51 @@ Section DMergeDef. Variable A : Set. - Definition DMerge := (MapFold (Map A) (Map A) (M0 A) (MapMerge A) [_:ad][m:(Map A)] m). + Definition DMerge := + MapFold (Map A) (Map A) (M0 A) (MapMerge A) (fun (_: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). + Lemma in_dom_DMerge_1 : + forall (m:Map (Map A)) (a:ad), + in_dom A a (DMerge m) = + match MapSweep _ (fun (_:ad) (m0:Map A) => in_dom A a m0) m with + | SOME _ => true + | _ => false + end. Proof. - Unfold DMerge. 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. + unfold DMerge in |- *. intros. + rewrite + (MapFold_distr_l (Map A) (Map A) (M0 A) (MapMerge A) bool false orb ad + (in_dom A) (fun c:ad => refl_equal _) (in_dom_merge A)) + . + apply MapFold_orb. Qed. - Lemma in_dom_DMerge_2 : (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}}. + Lemma in_dom_DMerge_2 : + forall (m:Map (Map A)) (a:ad), + in_dom A a (DMerge m) = true -> + {b : ad & + {m0 : Map A | MapGet _ m b = SOME _ m0 /\ in_dom A a m0 = true}}. Proof. - Intros m a. Rewrite in_dom_DMerge_1. - Elim (option_sum ? (MapSweep (Map A) [_: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. + intros m a. rewrite in_dom_DMerge_1. + elim + (option_sum _ + (MapSweep (Map A) (fun (_:ad) (m0:Map A) => in_dom A a m0) m)). + intro H. elim H. intro r. elim r. intros b m0 H0. intro. split with b. split with m0. + split. exact (MapSweep_semantics_2 _ _ _ _ _ H0). + exact (MapSweep_semantics_1 _ _ _ _ _ H0). + intro H. rewrite H. intro. discriminate H0. Qed. - Lemma in_dom_DMerge_3 : (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. + Lemma in_dom_DMerge_3 : + forall (m:Map (Map A)) (a b:ad) (m0:Map A), + MapGet _ m a = SOME _ m0 -> + in_dom A b m0 = true -> in_dom A b (DMerge m) = true. Proof. - Intros m a b m0 H H0. Rewrite in_dom_DMerge_1. - Elim (MapSweep_semantics_4 ? [_: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. + intros m a b m0 H H0. rewrite in_dom_DMerge_1. + elim + (MapSweep_semantics_4 _ (fun (_:ad) (m'0:Map A) => in_dom A b m'0) _ _ _ + H H0). + intros a' H1. elim H1. intros m'0 H2. rewrite H2. reflexivity. Qed. -End DMergeDef. +End DMergeDef.
\ No newline at end of file diff --git a/theories/IntMap/Mapiter.v b/theories/IntMap/Mapiter.v index 216a07c630..3c0aad8028 100644 --- a/theories/IntMap/Mapiter.v +++ b/theories/IntMap/Mapiter.v @@ -7,16 +7,16 @@ (***********************************************************************) (*i $Id$ i*) -Require Bool. -Require Sumbool. -Require ZArith. -Require Addr. -Require Adist. -Require Addec. -Require Map. -Require Mapaxioms. -Require Fset. -Require PolyList. +Require Import Bool. +Require Import Sumbool. +Require Import ZArith. +Require Import Addr. +Require Import Adist. +Require Import Addec. +Require Import Map. +Require Import Mapaxioms. +Require Import Fset. +Require Import List. Section MapIter. @@ -24,172 +24,200 @@ Section MapIter. Section MapSweepDef. - Variable f:ad->A->bool. - - Definition MapSweep2 := [a0:ad; y:A] if (f a0 y) then (SOME ? (a0, y)) else (NONE ?). - - Fixpoint MapSweep1 [pf:ad->ad; m:(Map A)] : (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 + Variable f : ad -> A -> bool. + + Definition MapSweep2 (a0:ad) (y:A) := + if f a0 y then SOME _ (a0, y) else NONE _. + + Fixpoint MapSweep1 (pf:ad -> ad) (m:Map A) {struct m} : + option (ad * A) := + match m with + | M0 => NONE _ + | M1 a y => MapSweep2 (pf a) y + | M2 m m' => + match MapSweep1 (fun a:ad => pf (ad_double a)) m with + | SOME r => SOME _ r + | NONE => MapSweep1 (fun a:ad => pf (ad_double_plus_un a)) m' + end end. - Definition MapSweep := [m:(Map A)] (MapSweep1 ([a:ad] a) m). + Definition MapSweep (m:Map A) := MapSweep1 (fun 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. + Lemma MapSweep_semantics_1_1 : + forall (m:Map A) (pf:ad -> ad) (a:ad) (y:A), + MapSweep1 pf m = SOME _ (a, y) -> f a y = true. Proof. - 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). + simple induction m. intros. discriminate H. + simpl in |- *. intros a y pf a0 y0. elim (sumbool_of_bool (f (pf a) y)). intro H. unfold MapSweep2 in |- *. + rewrite H. intro H0. inversion H0. rewrite <- H3. assumption. + intro H. unfold MapSweep2 in |- *. rewrite H. intro H0. discriminate H0. + simpl in |- *. intros. elim (option_sum (ad * A) (MapSweep1 (fun a0:ad => pf (ad_double a0)) m0)). + intro H2. elim H2. intros r H3. rewrite H3 in H1. inversion H1. rewrite H5 in H3. + exact (H (fun a0:ad => pf (ad_double a0)) a y H3). + intro H2. rewrite H2 in H1. exact (H0 (fun 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. + Lemma MapSweep_semantics_1 : + forall (m:Map A) (a:ad) (y:A), MapSweep m = SOME _ (a, y) -> f a y = true. Proof. - Intros. Exact (MapSweep_semantics_1_1 m [a:ad]a a y H). + intros. exact (MapSweep_semantics_1_1 m (fun 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')}. + Lemma MapSweep_semantics_2_1 : + forall (m:Map A) (pf:ad -> ad) (a:ad) (y:A), + MapSweep1 pf m = SOME _ (a, y) -> {a' : ad | a = pf a'}. Proof. - 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. + simple induction m. intros. discriminate H. + simpl in |- *. unfold MapSweep2 in |- *. intros a y pf a0 y0. case (f (pf a) y). intros. split with a. + inversion H. reflexivity. + intro. discriminate H. + intros m0 H m1 H0 pf a y. simpl in |- *. + elim + (option_sum (ad * A) (MapSweep1 (fun a0:ad => pf (ad_double a0)) m0)). intro H1. elim H1. + intros r H2. rewrite H2. intro H3. inversion H3. rewrite H5 in H2. + elim (H (fun a0:ad => pf (ad_double a0)) a y H2). intros a0 H6. split with (ad_double a0). + assumption. + intro H1. rewrite H1. intro H2. elim (H0 (fun 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). + Lemma MapSweep_semantics_2_2 : + forall (m:Map A) (pf fp:ad -> ad), + (forall a0:ad, fp (pf a0) = a0) -> + forall (a:ad) (y:A), + MapSweep1 pf m = SOME _ (a, y) -> MapGet A m (fp a) = SOME _ y. Proof. - 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. + simple induction m. intros. discriminate H0. + simpl in |- *. intros a y pf fp H a0 y0. unfold MapSweep2 in |- *. elim (sumbool_of_bool (f (pf a) y)). + intro H0. rewrite H0. intro H1. inversion H1. rewrite (H a). rewrite (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 (fun a0:ad => pf (ad_double a0)) m0)). + intro H4. simpl in H2. apply + (H0 (fun a0:ad => pf (ad_double_plus_un a0)) + (fun a0:ad => ad_div_2 (fp a0))). + intro. rewrite H1. apply ad_double_plus_un_div_2. + elim + (option_sum (ad * A) (MapSweep1 (fun 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 (fun 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 (fun a0:ad => pf (ad_double_plus_un a0)) + (fun 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 (fun 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 (fun a0:ad => pf (ad_double a0)) (fun 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 (fun 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). + Lemma MapSweep_semantics_2 : + forall (m:Map A) (a:ad) (y:A), + MapSweep m = SOME _ (a, y) -> MapGet A m a = SOME _ y. Proof. - Intros. - Exact (MapSweep_semantics_2_2 m [a0:ad]a0 [a0:ad]a0 [a0:ad](refl_equal ad a0) a y H). + intros. + exact + (MapSweep_semantics_2_2 m (fun a0:ad => a0) (fun a0:ad => a0) + (fun a0:ad => refl_equal a0) a y H). Qed. - Lemma MapSweep_semantics_3_1 : (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. + Lemma MapSweep_semantics_3_1 : + forall (m:Map A) (pf:ad -> ad), + MapSweep1 pf m = NONE _ -> + forall (a:ad) (y:A), MapGet A m a = SOME _ y -> f (pf a) y = false. Proof. - 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). + simple induction m. intros. discriminate H0. + simpl in |- *. unfold MapSweep2 in |- *. intros a y pf. elim (sumbool_of_bool (f (pf a) y)). intro H. + rewrite H. intro. discriminate H0. + intro H. rewrite H. intros H0 a0 y0. elim (sumbool_of_bool (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 (fun 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 (fun 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 (fun 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. + Lemma MapSweep_semantics_3 : + forall m:Map A, + MapSweep m = NONE _ -> + forall (a:ad) (y:A), MapGet A m a = SOME _ y -> f a y = false. Proof. - Intros. - Exact (MapSweep_semantics_3_1 m [a0:ad]a0 H a y H0). + intros. + exact (MapSweep_semantics_3_1 m (fun 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'))}}. + Lemma MapSweep_semantics_4_1 : + forall (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. + simple 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 in |- *. + 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 (fun a0:ad => pf (ad_double_plus_un a0)) (ad_div_2 a) y H1 H2). intros a'' H4. elim H4. + intros y'' H5. simpl in |- *. elim (option_sum _ (MapSweep1 (fun 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 (fun 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 in |- *. 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'))}}. + Lemma MapSweep_semantics_4 : + forall (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). + intros. exact (MapSweep_semantics_4_1 m (fun a0:ad => a0) a y H H0). Qed. End MapSweepDef. Variable B : Set. - Fixpoint MapCollect1 [f:ad->A->(Map B); pf:ad->ad; m:(Map A)] : (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)) + Fixpoint MapCollect1 (f:ad -> A -> Map B) (pf:ad -> ad) + (m:Map A) {struct m} : Map B := + match m with + | M0 => M0 B + | M1 a y => f (pf a) y + | M2 m1 m2 => + MapMerge B (MapCollect1 f (fun a0:ad => pf (ad_double a0)) m1) + (MapCollect1 f (fun 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). + Definition MapCollect (f:ad -> A -> Map B) (m:Map A) := + MapCollect1 f (fun a:ad => a) m. Section MapFoldDef. @@ -197,331 +225,396 @@ Section MapIter. 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)) + Fixpoint MapFold1 (f:ad -> A -> M) (pf:ad -> ad) + (m:Map A) {struct m} : M := + match m with + | M0 => neutral + | M1 a y => f (pf a) y + | M2 m1 m2 => + op (MapFold1 f (fun a0:ad => pf (ad_double a0)) m1) + (MapFold1 f (fun 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). + Definition MapFold (f:ad -> A -> M) (m:Map A) := + MapFold1 f (fun a:ad => a) m. - Lemma MapFold_empty : (f:ad->A->M) (MapFold f (M0 A))=neutral. + Lemma MapFold_empty : forall f:ad -> A -> M, MapFold f (M0 A) = neutral. Proof. - Trivial. + trivial. Qed. - Lemma MapFold_M1 : (f:ad->A->M) (a:ad) (y:A) (MapFold f (M1 A a y)) = (f a y). + Lemma MapFold_M1 : + forall (f:ad -> A -> M) (a:ad) (y:A), MapFold f (M1 A a y) = f a y. Proof. - Trivial. + 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 + Variable f : State -> ad -> A -> State * M. + + Fixpoint MapFold1_state (state:State) (pf:ad -> ad) + (m:Map A) {struct m} : State * M := + match m with + | M0 => (state, neutral) + | M1 a y => f state (pf a) y + | M2 m1 m2 => + match MapFold1_state state (fun a0:ad => pf (ad_double a0)) m1 with + | (state1, x1) => + match + MapFold1_state state1 + (fun a0:ad => pf (ad_double_plus_un a0)) m2 + with + | (state2, x2) => (state2, op x1 x2) + end end end. - Definition MapFold_state := [state:State] (MapFold1_state state [a:ad]a). + Definition MapFold_state (state:State) := + MapFold1_state state (fun a:ad => a). - Lemma pair_sp : (B,C:Set) (x:B*C) x=(Fst x, Snd x). + Lemma pair_sp : forall (B C:Set) (x:B * C), x = (fst x, snd x). Proof. - Induction x. Trivial. + simple 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). + Lemma MapFold_state_stateless_1 : + forall (m:Map A) (g:ad -> A -> M) (pf:ad -> ad), + (forall (state:State) (a:ad) (y:A), snd (f state a y) = g a y) -> + forall state:State, snd (MapFold1_state state pf m) = MapFold1 g pf m. Proof. - 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 ? ? + simple induction m. trivial. + intros. simpl in |- *. apply H. + intros. simpl in |- *. rewrite + (pair_sp _ _ (MapFold1_state state (fun a0:ad => pf (ad_double a0)) m0)) + . + rewrite (H g (fun 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. + (fst (MapFold1_state state (fun a0:ad => pf (ad_double a0)) m0)) + (fun a0:ad => pf (ad_double_plus_un a0)) m1)) + . + simpl in |- *. + rewrite + (H0 g (fun a0:ad => pf (ad_double_plus_un a0)) H1 + (fst (MapFold1_state state (fun 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). + Lemma MapFold_state_stateless : + forall g:ad -> A -> M, + (forall (state:State) (a:ad) (y:A), snd (f state a y) = g a y) -> + forall (state:State) (m:Map A), + snd (MapFold_state state m) = MapFold g m. Proof. - Intros. Exact (MapFold_state_stateless_1 m g [a0:ad]a0 H state). + intros. exact (MapFold_state_stateless_1 m g (fun 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). + Lemma MapCollect_as_Fold : + forall (f:ad -> A -> Map B) (m:Map A), + MapCollect f m = MapFold (Map B) (M0 B) (MapMerge B) f m. Proof. - Induction m;Trivial. + simple 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 := list (ad * A). + Definition anil := nil (A:=(ad * A)). + Definition acons := cons (A:=(ad * A)). + Definition aapp := app (A:=(ad * A)). - Definition alist_of_Map := (MapFold alist anil aapp [a:ad;y:A] (acons (pair ? ? a y) anil)). + Definition alist_of_Map := + MapFold alist anil aapp (fun (a:ad) (y:A) => acons (a, y) anil). - Fixpoint alist_semantics [l:alist] : ad -> (option A) := - 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) + Fixpoint alist_semantics (l:alist) : ad -> option A := + match l with + | nil => fun _:ad => NONE A + | (a, y) :: l' => + fun 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). + Lemma alist_semantics_app : + forall (l l':alist) (a:ad), + alist_semantics (aapp l l') a = + match alist_semantics l a with + | NONE => alist_semantics l' a + | SOME y => SOME A y + end. Proof. - Unfold aapp. Induction l. Trivial. - Intros. Elim a. Intros a1 y1. Simpl. Case (ad_eq a1 a0). Reflexivity. - Apply H. + unfold aapp in |- *. simple induction l. trivial. + intros. elim a. intros a1 y1. simpl in |- *. 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')}. + Lemma alist_of_Map_semantics_1_1 : + forall (m:Map A) (pf:ad -> ad) (a:ad) (y:A), + alist_semantics + (MapFold1 alist anil aapp (fun (a0:ad) (y:A) => acons (a0, y) anil) pf + m) a = SOME 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. + simple induction m. simpl in |- *. intros. discriminate H. + simpl in |- *. 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 (fun (a0:ad) (y:A) => acons (a0, y) anil) + (fun a0:ad => pf (ad_double a0)) m0) + (MapFold1 alist anil aapp (fun (a0:ad) (y:A) => acons (a0, y) anil) + (fun a0:ad => pf (ad_double_plus_un a0)) m1)) a = + SOME A y) in H1. + rewrite + (alist_semantics_app + (MapFold1 alist anil aapp (fun (a0:ad) (y0:A) => acons (a0, y0) anil) + (fun a0:ad => pf (ad_double a0)) m0) + (MapFold1 alist anil aapp (fun (a0:ad) (y0:A) => acons (a0, y0) anil) + (fun a0:ad => pf (ad_double_plus_un a0)) m1) a) + in H1. + elim + (option_sum A + (alist_semantics + (MapFold1 alist anil aapp + (fun (a0:ad) (y0:A) => acons (a0, y0) anil) + (fun a0:ad => pf (ad_double a0)) m0) a)). + intro H2. elim H2. intros y0 H3. elim (H (fun 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 (fun 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. + Definition ad_inj (pf:ad -> ad) := + forall 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))). + Lemma ad_comp_double_inj : + forall pf:ad -> ad, ad_inj pf -> ad_inj (fun a0:ad => pf (ad_double a0)). Proof. - Unfold ad_inj. Intros. Apply ad_double_inj. Exact (H ? ? H0). + unfold ad_inj in |- *. 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))). + Lemma ad_comp_double_plus_un_inj : + forall pf:ad -> ad, + ad_inj pf -> ad_inj (fun a0:ad => pf (ad_double_plus_un a0)). Proof. - Unfold ad_inj. Intros. Apply ad_double_plus_un_inj. Exact (H ? ? H0). + unfold ad_inj in |- *. 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)). + Lemma alist_of_Map_semantics_1 : + forall (m:Map A) (pf:ad -> ad), + ad_inj pf -> + forall a:ad, + MapGet A m a = + alist_semantics + (MapFold1 alist anil aapp (fun (a0:ad) (y:A) => acons (a0, y) anil) + pf m) (pf a). Proof. - 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. + simple induction m. trivial. + simpl in |- *. 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 (fun (a0:ad) (y:A) => acons (a0, y) anil) + (fun a0:ad => pf (ad_double a0)) m0) + (MapFold1 alist anil aapp (fun (a0:ad) (y:A) => acons (a0, y) anil) + (fun a0:ad => pf (ad_double_plus_un a0)) m1)) ( + pf a)) in |- *. + 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 (fun 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 + (fun (a1:ad) (y:A) => acons (a1, y) anil) + (fun 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 (fun 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 (fun 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 + (fun (a1:ad) (y:A) => acons (a1, y) anil) + (fun 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 (fun 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))). + Lemma alist_of_Map_semantics : + forall 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). + unfold eqm in |- *. intros. exact + (alist_of_Map_semantics_1 m (fun a0:ad => a0) + (fun (a0 a1:ad) (p:a0 = a1) => p) a). Qed. - Fixpoint Map_of_alist [l:alist] : (Map A) := - Cases l of - nil => (M0 A) - | (cons (a, y) l') => (MapPut A (Map_of_alist l') a y) + Fixpoint Map_of_alist (l:alist) : Map A := + match l with + | nil => M0 A + | (a, y) :: l' => MapPut A (Map_of_alist l') a y end. - Lemma Map_of_alist_semantics : (l:alist) - (eqm A (alist_semantics l) (MapGet A (Map_of_alist l))). + Lemma Map_of_alist_semantics : + forall 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. + unfold eqm in |- *. simple induction l. trivial. + intros r l0 H a. elim r. intros a0 y0. simpl in |- *. 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). + Lemma Map_of_alist_of_Map : + forall 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. + unfold eqmap in |- *. intro. apply eqm_trans with (f' := alist_semantics (alist_of_Map m)). + apply eqm_sym. apply Map_of_alist_semantics. + apply eqm_sym. apply alist_of_Map_semantics. Qed. - Lemma alist_of_Map_of_alist : (l:alist) - (eqm A (alist_semantics (alist_of_Map (Map_of_alist l))) (alist_semantics l)). + Lemma alist_of_Map_of_alist : + forall l:alist, + eqm A (alist_semantics (alist_of_Map (Map_of_alist l))) + (alist_semantics l). Proof. - Intro. Apply eqm_trans with f':=(MapGet A (Map_of_alist l)). - Apply eqm_sym. Apply alist_of_Map_semantics. - Apply eqm_sym. Apply Map_of_alist_semantics. + 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')) -. + Lemma fold_right_aapp : + forall (M:Set) (neutral:M) (op:M -> M -> M), + (forall a b c:M, op (op a b) c = op a (op b c)) -> + (forall a:M, op neutral a = a) -> + forall (f:ad -> A -> M) (l l':alist), + fold_right (fun (r:ad * A) (m:M) => let (a, y) := r in op (f a y) m) + neutral (aapp l l') = + op + (fold_right + (fun (r:ad * A) (m:M) => let (a, y) := r in op (f a y) m) neutral + l) + (fold_right + (fun (r:ad * A) (m:M) => let (a, y) := r in op (f a y) m) neutral + l'). Proof. - Induction l. Simpl. Intro. Rewrite H0. Reflexivity. - Intros r l0 H1 l'. Elim r. Intros a y. Simpl. Rewrite H. Rewrite (H1 l'). Reflexivity. + simple induction l. simpl in |- *. intro. rewrite H0. reflexivity. + intros r l0 H1 l'. elim r. intros a y. simpl in |- *. rewrite H. rewrite (H1 l'). reflexivity. Qed. - Lemma MapFold_as_fold_1 : (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)). + Lemma MapFold_as_fold_1 : + forall (M:Set) (neutral:M) (op:M -> M -> M), + (forall a b c:M, op (op a b) c = op a (op b c)) -> + (forall a:M, op neutral a = a) -> + (forall a:M, op a neutral = a) -> + forall (f:ad -> A -> M) (m:Map A) (pf:ad -> ad), + MapFold1 M neutral op f pf m = + fold_right (fun (r:ad * A) (m:M) => let (a, y) := r in op (f a y) m) + neutral + (MapFold1 alist anil aapp (fun (a:ad) (y:A) => acons (a, y) anil) pf + m). Proof. - 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. + simple induction m. trivial. + intros. simpl in |- *. rewrite H1. reflexivity. + intros. simpl in |- *. rewrite (fold_right_aapp M neutral op H H0 f). + rewrite (H2 (fun a0:ad => pf (ad_double a0))). rewrite (H3 (fun 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)). + Lemma MapFold_as_fold : + forall (M:Set) (neutral:M) (op:M -> M -> M), + (forall a b c:M, op (op a b) c = op a (op b c)) -> + (forall a:M, op neutral a = a) -> + (forall a:M, op a neutral = a) -> + forall (f:ad -> A -> M) (m:Map A), + MapFold M neutral op f m = + fold_right (fun (r:ad * A) (m:M) => let (a, y) := r in op (f a y) m) + neutral (alist_of_Map m). Proof. - Intros. Exact (MapFold_as_fold_1 M neutral op H H0 H1 f m [a0:ad]a0). + intros. exact (MapFold_as_fold_1 M neutral op H H0 H1 f m (fun 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')))). + Lemma alist_MapMerge_semantics : + forall m m':Map A, + eqm A (alist_semantics (aapp (alist_of_Map m') (alist_of_Map m))) + (alist_semantics (alist_of_Map (MapMerge A m m'))). Proof. - Unfold eqm. 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. + unfold eqm in |- *. intros. rewrite alist_semantics_app. rewrite <- (alist_of_Map_semantics m a). + rewrite <- (alist_of_Map_semantics m' a). + rewrite <- (alist_of_Map_semantics (MapMerge A m m') a). + rewrite (MapMerge_semantics A m m' a). reflexivity. Qed. - Lemma alist_MapMerge_semantics_disjoint : (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')))). + Lemma alist_MapMerge_semantics_disjoint : + forall m m':Map A, + eqmap A (MapDomRestrTo A A m m') (M0 A) -> + eqm A (alist_semantics (aapp (alist_of_Map m) (alist_of_Map m'))) + (alist_semantics (alist_of_Map (MapMerge A m m'))). Proof. - Unfold eqm. 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. + unfold eqm in |- *. intros. rewrite alist_semantics_app. rewrite <- (alist_of_Map_semantics m a). + rewrite <- (alist_of_Map_semantics m' a). + rewrite <- (alist_of_Map_semantics (MapMerge A m m') a). rewrite (MapMerge_semantics A m m' a). + elim (option_sum _ (MapGet A m a)). intro H0. elim H0. intros y H1. rewrite H1. + elim (option_sum _ (MapGet A m' a)). intro H2. elim H2. intros y' H3. + cut (MapGet A (MapDomRestrTo A A m m') a = NONE 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))). + Lemma alist_semantics_disjoint_comm : + forall l l':alist, + eqmap A (MapDomRestrTo A A (Map_of_alist l) (Map_of_alist l')) (M0 A) -> + eqm A (alist_semantics (aapp l l')) (alist_semantics (aapp l' l)). Proof. - Unfold eqm. 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. + unfold eqm in |- *. intros. rewrite (alist_semantics_app l l' a). rewrite (alist_semantics_app l' l a). + rewrite <- (alist_of_Map_of_alist l a). rewrite <- (alist_of_Map_of_alist l' a). + rewrite <- + (alist_semantics_app (alist_of_Map (Map_of_alist l)) + (alist_of_Map (Map_of_alist l')) a). + rewrite <- + (alist_semantics_app (alist_of_Map (Map_of_alist l')) + (alist_of_Map (Map_of_alist l)) a). + rewrite (alist_MapMerge_semantics (Map_of_alist l) (Map_of_alist l') a). + rewrite + (alist_MapMerge_semantics_disjoint (Map_of_alist l) ( + Map_of_alist l') H a). + reflexivity. Qed. End MapIter. - diff --git a/theories/IntMap/Maplists.v b/theories/IntMap/Maplists.v index 6e5e40814b..bcb87179c4 100644 --- a/theories/IntMap/Maplists.v +++ b/theories/IntMap/Maplists.v @@ -7,304 +7,334 @@ (***********************************************************************) (*i $Id$ i*) -Require Addr. -Require Addec. -Require Map. -Require Fset. -Require Mapaxioms. -Require Mapsubset. -Require Mapcard. -Require Mapcanon. -Require Mapc. -Require Bool. -Require Sumbool. -Require PolyList. -Require Arith. -Require Mapiter. -Require Mapfold. +Require Import Addr. +Require Import Addec. +Require Import Map. +Require Import Fset. +Require Import Mapaxioms. +Require Import Mapsubset. +Require Import Mapcard. +Require Import Mapcanon. +Require Import Mapc. +Require Import Bool. +Require Import Sumbool. +Require Import List. +Require Import Arith. +Require Import Mapiter. +Require Import Mapfold. Section MapLists. - Fixpoint ad_in_list [a:ad;l:(list ad)] : bool := - Cases l of - nil => false - | (cons a' l') => (orb (ad_eq a a') (ad_in_list a l')) + Fixpoint ad_in_list (a:ad) (l:list ad) {struct l} : bool := + match l with + | nil => false + | 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')) + Fixpoint ad_list_stutters (l:list ad) : bool := + match l with + | nil => false + | a :: l' => orb (ad_in_list a l') (ad_list_stutters l') end. - Lemma ad_in_list_forms_circuit : (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) + Lemma ad_in_list_forms_circuit : + forall (x:ad) (l:list ad), + ad_in_list x l = true -> + {l1 : list ad & {l2 : list ad | l = l1 ++ x :: l2}}. + Proof. + simple induction l. intro. discriminate H. + intros. elim (sumbool_of_bool (ad_eq x a)). intro H1. simpl in H0. split with (nil (A:=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 (a :: l'1). elim H3. intros l2 H4. split with l2. rewrite H4. reflexivity. + Qed. + + Lemma ad_list_stutters_has_circuit : + forall l:list ad, + ad_list_stutters l = true -> + {x : ad & + {l0 : list ad & + {l1 : list ad & {l2 : list ad | l = l0 ++ x :: l1 ++ x :: l2}}}}. + Proof. + simple induction l. intro. discriminate H. + intros. simpl in H0. elim (orb_true_elim _ _ H0). intro H1. split with a. + split with (nil (A:=ad)). simpl in |- *. elim (ad_in_list_forms_circuit a l0 H1). intros l1 H2. + split with l1. elim H2. intros l2 H3. split with l2. rewrite H3. reflexivity. + intro H1. elim (H H1). intros x H2. split with x. elim H2. intros l1 H3. + split with (a :: l1). elim H3. intros l2 H4. split with l2. elim H4. intros l3 H5. + split with l3. rewrite H5. reflexivity. + Qed. + + Fixpoint Elems (l:list ad) : FSet := + match l with + | nil => M0 unit + | a :: l' => MapPut _ (Elems l') a tt end. - Lemma Elems_canon : (l:(list ad)) (mapcanon ? (Elems l)). + Lemma Elems_canon : forall l:list ad, mapcanon _ (Elems l). Proof. - Induction l. Exact (M0_canon unit). - Intros. Simpl. Apply MapPut_canon. Assumption. + simple induction l. exact (M0_canon unit). + intros. simpl in |- *. apply MapPut_canon. assumption. Qed. - Lemma Elems_app : (l,l':(list ad)) (Elems (app l l'))=(FSetUnion (Elems l) (Elems l')). + Lemma Elems_app : + forall l l':list ad, Elems (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. + simple induction l. trivial. + intros. simpl in |- *. rewrite (MapPut_as_Merge_c unit (Elems l0)). + rewrite (MapPut_as_Merge_c unit (Elems (l0 ++ l'))). + change + (FSetUnion (Elems (l0 ++ l')) (M1 unit a tt) = + FSetUnion (FSetUnion (Elems l0) (M1 unit a tt)) (Elems l')) + in |- *. + rewrite FSetUnion_comm_c. rewrite (FSetUnion_comm_c (Elems l0) (M1 unit a tt)). + rewrite FSetUnion_assoc_c. rewrite (H l'). reflexivity. + apply M1_canon. + apply Elems_canon. + apply Elems_canon. + apply Elems_canon. + apply M1_canon. + apply Elems_canon. + apply M1_canon. + apply Elems_canon. + apply Elems_canon. Qed. - Lemma Elems_rev : (l:(list ad)) (Elems (rev l))=(Elems l). + Lemma Elems_rev : forall 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. + simple induction l. trivial. + intros. simpl in |- *. rewrite Elems_app. simpl in |- *. rewrite (MapPut_as_Merge_c unit (Elems l0)). + rewrite H. reflexivity. + apply Elems_canon. Qed. - Lemma ad_in_elems_in_list : (l:(list ad)) (a:ad) (in_FSet a (Elems l))=(ad_in_list a l). + Lemma ad_in_elems_in_list : + forall (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. + simple induction l. trivial. + simpl in |- *. unfold in_FSet in |- *. intros. rewrite (in_dom_put _ (Elems l0) a tt a0). + rewrite (H a0). reflexivity. Qed. - Lemma ad_list_not_stutters_card : (l:(list ad)) (ad_list_stutters l)=false -> - (length l)=(MapCard ? (Elems l)). + Lemma ad_list_not_stutters_card : + forall 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). + simple induction l. trivial. + simpl in |- *. intros. rewrite MapCard_Put_2_conv. rewrite H. reflexivity. + elim (orb_false_elim _ _ H0). trivial. + elim (sumbool_of_bool (in_FSet a (Elems l0))). rewrite ad_in_elems_in_list. + intro H1. rewrite H1 in H0. discriminate H0. + exact (in_dom_none unit (Elems l0) a). Qed. - Lemma ad_list_card : (l:(list ad)) (le (MapCard ? (Elems l)) (length l)). + Lemma ad_list_card : forall l:list ad, 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. + simple induction l. trivial. + intros. simpl in |- *. apply le_trans with (m := S (MapCard _ (Elems l0))). apply MapCard_Put_ub. + apply le_n_S. assumption. Qed. - Lemma ad_list_stutters_card : (l:(list ad)) (ad_list_stutters l)=true -> - (lt (MapCard ? (Elems l)) (length l)). + Lemma ad_list_stutters_card : + forall l:list ad, + ad_list_stutters l = true -> 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. + simple induction l. intro. discriminate H. + intros. simpl in |- *. simpl in H0. elim (orb_true_elim _ _ H0). intro H1. + rewrite <- (ad_in_elems_in_list l0 a) in H1. elim (in_dom_some _ _ _ H1). intros y H2. + rewrite (MapCard_Put_1_conv _ _ _ _ tt H2). apply le_lt_trans with (m := length l0). + apply ad_list_card. + apply lt_n_Sn. + intro H1. apply le_lt_trans with (m := S (MapCard _ (Elems l0))). apply MapCard_Put_ub. + apply lt_n_S. apply H. assumption. Qed. - Lemma ad_list_not_stutters_card_conv : (l:(list ad)) (length l)=(MapCard ? (Elems l)) -> - (ad_list_stutters l)=false. + Lemma ad_list_not_stutters_card_conv : + forall l:list ad, + length l = MapCard _ (Elems l) -> ad_list_stutters l = false. Proof. - Intros. Elim (sumbool_of_bool (ad_list_stutters l)). Intro H0. - Cut (lt (MapCard ? (Elems l)) (length l)). Intro. Rewrite H in H1. Elim (lt_n_n ? H1). - Exact (ad_list_stutters_card ? H0). - Trivial. + intros. elim (sumbool_of_bool (ad_list_stutters l)). intro H0. + cut (MapCard _ (Elems l) < length l). intro. rewrite H in H1. elim (lt_irrefl _ H1). + exact (ad_list_stutters_card _ H0). + trivial. Qed. - Lemma ad_list_stutters_card_conv : (l:(list ad)) (lt (MapCard ? (Elems l)) (length l)) -> - (ad_list_stutters l)=true. + Lemma ad_list_stutters_card_conv : + forall l:list ad, + MapCard _ (Elems l) < length l -> ad_list_stutters l = true. Proof. - Intros. Elim (sumbool_of_bool (ad_list_stutters l)). Trivial. - Intro H0. Rewrite (ad_list_not_stutters_card ? H0) in H. Elim (lt_n_n ? H). + intros. elim (sumbool_of_bool (ad_list_stutters l)). trivial. + intro H0. rewrite (ad_list_not_stutters_card _ H0) in H. elim (lt_irrefl _ H). Qed. - Lemma ad_in_list_l : (l,l':(list ad)) (a:ad) (ad_in_list a l)=true -> - (ad_in_list a (app l l'))=true. + Lemma ad_in_list_l : + forall (l l':list ad) (a:ad), + ad_in_list a l = true -> ad_in_list a (l ++ l') = true. Proof. - 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. + simple induction l. intros. discriminate H. + intros. simpl in |- *. simpl in H0. elim (orb_true_elim _ _ H0). intro H1. rewrite H1. reflexivity. + intro H1. rewrite (H l' a0 H1). apply orb_b_true. Qed. - Lemma ad_list_stutters_app_l : (l,l':(list ad)) (ad_list_stutters l)=true -> - (ad_list_stutters (app l l'))=true. + Lemma ad_list_stutters_app_l : + forall l l':list ad, + ad_list_stutters l = true -> ad_list_stutters (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. + simple induction l. intros. discriminate H. + intros. simpl in |- *. simpl in H0. elim (orb_true_elim _ _ H0). intro H1. + rewrite (ad_in_list_l l0 l' a H1). reflexivity. + intro H1. rewrite (H l' H1). apply orb_b_true. Qed. - Lemma ad_in_list_r : (l,l':(list ad)) (a:ad) (ad_in_list a l')=true -> - (ad_in_list a (app l l'))=true. + Lemma ad_in_list_r : + forall (l l':list ad) (a:ad), + ad_in_list a l' = true -> ad_in_list a (l ++ l') = true. Proof. - Induction l. Trivial. - Intros. Simpl. Rewrite (H l' a0 H0). Apply orb_b_true. + simple induction l. trivial. + intros. simpl in |- *. 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. + Lemma ad_list_stutters_app_r : + forall l l':list ad, + ad_list_stutters l' = true -> ad_list_stutters (l ++ l') = true. Proof. - Induction l. Trivial. - Intros. Simpl. Rewrite (H l' H0). Apply orb_b_true. + simple induction l. trivial. + intros. simpl in |- *. 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. + Lemma ad_list_stutters_app_conv_l : + forall l l':list ad, + ad_list_stutters (l ++ l') = false -> ad_list_stutters l = false. Proof. - Intros. Elim (sumbool_of_bool (ad_list_stutters l)). Intro H0. - Rewrite (ad_list_stutters_app_l l l' H0) in H. Discriminate H. - Trivial. + 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. + Lemma ad_list_stutters_app_conv_r : + forall l l':list ad, + ad_list_stutters (l ++ l') = false -> ad_list_stutters l' = false. Proof. - Intros. Elim (sumbool_of_bool (ad_list_stutters l')). Intro H0. - Rewrite (ad_list_stutters_app_r l l' H0) in H. Discriminate H. - Trivial. + 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. + Lemma ad_in_list_app_1 : + forall (l l':list ad) (x:ad), ad_in_list x (l ++ x :: l') = true. Proof. - Induction l. Simpl. Intros. Rewrite (ad_eq_correct x). Reflexivity. - Intros. Simpl. Rewrite (H l' x). Apply orb_b_true. + simple induction l. simpl in |- *. intros. rewrite (ad_eq_correct x). reflexivity. + intros. simpl in |- *. 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')). + Lemma ad_in_list_app : + forall (l l':list ad) (x:ad), + ad_in_list x (l ++ l') = orb (ad_in_list x l) (ad_in_list x l'). Proof. - Induction l. Trivial. - Intros. Simpl. Rewrite <- orb_assoc. Rewrite (H l' x). Reflexivity. + simple induction l. trivial. + intros. simpl in |- *. 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). + Lemma ad_in_list_rev : + forall (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. + simple induction l. trivial. + intros. simpl in |- *. rewrite ad_in_list_app. rewrite (H x). simpl in |- *. rewrite orb_b_false. + apply orb_comm. Qed. - Lemma ad_list_has_circuit_stutters : (l0,l1,l2:(list ad)) (x:ad) - (ad_list_stutters (app l0 (cons x (app l1 (cons x l2)))))=true. + Lemma ad_list_has_circuit_stutters : + forall (l0 l1 l2:list ad) (x:ad), + ad_list_stutters (l0 ++ x :: l1 ++ 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. + simple induction l0. simpl in |- *. intros. rewrite (ad_in_list_app_1 l1 l2 x). reflexivity. + intros. simpl in |- *. rewrite (H l1 l2 x). apply orb_b_true. Qed. - Lemma ad_list_stutters_prev_l : (l,l':(list ad)) (x:ad) (ad_in_list x l)=true -> - (ad_list_stutters (app l (cons x l')))=true. + Lemma ad_list_stutters_prev_l : + forall (l l':list ad) (x:ad), + ad_in_list x l = true -> ad_list_stutters (l ++ x :: l') = true. Proof. - Intros. Elim (ad_in_list_forms_circuit ? ? H). Intros l0 H0. Elim H0. Intros l1 H1. - Rewrite H1. Rewrite app_ass. Simpl. Apply ad_list_has_circuit_stutters. + intros. elim (ad_in_list_forms_circuit _ _ H). intros l0 H0. elim H0. intros l1 H1. + rewrite H1. rewrite app_ass. simpl in |- *. apply ad_list_has_circuit_stutters. Qed. - Lemma ad_list_stutters_prev_conv_l : (l,l':(list ad)) (x:ad) - (ad_list_stutters (app l (cons x l')))=false -> (ad_in_list x l)=false. + Lemma ad_list_stutters_prev_conv_l : + forall (l l':list ad) (x:ad), + ad_list_stutters (l ++ x :: l') = false -> ad_in_list x l = false. Proof. - Intros. Elim (sumbool_of_bool (ad_in_list x l)). Intro H0. - Rewrite (ad_list_stutters_prev_l l l' x H0) in H. Discriminate H. - Trivial. + 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. + Lemma ad_list_stutters_prev_r : + forall (l l':list ad) (x:ad), + ad_in_list x l' = true -> ad_list_stutters (l ++ x :: l') = true. Proof. - Intros. Elim (ad_in_list_forms_circuit ? ? H). Intros l0 H0. Elim H0. Intros l1 H1. - Rewrite H1. Apply ad_list_has_circuit_stutters. + 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. + Lemma ad_list_stutters_prev_conv_r : + forall (l l':list ad) (x:ad), + ad_list_stutters (l ++ x :: l') = false -> ad_in_list x l' = false. Proof. - Intros. Elim (sumbool_of_bool (ad_in_list x l')). Intro H0. - Rewrite (ad_list_stutters_prev_r l l' x H0) in H. Discriminate H. - Trivial. + 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'). + Lemma ad_list_Elems : + forall l l':list ad, + MapCard _ (Elems l) = MapCard _ (Elems l') -> + length l = length l' -> ad_list_stutters l = ad_list_stutters l'. Proof. - Intros. Elim (sumbool_of_bool (ad_list_stutters l)). Intro H1. Rewrite H1. Apply sym_eq. - Apply ad_list_stutters_card_conv. Rewrite <- H. Rewrite <- H0. Apply ad_list_stutters_card. - Assumption. - Intro H1. Rewrite H1. Apply sym_eq. Apply ad_list_not_stutters_card_conv. Rewrite <- H. - Rewrite <- H0. Apply ad_list_not_stutters_card. Assumption. + 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')). + Lemma ad_list_app_length : + forall l l':list ad, length (l ++ l') = length l + length l'. Proof. - Induction l. Trivial. - Intros. Simpl. Rewrite (H l'). Reflexivity. + simple induction l. trivial. + intros. simpl in |- *. 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)). + Lemma ad_list_stutters_permute : + forall l l':list ad, + ad_list_stutters (l ++ l') = ad_list_stutters (l' ++ l). Proof. - Intros. Apply ad_list_Elems. Rewrite Elems_app. Rewrite Elems_app. - Rewrite (FSetUnion_comm_c ? ? (Elems_canon l) (Elems_canon l')). Reflexivity. - Rewrite ad_list_app_length. Rewrite ad_list_app_length. Apply plus_sym. + intros. apply ad_list_Elems. rewrite Elems_app. rewrite Elems_app. + rewrite (FSetUnion_comm_c _ _ (Elems_canon l) (Elems_canon l')). reflexivity. + rewrite ad_list_app_length. rewrite ad_list_app_length. apply plus_comm. Qed. - Lemma ad_list_rev_length : (l:(list ad)) (length (rev l))=(length l). + Lemma ad_list_rev_length : forall 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. + simple induction l. trivial. + intros. simpl in |- *. rewrite ad_list_app_length. simpl in |- *. rewrite H. rewrite <- plus_Snm_nSm. + rewrite <- plus_n_O. reflexivity. Qed. - Lemma ad_list_stutters_rev : (l:(list ad)) (ad_list_stutters (rev l))=(ad_list_stutters l). + Lemma ad_list_stutters_rev : + forall l:list ad, ad_list_stutters (rev l) = ad_list_stutters l. Proof. - Intros. Apply ad_list_Elems. Rewrite Elems_rev. Reflexivity. - Apply ad_list_rev_length. + 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'). + Lemma ad_list_app_rev : + forall (l l':list ad) (x:ad), rev l ++ x :: l' = rev (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. + simple induction l. trivial. + intros. simpl in |- *. rewrite (app_ass (rev l0) (a :: nil) (x :: l')). simpl in |- *. + rewrite (H (x :: l') a). simpl in |- *. + rewrite (app_ass (rev l0) (a :: nil) (x :: nil)). simpl in |- *. + rewrite app_ass. simpl in |- *. rewrite app_ass. reflexivity. Qed. Section ListOfDomDef. @@ -312,88 +342,96 @@ Section MapLists. Variable A : Set. Definition ad_list_of_dom := - (MapFold A (list ad) (nil ad) (!app ad) [a:ad][_:A] (cons a (nil ad))). + MapFold A (list ad) nil (app (A:=ad)) (fun (a:ad) (_:A) => a :: nil). - 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). + Lemma ad_in_list_of_dom_in_dom : + forall (m:Map A) (a:ad), ad_in_list a (ad_list_of_dom m) = in_dom A a m. Proof. - Unfold ad_list_of_dom. 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 ? ? ?). + unfold ad_list_of_dom in |- *. intros. + rewrite + (MapFold_distr_l A (list ad) nil (app (A:=ad)) bool false orb ad + (fun (a:ad) (l:list ad) => ad_in_list a l) ( + fun c:ad => refl_equal _) ad_in_list_app + (fun (a0:ad) (_:A) => a0 :: nil) m a). + simpl in |- *. rewrite (MapFold_orb A (fun (a0:ad) (_:A) => orb (ad_eq a a0) false) m). + elim + (option_sum _ + (MapSweep A (fun (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 in |- *. + 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 (y:=_)). Qed. - Lemma Elems_of_list_of_dom : - (m:(Map A)) (eqmap unit (Elems (ad_list_of_dom m)) (MapDom A m)). + Lemma Elems_of_list_of_dom : + forall m:Map A, eqmap unit (Elems (ad_list_of_dom m)) (MapDom A m). Proof. - Unfold eqmap eqm. 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. + unfold eqmap, eqm in |- *. intros. elim (sumbool_of_bool (in_FSet a (Elems (ad_list_of_dom m)))). + intro H. elim (in_dom_some _ _ _ H). intro t. elim t. intro H0. + rewrite (ad_in_elems_in_list (ad_list_of_dom m) a) in H. + rewrite (ad_in_list_of_dom_in_dom m a) in H. rewrite (MapDom_Dom A m a) in H. + elim (in_dom_some _ _ _ H). intro t'. elim t'. intro H1. rewrite H1. assumption. + intro H. rewrite (in_dom_none _ _ _ H). + rewrite (ad_in_elems_in_list (ad_list_of_dom m) a) in H. + rewrite (ad_in_list_of_dom_in_dom m a) in H. rewrite (MapDom_Dom A m a) in H. + rewrite (in_dom_none _ _ _ H). reflexivity. Qed. - Lemma Elems_of_list_of_dom_c : (m:(Map A)) (mapcanon A m) -> - (Elems (ad_list_of_dom m))=(MapDom A m). + Lemma Elems_of_list_of_dom_c : + forall m:Map A, mapcanon A m -> Elems (ad_list_of_dom m) = MapDom A m. Proof. - Intros. Apply (mapcanon_unique unit). Apply Elems_canon. - Apply MapDom_canon. Assumption. - Apply Elems_of_list_of_dom. + 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). + Lemma ad_list_of_dom_card_1 : + forall (m:Map A) (pf:ad -> ad), + length + (MapFold1 A (list ad) nil (app (A:=ad)) (fun (a:ad) (_:A) => a :: nil) + pf m) = MapCard A m. Proof. - 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. + simple induction m; try trivial. simpl in |- *. intros. rewrite ad_list_app_length. + rewrite (H (fun a0:ad => pf (ad_double a0))). rewrite (H0 (fun 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). + Lemma ad_list_of_dom_card : + forall 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). + exact (fun m:Map A => ad_list_of_dom_card_1 m (fun a:ad => a)). Qed. - Lemma ad_list_of_dom_not_stutters : - (m:(Map A)) (ad_list_stutters (ad_list_of_dom m))=false. + Lemma ad_list_of_dom_not_stutters : + forall m:Map A, ad_list_stutters (ad_list_of_dom m) = false. Proof. - Intro. Apply ad_list_not_stutters_card_conv. Rewrite ad_list_of_dom_card. Apply sym_eq. - Rewrite (MapCard_Dom A m). Apply MapCard_ext. Exact (Elems_of_list_of_dom m). + 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)). + Lemma ad_list_of_dom_Dom_1 : + forall (A:Set) (m:Map A) (pf:ad -> ad), + MapFold1 A (list ad) nil (app (A:=ad)) (fun (a:ad) (_:A) => a :: nil) pf + m = + MapFold1 unit (list ad) nil (app (A:=ad)) + (fun (a:ad) (_:unit) => a :: nil) pf (MapDom A m). Proof. - 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. + simple induction m; try trivial. simpl in |- *. intros. rewrite (H (fun a0:ad => pf (ad_double a0))). + rewrite (H0 (fun 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)). + Lemma ad_list_of_dom_Dom : + forall (A:Set) (m:Map A), + ad_list_of_dom A m = ad_list_of_dom unit (MapDom A m). Proof. - Intros. Exact (ad_list_of_dom_Dom_1 A m [a0:ad]a0). + intros. exact (ad_list_of_dom_Dom_1 A m (fun a0:ad => a0)). Qed. -End MapLists. +End MapLists.
\ No newline at end of file diff --git a/theories/IntMap/Mapsubset.v b/theories/IntMap/Mapsubset.v index defe49712c..cff8f670bb 100644 --- a/theories/IntMap/Mapsubset.v +++ b/theories/IntMap/Mapsubset.v @@ -7,548 +7,600 @@ (***********************************************************************) (*i $Id$ i*) -Require Bool. -Require Sumbool. -Require Arith. -Require ZArith. -Require Addr. -Require Adist. -Require Addec. -Require Map. -Require Fset. -Require Mapaxioms. -Require Mapiter. +Require Import Bool. +Require Import Sumbool. +Require Import Arith. +Require Import ZArith. +Require Import Addr. +Require Import Adist. +Require Import Addec. +Require Import Map. +Require Import Fset. +Require Import Mapaxioms. +Require Import Mapiter. Section MapSubsetDef. - Variable A, B : Set. + Variables A B : Set. - Definition MapSubset := [m:(Map A)] [m':(Map B)] - (a:ad) (in_dom A a m)=true -> (in_dom B a m')=true. + Definition MapSubset (m:Map A) (m':Map B) := + forall a:ad, in_dom A a m = true -> in_dom B a m' = true. - Definition MapSubset_1 := [m:(Map A)] [m':(Map B)] - Cases (MapSweep A [a:ad][_:A] (negb (in_dom B a m')) m) of - NONE => true - | _ => false - end. + Definition MapSubset_1 (m:Map A) (m':Map B) := + match MapSweep A (fun (a:ad) (_:A) => negb (in_dom B a m')) m with + | NONE => true + | _ => false + end. - Definition MapSubset_2 := [m:(Map A)] [m':(Map B)] - (eqmap A (MapDomRestrBy A B m m') (M0 A)). + 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. + Lemma MapSubset_imp_1 : + forall (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. + unfold MapSubset, MapSubset_1 in |- *. intros. + elim + (option_sum _ (MapSweep A (fun (a:ad) (_:A) => negb (in_dom B a m')) m)). + intro H0. elim H0. intro r. elim r. intros a y H1. cut (negb (in_dom B a m') = true). + intro. cut (in_dom A a m = false). intro. unfold in_dom in H3. + rewrite (MapSweep_semantics_2 _ _ m a y H1) in H3. discriminate H3. + elim (sumbool_of_bool (in_dom A a m)). intro H3. rewrite (H a H3) in H2. discriminate H2. + trivial. + exact (MapSweep_semantics_1 _ _ m a y H1). + intro H0. rewrite H0. reflexivity. Qed. - Lemma MapSubset_1_imp : (m:(Map A)) (m':(Map B)) - (MapSubset_1 m m')=true -> (MapSubset m m'). + Lemma MapSubset_1_imp : + forall (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. + unfold MapSubset, MapSubset_1 in |- *. unfold in_dom at 2 in |- *. intros. elim (option_sum _ (MapGet A m a)). + intro H1. elim H1. intros y H2. + elim + (option_sum _ (MapSweep A (fun (a:ad) (_:A) => negb (in_dom B a m')) m)). intro H3. + elim H3. intro r. elim r. intros a' y' H4. rewrite H4 in H. discriminate H. + intro H3. cut (negb (in_dom B a m') = false). intro. rewrite (negb_intro (in_dom B a m')). + rewrite H4. reflexivity. + exact (MapSweep_semantics_3 _ _ m H3 a y H2). + intro H1. rewrite H1 in H0. discriminate H0. Qed. - Lemma map_dom_empty_1 : - (m:(Map A)) (eqmap A m (M0 A)) -> (a:ad) (in_dom ? a m)=false. + Lemma map_dom_empty_1 : + forall m:Map A, eqmap A m (M0 A) -> forall a:ad, in_dom _ a m = false. Proof. - Unfold eqmap eqm in_dom. Intros. Rewrite (H a). Reflexivity. + unfold eqmap, eqm, in_dom in |- *. 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)). + Lemma map_dom_empty_2 : + forall m:Map A, (forall a:ad, in_dom _ a m = false) -> eqmap A m (M0 A). Proof. - Unfold eqmap eqm in_dom. 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). + unfold eqmap, eqm, in_dom in |- *. intros. + cut + (match MapGet A m a with + | NONE => false + | SOME _ => true + end = false). + case (MapGet A m a). trivial. + intros. discriminate H0. + exact (H a). Qed. - Lemma MapSubset_imp_2 : - (m:(Map A)) (m':(Map B)) (MapSubset m m') -> (MapSubset_2 m m'). + Lemma MapSubset_imp_2 : + forall (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. + unfold MapSubset, MapSubset_2 in |- *. intros. apply map_dom_empty_2. intro. rewrite in_dom_restrby. + elim (sumbool_of_bool (in_dom A a m)). intro H0. rewrite H0. rewrite (H a H0). reflexivity. + intro H0. rewrite H0. reflexivity. Qed. - Lemma MapSubset_2_imp : - (m:(Map A)) (m':(Map B)) (MapSubset_2 m m') -> (MapSubset m m'). + Lemma MapSubset_2_imp : + forall (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). + unfold MapSubset, MapSubset_2 in |- *. intros. cut (in_dom _ a (MapDomRestrBy A B m m') = false). + rewrite in_dom_restrby. intro. elim (andb_false_elim _ _ H1). rewrite H0. + intro H2. discriminate H2. + intro H2. rewrite (negb_intro (in_dom B a m')). rewrite H2. reflexivity. + exact (map_dom_empty_1 _ H a). Qed. End MapSubsetDef. Section MapSubsetOrder. - Variable A, B, C : Set. + Variables A B C : Set. - Lemma MapSubset_refl : (m:(Map A)) (MapSubset A A m m). + Lemma MapSubset_refl : forall m:Map A, MapSubset A A m m. Proof. - Unfold MapSubset. Trivial. + unfold MapSubset in |- *. 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')). + Lemma MapSubset_antisym : + forall (m:Map A) (m':Map B), + MapSubset A B m m' -> + MapSubset B A m' m -> eqmap unit (MapDom A m) (MapDom B m'). Proof. - Unfold MapSubset eqmap eqm. 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. + unfold MapSubset, eqmap, eqm in |- *. intros. elim (option_sum _ (MapGet _ (MapDom A m) a)). + intro H1. elim H1. intro t. elim t. intro H2. elim (option_sum _ (MapGet _ (MapDom B m') a)). + intro H3. elim H3. intro t'. elim t'. intro H4. rewrite H4. exact H2. + intro H3. cut (in_dom B a m' = true). intro. rewrite (MapDom_Dom B m' a) in H4. + unfold in_FSet, in_dom in H4. rewrite H3 in H4. discriminate H4. + apply H. rewrite (MapDom_Dom A m a). unfold in_FSet, in_dom in |- *. rewrite H2. reflexivity. + intro H1. elim (option_sum _ (MapGet _ (MapDom B m') a)). intro H2. elim H2. intros t H3. + cut (in_dom A a m = true). intro. rewrite (MapDom_Dom A m a) in H4. unfold in_FSet, in_dom in H4. + rewrite H1 in H4. discriminate H4. + apply H0. rewrite (MapDom_Dom B m' a). unfold in_FSet, in_dom in |- *. rewrite H3. reflexivity. + intro H2. rewrite H2. exact H1. Qed. - Lemma MapSubset_trans : (m:(Map A)) (m':(Map B)) (m'':(Map C)) - (MapSubset A B m m') -> (MapSubset B C m' m'') -> (MapSubset A C m m''). + Lemma MapSubset_trans : + forall (m:Map A) (m':Map B) (m'':Map C), + MapSubset A B m m' -> MapSubset B C m' m'' -> MapSubset A C m m''. Proof. - Unfold MapSubset. Intros. Apply H0. Apply H. Assumption. + unfold MapSubset in |- *. intros. apply H0. apply H. assumption. Qed. End MapSubsetOrder. Section FSubsetOrder. - Lemma FSubset_refl : (s:FSet) (MapSubset ? ? s s). + Lemma FSubset_refl : forall s:FSet, MapSubset _ _ s s. Proof. - Exact (MapSubset_refl unit). + exact (MapSubset_refl unit). Qed. - Lemma FSubset_antisym : (s,s':FSet) - (MapSubset ? ? s s') -> (MapSubset ? ? s' s) -> (eqmap unit s s'). + Lemma FSubset_antisym : + forall s s':FSet, + MapSubset _ _ s s' -> MapSubset _ _ s' s -> eqmap unit s s'. Proof. - Intros. Rewrite <- (FSet_Dom s). Rewrite <- (FSet_Dom s'). - Exact (MapSubset_antisym ? ? s s' H H0). + 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''). + Lemma FSubset_trans : + forall s s' s'':FSet, + MapSubset _ _ s s' -> MapSubset _ _ s' s'' -> MapSubset _ _ s s''. Proof. - Exact (MapSubset_trans unit unit unit). + exact (MapSubset_trans unit unit unit). Qed. End FSubsetOrder. Section MapSubsetExtra. - Variable A, B : Set. + Variables 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')). + Lemma MapSubset_Dom_1 : + forall (m:Map A) (m':Map B), + MapSubset A B m m' -> MapSubset unit unit (MapDom A m) (MapDom B m'). Proof. - Unfold MapSubset. 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). + unfold MapSubset in |- *. intros. elim (MapDom_semantics_2 _ m a H0). intros y H1. + cut (in_dom A a m = true -> in_dom B a m' = true). intro. unfold in_dom in H2. + rewrite H1 in H2. elim (option_sum _ (MapGet B m' a)). intro H3. elim H3. + intros y' H4. exact (MapDom_semantics_1 _ m' a y' H4). + intro H3. rewrite H3 in H2. cut (false = true). intro. discriminate H4. + apply H2. reflexivity. + exact (H a). Qed. - Lemma MapSubset_Dom_2 : (m:(Map A)) (m':(Map B)) - (MapSubset unit unit (MapDom A m) (MapDom B m')) -> (MapSubset A B m m'). + Lemma MapSubset_Dom_2 : + forall (m:Map A) (m':Map B), + MapSubset unit unit (MapDom A m) (MapDom B m') -> MapSubset A B m m'. Proof. - Unfold MapSubset. 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. + unfold MapSubset in |- *. intros. unfold in_dom in H0. elim (option_sum _ (MapGet A m a)). + intro H1. elim H1. intros y H2. + elim (MapDom_semantics_2 _ _ _ (H a (MapDom_semantics_1 _ _ _ _ H2))). intros y' H3. + unfold in_dom in |- *. rewrite H3. reflexivity. + intro H1. rewrite H1 in H0. discriminate H0. Qed. - Lemma MapSubset_1_Dom : (m:(Map A)) (m':(Map B)) - (MapSubset_1 A B m m')=(MapSubset_1 unit unit (MapDom A m) (MapDom B m')). + Lemma MapSubset_1_Dom : + forall (m:Map A) (m':Map B), + MapSubset_1 A B m m' = MapSubset_1 unit unit (MapDom A m) (MapDom B m'). Proof. - Intros. Elim (sumbool_of_bool (MapSubset_1 A B m m')). Intro H. Rewrite H. - Apply sym_eq. Apply MapSubset_imp_1. Apply MapSubset_Dom_1. Exact (MapSubset_1_imp ? ? ? ? H). - Intro H. Rewrite H. Elim (sumbool_of_bool (MapSubset_1 unit unit (MapDom A m) (MapDom B m'))). - Intro H0. - Rewrite (MapSubset_imp_1 ? ? ? ? (MapSubset_Dom_2 ? ? (MapSubset_1_imp ? ? ? ? H0))) in H. - Discriminate H. - Intro. Apply sym_eq. Assumption. + 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)). + Lemma MapSubset_Put : + forall (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. + unfold MapSubset in |- *. 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')). + Lemma MapSubset_Put_mono : + forall (m:Map A) (m':Map B) (a:ad) (y:A) (y':B), + MapSubset A B m m' -> MapSubset A B (MapPut A m a y) (MapPut B m' a y'). Proof. - Unfold MapSubset. 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. + unfold MapSubset in |- *. intros. rewrite in_dom_put. rewrite (in_dom_put A m a y a0) in H0. + elim (orb_true_elim _ _ H0). intro H1. rewrite H1. reflexivity. + intro H1. rewrite (H _ H1). apply orb_b_true. Qed. - Lemma MapSubset_Put_behind : - (m:(Map A)) (a:ad) (y:A) (MapSubset A A m (MapPut_behind A m a y)). + Lemma MapSubset_Put_behind : + forall (m:Map A) (a:ad) (y:A), MapSubset A A m (MapPut_behind A m a y). Proof. - Unfold MapSubset. Intros. Rewrite in_dom_put_behind. Rewrite H. Apply orb_b_true. + unfold MapSubset in |- *. 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')). + Lemma MapSubset_Put_behind_mono : + forall (m:Map A) (m':Map B) (a:ad) (y:A) (y':B), + MapSubset A B m m' -> + MapSubset A B (MapPut_behind A m a y) (MapPut_behind B m' a y'). Proof. - Unfold MapSubset. 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. + unfold MapSubset in |- *. intros. rewrite in_dom_put_behind. + rewrite (in_dom_put_behind A m a y a0) in H0. + elim (orb_true_elim _ _ H0). intro H1. rewrite H1. reflexivity. + intro H1. rewrite (H _ H1). apply orb_b_true. Qed. - Lemma MapSubset_Remove : (m:(Map A)) (a:ad) (MapSubset A A (MapRemove A m a) m). + Lemma MapSubset_Remove : + forall (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. + unfold MapSubset in |- *. intros. unfold MapSubset in |- *. intros. rewrite (in_dom_remove _ m a a0) in H. + elim (andb_prop _ _ H). trivial. Qed. - Lemma MapSubset_Remove_mono : (m:(Map A)) (m':(Map B)) (a:ad) - (MapSubset A B m m') -> (MapSubset A B (MapRemove A m a) (MapRemove B m' a)). + Lemma MapSubset_Remove_mono : + forall (m:Map A) (m':Map B) (a:ad), + MapSubset A B m m' -> MapSubset A B (MapRemove A m a) (MapRemove B m' a). Proof. - Unfold MapSubset. 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. + unfold MapSubset in |- *. intros. rewrite in_dom_remove. rewrite (in_dom_remove A m a a0) in H0. + elim (andb_prop _ _ H0). intros. rewrite H1. rewrite (H _ H2). reflexivity. Qed. - Lemma MapSubset_Merge_l : (m,m':(Map A)) (MapSubset A A m (MapMerge A m m')). + Lemma MapSubset_Merge_l : + forall m m':Map A, MapSubset A A m (MapMerge A m m'). Proof. - Unfold MapSubset. Intros. Rewrite in_dom_merge. Rewrite H. Reflexivity. + unfold MapSubset in |- *. 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')). + Lemma MapSubset_Merge_r : + forall 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. + unfold MapSubset in |- *. 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''')). + Lemma MapSubset_Merge_mono : + forall (m m':Map A) (m'' m''':Map B), + MapSubset A B m m'' -> + MapSubset A B m' m''' -> + MapSubset A B (MapMerge A m m') (MapMerge B m'' m'''). Proof. - Unfold MapSubset. 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. + unfold MapSubset in |- *. intros. rewrite in_dom_merge. rewrite (in_dom_merge A m m' a) in H1. + elim (orb_true_elim _ _ H1). intro H2. rewrite (H _ H2). reflexivity. + intro H2. rewrite (H0 _ H2). apply orb_b_true. Qed. - Lemma MapSubset_DomRestrTo_l : (m:(Map A)) (m':(Map B)) - (MapSubset A A (MapDomRestrTo A B m m') m). + Lemma MapSubset_DomRestrTo_l : + forall (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. + unfold MapSubset in |- *. 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'). + Lemma MapSubset_DomRestrTo_r : + forall (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. + unfold MapSubset in |- *. 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). + Lemma MapSubset_ext : + forall (m0 m1:Map A) (m2 m3:Map B), + eqmap A m0 m1 -> + eqmap B m2 m3 -> MapSubset A B m0 m2 -> MapSubset A B m1 m3. Proof. - Intros. Apply MapSubset_2_imp. Unfold MapSubset_2. - 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). + intros. apply MapSubset_2_imp. unfold MapSubset_2 in |- *. + apply eqmap_trans with (m' := MapDomRestrBy A B m0 m2). apply MapDomRestrBy_ext. apply eqmap_sym. + assumption. + apply eqmap_sym. assumption. + exact (MapSubset_imp_2 _ _ _ _ H1). Qed. - Variable C, D : Set. + Variables 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''')). + Lemma MapSubset_DomRestrTo_mono : + forall (m:Map A) (m':Map B) (m'':Map C) (m''':Map D), + MapSubset _ _ m m'' -> + MapSubset _ _ m' m''' -> + MapSubset _ _ (MapDomRestrTo _ _ m m') (MapDomRestrTo _ _ m'' m'''). Proof. - Unfold MapSubset. 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. + unfold MapSubset in |- *. intros. rewrite in_dom_restrto. rewrite (in_dom_restrto A B m m' a) in H1. + elim (andb_prop _ _ H1). intros. rewrite (H _ H2). rewrite (H0 _ H3). reflexivity. Qed. - Lemma MapSubset_DomRestrBy_l : (m:(Map A)) (m':(Map B)) - (MapSubset A A (MapDomRestrBy A B m m') m). + Lemma MapSubset_DomRestrBy_l : + forall (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. + unfold MapSubset in |- *. 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''')). + Lemma MapSubset_DomRestrBy_mono : + forall (m:Map A) (m':Map B) (m'':Map C) (m''':Map D), + MapSubset _ _ m m'' -> + MapSubset _ _ m''' m' -> + MapSubset _ _ (MapDomRestrBy _ _ m m') (MapDomRestrBy _ _ m'' m'''). Proof. - Unfold MapSubset. 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. + unfold MapSubset in |- *. intros. rewrite in_dom_restrby. rewrite (in_dom_restrby A B m m' a) in H1. + elim (andb_prop _ _ H1). intros. rewrite (H _ H2). elim (sumbool_of_bool (in_dom D a m''')). + intro H4. rewrite (H0 _ H4) in H3. discriminate H3. + intro H4. rewrite H4. reflexivity. Qed. End MapSubsetExtra. Section MapDisjointDef. - Variable A, B : Set. + Variables 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 (m:Map A) (m':Map B) := + forall a:ad, in_dom A a m = true -> in_dom B a m' = true -> False. - Definition MapDisjoint_1 := [m:(Map A)] [m':(Map B)] - Cases (MapSweep A [a:ad][_:A] (in_dom B a m') m) of - NONE => true - | _ => false - end. + Definition MapDisjoint_1 (m:Map A) (m':Map B) := + match MapSweep A (fun (a:ad) (_:A) => in_dom B a m') m with + | NONE => true + | _ => false + end. - Definition MapDisjoint_2 := [m:(Map A)] [m':(Map B)] - (eqmap A (MapDomRestrTo A B m m') (M0 A)). + 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. + Lemma MapDisjoint_imp_1 : + forall (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. + unfold MapDisjoint, MapDisjoint_1 in |- *. intros. + elim (option_sum _ (MapSweep A (fun (a:ad) (_:A) => in_dom B a m') m)). intro H0. elim H0. + intro r. elim r. intros a y H1. cut (in_dom A a m = true -> in_dom B a m' = true -> False). + intro. unfold in_dom at 1 in H2. rewrite (MapSweep_semantics_2 _ _ _ _ _ H1) in H2. + rewrite (MapSweep_semantics_1 _ _ _ _ _ H1) in H2. elim (H2 (refl_equal _) (refl_equal _)). + exact (H a). + intro H0. rewrite H0. reflexivity. Qed. - Lemma MapDisjoint_1_imp : (m:(Map A)) (m':(Map B)) - (MapDisjoint_1 m m')=true -> (MapDisjoint m m'). + Lemma MapDisjoint_1_imp : + forall (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. + unfold MapDisjoint, MapDisjoint_1 in |- *. intros. + elim (option_sum _ (MapSweep A (fun (a:ad) (_:A) => in_dom B a m') m)). intro H2. elim H2. + intro r. elim r. intros a' y' H3. rewrite H3 in H. discriminate H. + intro H2. unfold in_dom in H0. elim (option_sum _ (MapGet A m a)). intro H3. elim H3. + intros y H4. rewrite (MapSweep_semantics_3 _ _ _ H2 a y H4) in H1. discriminate H1. + intro H3. rewrite H3 in H0. discriminate H0. Qed. - Lemma MapDisjoint_imp_2 : (m:(Map A)) (m':(Map B)) (MapDisjoint m m') -> - (MapDisjoint_2 m m'). + Lemma MapDisjoint_imp_2 : + forall (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). + unfold MapDisjoint, MapDisjoint_2 in |- *. unfold eqmap, eqm in |- *. intros. + rewrite (MapDomRestrTo_semantics A B m m' a). + cut (in_dom A a m = true -> in_dom B a m' = true -> False). intro. + elim (option_sum _ (MapGet A m a)). intro H1. elim H1. intros y H2. unfold in_dom at 1 in H0. + elim (option_sum _ (MapGet B m' a)). intro H3. elim H3. intros y' H4. unfold in_dom at 1 in H0. + rewrite H4 in H0. rewrite H2 in H0. elim (H0 (refl_equal _) (refl_equal _)). + intro H3. rewrite H3. reflexivity. + intro H1. rewrite H1. case (MapGet B m' a); reflexivity. + exact (H a). Qed. - Lemma MapDisjoint_2_imp : (m:(Map A)) (m':(Map B)) (MapDisjoint_2 m m') -> - (MapDisjoint m m'). + Lemma MapDisjoint_2_imp : + forall (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). + unfold MapDisjoint, MapDisjoint_2 in |- *. unfold eqmap, eqm in |- *. intros. elim (in_dom_some _ _ _ H0). + intros y H2. elim (in_dom_some _ _ _ H1). intros y' H3. + cut (MapGet A (MapDomRestrTo A B m m') a = NONE 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). + Lemma Map_M0_disjoint : forall m:Map B, MapDisjoint (M0 A) m. Proof. - Unfold MapDisjoint in_dom. Intros. Discriminate H. + unfold MapDisjoint, in_dom in |- *. intros. discriminate H. Qed. - Lemma Map_disjoint_M0 : (m:(Map A)) (MapDisjoint m (M0 B)). + Lemma Map_disjoint_M0 : forall m:Map A, MapDisjoint m (M0 B). Proof. - Unfold MapDisjoint in_dom. Intros. Discriminate H0. + unfold MapDisjoint, in_dom in |- *. intros. discriminate H0. Qed. End MapDisjointDef. Section MapDisjointExtra. - Variable A, B : Set. + Variables 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). + Lemma MapDisjoint_ext : + forall (m0 m1:Map A) (m2 m3:Map B), + eqmap A m0 m1 -> + eqmap B m2 m3 -> MapDisjoint A B m0 m2 -> MapDisjoint A B m1 m3. Proof. - Intros. Apply MapDisjoint_2_imp. Unfold MapDisjoint_2. - Apply eqmap_trans with m':=(MapDomRestrTo A B m0 m2). Apply eqmap_sym. Apply MapDomRestrTo_ext. - Assumption. - Assumption. - Exact (MapDisjoint_imp_2 ? ? ? ? H1). + intros. apply MapDisjoint_2_imp. unfold MapDisjoint_2 in |- *. + apply eqmap_trans with (m' := MapDomRestrTo A B m0 m2). apply eqmap_sym. apply MapDomRestrTo_ext. + assumption. + assumption. + exact (MapDisjoint_imp_2 _ _ _ _ H1). Qed. - Lemma MapMerge_disjoint : (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)))). + Lemma MapMerge_disjoint : + forall m m':Map A, + MapDisjoint A A m m' -> + forall a:ad, + in_dom A a (MapMerge A m m') = + orb (andb (in_dom A a m) (negb (in_dom A a m'))) + (andb (in_dom A a m') (negb (in_dom A a m))). Proof. - Unfold MapDisjoint. 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. + unfold MapDisjoint in |- *. intros. rewrite in_dom_merge. elim (sumbool_of_bool (in_dom A a m)). + intro H0. rewrite H0. elim (sumbool_of_bool (in_dom A a m')). intro H1. elim (H a H0 H1). + intro H1. rewrite H1. reflexivity. + intro H0. rewrite H0. simpl in |- *. rewrite andb_b_true. reflexivity. Qed. - Lemma MapDisjoint_M2_l : (m0,m1:(Map A)) (m2,m3:(Map B)) - (MapDisjoint A B (M2 A m0 m1) (M2 B m2 m3)) -> (MapDisjoint A B m0 m2). + Lemma MapDisjoint_M2_l : + forall (m0 m1:Map A) (m2 m3:Map B), + MapDisjoint A B (M2 A m0 m1) (M2 B m2 m3) -> MapDisjoint A B m0 m2. Proof. - Unfold MapDisjoint in_dom. 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. + unfold MapDisjoint, in_dom in |- *. intros. elim (option_sum _ (MapGet A m0 a)). intro H2. + elim H2. intros y H3. elim (option_sum _ (MapGet B m2 a)). intro H4. elim H4. + intros y' H5. apply (H (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). + Lemma MapDisjoint_M2_r : + forall (m0 m1:Map A) (m2 m3:Map B), + MapDisjoint A B (M2 A m0 m1) (M2 B m2 m3) -> MapDisjoint A B m1 m3. Proof. - Unfold MapDisjoint in_dom. 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. + unfold MapDisjoint, in_dom in |- *. intros. elim (option_sum _ (MapGet A m1 a)). intro H2. + elim H2. intros y H3. elim (option_sum _ (MapGet B m3 a)). intro H4. elim H4. + intros y' H5. apply (H (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)). + Lemma MapDisjoint_M2 : + forall (m0 m1:Map A) (m2 m3:Map B), + MapDisjoint A B m0 m2 -> + MapDisjoint A B m1 m3 -> MapDisjoint A B (M2 A m0 m1) (M2 B m2 m3). Proof. - Unfold MapDisjoint in_dom. 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). + unfold MapDisjoint, in_dom in |- *. 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. + Lemma MapDisjoint_M1_l : + forall (m:Map A) (a:ad) (y:B), + MapDisjoint B A (M1 B a y) m -> in_dom A a m = false. Proof. - Unfold MapDisjoint. Intros. Elim (sumbool_of_bool (in_dom A a m)). Intro H0. - Elim (H a (in_dom_M1_1 B a y) H0). - Trivial. + unfold MapDisjoint in |- *. intros. elim (sumbool_of_bool (in_dom A a m)). intro H0. + elim (H a (in_dom_M1_1 B a y) H0). + trivial. Qed. - Lemma MapDisjoint_M1_r : (m:(Map A)) (a:ad) (y:B) - (MapDisjoint A B m (M1 B a y)) -> (in_dom A a m)=false. + Lemma MapDisjoint_M1_r : + forall (m:Map A) (a:ad) (y:B), + MapDisjoint A B m (M1 B a y) -> in_dom A a m = false. Proof. - Unfold MapDisjoint. Intros. Elim (sumbool_of_bool (in_dom A a m)). Intro H0. - Elim (H a H0 (in_dom_M1_1 B a y)). - Trivial. + unfold MapDisjoint in |- *. intros. elim (sumbool_of_bool (in_dom A a m)). intro H0. + elim (H a H0 (in_dom_M1_1 B a y)). + trivial. Qed. - Lemma MapDisjoint_M1_conv_l : (m:(Map A)) (a:ad) (y:B) - (in_dom A a m)=false -> (MapDisjoint B A (M1 B a y) m). + Lemma MapDisjoint_M1_conv_l : + forall (m:Map A) (a:ad) (y:B), + in_dom A a m = false -> MapDisjoint B A (M1 B a y) m. Proof. - Unfold MapDisjoint. Intros. Rewrite (in_dom_M1_2 B a a0 y H0) in H. Rewrite H1 in H. - Discriminate H. + unfold MapDisjoint in |- *. intros. rewrite (in_dom_M1_2 B a a0 y H0) in H. rewrite H1 in H. + discriminate H. Qed. - Lemma MapDisjoint_M1_conv_r : (m:(Map A)) (a:ad) (y:B) - (in_dom A a m)=false -> (MapDisjoint A B m (M1 B a y)). + Lemma MapDisjoint_M1_conv_r : + forall (m:Map A) (a:ad) (y:B), + in_dom A a m = false -> MapDisjoint A B m (M1 B a y). Proof. - Unfold MapDisjoint. Intros. Rewrite (in_dom_M1_2 B a a0 y H1) in H. Rewrite H0 in H. - Discriminate H. + unfold MapDisjoint in |- *. intros. rewrite (in_dom_M1_2 B a a0 y H1) in H. rewrite H0 in H. + discriminate H. Qed. - Lemma MapDisjoint_sym : (m:(Map A)) (m':(Map B)) - (MapDisjoint A B m m') -> (MapDisjoint B A m' m). + Lemma MapDisjoint_sym : + forall (m:Map A) (m':Map B), MapDisjoint A B m m' -> MapDisjoint B A m' m. Proof. - Unfold MapDisjoint. Intros. Exact (H ? H1 H0). + unfold MapDisjoint in |- *. intros. exact (H _ H1 H0). Qed. - Lemma MapDisjoint_empty : (m:(Map A)) (MapDisjoint A A m m) -> (eqmap A m (M0 A)). + Lemma MapDisjoint_empty : + forall 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). + unfold eqmap, eqm in |- *. intros. rewrite <- (MapDomRestrTo_idempotent A m a). + exact (MapDisjoint_imp_2 A A m m H a). Qed. - Lemma MapDelta_disjoint : (m,m':(Map A)) (MapDisjoint A A m m') -> - (eqmap A (MapDelta A m m') (MapMerge A m m')). + Lemma MapDelta_disjoint : + forall m m':Map A, + MapDisjoint A A m m' -> eqmap A (MapDelta A m m') (MapMerge A m m'). Proof. - Intros. - Apply eqmap_trans with m':=(MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m m')). - Apply MapDelta_as_DomRestrBy. - Apply eqmap_trans with m':=(MapDomRestrBy A A (MapMerge A m m') (M0 A)). - Apply MapDomRestrBy_ext. Apply eqmap_refl. - Exact (MapDisjoint_imp_2 A A m m' H). - Apply MapDomRestrBy_m_empty. + 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'')). + Lemma MapDomRestr_disjoint : + forall (m:Map A) (m':Map B) (m'':Map C), + MapDisjoint A B (MapDomRestrTo A C m m'') (MapDomRestrBy B C m' m''). Proof. - Unfold MapDisjoint. 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. + unfold MapDisjoint in |- *. intros m m' m'' a. rewrite in_dom_restrto. rewrite in_dom_restrby. + intros. elim (andb_prop _ _ H). elim (andb_prop _ _ H0). intros. rewrite H4 in H2. + discriminate H2. Qed. - Lemma MapDelta_RestrTo_disjoint : (m,m':(Map A)) - (MapDisjoint A A (MapDelta A m m') (MapDomRestrTo A A m m')). + Lemma MapDelta_RestrTo_disjoint : + forall 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. + unfold MapDisjoint in |- *. intros m m' a. rewrite in_dom_delta. rewrite in_dom_restrto. + intros. elim (andb_prop _ _ H0). intros. rewrite H1 in H. rewrite H2 in H. discriminate H. Qed. - Lemma MapDelta_RestrTo_disjoint_2 : (m,m':(Map A)) - (MapDisjoint A A (MapDelta A m m') (MapDomRestrTo A A m' m)). + Lemma MapDelta_RestrTo_disjoint_2 : + forall m m':Map A, + MapDisjoint A A (MapDelta A m m') (MapDomRestrTo A A m' m). Proof. - Unfold MapDisjoint. 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. + unfold MapDisjoint in |- *. intros m m' a. rewrite in_dom_delta. rewrite in_dom_restrto. + intros. elim (andb_prop _ _ H0). intros. rewrite H1 in H. rewrite H2 in H. discriminate H. Qed. Variable D : Set. - Lemma MapSubset_Disjoint : (m:(Map A)) (m':(Map B)) (m'':(Map C)) (m''':(Map D)) - (MapSubset ? ? m m') -> (MapSubset ? ? m'' m''') -> (MapDisjoint ? ? m' m''') -> - (MapDisjoint ? ? m m''). + Lemma MapSubset_Disjoint : + forall (m:Map A) (m':Map B) (m'':Map C) (m''':Map D), + MapSubset _ _ m m' -> + MapSubset _ _ m'' m''' -> + MapDisjoint _ _ m' m''' -> MapDisjoint _ _ m m''. Proof. - Unfold MapSubset MapDisjoint. Intros. Exact (H1 ? (H ? H2) (H0 ? H3)). + unfold MapSubset, MapDisjoint in |- *. 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''). + Lemma MapSubset_Disjoint_l : + forall (m:Map A) (m':Map B) (m'':Map C), + MapSubset _ _ m m' -> MapDisjoint _ _ m' m'' -> MapDisjoint _ _ m m''. Proof. - Unfold MapSubset MapDisjoint. Intros. Exact (H0 ? (H ? H1) H2). + unfold MapSubset, MapDisjoint in |- *. 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''). + Lemma MapSubset_Disjoint_r : + forall (m:Map A) (m'':Map C) (m''':Map D), + MapSubset _ _ m'' m''' -> + MapDisjoint _ _ m m''' -> MapDisjoint _ _ m m''. Proof. - Unfold MapSubset MapDisjoint. Intros. Exact (H0 ? H1 (H ? H2)). + unfold MapSubset, MapDisjoint in |- *. intros. exact (H0 _ H1 (H _ H2)). Qed. -End MapDisjointExtra. +End MapDisjointExtra.
\ No newline at end of file |