Commit bc659ba4 authored by Robbert Krebbers's avatar Robbert Krebbers

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
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.
......
(* 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!
Please register or to comment