diff options
| author |  glondu <glondu@85f007b7-540e-0410-9357-904b9bb8a0f7> | 2009-09-17 15:58:14 +0000 |
|---|---|---|
| committer | glondu <glondu@85f007b7-540e-0410-9357-904b9bb8a0f7> | 2009-09-17 15:58:14 +0000 |
| commit | 61ccbc81a2f3b4662ed4a2bad9d07d2003dda3a2 (patch) | |
| tree | 961cc88c714aa91a0276ea9fbf8bc53b2b9d5c28 /theories/FSets | |
| parent | 6d3fbdf36c6a47b49c2a4b16f498972c93c07574 (diff) | |
Delete trailing whitespaces in all *.{v,ml*} files
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@12337 85f007b7-540e-0410-9357-904b9bb8a0f7
Diffstat (limited to 'theories/FSets')
| -rw-r--r-- | theories/FSets/FMapAVL.v | 670 | ||||
| -rw-r--r-- | theories/FSets/FMapFacts.v | 208 | ||||
| -rw-r--r-- | theories/FSets/FMapFullAVL.v | 264 | ||||
| -rw-r--r-- | theories/FSets/FMapInterface.v | 154 | ||||
| -rw-r--r-- | theories/FSets/FMapList.v | 454 | ||||
| -rw-r--r-- | theories/FSets/FMapPositive.v | 142 | ||||
| -rw-r--r-- | theories/FSets/FMapWeakList.v | 326 | ||||
| -rw-r--r-- | theories/FSets/FSetAVL.v | 626 | ||||
| -rw-r--r-- | theories/FSets/FSetBridge.v | 302 | ||||
| -rw-r--r-- | theories/FSets/FSetDecide.v | 42 | ||||
| -rw-r--r-- | theories/FSets/FSetEqProperties.v | 270 | ||||
| -rw-r--r-- | theories/FSets/FSetFacts.v | 62 | ||||
| -rw-r--r-- | theories/FSets/FSetFullAVL.v | 322 | ||||
| -rw-r--r-- | theories/FSets/FSetInterface.v | 100 | ||||
| -rw-r--r-- | theories/FSets/FSetList.v | 300 | ||||
| -rw-r--r-- | theories/FSets/FSetProperties.v | 160 | ||||
| -rw-r--r-- | theories/FSets/FSetToFiniteSet.v | 24 | ||||
| -rw-r--r-- | theories/FSets/FSetWeakList.v | 230 | ||||
| -rw-r--r-- | theories/FSets/OrderedType.v | 192 | ||||
| -rw-r--r-- | theories/FSets/OrderedTypeAlt.v | 34 | ||||
| -rw-r--r-- | theories/FSets/OrderedTypeEx.v | 34 |
21 files changed, 2458 insertions, 2458 deletions
diff --git a/theories/FSets/FMapAVL.v b/theories/FSets/FMapAVL.v index bf10728c8..189cf88ad 100644 --- a/theories/FSets/FMapAVL.v +++ b/theories/FSets/FMapAVL.v @@ -14,8 +14,8 @@ (** * FMapAVL *) (** This module implements maps using AVL trees. - It follows the implementation from Ocaml's standard library. - + It follows the implementation from Ocaml's standard library. + See the comments at the beginning of FSetAVL for more details. *) @@ -30,8 +30,8 @@ Notation "s #1" := (fst s) (at level 9, format "s '#1'") : pair_scope. Notation "s #2" := (snd s) (at level 9, format "s '#2'") : pair_scope. (** * The Raw functor - - Functor of pure functions + separate proofs of invariant + + Functor of pure functions + separate proofs of invariant preservation *) Module Raw (Import I:Int)(X: OrderedType). @@ -85,20 +85,20 @@ Definition is_empty m := match m with Leaf => true | _ => false end. to achieve logarithmic complexity. *) Fixpoint mem x m : bool := - match m with - | Leaf => false - | Node l y _ r _ => match X.compare x y with - | LT _ => mem x l + match m with + | Leaf => false + | Node l y _ r _ => match X.compare x y with + | LT _ => mem x l | EQ _ => true | GT _ => mem x r end end. -Fixpoint find x m : option elt := - match m with - | Leaf => None - | Node l y d r _ => match X.compare x y with - | LT _ => find x l +Fixpoint find x m : option elt := + match m with + | Leaf => None + | Node l y d r _ => match X.compare x y with + | LT _ => find x l | EQ _ => Some d | GT _ => find x r end @@ -109,7 +109,7 @@ Fixpoint find x m : option elt := (** [create l x r] creates a node, assuming [l] and [r] to be balanced and [|height l - height r| <= 2]. *) -Definition create l x e r := +Definition create l x e r := Node l x e r (max (height l) (height r) + 1). (** [bal l x e r] acts as [create], but performs one step of @@ -117,45 +117,45 @@ Definition create l x e r := Definition assert_false := create. -Fixpoint bal l x d r := - let hl := height l in +Fixpoint bal l x d r := + let hl := height l in let hr := height r in - if gt_le_dec hl (hr+2) then - match l with + if gt_le_dec hl (hr+2) then + match l with | Leaf => assert_false l x d r - | Node ll lx ld lr _ => - if ge_lt_dec (height ll) (height lr) then + | Node ll lx ld lr _ => + if ge_lt_dec (height ll) (height lr) then create ll lx ld (create lr x d r) - else - match lr with + else + match lr with | Leaf => assert_false l x d r - | Node lrl lrx lrd lrr _ => + | Node lrl lrx lrd lrr _ => create (create ll lx ld lrl) lrx lrd (create lrr x d r) end end - else - if gt_le_dec hr (hl+2) then + else + if gt_le_dec hr (hl+2) then match r with | Leaf => assert_false l x d r | Node rl rx rd rr _ => - if ge_lt_dec (height rr) (height rl) then + if ge_lt_dec (height rr) (height rl) then create (create l x d rl) rx rd rr - else + else match rl with | Leaf => assert_false l x d r - | Node rll rlx rld rlr _ => - create (create l x d rll) rlx rld (create rlr rx rd rr) + | Node rll rlx rld rlr _ => + create (create l x d rll) rlx rld (create rlr rx rd rr) end end - else + else create l x d r. (** * Insertion *) -Fixpoint add x d m := - match m with +Fixpoint add x d m := + match m with | Leaf => Node Leaf x d Leaf 1 - | Node l y d' r h => + | Node l y d' r h => match X.compare x y with | LT _ => bal (add x d l) y d' r | EQ _ => Node l y d r h @@ -165,16 +165,16 @@ Fixpoint add x d m := (** * Extraction of minimum binding - Morally, [remove_min] is to be applied to a non-empty tree - [t = Node l x e r h]. Since we can't deal here with [assert false] - for [t=Leaf], we pre-unpack [t] (and forget about [h]). + Morally, [remove_min] is to be applied to a non-empty tree + [t = Node l x e r h]. Since we can't deal here with [assert false] + for [t=Leaf], we pre-unpack [t] (and forget about [h]). *) - -Fixpoint remove_min l x d r : t*(key*elt) := + +Fixpoint remove_min l x d r : t*(key*elt) := match l with | Leaf => (r,(x,d)) - | Node ll lx ld lr lh => - let (l',m) := remove_min ll lx ld lr in + | Node ll lx ld lr lh => + let (l',m) := remove_min ll lx ld lr in (bal l' x d r, m) end. @@ -185,18 +185,18 @@ Fixpoint remove_min l x d r : t*(key*elt) := [|height t1 - height t2| <= 2]. *) -Fixpoint merge s1 s2 := match s1,s2 with - | Leaf, _ => s2 +Fixpoint merge s1 s2 := match s1,s2 with + | Leaf, _ => s2 | _, Leaf => s1 - | _, Node l2 x2 d2 r2 h2 => - match remove_min l2 x2 d2 r2 with + | _, Node l2 x2 d2 r2 h2 => + match remove_min l2 x2 d2 r2 with (s2',(x,d)) => bal s1 x d s2' end end. (** * Deletion *) -Fixpoint remove x m := match m with +Fixpoint remove x m := match m with | Leaf => Leaf | Node l y d r h => match X.compare x y with @@ -206,26 +206,26 @@ Fixpoint remove x m := match m with end end. -(** * join - - Same as [bal] but does not assume anything regarding heights of [l] +(** * join + + Same as [bal] but does not assume anything regarding heights of [l] and [r]. *) Fixpoint join l : key -> elt -> t -> t := match l with | Leaf => add - | Node ll lx ld lr lh => fun x d => - fix join_aux (r:t) : t := match r with + | Node ll lx ld lr lh => fun x d => + fix join_aux (r:t) : t := match r with | Leaf => add x d l - | Node rl rx rd rr rh => + | Node rl rx rd rr rh => if gt_le_dec lh (rh+2) then bal ll lx ld (join lr x d r) - else if gt_le_dec rh (lh+2) then bal (join_aux rl) rx rd rr + else if gt_le_dec rh (lh+2) then bal (join_aux rl) rx rd rr else create l x d r end end. -(** * Splitting +(** * Splitting [split x m] returns a triple [(l, o, r)] where - [l] is the set of elements of [m] that are [< x] @@ -236,17 +236,17 @@ Fixpoint join l : key -> elt -> t -> t := Record triple := mktriple { t_left:t; t_opt:option elt; t_right:t }. Notation "<< l , b , r >>" := (mktriple l b r) (at level 9). -Fixpoint split x m : triple := match m with +Fixpoint split x m : triple := match m with | Leaf => << Leaf, None, Leaf >> - | Node l y d r h => - match X.compare x y with + | Node l y d r h => + match X.compare x y with | LT _ => let (ll,o,rl) := split x l in << ll, o, join rl y d r >> | EQ _ => << l, Some d, r >> | GT _ => let (rl,o,rr) := split x r in << join l y d rl, o, rr >> end end. -(** * Concatenation +(** * Concatenation Same as [merge] but does not assume anything about heights. *) @@ -256,7 +256,7 @@ Definition concat m1 m2 := | Leaf, _ => m2 | _ , Leaf => m1 | _, Node l2 x2 d2 r2 _ => - let (m2',xd) := remove_min l2 x2 d2 r2 in + let (m2',xd) := remove_min l2 x2 d2 r2 in join m1 xd#1 xd#2 m2' end. @@ -277,7 +277,7 @@ Definition elements := elements_aux nil. (** * Fold *) -Fixpoint fold (A : Type) (f : key -> elt -> A -> A) (m : t) : A -> A := +Fixpoint fold (A : Type) (f : key -> elt -> A -> A) (m : t) : A -> A := fun a => match m with | Leaf => a | Node l x d r _ => fold f r (f x d (fold f l a)) @@ -293,11 +293,11 @@ Inductive enumeration := | End : enumeration | More : key -> elt -> t -> enumeration -> enumeration. -(** [cons m e] adds the elements of tree [m] on the head of +(** [cons m e] adds the elements of tree [m] on the head of enumeration [e]. *) -Fixpoint cons m e : enumeration := - match m with +Fixpoint cons m e : enumeration := + match m with | Leaf => e | Node l x d r h => cons l (More x d r e) end. @@ -316,7 +316,7 @@ Definition equal_more x1 d1 (cont:enumeration->bool) e2 := (** Comparison of left tree, middle element, then right tree *) -Fixpoint equal_cont m1 (cont:enumeration->bool) e2 := +Fixpoint equal_cont m1 (cont:enumeration->bool) e2 := match m1 with | Leaf => cont e2 | Node l1 x1 d1 r1 _ => @@ -341,8 +341,8 @@ Notation "t #r" := (t_right t) (at level 9, format "t '#r'"). (** * Map *) -Fixpoint map (elt elt' : Type)(f : elt -> elt')(m : t elt) : t elt' := - match m with +Fixpoint map (elt elt' : Type)(f : elt -> elt')(m : t elt) : t elt' := + match m with | Leaf => Leaf _ | Node l x d r h => Node (map f l) x (f d) (map f r) h end. @@ -350,7 +350,7 @@ Fixpoint map (elt elt' : Type)(f : elt -> elt')(m : t elt) : t elt' := (* * Mapi *) Fixpoint mapi (elt elt' : Type)(f : key -> elt -> elt')(m : t elt) : t elt' := - match m with + match m with | Leaf => Leaf _ | Node l x d r h => Node (mapi f l) x (f x d) (mapi f r) h end. @@ -358,28 +358,28 @@ Fixpoint mapi (elt elt' : Type)(f : key -> elt -> elt')(m : t elt) : t elt' := (** * Map with removal *) Fixpoint map_option (elt elt' : Type)(f : key -> elt -> option elt')(m : t elt) - : t elt' := - match m with + : t elt' := + match m with | Leaf => Leaf _ - | Node l x d r h => - match f x d with + | Node l x d r h => + match f x d with | Some d' => join (map_option f l) x d' (map_option f r) | None => concat (map_option f l) (map_option f r) end end. (** * Optimized map2 - - Suggestion by B. Gregoire: a [map2] function with specialized - arguments allowing to bypass some tree traversal. Instead of one - [f0] of type [key -> option elt -> option elt' -> option elt''], - we ask here for: + + Suggestion by B. Gregoire: a [map2] function with specialized + arguments allowing to bypass some tree traversal. Instead of one + [f0] of type [key -> option elt -> option elt' -> option elt''], + we ask here for: - [f] which is a specialisation of [f0] when first option isn't [None] - [mapl] treats a [tree elt] with [f0] when second option is [None] - [mapr] treats a [tree elt'] with [f0] when first option is [None] - The idea is that [mapl] and [mapr] can be instantaneous (e.g. - the identity or some constant function). + The idea is that [mapl] and [mapr] can be instantaneous (e.g. + the identity or some constant function). *) Section Map2_opt. @@ -388,13 +388,13 @@ Variable f : key -> elt -> option elt' -> option elt''. Variable mapl : t elt -> t elt''. Variable mapr : t elt' -> t elt''. -Fixpoint map2_opt m1 m2 := - match m1, m2 with - | Leaf, _ => mapr m2 +Fixpoint map2_opt m1 m2 := + match m1, m2 with + | Leaf, _ => mapr m2 | _, Leaf => mapl m1 - | Node l1 x1 d1 r1 h1, _ => + | Node l1 x1 d1 r1 h1, _ => let (l2',o2,r2') := split x1 m2 in - match f x1 d1 o2 with + match f x1 d1 o2 with | Some e => join (map2_opt l1 l2') x1 e (map2_opt r1 r2') | None => concat (map2_opt l1 l2') (map2_opt r1 r2') end @@ -403,8 +403,8 @@ Fixpoint map2_opt m1 m2 := End Map2_opt. (** * Map2 - - The [map2] function of the Map interface can be implemented + + The [map2] function of the Map interface can be implemented via [map2_opt] and [map_option]. *) @@ -412,8 +412,8 @@ Section Map2. Variable elt elt' elt'' : Type. Variable f : option elt -> option elt' -> option elt''. -Definition map2 : t elt -> t elt' -> t elt'' := - map2_opt +Definition map2 : t elt -> t elt' -> t elt'' := + map2_opt (fun _ d o => f (Some d) o) (map_option (fun _ d => f (Some d) None)) (map_option (fun _ d' => f None (Some d'))). @@ -432,24 +432,24 @@ Variable elt : Type. Inductive MapsTo (x : key)(e : elt) : t elt -> Prop := | MapsRoot : forall l r h y, X.eq x y -> MapsTo x e (Node l y e r h) - | MapsLeft : forall l r h y e', + | MapsLeft : forall l r h y e', MapsTo x e l -> MapsTo x e (Node l y e' r h) - | MapsRight : forall l r h y e', + | MapsRight : forall l r h y e', MapsTo x e r -> MapsTo x e (Node l y e' r h). Inductive In (x : key) : t elt -> Prop := | InRoot : forall l r h y e, X.eq x y -> In x (Node l y e r h) - | InLeft : forall l r h y e', + | InLeft : forall l r h y e', In x l -> In x (Node l y e' r h) - | InRight : forall l r h y e', + | InRight : forall l r h y e', In x r -> In x (Node l y e' r h). Definition In0 k m := exists e:elt, MapsTo k e m. (** ** Binary search trees *) -(** [lt_tree x s]: all elements in [s] are smaller than [x] +(** [lt_tree x s]: all elements in [s] are smaller than [x] (resp. greater for [gt_tree]) *) Definition lt_tree x m := forall y, In y m -> X.lt y x. @@ -459,7 +459,7 @@ Definition gt_tree x m := forall y, In y m -> X.lt x y. Inductive bst : t elt -> Prop := | BSLeaf : bst (Leaf _) - | BSNode : forall x e l r h, bst l -> bst r -> + | BSNode : forall x e l r h, bst l -> bst r -> lt_tree x l -> gt_tree x r -> bst (Node l x e r h). End Invariants. @@ -474,10 +474,10 @@ Module Proofs. Functional Scheme mem_ind := Induction for mem Sort Prop. Functional Scheme find_ind := Induction for find Sort Prop. -Functional Scheme bal_ind := Induction for bal Sort Prop. +Functional Scheme bal_ind := Induction for bal Sort Prop. Functional Scheme add_ind := Induction for add Sort Prop. Functional Scheme remove_min_ind := Induction for remove_min Sort Prop. -Functional Scheme merge_ind := Induction for merge Sort Prop. +Functional Scheme merge_ind := Induction for merge Sort Prop. Functional Scheme remove_ind := Induction for remove Sort Prop. Functional Scheme concat_ind := Induction for concat Sort Prop. Functional Scheme split_ind := Induction for split Sort Prop. @@ -489,24 +489,24 @@ Functional Scheme map2_opt_ind := Induction for map2_opt Sort Prop. Hint Constructors tree MapsTo In bst. Hint Unfold lt_tree gt_tree. -Tactic Notation "factornode" ident(l) ident(x) ident(d) ident(r) ident(h) - "as" ident(s) := +Tactic Notation "factornode" ident(l) ident(x) ident(d) ident(r) ident(h) + "as" ident(s) := set (s:=Node l x d r h) in *; clearbody s; clear l x d r h. (** A tactic for cleaning hypothesis after use of functional induction. *) Ltac clearf := - match goal with + match goal with | H : (@Logic.eq (Compare _ _ _ _) _ _) |- _ => clear H; clearf | H : (@Logic.eq (sumbool _ _) _ _) |- _ => clear H; clearf | _ => idtac end. -(** A tactic to repeat [inversion_clear] on all hyps of the +(** A tactic to repeat [inversion_clear] on all hyps of the form [(f (Node ...))] *) Ltac inv f := - match goal with + match goal with | H:f (Leaf _) |- _ => inversion_clear H; inv f | H:f _ (Leaf _) |- _ => inversion_clear H; inv f | H:f _ _ (Leaf _) |- _ => inversion_clear H; inv f @@ -518,8 +518,8 @@ Ltac inv f := | _ => idtac end. -Ltac inv_all f := - match goal with +Ltac inv_all f := + match goal with | H: f _ |- _ => inversion_clear H; inv f | H: f _ _ |- _ => inversion_clear H; inv f | H: f _ _ _ |- _ => inversion_clear H; inv f @@ -529,7 +529,7 @@ Ltac inv_all f := (** Helper tactic concerning order of elements. *) -Ltac order := match goal with +Ltac order := match goal with | U: lt_tree _ ?s, V: In _ ?s |- _ => generalize (U _ V); clear U; order | U: gt_tree _ ?s, V: In _ ?s |- _ => generalize (U _ V); clear U; order | _ => MX.order @@ -537,21 +537,21 @@ end. Ltac intuition_in := repeat progress (intuition; inv In; inv MapsTo). -(* Function/Functional Scheme can't deal with internal fix. +(* Function/Functional Scheme can't deal with internal fix. Let's do its job by hand: *) -Ltac join_tac := - intros l; induction l as [| ll _ lx ld lr Hlr lh]; +Ltac join_tac := + intros l; induction l as [| ll _ lx ld lr Hlr lh]; [ | intros x d r; induction r as [| rl Hrl rx rd rr _ rh]; unfold join; - [ | destruct (gt_le_dec lh (rh+2)); + [ | destruct (gt_le_dec lh (rh+2)); [ match goal with |- context [ bal ?u ?v ?w ?z ] => - replace (bal u v w z) + replace (bal u v w z) with (bal ll lx ld (join lr x d (Node rl rx rd rr rh))); [ | auto] - end - | destruct (gt_le_dec rh (lh+2)); - [ match goal with |- context [ bal ?u ?v ?w ?z ] => - replace (bal u v w z) - with (bal (join (Node ll lx ld lr lh) x d rl) rx rd rr); [ | auto] + end + | destruct (gt_le_dec rh (lh+2)); + [ match goal with |- context [ bal ?u ?v ?w ?z ] => + replace (bal u v w z) + with (bal (join (Node ll lx ld lr lh) x d rl) rx rd rr); [ | auto] end | ] ] ] ]; intros. @@ -575,7 +575,7 @@ Proof. Qed. Lemma In_alt : forall k m, In0 k m <-> In k m. -Proof. +Proof. split. intros (e,H); eauto. unfold In0; apply In_MapsTo; auto. @@ -588,14 +588,14 @@ Proof. Qed. Hint Immediate MapsTo_1. -Lemma In_1 : +Lemma In_1 : forall m x y, X.eq x y -> In x m -> In y m. Proof. intros m x y; induction m; simpl; intuition_in; eauto. Qed. -Lemma In_node_iff : - forall l x e r h y, +Lemma In_node_iff : + forall l x e r h y, In y (Node l x e r h) <-> In y l \/ X.eq y x \/ In y r. Proof. intuition_in. @@ -613,7 +613,7 @@ Proof. unfold gt_tree in |- *; intros; intuition_in. Qed. -Lemma lt_tree_node : forall x y l r e h, +Lemma lt_tree_node : forall x y l r e h, lt_tree x l -> lt_tree x r -> X.lt y x -> lt_tree x (Node l y e r h). Proof. unfold lt_tree in *; intuition_in; order. @@ -627,25 +627,25 @@ Qed. Hint Resolve lt_leaf gt_leaf lt_tree_node gt_tree_node. -Lemma lt_left : forall x y l r e h, +Lemma lt_left : forall x y l r e h, lt_tree x (Node l y e r h) -> lt_tree x l. Proof. intuition_in. Qed. -Lemma lt_right : forall x y l r e h, +Lemma lt_right : forall x y l r e h, lt_tree x (Node l y e r h) -> lt_tree x r. Proof. intuition_in. Qed. -Lemma gt_left : forall x y l r e h, +Lemma gt_left : forall x y l r e h, gt_tree x (Node l y e r h) -> gt_tree x l. Proof. intuition_in. Qed. -Lemma gt_right : forall x y l r e h, +Lemma gt_right : forall x y l r e h, gt_tree x (Node l y e r h) -> gt_tree x r. Proof. intuition_in. @@ -695,39 +695,39 @@ Qed. (** * Emptyness test *) -Lemma is_empty_1 : forall m, Empty m -> is_empty m = true. +Lemma is_empty_1 : forall m, Empty m -> is_empty m = true. Proof. destruct m as [|r x e l h]; simpl; auto. intro H; elim (H x e); auto. Qed. Lemma is_empty_2 : forall m, is_empty m = true -> Empty m. -Proof. +Proof. destruct m; simpl; intros; try discriminate; red; intuition_in. Qed. (** * Appartness *) Lemma mem_1 : forall m x, bst m -> In x m -> mem x m = true. -Proof. +Proof. intros m x; functional induction (mem x m); auto; intros; clearf; inv bst; intuition_in; order. Qed. -Lemma mem_2 : forall m x, mem x m = true -> In x m. -Proof. +Lemma mem_2 : forall m x, mem x m = true -> In x m. +Proof. intros m x; functional induction (mem x m); auto; intros; discriminate. Qed. Lemma find_1 : forall m x e, bst m -> MapsTo x e m -> find x m = Some e. -Proof. +Proof. intros m x; functional induction (find x m); auto; intros; clearf; - inv bst; intuition_in; simpl; auto; + inv bst; intuition_in; simpl; auto; try solve [order | absurd (X.lt x y); eauto | absurd (X.lt y x); eauto]. Qed. Lemma find_2 : forall m x e, find x m = Some e -> MapsTo x e m. -Proof. +Proof. intros m x; functional induction (find x m); subst; intros; clearf; try discriminate. constructor 2; auto. @@ -735,7 +735,7 @@ Proof. constructor 3; auto. Qed. -Lemma find_iff : forall m x e, bst m -> +Lemma find_iff : forall m x e, bst m -> (find x m = Some e <-> MapsTo x e m). Proof. split; auto using find_1, find_2. @@ -745,7 +745,7 @@ Lemma find_in : forall m x, find x m <> None -> In x m. Proof. intros. case_eq (find x m); [intros|congruence]. - apply MapsTo_In with e; apply find_2; auto. + apply MapsTo_In with e; apply find_2; auto. Qed. Lemma in_find : forall m x, bst m -> In x m -> find x m <> None. @@ -755,7 +755,7 @@ Proof. rewrite (find_1 H Hd); discriminate. Qed. -Lemma find_in_iff : forall m x, bst m -> +Lemma find_in_iff : forall m x, bst m -> (find x m <> None <-> In x m). Proof. split; auto using find_in, in_find. @@ -771,11 +771,11 @@ Proof. elim H0; apply find_in; congruence. Qed. -Lemma find_find : forall m m' x, - find x m = find x m' <-> +Lemma find_find : forall m m' x, + find x m = find x m' <-> (forall d, find x m = Some d <-> find x m' = Some d). Proof. - intros; destruct (find x m); destruct (find x m'); split; intros; + intros; destruct (find x m); destruct (find x m'); split; intros; try split; try congruence. rewrite H; auto. symmetry; rewrite <- H; auto. @@ -783,7 +783,7 @@ Proof. Qed. Lemma find_mapsto_equiv : forall m m' x, bst m -> bst m' -> - (find x m = find x m' <-> + (find x m = find x m' <-> (forall d, MapsTo x d m <-> MapsTo x d m')). Proof. intros m m' x Hm Hm'. @@ -793,8 +793,8 @@ Proof. rewrite 2 find_iff; auto. Qed. -Lemma find_in_equiv : forall m m' x, bst m -> bst m' -> - find x m = find x m' -> +Lemma find_in_equiv : forall m m' x, bst m -> bst m' -> + find x m = find x m' -> (In x m <-> In x m'). Proof. split; intros; apply find_in; [ rewrite <- H1 | rewrite H1 ]; @@ -803,27 +803,27 @@ Qed. (** * Helper functions *) -Lemma create_bst : - forall l x e r, bst l -> bst r -> lt_tree x l -> gt_tree x r -> +Lemma create_bst : + forall l x e r, bst l -> bst r -> lt_tree x l -> gt_tree x r -> bst (create l x e r). Proof. unfold create; auto. Qed. Hint Resolve create_bst. -Lemma create_in : - forall l x e r y, +Lemma create_in : + forall l x e r y, In y (create l x e r) <-> X.eq y x \/ In y l \/ In y r. Proof. unfold create; split; [ inversion_clear 1 | ]; intuition. Qed. -Lemma bal_bst : forall l x e r, bst l -> bst r -> +Lemma bal_bst : forall l x e r, bst l -> bst r -> lt_tree x l -> gt_tree x r -> bst (bal l x e r). Proof. intros l x e r; functional induction (bal l x e r); intros; clearf; inv bst; repeat apply create_bst; auto; unfold create; try constructor; - (apply lt_tree_node || apply gt_tree_node); auto; + (apply lt_tree_node || apply gt_tree_node); auto; (eapply lt_tree_trans || eapply gt_tree_trans); eauto. Qed. Hint Resolve bal_bst. @@ -842,7 +842,7 @@ Proof. unfold assert_false, create; intuition_in. Qed. -Lemma bal_find : forall l x e r y, +Lemma bal_find : forall l x e r y, bst l -> bst r -> lt_tree x l -> gt_tree x r -> find y (bal l x e r) = find y (create l x e r). Proof. @@ -870,32 +870,32 @@ Qed. Hint Resolve add_bst. Lemma add_1 : forall m x y e, X.eq x y -> MapsTo y e (add x e m). -Proof. - intros m x y e; functional induction (add x e m); +Proof. + intros m x y e; functional induction (add x e m); intros; inv bst; try rewrite bal_mapsto; unfold create; eauto. Qed. -Lemma add_2 : forall m x y e e', ~X.eq x y -> +Lemma add_2 : forall m x y e e', ~X.eq x y -> MapsTo y e m -> MapsTo y e (add x e' m). Proof. intros m x y e e'; induction m; simpl; auto. destruct (X.compare x k); - intros; inv bst; try rewrite bal_mapsto; unfold create; auto; + intros; inv bst; try rewrite bal_mapsto; unfold create; auto; inv MapsTo; auto; order. Qed. -Lemma add_3 : forall m x y e e', ~X.eq x y -> +Lemma add_3 : forall m x y e e', ~X.eq x y -> MapsTo y e (add x e' m) -> MapsTo y e m. Proof. - intros m x y e e'; induction m; simpl; auto. + intros m x y e e'; induction m; simpl; auto. intros; inv MapsTo; auto; order. - destruct (X.compare x k); intro; - try rewrite bal_mapsto; auto; unfold create; intros; inv MapsTo; auto; + destruct (X.compare x k); intro; + try rewrite bal_mapsto; auto; unfold create; intros; inv MapsTo; auto; order. Qed. -Lemma add_find : forall m x y e, bst m -> - find y (add x e m) = +Lemma add_find : forall m x y e, bst m -> + find y (add x e m) = match X.compare y x with EQ _ => Some e | _ => find y m end. Proof. intros. @@ -909,7 +909,7 @@ Qed. (** * Extraction of minimum binding *) Lemma remove_min_in : forall l x e r h y, - In y (Node l x e r h) <-> + In y (Node l x e r h) <-> X.eq y (remove_min l x e r)#2#1 \/ In y (remove_min l x e r)#1. Proof. intros l x e r; functional induction (remove_min l x e r); simpl in *; intros. @@ -919,7 +919,7 @@ Proof. Qed. Lemma remove_min_mapsto : forall l x e r h y e', - MapsTo y e' (Node l x e r h) <-> + MapsTo y e' (Node l x e r h) <-> ((X.eq y (remove_min l x e r)#2#1) /\ e' = (remove_min l x e r)#2#2) \/ MapsTo y e' (remove_min l x e r)#1. Proof. @@ -933,7 +933,7 @@ Proof. inversion_clear H3; intuition. Qed. -Lemma remove_min_bst : forall l x e r h, +Lemma remove_min_bst : forall l x e r h, bst (Node l x e r h) -> bst (remove_min l x e r)#1. Proof. intros l x e r; functional induction (remove_min l x e r); simpl in *; intros. @@ -949,8 +949,8 @@ Proof. Qed. Hint Resolve remove_min_bst. -Lemma remove_min_gt_tree : forall l x e r h, - bst (Node l x e r h) -> +Lemma remove_min_gt_tree : forall l x e r h, + bst (Node l x e r h) -> gt_tree (remove_min l x e r)#2#1 (remove_min l x e r)#1. Proof. intros l x e r; functional induction (remove_min l x e r); simpl in *; intros. @@ -968,10 +968,10 @@ Proof. Qed. Hint Resolve remove_min_gt_tree. -Lemma remove_min_find : forall l x e r h y, - bst (Node l x e r h) -> - find y (Node l x e r h) = - match X.compare y (remove_min l x e r)#2#1 with +Lemma remove_min_find : forall l x e r h y, + bst (Node l x e r h) -> + find y (Node l x e r h) = + match X.compare y (remove_min l x e r)#2#1 with | LT _ => None | EQ _ => Some (remove_min l x e r)#2#2 | GT _ => find y (remove_min l x e r)#1 @@ -990,9 +990,9 @@ Qed. (** * Merging two trees *) -Lemma merge_in : forall m1 m2 y, bst m1 -> bst m2 -> +Lemma merge_in : forall m1 m2 y, bst m1 -> bst m2 -> (In y (merge m1 m2) <-> In y m1 \/ In y m2). -Proof. +Proof. intros m1 m2; functional induction (merge m1 m2);intros; try factornode _x _x0 _x1 _x2 _x3 as m1. intuition_in. @@ -1000,10 +1000,10 @@ Proof. rewrite bal_in, remove_min_in, e1; simpl; intuition. Qed. -Lemma merge_mapsto : forall m1 m2 y e, bst m1 -> bst m2 -> +Lemma merge_mapsto : forall m1 m2 y e, bst m1 -> bst m2 -> (MapsTo y e (merge m1 m2) <-> MapsTo y e m1 \/ MapsTo y e m2). Proof. - intros m1 m2; functional induction (merge m1 m2); intros; + intros m1 m2; functional induction (merge m1 m2); intros; try factornode _x _x0 _x1 _x2 _x3 as m1. intuition_in. intuition_in. @@ -1013,12 +1013,12 @@ Proof. inversion_clear H1; intuition. Qed. -Lemma merge_bst : forall m1 m2, bst m1 -> bst m2 -> - (forall y1 y2 : key, In y1 m1 -> In y2 m2 -> X.lt y1 y2) -> - bst (merge m1 m2). +Lemma merge_bst : forall m1 m2, bst m1 -> bst m2 -> + (forall y1 y2 : key, In y1 m1 -> In y2 m2 -> X.lt y1 y2) -> + bst (merge m1 m2). Proof. intros m1 m2; functional induction (merge m1 m2); intros; auto; - try factornode _x _x0 _x1 _x2 _x3 as m1. + try factornode _x _x0 _x1 _x2 _x3 as m1. apply bal_bst; auto. generalize (remove_min_bst H0); rewrite e1; simpl in *; auto. intro; intro. @@ -1029,7 +1029,7 @@ Qed. (** * Deletion *) -Lemma remove_in : forall m x y, bst m -> +Lemma remove_in : forall m x y, bst m -> (In y (remove x m) <-> ~ X.eq y x /\ In y m). Proof. intros m x; functional induction (remove x m); simpl; intros. @@ -1049,7 +1049,7 @@ Proof. Qed. Lemma remove_bst : forall m x, bst m -> bst (remove x m). -Proof. +Proof. intros m x; functional induction (remove x m); simpl; intros. auto. (* LT *) @@ -1061,7 +1061,7 @@ Proof. (* EQ *) inv bst. apply merge_bst; eauto. - (* GT *) + (* GT *) inv bst. apply bal_bst; auto. intro; intro. @@ -1070,16 +1070,16 @@ Proof. Qed. Lemma remove_1 : forall m x y, bst m -> X.eq x y -> ~ In y (remove x m). -Proof. +Proof. intros; rewrite remove_in; intuition. Qed. -Lemma remove_2 : forall m x y e, bst m -> ~X.eq x y -> +Lemma remove_2 : forall m x y e, bst m -> ~X.eq x y -> MapsTo y e m -> MapsTo y e (remove x m). Proof. intros m x y e; induction m; simpl; auto. - destruct (X.compare x k); - intros; inv bst; try rewrite bal_mapsto; unfold create; auto; + destruct (X.compare x k); + intros; inv bst; try rewrite bal_mapsto; unfold create; auto; try solve [inv MapsTo; auto]. rewrite merge_mapsto; auto. inv MapsTo; auto; order. @@ -1089,7 +1089,7 @@ Lemma remove_3 : forall m x y e, bst m -> MapsTo y e (remove x m) -> MapsTo y e m. Proof. intros m x y e; induction m; simpl; auto. - destruct (X.compare x k); intros Bs; inv bst; + destruct (X.compare x k); intros Bs; inv bst; try rewrite bal_mapsto; auto; unfold create. intros; inv MapsTo; auto. rewrite merge_mapsto; intuition. @@ -1098,7 +1098,7 @@ Qed. (** * join *) -Lemma join_in : forall l x d r y, +Lemma join_in : forall l x d r y, In y (join l x d r) <-> X.eq y x \/ In y l \/ In y r. Proof. join_tac. @@ -1110,23 +1110,23 @@ Proof. apply create_in. Qed. -Lemma join_bst : forall l x d r, bst l -> bst r -> +Lemma join_bst : forall l x d r, bst l -> bst r -> lt_tree x l -> gt_tree x r -> bst (join l x d r). Proof. - join_tac; auto; try (simpl; auto; fail); inv bst; apply bal_bst; auto; + join_tac; auto; try (simpl; auto; fail); inv bst; apply bal_bst; auto; clear Hrl Hlr z; intro; intros; rewrite join_in in *. intuition; [ apply MX.lt_eq with x | ]; eauto. intuition; [ apply MX.eq_lt with x | ]; eauto. Qed. Hint Resolve join_bst. -Lemma join_find : forall l x d r y, - bst l -> bst r -> lt_tree x l -> gt_tree x r -> +Lemma join_find : forall l x d r y, + bst l -> bst r -> lt_tree x l -> gt_tree x r -> find y (join l x d r) = find y (create l x d r). Proof. join_tac; auto; inv bst; - simpl (join (Leaf elt)); - try (assert (X.lt lx x) by auto); + simpl (join (Leaf elt)); + try (assert (X.lt lx x) by auto); try (assert (X.lt x rx) by auto); rewrite ?add_find, ?bal_find; auto. @@ -1150,10 +1150,10 @@ Qed. (** * split *) -Lemma split_in_1 : forall m x, bst m -> forall y, +Lemma split_in_1 : forall m x, bst m -> forall y, (In y (split x m)#l <-> In y m /\ X.lt y x). Proof. - intros m x; functional induction (split x m); simpl; intros; + intros m x; functional induction (split x m); simpl; intros; inv bst; try clear e0. intuition_in. rewrite e1 in IHt; simpl in IHt; rewrite IHt; intuition_in; order. @@ -1162,10 +1162,10 @@ Proof. rewrite e1 in IHt; simpl in IHt; rewrite IHt; intuition_in; order. Qed. -Lemma split_in_2 : forall m x, bst m -> forall y, +Lemma split_in_2 : forall m x, bst m -> forall y, (In y (split x m)#r <-> In y m /\ X.lt x y). -Proof. - intros m x; functional induction (split x m); subst; simpl; intros; +Proof. + intros m x; functional induction (split x m); subst; simpl; intros; inv bst; try clear e0. intuition_in. rewrite join_in. @@ -1174,18 +1174,18 @@ Proof. rewrite e1 in IHt; simpl in IHt; rewrite IHt; intuition_in; order. Qed. -Lemma split_in_3 : forall m x, bst m -> +Lemma split_in_3 : forall m x, bst m -> (split x m)#o = find x m. Proof. intros m x; functional induction (split x m); subst; simpl; auto; - intros; inv bst; try clear e0; + intros; inv bst; try clear e0; destruct X.compare; try (order;fail); rewrite <-IHt, e1; auto. Qed. -Lemma split_bst : forall m x, bst m -> +Lemma split_bst : forall m x, bst m -> bst (split x m)#l /\ bst (split x m)#r. -Proof. - intros m x; functional induction (split x m); subst; simpl; intros; +Proof. + intros m x; functional induction (split x m); subst; simpl; intros; inv bst; try clear e0; try rewrite e1 in *; simpl in *; intuition; apply join_bst; auto. intros y0. @@ -1204,17 +1204,17 @@ Proof. intros m x B y Hy; rewrite split_in_2 in Hy; intuition. Qed. -Lemma split_find : forall m x y, bst m -> - find y m = match X.compare y x with +Lemma split_find : forall m x y, bst m -> + find y m = match X.compare y x with | LT _ => find y (split x m)#l | EQ _ => (split x m)#o | GT _ => find y (split x m)#r end. Proof. - intros m x; functional induction (split x m); subst; simpl; intros; - inv bst; try clear e0; try rewrite e1 in *; simpl in *; + intros m x; functional induction (split x m); subst; simpl; intros; + inv bst; try clear e0; try rewrite e1 in *; simpl in *; [ destruct X.compare; auto | .. ]; - try match goal with E:split ?x ?t = _, B:bst ?t |- _ => + try match goal with E:split ?x ?t = _, B:bst ?t |- _ => generalize (split_in_1 x B)(split_in_2 x B)(split_bst x B); rewrite E; simpl; destruct 3 end. @@ -1231,7 +1231,7 @@ Qed. (** * Concatenation *) -Lemma concat_in : forall m1 m2 y, +Lemma concat_in : forall m1 m2 y, In y (concat m1 m2) <-> In y m1 \/ In y m2. Proof. intros m1 m2; functional induction (concat m1 m2); intros; @@ -1241,11 +1241,11 @@ Proof. rewrite join_in, remove_min_in, e1; simpl; intuition. Qed. -Lemma concat_bst : forall m1 m2, bst m1 -> bst m2 -> - (forall y1 y2, In y1 m1 -> In y2 m2 -> X.lt y1 y2) -> +Lemma concat_bst : forall m1 m2, bst m1 -> bst m2 -> + (forall y1 y2, In y1 m1 -> In y2 m2 -> X.lt y1 y2) -> bst (concat m1 m2). Proof. - intros m1 m2; functional induction (concat m1 m2); intros; auto; + intros m1 m2; functional induction (concat m1 m2); intros; auto; try factornode _x _x0 _x1 _x2 _x3 as m1. apply join_bst; auto. change (bst (m2',xd)#1); rewrite <-e1; eauto. @@ -1256,19 +1256,19 @@ Proof. Qed. Hint Resolve concat_bst. -Lemma concat_find : forall m1 m2 y, bst m1 -> bst m2 -> - (forall y1 y2, In y1 m1 -> In y2 m2 -> X.lt y1 y2) -> - find y (concat m1 m2) = +Lemma concat_find : forall m1 m2 y, bst m1 -> bst m2 -> + (forall y1 y2, In y1 m1 -> In y2 m2 -> X.lt y1 y2) -> + find y (concat m1 m2) = match find y m2 with Some d => Some d | None => find y m1 end. Proof. - intros m1 m2; functional induction (concat m1 m2); intros; auto; + intros m1 m2; functional induction (concat m1 m2); intros; auto; try factornode _x _x0 _x1 _x2 _x3 as m1. simpl; destruct (find y m2); auto. generalize (remove_min_find y H0)(remove_min_in l2 x2 d2 r2 _x4) - (remove_min_bst H0)(remove_min_gt_tree H0); + (remove_min_bst H0)(remove_min_gt_tree H0); rewrite e1; simpl fst; simpl snd; intros. - + inv bst. rewrite H2, join_find; auto; clear H2. simpl; destruct X.compare; simpl; auto. @@ -1286,7 +1286,7 @@ Notation eqk := (PX.eqk (elt:= elt)). Notation eqke := (PX.eqke (elt:= elt)). Notation ltk := (PX.ltk (elt:= elt)). -Lemma elements_aux_mapsto : forall (s:t elt) acc x e, +Lemma elements_aux_mapsto : forall (s:t elt) acc x e, InA eqke (x,e) (elements_aux acc s) <-> MapsTo x e s \/ InA eqke (x,e) acc. Proof. induction s as [ | l Hl x e r Hr h ]; simpl; auto. @@ -1299,8 +1299,8 @@ Proof. destruct H0; simpl in *; subst; intuition. Qed. -Lemma elements_mapsto : forall (s:t elt) x e, InA eqke (x,e) (elements s) <-> MapsTo x e s. -Proof. +Lemma elements_mapsto : forall (s:t elt) x e, InA eqke (x,e) (elements s) <-> MapsTo x e s. +Proof. intros; generalize (elements_aux_mapsto s nil x e); intuition. inversion_clear H0. Qed. @@ -1324,7 +1324,7 @@ Proof. induction s as [ | l Hl y e r Hr h]; simpl; intuition. inv bst. apply Hl; auto. - constructor. + constructor. apply Hr; eauto. apply (InA_InfA (PX.eqke_refl (elt:=elt))); intros (y',e') H6. destruct (elements_aux_mapsto r acc y' e'); intuition. @@ -1382,7 +1382,7 @@ Qed. (** * Fold *) -Definition fold' (A : Type) (f : key -> elt -> A -> A)(s : t elt) := +Definition fold' (A : Type) (f : key -> elt -> A -> A)(s : t elt) := L.fold f (elements s). Lemma fold_equiv_aux : @@ -1401,14 +1401,14 @@ Lemma fold_equiv : forall (A : Type) (s : t elt) (f : key -> elt -> A -> A) (a : A), fold f s a = fold' f s a. Proof. - unfold fold', elements in |- *. + unfold fold', elements in |- *. simple induction s; simpl in |- *; auto; intros. rewrite fold_equiv_aux. rewrite H0. simpl in |- *; auto. Qed. -Lemma fold_1 : +Lemma fold_1 : forall (s:t elt)(Hs:bst s)(A : Type)(i:A)(f : key -> elt -> A -> A), fold f s i = fold_left (fun a p => f p#1 p#2 a) (elements s) i. Proof. @@ -1421,9 +1421,9 @@ Qed. (** * Comparison *) -(** [flatten_e e] returns the list of elements of the enumeration [e] +(** [flatten_e e] returns the list of elements of the enumeration [e] i.e. the list of elements actually compared *) - + Fixpoint flatten_e (e : enumeration elt) : list (key*elt) := match e with | End => nil | More x e t r => (x,e) :: elements t ++ flatten_e r @@ -1431,13 +1431,13 @@ Fixpoint flatten_e (e : enumeration elt) : list (key*elt) := match e with Lemma flatten_e_elements : forall (l:t elt) r x d z e, - elements l ++ flatten_e (More x d r e) = + elements l ++ flatten_e (More x d r e) = elements (Node l x d r z) ++ flatten_e e. Proof. intros; simpl; apply elements_node. Qed. -Lemma cons_1 : forall (s:t elt) e, +Lemma cons_1 : forall (s:t elt) e, flatten_e (cons s e) = elements s ++ flatten_e e. Proof. induction s; simpl; auto; intros. @@ -1450,24 +1450,24 @@ Variable cmp : elt->elt->bool. Definition IfEq b l1 l2 := L.equal cmp l1 l2 = b. -Lemma cons_IfEq : forall b x1 x2 d1 d2 l1 l2, - X.eq x1 x2 -> cmp d1 d2 = true -> - IfEq b l1 l2 -> +Lemma cons_IfEq : forall b x1 x2 d1 d2 l1 l2, + X.eq x1 x2 -> cmp d1 d2 = true -> + IfEq b l1 l2 -> IfEq b ((x1,d1)::l1) ((x2,d2)::l2). Proof. - unfold IfEq; destruct b; simpl; intros; destruct X.compare; simpl; + unfold IfEq; destruct b; simpl; intros; destruct X.compare; simpl; try rewrite H0; auto; order. Qed. -Lemma equal_end_IfEq : forall e2, +Lemma equal_end_IfEq : forall e2, IfEq (equal_end e2) nil (flatten_e e2). Proof. destruct e2; red; auto. Qed. -Lemma equal_more_IfEq : - forall x1 d1 (cont:enumeration elt -> bool) x2 d2 r2 e2 l, - IfEq (cont (cons r2 e2)) l (elements r2 ++ flatten_e e2) -> +Lemma equal_more_IfEq : + forall x1 d1 (cont:enumeration elt -> bool) x2 d2 r2 e2 l, + IfEq (cont (cons r2 e2)) l (elements r2 ++ flatten_e e2) -> IfEq (equal_more cmp x1 d1 cont (More x2 d2 r2 e2)) ((x1,d1)::l) (flatten_e (More x2 d2 r2 e2)). Proof. @@ -1475,7 +1475,7 @@ Proof. rewrite <-andb_lazy_alt; f_equal; auto. Qed. -Lemma equal_cont_IfEq : forall m1 cont e2 l, +Lemma equal_cont_IfEq : forall m1 cont e2 l, (forall e, IfEq (cont e) l (flatten_e e)) -> IfEq (equal_cont cmp m1 cont e2) (elements m1 ++ l) (flatten_e e2). Proof. @@ -1493,18 +1493,18 @@ Lemma equal_IfEq : forall (m1 m2:t elt), Proof. intros; unfold equal. rewrite (app_nil_end (elements m1)). - replace (elements m2) with (flatten_e (cons m2 (End _))) + replace (elements m2) with (flatten_e (cons m2 (End _))) by (rewrite cons_1; simpl; rewrite <-app_nil_end; auto). apply equal_cont_IfEq. intros. apply equal_end_IfEq; auto. Qed. -Definition Equivb m m' := - (forall k, In k m <-> In k m') /\ +Definition Equivb m m' := + (forall k, In k m <-> In k m') /\ (forall k e e', MapsTo k e m -> MapsTo k e' m' -> cmp e e' = true). -Lemma Equivb_elements : forall s s', +Lemma Equivb_elements : forall s s', Equivb s s' <-> L.Equivb cmp (elements s) (elements s'). Proof. unfold Equivb, L.Equivb; split; split; intros. @@ -1516,7 +1516,7 @@ destruct H. apply (H2 k); unfold L.PX.MapsTo; rewrite elements_mapsto; auto. Qed. -Lemma equal_Equivb : forall (s s': t elt), bst s -> bst s' -> +Lemma equal_Equivb : forall (s s': t elt), bst s -> bst s' -> (equal cmp s s' = true <-> Equivb s s'). Proof. intros s s' B B'. @@ -1526,17 +1526,17 @@ Qed. End Elt. -Section Map. +Section Map. Variable elt elt' : Type. -Variable f : elt -> elt'. +Variable f : elt -> elt'. -Lemma map_1 : forall (m: t elt)(x:key)(e:elt), +Lemma map_1 : forall (m: t elt)(x:key)(e:elt), MapsTo x e m -> MapsTo x (f e) (map f m). Proof. induction m; simpl; inversion_clear 1; auto. Qed. -Lemma map_2 : forall (m: t elt)(x:key), +Lemma map_2 : forall (m: t elt)(x:key), In x (map f m) -> In x m. Proof. induction m; simpl; inversion_clear 1; auto. @@ -1545,7 +1545,7 @@ Qed. Lemma map_bst : forall m, bst m -> bst (map f m). Proof. induction m; simpl; auto. -inversion_clear 1; constructor; auto; +inversion_clear 1; constructor; auto; red; auto using map_2. Qed. @@ -1554,7 +1554,7 @@ Section Mapi. Variable elt elt' : Type. Variable f : key -> elt -> elt'. -Lemma mapi_1 : forall (m: tree elt)(x:key)(e:elt), +Lemma mapi_1 : forall (m: tree elt)(x:key)(e:elt), MapsTo x e m -> exists y, X.eq y x /\ MapsTo x (f y e) (mapi f m). Proof. induction m; simpl; inversion_clear 1; auto. @@ -1565,7 +1565,7 @@ destruct (IHm2 _ _ H0). exists x0; intuition. Qed. -Lemma mapi_2 : forall (m: t elt)(x:key), +Lemma mapi_2 : forall (m: t elt)(x:key), In x (mapi f m) -> In x m. Proof. induction m; simpl; inversion_clear 1; auto. @@ -1574,7 +1574,7 @@ Qed. Lemma mapi_bst : forall m, bst m -> bst (mapi f m). Proof. induction m; simpl; auto. -inversion_clear 1; constructor; auto; +inversion_clear 1; constructor; auto; red; auto using mapi_2. Qed. @@ -1585,7 +1585,7 @@ Variable elt elt' : Type. Variable f : key -> elt -> option elt'. Hypothesis f_compat : forall x x' d, X.eq x x' -> f x d = f x' d. -Lemma map_option_2 : forall (m:t elt)(x:key), +Lemma map_option_2 : forall (m:t elt)(x:key), In x (map_option f m) -> exists d, MapsTo x d m /\ f x d <> None. Proof. intros m; functional induction (map_option f m); simpl; auto; intros. @@ -1601,9 +1601,9 @@ Qed. Lemma map_option_bst : forall m, bst m -> bst (map_option f m). Proof. -intros m; functional induction (map_option f m); simpl; auto; intros; +intros m; functional induction (map_option f m); simpl; auto; intros; inv bst. -apply join_bst; auto; intros y H; +apply join_bst; auto; intros y H; destruct (map_option_2 H) as (d0 & ? & ?); eauto using MapsTo_In. apply concat_bst; auto; intros y y' H H'. destruct (map_option_2 H) as (d0 & ? & ?). @@ -1612,22 +1612,22 @@ eapply X.lt_trans with x; eauto using MapsTo_In. Qed. Hint Resolve map_option_bst. -Ltac nonify e := - replace e with (@None elt) by +Ltac nonify e := + replace e with (@None elt) by (symmetry; rewrite not_find_iff; auto; intro; order). -Lemma map_option_find : forall (m:t elt)(x:key), - bst m -> - find x (map_option f m) = +Lemma map_option_find : forall (m:t elt)(x:key), + bst m -> + find x (map_option f m) = match (find x m) with Some d => f x d | None => None end. Proof. intros m; functional induction (map_option f m); simpl; auto; intros; - inv bst; rewrite join_find || rewrite concat_find; auto; simpl; + inv bst; rewrite join_find || rewrite concat_find; auto; simpl; try destruct X.compare; simpl; auto. rewrite (f_compat d e); auto. intros y H; destruct (map_option_2 H) as (? & ? & ?); eauto using MapsTo_In. -intros y H; +intros y H; destruct (map_option_2 H) as (? & ? & ?); eauto using MapsTo_In. rewrite <- IHt, IHt0; auto; nonify (find x0 r); auto. @@ -1653,21 +1653,21 @@ Variable mapr : t elt' -> t elt''. Hypothesis f0_f : forall x d o, f x d o = f0 x (Some d) o. Hypothesis mapl_bst : forall m, bst m -> bst (mapl m). Hypothesis mapr_bst : forall m', bst m' -> bst (mapr m'). -Hypothesis mapl_f0 : forall x m, bst m -> - find x (mapl m) = +Hypothesis mapl_f0 : forall x m, bst m -> + find x (mapl m) = match find x m with Some d => f0 x (Some d) None | None => None end. -Hypothesis mapr_f0 : forall x m', bst m' -> - find x (mapr m') = +Hypothesis mapr_f0 : forall x m', bst m' -> + find x (mapr m') = match find x m' with Some d' => f0 x None (Some d') | None => None end. Hypothesis f0_compat : forall x x' o o', X.eq x x' -> f0 x o o' = f0 x' o o'. Notation map2_opt := (map2_opt f mapl mapr). -Lemma map2_opt_2 : forall m m' y, bst m -> bst m' -> +Lemma map2_opt_2 : forall m m' y, bst m -> bst m' -> In y (map2_opt m m') -> In y m \/ In y m'. Proof. intros m m'; functional induction (map2_opt m m'); intros; - auto; try factornode _x0 _x1 _x2 _x3 _x4 as m2; + auto; try factornode _x0 _x1 _x2 _x3 _x4 as m2; try (generalize (split_in_1 x1 H0 y)(split_in_2 x1 H0 y) (split_bst x1 H0); rewrite e1; simpl; destruct 3; inv bst). @@ -1689,12 +1689,12 @@ destruct (IHt1 y H6 H4 H'); intuition. destruct (IHt0 y H7 H5 H'); intuition. Qed. -Lemma map2_opt_bst : forall m m', bst m -> bst m' -> +Lemma map2_opt_bst : forall m m', bst m -> bst m' -> bst (map2_opt m m'). Proof. intros m m'; functional induction (map2_opt m m'); intros; - auto; try factornode _x0 _x1 _x2 _x3 _x4 as m2; inv bst; - generalize (split_in_1 x1 H0)(split_in_2 x1 H0)(split_bst x1 H0); + auto; try factornode _x0 _x1 _x2 _x3 _x4 as m2; inv bst; + generalize (split_in_1 x1 H0)(split_in_2 x1 H0)(split_bst x1 H0); rewrite e1; simpl in *; destruct 3. apply join_bst; auto. @@ -1711,31 +1711,31 @@ destruct (map2_opt_2 H2 H7 Hy'); intuition. Qed. Hint Resolve map2_opt_bst. -Ltac map2_aux := +Ltac map2_aux := match goal with - | H : In ?x _ \/ In ?x ?m, - H' : find ?x ?m = find ?x ?m', B:bst ?m, B':bst ?m' |- _ => - destruct H; [ intuition_in; order | + | H : In ?x _ \/ In ?x ?m, + H' : find ?x ?m = find ?x ?m', B:bst ?m, B':bst ?m' |- _ => + destruct H; [ intuition_in; order | rewrite <-(find_in_equiv B B' H'); auto ] end. -Ltac nonify t := - match t with (find ?y (map2_opt ?m ?m')) => +Ltac nonify t := + match t with (find ?y (map2_opt ?m ?m')) => replace t with (@None elt''); [ | symmetry; rewrite not_find_iff; auto; intro; destruct (@map2_opt_2 m m' y); auto; order ] end. -Lemma map2_opt_1 : forall m m' y, bst m -> bst m' -> +Lemma map2_opt_1 : forall m m' y, bst m -> bst m' -> In y m \/ In y m' -> find y (map2_opt m m') = f0 y (find y m) (find y m'). Proof. intros m m'; functional induction (map2_opt m m'); intros; - auto; try factornode _x0 _x1 _x2 _x3 _x4 as m2; + auto; try factornode _x0 _x1 _x2 _x3 _x4 as m2; try (generalize (split_in_1 x1 H0)(split_in_2 x1 H0) (split_in_3 x1 H0)(split_bst x1 H0)(split_find x1 y H0) (split_lt_tree (x:=x1) H0)(split_gt_tree (x:=x1) H0); - rewrite e1; simpl in *; destruct 4; intros; inv bst; + rewrite e1; simpl in *; destruct 4; intros; inv bst; subst o2; rewrite H7, ?join_find, ?concat_find; auto). simpl; destruct H1; [ inversion_clear H1 | ]. @@ -1777,19 +1777,19 @@ Variable f : option elt -> option elt' -> option elt''. Lemma map2_bst : forall m m', bst m -> bst m' -> bst (map2 f m m'). Proof. unfold map2; intros. -apply map2_opt_bst with (fun _ => f); auto using map_option_bst; +apply map2_opt_bst with (fun _ => f); auto using map_option_bst; intros; rewrite map_option_find; auto. Qed. -Lemma map2_1 : forall m m' y, bst m -> bst m' -> +Lemma map2_1 : forall m m' y, bst m -> bst m' -> In y m \/ In y m' -> find y (map2 f m m') = f (find y m) (find y m'). Proof. unfold map2; intros. -rewrite (map2_opt_1 (f0:=fun _ => f)); +rewrite (map2_opt_1 (f0:=fun _ => f)); auto using map_option_bst; intros; rewrite map_option_find; auto. Qed. -Lemma map2_2 : forall m m' y, bst m -> bst m' -> +Lemma map2_2 : forall m m' y, bst m -> bst m' -> In y (map2 f m m') -> In y m \/ In y m'. Proof. unfold map2; intros. @@ -1806,38 +1806,38 @@ End Raw. (** * Encapsulation - Now, in order to really provide a functor implementing [S], we + Now, in order to really provide a functor implementing [S], we need to encapsulate everything into a type of balanced binary search trees. *) Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Module E := X. - Module Raw := Raw I X. + Module Raw := Raw I X. Import Raw.Proofs. - Record bst (elt:Type) := + Record bst (elt:Type) := Bst {this :> Raw.tree elt; is_bst : Raw.bst this}. - - Definition t := bst. + + Definition t := bst. Definition key := E.t. - - Section Elt. + + Section Elt. Variable elt elt' elt'': Type. Implicit Types m : t elt. - Implicit Types x y : key. - Implicit Types e : elt. + Implicit Types x y : key. + Implicit Types e : elt. Definition empty : t elt := Bst (empty_bst elt). Definition is_empty m : bool := Raw.is_empty m.(this). Definition add x e m : t elt := Bst (add_bst x e m.(is_bst)). - Definition remove x m : t elt := Bst (remove_bst x m.(is_bst)). + Definition remove x m : t elt := Bst (remove_bst x m.(is_bst)). Definition mem x m : bool := Raw.mem x m.(this). Definition find x m : option elt := Raw.find x m.(this). Definition map f m : t elt' := Bst (map_bst f m.(is_bst)). - Definition mapi (f:key->elt->elt') m : t elt' := + Definition mapi (f:key->elt->elt') m : t elt' := Bst (mapi_bst f m.(is_bst)). - Definition map2 f m (m':t elt') : t elt'' := + Definition map2 f m (m':t elt') : t elt'' := Bst (map2_bst f m.(is_bst) m'.(is_bst)). Definition elements m : list (key*elt) := Raw.elements m.(this). Definition cardinal m := Raw.cardinal m.(this). @@ -1854,14 +1854,14 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Lemma MapsTo_1 : forall m x y e, E.eq x y -> MapsTo x e m -> MapsTo y e m. Proof. intros m; exact (@MapsTo_1 _ m.(this)). Qed. - + Lemma mem_1 : forall m x, In x m -> mem x m = true. Proof. unfold In, mem; intros m x; rewrite In_alt; simpl; apply mem_1; auto. apply m.(is_bst). Qed. - - Lemma mem_2 : forall m x, mem x m = true -> In x m. + + Lemma mem_2 : forall m x, mem x m = true -> In x m. Proof. unfold In, mem; intros m x; rewrite In_alt; simpl; apply mem_2; auto. Qed. @@ -1892,7 +1892,7 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Proof. intros m x y e; exact (@remove_3 elt _ x y e m.(is_bst)). Qed. - Lemma find_1 : forall m x e, MapsTo x e m -> find x m = Some e. + Lemma find_1 : forall m x e, MapsTo x e m -> find x m = Some e. Proof. intros m x e; exact (@find_1 elt _ x e m.(is_bst)). Qed. Lemma find_2 : forall m x e, find x m = Some e -> MapsTo x e m. Proof. intros m; exact (@find_2 elt m.(this)). Qed. @@ -1901,36 +1901,36 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i. Proof. intros m; exact (@fold_1 elt m.(this) m.(is_bst)). Qed. - Lemma elements_1 : forall m x e, + Lemma elements_1 : forall m x e, MapsTo x e m -> InA eq_key_elt (x,e) (elements m). Proof. intros; unfold elements, MapsTo, eq_key_elt; rewrite elements_mapsto; auto. Qed. - Lemma elements_2 : forall m x e, + Lemma elements_2 : forall m x e, InA eq_key_elt (x,e) (elements m) -> MapsTo x e m. Proof. intros; unfold elements, MapsTo, eq_key_elt; rewrite <- elements_mapsto; auto. Qed. - Lemma elements_3 : forall m, sort lt_key (elements m). + Lemma elements_3 : forall m, sort lt_key (elements m). Proof. intros m; exact (@elements_sort elt m.(this) m.(is_bst)). Qed. - Lemma elements_3w : forall m, NoDupA eq_key (elements m). + Lemma elements_3w : forall m, NoDupA eq_key (elements m). Proof. intros m; exact (@elements_nodup elt m.(this) m.(is_bst)). Qed. Lemma cardinal_1 : forall m, cardinal m = length (elements m). Proof. intro m; exact (@elements_cardinal elt m.(this)). Qed. Definition Equal m m' := forall y, find y m = find y m'. - Definition Equiv (eq_elt:elt->elt->Prop) m m' := - (forall k, In k m <-> In k m') /\ + Definition Equiv (eq_elt:elt->elt->Prop) m m' := + (forall k, In k m <-> In k m') /\ (forall k e e', MapsTo k e m -> MapsTo k e' m' -> eq_elt e e'). Definition Equivb cmp := Equiv (Cmp cmp). - Lemma Equivb_Equivb : forall cmp m m', + Lemma Equivb_Equivb : forall cmp m m', Equivb cmp m m' <-> Raw.Proofs.Equivb cmp m m'. - Proof. + Proof. intros; unfold Equivb, Equiv, Raw.Proofs.Equivb, In; intuition. generalize (H0 k); do 2 rewrite In_alt; intuition. generalize (H0 k); do 2 rewrite In_alt; intuition. @@ -1938,23 +1938,23 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. generalize (H0 k); do 2 rewrite <- In_alt; intuition. Qed. - Lemma equal_1 : forall m m' cmp, - Equivb cmp m m' -> equal cmp m m' = true. - Proof. - unfold equal; intros (m,b) (m',b') cmp; rewrite Equivb_Equivb; + Lemma equal_1 : forall m m' cmp, + Equivb cmp m m' -> equal cmp m m' = true. + Proof. + unfold equal; intros (m,b) (m',b') cmp; rewrite Equivb_Equivb; intros; simpl in *; rewrite equal_Equivb; auto. - Qed. + Qed. - Lemma equal_2 : forall m m' cmp, + Lemma equal_2 : forall m m' cmp, equal cmp m m' = true -> Equivb cmp m m'. - Proof. - unfold equal; intros (m,b) (m',b') cmp; rewrite Equivb_Equivb; + Proof. + unfold equal; intros (m,b) (m',b') cmp; rewrite Equivb_Equivb; intros; simpl in *; rewrite <-equal_Equivb; auto. Qed. End Elt. - Lemma map_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt)(f:elt->elt'), + Lemma map_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt)(f:elt->elt'), MapsTo x e m -> MapsTo x (f e) (map f m). Proof. intros elt elt' m x e f; exact (@map_1 elt elt' f m.(this) x e). Qed. @@ -1962,10 +1962,10 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Proof. intros elt elt' m x f; do 2 unfold In in *; do 2 rewrite In_alt; simpl. apply map_2; auto. - Qed. + Qed. Lemma mapi_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt) - (f:key->elt->elt'), MapsTo x e m -> + (f:key->elt->elt'), MapsTo x e m -> exists y, E.eq y x /\ MapsTo x (f y e) (mapi f m). Proof. intros elt elt' m x e f; exact (@mapi_1 elt elt' f m.(this) x e). Qed. Lemma mapi_2 : forall (elt elt':Type)(m: t elt)(x:key) @@ -1975,10 +1975,10 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Qed. Lemma map2_1 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt') - (x:key)(f:option elt->option elt'->option elt''), - In x m \/ In x m' -> - find x (map2 f m m') = f (find x m) (find x m'). - Proof. + (x:key)(f:option elt->option elt'->option elt''), + In x m \/ In x m' -> + find x (map2 f m m') = f (find x m) (find x m'). + Proof. unfold find, map2, In; intros elt elt' elt'' m m' x f. do 2 rewrite In_alt; intros; simpl; apply map2_1; auto. apply m.(is_bst). @@ -1986,9 +1986,9 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Qed. Lemma map2_2 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt') - (x:key)(f:option elt->option elt'->option elt''), + (x:key)(f:option elt->option elt'->option elt''), In x (map2 f m m') -> In x m \/ In x m'. - Proof. + Proof. unfold In, map2; intros elt elt' elt'' m m' x f. do 3 rewrite In_alt; intros; simpl in *; eapply map2_2; eauto. apply m.(is_bst). @@ -1998,19 +1998,19 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. End IntMake. -Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <: - Sord with Module Data := D +Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <: + Sord with Module Data := D with Module MapS.E := X. Module Data := D. - Module Import MapS := IntMake(I)(X). + Module Import MapS := IntMake(I)(X). Module LO := FMapList.Make_ord(X)(D). Module R := Raw. Module P := Raw.Proofs. Definition t := MapS.t D.t. - Definition cmp e e' := + Definition cmp e e' := match D.compare e e' with EQ _ => true | _ => false end. (** One step of comparison of elements *) @@ -2020,9 +2020,9 @@ Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <: | R.End => Gt | R.More x2 d2 r2 e2 => match X.compare x1 x2 with - | EQ _ => match D.compare d1 d2 with + | EQ _ => match D.compare d1 d2 with | EQ _ => cont (R.cons r2 e2) - | LT _ => Lt + | LT _ => Lt | GT _ => Gt end | LT _ => Lt @@ -2046,7 +2046,7 @@ Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <: (** The complete comparison *) - Definition compare_pure s1 s2 := + Definition compare_pure s1 s2 := compare_cont s1 compare_end (R.cons s2 (Raw.End _)). (** Correctness of this comparison *) @@ -2058,7 +2058,7 @@ Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <: | Gt => (fun l1 l2 => LO.lt_list l2 l1) end. - Lemma cons_Cmp : forall c x1 x2 d1 d2 l1 l2, + Lemma cons_Cmp : forall c x1 x2 d1 d2 l1 l2, X.eq x1 x2 -> D.eq d1 d2 -> Cmp c l1 l2 -> Cmp c ((x1,d1)::l1) ((x2,d2)::l2). Proof. @@ -2077,10 +2077,10 @@ Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <: Cmp (compare_more x1 d1 cont (R.More x2 d2 r2 e2)) ((x1,d1)::l) (P.flatten_e (R.More x2 d2 r2 e2)). Proof. - simpl; intros; destruct X.compare; simpl; + simpl; intros; destruct X.compare; simpl; try destruct D.compare; simpl; auto; P.MX.elim_comp; auto. Qed. - + Lemma compare_cont_Cmp : forall s1 cont e2 l, (forall e, Cmp (cont e) l (P.flatten_e e)) -> Cmp (compare_cont s1 cont e2) (R.elements s1 ++ l) (P.flatten_e e2). @@ -2114,10 +2114,10 @@ Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <: generalize (compare_Cmp s s'). destruct compare_pure; intros; [apply EQ|apply LT|apply GT]; red; auto. Defined. - + (* Proofs about [eq] and [lt] *) - Definition selements (m1 : t) := + Definition selements (m1 : t) := LO.MapS.Build_slist (P.elements_sort m1.(is_bst)). Definition seq (m1 m2 : t) := LO.eq (selements m1) (selements m2). @@ -2154,7 +2154,7 @@ Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <: Qed. Lemma eq_refl : forall m : t, eq m m. - Proof. + Proof. intros; rewrite eq_seq; unfold seq; intros; apply LO.eq_refl. Qed. @@ -2171,13 +2171,13 @@ Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <: Lemma lt_trans : forall m1 m2 m3 : t, lt m1 m2 -> lt m2 m3 -> lt m1 m3. Proof. - intros m1 m2 m3; rewrite 3 lt_slt; unfold slt; + intros m1 m2 m3; rewrite 3 lt_slt; unfold slt; intros; eapply LO.lt_trans; eauto. Qed. Lemma lt_not_eq : forall m1 m2 : t, lt m1 m2 -> ~ eq m1 m2. Proof. - intros m1 m2; rewrite lt_slt, eq_seq; unfold slt, seq; + intros m1 m2; rewrite lt_slt, eq_seq; unfold slt, seq; intros; apply LO.lt_not_eq; auto. Qed. @@ -2188,8 +2188,8 @@ End IntMake_ord. Module Make (X: OrderedType) <: S with Module E := X :=IntMake(Z_as_Int)(X). -Module Make_ord (X: OrderedType)(D: OrderedType) - <: Sord with Module Data := D +Module Make_ord (X: OrderedType)(D: OrderedType) + <: Sord with Module Data := D with Module MapS.E := X :=IntMake_ord(Z_as_Int)(X)(D). diff --git a/theories/FSets/FMapFacts.v b/theories/FSets/FMapFacts.v index e09db9b6e..88ca717e2 100644 --- a/theories/FSets/FMapFacts.v +++ b/theories/FSets/FMapFacts.v @@ -11,12 +11,12 @@ (** * Finite maps library *) (** This functor derives additional facts from [FMapInterface.S]. These - facts are mainly the specifications of [FMapInterface.S] written using - different styles: equivalence and boolean equalities. + facts are mainly the specifications of [FMapInterface.S] written using + different styles: equivalence and boolean equalities. *) Require Import Bool DecidableType DecidableTypeEx OrderedType Morphisms. -Require Export FMapInterface. +Require Export FMapInterface. Set Implicit Arguments. Unset Strict Implicit. @@ -46,7 +46,7 @@ destruct o; destruct o'; try rewrite H; auto. symmetry; rewrite <- H; auto. Qed. -Lemma MapsTo_fun : forall (elt:Type) m x (e e':elt), +Lemma MapsTo_fun : forall (elt:Type) m x (e e':elt), MapsTo x e m -> MapsTo x e' m -> e=e'. Proof. intros. @@ -56,7 +56,7 @@ Qed. (** ** Specifications written using equivalences *) -Section IffSpec. +Section IffSpec. Variable elt elt' elt'': Type. Implicit Type m: t elt. Implicit Type x y z: key. @@ -112,7 +112,7 @@ destruct mem; intuition. Qed. Lemma equal_iff : forall m m' cmp, Equivb cmp m m' <-> equal cmp m m' = true. -Proof. +Proof. split; [apply equal_1|apply equal_2]. Qed. @@ -127,16 +127,16 @@ unfold In. split; [intros (e,H); rewrite empty_mapsto_iff in H|]; intuition. Qed. -Lemma is_empty_iff : forall m, Empty m <-> is_empty m = true. -Proof. +Lemma is_empty_iff : forall m, Empty m <-> is_empty m = true. +Proof. split; [apply is_empty_1|apply is_empty_2]. Qed. -Lemma add_mapsto_iff : forall m x y e e', - MapsTo y e' (add x e m) <-> - (E.eq x y /\ e=e') \/ +Lemma add_mapsto_iff : forall m x y e e', + MapsTo y e' (add x e m) <-> + (E.eq x y /\ e=e') \/ (~E.eq x y /\ MapsTo y e' m). -Proof. +Proof. intros. intuition. destruct (eq_dec x y); [left|right]. @@ -147,7 +147,7 @@ subst; auto with map. Qed. Lemma add_in_iff : forall m x y e, In y (add x e m) <-> E.eq x y \/ In y m. -Proof. +Proof. unfold In; split. intros (e',H). destruct (eq_dec x y) as [E|E]; auto. @@ -161,13 +161,13 @@ destruct E; auto. exists e'; apply add_2; auto. Qed. -Lemma add_neq_mapsto_iff : forall m x y e e', +Lemma add_neq_mapsto_iff : forall m x y e e', ~ E.eq x y -> (MapsTo y e' (add x e m) <-> MapsTo y e' m). Proof. split; [apply add_3|apply add_2]; auto. Qed. -Lemma add_neq_in_iff : forall m x y e, +Lemma add_neq_in_iff : forall m x y e, ~ E.eq x y -> (In y (add x e m) <-> In y m). Proof. split; intros (e',H0); exists e'. @@ -175,9 +175,9 @@ apply (add_3 H H0). apply add_2; auto. Qed. -Lemma remove_mapsto_iff : forall m x y e, +Lemma remove_mapsto_iff : forall m x y e, MapsTo y e (remove x m) <-> ~E.eq x y /\ MapsTo y e m. -Proof. +Proof. intros. split; intros. split. @@ -188,7 +188,7 @@ apply remove_2; intuition. Qed. Lemma remove_in_iff : forall m x y, In y (remove x m) <-> ~E.eq x y /\ In y m. -Proof. +Proof. unfold In; split. intros (e,H). split. @@ -198,13 +198,13 @@ exists e; apply remove_3 with x; auto. intros (H,(e,H0)); exists e; apply remove_2; auto. Qed. -Lemma remove_neq_mapsto_iff : forall m x y e, +Lemma remove_neq_mapsto_iff : forall m x y e, ~ E.eq x y -> (MapsTo y e (remove x m) <-> MapsTo y e m). Proof. split; [apply remove_3|apply remove_2]; auto. Qed. -Lemma remove_neq_in_iff : forall m x y, +Lemma remove_neq_in_iff : forall m x y, ~ E.eq x y -> (In y (remove x m) <-> In y m). Proof. split; intros (e',H0); exists e'. @@ -212,19 +212,19 @@ apply (remove_3 H0). apply remove_2; auto. Qed. -Lemma elements_mapsto_iff : forall m x e, +Lemma elements_mapsto_iff : forall m x e, MapsTo x e m <-> InA (@eq_key_elt _) (x,e) (elements m). -Proof. +Proof. split; [apply elements_1 | apply elements_2]. Qed. -Lemma elements_in_iff : forall m x, +Lemma elements_in_iff : forall m x, In x m <-> exists e, InA (@eq_key_elt _) (x,e) (elements m). -Proof. +Proof. unfold In; split; intros (e,H); exists e; [apply elements_1 | apply elements_2]; auto. Qed. -Lemma map_mapsto_iff : forall m x b (f : elt -> elt'), +Lemma map_mapsto_iff : forall m x b (f : elt -> elt'), MapsTo x b (map f m) <-> exists a, b = f a /\ MapsTo x a m. Proof. split. @@ -240,7 +240,7 @@ intros (a,(H,H0)). subst b; auto with map. Qed. -Lemma map_in_iff : forall m x (f : elt -> elt'), +Lemma map_in_iff : forall m x (f : elt -> elt'), In x (map f m) <-> In x m. Proof. split; intros; eauto with map. @@ -257,11 +257,11 @@ destruct (mapi_1 f H) as (y,(H0,H1)). exists (f y a); auto. Qed. -(** Unfortunately, we don't have simple equivalences for [mapi] - and [MapsTo]. The only correct one needs compatibility of [f]. *) +(** Unfortunately, we don't have simple equivalences for [mapi] + and [MapsTo]. The only correct one needs compatibility of [f]. *) -Lemma mapi_inv : forall m x b (f : key -> elt -> elt'), - MapsTo x b (mapi f m) -> +Lemma mapi_inv : forall m x b (f : key -> elt -> elt'), + MapsTo x b (mapi f m) -> exists a, exists y, E.eq y x /\ b = f y a /\ MapsTo x a m. Proof. intros; case_eq (find x m); intros. @@ -275,8 +275,8 @@ destruct (mapi_2 H1) as (a,H2). rewrite (find_1 H2) in H0; discriminate. Qed. -Lemma mapi_1bis : forall m x e (f:key->elt->elt'), - (forall x y e, E.eq x y -> f x e = f y e) -> +Lemma mapi_1bis : forall m x e (f:key->elt->elt'), + (forall x y e, E.eq x y -> f x e = f y e) -> MapsTo x e m -> MapsTo x (f x e) (mapi f m). Proof. intros. @@ -286,7 +286,7 @@ auto. Qed. Lemma mapi_mapsto_iff : forall m x b (f:key->elt->elt'), - (forall x y e, E.eq x y -> f x e = f y e) -> + (forall x y e, E.eq x y -> f x e = f y e) -> (MapsTo x b (mapi f m) <-> exists a, b = f x a /\ MapsTo x a m). Proof. split. @@ -299,14 +299,14 @@ subst b. apply mapi_1bis; auto. Qed. -(** Things are even worse for [map2] : we don't try to state any +(** Things are even worse for [map2] : we don't try to state any equivalence, see instead boolean results below. *) End IffSpec. (** Useful tactic for simplifying expressions like [In y (add x e (remove z m))] *) - -Ltac map_iff := + +Ltac map_iff := repeat (progress ( rewrite add_mapsto_iff || rewrite add_in_iff || rewrite remove_mapsto_iff || rewrite remove_in_iff || @@ -318,7 +318,7 @@ Ltac map_iff := Section BoolSpec. -Lemma mem_find_b : forall (elt:Type)(m:t elt)(x:key), mem x m = if find x m then true else false. +Lemma mem_find_b : forall (elt:Type)(m:t elt)(x:key), mem x m = if find x m then true else false. Proof. intros. generalize (find_mapsto_iff m x)(mem_in_iff m x); unfold In. @@ -336,7 +336,7 @@ Implicit Types x y z : key. Implicit Types e : elt. Lemma mem_b : forall m x y, E.eq x y -> mem x m = mem y m. -Proof. +Proof. intros. generalize (mem_in_iff m x) (mem_in_iff m y)(In_iff m H). destruct (mem x m); destruct (mem y m); intuition. @@ -362,14 +362,14 @@ generalize (mem_2 H). rewrite empty_in_iff; intuition. Qed. -Lemma add_eq_o : forall m x y e, +Lemma add_eq_o : forall m x y e, E.eq x y -> find y (add x e m) = Some e. Proof. auto with map. Qed. -Lemma add_neq_o : forall m x y e, - ~ E.eq x y -> find y (add x e m) = find y m. +Lemma add_neq_o : forall m x y e, + ~ E.eq x y -> find y (add x e m) = find y m. Proof. intros. rewrite eq_option_alt. intro e'. rewrite <- 2 find_mapsto_iff. apply add_neq_mapsto_iff; auto. @@ -382,26 +382,26 @@ Proof. intros; destruct (eq_dec x y); auto with map. Qed. -Lemma add_eq_b : forall m x y e, +Lemma add_eq_b : forall m x y e, E.eq x y -> mem y (add x e m) = true. Proof. intros; rewrite mem_find_b; rewrite add_eq_o; auto. Qed. -Lemma add_neq_b : forall m x y e, +Lemma add_neq_b : forall m x y e, ~E.eq x y -> mem y (add x e m) = mem y m. Proof. intros; do 2 rewrite mem_find_b; rewrite add_neq_o; auto. Qed. -Lemma add_b : forall m x y e, - mem y (add x e m) = eqb x y || mem y m. +Lemma add_b : forall m x y e, + mem y (add x e m) = eqb x y || mem y m. Proof. intros; do 2 rewrite mem_find_b; rewrite add_o; unfold eqb. destruct (eq_dec x y); simpl; auto. Qed. -Lemma remove_eq_o : forall m x y, +Lemma remove_eq_o : forall m x y, E.eq x y -> find y (remove x m) = None. Proof. intros. rewrite eq_option_alt. intro e. @@ -442,14 +442,14 @@ intros; do 2 rewrite mem_find_b; rewrite remove_o; unfold eqb. destruct (eq_dec x y); auto. Qed. -Definition option_map (A B:Type)(f:A->B)(o:option A) : option B := - match o with +Definition option_map (A B:Type)(f:A->B)(o:option A) : option B := + match o with | Some a => Some (f a) | None => None end. -Lemma map_o : forall m x (f:elt->elt'), - find x (map f m) = option_map f (find x m). +Lemma map_o : forall m x (f:elt->elt'), + find x (map f m) = option_map f (find x m). Proof. intros. generalize (find_mapsto_iff (map f m) x) (find_mapsto_iff m x) @@ -463,14 +463,14 @@ rewrite H0 in H2; discriminate. rewrite <- H; rewrite H1; exists e; rewrite H0; auto. Qed. -Lemma map_b : forall m x (f:elt->elt'), +Lemma map_b : forall m x (f:elt->elt'), mem x (map f m) = mem x m. Proof. intros; do 2 rewrite mem_find_b; rewrite map_o. destruct (find x m); simpl; auto. Qed. -Lemma mapi_b : forall m x (f:key->elt->elt'), +Lemma mapi_b : forall m x (f:key->elt->elt'), mem x (mapi f m) = mem x m. Proof. intros. @@ -480,12 +480,12 @@ symmetry; rewrite <- H0; rewrite <- H1; rewrite H; auto. rewrite <- H; rewrite H1; rewrite H0; auto. Qed. -Lemma mapi_o : forall m x (f:key->elt->elt'), - (forall x y e, E.eq x y -> f x e = f y e) -> +Lemma mapi_o : forall m x (f:key->elt->elt'), + (forall x y e, E.eq x y -> f x e = f y e) -> find x (mapi f m) = option_map (f x) (find x m). Proof. intros. -generalize (find_mapsto_iff (mapi f m) x) (find_mapsto_iff m x) +generalize (find_mapsto_iff (mapi f m) x) (find_mapsto_iff m x) (fun b => mapi_mapsto_iff m x b H). destruct (find x (mapi f m)); destruct (find x m); simpl; auto; intros. rewrite <- H0; rewrite H2; exists e0; rewrite H1; auto. @@ -496,9 +496,9 @@ rewrite H1 in H3; discriminate. rewrite <- H0; rewrite H2; exists e; rewrite H1; auto. Qed. -Lemma map2_1bis : forall (m: t elt)(m': t elt') x - (f:option elt->option elt'->option elt''), - f None None = None -> +Lemma map2_1bis : forall (m: t elt)(m': t elt') x + (f:option elt->option elt'->option elt''), + f None None = None -> find x (map2 f m m') = f (find x m) (find x m'). Proof. intros. @@ -598,7 +598,7 @@ Section Cmp. Variable eq_elt : elt->elt->Prop. Variable cmp : elt->elt->bool. -Definition compat_cmp := +Definition compat_cmp := forall e e', cmp e e' = true <-> eq_elt e e'. Lemma Equiv_Equivb : compat_cmp -> @@ -613,17 +613,17 @@ End Cmp. (** Composition of the two last results: relation between [Equal] and [Equivb]. *) -Lemma Equal_Equivb : forall cmp, - (forall e e', cmp e e' = true <-> e = e') -> +Lemma Equal_Equivb : forall cmp, + (forall e e', cmp e e' = true <-> e = e') -> forall (m m':t elt), Equal m m' <-> Equivb cmp m m'. Proof. intros; rewrite Equal_Equiv. apply Equiv_Equivb; auto. Qed. -Lemma Equal_Equivb_eqdec : +Lemma Equal_Equivb_eqdec : forall eq_elt_dec : (forall e e', { e = e' } + { e <> e' }), - let cmp := fun e e' => if eq_elt_dec e e' then true else false in + let cmp := fun e e' => if eq_elt_dec e e' then true else false in forall (m m':t elt), Equal m m' <-> Equivb cmp m m'. Proof. intros; apply Equal_Equivb. @@ -638,11 +638,11 @@ End Equalities. Lemma Equal_refl : forall (elt:Type)(m : t elt), Equal m m. Proof. red; reflexivity. Qed. -Lemma Equal_sym : forall (elt:Type)(m m' : t elt), +Lemma Equal_sym : forall (elt:Type)(m m' : t elt), Equal m m' -> Equal m' m. Proof. unfold Equal; auto. Qed. -Lemma Equal_trans : forall (elt:Type)(m m' m'' : t elt), +Lemma Equal_trans : forall (elt:Type)(m m' m'' : t elt), Equal m m' -> Equal m' m'' -> Equal m m''. Proof. unfold Equal; congruence. Qed. @@ -651,15 +651,15 @@ Proof. constructor; red; [apply Equal_refl | apply Equal_sym | apply Equal_trans]. Qed. -Add Relation key E.eq - reflexivity proved by E.eq_refl +Add Relation key E.eq + reflexivity proved by E.eq_refl symmetry proved by E.eq_sym - transitivity proved by E.eq_trans + transitivity proved by E.eq_trans as KeySetoid. Implicit Arguments Equal [[elt]]. -Add Parametric Relation (elt : Type) : (t elt) Equal +Add Parametric Relation (elt : Type) : (t elt) Equal reflexivity proved by (@Equal_refl elt) symmetry proved by (@Equal_sym elt) transitivity proved by (@Equal_trans elt) @@ -762,7 +762,7 @@ Module WProperties_fun (E:DecidableType)(M:WSfun E). Notation eqke := (@eq_key_elt elt). Notation eqk := (@eq_key elt). - + (** Complements about InA, NoDupA and findA *) Lemma InA_eqke_eqk : forall k1 k2 e1 e2 l, @@ -1205,19 +1205,19 @@ Module WProperties_fun (E:DecidableType)(M:WSfun E). apply fold_Add with (eqA:=Leibniz); compute; auto. Qed. - Lemma cardinal_inv_1 : forall m : t elt, + Lemma cardinal_inv_1 : forall m : t elt, cardinal m = 0 -> Empty m. Proof. - intros; rewrite cardinal_Empty; auto. + intros; rewrite cardinal_Empty; auto. Qed. Hint Resolve cardinal_inv_1 : map. Lemma cardinal_inv_2 : forall m n, cardinal m = S n -> { p : key*elt | MapsTo (fst p) (snd p) m }. - Proof. + Proof. intros; rewrite M.cardinal_1 in *. generalize (elements_mapsto_iff m). - destruct (elements m); try discriminate. + destruct (elements m); try discriminate. exists p; auto. rewrite H0; destruct p; simpl; auto. constructor; red; auto. @@ -1243,16 +1243,16 @@ Module WProperties_fun (E:DecidableType)(M:WSfun E). (** * Emulation of some functions lacking in the interface *) - Definition filter (f : key -> elt -> bool)(m : t elt) := + Definition filter (f : key -> elt -> bool)(m : t elt) := fold (fun k e m => if f k e then add k e m else m) m (empty _). - Definition for_all (f : key -> elt -> bool)(m : t elt) := + Definition for_all (f : key -> elt -> bool)(m : t elt) := fold (fun k e b => if f k e then b else false) m true. - Definition exists_ (f : key -> elt -> bool)(m : t elt) := + Definition exists_ (f : key -> elt -> bool)(m : t elt) := fold (fun k e b => if f k e then true else b) m false. - Definition partition (f : key -> elt -> bool)(m : t elt) := + Definition partition (f : key -> elt -> bool)(m : t elt) := (filter f m, filter (fun k e => negb (f k e)) m). (** [update] adds to [m1] all the bindings of [m2]. It can be seen as @@ -1762,7 +1762,7 @@ Module OrdProperties (M:S). Import F. Import M. - Section Elt. + Section Elt. Variable elt:Type. Notation eqke := (@eqke elt). @@ -1780,7 +1780,7 @@ Module OrdProperties (M:S). Lemma sort_equivlistA_eqlistA : forall l l' : list (key*elt), sort ltk l -> sort ltk l' -> equivlistA eqke l l' -> eqlistA eqke l l'. Proof. - apply SortA_equivlistA_eqlistA; eauto; + apply SortA_equivlistA_eqlistA; eauto; unfold O.eqke, O.ltk; simpl; intuition; eauto. Qed. @@ -1788,7 +1788,7 @@ Module OrdProperties (M:S). Definition gtb (p p':key*elt) := match E.compare (fst p) (fst p') with GT _ => true | _ => false end. - Definition leb p := fun p' => negb (gtb p p'). + Definition leb p := fun p' => negb (gtb p p'). Definition elements_lt p m := List.filter (gtb p) (elements m). Definition elements_ge p m := List.filter (leb p) (elements m). @@ -1808,7 +1808,7 @@ Module OrdProperties (M:S). Lemma gtb_compat : forall p, compat_bool eqke (gtb p). Proof. red; intros (x,e) (a,e') (b,e'') H; red in H; simpl in *; destruct H. - generalize (gtb_1 (x,e) (a,e'))(gtb_1 (x,e) (b,e'')); + generalize (gtb_1 (x,e) (a,e'))(gtb_1 (x,e) (b,e'')); destruct (gtb (x,e) (a,e')); destruct (gtb (x,e) (b,e'')); auto. unfold O.ltk in *; simpl in *; intros. symmetry; rewrite H2. @@ -1828,7 +1828,7 @@ Module OrdProperties (M:S). Hint Resolve gtb_compat leb_compat elements_3 : map. - Lemma elements_split : forall p m, + Lemma elements_split : forall p m, elements m = elements_lt p m ++ elements_ge p m. Proof. unfold elements_lt, elements_ge, leb; intros. @@ -1841,8 +1841,8 @@ Module OrdProperties (M:S). unfold O.ltk in *; simpl in *; ME.order. Qed. - Lemma elements_Add : forall m m' x e, ~In x m -> Add x e m m' -> - eqlistA eqke (elements m') + Lemma elements_Add : forall m m' x e, ~In x m -> Add x e m m' -> + eqlistA eqke (elements m') (elements_lt (x,e) m ++ (x,e):: elements_ge (x,e) m). Proof. intros; unfold elements_lt, elements_ge. @@ -1890,8 +1890,8 @@ Module OrdProperties (M:S). right; split; auto; ME.order. Qed. - Lemma elements_Add_Above : forall m m' x e, - Above x m -> Add x e m m' -> + Lemma elements_Add_Above : forall m m' x e, + Above x m -> Add x e m m' -> eqlistA eqke (elements m') (elements m ++ (x,e)::nil). Proof. intros. @@ -1919,8 +1919,8 @@ Module OrdProperties (M:S). ME.order. Qed. - Lemma elements_Add_Below : forall m m' x e, - Below x m -> Add x e m m' -> + Lemma elements_Add_Below : forall m m' x e, + Below x m -> Add x e m m' -> eqlistA eqke (elements m') ((x,e)::elements m). Proof. intros. @@ -1949,7 +1949,7 @@ Module OrdProperties (M:S). ME.order. Qed. - Lemma elements_Equal_eqlistA : forall (m m': t elt), + Lemma elements_Equal_eqlistA : forall (m m': t elt), Equal m m' -> eqlistA eqke (elements m) (elements m'). Proof. intros. @@ -1964,15 +1964,15 @@ Module OrdProperties (M:S). Section Min_Max_Elt. (** We emulate two [max_elt] and [min_elt] functions. *) - - Fixpoint max_elt_aux (l:list (key*elt)) := match l with - | nil => None + + Fixpoint max_elt_aux (l:list (key*elt)) := match l with + | nil => None | (x,e)::nil => Some (x,e) | (x,e)::l => max_elt_aux l end. Definition max_elt m := max_elt_aux (elements m). - Lemma max_elt_Above : + Lemma max_elt_Above : forall m x e, max_elt m = Some (x,e) -> Above x (remove x m). Proof. red; intros. @@ -2011,8 +2011,8 @@ Module OrdProperties (M:S). red; eauto. inversion H2; auto. Qed. - - Lemma max_elt_MapsTo : + + Lemma max_elt_MapsTo : forall m x e, max_elt m = Some (x,e) -> MapsTo x e m. Proof. intros. @@ -2025,7 +2025,7 @@ Module OrdProperties (M:S). constructor 2; auto. Qed. - Lemma max_elt_Empty : + Lemma max_elt_Empty : forall m, max_elt m = None -> Empty m. Proof. intros. @@ -2036,12 +2036,12 @@ Module OrdProperties (M:S). assert (H':=IHl H); discriminate. Qed. - Definition min_elt m : option (key*elt) := match elements m with + Definition min_elt m : option (key*elt) := match elements m with | nil => None | (x,e)::_ => Some (x,e) end. - Lemma min_elt_Below : + Lemma min_elt_Below : forall m x e, min_elt m = Some (x,e) -> Below x (remove x m). Proof. unfold min_elt, Below; intros. @@ -2061,8 +2061,8 @@ Module OrdProperties (M:S). intros (x1,x2) (y1,y2) (z1,z2); compute; intuition; eauto. intros (x1,x2) (y1,y2) (z1,z2); compute; intuition; eauto. Qed. - - Lemma min_elt_MapsTo : + + Lemma min_elt_MapsTo : forall m x e, min_elt m = Some (x,e) -> MapsTo x e m. Proof. intros. @@ -2074,7 +2074,7 @@ Module OrdProperties (M:S). injection H; intros; subst; constructor; red; auto. Qed. - Lemma min_elt_Empty : + Lemma min_elt_Empty : forall m, min_elt m = None -> Empty m. Proof. intros. @@ -2109,7 +2109,7 @@ Module OrdProperties (M:S). assert (S n = S (cardinal (remove k m))). rewrite Heqn. eapply cardinal_2; eauto with map. - inversion H1; auto. + inversion H1; auto. eapply max_elt_Above; eauto. apply X; apply max_elt_Empty; auto. @@ -2136,7 +2136,7 @@ Module OrdProperties (M:S). assert (S n = S (cardinal (remove k m))). rewrite Heqn. eapply cardinal_2; eauto with map. - inversion H1; auto. + inversion H1; auto. eapply min_elt_Below; eauto. apply X; apply min_elt_Empty; auto. diff --git a/theories/FSets/FMapFullAVL.v b/theories/FSets/FMapFullAVL.v index 3ebb0c1af..52766bf96 100644 --- a/theories/FSets/FMapFullAVL.v +++ b/theories/FSets/FMapFullAVL.v @@ -12,18 +12,18 @@ (* $Id$ *) (** * FMapFullAVL - + This file contains some complements to [FMapAVL]. - - Functor [AvlProofs] proves that trees of [FMapAVL] are not only + - Functor [AvlProofs] proves that trees of [FMapAVL] are not only binary search trees, but moreover well-balanced ones. This is done by proving that all operations preserve the balancing. - - - We then pack the previous elements in a [IntMake] functor + + - We then pack the previous elements in a [IntMake] functor similar to the one of [FMapAVL], but richer. - - In final [IntMake_ord] functor, the [compare] function is - different from the one in [FMapAVL]: this non-structural + - In final [IntMake_ord] functor, the [compare] function is + different from the one in [FMapAVL]: this non-structural version is closer to the original Ocaml code. *) @@ -54,11 +54,11 @@ Implicit Types m r : t elt. Inductive avl : t elt -> Prop := | RBLeaf : avl (Leaf _) - | RBNode : forall x e l r h, + | RBNode : forall x e l r h, avl l -> avl r -> -(2) <= height l - height r <= 2 -> - h = max (height l) (height r) + 1 -> + h = max (height l) (height r) + 1 -> avl (Node l x e r h). @@ -66,28 +66,28 @@ Inductive avl : t elt -> Prop := Hint Constructors avl. -Lemma height_non_negative : forall (s : t elt), avl s -> +Lemma height_non_negative : forall (s : t elt), avl s -> height s >= 0. Proof. induction s; simpl; intros; auto with zarith. inv avl; intuition; omega_max. Qed. -Ltac avl_nn_hyp H := +Ltac avl_nn_hyp H := let nz := fresh "nz" in assert (nz := height_non_negative H). -Ltac avl_nn h := - let t := type of h in - match type of t with +Ltac avl_nn h := + let t := type of h in + match type of t with | Prop => avl_nn_hyp h | _ => match goal with H : avl h |- _ => avl_nn_hyp H end end. -(* Repeat the previous tactic. +(* Repeat the previous tactic. Drawback: need to clear the [avl _] hyps ... Thank you Ltac *) Ltac avl_nns := - match goal with + match goal with | H:avl _ |- _ => avl_nn_hyp H; clear H; avl_nns | _ => idtac end. @@ -105,7 +105,7 @@ Hint Resolve avl_node. (** Results about [height] *) -Lemma height_0 : forall l, avl l -> height l = 0 -> +Lemma height_0 : forall l, avl l -> height l = 0 -> l = Leaf _. Proof. destruct 1; intuition; simpl in *. @@ -116,38 +116,38 @@ Qed. (** * Empty map *) Lemma empty_avl : avl (empty elt). -Proof. +Proof. unfold empty; auto. Qed. (** * Helper functions *) -Lemma create_avl : - forall l x e r, avl l -> avl r -> -(2) <= height l - height r <= 2 -> +Lemma create_avl : + forall l x e r, avl l -> avl r -> -(2) <= height l - height r <= 2 -> avl (create l x e r). Proof. unfold create; auto. Qed. -Lemma create_height : - forall l x e r, avl l -> avl r -> -(2) <= height l - height r <= 2 -> +Lemma create_height : + forall l x e r, avl l -> avl r -> -(2) <= height l - height r <= 2 -> height (create l x e r) = max (height l) (height r) + 1. Proof. unfold create; intros; auto. Qed. -Lemma bal_avl : forall l x e r, avl l -> avl r -> +Lemma bal_avl : forall l x e r, avl l -> avl r -> -(3) <= height l - height r <= 3 -> avl (bal l x e r). Proof. intros l x e r; functional induction (bal l x e r); intros; clearf; - inv avl; simpl in *; + inv avl; simpl in *; match goal with |- avl (assert_false _ _ _ _) => avl_nns | _ => repeat apply create_avl; simpl in *; auto end; omega_max. Qed. -Lemma bal_height_1 : forall l x e r, avl l -> avl r -> +Lemma bal_height_1 : forall l x e r, avl l -> avl r -> -(3) <= height l - height r <= 3 -> 0 <= height (bal l x e r) - max (height l) (height r) <= 1. Proof. @@ -155,25 +155,25 @@ Proof. inv avl; avl_nns; simpl in *; omega_max. Qed. -Lemma bal_height_2 : - forall l x e r, avl l -> avl r -> -(2) <= height l - height r <= 2 -> +Lemma bal_height_2 : + forall l x e r, avl l -> avl r -> -(2) <= height l - height r <= 2 -> height (bal l x e r) == max (height l) (height r) +1. Proof. intros l x e r; functional induction (bal l x e r); intros; clearf; inv avl; avl_nns; simpl in *; omega_max. Qed. -Ltac omega_bal := match goal with - | H:avl ?l, H':avl ?r |- context [ bal ?l ?x ?e ?r ] => - generalize (bal_height_1 x e H H') (bal_height_2 x e H H'); +Ltac omega_bal := match goal with + | H:avl ?l, H':avl ?r |- context [ bal ?l ?x ?e ?r ] => + generalize (bal_height_1 x e H H') (bal_height_2 x e H H'); omega_max end. (** * Insertion *) -Lemma add_avl_1 : forall m x e, avl m -> +Lemma add_avl_1 : forall m x e, avl m -> avl (add x e m) /\ 0 <= height (add x e m) - height m <= 1. -Proof. +Proof. intros m x e; functional induction (add x e m); intros; inv avl; simpl in *. intuition; try constructor; simpl; auto; try omega_max. (* LT *) @@ -198,8 +198,8 @@ Hint Resolve add_avl. (** * Extraction of minimum binding *) -Lemma remove_min_avl_1 : forall l x e r h, avl (Node l x e r h) -> - avl (remove_min l x e r)#1 /\ +Lemma remove_min_avl_1 : forall l x e r h, avl (Node l x e r h) -> + avl (remove_min l x e r)#1 /\ 0 <= height (Node l x e r h) - height (remove_min l x e r)#1 <= 1. Proof. intros l x e r; functional induction (remove_min l x e r); simpl in *; intros. @@ -212,20 +212,20 @@ Proof. omega_bal. Qed. -Lemma remove_min_avl : forall l x e r h, avl (Node l x e r h) -> - avl (remove_min l x e r)#1. +Lemma remove_min_avl : forall l x e r h, avl (Node l x e r h) -> + avl (remove_min l x e r)#1. Proof. intros; generalize (remove_min_avl_1 H); intuition. Qed. (** * Merging two trees *) -Lemma merge_avl_1 : forall m1 m2, avl m1 -> avl m2 -> - -(2) <= height m1 - height m2 <= 2 -> - avl (merge m1 m2) /\ +Lemma merge_avl_1 : forall m1 m2, avl m1 -> avl m2 -> + -(2) <= height m1 - height m2 <= 2 -> + avl (merge m1 m2) /\ 0<= height (merge m1 m2) - max (height m1) (height m2) <=1. Proof. - intros m1 m2; functional induction (merge m1 m2); intros; + intros m1 m2; functional induction (merge m1 m2); intros; try factornode _x _x0 _x1 _x2 _x3 as m1. simpl; split; auto; avl_nns; omega_max. simpl; split; auto; avl_nns; omega_max. @@ -237,16 +237,16 @@ Proof. omega_bal. Qed. -Lemma merge_avl : forall m1 m2, avl m1 -> avl m2 -> +Lemma merge_avl : forall m1 m2, avl m1 -> avl m2 -> -(2) <= height m1 - height m2 <= 2 -> avl (merge m1 m2). -Proof. +Proof. intros; generalize (merge_avl_1 H H0 H1); intuition. Qed. (** * Deletion *) -Lemma remove_avl_1 : forall m x, avl m -> +Lemma remove_avl_1 : forall m x, avl m -> avl (remove x m) /\ 0 <= height m - height (remove x m) <= 1. Proof. intros m x; functional induction (remove x m); intros. @@ -254,25 +254,25 @@ Proof. (* LT *) inv avl. destruct (IHt H0). - split. + split. apply bal_avl; auto. omega_max. omega_bal. (* EQ *) - inv avl. + inv avl. generalize (merge_avl_1 H0 H1 H2). intuition omega_max. (* GT *) inv avl. destruct (IHt H1). - split. + split. apply bal_avl; auto. omega_max. omega_bal. Qed. Lemma remove_avl : forall m x, avl m -> avl (remove x m). -Proof. +Proof. intros; generalize (remove_avl_1 x H); intuition. Qed. Hint Resolve remove_avl. @@ -280,7 +280,7 @@ Hint Resolve remove_avl. (** * Join *) -Lemma join_avl_1 : forall l x d r, avl l -> avl r -> +Lemma join_avl_1 : forall l x d r, avl l -> avl r -> avl (join l x d r) /\ 0<= height (join l x d r) - max (height l) (height r) <= 1. Proof. @@ -346,9 +346,9 @@ Hint Resolve concat_avl. (** split *) -Lemma split_avl : forall m x, avl m -> +Lemma split_avl : forall m x, avl m -> avl (split x m)#l /\ avl (split x m)#r. -Proof. +Proof. intros m x; functional induction (split x m); simpl; auto. rewrite e1 in IHt;simpl in IHt;inversion_clear 1; intuition. simpl; inversion_clear 1; auto. @@ -358,12 +358,12 @@ Qed. End Elt. Hint Constructors avl. -Section Map. +Section Map. Variable elt elt' : Type. -Variable f : elt -> elt'. +Variable f : elt -> elt'. Lemma map_height : forall m, height (map f m) = height m. -Proof. +Proof. destruct m; simpl; auto. Qed. @@ -377,10 +377,10 @@ End Map. Section Mapi. Variable elt elt' : Type. -Variable f : key -> elt -> elt'. +Variable f : key -> elt -> elt'. Lemma mapi_height : forall m, height (mapi f m) = height m. -Proof. +Proof. destruct m; simpl; auto. Qed. @@ -392,7 +392,7 @@ Qed. End Mapi. -Section Map_option. +Section Map_option. Variable elt elt' : Type. Variable f : key -> elt -> option elt'. @@ -414,12 +414,12 @@ Hypothesis mapr_avl : forall m', avl m' -> avl (mapr m'). Notation map2_opt := (map2_opt f mapl mapr). -Lemma map2_opt_avl : forall m1 m2, avl m1 -> avl m2 -> +Lemma map2_opt_avl : forall m1 m2, avl m1 -> avl m2 -> avl (map2_opt m1 m2). Proof. -intros m1 m2; functional induction (map2_opt m1 m2); auto; -factornode _x0 _x1 _x2 _x3 _x4 as r2; intros; -destruct (split_avl x1 H0); rewrite e1 in *; simpl in *; inv avl; +intros m1 m2; functional induction (map2_opt m1 m2); auto; +factornode _x0 _x1 _x2 _x3 _x4 as r2; intros; +destruct (split_avl x1 H0); rewrite e1 in *; simpl in *; inv avl; auto using join_avl, concat_avl. Qed. @@ -439,11 +439,11 @@ End AvlProofs. (** * Encapsulation - We can implement [S] with balanced binary search trees. + We can implement [S] with balanced binary search trees. When compared to [FMapAVL], we maintain here two invariants (bst and avl) instead of only bst, which is enough for fulfilling the FMap interface. -*) +*) Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. @@ -452,32 +452,32 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Import Raw. Import Raw.Proofs. - Record bbst (elt:Type) := + Record bbst (elt:Type) := Bbst {this :> tree elt; is_bst : bst this; is_avl: avl this}. - + Definition t := bbst. Definition key := E.t. - + Section Elt. Variable elt elt' elt'': Type. Implicit Types m : t elt. - Implicit Types x y : key. - Implicit Types e : elt. + Implicit Types x y : key. + Implicit Types e : elt. Definition empty : t elt := Bbst (empty_bst elt) (empty_avl elt). Definition is_empty m : bool := is_empty m.(this). - Definition add x e m : t elt := + Definition add x e m : t elt := Bbst (add_bst x e m.(is_bst)) (add_avl x e m.(is_avl)). - Definition remove x m : t elt := + Definition remove x m : t elt := Bbst (remove_bst x m.(is_bst)) (remove_avl x m.(is_avl)). Definition mem x m : bool := mem x m.(this). Definition find x m : option elt := find x m.(this). - Definition map f m : t elt' := + Definition map f m : t elt' := Bbst (map_bst f m.(is_bst)) (map_avl f m.(is_avl)). - Definition mapi (f:key->elt->elt') m : t elt' := + Definition mapi (f:key->elt->elt') m : t elt' := Bbst (mapi_bst f m.(is_bst)) (mapi_avl f m.(is_avl)). - Definition map2 f m (m':t elt') : t elt'' := + Definition map2 f m (m':t elt') : t elt'' := Bbst (map2_bst f m.(is_bst) m'.(is_bst)) (map2_avl f m.(is_avl) m'.(is_avl)). Definition elements m : list (key*elt) := elements m.(this). Definition cardinal m := cardinal m.(this). @@ -494,14 +494,14 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Lemma MapsTo_1 : forall m x y e, E.eq x y -> MapsTo x e m -> MapsTo y e m. Proof. intros m; exact (@MapsTo_1 _ m.(this)). Qed. - + Lemma mem_1 : forall m x, In x m -> mem x m = true. Proof. unfold In, mem; intros m x; rewrite In_alt; simpl; apply mem_1; auto. apply m.(is_bst). Qed. - - Lemma mem_2 : forall m x, mem x m = true -> In x m. + + Lemma mem_2 : forall m x, mem x m = true -> In x m. Proof. unfold In, mem; intros m x; rewrite In_alt; simpl; apply mem_2; auto. Qed. @@ -532,7 +532,7 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Proof. intros m x y e; exact (@remove_3 elt _ x y e m.(is_bst)). Qed. - Lemma find_1 : forall m x e, MapsTo x e m -> find x m = Some e. + Lemma find_1 : forall m x e, MapsTo x e m -> find x m = Some e. Proof. intros m x e; exact (@find_1 elt _ x e m.(is_bst)). Qed. Lemma find_2 : forall m x e, find x m = Some e -> MapsTo x e m. Proof. intros m; exact (@find_2 elt m.(this)). Qed. @@ -541,36 +541,36 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i. Proof. intros m; exact (@fold_1 elt m.(this) m.(is_bst)). Qed. - Lemma elements_1 : forall m x e, + Lemma elements_1 : forall m x e, MapsTo x e m -> InA eq_key_elt (x,e) (elements m). Proof. intros; unfold elements, MapsTo, eq_key_elt; rewrite elements_mapsto; auto. Qed. - Lemma elements_2 : forall m x e, + Lemma elements_2 : forall m x e, InA eq_key_elt (x,e) (elements m) -> MapsTo x e m. Proof. intros; unfold elements, MapsTo, eq_key_elt; rewrite <- elements_mapsto; auto. Qed. - Lemma elements_3 : forall m, sort lt_key (elements m). + Lemma elements_3 : forall m, sort lt_key (elements m). Proof. intros m; exact (@elements_sort elt m.(this) m.(is_bst)). Qed. - Lemma elements_3w : forall m, NoDupA eq_key (elements m). + Lemma elements_3w : forall m, NoDupA eq_key (elements m). Proof. intros m; exact (@elements_nodup elt m.(this) m.(is_bst)). Qed. Lemma cardinal_1 : forall m, cardinal m = length (elements m). Proof. intro m; exact (@elements_cardinal elt m.(this)). Qed. Definition Equal m m' := forall y, find y m = find y m'. - Definition Equiv (eq_elt:elt->elt->Prop) m m' := - (forall k, In k m <-> In k m') /\ + Definition Equiv (eq_elt:elt->elt->Prop) m m' := + (forall k, In k m <-> In k m') /\ (forall k e e', MapsTo k e m -> MapsTo k e' m' -> eq_elt e e'). Definition Equivb cmp := Equiv (Cmp cmp). - Lemma Equivb_Equivb : forall cmp m m', + Lemma Equivb_Equivb : forall cmp m m', Equivb cmp m m' <-> Raw.Proofs.Equivb cmp m m'. - Proof. + Proof. intros; unfold Equivb, Equiv, Raw.Proofs.Equivb, In; intuition. generalize (H0 k); do 2 rewrite In_alt; intuition. generalize (H0 k); do 2 rewrite In_alt; intuition. @@ -578,23 +578,23 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. generalize (H0 k); do 2 rewrite <- In_alt; intuition. Qed. - Lemma equal_1 : forall m m' cmp, - Equivb cmp m m' -> equal cmp m m' = true. - Proof. - unfold equal; intros (m,b,a) (m',b',a') cmp; rewrite Equivb_Equivb; + Lemma equal_1 : forall m m' cmp, + Equivb cmp m m' -> equal cmp m m' = true. + Proof. + unfold equal; intros (m,b,a) (m',b',a') cmp; rewrite Equivb_Equivb; intros; simpl in *; rewrite equal_Equivb; auto. - Qed. + Qed. - Lemma equal_2 : forall m m' cmp, + Lemma equal_2 : forall m m' cmp, equal cmp m m' = true -> Equivb cmp m m'. - Proof. - unfold equal; intros (m,b,a) (m',b',a') cmp; rewrite Equivb_Equivb; + Proof. + unfold equal; intros (m,b,a) (m',b',a') cmp; rewrite Equivb_Equivb; intros; simpl in *; rewrite <-equal_Equivb; auto. Qed. End Elt. - Lemma map_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt)(f:elt->elt'), + Lemma map_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt)(f:elt->elt'), MapsTo x e m -> MapsTo x (f e) (map f m). Proof. intros elt elt' m x e f; exact (@map_1 elt elt' f m.(this) x e). Qed. @@ -602,10 +602,10 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Proof. intros elt elt' m x f; do 2 unfold In in *; do 2 rewrite In_alt; simpl. apply map_2; auto. - Qed. + Qed. Lemma mapi_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt) - (f:key->elt->elt'), MapsTo x e m -> + (f:key->elt->elt'), MapsTo x e m -> exists y, E.eq y x /\ MapsTo x (f y e) (mapi f m). Proof. intros elt elt' m x e f; exact (@mapi_1 elt elt' f m.(this) x e). Qed. Lemma mapi_2 : forall (elt elt':Type)(m: t elt)(x:key) @@ -615,10 +615,10 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Qed. Lemma map2_1 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt') - (x:key)(f:option elt->option elt'->option elt''), - In x m \/ In x m' -> - find x (map2 f m m') = f (find x m) (find x m'). - Proof. + (x:key)(f:option elt->option elt'->option elt''), + In x m \/ In x m' -> + find x (map2 f m m') = f (find x m) (find x m'). + Proof. unfold find, map2, In; intros elt elt' elt'' m m' x f. do 2 rewrite In_alt; intros; simpl; apply map2_1; auto. apply m.(is_bst). @@ -626,9 +626,9 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Qed. Lemma map2_2 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt') - (x:key)(f:option elt->option elt'->option elt''), + (x:key)(f:option elt->option elt'->option elt''), In x (map2 f m m') -> In x m \/ In x m'. - Proof. + Proof. unfold In, map2; intros elt elt' elt'' m m' x f. do 3 rewrite In_alt; intros; simpl in *; eapply map2_2; eauto. apply m.(is_bst). @@ -638,54 +638,54 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. End IntMake. -Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <: - Sord with Module Data := D +Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <: + Sord with Module Data := D with Module MapS.E := X. Module Data := D. - Module Import MapS := IntMake(I)(X). + Module Import MapS := IntMake(I)(X). Import AvlProofs. Import Raw.Proofs. Module Import MD := OrderedTypeFacts(D). Module LO := FMapList.Make_ord(X)(D). - Definition t := MapS.t D.t. + Definition t := MapS.t D.t. - Definition cmp e e' := + Definition cmp e e' := match D.compare e e' with EQ _ => true | _ => false end. - Definition elements (m:t) := + Definition elements (m:t) := LO.MapS.Build_slist (Raw.Proofs.elements_sort m.(is_bst)). - (** * As comparison function, we propose here a non-structural - version faithful to the code of Ocaml's Map library, instead of + (** * As comparison function, we propose here a non-structural + version faithful to the code of Ocaml's Map library, instead of the structural version of FMapAVL *) - Fixpoint cardinal_e (e:Raw.enumeration D.t) := - match e with + Fixpoint cardinal_e (e:Raw.enumeration D.t) := + match e with | Raw.End => 0%nat | Raw.More _ _ r e => S (Raw.cardinal r + cardinal_e e) end. - Lemma cons_cardinal_e : forall m e, + Lemma cons_cardinal_e : forall m e, cardinal_e (Raw.cons m e) = (Raw.cardinal m + cardinal_e e)%nat. Proof. induction m; simpl; intros; auto. rewrite IHm1; simpl; rewrite <- plus_n_Sm; auto with arith. Qed. - Definition cardinal_e_2 ee := + Definition cardinal_e_2 ee := (cardinal_e (fst ee) + cardinal_e (snd ee))%nat. - Function compare_aux (ee:Raw.enumeration D.t * Raw.enumeration D.t) - { measure cardinal_e_2 ee } : comparison := - match ee with + Function compare_aux (ee:Raw.enumeration D.t * Raw.enumeration D.t) + { measure cardinal_e_2 ee } : comparison := + match ee with | (Raw.End, Raw.End) => Eq | (Raw.End, Raw.More _ _ _ _) => Lt | (Raw.More _ _ _ _, Raw.End) => Gt | (Raw.More x1 d1 r1 e1, Raw.More x2 d2 r2 e2) => match X.compare x1 x2 with - | EQ _ => match D.compare d1 d2 with + | EQ _ => match D.compare d1 d2 with | EQ _ => compare_aux (Raw.cons r1 e1, Raw.cons r2 e2) | LT _ => Lt | GT _ => Gt @@ -695,10 +695,10 @@ Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <: end end. Proof. - intros; unfold cardinal_e_2; simpl; + intros; unfold cardinal_e_2; simpl; abstract (do 2 rewrite cons_cardinal_e; romega with * ). Defined. - + Definition Cmp c := match c with | Eq => LO.eq_list @@ -706,7 +706,7 @@ Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <: | Gt => (fun l1 l2 => LO.lt_list l2 l1) end. - Lemma cons_Cmp : forall c x1 x2 d1 d2 l1 l2, + Lemma cons_Cmp : forall c x1 x2 d1 d2 l1 l2, X.eq x1 x2 -> D.eq d1 d2 -> Cmp c l1 l2 -> Cmp c ((x1,d1)::l1) ((x2,d2)::l2). Proof. @@ -714,23 +714,23 @@ Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <: Qed. Hint Resolve cons_Cmp. - Lemma compare_aux_Cmp : forall e, + Lemma compare_aux_Cmp : forall e, Cmp (compare_aux e) (flatten_e (fst e)) (flatten_e (snd e)). Proof. - intros e; functional induction (compare_aux e); simpl in *; + intros e; functional induction (compare_aux e); simpl in *; auto; intros; try clear e0; try clear e3; try MX.elim_comp; auto. rewrite 2 cons_1 in IHc; auto. Qed. - Lemma compare_Cmp : forall m1 m2, - Cmp (compare_aux (Raw.cons m1 (Raw.End _), Raw.cons m2 (Raw.End _))) + Lemma compare_Cmp : forall m1 m2, + Cmp (compare_aux (Raw.cons m1 (Raw.End _), Raw.cons m2 (Raw.End _))) (Raw.elements m1) (Raw.elements m2). Proof. - intros. + intros. assert (H1:=cons_1 m1 (Raw.End _)). assert (H2:=cons_1 m2 (Raw.End _)). simpl in *; rewrite <- app_nil_end in *; rewrite <-H1,<-H2. - apply (@compare_aux_Cmp (Raw.cons m1 (Raw.End _), + apply (@compare_aux_Cmp (Raw.cons m1 (Raw.End _), Raw.cons m2 (Raw.End _))). Qed. @@ -744,10 +744,10 @@ Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <: destruct compare_aux; intros; [apply EQ|apply LT|apply GT]; red; auto. Defined. - + (* Proofs about [eq] and [lt] *) - Definition selements (m1 : t) := + Definition selements (m1 : t) := LO.MapS.Build_slist (elements_sort m1.(is_bst)). Definition seq (m1 m2 : t) := LO.eq (selements m1) (selements m2). @@ -784,7 +784,7 @@ Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <: Qed. Lemma eq_refl : forall m : t, eq m m. - Proof. + Proof. intros; rewrite eq_seq; unfold seq; intros; apply LO.eq_refl. Qed. @@ -801,13 +801,13 @@ Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <: Lemma lt_trans : forall m1 m2 m3 : t, lt m1 m2 -> lt m2 m3 -> lt m1 m3. Proof. - intros m1 m2 m3; rewrite 3 lt_slt; unfold slt; + intros m1 m2 m3; rewrite 3 lt_slt; unfold slt; intros; eapply LO.lt_trans; eauto. Qed. Lemma lt_not_eq : forall m1 m2 : t, lt m1 m2 -> ~ eq m1 m2. Proof. - intros m1 m2; rewrite lt_slt, eq_seq; unfold slt, seq; + intros m1 m2; rewrite lt_slt, eq_seq; unfold slt, seq; intros; apply LO.lt_not_eq; auto. Qed. @@ -818,8 +818,8 @@ End IntMake_ord. Module Make (X: OrderedType) <: S with Module E := X :=IntMake(Z_as_Int)(X). -Module Make_ord (X: OrderedType)(D: OrderedType) - <: Sord with Module Data := D +Module Make_ord (X: OrderedType)(D: OrderedType) + <: Sord with Module Data := D with Module MapS.E := X :=IntMake_ord(Z_as_Int)(X)(D). diff --git a/theories/FSets/FMapInterface.v b/theories/FSets/FMapInterface.v index ebc99933b..cd51b2aff 100644 --- a/theories/FSets/FMapInterface.v +++ b/theories/FSets/FMapInterface.v @@ -8,7 +8,7 @@ (* $Id$ *) -(** * Finite map library *) +(** * Finite map library *) (** This file proposes interfaces for finite maps *) @@ -16,8 +16,8 @@ Require Export Bool DecidableType OrderedType. Set Implicit Arguments. Unset Strict Implicit. -(** When compared with Ocaml Map, this signature has been split in - several parts : +(** When compared with Ocaml Map, this signature has been split in + several parts : - The first parts [WSfun] and [WS] propose signatures for weak maps, which are maps with no ordering on the key type nor the @@ -29,18 +29,18 @@ Unset Strict Implicit. (add, find, ...). The only function that asks for more is [equal], whose first argument should be a comparison on data. - - Then comes [Sfun] and [S], that extend [WSfun] and [WS] to the - case where the key type is ordered. The main novelty is that + - Then comes [Sfun] and [S], that extend [WSfun] and [WS] to the + case where the key type is ordered. The main novelty is that [elements] is required to produce sorted lists. - - Finally, [Sord] extends [S] with a complete comparison function. For - that, the data type should have a decidable total ordering as well. + - Finally, [Sord] extends [S] with a complete comparison function. For + that, the data type should have a decidable total ordering as well. If unsure, what you're looking for is probably [S]: apart from [Sord], - all other signatures are subsets of [S]. + all other signatures are subsets of [S]. + + Some additional differences with Ocaml: - Some additional differences with Ocaml: - - no [iter] function, useless since Coq is purely functional - [option] types are used instead of [Not_found] exceptions - more functions are provided: [elements] and [cardinal] and [map2] @@ -51,7 +51,7 @@ Unset Strict Implicit. Definition Cmp (elt:Type)(cmp:elt->elt->bool) e1 e2 := cmp e1 e2 = true. (** ** Weak signature for maps - + No requirements for an ordering on keys nor elements, only decidability of equality on keys. First, a functorial signature: *) @@ -61,8 +61,8 @@ Module Type WSfun (E : DecidableType). Parameter t : Type -> Type. (** the abstract type of maps *) - - Section Types. + + Section Types. Variable elt:Type. @@ -73,61 +73,61 @@ Module Type WSfun (E : DecidableType). (** Test whether a map is empty or not. *) Parameter add : key -> elt -> t elt -> t elt. - (** [add x y m] returns a map containing the same bindings as [m], - plus a binding of [x] to [y]. If [x] was already bound in [m], + (** [add x y m] returns a map containing the same bindings as [m], + plus a binding of [x] to [y]. If [x] was already bound in [m], its previous binding disappears. *) - Parameter find : key -> t elt -> option elt. - (** [find x m] returns the current binding of [x] in [m], + Parameter find : key -> t elt -> option elt. + (** [find x m] returns the current binding of [x] in [m], or [None] if no such binding exists. *) Parameter remove : key -> t elt -> t elt. - (** [remove x m] returns a map containing the same bindings as [m], + (** [remove x m] returns a map containing the same bindings as [m], except for [x] which is unbound in the returned map. *) Parameter mem : key -> t elt -> bool. - (** [mem x m] returns [true] if [m] contains a binding for [x], + (** [mem x m] returns [true] if [m] contains a binding for [x], and [false] otherwise. *) Variable elt' elt'' : Type. Parameter map : (elt -> elt') -> t elt -> t elt'. - (** [map f m] returns a map with same domain as [m], where the associated + (** [map f m] returns a map with same domain as [m], where the associated value a of all bindings of [m] has been replaced by the result of the application of [f] to [a]. Since Coq is purely functional, the order in which the bindings are passed to [f] is irrelevant. *) Parameter mapi : (key -> elt -> elt') -> t elt -> t elt'. - (** Same as [map], but the function receives as arguments both the + (** Same as [map], but the function receives as arguments both the key and the associated value for each binding of the map. *) - Parameter map2 : + Parameter map2 : (option elt -> option elt' -> option elt'') -> t elt -> t elt' -> t elt''. - (** [map2 f m m'] creates a new map whose bindings belong to the ones - of either [m] or [m']. The presence and value for a key [k] is - determined by [f e e'] where [e] and [e'] are the (optional) bindings + (** [map2 f m m'] creates a new map whose bindings belong to the ones + of either [m] or [m']. The presence and value for a key [k] is + determined by [f e e'] where [e] and [e'] are the (optional) bindings of [k] in [m] and [m']. *) Parameter elements : t elt -> list (key*elt). - (** [elements m] returns an assoc list corresponding to the bindings + (** [elements m] returns an assoc list corresponding to the bindings of [m], in any order. *) - Parameter cardinal : t elt -> nat. + Parameter cardinal : t elt -> nat. (** [cardinal m] returns the number of bindings in [m]. *) Parameter fold : forall A: Type, (key -> elt -> A -> A) -> t elt -> A -> A. - (** [fold f m a] computes [(f kN dN ... (f k1 d1 a)...)], - where [k1] ... [kN] are the keys of all bindings in [m] + (** [fold f m a] computes [(f kN dN ... (f k1 d1 a)...)], + where [k1] ... [kN] are the keys of all bindings in [m] (in any order), and [d1] ... [dN] are the associated data. *) Parameter equal : (elt -> elt -> bool) -> t elt -> t elt -> bool. - (** [equal cmp m1 m2] tests whether the maps [m1] and [m2] are equal, - that is, contain equal keys and associate them with equal data. - [cmp] is the equality predicate used to compare the data associated + (** [equal cmp m1 m2] tests whether the maps [m1] and [m2] are equal, + that is, contain equal keys and associate them with equal data. + [cmp] is the equality predicate used to compare the data associated with the keys. *) - Section Spec. - + Section Spec. + Variable m m' m'' : t elt. Variable x y z : key. Variable e e' : elt. @@ -139,24 +139,24 @@ Module Type WSfun (E : DecidableType). Definition Empty m := forall (a : key)(e:elt) , ~ MapsTo a e m. Definition eq_key (p p':key*elt) := E.eq (fst p) (fst p'). - - Definition eq_key_elt (p p':key*elt) := + + Definition eq_key_elt (p p':key*elt) := E.eq (fst p) (fst p') /\ (snd p) = (snd p'). (** Specification of [MapsTo] *) Parameter MapsTo_1 : E.eq x y -> MapsTo x e m -> MapsTo y e m. - + (** Specification of [mem] *) Parameter mem_1 : In x m -> mem x m = true. - Parameter mem_2 : mem x m = true -> In x m. - + Parameter mem_2 : mem x m = true -> In x m. + (** Specification of [empty] *) Parameter empty_1 : Empty empty. (** Specification of [is_empty] *) - Parameter is_empty_1 : Empty m -> is_empty m = true. + Parameter is_empty_1 : Empty m -> is_empty m = true. Parameter is_empty_2 : is_empty m = true -> Empty m. - + (** Specification of [add] *) Parameter add_1 : E.eq x y -> MapsTo y e (add x e m). Parameter add_2 : ~ E.eq x y -> MapsTo y e m -> MapsTo y e (add x e' m). @@ -168,50 +168,50 @@ Module Type WSfun (E : DecidableType). Parameter remove_3 : MapsTo y e (remove x m) -> MapsTo y e m. (** Specification of [find] *) - Parameter find_1 : MapsTo x e m -> find x m = Some e. + Parameter find_1 : MapsTo x e m -> find x m = Some e. Parameter find_2 : find x m = Some e -> MapsTo x e m. (** Specification of [elements] *) - Parameter elements_1 : + Parameter elements_1 : MapsTo x e m -> InA eq_key_elt (x,e) (elements m). - Parameter elements_2 : + Parameter elements_2 : InA eq_key_elt (x,e) (elements m) -> MapsTo x e m. - (** When compared with ordered maps, here comes the only + (** When compared with ordered maps, here comes the only property that is really weaker: *) - Parameter elements_3w : NoDupA eq_key (elements m). + Parameter elements_3w : NoDupA eq_key (elements m). (** Specification of [cardinal] *) Parameter cardinal_1 : cardinal m = length (elements m). - (** Specification of [fold] *) + (** Specification of [fold] *) Parameter fold_1 : forall (A : Type) (i : A) (f : key -> elt -> A -> A), fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i. (** Equality of maps *) - + (** Caveat: there are at least three distinct equality predicates on maps. - - The simpliest (and maybe most natural) way is to consider keys up to - their equivalence [E.eq], but elements up to Leibniz equality, in + - The simpliest (and maybe most natural) way is to consider keys up to + their equivalence [E.eq], but elements up to Leibniz equality, in the spirit of [eq_key_elt] above. This leads to predicate [Equal]. - Unfortunately, this [Equal] predicate can't be used to describe - the [equal] function, since this function (for compatibility with - ocaml) expects a boolean comparison [cmp] that may identify more - elements than Leibniz. So logical specification of [equal] is done + the [equal] function, since this function (for compatibility with + ocaml) expects a boolean comparison [cmp] that may identify more + elements than Leibniz. So logical specification of [equal] is done via another predicate [Equivb] - This predicate [Equivb] is quite ad-hoc with its boolean [cmp], it can be generalized in a [Equiv] expecting a more general (possibly non-decidable) equality predicate on elements *) Definition Equal m m' := forall y, find y m = find y m'. - Definition Equiv (eq_elt:elt->elt->Prop) m m' := - (forall k, In k m <-> In k m') /\ - (forall k e e', MapsTo k e m -> MapsTo k e' m' -> eq_elt e e'). + Definition Equiv (eq_elt:elt->elt->Prop) m m' := + (forall k, In k m <-> In k m') /\ + (forall k e e', MapsTo k e m -> MapsTo k e' m' -> eq_elt e e'). Definition Equivb (cmp: elt->elt->bool) := Equiv (Cmp cmp). (** Specification of [equal] *) - Variable cmp : elt -> elt -> bool. + Variable cmp : elt -> elt -> bool. Parameter equal_1 : Equivb cmp m m' -> equal cmp m m' = true. Parameter equal_2 : equal cmp m m' = true -> Equivb cmp m m'. @@ -220,26 +220,26 @@ Module Type WSfun (E : DecidableType). End Types. (** Specification of [map] *) - Parameter map_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt)(f:elt->elt'), + Parameter map_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt)(f:elt->elt'), MapsTo x e m -> MapsTo x (f e) (map f m). - Parameter map_2 : forall (elt elt':Type)(m: t elt)(x:key)(f:elt->elt'), + Parameter map_2 : forall (elt elt':Type)(m: t elt)(x:key)(f:elt->elt'), In x (map f m) -> In x m. - + (** Specification of [mapi] *) Parameter mapi_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt) - (f:key->elt->elt'), MapsTo x e m -> + (f:key->elt->elt'), MapsTo x e m -> exists y, E.eq y x /\ MapsTo x (f y e) (mapi f m). Parameter mapi_2 : forall (elt elt':Type)(m: t elt)(x:key) (f:key->elt->elt'), In x (mapi f m) -> In x m. (** Specification of [map2] *) Parameter map2_1 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt') - (x:key)(f:option elt->option elt'->option elt''), - In x m \/ In x m' -> - find x (map2 f m m') = f (find x m) (find x m'). + (x:key)(f:option elt->option elt'->option elt''), + In x m \/ In x m' -> + find x (map2 f m m') = f (find x m) (find x m'). Parameter map2_2 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt') - (x:key)(f:option elt->option elt'->option elt''), + (x:key)(f:option elt->option elt'->option elt''), In x (map2 f m m') -> In x m \/ In x m'. Hint Immediate MapsTo_1 mem_2 is_empty_2 @@ -252,11 +252,11 @@ Module Type WSfun (E : DecidableType). End WSfun. -(** ** Static signature for Weak Maps +(** ** Static signature for Weak Maps Similar to [WSfun] but expressed in a self-contained way. *) -Module Type WS. +Module Type WS. Declare Module E : DecidableType. Include Type WSfun E. End WS. @@ -274,7 +274,7 @@ Module Type Sfun (E : OrderedType). Parameter elements_3 : forall m, sort lt_key (elements m). (** Remark: since [fold] is specified via [elements], this stronger specification of [elements] has an indirect impact on [fold], - which can now be proved to receive elements in increasing order. *) + which can now be proved to receive elements in increasing order. *) End elt. End Sfun. @@ -282,7 +282,7 @@ End Sfun. (** ** Maps on ordered keys, self-contained signature *) -Module Type S. +Module Type S. Declare Module E : OrderedType. Include Type Sfun E. End S. @@ -293,28 +293,28 @@ End S. Module Type Sord. - Declare Module Data : OrderedType. - Declare Module MapS : S. + Declare Module Data : OrderedType. + Declare Module MapS : S. Import MapS. - - Definition t := MapS.t Data.t. + + Definition t := MapS.t Data.t. Parameter eq : t -> t -> Prop. - Parameter lt : t -> t -> Prop. - + Parameter lt : t -> t -> Prop. + Axiom eq_refl : forall m : t, eq m m. Axiom eq_sym : forall m1 m2 : t, eq m1 m2 -> eq m2 m1. Axiom eq_trans : forall m1 m2 m3 : t, eq m1 m2 -> eq m2 m3 -> eq m1 m3. Axiom lt_trans : forall m1 m2 m3 : t, lt m1 m2 -> lt m2 m3 -> lt m1 m3. Axiom lt_not_eq : forall m1 m2 : t, lt m1 m2 -> ~ eq m1 m2. - Definition cmp e e' := match Data.compare e e' with EQ _ => true | _ => false end. + Definition cmp e e' := match Data.compare e e' with EQ _ => true | _ => false end. Parameter eq_1 : forall m m', Equivb cmp m m' -> eq m m'. Parameter eq_2 : forall m m', eq m m' -> Equivb cmp m m'. Parameter compare : forall m1 m2, Compare lt eq m1 m2. - (** Total ordering between maps. [Data.compare] is a total ordering + (** Total ordering between maps. [Data.compare] is a total ordering used to compare data associated with equal keys in the two maps. *) End Sord. diff --git a/theories/FSets/FMapList.v b/theories/FSets/FMapList.v index a99c6a908..4c21e1738 100644 --- a/theories/FSets/FMapList.v +++ b/theories/FSets/FMapList.v @@ -30,7 +30,7 @@ Definition t (elt:Type) := list (X.t * elt). Section Elt. Variable elt : Type. -Notation eqk := (eqk (elt:=elt)). +Notation eqk := (eqk (elt:=elt)). Notation eqke := (eqke (elt:=elt)). Notation ltk := (ltk (elt:=elt)). Notation MapsTo := (MapsTo (elt:=elt)). @@ -45,7 +45,7 @@ Definition empty : t elt := nil. Definition Empty m := forall (a : key)(e:elt) , ~ MapsTo a e m. Lemma empty_1 : Empty empty. -Proof. +Proof. unfold Empty,empty. intros a e. intro abs. @@ -54,7 +54,7 @@ Qed. Hint Resolve empty_1. Lemma empty_sorted : Sort empty. -Proof. +Proof. unfold empty; auto. Qed. @@ -62,7 +62,7 @@ Qed. Definition is_empty (l : t elt) : bool := if l then true else false. -Lemma is_empty_1 :forall m, Empty m -> is_empty m = true. +Lemma is_empty_1 :forall m, Empty m -> is_empty m = true. Proof. unfold Empty, PX.MapsTo. intros m. @@ -72,7 +72,7 @@ Proof. Qed. Lemma is_empty_2 : forall m, is_empty m = true -> Empty m. -Proof. +Proof. intros m. case m;auto. intros p l abs. @@ -93,12 +93,12 @@ Function mem (k : key) (s : t elt) {struct s} : bool := end. Lemma mem_1 : forall m (Hm:Sort m) x, In x m -> mem x m = true. -Proof. - intros m Hm x; generalize Hm; clear Hm. +Proof. + intros m Hm x; generalize Hm; clear Hm. functional induction (mem x m);intros sorted belong1;trivial. - + inversion belong1. inversion H. - + absurd (In x ((k', _x) :: l));try assumption. apply Sort_Inf_NotIn with _x;auto. @@ -107,13 +107,13 @@ Proof. elim (In_inv belong1);auto. intro abs. absurd (X.eq x k');auto. -Qed. +Qed. -Lemma mem_2 : forall m (Hm:Sort m) x, mem x m = true -> In x m. +Lemma mem_2 : forall m (Hm:Sort m) x, mem x m = true -> In x m. Proof. intros m Hm x; generalize Hm; clear Hm; unfold PX.In,PX.MapsTo. functional induction (mem x m); intros sorted hyp;try ((inversion hyp);fail). - exists _x; auto. + exists _x; auto. induction IHb; auto. exists x0; auto. inversion_clear sorted; auto. @@ -124,7 +124,7 @@ Qed. Function find (k:key) (s: t elt) {struct s} : option elt := match s with | nil => None - | (k',x)::s' => + | (k',x)::s' => match X.compare k k' with | LT _ => None | EQ _ => Some x @@ -138,7 +138,7 @@ Proof. functional induction (find x m);simpl;intros e' eqfind; inversion eqfind; auto. Qed. -Lemma find_1 : forall m (Hm:Sort m) x e, MapsTo x e m -> find x m = Some e. +Lemma find_1 : forall m (Hm:Sort m) x e, MapsTo x e m -> find x m = Some e. Proof. intros m Hm x e; generalize Hm; clear Hm; unfold PX.MapsTo. functional induction (find x m);simpl; subst; try clear H_eq_1. @@ -150,9 +150,9 @@ Proof. clear e1;generalize (Sort_In_cons_1 Hm (InA_eqke_eqk H0)); compute; order. clear e1;inversion_clear 2. - compute in H0; destruct H0; intuition congruence. + compute in H0; destruct H0; intuition congruence. generalize (Sort_In_cons_1 Hm (InA_eqke_eqk H0)); compute; order. - + clear e1; do 2 inversion_clear 1; auto. compute in H2; destruct H2; order. Qed. @@ -177,10 +177,10 @@ Proof. functional induction (add x e m);simpl;auto. Qed. -Lemma add_2 : forall m x y e e', +Lemma add_2 : forall m x y e e', ~ X.eq x y -> MapsTo y e m -> MapsTo y e (add x e' m). Proof. - intros m x y e e'. + intros m x y e e'. generalize y e; clear y e; unfold PX.MapsTo. functional induction (add x e' m) ;simpl;auto; clear e0. subst;auto. @@ -191,7 +191,7 @@ Proof. auto. intros y' e'' eqky'; inversion_clear 1; intuition. Qed. - + Lemma add_3 : forall m x y e e', ~ X.eq x y -> MapsTo y e (add x e' m) -> MapsTo y e m. @@ -200,15 +200,15 @@ Proof. functional induction (add x e' m);simpl; intros. apply (In_inv_3 H0); compute; auto. apply (In_inv_3 H0); compute; auto. - constructor 2; apply (In_inv_3 H0); compute; auto. + constructor 2; apply (In_inv_3 H0); compute; auto. inversion_clear H0; auto. Qed. -Lemma add_Inf : forall (m:t elt)(x x':key)(e e':elt), +Lemma add_Inf : forall (m:t elt)(x x':key)(e e':elt), Inf (x',e') m -> ltk (x',e') (x,e) -> Inf (x',e') (add x e m). Proof. - induction m. + induction m. simpl; intuition. intros. destruct a as (x'',e''). @@ -227,7 +227,7 @@ Proof. simpl; case (X.compare x x'); intuition; inversion_clear Hm; auto. constructor; auto. apply Inf_eq with (x',e'); auto. -Qed. +Qed. (** * [remove] *) @@ -240,48 +240,48 @@ Function remove (k : key) (s : t elt) {struct s} : t elt := | EQ _ => l | GT _ => (k',x) :: remove k l end - end. + end. Lemma remove_1 : forall m (Hm:Sort m) x y, X.eq x y -> ~ In y (remove x m). Proof. intros m Hm x y; generalize Hm; clear Hm. functional induction (remove x m);simpl;intros;subst. - + red; inversion 1; inversion H1. apply Sort_Inf_NotIn with x0; auto. clear e0;constructor; compute; order. - + clear e0;inversion_clear Hm. - apply Sort_Inf_NotIn with x0; auto. + apply Sort_Inf_NotIn with x0; auto. apply Inf_eq with (k',x0);auto; compute; apply X.eq_trans with x; auto. clear e0;inversion_clear Hm. assert (notin:~ In y (remove x l)) by auto. intros (x1,abs). - inversion_clear abs. + inversion_clear abs. compute in H2; destruct H2; order. apply notin; exists x1; auto. Qed. -Lemma remove_2 : forall m (Hm:Sort m) x y e, +Lemma remove_2 : forall m (Hm:Sort m) x y e, ~ X.eq x y -> MapsTo y e m -> MapsTo y e (remove x m). Proof. intros m Hm x y e; generalize Hm; clear Hm; unfold PX.MapsTo. - functional induction (remove x m);subst;auto; - match goal with + functional induction (remove x m);subst;auto; + match goal with | [H: X.compare _ _ = _ |- _ ] => clear H | _ => idtac end. inversion_clear 3; auto. compute in H1; destruct H1; order. - + inversion_clear 1; inversion_clear 2; auto. Qed. -Lemma remove_3 : forall m (Hm:Sort m) x y e, +Lemma remove_3 : forall m (Hm:Sort m) x y e, MapsTo y e (remove x m) -> MapsTo y e m. Proof. intros m Hm x y e; generalize Hm; clear Hm; unfold PX.MapsTo. @@ -289,10 +289,10 @@ Proof. inversion_clear 1; inversion_clear 1; auto. Qed. -Lemma remove_Inf : forall (m:t elt)(Hm : Sort m)(x x':key)(e':elt), +Lemma remove_Inf : forall (m:t elt)(Hm : Sort m)(x x':key)(e':elt), Inf (x',e') m -> Inf (x',e') (remove x m). Proof. - induction m. + induction m. simpl; intuition. intros. destruct a as (x'',e''). @@ -311,31 +311,31 @@ Proof. intros. destruct a as (x',e'). simpl; case (X.compare x x'); intuition; inversion_clear Hm; auto. -Qed. +Qed. (** * [elements] *) Definition elements (m: t elt) := m. -Lemma elements_1 : forall m x e, +Lemma elements_1 : forall m x e, MapsTo x e m -> InA eqke (x,e) (elements m). Proof. auto. Qed. -Lemma elements_2 : forall m x e, +Lemma elements_2 : forall m x e, InA eqke (x,e) (elements m) -> MapsTo x e m. -Proof. +Proof. auto. Qed. -Lemma elements_3 : forall m (Hm:Sort m), sort ltk (elements m). -Proof. +Lemma elements_3 : forall m (Hm:Sort m), sort ltk (elements m). +Proof. auto. Qed. -Lemma elements_3w : forall m (Hm:Sort m), NoDupA eqk (elements m). -Proof. +Lemma elements_3w : forall m (Hm:Sort m), NoDupA eqk (elements m). +Proof. intros. apply Sort_NoDupA. apply elements_3; auto. @@ -351,30 +351,30 @@ Function fold (A:Type)(f:key->elt->A->A)(m:t elt) (acc:A) {struct m} : A := Lemma fold_1 : forall m (A:Type)(i:A)(f:key->elt->A->A), fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i. -Proof. +Proof. intros; functional induction (fold f m i); auto. Qed. (** * [equal] *) -Function equal (cmp:elt->elt->bool)(m m' : t elt) { struct m } : bool := - match m, m' with +Function equal (cmp:elt->elt->bool)(m m' : t elt) { struct m } : bool := + match m, m' with | nil, nil => true - | (x,e)::l, (x',e')::l' => - match X.compare x x' with + | (x,e)::l, (x',e')::l' => + match X.compare x x' with | EQ _ => cmp e e' && equal cmp l l' | _ => false - end - | _, _ => false + end + | _, _ => false end. -Definition Equivb cmp m m' := - (forall k, In k m <-> In k m') /\ - (forall k e e', MapsTo k e m -> MapsTo k e' m' -> cmp e e' = true). +Definition Equivb cmp m m' := + (forall k, In k m <-> In k m') /\ + (forall k e e', MapsTo k e m -> MapsTo k e' m' -> cmp e e' = true). -Lemma equal_1 : forall m (Hm:Sort m) m' (Hm': Sort m') cmp, - Equivb cmp m m' -> equal cmp m m' = true. -Proof. +Lemma equal_1 : forall m (Hm:Sort m) m' (Hm': Sort m') cmp, + Equivb cmp m m' -> equal cmp m m' = true. +Proof. intros m Hm m' Hm' cmp; generalize Hm Hm'; clear Hm Hm'. functional induction (equal cmp m m'); simpl; subst;auto; unfold Equivb; intuition; subst. @@ -407,7 +407,7 @@ Proof. destruct (X.compare x x'); try contradiction; clear y. destruct (H0 x). - assert (In x ((x',e')::l')). + assert (In x ((x',e')::l')). apply H; auto. exists e; auto. destruct (In_inv H3). @@ -418,7 +418,7 @@ Proof. elim (Sort_Inf_NotIn H5 H7 H4). destruct (H0 x'). - assert (In x' ((x,e)::l)). + assert (In x' ((x,e)::l)). apply H2; auto. exists e'; auto. destruct (In_inv H3). @@ -430,7 +430,7 @@ Proof. destruct m; destruct m';try contradiction. - + clear H1;destruct p as (k,e). destruct (H0 k). destruct H1. @@ -447,18 +447,18 @@ Proof. Qed. -Lemma equal_2 : forall m (Hm:Sort m) m' (Hm:Sort m') cmp, +Lemma equal_2 : forall m (Hm:Sort m) m' (Hm:Sort m') cmp, equal cmp m m' = true -> Equivb cmp m m'. Proof. intros m Hm m' Hm' cmp; generalize Hm Hm'; clear Hm Hm'. - functional induction (equal cmp m m'); simpl; subst;auto; unfold Equivb; - intuition; try discriminate; subst; + functional induction (equal cmp m m'); simpl; subst;auto; unfold Equivb; + intuition; try discriminate; subst; try match goal with H: X.compare _ _ = _ |- _ => clear H end. inversion H0. inversion_clear Hm;inversion_clear Hm'. - destruct (andb_prop _ _ H); clear H. + destruct (andb_prop _ _ H); clear H. destruct (IHb H1 H3 H6). destruct (In_inv H0). exists e'; constructor; split; trivial; apply X.eq_trans with x; auto. @@ -467,7 +467,7 @@ Proof. exists e''; auto. inversion_clear Hm;inversion_clear Hm'. - destruct (andb_prop _ _ H); clear H. + destruct (andb_prop _ _ H); clear H. destruct (IHb H1 H3 H6). destruct (In_inv H0). exists e; constructor; split; trivial; apply X.eq_trans with x'; auto. @@ -476,15 +476,15 @@ Proof. exists e''; auto. inversion_clear Hm;inversion_clear Hm'. - destruct (andb_prop _ _ H); clear H. + destruct (andb_prop _ _ H); clear H. destruct (IHb H2 H4 H7). inversion_clear H0. destruct H9; simpl in *; subst. - inversion_clear H1. + inversion_clear H1. destruct H9; simpl in *; subst; auto. elim (Sort_Inf_NotIn H4 H5). exists e'0; apply MapsTo_eq with k; auto; order. - inversion_clear H1. + inversion_clear H1. destruct H0; simpl in *; subst; auto. elim (Sort_Inf_NotIn H2 H3). exists e0; apply MapsTo_eq with k; auto; order. @@ -494,7 +494,7 @@ Qed. (** This lemma isn't part of the spec of [Equivb], but is used in [FMapAVL] *) Lemma equal_cons : forall cmp l1 l2 x y, Sort (x::l1) -> Sort (y::l2) -> - eqk x y -> cmp (snd x) (snd y) = true -> + eqk x y -> cmp (snd x) (snd y) = true -> (Equivb cmp l1 l2 <-> Equivb cmp (x :: l1) (y :: l2)). Proof. intros. @@ -517,7 +517,7 @@ Qed. Variable elt':Type. (** * [map] and [mapi] *) - + Fixpoint map (f:elt -> elt') (m:t elt) {struct m} : t elt' := match m with | nil => nil @@ -531,24 +531,24 @@ Fixpoint mapi (f: key -> elt -> elt') (m:t elt) {struct m} : t elt' := end. End Elt. -Section Elt2. -(* A new section is necessary for previous definitions to work +Section Elt2. +(* A new section is necessary for previous definitions to work with different [elt], especially [MapsTo]... *) - + Variable elt elt' : Type. (** Specification of [map] *) -Lemma map_1 : forall (m:t elt)(x:key)(e:elt)(f:elt->elt'), +Lemma map_1 : forall (m:t elt)(x:key)(e:elt)(f:elt->elt'), MapsTo x e m -> MapsTo x (f e) (map f m). Proof. intros m x e f. (* functional induction map elt elt' f m. *) (* Marche pas ??? *) induction m. inversion 1. - + destruct a as (x',e'). - simpl. + simpl. inversion_clear 1. constructor 1. unfold eqke in *; simpl in *; intuition congruence. @@ -556,15 +556,15 @@ Proof. unfold MapsTo in *; auto. Qed. -Lemma map_2 : forall (m:t elt)(x:key)(f:elt->elt'), +Lemma map_2 : forall (m:t elt)(x:key)(f:elt->elt'), In x (map f m) -> In x m. Proof. - intros m x f. + intros m x f. (* functional induction map elt elt' f m. *) (* Marche pas ??? *) induction m; simpl. intros (e,abs). inversion abs. - + destruct a as (x',e). intros hyp. inversion hyp. clear hyp. @@ -578,9 +578,9 @@ Proof. Qed. Lemma map_lelistA : forall (m: t elt)(x:key)(e:elt)(e':elt')(f:elt->elt'), - lelistA (@ltk elt) (x,e) m -> + lelistA (@ltk elt) (x,e) m -> lelistA (@ltk elt') (x,e') (map f m). -Proof. +Proof. induction m; simpl; auto. intros. destruct a as (x0,e0). @@ -589,30 +589,30 @@ Qed. Hint Resolve map_lelistA. -Lemma map_sorted : forall (m: t elt)(Hm : sort (@ltk elt) m)(f:elt -> elt'), +Lemma map_sorted : forall (m: t elt)(Hm : sort (@ltk elt) m)(f:elt -> elt'), sort (@ltk elt') (map f m). -Proof. +Proof. induction m; simpl; auto. intros. destruct a as (x',e'). inversion_clear Hm. constructor; auto. exact (map_lelistA _ _ H0). -Qed. - +Qed. + (** Specification of [mapi] *) -Lemma mapi_1 : forall (m:t elt)(x:key)(e:elt)(f:key->elt->elt'), - MapsTo x e m -> +Lemma mapi_1 : forall (m:t elt)(x:key)(e:elt)(f:key->elt->elt'), + MapsTo x e m -> exists y, X.eq y x /\ MapsTo x (f y e) (mapi f m). Proof. intros m x e f. (* functional induction mapi elt elt' f m. *) (* Marche pas ??? *) induction m. inversion 1. - + destruct a as (x',e'). - simpl. + simpl. inversion_clear 1. exists x'. destruct H0; simpl in *. @@ -621,18 +621,18 @@ Proof. unfold eqke in *; simpl in *; intuition congruence. destruct IHm as (y, hyp); auto. exists y; intuition. -Qed. +Qed. -Lemma mapi_2 : forall (m:t elt)(x:key)(f:key->elt->elt'), +Lemma mapi_2 : forall (m:t elt)(x:key)(f:key->elt->elt'), In x (mapi f m) -> In x m. Proof. - intros m x f. + intros m x f. (* functional induction mapi elt elt' f m. *) (* Marche pas ??? *) induction m; simpl. intros (e,abs). inversion abs. - + destruct a as (x',e). intros hyp. inversion hyp. clear hyp. @@ -646,9 +646,9 @@ Proof. Qed. Lemma mapi_lelistA : forall (m: t elt)(x:key)(e:elt)(f:key->elt->elt'), - lelistA (@ltk elt) (x,e) m -> + lelistA (@ltk elt) (x,e) m -> lelistA (@ltk elt') (x,f x e) (mapi f m). -Proof. +Proof. induction m; simpl; auto. intros. destruct a as (x',e'). @@ -657,7 +657,7 @@ Qed. Hint Resolve mapi_lelistA. -Lemma mapi_sorted : forall m (Hm : sort (@ltk elt) m)(f: key ->elt -> elt'), +Lemma mapi_sorted : forall m (Hm : sort (@ltk elt) m)(f: key ->elt -> elt'), sort (@ltk elt') (mapi f m). Proof. induction m; simpl; auto. @@ -666,7 +666,7 @@ Proof. inversion_clear Hm; auto. Qed. -End Elt2. +End Elt2. Section Elt3. (** * [map2] *) @@ -674,27 +674,27 @@ Section Elt3. Variable elt elt' elt'' : Type. Variable f : option elt -> option elt' -> option elt''. -Definition option_cons (A:Type)(k:key)(o:option A)(l:list (key*A)) := - match o with +Definition option_cons (A:Type)(k:key)(o:option A)(l:list (key*A)) := + match o with | Some e => (k,e)::l | None => l end. -Fixpoint map2_l (m : t elt) : t elt'' := - match m with - | nil => nil +Fixpoint map2_l (m : t elt) : t elt'' := + match m with + | nil => nil | (k,e)::l => option_cons k (f (Some e) None) (map2_l l) - end. + end. -Fixpoint map2_r (m' : t elt') : t elt'' := - match m' with - | nil => nil +Fixpoint map2_r (m' : t elt') : t elt'' := + match m' with + | nil => nil | (k,e')::l' => option_cons k (f None (Some e')) (map2_r l') - end. + end. Fixpoint map2 (m : t elt) : t elt' -> t elt'' := match m with - | nil => map2_r + | nil => map2_r | (k,e) :: l => fix map2_aux (m' : t elt') : t elt'' := match m' with @@ -706,7 +706,7 @@ Fixpoint map2 (m : t elt) : t elt' -> t elt'' := | GT _ => option_cons k' (f None (Some e')) (map2_aux l') end end - end. + end. Notation oee' := (option elt * option elt')%type. @@ -724,14 +724,14 @@ Fixpoint combine (m : t elt) : t elt' -> t oee' := | GT _ => (k',(None,Some e'))::combine_aux l' end end - end. + end. -Definition fold_right_pair (A B C:Type)(f: A->B->C->C)(l:list (A*B))(i:C) := +Definition fold_right_pair (A B C:Type)(f: A->B->C->C)(l:list (A*B))(i:C) := List.fold_right (fun p => f (fst p) (snd p)) i l. -Definition map2_alt m m' := - let m0 : t oee' := combine m m' in - let m1 : t (option elt'') := map (fun p => f (fst p) (snd p)) m0 in +Definition map2_alt m m' := + let m0 : t oee' := combine m m' in + let m1 : t (option elt'') := map (fun p => f (fst p) (snd p)) m0 in fold_right_pair (option_cons (A:=elt'')) m1 nil. Lemma map2_alt_equiv : forall m m', map2_alt m m' = map2 m m'. @@ -758,20 +758,20 @@ Proof. apply IHm'. Qed. -Lemma combine_lelistA : - forall m m' (x:key)(e:elt)(e':elt')(e'':oee'), - lelistA (@ltk elt) (x,e) m -> - lelistA (@ltk elt') (x,e') m' -> +Lemma combine_lelistA : + forall m m' (x:key)(e:elt)(e':elt')(e'':oee'), + lelistA (@ltk elt) (x,e) m -> + lelistA (@ltk elt') (x,e') m' -> lelistA (@ltk oee') (x,e'') (combine m m'). Proof. - induction m. + induction m. intros. simpl. exact (map_lelistA _ _ H0). - induction m'. + induction m'. intros. destruct a. - replace (combine ((t0, e0) :: m) nil) with + replace (combine ((t0, e0) :: m) nil) with (map (fun e => (Some e,None (A:=elt'))) ((t0,e0)::m)); auto. exact (map_lelistA _ _ H). intros. @@ -784,18 +784,18 @@ Proof. Qed. Hint Resolve combine_lelistA. -Lemma combine_sorted : - forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m'), +Lemma combine_sorted : + forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m'), sort (@ltk oee') (combine m m'). Proof. - induction m. + induction m. intros; clear Hm. simpl. apply map_sorted; auto. - induction m'. + induction m'. intros; clear Hm'. destruct a. - replace (combine ((t0, e) :: m) nil) with + replace (combine ((t0, e) :: m) nil) with (map (fun e => (Some e,None (A:=elt'))) ((t0,e)::m)); auto. apply map_sorted; auto. intros. @@ -805,11 +805,11 @@ Proof. inversion_clear Hm. constructor; auto. assert (lelistA (ltk (elt:=elt')) (k, e') ((k',e')::m')) by auto. - exact (combine_lelistA _ H0 H1). + exact (combine_lelistA _ H0 H1). inversion_clear Hm; inversion_clear Hm'. constructor; auto. assert (lelistA (ltk (elt:=elt')) (k, e') m') by (apply Inf_eq with (k',e'); auto). - exact (combine_lelistA _ H0 H3). + exact (combine_lelistA _ H0 H3). inversion_clear Hm; inversion_clear Hm'. constructor; auto. change (lelistA (ltk (elt:=oee')) (k', (None, Some e')) @@ -818,8 +818,8 @@ Proof. exact (combine_lelistA _ H3 H2). Qed. -Lemma map2_sorted : - forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m'), +Lemma map2_sorted : + forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m'), sort (@ltk elt'') (map2 m m'). Proof. intros. @@ -829,7 +829,7 @@ Proof. set (l0:=combine m m') in *; clearbody l0. set (f':= fun p : oee' => f (fst p) (snd p)). assert (H1:=map_sorted (elt' := option elt'') H0 f'). - set (l1:=map f' l0) in *; clearbody l1. + set (l1:=map f' l0) in *; clearbody l1. clear f' f H0 l0 Hm Hm' m m'. induction l1. simpl; auto. @@ -848,16 +848,16 @@ Proof. apply IHl1; auto. apply Inf_lt with (t1, None (A:=elt'')); auto. Qed. - -Definition at_least_one (o:option elt)(o':option elt') := - match o, o' with - | None, None => None + +Definition at_least_one (o:option elt)(o':option elt') := + match o, o' with + | None, None => None | _, _ => Some (o,o') end. -Lemma combine_1 : - forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m') (x:key), - find x (combine m m') = at_least_one (find x m) (find x m'). +Lemma combine_1 : + forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m') (x:key), + find x (combine m m') = at_least_one (find x m) (find x m'). Proof. induction m. intros. @@ -881,32 +881,32 @@ Proof. destruct a as (k,e); destruct a0 as (k',e'); simpl. inversion Hm; inversion Hm'; subst. destruct (X.compare k k'); simpl; - destruct (X.compare x k); + destruct (X.compare x k); elim_comp || destruct (X.compare x k'); simpl; auto. rewrite IHm; auto; simpl; elim_comp; auto. rewrite IHm; auto; simpl; elim_comp; auto. rewrite IHm; auto; simpl; elim_comp; auto. change (find x (combine ((k, e) :: m) m') = at_least_one None (find x m')). - rewrite IHm'; auto. + rewrite IHm'; auto. simpl find; elim_comp; auto. change (find x (combine ((k, e) :: m) m') = Some (Some e, find x m')). - rewrite IHm'; auto. + rewrite IHm'; auto. simpl find; elim_comp; auto. - change (find x (combine ((k, e) :: m) m') = + change (find x (combine ((k, e) :: m) m') = at_least_one (find x m) (find x m')). - rewrite IHm'; auto. + rewrite IHm'; auto. simpl find; elim_comp; auto. Qed. -Definition at_least_one_then_f (o:option elt)(o':option elt') := - match o, o' with - | None, None => None +Definition at_least_one_then_f (o:option elt)(o':option elt') := + match o, o' with + | None, None => None | _, _ => f o o' end. -Lemma map2_0 : - forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m') (x:key), - find x (map2 m m') = at_least_one_then_f (find x m) (find x m'). +Lemma map2_0 : + forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m') (x:key), + find x (map2 m m') = at_least_one_then_f (find x m) (find x m'). Proof. intros. rewrite <- map2_alt_equiv. @@ -915,7 +915,7 @@ Proof. assert (H2:=combine_sorted Hm Hm'). set (f':= fun p : oee' => f (fst p) (snd p)). set (m0 := combine m m') in *; clearbody m0. - set (o:=find x m) in *; clearbody o. + set (o:=find x m) in *; clearbody o. set (o':=find x m') in *; clearbody o'. clear Hm Hm' m m'. generalize H; clear H. @@ -984,10 +984,10 @@ Qed. (** Specification of [map2] *) -Lemma map2_1 : +Lemma map2_1 : forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m')(x:key), - In x m \/ In x m' -> - find x (map2 m m') = f (find x m) (find x m'). + In x m \/ In x m' -> + find x (map2 m m') = f (find x m) (find x m'). Proof. intros. rewrite map2_0; auto. @@ -997,10 +997,10 @@ Proof. rewrite (find_1 Hm' H). destruct (find x m); simpl; auto. Qed. - -Lemma map2_2 : - forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m')(x:key), - In x (map2 m m') -> In x m \/ In x m'. + +Lemma map2_2 : + forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m')(x:key), + In x (map2 m m') -> In x m \/ In x m'. Proof. intros. destruct H as (e,H). @@ -1008,9 +1008,9 @@ Proof. rewrite (find_1 (map2_sorted Hm Hm') H). generalize (@find_2 _ m x). generalize (@find_2 _ m' x). - destruct (find x m); + destruct (find x m); destruct (find x m'); simpl; intros. - left; exists e0; auto. + left; exists e0; auto. left; exists e0; auto. right; exists e0; auto. discriminate. @@ -1020,31 +1020,31 @@ End Elt3. End Raw. Module Make (X: OrderedType) <: S with Module E := X. -Module Raw := Raw X. +Module Raw := Raw X. Module E := X. Definition key := E.t. -Record slist (elt:Type) := +Record slist (elt:Type) := {this :> Raw.t elt; sorted : sort (@Raw.PX.ltk elt) this}. -Definition t (elt:Type) : Type := slist elt. +Definition t (elt:Type) : Type := slist elt. -Section Elt. - Variable elt elt' elt'':Type. +Section Elt. + Variable elt elt' elt'':Type. Implicit Types m : t elt. - Implicit Types x y : key. + Implicit Types x y : key. Implicit Types e : elt. Definition empty : t elt := Build_slist (Raw.empty_sorted elt). Definition is_empty m : bool := Raw.is_empty m.(this). Definition add x e m : t elt := Build_slist (Raw.add_sorted m.(sorted) x e). Definition find x m : option elt := Raw.find x m.(this). - Definition remove x m : t elt := Build_slist (Raw.remove_sorted m.(sorted) x). + Definition remove x m : t elt := Build_slist (Raw.remove_sorted m.(sorted) x). Definition mem x m : bool := Raw.mem x m.(this). Definition map f m : t elt' := Build_slist (Raw.map_sorted m.(sorted) f). Definition mapi (f:key->elt->elt') m : t elt' := Build_slist (Raw.mapi_sorted m.(sorted) f). - Definition map2 f m (m':t elt') : t elt'' := + Definition map2 f m (m':t elt') : t elt'' := Build_slist (Raw.map2_sorted f m.(sorted) m'.(sorted)). Definition elements m : list (key*elt) := @Raw.elements elt m.(this). Definition cardinal m := length m.(this). @@ -1056,9 +1056,9 @@ Section Elt. Definition Empty m : Prop := Raw.Empty m.(this). Definition Equal m m' := forall y, find y m = find y m'. - Definition Equiv (eq_elt:elt->elt->Prop) m m' := - (forall k, In k m <-> In k m') /\ - (forall k e e', MapsTo k e m -> MapsTo k e' m' -> eq_elt e e'). + Definition Equiv (eq_elt:elt->elt->Prop) m m' := + (forall k, In k m <-> In k m') /\ + (forall k e e', MapsTo k e m -> MapsTo k e' m' -> eq_elt e e'). Definition Equivb cmp m m' : Prop := @Raw.Equivb elt cmp m.(this) m'.(this). Definition eq_key : (key*elt) -> (key*elt) -> Prop := @Raw.PX.eqk elt. @@ -1095,7 +1095,7 @@ Section Elt. Lemma remove_3 : forall m x y e, MapsTo y e (remove x m) -> MapsTo y e m. Proof. intros m; exact (@Raw.remove_3 elt m.(this) m.(sorted)). Qed. - Lemma find_1 : forall m x e, MapsTo x e m -> find x m = Some e. + Lemma find_1 : forall m x e, MapsTo x e m -> find x m = Some e. Proof. intros m; exact (@Raw.find_1 elt m.(this) m.(sorted)). Qed. Lemma find_2 : forall m x e, find x m = Some e -> MapsTo x e m. Proof. intros m; exact (@Raw.find_2 elt m.(this)). Qed. @@ -1104,9 +1104,9 @@ Section Elt. Proof. intros m; exact (@Raw.elements_1 elt m.(this)). Qed. Lemma elements_2 : forall m x e, InA eq_key_elt (x,e) (elements m) -> MapsTo x e m. Proof. intros m; exact (@Raw.elements_2 elt m.(this)). Qed. - Lemma elements_3 : forall m, sort lt_key (elements m). + Lemma elements_3 : forall m, sort lt_key (elements m). Proof. intros m; exact (@Raw.elements_3 elt m.(this) m.(sorted)). Qed. - Lemma elements_3w : forall m, NoDupA eq_key (elements m). + Lemma elements_3w : forall m, NoDupA eq_key (elements m). Proof. intros m; exact (@Raw.elements_3w elt m.(this) m.(sorted)). Qed. Lemma cardinal_1 : forall m, cardinal m = length (elements m). @@ -1116,22 +1116,22 @@ Section Elt. fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i. Proof. intros m; exact (@Raw.fold_1 elt m.(this)). Qed. - Lemma equal_1 : forall m m' cmp, Equivb cmp m m' -> equal cmp m m' = true. + Lemma equal_1 : forall m m' cmp, Equivb cmp m m' -> equal cmp m m' = true. Proof. intros m m'; exact (@Raw.equal_1 elt m.(this) m.(sorted) m'.(this) m'.(sorted)). Qed. Lemma equal_2 : forall m m' cmp, equal cmp m m' = true -> Equivb cmp m m'. Proof. intros m m'; exact (@Raw.equal_2 elt m.(this) m.(sorted) m'.(this) m'.(sorted)). Qed. End Elt. - - Lemma map_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt)(f:elt->elt'), + + Lemma map_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt)(f:elt->elt'), MapsTo x e m -> MapsTo x (f e) (map f m). Proof. intros elt elt' m; exact (@Raw.map_1 elt elt' m.(this)). Qed. - Lemma map_2 : forall (elt elt':Type)(m: t elt)(x:key)(f:elt->elt'), - In x (map f m) -> In x m. + Lemma map_2 : forall (elt elt':Type)(m: t elt)(x:key)(f:elt->elt'), + In x (map f m) -> In x m. Proof. intros elt elt' m; exact (@Raw.map_2 elt elt' m.(this)). Qed. Lemma mapi_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt) - (f:key->elt->elt'), MapsTo x e m -> + (f:key->elt->elt'), MapsTo x e m -> exists y, E.eq y x /\ MapsTo x (f y e) (mapi f m). Proof. intros elt elt' m; exact (@Raw.mapi_1 elt elt' m.(this)). Qed. Lemma mapi_2 : forall (elt elt':Type)(m: t elt)(x:key) @@ -1139,58 +1139,58 @@ Section Elt. Proof. intros elt elt' m; exact (@Raw.mapi_2 elt elt' m.(this)). Qed. Lemma map2_1 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt') - (x:key)(f:option elt->option elt'->option elt''), - In x m \/ In x m' -> - find x (map2 f m m') = f (find x m) (find x m'). - Proof. - intros elt elt' elt'' m m' x f; + (x:key)(f:option elt->option elt'->option elt''), + In x m \/ In x m' -> + find x (map2 f m m') = f (find x m) (find x m'). + Proof. + intros elt elt' elt'' m m' x f; exact (@Raw.map2_1 elt elt' elt'' f m.(this) m.(sorted) m'.(this) m'.(sorted) x). Qed. Lemma map2_2 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt') - (x:key)(f:option elt->option elt'->option elt''), + (x:key)(f:option elt->option elt'->option elt''), In x (map2 f m m') -> In x m \/ In x m'. - Proof. - intros elt elt' elt'' m m' x f; + Proof. + intros elt elt' elt'' m m' x f; exact (@Raw.map2_2 elt elt' elt'' f m.(this) m.(sorted) m'.(this) m'.(sorted) x). Qed. End Make. -Module Make_ord (X: OrderedType)(D : OrderedType) <: -Sord with Module Data := D +Module Make_ord (X: OrderedType)(D : OrderedType) <: +Sord with Module Data := D with Module MapS.E := X. Module Data := D. -Module MapS := Make(X). +Module MapS := Make(X). Import MapS. Module MD := OrderedTypeFacts(D). Import MD. -Definition t := MapS.t D.t. +Definition t := MapS.t D.t. Definition cmp e e' := match D.compare e e' with EQ _ => true | _ => false end. -Fixpoint eq_list (m m' : list (X.t * D.t)) { struct m } : Prop := - match m, m' with +Fixpoint eq_list (m m' : list (X.t * D.t)) { struct m } : Prop := + match m, m' with | nil, nil => True - | (x,e)::l, (x',e')::l' => - match X.compare x x' with + | (x,e)::l, (x',e')::l' => + match X.compare x x' with | EQ _ => D.eq e e' /\ eq_list l l' | _ => False - end + end | _, _ => False end. Definition eq m m' := eq_list m.(this) m'.(this). -Fixpoint lt_list (m m' : list (X.t * D.t)) {struct m} : Prop := - match m, m' with +Fixpoint lt_list (m m' : list (X.t * D.t)) {struct m} : Prop := + match m, m' with | nil, nil => False | nil, _ => True | _, nil => False - | (x,e)::l, (x',e')::l' => - match X.compare x x' with + | (x,e)::l, (x',e')::l' => + match X.compare x x' with | LT _ => True | GT _ => False | EQ _ => D.lt e e' \/ (D.eq e e' /\ lt_list l l') @@ -1209,9 +1209,9 @@ Proof. destruct a; unfold equal; simpl; intuition. destruct a as (x,e). destruct p as (x',e'). - unfold equal; simpl. + unfold equal; simpl. destruct (X.compare x x'); simpl; intuition. - unfold cmp at 1. + unfold cmp at 1. MD.elim_comp; clear H; simpl. inversion_clear Hl. inversion_clear Hl'. @@ -1258,7 +1258,7 @@ Qed. Lemma eq_sym : forall m1 m2 : t, eq m1 m2 -> eq m2 m1. Proof. - intros (m,Hm); induction m; + intros (m,Hm); induction m; intros (m', Hm'); destruct m'; unfold eq; simpl; try destruct a as (x,e); try destruct p as (x',e'); auto. destruct (X.compare x x'); MapS.Raw.MX.elim_comp; intuition. @@ -1267,15 +1267,15 @@ Proof. Qed. Lemma eq_trans : forall m1 m2 m3 : t, eq m1 m2 -> eq m2 m3 -> eq m1 m3. -Proof. - intros (m1,Hm1); induction m1; - intros (m2, Hm2); destruct m2; - intros (m3, Hm3); destruct m3; unfold eq; simpl; - try destruct a as (x,e); - try destruct p as (x',e'); +Proof. + intros (m1,Hm1); induction m1; + intros (m2, Hm2); destruct m2; + intros (m3, Hm3); destruct m3; unfold eq; simpl; + try destruct a as (x,e); + try destruct p as (x',e'); try destruct p0 as (x'',e''); try contradiction; auto. - destruct (X.compare x x'); - destruct (X.compare x' x''); + destruct (X.compare x x'); + destruct (X.compare x' x''); MapS.Raw.MX.elim_comp. intuition. apply D.eq_trans with e'; auto. @@ -1285,14 +1285,14 @@ Qed. Lemma lt_trans : forall m1 m2 m3 : t, lt m1 m2 -> lt m2 m3 -> lt m1 m3. Proof. - intros (m1,Hm1); induction m1; - intros (m2, Hm2); destruct m2; - intros (m3, Hm3); destruct m3; unfold lt; simpl; - try destruct a as (x,e); - try destruct p as (x',e'); + intros (m1,Hm1); induction m1; + intros (m2, Hm2); destruct m2; + intros (m3, Hm3); destruct m3; unfold lt; simpl; + try destruct a as (x,e); + try destruct p as (x',e'); try destruct p0 as (x'',e''); try contradiction; auto. - destruct (X.compare x x'); - destruct (X.compare x' x''); + destruct (X.compare x x'); + destruct (X.compare x' x''); MapS.Raw.MX.elim_comp; auto. intuition. left; apply D.lt_trans with e'; auto. @@ -1307,9 +1307,9 @@ Qed. Lemma lt_not_eq : forall m1 m2 : t, lt m1 m2 -> ~ eq m1 m2. Proof. - intros (m1,Hm1); induction m1; - intros (m2, Hm2); destruct m2; unfold eq, lt; simpl; - try destruct a as (x,e); + intros (m1,Hm1); induction m1; + intros (m2, Hm2); destruct m2; unfold eq, lt; simpl; + try destruct a as (x,e); try destruct p as (x',e'); try contradiction; auto. destruct (X.compare x x'); auto. intuition. @@ -1322,20 +1322,20 @@ Ltac cmp_solve := unfold eq, lt; simpl; try Raw.MX.elim_comp; auto. Definition compare : forall m1 m2, Compare lt eq m1 m2. Proof. - intros (m1,Hm1); induction m1; - intros (m2, Hm2); destruct m2; + intros (m1,Hm1); induction m1; + intros (m2, Hm2); destruct m2; [ apply EQ | apply LT | apply GT | ]; cmp_solve. - destruct a as (x,e); destruct p as (x',e'). - destruct (X.compare x x'); + destruct a as (x,e); destruct p as (x',e'). + destruct (X.compare x x'); [ apply LT | | apply GT ]; cmp_solve. - destruct (D.compare e e'); + destruct (D.compare e e'); [ apply LT | | apply GT ]; cmp_solve. assert (Hm11 : sort (Raw.PX.ltk (elt:=D.t)) m1). inversion_clear Hm1; auto. assert (Hm22 : sort (Raw.PX.ltk (elt:=D.t)) m2). inversion_clear Hm2; auto. - destruct (IHm1 Hm11 (Build_slist Hm22)); + destruct (IHm1 Hm11 (Build_slist Hm22)); [ apply LT | apply EQ | apply GT ]; cmp_solve. Qed. -End Make_ord. +End Make_ord. diff --git a/theories/FSets/FMapPositive.v b/theories/FSets/FMapPositive.v index 10c7ce4a8..112ccce30 100644 --- a/theories/FSets/FMapPositive.v +++ b/theories/FSets/FMapPositive.v @@ -6,8 +6,8 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* Finite sets library. - * Authors: Pierre Letouzey and Jean-Christophe Filliâtre +(* Finite sets library. + * Authors: Pierre Letouzey and Jean-Christophe Filliâtre * Institution: LRI, CNRS UMR 8623 - Université Paris Sud * 91405 Orsay, France *) @@ -25,16 +25,16 @@ Open Local Scope positive_scope. (** * An implementation of [FMapInterface.S] for positive keys. *) -(** This file is an adaptation to the [FMap] framework of a work by +(** This file is an adaptation to the [FMap] framework of a work by Xavier Leroy and Sandrine Blazy (used for building certified compilers). - Keys are of type [positive], and maps are binary trees: the sequence + Keys are of type [positive], and maps are binary trees: the sequence of binary digits of a positive number corresponds to a path in such a tree. - This is quite similar to the [IntMap] library, except that no path compression - is implemented, and that the current file is simple enough to be + This is quite similar to the [IntMap] library, except that no path compression + is implemented, and that the current file is simple enough to be self-contained. *) -(** Even if [positive] can be seen as an ordered type with respect to the - usual order (see [OrderedTypeEx]), we use here a lexicographic order +(** Even if [positive] can be seen as an ordered type with respect to the + usual order (see [OrderedTypeEx]), we use here a lexicographic order over bits, which is more natural here (lower bits are considered first). *) Module PositiveOrderedTypeBits <: UsualOrderedType. @@ -44,8 +44,8 @@ Module PositiveOrderedTypeBits <: UsualOrderedType. Definition eq_sym := @sym_eq t. Definition eq_trans := @trans_eq t. - Fixpoint bits_lt (p q:positive) { struct p } : Prop := - match p, q with + Fixpoint bits_lt (p q:positive) { struct p } : Prop := + match p, q with | xH, xI _ => True | xH, _ => False | xO p, xO q => bits_lt p q @@ -63,9 +63,9 @@ Module PositiveOrderedTypeBits <: UsualOrderedType. induction y; destruct z; simpl; eauto; intuition. induction y; destruct z; simpl; eauto; intuition. Qed. - + Lemma lt_trans : forall x y z : t, lt x y -> lt y z -> lt x z. - Proof. + Proof. exact bits_lt_trans. Qed. @@ -101,7 +101,7 @@ Module PositiveOrderedTypeBits <: UsualOrderedType. apply LT; auto. apply EQ; rewrite e; red; auto. apply GT; auto. - (* O H *) + (* O H *) apply LT; simpl; auto. (* H I *) apply LT; simpl; auto. @@ -122,7 +122,7 @@ Module PositiveOrderedTypeBits <: UsualOrderedType. End PositiveOrderedTypeBits. (** Other positive stuff *) - + Fixpoint append (i j : positive) {struct i} : positive := match i with | xH => j @@ -130,7 +130,7 @@ Fixpoint append (i j : positive) {struct i} : positive := | xO ii => xO (append ii j) end. -Lemma append_assoc_0 : +Lemma append_assoc_0 : forall (i j : positive), append i (xO j) = append (append i (xO xH)) j. Proof. induction i; intros; destruct j; simpl; @@ -140,7 +140,7 @@ Proof. auto. Qed. -Lemma append_assoc_1 : +Lemma append_assoc_1 : forall (i j : positive), append i (xI j) = append (append i (xI xH)) j. Proof. induction i; intros; destruct j; simpl; @@ -159,7 +159,7 @@ Lemma append_neutral_l : forall (i : positive), append xH i = i. Proof. simpl; auto. Qed. - + (** The module of maps over positive keys *) @@ -182,9 +182,9 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. Implicit Arguments Leaf [A]. Definition empty : t A := Leaf. - - Fixpoint is_empty (m : t A) {struct m} : bool := - match m with + + Fixpoint is_empty (m : t A) {struct m} : bool := + match m with | Leaf => true | Node l None r => (is_empty l) && (is_empty r) | _ => false @@ -279,8 +279,8 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. (** [cardinal] *) Fixpoint cardinal (m : t A) : nat := - match m with - | Leaf => 0%nat + match m with + | Leaf => 0%nat | Node l None r => (cardinal l + cardinal r)%nat | Node l (Some _) r => S (cardinal l + cardinal r) end. @@ -565,7 +565,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. exact (xelements_complete i xH m v H). Qed. - Lemma cardinal_1 : + Lemma cardinal_1 : forall (m: t A), cardinal m = length (elements m). Proof. unfold elements. @@ -584,13 +584,13 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. Definition Empty m := forall (a : positive)(e:A) , ~ MapsTo a e m. Definition eq_key (p p':positive*A) := E.eq (fst p) (fst p'). - - Definition eq_key_elt (p p':positive*A) := + + Definition eq_key_elt (p p':positive*A) := E.eq (fst p) (fst p') /\ (snd p) = (snd p'). Definition lt_key (p p':positive*A) := E.lt (fst p) (fst p'). - Lemma mem_find : + Lemma mem_find : forall m x, mem x m = match find x m with None => false | _ => true end. Proof. induction m; destruct x; simpl; auto. @@ -625,7 +625,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. simpl; generalize H0; rewrite Empty_alt; auto. Qed. - Section FMapSpec. + Section FMapSpec. Lemma mem_1 : forall m x, In x m -> mem x m = true. Proof. @@ -633,7 +633,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. destruct 1 as (e0,H0); rewrite H0; auto. Qed. - Lemma mem_2 : forall m x, mem x m = true -> In x m. + Lemma mem_2 : forall m x, mem x m = true -> In x m. Proof. unfold In, MapsTo; intros m x; rewrite mem_find. destruct (find x m). @@ -659,7 +659,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. rewrite Empty_alt; apply gempty. Qed. - Lemma is_empty_1 : Empty m -> is_empty m = true. + Lemma is_empty_1 : Empty m -> is_empty m = true. Proof. induction m; simpl; auto. rewrite Empty_Node. @@ -699,7 +699,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. Qed. Lemma remove_1 : E.eq x y -> ~ In y (remove x m). - Proof. + Proof. intros; intro. generalize (mem_1 H0). rewrite mem_find. @@ -716,15 +716,15 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. Qed. Lemma remove_3 : MapsTo y e (remove x m) -> MapsTo y e m. - Proof. + Proof. unfold MapsTo. destruct (E.eq_dec x y). subst. rewrite grs; intros; discriminate. rewrite gro; auto. Qed. - - Lemma elements_1 : + + Lemma elements_1 : MapsTo x e m -> InA eq_key_elt (x,e) (elements m). Proof. unfold MapsTo. @@ -736,7 +736,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. apply elements_correct; auto. Qed. - Lemma elements_2 : + Lemma elements_2 : InA eq_key_elt (x,e) (elements m) -> MapsTo x e m. Proof. unfold MapsTo. @@ -746,7 +746,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. apply elements_complete; auto. Qed. - Lemma xelements_bits_lt_1 : forall p p0 q m v, + Lemma xelements_bits_lt_1 : forall p p0 q m v, List.In (p0,v) (xelements m (append p (xO q))) -> E.bits_lt p0 p. Proof. intros. @@ -755,7 +755,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. induction p; destruct p0; simpl; intros; eauto; try discriminate. Qed. - Lemma xelements_bits_lt_2 : forall p p0 q m v, + Lemma xelements_bits_lt_2 : forall p p0 q m v, List.In (p0,v) (xelements m (append p (xI q))) -> E.bits_lt p p0. Proof. intros. @@ -803,7 +803,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. eapply xelements_bits_lt_2; eauto. Qed. - Lemma elements_3 : sort lt_key (elements m). + Lemma elements_3 : sort lt_key (elements m). Proof. unfold elements. apply xelements_sort; auto. @@ -818,7 +818,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. End FMapSpec. (** [map] and [mapi] *) - + Variable B : Type. Section Mapi. @@ -862,9 +862,9 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. rewrite append_neutral_l; auto. Qed. - Lemma mapi_1 : - forall (elt elt':Type)(m: t elt)(x:key)(e:elt)(f:key->elt->elt'), - MapsTo x e m -> + Lemma mapi_1 : + forall (elt elt':Type)(m: t elt)(x:key)(e:elt)(f:key->elt->elt'), + MapsTo x e m -> exists y, E.eq y x /\ MapsTo x (f y e) (mapi f m). Proof. intros. @@ -877,8 +877,8 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. simpl; auto. Qed. - Lemma mapi_2 : - forall (elt elt':Type)(m: t elt)(x:key)(f:key->elt->elt'), + Lemma mapi_2 : + forall (elt elt':Type)(m: t elt)(x:key)(f:key->elt->elt'), In x (mapi f m) -> In x m. Proof. intros. @@ -891,14 +891,14 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. simpl in *; discriminate. Qed. - Lemma map_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt)(f:elt->elt'), + Lemma map_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt)(f:elt->elt'), MapsTo x e m -> MapsTo x (f e) (map f m). Proof. intros; unfold map. destruct (mapi_1 (fun _ => f) H); intuition. Qed. - - Lemma map_2 : forall (elt elt':Type)(m: t elt)(x:key)(f:elt->elt'), + + Lemma map_2 : forall (elt elt':Type)(m: t elt)(x:key)(f:elt->elt'), In x (map f m) -> In x m. Proof. intros; unfold map in *; eapply mapi_2; eauto. @@ -907,7 +907,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. Section map2. Variable A B C : Type. Variable f : option A -> option B -> option C. - + Implicit Arguments Leaf [A]. Fixpoint xmap2_l (m : t A) {struct m} : t C := @@ -954,14 +954,14 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. End map2. - Definition map2 (elt elt' elt'':Type)(f:option elt->option elt'->option elt'') := + Definition map2 (elt elt' elt'':Type)(f:option elt->option elt'->option elt'') := _map2 (fun o1 o2 => match o1,o2 with None,None => None | _, _ => f o1 o2 end). Lemma map2_1 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt') - (x:key)(f:option elt->option elt'->option elt''), - In x m \/ In x m' -> - find x (map2 f m m') = f (find x m) (find x m'). - Proof. + (x:key)(f:option elt->option elt'->option elt''), + In x m \/ In x m' -> + find x (map2 f m m') = f (find x m) (find x m'). + Proof. intros. unfold map2. rewrite gmap2; auto. @@ -974,7 +974,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. Qed. Lemma map2_2 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt') - (x:key)(f:option elt->option elt'->option elt''), + (x:key)(f:option elt->option elt'->option elt''), In x (map2 f m m') -> In x m \/ In x m'. Proof. intros. @@ -1032,12 +1032,12 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. rewrite xfoldi_1; reflexivity. Qed. - Fixpoint equal (A:Type)(cmp : A -> A -> bool)(m1 m2 : t A) {struct m1} : bool := - match m1, m2 with + Fixpoint equal (A:Type)(cmp : A -> A -> bool)(m1 m2 : t A) {struct m1} : bool := + match m1, m2 with | Leaf, _ => is_empty m2 | _, Leaf => is_empty m1 - | Node l1 o1 r1, Node l2 o2 r2 => - (match o1, o2 with + | Node l1 o1 r1, Node l2 o2 r2 => + (match o1, o2 with | None, None => true | Some v1, Some v2 => cmp v1 v2 | _, _ => false @@ -1045,19 +1045,19 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. && equal cmp l1 l2 && equal cmp r1 r2 end. - Definition Equal (A:Type)(m m':t A) := + Definition Equal (A:Type)(m m':t A) := forall y, find y m = find y m'. - Definition Equiv (A:Type)(eq_elt:A->A->Prop) m m' := - (forall k, In k m <-> In k m') /\ - (forall k e e', MapsTo k e m -> MapsTo k e' m' -> eq_elt e e'). + Definition Equiv (A:Type)(eq_elt:A->A->Prop) m m' := + (forall k, In k m <-> In k m') /\ + (forall k e e', MapsTo k e m -> MapsTo k e' m' -> eq_elt e e'). Definition Equivb (A:Type)(cmp: A->A->bool) := Equiv (Cmp cmp). - Lemma equal_1 : forall (A:Type)(m m':t A)(cmp:A->A->bool), - Equivb cmp m m' -> equal cmp m m' = true. - Proof. + Lemma equal_1 : forall (A:Type)(m m':t A)(cmp:A->A->bool), + Equivb cmp m m' -> equal cmp m m' = true. + Proof. induction m. (* m = Leaf *) - destruct 1. + destruct 1. simpl. apply is_empty_1. red; red; intros. @@ -1069,7 +1069,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. (* m = Node *) destruct m'. (* m' = Leaf *) - destruct 1. + destruct 1. simpl. destruct o. assert (In xH (Leaf A)). @@ -1106,9 +1106,9 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. apply andb_true_intro; split; auto. Qed. - Lemma equal_2 : forall (A:Type)(m m':t A)(cmp:A->A->bool), - equal cmp m m' = true -> Equivb cmp m m'. - Proof. + Lemma equal_2 : forall (A:Type)(m m':t A)(cmp:A->A->bool), + equal cmp m m' = true -> Equivb cmp m m'. + Proof. induction m. (* m = Leaf *) simpl. @@ -1182,7 +1182,7 @@ Module PositiveMapAdditionalFacts. rewrite (IHi m2 v H); congruence. rewrite (IHi m1 v H); congruence. Qed. - + Lemma xmap2_lr : forall (A B : Type)(f g: option A -> option A -> option B)(m : t A), (forall (i j : option A), f i j = g j i) -> @@ -1210,7 +1210,7 @@ Module PositiveMapAdditionalFacts. auto. rewrite IHm1_1. rewrite IHm1_2. - auto. + auto. Qed. End PositiveMapAdditionalFacts. diff --git a/theories/FSets/FMapWeakList.v b/theories/FSets/FMapWeakList.v index 0c12516c4..e29bde236 100644 --- a/theories/FSets/FMapWeakList.v +++ b/theories/FSets/FMapWeakList.v @@ -8,7 +8,7 @@ (* $Id$ *) -(** * Finite map library *) +(** * Finite map library *) (** This file proposes an implementation of the non-dependant interface [FMapInterface.WS] using lists of pairs, unordered but without redundancy. *) @@ -29,7 +29,7 @@ Section Elt. Variable elt : Type. -Notation eqk := (eqk (elt:=elt)). +Notation eqk := (eqk (elt:=elt)). Notation eqke := (eqke (elt:=elt)). Notation MapsTo := (MapsTo (elt:=elt)). Notation In := (In (elt:=elt)). @@ -52,7 +52,7 @@ Qed. Hint Resolve empty_1. Lemma empty_NoDup : NoDupA empty. -Proof. +Proof. unfold empty; auto. Qed. @@ -60,7 +60,7 @@ Qed. Definition is_empty (l : t elt) : bool := if l then true else false. -Lemma is_empty_1 :forall m, Empty m -> is_empty m = true. +Lemma is_empty_1 :forall m, Empty m -> is_empty m = true. Proof. unfold Empty, PX.MapsTo. intros m. @@ -88,7 +88,7 @@ Function mem (k : key) (s : t elt) {struct s} : bool := Lemma mem_1 : forall m (Hm:NoDupA m) x, In x m -> mem x m = true. Proof. - intros m Hm x; generalize Hm; clear Hm. + intros m Hm x; generalize Hm; clear Hm. functional induction (mem x m);intros NoDup belong1;trivial. inversion belong1. inversion H. inversion_clear NoDup. @@ -98,13 +98,13 @@ Proof. contradiction. apply IHb; auto. exists x0; auto. -Qed. +Qed. -Lemma mem_2 : forall m (Hm:NoDupA m) x, mem x m = true -> In x m. +Lemma mem_2 : forall m (Hm:NoDupA m) x, mem x m = true -> In x m. Proof. intros m Hm x; generalize Hm; clear Hm; unfold PX.In,PX.MapsTo. functional induction (mem x m); intros NoDup hyp; try discriminate. - exists _x; auto. + exists _x; auto. inversion_clear NoDup. destruct IHb; auto. exists x0; auto. @@ -124,8 +124,8 @@ Proof. functional induction (find x m);simpl;intros e' eqfind; inversion eqfind; auto. Qed. -Lemma find_1 : forall m (Hm:NoDupA m) x e, - MapsTo x e m -> find x m = Some e. +Lemma find_1 : forall m (Hm:NoDupA m) x e, + MapsTo x e m -> find x m = Some e. Proof. intros m Hm x e; generalize Hm; clear Hm; unfold PX.MapsTo. functional induction (find x m);simpl; subst; try clear H_eq_1. @@ -142,7 +142,7 @@ Qed. (* Not part of the exported specifications, used later for [combine]. *) -Lemma find_eq : forall m (Hm:NoDupA m) x x', +Lemma find_eq : forall m (Hm:NoDupA m) x x', X.eq x x' -> find x m = find x' m. Proof. induction m; simpl; auto; destruct a; intros. @@ -167,7 +167,7 @@ Proof. functional induction (add x e m);simpl;auto. Qed. -Lemma add_2 : forall m x y e e', +Lemma add_2 : forall m x y e e', ~ X.eq x y -> MapsTo y e m -> MapsTo y e (add x e' m). Proof. intros m x y e e'; generalize y e; clear y e; unfold PX.MapsTo. @@ -178,7 +178,7 @@ Proof. auto. intros y' e'' eqky'; inversion_clear 1; intuition. Qed. - + Lemma add_3 : forall m x y e e', ~ X.eq x y -> MapsTo y e (add x e' m) -> MapsTo y e m. Proof. @@ -189,14 +189,14 @@ Proof. inversion_clear 2; auto. Qed. -Lemma add_3' : forall m x y e e', - ~ X.eq x y -> InA eqk (y,e) (add x e' m) -> InA eqk (y,e) m. +Lemma add_3' : forall m x y e e', + ~ X.eq x y -> InA eqk (y,e) (add x e' m) -> InA eqk (y,e) m. Proof. intros m x y e e'. generalize y e; clear y e. functional induction (add x e' m);simpl;auto. inversion_clear 2. compute in H1; elim H; auto. - inversion H1. + inversion H1. constructor 2; inversion_clear H0; auto. compute in H1; elim H; auto. inversion_clear 2; auto. @@ -218,7 +218,7 @@ Qed. (* Not part of the exported specifications, used later for [combine]. *) -Lemma add_eq : forall m (Hm:NoDupA m) x a e, +Lemma add_eq : forall m (Hm:NoDupA m) x a e, X.eq x a -> find x (add a e m) = Some e. Proof. intros. @@ -227,7 +227,7 @@ Proof. apply add_1; auto. Qed. -Lemma add_not_eq : forall m (Hm:NoDupA m) x a e, +Lemma add_not_eq : forall m (Hm:NoDupA m) x a e, ~X.eq x a -> find x (add a e m) = find x m. Proof. intros. @@ -250,7 +250,7 @@ Function remove (k : key) (s : t elt) {struct s} : t elt := match s with | nil => nil | (k',x) :: l => if X.eq_dec k k' then l else (k',x) :: remove k l - end. + end. Lemma remove_1 : forall m (Hm:NoDupA m) x y, X.eq x y -> ~ In y (remove x m). Proof. @@ -265,7 +265,7 @@ Proof. destruct H0 as (e,H2); unfold PX.MapsTo in H2. apply InA_eqk with (y,e); auto. compute; apply X.eq_trans with x; auto. - + intro H2. destruct H2 as (e,H2); inversion_clear H2. compute in H0; destruct H0. @@ -274,8 +274,8 @@ Proof. elim (IHt0 H2 H). exists e; auto. Qed. - -Lemma remove_2 : forall m (Hm:NoDupA m) x y e, + +Lemma remove_2 : forall m (Hm:NoDupA m) x y e, ~ X.eq x y -> MapsTo y e m -> MapsTo y e (remove x m). Proof. intros m Hm x y e; generalize Hm; clear Hm; unfold PX.MapsTo. @@ -283,11 +283,11 @@ Proof. inversion_clear 3; auto. compute in H1; destruct H1. elim H; apply X.eq_trans with k'; auto. - + inversion_clear 1; inversion_clear 2; auto. Qed. -Lemma remove_3 : forall m (Hm:NoDupA m) x y e, +Lemma remove_3 : forall m (Hm:NoDupA m) x y e, MapsTo y e (remove x m) -> MapsTo y e m. Proof. intros m Hm x y e; generalize Hm; clear Hm; unfold PX.MapsTo. @@ -295,7 +295,7 @@ Proof. do 2 inversion_clear 1; auto. Qed. -Lemma remove_3' : forall m (Hm:NoDupA m) x y e, +Lemma remove_3' : forall m (Hm:NoDupA m) x y e, InA eqk (y,e) (remove x m) -> InA eqk (y,e) m. Proof. intros m Hm x y e; generalize Hm; clear Hm; unfold PX.MapsTo. @@ -313,7 +313,7 @@ Proof. simpl; case (X.eq_dec x x'); auto. constructor; auto. contradict H; apply remove_3' with x; auto. -Qed. +Qed. (** * [elements] *) @@ -325,12 +325,12 @@ Proof. Qed. Lemma elements_2 : forall m x e, InA eqke (x,e) (elements m) -> MapsTo x e m. -Proof. +Proof. auto. Qed. -Lemma elements_3w : forall m (Hm:NoDupA m), NoDupA (elements m). -Proof. +Lemma elements_3w : forall m (Hm:NoDupA m), NoDupA (elements m). +Proof. auto. Qed. @@ -344,34 +344,34 @@ Function fold (A:Type)(f:key->elt->A->A)(m:t elt) (acc : A) {struct m} : A := Lemma fold_1 : forall m (A:Type)(i:A)(f:key->elt->A->A), fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i. -Proof. +Proof. intros; functional induction (@fold A f m i); auto. Qed. (** * [equal] *) -Definition check (cmp : elt -> elt -> bool)(k:key)(e:elt)(m': t elt) := - match find k m' with +Definition check (cmp : elt -> elt -> bool)(k:key)(e:elt)(m': t elt) := + match find k m' with | None => false | Some e' => cmp e e' end. -Definition submap (cmp : elt -> elt -> bool)(m m' : t elt) : bool := - fold (fun k e b => andb (check cmp k e m') b) m true. - +Definition submap (cmp : elt -> elt -> bool)(m m' : t elt) : bool := + fold (fun k e b => andb (check cmp k e m') b) m true. + Definition equal (cmp : elt -> elt -> bool)(m m' : t elt) : bool := andb (submap cmp m m') (submap (fun e' e => cmp e e') m' m). -Definition Submap cmp m m' := - (forall k, In k m -> In k m') /\ - (forall k e e', MapsTo k e m -> MapsTo k e' m' -> cmp e e' = true). +Definition Submap cmp m m' := + (forall k, In k m -> In k m') /\ + (forall k e e', MapsTo k e m -> MapsTo k e' m' -> cmp e e' = true). -Definition Equivb cmp m m' := - (forall k, In k m <-> In k m') /\ - (forall k e e', MapsTo k e m -> MapsTo k e' m' -> cmp e e' = true). +Definition Equivb cmp m m' := + (forall k, In k m <-> In k m') /\ + (forall k e e', MapsTo k e m -> MapsTo k e' m' -> cmp e e' = true). -Lemma submap_1 : forall m (Hm:NoDupA m) m' (Hm': NoDupA m') cmp, - Submap cmp m m' -> submap cmp m m' = true. +Lemma submap_1 : forall m (Hm:NoDupA m) m' (Hm': NoDupA m') cmp, + Submap cmp m m' -> submap cmp m m' = true. Proof. unfold Submap, submap. induction m. @@ -390,9 +390,9 @@ Proof. destruct H5 as (e'',H5); exists e''; auto. apply H0 with k; auto. Qed. - -Lemma submap_2 : forall m (Hm:NoDupA m) m' (Hm': NoDupA m') cmp, - submap cmp m m' = true -> Submap cmp m m'. + +Lemma submap_2 : forall m (Hm:NoDupA m) m' (Hm': NoDupA m') cmp, + submap cmp m m' = true -> Submap cmp m m'. Proof. unfold Submap, submap. induction m. @@ -400,7 +400,7 @@ Proof. intuition. destruct H0; inversion H0. inversion H0. - + destruct a; simpl; intros. inversion_clear Hm. rewrite andb_b_true in H. @@ -414,7 +414,7 @@ Proof. rewrite H2 in H. destruct (IHm H1 m' Hm' cmp H); auto. unfold check in H2. - case_eq (find t0 m'); [intros e' H5 | intros H5]; + case_eq (find t0 m'); [intros e' H5 | intros H5]; rewrite H5 in H2; try discriminate. split; intros. destruct H6 as (e0,H6); inversion_clear H6. @@ -432,15 +432,15 @@ Qed. (** Specification of [equal] *) -Lemma equal_1 : forall m (Hm:NoDupA m) m' (Hm': NoDupA m') cmp, - Equivb cmp m m' -> equal cmp m m' = true. -Proof. +Lemma equal_1 : forall m (Hm:NoDupA m) m' (Hm': NoDupA m') cmp, + Equivb cmp m m' -> equal cmp m m' = true. +Proof. unfold Equivb, equal. intuition. apply andb_true_intro; split; apply submap_1; unfold Submap; firstorder. Qed. -Lemma equal_2 : forall m (Hm:NoDupA m) m' (Hm':NoDupA m') cmp, +Lemma equal_2 : forall m (Hm:NoDupA m) m' (Hm':NoDupA m') cmp, equal cmp m m' = true -> Equivb cmp m m'. Proof. unfold Equivb, equal. @@ -449,12 +449,12 @@ Proof. generalize (submap_2 Hm Hm' H0). generalize (submap_2 Hm' Hm H1). firstorder. -Qed. +Qed. Variable elt':Type. (** * [map] and [mapi] *) - + Fixpoint map (f:elt -> elt') (m:t elt) {struct m} : t elt' := match m with | nil => nil @@ -468,24 +468,24 @@ Fixpoint mapi (f: key -> elt -> elt') (m:t elt) {struct m} : t elt' := end. End Elt. -Section Elt2. -(* A new section is necessary for previous definitions to work +Section Elt2. +(* A new section is necessary for previous definitions to work with different [elt], especially [MapsTo]... *) - + Variable elt elt' : Type. (** Specification of [map] *) -Lemma map_1 : forall (m:t elt)(x:key)(e:elt)(f:elt->elt'), +Lemma map_1 : forall (m:t elt)(x:key)(e:elt)(f:elt->elt'), MapsTo x e m -> MapsTo x (f e) (map f m). Proof. intros m x e f. (* functional induction map elt elt' f m. *) (* Marche pas ??? *) induction m. inversion 1. - + destruct a as (x',e'). - simpl. + simpl. inversion_clear 1. constructor 1. unfold eqke in *; simpl in *; intuition congruence. @@ -493,15 +493,15 @@ Proof. unfold MapsTo in *; auto. Qed. -Lemma map_2 : forall (m:t elt)(x:key)(f:elt->elt'), +Lemma map_2 : forall (m:t elt)(x:key)(f:elt->elt'), In x (map f m) -> In x m. Proof. - intros m x f. + intros m x f. (* functional induction map elt elt' f m. *) (* Marche pas ??? *) induction m; simpl. intros (e,abs). inversion abs. - + destruct a as (x',e). intros hyp. inversion hyp. clear hyp. @@ -514,9 +514,9 @@ Proof. constructor 2; auto. Qed. -Lemma map_NoDup : forall m (Hm : NoDupA (@eqk elt) m)(f:elt->elt'), +Lemma map_NoDup : forall m (Hm : NoDupA (@eqk elt) m)(f:elt->elt'), NoDupA (@eqk elt') (map f m). -Proof. +Proof. induction m; simpl; auto. intros. destruct a as (x',e'). @@ -524,25 +524,25 @@ Proof. constructor; auto. contradict H. (* il faut un map_1 avec eqk au lieu de eqke *) - clear IHm H0. + clear IHm H0. induction m; simpl in *; auto. inversion H. destruct a; inversion H; auto. -Qed. - +Qed. + (** Specification of [mapi] *) -Lemma mapi_1 : forall (m:t elt)(x:key)(e:elt)(f:key->elt->elt'), - MapsTo x e m -> +Lemma mapi_1 : forall (m:t elt)(x:key)(e:elt)(f:key->elt->elt'), + MapsTo x e m -> exists y, X.eq y x /\ MapsTo x (f y e) (mapi f m). Proof. intros m x e f. (* functional induction mapi elt elt' f m. *) (* Marche pas ??? *) induction m. inversion 1. - + destruct a as (x',e'). - simpl. + simpl. inversion_clear 1. exists x'. destruct H0; simpl in *. @@ -551,17 +551,17 @@ Proof. unfold eqke in *; simpl in *; intuition congruence. destruct IHm as (y, hyp); auto. exists y; intuition. -Qed. +Qed. -Lemma mapi_2 : forall (m:t elt)(x:key)(f:key->elt->elt'), +Lemma mapi_2 : forall (m:t elt)(x:key)(f:key->elt->elt'), In x (mapi f m) -> In x m. Proof. - intros m x f. + intros m x f. (* functional induction mapi elt elt' f m. *) (* Marche pas ??? *) induction m; simpl. intros (e,abs). inversion abs. - + destruct a as (x',e). intros hyp. inversion hyp. clear hyp. @@ -574,7 +574,7 @@ Proof. constructor 2; auto. Qed. -Lemma mapi_NoDup : forall m (Hm : NoDupA (@eqk elt) m)(f: key->elt->elt'), +Lemma mapi_NoDup : forall m (Hm : NoDupA (@eqk elt) m)(f: key->elt->elt'), NoDupA (@eqk elt') (mapi f m). Proof. induction m; simpl; auto. @@ -589,30 +589,30 @@ Proof. destruct a; inversion_clear H; auto. Qed. -End Elt2. +End Elt2. Section Elt3. Variable elt elt' elt'' : Type. Notation oee' := (option elt * option elt')%type. - + Definition combine_l (m:t elt)(m':t elt') : t oee' := - mapi (fun k e => (Some e, find k m')) m. + mapi (fun k e => (Some e, find k m')) m. Definition combine_r (m:t elt)(m':t elt') : t oee' := - mapi (fun k e' => (find k m, Some e')) m'. + mapi (fun k e' => (find k m, Some e')) m'. -Definition fold_right_pair (A B C:Type)(f:A->B->C->C)(l:list (A*B))(i:C) := +Definition fold_right_pair (A B C:Type)(f:A->B->C->C)(l:list (A*B))(i:C) := List.fold_right (fun p => f (fst p) (snd p)) i l. -Definition combine (m:t elt)(m':t elt') : t oee' := - let l := combine_l m m' in - let r := combine_r m m' in +Definition combine (m:t elt)(m':t elt') : t oee' := + let l := combine_l m m' in + let r := combine_r m m' in fold_right_pair (add (elt:=oee')) l r. -Lemma fold_right_pair_NoDup : - forall l r (Hl: NoDupA (eqk (elt:=oee')) l) - (Hl: NoDupA (eqk (elt:=oee')) r), +Lemma fold_right_pair_NoDup : + forall l r (Hl: NoDupA (eqk (elt:=oee')) l) + (Hl: NoDupA (eqk (elt:=oee')) r), NoDupA (eqk (elt:=oee')) (fold_right_pair (add (elt:=oee')) l r). Proof. induction l; simpl; auto. @@ -622,8 +622,8 @@ Proof. Qed. Hint Resolve fold_right_pair_NoDup. -Lemma combine_NoDup : - forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m'), +Lemma combine_NoDup : + forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m'), NoDupA (@eqk oee') (combine m m'). Proof. unfold combine, combine_r, combine_l. @@ -637,21 +637,21 @@ Proof. auto. Qed. -Definition at_least_left (o:option elt)(o':option elt') := - match o with - | None => None +Definition at_least_left (o:option elt)(o':option elt') := + match o with + | None => None | _ => Some (o,o') end. -Definition at_least_right (o:option elt)(o':option elt') := - match o' with - | None => None +Definition at_least_right (o:option elt)(o':option elt') := + match o' with + | None => None | _ => Some (o,o') end. -Lemma combine_l_1 : - forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m')(x:key), - find x (combine_l m m') = at_least_left (find x m) (find x m'). +Lemma combine_l_1 : + forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m')(x:key), + find x (combine_l m m') = at_least_left (find x m) (find x m'). Proof. unfold combine_l. intros. @@ -668,9 +668,9 @@ Proof. rewrite (find_1 Hm H1) in H; discriminate. Qed. -Lemma combine_r_1 : - forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m')(x:key), - find x (combine_r m m') = at_least_right (find x m) (find x m'). +Lemma combine_r_1 : + forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m')(x:key), + find x (combine_r m m') = at_least_right (find x m) (find x m'). Proof. unfold combine_r. intros. @@ -687,15 +687,15 @@ Proof. rewrite (find_1 Hm' H1) in H; discriminate. Qed. -Definition at_least_one (o:option elt)(o':option elt') := - match o, o' with - | None, None => None +Definition at_least_one (o:option elt)(o':option elt') := + match o, o' with + | None, None => None | _, _ => Some (o,o') end. -Lemma combine_1 : - forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m')(x:key), - find x (combine m m') = at_least_one (find x m) (find x m'). +Lemma combine_1 : + forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m')(x:key), + find x (combine m m') = at_least_one (find x m) (find x m'). Proof. unfold combine. intros. @@ -726,19 +726,19 @@ Qed. Variable f : option elt -> option elt' -> option elt''. -Definition option_cons (A:Type)(k:key)(o:option A)(l:list (key*A)) := +Definition option_cons (A:Type)(k:key)(o:option A)(l:list (key*A)) := match o with | Some e => (k,e)::l | None => l end. -Definition map2 m m' := - let m0 : t oee' := combine m m' in - let m1 : t (option elt'') := map (fun p => f (fst p) (snd p)) m0 in +Definition map2 m m' := + let m0 : t oee' := combine m m' in + let m1 : t (option elt'') := map (fun p => f (fst p) (snd p)) m0 in fold_right_pair (option_cons (A:=elt'')) m1 nil. -Lemma map2_NoDup : - forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m'), +Lemma map2_NoDup : + forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m'), NoDupA (@eqk elt'') (map2 m m'). Proof. intros. @@ -747,7 +747,7 @@ Proof. set (l0:=combine m m') in *; clearbody l0. set (f':= fun p : oee' => f (fst p) (snd p)). assert (H1:=map_NoDup (elt' := option elt'') H0 f'). - set (l1:=map f' l0) in *; clearbody l1. + set (l1:=map f' l0) in *; clearbody l1. clear f' f H0 l0 Hm Hm' m m'. induction l1. simpl; auto. @@ -763,15 +763,15 @@ Proof. inversion_clear H; auto. Qed. -Definition at_least_one_then_f (o:option elt)(o':option elt') := - match o, o' with - | None, None => None +Definition at_least_one_then_f (o:option elt)(o':option elt') := + match o, o' with + | None, None => None | _, _ => f o o' end. -Lemma map2_0 : - forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m')(x:key), - find x (map2 m m') = at_least_one_then_f (find x m) (find x m'). +Lemma map2_0 : + forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m')(x:key), + find x (map2 m m') = at_least_one_then_f (find x m) (find x m'). Proof. intros. unfold map2. @@ -779,7 +779,7 @@ Proof. assert (H2:=combine_NoDup Hm Hm'). set (f':= fun p : oee' => f (fst p) (snd p)). set (m0 := combine m m') in *; clearbody m0. - set (o:=find x m) in *; clearbody o. + set (o:=find x m) in *; clearbody o. set (o':=find x m') in *; clearbody o'. clear Hm Hm' m m'. generalize H; clear H. @@ -795,14 +795,14 @@ Proof. destruct o; destruct o'; simpl in *; inversion_clear H; auto. rewrite H2. unfold f'; simpl. - destruct (f oo oo'); simpl. + destruct (f oo oo'); simpl. destruct (X.eq_dec x k); try contradict n; auto. destruct (IHm0 H1) as (_,H4); apply H4; auto. case_eq (find x m0); intros; auto. elim H0. apply InA_eqk with (x,p); auto. apply InA_eqke_eqk. - exact (find_2 H3). + exact (find_2 H3). (* k < x *) unfold f'; simpl. destruct (f oo oo'); simpl. @@ -826,10 +826,10 @@ Proof. Qed. (** Specification of [map2] *) -Lemma map2_1 : +Lemma map2_1 : forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m')(x:key), - In x m \/ In x m' -> - find x (map2 m m') = f (find x m) (find x m'). + In x m \/ In x m' -> + find x (map2 m m') = f (find x m) (find x m'). Proof. intros. rewrite map2_0; auto. @@ -839,10 +839,10 @@ Proof. rewrite (find_1 Hm' H). destruct (find x m); simpl; auto. Qed. - -Lemma map2_2 : - forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m')(x:key), - In x (map2 m m') -> In x m \/ In x m'. + +Lemma map2_2 : + forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m')(x:key), + In x (map2 m m') -> In x m \/ In x m'. Proof. intros. destruct H as (e,H). @@ -850,9 +850,9 @@ Proof. rewrite (find_1 (map2_NoDup Hm Hm') H). generalize (@find_2 _ m x). generalize (@find_2 _ m' x). - destruct (find x m); + destruct (find x m); destruct (find x m'); simpl; intros. - left; exists e0; auto. + left; exists e0; auto. left; exists e0; auto. right; exists e0; auto. discriminate. @@ -863,31 +863,31 @@ End Raw. Module Make (X: DecidableType) <: WS with Module E:=X. - Module Raw := Raw X. + Module Raw := Raw X. Module E := X. - Definition key := E.t. + Definition key := E.t. - Record slist (elt:Type) := + Record slist (elt:Type) := {this :> Raw.t elt; NoDup : NoDupA (@Raw.PX.eqk elt) this}. - Definition t (elt:Type) := slist elt. + Definition t (elt:Type) := slist elt. -Section Elt. - Variable elt elt' elt'':Type. +Section Elt. + Variable elt elt' elt'':Type. Implicit Types m : t elt. - Implicit Types x y : key. + Implicit Types x y : key. Implicit Types e : elt. Definition empty : t elt := Build_slist (Raw.empty_NoDup elt). Definition is_empty m : bool := Raw.is_empty m.(this). Definition add x e m : t elt := Build_slist (Raw.add_NoDup m.(NoDup) x e). Definition find x m : option elt := Raw.find x m.(this). - Definition remove x m : t elt := Build_slist (Raw.remove_NoDup m.(NoDup) x). + Definition remove x m : t elt := Build_slist (Raw.remove_NoDup m.(NoDup) x). Definition mem x m : bool := Raw.mem x m.(this). Definition map f m : t elt' := Build_slist (Raw.map_NoDup m.(NoDup) f). Definition mapi (f:key->elt->elt') m : t elt' := Build_slist (Raw.mapi_NoDup m.(NoDup) f). - Definition map2 f m (m':t elt') : t elt'' := + Definition map2 f m (m':t elt') : t elt'' := Build_slist (Raw.map2_NoDup f m.(NoDup) m'.(NoDup)). Definition elements m : list (key*elt) := @Raw.elements elt m.(this). Definition cardinal m := length m.(this). @@ -898,9 +898,9 @@ Section Elt. Definition Empty m : Prop := Raw.Empty m.(this). Definition Equal m m' := forall y, find y m = find y m'. - Definition Equiv (eq_elt:elt->elt->Prop) m m' := - (forall k, In k m <-> In k m') /\ - (forall k e e', MapsTo k e m -> MapsTo k e' m' -> eq_elt e e'). + Definition Equiv (eq_elt:elt->elt->Prop) m m' := + (forall k, In k m <-> In k m') /\ + (forall k e e', MapsTo k e m -> MapsTo k e' m' -> eq_elt e e'). Definition Equivb cmp m m' : Prop := @Raw.Equivb elt cmp m.(this) m'.(this). Definition eq_key : (key*elt) -> (key*elt) -> Prop := @Raw.PX.eqk elt. @@ -936,7 +936,7 @@ Section Elt. Lemma remove_3 : forall m x y e, MapsTo y e (remove x m) -> MapsTo y e m. Proof. intros m; exact (@Raw.remove_3 elt m.(this) m.(NoDup)). Qed. - Lemma find_1 : forall m x e, MapsTo x e m -> find x m = Some e. + Lemma find_1 : forall m x e, MapsTo x e m -> find x m = Some e. Proof. intros m; exact (@Raw.find_1 elt m.(this) m.(NoDup)). Qed. Lemma find_2 : forall m x e, find x m = Some e -> MapsTo x e m. Proof. intros m; exact (@Raw.find_2 elt m.(this)). Qed. @@ -945,32 +945,32 @@ Section Elt. Proof. intros m; exact (@Raw.elements_1 elt m.(this)). Qed. Lemma elements_2 : forall m x e, InA eq_key_elt (x,e) (elements m) -> MapsTo x e m. Proof. intros m; exact (@Raw.elements_2 elt m.(this)). Qed. - Lemma elements_3w : forall m, NoDupA eq_key (elements m). + Lemma elements_3w : forall m, NoDupA eq_key (elements m). Proof. intros m; exact (@Raw.elements_3w elt m.(this) m.(NoDup)). Qed. - - Lemma cardinal_1 : forall m, cardinal m = length (elements m). + + Lemma cardinal_1 : forall m, cardinal m = length (elements m). Proof. intros; reflexivity. Qed. Lemma fold_1 : forall m (A : Type) (i : A) (f : key -> elt -> A -> A), fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i. Proof. intros m; exact (@Raw.fold_1 elt m.(this)). Qed. - Lemma equal_1 : forall m m' cmp, Equivb cmp m m' -> equal cmp m m' = true. + Lemma equal_1 : forall m m' cmp, Equivb cmp m m' -> equal cmp m m' = true. Proof. intros m m'; exact (@Raw.equal_1 elt m.(this) m.(NoDup) m'.(this) m'.(NoDup)). Qed. Lemma equal_2 : forall m m' cmp, equal cmp m m' = true -> Equivb cmp m m'. Proof. intros m m'; exact (@Raw.equal_2 elt m.(this) m.(NoDup) m'.(this) m'.(NoDup)). Qed. End Elt. - - Lemma map_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt)(f:elt->elt'), + + Lemma map_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt)(f:elt->elt'), MapsTo x e m -> MapsTo x (f e) (map f m). Proof. intros elt elt' m; exact (@Raw.map_1 elt elt' m.(this)). Qed. - Lemma map_2 : forall (elt elt':Type)(m: t elt)(x:key)(f:elt->elt'), - In x (map f m) -> In x m. + Lemma map_2 : forall (elt elt':Type)(m: t elt)(x:key)(f:elt->elt'), + In x (map f m) -> In x m. Proof. intros elt elt' m; exact (@Raw.map_2 elt elt' m.(this)). Qed. Lemma mapi_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt) - (f:key->elt->elt'), MapsTo x e m -> + (f:key->elt->elt'), MapsTo x e m -> exists y, E.eq y x /\ MapsTo x (f y e) (mapi f m). Proof. intros elt elt' m; exact (@Raw.mapi_1 elt elt' m.(this)). Qed. Lemma mapi_2 : forall (elt elt':Type)(m: t elt)(x:key) @@ -978,18 +978,18 @@ Section Elt. Proof. intros elt elt' m; exact (@Raw.mapi_2 elt elt' m.(this)). Qed. Lemma map2_1 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt') - (x:key)(f:option elt->option elt'->option elt''), - In x m \/ In x m' -> - find x (map2 f m m') = f (find x m) (find x m'). - Proof. - intros elt elt' elt'' m m' x f; + (x:key)(f:option elt->option elt'->option elt''), + In x m \/ In x m' -> + find x (map2 f m m') = f (find x m) (find x m'). + Proof. + intros elt elt' elt'' m m' x f; exact (@Raw.map2_1 elt elt' elt'' f m.(this) m.(NoDup) m'.(this) m'.(NoDup) x). Qed. Lemma map2_2 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt') - (x:key)(f:option elt->option elt'->option elt''), + (x:key)(f:option elt->option elt'->option elt''), In x (map2 f m m') -> In x m \/ In x m'. - Proof. - intros elt elt' elt'' m m' x f; + Proof. + intros elt elt' elt'' m m' x f; exact (@Raw.map2_2 elt elt' elt'' f m.(this) m.(NoDup) m'.(this) m'.(NoDup) x). Qed. diff --git a/theories/FSets/FSetAVL.v b/theories/FSets/FSetAVL.v index 10e06711f..0f0e675ee 100644 --- a/theories/FSets/FSetAVL.v +++ b/theories/FSets/FSetAVL.v @@ -6,8 +6,8 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* Finite sets library. - * Authors: Pierre Letouzey and Jean-Christophe Filliâtre +(* Finite sets library. + * Authors: Pierre Letouzey and Jean-Christophe Filliâtre * Institution: LRI, CNRS UMR 8623 - Université Paris Sud * 91405 Orsay, France *) @@ -17,14 +17,14 @@ (** This module implements sets using AVL trees. It follows the implementation from Ocaml's standard library, - + All operations given here expect and produce well-balanced trees (in the ocaml sense: heigths of subtrees shouldn't differ by more than 2), and hence has low complexities (e.g. add is logarithmic in the size of the set). But proving these balancing preservations is in fact not necessary for ensuring correct operational behavior and hence fulfilling the FSet interface. As a consequence, - balancing results are not part of this file anymore, they can + balancing results are not part of this file anymore, they can now be found in [FSetFullAVL]. Four operations ([union], [subset], [compare] and [equal]) have @@ -47,9 +47,9 @@ Unset Strict Implicit. Notation "s #1" := (fst s) (at level 9, format "s '#1'") : pair_scope. Notation "s #2" := (snd s) (at level 9, format "s '#2'") : pair_scope. -(** * Raw - - Functor of pure functions + a posteriori proofs of invariant +(** * Raw + + Functor of pure functions + a posteriori proofs of invariant preservation *) Module Raw (Import I:Int)(X:OrderedType). @@ -89,19 +89,19 @@ Definition empty := Leaf. (** * Emptyness test *) -Definition is_empty s := +Definition is_empty s := match s with Leaf => true | _ => false end. (** * Appartness *) -(** The [mem] function is deciding appartness. It exploits the +(** The [mem] function is deciding appartness. It exploits the binary search tree invariant to achieve logarithmic complexity. *) -Fixpoint mem x s := - match s with - | Leaf => false - | Node l y r _ => match X.compare x y with - | LT _ => mem x l +Fixpoint mem x s := + match s with + | Leaf => false + | Node l y r _ => match X.compare x y with + | LT _ => mem x l | EQ _ => true | GT _ => mem x r end @@ -116,7 +116,7 @@ Definition singleton x := Node Leaf x Leaf 1. (** [create l x r] creates a node, assuming [l] and [r] to be balanced and [|height l - height r| <= 2]. *) -Definition create l x r := +Definition create l x r := Node l x r (max (height l) (height r) + 1). (** [bal l x r] acts as [create], but performs one step of @@ -124,44 +124,44 @@ Definition create l x r := Definition assert_false := create. -Definition bal l x r := - let hl := height l in +Definition bal l x r := + let hl := height l in let hr := height r in - if gt_le_dec hl (hr+2) then - match l with + if gt_le_dec hl (hr+2) then + match l with | Leaf => assert_false l x r - | Node ll lx lr _ => - if ge_lt_dec (height ll) (height lr) then + | Node ll lx lr _ => + if ge_lt_dec (height ll) (height lr) then create ll lx (create lr x r) - else - match lr with + else + match lr with | Leaf => assert_false l x r - | Node lrl lrx lrr _ => + | Node lrl lrx lrr _ => create (create ll lx lrl) lrx (create lrr x r) end end - else - if gt_le_dec hr (hl+2) then + else + if gt_le_dec hr (hl+2) then match r with | Leaf => assert_false l x r | Node rl rx rr _ => - if ge_lt_dec (height rr) (height rl) then + if ge_lt_dec (height rr) (height rl) then create (create l x rl) rx rr - else + else match rl with | Leaf => assert_false l x r - | Node rll rlx rlr _ => - create (create l x rll) rlx (create rlr rx rr) + | Node rll rlx rlr _ => + create (create l x rll) rlx (create rlr rx rr) end end - else + else create l x r. (** * Insertion *) -Fixpoint add x s := match s with +Fixpoint add x s := match s with | Leaf => Node Leaf x Leaf 1 - | Node l y r h => + | Node l y r h => match X.compare x y with | LT _ => bal (add x l) y r | EQ _ => Node l y r h @@ -171,19 +171,19 @@ Fixpoint add x s := match s with (** * Join - Same as [bal] but does not assume anything regarding heights - of [l] and [r]. + Same as [bal] but does not assume anything regarding heights + of [l] and [r]. *) Fixpoint join l : elt -> t -> t := match l with | Leaf => add - | Node ll lx lr lh => fun x => - fix join_aux (r:t) : t := match r with + | Node ll lx lr lh => fun x => + fix join_aux (r:t) : t := match r with | Leaf => add x l - | Node rl rx rr rh => + | Node rl rx rr rh => if gt_le_dec lh (rh+2) then bal ll lx (join lr x r) - else if gt_le_dec rh (lh+2) then bal (join_aux rl) rx rr + else if gt_le_dec rh (lh+2) then bal (join_aux rl) rx rr else create l x r end end. @@ -194,11 +194,11 @@ Fixpoint join l : elt -> t -> t := [t = Node l x r h]. Since we can't deal here with [assert false] for [t=Leaf], we pre-unpack [t] (and forget about [h]). *) - -Fixpoint remove_min l x r : t*elt := - match l with + +Fixpoint remove_min l x r : t*elt := + match l with | Leaf => (r,x) - | Node ll lx lr lh => + | Node ll lx lr lh => let (l',m) := remove_min ll lx lr in (bal l' x r, m) end. @@ -209,16 +209,16 @@ Fixpoint remove_min l x r : t*elt := [|height t1 - height t2| <= 2]. *) -Definition merge s1 s2 := match s1,s2 with - | Leaf, _ => s2 +Definition merge s1 s2 := match s1,s2 with + | Leaf, _ => s2 | _, Leaf => s1 - | _, Node l2 x2 r2 h2 => + | _, Node l2 x2 r2 h2 => let (s2',m) := remove_min l2 x2 r2 in bal s1 m s2' end. (** * Deletion *) -Fixpoint remove x s := match s with +Fixpoint remove x s := match s with | Leaf => Leaf | Node l y r h => match X.compare x y with @@ -230,7 +230,7 @@ Fixpoint remove x s := match s with (** * Minimum element *) -Fixpoint min_elt s := match s with +Fixpoint min_elt s := match s with | Leaf => None | Node Leaf y _ _ => Some y | Node l _ _ _ => min_elt l @@ -238,7 +238,7 @@ end. (** * Maximum element *) -Fixpoint max_elt s := match s with +Fixpoint max_elt s := match s with | Leaf => None | Node _ y Leaf _ => Some y | Node _ _ r _ => max_elt r @@ -253,16 +253,16 @@ Definition choose := min_elt. Same as [merge] but does not assume anything about heights. *) -Definition concat s1 s2 := - match s1, s2 with - | Leaf, _ => s2 +Definition concat s1 s2 := + match s1, s2 with + | Leaf, _ => s2 | _, Leaf => s1 - | _, Node l2 x2 r2 _ => - let (s2',m) := remove_min l2 x2 r2 in + | _, Node l2 x2 r2 _ => + let (s2',m) := remove_min l2 x2 r2 in join s1 m s2' end. -(** * Splitting +(** * Splitting [split x s] returns a triple [(l, present, r)] where - [l] is the set of elements of [s] that are [< x] @@ -278,8 +278,8 @@ Notation "t #r" := (t_right t) (at level 9, format "t '#r'"). Fixpoint split x s : triple := match s with | Leaf => << Leaf, false, Leaf >> - | Node l y r h => - match X.compare x y with + | Node l y r h => + match X.compare x y with | LT _ => let (ll,b,rl) := split x l in << ll, b, join rl y r >> | EQ _ => << l, true, r >> | GT _ => let (rl,b,rr) := split x r in << join l y rl, b, rr >> @@ -288,22 +288,22 @@ Fixpoint split x s : triple := match s with (** * Intersection *) -Fixpoint inter s1 s2 := match s1, s2 with +Fixpoint inter s1 s2 := match s1, s2 with | Leaf, _ => Leaf | _, Leaf => Leaf - | Node l1 x1 r1 h1, _ => - let (l2',pres,r2') := split x1 s2 in + | Node l1 x1 r1 h1, _ => + let (l2',pres,r2') := split x1 s2 in if pres then join (inter l1 l2') x1 (inter r1 r2') else concat (inter l1 l2') (inter r1 r2') end. (** * Difference *) -Fixpoint diff s1 s2 := match s1, s2 with +Fixpoint diff s1 s2 := match s1, s2 with | Leaf, _ => Leaf | _, Leaf => s1 - | Node l1 x1 r1 h1, _ => - let (l2',pres,r2') := split x1 s2 in + | Node l1 x1 r1 h1, _ => + let (l2',pres,r2') := split x1 s2 in if pres then concat (diff l1 l2') (diff r1 r2') else join (diff l1 l2') x1 (diff r1 r2') end. @@ -318,15 +318,15 @@ end. experimentally all the tests I've made in ocaml have shown this potential slowdown to be non-significant. Anyway, the exact code of ocaml has also been formalized thanks to Function+measure, see - [ocaml_union] in [FSetFullAVL]. + [ocaml_union] in [FSetFullAVL]. *) -Fixpoint union s1 s2 := - match s1, s2 with +Fixpoint union s1 s2 := + match s1, s2 with | Leaf, _ => s2 | _, Leaf => s1 - | Node l1 x1 r1 h1, _ => - let (l2',_,r2') := split x1 s2 in + | Node l1 x1 r1 h1, _ => + let (l2',_,r2') := split x1 s2 in join (union l1 l2') x1 (union r1 r2') end. @@ -347,10 +347,10 @@ Definition elements := elements_aux nil. (** * Filter *) -Fixpoint filter_acc (f:elt->bool) acc s := match s with +Fixpoint filter_acc (f:elt->bool) acc s := match s with | Leaf => acc - | Node l x r h => - filter_acc f (filter_acc f (if f x then add x acc else acc) l) r + | Node l x r h => + filter_acc f (filter_acc f (if f x then add x acc else acc) l) r end. Definition filter f := filter_acc f Leaf. @@ -358,11 +358,11 @@ Definition filter f := filter_acc f Leaf. (** * Partition *) -Fixpoint partition_acc (f:elt->bool)(acc : t*t)(s : t) : t*t := - match s with +Fixpoint partition_acc (f:elt->bool)(acc : t*t)(s : t) : t*t := + match s with | Leaf => acc - | Node l x r _ => - let (acct,accf) := acc in + | Node l x r _ => + let (acct,accf) := acc in partition_acc f (partition_acc f (if f x then (add x acct, accf) else (acct, add x accf)) l) r @@ -372,19 +372,19 @@ Definition partition f := partition_acc f (Leaf,Leaf). (** * [for_all] and [exists] *) -Fixpoint for_all (f:elt->bool) s := match s with +Fixpoint for_all (f:elt->bool) s := match s with | Leaf => true | Node l x r _ => f x &&& for_all f l &&& for_all f r end. -Fixpoint exists_ (f:elt->bool) s := match s with +Fixpoint exists_ (f:elt->bool) s := match s with | Leaf => false | Node l x r _ => f x ||| exists_ f l ||| exists_ f r end. (** * Fold *) -Fixpoint fold (A : Type) (f : elt -> A -> A)(s : tree) : A -> A := +Fixpoint fold (A : Type) (f : elt -> A -> A)(s : tree) : A -> A := fun a => match s with | Leaf => a | Node l x r _ => fold f r (f x (fold f l a)) @@ -394,43 +394,43 @@ Implicit Arguments fold [A]. (** * Subset *) -(** In ocaml, recursive calls are made on "half-trees" such as +(** In ocaml, recursive calls are made on "half-trees" such as (Node l1 x1 Leaf _) and (Node Leaf x1 r1 _). Instead of these non-structural calls, we propose here two specialized functions for - these situations. This version should be almost as efficient as - the one of ocaml (closures as arguments may slow things a bit), + these situations. This version should be almost as efficient as + the one of ocaml (closures as arguments may slow things a bit), it is simply less compact. The exact ocaml version has also been - formalized (thanks to Function+measure), see [ocaml_subset] in + formalized (thanks to Function+measure), see [ocaml_subset] in [FSetFullAVL]. *) -Fixpoint subsetl (subset_l1:t->bool) x1 s2 : bool := - match s2 with +Fixpoint subsetl (subset_l1:t->bool) x1 s2 : bool := + match s2 with | Leaf => false - | Node l2 x2 r2 h2 => - match X.compare x1 x2 with - | EQ _ => subset_l1 l2 + | Node l2 x2 r2 h2 => + match X.compare x1 x2 with + | EQ _ => subset_l1 l2 | LT _ => subsetl subset_l1 x1 l2 | GT _ => mem x1 r2 &&& subset_l1 s2 end end. -Fixpoint subsetr (subset_r1:t->bool) x1 s2 : bool := - match s2 with +Fixpoint subsetr (subset_r1:t->bool) x1 s2 : bool := + match s2 with | Leaf => false - | Node l2 x2 r2 h2 => - match X.compare x1 x2 with - | EQ _ => subset_r1 r2 + | Node l2 x2 r2 h2 => + match X.compare x1 x2 with + | EQ _ => subset_r1 r2 | LT _ => mem x1 l2 &&& subset_r1 s2 | GT _ => subsetr subset_r1 x1 r2 end end. -Fixpoint subset s1 s2 : bool := match s1, s2 with +Fixpoint subset s1 s2 : bool := match s1, s2 with | Leaf, _ => true | Node _ _ _ _, Leaf => false - | Node l1 x1 r1 h1, Node l2 x2 r2 h2 => - match X.compare x1 x2 with + | Node l1 x1 r1 h1, Node l2 x2 r2 h2 => + match X.compare x1 x2 with | EQ _ => subset l1 l2 &&& subset r1 r2 | LT _ => subsetl (subset l1) x1 l2 &&& subset r1 s2 | GT _ => subsetr (subset r1) x1 r2 &&& subset l1 s2 @@ -442,8 +442,8 @@ Fixpoint subset s1 s2 : bool := match s1, s2 with Transformation in C.P.S. suggested by Benjamin Grégoire. The original ocaml code (with non-structural recursive calls) has also been formalized (thanks to Function+measure), see - [ocaml_compare] in [FSetFullAVL]. The following code with - continuations computes dramatically faster in Coq, and + [ocaml_compare] in [FSetFullAVL]. The following code with + continuations computes dramatically faster in Coq, and should be almost as efficient after extraction. *) @@ -454,11 +454,11 @@ Inductive enumeration := | More : elt -> tree -> enumeration -> enumeration. -(** [cons t e] adds the elements of tree [t] on the head of +(** [cons t e] adds the elements of tree [t] on the head of enumeration [e]. *) -Fixpoint cons s e : enumeration := - match s with +Fixpoint cons s e : enumeration := + match s with | Leaf => e | Node l x r h => cons l (More x r e) end. @@ -478,7 +478,7 @@ Definition compare_more x1 (cont:enumeration->comparison) e2 := (** Comparison of left tree, middle element, then right tree *) -Fixpoint compare_cont s1 (cont:enumeration->comparison) e2 := +Fixpoint compare_cont s1 (cont:enumeration->comparison) e2 := match s1 with | Leaf => cont e2 | Node l1 x1 r1 _ => @@ -487,7 +487,7 @@ Fixpoint compare_cont s1 (cont:enumeration->comparison) e2 := (** Initial continuation *) -Definition compare_end e2 := +Definition compare_end e2 := match e2 with End => Eq | _ => Lt end. (** The complete comparison *) @@ -496,10 +496,10 @@ Definition compare s1 s2 := compare_cont s1 compare_end (cons s2 End). (** * Equality test *) -Definition equal s1 s2 : bool := - match compare s1 s2 with +Definition equal s1 s2 : bool := + match compare s1 s2 with | Eq => true - | _ => false + | _ => false end. @@ -516,7 +516,7 @@ Inductive In (x : elt) : tree -> Prop := (** ** Binary search trees *) -(** [lt_tree x s]: all elements in [s] are smaller than [x] +(** [lt_tree x s]: all elements in [s] are smaller than [x] (resp. greater for [gt_tree]) *) Definition lt_tree x s := forall y, In y s -> X.lt y x. @@ -526,7 +526,7 @@ Definition gt_tree x s := forall y, In y s -> X.lt x y. Inductive bst : tree -> Prop := | BSLeaf : bst Leaf - | BSNode : forall x l r h, bst l -> bst r -> + | BSNode : forall x l r h, bst l -> bst r -> lt_tree x l -> gt_tree x r -> bst (Node l x r h). @@ -553,15 +553,15 @@ Module Proofs. Hint Constructors In bst. Hint Unfold lt_tree gt_tree. -Tactic Notation "factornode" ident(l) ident(x) ident(r) ident(h) - "as" ident(s) := +Tactic Notation "factornode" ident(l) ident(x) ident(r) ident(h) + "as" ident(s) := set (s:=Node l x r h) in *; clearbody s; clear l x r h. -(** A tactic to repeat [inversion_clear] on all hyps of the +(** A tactic to repeat [inversion_clear] on all hyps of the form [(f (Node _ _ _ _))] *) Ltac inv f := - match goal with + match goal with | H:f Leaf |- _ => inversion_clear H; inv f | H:f _ Leaf |- _ => inversion_clear H; inv f | H:f (Node _ _ _ _) |- _ => inversion_clear H; inv f @@ -573,7 +573,7 @@ Ltac intuition_in := repeat progress (intuition; inv In). (** Helper tactic concerning order of elements. *) -Ltac order := match goal with +Ltac order := match goal with | U: lt_tree _ ?s, V: In _ ?s |- _ => generalize (U _ V); clear U; order | U: gt_tree _ ?s, V: In _ ?s |- _ => generalize (U _ V); clear U; order | _ => MX.order @@ -591,8 +591,8 @@ Proof. Qed. Hint Immediate In_1. -Lemma In_node_iff : - forall l x r h y, +Lemma In_node_iff : + forall l x r h y, In y (Node l x r h) <-> In y l \/ X.eq y x \/ In y r. Proof. intuition_in. @@ -655,10 +655,10 @@ Hint Resolve lt_tree_not_in lt_tree_trans gt_tree_not_in gt_tree_trans. (** * Inductions principles *) Functional Scheme mem_ind := Induction for mem Sort Prop. -Functional Scheme bal_ind := Induction for bal Sort Prop. +Functional Scheme bal_ind := Induction for bal Sort Prop. Functional Scheme add_ind := Induction for add Sort Prop. Functional Scheme remove_min_ind := Induction for remove_min Sort Prop. -Functional Scheme merge_ind := Induction for merge Sort Prop. +Functional Scheme merge_ind := Induction for merge Sort Prop. Functional Scheme remove_ind := Induction for remove Sort Prop. Functional Scheme min_elt_ind := Induction for min_elt Sort Prop. Functional Scheme max_elt_ind := Induction for max_elt Sort Prop. @@ -684,14 +684,14 @@ Qed. (** * Emptyness test *) -Lemma is_empty_1 : forall s, Empty s -> is_empty s = true. +Lemma is_empty_1 : forall s, Empty s -> is_empty s = true. Proof. destruct s as [|r x l h]; simpl; auto. intro H; elim (H x); auto. Qed. Lemma is_empty_2 : forall s, is_empty s = true -> Empty s. -Proof. +Proof. destruct s; simpl; intros; try discriminate; red; auto. Qed. @@ -701,12 +701,12 @@ Qed. Lemma mem_1 : forall s x, bst s -> In x s -> mem x s = true. Proof. - intros s x; functional induction mem x s; auto; intros; try clear e0; + intros s x; functional induction mem x s; auto; intros; try clear e0; inv bst; intuition_in; order. Qed. -Lemma mem_2 : forall s x, mem x s = true -> In x s. -Proof. +Lemma mem_2 : forall s x, mem x s = true -> In x s. +Proof. intros s x; functional induction mem x s; auto; intros; discriminate. Qed. @@ -714,13 +714,13 @@ Qed. (** * Singleton set *) -Lemma singleton_1 : forall x y, In y (singleton x) -> X.eq x y. -Proof. +Lemma singleton_1 : forall x y, In y (singleton x) -> X.eq x y. +Proof. unfold singleton; intros; inv In; order. Qed. -Lemma singleton_2 : forall x y, X.eq x y -> In y (singleton x). -Proof. +Lemma singleton_2 : forall x y, X.eq x y -> In y (singleton x). +Proof. unfold singleton; auto. Qed. @@ -733,33 +733,33 @@ Qed. (** * Helper functions *) -Lemma create_in : +Lemma create_in : forall l x r y, In y (create l x r) <-> X.eq y x \/ In y l \/ In y r. Proof. unfold create; split; [ inversion_clear 1 | ]; intuition. Qed. -Lemma create_bst : - forall l x r, bst l -> bst r -> lt_tree x l -> gt_tree x r -> +Lemma create_bst : + forall l x r, bst l -> bst r -> lt_tree x l -> gt_tree x r -> bst (create l x r). Proof. unfold create; auto. Qed. Hint Resolve create_bst. -Lemma bal_in : forall l x r y, +Lemma bal_in : forall l x r y, In y (bal l x r) <-> X.eq y x \/ In y l \/ In y r. Proof. - intros l x r; functional induction bal l x r; intros; try clear e0; + intros l x r; functional induction bal l x r; intros; try clear e0; rewrite !create_in; intuition_in. Qed. -Lemma bal_bst : forall l x r, bst l -> bst r -> +Lemma bal_bst : forall l x r, bst l -> bst r -> lt_tree x l -> gt_tree x r -> bst (bal l x r). Proof. intros l x r; functional induction bal l x r; intros; inv bst; repeat apply create_bst; auto; unfold create; - (apply lt_tree_node || apply gt_tree_node); auto; + (apply lt_tree_node || apply gt_tree_node); auto; (eapply lt_tree_trans || eapply gt_tree_trans); eauto. Qed. Hint Resolve bal_bst. @@ -771,14 +771,14 @@ Hint Resolve bal_bst. Lemma add_in : forall s x y, In y (add x s) <-> X.eq y x \/ In y s. Proof. - intros s x; functional induction (add x s); auto; intros; + intros s x; functional induction (add x s); auto; intros; try rewrite bal_in, IHt; intuition_in. eapply In_1; eauto. Qed. Lemma add_bst : forall s x, bst s -> bst (add x s). -Proof. - intros s x; functional induction (add x s); auto; intros; +Proof. + intros s x; functional induction (add x s); auto; intros; inv bst; apply bal_bst; auto. (* lt_tree -> lt_tree (add ...) *) red; red in H3. @@ -800,25 +800,25 @@ Hint Resolve add_bst. (** * Join *) -(* Function/Functional Scheme can't deal with internal fix. +(* Function/Functional Scheme can't deal with internal fix. Let's do its job by hand: *) -Ltac join_tac := - intro l; induction l as [| ll _ lx lr Hlr lh]; +Ltac join_tac := + intro l; induction l as [| ll _ lx lr Hlr lh]; [ | intros x r; induction r as [| rl Hrl rx rr _ rh]; unfold join; - [ | destruct (gt_le_dec lh (rh+2)); - [ match goal with |- context b [ bal ?a ?b ?c] => - replace (bal a b c) - with (bal ll lx (join lr x (Node rl rx rr rh))); [ | auto] - end - | destruct (gt_le_dec rh (lh+2)); - [ match goal with |- context b [ bal ?a ?b ?c] => - replace (bal a b c) - with (bal (join (Node ll lx lr lh) x rl) rx rr); [ | auto] + [ | destruct (gt_le_dec lh (rh+2)); + [ match goal with |- context b [ bal ?a ?b ?c] => + replace (bal a b c) + with (bal ll lx (join lr x (Node rl rx rr rh))); [ | auto] + end + | destruct (gt_le_dec rh (lh+2)); + [ match goal with |- context b [ bal ?a ?b ?c] => + replace (bal a b c) + with (bal (join (Node ll lx lr lh) x rl) rx rr); [ | auto] end | ] ] ] ]; intros. -Lemma join_in : forall l x r y, +Lemma join_in : forall l x r y, In y (join l x r) <-> X.eq y x \/ In y l \/ In y r. Proof. join_tac. @@ -830,10 +830,10 @@ Proof. apply create_in. Qed. -Lemma join_bst : forall l x r, bst l -> bst r -> +Lemma join_bst : forall l x r, bst l -> bst r -> lt_tree x l -> gt_tree x r -> bst (join l x r). Proof. - join_tac; auto; inv bst; apply bal_bst; auto; + join_tac; auto; inv bst; apply bal_bst; auto; clear Hrl Hlr z; intro; intros; rewrite join_in in *. intuition; [ apply MX.lt_eq with x | ]; eauto. intuition; [ apply MX.eq_lt with x | ]; eauto. @@ -844,8 +844,8 @@ Hint Resolve join_bst. (** * Extraction of minimum element *) -Lemma remove_min_in : forall l x r h y, - In y (Node l x r h) <-> +Lemma remove_min_in : forall l x r h y, + In y (Node l x r h) <-> X.eq y (remove_min l x r)#2 \/ In y (remove_min l x r)#1. Proof. intros l x r; functional induction (remove_min l x r); simpl in *; intros. @@ -853,7 +853,7 @@ Proof. rewrite bal_in, In_node_iff, IHp, e0; simpl; intuition. Qed. -Lemma remove_min_bst : forall l x r h, +Lemma remove_min_bst : forall l x r h, bst (Node l x r h) -> bst (remove_min l x r)#1. Proof. intros l x r; functional induction (remove_min l x r); simpl; intros. @@ -865,7 +865,7 @@ Proof. rewrite remove_min_in, e0 in H2; simpl in H2; intuition. Qed. -Lemma remove_min_gt_tree : forall l x r h, +Lemma remove_min_gt_tree : forall l x r h, bst (Node l x r h) -> gt_tree (remove_min l x r)#2 (remove_min l x r)#1. Proof. @@ -873,8 +873,8 @@ Proof. inv bst; auto. inversion_clear H. specialize IHp with (1:=H0); rewrite e0 in IHp; simpl in IHp. - intro y; rewrite bal_in; intuition; - specialize (H2 m); rewrite remove_min_in, e0 in H2; simpl in H2; + intro y; rewrite bal_in; intuition; + specialize (H2 m); rewrite remove_min_in, e0 in H2; simpl in H2; [ apply MX.lt_eq with x | ]; eauto. Qed. Hint Resolve remove_min_bst remove_min_gt_tree. @@ -886,18 +886,18 @@ Hint Resolve remove_min_bst remove_min_gt_tree. Lemma merge_in : forall s1 s2 y, In y (merge s1 s2) <-> In y s1 \/ In y s2. Proof. - intros s1 s2; functional induction (merge s1 s2); intros; + intros s1 s2; functional induction (merge s1 s2); intros; try factornode _x _x0 _x1 _x2 as s1. intuition_in. intuition_in. rewrite bal_in, remove_min_in, e1; simpl; intuition. Qed. -Lemma merge_bst : forall s1 s2, bst s1 -> bst s2 -> - (forall y1 y2 : elt, In y1 s1 -> In y2 s2 -> X.lt y1 y2) -> +Lemma merge_bst : forall s1 s2, bst s1 -> bst s2 -> + (forall y1 y2 : elt, In y1 s1 -> In y2 s2 -> X.lt y1 y2) -> bst (merge s1 s2). Proof. - intros s1 s2; functional induction (merge s1 s2); intros; auto; + intros s1 s2; functional induction (merge s1 s2); intros; auto; try factornode _x _x0 _x1 _x2 as s1. apply bal_bst; auto. change s2' with ((s2',m)#1); rewrite <-e1; eauto. @@ -924,7 +924,7 @@ Proof. Qed. Lemma remove_bst : forall s x, bst s -> bst (remove x s). -Proof. +Proof. intros s x; functional induction (remove x s); intros; inv bst. auto. (* LT *) @@ -932,7 +932,7 @@ Proof. intro z; rewrite remove_in; auto; destruct 1; eauto. (* EQ *) eauto. - (* GT *) + (* GT *) apply bal_bst; auto. intro z; rewrite remove_in; auto; destruct 1; eauto. Qed. @@ -941,15 +941,15 @@ Hint Resolve remove_bst. (** * Minimum element *) -Lemma min_elt_1 : forall s x, min_elt s = Some x -> In x s. -Proof. +Lemma min_elt_1 : forall s x, min_elt s = Some x -> In x s. +Proof. intro s; functional induction (min_elt s); auto; inversion 1; auto. Qed. Lemma min_elt_2 : forall s x y, bst s -> - min_elt s = Some x -> In y s -> ~ X.lt y x. + min_elt s = Some x -> In y s -> ~ X.lt y x. Proof. - intro s; functional induction (min_elt s); + intro s; functional induction (min_elt s); try rename _x1 into l1, _x2 into x1, _x3 into r1, _x4 into h1. inversion_clear 2. inversion_clear 1. @@ -963,7 +963,7 @@ Proof. assert (X.lt x y) by (apply H2; auto). inversion_clear 1; auto; order. assert (X.lt x1 y) by auto. - inversion_clear 2; auto; + inversion_clear 2; auto; (assert (~ X.lt x1 x) by auto); order. Qed. @@ -980,13 +980,13 @@ Qed. (** * Maximum element *) -Lemma max_elt_1 : forall s x, max_elt s = Some x -> In x s. -Proof. +Lemma max_elt_1 : forall s x, max_elt s = Some x -> In x s. +Proof. intro s; functional induction (max_elt s); auto; inversion 1; auto. Qed. -Lemma max_elt_2 : forall s x y, bst s -> - max_elt s = Some x -> In y s -> ~ X.lt x y. +Lemma max_elt_2 : forall s x y, bst s -> + max_elt s = Some x -> In y s -> ~ X.lt x y. Proof. intro s; functional induction (max_elt s); try rename _x1 into l1, _x2 into x1, _x3 into r1, _x4 into h1. @@ -997,7 +997,7 @@ Proof. inversion_clear H5. inversion_clear 1. assert (X.lt y x1) by auto. - inversion_clear 2; auto; + inversion_clear 2; auto; (assert (~ X.lt x x1) by auto); order. Qed. @@ -1014,17 +1014,17 @@ Qed. (** * Any element *) Lemma choose_1 : forall s x, choose s = Some x -> In x s. -Proof. +Proof. exact min_elt_1. Qed. Lemma choose_2 : forall s, choose s = None -> Empty s. -Proof. +Proof. exact min_elt_3. Qed. -Lemma choose_3 : forall s s', bst s -> bst s' -> - forall x x', choose s = Some x -> choose s' = Some x' -> +Lemma choose_3 : forall s s', bst s -> bst s' -> + forall x x', choose s = Some x -> choose s' = Some x' -> Equal s s' -> X.eq x x'. Proof. unfold choose, Equal; intros s s' Hb Hb' x x' Hx Hx' H. @@ -1040,7 +1040,7 @@ Qed. (** * Concatenation *) -Lemma concat_in : forall s1 s2 y, +Lemma concat_in : forall s1 s2 y, In y (concat s1 s2) <-> In y s1 \/ In y s2. Proof. intros s1 s2; functional induction (concat s1 s2); intros; @@ -1049,12 +1049,12 @@ Proof. intuition_in. rewrite join_in, remove_min_in, e1; simpl; intuition. Qed. - -Lemma concat_bst : forall s1 s2, bst s1 -> bst s2 -> - (forall y1 y2 : elt, In y1 s1 -> In y2 s2 -> X.lt y1 y2) -> + +Lemma concat_bst : forall s1 s2, bst s1 -> bst s2 -> + (forall y1 y2 : elt, In y1 s1 -> In y2 s2 -> X.lt y1 y2) -> bst (concat s1 s2). -Proof. - intros s1 s2; functional induction (concat s1 s2); intros; auto; +Proof. + intros s1 s2; functional induction (concat s1 s2); intros; auto; try factornode _x _x0 _x1 _x2 as s1. apply join_bst; auto. change (bst (s2',m)#1); rewrite <-e1; eauto. @@ -1068,10 +1068,10 @@ Hint Resolve concat_bst. (** * Splitting *) -Lemma split_in_1 : forall s x y, bst s -> +Lemma split_in_1 : forall s x y, bst s -> (In y (split x s)#l <-> In y s /\ X.lt y x). Proof. - intros s x; functional induction (split x s); simpl; intros; + intros s x; functional induction (split x s); simpl; intros; inv bst; try clear e0. intuition_in. rewrite e1 in IHt; simpl in IHt; rewrite IHt; intuition_in; order. @@ -1080,10 +1080,10 @@ Proof. rewrite e1 in IHt; simpl in IHt; rewrite IHt; intuition_in; order. Qed. -Lemma split_in_2 : forall s x y, bst s -> +Lemma split_in_2 : forall s x y, bst s -> (In y (split x s)#r <-> In y s /\ X.lt x y). -Proof. - intros s x; functional induction (split x s); subst; simpl; intros; +Proof. + intros s x; functional induction (split x s); subst; simpl; intros; inv bst; try clear e0. intuition_in. rewrite join_in. @@ -1092,10 +1092,10 @@ Proof. rewrite e1 in IHt; simpl in IHt; rewrite IHt; intuition_in; order. Qed. -Lemma split_in_3 : forall s x, bst s -> +Lemma split_in_3 : forall s x, bst s -> ((split x s)#b = true <-> In x s). -Proof. - intros s x; functional induction (split x s); subst; simpl; intros; +Proof. + intros s x; functional induction (split x s); subst; simpl; intros; inv bst; try clear e0. intuition_in; try discriminate. rewrite e1 in IHt; simpl in IHt; rewrite IHt; intuition_in; order. @@ -1103,10 +1103,10 @@ Proof. rewrite e1 in IHt; simpl in IHt; rewrite IHt; intuition_in; order. Qed. -Lemma split_bst : forall s x, bst s -> +Lemma split_bst : forall s x, bst s -> bst (split x s)#l /\ bst (split x s)#r. -Proof. - intros s x; functional induction (split x s); subst; simpl; intros; +Proof. + intros s x; functional induction (split x s); subst; simpl; intros; inv bst; try clear e0; try rewrite e1 in *; simpl in *; intuition; apply join_bst; auto. intros y0. @@ -1119,15 +1119,15 @@ Qed. (** * Intersection *) -Lemma inter_bst_in : forall s1 s2, bst s1 -> bst s2 -> +Lemma inter_bst_in : forall s1 s2, bst s1 -> bst s2 -> bst (inter s1 s2) /\ (forall y, In y (inter s1 s2) <-> In y s1 /\ In y s2). Proof. - intros s1 s2; functional induction inter s1 s2; intros B1 B2; - [intuition_in|intuition_in | | ]; - factornode _x0 _x1 _x2 _x3 as s2; - generalize (split_bst x1 B2); + intros s1 s2; functional induction inter s1 s2; intros B1 B2; + [intuition_in|intuition_in | | ]; + factornode _x0 _x1 _x2 _x3 as s2; + generalize (split_bst x1 B2); rewrite e1; simpl; destruct 1; inv bst; - destruct IHt as (IHb1,IHi1); auto; + destruct IHt as (IHb1,IHi1); auto; destruct IHt0 as (IHb2,IHi2); auto; generalize (@split_in_1 s2 x1)(@split_in_2 s2 x1) (split_in_3 x1 B2)(split_bst x1 B2); @@ -1146,31 +1146,31 @@ Proof. apply In_1 with y; auto. Qed. -Lemma inter_in : forall s1 s2 y, bst s1 -> bst s2 -> +Lemma inter_in : forall s1 s2 y, bst s1 -> bst s2 -> (In y (inter s1 s2) <-> In y s1 /\ In y s2). -Proof. +Proof. intros s1 s2 y B1 B2; destruct (inter_bst_in B1 B2); auto. Qed. Lemma inter_bst : forall s1 s2, bst s1 -> bst s2 -> bst (inter s1 s2). -Proof. +Proof. intros s1 s2 B1 B2; destruct (inter_bst_in B1 B2); auto. Qed. (** * Difference *) -Lemma diff_bst_in : forall s1 s2, bst s1 -> bst s2 -> +Lemma diff_bst_in : forall s1 s2, bst s1 -> bst s2 -> bst (diff s1 s2) /\ (forall y, In y (diff s1 s2) <-> In y s1 /\ ~In y s2). Proof. - intros s1 s2; functional induction diff s1 s2; intros B1 B2; - [intuition_in|intuition_in | | ]; - factornode _x0 _x1 _x2 _x3 as s2; - generalize (split_bst x1 B2); - rewrite e1; simpl; destruct 1; - inv avl; inv bst; - destruct IHt as (IHb1,IHi1); auto; - destruct IHt0 as (IHb2,IHi2); auto; + intros s1 s2; functional induction diff s1 s2; intros B1 B2; + [intuition_in|intuition_in | | ]; + factornode _x0 _x1 _x2 _x3 as s2; + generalize (split_bst x1 B2); + rewrite e1; simpl; destruct 1; + inv avl; inv bst; + destruct IHt as (IHb1,IHi1); auto; + destruct IHt0 as (IHb2,IHi2); auto; generalize (@split_in_1 s2 x1)(@split_in_2 s2 x1) (split_in_3 x1 B2)(split_bst x1 B2); rewrite e1; simpl; split; intros. @@ -1189,21 +1189,21 @@ Proof. apply In_1 with y; auto. Qed. -Lemma diff_in : forall s1 s2 y, bst s1 -> bst s2 -> +Lemma diff_in : forall s1 s2 y, bst s1 -> bst s2 -> (In y (diff s1 s2) <-> In y s1 /\ ~In y s2). -Proof. +Proof. intros s1 s2 y B1 B2; destruct (diff_bst_in B1 B2); auto. Qed. -Lemma diff_bst : forall s1 s2, bst s1 -> bst s2 -> bst (diff s1 s2). -Proof. +Lemma diff_bst : forall s1 s2, bst s1 -> bst s2 -> bst (diff s1 s2). +Proof. intros s1 s2 B1 B2; destruct (diff_bst_in B1 B2); auto. Qed. (** * Union *) -Lemma union_in : forall s1 s2 y, bst s1 -> bst s2 -> +Lemma union_in : forall s1 s2 y, bst s1 -> bst s2 -> (In y (union s1 s2) <-> In y s1 \/ In y s2). Proof. intros s1 s2; functional induction union s1 s2; intros y B1 B2. @@ -1217,7 +1217,7 @@ Proof. case (X.compare y x1); intuition_in. Qed. -Lemma union_bst : forall s1 s2, bst s1 -> bst s2 -> +Lemma union_bst : forall s1 s2, bst s1 -> bst s2 -> bst (union s1 s2). Proof. intros s1 s2; functional induction union s1 s2; intros B1 B2; auto. @@ -1233,7 +1233,7 @@ Qed. (** * Elements *) -Lemma elements_aux_in : forall s acc x, +Lemma elements_aux_in : forall s acc x, InA X.eq x (elements_aux acc s) <-> In x s \/ InA X.eq x acc. Proof. induction s as [ | l Hl x r Hr h ]; simpl; auto. @@ -1245,8 +1245,8 @@ Proof. intuition; inversion_clear H3; intuition. Qed. -Lemma elements_in : forall s x, InA X.eq x (elements s) <-> In x s. -Proof. +Lemma elements_in : forall s x, InA X.eq x (elements s) <-> In x s. +Proof. intros; generalize (elements_aux_in s nil x); intuition. inversion_clear H0. Qed. @@ -1258,7 +1258,7 @@ Proof. induction s as [ | l Hl y r Hr h]; simpl; intuition. inv bst. apply Hl; auto. - constructor. + constructor. apply Hr; auto. apply MX.In_Inf; intros. destruct (elements_aux_in r acc y0); intuition. @@ -1318,10 +1318,10 @@ Qed. Section F. Variable f : elt -> bool. -Lemma filter_acc_in : forall s acc, - compat_bool X.eq f -> forall x : elt, +Lemma filter_acc_in : forall s acc, + compat_bool X.eq f -> forall x : elt, In x (filter_acc f acc s) <-> In x acc \/ In x s /\ f x = true. -Proof. +Proof. induction s; simpl; intros. intuition_in. rewrite IHs2, IHs1 by (destruct (f t); auto). @@ -1335,7 +1335,7 @@ Proof. rewrite H0 in H3; discriminate. Qed. -Lemma filter_acc_bst : forall s acc, bst s -> bst acc -> +Lemma filter_acc_bst : forall s acc, bst s -> bst acc -> bst (filter_acc f acc s). Proof. induction s; simpl; auto. @@ -1345,13 +1345,13 @@ Proof. Qed. Lemma filter_in : forall s, - compat_bool X.eq f -> forall x : elt, + compat_bool X.eq f -> forall x : elt, In x (filter f s) <-> In x s /\ f x = true. Proof. unfold filter; intros; rewrite filter_acc_in; intuition_in. Qed. -Lemma filter_bst : forall s, bst s -> bst (filter f s). +Lemma filter_bst : forall s, bst s -> bst (filter f s). Proof. unfold filter; intros; apply filter_acc_bst; auto. Qed. @@ -1360,15 +1360,15 @@ Qed. (** * Partition *) -Lemma partition_acc_in_1 : forall s acc, - compat_bool X.eq f -> forall x : elt, - In x (partition_acc f acc s)#1 <-> +Lemma partition_acc_in_1 : forall s acc, + compat_bool X.eq f -> forall x : elt, + In x (partition_acc f acc s)#1 <-> In x acc#1 \/ In x s /\ f x = true. -Proof. +Proof. induction s; simpl; intros. intuition_in. destruct acc as [acct accf]; simpl in *. - rewrite IHs2 by + rewrite IHs2 by (destruct (f t); auto; apply partition_acc_avl_1; simpl; auto). rewrite IHs1 by (destruct (f t); simpl; auto). case_eq (f t); simpl; intros. @@ -1381,15 +1381,15 @@ Proof. rewrite H0 in H3; discriminate. Qed. -Lemma partition_acc_in_2 : forall s acc, - compat_bool X.eq f -> forall x : elt, - In x (partition_acc f acc s)#2 <-> +Lemma partition_acc_in_2 : forall s acc, + compat_bool X.eq f -> forall x : elt, + In x (partition_acc f acc s)#2 <-> In x acc#2 \/ In x s /\ f x = false. -Proof. +Proof. induction s; simpl; intros. intuition_in. destruct acc as [acct accf]; simpl in *. - rewrite IHs2 by + rewrite IHs2 by (destruct (f t); auto; apply partition_acc_avl_2; simpl; auto). rewrite IHs1 by (destruct (f t); simpl; auto). case_eq (f t); simpl; intros. @@ -1403,23 +1403,23 @@ Proof. intuition. Qed. -Lemma partition_in_1 : forall s, - compat_bool X.eq f -> forall x : elt, +Lemma partition_in_1 : forall s, + compat_bool X.eq f -> forall x : elt, In x (partition f s)#1 <-> In x s /\ f x = true. Proof. - unfold partition; intros; rewrite partition_acc_in_1; + unfold partition; intros; rewrite partition_acc_in_1; simpl in *; intuition_in. -Qed. +Qed. Lemma partition_in_2 : forall s, - compat_bool X.eq f -> forall x : elt, + compat_bool X.eq f -> forall x : elt, In x (partition f s)#2 <-> In x s /\ f x = false. Proof. - unfold partition; intros; rewrite partition_acc_in_2; + unfold partition; intros; rewrite partition_acc_in_2; simpl in *; intuition_in. -Qed. +Qed. -Lemma partition_acc_bst_1 : forall s acc, bst s -> bst acc#1 -> +Lemma partition_acc_bst_1 : forall s acc, bst s -> bst acc#1 -> bst (partition_acc f acc s)#1. Proof. induction s; simpl; auto. @@ -1431,7 +1431,7 @@ Proof. apply IHs1; simpl; auto. Qed. -Lemma partition_acc_bst_2 : forall s acc, bst s -> bst acc#2 -> +Lemma partition_acc_bst_2 : forall s acc, bst s -> bst acc#2 -> bst (partition_acc f acc s)#2. Proof. induction s; simpl; auto. @@ -1443,12 +1443,12 @@ Proof. apply IHs1; simpl; auto. Qed. -Lemma partition_bst_1 : forall s, bst s -> bst (partition f s)#1. +Lemma partition_bst_1 : forall s, bst s -> bst (partition f s)#1. Proof. unfold partition; intros; apply partition_acc_bst_1; auto. Qed. -Lemma partition_bst_2 : forall s, bst s -> bst (partition f s)#2. +Lemma partition_bst_2 : forall s, bst s -> bst (partition f s)#2. Proof. unfold partition; intros; apply partition_acc_bst_2; auto. Qed. @@ -1493,10 +1493,10 @@ Qed. Lemma exists_2 : forall s, compat_bool X.eq f -> exists_ f s = true -> Exists (fun x => f x = true) s. -Proof. +Proof. induction s; simpl; intros; rewrite <- ?orb_lazy_alt in *. discriminate. - destruct (orb_true_elim _ _ H0) as [H1|H1]. + destruct (orb_true_elim _ _ H0) as [H1|H1]. destruct (orb_true_elim _ _ H1) as [H2|H2]. exists t; auto. destruct (IHs1 H H2); auto; exists x; intuition. @@ -1509,7 +1509,7 @@ End F. (** * Fold *) -Definition fold' (A : Type) (f : elt -> A -> A)(s : tree) := +Definition fold' (A : Type) (f : elt -> A -> A)(s : tree) := L.fold f (elements s). Implicit Arguments fold' [A]. @@ -1529,14 +1529,14 @@ Lemma fold_equiv : forall (A : Type) (s : tree) (f : elt -> A -> A) (a : A), fold f s a = fold' f s a. Proof. - unfold fold', elements in |- *. + unfold fold', elements in |- *. simple induction s; simpl in |- *; auto; intros. rewrite fold_equiv_aux. rewrite H0. simpl in |- *; auto. Qed. -Lemma fold_1 : +Lemma fold_1 : forall (s:t)(Hs:bst s)(A : Type)(f : elt -> A -> A)(i : A), fold f s i = fold_left (fun a e => f e a) (elements s) i. Proof. @@ -1552,7 +1552,7 @@ Qed. Lemma subsetl_12 : forall subset_l1 l1 x1 h1 s2, bst (Node l1 x1 Leaf h1) -> bst s2 -> - (forall s, bst s -> (subset_l1 s = true <-> Subset l1 s)) -> + (forall s, bst s -> (subset_l1 s = true <-> Subset l1 s)) -> (subsetl subset_l1 x1 s2 = true <-> Subset (Node l1 x1 Leaf h1) s2 ). Proof. induction s2 as [|l2 IHl2 x2 r2 IHr2 h2]; simpl; intros. @@ -1563,7 +1563,7 @@ Proof. specialize (IHr2 H H3 H1). inv bst. clear H8. destruct X.compare. - + rewrite IHl2; clear H1 IHl2 IHr2. unfold Subset. intuition_in. assert (In a (Node l2 x2 r2 h2)) by auto; intuition_in; order. @@ -1584,7 +1584,7 @@ Qed. Lemma subsetr_12 : forall subset_r1 r1 x1 h1 s2, bst (Node Leaf x1 r1 h1) -> bst s2 -> - (forall s, bst s -> (subset_r1 s = true <-> Subset r1 s)) -> + (forall s, bst s -> (subset_r1 s = true <-> Subset r1 s)) -> (subsetr subset_r1 x1 s2 = true <-> Subset (Node Leaf x1 r1 h1) s2). Proof. induction s2 as [|l2 IHl2 x2 r2 IHr2 h2]; simpl; intros. @@ -1606,7 +1606,7 @@ Proof. unfold Subset. intuition_in. assert (X.eq a x2) by order; intuition_in. assert (In a (Node l2 x2 r2 h2)) by auto; intuition_in; order. - + rewrite IHr2; clear H1 IHl2 IHr2. unfold Subset. intuition_in. assert (In a (Node l2 x2 r2 h2)) by auto; intuition_in; order. @@ -1614,7 +1614,7 @@ Proof. Qed. -Lemma subset_12 : forall s1 s2, bst s1 -> bst s2 -> +Lemma subset_12 : forall s1 s2, bst s1 -> bst s2 -> (subset s1 s2 = true <-> Subset s1 s2). Proof. induction s1 as [|l1 IHl1 x1 r1 IHr1 h1]; simpl; intros. @@ -1638,7 +1638,7 @@ Proof. assert (X.eq a x2) by order; intuition_in. assert (In a (Node l2 x2 r2 h2)) by auto; intuition_in; order. assert (In a (Node l2 x2 r2 h2)) by auto; intuition_in; order. - + rewrite <-andb_lazy_alt, andb_true_iff, IHl1 by auto. rewrite (@subsetr_12 (subset r1) r1 x1 h1) by auto. clear IHl1 IHr1. @@ -1656,7 +1656,7 @@ Qed. Definition eq := Equal. Definition lt (s1 s2 : t) : Prop := L.lt (elements s1) (elements s2). -Lemma eq_refl : forall s : t, Equal s s. +Lemma eq_refl : forall s : t, Equal s s. Proof. unfold Equal; intuition. Qed. @@ -1666,10 +1666,10 @@ Proof. unfold Equal; intros s s' H x; destruct (H x); split; auto. Qed. -Lemma eq_trans : forall s s' s'' : t, +Lemma eq_trans : forall s s' s'' : t, Equal s s' -> Equal s' s'' -> Equal s s''. Proof. - unfold Equal; intros s s' s'' H1 H2 x; + unfold Equal; intros s s' s'' H1 H2 x; destruct (H1 x); destruct (H2 x); split; auto. Qed. @@ -1686,10 +1686,10 @@ Proof. Qed. Hint Resolve eq_L_eq L_eq_eq. -Definition lt_trans (s s' s'' : t) (h : lt s s') +Definition lt_trans (s s' s'' : t) (h : lt s s') (h' : lt s' s'') : lt s s'' := L.lt_trans h h'. -Lemma lt_not_eq : forall s s' : t, +Lemma lt_not_eq : forall s s' : t, bst s -> bst s' -> lt s s' -> ~ Equal s s'. Proof. unfold lt in |- *; intros; intro. @@ -1713,7 +1713,7 @@ Hint Resolve L_eq_cons. (** [flatten_e e] returns the list of elements of [e] i.e. the list of elements actually compared *) - + Fixpoint flatten_e (e : enumeration) : list elt := match e with | End => nil | More x t r => x :: elements t ++ flatten_e r @@ -1726,7 +1726,7 @@ Proof. intros; simpl; apply elements_node. Qed. -Lemma cons_1 : forall s e, +Lemma cons_1 : forall s e, flatten_e (cons s e) = elements s ++ flatten_e e. Proof. induction s; simpl; auto; intros. @@ -1735,37 +1735,37 @@ Qed. (** Correctness of this comparison *) -Definition Cmp c := - match c with +Definition Cmp c := + match c with | Eq => L.eq | Lt => L.lt | Gt => (fun l1 l2 => L.lt l2 l1) end. Lemma cons_Cmp : forall c x1 x2 l1 l2, X.eq x1 x2 -> - Cmp c l1 l2 -> Cmp c (x1::l1) (x2::l2). + Cmp c l1 l2 -> Cmp c (x1::l1) (x2::l2). Proof. destruct c; simpl; auto. Qed. Hint Resolve cons_Cmp. -Lemma compare_end_Cmp : +Lemma compare_end_Cmp : forall e2, Cmp (compare_end e2) nil (flatten_e e2). Proof. destruct e2; simpl; auto. apply L.eq_refl. Qed. -Lemma compare_more_Cmp : forall x1 cont x2 r2 e2 l, - Cmp (cont (cons r2 e2)) l (elements r2 ++ flatten_e e2) -> - Cmp (compare_more x1 cont (More x2 r2 e2)) (x1::l) +Lemma compare_more_Cmp : forall x1 cont x2 r2 e2 l, + Cmp (cont (cons r2 e2)) l (elements r2 ++ flatten_e e2) -> + Cmp (compare_more x1 cont (More x2 r2 e2)) (x1::l) (flatten_e (More x2 r2 e2)). Proof. simpl; intros; destruct X.compare; simpl; auto. Qed. Lemma compare_cont_Cmp : forall s1 cont e2 l, - (forall e, Cmp (cont e) l (flatten_e e)) -> + (forall e, Cmp (cont e) l (flatten_e e)) -> Cmp (compare_cont s1 cont e2) (elements s1 ++ l) (flatten_e e2). Proof. induction s1 as [|l1 Hl1 x1 r1 Hr1 h1]; simpl; intros; auto. @@ -1781,7 +1781,7 @@ Lemma compare_Cmp : forall s1 s2, Proof. intros; unfold compare. rewrite (app_nil_end (elements s1)). - replace (elements s2) with (flatten_e (cons s2 End)) by + replace (elements s2) with (flatten_e (cons s2 End)) by (rewrite cons_1; simpl; rewrite <- app_nil_end; auto). apply compare_cont_Cmp; auto. intros. @@ -1790,21 +1790,21 @@ Qed. (** * Equality test *) -Lemma equal_1 : forall s1 s2, bst s1 -> bst s2 -> +Lemma equal_1 : forall s1 s2, bst s1 -> bst s2 -> Equal s1 s2 -> equal s1 s2 = true. Proof. unfold equal; intros s1 s2 B1 B2 E. -generalize (compare_Cmp s1 s2). +generalize (compare_Cmp s1 s2). destruct (compare s1 s2); simpl in *; auto; intros. elim (lt_not_eq B1 B2 H E); auto. elim (lt_not_eq B2 B1 H (eq_sym E)); auto. Qed. -Lemma equal_2 : forall s1 s2, +Lemma equal_2 : forall s1 s2, equal s1 s2 = true -> Equal s1 s2. Proof. unfold equal; intros s1 s2 E. -generalize (compare_Cmp s1 s2); +generalize (compare_Cmp s1 s2); destruct compare; auto; discriminate. Qed. @@ -1816,10 +1816,10 @@ End Raw. (** * Encapsulation - Now, in order to really provide a functor implementing [S], we - need to encapsulate everything into a type of binary search trees. - They also happen to be well-balanced, but this has no influence - on the correctness of operations, so we won't state this here, + Now, in order to really provide a functor implementing [S], we + need to encapsulate everything into a type of binary search trees. + They also happen to be well-balanced, but this has no influence + on the correctness of operations, so we won't state this here, see [FSetFullAVL] if you need more than just the FSet interface. *) @@ -1832,7 +1832,7 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Record bst := Bst {this :> Raw.t; is_bst : Raw.bst this}. Definition t := bst. Definition elt := E.t. - + Definition In (x : elt) (s : t) := Raw.In x s. Definition Equal (s s':t) := forall a : elt, In a s <-> In a s'. Definition Subset (s s':t) := forall a : elt, In a s -> In a s'. @@ -1840,15 +1840,15 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Definition For_all (P : elt -> Prop) (s:t) := forall x, In x s -> P x. Definition Exists (P : elt -> Prop) (s:t) := exists x, In x s /\ P x. - Lemma In_1 : forall (s:t)(x y:elt), E.eq x y -> In x s -> In y s. + Lemma In_1 : forall (s:t)(x y:elt), E.eq x y -> In x s -> In y s. Proof. intro s; exact (@In_1 s). Qed. - + Definition mem (x:elt)(s:t) : bool := Raw.mem x s. Definition empty : t := Bst empty_bst. Definition is_empty (s:t) : bool := Raw.is_empty s. Definition singleton (x:elt) : t := Bst (singleton_bst x). - Definition add (x:elt)(s:t) : t := Bst (add_bst x (is_bst s)). + Definition add (x:elt)(s:t) : t := Bst (add_bst x (is_bst s)). Definition remove (x:elt)(s:t) : t := Bst (remove_bst x (is_bst s)). Definition inter (s s':t) : t := Bst (inter_bst (is_bst s) (is_bst s')). Definition union (s s':t) : t := Bst (union_bst (is_bst s) (is_bst s')). @@ -1859,13 +1859,13 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Definition choose (s:t) : option elt := Raw.choose s. Definition fold (B : Type) (f : elt -> B -> B) (s:t) : B -> B := Raw.fold f s. Definition cardinal (s:t) : nat := Raw.cardinal s. - Definition filter (f : elt -> bool) (s:t) : t := + Definition filter (f : elt -> bool) (s:t) : t := Bst (filter_bst f (is_bst s)). Definition for_all (f : elt -> bool) (s:t) : bool := Raw.for_all f s. Definition exists_ (f : elt -> bool) (s:t) : bool := Raw.exists_ f s. Definition partition (f : elt -> bool) (s:t) : t * t := let p := Raw.partition f s in - (@Bst (fst p) (partition_bst_1 f (is_bst s)), + (@Bst (fst p) (partition_bst_1 f (is_bst s)), @Bst (snd p) (partition_bst_2 f (is_bst s))). Definition equal (s s':t) : bool := Raw.equal s s'. @@ -1890,13 +1890,13 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Defined. (* specs *) - Section Specs. - Variable s s' s'': t. + Section Specs. + Variable s s' s'': t. Variable x y : elt. Hint Resolve is_bst. - - Lemma mem_1 : In x s -> mem x s = true. + + Lemma mem_1 : In x s -> mem x s = true. Proof. exact (mem_1 (is_bst s)). Qed. Lemma mem_2 : mem x s = true -> In x s. Proof. exact (@mem_2 s x). Qed. @@ -1918,14 +1918,14 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Lemma is_empty_1 : Empty s -> is_empty s = true. Proof. exact (@is_empty_1 s). Qed. - Lemma is_empty_2 : is_empty s = true -> Empty s. + Lemma is_empty_2 : is_empty s = true -> Empty s. Proof. exact (@is_empty_2 s). Qed. - + Lemma add_1 : E.eq x y -> In y (add x s). Proof. wrap add add_in. Qed. Lemma add_2 : In y s -> In y (add x s). Proof. wrap add add_in. Qed. - Lemma add_3 : ~ E.eq x y -> In y (add x s) -> In y s. + Lemma add_3 : ~ E.eq x y -> In y (add x s) -> In y s. Proof. wrap add add_in. elim H; auto. Qed. Lemma remove_1 : E.eq x y -> ~ In y (remove x s). @@ -1935,14 +1935,14 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Lemma remove_3 : In y (remove x s) -> In y s. Proof. wrap remove remove_in. Qed. - Lemma singleton_1 : In y (singleton x) -> E.eq x y. + Lemma singleton_1 : In y (singleton x) -> E.eq x y. Proof. exact (@singleton_1 x y). Qed. - Lemma singleton_2 : E.eq x y -> In y (singleton x). + Lemma singleton_2 : E.eq x y -> In y (singleton x). Proof. exact (@singleton_2 x y). Qed. Lemma union_1 : In x (union s s') -> In x s \/ In x s'. Proof. wrap union union_in. Qed. - Lemma union_2 : In x s -> In x (union s s'). + Lemma union_2 : In x s -> In x (union s s'). Proof. wrap union union_in. Qed. Lemma union_3 : In x s' -> In x (union s s'). Proof. wrap union union_in. Qed. @@ -1953,30 +1953,30 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Proof. wrap inter inter_in. Qed. Lemma inter_3 : In x s -> In x s' -> In x (inter s s'). Proof. wrap inter inter_in. Qed. - - Lemma diff_1 : In x (diff s s') -> In x s. + + Lemma diff_1 : In x (diff s s') -> In x s. Proof. wrap diff diff_in. Qed. Lemma diff_2 : In x (diff s s') -> ~ In x s'. Proof. wrap diff diff_in. Qed. Lemma diff_3 : In x s -> ~ In x s' -> In x (diff s s'). Proof. wrap diff diff_in. Qed. - + Lemma fold_1 : forall (A : Type) (i : A) (f : elt -> A -> A), fold f s i = fold_left (fun a e => f e a) (elements s) i. Proof. unfold fold, elements; intros; apply fold_1; auto. Qed. Lemma cardinal_1 : cardinal s = length (elements s). - Proof. + Proof. unfold cardinal, elements; intros; apply elements_cardinal; auto. Qed. Section Filter. Variable f : elt -> bool. - Lemma filter_1 : compat_bool E.eq f -> In x (filter f s) -> In x s. + Lemma filter_1 : compat_bool E.eq f -> In x (filter f s) -> In x s. + Proof. intro. wrap filter filter_in. Qed. + Lemma filter_2 : compat_bool E.eq f -> In x (filter f s) -> f x = true. Proof. intro. wrap filter filter_in. Qed. - Lemma filter_2 : compat_bool E.eq f -> In x (filter f s) -> f x = true. - Proof. intro. wrap filter filter_in. Qed. Lemma filter_3 : compat_bool E.eq f -> In x s -> f x = true -> In x (filter f s). Proof. intro. wrap filter filter_in. Qed. @@ -1990,14 +1990,14 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Lemma exists_2 : compat_bool E.eq f -> exists_ f s = true -> Exists (fun x => f x = true) s. Proof. exact (@exists_2 f s). Qed. - Lemma partition_1 : compat_bool E.eq f -> + Lemma partition_1 : compat_bool E.eq f -> Equal (fst (partition f s)) (filter f s). Proof. unfold partition, filter, Equal, In; simpl ;intros H a. rewrite partition_in_1, filter_in; intuition. Qed. - Lemma partition_2 : compat_bool E.eq f -> + Lemma partition_2 : compat_bool E.eq f -> Equal (snd (partition f s)) (filter (fun x => negb (f x)) s). Proof. unfold partition, filter, Equal, In; simpl ;intros H a. @@ -2019,14 +2019,14 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Lemma elements_3w : NoDupA E.eq (elements s). Proof. exact (elements_nodup (is_bst s)). Qed. - Lemma min_elt_1 : min_elt s = Some x -> In x s. + Lemma min_elt_1 : min_elt s = Some x -> In x s. Proof. exact (@min_elt_1 s x). Qed. Lemma min_elt_2 : min_elt s = Some x -> In y s -> ~ E.lt y x. Proof. exact (@min_elt_2 s x y (is_bst s)). Qed. Lemma min_elt_3 : min_elt s = None -> Empty s. Proof. exact (@min_elt_3 s). Qed. - Lemma max_elt_1 : max_elt s = Some x -> In x s. + Lemma max_elt_1 : max_elt s = Some x -> In x s. Proof. exact (@max_elt_1 s x). Qed. Lemma max_elt_2 : max_elt s = Some x -> In y s -> ~ E.lt x y. Proof. exact (@max_elt_2 s x y (is_bst s)). Qed. @@ -2037,17 +2037,17 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Proof. exact (@choose_1 s x). Qed. Lemma choose_2 : choose s = None -> Empty s. Proof. exact (@choose_2 s). Qed. - Lemma choose_3 : choose s = Some x -> choose s' = Some y -> + Lemma choose_3 : choose s = Some x -> choose s' = Some y -> Equal s s' -> E.eq x y. Proof. exact (@choose_3 _ _ (is_bst s) (is_bst s') x y). Qed. - Lemma eq_refl : eq s s. + Lemma eq_refl : eq s s. Proof. exact (eq_refl s). Qed. Lemma eq_sym : eq s s' -> eq s' s. Proof. exact (@eq_sym s s'). Qed. Lemma eq_trans : eq s s' -> eq s' s'' -> eq s s''. Proof. exact (@eq_trans s s' s''). Qed. - + Lemma lt_trans : lt s s' -> lt s' s'' -> lt s s''. Proof. exact (@lt_trans s s' s''). Qed. Lemma lt_not_eq : lt s s' -> ~eq s s'. diff --git a/theories/FSets/FSetBridge.v b/theories/FSets/FSetBridge.v index e0e858211..796db9f8f 100644 --- a/theories/FSets/FSetBridge.v +++ b/theories/FSets/FSetBridge.v @@ -23,51 +23,51 @@ Set Firstorder Depth 2. Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E. Definition empty : {s : t | Empty s}. - Proof. + Proof. exists empty; auto with set. Qed. Definition is_empty : forall s : t, {Empty s} + {~ Empty s}. - Proof. + Proof. intros; generalize (is_empty_1 (s:=s)) (is_empty_2 (s:=s)). case (is_empty s); intuition. Qed. Definition mem : forall (x : elt) (s : t), {In x s} + {~ In x s}. - Proof. + Proof. intros; generalize (mem_1 (s:=s) (x:=x)) (mem_2 (s:=s) (x:=x)). case (mem x s); intuition. Qed. - + Definition Add (x : elt) (s s' : t) := forall y : elt, In y s' <-> E.eq x y \/ In y s. - + Definition add : forall (x : elt) (s : t), {s' : t | Add x s s'}. Proof. intros; exists (add x s); auto. unfold Add in |- *; intuition. elim (E.eq_dec x y); auto. - intros; right. + intros; right. eapply add_3; eauto. - Qed. - + Qed. + Definition singleton : forall x : elt, {s : t | forall y : elt, In y s <-> E.eq x y}. - Proof. + Proof. intros; exists (singleton x); intuition. Qed. - + Definition remove : forall (x : elt) (s : t), {s' : t | forall y : elt, In y s' <-> ~ E.eq x y /\ In y s}. Proof. intros; exists (remove x s); intuition. absurd (In x (remove x s)); auto with set. - apply In_1 with y; auto. + apply In_1 with y; auto. elim (E.eq_dec x y); intros; auto. absurd (In x (remove x s)); auto with set. - apply In_1 with y; auto. + apply In_1 with y; auto. eauto with set. Qed. @@ -75,47 +75,47 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E. forall s s' : t, {s'' : t | forall x : elt, In x s'' <-> In x s \/ In x s'}. Proof. intros; exists (union s s'); intuition. - Qed. + Qed. Definition inter : forall s s' : t, {s'' : t | forall x : elt, In x s'' <-> In x s /\ In x s'}. - Proof. + Proof. intros; exists (inter s s'); intuition; eauto with set. Qed. Definition diff : forall s s' : t, {s'' : t | forall x : elt, In x s'' <-> In x s /\ ~ In x s'}. - Proof. - intros; exists (diff s s'); intuition; eauto with set. - absurd (In x s'); eauto with set. - Qed. - + Proof. + intros; exists (diff s s'); intuition; eauto with set. + absurd (In x s'); eauto with set. + Qed. + Definition equal : forall s s' : t, {Equal s s'} + {~ Equal s s'}. - Proof. - intros. + Proof. + intros. generalize (equal_1 (s:=s) (s':=s')) (equal_2 (s:=s) (s':=s')). case (equal s s'); intuition. Qed. Definition subset : forall s s' : t, {Subset s s'} + {~Subset s s'}. - Proof. - intros. + Proof. + intros. generalize (subset_1 (s:=s) (s':=s')) (subset_2 (s:=s) (s':=s')). case (subset s s'); intuition. - Qed. + Qed. Definition elements : forall s : t, {l : list elt | sort E.lt l /\ (forall x : elt, In x s <-> InA E.eq x l)}. Proof. - intros; exists (elements s); intuition. - Defined. + intros; exists (elements s); intuition. + Defined. Definition fold : forall (A : Type) (f : elt -> A -> A) (s : t) (i : A), - {r : A | let (l,_) := elements s in + {r : A | let (l,_) := elements s in r = fold_left (fun a e => f e a) l i}. - Proof. + Proof. intros; exists (fold (A:=A) f s i); exact (fold_1 s i f). Qed. @@ -124,10 +124,10 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E. {r : nat | let (l,_) := elements s in r = length l }. Proof. intros; exists (cardinal s); exact (cardinal_1 s). - Qed. + Qed. Definition fdec (P : elt -> Prop) (Pdec : forall x : elt, {P x} + {~ P x}) - (x : elt) := if Pdec x then true else false. + (x : elt) := if Pdec x then true else false. Lemma compat_P_aux : forall (P : elt -> Prop) (Pdec : forall x : elt, {P x} + {~ P x}), @@ -143,7 +143,7 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E. forall (P : elt -> Prop) (Pdec : forall x : elt, {P x} + {~ P x}) (s : t), {s' : t | compat_P E.eq P -> forall x : elt, In x s' <-> In x s /\ P x}. Proof. - intros. + intros. exists (filter (fdec Pdec) s). intro H; assert (compat_bool E.eq (fdec Pdec)); auto. intuition. @@ -160,29 +160,29 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E. Definition for_all : forall (P : elt -> Prop) (Pdec : forall x : elt, {P x} + {~ P x}) (s : t), {compat_P E.eq P -> For_all P s} + {compat_P E.eq P -> ~ For_all P s}. - Proof. - intros. + Proof. + intros. generalize (for_all_1 (s:=s) (f:=fdec Pdec)) (for_all_2 (s:=s) (f:=fdec Pdec)). case (for_all (fdec Pdec) s); unfold For_all in |- *; [ left | right ]; intros. assert (compat_bool E.eq (fdec Pdec)); auto. generalize (H0 H3 (refl_equal _) _ H2). - unfold fdec in |- *. + unfold fdec in |- *. case (Pdec x); intuition. inversion H4. - intuition. + intuition. absurd (false = true); [ auto with bool | apply H; auto ]. intro. - unfold fdec in |- *. + unfold fdec in |- *. case (Pdec x); intuition. Qed. Definition exists_ : forall (P : elt -> Prop) (Pdec : forall x : elt, {P x} + {~ P x}) (s : t), {compat_P E.eq P -> Exists P s} + {compat_P E.eq P -> ~ Exists P s}. - Proof. - intros. + Proof. + intros. generalize (exists_1 (s:=s) (f:=fdec Pdec)) (exists_2 (s:=s) (f:=fdec Pdec)). case (exists_ (fdec Pdec) s); unfold Exists in |- *; [ left | right ]; @@ -190,14 +190,14 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E. elim H0; auto; intros. exists x; intuition. generalize H4. - unfold fdec in |- *. + unfold fdec in |- *. case (Pdec x); intuition. inversion H2. - intuition. - elim H2; intros. + intuition. + elim H2; intros. absurd (false = true); [ auto with bool | apply H; auto ]. exists x; intuition. - unfold fdec in |- *. + unfold fdec in |- *. case (Pdec x); intuition. Qed. @@ -228,12 +228,12 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E. inversion H9. generalize H; unfold For_all, Equal in |- *; intuition. elim (H0 x); intros. - cut ((fun x => negb (fdec Pdec x)) x = true). + cut ((fun x => negb (fdec Pdec x)) x = true). unfold fdec in |- *; case (Pdec x); intuition. change ((fun x => negb (fdec Pdec x)) x = true) in |- *. apply (filter_2 (s:=s) (x:=x)); auto. set (b := fdec Pdec x) in *; generalize (refl_equal b); - pattern b at -1 in |- *; case b; unfold b in |- *; + pattern b at -1 in |- *; case b; unfold b in |- *; [ left | right ]. elim (H4 x); intros _ B; apply B; auto with set. elim (H x); intros _ B; apply B; auto with set. @@ -242,16 +242,16 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E. eapply (filter_1 (s:=s) (x:=x) H2); elim (H4 x); intros B _; apply B; auto. eapply (filter_1 (s:=s) (x:=x) H3); elim (H x); intros B _; apply B; auto. - Qed. + Qed. - Definition choose_aux: forall s : t, + Definition choose_aux: forall s : t, { x : elt | M.choose s = Some x } + { M.choose s = None }. Proof. intros. destruct (M.choose s); [left | right]; auto. exists e; auto. Qed. - + Definition choose : forall s : t, {x : elt | In x s} + {Empty s}. Proof. intros; destruct (choose_aux s) as [(x,Hx)|H]. @@ -259,12 +259,12 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E. right; apply choose_2; auto. Defined. - Lemma choose_ok1 : - forall s x, M.choose s = Some x <-> exists H:In x s, + Lemma choose_ok1 : + forall s x, M.choose s = Some x <-> exists H:In x s, choose s = inleft _ (exist (fun x => In x s) x H). Proof. intros s x. - unfold choose; split; intros. + unfold choose; split; intros. destruct (choose_aux s) as [(y,Hy)|H']; try congruence. replace x with y in * by congruence. exists (choose_1 Hy); auto. @@ -272,10 +272,10 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E. destruct (choose_aux s) as [(y,Hy)|H']; congruence. Qed. - Lemma choose_ok2 : - forall s, M.choose s = None <-> exists H:Empty s, + Lemma choose_ok2 : + forall s, M.choose s = None <-> exists H:Empty s, choose s = inright _ H. - Proof. + Proof. intros s. unfold choose; split; intros. destruct (choose_aux s) as [(y,Hy)|H']; try congruence. @@ -284,8 +284,8 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E. destruct (choose_aux s) as [(y,Hy)|H']; congruence. Qed. - Lemma choose_equal : forall s s', Equal s s' -> - match choose s, choose s' with + Lemma choose_equal : forall s s', Equal s s' -> + match choose s, choose s' with | inleft (exist x _), inleft (exist x' _) => E.eq x x' | inright _, inright _ => True | _, _ => False @@ -306,29 +306,29 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E. Definition min_elt : forall s : t, {x : elt | In x s /\ For_all (fun y => ~ E.lt y x) s} + {Empty s}. - Proof. + Proof. intros; generalize (min_elt_1 (s:=s)) (min_elt_2 (s:=s)) (min_elt_3 (s:=s)). - case (min_elt s); [ left | right ]; auto. + case (min_elt s); [ left | right ]; auto. exists e; unfold For_all in |- *; eauto. - Qed. + Qed. Definition max_elt : forall s : t, {x : elt | In x s /\ For_all (fun y => ~ E.lt x y) s} + {Empty s}. - Proof. + Proof. intros; generalize (max_elt_1 (s:=s)) (max_elt_2 (s:=s)) (max_elt_3 (s:=s)). - case (max_elt s); [ left | right ]; auto. + case (max_elt s); [ left | right ]; auto. exists e; unfold For_all in |- *; eauto. - Qed. + Qed. - Module E := E. + Module E := E. Definition elt := elt. Definition t := t. - Definition In := In. + Definition In := In. Definition Equal s s' := forall a : elt, In a s <-> In a s'. Definition Subset s s' := forall a : elt, In a s -> In a s'. Definition Empty s := forall a : elt, ~ In a s. @@ -336,7 +336,7 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E. forall x : elt, In x s -> P x. Definition Exists (P : elt -> Prop) (s : t) := exists x : elt, In x s /\ P x. - + Definition eq_In := In_1. Definition eq := Equal. @@ -344,7 +344,7 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E. Definition eq_refl := eq_refl. Definition eq_sym := eq_sym. Definition eq_trans := eq_trans. - Definition lt_trans := lt_trans. + Definition lt_trans := lt_trans. Definition lt_not_eq := lt_not_eq. Definition compare := compare. @@ -386,7 +386,7 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. Proof. intros; unfold mem in |- *; case (M.mem x s); auto. Qed. - + Lemma mem_2 : forall (s : t) (x : elt), mem x s = true -> In x s. Proof. intros s x; unfold mem in |- *; case (M.mem x s); auto. @@ -399,26 +399,26 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. if equal s s' then true else false. Lemma equal_1 : forall s s' : t, Equal s s' -> equal s s' = true. - Proof. + Proof. intros; unfold equal in |- *; case M.equal; intuition. - Qed. - + Qed. + Lemma equal_2 : forall s s' : t, equal s s' = true -> Equal s s'. - Proof. + Proof. intros s s'; unfold equal in |- *; case (M.equal s s'); intuition; inversion H. Qed. - + Definition subset (s s' : t) : bool := if subset s s' then true else false. Lemma subset_1 : forall s s' : t, Subset s s' -> subset s s' = true. - Proof. + Proof. intros; unfold subset in |- *; case M.subset; intuition. - Qed. - + Qed. + Lemma subset_2 : forall s s' : t, subset s s' = true -> Subset s s'. - Proof. + Proof. intros s s'; unfold subset in |- *; case (M.subset s s'); intuition; inversion H. Qed. @@ -441,34 +441,34 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. intro s; unfold choose in |- *; case (M.choose s); auto. simple destruct s0; intros; discriminate H. Qed. - - Lemma choose_3 : forall s s' x x', + + Lemma choose_3 : forall s s' x x', choose s = Some x -> choose s' = Some x' -> Equal s s' -> E.eq x x'. Proof. unfold choose; intros. generalize (M.choose_equal H1); clear H1. - destruct (M.choose s) as [(?,?)|?]; destruct (M.choose s') as [(?,?)|?]; + destruct (M.choose s) as [(?,?)|?]; destruct (M.choose s') as [(?,?)|?]; simpl; auto; congruence. Qed. - Definition elements (s : t) : list elt := let (l, _) := elements s in l. - + Definition elements (s : t) : list elt := let (l, _) := elements s in l. + Lemma elements_1 : forall (s : t) (x : elt), In x s -> InA E.eq x (elements s). - Proof. + Proof. intros; unfold elements in |- *; case (M.elements s); firstorder. Qed. Lemma elements_2 : forall (s : t) (x : elt), InA E.eq x (elements s) -> In x s. - Proof. + Proof. intros s x; unfold elements in |- *; case (M.elements s); firstorder. Qed. - Lemma elements_3 : forall s : t, sort E.lt (elements s). - Proof. + Lemma elements_3 : forall s : t, sort E.lt (elements s). + Proof. intros; unfold elements in |- *; case (M.elements s); firstorder. Qed. Hint Resolve elements_3. - + Lemma elements_3w : forall s : t, NoDupA E.eq (elements s). Proof. auto. Qed. @@ -478,27 +478,27 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. | inright _ => None end. - Lemma min_elt_1 : forall (s : t) (x : elt), min_elt s = Some x -> In x s. + Lemma min_elt_1 : forall (s : t) (x : elt), min_elt s = Some x -> In x s. Proof. intros s x; unfold min_elt in |- *; case (M.min_elt s). simple destruct s0; intros; injection H; intros; subst; intuition. intros; discriminate H. - Qed. + Qed. Lemma min_elt_2 : - forall (s : t) (x y : elt), min_elt s = Some x -> In y s -> ~ E.lt y x. + forall (s : t) (x y : elt), min_elt s = Some x -> In y s -> ~ E.lt y x. Proof. intros s x y; unfold min_elt in |- *; case (M.min_elt s). unfold For_all in |- *; simple destruct s0; intros; injection H; intros; subst; firstorder. intros; discriminate H. - Qed. + Qed. Lemma min_elt_3 : forall s : t, min_elt s = None -> Empty s. Proof. intros s; unfold min_elt in |- *; case (M.min_elt s); auto. simple destruct s0; intros; discriminate H. - Qed. + Qed. Definition max_elt (s : t) : option elt := match max_elt s with @@ -506,27 +506,27 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. | inright _ => None end. - Lemma max_elt_1 : forall (s : t) (x : elt), max_elt s = Some x -> In x s. + Lemma max_elt_1 : forall (s : t) (x : elt), max_elt s = Some x -> In x s. Proof. intros s x; unfold max_elt in |- *; case (M.max_elt s). simple destruct s0; intros; injection H; intros; subst; intuition. intros; discriminate H. - Qed. + Qed. Lemma max_elt_2 : - forall (s : t) (x y : elt), max_elt s = Some x -> In y s -> ~ E.lt x y. + forall (s : t) (x y : elt), max_elt s = Some x -> In y s -> ~ E.lt x y. Proof. intros s x y; unfold max_elt in |- *; case (M.max_elt s). unfold For_all in |- *; simple destruct s0; intros; injection H; intros; subst; firstorder. intros; discriminate H. - Qed. + Qed. Lemma max_elt_3 : forall s : t, max_elt s = None -> Empty s. Proof. intros s; unfold max_elt in |- *; case (M.max_elt s); auto. simple destruct s0; intros; discriminate H. - Qed. + Qed. Definition add (x : elt) (s : t) : t := let (s', _) := add x s in s'. @@ -566,70 +566,70 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. Proof. intros s x y; unfold remove in |- *; case (M.remove x s); firstorder. Qed. - - Definition singleton (x : elt) : t := let (s, _) := singleton x in s. - - Lemma singleton_1 : forall x y : elt, In y (singleton x) -> E.eq x y. + + Definition singleton (x : elt) : t := let (s, _) := singleton x in s. + + Lemma singleton_1 : forall x y : elt, In y (singleton x) -> E.eq x y. Proof. intros x y; unfold singleton in |- *; case (M.singleton x); firstorder. Qed. - Lemma singleton_2 : forall x y : elt, E.eq x y -> In y (singleton x). + Lemma singleton_2 : forall x y : elt, E.eq x y -> In y (singleton x). Proof. intros x y; unfold singleton in |- *; case (M.singleton x); firstorder. Qed. - + Definition union (s s' : t) : t := let (s'', _) := union s s' in s''. - + Lemma union_1 : forall (s s' : t) (x : elt), In x (union s s') -> In x s \/ In x s'. - Proof. + Proof. intros s s' x; unfold union in |- *; case (M.union s s'); firstorder. Qed. - Lemma union_2 : forall (s s' : t) (x : elt), In x s -> In x (union s s'). - Proof. + Lemma union_2 : forall (s s' : t) (x : elt), In x s -> In x (union s s'). + Proof. intros s s' x; unfold union in |- *; case (M.union s s'); firstorder. Qed. Lemma union_3 : forall (s s' : t) (x : elt), In x s' -> In x (union s s'). - Proof. + Proof. intros s s' x; unfold union in |- *; case (M.union s s'); firstorder. Qed. Definition inter (s s' : t) : t := let (s'', _) := inter s s' in s''. - + Lemma inter_1 : forall (s s' : t) (x : elt), In x (inter s s') -> In x s. - Proof. + Proof. intros s s' x; unfold inter in |- *; case (M.inter s s'); firstorder. Qed. Lemma inter_2 : forall (s s' : t) (x : elt), In x (inter s s') -> In x s'. - Proof. + Proof. intros s s' x; unfold inter in |- *; case (M.inter s s'); firstorder. Qed. Lemma inter_3 : forall (s s' : t) (x : elt), In x s -> In x s' -> In x (inter s s'). - Proof. + Proof. intros s s' x; unfold inter in |- *; case (M.inter s s'); firstorder. Qed. Definition diff (s s' : t) : t := let (s'', _) := diff s s' in s''. - + Lemma diff_1 : forall (s s' : t) (x : elt), In x (diff s s') -> In x s. - Proof. + Proof. intros s s' x; unfold diff in |- *; case (M.diff s s'); firstorder. Qed. Lemma diff_2 : forall (s s' : t) (x : elt), In x (diff s s') -> ~ In x s'. - Proof. + Proof. intros s s' x; unfold diff in |- *; case (M.diff s s'); firstorder. Qed. Lemma diff_3 : forall (s s' : t) (x : elt), In x s -> ~ In x s' -> In x (diff s s'). - Proof. + Proof. intros s s' x; unfold diff in |- *; case (M.diff s s'); firstorder. Qed. @@ -637,26 +637,26 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. Lemma cardinal_1 : forall s, cardinal s = length (elements s). Proof. - intros; unfold cardinal in |- *; case (M.cardinal s); unfold elements in *; + intros; unfold cardinal in |- *; case (M.cardinal s); unfold elements in *; destruct (M.elements s); auto. Qed. - Definition fold (B : Type) (f : elt -> B -> B) (i : t) + Definition fold (B : Type) (f : elt -> B -> B) (i : t) (s : B) : B := let (fold, _) := fold f i s in fold. Lemma fold_1 : forall (s : t) (A : Type) (i : A) (f : elt -> A -> A), fold f s i = fold_left (fun a e => f e a) (elements s) i. Proof. - intros; unfold fold in |- *; case (M.fold f s i); unfold elements in *; + intros; unfold fold in |- *; case (M.fold f s i); unfold elements in *; destruct (M.elements s); auto. - Qed. + Qed. Definition f_dec : forall (f : elt -> bool) (x : elt), {f x = true} + {f x <> true}. Proof. intros; case (f x); auto with bool. - Defined. + Defined. Lemma compat_P_aux : forall f : elt -> bool, @@ -666,7 +666,7 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. Qed. Hint Resolve compat_P_aux. - + Definition filter (f : elt -> bool) (s : t) : t := let (s', _) := filter (P:=fun x => f x = true) (f_dec f) s in s'. @@ -680,7 +680,7 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. Lemma filter_2 : forall (s : t) (x : elt) (f : elt -> bool), - compat_bool E.eq f -> In x (filter f s) -> f x = true. + compat_bool E.eq f -> In x (filter f s) -> f x = true. Proof. intros s x f; unfold filter in |- *; case M.filter; intuition. generalize (i (compat_P_aux H)); firstorder. @@ -688,7 +688,7 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. Lemma filter_3 : forall (s : t) (x : elt) (f : elt -> bool), - compat_bool E.eq f -> In x s -> f x = true -> In x (filter f s). + compat_bool E.eq f -> In x s -> f x = true -> In x (filter f s). Proof. intros s x f; unfold filter in |- *; case M.filter; intuition. generalize (i (compat_P_aux H)); firstorder. @@ -697,98 +697,98 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. Definition for_all (f : elt -> bool) (s : t) : bool := if for_all (P:=fun x => f x = true) (f_dec f) s then true - else false. + else false. Lemma for_all_1 : forall (s : t) (f : elt -> bool), compat_bool E.eq f -> For_all (fun x => f x = true) s -> for_all f s = true. - Proof. + Proof. intros s f; unfold for_all in |- *; case M.for_all; intuition; elim n; auto. Qed. - + Lemma for_all_2 : forall (s : t) (f : elt -> bool), compat_bool E.eq f -> for_all f s = true -> For_all (fun x => f x = true) s. - Proof. + Proof. intros s f; unfold for_all in |- *; case M.for_all; intuition; inversion H0. Qed. - + Definition exists_ (f : elt -> bool) (s : t) : bool := if exists_ (P:=fun x => f x = true) (f_dec f) s then true - else false. + else false. Lemma exists_1 : forall (s : t) (f : elt -> bool), compat_bool E.eq f -> Exists (fun x => f x = true) s -> exists_ f s = true. - Proof. + Proof. intros s f; unfold exists_ in |- *; case M.exists_; intuition; elim n; auto. Qed. - + Lemma exists_2 : forall (s : t) (f : elt -> bool), compat_bool E.eq f -> exists_ f s = true -> Exists (fun x => f x = true) s. - Proof. + Proof. intros s f; unfold exists_ in |- *; case M.exists_; intuition; inversion H0. Qed. - - Definition partition (f : elt -> bool) (s : t) : + + Definition partition (f : elt -> bool) (s : t) : t * t := let (p, _) := partition (P:=fun x => f x = true) (f_dec f) s in p. - + Lemma partition_1 : forall (s : t) (f : elt -> bool), compat_bool E.eq f -> Equal (fst (partition f s)) (filter f s). Proof. - intros s f; unfold partition in |- *; case M.partition. - intro p; case p; clear p; intros s1 s2 H C. + intros s f; unfold partition in |- *; case M.partition. + intro p; case p; clear p; intros s1 s2 H C. generalize (H (compat_P_aux C)); clear H; intro H. simpl in |- *; unfold Equal in |- *; intuition. - apply filter_3; firstorder. - elim (H2 a); intros. - assert (In a s). + apply filter_3; firstorder. + elim (H2 a); intros. + assert (In a s). eapply filter_1; eauto. elim H3; intros; auto. absurd (f a = true). exact (H a H6). - eapply filter_2; eauto. - Qed. - + eapply filter_2; eauto. + Qed. + Lemma partition_2 : forall (s : t) (f : elt -> bool), compat_bool E.eq f -> Equal (snd (partition f s)) (filter (fun x => negb (f x)) s). Proof. - intros s f; unfold partition in |- *; case M.partition. - intro p; case p; clear p; intros s1 s2 H C. + intros s f; unfold partition in |- *; case M.partition. + intro p; case p; clear p; intros s1 s2 H C. generalize (H (compat_P_aux C)); clear H; intro H. assert (D : compat_bool E.eq (fun x => negb (f x))). generalize C; unfold compat_bool in |- *; intros; apply (f_equal negb); auto. simpl in |- *; unfold Equal in |- *; intuition. apply filter_3; firstorder. - elim (H2 a); intros. - assert (In a s). + elim (H2 a); intros. + assert (In a s). eapply filter_1; eauto. elim H3; intros; auto. absurd (f a = true). intro. - generalize (filter_2 D H1). + generalize (filter_2 D H1). rewrite H7; intros H8; inversion H8. exact (H0 a H6). - Qed. + Qed. - Module E := E. + Module E := E. Definition elt := elt. Definition t := t. - Definition In := In. + Definition In := In. Definition Equal s s' := forall a : elt, In a s <-> In a s'. Definition Subset s s' := forall a : elt, In a s -> In a s'. Definition Add (x : elt) (s s' : t) := @@ -806,7 +806,7 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. Definition eq_refl := eq_refl. Definition eq_sym := eq_sym. Definition eq_trans := eq_trans. - Definition lt_trans := lt_trans. + Definition lt_trans := lt_trans. Definition lt_not_eq := lt_not_eq. Definition compare := compare. diff --git a/theories/FSets/FSetDecide.v b/theories/FSets/FSetDecide.v index b7a1deb77..89cdc932f 100644 --- a/theories/FSets/FSetDecide.v +++ b/theories/FSets/FSetDecide.v @@ -148,35 +148,35 @@ the above form: XXX: This tactic and the similar subsequent ones should have been defined using [autorewrite]. However, dealing - with multiples rewrite sites and side-conditions is - done more cleverly with the following explicit + with multiples rewrite sites and side-conditions is + done more cleverly with the following explicit analysis of goals. *) - Ltac or_not_l_iff P Q tac := - (rewrite (or_not_l_iff_1 P Q) by tac) || + Ltac or_not_l_iff P Q tac := + (rewrite (or_not_l_iff_1 P Q) by tac) || (rewrite (or_not_l_iff_2 P Q) by tac). - Ltac or_not_r_iff P Q tac := - (rewrite (or_not_r_iff_1 P Q) by tac) || + Ltac or_not_r_iff P Q tac := + (rewrite (or_not_r_iff_1 P Q) by tac) || (rewrite (or_not_r_iff_2 P Q) by tac). - Ltac or_not_l_iff_in P Q H tac := - (rewrite (or_not_l_iff_1 P Q) in H by tac) || + Ltac or_not_l_iff_in P Q H tac := + (rewrite (or_not_l_iff_1 P Q) in H by tac) || (rewrite (or_not_l_iff_2 P Q) in H by tac). - Ltac or_not_r_iff_in P Q H tac := - (rewrite (or_not_r_iff_1 P Q) in H by tac) || + Ltac or_not_r_iff_in P Q H tac := + (rewrite (or_not_r_iff_1 P Q) in H by tac) || (rewrite (or_not_r_iff_2 P Q) in H by tac). Tactic Notation "push" "not" "using" ident(db) := - let dec := solve_decidable using db in + let dec := solve_decidable using db in unfold not, iff; repeat ( match goal with | |- context [True -> False] => rewrite not_true_iff | |- context [False -> False] => rewrite not_false_iff | |- context [(?P -> False) -> False] => rewrite (not_not_iff P) by dec - | |- context [(?P -> False) -> (?Q -> False)] => + | |- context [(?P -> False) -> (?Q -> False)] => rewrite (contrapositive P Q) by dec | |- context [(?P -> False) \/ ?Q] => or_not_l_iff P Q dec | |- context [?P \/ (?Q -> False)] => or_not_r_iff P Q dec @@ -192,23 +192,23 @@ the above form: Tactic Notation "push" "not" "in" "*" "|-" "using" ident(db) := - let dec := solve_decidable using db in + let dec := solve_decidable using db in unfold not, iff in * |-; repeat ( match goal with | H: context [True -> False] |- _ => rewrite not_true_iff in H | H: context [False -> False] |- _ => rewrite not_false_iff in H - | H: context [(?P -> False) -> False] |- _ => + | H: context [(?P -> False) -> False] |- _ => rewrite (not_not_iff P) in H by dec | H: context [(?P -> False) -> (?Q -> False)] |- _ => rewrite (contrapositive P Q) in H by dec | H: context [(?P -> False) \/ ?Q] |- _ => or_not_l_iff_in P Q H dec | H: context [?P \/ (?Q -> False)] |- _ => or_not_r_iff_in P Q H dec - | H: context [(?P -> False) -> ?Q] |- _ => + | H: context [(?P -> False) -> ?Q] |- _ => rewrite (imp_not_l P Q) in H by dec | H: context [?P \/ ?Q -> False] |- _ => rewrite (not_or_iff P Q) in H | H: context [?P /\ ?Q -> False] |- _ => rewrite (not_and_iff P Q) in H - | H: context [(?P -> ?Q) -> False] |- _ => + | H: context [(?P -> ?Q) -> False] |- _ => rewrite (not_imp_iff P Q) in H by dec end); fold any not. @@ -253,7 +253,7 @@ the above form: the hypotheses and goal together. *) Tactic Notation "pull" "not" "using" ident(db) := - let dec := solve_decidable using db in + let dec := solve_decidable using db in unfold not, iff; repeat ( match goal with @@ -269,7 +269,7 @@ the above form: rewrite <- (not_or_iff P Q) | |- context [?P -> ?Q -> False] => rewrite <- (not_and_iff P Q) | |- context [?P /\ (?Q -> False)] => rewrite <- (not_imp_iff P Q) by dec - | |- context [(?Q -> False) /\ ?P] => + | |- context [(?Q -> False) /\ ?P] => rewrite <- (not_imp_rev_iff P Q) by dec end); fold any not. @@ -279,7 +279,7 @@ the above form: Tactic Notation "pull" "not" "in" "*" "|-" "using" ident(db) := - let dec := solve_decidable using db in + let dec := solve_decidable using db in unfold not, iff in * |-; repeat ( match goal with @@ -294,8 +294,8 @@ the above form: | H: context [(?P -> False) -> ?Q] |- _ => rewrite (imp_not_l P Q) in H by dec | H: context [(?P -> False) /\ (?Q -> False)] |- _ => - rewrite <- (not_or_iff P Q) in H - | H: context [?P -> ?Q -> False] |- _ => + rewrite <- (not_or_iff P Q) in H + | H: context [?P -> ?Q -> False] |- _ => rewrite <- (not_and_iff P Q) in H | H: context [?P /\ (?Q -> False)] |- _ => rewrite <- (not_imp_iff P Q) in H by dec diff --git a/theories/FSets/FSetEqProperties.v b/theories/FSets/FSetEqProperties.v index 7ec360a66..d843bbcd6 100644 --- a/theories/FSets/FSetEqProperties.v +++ b/theories/FSets/FSetEqProperties.v @@ -10,11 +10,11 @@ (** * Finite sets library *) -(** This module proves many properties of finite sets that - are consequences of the axiomatization in [FsetInterface] - Contrary to the functor in [FsetProperties] it uses +(** This module proves many properties of finite sets that + are consequences of the axiomatization in [FsetInterface] + Contrary to the functor in [FsetProperties] it uses sets operations instead of predicates over sets, i.e. - [mem x s=true] instead of [In x s], + [mem x s=true] instead of [In x s], [equal s s'=true] instead of [Equal s s'], etc. *) Require Import FSetProperties Zerob Sumbool Omega DecidableTypeEx. @@ -26,59 +26,59 @@ Import M. Definition Add := MP.Add. -Section BasicProperties. +Section BasicProperties. -(** Some old specifications written with boolean equalities. *) +(** Some old specifications written with boolean equalities. *) Variable s s' s'': t. Variable x y z : elt. -Lemma mem_eq: +Lemma mem_eq: E.eq x y -> mem x s=mem y s. -Proof. +Proof. intro H; rewrite H; auto. Qed. -Lemma equal_mem_1: +Lemma equal_mem_1: (forall a, mem a s=mem a s') -> equal s s'=true. -Proof. +Proof. intros; apply equal_1; unfold Equal; intros. do 2 rewrite mem_iff; rewrite H; tauto. Qed. -Lemma equal_mem_2: +Lemma equal_mem_2: equal s s'=true -> forall a, mem a s=mem a s'. -Proof. +Proof. intros; rewrite (equal_2 H); auto. Qed. -Lemma subset_mem_1: +Lemma subset_mem_1: (forall a, mem a s=true->mem a s'=true) -> subset s s'=true. -Proof. +Proof. intros; apply subset_1; unfold Subset; intros a. do 2 rewrite mem_iff; auto. Qed. -Lemma subset_mem_2: +Lemma subset_mem_2: subset s s'=true -> forall a, mem a s=true -> mem a s'=true. -Proof. +Proof. intros H a; do 2 rewrite <- mem_iff; apply subset_2; auto. Qed. - + Lemma empty_mem: mem x empty=false. -Proof. +Proof. rewrite <- not_mem_iff; auto with set. Qed. Lemma is_empty_equal_empty: is_empty s = equal s empty. -Proof. +Proof. apply bool_1; split; intros. auto with set. rewrite <- is_empty_iff; auto with set. Qed. - + Lemma choose_mem_1: choose s=Some x -> mem x s=true. -Proof. +Proof. auto with set. Qed. @@ -90,44 +90,44 @@ Qed. Lemma add_mem_1: mem x (add x s)=true. Proof. auto with set. -Qed. - +Qed. + Lemma add_mem_2: ~E.eq x y -> mem y (add x s)=mem y s. -Proof. +Proof. apply add_neq_b. Qed. Lemma remove_mem_1: mem x (remove x s)=false. -Proof. +Proof. rewrite <- not_mem_iff; auto with set. -Qed. - +Qed. + Lemma remove_mem_2: ~E.eq x y -> mem y (remove x s)=mem y s. -Proof. +Proof. apply remove_neq_b. Qed. -Lemma singleton_equal_add: +Lemma singleton_equal_add: equal (singleton x) (add x empty)=true. Proof. rewrite (singleton_equal_add x); auto with set. -Qed. +Qed. -Lemma union_mem: +Lemma union_mem: mem x (union s s')=mem x s || mem x s'. -Proof. +Proof. apply union_b. Qed. -Lemma inter_mem: +Lemma inter_mem: mem x (inter s s')=mem x s && mem x s'. -Proof. +Proof. apply inter_b. Qed. -Lemma diff_mem: +Lemma diff_mem: mem x (diff s s')=mem x s && negb (mem x s'). -Proof. +Proof. apply diff_b. Qed. @@ -143,7 +143,7 @@ Proof. intros; rewrite not_mem_iff; auto. Qed. -(** Properties of [equal] *) +(** Properties of [equal] *) Lemma equal_refl: equal s s=true. Proof. @@ -155,19 +155,19 @@ Proof. intros; apply bool_1; do 2 rewrite <- equal_iff; intuition. Qed. -Lemma equal_trans: +Lemma equal_trans: equal s s'=true -> equal s' s''=true -> equal s s''=true. Proof. intros; rewrite (equal_2 H); auto. Qed. -Lemma equal_equal: +Lemma equal_equal: equal s s'=true -> equal s s''=equal s' s''. Proof. intros; rewrite (equal_2 H); auto. Qed. -Lemma equal_cardinal: +Lemma equal_cardinal: equal s s'=true -> cardinal s=cardinal s'. Proof. auto with set. @@ -175,25 +175,25 @@ Qed. (* Properties of [subset] *) -Lemma subset_refl: subset s s=true. +Lemma subset_refl: subset s s=true. Proof. auto with set. Qed. -Lemma subset_antisym: +Lemma subset_antisym: subset s s'=true -> subset s' s=true -> equal s s'=true. Proof. auto with set. Qed. -Lemma subset_trans: +Lemma subset_trans: subset s s'=true -> subset s' s''=true -> subset s s''=true. Proof. do 3 rewrite <- subset_iff; intros. apply subset_trans with s'; auto. Qed. -Lemma subset_equal: +Lemma subset_equal: equal s s'=true -> subset s s'=true. Proof. auto with set. @@ -201,7 +201,7 @@ Qed. (** Properties of [choose] *) -Lemma choose_mem_3: +Lemma choose_mem_3: is_empty s=false -> {x:elt|choose s=Some x /\ mem x s=true}. Proof. intros. @@ -221,13 +221,13 @@ Qed. (** Properties of [add] *) -Lemma add_mem_3: +Lemma add_mem_3: mem y s=true -> mem y (add x s)=true. Proof. auto with set. Qed. -Lemma add_equal: +Lemma add_equal: mem x s=true -> equal (add x s) s=true. Proof. auto with set. @@ -235,26 +235,26 @@ Qed. (** Properties of [remove] *) -Lemma remove_mem_3: +Lemma remove_mem_3: mem y (remove x s)=true -> mem y s=true. Proof. rewrite remove_b; intros H;destruct (andb_prop _ _ H); auto. Qed. -Lemma remove_equal: +Lemma remove_equal: mem x s=false -> equal (remove x s) s=true. Proof. intros; apply equal_1; apply remove_equal. rewrite not_mem_iff; auto. Qed. -Lemma add_remove: +Lemma add_remove: mem x s=true -> equal (add x (remove x s)) s=true. Proof. intros; apply equal_1; apply add_remove; auto with set. Qed. -Lemma remove_add: +Lemma remove_add: mem x s=false -> equal (remove x (add x s)) s=true. Proof. intros; apply equal_1; apply remove_add; auto. @@ -297,37 +297,37 @@ Proof. auto with set. Qed. -Lemma union_subset_equal: +Lemma union_subset_equal: subset s s'=true -> equal (union s s') s'=true. Proof. auto with set. Qed. -Lemma union_equal_1: +Lemma union_equal_1: equal s s'=true-> equal (union s s'') (union s' s'')=true. Proof. auto with set. Qed. -Lemma union_equal_2: +Lemma union_equal_2: equal s' s''=true-> equal (union s s') (union s s'')=true. Proof. auto with set. Qed. -Lemma union_assoc: +Lemma union_assoc: equal (union (union s s') s'') (union s (union s' s''))=true. Proof. auto with set. Qed. -Lemma add_union_singleton: +Lemma add_union_singleton: equal (add x s) (union (singleton x) s)=true. Proof. auto with set. Qed. -Lemma union_add: +Lemma union_add: equal (union (add x s) s') (add x (union s s'))=true. Proof. auto with set. @@ -346,62 +346,62 @@ auto with set. Qed. Lemma union_subset_3: - subset s s''=true -> subset s' s''=true -> + subset s s''=true -> subset s' s''=true -> subset (union s s') s''=true. Proof. intros; apply subset_1; apply union_subset_3; auto with set. Qed. -(** Properties of [inter] *) +(** Properties of [inter] *) Lemma inter_sym: equal (inter s s') (inter s' s)=true. Proof. auto with set. Qed. -Lemma inter_subset_equal: +Lemma inter_subset_equal: subset s s'=true -> equal (inter s s') s=true. Proof. auto with set. Qed. -Lemma inter_equal_1: +Lemma inter_equal_1: equal s s'=true -> equal (inter s s'') (inter s' s'')=true. Proof. auto with set. Qed. -Lemma inter_equal_2: +Lemma inter_equal_2: equal s' s''=true -> equal (inter s s') (inter s s'')=true. Proof. auto with set. Qed. -Lemma inter_assoc: +Lemma inter_assoc: equal (inter (inter s s') s'') (inter s (inter s' s''))=true. Proof. auto with set. Qed. -Lemma union_inter_1: +Lemma union_inter_1: equal (inter (union s s') s'') (union (inter s s'') (inter s' s''))=true. Proof. auto with set. Qed. -Lemma union_inter_2: +Lemma union_inter_2: equal (union (inter s s') s'') (inter (union s s'') (union s' s''))=true. Proof. auto with set. Qed. -Lemma inter_add_1: mem x s'=true -> +Lemma inter_add_1: mem x s'=true -> equal (inter (add x s) s') (add x (inter s s'))=true. Proof. auto with set. Qed. -Lemma inter_add_2: mem x s'=false -> +Lemma inter_add_2: mem x s'=false -> equal (inter (add x s) s') (inter s s')=true. Proof. intros; apply equal_1; apply inter_add_2. @@ -421,7 +421,7 @@ auto with set. Qed. Lemma inter_subset_3: - subset s'' s=true -> subset s'' s'=true -> + subset s'' s=true -> subset s'' s'=true -> subset s'' (inter s s')=true. Proof. intros; apply subset_1; apply inter_subset_3; auto with set. @@ -440,19 +440,19 @@ Proof. auto with set. Qed. -Lemma remove_inter_singleton: +Lemma remove_inter_singleton: equal (remove x s) (diff s (singleton x))=true. Proof. auto with set. Qed. Lemma diff_inter_empty: - equal (inter (diff s s') (inter s s')) empty=true. + equal (inter (diff s s') (inter s s')) empty=true. Proof. auto with set. Qed. -Lemma diff_inter_all: +Lemma diff_inter_all: equal (union (diff s s') (inter s s')) s=true. Proof. auto with set. @@ -462,7 +462,7 @@ End BasicProperties. Hint Immediate empty_mem is_empty_equal_empty add_mem_1 remove_mem_1 singleton_equal_add union_mem inter_mem - diff_mem equal_sym add_remove remove_add : set. + diff_mem equal_sym add_remove remove_add : set. Hint Resolve equal_mem_1 subset_mem_1 choose_mem_1 choose_mem_2 add_mem_2 remove_mem_2 equal_refl equal_equal subset_refl subset_equal subset_antisym @@ -472,8 +472,8 @@ Hint Resolve equal_mem_1 subset_mem_1 choose_mem_1 (** General recursion principle *) Lemma set_rec: forall (P:t->Type), - (forall s s', equal s s'=true -> P s -> P s') -> - (forall s x, mem x s=false -> P s -> P (add x s)) -> + (forall s s', equal s s'=true -> P s -> P s') -> + (forall s x, mem x s=false -> P s -> P (add x s)) -> P empty -> forall s, P s. Proof. intros. @@ -493,51 +493,51 @@ intros; do 2 rewrite mem_iff. destruct (mem x s); destruct (mem x s'); intuition. Qed. -Section Fold. +Section Fold. Variables (A:Type)(eqA:A->A->Prop)(st:Equivalence eqA). Variables (f:elt->A->A)(Comp:compat_op E.eq eqA f)(Ass:transpose eqA f). Variables (i:A). Variables (s s':t)(x:elt). - + Lemma fold_empty: (fold f empty i) = i. -Proof. +Proof. apply fold_empty; auto. Qed. -Lemma fold_equal: +Lemma fold_equal: equal s s'=true -> eqA (fold f s i) (fold f s' i). -Proof. +Proof. intros; apply fold_equal with (eqA:=eqA); auto with set. Qed. - -Lemma fold_add: + +Lemma fold_add: mem x s=false -> eqA (fold f (add x s) i) (f x (fold f s i)). -Proof. +Proof. intros; apply fold_add with (eqA:=eqA); auto. rewrite not_mem_iff; auto. Qed. -Lemma add_fold: +Lemma add_fold: mem x s=true -> eqA (fold f (add x s) i) (fold f s i). Proof. intros; apply add_fold with (eqA:=eqA); auto with set. Qed. -Lemma remove_fold_1: +Lemma remove_fold_1: mem x s=true -> eqA (f x (fold f (remove x s) i)) (fold f s i). Proof. intros; apply remove_fold_1 with (eqA:=eqA); auto with set. Qed. -Lemma remove_fold_2: +Lemma remove_fold_2: mem x s=false -> eqA (fold f (remove x s) i) (fold f s i). Proof. intros; apply remove_fold_2 with (eqA:=eqA); auto. rewrite not_mem_iff; auto. Qed. -Lemma fold_union: - (forall x, mem x s && mem x s'=false) -> +Lemma fold_union: + (forall x, mem x s && mem x s'=false) -> eqA (fold f (union s s') i) (fold f s (fold f s' i)). Proof. intros; apply fold_union with (eqA:=eqA); auto. @@ -548,40 +548,40 @@ End Fold. (** Properties of [cardinal] *) -Lemma add_cardinal_1: +Lemma add_cardinal_1: forall s x, mem x s=true -> cardinal (add x s)=cardinal s. Proof. auto with set. Qed. -Lemma add_cardinal_2: +Lemma add_cardinal_2: forall s x, mem x s=false -> cardinal (add x s)=S (cardinal s). Proof. intros; apply add_cardinal_2; auto. rewrite not_mem_iff; auto. Qed. -Lemma remove_cardinal_1: +Lemma remove_cardinal_1: forall s x, mem x s=true -> S (cardinal (remove x s))=cardinal s. Proof. intros; apply remove_cardinal_1; auto with set. Qed. -Lemma remove_cardinal_2: +Lemma remove_cardinal_2: forall s x, mem x s=false -> cardinal (remove x s)=cardinal s. Proof. intros; apply Equal_cardinal; apply equal_2; auto with set. Qed. -Lemma union_cardinal: - forall s s', (forall x, mem x s && mem x s'=false) -> +Lemma union_cardinal: + forall s s', (forall x, mem x s && mem x s'=false) -> cardinal (union s s')=cardinal s+cardinal s'. Proof. intros; apply union_cardinal; auto; intros. rewrite exclusive_set; auto. Qed. -Lemma subset_cardinal: +Lemma subset_cardinal: forall s s', subset s s'=true -> cardinal s<=cardinal s'. Proof. intros; apply subset_cardinal; auto with set. @@ -600,16 +600,16 @@ unfold compat_bool in *; intros; f_equal; auto. Qed. Lemma filter_mem: forall s x, mem x (filter f s)=mem x s && f x. -Proof. +Proof. intros; apply filter_b; auto. Qed. -Lemma for_all_filter: +Lemma for_all_filter: forall s, for_all f s=is_empty (filter (fun x => negb (f x)) s). -Proof. +Proof. intros; apply bool_1; split; intros. apply is_empty_1. -unfold Empty; intros. +unfold Empty; intros. rewrite filter_iff; auto. red; destruct 1. rewrite <- (@for_all_iff s f) in H; auto. @@ -621,10 +621,10 @@ rewrite filter_iff; auto. destruct (f x); auto. Qed. -Lemma exists_filter : +Lemma exists_filter : forall s, exists_ f s=negb (is_empty (filter f s)). -Proof. -intros; apply bool_1; split; intros. +Proof. +intros; apply bool_1; split; intros. destruct (exists_2 Comp H) as (a,(Ha1,Ha2)). apply bool_6. red; intros; apply (@is_empty_2 _ H0 a); auto with set. @@ -636,28 +636,28 @@ intros _ H0. rewrite (is_empty_1 (H0 (refl_equal None))) in H; auto; discriminate. Qed. -Lemma partition_filter_1: +Lemma partition_filter_1: forall s, equal (fst (partition f s)) (filter f s)=true. -Proof. +Proof. auto with set. Qed. -Lemma partition_filter_2: +Lemma partition_filter_2: forall s, equal (snd (partition f s)) (filter (fun x => negb (f x)) s)=true. -Proof. +Proof. auto with set. Qed. -Lemma filter_add_1 : forall s x, f x = true -> - filter f (add x s) [=] add x (filter f s). +Lemma filter_add_1 : forall s x, f x = true -> + filter f (add x s) [=] add x (filter f s). Proof. red; intros; set_iff; do 2 (rewrite filter_iff; auto); set_iff. intuition. rewrite <- H; apply Comp; auto. Qed. -Lemma filter_add_2 : forall s x, f x = false -> - filter f (add x s) [=] filter f s. +Lemma filter_add_2 : forall s x, f x = false -> + filter f (add x s) [=] filter f s. Proof. red; intros; do 2 (rewrite filter_iff; auto); set_iff. intuition. @@ -665,18 +665,18 @@ assert (f x = f a) by (apply Comp; auto). rewrite H in H1; rewrite H2 in H1; discriminate. Qed. -Lemma add_filter_1 : forall s s' x, +Lemma add_filter_1 : forall s s' x, f x=true -> (Add x s s') -> (Add x (filter f s) (filter f s')). Proof. unfold Add, MP.Add; intros. repeat rewrite filter_iff; auto. rewrite H0; clear H0. -assert (E.eq x y -> f y = true) by +assert (E.eq x y -> f y = true) by (intro H0; rewrite <- (Comp _ _ H0); auto). tauto. Qed. -Lemma add_filter_2 : forall s s' x, +Lemma add_filter_2 : forall s s' x, f x=false -> (Add x s s') -> filter f s [=] filter f s'. Proof. unfold Add, MP.Add, Equal; intros. @@ -686,7 +686,7 @@ assert (f a = true -> ~E.eq x a). intros H0 H1. rewrite (Comp _ _ H1) in H. rewrite H in H0; discriminate. -tauto. +tauto. Qed. Lemma union_filter: forall f g, (compat_bool E.eq f) -> (compat_bool E.eq g) -> @@ -711,7 +711,7 @@ Qed. (** Properties of [for_all] *) -Lemma for_all_mem_1: forall s, +Lemma for_all_mem_1: forall s, (forall x, (mem x s)=true->(f x)=true) -> (for_all f s)=true. Proof. intros. @@ -724,8 +724,8 @@ generalize (H a); case (mem a s);intros;auto. rewrite H0;auto. Qed. -Lemma for_all_mem_2: forall s, - (for_all f s)=true -> forall x,(mem x s)=true -> (f x)=true. +Lemma for_all_mem_2: forall s, + (for_all f s)=true -> forall x,(mem x s)=true -> (f x)=true. Proof. intros. rewrite for_all_filter in H; auto. @@ -737,7 +737,7 @@ rewrite H0; simpl;intros. rewrite <- negb_false_iff; auto. Qed. -Lemma for_all_mem_3: +Lemma for_all_mem_3: forall s x,(mem x s)=true -> (f x)=false -> (for_all f s)=false. Proof. intros. @@ -752,7 +752,7 @@ rewrite H0. simpl;auto. Qed. -Lemma for_all_mem_4: +Lemma for_all_mem_4: forall s, for_all f s=false -> {x:elt | mem x s=true /\ f x=false}. Proof. intros. @@ -767,7 +767,7 @@ Qed. (** Properties of [exists] *) -Lemma for_all_exists: +Lemma for_all_exists: forall s, exists_ f s = negb (for_all (fun x =>negb (f x)) s). Proof. intros. @@ -788,7 +788,7 @@ Proof. unfold compat_bool in *; intros; f_equal; auto. Qed. -Lemma exists_mem_1: +Lemma exists_mem_1: forall s, (forall x, mem x s=true->f x=false) -> exists_ f s=false. Proof. intros. @@ -798,8 +798,8 @@ intros;generalize (H x H0);intros. rewrite negb_true_iff; auto. Qed. -Lemma exists_mem_2: - forall s, exists_ f s=false -> forall x, mem x s=true -> f x=false. +Lemma exists_mem_2: + forall s, exists_ f s=false -> forall x, mem x s=true -> f x=false. Proof. intros. rewrite for_all_exists in H; auto. @@ -808,7 +808,7 @@ rewrite <- negb_true_iff. apply for_all_mem_2 with (2:=H); auto. Qed. -Lemma exists_mem_3: +Lemma exists_mem_3: forall s x, mem x s=true -> f x=true -> exists_ f s=true. Proof. intros. @@ -818,7 +818,7 @@ apply for_all_mem_3 with x;auto. rewrite negb_false_iff; auto. Qed. -Lemma exists_mem_4: +Lemma exists_mem_4: forall s, exists_ f s=true -> {x:elt | (mem x s)=true /\ (f x)=true}. Proof. intros. @@ -836,12 +836,12 @@ Section Sum. (** Adding a valuation function on all elements of a set. *) -Definition sum (f:elt -> nat)(s:t) := fold (fun x => plus (f x)) s 0. +Definition sum (f:elt -> nat)(s:t) := fold (fun x => plus (f x)) s 0. Notation compat_opL := (compat_op E.eq (@Logic.eq _)). Notation transposeL := (transpose (@Logic.eq _)). -Lemma sum_plus : - forall f g, compat_nat E.eq f -> compat_nat E.eq g -> +Lemma sum_plus : + forall f g, compat_nat E.eq f -> compat_nat E.eq g -> forall s, sum (fun x =>f x+g x) s = sum f s + sum g s. Proof. unfold sum. @@ -863,12 +863,12 @@ rewrite H0;simpl;omega. do 3 rewrite fold_empty;auto. Qed. -Lemma sum_filter : forall f, (compat_bool E.eq f) -> +Lemma sum_filter : forall f, (compat_bool E.eq f) -> forall s, (sum (fun x => if f x then 1 else 0) s) = (cardinal (filter f s)). Proof. unfold sum; intros f Hf. assert (st : Equivalence (@Logic.eq nat)) by (split; congruence). -assert (cc : compat_opL (fun x => plus (if f x then 1 else 0))). +assert (cc : compat_opL (fun x => plus (if f x then 1 else 0))). red; intros. rewrite (Hf x x' H); auto. assert (ct : transposeL (fun x => plus (if f x then 1 else 0))). @@ -891,12 +891,12 @@ unfold Empty; intros. rewrite filter_iff; auto; set_iff; tauto. Qed. -Lemma fold_compat : +Lemma fold_compat : forall (A:Type)(eqA:A->A->Prop)(st:Equivalence eqA) (f g:elt->A->A), - (compat_op E.eq eqA f) -> (transpose eqA f) -> - (compat_op E.eq eqA g) -> (transpose eqA g) -> - forall (i:A)(s:t),(forall x:elt, (In x s) -> forall y, (eqA (f x y) (g x y))) -> + (compat_op E.eq eqA f) -> (transpose eqA f) -> + (compat_op E.eq eqA g) -> (transpose eqA g) -> + forall (i:A)(s:t),(forall x:elt, (In x s) -> forall y, (eqA (f x y) (g x y))) -> (eqA (fold f s i) (fold g s i)). Proof. intros A eqA st f g fc ft gc gt i. @@ -916,8 +916,8 @@ symmetry; apply fold_add with (eqA:=eqA); auto. do 2 rewrite fold_empty; reflexivity. Qed. -Lemma sum_compat : - forall f g, compat_nat E.eq f -> compat_nat E.eq g -> +Lemma sum_compat : + forall f g, compat_nat E.eq f -> compat_nat E.eq g -> forall s, (forall x, In x s -> f x=g x) -> sum f s=sum g s. intros. unfold sum; apply (fold_compat _ (@Logic.eq nat)); auto. diff --git a/theories/FSets/FSetFacts.v b/theories/FSets/FSetFacts.v index a96def34a..412b6f5c5 100644 --- a/theories/FSets/FSetFacts.v +++ b/theories/FSets/FSetFacts.v @@ -11,8 +11,8 @@ (** * Finite sets library *) (** This functor derives additional facts from [FSetInterface.S]. These - facts are mainly the specifications of [FSetInterface.S] written using - different styles: equivalence and boolean equalities. + facts are mainly the specifications of [FSetInterface.S] written using + different styles: equivalence and boolean equalities. Moreover, we prove that [E.Eq] and [Equal] are setoid equalities. *) @@ -30,7 +30,7 @@ Definition eqb x y := if eq_dec x y then true else false. (** * Specifications written using equivalences *) -Section IffSpec. +Section IffSpec. Variable s s' s'' : t. Variable x y z : elt. @@ -50,12 +50,12 @@ rewrite mem_iff; destruct (mem x s); intuition. Qed. Lemma equal_iff : s[=]s' <-> equal s s' = true. -Proof. +Proof. split; [apply equal_1|apply equal_2]. Qed. Lemma subset_iff : s[<=]s' <-> subset s s' = true. -Proof. +Proof. split; [apply subset_1|apply subset_2]. Qed. @@ -64,8 +64,8 @@ Proof. intuition; apply (empty_1 H). Qed. -Lemma is_empty_iff : Empty s <-> is_empty s = true. -Proof. +Lemma is_empty_iff : Empty s <-> is_empty s = true. +Proof. split; [apply is_empty_1|apply is_empty_2]. Qed. @@ -75,7 +75,7 @@ split; [apply singleton_1|apply singleton_2]. Qed. Lemma add_iff : In y (add x s) <-> E.eq x y \/ In y s. -Proof. +Proof. split; [ | destruct 1; [apply add_1|apply add_2]]; auto. destruct (eq_dec x y) as [E|E]; auto. intro H; right; exact (add_3 E H). @@ -116,8 +116,8 @@ Qed. Variable f : elt->bool. Lemma filter_iff : compat_bool E.eq f -> (In x (filter f s) <-> In x s /\ f x = true). -Proof. -split; [split; [apply filter_1 with f | apply filter_2 with s] | destruct 1; apply filter_3]; auto. +Proof. +split; [split; [apply filter_1 with f | apply filter_2 with s] | destruct 1; apply filter_3]; auto. Qed. Lemma for_all_iff : compat_bool E.eq f -> @@ -125,7 +125,7 @@ Lemma for_all_iff : compat_bool E.eq f -> Proof. split; [apply for_all_1 | apply for_all_2]; auto. Qed. - + Lemma exists_iff : compat_bool E.eq f -> (Exists (fun x => f x = true) s <-> exists_ f s = true). Proof. @@ -133,17 +133,17 @@ split; [apply exists_1 | apply exists_2]; auto. Qed. Lemma elements_iff : In x s <-> InA E.eq x (elements s). -Proof. +Proof. split; [apply elements_1 | apply elements_2]. Qed. End IffSpec. (** Useful tactic for simplifying expressions like [In y (add x (union s s'))] *) - -Ltac set_iff := + +Ltac set_iff := repeat (progress ( - rewrite add_iff || rewrite remove_iff || rewrite singleton_iff + rewrite add_iff || rewrite remove_iff || rewrite singleton_iff || rewrite union_iff || rewrite inter_iff || rewrite diff_iff || rewrite empty_iff)). @@ -154,7 +154,7 @@ Variable s s' s'' : t. Variable x y z : elt. Lemma mem_b : E.eq x y -> mem x s = mem y s. -Proof. +Proof. intros. generalize (mem_iff s x) (mem_iff s y)(In_eq_iff s H). destruct (mem x s); destruct (mem y s); intuition. @@ -191,7 +191,7 @@ destruct (mem y s); destruct (mem y (remove x s)); intuition. Qed. Lemma singleton_b : mem y (singleton x) = eqb x y. -Proof. +Proof. generalize (mem_iff (singleton x) y)(singleton_iff x y); unfold eqb. destruct (eq_dec x y); destruct (mem y (singleton x)); intuition. Qed. @@ -236,7 +236,7 @@ Qed. Variable f : elt->bool. Lemma filter_b : compat_bool E.eq f -> mem x (filter f s) = mem x s && f x. -Proof. +Proof. intros. generalize (mem_iff (filter f s) x)(mem_iff s x)(filter_iff s x H). destruct (mem x s); destruct (mem x (filter f s)); destruct (f x); simpl; intuition. @@ -264,7 +264,7 @@ rewrite H2. rewrite InA_alt; eauto. Qed. -Lemma exists_b : compat_bool E.eq f -> +Lemma exists_b : compat_bool E.eq f -> exists_ f s = existsb f (elements s). Proof. intros. @@ -297,20 +297,20 @@ constructor ; red; [apply E.eq_refl|apply E.eq_sym|apply E.eq_trans]. Qed. Definition Equal_ST : Equivalence Equal. -Proof. +Proof. constructor ; red; [apply eq_refl | apply eq_sym | apply eq_trans]. Qed. -Add Relation elt E.eq - reflexivity proved by E.eq_refl +Add Relation elt E.eq + reflexivity proved by E.eq_refl symmetry proved by E.eq_sym - transitivity proved by E.eq_trans + transitivity proved by E.eq_trans as EltSetoid. -Add Relation t Equal - reflexivity proved by eq_refl +Add Relation t Equal + reflexivity proved by eq_refl symmetry proved by eq_sym - transitivity proved by eq_trans + transitivity proved by eq_trans as EqualSetoid. Add Morphism In with signature E.eq ==> Equal ==> iff as In_m. @@ -323,7 +323,7 @@ Add Morphism is_empty : is_empty_m. Proof. unfold Equal; intros s s' H. generalize (is_empty_iff s)(is_empty_iff s'). -destruct (is_empty s); destruct (is_empty s'); +destruct (is_empty s); destruct (is_empty s'); unfold Empty; auto; intros. symmetry. rewrite <- H1; intros a Ha. @@ -388,14 +388,14 @@ do 2 rewrite diff_iff; rewrite H; rewrite H0; intuition. Qed. Add Morphism Subset with signature Equal ==> Equal ==> iff as Subset_m. -Proof. +Proof. unfold Equal, Subset; firstorder. Qed. Add Morphism subset : subset_m. Proof. intros s s' H s'' s''' H0. -generalize (subset_iff s s'') (subset_iff s' s'''). +generalize (subset_iff s s'') (subset_iff s' s'''). destruct (subset s s''); destruct (subset s' s'''); auto; intros. rewrite H in H1; rewrite H0 in H1; intuition. rewrite H in H1; rewrite H0 in H1; intuition. @@ -467,7 +467,7 @@ Qed. (* [fold], [filter], [for_all], [exists_] and [partition] cannot be proved morphism without additional hypothesis on [f]. For instance: *) -Lemma filter_equal : forall f, compat_bool E.eq f -> +Lemma filter_equal : forall f, compat_bool E.eq f -> forall s s', s[=]s' -> filter f s [=] filter f s'. Proof. unfold Equal; intros; repeat rewrite filter_iff; auto; rewrite H0; tauto. @@ -481,7 +481,7 @@ rewrite Hff', Hss'; intuition. red; intros; rewrite <- 2 Hff'; auto. Qed. -Lemma filter_subset : forall f, compat_bool E.eq f -> +Lemma filter_subset : forall f, compat_bool E.eq f -> forall s s', s[<=]s' -> filter f s [<=] filter f s'. Proof. unfold Subset; intros; rewrite filter_iff in *; intuition. diff --git a/theories/FSets/FSetFullAVL.v b/theories/FSets/FSetFullAVL.v index 81ed9a572..bc0d758bd 100644 --- a/theories/FSets/FSetFullAVL.v +++ b/theories/FSets/FSetFullAVL.v @@ -6,27 +6,27 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* Finite sets library. - * Authors: Pierre Letouzey and Jean-Christophe Filliâtre +(* Finite sets library. + * Authors: Pierre Letouzey and Jean-Christophe Filliâtre * Institution: LRI, CNRS UMR 8623 - Université Paris Sud * 91405 Orsay, France *) (* $Id$ *) (** * FSetFullAVL - + This file contains some complements to [FSetAVL]. - - Functor [AvlProofs] proves that trees of [FSetAVL] are not only + - Functor [AvlProofs] proves that trees of [FSetAVL] are not only binary search trees, but moreover well-balanced ones. This is done by proving that all operations preserve the balancing. - - Functor [OcamlOps] contains variants of [union], [subset], + - Functor [OcamlOps] contains variants of [union], [subset], [compare] and [equal] that are faithful to the original ocaml codes, while the versions in FSetAVL have been adapted to perform only - structural recursive code. - - - Finally, we pack the previous elements in a [Make] functor + structural recursive code. + + - Finally, we pack the previous elements in a [Make] functor similar to the one of [FSetAVL], but richer. *) @@ -54,7 +54,7 @@ Inductive avl : tree -> Prop := | RBLeaf : avl Leaf | RBNode : forall x l r h, avl l -> avl r -> -(2) <= height l - height r <= 2 -> - h = max (height l) (height r) + 1 -> + h = max (height l) (height r) + 1 -> avl (Node l x r h). (** * Automation and dedicated tactics *) @@ -64,7 +64,7 @@ Hint Constructors avl. (** A tactic for cleaning hypothesis after use of functional induction. *) Ltac clearf := - match goal with + match goal with | H : (@Logic.eq (Compare _ _ _ _) _ _) |- _ => clear H; clearf | H : (@Logic.eq (sumbool _ _) _ _) |- _ => clear H; clearf | _ => idtac @@ -77,25 +77,25 @@ Proof. induction s; simpl; intros; auto with zarith. inv avl; intuition; omega_max. Qed. -Implicit Arguments height_non_negative. +Implicit Arguments height_non_negative. (** When [H:avl r], typing [avl_nn H] or [avl_nn r] adds [height r>=0] *) -Ltac avl_nn_hyp H := +Ltac avl_nn_hyp H := let nz := fresh "nz" in assert (nz := height_non_negative H). -Ltac avl_nn h := - let t := type of h in - match type of t with +Ltac avl_nn h := + let t := type of h in + match type of t with | Prop => avl_nn_hyp h | _ => match goal with H : avl h |- _ => avl_nn_hyp H end end. -(* Repeat the previous tactic. +(* Repeat the previous tactic. Drawback: need to clear the [avl _] hyps ... Thank you Ltac *) Ltac avl_nns := - match goal with + match goal with | H:avl _ |- _ => avl_nn_hyp H; clear H; avl_nns | _ => idtac end. @@ -110,7 +110,7 @@ Qed. (** * Results about [avl] *) -Lemma avl_node : +Lemma avl_node : forall x l r, avl l -> avl r -> -(2) <= height l - height r <= 2 -> avl (Node l x r (max (height l) (height r) + 1)). @@ -123,7 +123,7 @@ Hint Resolve avl_node. (** empty *) Lemma empty_avl : avl empty. -Proof. +Proof. auto. Qed. @@ -137,15 +137,15 @@ Qed. (** create *) -Lemma create_avl : - forall l x r, avl l -> avl r -> -(2) <= height l - height r <= 2 -> +Lemma create_avl : + forall l x r, avl l -> avl r -> -(2) <= height l - height r <= 2 -> avl (create l x r). Proof. unfold create; auto. Qed. -Lemma create_height : - forall l x r, avl l -> avl r -> -(2) <= height l - height r <= 2 -> +Lemma create_height : + forall l x r, avl l -> avl r -> -(2) <= height l - height r <= 2 -> height (create l x r) = max (height l) (height r) + 1. Proof. unfold create; auto. @@ -153,17 +153,17 @@ Qed. (** bal *) -Lemma bal_avl : forall l x r, avl l -> avl r -> +Lemma bal_avl : forall l x r, avl l -> avl r -> -(3) <= height l - height r <= 3 -> avl (bal l x r). Proof. intros l x r; functional induction bal l x r; intros; clearf; - inv avl; simpl in *; + inv avl; simpl in *; match goal with |- avl (assert_false _ _ _) => avl_nns | _ => repeat apply create_avl; simpl in *; auto end; omega_max. Qed. -Lemma bal_height_1 : forall l x r, avl l -> avl r -> +Lemma bal_height_1 : forall l x r, avl l -> avl r -> -(3) <= height l - height r <= 3 -> 0 <= height (bal l x r) - max (height l) (height r) <= 1. Proof. @@ -171,25 +171,25 @@ Proof. inv avl; avl_nns; simpl in *; omega_max. Qed. -Lemma bal_height_2 : - forall l x r, avl l -> avl r -> -(2) <= height l - height r <= 2 -> +Lemma bal_height_2 : + forall l x r, avl l -> avl r -> -(2) <= height l - height r <= 2 -> height (bal l x r) == max (height l) (height r) +1. Proof. intros l x r; functional induction bal l x r; intros; clearf; inv avl; simpl in *; omega_max. Qed. -Ltac omega_bal := match goal with - | H:avl ?l, H':avl ?r |- context [ bal ?l ?x ?r ] => - generalize (bal_height_1 x H H') (bal_height_2 x H H'); +Ltac omega_bal := match goal with + | H:avl ?l, H':avl ?r |- context [ bal ?l ?x ?r ] => + generalize (bal_height_1 x H H') (bal_height_2 x H H'); omega_max end. (** add *) -Lemma add_avl_1 : forall s x, avl s -> +Lemma add_avl_1 : forall s x, avl s -> avl (add x s) /\ 0 <= height (add x s) - height s <= 1. -Proof. +Proof. intros s x; functional induction (add x s); subst;intros; inv avl; simpl in *. intuition; try constructor; simpl; auto; try omega_max. (* LT *) @@ -216,10 +216,10 @@ Hint Resolve add_avl. Lemma join_avl_1 : forall l x r, avl l -> avl r -> avl (join l x r) /\ 0<= height (join l x r) - max (height l) (height r) <= 1. -Proof. +Proof. join_tac. - split; simpl; auto. + split; simpl; auto. destruct (add_avl_1 x H0). avl_nns; omega_max. set (l:=Node ll lx lr lh) in *. @@ -269,8 +269,8 @@ Hint Resolve join_avl. (** remove_min *) -Lemma remove_min_avl_1 : forall l x r h, avl (Node l x r h) -> - avl (remove_min l x r)#1 /\ +Lemma remove_min_avl_1 : forall l x r h, avl (Node l x r h) -> + avl (remove_min l x r)#1 /\ 0 <= height (Node l x r h) - height (remove_min l x r)#1 <= 1. Proof. intros l x r; functional induction (remove_min l x r); subst;simpl in *; intros. @@ -278,25 +278,25 @@ Proof. avl_nns; omega_max. inversion_clear H. rewrite e0 in IHp;simpl in IHp;destruct (IHp _x); auto. - split; simpl in *. + split; simpl in *. apply bal_avl; auto; omega_max. omega_bal. Qed. -Lemma remove_min_avl : forall l x r h, avl (Node l x r h) -> - avl (remove_min l x r)#1. +Lemma remove_min_avl : forall l x r h, avl (Node l x r h) -> + avl (remove_min l x r)#1. Proof. intros; destruct (remove_min_avl_1 H); auto. Qed. (** merge *) -Lemma merge_avl_1 : forall s1 s2, avl s1 -> avl s2 -> - -(2) <= height s1 - height s2 <= 2 -> - avl (merge s1 s2) /\ +Lemma merge_avl_1 : forall s1 s2, avl s1 -> avl s2 -> + -(2) <= height s1 - height s2 <= 2 -> + avl (merge s1 s2) /\ 0<= height (merge s1 s2) - max (height s1) (height s2) <=1. Proof. - intros s1 s2; functional induction (merge s1 s2); intros; + intros s1 s2; functional induction (merge s1 s2); intros; try factornode _x _x0 _x1 _x2 as s1. simpl; split; auto; avl_nns; omega_max. simpl; split; auto; avl_nns; simpl in *; omega_max. @@ -308,16 +308,16 @@ Proof. simpl in *; omega_bal. Qed. -Lemma merge_avl : forall s1 s2, avl s1 -> avl s2 -> +Lemma merge_avl : forall s1 s2, avl s1 -> avl s2 -> -(2) <= height s1 - height s2 <= 2 -> avl (merge s1 s2). -Proof. +Proof. intros; destruct (merge_avl_1 H H0 H1); auto. Qed. (** remove *) -Lemma remove_avl_1 : forall s x, avl s -> +Lemma remove_avl_1 : forall s x, avl s -> avl (remove x s) /\ 0 <= height s - height (remove x s) <= 1. Proof. intros s x; functional induction (remove x s); intros. @@ -325,25 +325,25 @@ Proof. (* LT *) inv avl. destruct (IHt H0). - split. + split. apply bal_avl; auto. omega_max. omega_bal. (* EQ *) - inv avl. + inv avl. generalize (merge_avl_1 H0 H1 H2). intuition omega_max. (* GT *) inv avl. destruct (IHt H1). - split. + split. apply bal_avl; auto. omega_max. omega_bal. Qed. Lemma remove_avl : forall s x, avl s -> avl (remove x s). -Proof. +Proof. intros; destruct (remove_avl_1 x H); auto. Qed. Hint Resolve remove_avl. @@ -360,9 +360,9 @@ Hint Resolve concat_avl. (** split *) -Lemma split_avl : forall s x, avl s -> +Lemma split_avl : forall s x, avl s -> avl (split x s)#l /\ avl (split x s)#r. -Proof. +Proof. intros s x; functional induction (split x s); simpl; auto. rewrite e1 in IHt;simpl in IHt;inversion_clear 1; intuition. simpl; inversion_clear 1; auto. @@ -371,19 +371,19 @@ Qed. (** inter *) -Lemma inter_avl : forall s1 s2, avl s1 -> avl s2 -> avl (inter s1 s2). +Lemma inter_avl : forall s1 s2, avl s1 -> avl s2 -> avl (inter s1 s2). Proof. intros s1 s2; functional induction inter s1 s2; auto; intros A1 A2; - generalize (split_avl x1 A2); rewrite e1; simpl; destruct 1; + generalize (split_avl x1 A2); rewrite e1; simpl; destruct 1; inv avl; auto. Qed. (** diff *) -Lemma diff_avl : forall s1 s2, avl s1 -> avl s2 -> avl (diff s1 s2). -Proof. +Lemma diff_avl : forall s1 s2, avl s1 -> avl s2 -> avl (diff s1 s2). +Proof. intros s1 s2; functional induction diff s1 s2; auto; intros A1 A2; - generalize (split_avl x1 A2); rewrite e1; simpl; destruct 1; + generalize (split_avl x1 A2); rewrite e1; simpl; destruct 1; inv avl; auto. Qed. @@ -392,30 +392,30 @@ Qed. Lemma union_avl : forall s1 s2, avl s1 -> avl s2 -> avl (union s1 s2). Proof. intros s1 s2; functional induction union s1 s2; auto; intros A1 A2; - generalize (split_avl x1 A2); rewrite e1; simpl; destruct 1; + generalize (split_avl x1 A2); rewrite e1; simpl; destruct 1; inv avl; auto. Qed. (** filter *) -Lemma filter_acc_avl : forall f s acc, avl s -> avl acc -> +Lemma filter_acc_avl : forall f s acc, avl s -> avl acc -> avl (filter_acc f acc s). Proof. induction s; simpl; auto. intros. inv avl. destruct (f t); auto. -Qed. +Qed. Hint Resolve filter_acc_avl. -Lemma filter_avl : forall f s, avl s -> avl (filter f s). +Lemma filter_avl : forall f s, avl s -> avl (filter f s). Proof. unfold filter; intros; apply filter_acc_avl; auto. Qed. (** partition *) -Lemma partition_acc_avl_1 : forall f s acc, avl s -> +Lemma partition_acc_avl_1 : forall f s acc, avl s -> avl acc#1 -> avl (partition_acc f acc s)#1. Proof. induction s; simpl; auto. @@ -427,7 +427,7 @@ Proof. destruct (f t); simpl; auto. Qed. -Lemma partition_acc_avl_2 : forall f s acc, avl s -> +Lemma partition_acc_avl_2 : forall f s acc, avl s -> avl acc#2 -> avl (partition_acc f acc s)#2. Proof. induction s; simpl; auto. @@ -437,14 +437,14 @@ Proof. apply IHs2; auto. apply IHs1; auto. destruct (f t); simpl; auto. -Qed. +Qed. -Lemma partition_avl_1 : forall f s, avl s -> avl (partition f s)#1. +Lemma partition_avl_1 : forall f s, avl s -> avl (partition f s)#1. Proof. unfold partition; intros; apply partition_acc_avl_1; auto. Qed. -Lemma partition_avl_2 : forall f s, avl s -> avl (partition f s)#2. +Lemma partition_avl_2 : forall f s, avl s -> avl (partition f s)#2. Proof. unfold partition; intros; apply partition_acc_avl_2; auto. Qed. @@ -462,29 +462,29 @@ Open Local Scope nat_scope. (** Properties of cardinal *) -Lemma bal_cardinal : forall l x r, +Lemma bal_cardinal : forall l x r, cardinal (bal l x r) = S (cardinal l + cardinal r). Proof. intros l x r; functional induction bal l x r; intros; clearf; simpl; auto with arith; romega with *. Qed. -Lemma add_cardinal : forall x s, +Lemma add_cardinal : forall x s, cardinal (add x s) <= S (cardinal s). Proof. - intros; functional induction add x s; simpl; auto with arith; + intros; functional induction add x s; simpl; auto with arith; rewrite bal_cardinal; romega with *. Qed. -Lemma join_cardinal : forall l x r, +Lemma join_cardinal : forall l x r, cardinal (join l x r) <= S (cardinal l + cardinal r). Proof. join_tac; auto with arith. simpl; apply add_cardinal. simpl; destruct X.compare; simpl; auto with arith. - generalize (bal_cardinal (add x ll) lx lr) (add_cardinal x ll); + generalize (bal_cardinal (add x ll) lx lr) (add_cardinal x ll); romega with *. - generalize (bal_cardinal ll lx (add x lr)) (add_cardinal x lr); + generalize (bal_cardinal ll lx (add x lr)) (add_cardinal x lr); romega with *. generalize (bal_cardinal ll lx (join lr x (Node rl rx rr rh))) (Hlr x (Node rl rx rr rh)); simpl; romega with *. @@ -492,7 +492,7 @@ Proof. romega with *. Qed. -Lemma split_cardinal_1 : forall x s, +Lemma split_cardinal_1 : forall x s, (cardinal (split x s)#l <= cardinal s)%nat. Proof. intros x s; functional induction split x s; simpl; auto. @@ -503,7 +503,7 @@ Proof. generalize (@join_cardinal l y rl); romega with *. Qed. -Lemma split_cardinal_2 : forall x s, +Lemma split_cardinal_2 : forall x s, (cardinal (split x s)#r <= cardinal s)%nat. Proof. intros x s; functional induction split x s; simpl; auto. @@ -517,26 +517,26 @@ Qed. Definition cardinal2 (s:t*t) := (cardinal s#1 + cardinal s#2)%nat. -Ltac ocaml_union_tac := +Ltac ocaml_union_tac := intros; unfold cardinal2; simpl fst in *; simpl snd in *; - match goal with H: split ?x ?s = _ |- _ => - generalize (split_cardinal_1 x s) (split_cardinal_2 x s); + match goal with H: split ?x ?s = _ |- _ => + generalize (split_cardinal_1 x s) (split_cardinal_2 x s); rewrite H; simpl; romega with * end. Function ocaml_union (s : t * t) { measure cardinal2 s } : t := - match s with + match s with | (Leaf, Leaf) => s#2 | (Leaf, Node _ _ _ _) => s#2 | (Node _ _ _ _, Leaf) => s#1 - | (Node l1 x1 r1 h1, Node l2 x2 r2 h2) => + | (Node l1 x1 r1 h1, Node l2 x2 r2 h2) => if ge_lt_dec h1 h2 then if eq_dec h2 1%I then add x2 s#1 else - let (l2',_,r2') := split x1 s#2 in + let (l2',_,r2') := split x1 s#2 in join (ocaml_union (l1,l2')) x1 (ocaml_union (r1,r2')) else if eq_dec h1 1%I then add x1 s#2 else - let (l1',_,r1') := split x2 s#1 in + let (l1',_,r1') := split x2 s#1 in join (ocaml_union (l1',l2)) x2 (ocaml_union (r1',r2)) end. Proof. @@ -546,11 +546,11 @@ abstract ocaml_union_tac. abstract ocaml_union_tac. Defined. -Lemma ocaml_union_in : forall s y, +Lemma ocaml_union_in : forall s y, bst s#1 -> avl s#1 -> bst s#2 -> avl s#2 -> (In y (ocaml_union s) <-> In y s#1 \/ In y s#2). Proof. - intros s; functional induction ocaml_union s; intros y B1 A1 B2 A2; + intros s; functional induction ocaml_union s; intros y B1 A1 B2 A2; simpl fst in *; simpl snd in *; try clear e0 e1. intuition_in. intuition_in. @@ -575,7 +575,7 @@ Proof. rewrite (height_0 H4); [ | avl_nn r1; omega_max]. rewrite add_in; auto; intuition_in. (* join (union (l1',l2)) x1 (union (r1',r2)) *) - generalize + generalize (split_avl x2 A1) (split_bst x2 B1) (split_in_1 x2 y B1) (split_in_2 x2 y B1). rewrite e2; simpl. @@ -589,7 +589,7 @@ Lemma ocaml_union_bst : forall s, bst s#1 -> avl s#1 -> bst s#2 -> avl s#2 -> bst (ocaml_union s). Proof. intros s; functional induction ocaml_union s; intros B1 A1 B2 A2; - simpl fst in *; simpl snd in *; try clear e0 e1; + simpl fst in *; simpl snd in *; try clear e0 e1; try apply add_bst; auto. (* join (union (l1,l2')) x1 (union (r1,r2')) *) clear _x _x0; factornode l2 x2 r2 h2 as s2. @@ -613,10 +613,10 @@ Proof. intro y; rewrite ocaml_union_in, H4; intuition_in. Qed. -Lemma ocaml_union_avl : forall s, +Lemma ocaml_union_avl : forall s, avl s#1 -> avl s#2 -> avl (ocaml_union s). Proof. - intros s; functional induction ocaml_union s; + intros s; functional induction ocaml_union s; simpl fst in *; simpl snd in *; auto. intros A1 A2; generalize (split_avl x1 A2); rewrite e2; simpl. inv avl; destruct 1; auto. @@ -654,7 +654,7 @@ Proof. intros; unfold cardinal2; simpl; abstract romega with *. Defined. -Lemma ocaml_subset_12 : forall s, +Lemma ocaml_subset_12 : forall s, bst s#1 -> bst s#2 -> (ocaml_subset s = true <-> Subset s#1 s#2). Proof. @@ -685,7 +685,7 @@ Proof. assert (In a (Node l2 x2 r2 h2)) by auto; intuition_in; order. Qed. -Lemma ocaml_subset_alt : forall s, bst s#1 -> bst s#2 -> +Lemma ocaml_subset_alt : forall s, bst s#1 -> bst s#2 -> ocaml_subset s = subset s#1 s#2. Proof. intros. @@ -704,7 +704,7 @@ Fixpoint cardinal_e e := match e with | More _ s r => S (cardinal s + cardinal_e r) end. -Lemma cons_cardinal_e : forall s e, +Lemma cons_cardinal_e : forall s e, cardinal_e (cons s e) = cardinal s + cardinal_e e. Proof. induction s; simpl; intros; auto. @@ -713,32 +713,32 @@ Qed. Definition cardinal_e_2 e := cardinal_e e#1 + cardinal_e e#2. -Function ocaml_compare_aux - (e:enumeration*enumeration) { measure cardinal_e_2 e } : comparison := - match e with +Function ocaml_compare_aux + (e:enumeration*enumeration) { measure cardinal_e_2 e } : comparison := + match e with | (End,End) => Eq - | (End,More _ _ _) => Lt - | (More _ _ _, End) => Gt - | (More x1 r1 e1, More x2 r2 e2) => - match X.compare x1 x2 with + | (End,More _ _ _) => Lt + | (More _ _ _, End) => Gt + | (More x1 r1 e1, More x2 r2 e2) => + match X.compare x1 x2 with | EQ _ => ocaml_compare_aux (cons r1 e1, cons r2 e2) - | LT _ => Lt - | GT _ => Gt + | LT _ => Lt + | GT _ => Gt end end. Proof. -intros; unfold cardinal_e_2; simpl; +intros; unfold cardinal_e_2; simpl; abstract (do 2 rewrite cons_cardinal_e; romega with *). Defined. -Definition ocaml_compare s1 s2 := +Definition ocaml_compare s1 s2 := ocaml_compare_aux (cons s1 End, cons s2 End). -Lemma ocaml_compare_aux_Cmp : forall e, +Lemma ocaml_compare_aux_Cmp : forall e, Cmp (ocaml_compare_aux e) (flatten_e e#1) (flatten_e e#2). Proof. - intros e; functional induction ocaml_compare_aux e; simpl; intros; + intros e; functional induction ocaml_compare_aux e; simpl; intros; auto; try discriminate. apply L.eq_refl. simpl in *. @@ -756,11 +756,11 @@ Proof. apply (@ocaml_compare_aux_Cmp (cons s1 End, cons s2 End)). Qed. -Lemma ocaml_compare_alt : forall s1 s2, bst s1 -> bst s2 -> +Lemma ocaml_compare_alt : forall s1 s2, bst s1 -> bst s2 -> ocaml_compare s1 s2 = compare s1 s2. Proof. intros s1 s2 B1 B2. - generalize (ocaml_compare_Cmp s1 s2)(compare_Cmp s1 s2). + generalize (ocaml_compare_Cmp s1 s2)(compare_Cmp s1 s2). unfold Cmp. destruct ocaml_compare; destruct compare; auto; intros; elimtype False. elim (lt_not_eq B1 B2 H0); auto. @@ -781,13 +781,13 @@ Qed. (** * Equality test *) -Definition ocaml_equal s1 s2 : bool := - match ocaml_compare s1 s2 with +Definition ocaml_equal s1 s2 : bool := + match ocaml_compare s1 s2 with | Eq => true - | _ => false + | _ => false end. -Lemma ocaml_equal_1 : forall s1 s2, bst s1 -> bst s2 -> +Lemma ocaml_equal_1 : forall s1 s2, bst s1 -> bst s2 -> Equal s1 s2 -> ocaml_equal s1 s2 = true. Proof. unfold ocaml_equal; intros s1 s2 B1 B2 E. @@ -801,11 +801,11 @@ Lemma ocaml_equal_2 : forall s1 s2, ocaml_equal s1 s2 = true -> Equal s1 s2. Proof. unfold ocaml_equal; intros s1 s2 E. -generalize (ocaml_compare_Cmp s1 s2); +generalize (ocaml_compare_Cmp s1 s2); destruct ocaml_compare; auto; discriminate. Qed. -Lemma ocaml_equal_alt : forall s1 s2, bst s1 -> bst s2 -> +Lemma ocaml_equal_alt : forall s1 s2, bst s1 -> bst s2 -> ocaml_equal s1 s2 = equal s1 s2. Proof. intros; unfold ocaml_equal, equal; rewrite ocaml_compare_alt; auto. @@ -817,14 +817,14 @@ End OcamlOps. (** * Encapsulation - We can implement [S] with balanced binary search trees. + We can implement [S] with balanced binary search trees. When compared to [FSetAVL], we maintain here two invariants (bst and avl) instead of only bst, which is enough for fulfilling the FSet interface. - This encapsulation propose the non-structural variants + This encapsulation propose the non-structural variants [ocaml_union], [ocaml_subset], [ocaml_compare], [ocaml_equal]. -*) +*) Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. @@ -837,61 +837,61 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Record bbst := Bbst {this :> Raw.t; is_bst : bst this; is_avl : avl this}. Definition t := bbst. Definition elt := E.t. - + Definition In (x : elt) (s : t) : Prop := In x s. Definition Equal (s s':t) : Prop := forall a : elt, In a s <-> In a s'. Definition Subset (s s':t) : Prop := forall a : elt, In a s -> In a s'. Definition Empty (s:t) : Prop := forall a : elt, ~ In a s. Definition For_all (P : elt -> Prop) (s:t) : Prop := forall x, In x s -> P x. Definition Exists (P : elt -> Prop) (s:t) : Prop := exists x, In x s /\ P x. - - Lemma In_1 : forall (s:t)(x y:elt), E.eq x y -> In x s -> In y s. + + Lemma In_1 : forall (s:t)(x y:elt), E.eq x y -> In x s -> In y s. Proof. intro s; exact (@In_1 s). Qed. - + Definition mem (x:elt)(s:t) : bool := mem x s. Definition empty : t := Bbst empty_bst empty_avl. Definition is_empty (s:t) : bool := is_empty s. - Definition singleton (x:elt) : t := + Definition singleton (x:elt) : t := Bbst (singleton_bst x) (singleton_avl x). - Definition add (x:elt)(s:t) : t := - Bbst (add_bst x (is_bst s)) (add_avl x (is_avl s)). - Definition remove (x:elt)(s:t) : t := + Definition add (x:elt)(s:t) : t := + Bbst (add_bst x (is_bst s)) (add_avl x (is_avl s)). + Definition remove (x:elt)(s:t) : t := Bbst (remove_bst x (is_bst s)) (remove_avl x (is_avl s)). - Definition inter (s s':t) : t := + Definition inter (s s':t) : t := Bbst (inter_bst (is_bst s) (is_bst s')) (inter_avl (is_avl s) (is_avl s')). Definition union (s s':t) : t := Bbst (union_bst (is_bst s) (is_bst s')) (union_avl (is_avl s) (is_avl s')). Definition ocaml_union (s s':t) : t := - Bbst (@ocaml_union_bst (s.(this),s'.(this)) + Bbst (@ocaml_union_bst (s.(this),s'.(this)) (is_bst s) (is_avl s) (is_bst s') (is_avl s')) (@ocaml_union_avl (s.(this),s'.(this)) (is_avl s) (is_avl s')). - Definition diff (s s':t) : t := + Definition diff (s s':t) : t := Bbst (diff_bst (is_bst s) (is_bst s')) (diff_avl (is_avl s) (is_avl s')). Definition elements (s:t) : list elt := elements s. Definition min_elt (s:t) : option elt := min_elt s. Definition max_elt (s:t) : option elt := max_elt s. Definition choose (s:t) : option elt := choose s. - Definition fold (B : Type) (f : elt -> B -> B) (s:t) : B -> B := fold f s. + Definition fold (B : Type) (f : elt -> B -> B) (s:t) : B -> B := fold f s. Definition cardinal (s:t) : nat := cardinal s. - Definition filter (f : elt -> bool) (s:t) : t := + Definition filter (f : elt -> bool) (s:t) : t := Bbst (filter_bst f (is_bst s)) (filter_avl f (is_avl s)). Definition for_all (f : elt -> bool) (s:t) : bool := for_all f s. Definition exists_ (f : elt -> bool) (s:t) : bool := exists_ f s. Definition partition (f : elt -> bool) (s:t) : t * t := let p := partition f s in - (@Bbst (fst p) (partition_bst_1 f (is_bst s)) - (partition_avl_1 f (is_avl s)), + (@Bbst (fst p) (partition_bst_1 f (is_bst s)) + (partition_avl_1 f (is_avl s)), @Bbst (snd p) (partition_bst_2 f (is_bst s)) (partition_avl_2 f (is_avl s))). Definition equal (s s':t) : bool := equal s s'. Definition ocaml_equal (s s':t) : bool := ocaml_equal s s'. Definition subset (s s':t) : bool := subset s s'. - Definition ocaml_subset (s s':t) : bool := + Definition ocaml_subset (s s':t) : bool := ocaml_subset (s.(this),s'.(this)). Definition eq (s s':t) : Prop := Equal s s'. @@ -922,13 +922,13 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Defined. (* specs *) - Section Specs. - Variable s s' s'': t. + Section Specs. + Variable s s' s'': t. Variable x y : elt. Hint Resolve is_bst is_avl. - - Lemma mem_1 : In x s -> mem x s = true. + + Lemma mem_1 : In x s -> mem x s = true. Proof. exact (mem_1 (is_bst s)). Qed. Lemma mem_2 : mem x s = true -> In x s. Proof. exact (@mem_2 s x). Qed. @@ -939,15 +939,15 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Proof. exact (@equal_2 s s'). Qed. Lemma ocaml_equal_alt : ocaml_equal s s' = equal s s'. - Proof. + Proof. destruct s; destruct s'; unfold ocaml_equal, equal; simpl. apply ocaml_equal_alt; auto. Qed. - + Lemma ocaml_equal_1 : Equal s s' -> ocaml_equal s s' = true. Proof. exact (ocaml_equal_1 (is_bst s) (is_bst s')). Qed. Lemma ocaml_equal_2 : ocaml_equal s s' = true -> Equal s s'. - Proof. exact (@ocaml_equal_2 s s'). Qed. + Proof. exact (@ocaml_equal_2 s s'). Qed. Ltac wrap t H := unfold t, In; simpl; rewrite H; auto; intuition. @@ -957,7 +957,7 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Proof. wrap subset subset_12. Qed. Lemma ocaml_subset_alt : ocaml_subset s s' = subset s s'. - Proof. + Proof. destruct s; destruct s'; unfold ocaml_subset, subset; simpl. rewrite ocaml_subset_alt; auto. Qed. @@ -972,14 +972,14 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Lemma is_empty_1 : Empty s -> is_empty s = true. Proof. exact (@is_empty_1 s). Qed. - Lemma is_empty_2 : is_empty s = true -> Empty s. + Lemma is_empty_2 : is_empty s = true -> Empty s. Proof. exact (@is_empty_2 s). Qed. - + Lemma add_1 : E.eq x y -> In y (add x s). Proof. wrap add add_in. Qed. Lemma add_2 : In y s -> In y (add x s). Proof. wrap add add_in. Qed. - Lemma add_3 : ~ E.eq x y -> In y (add x s) -> In y s. + Lemma add_3 : ~ E.eq x y -> In y (add x s) -> In y s. Proof. wrap add add_in. elim H; auto. Qed. Lemma remove_1 : E.eq x y -> ~ In y (remove x s). @@ -989,20 +989,20 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Lemma remove_3 : In y (remove x s) -> In y s. Proof. wrap remove remove_in. Qed. - Lemma singleton_1 : In y (singleton x) -> E.eq x y. + Lemma singleton_1 : In y (singleton x) -> E.eq x y. Proof. exact (@singleton_1 x y). Qed. - Lemma singleton_2 : E.eq x y -> In y (singleton x). + Lemma singleton_2 : E.eq x y -> In y (singleton x). Proof. exact (@singleton_2 x y). Qed. Lemma union_1 : In x (union s s') -> In x s \/ In x s'. Proof. wrap union union_in. Qed. - Lemma union_2 : In x s -> In x (union s s'). + Lemma union_2 : In x s -> In x (union s s'). Proof. wrap union union_in. Qed. Lemma union_3 : In x s' -> In x (union s s'). Proof. wrap union union_in. Qed. Lemma ocaml_union_alt : Equal (ocaml_union s s') (union s s'). - Proof. + Proof. unfold ocaml_union, union, Equal, In. destruct s as (s0,b,a); destruct s' as (s0',b',a'); simpl. exact (@ocaml_union_alt (s0,s0') b a b' a'). @@ -1021,32 +1021,32 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Proof. wrap inter inter_in. Qed. Lemma inter_3 : In x s -> In x s' -> In x (inter s s'). Proof. wrap inter inter_in. Qed. - - Lemma diff_1 : In x (diff s s') -> In x s. + + Lemma diff_1 : In x (diff s s') -> In x s. Proof. wrap diff diff_in. Qed. Lemma diff_2 : In x (diff s s') -> ~ In x s'. Proof. wrap diff diff_in. Qed. Lemma diff_3 : In x s -> ~ In x s' -> In x (diff s s'). Proof. wrap diff diff_in. Qed. - + Lemma fold_1 : forall (A : Type) (i : A) (f : elt -> A -> A), fold f s i = fold_left (fun a e => f e a) (elements s) i. - Proof. + Proof. unfold fold, elements; intros; apply fold_1; auto. Qed. Lemma cardinal_1 : cardinal s = length (elements s). - Proof. + Proof. unfold cardinal, elements; intros; apply elements_cardinal; auto. Qed. Section Filter. Variable f : elt -> bool. - Lemma filter_1 : compat_bool E.eq f -> In x (filter f s) -> In x s. + Lemma filter_1 : compat_bool E.eq f -> In x (filter f s) -> In x s. + Proof. intro. wrap filter filter_in. Qed. + Lemma filter_2 : compat_bool E.eq f -> In x (filter f s) -> f x = true. Proof. intro. wrap filter filter_in. Qed. - Lemma filter_2 : compat_bool E.eq f -> In x (filter f s) -> f x = true. - Proof. intro. wrap filter filter_in. Qed. Lemma filter_3 : compat_bool E.eq f -> In x s -> f x = true -> In x (filter f s). Proof. intro. wrap filter filter_in. Qed. @@ -1060,14 +1060,14 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Lemma exists_2 : compat_bool E.eq f -> exists_ f s = true -> Exists (fun x => f x = true) s. Proof. exact (@exists_2 f s). Qed. - Lemma partition_1 : compat_bool E.eq f -> + Lemma partition_1 : compat_bool E.eq f -> Equal (fst (partition f s)) (filter f s). Proof. unfold partition, filter, Equal, In; simpl ;intros H a. rewrite partition_in_1, filter_in; intuition. Qed. - Lemma partition_2 : compat_bool E.eq f -> + Lemma partition_2 : compat_bool E.eq f -> Equal (snd (partition f s)) (filter (fun x => negb (f x)) s). Proof. unfold partition, filter, Equal, In; simpl ;intros H a. @@ -1089,14 +1089,14 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Lemma elements_3w : NoDupA E.eq (elements s). Proof. exact (elements_nodup (is_bst s)). Qed. - Lemma min_elt_1 : min_elt s = Some x -> In x s. + Lemma min_elt_1 : min_elt s = Some x -> In x s. Proof. exact (@min_elt_1 s x). Qed. Lemma min_elt_2 : min_elt s = Some x -> In y s -> ~ E.lt y x. Proof. exact (@min_elt_2 s x y (is_bst s)). Qed. Lemma min_elt_3 : min_elt s = None -> Empty s. Proof. exact (@min_elt_3 s). Qed. - Lemma max_elt_1 : max_elt s = Some x -> In x s. + Lemma max_elt_1 : max_elt s = Some x -> In x s. Proof. exact (@max_elt_1 s x). Qed. Lemma max_elt_2 : max_elt s = Some x -> In y s -> ~ E.lt x y. Proof. exact (@max_elt_2 s x y (is_bst s)). Qed. @@ -1107,17 +1107,17 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Proof. exact (@choose_1 s x). Qed. Lemma choose_2 : choose s = None -> Empty s. Proof. exact (@choose_2 s). Qed. - Lemma choose_3 : choose s = Some x -> choose s' = Some y -> + Lemma choose_3 : choose s = Some x -> choose s' = Some y -> Equal s s' -> E.eq x y. Proof. exact (@choose_3 _ _ (is_bst s) (is_bst s') x y). Qed. - Lemma eq_refl : eq s s. + Lemma eq_refl : eq s s. Proof. exact (eq_refl s). Qed. Lemma eq_sym : eq s s' -> eq s' s. Proof. exact (@eq_sym s s'). Qed. Lemma eq_trans : eq s s' -> eq s' s'' -> eq s s''. Proof. exact (@eq_trans s s' s''). Qed. - + Lemma lt_trans : lt s s' -> lt s' s'' -> lt s s''. Proof. exact (@lt_trans s s' s''). Qed. Lemma lt_not_eq : lt s s' -> ~eq s s'. diff --git a/theories/FSets/FSetInterface.v b/theories/FSets/FSetInterface.v index 1f21a2262..d94ff7c95 100644 --- a/theories/FSets/FSetInterface.v +++ b/theories/FSets/FSetInterface.v @@ -10,13 +10,13 @@ (** * Finite set library *) -(** Set interfaces, inspired by the one of Ocaml. When compared with - Ocaml, the main differences are: +(** Set interfaces, inspired by the one of Ocaml. When compared with + Ocaml, the main differences are: - the lack of [iter] function, useless since Coq is purely functional - the use of [option] types instead of [Not_found] exceptions - - the use of [nat] instead of [int] for the [cardinal] function + - the use of [nat] instead of [int] for the [cardinal] function - Several variants of the set interfaces are available: + Several variants of the set interfaces are available: - [WSfun] : functorial signature for weak sets, non-dependent style - [WS] : self-contained version of [WSfun] - [Sfun] : functorial signature for ordered sets, non-dependent style @@ -24,7 +24,7 @@ - [Sdep] : analog of [S] written using dependent style If unsure, [S] is probably what you're looking for: other signatures - are subsets of it, apart from [Sdep] which is isomorphic to [S] (see + are subsets of it, apart from [Sdep] which is isomorphic to [S] (see [FSetBridge]). *) @@ -34,14 +34,14 @@ Unset Strict Implicit. (** * Non-dependent signatures - The following signatures presents sets as purely informative + The following signatures presents sets as purely informative programs together with axioms *) (** ** Functorial signature for weak sets - Weak sets are sets without ordering on base elements, only + Weak sets are sets without ordering on base elements, only a decidable equality. *) Module Type WSfun (E : DecidableType). @@ -57,7 +57,7 @@ Module Type WSfun (E : DecidableType). Definition Empty s := forall a : elt, ~ In a s. Definition For_all (P : elt -> Prop) s := forall x, In x s -> P x. Definition Exists (P : elt -> Prop) s := exists x, In x s /\ P x. - + Notation "s [=] t" := (Equal s t) (at level 70, no associativity). Notation "s [<=] t" := (Subset s t) (at level 70, no associativity). @@ -137,7 +137,7 @@ Module Type WSfun (E : DecidableType). the set is empty. Which element is chosen is unspecified. Equal sets could return different elements. *) - Section Spec. + Section Spec. Variable s s' s'': t. Variable x y : elt. @@ -146,15 +146,15 @@ Module Type WSfun (E : DecidableType). Parameter In_1 : E.eq x y -> In x s -> In y s. (** Specification of [eq] *) - Parameter eq_refl : eq s s. + Parameter eq_refl : eq s s. Parameter eq_sym : eq s s' -> eq s' s. Parameter eq_trans : eq s s' -> eq s' s'' -> eq s s''. (** Specification of [mem] *) Parameter mem_1 : In x s -> mem x s = true. - Parameter mem_2 : mem x s = true -> In x s. - - (** Specification of [equal] *) + Parameter mem_2 : mem x s = true -> In x s. + + (** Specification of [equal] *) Parameter equal_1 : Equal s s' -> equal s s' = true. Parameter equal_2 : equal s s' = true -> Equal s s'. @@ -166,13 +166,13 @@ Module Type WSfun (E : DecidableType). Parameter empty_1 : Empty empty. (** Specification of [is_empty] *) - Parameter is_empty_1 : Empty s -> is_empty s = true. + Parameter is_empty_1 : Empty s -> is_empty s = true. Parameter is_empty_2 : is_empty s = true -> Empty s. - + (** Specification of [add] *) Parameter add_1 : E.eq x y -> In y (add x s). Parameter add_2 : In y s -> In y (add x s). - Parameter add_3 : ~ E.eq x y -> In y (add x s) -> In y s. + Parameter add_3 : ~ E.eq x y -> In y (add x s) -> In y s. (** Specification of [remove] *) Parameter remove_1 : E.eq x y -> ~ In y (remove x s). @@ -180,12 +180,12 @@ Module Type WSfun (E : DecidableType). Parameter remove_3 : In y (remove x s) -> In y s. (** Specification of [singleton] *) - Parameter singleton_1 : In y (singleton x) -> E.eq x y. - Parameter singleton_2 : E.eq x y -> In y (singleton x). + Parameter singleton_1 : In y (singleton x) -> E.eq x y. + Parameter singleton_2 : E.eq x y -> In y (singleton x). (** Specification of [union] *) Parameter union_1 : In x (union s s') -> In x s \/ In x s'. - Parameter union_2 : In x s -> In x (union s s'). + Parameter union_2 : In x s -> In x (union s s'). Parameter union_3 : In x s' -> In x (union s s'). (** Specification of [inter] *) @@ -194,24 +194,24 @@ Module Type WSfun (E : DecidableType). Parameter inter_3 : In x s -> In x s' -> In x (inter s s'). (** Specification of [diff] *) - Parameter diff_1 : In x (diff s s') -> In x s. + Parameter diff_1 : In x (diff s s') -> In x s. Parameter diff_2 : In x (diff s s') -> ~ In x s'. Parameter diff_3 : In x s -> ~ In x s' -> In x (diff s s'). - - (** Specification of [fold] *) + + (** Specification of [fold] *) Parameter fold_1 : forall (A : Type) (i : A) (f : elt -> A -> A), fold f s i = fold_left (fun a e => f e a) (elements s) i. - (** Specification of [cardinal] *) + (** Specification of [cardinal] *) Parameter cardinal_1 : cardinal s = length (elements s). Section Filter. - + Variable f : elt -> bool. (** Specification of [filter] *) - Parameter filter_1 : compat_bool E.eq f -> In x (filter f s) -> In x s. - Parameter filter_2 : compat_bool E.eq f -> In x (filter f s) -> f x = true. + Parameter filter_1 : compat_bool E.eq f -> In x (filter f s) -> In x s. + Parameter filter_2 : compat_bool E.eq f -> In x (filter f s) -> f x = true. Parameter filter_3 : compat_bool E.eq f -> In x s -> f x = true -> In x (filter f s). @@ -243,7 +243,7 @@ Module Type WSfun (E : DecidableType). (** Specification of [elements] *) Parameter elements_1 : In x s -> InA E.eq x (elements s). Parameter elements_2 : InA E.eq x (elements s) -> In x s. - (** When compared with ordered sets, here comes the only + (** When compared with ordered sets, here comes the only property that is really weaker: *) Parameter elements_3w : NoDupA E.eq (elements s). @@ -257,11 +257,11 @@ Module Type WSfun (E : DecidableType). is_empty_1 choose_1 choose_2 add_1 add_2 remove_1 remove_2 singleton_2 union_1 union_2 union_3 inter_3 diff_3 fold_1 filter_3 for_all_1 exists_1 - partition_1 partition_2 elements_1 elements_3w + partition_1 partition_2 elements_1 elements_3w : set. Hint Immediate In_1 mem_2 equal_2 subset_2 is_empty_2 add_3 remove_3 singleton_1 inter_1 inter_2 diff_1 diff_2 - filter_1 filter_2 for_all_2 exists_2 elements_2 + filter_1 filter_2 for_all_2 exists_2 elements_2 : set. End WSfun. @@ -270,7 +270,7 @@ End WSfun. (** ** Static signature for weak sets - Similar to the functorial signature [SW], except that the + Similar to the functorial signature [SW], except that the module [E] of base elements is incorporated in the signature. *) Module Type WS. @@ -295,48 +295,48 @@ Module Type Sfun (E : OrderedType). Parameter min_elt : t -> option elt. (** Return the smallest element of the given set - (with respect to the [E.compare] ordering), + (with respect to the [E.compare] ordering), or [None] if the set is empty. *) Parameter max_elt : t -> option elt. (** Same as [min_elt], but returns the largest element of the given set. *) - Section Spec. + Section Spec. Variable s s' s'' : t. Variable x y : elt. - + (** Specification of [lt] *) Parameter lt_trans : lt s s' -> lt s' s'' -> lt s s''. Parameter lt_not_eq : lt s s' -> ~ eq s s'. (** Additional specification of [elements] *) - Parameter elements_3 : sort E.lt (elements s). + Parameter elements_3 : sort E.lt (elements s). (** Remark: since [fold] is specified via [elements], this stronger - specification of [elements] has an indirect impact on [fold], + specification of [elements] has an indirect impact on [fold], which can now be proved to receive elements in increasing order. *) (** Specification of [min_elt] *) - Parameter min_elt_1 : min_elt s = Some x -> In x s. - Parameter min_elt_2 : min_elt s = Some x -> In y s -> ~ E.lt y x. + Parameter min_elt_1 : min_elt s = Some x -> In x s. + Parameter min_elt_2 : min_elt s = Some x -> In y s -> ~ E.lt y x. Parameter min_elt_3 : min_elt s = None -> Empty s. - (** Specification of [max_elt] *) - Parameter max_elt_1 : max_elt s = Some x -> In x s. - Parameter max_elt_2 : max_elt s = Some x -> In y s -> ~ E.lt x y. + (** Specification of [max_elt] *) + Parameter max_elt_1 : max_elt s = Some x -> In x s. + Parameter max_elt_2 : max_elt s = Some x -> In y s -> ~ E.lt x y. Parameter max_elt_3 : max_elt s = None -> Empty s. (** Additional specification of [choose] *) - Parameter choose_3 : choose s = Some x -> choose s' = Some y -> + Parameter choose_3 : choose s = Some x -> choose s' = Some y -> Equal s s' -> E.eq x y. End Spec. Hint Resolve elements_3 : set. - Hint Immediate + Hint Immediate min_elt_1 min_elt_2 min_elt_3 max_elt_1 max_elt_2 max_elt_3 : set. End Sfun. @@ -344,7 +344,7 @@ End Sfun. (** ** Static signature for sets on ordered elements - Similar to the functorial signature [Sfun], except that the + Similar to the functorial signature [Sfun], except that the module [E] of base elements is incorporated in the signature. *) Module Type S. @@ -411,7 +411,7 @@ Module Type Sdep. Parameter singleton : forall x : elt, {s : t | forall y : elt, In y s <-> E.eq x y}. - + Parameter remove : forall (x : elt) (s : t), @@ -433,7 +433,7 @@ Module Type Sdep. {s'' : t | forall x : elt, In x s'' <-> In x s /\ ~ In x s'}. Parameter equal : forall s s' : t, {s[=]s'} + {~ s[=]s'}. - + Parameter subset : forall s s' : t, {Subset s s'} + {~ Subset s s'}. Parameter @@ -447,7 +447,7 @@ Module Type Sdep. forall (P : elt -> Prop) (Pdec : forall x : elt, {P x} + {~ P x}) (s : t), {compat_P E.eq P -> For_all P s} + {compat_P E.eq P -> ~ For_all P s}. - + Parameter exists_ : forall (P : elt -> Prop) (Pdec : forall x : elt, {P x} + {~ P x}) @@ -474,7 +474,7 @@ Module Type Sdep. Parameter fold : forall (A : Type) (f : elt -> A -> A) (s : t) (i : A), - {r : A | let (l,_) := elements s in + {r : A | let (l,_) := elements s in r = fold_left (fun a e => f e a) l i}. Parameter @@ -494,10 +494,10 @@ Module Type Sdep. Parameter choose : forall s : t, {x : elt | In x s} + {Empty s}. - (** The [choose_3] specification of [S] cannot be packed + (** The [choose_3] specification of [S] cannot be packed in the dependent version of [choose], so we leave it separate. *) - Parameter choose_equal : forall s s', Equal s s' -> - match choose s, choose s' with + Parameter choose_equal : forall s s', Equal s s' -> + match choose s, choose s' with | inleft (exist x _), inleft (exist x' _) => E.eq x x' | inright _, inright _ => True | _, _ => False diff --git a/theories/FSets/FSetList.v b/theories/FSets/FSetList.v index 4e46610bc..eb6f7b222 100644 --- a/theories/FSets/FSetList.v +++ b/theories/FSets/FSetList.v @@ -10,7 +10,7 @@ (** * Finite sets library *) -(** This file proposes an implementation of the non-dependant +(** This file proposes an implementation of the non-dependant interface [FSetInterface.S] using strictly ordered list. *) Require Export FSetInterface. @@ -20,11 +20,11 @@ Unset Strict Implicit. (** * Functions over lists First, we provide sets as lists which are not necessarily sorted. - The specs are proved under the additional condition of being sorted. + The specs are proved under the additional condition of being sorted. And the functions returning sets are proved to preserve this invariant. *) Module Raw (X: OrderedType). - + Module MX := OrderedTypeFacts X. Import MX. @@ -59,7 +59,7 @@ Module Raw (X: OrderedType). end end. - Definition singleton (x : elt) : t := x :: nil. + Definition singleton (x : elt) : t := x :: nil. Fixpoint remove (x : elt) (s : t) {struct s} : t := match s with @@ -70,8 +70,8 @@ Module Raw (X: OrderedType). | EQ _ => l | GT _ => y :: remove x l end - end. - + end. + Fixpoint union (s : t) : t -> t := match s with | nil => fun s' => s' @@ -86,7 +86,7 @@ Module Raw (X: OrderedType). | GT _ => x' :: union_aux l' end end) - end. + end. Fixpoint inter (s : t) : t -> t := match s with @@ -102,8 +102,8 @@ Module Raw (X: OrderedType). | GT _ => inter_aux l' end end) - end. - + end. + Fixpoint diff (s : t) : t -> t := match s with | nil => fun _ => nil @@ -118,8 +118,8 @@ Module Raw (X: OrderedType). | GT _ => diff_aux l' end end) - end. - + end. + Fixpoint equal (s : t) : t -> bool := fun s' : t => match s, s' with @@ -144,31 +144,31 @@ Module Raw (X: OrderedType). | _, _ => false end. - Fixpoint fold (B : Type) (f : elt -> B -> B) (s : t) {struct s} : + Fixpoint fold (B : Type) (f : elt -> B -> B) (s : t) {struct s} : B -> B := fun i => match s with | nil => i | x :: l => fold f l (f x i) - end. + end. Fixpoint filter (f : elt -> bool) (s : t) {struct s} : t := match s with | nil => nil | x :: l => if f x then x :: filter f l else filter f l - end. + end. Fixpoint for_all (f : elt -> bool) (s : t) {struct s} : bool := match s with | nil => true | x :: l => if f x then for_all f l else false - end. - + end. + Fixpoint exists_ (f : elt -> bool) (s : t) {struct s} : bool := match s with | nil => false | x :: l => if f x then true else exists_ f l end. - Fixpoint partition (f : elt -> bool) (s : t) {struct s} : + Fixpoint partition (f : elt -> bool) (s : t) {struct s} : t * t := match s with | nil => (nil, nil) @@ -211,7 +211,7 @@ Module Raw (X: OrderedType). Definition Exists (P : elt -> Prop) (s : t) := exists x, In x s /\ P x. Lemma mem_1 : - forall (s : t) (Hs : Sort s) (x : elt), In x s -> mem x s = true. + forall (s : t) (Hs : Sort s) (x : elt), In x s -> mem x s = true. Proof. simple induction s; intros. inversion H. @@ -234,25 +234,25 @@ Module Raw (X: OrderedType). Lemma add_Inf : forall (s : t) (x a : elt), Inf a s -> X.lt a x -> Inf a (add x s). Proof. - simple induction s. + simple induction s. simpl; intuition. simpl; intros; case (X.compare x a); intuition; inversion H0; intuition. Qed. Hint Resolve add_Inf. - + Lemma add_sort : forall (s : t) (Hs : Sort s) (x : elt), Sort (add x s). Proof. simple induction s. simpl; intuition. simpl; intros; case (X.compare x a); intuition; inversion_clear Hs; auto. - Qed. + Qed. Lemma add_1 : forall (s : t) (Hs : Sort s) (x y : elt), X.eq x y -> In y (add x s). Proof. - simple induction s. + simple induction s. simpl; intuition. simpl; intros; case (X.compare x a); inversion_clear Hs; auto. constructor; apply X.eq_trans with x; auto. @@ -261,7 +261,7 @@ Module Raw (X: OrderedType). Lemma add_2 : forall (s : t) (Hs : Sort s) (x y : elt), In y s -> In y (add x s). Proof. - simple induction s. + simple induction s. simpl; intuition. simpl; intros; case (X.compare x a); intuition. inversion_clear Hs; inversion_clear H0; auto. @@ -271,7 +271,7 @@ Module Raw (X: OrderedType). forall (s : t) (Hs : Sort s) (x y : elt), ~ X.eq x y -> In y (add x s) -> In y s. Proof. - simple induction s. + simple induction s. simpl; inversion_clear 3; auto; order. simpl; intros a l Hrec Hs x y; case (X.compare x a); intros; inversion_clear H0; inversion_clear Hs; auto. @@ -282,7 +282,7 @@ Module Raw (X: OrderedType). Lemma remove_Inf : forall (s : t) (Hs : Sort s) (x a : elt), Inf a s -> Inf a (remove x s). Proof. - simple induction s. + simple induction s. simpl; intuition. simpl; intros; case (X.compare x a); intuition; inversion_clear H0; auto. inversion_clear Hs; apply Inf_lt with a; auto. @@ -295,14 +295,14 @@ Module Raw (X: OrderedType). simple induction s. simpl; intuition. simpl; intros; case (X.compare x a); intuition; inversion_clear Hs; auto. - Qed. + Qed. Lemma remove_1 : forall (s : t) (Hs : Sort s) (x y : elt), X.eq x y -> ~ In y (remove x s). Proof. - simple induction s. + simple induction s. simpl; red; intros; inversion H0. - simpl; intros; case (X.compare x a); intuition; inversion_clear Hs. + simpl; intros; case (X.compare x a); intuition; inversion_clear Hs. inversion_clear H1. order. generalize (Sort_Inf_In H2 H3 H4); order. @@ -316,23 +316,23 @@ Module Raw (X: OrderedType). forall (s : t) (Hs : Sort s) (x y : elt), ~ X.eq x y -> In y s -> In y (remove x s). Proof. - simple induction s. + simple induction s. simpl; intuition. simpl; intros; case (X.compare x a); intuition; inversion_clear Hs; - inversion_clear H1; auto. + inversion_clear H1; auto. destruct H0; apply X.eq_trans with a; auto. Qed. Lemma remove_3 : forall (s : t) (Hs : Sort s) (x y : elt), In y (remove x s) -> In y s. Proof. - simple induction s. + simple induction s. simpl; intuition. simpl; intros a l Hrec Hs x y; case (X.compare x a); intuition. inversion_clear Hs; inversion_clear H; auto. constructor 2; apply Hrec with x; auto. Qed. - + Lemma singleton_sort : forall x : elt, Sort (singleton x). Proof. unfold singleton; simpl; auto. @@ -342,12 +342,12 @@ Module Raw (X: OrderedType). Proof. unfold singleton; simpl; intuition. inversion_clear H; auto; inversion H0. - Qed. + Qed. Lemma singleton_2 : forall x y : elt, X.eq x y -> In y (singleton x). Proof. unfold singleton; simpl; auto. - Qed. + Qed. Ltac DoubleInd := simple induction s; @@ -366,15 +366,15 @@ Module Raw (X: OrderedType). case (X.compare x x'); auto. Qed. Hint Resolve union_Inf. - + Lemma union_sort : forall (s s' : t) (Hs : Sort s) (Hs' : Sort s'), Sort (union s s'). Proof. DoubleInd; case (X.compare x x'); intuition; constructor; auto. apply Inf_eq with x'; trivial; apply union_Inf; trivial; apply Inf_eq with x; auto. change (Inf x' (union (x :: l) l')); auto. - Qed. - + Qed. + Lemma union_1 : forall (s s' : t) (Hs : Sort s) (Hs' : Sort s') (x : elt), In x (union s s') -> In x s \/ In x s'. @@ -389,7 +389,7 @@ Module Raw (X: OrderedType). forall (s s' : t) (Hs : Sort s) (Hs' : Sort s') (x : elt), In x s -> In x (union s s'). Proof. - DoubleInd. + DoubleInd. intros i Hi; case (X.compare x x'); intuition; inversion_clear Hi; auto. Qed. @@ -397,23 +397,23 @@ Module Raw (X: OrderedType). forall (s s' : t) (Hs : Sort s) (Hs' : Sort s') (x : elt), In x s' -> In x (union s s'). Proof. - DoubleInd. + DoubleInd. intros i Hi; case (X.compare x x'); inversion_clear Hi; intuition. - constructor; apply X.eq_trans with x'; auto. + constructor; apply X.eq_trans with x'; auto. Qed. - + Lemma inter_Inf : forall (s s' : t) (Hs : Sort s) (Hs' : Sort s') (a : elt), Inf a s -> Inf a s' -> Inf a (inter s s'). Proof. DoubleInd. intros i His His'; inversion His; inversion His'; subst. - case (X.compare x x'); intuition. + case (X.compare x x'); intuition. apply Inf_lt with x; auto. apply H3; auto. apply Inf_lt with x'; auto. Qed. - Hint Resolve inter_Inf. + Hint Resolve inter_Inf. Lemma inter_sort : forall (s s' : t) (Hs : Sort s) (Hs' : Sort s'), Sort (inter s s'). @@ -421,8 +421,8 @@ Module Raw (X: OrderedType). DoubleInd; case (X.compare x x'); auto. constructor; auto. apply Inf_eq with x'; trivial; apply inter_Inf; trivial; apply Inf_eq with x; auto. - Qed. - + Qed. + Lemma inter_1 : forall (s s' : t) (Hs : Sort s) (Hs' : Sort s') (x : elt), In x (inter s s') -> In x s. @@ -455,7 +455,7 @@ Module Raw (X: OrderedType). inversion_clear His; auto; inversion_clear His'; auto. constructor; apply X.eq_trans with x'; auto. - change (In i (inter (x :: l) l')). + change (In i (inter (x :: l) l')). inversion_clear His'; auto. generalize (Sort_Inf_In Hs (cons_leA _ _ _ _ l0) His); order. Qed. @@ -473,14 +473,14 @@ Module Raw (X: OrderedType). apply H10; trivial. apply Inf_lt with x'; auto. Qed. - Hint Resolve diff_Inf. + Hint Resolve diff_Inf. Lemma diff_sort : forall (s s' : t) (Hs : Sort s) (Hs' : Sort s'), Sort (diff s s'). Proof. DoubleInd; case (X.compare x x'); auto. - Qed. - + Qed. + Lemma diff_1 : forall (s s' : t) (Hs : Sort s) (Hs' : Sort s') (x : elt), In x (diff s s') -> In x s. @@ -496,18 +496,18 @@ Module Raw (X: OrderedType). In x (diff s s') -> ~ In x s'. Proof. DoubleInd. - intros; intro Abs; inversion Abs. + intros; intro Abs; inversion Abs. case (X.compare x x'); intuition. inversion_clear H. generalize (Sort_Inf_In Hs' (cons_leA _ _ _ _ l0) H3); order. apply Hrec with (x'::l') x0; auto. - + inversion_clear H3. generalize (Sort_Inf_In H1 H2 (diff_1 H1 H5 H)); order. apply Hrec with l' x0; auto. - - inversion_clear H3. + + inversion_clear H3. generalize (Sort_Inf_In Hs (cons_leA _ _ _ _ l0) (diff_1 Hs H5 H)); order. apply H0 with x0; auto. Qed. @@ -519,7 +519,7 @@ Module Raw (X: OrderedType). DoubleInd. intros i His His'; elim (X.compare x x'); intuition; inversion_clear His; auto. elim His'; constructor; apply X.eq_trans with x; auto. - Qed. + Qed. Lemma equal_1 : forall (s s' : t) (Hs : Sort s) (Hs' : Sort s'), @@ -539,7 +539,7 @@ Module Raw (X: OrderedType). assert (A : In x (x' :: l')); auto; inversion_clear A. order. generalize (Sort_Inf_In H5 H6 H4); order. - + apply Hrec; intuition; elim (H a); intros. assert (A : In a (x' :: l')); auto; inversion_clear A; auto. generalize (Sort_Inf_In H1 H2 H0); order. @@ -565,8 +565,8 @@ Module Raw (X: OrderedType). elim (Hrec l' H a); intuition; inversion_clear H2; auto. constructor; apply X.eq_trans with x; auto. constructor; apply X.eq_trans with x'; auto. - Qed. - + Qed. + Lemma subset_1 : forall (s s' : t) (Hs : Sort s) (Hs' : Sort s'), Subset s s' -> subset s s' = true. @@ -574,7 +574,7 @@ Module Raw (X: OrderedType). intros s s'; generalize s' s; clear s s'. simple induction s'; unfold Subset. intro s; case s; auto. - intros; elim (H e); intros; assert (A : In e nil); auto; inversion A. + intros; elim (H e); intros; assert (A : In e nil); auto; inversion A. intros x' l' Hrec s; case s. simpl; auto. intros x l Hs Hs'; inversion Hs; inversion Hs'; subst. @@ -583,14 +583,14 @@ Module Raw (X: OrderedType). assert (A : In x (x' :: l')); auto; inversion_clear A. order. generalize (Sort_Inf_In H5 H6 H0); order. - + apply Hrec; intuition. assert (A : In a (x' :: l')); auto; inversion_clear A; auto. generalize (Sort_Inf_In H1 H2 H0); order. apply Hrec; intuition. assert (A : In a (x' :: l')); auto; inversion_clear A; auto. - inversion_clear H0. + inversion_clear H0. order. generalize (Sort_Inf_In H1 H2 H4); order. Qed. @@ -604,13 +604,13 @@ Module Raw (X: OrderedType). intros x' l' Hrec s; case s. intros; inversion H0. intros x l; simpl; case (X.compare x); intros; auto. - discriminate H. + discriminate H. inversion_clear H0. constructor; apply X.eq_trans with x; auto. constructor 2; apply Hrec with l; auto. constructor 2; apply Hrec with (x::l); auto. - Qed. - + Qed. + Lemma empty_sort : Sort empty. Proof. unfold empty; constructor. @@ -619,15 +619,15 @@ Module Raw (X: OrderedType). Lemma empty_1 : Empty empty. Proof. unfold Empty, empty; intuition; inversion H. - Qed. + Qed. Lemma is_empty_1 : forall s : t, Empty s -> is_empty s = true. Proof. unfold Empty; intro s; case s; simpl; intuition. elim (H e); auto. Qed. - - Lemma is_empty_2 : forall s : t, is_empty s = true -> Empty s. + + Lemma is_empty_2 : forall s : t, is_empty s = true -> Empty s. Proof. unfold Empty; intro s; case s; simpl; intuition; inversion H0. @@ -639,39 +639,39 @@ Module Raw (X: OrderedType). Qed. Lemma elements_2 : forall (s : t) (x : elt), In x (elements s) -> In x s. - Proof. + Proof. unfold elements; auto. Qed. - - Lemma elements_3 : forall (s : t) (Hs : Sort s), Sort (elements s). - Proof. + + Lemma elements_3 : forall (s : t) (Hs : Sort s), Sort (elements s). + Proof. unfold elements; auto. Qed. - Lemma elements_3w : forall (s : t) (Hs : Sort s), NoDupA X.eq (elements s). - Proof. + Lemma elements_3w : forall (s : t) (Hs : Sort s), NoDupA X.eq (elements s). + Proof. unfold elements; auto. Qed. - Lemma min_elt_1 : forall (s : t) (x : elt), min_elt s = Some x -> In x s. + Lemma min_elt_1 : forall (s : t) (x : elt), min_elt s = Some x -> In x s. Proof. intro s; case s; simpl; intros; inversion H; auto. - Qed. + Qed. Lemma min_elt_2 : forall (s : t) (Hs : Sort s) (x y : elt), - min_elt s = Some x -> In y s -> ~ X.lt y x. + min_elt s = Some x -> In y s -> ~ X.lt y x. Proof. simple induction s; simpl. intros; inversion H. - intros a l; case l; intros; inversion H0; inversion_clear H1; subst. + intros a l; case l; intros; inversion H0; inversion_clear H1; subst. order. inversion H2. order. inversion_clear Hs. inversion_clear H3. generalize (H H1 e y (refl_equal (Some e)) H2); order. - Qed. + Qed. Lemma min_elt_3 : forall s : t, min_elt s = None -> Empty s. Proof. @@ -679,8 +679,8 @@ Module Raw (X: OrderedType). inversion H; inversion H0. Qed. - Lemma max_elt_1 : forall (s : t) (x : elt), max_elt s = Some x -> In x s. - Proof. + Lemma max_elt_1 : forall (s : t) (x : elt), max_elt s = Some x -> In x s. + Proof. simple induction s; simpl. intros; inversion H. intros x l; case l; simpl. @@ -689,10 +689,10 @@ Module Raw (X: OrderedType). intros. constructor 2; apply (H _ H0). Qed. - + Lemma max_elt_2 : forall (s : t) (Hs : Sort s) (x y : elt), - max_elt s = Some x -> In y s -> ~ X.lt x y. + max_elt s = Some x -> In y s -> ~ X.lt x y. Proof. simple induction s; simpl. intros; inversion H. @@ -706,7 +706,7 @@ Module Raw (X: OrderedType). assert (In e (e::l0)) by auto. generalize (H H2 x0 e H0 H1); order. generalize (H H2 x0 y H0 H3); order. - Qed. + Qed. Lemma max_elt_3 : forall s : t, max_elt s = None -> Empty s. Proof. @@ -734,7 +734,7 @@ Module Raw (X: OrderedType). rewrite H; auto using min_elt_1. destruct (X.compare x x'); intuition. Qed. - + Lemma fold_1 : forall (s : t) (Hs : Sort s) (A : Type) (i : A) (f : elt -> A -> A), fold f s i = fold_left (fun a e => f e a) (elements s) i. @@ -758,9 +758,9 @@ Module Raw (X: OrderedType). Inf x s -> Inf x (filter f s). Proof. simple induction s; simpl. - intuition. + intuition. intros x l Hrec Hs a f Ha; inversion_clear Hs; inversion_clear Ha. - case (f x). + case (f x). constructor; auto. apply Hrec; auto. apply Inf_lt with x; auto. @@ -774,7 +774,7 @@ Module Raw (X: OrderedType). intros x l Hrec Hs f; inversion_clear Hs. case (f x); auto. constructor; auto. - apply filter_Inf; auto. + apply filter_Inf; auto. Qed. Lemma filter_1 : @@ -793,7 +793,7 @@ Module Raw (X: OrderedType). Lemma filter_2 : forall (s : t) (x : elt) (f : elt -> bool), - compat_bool X.eq f -> In x (filter f s) -> f x = true. + compat_bool X.eq f -> In x (filter f s) -> f x = true. Proof. simple induction s; simpl. intros; inversion H0. @@ -802,10 +802,10 @@ Module Raw (X: OrderedType). inversion_clear 2; auto. symmetry; auto. Qed. - + Lemma filter_3 : forall (s : t) (x : elt) (f : elt -> bool), - compat_bool X.eq f -> In x s -> f x = true -> In x (filter f s). + compat_bool X.eq f -> In x s -> f x = true -> In x (filter f s). Proof. simple induction s; simpl. intros; inversion H0. @@ -820,9 +820,9 @@ Module Raw (X: OrderedType). forall (s : t) (f : elt -> bool), compat_bool X.eq f -> For_all (fun x => f x = true) s -> for_all f s = true. - Proof. + Proof. simple induction s; simpl; auto; unfold For_all. - intros x l Hrec f Hf. + intros x l Hrec f Hf. generalize (Hf x); case (f x); simpl. auto. intros; rewrite (H x); auto. @@ -832,11 +832,11 @@ Module Raw (X: OrderedType). forall (s : t) (f : elt -> bool), compat_bool X.eq f -> for_all f s = true -> For_all (fun x => f x = true) s. - Proof. + Proof. simple induction s; simpl; auto; unfold For_all. intros; inversion H1. - intros x l Hrec f Hf. - intros A a; intros. + intros x l Hrec f Hf. + intros A a; intros. assert (f x = true). generalize A; case (f x); auto. rewrite H0 in A; simpl in A. @@ -850,9 +850,9 @@ Module Raw (X: OrderedType). Proof. simple induction s; simpl; auto; unfold Exists. intros. - elim H0; intuition. + elim H0; intuition. inversion H2. - intros x l Hrec f Hf. + intros x l Hrec f Hf. generalize (Hf x); case (f x); simpl. auto. destruct 2 as [a (A1,A2)]. @@ -865,7 +865,7 @@ Module Raw (X: OrderedType). Lemma exists_2 : forall (s : t) (f : elt -> bool), compat_bool X.eq f -> exists_ f s = true -> Exists (fun x => f x = true) s. - Proof. + Proof. simple induction s; simpl; auto; unfold Exists. intros; discriminate. intros x l Hrec f Hf. @@ -880,7 +880,7 @@ Module Raw (X: OrderedType). Inf x s -> Inf x (fst (partition f s)). Proof. simple induction s; simpl. - intuition. + intuition. intros x l Hrec Hs f a Ha; inversion_clear Hs; inversion_clear Ha. generalize (Hrec H f a). case (f x); case (partition f l); simpl. @@ -893,7 +893,7 @@ Module Raw (X: OrderedType). Inf x s -> Inf x (snd (partition f s)). Proof. simple induction s; simpl. - intuition. + intuition. intros x l Hrec Hs f a Ha; inversion_clear Hs; inversion_clear Ha. generalize (Hrec H f a). case (f x); case (partition f l); simpl. @@ -910,7 +910,7 @@ Module Raw (X: OrderedType). generalize (Hrec H f); generalize (partition_Inf_1 H f). case (f x); case (partition f l); simpl; auto. Qed. - + Lemma partition_sort_2 : forall (s : t) (Hs : Sort s) (f : elt -> bool), Sort (snd (partition f s)). Proof. @@ -935,7 +935,7 @@ Module Raw (X: OrderedType). constructor 2; rewrite <- H; auto. constructor 2; rewrite H; auto. Qed. - + Lemma partition_2 : forall (s : t) (f : elt -> bool), compat_bool X.eq f -> @@ -943,7 +943,7 @@ Module Raw (X: OrderedType). Proof. simple induction s; simpl; auto; unfold Equal. split; auto. - intros x l Hrec f Hf. + intros x l Hrec f Hf. generalize (Hrec f Hf); clear Hrec. destruct (partition f l) as [s1 s2]; simpl; intros. case (f x); simpl; auto. @@ -951,21 +951,21 @@ Module Raw (X: OrderedType). constructor 2; rewrite <- H; auto. constructor 2; rewrite H; auto. Qed. - + Definition eq : t -> t -> Prop := Equal. - Lemma eq_refl : forall s : t, eq s s. - Proof. + Lemma eq_refl : forall s : t, eq s s. + Proof. unfold eq, Equal; intuition. Qed. Lemma eq_sym : forall s s' : t, eq s s' -> eq s' s. - Proof. + Proof. unfold eq, Equal; intros; destruct (H a); intuition. Qed. Lemma eq_trans : forall s s' s'' : t, eq s s' -> eq s' s'' -> eq s s''. - Proof. + Proof. unfold eq, Equal; intros; destruct (H a); destruct (H0 a); intuition. Qed. @@ -977,29 +977,29 @@ Module Raw (X: OrderedType). forall (x y : elt) (s s' : t), X.eq x y -> lt s s' -> lt (x :: s) (y :: s'). Hint Constructors lt. - + Lemma lt_trans : forall s s' s'' : t, lt s s' -> lt s' s'' -> lt s s''. - Proof. + Proof. intros s s' s'' H; generalize s''; clear s''; elim H. intros x l s'' H'; inversion_clear H'; auto. - intros x x' l l' E s'' H'; inversion_clear H'; auto. + intros x x' l l' E s'' H'; inversion_clear H'; auto. constructor; apply X.lt_trans with x'; auto. constructor; apply lt_eq with x'; auto. intros. inversion_clear H3. constructor; apply eq_lt with y; auto. - constructor 3; auto; apply X.eq_trans with y; auto. - Qed. + constructor 3; auto; apply X.eq_trans with y; auto. + Qed. Lemma lt_not_eq : forall (s s' : t) (Hs : Sort s) (Hs' : Sort s'), lt s s' -> ~ eq s s'. - Proof. - unfold eq, Equal. + Proof. + unfold eq, Equal. intros s s' Hs Hs' H; generalize Hs Hs'; clear Hs Hs'; elim H; intros; intro. elim (H0 x); intros. assert (X : In x nil); auto; inversion X. inversion_clear Hs; inversion_clear Hs'. - elim (H1 x); intros. + elim (H1 x); intros. assert (X : In x (y :: s'0)); auto; inversion_clear X. order. generalize (Sort_Inf_In H4 H5 H8); order. @@ -1019,8 +1019,8 @@ Module Raw (X: OrderedType). forall (s s' : t) (Hs : Sort s) (Hs' : Sort s'), Compare lt eq s s'. Proof. simple induction s. - intros; case s'. - constructor 2; apply eq_refl. + intros; case s'. + constructor 2; apply eq_refl. constructor 1; auto. intros a l Hrec s'; case s'. constructor 3; auto. @@ -1039,25 +1039,25 @@ Module Raw (X: OrderedType). destruct (e1 a0); auto. Defined. - End ForNotations. + End ForNotations. Hint Constructors lt. End Raw. (** * Encapsulation - Now, in order to really provide a functor implementing [S], we + Now, in order to really provide a functor implementing [S], we need to encapsulate everything into a type of strictly ordered lists. *) Module Make (X: OrderedType) <: S with Module E := X. - Module Raw := Raw X. + Module Raw := Raw X. Module E := X. Record slist := {this :> Raw.t; sorted : sort E.lt this}. - Definition t := slist. + Definition t := slist. Definition elt := E.t. - + Definition In (x : elt) (s : t) : Prop := InA E.eq x s.(this). Definition Equal (s s':t) : Prop := forall a : elt, In a s <-> In a s'. Definition Subset (s s':t) : Prop := forall a : elt, In a s -> In a s'. @@ -1070,12 +1070,12 @@ Module Make (X: OrderedType) <: S with Module E := X. Definition remove (x : elt)(s : t) : t := Build_slist (Raw.remove_sort (sorted s) x). Definition singleton (x : elt) : t := Build_slist (Raw.singleton_sort x). Definition union (s s' : t) : t := - Build_slist (Raw.union_sort (sorted s) (sorted s')). + Build_slist (Raw.union_sort (sorted s) (sorted s')). Definition inter (s s' : t) : t := - Build_slist (Raw.inter_sort (sorted s) (sorted s')). + Build_slist (Raw.inter_sort (sorted s) (sorted s')). Definition diff (s s' : t) : t := - Build_slist (Raw.diff_sort (sorted s) (sorted s')). - Definition equal (s s' : t) : bool := Raw.equal s s'. + Build_slist (Raw.diff_sort (sorted s) (sorted s')). + Definition equal (s s' : t) : bool := Raw.equal s s'. Definition subset (s s' : t) : bool := Raw.subset s s'. Definition empty : t := Build_slist Raw.empty_sort. Definition is_empty (s : t) : bool := Raw.is_empty s. @@ -1083,7 +1083,7 @@ Module Make (X: OrderedType) <: S with Module E := X. Definition min_elt (s : t) : option elt := Raw.min_elt s. Definition max_elt (s : t) : option elt := Raw.max_elt s. Definition choose (s : t) : option elt := Raw.choose s. - Definition fold (B : Type) (f : elt -> B -> B) (s : t) : B -> B := Raw.fold (B:=B) f s. + Definition fold (B : Type) (f : elt -> B -> B) (s : t) : B -> B := Raw.fold (B:=B) f s. Definition cardinal (s : t) : nat := Raw.cardinal s. Definition filter (f : elt -> bool) (s : t) : t := Build_slist (Raw.filter_sort (sorted s) f). @@ -1096,18 +1096,18 @@ Module Make (X: OrderedType) <: S with Module E := X. Definition eq (s s' : t) : Prop := Raw.eq s s'. Definition lt (s s' : t) : Prop := Raw.lt s s'. - Section Spec. + Section Spec. Variable s s' s'': t. Variable x y : elt. - Lemma In_1 : E.eq x y -> In x s -> In y s. + Lemma In_1 : E.eq x y -> In x s -> In y s. Proof. exact (fun H H' => Raw.MX.In_eq H H'). Qed. - + Lemma mem_1 : In x s -> mem x s = true. Proof. exact (fun H => Raw.mem_1 s.(sorted) H). Qed. - Lemma mem_2 : mem x s = true -> In x s. + Lemma mem_2 : mem x s = true -> In x s. Proof. exact (fun H => Raw.mem_2 H). Qed. - + Lemma equal_1 : Equal s s' -> equal s s' = true. Proof. exact (Raw.equal_1 s.(sorted) s'.(sorted)). Qed. Lemma equal_2 : equal s s' = true -> Equal s s'. @@ -1121,16 +1121,16 @@ Module Make (X: OrderedType) <: S with Module E := X. Lemma empty_1 : Empty empty. Proof. exact Raw.empty_1. Qed. - Lemma is_empty_1 : Empty s -> is_empty s = true. + Lemma is_empty_1 : Empty s -> is_empty s = true. Proof. exact (fun H => Raw.is_empty_1 H). Qed. Lemma is_empty_2 : is_empty s = true -> Empty s. Proof. exact (fun H => Raw.is_empty_2 H). Qed. - + Lemma add_1 : E.eq x y -> In y (add x s). Proof. exact (fun H => Raw.add_1 s.(sorted) H). Qed. Lemma add_2 : In y s -> In y (add x s). Proof. exact (fun H => Raw.add_2 s.(sorted) x H). Qed. - Lemma add_3 : ~ E.eq x y -> In y (add x s) -> In y s. + Lemma add_3 : ~ E.eq x y -> In y (add x s) -> In y s. Proof. exact (fun H => Raw.add_3 s.(sorted) H). Qed. Lemma remove_1 : E.eq x y -> ~ In y (remove x s). @@ -1140,14 +1140,14 @@ Module Make (X: OrderedType) <: S with Module E := X. Lemma remove_3 : In y (remove x s) -> In y s. Proof. exact (fun H => Raw.remove_3 s.(sorted) H). Qed. - Lemma singleton_1 : In y (singleton x) -> E.eq x y. + Lemma singleton_1 : In y (singleton x) -> E.eq x y. Proof. exact (fun H => Raw.singleton_1 H). Qed. - Lemma singleton_2 : E.eq x y -> In y (singleton x). + Lemma singleton_2 : E.eq x y -> In y (singleton x). Proof. exact (fun H => Raw.singleton_2 H). Qed. Lemma union_1 : In x (union s s') -> In x s \/ In x s'. Proof. exact (fun H => Raw.union_1 s.(sorted) s'.(sorted) H). Qed. - Lemma union_2 : In x s -> In x (union s s'). + Lemma union_2 : In x s -> In x (union s s'). Proof. exact (fun H => Raw.union_2 s.(sorted) s'.(sorted) H). Qed. Lemma union_3 : In x s' -> In x (union s s'). Proof. exact (fun H => Raw.union_3 s.(sorted) s'.(sorted) H). Qed. @@ -1159,13 +1159,13 @@ Module Make (X: OrderedType) <: S with Module E := X. Lemma inter_3 : In x s -> In x s' -> In x (inter s s'). Proof. exact (fun H => Raw.inter_3 s.(sorted) s'.(sorted) H). Qed. - Lemma diff_1 : In x (diff s s') -> In x s. + Lemma diff_1 : In x (diff s s') -> In x s. Proof. exact (fun H => Raw.diff_1 s.(sorted) s'.(sorted) H). Qed. Lemma diff_2 : In x (diff s s') -> ~ In x s'. Proof. exact (fun H => Raw.diff_2 s.(sorted) s'.(sorted) H). Qed. Lemma diff_3 : In x s -> ~ In x s' -> In x (diff s s'). Proof. exact (fun H => Raw.diff_3 s.(sorted) s'.(sorted) H). Qed. - + Lemma fold_1 : forall (A : Type) (i : A) (f : elt -> A -> A), fold f s i = fold_left (fun a e => f e a) (elements s) i. Proof. exact (Raw.fold_1 s.(sorted)). Qed. @@ -1174,12 +1174,12 @@ Module Make (X: OrderedType) <: S with Module E := X. Proof. exact (Raw.cardinal_1 s.(sorted)). Qed. Section Filter. - + Variable f : elt -> bool. - Lemma filter_1 : compat_bool E.eq f -> In x (filter f s) -> In x s. + Lemma filter_1 : compat_bool E.eq f -> In x (filter f s) -> In x s. Proof. exact (@Raw.filter_1 s x f). Qed. - Lemma filter_2 : compat_bool E.eq f -> In x (filter f s) -> f x = true. + Lemma filter_2 : compat_bool E.eq f -> In x (filter f s) -> f x = true. Proof. exact (@Raw.filter_2 s x f). Qed. Lemma filter_3 : compat_bool E.eq f -> In x s -> f x = true -> In x (filter f s). @@ -1222,16 +1222,16 @@ Module Make (X: OrderedType) <: S with Module E := X. Lemma elements_3w : NoDupA E.eq (elements s). Proof. exact (Raw.elements_3w s.(sorted)). Qed. - Lemma min_elt_1 : min_elt s = Some x -> In x s. + Lemma min_elt_1 : min_elt s = Some x -> In x s. Proof. exact (fun H => Raw.min_elt_1 H). Qed. - Lemma min_elt_2 : min_elt s = Some x -> In y s -> ~ E.lt y x. + Lemma min_elt_2 : min_elt s = Some x -> In y s -> ~ E.lt y x. Proof. exact (fun H => Raw.min_elt_2 s.(sorted) H). Qed. Lemma min_elt_3 : min_elt s = None -> Empty s. Proof. exact (fun H => Raw.min_elt_3 H). Qed. - Lemma max_elt_1 : max_elt s = Some x -> In x s. + Lemma max_elt_1 : max_elt s = Some x -> In x s. Proof. exact (fun H => Raw.max_elt_1 H). Qed. - Lemma max_elt_2 : max_elt s = Some x -> In y s -> ~ E.lt x y. + Lemma max_elt_2 : max_elt s = Some x -> In y s -> ~ E.lt x y. Proof. exact (fun H => Raw.max_elt_2 s.(sorted) H). Qed. Lemma max_elt_3 : max_elt s = None -> Empty s. Proof. exact (fun H => Raw.max_elt_3 H). Qed. @@ -1240,7 +1240,7 @@ Module Make (X: OrderedType) <: S with Module E := X. Proof. exact (fun H => Raw.choose_1 H). Qed. Lemma choose_2 : choose s = None -> Empty s. Proof. exact (fun H => Raw.choose_2 H). Qed. - Lemma choose_3 : choose s = Some x -> choose s' = Some y -> + Lemma choose_3 : choose s = Some x -> choose s' = Some y -> Equal s s' -> E.eq x y. Proof. exact (@Raw.choose_3 _ _ s.(sorted) s'.(sorted) x y). Qed. @@ -1259,8 +1259,8 @@ Module Make (X: OrderedType) <: S with Module E := X. Definition compare : Compare lt eq s s'. Proof. elim (Raw.compare s.(sorted) s'.(sorted)); - [ constructor 1 | constructor 2 | constructor 3 ]; - auto. + [ constructor 1 | constructor 2 | constructor 3 ]; + auto. Defined. Definition eq_dec : { eq s s' } + { ~ eq s s' }. diff --git a/theories/FSets/FSetProperties.v b/theories/FSets/FSetProperties.v index 6a062ea14..032f0c1b3 100644 --- a/theories/FSets/FSetProperties.v +++ b/theories/FSets/FSetProperties.v @@ -11,9 +11,9 @@ (** * Finite sets library *) (** This functor derives additional properties from [FSetInterface.S]. - Contrary to the functor in [FSetEqProperties] it uses + Contrary to the functor in [FSetEqProperties] it uses predicates over sets instead of sets operations, i.e. - [In x s] instead of [mem x s=true], + [In x s] instead of [mem x s=true], [Equal s s'] instead of [equal s s'=true], etc. *) Require Export FSetInterface. @@ -47,7 +47,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). fsetdec. fsetdec. Qed. - + Ltac expAdd := repeat rewrite Add_Equal. Section BasicProperties. @@ -64,7 +64,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). Lemma equal_trans : s1[=]s2 -> s2[=]s3 -> s1[=]s3. Proof. fsetdec. Qed. - Lemma subset_refl : s[<=]s. + Lemma subset_refl : s[<=]s. Proof. fsetdec. Qed. Lemma subset_trans : s1[<=]s2 -> s2[<=]s3 -> s1[<=]s3. @@ -84,7 +84,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). Lemma subset_diff : s1[<=]s3 -> diff s1 s2 [<=] s3. Proof. fsetdec. Qed. - + Lemma subset_add_3 : In x s2 -> s1[<=]s2 -> add x s1 [<=] s2. Proof. fsetdec. Qed. @@ -93,7 +93,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). Lemma in_subset : In x s1 -> s1[<=]s2 -> In x s2. Proof. fsetdec. Qed. - + Lemma double_inclusion : s1[=]s2 <-> s1[<=]s2 /\ s2[<=]s1. Proof. intuition fsetdec. Qed. @@ -105,7 +105,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). Lemma add_equal : In x s -> add x s [=] s. Proof. fsetdec. Qed. - + Lemma add_add : add x (add x' s) [=] add x' (add x s). Proof. fsetdec. Qed. @@ -149,11 +149,11 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). Lemma union_add : union (add x s) s' [=] add x (union s s'). Proof. fsetdec. Qed. - Lemma union_remove_add_1 : + Lemma union_remove_add_1 : union (remove x s) (add x s') [=] union (add x s) (remove x s'). Proof. fsetdec. Qed. - Lemma union_remove_add_2 : In x s -> + Lemma union_remove_add_2 : In x s -> union (remove x s) (add x s') [=] union s s'. Proof. fsetdec. Qed. @@ -167,10 +167,10 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). Proof. fsetdec. Qed. Lemma union_subset_4 : s[<=]s' -> union s s'' [<=] union s' s''. - Proof. fsetdec. Qed. + Proof. fsetdec. Qed. Lemma union_subset_5 : s[<=]s' -> union s'' s [<=] union s'' s'. - Proof. fsetdec. Qed. + Proof. fsetdec. Qed. Lemma empty_union_1 : Empty s -> union s s' [=] s'. Proof. fsetdec. Qed. @@ -178,7 +178,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). Lemma empty_union_2 : Empty s -> union s' s [=] s'. Proof. fsetdec. Qed. - Lemma not_in_union : ~In x s -> ~In x s' -> ~In x (union s s'). + Lemma not_in_union : ~In x s -> ~In x s' -> ~In x (union s s'). Proof. fsetdec. Qed. Lemma inter_sym : inter s s' [=] inter s' s. @@ -224,7 +224,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). s''[<=]s -> s''[<=]s' -> s''[<=] inter s s'. Proof. fsetdec. Qed. - Lemma empty_diff_1 : Empty s -> Empty (diff s s'). + Lemma empty_diff_1 : Empty s -> Empty (diff s s'). Proof. fsetdec. Qed. Lemma empty_diff_2 : Empty s -> diff s' s [=] s'. @@ -240,7 +240,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). remove x s [=] diff s (singleton x). Proof. fsetdec. Qed. - Lemma diff_inter_empty : inter (diff s s') (inter s s') [=] empty. + Lemma diff_inter_empty : inter (diff s s') (inter s s') [=] empty. Proof. fsetdec. Qed. Lemma diff_inter_all : union (diff s s') (inter s s') [=] s. @@ -249,19 +249,19 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). Lemma Add_add : Add x s (add x s). Proof. expAdd; fsetdec. Qed. - Lemma Add_remove : In x s -> Add x (remove x s) s. + Lemma Add_remove : In x s -> Add x (remove x s) s. Proof. expAdd; fsetdec. Qed. Lemma union_Add : Add x s s' -> Add x (union s s'') (union s' s''). - Proof. expAdd; fsetdec. Qed. + Proof. expAdd; fsetdec. Qed. Lemma inter_Add : In x s'' -> Add x s s' -> Add x (inter s s'') (inter s' s''). - Proof. expAdd; fsetdec. Qed. + Proof. expAdd; fsetdec. Qed. Lemma union_Equal : In x s'' -> Add x s s' -> union s s'' [=] union s' s''. - Proof. expAdd; fsetdec. Qed. + Proof. expAdd; fsetdec. Qed. Lemma inter_Add_2 : ~In x s'' -> Add x s s' -> inter s s'' [=] inter s' s''. @@ -270,16 +270,16 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). End BasicProperties. Hint Immediate equal_sym add_remove remove_add union_sym inter_sym: set. - Hint Resolve equal_refl equal_trans subset_refl subset_equal subset_antisym - subset_trans subset_empty subset_remove_3 subset_diff subset_add_3 + Hint Resolve equal_refl equal_trans subset_refl subset_equal subset_antisym + subset_trans subset_empty subset_remove_3 subset_diff subset_add_3 subset_add_2 in_subset empty_is_empty_1 empty_is_empty_2 add_equal - remove_equal singleton_equal_add union_subset_equal union_equal_1 - union_equal_2 union_assoc add_union_singleton union_add union_subset_1 + remove_equal singleton_equal_add union_subset_equal union_equal_1 + union_equal_2 union_assoc add_union_singleton union_add union_subset_1 union_subset_2 union_subset_3 inter_subset_equal inter_equal_1 inter_equal_2 inter_assoc union_inter_1 union_inter_2 inter_add_1 inter_add_2 - empty_inter_1 empty_inter_2 empty_union_1 empty_union_2 empty_diff_1 - empty_diff_2 union_Add inter_Add union_Equal inter_Add_2 not_in_union - inter_subset_1 inter_subset_2 inter_subset_3 diff_subset diff_subset_equal + empty_inter_1 empty_inter_2 empty_union_1 empty_union_2 empty_diff_1 + empty_diff_2 union_Add inter_Add union_Equal inter_Add_2 not_in_union + inter_subset_1 inter_subset_2 inter_subset_3 diff_subset diff_subset_equal remove_diff_singleton diff_inter_empty diff_inter_all Add_add Add_remove Equal_remove add_add : set. @@ -504,7 +504,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). generalize H H2; clear H H2; case l; simpl; intros. reflexivity. elim (H e). - elim (H2 e); intuition. + elim (H2 e); intuition. Qed. Lemma fold_2 : @@ -514,17 +514,17 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). transpose eqA f -> ~ In x s -> Add x s s' -> eqA (fold f s' i) (f x (fold f s i)). Proof. - intros; destruct (fold_0 s i f) as (l,(Hl, (Hl1, Hl2))); + intros; destruct (fold_0 s i f) as (l,(Hl, (Hl1, Hl2))); destruct (fold_0 s' i f) as (l',(Hl', (Hl'1, Hl'2))). rewrite Hl2; rewrite Hl'2; clear Hl2 Hl'2. apply fold_right_add with (eqA:=E.eq)(eqB:=eqA); auto. eauto. rewrite <- Hl1; auto. - intros a; rewrite InA_cons; rewrite <- Hl1; rewrite <- Hl'1; + intros a; rewrite InA_cons; rewrite <- Hl1; rewrite <- Hl'1; rewrite (H2 a); intuition. Qed. - (** In fact, [fold] on empty sets is more than equivalent to + (** In fact, [fold] on empty sets is more than equivalent to the initial element, it is Leibniz-equal to it. *) Lemma fold_1b : @@ -541,7 +541,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). Variables (A:Type)(eqA:A->A->Prop)(st:Equivalence eqA). Variables (f:elt->A->A)(Comp:compat_op E.eq eqA f)(Ass:transpose eqA f). - Lemma fold_commutes : forall i s x, + Lemma fold_commutes : forall i s x, eqA (fold f s (f x i)) (f x (fold f s i)). Proof. intros. @@ -552,15 +552,15 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). (** ** Fold is a morphism *) - Lemma fold_init : forall i i' s, eqA i i' -> + Lemma fold_init : forall i i' s, eqA i i' -> eqA (fold f s i) (fold f s i'). Proof. intros. apply fold_rel with (R:=eqA); auto. Qed. - Lemma fold_equal : + Lemma fold_equal : forall i s s', s[=]s' -> eqA (fold f s i) (fold f s' i). - Proof. + Proof. intros i s; pattern s; apply set_induction; clear s; intros. transitivity i. apply fold_1; auto. @@ -576,23 +576,23 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). (** ** Fold and other set operators *) Lemma fold_empty : forall i, fold f empty i = i. - Proof. + Proof. intros i; apply fold_1b; auto with set. Qed. - Lemma fold_add : forall i s x, ~In x s -> + Lemma fold_add : forall i s x, ~In x s -> eqA (fold f (add x s) i) (f x (fold f s i)). - Proof. + Proof. intros; apply fold_2 with (eqA := eqA); auto with set. Qed. - Lemma add_fold : forall i s x, In x s -> + Lemma add_fold : forall i s x, In x s -> eqA (fold f (add x s) i) (fold f s i). Proof. intros; apply fold_equal; auto with set. Qed. - Lemma remove_fold_1: forall i s x, In x s -> + Lemma remove_fold_1: forall i s x, In x s -> eqA (f x (fold f (remove x s) i)) (fold f s i). Proof. intros. @@ -600,7 +600,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). apply fold_2 with (eqA:=eqA); auto with set. Qed. - Lemma remove_fold_2: forall i s x, ~In x s -> + Lemma remove_fold_2: forall i s x, ~In x s -> eqA (fold f (remove x s) i) (fold f s i). Proof. intros. @@ -620,7 +620,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). symmetry; apply fold_1; auto. rename s'0 into s''. destruct (In_dec x s'). - (* In x s' *) + (* In x s' *) transitivity (fold f (union s'' s') (f x (fold f (inter s s') i))); auto with set. apply fold_init; auto. apply fold_2 with (eqA:=eqA); auto with set. @@ -646,7 +646,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). symmetry; apply fold_2 with (eqA:=eqA); auto. Qed. - Lemma fold_diff_inter : forall i s s', + Lemma fold_diff_inter : forall i s s', eqA (fold f (diff s s') (fold f (inter s s') i)) (fold f s i). Proof. intros. @@ -659,7 +659,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). apply fold_1; auto with set. Qed. - Lemma fold_union: forall i s s', + Lemma fold_union: forall i s s', (forall x, ~(In x s/\In x s')) -> eqA (fold f (union s s') i) (fold f s (fold f s' i)). Proof. @@ -696,9 +696,9 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). Lemma cardinal_0 : forall s, exists l : list elt, NoDupA E.eq l /\ - (forall x : elt, In x s <-> InA E.eq x l) /\ + (forall x : elt, In x s <-> InA E.eq x l) /\ cardinal s = length l. - Proof. + Proof. intros; exists (elements s); intuition; apply cardinal_1. Qed. @@ -724,32 +724,32 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). destruct (elements s); intuition; discriminate. Qed. - Lemma cardinal_inv_1 : forall s, cardinal s = 0 -> Empty s. + Lemma cardinal_inv_1 : forall s, cardinal s = 0 -> Empty s. Proof. - intros; rewrite cardinal_Empty; auto. + intros; rewrite cardinal_Empty; auto. Qed. Hint Resolve cardinal_inv_1. - + Lemma cardinal_inv_2 : forall s n, cardinal s = S n -> { x : elt | In x s }. - Proof. + Proof. intros; rewrite M.cardinal_1 in H. generalize (elements_2 (s:=s)). - destruct (elements s); try discriminate. + destruct (elements s); try discriminate. exists e; auto. Qed. Lemma cardinal_inv_2b : forall s, cardinal s <> 0 -> { x : elt | In x s }. Proof. - intro; generalize (@cardinal_inv_2 s); destruct cardinal; + intro; generalize (@cardinal_inv_2 s); destruct cardinal; [intuition|eauto]. Qed. (** ** Cardinal is a morphism *) Lemma Equal_cardinal : forall s s', s[=]s' -> cardinal s = cardinal s'. - Proof. + Proof. symmetry. remember (cardinal s) as n; symmetry in Heqn; revert s s' Heqn H. induction n; intros. @@ -794,8 +794,8 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). apply fold_diff_inter with (eqA:=@Logic.eq nat); auto. Qed. - Lemma union_cardinal: - forall s s', (forall x, ~(In x s/\In x s')) -> + Lemma union_cardinal: + forall s s', (forall x, ~(In x s/\In x s')) -> cardinal (union s s')=cardinal s+cardinal s'. Proof. intros; do 3 rewrite cardinal_fold. @@ -803,7 +803,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). apply fold_union; auto. Qed. - Lemma subset_cardinal : + Lemma subset_cardinal : forall s s', s[<=]s' -> cardinal s <= cardinal s' . Proof. intros. @@ -812,9 +812,9 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). rewrite (inter_subset_equal H); auto with arith. Qed. - Lemma subset_cardinal_lt : + Lemma subset_cardinal_lt : forall s s' x, s[<=]s' -> In x s' -> ~In x s -> cardinal s < cardinal s'. - Proof. + Proof. intros. rewrite <- (diff_inter_cardinal s' s). rewrite (inter_sym s' s). @@ -826,7 +826,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). intros _. change (0 + cardinal s < S n + cardinal s). apply Plus.plus_lt_le_compat; auto with arith. - Qed. + Qed. Theorem union_inter_cardinal : forall s s', cardinal (union s s') + cardinal (inter s s') = cardinal s + cardinal s' . @@ -837,7 +837,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). apply fold_union_inter with (eqA:=@Logic.eq nat); auto. Qed. - Lemma union_cardinal_inter : + Lemma union_cardinal_inter : forall s s', cardinal (union s s') = cardinal s + cardinal s' - cardinal (inter s s'). Proof. intros. @@ -846,17 +846,17 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). auto with arith. Qed. - Lemma union_cardinal_le : + Lemma union_cardinal_le : forall s s', cardinal (union s s') <= cardinal s + cardinal s'. Proof. intros; generalize (union_inter_cardinal s s'). intros; rewrite <- H; auto with arith. Qed. - Lemma add_cardinal_1 : + Lemma add_cardinal_1 : forall s x, In x s -> cardinal (add x s) = cardinal s. Proof. - auto with set. + auto with set. Qed. Lemma add_cardinal_2 : @@ -877,9 +877,9 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). apply remove_fold_1 with (eqA:=@Logic.eq nat); auto. Qed. - Lemma remove_cardinal_2 : + Lemma remove_cardinal_2 : forall s x, ~In x s -> cardinal (remove x s) = cardinal s. - Proof. + Proof. auto with set. Qed. @@ -950,7 +950,7 @@ Module OrdProperties (M:S). Qed. Hint Resolve gtb_compat leb_compat. - Lemma elements_split : forall x s, + Lemma elements_split : forall x s, elements s = elements_lt x s ++ elements_ge x s. Proof. unfold elements_lt, elements_ge, leb; intros. @@ -964,8 +964,8 @@ Module OrdProperties (M:S). ME.order. Qed. - Lemma elements_Add : forall s s' x, ~In x s -> Add x s s' -> - eqlistA E.eq (elements s') (elements_lt x s ++ x :: elements_ge x s). + Lemma elements_Add : forall s s' x, ~In x s -> Add x s s' -> + eqlistA E.eq (elements s') (elements_lt x s ++ x :: elements_ge x s). Proof. intros; unfold elements_ge, elements_lt. apply sort_equivlistA_eqlistA; auto with set. @@ -1003,8 +1003,8 @@ Module OrdProperties (M:S). Definition Above x s := forall y, In y s -> E.lt y x. Definition Below x s := forall y, In y s -> E.lt x y. - Lemma elements_Add_Above : forall s s' x, - Above x s -> Add x s s' -> + Lemma elements_Add_Above : forall s s' x, + Above x s -> Add x s s' -> eqlistA E.eq (elements s') (elements s ++ x::nil). Proof. intros. @@ -1020,8 +1020,8 @@ Module OrdProperties (M:S). do 2 rewrite <- elements_iff; rewrite (H0 a); intuition. Qed. - Lemma elements_Add_Below : forall s s' x, - Below x s -> Add x s s' -> + Lemma elements_Add_Below : forall s s' x, + Below x s -> Add x s s' -> eqlistA E.eq (elements s') (x::elements s). Proof. intros. @@ -1038,7 +1038,7 @@ Module OrdProperties (M:S). do 2 rewrite <- elements_iff; rewrite (H0 a); intuition. Qed. - (** Two other induction principles on sets: we can be more restrictive + (** Two other induction principles on sets: we can be more restrictive on the element we add at each step. *) Lemma set_induction_max : @@ -1119,15 +1119,15 @@ Module OrdProperties (M:S). apply elements_Add_Below; auto. Qed. - (** The following results have already been proved earlier, + (** The following results have already been proved earlier, but we can now prove them with one hypothesis less: no need for [(transpose eqA f)]. *) - Section FoldOpt. + Section FoldOpt. Variables (A:Type)(eqA:A->A->Prop)(st:Equivalence eqA). Variables (f:elt->A->A)(Comp:compat_op E.eq eqA f). - Lemma fold_equal : + Lemma fold_equal : forall i s s', s[=]s' -> eqA (fold f s i) (fold f s' i). Proof. intros; do 2 rewrite M.fold_1. @@ -1138,13 +1138,13 @@ Module OrdProperties (M:S). red; intro a; do 2 rewrite <- elements_iff; auto. Qed. - Lemma add_fold : forall i s x, In x s -> + Lemma add_fold : forall i s x, In x s -> eqA (fold f (add x s) i) (fold f s i). Proof. intros; apply fold_equal; auto with set. Qed. - Lemma remove_fold_2: forall i s x, ~In x s -> + Lemma remove_fold_2: forall i s x, ~In x s -> eqA (fold f (remove x s) i) (fold f s i). Proof. intros. @@ -1155,16 +1155,16 @@ Module OrdProperties (M:S). (** An alternative version of [choose_3] *) - Lemma choose_equal : forall s s', Equal s s' -> - match choose s, choose s' with + Lemma choose_equal : forall s s', Equal s s' -> + match choose s, choose s' with | Some x, Some x' => E.eq x x' | None, None => True | _, _ => False end. Proof. - intros s s' H; + intros s s' H; generalize (@choose_1 s)(@choose_2 s) - (@choose_1 s')(@choose_2 s')(@choose_3 s s'); + (@choose_1 s')(@choose_2 s')(@choose_3 s s'); destruct (choose s); destruct (choose s'); simpl; intuition. apply H5 with e; rewrite <-H; auto. apply H5 with e; rewrite H; auto. diff --git a/theories/FSets/FSetToFiniteSet.v b/theories/FSets/FSetToFiniteSet.v index 7938beda7..23420109c 100644 --- a/theories/FSets/FSetToFiniteSet.v +++ b/theories/FSets/FSetToFiniteSet.v @@ -6,8 +6,8 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* Finite sets library. - * Authors: Pierre Letouzey and Jean-Christophe Filliâtre +(* Finite sets library. + * Authors: Pierre Letouzey and Jean-Christophe Filliâtre * Institution: LRI, CNRS UMR 8623 - Université Paris Sud * 91405 Orsay, France *) @@ -16,14 +16,14 @@ Require Import Ensembles Finite_sets. Require Import FSetInterface FSetProperties OrderedTypeEx DecidableTypeEx. -(** * Going from [FSets] with usual Leibniz equality +(** * Going from [FSets] with usual Leibniz equality to the good old [Ensembles] and [Finite_sets] theory. *) Module WS_to_Finite_set (U:UsualDecidableType)(M: WSfun U). Module MP:= WProperties_fun U M. Import M MP FM Ensembles Finite_sets. - Definition mkEns : M.t -> Ensemble M.elt := + Definition mkEns : M.t -> Ensemble M.elt := fun s x => M.In x s. Notation " !! " := mkEns. @@ -115,11 +115,11 @@ Module WS_to_Finite_set (U:UsualDecidableType)(M: WSfun U). Proof. intro s; pattern s; apply set_induction; clear s; intros. intros; replace (!!s) with (Empty_set elt); auto with sets. - symmetry; apply Extensionality_Ensembles. + symmetry; apply Extensionality_Ensembles. apply Empty_Empty_set; auto. replace (!!s') with (Add _ (!!s) x). constructor 2; auto. - symmetry; apply Extensionality_Ensembles. + symmetry; apply Extensionality_Ensembles. apply Add_Add; auto. Qed. @@ -128,18 +128,18 @@ Module WS_to_Finite_set (U:UsualDecidableType)(M: WSfun U). intro s; pattern s; apply set_induction; clear s; intros. intros; replace (!!s) with (Empty_set elt); auto with sets. rewrite cardinal_1; auto with sets. - symmetry; apply Extensionality_Ensembles. + symmetry; apply Extensionality_Ensembles. apply Empty_Empty_set; auto. replace (!!s') with (Add _ (!!s) x). - rewrite (cardinal_2 H0 H1); auto with sets. - symmetry; apply Extensionality_Ensembles. + rewrite (cardinal_2 H0 H1); auto with sets. + symmetry; apply Extensionality_Ensembles. apply Add_Add; auto. Qed. - (** we can even build a function from Finite Ensemble to FSet + (** we can even build a function from Finite Ensemble to FSet ... at least in Prop. *) - Lemma Ens_to_FSet : forall e : Ensemble M.elt, Finite _ e -> + Lemma Ens_to_FSet : forall e : Ensemble M.elt, Finite _ e -> exists s:M.t, !!s === e. Proof. induction 1. @@ -147,7 +147,7 @@ Module WS_to_Finite_set (U:UsualDecidableType)(M: WSfun U). apply empty_Empty_Set. destruct IHFinite as (s,Hs). exists (M.add x s). - apply Extensionality_Ensembles in Hs. + apply Extensionality_Ensembles in Hs. rewrite <- Hs. apply add_Add. Qed. diff --git a/theories/FSets/FSetWeakList.v b/theories/FSets/FSetWeakList.v index d03e3bdc8..7a3e60d38 100644 --- a/theories/FSets/FSetWeakList.v +++ b/theories/FSets/FSetWeakList.v @@ -10,7 +10,7 @@ (** * Finite sets library *) -(** This file proposes an implementation of the non-dependant +(** This file proposes an implementation of the non-dependant interface [FSetWeakInterface.S] using lists without redundancy. *) Require Import FSetInterface. @@ -20,7 +20,7 @@ Unset Strict Implicit. (** * Functions over lists First, we provide sets as lists which are (morally) without redundancy. - The specs are proved under the additional condition of no redundancy. + The specs are proved under the additional condition of no redundancy. And the functions returning sets are proved to preserve this invariant. *) Module Raw (X: DecidableType). @@ -48,7 +48,7 @@ Module Raw (X: DecidableType). if X.eq_dec x y then s else y :: add x l end. - Definition singleton (x : elt) : t := x :: nil. + Definition singleton (x : elt) : t := x :: nil. Fixpoint remove (x : elt) (s : t) {struct s} : t := match s with @@ -57,42 +57,42 @@ Module Raw (X: DecidableType). if X.eq_dec x y then l else y :: remove x l end. - Fixpoint fold (B : Type) (f : elt -> B -> B) (s : t) {struct s} : + Fixpoint fold (B : Type) (f : elt -> B -> B) (s : t) {struct s} : B -> B := fun i => match s with | nil => i | x :: l => fold f l (f x i) - end. + end. Definition union (s : t) : t -> t := fold add s. - + Definition diff (s s' : t) : t := fold remove s' s. - Definition inter (s s': t) : t := + Definition inter (s s': t) : t := fold (fun x s => if mem x s' then add x s else s) s nil. Definition subset (s s' : t) : bool := is_empty (diff s s'). - Definition equal (s s' : t) : bool := andb (subset s s') (subset s' s). + Definition equal (s s' : t) : bool := andb (subset s s') (subset s' s). Fixpoint filter (f : elt -> bool) (s : t) {struct s} : t := match s with | nil => nil | x :: l => if f x then x :: filter f l else filter f l - end. + end. Fixpoint for_all (f : elt -> bool) (s : t) {struct s} : bool := match s with | nil => true | x :: l => if f x then for_all f l else false - end. - + end. + Fixpoint exists_ (f : elt -> bool) (s : t) {struct s} : bool := match s with | nil => false | x :: l => if f x then true else exists_ f l end. - Fixpoint partition (f : elt -> bool) (s : t) {struct s} : + Fixpoint partition (f : elt -> bool) (s : t) {struct s} : t * t := match s with | nil => (nil, nil) @@ -105,14 +105,14 @@ Module Raw (X: DecidableType). Definition elements (s : t) : list elt := s. - Definition choose (s : t) : option elt := - match s with + Definition choose (s : t) : option elt := + match s with | nil => None | x::_ => Some x end. (** ** Proofs of set operation specifications. *) - Section ForNotations. + Section ForNotations. Notation NoDup := (NoDupA X.eq). Notation In := (InA X.eq). @@ -130,7 +130,7 @@ Module Raw (X: DecidableType). Hint Immediate In_eq. Lemma mem_1 : - forall (s : t)(x : elt), In x s -> mem x s = true. + forall (s : t)(x : elt), In x s -> mem x s = true. Proof. induction s; intros. inversion H. @@ -140,7 +140,7 @@ Module Raw (X: DecidableType). Lemma mem_2 : forall (s : t) (x : elt), mem x s = true -> In x s. Proof. - induction s. + induction s. intros; inversion H. intros x; simpl. destruct (X.eq_dec x a); firstorder; discriminate. @@ -149,7 +149,7 @@ Module Raw (X: DecidableType). Lemma add_1 : forall (s : t) (Hs : NoDup s) (x y : elt), X.eq x y -> In y (add x s). Proof. - induction s. + induction s. simpl; intuition. simpl; intros; case (X.eq_dec x a); intuition; inversion_clear Hs; firstorder. @@ -159,7 +159,7 @@ Module Raw (X: DecidableType). Lemma add_2 : forall (s : t) (Hs : NoDup s) (x y : elt), In y s -> In y (add x s). Proof. - induction s. + induction s. simpl; intuition. simpl; intros; case (X.eq_dec x a); intuition. inversion_clear Hs; eauto; inversion_clear H; intuition. @@ -169,18 +169,18 @@ Module Raw (X: DecidableType). forall (s : t) (Hs : NoDup s) (x y : elt), ~ X.eq x y -> In y (add x s) -> In y s. Proof. - induction s. + induction s. simpl; intuition. inversion_clear H0; firstorder; absurd (X.eq x y); auto. simpl; intros Hs x y; case (X.eq_dec x a); intros; - inversion_clear H0; inversion_clear Hs; firstorder; + inversion_clear H0; inversion_clear Hs; firstorder; absurd (X.eq x y); auto. Qed. Lemma add_unique : forall (s : t) (Hs : NoDup s)(x:elt), NoDup (add x s). Proof. - induction s. + induction s. simpl; intuition. constructor; auto. intro H0; inversion H0. @@ -197,9 +197,9 @@ Module Raw (X: DecidableType). Lemma remove_1 : forall (s : t) (Hs : NoDup s) (x y : elt), X.eq x y -> ~ In y (remove x s). Proof. - simple induction s. + simple induction s. simpl; red; intros; inversion H0. - simpl; intros; case (X.eq_dec x a); intuition; inversion_clear Hs. + simpl; intros; case (X.eq_dec x a); intuition; inversion_clear Hs. elim H2. apply In_eq with y; eauto. inversion_clear H1; eauto. @@ -209,17 +209,17 @@ Module Raw (X: DecidableType). forall (s : t) (Hs : NoDup s) (x y : elt), ~ X.eq x y -> In y s -> In y (remove x s). Proof. - simple induction s. + simple induction s. simpl; intuition. simpl; intros; case (X.eq_dec x a); intuition; inversion_clear Hs; - inversion_clear H1; auto. - absurd (X.eq x y); eauto. + inversion_clear H1; auto. + absurd (X.eq x y); eauto. Qed. Lemma remove_3 : forall (s : t) (Hs : NoDup s) (x y : elt), In y (remove x s) -> In y s. Proof. - simple induction s. + simple induction s. simpl; intuition. simpl; intros a l Hrec Hs x y; case (X.eq_dec x a); intuition. inversion_clear Hs; inversion_clear H; firstorder. @@ -235,7 +235,7 @@ Module Raw (X: DecidableType). constructor; auto. intro H2; elim H0. eapply remove_3; eauto. - Qed. + Qed. Lemma singleton_unique : forall x : elt, NoDup (singleton x). Proof. @@ -246,13 +246,13 @@ Module Raw (X: DecidableType). Proof. unfold singleton; simpl; intuition. inversion_clear H; auto; inversion H0. - Qed. + Qed. Lemma singleton_2 : forall x y : elt, X.eq x y -> In y (singleton x). Proof. unfold singleton; simpl; intuition. - Qed. - + Qed. + Lemma empty_unique : NoDup empty. Proof. unfold empty; constructor. @@ -261,15 +261,15 @@ Module Raw (X: DecidableType). Lemma empty_1 : Empty empty. Proof. unfold Empty, empty; intuition; inversion H. - Qed. + Qed. Lemma is_empty_1 : forall s : t, Empty s -> is_empty s = true. Proof. unfold Empty; intro s; case s; simpl; intuition. elim (H e); auto. Qed. - - Lemma is_empty_2 : forall s : t, is_empty s = true -> Empty s. + + Lemma is_empty_2 : forall s : t, is_empty s = true -> Empty s. Proof. unfold Empty; intro s; case s; simpl; intuition; inversion H0. @@ -281,12 +281,12 @@ Module Raw (X: DecidableType). Qed. Lemma elements_2 : forall (s : t) (x : elt), In x (elements s) -> In x s. - Proof. + Proof. unfold elements; auto. Qed. - - Lemma elements_3w : forall (s : t) (Hs : NoDup s), NoDup (elements s). - Proof. + + Lemma elements_3w : forall (s : t) (Hs : NoDup s), NoDup (elements s). + Proof. unfold elements; auto. Qed. @@ -306,7 +306,7 @@ Module Raw (X: DecidableType). apply IHs; auto. apply add_unique; auto. Qed. - + Lemma union_1 : forall (s s' : t) (Hs : NoDup s) (Hs' : NoDup s') (x : elt), In x (union s s') -> In x s \/ In x s'. @@ -319,7 +319,7 @@ Module Raw (X: DecidableType). right; eapply add_3; eauto. Qed. - Lemma union_0 : + Lemma union_0 : forall (s s' : t) (Hs : NoDup s) (Hs' : NoDup s') (x : elt), In x s \/ In x s' -> In x (union s s'). Proof. @@ -355,14 +355,14 @@ Module Raw (X: DecidableType). unfold inter; intros s. set (acc := nil (A:=elt)). assert (NoDup acc) by (unfold acc; auto). - clearbody acc; generalize H; clear H; generalize acc; clear acc. + clearbody acc; generalize H; clear H; generalize acc; clear acc. induction s; simpl; auto; intros. inversion_clear Hs. apply IHs; auto. destruct (mem a s'); intros; auto. apply add_unique; auto. - Qed. - + Qed. + Lemma inter_0 : forall (s s' : t) (Hs : NoDup s) (Hs' : NoDup s') (x : elt), In x (inter s s') -> In x s /\ In x s'. @@ -373,7 +373,7 @@ Module Raw (X: DecidableType). cut ((In x s /\ In x s') \/ In x acc). destruct 1; auto. inversion H1. - clearbody acc. + clearbody acc. generalize H0 H Hs' Hs; clear H0 H Hs Hs'. generalize acc x s'; clear acc x s'. induction s; simpl; auto; intros. @@ -414,7 +414,7 @@ Module Raw (X: DecidableType). unfold inter. set (acc := nil (A:=elt)) in *. assert (NoDup acc) by (unfold acc; auto). - clearbody acc. + clearbody acc. generalize H Hs' Hs; clear H Hs Hs'. generalize acc x s'; clear acc x s'. induction s; simpl; auto; intros. @@ -446,8 +446,8 @@ Module Raw (X: DecidableType). inversion_clear Hs'. apply IHs'; auto. apply remove_unique; auto. - Qed. - + Qed. + Lemma diff_0 : forall (s s' : t) (Hs : NoDup s) (Hs' : NoDup s') (x : elt), In x (diff s s') -> In x s /\ ~ In x s'. @@ -458,7 +458,7 @@ Module Raw (X: DecidableType). split; auto; intro H1; inversion H1. inversion_clear Hs'. destruct (IHs' (remove a s) (remove_unique Hs a) H1 x H). - split. + split. eapply remove_3; eauto. red; intros. inversion_clear H4; auto. @@ -469,14 +469,14 @@ Module Raw (X: DecidableType). forall (s s' : t) (Hs : NoDup s) (Hs' : NoDup s') (x : elt), In x (diff s s') -> In x s. Proof. - intros; cut (In x s /\ ~ In x s'); [ intuition | apply diff_0; auto]. + intros; cut (In x s /\ ~ In x s'); [ intuition | apply diff_0; auto]. Qed. Lemma diff_2 : forall (s s' : t) (Hs : NoDup s) (Hs' : NoDup s') (x : elt), In x (diff s s') -> ~ In x s'. Proof. - intros; cut (In x s /\ ~ In x s'); [ intuition | apply diff_0; auto]. + intros; cut (In x s /\ ~ In x s'); [ intuition | apply diff_0; auto]. Qed. Lemma diff_3 : @@ -489,8 +489,8 @@ Module Raw (X: DecidableType). apply IHs'; auto. apply remove_unique; auto. apply remove_2; auto. - Qed. - + Qed. + Lemma subset_1 : forall (s s' : t) (Hs : NoDup s) (Hs' : NoDup s'), Subset s s' -> subset s s' = true. @@ -504,7 +504,7 @@ Module Raw (X: DecidableType). eapply diff_1; eauto. Qed. - Lemma subset_2 : forall (s s' : t)(Hs : NoDup s) (Hs' : NoDup s'), + Lemma subset_2 : forall (s s' : t)(Hs : NoDup s) (Hs' : NoDup s'), subset s s' = true -> Subset s s'. Proof. unfold subset, Subset; intros. @@ -524,26 +524,26 @@ Module Raw (X: DecidableType). apply andb_true_intro; split; apply subset_1; firstorder. Qed. - Lemma equal_2 : forall (s s' : t)(Hs : NoDup s) (Hs' : NoDup s'), + Lemma equal_2 : forall (s s' : t)(Hs : NoDup s) (Hs' : NoDup s'), equal s s' = true -> Equal s s'. Proof. unfold Equal, equal; intros. destruct (andb_prop _ _ H); clear H. split; apply subset_2; auto. - Qed. + Qed. Definition choose_1 : forall (s : t) (x : elt), choose s = Some x -> In x s. Proof. destruct s; simpl; intros; inversion H; auto. - Qed. + Qed. Definition choose_2 : forall s : t, choose s = None -> Empty s. Proof. destruct s; simpl; intros. intros x H0; inversion H0. inversion H. - Qed. + Qed. Lemma cardinal_1 : forall (s : t) (Hs : NoDup s), cardinal s = length (elements s). @@ -567,7 +567,7 @@ Module Raw (X: DecidableType). Lemma filter_2 : forall (s : t) (x : elt) (f : elt -> bool), - compat_bool X.eq f -> In x (filter f s) -> f x = true. + compat_bool X.eq f -> In x (filter f s) -> f x = true. Proof. simple induction s; simpl. intros; inversion H0. @@ -576,10 +576,10 @@ Module Raw (X: DecidableType). inversion_clear 2; auto. symmetry; auto. Qed. - + Lemma filter_3 : forall (s : t) (x : elt) (f : elt -> bool), - compat_bool X.eq f -> In x s -> f x = true -> In x (filter f s). + compat_bool X.eq f -> In x s -> f x = true -> In x (filter f s). Proof. simple induction s; simpl. intros; inversion H0. @@ -607,9 +607,9 @@ Module Raw (X: DecidableType). forall (s : t) (f : elt -> bool), compat_bool X.eq f -> For_all (fun x => f x = true) s -> for_all f s = true. - Proof. + Proof. simple induction s; simpl; auto; unfold For_all. - intros x l Hrec f Hf. + intros x l Hrec f Hf. generalize (Hf x); case (f x); simpl. auto. intros; rewrite (H x); auto. @@ -619,11 +619,11 @@ Module Raw (X: DecidableType). forall (s : t) (f : elt -> bool), compat_bool X.eq f -> for_all f s = true -> For_all (fun x => f x = true) s. - Proof. + Proof. simple induction s; simpl; auto; unfold For_all. intros; inversion H1. - intros x l Hrec f Hf. - intros A a; intros. + intros x l Hrec f Hf. + intros A a; intros. assert (f x = true). generalize A; case (f x); auto. rewrite H0 in A; simpl in A. @@ -637,9 +637,9 @@ Module Raw (X: DecidableType). Proof. simple induction s; simpl; auto; unfold Exists. intros. - elim H0; intuition. + elim H0; intuition. inversion H2. - intros x l Hrec f Hf. + intros x l Hrec f Hf. generalize (Hf x); case (f x); simpl. auto. destruct 2 as [a (A1,A2)]. @@ -652,7 +652,7 @@ Module Raw (X: DecidableType). Lemma exists_2 : forall (s : t) (f : elt -> bool), compat_bool X.eq f -> exists_ f s = true -> Exists (fun x => f x = true) s. - Proof. + Proof. simple induction s; simpl; auto; unfold Exists. intros; discriminate. intros x l Hrec f Hf. @@ -671,9 +671,9 @@ Module Raw (X: DecidableType). intros x l Hrec f Hf. generalize (Hrec f Hf); clear Hrec. case (partition f l); intros s1 s2; simpl; intros. - case (f x); simpl; firstorder; inversion H0; intros; firstorder. + case (f x); simpl; firstorder; inversion H0; intros; firstorder. Qed. - + Lemma partition_2 : forall (s : t) (f : elt -> bool), compat_bool X.eq f -> @@ -681,14 +681,14 @@ Module Raw (X: DecidableType). Proof. simple induction s; simpl; auto; unfold Equal. firstorder. - intros x l Hrec f Hf. + intros x l Hrec f Hf. generalize (Hrec f Hf); clear Hrec. case (partition f l); intros s1 s2; simpl; intros. - case (f x); simpl; firstorder; inversion H0; intros; firstorder. + case (f x); simpl; firstorder; inversion H0; intros; firstorder. Qed. - Lemma partition_aux_1 : - forall (s : t) (Hs : NoDup s) (f : elt -> bool)(x:elt), + Lemma partition_aux_1 : + forall (s : t) (Hs : NoDup s) (f : elt -> bool)(x:elt), In x (fst (partition f s)) -> In x s. Proof. induction s; simpl; auto; intros. @@ -696,10 +696,10 @@ Module Raw (X: DecidableType). generalize (IHs H1 f x). destruct (f a); destruct (partition f s); simpl in *; auto. inversion_clear H; auto. - Qed. - - Lemma partition_aux_2 : - forall (s : t) (Hs : NoDup s) (f : elt -> bool)(x:elt), + Qed. + + Lemma partition_aux_2 : + forall (s : t) (Hs : NoDup s) (f : elt -> bool)(x:elt), In x (snd (partition f s)) -> In x s. Proof. induction s; simpl; auto; intros. @@ -707,8 +707,8 @@ Module Raw (X: DecidableType). generalize (IHs H1 f x). destruct (f a); destruct (partition f s); simpl in *; auto. inversion_clear H; auto. - Qed. - + Qed. + Lemma partition_unique_1 : forall (s : t) (Hs : NoDup s) (f : elt -> bool), NoDup (fst (partition f s)). Proof. @@ -719,7 +719,7 @@ Module Raw (X: DecidableType). generalize (Hrec H0 f). case (f x); case (partition f l); simpl; auto. Qed. - + Lemma partition_unique_2 : forall (s : t) (Hs : NoDup s) (f : elt -> bool), NoDup (snd (partition f s)). Proof. @@ -733,17 +733,17 @@ Module Raw (X: DecidableType). Definition eq : t -> t -> Prop := Equal. - Lemma eq_refl : forall s, eq s s. + Lemma eq_refl : forall s, eq s s. Proof. firstorder. Qed. Lemma eq_sym : forall s s', eq s s' -> eq s' s. Proof. firstorder. Qed. - Lemma eq_trans : + Lemma eq_trans : forall s s' s'', eq s s' -> eq s' s'' -> eq s s''. Proof. firstorder. Qed. - Definition eq_dec : forall (s s':t)(Hs:NoDup s)(Hs':NoDup s'), + Definition eq_dec : forall (s s':t)(Hs:NoDup s)(Hs':NoDup s'), { eq s s' }+{ ~eq s s' }. Proof. intros. @@ -758,18 +758,18 @@ End Raw. (** * Encapsulation - Now, in order to really provide a functor implementing [S], we + Now, in order to really provide a functor implementing [S], we need to encapsulate everything into a type of lists without redundancy. *) Module Make (X: DecidableType) <: WS with Module E := X. - Module Raw := Raw X. + Module Raw := Raw X. Module E := X. Record slist := {this :> Raw.t; unique : NoDupA E.eq this}. - Definition t := slist. + Definition t := slist. Definition elt := E.t. - + Definition In (x : elt) (s : t) : Prop := InA E.eq x s.(this). Definition Equal (s s':t) : Prop := forall a : elt, In a s <-> In a s'. Definition Subset (s s':t) : Prop := forall a : elt, In a s -> In a s'. @@ -783,18 +783,18 @@ Module Make (X: DecidableType) <: WS with Module E := X. Definition remove (x : elt)(s : t) : t := Build_slist (Raw.remove_unique (unique s) x). Definition singleton (x : elt) : t := Build_slist (Raw.singleton_unique x). Definition union (s s' : t) : t := - Build_slist (Raw.union_unique (unique s) (unique s')). + Build_slist (Raw.union_unique (unique s) (unique s')). Definition inter (s s' : t) : t := - Build_slist (Raw.inter_unique (unique s) (unique s')). + Build_slist (Raw.inter_unique (unique s) (unique s')). Definition diff (s s' : t) : t := - Build_slist (Raw.diff_unique (unique s) (unique s')). - Definition equal (s s' : t) : bool := Raw.equal s s'. + Build_slist (Raw.diff_unique (unique s) (unique s')). + Definition equal (s s' : t) : bool := Raw.equal s s'. Definition subset (s s' : t) : bool := Raw.subset s s'. Definition empty : t := Build_slist Raw.empty_unique. Definition is_empty (s : t) : bool := Raw.is_empty s. Definition elements (s : t) : list elt := Raw.elements s. Definition choose (s:t) : option elt := Raw.choose s. - Definition fold (B : Type) (f : elt -> B -> B) (s : t) : B -> B := Raw.fold (B:=B) f s. + Definition fold (B : Type) (f : elt -> B -> B) (s : t) : B -> B := Raw.fold (B:=B) f s. Definition cardinal (s : t) : nat := Raw.cardinal s. Definition filter (f : elt -> bool) (s : t) : t := Build_slist (Raw.filter_unique (unique s) f). @@ -805,18 +805,18 @@ Module Make (X: DecidableType) <: WS with Module E := X. (Build_slist (this:=fst p) (Raw.partition_unique_1 (unique s) f), Build_slist (this:=snd p) (Raw.partition_unique_2 (unique s) f)). - Section Spec. + Section Spec. Variable s s' : t. Variable x y : elt. - Lemma In_1 : E.eq x y -> In x s -> In y s. + Lemma In_1 : E.eq x y -> In x s -> In y s. Proof. exact (fun H H' => Raw.In_eq H H'). Qed. - + Lemma mem_1 : In x s -> mem x s = true. Proof. exact (fun H => Raw.mem_1 H). Qed. - Lemma mem_2 : mem x s = true -> In x s. + Lemma mem_2 : mem x s = true -> In x s. Proof. exact (fun H => Raw.mem_2 H). Qed. - + Lemma equal_1 : Equal s s' -> equal s s' = true. Proof. exact (Raw.equal_1 s.(unique) s'.(unique)). Qed. Lemma equal_2 : equal s s' = true -> Equal s s'. @@ -830,16 +830,16 @@ Module Make (X: DecidableType) <: WS with Module E := X. Lemma empty_1 : Empty empty. Proof. exact Raw.empty_1. Qed. - Lemma is_empty_1 : Empty s -> is_empty s = true. + Lemma is_empty_1 : Empty s -> is_empty s = true. Proof. exact (fun H => Raw.is_empty_1 H). Qed. Lemma is_empty_2 : is_empty s = true -> Empty s. Proof. exact (fun H => Raw.is_empty_2 H). Qed. - + Lemma add_1 : E.eq x y -> In y (add x s). Proof. exact (fun H => Raw.add_1 s.(unique) H). Qed. Lemma add_2 : In y s -> In y (add x s). Proof. exact (fun H => Raw.add_2 s.(unique) x H). Qed. - Lemma add_3 : ~ E.eq x y -> In y (add x s) -> In y s. + Lemma add_3 : ~ E.eq x y -> In y (add x s) -> In y s. Proof. exact (fun H => Raw.add_3 s.(unique) H). Qed. Lemma remove_1 : E.eq x y -> ~ In y (remove x s). @@ -849,14 +849,14 @@ Module Make (X: DecidableType) <: WS with Module E := X. Lemma remove_3 : In y (remove x s) -> In y s. Proof. exact (fun H => Raw.remove_3 s.(unique) H). Qed. - Lemma singleton_1 : In y (singleton x) -> E.eq x y. + Lemma singleton_1 : In y (singleton x) -> E.eq x y. Proof. exact (fun H => Raw.singleton_1 H). Qed. - Lemma singleton_2 : E.eq x y -> In y (singleton x). + Lemma singleton_2 : E.eq x y -> In y (singleton x). Proof. exact (fun H => Raw.singleton_2 H). Qed. Lemma union_1 : In x (union s s') -> In x s \/ In x s'. Proof. exact (fun H => Raw.union_1 s.(unique) s'.(unique) H). Qed. - Lemma union_2 : In x s -> In x (union s s'). + Lemma union_2 : In x s -> In x (union s s'). Proof. exact (fun H => Raw.union_2 s.(unique) s'.(unique) H). Qed. Lemma union_3 : In x s' -> In x (union s s'). Proof. exact (fun H => Raw.union_3 s.(unique) s'.(unique) H). Qed. @@ -868,13 +868,13 @@ Module Make (X: DecidableType) <: WS with Module E := X. Lemma inter_3 : In x s -> In x s' -> In x (inter s s'). Proof. exact (fun H => Raw.inter_3 s.(unique) s'.(unique) H). Qed. - Lemma diff_1 : In x (diff s s') -> In x s. + Lemma diff_1 : In x (diff s s') -> In x s. Proof. exact (fun H => Raw.diff_1 s.(unique) s'.(unique) H). Qed. Lemma diff_2 : In x (diff s s') -> ~ In x s'. Proof. exact (fun H => Raw.diff_2 s.(unique) s'.(unique) H). Qed. Lemma diff_3 : In x s -> ~ In x s' -> In x (diff s s'). Proof. exact (fun H => Raw.diff_3 s.(unique) s'.(unique) H). Qed. - + Lemma fold_1 : forall (A : Type) (i : A) (f : elt -> A -> A), fold f s i = fold_left (fun a e => f e a) (elements s) i. Proof. exact (Raw.fold_1 s.(unique)). Qed. @@ -883,12 +883,12 @@ Module Make (X: DecidableType) <: WS with Module E := X. Proof. exact (Raw.cardinal_1 s.(unique)). Qed. Section Filter. - + Variable f : elt -> bool. - Lemma filter_1 : compat_bool E.eq f -> In x (filter f s) -> In x s. + Lemma filter_1 : compat_bool E.eq f -> In x (filter f s) -> In x s. Proof. exact (fun H => @Raw.filter_1 s x f). Qed. - Lemma filter_2 : compat_bool E.eq f -> In x (filter f s) -> f x = true. + Lemma filter_2 : compat_bool E.eq f -> In x (filter f s) -> f x = true. Proof. exact (@Raw.filter_2 s x f). Qed. Lemma filter_3 : compat_bool E.eq f -> In x s -> f x = true -> In x (filter f s). @@ -938,20 +938,20 @@ Module Make (X: DecidableType) <: WS with Module E := X. Definition eq : t -> t -> Prop := Equal. - Lemma eq_refl : forall s, eq s s. + Lemma eq_refl : forall s, eq s s. Proof. firstorder. Qed. Lemma eq_sym : forall s s', eq s s' -> eq s' s. Proof. firstorder. Qed. - Lemma eq_trans : + Lemma eq_trans : forall s s' s'', eq s s' -> eq s' s'' -> eq s s''. Proof. firstorder. Qed. - Definition eq_dec : forall (s s':t), + Definition eq_dec : forall (s s':t), { eq s s' }+{ ~eq s s' }. - Proof. - intros s s'; exact (Raw.eq_dec s.(unique) s'.(unique)). + Proof. + intros s s'; exact (Raw.eq_dec s.(unique) s'.(unique)). Defined. End Make. diff --git a/theories/FSets/OrderedType.v b/theories/FSets/OrderedType.v index 8c4c6818a..4e5d39faf 100644 --- a/theories/FSets/OrderedType.v +++ b/theories/FSets/OrderedType.v @@ -69,22 +69,22 @@ Module OrderedTypeFacts (Import O: OrderedType). Lemma lt_antirefl : forall x, ~ lt x x. Proof. - intros; intro; absurd (eq x x); auto. + intros; intro; absurd (eq x x); auto. Qed. Lemma lt_eq : forall x y z, lt x y -> eq y z -> lt x z. - Proof. + Proof. intros; destruct (compare x z); auto. elim (lt_not_eq H); apply eq_trans with z; auto. elim (lt_not_eq (lt_trans l H)); auto. - Qed. + Qed. - Lemma eq_lt : forall x y z, eq x y -> lt y z -> lt x z. + Lemma eq_lt : forall x y z, eq x y -> lt y z -> lt x z. Proof. intros; destruct (compare x z); auto. elim (lt_not_eq H0); apply eq_trans with x; auto. elim (lt_not_eq (lt_trans H0 l)); auto. - Qed. + Qed. Lemma le_eq : forall x y z, ~lt x y -> eq y z -> ~lt x z. Proof. @@ -125,23 +125,23 @@ Module OrderedTypeFacts (Import O: OrderedType). Qed. Lemma le_neq : forall x y, ~lt x y -> ~eq x y -> lt y x. - Proof. + Proof. intros; destruct (compare x y); intuition. Qed. Lemma neq_sym : forall x y, ~eq x y -> ~eq y x. - Proof. + Proof. intuition. Qed. -(* TODO concernant la tactique order: +(* TODO concernant la tactique order: * propagate_lt n'est sans doute pas complet * un propagate_le * exploiter les hypotheses negatives restant a la fin * faire que ca marche meme quand une hypothese depend d'un eq ou lt. -*) +*) -Ltac abstraction := match goal with +Ltac abstraction := match goal with (* First, some obvious simplifications *) | H : False |- _ => elim H | H : lt ?x ?x |- _ => elim (lt_antirefl H) @@ -151,43 +151,43 @@ Ltac abstraction := match goal with | |- eq ?x ?x => exact (eq_refl x) | |- lt ?x ?x => elimtype False; abstraction | |- ~ _ => intro; abstraction - | H1: ~lt ?x ?y, H2: ~eq ?x ?y |- _ => + | H1: ~lt ?x ?y, H2: ~eq ?x ?y |- _ => generalize (le_neq H1 H2); clear H1 H2; intro; abstraction - | H1: ~lt ?x ?y, H2: ~eq ?y ?x |- _ => + | H1: ~lt ?x ?y, H2: ~eq ?y ?x |- _ => generalize (le_neq H1 (neq_sym H2)); clear H1 H2; intro; abstraction (* Then, we generalize all interesting facts *) | H : ~eq ?x ?y |- _ => revert H; abstraction - | H : ~lt ?x ?y |- _ => revert H; abstraction + | H : ~lt ?x ?y |- _ => revert H; abstraction | H : lt ?x ?y |- _ => revert H; abstraction | H : eq ?x ?y |- _ => revert H; abstraction | _ => idtac end. -Ltac do_eq a b EQ := match goal with - | |- lt ?x ?y -> _ => let H := fresh "H" in - (intro H; +Ltac do_eq a b EQ := match goal with + | |- lt ?x ?y -> _ => let H := fresh "H" in + (intro H; (generalize (eq_lt (eq_sym EQ) H); clear H; intro H) || - (generalize (lt_eq H EQ); clear H; intro H) || - idtac); + (generalize (lt_eq H EQ); clear H; intro H) || + idtac); do_eq a b EQ - | |- ~lt ?x ?y -> _ => let H := fresh "H" in - (intro H; + | |- ~lt ?x ?y -> _ => let H := fresh "H" in + (intro H; (generalize (eq_le (eq_sym EQ) H); clear H; intro H) || - (generalize (le_eq H EQ); clear H; intro H) || - idtac); - do_eq a b EQ - | |- eq ?x ?y -> _ => let H := fresh "H" in - (intro H; + (generalize (le_eq H EQ); clear H; intro H) || + idtac); + do_eq a b EQ + | |- eq ?x ?y -> _ => let H := fresh "H" in + (intro H; (generalize (eq_trans (eq_sym EQ) H); clear H; intro H) || - (generalize (eq_trans H EQ); clear H; intro H) || - idtac); - do_eq a b EQ - | |- ~eq ?x ?y -> _ => let H := fresh "H" in - (intro H; + (generalize (eq_trans H EQ); clear H; intro H) || + idtac); + do_eq a b EQ + | |- ~eq ?x ?y -> _ => let H := fresh "H" in + (intro H; (generalize (eq_neq (eq_sym EQ) H); clear H; intro H) || - (generalize (neq_eq H EQ); clear H; intro H) || - idtac); - do_eq a b EQ + (generalize (neq_eq H EQ); clear H; intro H) || + idtac); + do_eq a b EQ | |- lt a ?y => apply eq_lt with b; [exact EQ|] | |- lt ?y a => apply lt_eq with b; [|exact (eq_sym EQ)] | |- eq a ?y => apply eq_trans with b; [exact EQ|] @@ -195,27 +195,27 @@ Ltac do_eq a b EQ := match goal with | _ => idtac end. -Ltac propagate_eq := abstraction; clear; match goal with +Ltac propagate_eq := abstraction; clear; match goal with (* the abstraction tactic leaves equality facts in head position...*) - | |- eq ?a ?b -> _ => - let EQ := fresh "EQ" in (intro EQ; do_eq a b EQ; clear EQ); - propagate_eq + | |- eq ?a ?b -> _ => + let EQ := fresh "EQ" in (intro EQ; do_eq a b EQ; clear EQ); + propagate_eq | _ => idtac end. -Ltac do_lt x y LT := match goal with +Ltac do_lt x y LT := match goal with (* LT *) | |- lt x y -> _ => intros _; do_lt x y LT - | |- lt y ?z -> _ => let H := fresh "H" in + | |- lt y ?z -> _ => let H := fresh "H" in (intro H; generalize (lt_trans LT H); intro); do_lt x y LT - | |- lt ?z x -> _ => let H := fresh "H" in + | |- lt ?z x -> _ => let H := fresh "H" in (intro H; generalize (lt_trans H LT); intro); do_lt x y LT | |- lt _ _ -> _ => intro; do_lt x y LT (* GE *) | |- ~lt y x -> _ => intros _; do_lt x y LT - | |- ~lt x ?z -> _ => let H := fresh "H" in + | |- ~lt x ?z -> _ => let H := fresh "H" in (intro H; generalize (le_lt_trans H LT); intro); do_lt x y LT - | |- ~lt ?z y -> _ => let H := fresh "H" in + | |- ~lt ?z y -> _ => let H := fresh "H" in (intro H; generalize (lt_le_trans LT H); intro); do_lt x y LT | |- ~lt _ _ -> _ => intro; do_lt x y LT | _ => idtac @@ -223,21 +223,21 @@ Ltac do_lt x y LT := match goal with Definition hide_lt := lt. -Ltac propagate_lt := abstraction; match goal with +Ltac propagate_lt := abstraction; match goal with (* when no [=] remains, the abstraction tactic leaves [<] facts first. *) - | |- lt ?x ?y -> _ => - let LT := fresh "LT" in (intro LT; do_lt x y LT; - change (hide_lt x y) in LT); - propagate_lt + | |- lt ?x ?y -> _ => + let LT := fresh "LT" in (intro LT; do_lt x y LT; + change (hide_lt x y) in LT); + propagate_lt | _ => unfold hide_lt in * end. -Ltac order := - intros; - propagate_eq; - propagate_lt; - auto; - propagate_lt; +Ltac order := + intros; + propagate_eq; + propagate_lt; + auto; + propagate_lt; eauto. Ltac false_order := elimtype False; order. @@ -245,22 +245,22 @@ Ltac false_order := elimtype False; order. Lemma gt_not_eq : forall x y, lt y x -> ~ eq x y. Proof. order. - Qed. - + Qed. + Lemma eq_not_lt : forall x y : t, eq x y -> ~ lt x y. - Proof. + Proof. order. Qed. Hint Resolve gt_not_eq eq_not_lt. Lemma eq_not_gt : forall x y : t, eq x y -> ~ lt y x. - Proof. + Proof. order. Qed. Lemma lt_not_gt : forall x y : t, lt x y -> ~ lt y x. - Proof. + Proof. order. Qed. @@ -269,44 +269,44 @@ Ltac false_order := elimtype False; order. Lemma elim_compare_eq : forall x y : t, eq x y -> exists H : eq x y, compare x y = EQ _ H. - Proof. + Proof. intros; case (compare x y); intros H'; try solve [false_order]. - exists H'; auto. + exists H'; auto. Qed. Lemma elim_compare_lt : forall x y : t, lt x y -> exists H : lt x y, compare x y = LT _ H. - Proof. + Proof. intros; case (compare x y); intros H'; try solve [false_order]. - exists H'; auto. + exists H'; auto. Qed. Lemma elim_compare_gt : forall x y : t, lt y x -> exists H : lt y x, compare x y = GT _ H. - Proof. + Proof. intros; case (compare x y); intros H'; try solve [false_order]. - exists H'; auto. + exists H'; auto. Qed. - Ltac elim_comp := - match goal with - | |- ?e => match e with + Ltac elim_comp := + match goal with + | |- ?e => match e with | context ctx [ compare ?a ?b ] => - let H := fresh in - (destruct (compare a b) as [H|H|H]; + let H := fresh in + (destruct (compare a b) as [H|H|H]; try solve [ intros; false_order]) end end. Ltac elim_comp_eq x y := elim (elim_compare_eq (x:=x) (y:=y)); - [ intros _1 _2; rewrite _2; clear _1 _2 | auto ]. + [ intros _1 _2; rewrite _2; clear _1 _2 | auto ]. Ltac elim_comp_lt x y := elim (elim_compare_lt (x:=x) (y:=y)); - [ intros _1 _2; rewrite _2; clear _1 _2 | auto ]. + [ intros _1 _2; rewrite _2; clear _1 _2 | auto ]. Ltac elim_comp_gt x y := elim (elim_compare_gt (x:=x) (y:=y)); @@ -314,7 +314,7 @@ Ltac false_order := elimtype False; order. (** For compatibility reasons *) Definition eq_dec := eq_dec. - + Lemma lt_dec : forall x y : t, {lt x y} + {~ lt x y}. Proof. intros; elim (compare x y); [ left | right | right ]; auto. @@ -322,8 +322,8 @@ Ltac false_order := elimtype False; order. Definition eqb x y : bool := if eq_dec x y then true else false. - Lemma eqb_alt : - forall x y, eqb x y = match compare x y with EQ _ => true | _ => false end. + Lemma eqb_alt : + forall x y, eqb x y = match compare x y with EQ _ => true | _ => false end. Proof. unfold eqb; intros; destruct (eq_dec x y); elim_comp; auto. Qed. @@ -345,20 +345,20 @@ Proof. exact (In_InA eq_refl). Qed. Lemma Inf_lt : forall l x y, lt x y -> Inf y l -> Inf x l. Proof. exact (InfA_ltA lt_trans). Qed. - + Lemma Inf_eq : forall l x y, eq x y -> Inf y l -> Inf x l. Proof. exact (InfA_eqA eq_lt). Qed. Lemma Sort_Inf_In : forall l x a, Sort l -> Inf a l -> In x l -> lt a x. Proof. exact (SortA_InfA_InA eq_refl eq_sym lt_trans lt_eq eq_lt). Qed. - + Lemma ListIn_Inf : forall l x, (forall y, List.In y l -> lt x y) -> Inf x l. Proof. exact (@In_InfA t lt). Qed. Lemma In_Inf : forall l x, (forall y, In y l -> lt x y) -> Inf x l. Proof. exact (InA_InfA eq_refl (ltA:=lt)). Qed. -Lemma Inf_alt : +Lemma Inf_alt : forall l x, Sort l -> (Inf x l <-> (forall y, In y l -> lt x y)). Proof. exact (InfA_alt eq_refl eq_sym lt_trans lt_eq eq_lt). Qed. @@ -367,8 +367,8 @@ Proof. exact (SortA_NoDupA eq_refl eq_sym lt_trans lt_not_eq lt_eq eq_lt) . Qed. End ForNotations. -Hint Resolve ListIn_In Sort_NoDup Inf_lt. -Hint Immediate In_eq Inf_lt. +Hint Resolve ListIn_In Sort_NoDup Inf_lt. +Hint Immediate In_eq Inf_lt. End OrderedTypeFacts. @@ -382,7 +382,7 @@ Module KeyOrderedType(O:OrderedType). Notation key:=t. Definition eqk (p p':key*elt) := eq (fst p) (fst p'). - Definition eqke (p p':key*elt) := + Definition eqke (p p':key*elt) := eq (fst p) (fst p') /\ (snd p) = (snd p'). Definition ltk (p p':key*elt) := lt (fst p) (fst p'). @@ -390,7 +390,7 @@ Module KeyOrderedType(O:OrderedType). Hint Extern 2 (eqke ?a ?b) => split. (* eqke is stricter than eqk *) - + Lemma eqke_eqk : forall x x', eqke x x' -> eqk x x'. Proof. unfold eqk, eqke; intuition. @@ -406,7 +406,7 @@ Module KeyOrderedType(O:OrderedType). Hint Immediate ltk_right_r ltk_right_l. (* eqk, eqke are equalities, ltk is a strict order *) - + Lemma eqk_refl : forall e, eqk e e. Proof. auto. Qed. @@ -431,7 +431,7 @@ Module KeyOrderedType(O:OrderedType). Proof. eauto. Qed. Lemma ltk_not_eqk : forall e e', ltk e e' -> ~ eqk e e'. - Proof. unfold eqk, ltk; auto. Qed. + Proof. unfold eqk, ltk; auto. Qed. Lemma ltk_not_eqke : forall e e', ltk e e' -> ~eqke e e'. Proof. @@ -458,10 +458,10 @@ Module KeyOrderedType(O:OrderedType). intros (k,e) (k',e') (k'',e''). unfold ltk, eqk; simpl; eauto. Qed. - Hint Resolve eqk_not_ltk. + Hint Resolve eqk_not_ltk. Hint Immediate ltk_eqk eqk_ltk. - Lemma InA_eqke_eqk : + Lemma InA_eqke_eqk : forall x m, InA eqke x m -> InA eqk x m. Proof. unfold eqke; induction 1; intuition. @@ -496,7 +496,7 @@ Module KeyOrderedType(O:OrderedType). Lemma In_eq : forall l x y, eq x y -> In x l -> In y l. Proof. destruct 2 as (e,E); exists e; eapply MapsTo_eq; eauto. - Qed. + Qed. Lemma Inf_eq : forall l x x', eqk x x' -> Inf x' l -> Inf x l. Proof. exact (InfA_eqA eqk_ltk). Qed. @@ -507,13 +507,13 @@ Module KeyOrderedType(O:OrderedType). Hint Immediate Inf_eq. Hint Resolve Inf_lt. - Lemma Sort_Inf_In : + Lemma Sort_Inf_In : forall l p q, Sort l -> Inf q l -> InA eqk p l -> ltk q p. - Proof. + Proof. exact (SortA_InfA_InA eqk_refl eqk_sym ltk_trans ltk_eqk eqk_ltk). Qed. - Lemma Sort_Inf_NotIn : + Lemma Sort_Inf_NotIn : forall l k e, Sort l -> Inf (k,e) l -> ~In k l. Proof. intros; red; intros. @@ -524,7 +524,7 @@ Module KeyOrderedType(O:OrderedType). Qed. Lemma Sort_NoDupA: forall l, Sort l -> NoDupA eqk l. - Proof. + Proof. exact (SortA_NoDupA eqk_refl eqk_sym ltk_trans ltk_not_eqk ltk_eqk eqk_ltk). Qed. @@ -540,7 +540,7 @@ Module KeyOrderedType(O:OrderedType). left; apply Sort_In_cons_1 with l; auto. Qed. - Lemma Sort_In_cons_3 : + Lemma Sort_In_cons_3 : forall x l k e, Sort ((k,e)::l) -> In x l -> ~eq x k. Proof. inversion_clear 1; red; intros. @@ -552,15 +552,15 @@ Module KeyOrderedType(O:OrderedType). inversion 1. inversion_clear H0; eauto. destruct H1; simpl in *; intuition. - Qed. + Qed. - Lemma In_inv_2 : forall k k' e e' l, + Lemma In_inv_2 : forall k k' e e' l, InA eqk (k, e) ((k', e') :: l) -> ~ eq k k' -> InA eqk (k, e) l. - Proof. + Proof. inversion_clear 1; compute in H0; intuition. Qed. - Lemma In_inv_3 : forall x x' l, + Lemma In_inv_3 : forall x x' l, InA eqke x (x' :: l) -> ~ eqk x x' -> InA eqke x l. Proof. inversion_clear 1; compute in H0; intuition. @@ -573,7 +573,7 @@ Module KeyOrderedType(O:OrderedType). Hint Resolve eqk_trans eqke_trans eqk_refl eqke_refl. Hint Resolve ltk_trans ltk_not_eqk ltk_not_eqke. Hint Immediate eqk_sym eqke_sym. - Hint Resolve eqk_not_ltk. + Hint Resolve eqk_not_ltk. Hint Immediate ltk_eqk eqk_ltk. Hint Resolve InA_eqke_eqk. Hint Unfold MapsTo In. diff --git a/theories/FSets/OrderedTypeAlt.v b/theories/FSets/OrderedTypeAlt.v index 95c9c31a9..3a9fa1a73 100644 --- a/theories/FSets/OrderedTypeAlt.v +++ b/theories/FSets/OrderedTypeAlt.v @@ -6,8 +6,8 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* Finite sets library. - * Authors: Pierre Letouzey and Jean-Christophe Filliâtre +(* Finite sets library. + * Authors: Pierre Letouzey and Jean-Christophe Filliâtre * Institution: LRI, CNRS UMR 8623 - Université Paris Sud * 91405 Orsay, France *) @@ -19,23 +19,23 @@ Require Import OrderedType. inferface. *) (** NB: [comparison], defined in [Datatypes.v] is [Eq|Lt|Gt] -whereas [compare], defined in [OrderedType.v] is [EQ _ | LT _ | GT _ ] +whereas [compare], defined in [OrderedType.v] is [EQ _ | LT _ | GT _ ] *) Module Type OrderedTypeAlt. Parameter t : Type. - + Parameter compare : t -> t -> comparison. Infix "?=" := compare (at level 70, no associativity). - Parameter compare_sym : + Parameter compare_sym : forall x y, (y?=x) = CompOpp (x?=y). - Parameter compare_trans : + Parameter compare_trans : forall c x y z, (x?=y) = c -> (y?=z) = c -> (x?=z) = c. -End OrderedTypeAlt. +End OrderedTypeAlt. (** From this new presentation to the original one. *) @@ -56,7 +56,7 @@ Module OrderedType_from_Alt (O:OrderedTypeAlt) <: OrderedType. Qed. Lemma eq_sym : forall x y, eq x y -> eq y x. - Proof. + Proof. unfold eq; intros. rewrite compare_sym. rewrite H; simpl; auto. @@ -88,7 +88,7 @@ Module OrderedType_from_Alt (O:OrderedTypeAlt) <: OrderedType. case (x ?= y); [ left | right | right ]; auto; discriminate. Defined. -End OrderedType_from_Alt. +End OrderedType_from_Alt. (** From the original presentation to this alternative one. *) @@ -99,30 +99,30 @@ Module OrderedType_to_Alt (O:OrderedType) <: OrderedTypeAlt. Definition t := t. - Definition compare x y := match compare x y with + Definition compare x y := match compare x y with | LT _ => Lt | EQ _ => Eq | GT _ => Gt - end. + end. Infix "?=" := compare (at level 70, no associativity). - Lemma compare_sym : + Lemma compare_sym : forall x y, (y?=x) = CompOpp (x?=y). Proof. intros x y; unfold compare. destruct O.compare; elim_comp; simpl; auto. Qed. - - Lemma compare_trans : + + Lemma compare_trans : forall c x y z, (x?=y) = c -> (y?=z) = c -> (x?=z) = c. Proof. intros c x y z. - destruct c; unfold compare; - do 2 (destruct O.compare; intros; try discriminate); + destruct c; unfold compare; + do 2 (destruct O.compare; intros; try discriminate); elim_comp; auto. Qed. End OrderedType_to_Alt. - + diff --git a/theories/FSets/OrderedTypeEx.v b/theories/FSets/OrderedTypeEx.v index e6312a147..e76cead2d 100644 --- a/theories/FSets/OrderedTypeEx.v +++ b/theories/FSets/OrderedTypeEx.v @@ -6,8 +6,8 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* Finite sets library. - * Authors: Pierre Letouzey and Jean-Christophe Filliâtre +(* Finite sets library. + * Authors: Pierre Letouzey and Jean-Christophe Filliâtre * Institution: LRI, CNRS UMR 8623 - Université Paris Sud * 91405 Orsay, France *) @@ -21,7 +21,7 @@ Require Import Compare_dec. (** * Examples of Ordered Type structures. *) -(** First, a particular case of [OrderedType] where +(** First, a particular case of [OrderedType] where the equality is the usual one of Coq. *) Module Type UsualOrderedType. @@ -80,7 +80,7 @@ Open Local Scope Z_scope. Module Z_as_OT <: UsualOrderedType. Definition t := Z. - Definition eq := @eq Z. + Definition eq := @eq Z. Definition eq_refl := @refl_equal t. Definition eq_sym := @sym_eq t. Definition eq_trans := @trans_eq t. @@ -105,7 +105,7 @@ Module Z_as_OT <: UsualOrderedType. End Z_as_OT. -(** [positive] is an ordered type with respect to the usual order on natural numbers. *) +(** [positive] is an ordered type with respect to the usual order on natural numbers. *) Open Local Scope positive_scope. @@ -117,9 +117,9 @@ Module Positive_as_OT <: UsualOrderedType. Definition eq_trans := @trans_eq t. Definition lt p q:= (p ?= q) Eq = Lt. - + Lemma lt_trans : forall x y z : t, lt x y -> lt y z -> lt x z. - Proof. + Proof. unfold lt; intros x y z. change ((Zpos x < Zpos y)%Z -> (Zpos y < Zpos z)%Z -> (Zpos x < Zpos z)%Z). omega. @@ -149,7 +149,7 @@ Module Positive_as_OT <: UsualOrderedType. End Positive_as_OT. -(** [N] is an ordered type with respect to the usual order on natural numbers. *) +(** [N] is an ordered type with respect to the usual order on natural numbers. *) Open Local Scope positive_scope. @@ -180,7 +180,7 @@ Module N_as_OT <: UsualOrderedType. End N_as_OT. -(** From two ordered types, we can build a new OrderedType +(** From two ordered types, we can build a new OrderedType over their cartesian product, using the lexicographic order. *) Module PairOrderedType(O1 O2:OrderedType) <: OrderedType. @@ -188,29 +188,29 @@ Module PairOrderedType(O1 O2:OrderedType) <: OrderedType. Module MO2:=OrderedTypeFacts(O2). Definition t := prod O1.t O2.t. - + Definition eq x y := O1.eq (fst x) (fst y) /\ O2.eq (snd x) (snd y). - Definition lt x y := - O1.lt (fst x) (fst y) \/ + Definition lt x y := + O1.lt (fst x) (fst y) \/ (O1.eq (fst x) (fst y) /\ O2.lt (snd x) (snd y)). Lemma eq_refl : forall x : t, eq x x. - Proof. + Proof. intros (x1,x2); red; simpl; auto. Qed. Lemma eq_sym : forall x y : t, eq x y -> eq y x. - Proof. + Proof. intros (x1,x2) (y1,y2); unfold eq; simpl; intuition. Qed. Lemma eq_trans : forall x y z : t, eq x y -> eq y z -> eq x z. - Proof. + Proof. intros (x1,x2) (y1,y2) (z1,z2); unfold eq; simpl; intuition eauto. Qed. - - Lemma lt_trans : forall x y z : t, lt x y -> lt y z -> lt x z. + + Lemma lt_trans : forall x y z : t, lt x y -> lt y z -> lt x z. Proof. intros (x1,x2) (y1,y2) (z1,z2); unfold eq, lt; simpl; intuition. left; eauto. |