### Finite maps and sets using ordered association lists.

```This commit includes the following changes:
* More theorems about pre-, partial and total orders.
* Define the lexicographic order on various commonly used data types.
* Mergesort and its correctness proof.
* Implement finite maps and sets using ordered association lists.```
parent 46304c52
theories/assoc.v 0 → 100644
This diff is collapsed.
 ... ... @@ -14,9 +14,9 @@ Coercion Is_true : bool >-> Sortclass. (** Ensure that [simpl] unfolds [id], [compose], and [flip] when fully applied. *) Arguments id _ _/. Arguments id _ _ /. Arguments compose _ _ _ _ _ _ /. Arguments flip _ _ _ _ _ _/. Arguments flip _ _ _ _ _ _ /. Typeclasses Transparent id compose flip. (** Change [True] and [False] into notations in order to enable overloading. ... ... @@ -211,7 +211,7 @@ Notation "{[ x , y ]}" := (singleton (x,y)) Notation "{[ x , y , z ]}" := (singleton (x,y,z)) (at level 1, y at next level, z at next level) : C_scope. Class SubsetEq A := subseteq: A → A → Prop. Class SubsetEq A := subseteq: relation A. Instance: Params (@subseteq) 2. Infix "⊆" := subseteq (at level 70) : C_scope. Notation "(⊆)" := subseteq (only parsing) : C_scope. ... ... @@ -226,17 +226,22 @@ Notation "(⊆*)" := (Forall2 subseteq) (only parsing) : C_scope. Hint Extern 0 (_ ⊆ _) => reflexivity. Class Subset A := subset: A → A → Prop. Instance: Params (@subset) 2. Infix "⊂" := subset (at level 70) : C_scope. Notation "(⊂)" := subset (only parsing) : C_scope. Notation "( X ⊂ )" := (subset X) (only parsing) : C_scope. Notation "( ⊂ X )" := (λ Y, subset Y X) (only parsing) : C_scope. Definition strict {A} (R : relation A) : relation A := λ X Y, R X Y ∧ ¬R Y X. Instance: Params (@strict) 2. Infix "⊂" := (strict subseteq) (at level 70) : C_scope. Notation "(⊂)" := (strict subseteq) (only parsing) : C_scope. Notation "( X ⊂ )" := (strict subseteq X) (only parsing) : C_scope. Notation "( ⊂ X )" := (λ Y, strict subseteq Y X) (only parsing) : C_scope. Notation "X ⊄ Y" := (¬X ⊂ Y) (at level 70) : C_scope. Notation "(⊄)" := (λ X Y, X ⊄ Y) (only parsing) : C_scope. Notation "( X ⊄ )" := (λ Y, X ⊄ Y) (only parsing) : C_scope. Notation "( ⊄ X )" := (λ Y, Y ⊄ X) (only parsing) : C_scope. (** The class [Lexico A] is used for the lexicographic order on [A]. This order is used to create finite maps, finite sets, etc, and is typically different from the order [(⊆)]. *) Class Lexico A := lexico: relation A. Class ElemOf A B := elem_of: A → B → Prop. Instance: Params (@elem_of) 3. Infix "∈" := elem_of (at level 70) : C_scope. ... ... @@ -472,6 +477,11 @@ Class RightDistr {A} (R : relation A) (f g : A → A → A) : Prop := right_distr: ∀ y z x, R (f (g y z) x) (g (f y x) (f z x)). Class AntiSymmetric {A} (R S : relation A) : Prop := anti_symmetric: ∀ x y, S x y → S y x → R x y. Class Total {A} (R : relation A) := total x y : R x y ∨ R y x. Class Trichotomy {A} (R : relation A) := trichotomy : ∀ x y, strict R x y ∨ x = y ∨ strict R y x. Class TrichotomyT {A} (R : relation A) := trichotomyT : ∀ x y, {strict R x y} + {x = y} + {strict R y x}. Arguments irreflexivity {_} _ {_} _ _. Arguments injective {_ _ _ _} _ {_} _ _ _. ... ... @@ -488,6 +498,9 @@ Arguments right_absorb {_ _} _ _ {_} _. Arguments left_distr {_ _} _ _ {_} _ _ _. Arguments right_distr {_ _} _ _ {_} _ _ _. Arguments anti_symmetric {_ _} _ {_} _ _ _ _. Arguments total {_} _ {_} _ _. Arguments trichotomy {_} _ {_} _ _. Arguments trichotomyT {_} _ {_} _ _. (** The following lemmas are specific versions of the projections of the above type classes for Leibniz equality. These lemmas allow us to enforce Coq not to ... ... @@ -518,15 +531,22 @@ Lemma right_distr_L {A} (f g : A → A → A) `{!RightDistr (=) f g} y z x : Proof. auto. Qed. (** ** Axiomatization of ordered structures *) (** The classes [PreOrder], [PartialOrder], and [TotalOrder] do not use the relation [⊆] because we often have multiple orders on the same structure. *) Class PartialOrder {A} (R : relation A) : Prop := { po_preorder :> PreOrder R; po_anti_symmetric :> AntiSymmetric (=) R }. Class TotalOrder {A} (R : relation A) : Prop := { to_po :> PartialOrder R; to_trichotomy :> Trichotomy R }. (** A pre-order equipped with a smallest element. *) Class BoundedPreOrder A `{Empty A} `{SubsetEq A} : Prop := { bounded_preorder :>> PreOrder (⊆); subseteq_empty x : ∅ ⊆ x }. Class PartialOrder {A} (R : relation A) : Prop := { po_preorder :> PreOrder R; po_antisym :> AntiSymmetric (=) R }. (** We do not include equality in the following interfaces so as to avoid the need for proofs that the relations and operations respect setoid equality. ... ... @@ -678,18 +698,10 @@ Arguments snd_map {_ _ _} _ !_ /. Instance: ∀ {A A' B} (f : A → A'), Injective (=) (=) f → Injective (=) (=) (@fst_map A A' B f). Proof. intros ????? [??] [??]; simpl; intro; f_equal. * apply (injective f). congruence. * congruence. Qed. Proof. intros ????? [??] [??]; injection 1; firstorder congruence. Qed. Instance: ∀ {A B B'} (f : B → B'), Injective (=) (=) f → Injective (=) (=) (@snd_map A B B' f). Proof. intros ????? [??] [??]; simpl; intro; f_equal. * congruence. * apply (injective f). congruence. Qed. Proof. intros ????? [??] [??]; injection 1; firstorder congruence. Qed. Definition prod_relation {A B} (R1 : relation A) (R2 : relation B) : relation (A * B) := λ x y, R1 (fst x) (fst y) ∧ R2 (snd x) (snd y). ... ... @@ -781,51 +793,51 @@ Proof. intros y. exists (g y). auto. Qed. Lemma impl_transitive (P Q R : Prop) : (P → Q) → (Q → R) → (P → R). Proof. tauto. Qed. Instance: Commutative (↔) (@eq A). Proof. red. intuition. Qed. Proof. red; intuition. Qed. Instance: Commutative (↔) (λ x y, @eq A y x). Proof. red. intuition. Qed. Proof. red; intuition. Qed. Instance: Commutative (↔) (↔). Proof. red. intuition. Qed. Proof. red; intuition. Qed. Instance: Commutative (↔) (∧). Proof. red. intuition. Qed. Proof. red; intuition. Qed. Instance: Associative (↔) (∧). Proof. red. intuition. Qed. Proof. red; intuition. Qed. Instance: Idempotent (↔) (∧). Proof. red. intuition. Qed. Proof. red; intuition. Qed. Instance: Commutative (↔) (∨). Proof. red. intuition. Qed. Proof. red; intuition. Qed. Instance: Associative (↔) (∨). Proof. red. intuition. Qed. Proof. red; intuition. Qed. Instance: Idempotent (↔) (∨). Proof. red. intuition. Qed. Proof. red; intuition. Qed. Instance: LeftId (↔) True (∧). Proof. red. intuition. Qed. Proof. red; intuition. Qed. Instance: RightId (↔) True (∧). Proof. red. intuition. Qed. Proof. red; intuition. Qed. Instance: LeftAbsorb (↔) False (∧). Proof. red. intuition. Qed. Proof. red; intuition. Qed. Instance: RightAbsorb (↔) False (∧). Proof. red. intuition. Qed. Proof. red; intuition. Qed. Instance: LeftId (↔) False (∨). Proof. red. intuition. Qed. Proof. red; intuition. Qed. Instance: RightId (↔) False (∨). Proof. red. intuition. Qed. Proof. red; intuition. Qed. Instance: LeftAbsorb (↔) True (∨). Proof. red. intuition. Qed. Proof. red; intuition. Qed. Instance: RightAbsorb (↔) True (∨). Proof. red. intuition. Qed. Proof. red; intuition. Qed. Instance: LeftId (↔) True impl. Proof. unfold impl. red. intuition. Qed. Proof. unfold impl. red; intuition. Qed. Instance: RightAbsorb (↔) True impl. Proof. unfold impl. red. intuition. Qed. Proof. unfold impl. red; intuition. Qed. Instance: LeftDistr (↔) (∧) (∨). Proof. red. intuition. Qed. Proof. red; intuition. Qed. Instance: RightDistr (↔) (∧) (∨). Proof. red. intuition. Qed. Proof. red; intuition. Qed. Instance: LeftDistr (↔) (∨) (∧). Proof. red. intuition. Qed. Proof. red; intuition. Qed. Instance: RightDistr (↔) (∨) (∧). Proof. red. intuition. Qed. Proof. red; intuition. Qed. Lemma not_injective `{Injective A B R R' f} x y : ¬R x y → ¬R' (f x) (f y). Proof. intuition. Qed. Instance injective_compose {A B C} R1 R2 R3 (f : A → B) (g : B → C) : ... ...
 ... ... @@ -144,7 +144,7 @@ Proof. by apply size_non_empty_iff, non_empty_difference. Qed. Lemma collection_wf : wf (@subset C _). Lemma collection_wf : wf (strict (@subseteq C _)). Proof. apply well_founded_lt_compat with size, subset_size. Qed. Lemma collection_ind (P : C → Prop) : ... ...
 ... ... @@ -372,7 +372,7 @@ Lemma insert_subset_inv {A} (m1 m2 : M A) i x : ∃ m2', m2 = <[i:=x]>m2' ∧ m1 ⊂ m2' ∧ m2' !! i = None. Proof. intros Hi Hm1m2. exists (delete i m2). split_ands. * rewrite insert_delete. done. eapply lookup_weaken, subset_subseteq; eauto. * rewrite insert_delete. done. eapply lookup_weaken, strict_include; eauto. by rewrite lookup_insert. * eauto using insert_delete_subset. * by rewrite lookup_delete. ... ... @@ -564,7 +564,7 @@ Proof. rewrite !map_to_list_insert; simpl; auto with arith. Qed. Lemma map_wf {A} : wf (@subset (M A) _). Lemma map_wf {A} : wf (strict (@subseteq (M A) _)). Proof. apply (wf_projected (<) (length ∘ map_to_list)). * by apply map_to_list_length. ... ... @@ -1013,13 +1013,13 @@ Qed. Lemma map_union_cancel_l {A} (m1 m2 m3 : M A) : m1 ⊥ m3 → m2 ⊥ m3 → m3 ∪ m1 = m3 ∪ m2 → m1 = m2. Proof. intros. by apply (anti_symmetric _); intros. by apply (anti_symmetric (⊆)); apply map_union_reflecting_l with m3; auto with congruence. Qed. Lemma map_union_cancel_r {A} (m1 m2 m3 : M A) : m1 ⊥ m3 → m2 ⊥ m3 → m1 ∪ m3 = m2 ∪ m3 → m1 = m2. Proof. intros. apply (anti_symmetric _); intros. apply (anti_symmetric (⊆)); apply map_union_reflecting_r with m3; auto with congruence. Qed. ... ...
theories/lexico.v 0 → 100644
 (* Copyright (c) 2012-2013, Robbert Krebbers. *) (* This file is distributed under the terms of the BSD license. *) (** This files defines a lexicographic order on various common data structures and proves that it is a partial order having a strong variant of trichotomy. *) Require Import orders. Notation cast_trichotomy T := match T with | inleft (left _) => inleft (left _) | inleft (right _) => inleft (right _) | inright _ => inright _ end. Instance prod_lexico `{Lexico A} `{Lexico B} : Lexico (A * B) := λ p1 p2, (**i 1.) *) strict lexico (fst p1) (fst p2) ∨ (**i 2.) *) fst p1 = fst p2 ∧ lexico (snd p1) (snd p2). Lemma prod_lexico_strict `{Lexico A} `{Lexico B} (p1 p2 : A * B) : strict lexico p1 p2 ↔ strict lexico (fst p1) (fst p2) ∨ fst p1 = fst p2 ∧ strict lexico (snd p1) (snd p2). Proof. destruct p1, p2. repeat (unfold lexico, prod_lexico, strict). naive_solver. Qed. Instance bool_lexico : Lexico bool := (→). Instance nat_lexico : Lexico nat := (≤). Instance N_lexico : Lexico N := (≤)%N. Instance Z_lexico : Lexico Z := (≤)%Z. Typeclasses Opaque bool_lexico nat_lexico N_lexico Z_lexico. Instance list_lexico `{Lexico A} : Lexico (list A) := fix go l1 l2 := let _ : Lexico (list A) := @go in match l1, l2 with | [], _ => True | _ :: _, [] => False | x1 :: l1, x2 :: l2 => lexico (x1,l1) (x2,l2) end. Instance sig_lexico `{Lexico A} (P : A → Prop) `{∀ x, ProofIrrel (P x)} : Lexico (sig P) := λ x1 x2, lexico (`x1) (`x2). Lemma prod_lexico_reflexive `{Lexico A} `{!PartialOrder (@lexico A _)} `{Lexico B} (x : A) (y : B) : lexico y y → lexico (x,y) (x,y). Proof. by right. Qed. Lemma prod_lexico_transitive `{Lexico A} `{!PartialOrder (@lexico A _)} `{Lexico B} (x1 x2 x3 : A) (y1 y2 y3 : B) : lexico (x1,y1) (x2,y2) → lexico (x2,y2) (x3,y3) → (lexico y1 y2 → lexico y2 y3 → lexico y1 y3) → lexico (x1,y1) (x3,y3). Proof. intros Hx12 Hx23 ?; revert Hx12 Hx23. unfold lexico, prod_lexico. intros [|[??]] [?|[??]]; simplify_equality'; auto. left. by transitivity x2. Qed. Lemma prod_lexico_anti_symmetric `{Lexico A} `{!PartialOrder (@lexico A _)} `{Lexico B} (x1 x2 : A) (y1 y2 : B) : lexico (x1,y1) (x2,y2) → lexico (x2,y2) (x1,y1) → (lexico y1 y2 → lexico y2 y1 → y1 = y2) → x1 = x2 ∧ y1 = y2. Proof. by intros [[??]|[??]] [[??]|[??]] ?; simplify_equality'; auto. Qed. Instance prod_lexico_po `{Lexico A} `{Lexico B} `{!PartialOrder (@lexico A _)} `{!PartialOrder (@lexico B _)} : PartialOrder (@lexico (A * B) _). Proof. repeat split. * by intros [??]; apply prod_lexico_reflexive. * intros [??] [??] [??] ??. eapply prod_lexico_transitive; eauto. apply @transitivity, _. * intros [x1 y1] [x2 y2] ??. destruct (prod_lexico_anti_symmetric x1 x2 y1 y2); try intuition congruence. apply (anti_symmetric _). Qed. Instance prod_lexico_trichotomyT `{Lexico A} `{tA: !TrichotomyT (@lexico A _)} `{Lexico B} `{tB:!TrichotomyT (@lexico B _)}: TrichotomyT (@lexico (A * B) _). Proof. red; refine (λ p1 p2, match trichotomyT lexico (fst p1) (fst p2) with | inleft (left _) => inleft (left _) | inleft (right _) => cast_trichotomy (trichotomyT lexico (snd p1) (snd p2)) | inright _ => inright _ end); clear tA tB; abstract (rewrite ?prod_lexico_strict; intuition (auto using injective_projections with congruence)). Defined. Instance bool_lexico_po : PartialOrder (@lexico bool _). Proof. unfold lexico, bool_lexico. repeat split. * intros []; simpl; tauto. * intros [] [] []; simpl; tauto. * intros [] []; simpl; tauto. Qed. Instance bool_lexico_trichotomy: TrichotomyT (@lexico bool _). Proof. red; refine (λ b1 b2, match b1, b2 with | false, false => inleft (right _) | false, true => inleft (left _) | true, false => inright _ | true, true => inleft (right _) end); abstract (unfold strict, lexico, bool_lexico; naive_solver). Defined. Lemma nat_lexico_strict (x1 x2 : nat) : strict lexico x1 x2 ↔ x1 < x2. Proof. unfold strict, lexico, nat_lexico. lia. Qed. Instance nat_lexico_po : PartialOrder (@lexico nat _). Proof. unfold lexico, nat_lexico. apply _. Qed. Instance nat_lexico_trichotomy: TrichotomyT (@lexico nat _). Proof. red; refine (λ n1 n2, match Nat.compare n1 n2 as c return Nat.compare n1 n2 = c → _ with | Lt => λ H, inleft (left (proj2 (nat_lexico_strict _ _) (nat_compare_Lt_lt _ _ H))) | Eq => λ H, inleft (right (nat_compare_eq _ _ H)) | Gt => λ H, inright (proj2 (nat_lexico_strict _ _) (nat_compare_Gt_gt _ _ H)) end eq_refl). Defined. Lemma N_lexico_strict (x1 x2 : N) : strict lexico x1 x2 ↔ (x1 < x2)%N. Proof. unfold strict, lexico, N_lexico. lia. Qed. Instance N_lexico_po : PartialOrder (@lexico N _). Proof. unfold lexico, N_lexico. apply _. Qed. Instance N_lexico_trichotomy: TrichotomyT (@lexico N _). Proof. red; refine (λ n1 n2, match N.compare n1 n2 as c return N.compare n1 n2 = c → _ with | Lt => λ H, inleft (left (proj2 (N_lexico_strict _ _) (proj2 (N.compare_lt_iff _ _) H))) | Eq => λ H, inleft (right (N.compare_eq _ _ H)) | Gt => λ H, inright (proj2 (N_lexico_strict _ _) (proj1 (N.compare_gt_iff _ _) H)) end eq_refl). Defined. Lemma Z_lexico_strict (x1 x2 : Z) : strict lexico x1 x2 ↔ (x1 < x2)%Z. Proof. unfold strict, lexico, Z_lexico. lia. Qed. Instance Z_lexico_po : PartialOrder (@lexico Z _). Proof. unfold lexico, Z_lexico. apply _. Qed. Instance Z_lexico_trichotomy: TrichotomyT (@lexico Z _). Proof. red; refine (λ n1 n2, match Z.compare n1 n2 as c return Z.compare n1 n2 = c → _ with | Lt => λ H, inleft (left (proj2 (Z_lexico_strict _ _) (proj2 (Z.compare_lt_iff _ _) H))) | Eq => λ H, inleft (right (Z.compare_eq _ _ H)) | Gt => λ H, inright (proj2 (Z_lexico_strict _ _) (proj1 (Z.compare_gt_iff _ _) H)) end eq_refl). Defined. Instance list_lexico_po `{Lexico A} `{!PartialOrder (@lexico A _)} : PartialOrder (@lexico (list A) _). Proof. repeat split. * intros l. induction l. done. by apply prod_lexico_reflexive. * intros l1. induction l1 as [|x1 l1]; intros [|x2 l2] [|x3 l3] ??; try done. eapply prod_lexico_transitive; eauto. * intros l1. induction l1 as [|x1 l1]; intros [|x2 l2] ??; try done. destruct (prod_lexico_anti_symmetric x1 x2 l1 l2); naive_solver. Qed. Instance list_lexico_trichotomy `{Lexico A} `{!TrichotomyT (@lexico A _)} : TrichotomyT (@lexico (list A) _). Proof. refine ( fix go l1 l2 := let go' : TrichotomyT (@lexico (list A) _) := @go in match l1, l2 with | [], [] => inleft (right _) | [], _ :: _ => inleft (left _) | _ :: _, [] => inright _ | x1 :: l1, x2 :: l2 => cast_trichotomy (trichotomyT lexico (x1,l1) (x2,l2)) end); clear go go'; abstract (repeat (done || constructor || congruence || by inversion 1)). Defined. Instance sig_lexico_po `{Lexico A} `{!PartialOrder (@lexico A _)} (P : A → Prop) `{∀ x, ProofIrrel (P x)} : PartialOrder (@lexico (sig P) _). Proof. unfold lexico, sig_lexico. repeat split. * by intros [??]. * intros [x1 ?] [x2 ?] [x3 ?] ??. by simplify_order. * intros [x1 ?] [x2 ?] ??. apply (sig_eq_pi _). by simplify_order. Qed. Instance sig_lexico_trichotomy `{Lexico A} `{tA: !TrichotomyT (@lexico A _)} (P : A → Prop) `{∀ x, ProofIrrel (P x)} : TrichotomyT (@lexico (sig P) _). Proof. red; refine (λ x1 x2, cast_trichotomy (trichotomyT lexico (`x1) (`x2))); abstract (repeat (done || constructor || apply (sig_eq_pi P))). Defined.
 ... ... @@ -79,7 +79,8 @@ Proof. apply (lookup_merge f t1 t2). Qed. (** Finally, we can construct sets of [N]s satisfying extensional equality. *) (** * Finite sets *) (** We construct sets of [N]s satisfying extensional equality. *) Notation Nset := (mapset Nmap). Instance Nmap_dom {A} : Dom (Nmap A) Nset := mapset_dom. Instance: FinMapDom N Nmap Nset := mapset_dom_spec.
 ... ... @@ -187,6 +187,11 @@ Program Instance N_lt_dec (x y : N) : Decision (x < y)%N := end. Next Obligation. congruence. Qed. Instance N_inhabited: Inhabited N := populate 1%N. Instance: PartialOrder (≤)%N. Proof. repeat split; red. apply N.le_refl. apply N.le_trans. apply N.le_antisymm. Qed. Hint Extern 0 (_ ≤ _)%N => reflexivity. (** * Notations and properties of [Z] *) Open Scope Z_scope. ... ... @@ -210,6 +215,10 @@ Instance Z_eq_dec: ∀ x y : Z, Decision (x = y) := Z.eq_dec. Instance Z_le_dec: ∀ x y : Z, Decision (x ≤ y) := Z_le_dec. Instance Z_lt_dec: ∀ x y : Z, Decision (x < y) := Z_lt_dec. Instance Z_inhabited: Inhabited Z := populate 1. Instance: PartialOrder (≤). Proof. repeat split; red. apply Z.le_refl. apply Z.le_trans. apply Z.le_antisymm. Qed. Lemma Z_pow_pred_r n m : 0 < m → n * n ^ (Z.pred m) = n ^ m. Proof. ... ... @@ -362,7 +371,7 @@ Proof. apply Z_to_option_nat_Some_alt. auto using Nat2Z.is_nonneg. Qed. (** The function [Z_of_sumbool] converts a sumbool [P] into an integer by yielding one if [P] and zero if [Q]. *) Definition Z_of_sumbool {P Q : Prop} (p : {P} + {Q}) : Z := Definition Z_of_sumbool {P Q : Prop} (p : {P} + {Q} ) : Z := (if p then 1 else 0)%Z. (** Some correspondence lemmas between [nat] and [N] that are not part of the ... ...
This diff is collapsed.
This diff is collapsed.
 ... ... @@ -13,4 +13,5 @@ Require Export fin_collections listset fresh_numbers list. list lexico.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!