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. ...@@ -14,9 +14,9 @@ Coercion Is_true : bool >-> Sortclass.
(** Ensure that [simpl] unfolds [id], [compose], and [flip] when fully (** Ensure that [simpl] unfolds [id], [compose], and [flip] when fully
applied. *) applied. *)
Arguments id _ _/. Arguments id _ _ /.
Arguments compose _ _ _ _ _ _ /. Arguments compose _ _ _ _ _ _ /.
Arguments flip _ _ _ _ _ _/. Arguments flip _ _ _ _ _ _ /.
Typeclasses Transparent id compose flip. Typeclasses Transparent id compose flip.
(** Change [True] and [False] into notations in order to enable overloading. (** Change [True] and [False] into notations in order to enable overloading.
...@@ -211,7 +211,7 @@ Notation "{[ x , y ]}" := (singleton (x,y)) ...@@ -211,7 +211,7 @@ Notation "{[ x , y ]}" := (singleton (x,y))
Notation "{[ x , y , z ]}" := (singleton (x,y,z)) Notation "{[ x , y , z ]}" := (singleton (x,y,z))
(at level 1, y at next level, z at next level) : C_scope. (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. Instance: Params (@subseteq) 2.
Infix "⊆" := subseteq (at level 70) : C_scope. Infix "⊆" := subseteq (at level 70) : C_scope.
Notation "(⊆)" := subseteq (only parsing) : C_scope. Notation "(⊆)" := subseteq (only parsing) : C_scope.
...@@ -226,17 +226,22 @@ Notation "(⊆*)" := (Forall2 subseteq) (only parsing) : C_scope. ...@@ -226,17 +226,22 @@ Notation "(⊆*)" := (Forall2 subseteq) (only parsing) : C_scope.
Hint Extern 0 (_ _) => reflexivity. Hint Extern 0 (_ _) => reflexivity.
Class Subset A := subset: A A Prop. Definition strict {A} (R : relation A) : relation A := λ X Y, R X Y ¬R Y X.
Instance: Params (@subset) 2. Instance: Params (@strict) 2.
Infix "⊂" := subset (at level 70) : C_scope. Infix "⊂" := (strict subseteq) (at level 70) : C_scope.
Notation "(⊂)" := subset (only parsing) : C_scope. Notation "(⊂)" := (strict subseteq) (only parsing) : C_scope.
Notation "( X ⊂ )" := (subset X) (only parsing) : C_scope. Notation "( X ⊂ )" := (strict subseteq X) (only parsing) : C_scope.
Notation "( ⊂ X )" := (λ Y, subset Y 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) (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, X Y) (only parsing) : C_scope. Notation "( X ⊄ )" := (λ Y, X Y) (only parsing) : C_scope.
Notation "( ⊄ X )" := (λ Y, Y X) (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. Class ElemOf A B := elem_of: A B Prop.
Instance: Params (@elem_of) 3. Instance: Params (@elem_of) 3.
Infix "∈" := elem_of (at level 70) : C_scope. Infix "∈" := elem_of (at level 70) : C_scope.
...@@ -472,6 +477,11 @@ Class RightDistr {A} (R : relation A) (f g : A → A → A) : Prop := ...@@ -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)). 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 := Class AntiSymmetric {A} (R S : relation A) : Prop :=
anti_symmetric: x y, S x y S y x R x y. 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 irreflexivity {_} _ {_} _ _.
Arguments injective {_ _ _ _} _ {_} _ _ _. Arguments injective {_ _ _ _} _ {_} _ _ _.
...@@ -488,6 +498,9 @@ Arguments right_absorb {_ _} _ _ {_} _. ...@@ -488,6 +498,9 @@ Arguments right_absorb {_ _} _ _ {_} _.
Arguments left_distr {_ _} _ _ {_} _ _ _. Arguments left_distr {_ _} _ _ {_} _ _ _.
Arguments right_distr {_ _} _ _ {_} _ _ _. Arguments right_distr {_ _} _ _ {_} _ _ _.
Arguments anti_symmetric {_ _} _ {_} _ _ _ _. Arguments anti_symmetric {_ _} _ {_} _ _ _ _.
Arguments total {_} _ {_} _ _.
Arguments trichotomy {_} _ {_} _ _.
Arguments trichotomyT {_} _ {_} _ _.
(** The following lemmas are specific versions of the projections of the above (** 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 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 : ...@@ -518,15 +531,22 @@ Lemma right_distr_L {A} (f g : A → A → A) `{!RightDistr (=) f g} y z x :
Proof. auto. Qed. Proof. auto. Qed.
(** ** Axiomatization of ordered structures *) (** ** 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. *) (** A pre-order equipped with a smallest element. *)
Class BoundedPreOrder A `{Empty A} `{SubsetEq A} : Prop := { Class BoundedPreOrder A `{Empty A} `{SubsetEq A} : Prop := {
bounded_preorder :>> PreOrder (); bounded_preorder :>> PreOrder ();
subseteq_empty x : x 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 (** 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. need for proofs that the relations and operations respect setoid equality.
...@@ -678,18 +698,10 @@ Arguments snd_map {_ _ _} _ !_ /. ...@@ -678,18 +698,10 @@ Arguments snd_map {_ _ _} _ !_ /.
Instance: {A A' B} (f : A A'), Instance: {A A' B} (f : A A'),
Injective (=) (=) f Injective (=) (=) (@fst_map A A' B f). Injective (=) (=) f Injective (=) (=) (@fst_map A A' B f).
Proof. Proof. intros ????? [??] [??]; injection 1; firstorder congruence. Qed.
intros ????? [??] [??]; simpl; intro; f_equal.
* apply (injective f). congruence.
* congruence.
Qed.
Instance: {A B B'} (f : B B'), Instance: {A B B'} (f : B B'),
Injective (=) (=) f Injective (=) (=) (@snd_map A B B' f). Injective (=) (=) f Injective (=) (=) (@snd_map A B B' f).
Proof. Proof. intros ????? [??] [??]; injection 1; firstorder congruence. Qed.
intros ????? [??] [??]; simpl; intro; f_equal.
* congruence.
* apply (injective f). congruence.
Qed.
Definition prod_relation {A B} (R1 : relation A) (R2 : relation B) : 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). 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. ...@@ -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). Lemma impl_transitive (P Q R : Prop) : (P Q) (Q R) (P R).
Proof. tauto. Qed. Proof. tauto. Qed.
Instance: Commutative () (@eq A). Instance: Commutative () (@eq A).
Proof. red. intuition. Qed. Proof. red; intuition. Qed.
Instance: Commutative () (λ x y, @eq A y x). Instance: Commutative () (λ x y, @eq A y x).
Proof. red. intuition. Qed. Proof. red; intuition. Qed.
Instance: Commutative () (). Instance: Commutative () ().
Proof. red. intuition. Qed. Proof. red; intuition. Qed.
Instance: Commutative () (). Instance: Commutative () ().
Proof. red. intuition. Qed. Proof. red; intuition. Qed.
Instance: Associative () (). Instance: Associative () ().
Proof. red. intuition. Qed. Proof. red; intuition. Qed.
Instance: Idempotent () (). Instance: Idempotent () ().
Proof. red. intuition. Qed. Proof. red; intuition. Qed.
Instance: Commutative () (). Instance: Commutative () ().
Proof. red. intuition. Qed. Proof. red; intuition. Qed.
Instance: Associative () (). Instance: Associative () ().
Proof. red. intuition. Qed. Proof. red; intuition. Qed.
Instance: Idempotent () (). Instance: Idempotent () ().
Proof. red. intuition. Qed. Proof. red; intuition. Qed.
Instance: LeftId () True (). Instance: LeftId () True ().
Proof. red. intuition. Qed. Proof. red; intuition. Qed.
Instance: RightId () True (). Instance: RightId () True ().
Proof. red. intuition. Qed. Proof. red; intuition. Qed.
Instance: LeftAbsorb () False (). Instance: LeftAbsorb () False ().
Proof. red. intuition. Qed. Proof. red; intuition. Qed.
Instance: RightAbsorb () False (). Instance: RightAbsorb () False ().
Proof. red. intuition. Qed. Proof. red; intuition. Qed.
Instance: LeftId () False (). Instance: LeftId () False ().
Proof. red. intuition. Qed. Proof. red; intuition. Qed.
Instance: RightId () False (). Instance: RightId () False ().
Proof. red. intuition. Qed. Proof. red; intuition. Qed.
Instance: LeftAbsorb () True (). Instance: LeftAbsorb () True ().
Proof. red. intuition. Qed. Proof. red; intuition. Qed.
Instance: RightAbsorb () True (). Instance: RightAbsorb () True ().
Proof. red. intuition. Qed. Proof. red; intuition. Qed.
Instance: LeftId () True impl. Instance: LeftId () True impl.
Proof. unfold impl. red. intuition. Qed. Proof. unfold impl. red; intuition. Qed.
Instance: RightAbsorb () True impl. Instance: RightAbsorb () True impl.
Proof. unfold impl. red. intuition. Qed. Proof. unfold impl. red; intuition. Qed.
Instance: LeftDistr () () (). Instance: LeftDistr () () ().
Proof. red. intuition. Qed. Proof. red; intuition. Qed.
Instance: RightDistr () () (). Instance: RightDistr () () ().
Proof. red. intuition. Qed. Proof. red; intuition. Qed.
Instance: LeftDistr () () (). Instance: LeftDistr () () ().
Proof. red. intuition. Qed. Proof. red; intuition. Qed.
Instance: RightDistr () () (). 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). Lemma not_injective `{Injective A B R R' f} x y : ¬R x y ¬R' (f x) (f y).
Proof. intuition. Qed. Proof. intuition. Qed.
Instance injective_compose {A B C} R1 R2 R3 (f : A B) (g : B C) : Instance injective_compose {A B C} R1 R2 R3 (f : A B) (g : B C) :
......
...@@ -144,7 +144,7 @@ Proof. ...@@ -144,7 +144,7 @@ Proof.
by apply size_non_empty_iff, non_empty_difference. by apply size_non_empty_iff, non_empty_difference.
Qed. 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. Proof. apply well_founded_lt_compat with size, subset_size. Qed.
Lemma collection_ind (P : C Prop) : Lemma collection_ind (P : C Prop) :
......
...@@ -372,7 +372,7 @@ Lemma insert_subset_inv {A} (m1 m2 : M A) i x : ...@@ -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. m2', m2 = <[i:=x]>m2' m1 m2' m2' !! i = None.
Proof. Proof.
intros Hi Hm1m2. exists (delete i m2). split_ands. 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. by rewrite lookup_insert.
* eauto using insert_delete_subset. * eauto using insert_delete_subset.
* by rewrite lookup_delete. * by rewrite lookup_delete.
...@@ -564,7 +564,7 @@ Proof. ...@@ -564,7 +564,7 @@ Proof.
rewrite !map_to_list_insert; simpl; auto with arith. rewrite !map_to_list_insert; simpl; auto with arith.
Qed. Qed.
Lemma map_wf {A} : wf (@subset (M A) _). Lemma map_wf {A} : wf (strict (@subseteq (M A) _)).
Proof. Proof.
apply (wf_projected (<) (length map_to_list)). apply (wf_projected (<) (length map_to_list)).
* by apply map_to_list_length. * by apply map_to_list_length.
...@@ -1013,13 +1013,13 @@ Qed. ...@@ -1013,13 +1013,13 @@ Qed.
Lemma map_union_cancel_l {A} (m1 m2 m3 : M A) : Lemma map_union_cancel_l {A} (m1 m2 m3 : M A) :
m1 m3 m2 m3 m3 m1 = m3 m2 m1 = m2. m1 m3 m2 m3 m3 m1 = m3 m2 m1 = m2.
Proof. Proof.
intros. by apply (anti_symmetric _); intros. by apply (anti_symmetric ());
apply map_union_reflecting_l with m3; auto with congruence. apply map_union_reflecting_l with m3; auto with congruence.
Qed. Qed.
Lemma map_union_cancel_r {A} (m1 m2 m3 : M A) : Lemma map_union_cancel_r {A} (m1 m2 m3 : M A) :
m1 m3 m2 m3 m1 m3 = m2 m3 m1 = m2. m1 m3 m2 m3 m1 m3 = m2 m3 m1 = m2.
Proof. Proof.
intros. apply (anti_symmetric _); intros. apply (anti_symmetric ());
apply map_union_reflecting_r with m3; auto with congruence. apply map_union_reflecting_r with m3; auto with congruence.
Qed. 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. ...@@ -79,7 +79,8 @@ Proof.
apply (lookup_merge f t1 t2). apply (lookup_merge f t1 t2).
Qed. 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). Notation Nset := (mapset Nmap).
Instance Nmap_dom {A} : Dom (Nmap A) Nset := mapset_dom. Instance Nmap_dom {A} : Dom (Nmap A) Nset := mapset_dom.
Instance: FinMapDom N Nmap Nset := mapset_dom_spec. Instance: FinMapDom N Nmap Nset := mapset_dom_spec.
...@@ -187,6 +187,11 @@ Program Instance N_lt_dec (x y : N) : Decision (x < y)%N := ...@@ -187,6 +187,11 @@ Program Instance N_lt_dec (x y : N) : Decision (x < y)%N :=
end. end.
Next Obligation. congruence. Qed. Next Obligation. congruence. Qed.
Instance N_inhabited: Inhabited N := populate 1%N. 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] *) (** * Notations and properties of [Z] *)
Open Scope Z_scope. Open Scope Z_scope.
...@@ -210,6 +215,10 @@ Instance Z_eq_dec: ∀ x y : Z, Decision (x = y) := Z.eq_dec. ...@@ -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_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_lt_dec: x y : Z, Decision (x < y) := Z_lt_dec.
Instance Z_inhabited: Inhabited Z := populate 1. 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. Lemma Z_pow_pred_r n m : 0 < m n * n ^ (Z.pred m) = n ^ m.
Proof. Proof.
...@@ -362,7 +371,7 @@ Proof. apply Z_to_option_nat_Some_alt. auto using Nat2Z.is_nonneg. Qed. ...@@ -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 (** The function [Z_of_sumbool] converts a sumbool [P] into an integer
by yielding one if [P] and zero if [Q]. *) 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. (if p then 1 else 0)%Z.
(** Some correspondence lemmas between [nat] and [N] that are not part of the (** 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 ...@@ -13,4 +13,5 @@ Require Export
fin_collections fin_collections
listset listset
fresh_numbers 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