base.v 59.6 KB
 Robbert Krebbers committed Aug 29, 2012 1 2 (** This file collects type class interfaces, notations, and general theorems that are used throughout the whole development. Most importantly it contains  Robbert Krebbers committed Feb 20, 2019 3 abstract interfaces for ordered structures, sets, and various other data  Robbert Krebbers committed Aug 29, 2012 4 structures. *)  Ralf Jung committed Oct 28, 2017 5   Olivier Laurent committed May 07, 2020 6 7 8 9 (* We want to ensure that [le] and [lt] refer to operations on [nat]. These two functions being defined both in [Coq.Bool] and in [Coq.Peano], we must export [Coq.Peano] later than any export of [Coq.Bool]. *) From Coq Require Export Morphisms RelationClasses List Bool Utf8 Setoid Peano.  Robbert Krebbers committed Mar 03, 2019 10 From Coq Require Import Permutation.  Ralf Jung committed Jan 31, 2017 11 Set Default Proof Using "Type".  Robbert Krebbers committed Aug 19, 2016 12 13 Export ListNotations. From Coq.Program Require Export Basics Syntax.  Robbert Krebbers committed Mar 09, 2017 14   Michael Sammler committed Apr 10, 2020 15 16 17 18 19 (** This notation is necessary to prevent [length] from being printed as [strings.length] if strings.v is imported and later base.v. See also strings.v and https://gitlab.mpi-sws.org/iris/stdpp/-/merge_requests/144 and https://gitlab.mpi-sws.org/iris/stdpp/-/merge_requests/129. *)  Robbert Krebbers committed Apr 08, 2020 20 21 Notation length := Datatypes.length.  Ralf Jung committed Feb 12, 2018 22 23 (** * Enable implicit generalization. *) (** This option enables implicit generalization in arguments of the form  Robbert Krebbers committed Apr 08, 2020 24 25  [{...}] (i.e., anonymous arguments). Unfortunately, it also enables implicit generalization in [Instance]. We think that the fact that both  Ralf Jung committed Oct 28, 2017 26 27 28 29  behaviors are coupled together is a [bug in Coq](https://github.com/coq/coq/issues/6030). *) Global Generalizable All Variables.  Robbert Krebbers committed Oct 28, 2017 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 (** * Tweak program *) (** 1. Since we only use Program to solve logical side-conditions, they should always be made Opaque, otherwise we end up with performance problems due to Coq blindly unfolding them. Note that in most cases we use [Next Obligation. (* ... *) Qed.], for which this option does not matter. However, sometimes we write things like [Solve Obligations with naive_solver (* ... *)], and then the obligations should surely be opaque. *) Global Unset Transparent Obligations. (** 2. Do not let Program automatically simplify obligations. The default obligation tactic is [Tactics.program_simpl], which, among other things, introduces all variables and gives them fresh names. As such, it becomes impossible to refer to hypotheses in a robust way. *)  Robbert Krebbers committed Jan 12, 2016 45 Obligation Tactic := idtac.  Robbert Krebbers committed Oct 28, 2017 46 47  (** 3. Hide obligations from the results of the [Search] commands. *)  Robbert Krebbers committed Mar 09, 2017 48 Add Search Blacklist "_obligation_".  Robbert Krebbers committed Jun 11, 2012 49   Robbert Krebbers committed Oct 28, 2017 50 (** * Sealing off definitions *)  Ralf Jung committed Oct 10, 2017 51 52 53 54 Section seal. Local Set Primitive Projections. Record seal {A} (f : A) := { unseal : A; seal_eq : unseal = f }. End seal.  Ralf Jung committed Oct 13, 2017 55 56 Arguments unseal {_ _} _ : assert. Arguments seal_eq {_ _} _ : assert.  Ralf Jung committed Jan 31, 2017 57   Robbert Krebbers committed Feb 08, 2018 58 (** * Non-backtracking type classes *)  Robbert Krebbers committed Apr 26, 2019 59 (** The type class [TCNoBackTrack P] can be used to establish [P] without ever  Robbert Krebbers committed Feb 08, 2018 60 61 62 63 64 65 66 67 68 69 70 backtracking on the instance of [P] that has been found. Backtracking may normally happen when [P] contains evars that could be instanciated in different ways depending on which instance is picked, and type class search somewhere else depends on this evar. The proper way of handling this would be by setting Coq's option Typeclasses Unique Instances. However, this option seems to be broken, see Coq issue #6714. See https://gitlab.mpi-sws.org/FP/iris-coq/merge_requests/112 for a rationale of this type class. *)  Robbert Krebbers committed Apr 26, 2019 71 72 Class TCNoBackTrack (P : Prop) := { tc_no_backtrack : P }. Hint Extern 0 (TCNoBackTrack _) => constructor; apply _ : typeclass_instances.  Robbert Krebbers committed Feb 08, 2018 73   Robbert Krebbers committed Feb 19, 2018 74 75 (* A conditional at the type class level. Note that [TCIf P Q R] is not the same as [TCOr (TCAnd P Q) R]: the latter will backtrack to [R] if it fails to  Paolo G. Giarrusso committed Apr 26, 2019 76 establish [Q], i.e. does not have the behavior of a conditional. Furthermore,  Robbert Krebbers committed Feb 19, 2018 77 note that [TCOr (TCAnd P Q) (TCAnd (TCNot P) R)] would not work; we generally  Robbert Krebbers committed Feb 19, 2018 78 would not be able to prove the negation of [P]. *)  Robbert Krebbers committed Feb 22, 2018 79 Inductive TCIf (P Q R : Prop) : Prop :=  Robbert Krebbers committed Feb 19, 2018 80 81 82 83 84 85 86 87  | TCIf_true : P → Q → TCIf P Q R | TCIf_false : R → TCIf P Q R. Existing Class TCIf. Hint Extern 0 (TCIf _ _ _) => first [apply TCIf_true; [apply _|] |apply TCIf_false] : typeclass_instances.  Robbert Krebbers committed Oct 28, 2017 88 (** * Typeclass opaque definitions *)  Ralf Jung committed Feb 12, 2018 89 (** The constant [tc_opaque] is used to make definitions opaque for just type  Robbert Krebbers committed Oct 06, 2017 90 91 92 93 94 class search. Note that [simpl] is set up to always unfold [tc_opaque]. *) Definition tc_opaque {A} (x : A) : A := x. Typeclasses Opaque tc_opaque. Arguments tc_opaque {_} _ /.  Ralf Jung committed Feb 12, 2018 95 (** Below we define type class versions of the common logical operators. It is  Robbert Krebbers committed Sep 02, 2017 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 important to note that we duplicate the definitions, and do not declare the existing logical operators as type classes. That is, we do not say: Existing Class or. Existing Class and. If we could define the existing logical operators as classes, there is no way of disambiguating whether a premise of a lemma should be solved by type class resolution or not. These classes are useful for two purposes: writing complicated type class premises in a more concise way, and for efficiency. For example, using the [Or] class, instead of defining two instances [P → Q1 → R] and [P → Q2 → R] we could have one instance [P → Or Q1 Q2 → R]. When we declare the instance that way, we avoid the need to derive [P] twice. *)  Robbert Krebbers committed Sep 02, 2017 111 Inductive TCOr (P1 P2 : Prop) : Prop :=  Robbert Krebbers committed Sep 02, 2017 112 113 114 115 116  | TCOr_l : P1 → TCOr P1 P2 | TCOr_r : P2 → TCOr P1 P2. Existing Class TCOr. Existing Instance TCOr_l | 9. Existing Instance TCOr_r | 10.  Robbert Krebbers committed Mar 10, 2020 117 Hint Mode TCOr ! ! : typeclass_instances.  Robbert Krebbers committed Aug 08, 2017 118   Robbert Krebbers committed Sep 02, 2017 119 Inductive TCAnd (P1 P2 : Prop) : Prop := TCAnd_intro : P1 → P2 → TCAnd P1 P2.  Robbert Krebbers committed Sep 02, 2017 120 121 Existing Class TCAnd. Existing Instance TCAnd_intro.  Robbert Krebbers committed Mar 10, 2020 122 Hint Mode TCAnd ! ! : typeclass_instances.  Robbert Krebbers committed Aug 17, 2017 123   Robbert Krebbers committed Sep 02, 2017 124 125 126 Inductive TCTrue : Prop := TCTrue_intro : TCTrue. Existing Class TCTrue. Existing Instance TCTrue_intro.  Robbert Krebbers committed Aug 17, 2017 127   Robbert Krebbers committed Sep 02, 2017 128 129 130 131 132 133 Inductive TCForall {A} (P : A → Prop) : list A → Prop := | TCForall_nil : TCForall P [] | TCForall_cons x xs : P x → TCForall P xs → TCForall P (x :: xs). Existing Class TCForall. Existing Instance TCForall_nil. Existing Instance TCForall_cons.  Robbert Krebbers committed Mar 10, 2020 134 Hint Mode TCForall ! ! ! : typeclass_instances.  Robbert Krebbers committed Sep 02, 2017 135   Robbert Krebbers committed Mar 10, 2020 136 137 138 (** The class [TCForall2 P l k] is commonly used to transform an input list [l] into an output list [k], or the converse. Therefore there are two modes, either [l] input and [k] output, or [k] input and [l] input. *)  Robbert Krebbers committed Dec 08, 2017 139 140 141 142 143 144 145 Inductive TCForall2 {A B} (P : A → B → Prop) : list A → list B → Prop := | TCForall2_nil : TCForall2 P [] [] | TCForall2_cons x y xs ys : P x y → TCForall2 P xs ys → TCForall2 P (x :: xs) (y :: ys). Existing Class TCForall2. Existing Instance TCForall2_nil. Existing Instance TCForall2_cons.  Robbert Krebbers committed Mar 10, 2020 146 147 Hint Mode TCForall2 ! ! ! ! - : typeclass_instances. Hint Mode TCForall2 ! ! ! - ! : typeclass_instances.  Robbert Krebbers committed Dec 08, 2017 148   Robbert Krebbers committed Nov 30, 2018 149 150 151 152 153 154 Inductive TCElemOf {A} (x : A) : list A → Prop := | TCElemOf_here xs : TCElemOf x (x :: xs) | TCElemOf_further y xs : TCElemOf x xs → TCElemOf x (y :: xs). Existing Class TCElemOf. Existing Instance TCElemOf_here. Existing Instance TCElemOf_further.  Robbert Krebbers committed Mar 10, 2020 155 Hint Mode TCElemOf ! ! ! : typeclass_instances.  Robbert Krebbers committed Nov 30, 2018 156   Robbert Krebbers committed Mar 10, 2020 157 158 159 160 (** We declare both arguments [x] and [y] of [TCEq x y] as outputs, which means [TCEq] can also be used to unify evars. This is harmless: since the only instance of [TCEq] is [TCEq_refl] below, it can never cause loops. See https://gitlab.mpi-sws.org/iris/iris/merge_requests/391 for a use case. *)  Robbert Krebbers committed Feb 02, 2018 161 162 163 Inductive TCEq {A} (x : A) : A → Prop := TCEq_refl : TCEq x x. Existing Class TCEq. Existing Instance TCEq_refl.  Robbert Krebbers committed Mar 10, 2020 164 Hint Mode TCEq ! - - : typeclass_instances.  Robbert Krebbers committed Feb 02, 2018 165   Michael Sammler committed Mar 31, 2020 166 167 168 Lemma TCEq_eq {A} (x1 x2 : A) : TCEq x1 x2 ↔ x1 = x2. Proof. split; destruct 1; reflexivity. Qed.  Robbert Krebbers committed Feb 23, 2018 169 170 171 172 Inductive TCDiag {A} (C : A → Prop) : A → A → Prop := | TCDiag_diag x : C x → TCDiag C x x. Existing Class TCDiag. Existing Instance TCDiag_diag.  Robbert Krebbers committed Mar 10, 2020 173 174 Hint Mode TCDiag ! ! ! - : typeclass_instances. Hint Mode TCDiag ! ! - ! : typeclass_instances.  Robbert Krebbers committed Feb 23, 2018 175   176 177 178 179 180 181 (** Given a proposition [P] that is a type class, [tc_to_bool P] will return [true] iff there is an instance of [P]. It is often useful in Ltac programming, where one can do [lazymatch tc_to_bool P with true => .. | false => .. end]. *) Definition tc_to_bool (P : Prop) {p : bool} {TCIf P (TCEq p true) (TCEq p false)} : bool := p.  Robbert Krebbers committed Nov 09, 2017 182 (** Throughout this development we use [stdpp_scope] for all general purpose  Robbert Krebbers committed May 27, 2016 183 notations that do not belong to a more specific scope. *)  Robbert Krebbers committed Nov 09, 2017 184 185 Delimit Scope stdpp_scope with stdpp. Global Open Scope stdpp_scope.  Robbert Krebbers committed Aug 21, 2012 186   Robbert Krebbers committed Aug 29, 2012 187 (** Change [True] and [False] into notations in order to enable overloading.  Robbert Krebbers committed May 27, 2016 188 189 We will use this to give [True] and [False] a different interpretation for embedded logics. *)  Ralf Jung committed Jun 10, 2018 190 191 Notation "'True'" := True (format "True") : type_scope. Notation "'False'" := False (format "False") : type_scope.  Robbert Krebbers committed Jun 11, 2012 192   Gregory Malecha committed May 27, 2020 193 (** Change [forall] into a notation in order to enable overloading. *)  Tej Chajed committed May 27, 2020 194 Notation "'forall' x .. y , P" := (forall x, .. (forall y, P) ..)  Gregory Malecha committed May 27, 2020 195 196 197  (at level 200, x binder, y binder, right associativity, only parsing) : type_scope.  Robbert Krebbers committed Jun 11, 2012 198   Robbert Krebbers committed May 27, 2016 199 (** * Equality *)  Robbert Krebbers committed Aug 29, 2012 200 (** Introduce some Haskell style like notations. *)  Robbert Krebbers committed Nov 09, 2017 201 Notation "(=)" := eq (only parsing) : stdpp_scope.  Robbert Krebbers committed Sep 19, 2019 202 203 Notation "( x =.)" := (eq x) (only parsing) : stdpp_scope. Notation "(.= x )" := (λ y, eq y x) (only parsing) : stdpp_scope.  Robbert Krebbers committed Nov 09, 2017 204 Notation "(≠)" := (λ x y, x ≠ y) (only parsing) : stdpp_scope.  Robbert Krebbers committed Sep 19, 2019 205 206 Notation "( x ≠.)" := (λ y, x ≠ y) (only parsing) : stdpp_scope. Notation "(.≠ x )" := (λ y, y ≠ x) (only parsing) : stdpp_scope.  Robbert Krebbers committed Jun 11, 2012 207   208 209 210 211 Infix "=@{ A }" := (@eq A) (at level 70, only parsing, no associativity) : stdpp_scope. Notation "(=@{ A } )" := (@eq A) (only parsing) : stdpp_scope. Notation "(≠@{ A } )" := (λ X Y, ¬X =@{A} Y) (only parsing) : stdpp_scope.  Robbert Krebbers committed Apr 27, 2018 212 213 Notation "X ≠@{ A } Y":= (¬X =@{ A } Y) (at level 70, only parsing, no associativity) : stdpp_scope.  214   Tej Chajed committed Nov 28, 2018 215 216 Hint Extern 0 (_ = _) => reflexivity : core. Hint Extern 100 (_ ≠ _) => discriminate : core.  Robbert Krebbers committed Jun 11, 2012 217   218 Instance: ∀ A, PreOrder (=@{A}).  Robbert Krebbers committed May 27, 2016 219 220 221 Proof. split; repeat intro; congruence. Qed. (** ** Setoid equality *)  Ralf Jung committed Dec 05, 2017 222 223 224 (** We define an operational type class for setoid equality, i.e., the "canonical" equivalence for a type. The typeclass is tied to the \equiv symbol. This is based on (Spitters/van der Weegen, 2011). *)  Robbert Krebbers committed May 27, 2016 225 Class Equiv A := equiv: relation A.  Robbert Krebbers committed Sep 17, 2017 226 227 228 (* No Hint Mode set because of Coq bug #5735 Hint Mode Equiv ! : typeclass_instances. *)  Robbert Krebbers committed Nov 09, 2017 229 Infix "≡" := equiv (at level 70, no associativity) : stdpp_scope.  230 231 232 Infix "≡@{ A }" := (@equiv A _) (at level 70, only parsing, no associativity) : stdpp_scope.  Robbert Krebbers committed Nov 09, 2017 233 Notation "(≡)" := equiv (only parsing) : stdpp_scope.  Robbert Krebbers committed Sep 19, 2019 234 235 Notation "( X ≡.)" := (equiv X) (only parsing) : stdpp_scope. Notation "(.≡ X )" := (λ Y, Y ≡ X) (only parsing) : stdpp_scope.  Robbert Krebbers committed Nov 09, 2017 236 237 Notation "(≢)" := (λ X Y, ¬X ≡ Y) (only parsing) : stdpp_scope. Notation "X ≢ Y":= (¬X ≡ Y) (at level 70, no associativity) : stdpp_scope.  Robbert Krebbers committed Sep 19, 2019 238 239 Notation "( X ≢.)" := (λ Y, X ≢ Y) (only parsing) : stdpp_scope. Notation "(.≢ X )" := (λ Y, Y ≢ X) (only parsing) : stdpp_scope.  Robbert Krebbers committed May 27, 2016 240   241 242 Notation "(≡@{ A } )" := (@equiv A _) (only parsing) : stdpp_scope. Notation "(≢@{ A } )" := (λ X Y, ¬X ≡@{A} Y) (only parsing) : stdpp_scope.  Robbert Krebbers committed Apr 27, 2018 243 244 Notation "X ≢@{ A } Y":= (¬X ≡@{ A } Y) (at level 70, only parsing, no associativity) : stdpp_scope.  245   Robbert Krebbers committed May 27, 2016 246 247 248 249 250 (** The type class [LeibnizEquiv] collects setoid equalities that coincide with Leibniz equality. We provide the tactic [fold_leibniz] to transform such setoid equalities into Leibniz equalities, and [unfold_leibniz] for the reverse. *) Class LeibnizEquiv A {Equiv A} := leibniz_equiv x y : x ≡ y → x = y.  Robbert Krebbers committed Sep 17, 2017 251 252 Hint Mode LeibnizEquiv ! - : typeclass_instances.  253 Lemma leibniz_equiv_iff {LeibnizEquiv A, !Reflexive (≡@{A})} (x y : A) :  Robbert Krebbers committed May 27, 2016 254 255  x ≡ y ↔ x = y. Proof. split. apply leibniz_equiv. intros ->; reflexivity. Qed.  Robbert Krebbers committed Sep 17, 2017 256   Robbert Krebbers committed May 27, 2016 257 258 Ltac fold_leibniz := repeat match goal with  259  | H : context [ _ ≡@{?A} _ ] |- _ =>  Robbert Krebbers committed May 27, 2016 260  setoid_rewrite (leibniz_equiv_iff (A:=A)) in H  261  | |- context [ _ ≡@{?A} _ ] =>  Robbert Krebbers committed May 27, 2016 262 263 264 265  setoid_rewrite (leibniz_equiv_iff (A:=A)) end. Ltac unfold_leibniz := repeat match goal with  266  | H : context [ _ =@{?A} _ ] |- _ =>  Robbert Krebbers committed May 27, 2016 267  setoid_rewrite <-(leibniz_equiv_iff (A:=A)) in H  268  | |- context [ _ =@{?A} _ ] =>  Robbert Krebbers committed May 27, 2016 269 270 271 272 273 274 275 276  setoid_rewrite <-(leibniz_equiv_iff (A:=A)) end. Definition equivL {A} : Equiv A := (=). (** A [Params f n] instance forces the setoid rewriting mechanism not to rewrite in the first [n] arguments of the function [f]. We will declare such instances for all operational type classes in this development. *)  Maxime Dénès committed Jan 24, 2019 277 Instance: Params (@equiv) 2 := {}.  Robbert Krebbers committed May 27, 2016 278 279 280 281  (** The following instance forces [setoid_replace] to use setoid equality (for types that have an [Equiv] instance) rather than the standard Leibniz equality. *)  Maxime Dénès committed Jan 24, 2019 282 Instance equiv_default_relation {Equiv A} : DefaultRelation (≡) | 3 := {}.  Tej Chajed committed Nov 28, 2018 283 284 Hint Extern 0 (_ ≡ _) => reflexivity : core. Hint Extern 0 (_ ≡ _) => symmetry; assumption : core.  Robbert Krebbers committed May 27, 2016 285 286 287 288 289  (** * Type classes *) (** ** Decidable propositions *) (** This type class by (Spitters/van der Weegen, 2011) collects decidable  290 propositions. *)  Robbert Krebbers committed May 27, 2016 291 Class Decision (P : Prop) := decide : {P} + {¬P}.  Robbert Krebbers committed Sep 17, 2017 292 Hint Mode Decision ! : typeclass_instances.  293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 Arguments decide _ {_} : simpl never, assert. (** Although [RelDecision R] is just [∀ x y, Decision (R x y)], we make this an explicit class instead of a notation for two reasons: - It allows us to control [Hint Mode] more precisely. In particular, if it were defined as a notation, the above [Hint Mode] for [Decision] would not prevent diverging instance search when looking for [RelDecision (@eq ?A)], which would result in it looking for [Decision (@eq ?A x y)], i.e. an instance where the head position of [Decision] is not en evar. - We use it to avoid inefficient computation due to eager evaluation of propositions by [vm_compute]. This inefficiency arises for example if [(x = y) := (f x = f y)]. Since [decide (x = y)] evaluates to [decide (f x = f y)], this would then lead to evaluation of [f x] and [f y]. Using the [RelDecision], the [f] is hidden under a lambda, which prevents unnecessary evaluation. *) Class RelDecision {A B} (R : A → B → Prop) := decide_rel x y :> Decision (R x y). Hint Mode RelDecision ! ! ! : typeclass_instances. Arguments decide_rel {_ _} _ {_} _ _ : simpl never, assert.  313 Notation EqDecision A := (RelDecision (=@{A})).  Robbert Krebbers committed May 27, 2016 314 315 316 317  (** ** Inhabited types *) (** This type class collects types that are inhabited. *) Class Inhabited (A : Type) : Type := populate { inhabitant : A }.  Robbert Krebbers committed Sep 17, 2017 318 Hint Mode Inhabited ! : typeclass_instances.  Robbert Krebbers committed Sep 08, 2017 319 Arguments populate {_} _ : assert.  Robbert Krebbers committed May 27, 2016 320 321 322 323 324 325  (** ** Proof irrelevant types *) (** This type class collects types that are proof irrelevant. That means, all elements of the type are equal. We use this notion only used for propositions, but by universe polymorphism we can generalize it. *) Class ProofIrrel (A : Type) : Prop := proof_irrel (x y : A) : x = y.  Robbert Krebbers committed Sep 17, 2017 326 Hint Mode ProofIrrel ! : typeclass_instances.  Robbert Krebbers committed May 27, 2016 327 328 329  (** ** Common properties *) (** These operational type classes allow us to refer to common mathematical  Robbert Krebbers committed Sep 19, 2019 330 331 properties in a generic way. For example, for injectivity of [(k ++.)] it allows us to write [inj (k ++.)] instead of [app_inv_head k]. *)  Robbert Krebbers committed May 27, 2016 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 Class Inj {A B} (R : relation A) (S : relation B) (f : A → B) : Prop := inj x y : S (f x) (f y) → R x y. Class Inj2 {A B C} (R1 : relation A) (R2 : relation B) (S : relation C) (f : A → B → C) : Prop := inj2 x1 x2 y1 y2 : S (f x1 x2) (f y1 y2) → R1 x1 y1 ∧ R2 x2 y2. Class Cancel {A B} (S : relation B) (f : A → B) (g : B → A) : Prop := cancel : ∀ x, S (f (g x)) x. Class Surj {A B} (R : relation B) (f : A → B) := surj y : ∃ x, R (f x) y. Class IdemP {A} (R : relation A) (f : A → A → A) : Prop := idemp x : R (f x x) x. Class Comm {A B} (R : relation A) (f : B → B → A) : Prop := comm x y : R (f x y) (f y x). Class LeftId {A} (R : relation A) (i : A) (f : A → A → A) : Prop := left_id x : R (f i x) x. Class RightId {A} (R : relation A) (i : A) (f : A → A → A) : Prop := right_id x : R (f x i) x. Class Assoc {A} (R : relation A) (f : A → A → A) : Prop := assoc x y z : R (f x (f y z)) (f (f x y) z). Class LeftAbsorb {A} (R : relation A) (i : A) (f : A → A → A) : Prop := left_absorb x : R (f i x) i. Class RightAbsorb {A} (R : relation A) (i : A) (f : A → A → A) : Prop := right_absorb x : R (f x i) i. Class AntiSymm {A} (R S : relation A) : Prop := anti_symm 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 : R x y ∨ x = y ∨ R y x. Class TrichotomyT {A} (R : relation A) := trichotomyT x y : {R x y} + {x = y} + {R y x}.  Robbert Krebbers committed Jun 26, 2019 362 363 364 365 366  Notation Involutive R f := (Cancel R f f). Lemma involutive {A} {R : relation A} (f : A → A) {Involutive R f} x : R (f (f x)) x. Proof. auto. Qed.  Robbert Krebbers committed May 27, 2016 367   Robbert Krebbers committed Sep 08, 2017 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 Arguments irreflexivity {_} _ {_} _ _ : assert. Arguments inj {_ _ _ _} _ {_} _ _ _ : assert. Arguments inj2 {_ _ _ _ _ _} _ {_} _ _ _ _ _: assert. Arguments cancel {_ _ _} _ _ {_} _ : assert. Arguments surj {_ _ _} _ {_} _ : assert. Arguments idemp {_ _} _ {_} _ : assert. Arguments comm {_ _ _} _ {_} _ _ : assert. Arguments left_id {_ _} _ _ {_} _ : assert. Arguments right_id {_ _} _ _ {_} _ : assert. Arguments assoc {_ _} _ {_} _ _ _ : assert. Arguments left_absorb {_ _} _ _ {_} _ : assert. Arguments right_absorb {_ _} _ _ {_} _ : assert. Arguments anti_symm {_ _} _ {_} _ _ _ _ : assert. Arguments total {_} _ {_} _ _ : assert. Arguments trichotomy {_} _ {_} _ _ : assert. Arguments trichotomyT {_} _ {_} _ _ : assert.  Robbert Krebbers committed May 27, 2016 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436  Lemma not_symmetry {R : relation A, !Symmetric R} x y : ¬R x y → ¬R y x. Proof. intuition. Qed. Lemma symmetry_iff (R : relation A) {!Symmetric R} x y : R x y ↔ R y x. Proof. intuition. Qed. Lemma not_inj {Inj A B R R' f} x y : ¬R x y → ¬R' (f x) (f y). Proof. intuition. Qed. Lemma not_inj2_1 {Inj2 A B C R R' R'' f} x1 x2 y1 y2 : ¬R x1 x2 → ¬R'' (f x1 y1) (f x2 y2). Proof. intros HR HR''. destruct (inj2 f x1 y1 x2 y2); auto. Qed. Lemma not_inj2_2 {Inj2 A B C R R' R'' f} x1 x2 y1 y2 : ¬R' y1 y2 → ¬R'' (f x1 y1) (f x2 y2). Proof. intros HR' HR''. destruct (inj2 f x1 y1 x2 y2); auto. Qed. Lemma inj_iff {A B} {R : relation A} {S : relation B} (f : A → B) {!Inj R S f} {!Proper (R ==> S) f} x y : S (f x) (f y) ↔ R x y. Proof. firstorder. Qed. Instance inj2_inj_1 {Inj2 A B C R1 R2 R3 f} y : Inj R1 R3 (λ x, f x y). Proof. repeat intro; edestruct (inj2 f); eauto. Qed. Instance inj2_inj_2 {Inj2 A B C R1 R2 R3 f} x : Inj R2 R3 (f x). Proof. repeat intro; edestruct (inj2 f); eauto. Qed. Lemma cancel_inj {Cancel A B R1 f g, !Equivalence R1, !Proper (R2 ==> R1) f} : Inj R1 R2 g. Proof. intros x y E. rewrite <-(cancel f g x), <-(cancel f g y), E. reflexivity. Qed. Lemma cancel_surj {Cancel A B R1 f g} : Surj R1 f. Proof. intros y. exists (g y). auto. Qed. (** 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 use the setoid rewriting mechanism. *) Lemma idemp_L {A} f {!@IdemP A (=) f} x : f x x = x. Proof. auto. Qed. Lemma comm_L {A B} f {!@Comm A B (=) f} x y : f x y = f y x. Proof. auto. Qed. Lemma left_id_L {A} i f {!@LeftId A (=) i f} x : f i x = x. Proof. auto. Qed. Lemma right_id_L {A} i f {!@RightId A (=) i f} x : f x i = x. Proof. auto. Qed. Lemma assoc_L {A} f {!@Assoc A (=) f} x y z : f x (f y z) = f (f x y) z. Proof. auto. Qed. Lemma left_absorb_L {A} i f {!@LeftAbsorb A (=) i f} x : f i x = i. Proof. auto. Qed. Lemma right_absorb_L {A} i f {!@RightAbsorb A (=) i f} x : f x i = i. Proof. auto. Qed. (** ** Generic orders *) (** The classes [PreOrder], [PartialOrder], and [TotalOrder] use an arbitrary relation [R] instead of [⊆] to support multiple orders on the same type. *) Definition strict {A} (R : relation A) : relation A := λ X Y, R X Y ∧ ¬R Y X.  Maxime Dénès committed Jan 24, 2019 437 Instance: Params (@strict) 2 := {}.  Robbert Krebbers committed May 27, 2016 438 439 440 441 442 443 444 445 446 447 Class PartialOrder {A} (R : relation A) : Prop := { partial_order_pre :> PreOrder R; partial_order_anti_symm :> AntiSymm (=) R }. Class TotalOrder {A} (R : relation A) : Prop := { total_order_partial :> PartialOrder R; total_order_trichotomy :> Trichotomy (strict R) }. (** * Logic *)  Robbert Krebbers committed Feb 14, 2020 448 449 Instance prop_inhabited : Inhabited Prop := populate True.  Robbert Krebbers committed Nov 09, 2017 450 Notation "(∧)" := and (only parsing) : stdpp_scope.  Robbert Krebbers committed Sep 19, 2019 451 452 Notation "( A ∧.)" := (and A) (only parsing) : stdpp_scope. Notation "(.∧ B )" := (λ A, A ∧ B) (only parsing) : stdpp_scope.  Robbert Krebbers committed May 27, 2016 453   Robbert Krebbers committed Nov 09, 2017 454 Notation "(∨)" := or (only parsing) : stdpp_scope.  Robbert Krebbers committed Sep 19, 2019 455 456 Notation "( A ∨.)" := (or A) (only parsing) : stdpp_scope. Notation "(.∨ B )" := (λ A, A ∨ B) (only parsing) : stdpp_scope.  Robbert Krebbers committed May 27, 2016 457   Robbert Krebbers committed Nov 09, 2017 458 Notation "(↔)" := iff (only parsing) : stdpp_scope.  Robbert Krebbers committed Sep 19, 2019 459 460 Notation "( A ↔.)" := (iff A) (only parsing) : stdpp_scope. Notation "(.↔ B )" := (λ A, A ↔ B) (only parsing) : stdpp_scope.  Robbert Krebbers committed May 27, 2016 461   Tej Chajed committed Nov 28, 2018 462 463 Hint Extern 0 (_ ↔ _) => reflexivity : core. Hint Extern 0 (_ ↔ _) => symmetry; assumption : core.  Robbert Krebbers committed May 27, 2016 464 465 466 467 468 469 470 471 472 473 474  Lemma or_l P Q : ¬Q → P ∨ Q ↔ P. Proof. tauto. Qed. Lemma or_r P Q : ¬P → P ∨ Q ↔ Q. Proof. tauto. Qed. Lemma and_wlog_l (P Q : Prop) : (Q → P) → Q → (P ∧ Q). Proof. tauto. Qed. Lemma and_wlog_r (P Q : Prop) : P → (P → Q) → (P ∧ Q). Proof. tauto. Qed. Lemma impl_transitive (P Q R : Prop) : (P → Q) → (Q → R) → (P → R). Proof. tauto. Qed.  Robbert Krebbers committed Jul 22, 2016 475 476 477 478 479 480 Lemma forall_proper {A} (P Q : A → Prop) : (∀ x, P x ↔ Q x) → (∀ x, P x) ↔ (∀ x, Q x). Proof. firstorder. Qed. Lemma exist_proper {A} (P Q : A → Prop) : (∀ x, P x ↔ Q x) → (∃ x, P x) ↔ (∃ x, Q x). Proof. firstorder. Qed.  Robbert Krebbers committed May 27, 2016 481   482 Instance: Comm (↔) (=@{A}).  Robbert Krebbers committed May 27, 2016 483 Proof. red; intuition. Qed.  484 Instance: Comm (↔) (λ x y, y =@{A} x).  Robbert Krebbers committed May 27, 2016 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 Proof. red; intuition. Qed. Instance: Comm (↔) (↔). Proof. red; intuition. Qed. Instance: Comm (↔) (∧). Proof. red; intuition. Qed. Instance: Assoc (↔) (∧). Proof. red; intuition. Qed. Instance: IdemP (↔) (∧). Proof. red; intuition. Qed. Instance: Comm (↔) (∨). Proof. red; intuition. Qed. Instance: Assoc (↔) (∨). Proof. red; intuition. Qed. Instance: IdemP (↔) (∨). Proof. red; intuition. Qed. Instance: LeftId (↔) True (∧). Proof. red; intuition. Qed. Instance: RightId (↔) True (∧). Proof. red; intuition. Qed. Instance: LeftAbsorb (↔) False (∧). Proof. red; intuition. Qed. Instance: RightAbsorb (↔) False (∧). Proof. red; intuition. Qed. Instance: LeftId (↔) False (∨). Proof. red; intuition. Qed. Instance: RightId (↔) False (∨). Proof. red; intuition. Qed. Instance: LeftAbsorb (↔) True (∨). Proof. red; intuition. Qed. Instance: RightAbsorb (↔) True (∨). Proof. red; intuition. Qed. Instance: LeftId (↔) True impl. Proof. unfold impl. red; intuition. Qed. Instance: RightAbsorb (↔) True impl. Proof. unfold impl. red; intuition. Qed. (** * Common data types *) (** ** Functions *)  Robbert Krebbers committed Nov 09, 2017 524 Notation "(→)" := (λ A B, A → B) (only parsing) : stdpp_scope.  Robbert Krebbers committed Sep 19, 2019 525 526 Notation "( A →.)" := (λ B, A → B) (only parsing) : stdpp_scope. Notation "(.→ B )" := (λ A, A → B) (only parsing) : stdpp_scope.  Robbert Krebbers committed Jan 09, 2013 527   Robbert Krebbers committed Aug 21, 2012 528 Notation "t $r" := (t r)  Robbert Krebbers committed Nov 09, 2017 529 530  (at level 65, right associativity, only parsing) : stdpp_scope. Notation "($)" := (λ f x, f x) (only parsing) : stdpp_scope.  Robbert Krebbers committed Sep 19, 2019 531 Notation "(.\$ x )" := (λ f, f x) (only parsing) : stdpp_scope.  Robbert Krebbers committed Jan 09, 2013 532   Robbert Krebbers committed Nov 09, 2017 533 534 Infix "∘" := compose : stdpp_scope. Notation "(∘)" := compose (only parsing) : stdpp_scope.  Robbert Krebbers committed Sep 19, 2019 535 536 Notation "( f ∘.)" := (compose f) (only parsing) : stdpp_scope. Notation "(.∘ f )" := (λ g, compose g f) (only parsing) : stdpp_scope.  Robbert Krebbers committed Aug 29, 2012 537   Robbert Krebbers committed May 29, 2016 538 539 540 Instance impl_inhabited {A} {Inhabited B} : Inhabited (A → B) := populate (λ _, inhabitant).  Robbert Krebbers committed May 27, 2016 541 542 (** Ensure that [simpl] unfolds [id], [compose], and [flip] when fully applied. *)  Robbert Krebbers committed Sep 08, 2017 543 544 545 546 Arguments id _ _ / : assert. Arguments compose _ _ _ _ _ _ / : assert. Arguments flip _ _ _ _ _ _ / : assert. Arguments const _ _ _ _ / : assert.  547 Typeclasses Transparent id compose flip const.  Robbert Krebbers committed May 27, 2016 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594  Definition fun_map {A A' B B'} (f: A' → A) (g: B → B') (h : A → B) : A' → B' := g ∘ h ∘ f. Instance const_proper {R1 : relation A, R2 : relation B} (x : B) : Reflexive R2 → Proper (R1 ==> R2) (λ _, x). Proof. intros ? y1 y2; reflexivity. Qed. Instance id_inj {A} : Inj (=) (=) (@id A). Proof. intros ??; auto. Qed. Instance compose_inj {A B C} R1 R2 R3 (f : A → B) (g : B → C) : Inj R1 R2 f → Inj R2 R3 g → Inj R1 R3 (g ∘ f). Proof. red; intuition. Qed. Instance id_surj {A} : Surj (=) (@id A). Proof. intros y; exists y; reflexivity. Qed. Instance compose_surj {A B C} R (f : A → B) (g : B → C) : Surj (=) f → Surj R g → Surj R (g ∘ f). Proof. intros ?? x. unfold compose. destruct (surj g x) as [y ?]. destruct (surj f y) as [z ?]. exists z. congruence. Qed. Instance id_comm {A B} (x : B) : Comm (=) (λ _ _ : A, x). Proof. intros ?; reflexivity. Qed. Instance id_assoc {A} (x : A) : Assoc (=) (λ _ _ : A, x). Proof. intros ???; reflexivity. Qed. Instance const1_assoc {A} : Assoc (=) (λ x _ : A, x). Proof. intros ???; reflexivity. Qed. Instance const2_assoc {A} : Assoc (=) (λ _ x : A, x). Proof. intros ???; reflexivity. Qed. Instance const1_idemp {A} : IdemP (=) (λ x _ : A, x). Proof. intros ?; reflexivity. Qed. Instance const2_idemp {A} : IdemP (=) (λ _ x : A, x). Proof. intros ?; reflexivity. Qed. (** ** Lists *) Instance list_inhabited {A} : Inhabited (list A) := populate []. Definition zip_with {A B C} (f : A → B → C) : list A → list B → list C := fix go l1 l2 := match l1, l2 with x1 :: l1, x2 :: l2 => f x1 x2 :: go l1 l2 | _ , _ => [] end. Notation zip := (zip_with pair). (** ** Booleans *) (** The following coercion allows us to use Booleans as propositions. *) Coercion Is_true : bool >-> Sortclass.  Tej Chajed committed Nov 28, 2018 595 596 597 Hint Unfold Is_true : core. Hint Immediate Is_true_eq_left : core. Hint Resolve orb_prop_intro andb_prop_intro : core.  Robbert Krebbers committed May 27, 2016 598 599 600 601 602 603 Notation "(&&)" := andb (only parsing). Notation "(||)" := orb (only parsing). Infix "&&*" := (zip_with (&&)) (at level 40). Infix "||*" := (zip_with (||)) (at level 50). Instance bool_inhabated : Inhabited bool := populate true.  Robbert Krebbers committed Jan 09, 2013 604   Robbert Krebbers committed May 27, 2016 605 606 607 608 609 Definition bool_le (β1 β2 : bool) : Prop := negb β1 || β2. Infix "=.>" := bool_le (at level 70). Infix "=.>*" := (Forall2 bool_le) (at level 70). Instance: PartialOrder bool_le. Proof. repeat split; repeat intros [|]; compute; tauto. Qed.  Robbert Krebbers committed Jan 09, 2013 610   Robbert Krebbers committed May 27, 2016 611 612 613 614 615 616 617 618 Lemma andb_True b1 b2 : b1 && b2 ↔ b1 ∧ b2. Proof. destruct b1, b2; simpl; tauto. Qed. Lemma orb_True b1 b2 : b1 || b2 ↔ b1 ∨ b2. Proof. destruct b1, b2; simpl; tauto. Qed. Lemma negb_True b : negb b ↔ ¬b. Proof. destruct b; simpl; tauto. Qed. Lemma Is_true_false (b : bool) : b = false → ¬b. Proof. now intros -> ?. Qed.  Robbert Krebbers committed Jan 09, 2013 619   Robbert Krebbers committed May 27, 2016 620 621 (** ** Unit *) Instance unit_equiv : Equiv unit := λ _ _, True.  622 Instance unit_equivalence : Equivalence (≡@{unit}).  Robbert Krebbers committed May 27, 2016 623 Proof. repeat split. Qed.  Robbert Krebbers committed Jul 11, 2016 624 625 Instance unit_leibniz : LeibnizEquiv unit. Proof. intros [] []; reflexivity. Qed.  Robbert Krebbers committed May 27, 2016 626 Instance unit_inhabited: Inhabited unit := populate ().  Robbert Krebbers committed May 02, 2014 627   Ralf Jung committed Aug 26, 2019 628 629 630 631 632 633 634 (** ** Empty *) Instance Empty_set_equiv : Equiv Empty_set := λ _ _, True. Instance Empty_set_equivalence : Equivalence (≡@{Empty_set}). Proof. repeat split. Qed. Instance Empty_set_leibniz : LeibnizEquiv Empty_set. Proof. intros [] []; reflexivity. Qed.  Robbert Krebbers committed May 27, 2016 635 (** ** Products *)  Robbert Krebbers committed Sep 19, 2019 636 637 Notation "( x ,.)" := (pair x) (only parsing) : stdpp_scope. Notation "(., y )" := (λ x, (x,y)) (only parsing) : stdpp_scope.  Robbert Krebbers committed May 02, 2014 638   David Swasey committed Nov 29, 2017 639 640 Notation "p .1" := (fst p) (at level 2, left associativity, format "p .1"). Notation "p .2" := (snd p) (at level 2, left associativity, format "p .2").  Robbert Krebbers committed May 02, 2014 641   Maxime Dénès committed Jan 24, 2019 642 643 644 Instance: Params (@pair) 2 := {}. Instance: Params (@fst) 2 := {}. Instance: Params (@snd) 2 := {}.  Robbert Krebbers committed May 30, 2016 645   Robbert Krebbers committed May 27, 2016 646 647 648 649 650 651 652 Notation curry := prod_curry. Notation uncurry := prod_uncurry. Definition curry3 {A B C D} (f : A → B → C → D) (p : A * B * C) : D := let '(a,b,c) := p in f a b c. Definition curry4 {A B C D E} (f : A → B → C → D → E) (p : A * B * C * D) : E := let '(a,b,c,d) := p in f a b c d.  Robbert Krebbers committed Sep 19, 2017 653 654 655 656 657 Definition uncurry3 {A B C D} (f : A * B * C → D) (a : A) (b : B) (c : C) : D := f (a, b, c). Definition uncurry4 {A B C D E} (f : A * B * C * D → E) (a : A) (b : B) (c : C) (d : D) : E := f (a, b, c, d).  Robbert Krebbers committed May 27, 2016 658 659 Definition prod_map {A A' B B'} (f: A → A') (g: B → B') (p : A * B) : A' * B' := (f (p.1), g (p.2)).  Robbert Krebbers committed Sep 08, 2017 660 Arguments prod_map {_ _ _ _} _ _ !_ / : assert.  Robbert Krebbers committed May 27, 2016 661   Robbert Krebbers committed May 02, 2014 662 663 Definition prod_zip {A A' A'' B B' B''} (f : A → A' → A'') (g : B → B' → B'') (p : A * B) (q : A' * B') : A'' * B'' := (f (p.1) (q.1), g (p.2) (q.2)).  Robbert Krebbers committed Sep 08, 2017 664 Arguments prod_zip {_ _ _ _ _ _} _ _ !_ !_ / : assert.  Robbert Krebbers committed May 02, 2014 665   Robbert Krebbers committed May 27, 2016 666 667 668 Instance prod_inhabited {A B} (iA : Inhabited A) (iB : Inhabited B) : Inhabited (A * B) := match iA, iB with populate x, populate y => populate (x,y) end.  Robbert Krebbers committed Aug 29, 2012 669   Robbert Krebbers committed May 27, 2016 670 671 672 673 674 675 676 677 Instance pair_inj : Inj2 (=) (=) (=) (@pair A B). Proof. injection 1; auto. Qed. Instance prod_map_inj {A A' B B'} (f : A → A') (g : B → B') : Inj (=) (=) f → Inj (=) (=) g → Inj (=) (=) (prod_map f g). Proof. intros ?? [??] [??] ?; simpl in *; f_equal; [apply (inj f)|apply (inj g)]; congruence. Qed.  Robbert Krebbers committed Aug 29, 2012 678   Robbert Krebbers committed May 27, 2016 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 Definition prod_relation {A B} (R1 : relation A) (R2 : relation B) : relation (A * B) := λ x y, R1 (x.1) (y.1) ∧ R2 (x.2) (y.2). Section prod_relation. Context {R1 : relation A, R2 : relation B}. Global Instance prod_relation_refl : Reflexive R1 → Reflexive R2 → Reflexive (prod_relation R1 R2). Proof. firstorder eauto. Qed. Global Instance prod_relation_sym : Symmetric R1 → Symmetric R2 → Symmetric (prod_relation R1 R2). Proof. firstorder eauto. Qed. Global Instance prod_relation_trans : Transitive R1 → Transitive R2 → Transitive (prod_relation R1 R2). Proof. firstorder eauto. Qed. Global Instance prod_relation_equiv : Equivalence R1 → Equivalence R2 → Equivalence (prod_relation R1 R2). Proof. split; apply _. Qed.  Robbert Krebbers committed May 27, 2016 695   Robbert Krebbers committed May 27, 2016 696 697  Global Instance pair_proper' : Proper (R1 ==> R2 ==> prod_relation R1 R2) pair. Proof. firstorder eauto. Qed.  Robbert Krebbers committed May 27, 2016 698 699  Global Instance pair_inj' : Inj2 R1 R2 (prod_relation R1 R2) pair. Proof. inversion_clear 1; eauto. Qed.  Robbert Krebbers committed May 27, 2016 700 701 702 703 704  Global Instance fst_proper' : Proper (prod_relation R1 R2 ==> R1) fst. Proof. firstorder eauto. Qed. Global Instance snd_proper' : Proper (prod_relation R1 R2 ==> R2) snd. Proof. firstorder eauto. Qed. End prod_relation.  Robbert Krebbers committed Jun 11, 2012 705   Robbert Krebbers committed May 27, 2016 706 707 Instance prod_equiv {Equiv A,Equiv B} : Equiv (A * B) := prod_relation (≡) (≡). Instance pair_proper {Equiv A, Equiv B} :  Robbert Krebbers committed May 27, 2016 708 709  Proper ((≡) ==> (≡) ==> (≡)) (@pair A B) := _. Instance pair_equiv_inj {Equiv A, Equiv B} : Inj2 (≡) (≡) (≡) (@pair A B) := _.  Robbert Krebbers committed May 27, 2016 710 711 712 Instance fst_proper {Equiv A, Equiv B} : Proper ((≡) ==> (≡)) (@fst A B) := _. Instance snd_proper {Equiv A, Equiv B} : Proper ((≡) ==> (≡)) (@snd A B) := _. Typeclasses Opaque prod_equiv.  Robbert Krebbers committed Jan 09, 2013 713   Robbert Krebbers committed Jun 01, 2016 714 715 Instance prod_leibniz {LeibnizEquiv A, LeibnizEquiv B} : LeibnizEquiv (A * B). Proof. intros [??] [??] [??]; f_equal; apply leibniz_equiv; auto. Qed.  Jacques-Henri Jourdan committed Jun 01, 2016 716   Robbert Krebbers committed May 27, 2016 717 (** ** Sums *)  Robbert Krebbers committed May 27, 2016 718 719 Definition sum_map {A A' B B'} (f: A → A') (g: B → B') (xy : A + B) : A' + B' := match xy with inl x => inl (f x) | inr y => inr (g y) end.  Robbert Krebbers committed Sep 08, 2017 720 Arguments sum_map {_ _ _ _} _ _ !_ / : assert.  Robbert Krebbers committed May 27, 2016 721   Robbert Krebbers committed Jan 09, 2013 722 Instance sum_inhabited_l {A B} (iA : Inhabited A) : Inhabited (A + B) :=  Robbert Krebbers committed May 07, 2013 723  match iA with populate x => populate (inl x) end.  Robbert Krebbers committed Jan 09, 2013 724 Instance sum_inhabited_r {A B} (iB : Inhabited A) : Inhabited (A + B) :=  Robbert Krebbers committed May 07, 2013 725  match iB with populate y => populate (inl y) end.  Robbert Krebbers committed Jan 09, 2013 726   Robbert Krebbers committed May 27, 2016 727 728 729 730 Instance inl_inj : Inj (=) (=) (@inl A B). Proof. injection 1; auto. Qed. Instance inr_inj : Inj (=) (=) (@inr A B). Proof. injection 1; auto. Qed.  Robbert Krebbers committed Mar 14, 2013 731   Robbert Krebbers committed May 27, 2016 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 Instance sum_map_inj {A A' B B'} (f : A → A') (g : B → B') : Inj (=) (=) f → Inj (=) (=) g → Inj (=) (=) (sum_map f g). Proof. intros ?? [?|?] [?|?] [=]; f_equal; apply (inj _); auto. Qed. Inductive sum_relation {A B} (R1 : relation A) (R2 : relation B) : relation (A + B) := | inl_related x1 x2 : R1 x1 x2 → sum_relation R1 R2 (inl x1) (inl x2) | inr_related y1 y2 : R2 y1 y2 → sum_relation R1 R2 (inr y1) (inr y2). Section sum_relation. Context {R1 : relation A, R2 : relation B}. Global Instance sum_relation_refl : Reflexive R1 → Reflexive R2 → Reflexive (sum_relation R1 R2). Proof. intros ?? [?|?]; constructor; reflexivity. Qed. Global Instance sum_relation_sym : Symmetric R1 → Symmetric R2 → Symmetric (sum_relation R1 R2). Proof. destruct 3; constructor; eauto. Qed. Global Instance sum_relation_trans : Transitive R1 → Transitive R2 → Transitive (sum_relation R1 R2). Proof. destruct 3; inversion_clear 1; constructor; eauto. Qed. Global Instance sum_relation_equiv : Equivalence R1 → Equivalence R2 → Equivalence (sum_relation R1 R2). Proof. split; apply _. Qed. Global Instance inl_proper' : Proper (R1 ==> sum_relation R1 R2) inl. Proof. constructor; auto. Qed. Global Instance inr_proper' : Proper (R2 ==> sum_relation R1 R2) inr. Proof. constructor; auto. Qed.  Robbert Krebbers committed May 27, 2016 759 760 761 762  Global Instance inl_inj' : Inj R1 (sum_relation R1 R2) inl. Proof. inversion_clear 1; auto. Qed. Global Instance inr_inj' : Inj R2 (sum_relation R1 R2) inr. Proof. inversion_clear 1; auto. Qed.  Robbert Krebbers committed May 27, 2016 763 764 765 766 767 End sum_relation. Instance sum_equiv {Equiv A, Equiv B} : Equiv (A + B) := sum_relation (≡) (≡). Instance inl_proper {Equiv A, Equiv B} : Proper ((≡) ==> (≡)) (@inl A B) := _. Instance inr_proper {Equiv A, Equiv B} : Proper ((≡) ==> (≡)) (@inr A B) := _.  Robbert Krebbers committed May 27, 2016 768 769 Instance inl_equiv_inj {Equiv A, Equiv B} : Inj (≡) (≡) (@inl A B) := _. Instance inr_equiv_inj {Equiv A, Equiv B} : Inj (≡) (≡) (@inr A B) := _.  Robbert Krebbers committed May 27, 2016 770 771 Typeclasses Opaque sum_equiv.  Robbert Krebbers committed May 27, 2016 772 773 (** ** Option *) Instance option_inhabited {A} : Inhabited (option A) := populate None.  Robbert Krebbers committed Jun 11, 2012 774   Robbert Krebbers committed May 27, 2016 775 (** ** Sigma types *)  Robbert Krebbers committed Sep 08, 2017 776 777 778 Arguments existT {_ _} _ _ : assert. Arguments projT1 {_ _} _ : assert. Arguments projT2 {_ _} _ : assert.  779   Robbert Krebbers committed Sep 08, 2017 780 781 782 Arguments exist {_} _ _ _ : assert. Arguments proj1_sig {_ _} _ : assert. Arguments proj2_sig {_ _} _ : assert.  Robbert Krebbers committed Nov 09, 2017 783 784 Notation "x ↾ p" := (exist _ x p) (at level 20) : stdpp_scope. Notation " x" := (proj1_sig x) (at level 10, format " x") : stdpp_scope.  Robbert Krebbers committed Feb 19, 2013 785   Robbert Krebbers committed May 27, 2016 786 787 788 Lemma proj1_sig_inj {A} (P : A → Prop) x (Px : P x) y (Py : P y) : x↾Px = y↾Py → x = y. Proof. injection 1; trivial. Qed.  Robbert Krebbers committed Nov 19, 2015 789   Robbert Krebbers committed May 27, 2016 790 791 792 793 794 795 796 797 798 799 Section sig_map. Context {P : A → Prop} {Q : B → Prop} (f : A → B) (Hf : ∀ x, P x → Q (f x)). Definition sig_map (x : sig P) : sig Q := f (x) ↾ Hf _ (proj2_sig x). Global Instance sig_map_inj: (∀ x, ProofIrrel (P x)) → Inj (=) (=) f → Inj (=) (=) sig_map. Proof. intros ?? [x Hx] [y Hy]. injection 1. intros Hxy. apply (inj f) in Hxy; subst. rewrite (proof_irrel _ Hy). auto. Qed. End sig_map.  Robbert Krebbers committed Sep 08, 2017 800 Arguments sig_map _ _ _ _ _ _ !_ / : assert.  Robbert Krebbers committed Aug 29, 2012 801   Robbert Krebbers committed Jun 20, 2019 802 803 804 805 Definition proj1_ex {P : Prop} {Q : P → Prop} (p : ∃ x, Q x) : P := let '(ex_intro _ x _) := p in x. Definition proj2_ex {P : Prop} {Q : P → Prop} (p : ∃ x, Q x) : Q (proj1_ex p) := let '(ex_intro _ x H) := p in H.  Robbert Krebbers committed Jun 11, 2012 806   Robbert Krebbers committed Feb 20, 2019 807 (** * Operations on sets *)  Robbert Krebbers committed Jan 09, 2013 808 (** We define operational type classes for the traditional operations and  Robbert Krebbers committed Feb 20, 2019 809 relations on sets: the empty set [∅], the union [(∪)],  Robbert Krebbers committed Jan 09, 2013 810 intersection [(∩)], and difference [(∖)], the singleton [{[_]}], the subset  811 [(⊆)] and element of [(∈)] relation, and disjointess [(##)]. *)  Robbert Krebbers committed Jun 11, 2012 812 Class Empty A := empty: A.  Robbert Krebbers committed Sep 17, 2017 813 Hint Mode Empty ! : typeclass_instances.  Ralf Jung committed Jun 10, 2018 814 Notation "∅" := empty (format "∅") : stdpp_scope.  Robbert Krebbers committed Jun 11, 2012 815   Jacques-Henri Jourdan committed Aug 08, 2016 816 817 Instance empty_inhabited (Empty A) : Inhabited A := populate ∅.  Robbert Krebbers committed Jun 11, 2012 818 Class Union A := union: A → A → A.  Robbert Krebbers committed Sep 17, 2017 819 Hint Mode Union ! : typeclass_instances.  Maxime Dénès committed Jan 24, 2019 820 Instance: Params (@union) 2 := {}.  Robbert Krebbers committed Nov 09, 2017 821 822 Infix "∪" := union (at level 50, left associativity) : stdpp_scope. Notation "(∪)" := union (only parsing) : stdpp_scope.  Robbert Krebbers committed Sep 19, 2019 823 824 Notation "( x ∪.)" := (union x) (only parsing) : stdpp_scope. Notation "(.∪ x )" := (λ y, union y x) (only parsing) : stdpp_scope.  Robbert Krebbers committed Nov 09, 2017 825 826 Infix "∪*" := (zip_with (∪)) (at level 50, left associativity) : stdpp_scope. Notation "(∪*)" := (zip_with (∪)) (only parsing) : stdpp_scope.  Robbert Krebbers committed May 02, 2014 827 Infix "∪**" := (zip_with (zip_with (∪)))  Robbert Krebbers committed Nov 09, 2017 828  (at level 50, left associativity) : stdpp_scope.  Robbert Krebbers committed May 02, 2014 829 Infix "∪*∪**" := (zip_with (prod_zip (∪) (∪*)))  Robbert Krebbers committed Nov 09, 2017 830  (at level 50, left associativity) : stdpp_scope.  Robbert Krebbers committed Jun 11, 2012 831   Robbert Krebbers committed May 07, 2013 832 Definition union_list {Empty A} {Union A} : list A → A := fold_right (∪) ∅.  Robbert Krebbers committed Sep 08, 2017 833 Arguments union_list _ _ _ !_ / : assert.  Robbert Krebbers committed Nov 09, 2017 834 Notation "⋃ l" := (union_list l) (at level 20, format "⋃ l") : stdpp_scope.