diff --git a/Makefile b/Makefile index 90fd0f704dadbc0d847bbc0a454ab8dde2c18b85..6394c42a5c3cd9ecfa57864c33cf15f87b0549cc 100644 --- a/Makefile +++ b/Makefile @@ -32,9 +32,9 @@ Makefile.coq: _CoqProject Makefile awk.Makefile build-dep: build/opam-pins.sh < opam.pins opam upgrade $(YFLAG) # it is not nice that we upgrade *all* packages here, but I found no nice way to upgrade only those that we pinned - opam pin add coq-iris "$$(pwd)#HEAD" -k git -n -y - opam install coq-iris --deps-only $(YFLAG) - opam pin remove coq-iris + opam pin add opam-builddep-temp "$$(pwd)#HEAD" -k git -n -y + opam install opam-builddep-temp --deps-only $(YFLAG) + opam pin remove opam-builddep-temp # Some files that do *not* need to be forwarded to Makefile.coq Makefile: ; diff --git a/README.md b/README.md index 581fd3102e3fae07324ec5c64487397250202dfb..0dcf568c402450a918659dcb92d7389894b2077b 100644 --- a/README.md +++ b/README.md @@ -8,10 +8,11 @@ This version is known to compile with: - Coq 8.6 - Ssreflect 1.6.1 + - A development version of [std++](https://gitlab.mpi-sws.org/robbertkrebbers/coq-stdpp) -The easiest way to install the correct versions of the dependencies is -through opam. Coq packages are available on the coq-released repository, -set up by the command: +The easiest way to install the correct versions of the dependencies is through +opam. Coq packages are available on the coq-released repository, set up by the +command: opam repo add coq-released https://coq.inria.fr/opam/released @@ -28,8 +29,6 @@ Run `make` to build the full development. ## Structure -* The folder [prelude](theories/prelude) contains an extended "Standard Library" - by [Robbert Krebbers](http://robbertkrebbers.nl/thesis.html). * The folder [algebra](theories/algebra) contains the COFE and CMRA constructions as well as the solver for recursive domain equations. * The folder [base_logic](theories/base_logic) defines the Iris base logic and diff --git a/_CoqProject b/_CoqProject index 58f275caf31e2aca81330e7d17b409b7e7d70a90..99afce68ce287ee66d07fdc33095f8a96fc2f4d4 100644 --- a/_CoqProject +++ b/_CoqProject @@ -1,42 +1,4 @@ -Q theories iris -theories/prelude/option.v -theories/prelude/fin_map_dom.v -theories/prelude/bset.v -theories/prelude/fin_maps.v -theories/prelude/vector.v -theories/prelude/pmap.v -theories/prelude/stringmap.v -theories/prelude/fin_collections.v -theories/prelude/mapset.v -theories/prelude/proof_irrel.v -theories/prelude/hashset.v -theories/prelude/pretty.v -theories/prelude/countable.v -theories/prelude/orders.v -theories/prelude/natmap.v -theories/prelude/strings.v -theories/prelude/relations.v -theories/prelude/collections.v -theories/prelude/listset.v -theories/prelude/streams.v -theories/prelude/gmap.v -theories/prelude/gmultiset.v -theories/prelude/base.v -theories/prelude/tactics.v -theories/prelude/prelude.v -theories/prelude/listset_nodup.v -theories/prelude/finite.v -theories/prelude/numbers.v -theories/prelude/nmap.v -theories/prelude/zmap.v -theories/prelude/coPset.v -theories/prelude/lexico.v -theories/prelude/set.v -theories/prelude/decidable.v -theories/prelude/list.v -theories/prelude/functions.v -theories/prelude/hlist.v -theories/prelude/sorting.v theories/algebra/cmra.v theories/algebra/cmra_big_op.v theories/algebra/cmra_tactics.v diff --git a/opam b/opam index 118d9a61f7b9ec75a812509eca52d5b428084579..f3f2e979e0c4a182dcfcfc2838c33679122c317b 100644 --- a/opam +++ b/opam @@ -15,4 +15,5 @@ remove: [ "sh" "-c" "rm -rf '%{lib}%/coq/user-contrib/iris'" ] depends: [ "coq" { ((>= "8.5.1" & < "8.7~") | (= "dev"))} "coq-mathcomp-ssreflect" { ((>= "1.6.1" & < "1.7~") | (= "dev"))} + "coq-stdpp" ] diff --git a/opam.pins b/opam.pins index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..b9ef09cf7cbb722351664e47d91fc93145b1afec 100644 --- a/opam.pins +++ b/opam.pins @@ -0,0 +1 @@ +coq-stdpp https://gitlab.mpi-sws.org/robbertkrebbers/coq-stdpp 2c261344225e46042932f248db87fd1cde04b5cd diff --git a/theories/algebra/base.v b/theories/algebra/base.v index fe4af017e2c0b23d312203def85fe9bbd8bded9f..06262f85016146a1e84bda7aabd214fa1a33f602 100644 --- a/theories/algebra/base.v +++ b/theories/algebra/base.v @@ -1,6 +1,6 @@ From mathcomp Require Export ssreflect. -From iris.prelude Require Export prelude. +From stdpp Require Export prelude. Set Default Proof Using "Type". Global Set Bullet Behavior "Strict Subproofs". Global Open Scope general_if_scope. -Ltac done := prelude.tactics.done. +Ltac done := stdpp.tactics.done. diff --git a/theories/algebra/cmra_big_op.v b/theories/algebra/cmra_big_op.v index b7a1c390a3a661b5d1dfb5f161e05a47dacb21ef..206c3ac11af52b5e14249109239c8c3d5dd59884 100644 --- a/theories/algebra/cmra_big_op.v +++ b/theories/algebra/cmra_big_op.v @@ -1,5 +1,5 @@ From iris.algebra Require Export cmra list. -From iris.prelude Require Import functions gmap gmultiset. +From stdpp Require Import functions gmap gmultiset. Set Default Proof Using "Type". (** The operator [ [⋅] Ps ] folds [⋅] over the list [Ps]. This operator is not a diff --git a/theories/algebra/coPset.v b/theories/algebra/coPset.v index 605adfde185d8d2beaa4fd9eefbb4443f0bf7986..9939f63dd3afb43407127213ae4dfbcd3748da77 100644 --- a/theories/algebra/coPset.v +++ b/theories/algebra/coPset.v @@ -1,6 +1,6 @@ From iris.algebra Require Export cmra. From iris.algebra Require Import updates local_updates. -From iris.prelude Require Export collections coPset. +From stdpp Require Export collections coPset. Set Default Proof Using "Type". (** This is pretty much the same as algebra/gset, but I was not able to generalize the construction without breaking canonical structures. *) diff --git a/theories/algebra/gmap.v b/theories/algebra/gmap.v index fd06ba9a83807b90ad7316d300bb1c4a0613ff08..479d20e2ce809fd1bc95d8901620f6ef5554ab9d 100644 --- a/theories/algebra/gmap.v +++ b/theories/algebra/gmap.v @@ -1,5 +1,5 @@ From iris.algebra Require Export cmra. -From iris.prelude Require Export gmap. +From stdpp Require Export gmap. From iris.algebra Require Import updates local_updates. From iris.base_logic Require Import base_logic. Set Default Proof Using "Type". diff --git a/theories/algebra/gset.v b/theories/algebra/gset.v index 5fb4622c5bbc6a113778c455a40016adc37bccd1..5bf2cfd6595de41bfc201f5ddb55abecad848d24 100644 --- a/theories/algebra/gset.v +++ b/theories/algebra/gset.v @@ -1,6 +1,6 @@ From iris.algebra Require Export cmra. From iris.algebra Require Import updates local_updates. -From iris.prelude Require Export collections gmap mapset. +From stdpp Require Export collections gmap mapset. Set Default Proof Using "Type". (* The union CMRA *) diff --git a/theories/algebra/iprod.v b/theories/algebra/iprod.v index 6077ee0fe18f69b9dfdfe78e077e444707d2d6f5..eec5599dc7724c8a8f30191a4ede07a6c3835839 100644 --- a/theories/algebra/iprod.v +++ b/theories/algebra/iprod.v @@ -1,6 +1,6 @@ From iris.algebra Require Export cmra. From iris.base_logic Require Import base_logic. -From iris.prelude Require Import finite. +From stdpp Require Import finite. Set Default Proof Using "Type". (** * Indexed product *) diff --git a/theories/algebra/list.v b/theories/algebra/list.v index d4b01fa6712ffcdc2feada8e4a8d2b2ee6a904ad..3077f9dd5d4972844a1ff582cc3999661e35a18c 100644 --- a/theories/algebra/list.v +++ b/theories/algebra/list.v @@ -1,5 +1,5 @@ From iris.algebra Require Export cmra. -From iris.prelude Require Export list. +From stdpp Require Export list. From iris.base_logic Require Import base_logic. From iris.algebra Require Import updates local_updates. Set Default Proof Using "Type". diff --git a/theories/algebra/sts.v b/theories/algebra/sts.v index 632313e618c9dfb6cae54d1b17ed27b44a282464..f4f5766e0458eb9c1ef3e9034bfac6d98c6d0a37 100644 --- a/theories/algebra/sts.v +++ b/theories/algebra/sts.v @@ -1,4 +1,4 @@ -From iris.prelude Require Export set. +From stdpp Require Export set. From iris.algebra Require Export cmra. From iris.algebra Require Import dra. Set Default Proof Using "Type". diff --git a/theories/algebra/vector.v b/theories/algebra/vector.v index 032779915bc471cb781c798d89895720f13f4500..2ca6c9087dbc858b4eb04501840fd664755d4985 100644 --- a/theories/algebra/vector.v +++ b/theories/algebra/vector.v @@ -1,4 +1,4 @@ -From iris.prelude Require Export vector. +From stdpp Require Export vector. From iris.algebra Require Export ofe. From iris.algebra Require Import list. Set Default Proof Using "Type". diff --git a/theories/base_logic/big_op.v b/theories/base_logic/big_op.v index 64075f8b7f5145187dc5263e8a25197a0c415835..d998ef2d8e7e7523ec91212fbe0bb868fdde5db2 100644 --- a/theories/base_logic/big_op.v +++ b/theories/base_logic/big_op.v @@ -1,6 +1,6 @@ From iris.algebra Require Export list cmra_big_op. From iris.base_logic Require Export base_logic. -From iris.prelude Require Import gmap fin_collections gmultiset functions. +From stdpp Require Import gmap fin_collections gmultiset functions. Set Default Proof Using "Type". Import uPred. diff --git a/theories/base_logic/hlist.v b/theories/base_logic/hlist.v index 5196fe0f9c384608a030ef607e8797079836f33b..a035aad0250498b6d64bc6af5fa8ab20772b0b00 100644 --- a/theories/base_logic/hlist.v +++ b/theories/base_logic/hlist.v @@ -1,4 +1,4 @@ -From iris.prelude Require Export hlist. +From stdpp Require Export hlist. From iris.base_logic Require Export base_logic. Set Default Proof Using "Type". Import uPred. diff --git a/theories/base_logic/lib/fancy_updates.v b/theories/base_logic/lib/fancy_updates.v index 37308769dcd0ba3bd5cebf294f3015501d421016..1e643d387856189f2324946663281821faac2997 100644 --- a/theories/base_logic/lib/fancy_updates.v +++ b/theories/base_logic/lib/fancy_updates.v @@ -1,5 +1,5 @@ From iris.base_logic.lib Require Export own. -From iris.prelude Require Export coPset. +From stdpp Require Export coPset. From iris.base_logic.lib Require Import wsat. From iris.algebra Require Import gmap. From iris.base_logic Require Import big_op. diff --git a/theories/base_logic/lib/fractional.v b/theories/base_logic/lib/fractional.v index af12736d1da3f2cab1b19a2557315d136c84f358..8029a018ad4f4e62432209e8dcf1d32d0c784e7a 100644 --- a/theories/base_logic/lib/fractional.v +++ b/theories/base_logic/lib/fractional.v @@ -1,4 +1,4 @@ -From iris.prelude Require Import gmap gmultiset. +From stdpp Require Import gmap gmultiset. From iris.base_logic Require Export derived. From iris.base_logic Require Import big_op. From iris.proofmode Require Import classes class_instances. diff --git a/theories/base_logic/lib/namespaces.v b/theories/base_logic/lib/namespaces.v index 3f23ca2d399596035188c22185b687886fcd7e5e..a1b7774ce999e618848b1170fac892525de3ec52 100644 --- a/theories/base_logic/lib/namespaces.v +++ b/theories/base_logic/lib/namespaces.v @@ -1,4 +1,4 @@ -From iris.prelude Require Export countable coPset. +From stdpp Require Export countable coPset. From iris.algebra Require Export base. Set Default Proof Using "Type". diff --git a/theories/base_logic/lib/saved_prop.v b/theories/base_logic/lib/saved_prop.v index 0ea8dbdb5a61058f06b8f8a43d781592a1bf0f86..384e60c74b12ebcf86bc9cb9c6f32f39e451d2fa 100644 --- a/theories/base_logic/lib/saved_prop.v +++ b/theories/base_logic/lib/saved_prop.v @@ -1,6 +1,6 @@ From iris.base_logic Require Export own. From iris.algebra Require Import agree. -From iris.prelude Require Import gmap. +From stdpp Require Import gmap. Set Default Proof Using "Type". Import uPred. diff --git a/theories/base_logic/lib/wsat.v b/theories/base_logic/lib/wsat.v index 850b62678fb62e03e1b52359576ea7dd3b9f8758..fe5e8da94ee7310e5ba34578ede8881ea35f50ad 100644 --- a/theories/base_logic/lib/wsat.v +++ b/theories/base_logic/lib/wsat.v @@ -1,5 +1,5 @@ From iris.base_logic.lib Require Export own. -From iris.prelude Require Export coPset. +From stdpp Require Export coPset. From iris.algebra Require Import gmap auth agree gset coPset. From iris.base_logic Require Import big_op. From iris.proofmode Require Import tactics. diff --git a/theories/base_logic/tactics.v b/theories/base_logic/tactics.v index d7cfdebfd224d1c0078f380e30fe22b0c7129b14..0a75c4fb55477da496025bcbe936d97f0116f86d 100644 --- a/theories/base_logic/tactics.v +++ b/theories/base_logic/tactics.v @@ -1,4 +1,4 @@ -From iris.prelude Require Import gmap. +From stdpp Require Import gmap. From iris.base_logic Require Export base_logic big_op. Set Default Proof Using "Type". Import uPred. diff --git a/theories/heap_lang/lang.v b/theories/heap_lang/lang.v index 936039b3854be898b85c242934a85a3306c93c16..6c7a70a605dfe6d247f87767c6996d3c53ad0990 100644 --- a/theories/heap_lang/lang.v +++ b/theories/heap_lang/lang.v @@ -1,7 +1,7 @@ From iris.program_logic Require Export ectx_language ectxi_language. From iris.algebra Require Export ofe. -From iris.prelude Require Export strings. -From iris.prelude Require Import gmap. +From stdpp Require Export strings. +From stdpp Require Import gmap. Set Default Proof Using "Type". Module heap_lang. diff --git a/theories/heap_lang/lib/barrier/proof.v b/theories/heap_lang/lib/barrier/proof.v index cfc90fab86ae1d88328f54d2d92e90ec7961ad3f..2bdce5c36927376aa33c3c4e64a3f29413175da7 100644 --- a/theories/heap_lang/lib/barrier/proof.v +++ b/theories/heap_lang/lib/barrier/proof.v @@ -1,7 +1,7 @@ From iris.program_logic Require Export weakestpre. From iris.heap_lang Require Export lang. From iris.heap_lang.lib.barrier Require Export barrier. -From iris.prelude Require Import functions. +From stdpp Require Import functions. From iris.base_logic Require Import big_op lib.saved_prop lib.sts. From iris.heap_lang Require Import proofmode. From iris.heap_lang.lib.barrier Require Import protocol. diff --git a/theories/heap_lang/lib/barrier/protocol.v b/theories/heap_lang/lib/barrier/protocol.v index f9f572247bb5b6e9b2331bfe977c461be32c563d..1992abed4a66434436ca727d4a859107282d7df9 100644 --- a/theories/heap_lang/lib/barrier/protocol.v +++ b/theories/heap_lang/lib/barrier/protocol.v @@ -1,6 +1,6 @@ From iris.algebra Require Export sts. From iris.base_logic Require Import lib.own. -From iris.prelude Require Export gmap. +From stdpp Require Export gmap. Set Default Proof Using "Type". (** The STS describing the main barrier protocol. Every state has an index-set diff --git a/theories/heap_lang/lifting.v b/theories/heap_lang/lifting.v index 660163a7e58e9dd99057edde44faf687870a3452..ec64faebe447f6932e25d912933ceefd9b36e4a9 100644 --- a/theories/heap_lang/lifting.v +++ b/theories/heap_lang/lifting.v @@ -4,7 +4,7 @@ From iris.program_logic Require Import ectx_lifting. From iris.heap_lang Require Export lang. From iris.heap_lang Require Import tactics. From iris.proofmode Require Import tactics. -From iris.prelude Require Import fin_maps. +From stdpp Require Import fin_maps. Set Default Proof Using "Type". Import uPred. diff --git a/theories/prelude/base.v b/theories/prelude/base.v deleted file mode 100644 index 65233ddfe3a3be343c6437f242577bc10dbd6936..0000000000000000000000000000000000000000 --- a/theories/prelude/base.v +++ /dev/null @@ -1,978 +0,0 @@ -(* Copyright (c) 2012-2017, Robbert Krebbers. *) -(* This file is distributed under the terms of the BSD license. *) -(** This file collects type class interfaces, notations, and general theorems -that are used throughout the whole development. Most importantly it contains -abstract interfaces for ordered structures, collections, and various other data -structures. *) -Global Generalizable All Variables. -Global Set Automatic Coercions Import. -Global Set Asymmetric Patterns. -Global Unset Transparent Obligations. -From Coq Require Export Morphisms RelationClasses List Bool Utf8 Setoid. -Set Default Proof Using "Type". -Export ListNotations. -From Coq.Program Require Export Basics Syntax. -Obligation Tactic := idtac. - -(** Sealing off definitions *) -Set Primitive Projections. -Record seal {A} (f : A) := { unseal : A; seal_eq : unseal = f }. -Arguments unseal {_ _} _. -Arguments seal_eq {_ _} _. -Unset Primitive Projections. - -(** Throughout this development we use [C_scope] for all general purpose -notations that do not belong to a more specific scope. *) -Delimit Scope C_scope with C. -Global Open Scope C_scope. - -(** Change [True] and [False] into notations in order to enable overloading. -We will use this to give [True] and [False] a different interpretation for -embedded logics. *) -Notation "'True'" := True : type_scope. -Notation "'False'" := False : type_scope. - - -(** * Equality *) -(** Introduce some Haskell style like notations. *) -Notation "(=)" := eq (only parsing) : C_scope. -Notation "( x =)" := (eq x) (only parsing) : C_scope. -Notation "(= x )" := (λ y, eq y x) (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. - -Hint Extern 0 (_ = _) => reflexivity. -Hint Extern 100 (_ ≠_) => discriminate. - -Instance: @PreOrder A (=). -Proof. split; repeat intro; congruence. Qed. - -(** ** Setoid equality *) -(** We define an operational type class for setoid equality. This is based on -(Spitters/van der Weegen, 2011). *) -Class Equiv A := equiv: relation A. -Infix "≡" := equiv (at level 70, no associativity) : C_scope. -Notation "(≡)" := equiv (only parsing) : C_scope. -Notation "( X ≡)" := (equiv X) (only parsing) : C_scope. -Notation "(≡ X )" := (λ Y, Y ≡ X) (only parsing) : C_scope. -Notation "(≢)" := (λ X Y, ¬X ≡ Y) (only parsing) : C_scope. -Notation "X ≢ Y":= (¬X ≡ Y) (at level 70, no associativity) : C_scope. -Notation "( X ≢)" := (λ Y, X ≢ Y) (only parsing) : C_scope. -Notation "(≢ X )" := (λ Y, Y ≢ X) (only parsing) : C_scope. - -(** 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. -Lemma leibniz_equiv_iff `{LeibnizEquiv A, !Reflexive (@equiv A _)} (x y : A) : - x ≡ y ↔ x = y. -Proof. split. apply leibniz_equiv. intros ->; reflexivity. Qed. - -Ltac fold_leibniz := repeat - match goal with - | H : context [ @equiv ?A _ _ _ ] |- _ => - setoid_rewrite (leibniz_equiv_iff (A:=A)) in H - | |- context [ @equiv ?A _ _ _ ] => - setoid_rewrite (leibniz_equiv_iff (A:=A)) - end. -Ltac unfold_leibniz := repeat - match goal with - | H : context [ @eq ?A _ _ ] |- _ => - setoid_rewrite <-(leibniz_equiv_iff (A:=A)) in H - | |- context [ @eq ?A _ _ ] => - 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. *) -Instance: Params (@equiv) 2. - -(** The following instance forces [setoid_replace] to use setoid equality -(for types that have an [Equiv] instance) rather than the standard Leibniz -equality. *) -Instance equiv_default_relation `{Equiv A} : DefaultRelation (≡) | 3. -Hint Extern 0 (_ ≡ _) => reflexivity. -Hint Extern 0 (_ ≡ _) => symmetry; assumption. - - -(** * Type classes *) -(** ** Decidable propositions *) -(** This type class by (Spitters/van der Weegen, 2011) collects decidable -propositions. For example to declare a parameter expressing decidable equality -on a type [A] we write [`{∀ x y : A, Decision (x = y)}] and use it by writing -[decide (x = y)]. *) -Class Decision (P : Prop) := decide : {P} + {¬P}. -Arguments decide _ {_}. -Notation EqDecision A := (∀ x y : A, Decision (x = y)). - -(** ** Inhabited types *) -(** This type class collects types that are inhabited. *) -Class Inhabited (A : Type) : Type := populate { inhabitant : A }. -Arguments populate {_} _. - -(** ** 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. - -(** ** Common properties *) -(** These operational type classes allow us to refer to common mathematical -properties in a generic way. For example, for injectivity of [(k ++)] it -allows us to write [inj (k ++)] instead of [app_inv_head k]. *) -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}. - -Arguments irreflexivity {_} _ {_} _ _. -Arguments inj {_ _ _ _} _ {_} _ _ _. -Arguments inj2 {_ _ _ _ _ _} _ {_} _ _ _ _ _. -Arguments cancel {_ _ _} _ _ {_} _. -Arguments surj {_ _ _} _ {_} _. -Arguments idemp {_ _} _ {_} _. -Arguments comm {_ _ _} _ {_} _ _. -Arguments left_id {_ _} _ _ {_} _. -Arguments right_id {_ _} _ _ {_} _. -Arguments assoc {_ _} _ {_} _ _ _. -Arguments left_absorb {_ _} _ _ {_} _. -Arguments right_absorb {_ _} _ _ {_} _. -Arguments anti_symm {_ _} _ {_} _ _ _ _. -Arguments total {_} _ {_} _ _. -Arguments trichotomy {_} _ {_} _ _. -Arguments trichotomyT {_} _ {_} _ _. - -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. -Instance: Params (@strict) 2. -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 *) -Notation "(∧)" := and (only parsing) : C_scope. -Notation "( A ∧)" := (and A) (only parsing) : C_scope. -Notation "(∧ B )" := (λ A, A ∧ B) (only parsing) : C_scope. - -Notation "(∨)" := or (only parsing) : C_scope. -Notation "( A ∨)" := (or A) (only parsing) : C_scope. -Notation "(∨ B )" := (λ A, A ∨ B) (only parsing) : C_scope. - -Notation "(↔)" := iff (only parsing) : C_scope. -Notation "( A ↔)" := (iff A) (only parsing) : C_scope. -Notation "(↔ B )" := (λ A, A ↔ B) (only parsing) : C_scope. - -Hint Extern 0 (_ ↔ _) => reflexivity. -Hint Extern 0 (_ ↔ _) => symmetry; assumption. - -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. -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. - -Instance: Comm (↔) (@eq A). -Proof. red; intuition. Qed. -Instance: Comm (↔) (λ x y, @eq A y x). -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 *) -Notation "(→)" := (λ A B, A → B) (only parsing) : C_scope. -Notation "( A →)" := (λ B, A → B) (only parsing) : C_scope. -Notation "(→ B )" := (λ A, A → B) (only parsing) : C_scope. - -Notation "t $ r" := (t r) - (at level 65, right associativity, only parsing) : C_scope. -Notation "($)" := (λ f x, f x) (only parsing) : C_scope. -Notation "($ x )" := (λ f, f x) (only parsing) : C_scope. - -Infix "∘" := compose : C_scope. -Notation "(∘)" := compose (only parsing) : C_scope. -Notation "( f ∘)" := (compose f) (only parsing) : C_scope. -Notation "(∘ f )" := (λ g, compose g f) (only parsing) : C_scope. - -Instance impl_inhabited {A} `{Inhabited B} : Inhabited (A → B) := - populate (λ _, inhabitant). - -(** Ensure that [simpl] unfolds [id], [compose], and [flip] when fully -applied. *) -Arguments id _ _ /. -Arguments compose _ _ _ _ _ _ /. -Arguments flip _ _ _ _ _ _ /. -Arguments const _ _ _ _ /. -Typeclasses Transparent id compose flip const. - -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. -Hint Unfold Is_true. -Hint Immediate Is_true_eq_left. -Hint Resolve orb_prop_intro andb_prop_intro. -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. - -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. - -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. - -(** ** Unit *) -Instance unit_equiv : Equiv unit := λ _ _, True. -Instance unit_equivalence : Equivalence (@equiv unit _). -Proof. repeat split. Qed. -Instance unit_leibniz : LeibnizEquiv unit. -Proof. intros [] []; reflexivity. Qed. -Instance unit_inhabited: Inhabited unit := populate (). - -(** ** Products *) -Notation "( x ,)" := (pair x) (only parsing) : C_scope. -Notation "(, y )" := (λ x, (x,y)) (only parsing) : C_scope. - -Notation "p .1" := (fst p) (at level 10, format "p .1"). -Notation "p .2" := (snd p) (at level 10, format "p .2"). - -Instance: Params (@pair) 2. -Instance: Params (@fst) 2. -Instance: Params (@snd) 2. - -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. - -Definition prod_map {A A' B B'} (f: A → A') (g: B → B') (p : A * B) : A' * B' := - (f (p.1), g (p.2)). -Arguments prod_map {_ _ _ _} _ _ !_ /. - -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)). -Arguments prod_zip {_ _ _ _ _ _} _ _ !_ !_ /. - -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. - -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. - -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. - - Global Instance pair_proper' : Proper (R1 ==> R2 ==> prod_relation R1 R2) pair. - Proof. firstorder eauto. Qed. - Global Instance pair_inj' : Inj2 R1 R2 (prod_relation R1 R2) pair. - Proof. inversion_clear 1; eauto. Qed. - 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. - -Instance prod_equiv `{Equiv A,Equiv B} : Equiv (A * B) := prod_relation (≡) (≡). -Instance pair_proper `{Equiv A, Equiv B} : - Proper ((≡) ==> (≡) ==> (≡)) (@pair A B) := _. -Instance pair_equiv_inj `{Equiv A, Equiv B} : Inj2 (≡) (≡) (≡) (@pair A B) := _. -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. - -Instance prod_leibniz `{LeibnizEquiv A, LeibnizEquiv B} : LeibnizEquiv (A * B). -Proof. intros [??] [??] [??]; f_equal; apply leibniz_equiv; auto. Qed. - -(** ** Sums *) -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. -Arguments sum_map {_ _ _ _} _ _ !_ /. - -Instance sum_inhabited_l {A B} (iA : Inhabited A) : Inhabited (A + B) := - match iA with populate x => populate (inl x) end. -Instance sum_inhabited_r {A B} (iB : Inhabited A) : Inhabited (A + B) := - match iB with populate y => populate (inl y) end. - -Instance inl_inj : Inj (=) (=) (@inl A B). -Proof. injection 1; auto. Qed. -Instance inr_inj : Inj (=) (=) (@inr A B). -Proof. injection 1; auto. Qed. - -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. - 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. -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) := _. -Instance inl_equiv_inj `{Equiv A, Equiv B} : Inj (≡) (≡) (@inl A B) := _. -Instance inr_equiv_inj `{Equiv A, Equiv B} : Inj (≡) (≡) (@inr A B) := _. -Typeclasses Opaque sum_equiv. - -(** ** Option *) -Instance option_inhabited {A} : Inhabited (option A) := populate None. - -(** ** Sigma types *) -Arguments existT {_ _} _ _. -Arguments proj1_sig {_ _} _. -Notation "x ↾ p" := (exist _ x p) (at level 20) : C_scope. -Notation "` x" := (proj1_sig x) (at level 10, format "` x") : C_scope. - -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. - -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. -Arguments sig_map _ _ _ _ _ _ !_ /. - - -(** * Operations on collections *) -(** We define operational type classes for the traditional operations and -relations on collections: the empty collection [∅], the union [(∪)], -intersection [(∩)], and difference [(∖)], the singleton [{[_]}], the subset -[(⊆)] and element of [(∈)] relation, and disjointess [(⊥)]. *) -Class Empty A := empty: A. -Notation "∅" := empty : C_scope. - -Instance empty_inhabited `(Empty A) : Inhabited A := populate ∅. - -Class Top A := top : A. -Notation "⊤" := top : C_scope. - -Class Union A := union: A → A → A. -Instance: Params (@union) 2. -Infix "∪" := union (at level 50, left associativity) : C_scope. -Notation "(∪)" := union (only parsing) : C_scope. -Notation "( x ∪)" := (union x) (only parsing) : C_scope. -Notation "(∪ x )" := (λ y, union y x) (only parsing) : C_scope. -Infix "∪*" := (zip_with (∪)) (at level 50, left associativity) : C_scope. -Notation "(∪*)" := (zip_with (∪)) (only parsing) : C_scope. -Infix "∪**" := (zip_with (zip_with (∪))) - (at level 50, left associativity) : C_scope. -Infix "∪*∪**" := (zip_with (prod_zip (∪) (∪*))) - (at level 50, left associativity) : C_scope. - -Definition union_list `{Empty A} `{Union A} : list A → A := fold_right (∪) ∅. -Arguments union_list _ _ _ !_ /. -Notation "⋃ l" := (union_list l) (at level 20, format "⋃ l") : C_scope. - -Class Intersection A := intersection: A → A → A. -Instance: Params (@intersection) 2. -Infix "∩" := intersection (at level 40) : C_scope. -Notation "(∩)" := intersection (only parsing) : C_scope. -Notation "( x ∩)" := (intersection x) (only parsing) : C_scope. -Notation "(∩ x )" := (λ y, intersection y x) (only parsing) : C_scope. - -Class Difference A := difference: A → A → A. -Instance: Params (@difference) 2. -Infix "∖" := difference (at level 40, left associativity) : C_scope. -Notation "(∖)" := difference (only parsing) : C_scope. -Notation "( x ∖)" := (difference x) (only parsing) : C_scope. -Notation "(∖ x )" := (λ y, difference y x) (only parsing) : C_scope. -Infix "∖*" := (zip_with (∖)) (at level 40, left associativity) : C_scope. -Notation "(∖*)" := (zip_with (∖)) (only parsing) : C_scope. -Infix "∖**" := (zip_with (zip_with (∖))) - (at level 40, left associativity) : C_scope. -Infix "∖*∖**" := (zip_with (prod_zip (∖) (∖*))) - (at level 50, left associativity) : C_scope. - -Class Singleton A B := singleton: A → B. -Instance: Params (@singleton) 3. -Notation "{[ x ]}" := (singleton x) (at level 1) : C_scope. -Notation "{[ x ; y ; .. ; z ]}" := - (union .. (union (singleton x) (singleton y)) .. (singleton z)) - (at level 1) : C_scope. -Notation "{[ x , y ]}" := (singleton (x,y)) - (at level 1, y at next level) : C_scope. -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: relation A. -Instance: Params (@subseteq) 2. -Infix "⊆" := subseteq (at level 70) : C_scope. -Notation "(⊆)" := subseteq (only parsing) : C_scope. -Notation "( X ⊆ )" := (subseteq X) (only parsing) : C_scope. -Notation "( ⊆ X )" := (λ Y, 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. -Infix "⊆*" := (Forall2 (⊆)) (at level 70) : C_scope. -Notation "(⊆*)" := (Forall2 (⊆)) (only parsing) : C_scope. -Infix "⊆**" := (Forall2 (⊆*)) (at level 70) : C_scope. -Infix "⊆1*" := (Forall2 (λ p q, p.1 ⊆ q.1)) (at level 70) : C_scope. -Infix "⊆2*" := (Forall2 (λ p q, p.2 ⊆ q.2)) (at level 70) : C_scope. -Infix "⊆1**" := (Forall2 (λ p q, p.1 ⊆* q.1)) (at level 70) : C_scope. -Infix "⊆2**" := (Forall2 (λ p q, p.2 ⊆* q.2)) (at level 70) : C_scope. - -Hint Extern 0 (_ ⊆ _) => reflexivity. -Hint Extern 0 (_ ⊆* _) => reflexivity. -Hint Extern 0 (_ ⊆** _) => reflexivity. - -Infix "⊂" := (strict (⊆)) (at level 70) : C_scope. -Notation "(⊂)" := (strict (⊆)) (only parsing) : C_scope. -Notation "( X ⊂ )" := (strict (⊆) X) (only parsing) : C_scope. -Notation "( ⊂ X )" := (λ Y, 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. - -Notation "X ⊆ Y ⊆ Z" := (X ⊆ Y ∧ Y ⊆ Z) (at level 70, Y at next level) : C_scope. -Notation "X ⊆ Y ⊂ Z" := (X ⊆ Y ∧ Y ⊂ Z) (at level 70, Y at next level) : C_scope. -Notation "X ⊂ Y ⊆ Z" := (X ⊂ Y ∧ Y ⊆ Z) (at level 70, Y at next level) : C_scope. -Notation "X ⊂ Y ⊂ Z" := (X ⊂ Y ∧ Y ⊂ Z) (at level 70, Y at next level) : 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. -Notation "(∈)" := elem_of (only parsing) : C_scope. -Notation "( x ∈)" := (elem_of x) (only parsing) : C_scope. -Notation "(∈ X )" := (λ x, elem_of x X) (only parsing) : C_scope. -Notation "x ∉ X" := (¬x ∈ X) (at level 80) : C_scope. -Notation "(∉)" := (λ x X, x ∉ X) (only parsing) : C_scope. -Notation "( x ∉)" := (λ X, x ∉ X) (only parsing) : C_scope. -Notation "(∉ X )" := (λ x, x ∉ X) (only parsing) : C_scope. - -Class Disjoint A := disjoint : A → A → Prop. -Instance: Params (@disjoint) 2. -Infix "⊥" := disjoint (at level 70) : C_scope. -Notation "(⊥)" := disjoint (only parsing) : C_scope. -Notation "( X ⊥.)" := (disjoint X) (only parsing) : C_scope. -Notation "(.⊥ X )" := (λ Y, Y ⊥ X) (only parsing) : C_scope. -Infix "⊥*" := (Forall2 (⊥)) (at level 70) : C_scope. -Notation "(⊥*)" := (Forall2 (⊥)) (only parsing) : C_scope. -Infix "⊥**" := (Forall2 (⊥*)) (at level 70) : C_scope. -Infix "⊥1*" := (Forall2 (λ p q, p.1 ⊥ q.1)) (at level 70) : C_scope. -Infix "⊥2*" := (Forall2 (λ p q, p.2 ⊥ q.2)) (at level 70) : C_scope. -Infix "⊥1**" := (Forall2 (λ p q, p.1 ⊥* q.1)) (at level 70) : C_scope. -Infix "⊥2**" := (Forall2 (λ p q, p.2 ⊥* q.2)) (at level 70) : C_scope. -Hint Extern 0 (_ ⊥ _) => symmetry; eassumption. -Hint Extern 0 (_ ⊥* _) => symmetry; eassumption. - -Class DisjointE E A := disjointE : E → A → A → Prop. -Instance: Params (@disjointE) 4. -Notation "X ⊥{ Γ } Y" := (disjointE Γ X Y) - (at level 70, format "X ⊥{ Γ } Y") : C_scope. -Notation "(⊥{ Γ } )" := (disjointE Γ) (only parsing, Γ at level 1) : C_scope. -Notation "Xs ⊥{ Γ }* Ys" := (Forall2 (⊥{Γ}) Xs Ys) - (at level 70, format "Xs ⊥{ Γ }* Ys") : C_scope. -Notation "(⊥{ Γ }* )" := (Forall2 (⊥{Γ})) - (only parsing, Γ at level 1) : C_scope. -Notation "X ⊥{ Γ1 , Γ2 , .. , Γ3 } Y" := (disjoint (pair .. (Γ1, Γ2) .. Γ3) X Y) - (at level 70, format "X ⊥{ Γ1 , Γ2 , .. , Γ3 } Y") : C_scope. -Notation "Xs ⊥{ Γ1 , Γ2 , .. , Γ3 }* Ys" := - (Forall2 (disjoint (pair .. (Γ1, Γ2) .. Γ3)) Xs Ys) - (at level 70, format "Xs ⊥{ Γ1 , Γ2 , .. , Γ3 }* Ys") : C_scope. -Hint Extern 0 (_ ⊥{_} _) => symmetry; eassumption. - -Class DisjointList A := disjoint_list : list A → Prop. -Instance: Params (@disjoint_list) 2. -Notation "⊥ Xs" := (disjoint_list Xs) (at level 20, format "⊥ Xs") : C_scope. - -Section disjoint_list. - Context `{Disjoint A, Union A, Empty A}. - Inductive disjoint_list_default : DisjointList A := - | disjoint_nil_2 : ⊥ (@nil A) - | disjoint_cons_2 (X : A) (Xs : list A) : X ⊥ ⋃ Xs → ⊥ Xs → ⊥ (X :: Xs). - Global Existing Instance disjoint_list_default. - - Lemma disjoint_list_nil : ⊥ @nil A ↔ True. - Proof. split; constructor. Qed. - Lemma disjoint_list_cons X Xs : ⊥ (X :: Xs) ↔ X ⊥ ⋃ Xs ∧ ⊥ Xs. - Proof. split. inversion_clear 1; auto. intros [??]. constructor; auto. Qed. -End disjoint_list. - -Class Filter A B := filter: ∀ (P : A → Prop) `{∀ x, Decision (P x)}, B → B. - -Class UpClose A B := up_close : A → B. -Notation "↑ x" := (up_close x) (at level 20, format "↑ x"). - -(** * Monadic operations *) -(** We define operational type classes for the monadic operations bind, join -and fmap. We use these type classes merely for convenient overloading of -notations and do not formalize any theory on monads (we do not even define a -class with the monad laws). *) -Class MRet (M : Type → Type) := mret: ∀ {A}, A → M A. -Arguments mret {_ _ _} _. -Instance: Params (@mret) 3. -Class MBind (M : Type → Type) := mbind : ∀ {A B}, (A → M B) → M A → M B. -Arguments mbind {_ _ _ _} _ !_ /. -Instance: Params (@mbind) 4. -Class MJoin (M : Type → Type) := mjoin: ∀ {A}, M (M A) → M A. -Arguments mjoin {_ _ _} !_ /. -Instance: Params (@mjoin) 3. -Class FMap (M : Type → Type) := fmap : ∀ {A B}, (A → B) → M A → M B. -Arguments fmap {_ _ _ _} _ !_ /. -Instance: Params (@fmap) 4. -Class OMap (M : Type → Type) := omap: ∀ {A B}, (A → option B) → M A → M B. -Arguments omap {_ _ _ _} _ !_ /. -Instance: Params (@omap) 4. - -Notation "m ≫= f" := (mbind f m) (at level 60, right associativity) : C_scope. -Notation "( m ≫=)" := (λ f, mbind f m) (only parsing) : C_scope. -Notation "(≫= f )" := (mbind f) (only parsing) : C_scope. -Notation "(≫=)" := (λ m f, mbind f m) (only parsing) : C_scope. - -Notation "x ↠y ; z" := (y ≫= (λ x : _, z)) - (at level 65, only parsing, right associativity) : C_scope. -Infix "<$>" := fmap (at level 60, right associativity) : C_scope. -Notation "' ( x1 , x2 ) ↠y ; z" := - (y ≫= (λ x : _, let ' (x1, x2) := x in z)) - (at level 65, only parsing, right associativity) : C_scope. -Notation "' ( x1 , x2 , x3 ) ↠y ; z" := - (y ≫= (λ x : _, let ' (x1,x2,x3) := x in z)) - (at level 65, only parsing, right associativity) : C_scope. -Notation "' ( x1 , x2 , x3 , x4 ) ↠y ; z" := - (y ≫= (λ x : _, let ' (x1,x2,x3,x4) := x in z)) - (at level 65, only parsing, right associativity) : C_scope. -Notation "' ( x1 , x2 , x3 , x4 , x5 ) ↠y ; z" := - (y ≫= (λ x : _, let ' (x1,x2,x3,x4,x5) := x in z)) - (at level 65, only parsing, right associativity) : C_scope. -Notation "' ( x1 , x2 , x3 , x4 , x5 , x6 ) ↠y ; z" := - (y ≫= (λ x : _, let ' (x1,x2,x3,x4,x5,x6) := x in z)) - (at level 65, only parsing, right associativity) : C_scope. - -Notation "ps .*1" := (fmap (M:=list) fst ps) - (at level 10, format "ps .*1"). -Notation "ps .*2" := (fmap (M:=list) snd ps) - (at level 10, format "ps .*2"). - -Class MGuard (M : Type → Type) := - mguard: ∀ P {dec : Decision P} {A}, (P → M A) → M A. -Arguments mguard _ _ _ !_ _ _ /. -Notation "'guard' P ; o" := (mguard P (λ _, o)) - (at level 65, only parsing, right associativity) : C_scope. -Notation "'guard' P 'as' H ; o" := (mguard P (λ H, o)) - (at level 65, only parsing, right associativity) : C_scope. - - -(** * Operations on maps *) -(** In this section we define operational type classes for the operations -on maps. In the file [fin_maps] we will axiomatize finite maps. -The function look up [m !! k] should yield the element at key [k] in [m]. *) -Class Lookup (K A M : Type) := lookup: K → M → option A. -Instance: Params (@lookup) 4. -Notation "m !! i" := (lookup i m) (at level 20) : C_scope. -Notation "(!!)" := lookup (only parsing) : C_scope. -Notation "( m !!)" := (λ i, m !! i) (only parsing) : C_scope. -Notation "(!! i )" := (lookup i) (only parsing) : C_scope. -Arguments lookup _ _ _ _ !_ !_ / : simpl nomatch. - -(** The singleton map *) -Class SingletonM K A M := singletonM: K → A → M. -Instance: Params (@singletonM) 5. -Notation "{[ k := a ]}" := (singletonM k a) (at level 1) : C_scope. - -(** The function insert [<[k:=a]>m] should update the element at key [k] with -value [a] in [m]. *) -Class Insert (K A M : Type) := insert: K → A → M → M. -Instance: Params (@insert) 5. -Notation "<[ k := a ]>" := (insert k a) - (at level 5, right associativity, format "<[ k := a ]>") : C_scope. -Arguments insert _ _ _ _ !_ _ !_ / : simpl nomatch. - -(** The function delete [delete k m] should delete the value at key [k] in -[m]. If the key [k] is not a member of [m], the original map should be -returned. *) -Class Delete (K M : Type) := delete: K → M → M. -Instance: Params (@delete) 4. -Arguments delete _ _ _ !_ !_ / : simpl nomatch. - -(** The function [alter f k m] should update the value at key [k] using the -function [f], which is called with the original value. *) -Class Alter (K A M : Type) := alter: (A → A) → K → M → M. -Instance: Params (@alter) 5. -Arguments alter {_ _ _ _} _ !_ !_ / : simpl nomatch. - -(** The function [alter f k m] should update the value at key [k] using the -function [f], which is called with the original value at key [k] or [None] -if [k] is not a member of [m]. The value at [k] should be deleted if [f] -yields [None]. *) -Class PartialAlter (K A M : Type) := - partial_alter: (option A → option A) → K → M → M. -Instance: Params (@partial_alter) 4. -Arguments partial_alter _ _ _ _ _ !_ !_ / : simpl nomatch. - -(** The function [dom C m] should yield the domain of [m]. That is a finite -collection of type [C] that contains the keys that are a member of [m]. *) -Class Dom (M C : Type) := dom: M → C. -Instance: Params (@dom) 3. -Arguments dom _ _ _ _ : clear implicits. -Arguments dom {_} _ {_} !_ / : simpl nomatch. - -(** The function [merge f m1 m2] should merge the maps [m1] and [m2] by -constructing a new map whose value at key [k] is [f (m1 !! k) (m2 !! k)].*) -Class Merge (M : Type → Type) := - merge: ∀ {A B C}, (option A → option B → option C) → M A → M B → M C. -Instance: Params (@merge) 4. -Arguments merge _ _ _ _ _ _ !_ !_ / : simpl nomatch. - -(** The function [union_with f m1 m2] is supposed to yield the union of [m1] -and [m2] using the function [f] to combine values of members that are in -both [m1] and [m2]. *) -Class UnionWith (A M : Type) := - union_with: (A → A → option A) → M → M → M. -Instance: Params (@union_with) 3. -Arguments union_with {_ _ _} _ !_ !_ / : simpl nomatch. - -(** Similarly for intersection and difference. *) -Class IntersectionWith (A M : Type) := - intersection_with: (A → A → option A) → M → M → M. -Instance: Params (@intersection_with) 3. -Arguments intersection_with {_ _ _} _ !_ !_ / : simpl nomatch. - -Class DifferenceWith (A M : Type) := - difference_with: (A → A → option A) → M → M → M. -Instance: Params (@difference_with) 3. -Arguments difference_with {_ _ _} _ !_ !_ / : simpl nomatch. - -Definition intersection_with_list `{IntersectionWith A M} - (f : A → A → option A) : M → list M → M := fold_right (intersection_with f). -Arguments intersection_with_list _ _ _ _ _ !_ /. - -Class LookupE (E K A M : Type) := lookupE: E → K → M → option A. -Instance: Params (@lookupE) 6. -Notation "m !!{ Γ } i" := (lookupE Γ i m) - (at level 20, format "m !!{ Γ } i") : C_scope. -Notation "(!!{ Γ } )" := (lookupE Γ) (only parsing, Γ at level 1) : C_scope. -Arguments lookupE _ _ _ _ _ _ !_ !_ / : simpl nomatch. - -Class InsertE (E K A M : Type) := insertE: E → K → A → M → M. -Instance: Params (@insertE) 6. -Notation "<[ k := a ]{ Γ }>" := (insertE Γ k a) - (at level 5, right associativity, format "<[ k := a ]{ Γ }>") : C_scope. -Arguments insertE _ _ _ _ _ _ !_ _ !_ / : simpl nomatch. - - -(** * Axiomatization of collections *) -(** The class [SimpleCollection A C] axiomatizes a collection of type [C] with -elements of type [A]. *) -Class SimpleCollection A C `{ElemOf A C, - Empty C, Singleton A C, Union C} : Prop := { - not_elem_of_empty (x : A) : x ∉ ∅; - elem_of_singleton (x y : A) : x ∈ {[ y ]} ↔ x = y; - elem_of_union X Y (x : A) : x ∈ X ∪ Y ↔ x ∈ X ∨ x ∈ Y -}. -Class Collection A C `{ElemOf A C, Empty C, Singleton A C, - Union C, Intersection C, Difference C} : Prop := { - collection_simple :>> SimpleCollection A C; - elem_of_intersection X Y (x : A) : x ∈ X ∩ Y ↔ x ∈ X ∧ x ∈ Y; - elem_of_difference X Y (x : A) : x ∈ X ∖ Y ↔ x ∈ X ∧ x ∉ Y -}. - -(** We axiomative a finite collection as a collection whose elements can be -enumerated as a list. These elements, given by the [elements] function, may be -in any order and should not contain duplicates. *) -Class Elements A C := elements: C → list A. -Instance: Params (@elements) 3. - -(** We redefine the standard library's [In] and [NoDup] using type classes. *) -Inductive elem_of_list {A} : ElemOf A (list A) := - | elem_of_list_here (x : A) l : x ∈ x :: l - | elem_of_list_further (x y : A) l : x ∈ l → x ∈ y :: l. -Existing Instance elem_of_list. - -Inductive NoDup {A} : list A → Prop := - | NoDup_nil_2 : NoDup [] - | NoDup_cons_2 x l : x ∉ l → NoDup l → NoDup (x :: l). - -(** Decidability of equality of the carrier set is admissible, but we add it -anyway so as to avoid cycles in type class search. *) -Class FinCollection A C `{ElemOf A C, Empty C, Singleton A C, Union C, - Intersection C, Difference C, Elements A C, EqDecision A} : Prop := { - fin_collection :>> Collection A C; - elem_of_elements X x : x ∈ elements X ↔ x ∈ X; - NoDup_elements X : NoDup (elements X) -}. -Class Size C := size: C → nat. -Arguments size {_ _} !_ / : simpl nomatch. -Instance: Params (@size) 2. - -(** The class [Collection M] axiomatizes a type constructor [M] that can be -used to construct a collection [M A] with elements of type [A]. The advantage -of this class, compared to [Collection], is that it also axiomatizes the -the monadic operations. The disadvantage, is that not many inhabits are -possible (we will only provide an inhabitant using unordered lists without -duplicates removed). More interesting implementations typically need -decidability of equality, or a total order on the elements, which do not fit -in a type constructor of type [Type → Type]. *) -Class CollectionMonad M `{∀ A, ElemOf A (M A), - ∀ A, Empty (M A), ∀ A, Singleton A (M A), ∀ A, Union (M A), - !MBind M, !MRet M, !FMap M, !MJoin M} : Prop := { - collection_monad_simple A :> SimpleCollection A (M A); - elem_of_bind {A B} (f : A → M B) (X : M A) (x : B) : - x ∈ X ≫= f ↔ ∃ y, x ∈ f y ∧ y ∈ X; - elem_of_ret {A} (x y : A) : x ∈ mret y ↔ x = y; - elem_of_fmap {A B} (f : A → B) (X : M A) (x : B) : - x ∈ f <$> X ↔ ∃ y, x = f y ∧ y ∈ X; - elem_of_join {A} (X : M (M A)) (x : A) : x ∈ mjoin X ↔ ∃ Y, x ∈ Y ∧ Y ∈ X -}. - -(** The function [fresh X] yields an element that is not contained in [X]. We -will later prove that [fresh] is [Proper] with respect to the induced setoid -equality on collections. *) -Class Fresh A C := fresh: C → A. -Instance: Params (@fresh) 3. -Class FreshSpec A C `{ElemOf A C, - Empty C, Singleton A C, Union C, Fresh A C} : Prop := { - fresh_collection_simple :>> SimpleCollection A C; - fresh_proper_alt X Y : (∀ x, x ∈ X ↔ x ∈ Y) → fresh X = fresh Y; - is_fresh (X : C) : fresh X ∉ X -}. - -(** * Miscellaneous *) -Class Half A := half: A → A. -Notation "½" := half : C_scope. -Notation "½*" := (fmap (M:=list) half) : C_scope. diff --git a/theories/prelude/bset.v b/theories/prelude/bset.v deleted file mode 100644 index 771523039044edb634cb899316f67c9f724cd591..0000000000000000000000000000000000000000 --- a/theories/prelude/bset.v +++ /dev/null @@ -1,35 +0,0 @@ -(* Copyright (c) 2012-2017, Robbert Krebbers. *) -(* This file is distributed under the terms of the BSD license. *) -(** This file implements bsets as functions into Prop. *) -From iris.prelude Require Export prelude. -Set Default Proof Using "Type". - -Record bset (A : Type) : Type := mkBSet { bset_car : A → bool }. -Arguments mkBSet {_} _. -Arguments bset_car {_} _ _. -Instance bset_top {A} : Top (bset A) := mkBSet (λ _, true). -Instance bset_empty {A} : Empty (bset A) := mkBSet (λ _, false). -Instance bset_singleton `{EqDecision A} : Singleton A (bset A) := λ x, - mkBSet (λ y, bool_decide (y = x)). -Instance bset_elem_of {A} : ElemOf A (bset A) := λ x X, bset_car X x. -Instance bset_union {A} : Union (bset A) := λ X1 X2, - mkBSet (λ x, bset_car X1 x || bset_car X2 x). -Instance bset_intersection {A} : Intersection (bset A) := λ X1 X2, - mkBSet (λ x, bset_car X1 x && bset_car X2 x). -Instance bset_difference {A} : Difference (bset A) := λ X1 X2, - mkBSet (λ x, bset_car X1 x && negb (bset_car X2 x)). -Instance bset_collection `{EqDecision A} : Collection A (bset A). -Proof. - split; [split| |]. - - by intros x ?. - - by intros x y; rewrite <-(bool_decide_spec (x = y)). - - split. apply orb_prop_elim. apply orb_prop_intro. - - split. apply andb_prop_elim. apply andb_prop_intro. - - intros X Y x; unfold elem_of, bset_elem_of; simpl. - destruct (bset_car X x), (bset_car Y x); simpl; tauto. -Qed. -Instance bset_elem_of_dec {A} x (X : bset A) : Decision (x ∈ X) := _. - -Typeclasses Opaque bset_elem_of. -Global Opaque bset_empty bset_singleton bset_union - bset_intersection bset_difference. diff --git a/theories/prelude/coPset.v b/theories/prelude/coPset.v deleted file mode 100644 index b5c11b3b351f2ea16be587c0ff7f431a55c89dd3..0000000000000000000000000000000000000000 --- a/theories/prelude/coPset.v +++ /dev/null @@ -1,436 +0,0 @@ -(* Copyright (c) 2012-2017, Robbert Krebbers. *) -(* This file is distributed under the terms of the BSD license. *) -(** This files implements the type [coPset] of efficient finite/cofinite sets -of positive binary naturals [positive]. These sets are: - -- Closed under union, intersection and set complement. -- Closed under splitting of cofinite sets. - -Also, they enjoy various nice properties, such as decidable equality and set -membership, as well as extensional equality (i.e. [X = Y ↔ ∀ x, x ∈ X ↔ x ∈ Y]). - -Since [positive]s are bitstrings, we encode [coPset]s as trees that correspond -to the decision function that map bitstrings to bools. *) -From iris.prelude Require Export collections. -From iris.prelude Require Import pmap gmap mapset. -Set Default Proof Using "Type". -Local Open Scope positive_scope. - -(** * The tree data structure *) -Inductive coPset_raw := - | coPLeaf : bool → coPset_raw - | coPNode : bool → coPset_raw → coPset_raw → coPset_raw. -Instance coPset_raw_eq_dec : EqDecision coPset_raw. -Proof. solve_decision. Defined. - -Fixpoint coPset_wf (t : coPset_raw) : bool := - match t with - | coPLeaf _ => true - | coPNode true (coPLeaf true) (coPLeaf true) => false - | coPNode false (coPLeaf false) (coPLeaf false) => false - | coPNode b l r => coPset_wf l && coPset_wf r - end. -Arguments coPset_wf !_ / : simpl nomatch. - -Lemma coPNode_wf_l b l r : coPset_wf (coPNode b l r) → coPset_wf l. -Proof. destruct b, l as [[]|],r as [[]|]; simpl; rewrite ?andb_True; tauto. Qed. -Lemma coPNode_wf_r b l r : coPset_wf (coPNode b l r) → coPset_wf r. -Proof. destruct b, l as [[]|],r as [[]|]; simpl; rewrite ?andb_True; tauto. Qed. -Local Hint Immediate coPNode_wf_l coPNode_wf_r. - -Definition coPNode' (b : bool) (l r : coPset_raw) : coPset_raw := - match b, l, r with - | true, coPLeaf true, coPLeaf true => coPLeaf true - | false, coPLeaf false, coPLeaf false => coPLeaf false - | _, _, _ => coPNode b l r - end. -Arguments coPNode' _ _ _ : simpl never. -Lemma coPNode_wf b l r : coPset_wf l → coPset_wf r → coPset_wf (coPNode' b l r). -Proof. destruct b, l as [[]|], r as [[]|]; simpl; auto. Qed. -Hint Resolve coPNode_wf. - -Fixpoint coPset_elem_of_raw (p : positive) (t : coPset_raw) {struct t} : bool := - match t, p with - | coPLeaf b, _ => b - | coPNode b l r, 1 => b - | coPNode _ l _, p~0 => coPset_elem_of_raw p l - | coPNode _ _ r, p~1 => coPset_elem_of_raw p r - end. -Local Notation e_of := coPset_elem_of_raw. -Arguments coPset_elem_of_raw _ !_ / : simpl nomatch. -Lemma coPset_elem_of_node b l r p : - e_of p (coPNode' b l r) = e_of p (coPNode b l r). -Proof. by destruct p, b, l as [[]|], r as [[]|]. Qed. - -Lemma coPLeaf_wf t b : (∀ p, e_of p t = b) → coPset_wf t → t = coPLeaf b. -Proof. - induction t as [b'|b' l IHl r IHr]; intros Ht ?; [f_equal; apply (Ht 1)|]. - assert (b' = b) by (apply (Ht 1)); subst. - assert (l = coPLeaf b) as -> by (apply IHl; try apply (λ p, Ht (p~0)); eauto). - assert (r = coPLeaf b) as -> by (apply IHr; try apply (λ p, Ht (p~1)); eauto). - by destruct b. -Qed. -Lemma coPset_eq t1 t2 : - (∀ p, e_of p t1 = e_of p t2) → coPset_wf t1 → coPset_wf t2 → t1 = t2. -Proof. - revert t2. - induction t1 as [b1|b1 l1 IHl r1 IHr]; intros [b2|b2 l2 r2] Ht ??; simpl in *. - - f_equal; apply (Ht 1). - - by discriminate (coPLeaf_wf (coPNode b2 l2 r2) b1). - - by discriminate (coPLeaf_wf (coPNode b1 l1 r1) b2). - - f_equal; [apply (Ht 1)| |]. - + apply IHl; try apply (λ x, Ht (x~0)); eauto. - + apply IHr; try apply (λ x, Ht (x~1)); eauto. -Qed. - -Fixpoint coPset_singleton_raw (p : positive) : coPset_raw := - match p with - | 1 => coPNode true (coPLeaf false) (coPLeaf false) - | p~0 => coPNode' false (coPset_singleton_raw p) (coPLeaf false) - | p~1 => coPNode' false (coPLeaf false) (coPset_singleton_raw p) - end. -Instance coPset_union_raw : Union coPset_raw := - fix go t1 t2 := let _ : Union _ := @go in - match t1, t2 with - | coPLeaf false, coPLeaf false => coPLeaf false - | _, coPLeaf true => coPLeaf true - | coPLeaf true, _ => coPLeaf true - | coPNode b l r, coPLeaf false => coPNode b l r - | coPLeaf false, coPNode b l r => coPNode b l r - | coPNode b1 l1 r1, coPNode b2 l2 r2 => coPNode' (b1||b2) (l1 ∪ l2) (r1 ∪ r2) - end. -Local Arguments union _ _!_ !_ /. -Instance coPset_intersection_raw : Intersection coPset_raw := - fix go t1 t2 := let _ : Intersection _ := @go in - match t1, t2 with - | coPLeaf true, coPLeaf true => coPLeaf true - | _, coPLeaf false => coPLeaf false - | coPLeaf false, _ => coPLeaf false - | coPNode b l r, coPLeaf true => coPNode b l r - | coPLeaf true, coPNode b l r => coPNode b l r - | coPNode b1 l1 r1, coPNode b2 l2 r2 => coPNode' (b1&&b2) (l1 ∩ l2) (r1 ∩ r2) - end. -Local Arguments intersection _ _!_ !_ /. -Fixpoint coPset_opp_raw (t : coPset_raw) : coPset_raw := - match t with - | coPLeaf b => coPLeaf (negb b) - | coPNode b l r => coPNode' (negb b) (coPset_opp_raw l) (coPset_opp_raw r) - end. - -Lemma coPset_singleton_wf p : coPset_wf (coPset_singleton_raw p). -Proof. induction p; simpl; eauto. Qed. -Lemma coPset_union_wf t1 t2 : coPset_wf t1 → coPset_wf t2 → coPset_wf (t1 ∪ t2). -Proof. revert t2; induction t1 as [[]|[]]; intros [[]|[] ??]; simpl; eauto. Qed. -Lemma coPset_intersection_wf t1 t2 : - coPset_wf t1 → coPset_wf t2 → coPset_wf (t1 ∩ t2). -Proof. revert t2; induction t1 as [[]|[]]; intros [[]|[] ??]; simpl; eauto. Qed. -Lemma coPset_opp_wf t : coPset_wf (coPset_opp_raw t). -Proof. induction t as [[]|[]]; simpl; eauto. Qed. -Lemma elem_to_Pset_singleton p q : e_of p (coPset_singleton_raw q) ↔ p = q. -Proof. - split; [|by intros <-; induction p; simpl; rewrite ?coPset_elem_of_node]. - by revert q; induction p; intros [?|?|]; simpl; - rewrite ?coPset_elem_of_node; intros; f_equal/=; auto. -Qed. -Lemma elem_to_Pset_union t1 t2 p : e_of p (t1 ∪ t2) = e_of p t1 || e_of p t2. -Proof. - by revert t2 p; induction t1 as [[]|[]]; intros [[]|[] ??] [?|?|]; simpl; - rewrite ?coPset_elem_of_node; simpl; - rewrite ?orb_true_l, ?orb_false_l, ?orb_true_r, ?orb_false_r. -Qed. -Lemma elem_to_Pset_intersection t1 t2 p : - e_of p (t1 ∩ t2) = e_of p t1 && e_of p t2. -Proof. - by revert t2 p; induction t1 as [[]|[]]; intros [[]|[] ??] [?|?|]; simpl; - rewrite ?coPset_elem_of_node; simpl; - rewrite ?andb_true_l, ?andb_false_l, ?andb_true_r, ?andb_false_r. -Qed. -Lemma elem_to_Pset_opp t p : e_of p (coPset_opp_raw t) = negb (e_of p t). -Proof. - by revert p; induction t as [[]|[]]; intros [?|?|]; simpl; - rewrite ?coPset_elem_of_node; simpl. -Qed. - -(** * Packed together + set operations *) -Definition coPset := { t | coPset_wf t }. - -Instance coPset_singleton : Singleton positive coPset := λ p, - coPset_singleton_raw p ↾ coPset_singleton_wf _. -Instance coPset_elem_of : ElemOf positive coPset := λ p X, e_of p (`X). -Instance coPset_empty : Empty coPset := coPLeaf false ↾ I. -Instance coPset_top : Top coPset := coPLeaf true ↾ I. -Instance coPset_union : Union coPset := λ X Y, - let (t1,Ht1) := X in let (t2,Ht2) := Y in - (t1 ∪ t2) ↾ coPset_union_wf _ _ Ht1 Ht2. -Instance coPset_intersection : Intersection coPset := λ X Y, - let (t1,Ht1) := X in let (t2,Ht2) := Y in - (t1 ∩ t2) ↾ coPset_intersection_wf _ _ Ht1 Ht2. -Instance coPset_difference : Difference coPset := λ X Y, - let (t1,Ht1) := X in let (t2,Ht2) := Y in - (t1 ∩ coPset_opp_raw t2) ↾ coPset_intersection_wf _ _ Ht1 (coPset_opp_wf _). - -Instance coPset_collection : Collection positive coPset. -Proof. - split; [split| |]. - - by intros ??. - - intros p q. apply elem_to_Pset_singleton. - - intros [t] [t'] p; unfold elem_of, coPset_elem_of, coPset_union; simpl. - by rewrite elem_to_Pset_union, orb_True. - - intros [t] [t'] p; unfold elem_of,coPset_elem_of,coPset_intersection; simpl. - by rewrite elem_to_Pset_intersection, andb_True. - - intros [t] [t'] p; unfold elem_of, coPset_elem_of, coPset_difference; simpl. - by rewrite elem_to_Pset_intersection, - elem_to_Pset_opp, andb_True, negb_True. -Qed. - -Instance coPset_leibniz : LeibnizEquiv coPset. -Proof. - intros X Y; rewrite elem_of_equiv; intros HXY. - apply (sig_eq_pi _), coPset_eq; try apply proj2_sig. - intros p; apply eq_bool_prop_intro, (HXY p). -Qed. - -Instance coPset_elem_of_dec (p : positive) (X : coPset) : Decision (p ∈ X) := _. -Instance coPset_equiv_dec (X Y : coPset) : Decision (X ≡ Y). -Proof. refine (cast_if (decide (X = Y))); abstract (by fold_leibniz). Defined. -Instance mapset_disjoint_dec (X Y : coPset) : Decision (X ⊥ Y). -Proof. - refine (cast_if (decide (X ∩ Y = ∅))); - abstract (by rewrite disjoint_intersection_L). -Defined. -Instance mapset_subseteq_dec (X Y : coPset) : Decision (X ⊆ Y). -Proof. - refine (cast_if (decide (X ∪ Y = Y))); abstract (by rewrite subseteq_union_L). -Defined. - -(** * Top *) -Lemma coPset_top_subseteq (X : coPset) : X ⊆ ⊤. -Proof. done. Qed. -Hint Resolve coPset_top_subseteq. - -(** * Finite sets *) -Fixpoint coPset_finite (t : coPset_raw) : bool := - match t with - | coPLeaf b => negb b | coPNode b l r => coPset_finite l && coPset_finite r - end. -Lemma coPset_finite_node b l r : - coPset_finite (coPNode' b l r) = coPset_finite l && coPset_finite r. -Proof. by destruct b, l as [[]|], r as [[]|]. Qed. -Lemma coPset_finite_spec X : set_finite X ↔ coPset_finite (`X). -Proof. - destruct X as [t Ht]. - unfold set_finite, elem_of at 1, coPset_elem_of; simpl; clear Ht; split. - - induction t as [b|b l IHl r IHr]; simpl. - { destruct b; simpl; [intros [l Hl]|done]. - by apply (is_fresh (of_list l : Pset)), elem_of_of_list, Hl. } - intros [ll Hll]; rewrite andb_True; split. - + apply IHl; exists (omap (maybe (~0)) ll); intros i. - rewrite elem_of_list_omap; intros; exists (i~0); auto. - + apply IHr; exists (omap (maybe (~1)) ll); intros i. - rewrite elem_of_list_omap; intros; exists (i~1); auto. - - induction t as [b|b l IHl r IHr]; simpl; [by exists []; destruct b|]. - rewrite andb_True; intros [??]; destruct IHl as [ll ?], IHr as [rl ?]; auto. - exists ([1] ++ ((~0) <$> ll) ++ ((~1) <$> rl))%list; intros [i|i|]; simpl; - rewrite elem_of_cons, elem_of_app, !elem_of_list_fmap; naive_solver. -Qed. -Instance coPset_finite_dec (X : coPset) : Decision (set_finite X). -Proof. - refine (cast_if (decide (coPset_finite (`X)))); by rewrite coPset_finite_spec. -Defined. - -(** * Pick element from infinite sets *) -(* Implemented using depth-first search, which results in very unbalanced -trees. *) -Fixpoint coPpick_raw (t : coPset_raw) : option positive := - match t with - | coPLeaf true | coPNode true _ _ => Some 1 - | coPLeaf false => None - | coPNode false l r => - match coPpick_raw l with - | Some i => Some (i~0) | None => (~1) <$> coPpick_raw r - end - end. -Definition coPpick (X : coPset) : positive := from_option id 1 (coPpick_raw (`X)). - -Lemma coPpick_raw_elem_of t i : coPpick_raw t = Some i → e_of i t. -Proof. - revert i; induction t as [[]|[] l ? r]; intros i ?; simplify_eq/=; auto. - destruct (coPpick_raw l); simplify_option_eq; auto. -Qed. -Lemma coPpick_raw_None t : coPpick_raw t = None → coPset_finite t. -Proof. - induction t as [[]|[] l ? r]; intros i; simplify_eq/=; auto. - destruct (coPpick_raw l); simplify_option_eq; auto. -Qed. -Lemma coPpick_elem_of X : ¬set_finite X → coPpick X ∈ X. -Proof. - destruct X as [t ?]; unfold coPpick; destruct (coPpick_raw _) as [j|] eqn:?. - - by intros; apply coPpick_raw_elem_of. - - by intros []; apply coPset_finite_spec, coPpick_raw_None. -Qed. - -(** * Conversion to psets *) -Fixpoint to_Pset_raw (t : coPset_raw) : Pmap_raw () := - match t with - | coPLeaf _ => PLeaf - | coPNode false l r => PNode' None (to_Pset_raw l) (to_Pset_raw r) - | coPNode true l r => PNode (Some ()) (to_Pset_raw l) (to_Pset_raw r) - end. -Lemma to_Pset_wf t : coPset_wf t → Pmap_wf (to_Pset_raw t). -Proof. induction t as [|[]]; simpl; eauto using PNode_wf. Qed. -Definition to_Pset (X : coPset) : Pset := - let (t,Ht) := X in Mapset (PMap (to_Pset_raw t) (to_Pset_wf _ Ht)). -Lemma elem_of_to_Pset X i : set_finite X → i ∈ to_Pset X ↔ i ∈ X. -Proof. - rewrite coPset_finite_spec; destruct X as [t Ht]. - change (coPset_finite t → to_Pset_raw t !! i = Some () ↔ e_of i t). - clear Ht; revert i; induction t as [[]|[] l IHl r IHr]; intros [i|i|]; - simpl; rewrite ?andb_True, ?PNode_lookup; naive_solver. -Qed. - -(** * Conversion from psets *) -Fixpoint of_Pset_raw (t : Pmap_raw ()) : coPset_raw := - match t with - | PLeaf => coPLeaf false - | PNode None l r => coPNode false (of_Pset_raw l) (of_Pset_raw r) - | PNode (Some _) l r => coPNode true (of_Pset_raw l) (of_Pset_raw r) - end. -Lemma of_Pset_wf t : Pmap_wf t → coPset_wf (of_Pset_raw t). -Proof. - induction t as [|[] l IHl r IHr]; simpl; rewrite ?andb_True; auto. - - intros [??]; destruct l as [|[]], r as [|[]]; simpl in *; auto. - - destruct l as [|[]], r as [|[]]; simpl in *; rewrite ?andb_true_r; - rewrite ?andb_True; rewrite ?andb_True in IHl, IHr; intuition. -Qed. -Lemma elem_of_of_Pset_raw i t : e_of i (of_Pset_raw t) ↔ t !! i = Some (). -Proof. by revert i; induction t as [|[[]|]]; intros []; simpl; auto; split. Qed. -Lemma of_Pset_raw_finite t : coPset_finite (of_Pset_raw t). -Proof. induction t as [|[[]|]]; simpl; rewrite ?andb_True; auto. Qed. - -Definition of_Pset (X : Pset) : coPset := - let 'Mapset (PMap t Ht) := X in of_Pset_raw t ↾ of_Pset_wf _ Ht. -Lemma elem_of_of_Pset X i : i ∈ of_Pset X ↔ i ∈ X. -Proof. destruct X as [[t ?]]; apply elem_of_of_Pset_raw. Qed. -Lemma of_Pset_finite X : set_finite (of_Pset X). -Proof. - apply coPset_finite_spec; destruct X as [[t ?]]; apply of_Pset_raw_finite. -Qed. - -(** * Conversion to and from gsets of positives *) -Lemma to_gset_wf (m : Pmap ()) : gmap_wf (K:=positive) m. -Proof. done. Qed. -Definition to_gset (X : coPset) : gset positive := - let 'Mapset m := to_Pset X in - Mapset (GMap m (bool_decide_pack _ (to_gset_wf m))). - -Definition of_gset (X : gset positive) : coPset := - let 'Mapset (GMap (PMap t Ht) _) := X in of_Pset_raw t ↾ of_Pset_wf _ Ht. - -Lemma elem_of_to_gset X i : set_finite X → i ∈ to_gset X ↔ i ∈ X. -Proof. - intros ?. rewrite <-elem_of_to_Pset by done. - unfold to_gset. by destruct (to_Pset X). -Qed. - -Lemma elem_of_of_gset X i : i ∈ of_gset X ↔ i ∈ X. -Proof. destruct X as [[[t ?]]]; apply elem_of_of_Pset_raw. Qed. -Lemma of_gset_finite X : set_finite (of_gset X). -Proof. - apply coPset_finite_spec; destruct X as [[[t ?]]]; apply of_Pset_raw_finite. -Qed. - -(** * Domain of finite maps *) -Instance Pmap_dom_coPset {A} : Dom (Pmap A) coPset := λ m, of_Pset (dom _ m). -Instance Pmap_dom_coPset_spec: FinMapDom positive Pmap coPset. -Proof. - split; try apply _; intros A m i; unfold dom, Pmap_dom_coPset. - by rewrite elem_of_of_Pset, elem_of_dom. -Qed. -Instance gmap_dom_coPset {A} : Dom (gmap positive A) coPset := λ m, - of_gset (dom _ m). -Instance gmap_dom_coPset_spec: FinMapDom positive (gmap positive) coPset. -Proof. - split; try apply _; intros A m i; unfold dom, gmap_dom_coPset. - by rewrite elem_of_of_gset, elem_of_dom. -Qed. - -(** * Suffix sets *) -Fixpoint coPset_suffixes_raw (p : positive) : coPset_raw := - match p with - | 1 => coPLeaf true - | p~0 => coPNode' false (coPset_suffixes_raw p) (coPLeaf false) - | p~1 => coPNode' false (coPLeaf false) (coPset_suffixes_raw p) - end. -Lemma coPset_suffixes_wf p : coPset_wf (coPset_suffixes_raw p). -Proof. induction p; simpl; eauto. Qed. -Definition coPset_suffixes (p : positive) : coPset := - coPset_suffixes_raw p ↾ coPset_suffixes_wf _. -Lemma elem_coPset_suffixes p q : p ∈ coPset_suffixes q ↔ ∃ q', p = q' ++ q. -Proof. - unfold elem_of, coPset_elem_of; simpl; split. - - revert p; induction q; intros [?|?|]; simpl; - rewrite ?coPset_elem_of_node; naive_solver. - - by intros [q' ->]; induction q; simpl; rewrite ?coPset_elem_of_node. -Qed. -Lemma coPset_suffixes_infinite p : ¬set_finite (coPset_suffixes p). -Proof. - rewrite coPset_finite_spec; simpl. - induction p; simpl; rewrite ?coPset_finite_node, ?andb_True; naive_solver. -Qed. - -(** * Splitting of infinite sets *) -Fixpoint coPset_l_raw (t : coPset_raw) : coPset_raw := - match t with - | coPLeaf false => coPLeaf false - | coPLeaf true => coPNode true (coPLeaf true) (coPLeaf false) - | coPNode b l r => coPNode' b (coPset_l_raw l) (coPset_l_raw r) - end. -Fixpoint coPset_r_raw (t : coPset_raw) : coPset_raw := - match t with - | coPLeaf false => coPLeaf false - | coPLeaf true => coPNode false (coPLeaf false) (coPLeaf true) - | coPNode b l r => coPNode' false (coPset_r_raw l) (coPset_r_raw r) - end. - -Lemma coPset_l_wf t : coPset_wf (coPset_l_raw t). -Proof. induction t as [[]|]; simpl; auto. Qed. -Lemma coPset_r_wf t : coPset_wf (coPset_r_raw t). -Proof. induction t as [[]|]; simpl; auto. Qed. -Definition coPset_l (X : coPset) : coPset := - let (t,Ht) := X in coPset_l_raw t ↾ coPset_l_wf _. -Definition coPset_r (X : coPset) : coPset := - let (t,Ht) := X in coPset_r_raw t ↾ coPset_r_wf _. - -Lemma coPset_lr_disjoint X : coPset_l X ∩ coPset_r X = ∅. -Proof. - apply elem_of_equiv_empty_L; intros p; apply Is_true_false. - destruct X as [t Ht]; simpl; clear Ht; rewrite elem_to_Pset_intersection. - revert p; induction t as [[]|[]]; intros [?|?|]; simpl; - rewrite ?coPset_elem_of_node; simpl; - rewrite ?orb_true_l, ?orb_false_l, ?orb_true_r, ?orb_false_r; auto. -Qed. -Lemma coPset_lr_union X : coPset_l X ∪ coPset_r X = X. -Proof. - apply elem_of_equiv_L; intros p; apply eq_bool_prop_elim. - destruct X as [t Ht]; simpl; clear Ht; rewrite elem_to_Pset_union. - revert p; induction t as [[]|[]]; intros [?|?|]; simpl; - rewrite ?coPset_elem_of_node; simpl; - rewrite ?orb_true_l, ?orb_false_l, ?orb_true_r, ?orb_false_r; auto. -Qed. -Lemma coPset_l_finite X : set_finite (coPset_l X) → set_finite X. -Proof. - rewrite !coPset_finite_spec; destruct X as [t Ht]; simpl; clear Ht. - induction t as [[]|]; simpl; rewrite ?coPset_finite_node, ?andb_True; tauto. -Qed. -Lemma coPset_r_finite X : set_finite (coPset_r X) → set_finite X. -Proof. - rewrite !coPset_finite_spec; destruct X as [t Ht]; simpl; clear Ht. - induction t as [[]|]; simpl; rewrite ?coPset_finite_node, ?andb_True; tauto. -Qed. -Lemma coPset_split X : - ¬set_finite X → - ∃ X1 X2, X = X1 ∪ X2 ∧ X1 ∩ X2 = ∅ ∧ ¬set_finite X1 ∧ ¬set_finite X2. -Proof. - exists (coPset_l X), (coPset_r X); eauto 10 using coPset_lr_union, - coPset_lr_disjoint, coPset_l_finite, coPset_r_finite. -Qed. diff --git a/theories/prelude/collections.v b/theories/prelude/collections.v deleted file mode 100644 index 2418e485d27c9a6f2b4329aed1e41361132ddfa8..0000000000000000000000000000000000000000 --- a/theories/prelude/collections.v +++ /dev/null @@ -1,1069 +0,0 @@ -(* Copyright (c) 2012-2017, Robbert Krebbers. *) -(* This file is distributed under the terms of the BSD license. *) -(** This file collects definitions and theorems on collections. Most -importantly, it implements some tactics to automatically solve goals involving -collections. *) -From iris.prelude Require Export orders list. -(* FIXME: This file needs a 'Proof Using' hint, but the default we use - everywhere makes for lots of extra ssumptions. *) - -Instance collection_equiv `{ElemOf A C} : Equiv C := λ X Y, - ∀ x, x ∈ X ↔ x ∈ Y. -Instance collection_subseteq `{ElemOf A C} : SubsetEq C := λ X Y, - ∀ x, x ∈ X → x ∈ Y. -Instance collection_disjoint `{ElemOf A C} : Disjoint C := λ X Y, - ∀ x, x ∈ X → x ∈ Y → False. -Typeclasses Opaque collection_equiv collection_subseteq collection_disjoint. - -(** * Setoids *) -Section setoids_simple. - Context `{SimpleCollection A C}. - - Global Instance collection_equivalence: @Equivalence C (≡). - Proof. - split. - - done. - - intros X Y ? x. by symmetry. - - intros X Y Z ?? x; by trans (x ∈ Y). - Qed. - Global Instance singleton_proper : Proper ((=) ==> (≡)) (singleton (B:=C)). - Proof. apply _. Qed. - Global Instance elem_of_proper : - Proper ((=) ==> (≡) ==> iff) (@elem_of A C _) | 5. - Proof. by intros x ? <- X Y. Qed. - Global Instance disjoint_proper: Proper ((≡) ==> (≡) ==> iff) (@disjoint C _). - Proof. - intros X1 X2 HX Y1 Y2 HY; apply forall_proper; intros x. by rewrite HX, HY. - Qed. - Global Instance union_proper : Proper ((≡) ==> (≡) ==> (≡)) (@union C _). - Proof. intros X1 X2 HX Y1 Y2 HY x. rewrite !elem_of_union. f_equiv; auto. Qed. - Global Instance union_list_proper: Proper ((≡) ==> (≡)) (union_list (A:=C)). - Proof. by induction 1; simpl; try apply union_proper. Qed. - Global Instance subseteq_proper : Proper ((≡) ==> (≡) ==> iff) ((⊆) : relation C). - Proof. - intros X1 X2 HX Y1 Y2 HY. apply forall_proper; intros x. by rewrite HX, HY. - Qed. -End setoids_simple. - -Section setoids. - Context `{Collection A C}. - - (** * Setoids *) - Global Instance intersection_proper : - Proper ((≡) ==> (≡) ==> (≡)) (@intersection C _). - Proof. - intros X1 X2 HX Y1 Y2 HY x. by rewrite !elem_of_intersection, HX, HY. - Qed. - Global Instance difference_proper : - Proper ((≡) ==> (≡) ==> (≡)) (@difference C _). - Proof. - intros X1 X2 HX Y1 Y2 HY x. by rewrite !elem_of_difference, HX, HY. - Qed. -End setoids. - -Section setoids_monad. - Context `{CollectionMonad M}. - - Global Instance collection_fmap_proper {A B} : - Proper (pointwise_relation _ (=) ==> (≡) ==> (≡)) (@fmap M _ A B). - Proof. - intros f1 f2 Hf X1 X2 HX x. rewrite !elem_of_fmap. f_equiv; intros z. - by rewrite HX, Hf. - Qed. - Global Instance collection_bind_proper {A B} : - Proper (((=) ==> (≡)) ==> (≡) ==> (≡)) (@mbind M _ A B). - Proof. - intros f1 f2 Hf X1 X2 HX x. rewrite !elem_of_bind. f_equiv; intros z. - by rewrite HX, (Hf z z). - Qed. - Global Instance collection_join_proper {A} : - Proper ((≡) ==> (≡)) (@mjoin M _ A). - Proof. - intros X1 X2 HX x. rewrite !elem_of_join. f_equiv; intros z. by rewrite HX. - Qed. -End setoids_monad. - -(** * Tactics *) -(** The tactic [set_unfold] transforms all occurrences of [(∪)], [(∩)], [(∖)], -[(<$>)], [∅], [{[_]}], [(≡)], and [(⊆)] into logically equivalent propositions -involving just [∈]. For example, [A → x ∈ X ∪ ∅] becomes [A → x ∈ X ∨ False]. - -This transformation is implemented using type classes instead of setoid -rewriting to ensure that we traverse each term at most once and to be able to -deal with occurences of the set operations under binders. *) -Class SetUnfold (P Q : Prop) := { set_unfold : P ↔ Q }. -Arguments set_unfold _ _ {_}. -Hint Mode SetUnfold + - : typeclass_instances. - -Class SetUnfoldSimpl (P Q : Prop) := { set_unfold_simpl : SetUnfold P Q }. -Hint Extern 0 (SetUnfoldSimpl _ _) => csimpl; constructor : typeclass_instances. - -Instance set_unfold_default P : SetUnfold P P | 1000. done. Qed. -Definition set_unfold_1 `{SetUnfold P Q} : P → Q := proj1 (set_unfold P Q). -Definition set_unfold_2 `{SetUnfold P Q} : Q → P := proj2 (set_unfold P Q). - -Lemma set_unfold_impl P Q P' Q' : - SetUnfold P P' → SetUnfold Q Q' → SetUnfold (P → Q) (P' → Q'). -Proof. constructor. by rewrite (set_unfold P P'), (set_unfold Q Q'). Qed. -Lemma set_unfold_and P Q P' Q' : - SetUnfold P P' → SetUnfold Q Q' → SetUnfold (P ∧ Q) (P' ∧ Q'). -Proof. constructor. by rewrite (set_unfold P P'), (set_unfold Q Q'). Qed. -Lemma set_unfold_or P Q P' Q' : - SetUnfold P P' → SetUnfold Q Q' → SetUnfold (P ∨ Q) (P' ∨ Q'). -Proof. constructor. by rewrite (set_unfold P P'), (set_unfold Q Q'). Qed. -Lemma set_unfold_iff P Q P' Q' : - SetUnfold P P' → SetUnfold Q Q' → SetUnfold (P ↔ Q) (P' ↔ Q'). -Proof. constructor. by rewrite (set_unfold P P'), (set_unfold Q Q'). Qed. -Lemma set_unfold_not P P' : SetUnfold P P' → SetUnfold (¬P) (¬P'). -Proof. constructor. by rewrite (set_unfold P P'). Qed. -Lemma set_unfold_forall {A} (P P' : A → Prop) : - (∀ x, SetUnfold (P x) (P' x)) → SetUnfold (∀ x, P x) (∀ x, P' x). -Proof. constructor. naive_solver. Qed. -Lemma set_unfold_exist {A} (P P' : A → Prop) : - (∀ x, SetUnfold (P x) (P' x)) → SetUnfold (∃ x, P x) (∃ x, P' x). -Proof. constructor. naive_solver. Qed. - -(* Avoid too eager application of the above instances (and thus too eager -unfolding of type class transparent definitions). *) -Hint Extern 0 (SetUnfold (_ → _) _) => - class_apply set_unfold_impl : typeclass_instances. -Hint Extern 0 (SetUnfold (_ ∧ _) _) => - class_apply set_unfold_and : typeclass_instances. -Hint Extern 0 (SetUnfold (_ ∨ _) _) => - class_apply set_unfold_or : typeclass_instances. -Hint Extern 0 (SetUnfold (_ ↔ _) _) => - class_apply set_unfold_iff : typeclass_instances. -Hint Extern 0 (SetUnfold (¬ _) _) => - class_apply set_unfold_not : typeclass_instances. -Hint Extern 1 (SetUnfold (∀ _, _) _) => - class_apply set_unfold_forall : typeclass_instances. -Hint Extern 0 (SetUnfold (∃ _, _) _) => - class_apply set_unfold_exist : typeclass_instances. - -Section set_unfold_simple. - Context `{SimpleCollection A C}. - Implicit Types x y : A. - Implicit Types X Y : C. - - Global Instance set_unfold_empty x : SetUnfold (x ∈ ∅) False. - Proof. constructor. split. apply not_elem_of_empty. done. Qed. - Global Instance set_unfold_singleton x y : SetUnfold (x ∈ {[ y ]}) (x = y). - Proof. constructor; apply elem_of_singleton. Qed. - Global Instance set_unfold_union x X Y P Q : - SetUnfold (x ∈ X) P → SetUnfold (x ∈ Y) Q → SetUnfold (x ∈ X ∪ Y) (P ∨ Q). - Proof. - intros ??; constructor. - by rewrite elem_of_union, (set_unfold (x ∈ X) P), (set_unfold (x ∈ Y) Q). - Qed. - Global Instance set_unfold_equiv_same X : SetUnfold (X ≡ X) True | 1. - Proof. done. Qed. - Global Instance set_unfold_equiv_empty_l X (P : A → Prop) : - (∀ x, SetUnfold (x ∈ X) (P x)) → SetUnfold (∅ ≡ X) (∀ x, ¬P x) | 5. - Proof. - intros ?; constructor. unfold equiv, collection_equiv. - pose proof not_elem_of_empty; naive_solver. - Qed. - Global Instance set_unfold_equiv_empty_r (P : A → Prop) : - (∀ x, SetUnfold (x ∈ X) (P x)) → SetUnfold (X ≡ ∅) (∀ x, ¬P x) | 5. - Proof. - intros ?; constructor. unfold equiv, collection_equiv. - pose proof not_elem_of_empty; naive_solver. - Qed. - Global Instance set_unfold_equiv (P Q : A → Prop) : - (∀ x, SetUnfold (x ∈ X) (P x)) → (∀ x, SetUnfold (x ∈ Y) (Q x)) → - SetUnfold (X ≡ Y) (∀ x, P x ↔ Q x) | 10. - Proof. constructor. apply forall_proper; naive_solver. Qed. - Global Instance set_unfold_subseteq (P Q : A → Prop) : - (∀ x, SetUnfold (x ∈ X) (P x)) → (∀ x, SetUnfold (x ∈ Y) (Q x)) → - SetUnfold (X ⊆ Y) (∀ x, P x → Q x). - Proof. constructor. apply forall_proper; naive_solver. Qed. - Global Instance set_unfold_subset (P Q : A → Prop) : - (∀ x, SetUnfold (x ∈ X) (P x)) → (∀ x, SetUnfold (x ∈ Y) (Q x)) → - SetUnfold (X ⊂ Y) ((∀ x, P x → Q x) ∧ ¬∀ x, Q x → P x). - Proof. - constructor. unfold strict. - repeat f_equiv; apply forall_proper; naive_solver. - Qed. - Global Instance set_unfold_disjoint (P Q : A → Prop) : - (∀ x, SetUnfold (x ∈ X) (P x)) → (∀ x, SetUnfold (x ∈ Y) (Q x)) → - SetUnfold (X ⊥ Y) (∀ x, P x → Q x → False). - Proof. constructor. unfold disjoint, collection_disjoint. naive_solver. Qed. - - Context `{!LeibnizEquiv C}. - Global Instance set_unfold_equiv_same_L X : SetUnfold (X = X) True | 1. - Proof. done. Qed. - Global Instance set_unfold_equiv_empty_l_L X (P : A → Prop) : - (∀ x, SetUnfold (x ∈ X) (P x)) → SetUnfold (∅ = X) (∀ x, ¬P x) | 5. - Proof. constructor. unfold_leibniz. by apply set_unfold_equiv_empty_l. Qed. - Global Instance set_unfold_equiv_empty_r_L (P : A → Prop) : - (∀ x, SetUnfold (x ∈ X) (P x)) → SetUnfold (X = ∅) (∀ x, ¬P x) | 5. - Proof. constructor. unfold_leibniz. by apply set_unfold_equiv_empty_r. Qed. - Global Instance set_unfold_equiv_L (P Q : A → Prop) : - (∀ x, SetUnfold (x ∈ X) (P x)) → (∀ x, SetUnfold (x ∈ Y) (Q x)) → - SetUnfold (X = Y) (∀ x, P x ↔ Q x) | 10. - Proof. constructor. unfold_leibniz. by apply set_unfold_equiv. Qed. -End set_unfold_simple. - -Section set_unfold. - Context `{Collection A C}. - Implicit Types x y : A. - Implicit Types X Y : C. - - Global Instance set_unfold_intersection x X Y P Q : - SetUnfold (x ∈ X) P → SetUnfold (x ∈ Y) Q → SetUnfold (x ∈ X ∩ Y) (P ∧ Q). - Proof. - intros ??; constructor. rewrite elem_of_intersection. - by rewrite (set_unfold (x ∈ X) P), (set_unfold (x ∈ Y) Q). - Qed. - Global Instance set_unfold_difference x X Y P Q : - SetUnfold (x ∈ X) P → SetUnfold (x ∈ Y) Q → SetUnfold (x ∈ X ∖ Y) (P ∧ ¬Q). - Proof. - intros ??; constructor. rewrite elem_of_difference. - by rewrite (set_unfold (x ∈ X) P), (set_unfold (x ∈ Y) Q). - Qed. -End set_unfold. - -Section set_unfold_monad. - Context `{CollectionMonad M} {A : Type}. - Implicit Types x y : A. - - Global Instance set_unfold_ret x y : SetUnfold (x ∈ mret y) (x = y). - Proof. constructor; apply elem_of_ret. Qed. - Global Instance set_unfold_bind {B} (f : A → M B) X (P Q : A → Prop) : - (∀ y, SetUnfold (y ∈ X) (P y)) → (∀ y, SetUnfold (x ∈ f y) (Q y)) → - SetUnfold (x ∈ X ≫= f) (∃ y, Q y ∧ P y). - Proof. constructor. rewrite elem_of_bind; naive_solver. Qed. - Global Instance set_unfold_fmap {B} (f : A → B) X (P : A → Prop) : - (∀ y, SetUnfold (y ∈ X) (P y)) → - SetUnfold (x ∈ f <$> X) (∃ y, x = f y ∧ P y). - Proof. constructor. rewrite elem_of_fmap; naive_solver. Qed. - Global Instance set_unfold_join (X : M (M A)) (P : M A → Prop) : - (∀ Y, SetUnfold (Y ∈ X) (P Y)) → SetUnfold (x ∈ mjoin X) (∃ Y, x ∈ Y ∧ P Y). - Proof. constructor. rewrite elem_of_join; naive_solver. Qed. -End set_unfold_monad. - -Section set_unfold_list. - Context {A : Type}. - Implicit Types x : A. - Implicit Types l : list A. - - Global Instance set_unfold_nil x : SetUnfold (x ∈ []) False. - Proof. constructor; apply elem_of_nil. Qed. - Global Instance set_unfold_cons x y l P : - SetUnfold (x ∈ l) P → SetUnfold (x ∈ y :: l) (x = y ∨ P). - Proof. constructor. by rewrite elem_of_cons, (set_unfold (x ∈ l) P). Qed. - Global Instance set_unfold_app x l k P Q : - SetUnfold (x ∈ l) P → SetUnfold (x ∈ k) Q → SetUnfold (x ∈ l ++ k) (P ∨ Q). - Proof. - intros ??; constructor. - by rewrite elem_of_app, (set_unfold (x ∈ l) P), (set_unfold (x ∈ k) Q). - Qed. - Global Instance set_unfold_included l k (P Q : A → Prop) : - (∀ x, SetUnfold (x ∈ l) (P x)) → (∀ x, SetUnfold (x ∈ k) (Q x)) → - SetUnfold (l ⊆ k) (∀ x, P x → Q x). - Proof. - constructor; unfold subseteq, list_subseteq. - apply forall_proper; naive_solver. - Qed. -End set_unfold_list. - -Ltac set_unfold := - let rec unfold_hyps := - try match goal with - | H : _ |- _ => - apply set_unfold_1 in H; revert H; - first [unfold_hyps; intros H | intros H; fail 1] - end in - apply set_unfold_2; unfold_hyps; csimpl in *. - -(** Since [firstorder] already fails or loops on very small goals generated by -[set_solver], we use the [naive_solver] tactic as a substitute. *) -Tactic Notation "set_solver" "by" tactic3(tac) := - try fast_done; - intros; setoid_subst; - set_unfold; - intros; setoid_subst; - try match goal with |- _ ∈ _ => apply dec_stable end; - naive_solver tac. -Tactic Notation "set_solver" "-" hyp_list(Hs) "by" tactic3(tac) := - clear Hs; set_solver by tac. -Tactic Notation "set_solver" "+" hyp_list(Hs) "by" tactic3(tac) := - clear -Hs; set_solver by tac. -Tactic Notation "set_solver" := set_solver by idtac. -Tactic Notation "set_solver" "-" hyp_list(Hs) := clear Hs; set_solver. -Tactic Notation "set_solver" "+" hyp_list(Hs) := clear -Hs; set_solver. - -Hint Extern 1000 (_ ∉ _) => set_solver : set_solver. -Hint Extern 1000 (_ ∈ _) => set_solver : set_solver. -Hint Extern 1000 (_ ⊆ _) => set_solver : set_solver. - - -(** * Collections with [∪], [∅] and [{[_]}] *) -Section simple_collection. - Context `{SimpleCollection A C}. - Implicit Types x y : A. - Implicit Types X Y : C. - Implicit Types Xs Ys : list C. - - (** Equality *) - Lemma elem_of_equiv X Y : X ≡ Y ↔ ∀ x, x ∈ X ↔ x ∈ Y. - Proof. set_solver. Qed. - Lemma collection_equiv_spec X Y : X ≡ Y ↔ X ⊆ Y ∧ Y ⊆ X. - Proof. set_solver. Qed. - - (** Subset relation *) - Global Instance collection_subseteq_antisymm: AntiSymm (≡) ((⊆) : relation C). - Proof. intros ??. set_solver. Qed. - - Global Instance collection_subseteq_preorder: PreOrder ((⊆) : relation C). - Proof. split. by intros ??. intros ???; set_solver. Qed. - - Lemma subseteq_union X Y : X ⊆ Y ↔ X ∪ Y ≡ Y. - Proof. set_solver. Qed. - Lemma subseteq_union_1 X Y : X ⊆ Y → X ∪ Y ≡ Y. - Proof. by rewrite subseteq_union. Qed. - Lemma subseteq_union_2 X Y : X ∪ Y ≡ Y → X ⊆ Y. - Proof. by rewrite subseteq_union. Qed. - - Lemma union_subseteq_l X Y : X ⊆ X ∪ Y. - Proof. set_solver. Qed. - Lemma union_subseteq_r X Y : Y ⊆ X ∪ Y. - Proof. set_solver. Qed. - Lemma union_least X Y Z : X ⊆ Z → Y ⊆ Z → X ∪ Y ⊆ Z. - Proof. set_solver. Qed. - - Lemma elem_of_subseteq X Y : X ⊆ Y ↔ ∀ x, x ∈ X → x ∈ Y. - Proof. done. Qed. - Lemma elem_of_subset X Y : X ⊂ Y ↔ (∀ x, x ∈ X → x ∈ Y) ∧ ¬(∀ x, x ∈ Y → x ∈ X). - Proof. set_solver. Qed. - - (** Union *) - Lemma not_elem_of_union x X Y : x ∉ X ∪ Y ↔ x ∉ X ∧ x ∉ Y. - Proof. set_solver. Qed. - Lemma elem_of_union_l x X Y : x ∈ X → x ∈ X ∪ Y. - Proof. set_solver. Qed. - Lemma elem_of_union_r x X Y : x ∈ Y → x ∈ X ∪ Y. - Proof. set_solver. Qed. - - Lemma union_preserving_l X Y1 Y2 : Y1 ⊆ Y2 → X ∪ Y1 ⊆ X ∪ Y2. - Proof. set_solver. Qed. - Lemma union_preserving_r X1 X2 Y : X1 ⊆ X2 → X1 ∪ Y ⊆ X2 ∪ Y. - Proof. set_solver. Qed. - Lemma union_preserving X1 X2 Y1 Y2 : X1 ⊆ X2 → Y1 ⊆ Y2 → X1 ∪ Y1 ⊆ X2 ∪ Y2. - Proof. set_solver. Qed. - - Global Instance union_idemp : IdemP ((≡) : relation C) (∪). - Proof. intros X. set_solver. Qed. - Global Instance union_empty_l : LeftId ((≡) : relation C) ∅ (∪). - Proof. intros X. set_solver. Qed. - Global Instance union_empty_r : RightId ((≡) : relation C) ∅ (∪). - Proof. intros X. set_solver. Qed. - Global Instance union_comm : Comm ((≡) : relation C) (∪). - Proof. intros X Y. set_solver. Qed. - Global Instance union_assoc : Assoc ((≡) : relation C) (∪). - Proof. intros X Y Z. set_solver. Qed. - - Lemma empty_union X Y : X ∪ Y ≡ ∅ ↔ X ≡ ∅ ∧ Y ≡ ∅. - Proof. set_solver. Qed. - - Lemma union_cancel_l X Y Z : Z ⊥ X → Z ⊥ Y → Z ∪ X ≡ Z ∪ Y → X ≡ Y. - Proof. set_solver. Qed. - Lemma union_cancel_r X Y Z : X ⊥ Z → Y ⊥ Z → X ∪ Z ≡ Y ∪ Z → X ≡ Y. - Proof. set_solver. Qed. - - (** Empty *) - Lemma elem_of_equiv_empty X : X ≡ ∅ ↔ ∀ x, x ∉ X. - Proof. set_solver. Qed. - Lemma elem_of_empty x : x ∈ ∅ ↔ False. - Proof. set_solver. Qed. - Lemma equiv_empty X : X ⊆ ∅ → X ≡ ∅. - Proof. set_solver. Qed. - Lemma union_positive_l X Y : X ∪ Y ≡ ∅ → X ≡ ∅. - Proof. set_solver. Qed. - Lemma union_positive_l_alt X Y : X ≢ ∅ → X ∪ Y ≢ ∅. - Proof. set_solver. Qed. - Lemma non_empty_inhabited x X : x ∈ X → X ≢ ∅. - Proof. set_solver. Qed. - - (** Singleton *) - Lemma elem_of_singleton_1 x y : x ∈ {[y]} → x = y. - Proof. by rewrite elem_of_singleton. Qed. - Lemma elem_of_singleton_2 x y : x = y → x ∈ {[y]}. - Proof. by rewrite elem_of_singleton. Qed. - Lemma elem_of_subseteq_singleton x X : x ∈ X ↔ {[ x ]} ⊆ X. - Proof. set_solver. Qed. - Lemma non_empty_singleton x : ({[ x ]} : C) ≢ ∅. - Proof. set_solver. Qed. - Lemma not_elem_of_singleton x y : x ∉ {[ y ]} ↔ x ≠y. - Proof. by rewrite elem_of_singleton. Qed. - - (** Disjointness *) - Lemma elem_of_disjoint X Y : X ⊥ Y ↔ ∀ x, x ∈ X → x ∈ Y → False. - Proof. done. Qed. - - Global Instance disjoint_sym : Symmetric (@disjoint C _). - Proof. intros X Y. set_solver. Qed. - Lemma disjoint_empty_l Y : ∅ ⊥ Y. - Proof. set_solver. Qed. - Lemma disjoint_empty_r X : X ⊥ ∅. - Proof. set_solver. Qed. - Lemma disjoint_singleton_l x Y : {[ x ]} ⊥ Y ↔ x ∉ Y. - Proof. set_solver. Qed. - Lemma disjoint_singleton_r y X : X ⊥ {[ y ]} ↔ y ∉ X. - Proof. set_solver. Qed. - Lemma disjoint_union_l X1 X2 Y : X1 ∪ X2 ⊥ Y ↔ X1 ⊥ Y ∧ X2 ⊥ Y. - Proof. set_solver. Qed. - Lemma disjoint_union_r X Y1 Y2 : X ⊥ Y1 ∪ Y2 ↔ X ⊥ Y1 ∧ X ⊥ Y2. - Proof. set_solver. Qed. - - (** Big unions *) - Lemma elem_of_union_list Xs x : x ∈ ⋃ Xs ↔ ∃ X, X ∈ Xs ∧ x ∈ X. - Proof. - split. - - induction Xs; simpl; intros HXs; [by apply elem_of_empty in HXs|]. - setoid_rewrite elem_of_cons. apply elem_of_union in HXs. naive_solver. - - intros [X [Hx]]. induction Hx; simpl; [by apply elem_of_union_l |]. - intros. apply elem_of_union_r; auto. - Qed. - - Lemma union_list_nil : ⋃ @nil C = ∅. - Proof. done. Qed. - Lemma union_list_cons X Xs : ⋃ (X :: Xs) = X ∪ ⋃ Xs. - Proof. done. Qed. - Lemma union_list_singleton X : ⋃ [X] ≡ X. - Proof. simpl. by rewrite (right_id ∅ _). Qed. - Lemma union_list_app Xs1 Xs2 : ⋃ (Xs1 ++ Xs2) ≡ ⋃ Xs1 ∪ ⋃ Xs2. - Proof. - induction Xs1 as [|X Xs1 IH]; simpl; [by rewrite (left_id ∅ _)|]. - by rewrite IH, (assoc _). - Qed. - Lemma union_list_reverse Xs : ⋃ (reverse Xs) ≡ ⋃ Xs. - Proof. - induction Xs as [|X Xs IH]; simpl; [done |]. - by rewrite reverse_cons, union_list_app, - union_list_singleton, (comm _), IH. - Qed. - Lemma union_list_preserving Xs Ys : Xs ⊆* Ys → ⋃ Xs ⊆ ⋃ Ys. - Proof. induction 1; simpl; auto using union_preserving. Qed. - Lemma empty_union_list Xs : ⋃ Xs ≡ ∅ ↔ Forall (≡ ∅) Xs. - Proof. - split. - - induction Xs; simpl; rewrite ?empty_union; intuition. - - induction 1 as [|?? E1 ? E2]; simpl. done. by apply empty_union. - Qed. - - Section leibniz. - Context `{!LeibnizEquiv C}. - - Lemma elem_of_equiv_L X Y : X = Y ↔ ∀ x, x ∈ X ↔ x ∈ Y. - Proof. unfold_leibniz. apply elem_of_equiv. Qed. - Lemma collection_equiv_spec_L X Y : X = Y ↔ X ⊆ Y ∧ Y ⊆ X. - Proof. unfold_leibniz. apply collection_equiv_spec. Qed. - - (** Subset relation *) - Global Instance collection_subseteq_partialorder : - PartialOrder ((⊆) : relation C). - Proof. split. apply _. intros ??. unfold_leibniz. apply (anti_symm _). Qed. - - Lemma subseteq_union_L X Y : X ⊆ Y ↔ X ∪ Y = Y. - Proof. unfold_leibniz. apply subseteq_union. Qed. - Lemma subseteq_union_1_L X Y : X ⊆ Y → X ∪ Y = Y. - Proof. unfold_leibniz. apply subseteq_union_1. Qed. - Lemma subseteq_union_2_L X Y : X ∪ Y = Y → X ⊆ Y. - Proof. unfold_leibniz. apply subseteq_union_2. Qed. - - (** Union *) - Global Instance union_idemp_L : IdemP (@eq C) (∪). - Proof. intros ?. unfold_leibniz. apply (idemp _). Qed. - Global Instance union_empty_l_L : LeftId (@eq C) ∅ (∪). - Proof. intros ?. unfold_leibniz. apply (left_id _ _). Qed. - Global Instance union_empty_r_L : RightId (@eq C) ∅ (∪). - Proof. intros ?. unfold_leibniz. apply (right_id _ _). Qed. - Global Instance union_comm_L : Comm (@eq C) (∪). - Proof. intros ??. unfold_leibniz. apply (comm _). Qed. - Global Instance union_assoc_L : Assoc (@eq C) (∪). - Proof. intros ???. unfold_leibniz. apply (assoc _). Qed. - - Lemma empty_union_L X Y : X ∪ Y = ∅ ↔ X = ∅ ∧ Y = ∅. - Proof. unfold_leibniz. apply empty_union. Qed. - - Lemma union_cancel_l_L X Y Z : Z ⊥ X → Z ⊥ Y → Z ∪ X = Z ∪ Y → X = Y. - Proof. unfold_leibniz. apply union_cancel_l. Qed. - Lemma union_cancel_r_L X Y Z : X ⊥ Z → Y ⊥ Z → X ∪ Z = Y ∪ Z → X = Y. - Proof. unfold_leibniz. apply union_cancel_r. Qed. - - (** Empty *) - Lemma elem_of_equiv_empty_L X : X = ∅ ↔ ∀ x, x ∉ X. - Proof. unfold_leibniz. apply elem_of_equiv_empty. Qed. - Lemma equiv_empty_L X : X ⊆ ∅ → X = ∅. - Proof. unfold_leibniz. apply equiv_empty. Qed. - Lemma union_positive_l_L X Y : X ∪ Y = ∅ → X = ∅. - Proof. unfold_leibniz. apply union_positive_l. Qed. - Lemma union_positive_l_alt_L X Y : X ≠∅ → X ∪ Y ≠∅. - Proof. unfold_leibniz. apply union_positive_l_alt. Qed. - Lemma non_empty_inhabited_L x X : x ∈ X → X ≠∅. - Proof. unfold_leibniz. apply non_empty_inhabited. Qed. - - (** Singleton *) - Lemma non_empty_singleton_L x : {[ x ]} ≠∅. - Proof. unfold_leibniz. apply non_empty_singleton. Qed. - - (** Big unions *) - Lemma union_list_singleton_L X : ⋃ [X] = X. - Proof. unfold_leibniz. apply union_list_singleton. Qed. - Lemma union_list_app_L Xs1 Xs2 : ⋃ (Xs1 ++ Xs2) = ⋃ Xs1 ∪ ⋃ Xs2. - Proof. unfold_leibniz. apply union_list_app. Qed. - Lemma union_list_reverse_L Xs : ⋃ (reverse Xs) = ⋃ Xs. - Proof. unfold_leibniz. apply union_list_reverse. Qed. - Lemma empty_union_list_L Xs : ⋃ Xs = ∅ ↔ Forall (= ∅) Xs. - Proof. unfold_leibniz. by rewrite empty_union_list. Qed. - End leibniz. - - Section dec. - Context `{∀ (X Y : C), Decision (X ≡ Y)}. - Lemma collection_subseteq_inv X Y : X ⊆ Y → X ⊂ Y ∨ X ≡ Y. - Proof. destruct (decide (X ≡ Y)); [by right|left;set_solver]. Qed. - Lemma collection_not_subset_inv X Y : X ⊄ Y → X ⊈ Y ∨ X ≡ Y. - Proof. destruct (decide (X ≡ Y)); [by right|left;set_solver]. Qed. - - Lemma non_empty_union X Y : X ∪ Y ≢ ∅ ↔ X ≢ ∅ ∨ Y ≢ ∅. - Proof. rewrite empty_union. destruct (decide (X ≡ ∅)); intuition. Qed. - Lemma non_empty_union_list Xs : ⋃ Xs ≢ ∅ → Exists (≢ ∅) Xs. - Proof. rewrite empty_union_list. apply (not_Forall_Exists _). Qed. - - Context `{!LeibnizEquiv C}. - Lemma collection_subseteq_inv_L X Y : X ⊆ Y → X ⊂ Y ∨ X = Y. - Proof. unfold_leibniz. apply collection_subseteq_inv. Qed. - Lemma collection_not_subset_inv_L X Y : X ⊄ Y → X ⊈ Y ∨ X = Y. - Proof. unfold_leibniz. apply collection_not_subset_inv. Qed. - Lemma non_empty_union_L X Y : X ∪ Y ≠∅ ↔ X ≠∅ ∨ Y ≠∅. - Proof. unfold_leibniz. apply non_empty_union. Qed. - Lemma non_empty_union_list_L Xs : ⋃ Xs ≠∅ → Exists (≠∅) Xs. - Proof. unfold_leibniz. apply non_empty_union_list. Qed. - End dec. -End simple_collection. - - -(** * Collections with [∪], [∩], [∖], [∅] and [{[_]}] *) -Section collection. - Context `{Collection A C}. - Implicit Types X Y : C. - - (** Intersection *) - Lemma subseteq_intersection X Y : X ⊆ Y ↔ X ∩ Y ≡ X. - Proof. set_solver. Qed. - Lemma subseteq_intersection_1 X Y : X ⊆ Y → X ∩ Y ≡ X. - Proof. apply subseteq_intersection. Qed. - Lemma subseteq_intersection_2 X Y : X ∩ Y ≡ X → X ⊆ Y. - Proof. apply subseteq_intersection. Qed. - - Lemma intersection_subseteq_l X Y : X ∩ Y ⊆ X. - Proof. set_solver. Qed. - Lemma intersection_subseteq_r X Y : X ∩ Y ⊆ Y. - Proof. set_solver. Qed. - Lemma intersection_greatest X Y Z : Z ⊆ X → Z ⊆ Y → Z ⊆ X ∩ Y. - Proof. set_solver. Qed. - - Lemma intersection_preserving_l X Y1 Y2 : Y1 ⊆ Y2 → X ∩ Y1 ⊆ X ∩ Y2. - Proof. set_solver. Qed. - Lemma intersection_preserving_r X1 X2 Y : X1 ⊆ X2 → X1 ∩ Y ⊆ X2 ∩ Y. - Proof. set_solver. Qed. - Lemma intersection_preserving X1 X2 Y1 Y2 : - X1 ⊆ X2 → Y1 ⊆ Y2 → X1 ∩ Y1 ⊆ X2 ∩ Y2. - Proof. set_solver. Qed. - - Global Instance intersection_idemp : IdemP ((≡) : relation C) (∩). - Proof. intros X; set_solver. Qed. - Global Instance intersection_comm : Comm ((≡) : relation C) (∩). - Proof. intros X Y; set_solver. Qed. - Global Instance intersection_assoc : Assoc ((≡) : relation C) (∩). - Proof. intros X Y Z; set_solver. Qed. - Global Instance intersection_empty_l : LeftAbsorb ((≡) : relation C) ∅ (∩). - Proof. intros X; set_solver. Qed. - Global Instance intersection_empty_r: RightAbsorb ((≡) : relation C) ∅ (∩). - Proof. intros X; set_solver. Qed. - - Lemma intersection_singletons x : ({[x]} : C) ∩ {[x]} ≡ {[x]}. - Proof. set_solver. Qed. - - Lemma union_intersection_l X Y Z : X ∪ (Y ∩ Z) ≡ (X ∪ Y) ∩ (X ∪ Z). - Proof. set_solver. Qed. - Lemma union_intersection_r X Y Z : (X ∩ Y) ∪ Z ≡ (X ∪ Z) ∩ (Y ∪ Z). - Proof. set_solver. Qed. - Lemma intersection_union_l X Y Z : X ∩ (Y ∪ Z) ≡ (X ∩ Y) ∪ (X ∩ Z). - Proof. set_solver. Qed. - Lemma intersection_union_r X Y Z : (X ∪ Y) ∩ Z ≡ (X ∩ Z) ∪ (Y ∩ Z). - Proof. set_solver. Qed. - - (** Difference *) - Lemma difference_twice X Y : (X ∖ Y) ∖ Y ≡ X ∖ Y. - Proof. set_solver. Qed. - Lemma subseteq_empty_difference X Y : X ⊆ Y → X ∖ Y ≡ ∅. - Proof. set_solver. Qed. - Lemma difference_diag X : X ∖ X ≡ ∅. - Proof. set_solver. Qed. - Lemma difference_union_distr_l X Y Z : (X ∪ Y) ∖ Z ≡ X ∖ Z ∪ Y ∖ Z. - Proof. set_solver. Qed. - Lemma difference_union_distr_r X Y Z : Z ∖ (X ∪ Y) ≡ (Z ∖ X) ∩ (Z ∖ Y). - Proof. set_solver. Qed. - Lemma difference_intersection_distr_l X Y Z : (X ∩ Y) ∖ Z ≡ X ∖ Z ∩ Y ∖ Z. - Proof. set_solver. Qed. - Lemma difference_disjoint X Y : X ⊥ Y → X ∖ Y ≡ X. - Proof. set_solver. Qed. - - (** Disjointness *) - Lemma disjoint_intersection X Y : X ⊥ Y ↔ X ∩ Y ≡ ∅. - Proof. set_solver. Qed. - - Section leibniz. - Context `{!LeibnizEquiv C}. - - (** Intersection *) - Lemma subseteq_intersection_L X Y : X ⊆ Y ↔ X ∩ Y = X. - Proof. unfold_leibniz. apply subseteq_intersection. Qed. - Lemma subseteq_intersection_1_L X Y : X ⊆ Y → X ∩ Y = X. - Proof. unfold_leibniz. apply subseteq_intersection_1. Qed. - Lemma subseteq_intersection_2_L X Y : X ∩ Y = X → X ⊆ Y. - Proof. unfold_leibniz. apply subseteq_intersection_2. Qed. - - Global Instance intersection_idemp_L : IdemP ((=) : relation C) (∩). - Proof. intros ?. unfold_leibniz. apply (idemp _). Qed. - Global Instance intersection_comm_L : Comm ((=) : relation C) (∩). - Proof. intros ??. unfold_leibniz. apply (comm _). Qed. - Global Instance intersection_assoc_L : Assoc ((=) : relation C) (∩). - Proof. intros ???. unfold_leibniz. apply (assoc _). Qed. - Global Instance intersection_empty_l_L: LeftAbsorb ((=) : relation C) ∅ (∩). - Proof. intros ?. unfold_leibniz. apply (left_absorb _ _). Qed. - Global Instance intersection_empty_r_L: RightAbsorb ((=) : relation C) ∅ (∩). - Proof. intros ?. unfold_leibniz. apply (right_absorb _ _). Qed. - - Lemma intersection_singletons_L x : {[x]} ∩ {[x]} = {[x]}. - Proof. unfold_leibniz. apply intersection_singletons. Qed. - - Lemma union_intersection_l_L X Y Z : X ∪ (Y ∩ Z) = (X ∪ Y) ∩ (X ∪ Z). - Proof. unfold_leibniz; apply union_intersection_l. Qed. - Lemma union_intersection_r_L X Y Z : (X ∩ Y) ∪ Z = (X ∪ Z) ∩ (Y ∪ Z). - Proof. unfold_leibniz; apply union_intersection_r. Qed. - Lemma intersection_union_l_L X Y Z : X ∩ (Y ∪ Z) = (X ∩ Y) ∪ (X ∩ Z). - Proof. unfold_leibniz; apply intersection_union_l. Qed. - Lemma intersection_union_r_L X Y Z : (X ∪ Y) ∩ Z = (X ∩ Z) ∪ (Y ∩ Z). - Proof. unfold_leibniz; apply intersection_union_r. Qed. - - (** Difference *) - Lemma difference_twice_L X Y : (X ∖ Y) ∖ Y = X ∖ Y. - Proof. unfold_leibniz. apply difference_twice. Qed. - Lemma subseteq_empty_difference_L X Y : X ⊆ Y → X ∖ Y = ∅. - Proof. unfold_leibniz. apply subseteq_empty_difference. Qed. - Lemma difference_diag_L X : X ∖ X = ∅. - Proof. unfold_leibniz. apply difference_diag. Qed. - Lemma difference_union_distr_l_L X Y Z : (X ∪ Y) ∖ Z = X ∖ Z ∪ Y ∖ Z. - Proof. unfold_leibniz. apply difference_union_distr_l. Qed. - Lemma difference_union_distr_r_L X Y Z : Z ∖ (X ∪ Y) = (Z ∖ X) ∩ (Z ∖ Y). - Proof. unfold_leibniz. apply difference_union_distr_r. Qed. - Lemma difference_intersection_distr_l_L X Y Z : - (X ∩ Y) ∖ Z = X ∖ Z ∩ Y ∖ Z. - Proof. unfold_leibniz. apply difference_intersection_distr_l. Qed. - Lemma difference_disjoint_L X Y : X ⊥ Y → X ∖ Y = X. - Proof. unfold_leibniz. apply difference_disjoint. Qed. - - (** Disjointness *) - Lemma disjoint_intersection_L X Y : X ⊥ Y ↔ X ∩ Y = ∅. - Proof. unfold_leibniz. apply disjoint_intersection. Qed. - End leibniz. - - Section dec. - Context `{∀ (x : A) (X : C), Decision (x ∈ X)}. - Lemma not_elem_of_intersection x X Y : x ∉ X ∩ Y ↔ x ∉ X ∨ x ∉ Y. - Proof. rewrite elem_of_intersection. destruct (decide (x ∈ X)); tauto. Qed. - Lemma not_elem_of_difference x X Y : x ∉ X ∖ Y ↔ x ∉ X ∨ x ∈ Y. - Proof. rewrite elem_of_difference. destruct (decide (x ∈ Y)); tauto. Qed. - Lemma union_difference X Y : X ⊆ Y → Y ≡ X ∪ Y ∖ X. - Proof. - intros ? x; split; rewrite !elem_of_union, elem_of_difference; [|intuition]. - destruct (decide (x ∈ X)); intuition. - Qed. - Lemma subseteq_disjoint_union X Y : X ⊆ Y ↔ ∃ Z, Y ≡ X ∪ Z ∧ X ⊥ Z. - Proof. - split; [|set_solver]. - exists (Y ∖ X); split; [auto using union_difference|set_solver]. - Qed. - Lemma non_empty_difference X Y : X ⊂ Y → Y ∖ X ≢ ∅. - Proof. intros [HXY1 HXY2] Hdiff. destruct HXY2. set_solver. Qed. - Lemma empty_difference_subseteq X Y : X ∖ Y ≡ ∅ → X ⊆ Y. - Proof. set_solver. Qed. - - Context `{!LeibnizEquiv C}. - Lemma union_difference_L X Y : X ⊆ Y → Y = X ∪ Y ∖ X. - Proof. unfold_leibniz. apply union_difference. Qed. - Lemma non_empty_difference_L X Y : X ⊂ Y → Y ∖ X ≠∅. - Proof. unfold_leibniz. apply non_empty_difference. Qed. - Lemma empty_difference_subseteq_L X Y : X ∖ Y = ∅ → X ⊆ Y. - Proof. unfold_leibniz. apply empty_difference_subseteq. Qed. - Lemma subseteq_disjoint_union_L X Y : X ⊆ Y ↔ ∃ Z, Y = X ∪ Z ∧ X ⊥ Z. - Proof. unfold_leibniz. apply subseteq_disjoint_union. Qed. - End dec. -End collection. - - -(** * Conversion of option and list *) -Definition of_option `{Singleton A C, Empty C} (mx : option A) : C := - match mx with None => ∅ | Some x => {[ x ]} end. -Fixpoint of_list `{Singleton A C, Empty C, Union C} (l : list A) : C := - match l with [] => ∅ | x :: l => {[ x ]} ∪ of_list l end. - -Section of_option_list. - Context `{SimpleCollection A C}. - Implicit Types l : list A. - - Lemma elem_of_of_option (x : A) mx: x ∈ of_option mx ↔ mx = Some x. - Proof. destruct mx; set_solver. Qed. - Lemma not_elem_of_of_option (x : A) mx: x ∉ of_option mx ↔ mx ≠Some x. - Proof. by rewrite elem_of_of_option. Qed. - - Lemma elem_of_of_list (x : A) l : x ∈ of_list l ↔ x ∈ l. - Proof. - split. - - induction l; simpl; [by rewrite elem_of_empty|]. - rewrite elem_of_union,elem_of_singleton; intros [->|?]; constructor; auto. - - induction 1; simpl; rewrite elem_of_union, elem_of_singleton; auto. - Qed. - Lemma not_elem_of_of_list (x : A) l : x ∉ of_list l ↔ x ∉ l. - Proof. by rewrite elem_of_of_list. Qed. - - Global Instance set_unfold_of_option (mx : option A) x : - SetUnfold (x ∈ of_option mx) (mx = Some x). - Proof. constructor; apply elem_of_of_option. Qed. - Global Instance set_unfold_of_list (l : list A) x P : - SetUnfold (x ∈ l) P → SetUnfold (x ∈ of_list l) P. - Proof. constructor. by rewrite elem_of_of_list, (set_unfold (x ∈ l) P). Qed. - - Lemma of_list_nil : of_list (C:=C) [] = ∅. - Proof. done. Qed. - Lemma of_list_cons x l : of_list (C:=C) (x :: l) = {[ x ]} ∪ of_list l. - Proof. done. Qed. - Lemma of_list_app l1 l2 : of_list (C:=C) (l1 ++ l2) ≡ of_list l1 ∪ of_list l2. - Proof. set_solver. Qed. - Global Instance of_list_perm : Proper ((≡ₚ) ==> (≡)) (of_list (C:=C)). - Proof. induction 1; set_solver. Qed. - - Context `{!LeibnizEquiv C}. - Lemma of_list_app_L l1 l2 : of_list (C:=C) (l1 ++ l2) = of_list l1 ∪ of_list l2. - Proof. set_solver. Qed. - Global Instance of_list_perm_L : Proper ((≡ₚ) ==> (=)) (of_list (C:=C)). - Proof. induction 1; set_solver. Qed. -End of_option_list. - - -(** * Guard *) -Global Instance collection_guard `{CollectionMonad M} : MGuard M := - λ P dec A x, match dec with left H => x H | _ => ∅ end. - -Section collection_monad_base. - Context `{CollectionMonad M}. - Lemma elem_of_guard `{Decision P} {A} (x : A) (X : M A) : - x ∈ guard P; X ↔ P ∧ x ∈ X. - Proof. - unfold mguard, collection_guard; simpl; case_match; - rewrite ?elem_of_empty; naive_solver. - Qed. - Lemma elem_of_guard_2 `{Decision P} {A} (x : A) (X : M A) : - P → x ∈ X → x ∈ guard P; X. - Proof. by rewrite elem_of_guard. Qed. - Lemma guard_empty `{Decision P} {A} (X : M A) : guard P; X ≡ ∅ ↔ ¬P ∨ X ≡ ∅. - Proof. - rewrite !elem_of_equiv_empty; setoid_rewrite elem_of_guard. - destruct (decide P); naive_solver. - Qed. - Global Instance set_unfold_guard `{Decision P} {A} (x : A) X Q : - SetUnfold (x ∈ X) Q → SetUnfold (x ∈ guard P; X) (P ∧ Q). - Proof. constructor. by rewrite elem_of_guard, (set_unfold (x ∈ X) Q). Qed. - Lemma bind_empty {A B} (f : A → M B) X : - X ≫= f ≡ ∅ ↔ X ≡ ∅ ∨ ∀ x, x ∈ X → f x ≡ ∅. - Proof. set_solver. Qed. -End collection_monad_base. - - -(** * Quantifiers *) -Definition set_Forall `{ElemOf A C} (P : A → Prop) (X : C) := ∀ x, x ∈ X → P x. -Definition set_Exists `{ElemOf A C} (P : A → Prop) (X : C) := ∃ x, x ∈ X ∧ P x. - -Section quantifiers. - Context `{SimpleCollection A B} (P : A → Prop). - - Lemma set_Forall_empty : set_Forall P ∅. - Proof. unfold set_Forall. set_solver. Qed. - Lemma set_Forall_singleton x : set_Forall P {[ x ]} ↔ P x. - Proof. unfold set_Forall. set_solver. Qed. - Lemma set_Forall_union X Y : - set_Forall P X → set_Forall P Y → set_Forall P (X ∪ Y). - Proof. unfold set_Forall. set_solver. Qed. - Lemma set_Forall_union_inv_1 X Y : set_Forall P (X ∪ Y) → set_Forall P X. - Proof. unfold set_Forall. set_solver. Qed. - Lemma set_Forall_union_inv_2 X Y : set_Forall P (X ∪ Y) → set_Forall P Y. - Proof. unfold set_Forall. set_solver. Qed. - - Lemma set_Exists_empty : ¬set_Exists P ∅. - Proof. unfold set_Exists. set_solver. Qed. - Lemma set_Exists_singleton x : set_Exists P {[ x ]} ↔ P x. - Proof. unfold set_Exists. set_solver. Qed. - Lemma set_Exists_union_1 X Y : set_Exists P X → set_Exists P (X ∪ Y). - Proof. unfold set_Exists. set_solver. Qed. - Lemma set_Exists_union_2 X Y : set_Exists P Y → set_Exists P (X ∪ Y). - Proof. unfold set_Exists. set_solver. Qed. - Lemma set_Exists_union_inv X Y : - set_Exists P (X ∪ Y) → set_Exists P X ∨ set_Exists P Y. - Proof. unfold set_Exists. set_solver. Qed. -End quantifiers. - -Section more_quantifiers. - Context `{SimpleCollection A B}. - - Lemma set_Forall_weaken (P Q : A → Prop) (Hweaken : ∀ x, P x → Q x) X : - set_Forall P X → set_Forall Q X. - Proof. unfold set_Forall. naive_solver. Qed. - Lemma set_Exists_weaken (P Q : A → Prop) (Hweaken : ∀ x, P x → Q x) X : - set_Exists P X → set_Exists Q X. - Proof. unfold set_Exists. naive_solver. Qed. -End more_quantifiers. - -(** * Fresh elements *) -(** We collect some properties on the [fresh] operation. In particular we -generalize [fresh] to generate lists of fresh elements. *) -Fixpoint fresh_list `{Fresh A C, Union C, Singleton A C} - (n : nat) (X : C) : list A := - match n with - | 0 => [] - | S n => let x := fresh X in x :: fresh_list n ({[ x ]} ∪ X) - end. -Inductive Forall_fresh `{ElemOf A C} (X : C) : list A → Prop := - | Forall_fresh_nil : Forall_fresh X [] - | Forall_fresh_cons x xs : - x ∉ xs → x ∉ X → Forall_fresh X xs → Forall_fresh X (x :: xs). - -Section fresh. - Context `{FreshSpec A C}. - Implicit Types X Y : C. - - Global Instance fresh_proper: Proper ((≡) ==> (=)) (fresh (C:=C)). - Proof. intros ???. by apply fresh_proper_alt, elem_of_equiv. Qed. - Global Instance fresh_list_proper: - Proper ((=) ==> (≡) ==> (=)) (fresh_list (C:=C)). - Proof. - intros ? n ->. induction n as [|n IH]; intros ?? E; f_equal/=; [by rewrite E|]. - apply IH. by rewrite E. - Qed. - - Lemma exist_fresh X : ∃ x, x ∉ X. - Proof. exists (fresh X). apply is_fresh. Qed. - Lemma Forall_fresh_NoDup X xs : Forall_fresh X xs → NoDup xs. - Proof. induction 1; by constructor. Qed. - Lemma Forall_fresh_elem_of X xs x : Forall_fresh X xs → x ∈ xs → x ∉ X. - Proof. - intros HX; revert x; rewrite <-Forall_forall. by induction HX; constructor. - Qed. - Lemma Forall_fresh_alt X xs : - Forall_fresh X xs ↔ NoDup xs ∧ ∀ x, x ∈ xs → x ∉ X. - Proof. - split; eauto using Forall_fresh_NoDup, Forall_fresh_elem_of. - rewrite <-Forall_forall. - intros [Hxs Hxs']. induction Hxs; decompose_Forall_hyps; constructor; auto. - Qed. - Lemma Forall_fresh_subseteq X Y xs : - Forall_fresh X xs → Y ⊆ X → Forall_fresh Y xs. - Proof. rewrite !Forall_fresh_alt; set_solver. Qed. - - Lemma fresh_list_length n X : length (fresh_list n X) = n. - Proof. revert X. induction n; simpl; auto. Qed. - Lemma fresh_list_is_fresh n X x : x ∈ fresh_list n X → x ∉ X. - Proof. - revert X. induction n as [|n IH]; intros X; simpl;[by rewrite elem_of_nil|]. - rewrite elem_of_cons; intros [->| Hin]; [apply is_fresh|]. - apply IH in Hin; set_solver. - Qed. - Lemma NoDup_fresh_list n X : NoDup (fresh_list n X). - Proof. - revert X. induction n; simpl; constructor; auto. - intros Hin; apply fresh_list_is_fresh in Hin; set_solver. - Qed. - Lemma Forall_fresh_list X n : Forall_fresh X (fresh_list n X). - Proof. - rewrite Forall_fresh_alt; eauto using NoDup_fresh_list, fresh_list_is_fresh. - Qed. -End fresh. - -(** * Properties of implementations of collections that form a monad *) -Section collection_monad. - Context `{CollectionMonad M}. - - Global Instance collection_fmap_mono {A B} : - Proper (pointwise_relation _ (=) ==> (⊆) ==> (⊆)) (@fmap M _ A B). - Proof. intros f g ? X Y ?; set_solver by eauto. Qed. - Global Instance collection_bind_mono {A B} : - Proper (((=) ==> (⊆)) ==> (⊆) ==> (⊆)) (@mbind M _ A B). - Proof. unfold respectful; intros f g Hfg X Y ?; set_solver. Qed. - Global Instance collection_join_mono {A} : - Proper ((⊆) ==> (⊆)) (@mjoin M _ A). - Proof. intros X Y ?; set_solver. Qed. - - Lemma collection_bind_singleton {A B} (f : A → M B) x : {[ x ]} ≫= f ≡ f x. - Proof. set_solver. Qed. - Lemma collection_guard_True {A} `{Decision P} (X : M A) : P → guard P; X ≡ X. - Proof. set_solver. Qed. - Lemma collection_fmap_compose {A B C} (f : A → B) (g : B → C) (X : M A) : - g ∘ f <$> X ≡ g <$> (f <$> X). - Proof. set_solver. Qed. - Lemma elem_of_fmap_1 {A B} (f : A → B) (X : M A) (y : B) : - y ∈ f <$> X → ∃ x, y = f x ∧ x ∈ X. - Proof. set_solver. Qed. - Lemma elem_of_fmap_2 {A B} (f : A → B) (X : M A) (x : A) : - x ∈ X → f x ∈ f <$> X. - Proof. set_solver. Qed. - Lemma elem_of_fmap_2_alt {A B} (f : A → B) (X : M A) (x : A) (y : B) : - x ∈ X → y = f x → y ∈ f <$> X. - Proof. set_solver. Qed. - - Lemma elem_of_mapM {A B} (f : A → M B) l k : - l ∈ mapM f k ↔ Forall2 (λ x y, x ∈ f y) l k. - Proof. - split. - - revert l. induction k; set_solver by eauto. - - induction 1; set_solver. - Qed. - Lemma collection_mapM_length {A B} (f : A → M B) l k : - l ∈ mapM f k → length l = length k. - Proof. revert l; induction k; set_solver by eauto. Qed. - Lemma elem_of_mapM_fmap {A B} (f : A → B) (g : B → M A) l k : - Forall (λ x, ∀ y, y ∈ g x → f y = x) l → k ∈ mapM g l → fmap f k = l. - Proof. intros Hl. revert k. induction Hl; set_solver. Qed. - Lemma elem_of_mapM_Forall {A B} (f : A → M B) (P : B → Prop) l k : - l ∈ mapM f k → Forall (λ x, ∀ y, y ∈ f x → P y) k → Forall P l. - Proof. rewrite elem_of_mapM. apply Forall2_Forall_l. Qed. - Lemma elem_of_mapM_Forall2_l {A B C} (f : A → M B) (P: B → C → Prop) l1 l2 k : - l1 ∈ mapM f k → Forall2 (λ x y, ∀ z, z ∈ f x → P z y) k l2 → - Forall2 P l1 l2. - Proof. - rewrite elem_of_mapM. intros Hl1. revert l2. - induction Hl1; inversion_clear 1; constructor; auto. - Qed. -End collection_monad. - -(** Finite collections *) -Definition set_finite `{ElemOf A B} (X : B) := ∃ l : list A, ∀ x, x ∈ X → x ∈ l. - -Section finite. - Context `{SimpleCollection A B}. - Global Instance set_finite_subseteq : - Proper (flip (⊆) ==> impl) (@set_finite A B _). - Proof. intros X Y HX [l Hl]; exists l; set_solver. Qed. - Global Instance set_finite_proper : Proper ((≡) ==> iff) (@set_finite A B _). - Proof. intros X Y HX; apply exist_proper. by setoid_rewrite HX. Qed. - Lemma empty_finite : set_finite ∅. - Proof. by exists []; intros ?; rewrite elem_of_empty. Qed. - Lemma singleton_finite (x : A) : set_finite {[ x ]}. - Proof. exists [x]; intros y ->%elem_of_singleton; left. Qed. - Lemma union_finite X Y : set_finite X → set_finite Y → set_finite (X ∪ Y). - Proof. - intros [lX ?] [lY ?]; exists (lX ++ lY); intros x. - rewrite elem_of_union, elem_of_app; naive_solver. - Qed. - Lemma union_finite_inv_l X Y : set_finite (X ∪ Y) → set_finite X. - Proof. intros [l ?]; exists l; set_solver. Qed. - Lemma union_finite_inv_r X Y : set_finite (X ∪ Y) → set_finite Y. - Proof. intros [l ?]; exists l; set_solver. Qed. -End finite. - -Section more_finite. - Context `{Collection A B}. - Lemma intersection_finite_l X Y : set_finite X → set_finite (X ∩ Y). - Proof. intros [l ?]; exists l; intros x [??]%elem_of_intersection; auto. Qed. - Lemma intersection_finite_r X Y : set_finite Y → set_finite (X ∩ Y). - Proof. intros [l ?]; exists l; intros x [??]%elem_of_intersection; auto. Qed. - Lemma difference_finite X Y : set_finite X → set_finite (X ∖ Y). - Proof. intros [l ?]; exists l; intros x [??]%elem_of_difference; auto. Qed. - Lemma difference_finite_inv X Y `{∀ x, Decision (x ∈ Y)} : - set_finite Y → set_finite (X ∖ Y) → set_finite X. - Proof. - intros [l ?] [k ?]; exists (l ++ k). - intros x ?; destruct (decide (x ∈ Y)); rewrite elem_of_app; set_solver. - Qed. -End more_finite. - -(** Sets of sequences of natural numbers *) -(* The set [seq_seq start len] of natural numbers contains the sequence -[start, start + 1, ..., start + (len-1)]. *) -Fixpoint seq_set `{Singleton nat C, Union C, Empty C} (start len : nat) : C := - match len with - | O => ∅ - | S len' => {[ start ]} ∪ seq_set (S start) len' - end. - -Section seq_set. - Context `{SimpleCollection nat C}. - Implicit Types start len x : nat. - - Lemma elem_of_seq_set start len x : - x ∈ seq_set start len ↔ start ≤ x < start + len. - Proof. - revert start. induction len as [|len IH]; intros start; simpl. - - rewrite elem_of_empty. omega. - - rewrite elem_of_union, elem_of_singleton, IH. omega. - Qed. - - Lemma seq_set_S_disjoint start len : {[ start + len ]} ⊥ seq_set start len. - Proof. intros x. rewrite elem_of_singleton, elem_of_seq_set. omega. Qed. - - Lemma seq_set_S_union start len : - seq_set start (C:=C) (S len) ≡ {[ start + len ]} ∪ seq_set start len. - Proof. - intros x. rewrite elem_of_union, elem_of_singleton, !elem_of_seq_set. omega. - Qed. - - Lemma seq_set_S_union_L `{!LeibnizEquiv C} start len : - seq_set start (S len) = {[ start + len ]} ∪ seq_set start len. - Proof. unfold_leibniz. apply seq_set_S_union. Qed. -End seq_set. - -(** Mimimal elements *) -Definition minimal `{ElemOf A C} (R : relation A) (x : A) (X : C) : Prop := - ∀ y, y ∈ X → R y x → R x y. -Instance: Params (@minimal) 5. -Typeclasses Opaque minimal. - -Section minimal. - Context `{SimpleCollection A C} {R : relation A}. - - Global Instance minimal_proper x : Proper (@equiv C _ ==> iff) (minimal R x). - Proof. intros X X' y; unfold minimal; set_solver. Qed. - - Lemma minimal_anti_symm_1 `{!AntiSymm (=) R} X x y : - minimal R x X → y ∈ X → R y x → x = y. - Proof. intros Hmin ??. apply (anti_symm _); auto. Qed. - Lemma minimal_anti_symm `{!AntiSymm (=) R} X x : - minimal R x X ↔ ∀ y, y ∈ X → R y x → x = y. - Proof. unfold minimal; naive_solver eauto using minimal_anti_symm_1. Qed. - - Lemma minimal_strict_1 `{!StrictOrder R} X x y : - minimal R x X → y ∈ X → ¬R y x. - Proof. intros Hmin ??. destruct (irreflexivity R x); trans y; auto. Qed. - Lemma minimal_strict `{!StrictOrder R} X x : - minimal R x X ↔ ∀ y, y ∈ X → ¬R y x. - Proof. unfold minimal; split; [eauto using minimal_strict_1|naive_solver]. Qed. - - Lemma empty_minimal x : minimal R x ∅. - Proof. unfold minimal; set_solver. Qed. - Lemma singleton_minimal x : minimal R x {[ x ]}. - Proof. unfold minimal; set_solver. Qed. - Lemma singleton_minimal_not_above y x : ¬R y x → minimal R x {[ y ]}. - Proof. unfold minimal; set_solver. Qed. - Lemma union_minimal X Y x : - minimal R x X → minimal R x Y → minimal R x (X ∪ Y). - Proof. unfold minimal; set_solver. Qed. - Lemma minimal_subseteq X Y x : minimal R x X → Y ⊆ X → minimal R x Y. - Proof. unfold minimal; set_solver. Qed. - - Lemma minimal_weaken `{!Transitive R} X x x' : - minimal R x X → R x' x → minimal R x' X. - Proof. - intros Hmin ? y ??. trans x; [done|]. by eapply (Hmin y), transitivity. - Qed. -End minimal. diff --git a/theories/prelude/countable.v b/theories/prelude/countable.v deleted file mode 100644 index c99113460dff803f6e60a3ca36061a22378d4ede..0000000000000000000000000000000000000000 --- a/theories/prelude/countable.v +++ /dev/null @@ -1,270 +0,0 @@ -(* Copyright (c) 2012-2017, Robbert Krebbers. *) -(* This file is distributed under the terms of the BSD license. *) -From iris.prelude Require Export list. -Set Default Proof Using "Type". -Local Open Scope positive. - -Class Countable A `{EqDecision A} := { - encode : A → positive; - decode : positive → option A; - decode_encode x : decode (encode x) = Some x -}. -Arguments encode : simpl never. -Arguments decode : simpl never. - -Definition encode_nat `{Countable A} (x : A) : nat := - pred (Pos.to_nat (encode x)). -Definition decode_nat `{Countable A} (i : nat) : option A := - decode (Pos.of_nat (S i)). -Instance encode_inj `{Countable A} : Inj (=) (=) encode. -Proof. - intros x y Hxy; apply (inj Some). - by rewrite <-(decode_encode x), Hxy, decode_encode. -Qed. -Instance encode_nat_inj `{Countable A} : Inj (=) (=) encode_nat. -Proof. unfold encode_nat; intros x y Hxy; apply (inj encode); lia. Qed. -Lemma decode_encode_nat `{Countable A} x : decode_nat (encode_nat x) = Some x. -Proof. - pose proof (Pos2Nat.is_pos (encode x)). - unfold decode_nat, encode_nat. rewrite Nat.succ_pred by lia. - by rewrite Pos2Nat.id, decode_encode. -Qed. - -(** * Choice principles *) -Section choice. - Context `{Countable A} (P : A → Prop). - - Inductive choose_step: relation positive := - | choose_step_None {p} : decode p = None → choose_step (Psucc p) p - | choose_step_Some {p x} : - decode p = Some x → ¬P x → choose_step (Psucc p) p. - Lemma choose_step_acc : (∃ x, P x) → Acc choose_step 1%positive. - Proof. - intros [x Hx]. cut (∀ i p, - i ≤ encode x → 1 + encode x = p + i → Acc choose_step p). - { intros help. by apply (help (encode x)). } - induction i as [|i IH] using Pos.peano_ind; intros p ??. - { constructor. intros j. assert (p = encode x) by lia; subst. - inversion 1 as [? Hd|?? Hd]; subst; - rewrite decode_encode in Hd; congruence. } - constructor. intros j. - inversion 1 as [? Hd|? y Hd]; subst; auto with lia. - Qed. - - Context `{∀ x, Decision (P x)}. - - Fixpoint choose_go {i} (acc : Acc choose_step i) : A := - match Some_dec (decode i) with - | inleft (x↾Hx) => - match decide (P x) with - | left _ => x | right H => choose_go (Acc_inv acc (choose_step_Some Hx H)) - end - | inright H => choose_go (Acc_inv acc (choose_step_None H)) - end. - Fixpoint choose_go_correct {i} (acc : Acc choose_step i) : P (choose_go acc). - Proof. destruct acc; simpl. repeat case_match; auto. Qed. - Fixpoint choose_go_pi {i} (acc1 acc2 : Acc choose_step i) : - choose_go acc1 = choose_go acc2. - Proof. destruct acc1, acc2; simpl; repeat case_match; auto. Qed. - - Definition choose (H: ∃ x, P x) : A := choose_go (choose_step_acc H). - Definition choose_correct (H: ∃ x, P x) : P (choose H) := choose_go_correct _. - Definition choose_pi (H1 H2 : ∃ x, P x) : - choose H1 = choose H2 := choose_go_pi _ _. - Definition choice (HA : ∃ x, P x) : { x | P x } := _↾choose_correct HA. -End choice. - -Lemma surj_cancel `{Countable A} `{EqDecision B} - (f : A → B) `{!Surj (=) f} : { g : B → A & Cancel (=) f g }. -Proof. - exists (λ y, choose (λ x, f x = y) (surj f y)). - intros y. by rewrite (choose_correct (λ x, f x = y) (surj f y)). -Qed. - -(** * Instances *) -(** ** Injection *) -Section injective_countable. - Context `{Countable A, EqDecision B}. - Context (f : B → A) (g : A → option B) (fg : ∀ x, g (f x) = Some x). - - Program Instance injective_countable : Countable B := - {| encode y := encode (f y); decode p := x ↠decode p; g x |}. - Next Obligation. intros y; simpl; rewrite decode_encode; eauto. Qed. -End injective_countable. - -(** ** Option *) -Program Instance option_countable `{Countable A} : Countable (option A) := {| - encode o := match o with None => 1 | Some x => Pos.succ (encode x) end; - decode p := if decide (p = 1) then Some None else Some <$> decode (Pos.pred p) -|}. -Next Obligation. - intros ??? [x|]; simpl; repeat case_decide; auto with lia. - by rewrite Pos.pred_succ, decode_encode. -Qed. - -(** ** Sums *) -Program Instance sum_countable `{Countable A} `{Countable B} : - Countable (A + B)%type := {| - encode xy := - match xy with inl x => (encode x)~0 | inr y => (encode y)~1 end; - decode p := - match p with - | 1 => None | p~0 => inl <$> decode p | p~1 => inr <$> decode p - end - |}. -Next Obligation. by intros ?????? [x|y]; simpl; rewrite decode_encode. Qed. - -(** ** Products *) -Fixpoint prod_encode_fst (p : positive) : positive := - match p with - | 1 => 1 - | p~0 => (prod_encode_fst p)~0~0 - | p~1 => (prod_encode_fst p)~0~1 - end. -Fixpoint prod_encode_snd (p : positive) : positive := - match p with - | 1 => 1~0 - | p~0 => (prod_encode_snd p)~0~0 - | p~1 => (prod_encode_snd p)~1~0 - end. -Fixpoint prod_encode (p q : positive) : positive := - match p, q with - | 1, 1 => 1~1 - | p~0, 1 => (prod_encode_fst p)~1~0 - | p~1, 1 => (prod_encode_fst p)~1~1 - | 1, q~0 => (prod_encode_snd q)~0~1 - | 1, q~1 => (prod_encode_snd q)~1~1 - | p~0, q~0 => (prod_encode p q)~0~0 - | p~0, q~1 => (prod_encode p q)~1~0 - | p~1, q~0 => (prod_encode p q)~0~1 - | p~1, q~1 => (prod_encode p q)~1~1 - end. -Fixpoint prod_decode_fst (p : positive) : option positive := - match p with - | p~0~0 => (~0) <$> prod_decode_fst p - | p~0~1 => Some match prod_decode_fst p with Some q => q~1 | _ => 1 end - | p~1~0 => (~0) <$> prod_decode_fst p - | p~1~1 => Some match prod_decode_fst p with Some q => q~1 | _ => 1 end - | 1~0 => None - | 1~1 => Some 1 - | 1 => Some 1 - end. -Fixpoint prod_decode_snd (p : positive) : option positive := - match p with - | p~0~0 => (~0) <$> prod_decode_snd p - | p~0~1 => (~0) <$> prod_decode_snd p - | p~1~0 => Some match prod_decode_snd p with Some q => q~1 | _ => 1 end - | p~1~1 => Some match prod_decode_snd p with Some q => q~1 | _ => 1 end - | 1~0 => Some 1 - | 1~1 => Some 1 - | 1 => None - end. - -Lemma prod_decode_encode_fst p q : prod_decode_fst (prod_encode p q) = Some p. -Proof. - assert (∀ p, prod_decode_fst (prod_encode_fst p) = Some p). - { intros p'. by induction p'; simplify_option_eq. } - assert (∀ p, prod_decode_fst (prod_encode_snd p) = None). - { intros p'. by induction p'; simplify_option_eq. } - revert q. by induction p; intros [?|?|]; simplify_option_eq. -Qed. -Lemma prod_decode_encode_snd p q : prod_decode_snd (prod_encode p q) = Some q. -Proof. - assert (∀ p, prod_decode_snd (prod_encode_snd p) = Some p). - { intros p'. by induction p'; simplify_option_eq. } - assert (∀ p, prod_decode_snd (prod_encode_fst p) = None). - { intros p'. by induction p'; simplify_option_eq. } - revert q. by induction p; intros [?|?|]; simplify_option_eq. -Qed. -Program Instance prod_countable `{Countable A} `{Countable B} : - Countable (A * B)%type := {| - encode xy := prod_encode (encode (xy.1)) (encode (xy.2)); - decode p := - x ↠prod_decode_fst p ≫= decode; - y ↠prod_decode_snd p ≫= decode; Some (x, y) - |}. -Next Obligation. - intros ?????? [x y]; simpl. - rewrite prod_decode_encode_fst, prod_decode_encode_snd; simpl. - by rewrite !decode_encode. -Qed. - -(** ** Lists *) -(* Lists are encoded as 1 separated sequences of 0s corresponding to the unary -representation of the elements. *) -Fixpoint list_encode `{Countable A} (acc : positive) (l : list A) : positive := - match l with - | [] => acc - | x :: l => list_encode (Nat.iter (encode_nat x) (~0) (acc~1)) l - end. -Fixpoint list_decode `{Countable A} (acc : list A) - (n : nat) (p : positive) : option (list A) := - match p with - | 1 => Some acc - | p~0 => list_decode acc (S n) p - | p~1 => x ↠decode_nat n; list_decode (x :: acc) O p - end. -Lemma x0_iter_x1 n acc : Nat.iter n (~0) acc~1 = acc ++ Nat.iter n (~0) 3. -Proof. by induction n; f_equal/=. Qed. -Lemma list_encode_app' `{Countable A} (l1 l2 : list A) acc : - list_encode acc (l1 ++ l2) = list_encode acc l1 ++ list_encode 1 l2. -Proof. - revert acc; induction l1; simpl; auto. - induction l2 as [|x l IH]; intros acc; simpl; [by rewrite ?(left_id_L _ _)|]. - by rewrite !(IH (Nat.iter _ _ _)), (assoc_L _), x0_iter_x1. -Qed. -Program Instance list_countable `{Countable A} : Countable (list A) := - {| encode := list_encode 1; decode := list_decode [] 0 |}. -Next Obligation. - intros A ??; simpl. - assert (∀ m acc n p, list_decode acc n (Nat.iter m (~0) p) - = list_decode acc (n + m) p) as decode_iter. - { induction m as [|m IH]; intros acc n p; simpl; [by rewrite Nat.add_0_r|]. - by rewrite IH, Nat.add_succ_r. } - cut (∀ l acc, list_decode acc 0 (list_encode 1 l) = Some (l ++ acc))%list. - { by intros help l; rewrite help, (right_id_L _ _). } - induction l as [|x l IH] using @rev_ind; intros acc; [done|]. - rewrite list_encode_app'; simpl; rewrite <-x0_iter_x1, decode_iter; simpl. - by rewrite decode_encode_nat; simpl; rewrite IH, <-(assoc_L _). -Qed. -Lemma list_encode_app `{Countable A} (l1 l2 : list A) : - encode (l1 ++ l2)%list = encode l1 ++ encode l2. -Proof. apply list_encode_app'. Qed. -Lemma list_encode_cons `{Countable A} x (l : list A) : - encode (x :: l) = Nat.iter (encode_nat x) (~0) 3 ++ encode l. -Proof. apply (list_encode_app' [_]). Qed. -Lemma list_encode_suffix `{Countable A} (l k : list A) : - l `suffix_of` k → ∃ q, encode k = q ++ encode l. -Proof. intros [l' ->]; exists (encode l'); apply list_encode_app. Qed. -Lemma list_encode_suffix_eq `{Countable A} q1 q2 (l1 l2 : list A) : - length l1 = length l2 → q1 ++ encode l1 = q2 ++ encode l2 → l1 = l2. -Proof. - revert q1 q2 l2; induction l1 as [|a1 l1 IH]; - intros q1 q2 [|a2 l2] ?; simplify_eq/=; auto. - rewrite !list_encode_cons, !(assoc _); intros Hl. - assert (l1 = l2) as <- by eauto; clear IH; f_equal. - apply (inj encode_nat); apply (inj (++ encode l1)) in Hl; revert Hl; clear. - generalize (encode_nat a2). - induction (encode_nat a1); intros [|?] ?; naive_solver. -Qed. - -(** ** Numbers *) -Instance pos_countable : Countable positive := - {| encode := id; decode := Some; decode_encode x := eq_refl |}. -Program Instance N_countable : Countable N := {| - encode x := match x with N0 => 1 | Npos p => Pos.succ p end; - decode p := if decide (p = 1) then Some 0%N else Some (Npos (Pos.pred p)) -|}. -Next Obligation. - by intros [|p];simpl;[|rewrite decide_False,Pos.pred_succ by (by destruct p)]. -Qed. -Program Instance Z_countable : Countable Z := {| - encode x := match x with Z0 => 1 | Zpos p => p~0 | Zneg p => p~1 end; - decode p := Some match p with 1 => Z0 | p~0 => Zpos p | p~1 => Zneg p end -|}. -Next Obligation. by intros [|p|p]. Qed. -Program Instance nat_countable : Countable nat := - {| encode x := encode (N.of_nat x); decode p := N.to_nat <$> decode p |}. -Next Obligation. - by intros x; lazy beta; rewrite decode_encode; csimpl; rewrite Nat2N.id. -Qed. diff --git a/theories/prelude/decidable.v b/theories/prelude/decidable.v deleted file mode 100644 index 74bcbe61eafb7c4b6abc015a60056a177aa54428..0000000000000000000000000000000000000000 --- a/theories/prelude/decidable.v +++ /dev/null @@ -1,202 +0,0 @@ -(* Copyright (c) 2012-2017, Robbert Krebbers. *) -(* This file is distributed under the terms of the BSD license. *) -(** This file collects theorems, definitions, tactics, related to propositions -with a decidable equality. Such propositions are collected by the [Decision] -type class. *) -From iris.prelude Require Export proof_irrel. -Set Default Proof Using "Type*". - -Hint Extern 200 (Decision _) => progress (lazy beta) : typeclass_instances. - -Lemma dec_stable `{Decision P} : ¬¬P → P. -Proof. firstorder. Qed. - -Lemma Is_true_reflect (b : bool) : reflect b b. -Proof. destruct b. left; constructor. right. intros []. Qed. -Instance: Inj (=) (↔) Is_true. -Proof. intros [] []; simpl; intuition. Qed. - -(** We introduce [decide_rel] to avoid inefficienct computation due to eager -evaluation of propositions by [vm_compute]. This inefficiency occurs if -[(x = y) := (f x = f y)] as [decide (x = y)] evaluates to [decide (f x = f y)] -which then might lead to evaluation of [f x] and [f y]. Using [decide_rel] -we hide [f] under a lambda abstraction to avoid this unnecessary evaluation. *) -Definition decide_rel {A B} (R : A → B → Prop) {dec : ∀ x y, Decision (R x y)} - (x : A) (y : B) : Decision (R x y) := dec x y. -Lemma decide_rel_correct {A B} (R : A → B → Prop) `{∀ x y, Decision (R x y)} - (x : A) (y : B) : decide_rel R x y = decide (R x y). -Proof. reflexivity. Qed. - -Lemma decide_True {A} `{Decision P} (x y : A) : - P → (if decide P then x else y) = x. -Proof. destruct (decide P); tauto. Qed. -Lemma decide_False {A} `{Decision P} (x y : A) : - ¬P → (if decide P then x else y) = y. -Proof. destruct (decide P); tauto. Qed. -Lemma decide_iff {A} P Q `{Decision P, Decision Q} (x y : A) : - (P ↔ Q) → (if decide P then x else y) = (if decide Q then x else y). -Proof. intros [??]. destruct (decide P), (decide Q); tauto. Qed. - -Lemma decide_left`{Decision P, !ProofIrrel P} (HP : P) : decide P = left HP. -Proof. destruct (decide P) as [?|?]; [|contradiction]. f_equal. apply proof_irrel. Qed. -Lemma decide_right`{Decision P} `{!ProofIrrel (¬ P)} (HP : ¬ P) : decide P = right HP. -Proof. destruct (decide P) as [?|?]; [contradiction|]. f_equal. apply proof_irrel. Qed. - -(** The tactic [destruct_decide] destructs a sumbool [dec]. If one of the -components is double negated, it will try to remove the double negation. *) -Tactic Notation "destruct_decide" constr(dec) "as" ident(H) := - destruct dec as [H|H]; - try match type of H with - | ¬¬_ => apply dec_stable in H - end. -Tactic Notation "destruct_decide" constr(dec) := - let H := fresh in destruct_decide dec as H. - -(** The tactic [case_decide] performs case analysis on an arbitrary occurrence -of [decide] or [decide_rel] in the conclusion or hypotheses. *) -Tactic Notation "case_decide" "as" ident(Hd) := - match goal with - | H : context [@decide ?P ?dec] |- _ => - destruct_decide (@decide P dec) as Hd - | H : context [@decide_rel _ _ ?R ?x ?y ?dec] |- _ => - destruct_decide (@decide_rel _ _ R x y dec) as Hd - | |- context [@decide ?P ?dec] => - destruct_decide (@decide P dec) as Hd - | |- context [@decide_rel _ _ ?R ?x ?y ?dec] => - destruct_decide (@decide_rel _ _ R x y dec) as Hd - end. -Tactic Notation "case_decide" := - let H := fresh in case_decide as H. - -(** The tactic [solve_decision] uses Coq's [decide equality] tactic together -with instance resolution to automatically generate decision procedures. *) -Ltac solve_trivial_decision := - match goal with - | |- Decision (?P) => apply _ - | |- sumbool ?P (¬?P) => change (Decision P); apply _ - end. -Ltac solve_decision := intros; first - [ solve_trivial_decision - | unfold Decision; decide equality; solve_trivial_decision ]. - -(** The following combinators are useful to create Decision proofs in -combination with the [refine] tactic. *) -Notation swap_if S := (match S with left H => right H | right H => left H end). -Notation cast_if S := (if S then left _ else right _). -Notation cast_if_and S1 S2 := (if S1 then cast_if S2 else right _). -Notation cast_if_and3 S1 S2 S3 := (if S1 then cast_if_and S2 S3 else right _). -Notation cast_if_and4 S1 S2 S3 S4 := - (if S1 then cast_if_and3 S2 S3 S4 else right _). -Notation cast_if_and5 S1 S2 S3 S4 S5 := - (if S1 then cast_if_and4 S2 S3 S4 S5 else right _). -Notation cast_if_and6 S1 S2 S3 S4 S5 S6 := - (if S1 then cast_if_and5 S2 S3 S4 S5 S6 else right _). -Notation cast_if_or S1 S2 := (if S1 then left _ else cast_if S2). -Notation cast_if_or3 S1 S2 S3 := (if S1 then left _ else cast_if_or S2 S3). -Notation cast_if_not_or S1 S2 := (if S1 then cast_if S2 else left _). -Notation cast_if_not S := (if S then right _ else left _). - -(** We can convert decidable propositions to booleans. *) -Definition bool_decide (P : Prop) {dec : Decision P} : bool := - if dec then true else false. - -Lemma bool_decide_reflect P `{dec : Decision P} : reflect P (bool_decide P). -Proof. unfold bool_decide. destruct dec; [left|right]; assumption. Qed. - -Tactic Notation "case_bool_decide" "as" ident (Hd) := - match goal with - | H : context [@bool_decide ?P ?dec] |- _ => - destruct_decide (@bool_decide_reflect P dec) as Hd - | |- context [@bool_decide ?P ?dec] => - destruct_decide (@bool_decide_reflect P dec) as Hd - end. -Tactic Notation "case_bool_decide" := - let H := fresh in case_bool_decide as H. - -Lemma bool_decide_spec (P : Prop) {dec : Decision P} : bool_decide P ↔ P. -Proof. unfold bool_decide. destruct dec; simpl; tauto. Qed. -Lemma bool_decide_unpack (P : Prop) {dec : Decision P} : bool_decide P → P. -Proof. rewrite bool_decide_spec; trivial. Qed. -Lemma bool_decide_pack (P : Prop) {dec : Decision P} : P → bool_decide P. -Proof. rewrite bool_decide_spec; trivial. Qed. -Hint Resolve bool_decide_pack. -Lemma bool_decide_true (P : Prop) `{Decision P} : P → bool_decide P = true. -Proof. case_bool_decide; tauto. Qed. -Lemma bool_decide_false (P : Prop) `{Decision P} : ¬P → bool_decide P = false. -Proof. case_bool_decide; tauto. Qed. -Lemma bool_decide_iff (P Q : Prop) `{Decision P, Decision Q} : - (P ↔ Q) → bool_decide P = bool_decide Q. -Proof. repeat case_bool_decide; tauto. Qed. - -(** * Decidable Sigma types *) -(** Leibniz equality on Sigma types requires the equipped proofs to be -equal as Coq does not support proof irrelevance. For decidable we -propositions we define the type [dsig P] whose Leibniz equality is proof -irrelevant. That is [∀ x y : dsig P, x = y ↔ `x = `y]. *) -Definition dsig `(P : A → Prop) `{∀ x : A, Decision (P x)} := - { x | bool_decide (P x) }. - -Definition proj2_dsig `{∀ x : A, Decision (P x)} (x : dsig P) : P (`x) := - bool_decide_unpack _ (proj2_sig x). -Definition dexist `{∀ x : A, Decision (P x)} (x : A) (p : P x) : dsig P := - x↾bool_decide_pack _ p. -Lemma dsig_eq `(P : A → Prop) `{∀ x, Decision (P x)} - (x y : dsig P) : x = y ↔ `x = `y. -Proof. apply (sig_eq_pi _). Qed. -Lemma dexists_proj1 `(P : A → Prop) `{∀ x, Decision (P x)} (x : dsig P) p : - dexist (`x) p = x. -Proof. apply dsig_eq; reflexivity. Qed. - -(** * Instances of Decision *) -(** Instances of [Decision] for operators of propositional logic. *) -Instance True_dec: Decision True := left I. -Instance False_dec: Decision False := right (False_rect False). -Instance Is_true_dec b : Decision (Is_true b). -Proof. destruct b; simpl; apply _. Defined. - -Section prop_dec. - Context `(P_dec : Decision P) `(Q_dec : Decision Q). - - Global Instance not_dec: Decision (¬P). - Proof. refine (cast_if_not P_dec); intuition. Defined. - Global Instance and_dec: Decision (P ∧ Q). - Proof. refine (cast_if_and P_dec Q_dec); intuition. Defined. - Global Instance or_dec: Decision (P ∨ Q). - Proof. refine (cast_if_or P_dec Q_dec); intuition. Defined. - Global Instance impl_dec: Decision (P → Q). - Proof. refine (if P_dec then cast_if Q_dec else left _); intuition. Defined. -End prop_dec. -Instance iff_dec `(P_dec : Decision P) `(Q_dec : Decision Q) : - Decision (P ↔ Q) := and_dec _ _. - -(** Instances of [Decision] for common data types. *) -Instance bool_eq_dec : EqDecision bool. -Proof. solve_decision. Defined. -Instance unit_eq_dec : EqDecision unit. -Proof. solve_decision. Defined. -Instance prod_eq_dec `{EqDecision A, EqDecision B} : EqDecision (A * B). -Proof. solve_decision. Defined. -Instance sum_eq_dec `{EqDecision A, EqDecision B} : EqDecision (A + B). -Proof. solve_decision. Defined. - -Instance curry_dec `(P_dec : ∀ (x : A) (y : B), Decision (P x y)) p : - Decision (curry P p) := - match p as p return Decision (curry P p) with - | (x,y) => P_dec x y - end. - -Instance sig_eq_dec `(P : A → Prop) `{∀ x, ProofIrrel (P x), EqDecision A} : - EqDecision (sig P). -Proof. - refine (λ x y, cast_if (decide (`x = `y))); rewrite sig_eq_pi; trivial. -Defined. - -(** Some laws for decidable propositions *) -Lemma not_and_l {P Q : Prop} `{Decision P} : ¬(P ∧ Q) ↔ ¬P ∨ ¬Q. -Proof. destruct (decide P); tauto. Qed. -Lemma not_and_r {P Q : Prop} `{Decision Q} : ¬(P ∧ Q) ↔ ¬P ∨ ¬Q. -Proof. destruct (decide Q); tauto. Qed. -Lemma not_and_l_alt {P Q : Prop} `{Decision P} : ¬(P ∧ Q) ↔ ¬P ∨ (¬Q ∧ P). -Proof. destruct (decide P); tauto. Qed. -Lemma not_and_r_alt {P Q : Prop} `{Decision Q} : ¬(P ∧ Q) ↔ (¬P ∧ Q) ∨ ¬Q. -Proof. destruct (decide Q); tauto. Qed. diff --git a/theories/prelude/fin_collections.v b/theories/prelude/fin_collections.v deleted file mode 100644 index 134813b3b2fbf263e8910a567002b51aed1f7326..0000000000000000000000000000000000000000 --- a/theories/prelude/fin_collections.v +++ /dev/null @@ -1,286 +0,0 @@ -(* Copyright (c) 2012-2017, Robbert Krebbers. *) -(* This file is distributed under the terms of the BSD license. *) -(** This file collects definitions and theorems on finite collections. Most -importantly, it implements a fold and size function and some useful induction -principles on finite collections . *) -From iris.prelude Require Import relations. -From iris.prelude Require Export numbers collections. -Set Default Proof Using "Type*". - -Instance collection_size `{Elements A C} : Size C := length ∘ elements. -Definition collection_fold `{Elements A C} {B} - (f : A → B → B) (b : B) : C → B := foldr f b ∘ elements. - -Instance collection_filter - `{Elements A C, Empty C, Singleton A C, Union C} : Filter A C := λ P _ X, - of_list (filter P (elements X)). -Typeclasses Opaque collection_filter. - -Section fin_collection. -Context `{FinCollection A C}. -Implicit Types X Y : C. - -Lemma fin_collection_finite X : set_finite X. -Proof. by exists (elements X); intros; rewrite elem_of_elements. Qed. - -Instance elem_of_dec_slow (x : A) (X : C) : Decision (x ∈ X) | 100. -Proof. - refine (cast_if (decide_rel (∈) x (elements X))); - by rewrite <-(elem_of_elements _). -Defined. - -(** * The [elements] operation *) -Global Instance elements_proper: Proper ((≡) ==> (≡ₚ)) (elements (C:=C)). -Proof. - intros ?? E. apply NoDup_Permutation. - - apply NoDup_elements. - - apply NoDup_elements. - - intros. by rewrite !elem_of_elements, E. -Qed. - -Lemma elements_empty : elements (∅ : C) = []. -Proof. - apply elem_of_nil_inv; intros x. - rewrite elem_of_elements, elem_of_empty; tauto. -Qed. -Lemma elements_empty_inv X : elements X = [] → X ≡ ∅. -Proof. - intros HX; apply elem_of_equiv_empty; intros x. - rewrite <-elem_of_elements, HX, elem_of_nil. tauto. -Qed. -Lemma elements_empty' X : elements X = [] ↔ X ≡ ∅. -Proof. - split; intros HX; [by apply elements_empty_inv|]. - by rewrite <-Permutation_nil, HX, elements_empty. -Qed. - -Lemma elements_union_singleton (X : C) x : - x ∉ X → elements ({[ x ]} ∪ X) ≡ₚ x :: elements X. -Proof. - intros ?; apply NoDup_Permutation. - { apply NoDup_elements. } - { by constructor; rewrite ?elem_of_elements; try apply NoDup_elements. } - intros y; rewrite elem_of_elements, elem_of_union, elem_of_singleton. - by rewrite elem_of_cons, elem_of_elements. -Qed. -Lemma elements_singleton x : elements {[ x ]} = [x]. -Proof. - apply Permutation_singleton. by rewrite <-(right_id ∅ (∪) {[x]}), - elements_union_singleton, elements_empty by set_solver. -Qed. -Lemma elements_submseteq X Y : X ⊆ Y → elements X ⊆+ elements Y. -Proof. - intros; apply NoDup_submseteq; auto using NoDup_elements. - intros x. rewrite !elem_of_elements; auto. -Qed. - -(** * The [size] operation *) -Global Instance collection_size_proper: Proper ((≡) ==> (=)) (@size C _). -Proof. intros ?? E. apply Permutation_length. by rewrite E. Qed. - -Lemma size_empty : size (∅ : C) = 0. -Proof. unfold size, collection_size. simpl. by rewrite elements_empty. Qed. -Lemma size_empty_inv (X : C) : size X = 0 → X ≡ ∅. -Proof. - intros; apply equiv_empty; intros x; rewrite <-elem_of_elements. - by rewrite (nil_length_inv (elements X)), ?elem_of_nil. -Qed. -Lemma size_empty_iff (X : C) : size X = 0 ↔ X ≡ ∅. -Proof. split. apply size_empty_inv. by intros ->; rewrite size_empty. Qed. -Lemma size_non_empty_iff (X : C) : size X ≠0 ↔ X ≢ ∅. -Proof. by rewrite size_empty_iff. Qed. - -Lemma collection_choose_or_empty X : (∃ x, x ∈ X) ∨ X ≡ ∅. -Proof. - destruct (elements X) as [|x l] eqn:HX; [right|left]. - - apply equiv_empty; intros x. by rewrite <-elem_of_elements, HX, elem_of_nil. - - exists x. rewrite <-elem_of_elements, HX. by left. -Qed. -Lemma collection_choose X : X ≢ ∅ → ∃ x, x ∈ X. -Proof. intros. by destruct (collection_choose_or_empty X). Qed. -Lemma collection_choose_L `{!LeibnizEquiv C} X : X ≠∅ → ∃ x, x ∈ X. -Proof. unfold_leibniz. apply collection_choose. Qed. -Lemma size_pos_elem_of X : 0 < size X → ∃ x, x ∈ X. -Proof. - intros Hsz. destruct (collection_choose_or_empty X) as [|HX]; [done|]. - contradict Hsz. rewrite HX, size_empty; lia. -Qed. - -Lemma size_singleton (x : A) : size {[ x ]} = 1. -Proof. unfold size, collection_size. simpl. by rewrite elements_singleton. Qed. -Lemma size_singleton_inv X x y : size X = 1 → x ∈ X → y ∈ X → x = y. -Proof. - unfold size, collection_size. simpl. rewrite <-!elem_of_elements. - generalize (elements X). intros [|? l]; intro; simplify_eq/=. - rewrite (nil_length_inv l), !elem_of_list_singleton by done; congruence. -Qed. -Lemma size_1_elem_of X : size X = 1 → ∃ x, X ≡ {[ x ]}. -Proof. - intros E. destruct (size_pos_elem_of X); auto with lia. - exists x. apply elem_of_equiv. split. - - rewrite elem_of_singleton. eauto using size_singleton_inv. - - set_solver. -Qed. - -Lemma size_union X Y : X ⊥ Y → size (X ∪ Y) = size X + size Y. -Proof. - intros. unfold size, collection_size. simpl. rewrite <-app_length. - apply Permutation_length, NoDup_Permutation. - - apply NoDup_elements. - - apply NoDup_app; repeat split; try apply NoDup_elements. - intros x; rewrite !elem_of_elements; set_solver. - - intros. by rewrite elem_of_app, !elem_of_elements, elem_of_union. -Qed. -Lemma size_union_alt X Y : size (X ∪ Y) = size X + size (Y ∖ X). -Proof. - rewrite <-size_union by set_solver. - setoid_replace (Y ∖ X) with ((Y ∪ X) ∖ X) by set_solver. - rewrite <-union_difference, (comm (∪)); set_solver. -Qed. - -Lemma subseteq_size X Y : X ⊆ Y → size X ≤ size Y. -Proof. intros. rewrite (union_difference X Y), size_union_alt by done. lia. Qed. -Lemma subset_size X Y : X ⊂ Y → size X < size Y. -Proof. - intros. rewrite (union_difference X Y) by set_solver. - rewrite size_union_alt, difference_twice. - cut (size (Y ∖ X) ≠0); [lia |]. - by apply size_non_empty_iff, non_empty_difference. -Qed. - -(** * Induction principles *) -Lemma collection_wf : wf (strict (@subseteq C _)). -Proof. apply (wf_projected (<) size); auto using subset_size, lt_wf. Qed. -Lemma collection_ind (P : C → Prop) : - Proper ((≡) ==> iff) P → - P ∅ → (∀ x X, x ∉ X → P X → P ({[ x ]} ∪ X)) → ∀ X, P X. -Proof. - intros ? Hemp Hadd. apply well_founded_induction with (⊂). - { apply collection_wf. } - intros X IH. destruct (collection_choose_or_empty X) as [[x ?]|HX]. - - rewrite (union_difference {[ x ]} X) by set_solver. - apply Hadd. set_solver. apply IH; set_solver. - - by rewrite HX. -Qed. -Lemma collection_ind_L `{!LeibnizEquiv C} (P : C → Prop) : - P ∅ → (∀ x X, x ∉ X → P X → P ({[ x ]} ∪ X)) → ∀ X, P X. -Proof. apply collection_ind. by intros ?? ->%leibniz_equiv_iff. Qed. - -(** * The [collection_fold] operation *) -Lemma collection_fold_ind {B} (P : B → C → Prop) (f : A → B → B) (b : B) : - Proper ((=) ==> (≡) ==> iff) P → - P b ∅ → (∀ x X r, x ∉ X → P r X → P (f x r) ({[ x ]} ∪ X)) → - ∀ X, P (collection_fold f b X) X. -Proof. - intros ? Hemp Hadd. - cut (∀ l, NoDup l → ∀ X, (∀ x, x ∈ X ↔ x ∈ l) → P (foldr f b l) X). - { intros help ?. apply help; [apply NoDup_elements|]. - symmetry. apply elem_of_elements. } - induction 1 as [|x l ?? IH]; simpl. - - intros X HX. setoid_rewrite elem_of_nil in HX. - rewrite equiv_empty. done. set_solver. - - intros X HX. setoid_rewrite elem_of_cons in HX. - rewrite (union_difference {[ x ]} X) by set_solver. - apply Hadd. set_solver. apply IH. set_solver. -Qed. -Lemma collection_fold_proper {B} (R : relation B) `{!Equivalence R} - (f : A → B → B) (b : B) `{!Proper ((=) ==> R ==> R) f} - (Hf : ∀ a1 a2 b, R (f a1 (f a2 b)) (f a2 (f a1 b))) : - Proper ((≡) ==> R) (collection_fold f b : C → B). -Proof. intros ?? E. apply (foldr_permutation R f b); auto. by rewrite E. Qed. - -(** * Minimal elements *) -Lemma minimal_exists R `{!Transitive R, ∀ x y, Decision (R x y)} (X : C) : - X ≢ ∅ → ∃ x, x ∈ X ∧ minimal R x X. -Proof. - pattern X; apply collection_ind; clear X. - { by intros X X' HX; setoid_rewrite HX. } - { done. } - intros x X ? IH Hemp. destruct (collection_choose_or_empty X) as [[z ?]|HX]. - { destruct IH as (x' & Hx' & Hmin); [set_solver|]. - destruct (decide (R x x')). - - exists x; split; [set_solver|]. - eauto using union_minimal, singleton_minimal, minimal_weaken. - - exists x'; split; [set_solver|]. - auto using union_minimal, singleton_minimal_not_above. } - exists x; split; [set_solver|]. - rewrite HX, (right_id _ (∪)). apply singleton_minimal. -Qed. -Lemma minimal_exists_L R `{!LeibnizEquiv C, !Transitive R, - ∀ x y, Decision (R x y)} (X : C) : - X ≠∅ → ∃ x, x ∈ X ∧ minimal R x X. -Proof. unfold_leibniz. apply (minimal_exists R). Qed. - -(** * Filter *) -Section filter. - Context (P : A → Prop) `{!∀ x, Decision (P x)}. - - Lemma elem_of_filter X x : x ∈ filter P X ↔ P x ∧ x ∈ X. - Proof. - unfold filter, collection_filter. - by rewrite elem_of_of_list, elem_of_list_filter, elem_of_elements. - Qed. - Global Instance set_unfold_filter X Q : - SetUnfold (x ∈ X) Q → SetUnfold (x ∈ filter P X) (P x ∧ Q). - Proof. - intros ??; constructor. by rewrite elem_of_filter, (set_unfold (x ∈ X) Q). - Qed. - - Lemma filter_empty : filter P (∅:C) ≡ ∅. - Proof. set_solver. Qed. - Lemma filter_union X Y : filter P (X ∪ Y) ≡ filter P X ∪ filter P Y. - Proof. set_solver. Qed. - Lemma filter_singleton x : P x → filter P ({[ x ]} : C) ≡ {[ x ]}. - Proof. set_solver. Qed. - Lemma filter_singleton_not x : ¬P x → filter P ({[ x ]} : C) ≡ ∅. - Proof. set_solver. Qed. - - Section leibniz_equiv. - Context `{!LeibnizEquiv C}. - Lemma filter_empty_L : filter P (∅:C) = ∅. - Proof. set_solver. Qed. - Lemma filter_union_L X Y : filter P (X ∪ Y) = filter P X ∪ filter P Y. - Proof. set_solver. Qed. - Lemma filter_singleton_L x : P x → filter P ({[ x ]} : C) = {[ x ]}. - Proof. set_solver. Qed. - Lemma filter_singleton_not_L x : ¬P x → filter P ({[ x ]} : C) = ∅. - Proof. set_solver. Qed. - End leibniz_equiv. -End filter. - -(** * Decision procedures *) -Lemma set_Forall_elements P X : set_Forall P X ↔ Forall P (elements X). -Proof. rewrite Forall_forall. by setoid_rewrite elem_of_elements. Qed. -Lemma set_Exists_elements P X : set_Exists P X ↔ Exists P (elements X). -Proof. rewrite Exists_exists. by setoid_rewrite elem_of_elements. Qed. - -Lemma set_Forall_Exists_dec (P Q : A → Prop) (dec : ∀ x, {P x} + {Q x}) X : - {set_Forall P X} + {set_Exists Q X}. -Proof. - refine (cast_if (Forall_Exists_dec P Q dec (elements X))); - [by apply set_Forall_elements|by apply set_Exists_elements]. -Defined. - -Lemma not_set_Forall_Exists P `{dec : ∀ x, Decision (P x)} X : - ¬set_Forall P X → set_Exists (not ∘ P) X. -Proof. intro. by destruct (set_Forall_Exists_dec P (not ∘ P) dec X). Qed. -Lemma not_set_Exists_Forall P `{dec : ∀ x, Decision (P x)} X : - ¬set_Exists P X → set_Forall (not ∘ P) X. -Proof. - by destruct (set_Forall_Exists_dec - (not ∘ P) P (λ x, swap_if (decide (P x))) X). -Qed. - -Global Instance set_Forall_dec (P : A → Prop) `{∀ x, Decision (P x)} X : - Decision (set_Forall P X) | 100. -Proof. - refine (cast_if (decide (Forall P (elements X)))); - by rewrite set_Forall_elements. -Defined. -Global Instance set_Exists_dec `(P : A → Prop) `{∀ x, Decision (P x)} X : - Decision (set_Exists P X) | 100. -Proof. - refine (cast_if (decide (Exists P (elements X)))); - by rewrite set_Exists_elements. -Defined. -End fin_collection. diff --git a/theories/prelude/fin_map_dom.v b/theories/prelude/fin_map_dom.v deleted file mode 100644 index ba49a38ea1ae83347cf7a3b5ce91cdbd81043c99..0000000000000000000000000000000000000000 --- a/theories/prelude/fin_map_dom.v +++ /dev/null @@ -1,137 +0,0 @@ -(* Copyright (c) 2012-2017, Robbert Krebbers. *) -(* This file is distributed under the terms of the BSD license. *) -(** This file provides an axiomatization of the domain function of finite -maps. We provide such an axiomatization, instead of implementing the domain -function in a generic way, to allow more efficient implementations. *) -From iris.prelude Require Export collections fin_maps. -Set Default Proof Using "Type*". - -Class FinMapDom K M D `{FMap M, - ∀ A, Lookup K A (M A), ∀ A, Empty (M A), ∀ A, PartialAlter K A (M A), - OMap M, Merge M, ∀ A, FinMapToList K A (M A), EqDecision K, - ∀ A, Dom (M A) D, ElemOf K D, Empty D, Singleton K D, - Union D, Intersection D, Difference D} := { - finmap_dom_map :>> FinMap K M; - finmap_dom_collection :>> Collection K D; - elem_of_dom {A} (m : M A) i : i ∈ dom D m ↔ is_Some (m !! i) -}. - -Section fin_map_dom. -Context `{FinMapDom K M D}. - -Lemma elem_of_dom_2 {A} (m : M A) i x : m !! i = Some x → i ∈ dom D m. -Proof. rewrite elem_of_dom; eauto. Qed. -Lemma not_elem_of_dom {A} (m : M A) i : i ∉ dom D m ↔ m !! i = None. -Proof. by rewrite elem_of_dom, eq_None_not_Some. Qed. -Lemma subseteq_dom {A} (m1 m2 : M A) : m1 ⊆ m2 → dom D m1 ⊆ dom D m2. -Proof. - rewrite map_subseteq_spec. - intros ??. rewrite !elem_of_dom. inversion 1; eauto. -Qed. -Lemma subset_dom {A} (m1 m2 : M A) : m1 ⊂ m2 → dom D m1 ⊂ dom D m2. -Proof. - intros [Hss1 Hss2]; split; [by apply subseteq_dom |]. - contradict Hss2. rewrite map_subseteq_spec. intros i x Hi. - specialize (Hss2 i). rewrite !elem_of_dom in Hss2. - destruct Hss2; eauto. by simplify_map_eq. -Qed. -Lemma dom_empty {A} : dom D (@empty (M A) _) ≡ ∅. -Proof. - intros x. rewrite elem_of_dom, lookup_empty, <-not_eq_None_Some. set_solver. -Qed. -Lemma dom_empty_inv {A} (m : M A) : dom D m ≡ ∅ → m = ∅. -Proof. - intros E. apply map_empty. intros. apply not_elem_of_dom. - rewrite E. set_solver. -Qed. -Lemma dom_alter {A} f (m : M A) i : dom D (alter f i m) ≡ dom D m. -Proof. - apply elem_of_equiv; intros j; rewrite !elem_of_dom; unfold is_Some. - destruct (decide (i = j)); simplify_map_eq/=; eauto. - destruct (m !! j); naive_solver. -Qed. -Lemma dom_insert {A} (m : M A) i x : dom D (<[i:=x]>m) ≡ {[ i ]} ∪ dom D m. -Proof. - apply elem_of_equiv. intros j. rewrite elem_of_union, !elem_of_dom. - unfold is_Some. setoid_rewrite lookup_insert_Some. - destruct (decide (i = j)); set_solver. -Qed. -Lemma dom_insert_subseteq {A} (m : M A) i x : dom D m ⊆ dom D (<[i:=x]>m). -Proof. rewrite (dom_insert _). set_solver. Qed. -Lemma dom_insert_subseteq_compat_l {A} (m : M A) i x X : - X ⊆ dom D m → X ⊆ dom D (<[i:=x]>m). -Proof. intros. trans (dom D m); eauto using dom_insert_subseteq. Qed. -Lemma dom_singleton {A} (i : K) (x : A) : dom D {[i := x]} ≡ {[ i ]}. -Proof. rewrite <-insert_empty, dom_insert, dom_empty; set_solver. Qed. -Lemma dom_delete {A} (m : M A) i : dom D (delete i m) ≡ dom D m ∖ {[ i ]}. -Proof. - apply elem_of_equiv. intros j. rewrite elem_of_difference, !elem_of_dom. - unfold is_Some. setoid_rewrite lookup_delete_Some. set_solver. -Qed. -Lemma delete_partial_alter_dom {A} (m : M A) i f : - i ∉ dom D m → delete i (partial_alter f i m) = m. -Proof. rewrite not_elem_of_dom. apply delete_partial_alter. Qed. -Lemma delete_insert_dom {A} (m : M A) i x : - i ∉ dom D m → delete i (<[i:=x]>m) = m. -Proof. rewrite not_elem_of_dom. apply delete_insert. Qed. -Lemma map_disjoint_dom {A} (m1 m2 : M A) : m1 ⊥ₘ m2 ↔ dom D m1 ⊥ dom D m2. -Proof. - rewrite map_disjoint_spec, elem_of_disjoint. - setoid_rewrite elem_of_dom. unfold is_Some. naive_solver. -Qed. -Lemma map_disjoint_dom_1 {A} (m1 m2 : M A) : m1 ⊥ₘ m2 → dom D m1 ⊥ dom D m2. -Proof. apply map_disjoint_dom. Qed. -Lemma map_disjoint_dom_2 {A} (m1 m2 : M A) : dom D m1 ⊥ dom D m2 → m1 ⊥ₘ m2. -Proof. apply map_disjoint_dom. Qed. -Lemma dom_union {A} (m1 m2 : M A) : dom D (m1 ∪ m2) ≡ dom D m1 ∪ dom D m2. -Proof. - apply elem_of_equiv. intros i. rewrite elem_of_union, !elem_of_dom. - unfold is_Some. setoid_rewrite lookup_union_Some_raw. - destruct (m1 !! i); naive_solver. -Qed. -Lemma dom_intersection {A} (m1 m2: M A) : dom D (m1 ∩ m2) ≡ dom D m1 ∩ dom D m2. -Proof. - apply elem_of_equiv. intros i. rewrite elem_of_intersection, !elem_of_dom. - unfold is_Some. setoid_rewrite lookup_intersection_Some. naive_solver. -Qed. -Lemma dom_difference {A} (m1 m2 : M A) : dom D (m1 ∖ m2) ≡ dom D m1 ∖ dom D m2. -Proof. - apply elem_of_equiv. intros i. rewrite elem_of_difference, !elem_of_dom. - unfold is_Some. setoid_rewrite lookup_difference_Some. - destruct (m2 !! i); naive_solver. -Qed. -Lemma dom_fmap {A B} (f : A → B) m : dom D (f <$> m) ≡ dom D m. -Proof. - apply elem_of_equiv. intros i. - rewrite !elem_of_dom, lookup_fmap, <-!not_eq_None_Some. - destruct (m !! i); naive_solver. -Qed. -Lemma dom_finite {A} (m : M A) : set_finite (dom D m). -Proof. - induction m using map_ind; rewrite ?dom_empty, ?dom_insert; - eauto using empty_finite, union_finite, singleton_finite. -Qed. - -Context `{!LeibnizEquiv D}. -Lemma dom_empty_L {A} : dom D (@empty (M A) _) = ∅. -Proof. unfold_leibniz; apply dom_empty. Qed. -Lemma dom_empty_inv_L {A} (m : M A) : dom D m = ∅ → m = ∅. -Proof. by intros; apply dom_empty_inv; unfold_leibniz. Qed. -Lemma dom_alter_L {A} f (m : M A) i : dom D (alter f i m) = dom D m. -Proof. unfold_leibniz; apply dom_alter. Qed. -Lemma dom_insert_L {A} (m : M A) i x : dom D (<[i:=x]>m) = {[ i ]} ∪ dom D m. -Proof. unfold_leibniz; apply dom_insert. Qed. -Lemma dom_singleton_L {A} (i : K) (x : A) : dom D {[i := x]} = {[ i ]}. -Proof. unfold_leibniz; apply dom_singleton. Qed. -Lemma dom_delete_L {A} (m : M A) i : dom D (delete i m) = dom D m ∖ {[ i ]}. -Proof. unfold_leibniz; apply dom_delete. Qed. -Lemma dom_union_L {A} (m1 m2 : M A) : dom D (m1 ∪ m2) = dom D m1 ∪ dom D m2. -Proof. unfold_leibniz; apply dom_union. Qed. -Lemma dom_intersection_L {A} (m1 m2 : M A) : - dom D (m1 ∩ m2) = dom D m1 ∩ dom D m2. -Proof. unfold_leibniz; apply dom_intersection. Qed. -Lemma dom_difference_L {A} (m1 m2 : M A) : dom D (m1 ∖ m2) = dom D m1 ∖ dom D m2. -Proof. unfold_leibniz; apply dom_difference. Qed. -Lemma dom_fmap_L {A B} (f : A → B) m : dom D (f <$> m) = dom D m. -Proof. unfold_leibniz; apply dom_fmap. Qed. -End fin_map_dom. diff --git a/theories/prelude/fin_maps.v b/theories/prelude/fin_maps.v deleted file mode 100644 index c720ca09ead68258cff74cb6b7f272541de12607..0000000000000000000000000000000000000000 --- a/theories/prelude/fin_maps.v +++ /dev/null @@ -1,1725 +0,0 @@ -(* Copyright (c) 2012-2017, Robbert Krebbers. *) -(* This file is distributed under the terms of the BSD license. *) -(** Finite maps associate data to keys. This file defines an interface for -finite maps and collects some theory on it. Most importantly, it proves useful -induction principles for finite maps and implements the tactic -[simplify_map_eq] to simplify goals involving finite maps. *) -From Coq Require Import Permutation. -From iris.prelude Require Export relations orders vector fin_collections. -(* FIXME: This file needs a 'Proof Using' hint, but the default we use - everywhere makes for lots of extra ssumptions. *) - -(** * Axiomatization of finite maps *) -(** We require Leibniz equality to be extensional on finite maps. This of -course limits the space of finite map implementations, but since we are mainly -interested in finite maps with numbers as indexes, we do not consider this to -be a serious limitation. The main application of finite maps is to implement -the memory, where extensionality of Leibniz equality is very important for a -convenient use in the assertions of our axiomatic semantics. *) - -(** Finiteness is axiomatized by requiring that each map can be translated -to an association list. The translation to association lists is used to -prove well founded recursion on finite maps. *) - -(** Finite map implementations are required to implement the [merge] function -which enables us to give a generic implementation of [union_with], -[intersection_with], and [difference_with]. *) - -Class FinMapToList K A M := map_to_list: M → list (K * A). - -Class FinMap K M `{FMap M, ∀ A, Lookup K A (M A), ∀ A, Empty (M A), ∀ A, - PartialAlter K A (M A), OMap M, Merge M, ∀ A, FinMapToList K A (M A), - EqDecision K} := { - map_eq {A} (m1 m2 : M A) : (∀ i, m1 !! i = m2 !! i) → m1 = m2; - lookup_empty {A} i : (∅ : M A) !! i = None; - lookup_partial_alter {A} f (m : M A) i : - partial_alter f i m !! i = f (m !! i); - lookup_partial_alter_ne {A} f (m : M A) i j : - i ≠j → partial_alter f i m !! j = m !! j; - lookup_fmap {A B} (f : A → B) (m : M A) i : (f <$> m) !! i = f <$> m !! i; - NoDup_map_to_list {A} (m : M A) : NoDup (map_to_list m); - elem_of_map_to_list {A} (m : M A) i x : - (i,x) ∈ map_to_list m ↔ m !! i = Some x; - lookup_omap {A B} (f : A → option B) m i : omap f m !! i = m !! i ≫= f; - lookup_merge {A B C} (f: option A → option B → option C) `{!DiagNone f} m1 m2 i : - merge f m1 m2 !! i = f (m1 !! i) (m2 !! i) -}. - -(** * Derived operations *) -(** All of the following functions are defined in a generic way for arbitrary -finite map implementations. These generic implementations do not cause a -significant performance loss to make including them in the finite map interface -worthwhile. *) -Instance map_insert `{PartialAlter K A M} : Insert K A M := - λ i x, partial_alter (λ _, Some x) i. -Instance map_alter `{PartialAlter K A M} : Alter K A M := - λ f, partial_alter (fmap f). -Instance map_delete `{PartialAlter K A M} : Delete K M := - partial_alter (λ _, None). -Instance map_singleton `{PartialAlter K A M, Empty M} : - SingletonM K A M := λ i x, <[i:=x]> ∅. - -Definition map_of_list `{Insert K A M, Empty M} : list (K * A) → M := - fold_right (λ p, <[p.1:=p.2]>) ∅. - -Definition map_to_collection `{FinMapToList K A M, - Singleton B C, Empty C, Union C} (f : K → A → B) (m : M) : C := - of_list (curry f <$> map_to_list m). -Definition map_of_collection `{Elements B C, Insert K A M, Empty M} - (f : B → K * A) (X : C) : M := - map_of_list (f <$> elements X). - -Instance map_union_with `{Merge M} {A} : UnionWith A (M A) := - λ f, merge (union_with f). -Instance map_intersection_with `{Merge M} {A} : IntersectionWith A (M A) := - λ f, merge (intersection_with f). -Instance map_difference_with `{Merge M} {A} : DifferenceWith A (M A) := - λ f, merge (difference_with f). - -Instance map_equiv `{∀ A, Lookup K A (M A), Equiv A} : Equiv (M A) | 18 := - λ m1 m2, ∀ i, m1 !! i ≡ m2 !! i. - -(** The relation [intersection_forall R] on finite maps describes that the -relation [R] holds for each pair in the intersection. *) -Definition map_Forall `{Lookup K A M} (P : K → A → Prop) : M → Prop := - λ m, ∀ i x, m !! i = Some x → P i x. -Definition map_relation `{∀ A, Lookup K A (M A)} {A B} (R : A → B → Prop) - (P : A → Prop) (Q : B → Prop) (m1 : M A) (m2 : M B) : Prop := ∀ i, - option_relation R P Q (m1 !! i) (m2 !! i). -Definition map_included `{∀ A, Lookup K A (M A)} {A} - (R : relation A) : relation (M A) := map_relation R (λ _, False) (λ _, True). -Definition map_disjoint `{∀ A, Lookup K A (M A)} {A} : relation (M A) := - map_relation (λ _ _, False) (λ _, True) (λ _, True). -Infix "⊥ₘ" := map_disjoint (at level 70) : C_scope. -Hint Extern 0 (_ ⊥ₘ _) => symmetry; eassumption. -Notation "( m ⊥ₘ.)" := (map_disjoint m) (only parsing) : C_scope. -Notation "(.⊥ₘ m )" := (λ m2, m2 ⊥ₘ m) (only parsing) : C_scope. -Instance map_subseteq `{∀ A, Lookup K A (M A)} {A} : SubsetEq (M A) := - map_included (=). - -(** The union of two finite maps only has a meaningful definition for maps -that are disjoint. However, as working with partial functions is inconvenient -in Coq, we define the union as a total function. In case both finite maps -have a value at the same index, we take the value of the first map. *) -Instance map_union `{Merge M} {A} : Union (M A) := union_with (λ x _, Some x). -Instance map_intersection `{Merge M} {A} : Intersection (M A) := - intersection_with (λ x _, Some x). - -(** The difference operation removes all values from the first map whose -index contains a value in the second map as well. *) -Instance map_difference `{Merge M} {A} : Difference (M A) := - difference_with (λ _ _, None). - -(** A stronger variant of map that allows the mapped function to use the index -of the elements. Implemented by conversion to lists, so not very efficient. *) -Definition map_imap `{∀ A, Insert K A (M A), ∀ A, Empty (M A), - ∀ A, FinMapToList K A (M A)} {A B} (f : K → A → option B) (m : M A) : M B := - map_of_list (omap (λ ix, (fst ix,) <$> curry f ix) (map_to_list m)). - -(* Folds a function [f] over a map. The order in which the function is called -is unspecified. *) -Definition map_fold `{FinMapToList K A M} {B} - (f : K → A → B → B) (b : B) : M → B := foldr (curry f) b ∘ map_to_list. - -(** * Theorems *) -Section theorems. -Context `{FinMap K M}. - -(** ** Setoids *) -Section setoid. - Context `{Equiv A}. - - Lemma map_equiv_lookup_l (m1 m2 : M A) i x : - m1 ≡ m2 → m1 !! i = Some x → ∃ y, m2 !! i = Some y ∧ x ≡ y. - Proof. generalize (equiv_Some_inv_l (m1 !! i) (m2 !! i) x); naive_solver. Qed. - - Global Instance map_equivalence : - Equivalence ((≡) : relation A) → Equivalence ((≡) : relation (M A)). - Proof. - split. - - by intros m i. - - by intros m1 m2 ? i. - - by intros m1 m2 m3 ?? i; trans (m2 !! i). - Qed. - Global Instance lookup_proper (i : K) : - Proper ((≡) ==> (≡)) (lookup (M:=M A) i). - Proof. by intros m1 m2 Hm. Qed. - Global Instance partial_alter_proper : - Proper (((≡) ==> (≡)) ==> (=) ==> (≡) ==> (≡)) (partial_alter (M:=M A)). - Proof. - by intros f1 f2 Hf i ? <- m1 m2 Hm j; destruct (decide (i = j)) as [->|]; - rewrite ?lookup_partial_alter, ?lookup_partial_alter_ne by done; - try apply Hf; apply lookup_proper. - Qed. - Global Instance insert_proper (i : K) : - Proper ((≡) ==> (≡) ==> (≡)) (insert (M:=M A) i). - Proof. by intros ???; apply partial_alter_proper; [constructor|]. Qed. - Global Instance singleton_proper k : - Proper ((≡) ==> (≡)) (singletonM k : A → M A). - Proof. - intros ???; apply insert_proper; [done|]. - intros ?. rewrite lookup_empty; constructor. - Qed. - Global Instance delete_proper (i : K) : - Proper ((≡) ==> (≡)) (delete (M:=M A) i). - Proof. by apply partial_alter_proper; [constructor|]. Qed. - Global Instance alter_proper : - Proper (((≡) ==> (≡)) ==> (=) ==> (≡) ==> (≡)) (alter (A:=A) (M:=M A)). - Proof. - intros ?? Hf; apply partial_alter_proper. - by destruct 1; constructor; apply Hf. - Qed. - Lemma merge_ext f g `{!DiagNone f, !DiagNone g} : - ((≡) ==> (≡) ==> (≡))%signature f g → - ((≡) ==> (≡) ==> (≡))%signature (merge (M:=M) f) (merge g). - Proof. - by intros Hf ?? Hm1 ?? Hm2 i; rewrite !lookup_merge by done; apply Hf. - Qed. - Global Instance union_with_proper : - Proper (((≡) ==> (≡) ==> (≡)) ==> (≡) ==> (≡) ==>(≡)) (union_with (M:=M A)). - Proof. - intros ?? Hf ?? Hm1 ?? Hm2 i; apply (merge_ext _ _); auto. - by do 2 destruct 1; first [apply Hf | constructor]. - Qed. - Global Instance map_leibniz `{!LeibnizEquiv A} : LeibnizEquiv (M A). - Proof. intros m1 m2 Hm; apply map_eq; intros i. apply leibniz_equiv, Hm. Qed. - Lemma map_equiv_empty (m : M A) : m ≡ ∅ ↔ m = ∅. - Proof. - split; [intros Hm; apply map_eq; intros i|intros ->]. - - generalize (Hm i). by rewrite lookup_empty, equiv_None. - - intros ?. rewrite lookup_empty; constructor. - Qed. - Global Instance map_fmap_proper `{Equiv B} (f : A → B) : - Proper ((≡) ==> (≡)) f → Proper ((≡) ==> (≡)) (fmap (M:=M) f). - Proof. - intros ? m m' ? k; rewrite !lookup_fmap. by apply option_fmap_proper. - Qed. -End setoid. - -(** ** General properties *) -Lemma map_eq_iff {A} (m1 m2 : M A) : m1 = m2 ↔ ∀ i, m1 !! i = m2 !! i. -Proof. split. by intros ->. apply map_eq. Qed. -Lemma map_subseteq_spec {A} (m1 m2 : M A) : - m1 ⊆ m2 ↔ ∀ i x, m1 !! i = Some x → m2 !! i = Some x. -Proof. - unfold subseteq, map_subseteq, map_relation. split; intros Hm i; - specialize (Hm i); destruct (m1 !! i), (m2 !! i); naive_solver. -Qed. -Global Instance: ∀ {A} (R : relation A), PreOrder R → PreOrder (map_included R). -Proof. - split; [intros m i; by destruct (m !! i); simpl|]. - intros m1 m2 m3 Hm12 Hm23 i; specialize (Hm12 i); specialize (Hm23 i). - destruct (m1 !! i), (m2 !! i), (m3 !! i); simplify_eq/=; - done || etrans; eauto. -Qed. -Global Instance: PartialOrder ((⊆) : relation (M A)). -Proof. - split; [apply _|]. - intros m1 m2; rewrite !map_subseteq_spec. - intros; apply map_eq; intros i; apply option_eq; naive_solver. -Qed. -Lemma lookup_weaken {A} (m1 m2 : M A) i x : - m1 !! i = Some x → m1 ⊆ m2 → m2 !! i = Some x. -Proof. rewrite !map_subseteq_spec. auto. Qed. -Lemma lookup_weaken_is_Some {A} (m1 m2 : M A) i : - is_Some (m1 !! i) → m1 ⊆ m2 → is_Some (m2 !! i). -Proof. inversion 1. eauto using lookup_weaken. Qed. -Lemma lookup_weaken_None {A} (m1 m2 : M A) i : - m2 !! i = None → m1 ⊆ m2 → m1 !! i = None. -Proof. - rewrite map_subseteq_spec, !eq_None_not_Some. - intros Hm2 Hm [??]; destruct Hm2; eauto. -Qed. -Lemma lookup_weaken_inv {A} (m1 m2 : M A) i x y : - m1 !! i = Some x → m1 ⊆ m2 → m2 !! i = Some y → x = y. -Proof. intros Hm1 ? Hm2. eapply lookup_weaken in Hm1; eauto. congruence. Qed. -Lemma lookup_ne {A} (m : M A) i j : m !! i ≠m !! j → i ≠j. -Proof. congruence. Qed. -Lemma map_empty {A} (m : M A) : (∀ i, m !! i = None) → m = ∅. -Proof. intros Hm. apply map_eq. intros. by rewrite Hm, lookup_empty. Qed. -Lemma lookup_empty_is_Some {A} i : ¬is_Some ((∅ : M A) !! i). -Proof. rewrite lookup_empty. by inversion 1. Qed. -Lemma lookup_empty_Some {A} i (x : A) : ¬∅ !! i = Some x. -Proof. by rewrite lookup_empty. Qed. -Lemma map_subset_empty {A} (m : M A) : m ⊄ ∅. -Proof. - intros [_ []]. rewrite map_subseteq_spec. intros ??. by rewrite lookup_empty. -Qed. -Lemma map_fmap_empty {A B} (f : A → B) : f <$> (∅ : M A) = ∅. -Proof. by apply map_eq; intros i; rewrite lookup_fmap, !lookup_empty. Qed. - -(** ** Properties of the [partial_alter] operation *) -Lemma partial_alter_ext {A} (f g : option A → option A) (m : M A) i : - (∀ x, m !! i = x → f x = g x) → partial_alter f i m = partial_alter g i m. -Proof. - intros. apply map_eq; intros j. by destruct (decide (i = j)) as [->|?]; - rewrite ?lookup_partial_alter, ?lookup_partial_alter_ne; auto. -Qed. -Lemma partial_alter_compose {A} f g (m : M A) i: - partial_alter (f ∘ g) i m = partial_alter f i (partial_alter g i m). -Proof. - intros. apply map_eq. intros ii. by destruct (decide (i = ii)) as [->|?]; - rewrite ?lookup_partial_alter, ?lookup_partial_alter_ne. -Qed. -Lemma partial_alter_commute {A} f g (m : M A) i j : - i ≠j → partial_alter f i (partial_alter g j m) = - partial_alter g j (partial_alter f i m). -Proof. - intros. apply map_eq; intros jj. destruct (decide (jj = j)) as [->|?]. - { by rewrite lookup_partial_alter_ne, - !lookup_partial_alter, lookup_partial_alter_ne. } - destruct (decide (jj = i)) as [->|?]. - - by rewrite lookup_partial_alter, - !lookup_partial_alter_ne, lookup_partial_alter by congruence. - - by rewrite !lookup_partial_alter_ne by congruence. -Qed. -Lemma partial_alter_self_alt {A} (m : M A) i x : - x = m !! i → partial_alter (λ _, x) i m = m. -Proof. - intros. apply map_eq. intros ii. by destruct (decide (i = ii)) as [->|]; - rewrite ?lookup_partial_alter, ?lookup_partial_alter_ne. -Qed. -Lemma partial_alter_self {A} (m : M A) i : partial_alter (λ _, m !! i) i m = m. -Proof. by apply partial_alter_self_alt. Qed. -Lemma partial_alter_subseteq {A} f (m : M A) i : - m !! i = None → m ⊆ partial_alter f i m. -Proof. - rewrite map_subseteq_spec. intros Hi j x Hj. - rewrite lookup_partial_alter_ne; congruence. -Qed. -Lemma partial_alter_subset {A} f (m : M A) i : - m !! i = None → is_Some (f (m !! i)) → m ⊂ partial_alter f i m. -Proof. - intros Hi Hfi. split; [by apply partial_alter_subseteq|]. - rewrite !map_subseteq_spec. inversion Hfi as [x Hx]. intros Hm. - apply (Some_ne_None x). rewrite <-(Hm i x); [done|]. - by rewrite lookup_partial_alter. -Qed. - -(** ** Properties of the [alter] operation *) -Lemma alter_ext {A} (f g : A → A) (m : M A) i : - (∀ x, m !! i = Some x → f x = g x) → alter f i m = alter g i m. -Proof. intro. apply partial_alter_ext. intros [x|] ?; f_equal/=; auto. Qed. -Lemma lookup_alter {A} (f : A → A) m i : alter f i m !! i = f <$> m !! i. -Proof. unfold alter. apply lookup_partial_alter. Qed. -Lemma lookup_alter_ne {A} (f : A → A) m i j : i ≠j → alter f i m !! j = m !! j. -Proof. unfold alter. apply lookup_partial_alter_ne. Qed. -Lemma alter_compose {A} (f g : A → A) (m : M A) i: - alter (f ∘ g) i m = alter f i (alter g i m). -Proof. - unfold alter, map_alter. rewrite <-partial_alter_compose. - apply partial_alter_ext. by intros [?|]. -Qed. -Lemma alter_commute {A} (f g : A → A) (m : M A) i j : - i ≠j → alter f i (alter g j m) = alter g j (alter f i m). -Proof. apply partial_alter_commute. Qed. -Lemma lookup_alter_Some {A} (f : A → A) m i j y : - alter f i m !! j = Some y ↔ - (i = j ∧ ∃ x, m !! j = Some x ∧ y = f x) ∨ (i ≠j ∧ m !! j = Some y). -Proof. - destruct (decide (i = j)) as [->|?]. - - rewrite lookup_alter. naive_solver (simplify_option_eq; eauto). - - rewrite lookup_alter_ne by done. naive_solver. -Qed. -Lemma lookup_alter_None {A} (f : A → A) m i j : - alter f i m !! j = None ↔ m !! j = None. -Proof. - by destruct (decide (i = j)) as [->|?]; - rewrite ?lookup_alter, ?fmap_None, ?lookup_alter_ne. -Qed. -Lemma alter_id {A} (f : A → A) m i : - (∀ x, m !! i = Some x → f x = x) → alter f i m = m. -Proof. - intros Hi; apply map_eq; intros j; destruct (decide (i = j)) as [->|?]. - { rewrite lookup_alter; destruct (m !! j); f_equal/=; auto. } - by rewrite lookup_alter_ne by done. -Qed. - -(** ** Properties of the [delete] operation *) -Lemma lookup_delete {A} (m : M A) i : delete i m !! i = None. -Proof. apply lookup_partial_alter. Qed. -Lemma lookup_delete_ne {A} (m : M A) i j : i ≠j → delete i m !! j = m !! j. -Proof. apply lookup_partial_alter_ne. Qed. -Lemma lookup_delete_Some {A} (m : M A) i j y : - delete i m !! j = Some y ↔ i ≠j ∧ m !! j = Some y. -Proof. - split. - - destruct (decide (i = j)) as [->|?]; - rewrite ?lookup_delete, ?lookup_delete_ne; intuition congruence. - - intros [??]. by rewrite lookup_delete_ne. -Qed. -Lemma lookup_delete_is_Some {A} (m : M A) i j : - is_Some (delete i m !! j) ↔ i ≠j ∧ is_Some (m !! j). -Proof. unfold is_Some; setoid_rewrite lookup_delete_Some; naive_solver. Qed. -Lemma lookup_delete_None {A} (m : M A) i j : - delete i m !! j = None ↔ i = j ∨ m !! j = None. -Proof. - destruct (decide (i = j)) as [->|?]; - rewrite ?lookup_delete, ?lookup_delete_ne; tauto. -Qed. -Lemma delete_empty {A} i : delete i (∅ : M A) = ∅. -Proof. rewrite <-(partial_alter_self ∅) at 2. by rewrite lookup_empty. Qed. -Lemma delete_singleton {A} i (x : A) : delete i {[i := x]} = ∅. -Proof. setoid_rewrite <-partial_alter_compose. apply delete_empty. Qed. -Lemma delete_commute {A} (m : M A) i j : - delete i (delete j m) = delete j (delete i m). -Proof. destruct (decide (i = j)). by subst. by apply partial_alter_commute. Qed. -Lemma delete_insert_ne {A} (m : M A) i j x : - i ≠j → delete i (<[j:=x]>m) = <[j:=x]>(delete i m). -Proof. intro. by apply partial_alter_commute. Qed. -Lemma delete_notin {A} (m : M A) i : m !! i = None → delete i m = m. -Proof. - intros. apply map_eq. intros j. by destruct (decide (i = j)) as [->|?]; - rewrite ?lookup_delete, ?lookup_delete_ne. -Qed. -Lemma delete_partial_alter {A} (m : M A) i f : - m !! i = None → delete i (partial_alter f i m) = m. -Proof. - intros. unfold delete, map_delete. rewrite <-partial_alter_compose. - unfold compose. by apply partial_alter_self_alt. -Qed. -Lemma delete_insert {A} (m : M A) i x : - m !! i = None → delete i (<[i:=x]>m) = m. -Proof. apply delete_partial_alter. Qed. -Lemma insert_delete {A} (m : M A) i x : <[i:=x]>(delete i m) = <[i:=x]> m. -Proof. symmetry; apply (partial_alter_compose (λ _, Some x)). Qed. -Lemma delete_subseteq {A} (m : M A) i : delete i m ⊆ m. -Proof. - rewrite !map_subseteq_spec. intros j x. rewrite lookup_delete_Some. tauto. -Qed. -Lemma delete_subseteq_compat {A} (m1 m2 : M A) i : - m1 ⊆ m2 → delete i m1 ⊆ delete i m2. -Proof. - rewrite !map_subseteq_spec. intros ? j x. - rewrite !lookup_delete_Some. intuition eauto. -Qed. -Lemma delete_subset_alt {A} (m : M A) i x : m !! i = Some x → delete i m ⊂ m. -Proof. - split; [apply delete_subseteq|]. - rewrite !map_subseteq_spec. intros Hi. apply (None_ne_Some x). - by rewrite <-(lookup_delete m i), (Hi i x). -Qed. -Lemma delete_subset {A} (m : M A) i : is_Some (m !! i) → delete i m ⊂ m. -Proof. inversion 1. eauto using delete_subset_alt. Qed. - -(** ** Properties of the [insert] operation *) -Lemma lookup_insert {A} (m : M A) i x : <[i:=x]>m !! i = Some x. -Proof. unfold insert. apply lookup_partial_alter. Qed. -Lemma lookup_insert_rev {A} (m : M A) i x y : <[i:=x]>m !! i = Some y → x = y. -Proof. rewrite lookup_insert. congruence. Qed. -Lemma lookup_insert_ne {A} (m : M A) i j x : i ≠j → <[i:=x]>m !! j = m !! j. -Proof. unfold insert. apply lookup_partial_alter_ne. Qed. -Lemma insert_insert {A} (m : M A) i x y : <[i:=x]>(<[i:=y]>m) = <[i:=x]>m. -Proof. unfold insert, map_insert. by rewrite <-partial_alter_compose. Qed. -Lemma insert_commute {A} (m : M A) i j x y : - i ≠j → <[i:=x]>(<[j:=y]>m) = <[j:=y]>(<[i:=x]>m). -Proof. apply partial_alter_commute. Qed. -Lemma lookup_insert_Some {A} (m : M A) i j x y : - <[i:=x]>m !! j = Some y ↔ (i = j ∧ x = y) ∨ (i ≠j ∧ m !! j = Some y). -Proof. - split. - - destruct (decide (i = j)) as [->|?]; - rewrite ?lookup_insert, ?lookup_insert_ne; intuition congruence. - - intros [[-> ->]|[??]]; [apply lookup_insert|]. by rewrite lookup_insert_ne. -Qed. -Lemma lookup_insert_is_Some {A} (m : M A) i j x : - is_Some (<[i:=x]>m !! j) ↔ i = j ∨ i ≠j ∧ is_Some (m !! j). -Proof. unfold is_Some; setoid_rewrite lookup_insert_Some; naive_solver. Qed. -Lemma lookup_insert_None {A} (m : M A) i j x : - <[i:=x]>m !! j = None ↔ m !! j = None ∧ i ≠j. -Proof. - split; [|by intros [??]; rewrite lookup_insert_ne]. - destruct (decide (i = j)) as [->|]; - rewrite ?lookup_insert, ?lookup_insert_ne; intuition congruence. -Qed. -Lemma insert_id {A} (m : M A) i x : m !! i = Some x → <[i:=x]>m = m. -Proof. - intros; apply map_eq; intros j; destruct (decide (i = j)) as [->|]; - by rewrite ?lookup_insert, ?lookup_insert_ne by done. -Qed. -Lemma insert_included {A} R `{!Reflexive R} (m : M A) i x : - (∀ y, m !! i = Some y → R y x) → map_included R m (<[i:=x]>m). -Proof. - intros ? j; destruct (decide (i = j)) as [->|]. - - rewrite lookup_insert. destruct (m !! j); simpl; eauto. - - rewrite lookup_insert_ne by done. by destruct (m !! j); simpl. -Qed. -Lemma insert_subseteq {A} (m : M A) i x : m !! i = None → m ⊆ <[i:=x]>m. -Proof. apply partial_alter_subseteq. Qed. -Lemma insert_subset {A} (m : M A) i x : m !! i = None → m ⊂ <[i:=x]>m. -Proof. intro. apply partial_alter_subset; eauto. Qed. -Lemma insert_subseteq_r {A} (m1 m2 : M A) i x : - m1 !! i = None → m1 ⊆ m2 → m1 ⊆ <[i:=x]>m2. -Proof. - rewrite !map_subseteq_spec. intros ?? j ?. - destruct (decide (j = i)) as [->|?]; [congruence|]. - rewrite lookup_insert_ne; auto. -Qed. -Lemma insert_delete_subseteq {A} (m1 m2 : M A) i x : - m1 !! i = None → <[i:=x]> m1 ⊆ m2 → m1 ⊆ delete i m2. -Proof. - rewrite !map_subseteq_spec. intros Hi Hix j y Hj. - destruct (decide (i = j)) as [->|]; [congruence|]. - rewrite lookup_delete_ne by done. - apply Hix; by rewrite lookup_insert_ne by done. -Qed. -Lemma delete_insert_subseteq {A} (m1 m2 : M A) i x : - m1 !! i = Some x → delete i m1 ⊆ m2 → m1 ⊆ <[i:=x]> m2. -Proof. - rewrite !map_subseteq_spec. - intros Hix Hi j y Hj. destruct (decide (i = j)) as [->|?]. - - rewrite lookup_insert. congruence. - - rewrite lookup_insert_ne by done. apply Hi. by rewrite lookup_delete_ne. -Qed. -Lemma insert_delete_subset {A} (m1 m2 : M A) i x : - m1 !! i = None → <[i:=x]> m1 ⊂ m2 → m1 ⊂ delete i m2. -Proof. - intros ? [Hm12 Hm21]; split; [eauto using insert_delete_subseteq|]. - contradict Hm21. apply delete_insert_subseteq; auto. - eapply lookup_weaken, Hm12. by rewrite lookup_insert. -Qed. -Lemma insert_subset_inv {A} (m1 m2 : M A) i x : - m1 !! i = None → <[i:=x]> m1 ⊂ m2 → - ∃ m2', m2 = <[i:=x]>m2' ∧ m1 ⊂ m2' ∧ m2' !! i = None. -Proof. - intros Hi Hm1m2. exists (delete i m2). split_and?. - - rewrite insert_delete, insert_id. done. - eapply lookup_weaken, strict_include; eauto. by rewrite lookup_insert. - - eauto using insert_delete_subset. - - by rewrite lookup_delete. -Qed. -Lemma insert_empty {A} i (x : A) : <[i:=x]>∅ = {[i := x]}. -Proof. done. Qed. -Lemma insert_non_empty {A} (m : M A) i x : <[i:=x]>m ≠∅. -Proof. - intros Hi%(f_equal (!! i)). by rewrite lookup_insert, lookup_empty in Hi. -Qed. - -(** ** Properties of the singleton maps *) -Lemma lookup_singleton_Some {A} i j (x y : A) : - {[i := x]} !! j = Some y ↔ i = j ∧ x = y. -Proof. - rewrite <-insert_empty,lookup_insert_Some, lookup_empty; intuition congruence. -Qed. -Lemma lookup_singleton_None {A} i j (x : A) : {[i := x]} !! j = None ↔ i ≠j. -Proof. rewrite <-insert_empty,lookup_insert_None, lookup_empty; tauto. Qed. -Lemma lookup_singleton {A} i (x : A) : {[i := x]} !! i = Some x. -Proof. by rewrite lookup_singleton_Some. Qed. -Lemma lookup_singleton_ne {A} i j (x : A) : i ≠j → {[i := x]} !! j = None. -Proof. by rewrite lookup_singleton_None. Qed. -Lemma map_non_empty_singleton {A} i (x : A) : {[i := x]} ≠∅. -Proof. - intros Hix. apply (f_equal (!! i)) in Hix. - by rewrite lookup_empty, lookup_singleton in Hix. -Qed. -Lemma insert_singleton {A} i (x y : A) : <[i:=y]>{[i := x]} = {[i := y]}. -Proof. - unfold singletonM, map_singleton, insert, map_insert. - by rewrite <-partial_alter_compose. -Qed. -Lemma alter_singleton {A} (f : A → A) i x : alter f i {[i := x]} = {[i := f x]}. -Proof. - intros. apply map_eq. intros i'. destruct (decide (i = i')) as [->|?]. - - by rewrite lookup_alter, !lookup_singleton. - - by rewrite lookup_alter_ne, !lookup_singleton_ne. -Qed. -Lemma alter_singleton_ne {A} (f : A → A) i j x : - i ≠j → alter f i {[j := x]} = {[j := x]}. -Proof. - intros. apply map_eq; intros i'. by destruct (decide (i = i')) as [->|?]; - rewrite ?lookup_alter, ?lookup_singleton_ne, ?lookup_alter_ne by done. -Qed. -Lemma singleton_non_empty {A} i (x : A) : {[i:=x]} ≠∅. -Proof. apply insert_non_empty. Qed. - -(** ** Properties of the map operations *) -Lemma fmap_empty {A B} (f : A → B) : f <$> ∅ = ∅. -Proof. apply map_empty; intros i. by rewrite lookup_fmap, lookup_empty. Qed. -Lemma omap_empty {A B} (f : A → option B) : omap f ∅ = ∅. -Proof. apply map_empty; intros i. by rewrite lookup_omap, lookup_empty. Qed. -Lemma fmap_insert {A B} (f: A → B) m i x: f <$> <[i:=x]>m = <[i:=f x]>(f <$> m). -Proof. - apply map_eq; intros i'; destruct (decide (i' = i)) as [->|]. - - by rewrite lookup_fmap, !lookup_insert. - - by rewrite lookup_fmap, !lookup_insert_ne, lookup_fmap by done. -Qed. -Lemma fmap_delete {A B} (f: A → B) m i: f <$> delete i m = delete i (f <$> m). -Proof. - apply map_eq; intros i'; destruct (decide (i' = i)) as [->|]. - - by rewrite lookup_fmap, !lookup_delete. - - by rewrite lookup_fmap, !lookup_delete_ne, lookup_fmap by done. -Qed. -Lemma omap_insert {A B} (f : A → option B) m i x y : - f x = Some y → omap f (<[i:=x]>m) = <[i:=y]>(omap f m). -Proof. - intros; apply map_eq; intros i'; destruct (decide (i' = i)) as [->|]. - - by rewrite lookup_omap, !lookup_insert. - - by rewrite lookup_omap, !lookup_insert_ne, lookup_omap by done. -Qed. -Lemma map_fmap_singleton {A B} (f : A → B) i x : f <$> {[i := x]} = {[i := f x]}. -Proof. - by unfold singletonM, map_singleton; rewrite fmap_insert, map_fmap_empty. -Qed. -Lemma omap_singleton {A B} (f : A → option B) i x y : - f x = Some y → omap f {[ i := x ]} = {[ i := y ]}. -Proof. - intros. unfold singletonM, map_singleton. - by erewrite omap_insert, omap_empty by eauto. -Qed. -Lemma map_fmap_id {A} (m : M A) : id <$> m = m. -Proof. apply map_eq; intros i; by rewrite lookup_fmap, option_fmap_id. Qed. -Lemma map_fmap_compose {A B C} (f : A → B) (g : B → C) (m : M A) : - g ∘ f <$> m = g <$> f <$> m. -Proof. apply map_eq; intros i; by rewrite !lookup_fmap,option_fmap_compose. Qed. -Lemma map_fmap_equiv_ext `{Equiv A, Equiv B} (f1 f2 : A → B) m : - (∀ i x, m !! i = Some x → f1 x ≡ f2 x) → f1 <$> m ≡ f2 <$> m. -Proof. - intros Hi i; rewrite !lookup_fmap. - destruct (m !! i) eqn:?; constructor; eauto. -Qed. -Lemma map_fmap_ext {A B} (f1 f2 : A → B) m : - (∀ i x, m !! i = Some x → f1 x = f2 x) → f1 <$> m = f2 <$> m. -Proof. - intros Hi; apply map_eq; intros i; rewrite !lookup_fmap. - by destruct (m !! i) eqn:?; simpl; erewrite ?Hi by eauto. -Qed. -Lemma omap_ext {A B} (f1 f2 : A → option B) m : - (∀ i x, m !! i = Some x → f1 x = f2 x) → omap f1 m = omap f2 m. -Proof. - intros Hi; apply map_eq; intros i; rewrite !lookup_omap. - by destruct (m !! i) eqn:?; simpl; erewrite ?Hi by eauto. -Qed. - -(** ** Properties of conversion to lists *) -Lemma elem_of_map_to_list' {A} (m : M A) ix : - ix ∈ map_to_list m ↔ m !! ix.1 = Some (ix.2). -Proof. destruct ix as [i x]. apply elem_of_map_to_list. Qed. -Lemma map_to_list_unique {A} (m : M A) i x y : - (i,x) ∈ map_to_list m → (i,y) ∈ map_to_list m → x = y. -Proof. rewrite !elem_of_map_to_list. congruence. Qed. -Lemma NoDup_fst_map_to_list {A} (m : M A) : NoDup ((map_to_list m).*1). -Proof. eauto using NoDup_fmap_fst, map_to_list_unique, NoDup_map_to_list. Qed. -Lemma elem_of_map_of_list_1' {A} (l : list (K * A)) i x : - (∀ y, (i,y) ∈ l → x = y) → (i,x) ∈ l → map_of_list l !! i = Some x. -Proof. - induction l as [|[j y] l IH]; csimpl; [by rewrite elem_of_nil|]. - setoid_rewrite elem_of_cons. - intros Hdup [?|?]; simplify_eq; [by rewrite lookup_insert|]. - destruct (decide (i = j)) as [->|]. - - rewrite lookup_insert; f_equal; eauto using eq_sym. - - rewrite lookup_insert_ne by done; eauto. -Qed. -Lemma elem_of_map_of_list_1 {A} (l : list (K * A)) i x : - NoDup (l.*1) → (i,x) ∈ l → map_of_list l !! i = Some x. -Proof. - intros ? Hx; apply elem_of_map_of_list_1'; eauto using NoDup_fmap_fst. - intros y; revert Hx. rewrite !elem_of_list_lookup; intros [i' Hi'] [j' Hj']. - cut (i' = j'); [naive_solver|]. apply NoDup_lookup with (l.*1) i; - by rewrite ?list_lookup_fmap, ?Hi', ?Hj'. -Qed. -Lemma elem_of_map_of_list_2 {A} (l : list (K * A)) i x : - map_of_list l !! i = Some x → (i,x) ∈ l. -Proof. - induction l as [|[j y] l IH]; simpl; [by rewrite lookup_empty|]. - rewrite elem_of_cons. destruct (decide (i = j)) as [->|]; - rewrite ?lookup_insert, ?lookup_insert_ne; intuition congruence. -Qed. -Lemma elem_of_map_of_list' {A} (l : list (K * A)) i x : - (∀ x', (i,x) ∈ l → (i,x') ∈ l → x = x') → - (i,x) ∈ l ↔ map_of_list l !! i = Some x. -Proof. split; auto using elem_of_map_of_list_1', elem_of_map_of_list_2. Qed. -Lemma elem_of_map_of_list {A} (l : list (K * A)) i x : - NoDup (l.*1) → (i,x) ∈ l ↔ map_of_list l !! i = Some x. -Proof. split; auto using elem_of_map_of_list_1, elem_of_map_of_list_2. Qed. - -Lemma not_elem_of_map_of_list_1 {A} (l : list (K * A)) i : - i ∉ l.*1 → map_of_list l !! i = None. -Proof. - rewrite elem_of_list_fmap, eq_None_not_Some. intros Hi [x ?]; destruct Hi. - exists (i,x); simpl; auto using elem_of_map_of_list_2. -Qed. -Lemma not_elem_of_map_of_list_2 {A} (l : list (K * A)) i : - map_of_list l !! i = None → i ∉ l.*1. -Proof. - induction l as [|[j y] l IH]; csimpl; [rewrite elem_of_nil; tauto|]. - rewrite elem_of_cons. destruct (decide (i = j)); simplify_eq. - - by rewrite lookup_insert. - - by rewrite lookup_insert_ne; intuition. -Qed. -Lemma not_elem_of_map_of_list {A} (l : list (K * A)) i : - i ∉ l.*1 ↔ map_of_list l !! i = None. -Proof. red; auto using not_elem_of_map_of_list_1,not_elem_of_map_of_list_2. Qed. -Lemma map_of_list_proper {A} (l1 l2 : list (K * A)) : - NoDup (l1.*1) → l1 ≡ₚ l2 → map_of_list l1 = map_of_list l2. -Proof. - intros ? Hperm. apply map_eq. intros i. apply option_eq. intros x. - by rewrite <-!elem_of_map_of_list; rewrite <-?Hperm. -Qed. -Lemma map_of_list_inj {A} (l1 l2 : list (K * A)) : - NoDup (l1.*1) → NoDup (l2.*1) → map_of_list l1 = map_of_list l2 → l1 ≡ₚ l2. -Proof. - intros ?? Hl1l2. apply NoDup_Permutation; auto using (NoDup_fmap_1 fst). - intros [i x]. by rewrite !elem_of_map_of_list, Hl1l2. -Qed. -Lemma map_of_to_list {A} (m : M A) : map_of_list (map_to_list m) = m. -Proof. - apply map_eq. intros i. apply option_eq. intros x. - by rewrite <-elem_of_map_of_list, elem_of_map_to_list - by auto using NoDup_fst_map_to_list. -Qed. -Lemma map_to_of_list {A} (l : list (K * A)) : - NoDup (l.*1) → map_to_list (map_of_list l) ≡ₚ l. -Proof. auto using map_of_list_inj, NoDup_fst_map_to_list, map_of_to_list. Qed. -Lemma map_to_list_inj {A} (m1 m2 : M A) : - map_to_list m1 ≡ₚ map_to_list m2 → m1 = m2. -Proof. - intros. rewrite <-(map_of_to_list m1), <-(map_of_to_list m2). - auto using map_of_list_proper, NoDup_fst_map_to_list. -Qed. -Lemma map_to_of_list_flip {A} (m1 : M A) l2 : - map_to_list m1 ≡ₚ l2 → m1 = map_of_list l2. -Proof. - intros. rewrite <-(map_of_to_list m1). - auto using map_of_list_proper, NoDup_fst_map_to_list. -Qed. - -Lemma map_of_list_nil {A} : map_of_list (@nil (K * A)) = ∅. -Proof. done. Qed. -Lemma map_of_list_cons {A} (l : list (K * A)) i x : - map_of_list ((i, x) :: l) = <[i:=x]>(map_of_list l). -Proof. done. Qed. -Lemma map_of_list_fmap {A B} (f : A → B) l : - map_of_list (prod_map id f <$> l) = f <$> map_of_list l. -Proof. - induction l as [|[i x] l IH]; csimpl; rewrite ?fmap_empty; auto. - rewrite <-map_of_list_cons; simpl. by rewrite IH, <-fmap_insert. -Qed. - -Lemma map_to_list_empty {A} : map_to_list ∅ = @nil (K * A). -Proof. - apply elem_of_nil_inv. intros [i x]. - rewrite elem_of_map_to_list. apply lookup_empty_Some. -Qed. -Lemma map_to_list_insert {A} (m : M A) i x : - m !! i = None → map_to_list (<[i:=x]>m) ≡ₚ (i,x) :: map_to_list m. -Proof. - intros. apply map_of_list_inj; csimpl. - - apply NoDup_fst_map_to_list. - - constructor; auto using NoDup_fst_map_to_list. - rewrite elem_of_list_fmap. intros [[??] [? Hlookup]]; subst; simpl in *. - rewrite elem_of_map_to_list in Hlookup. congruence. - - by rewrite !map_of_to_list. -Qed. -Lemma map_to_list_singleton {A} i (x : A) : map_to_list {[i:=x]} = [(i,x)]. -Proof. - apply Permutation_singleton. unfold singletonM, map_singleton. - by rewrite map_to_list_insert, map_to_list_empty by auto using lookup_empty. -Qed. - -Lemma map_to_list_submseteq {A} (m1 m2 : M A) : - m1 ⊆ m2 → map_to_list m1 ⊆+ map_to_list m2. -Proof. - intros; apply NoDup_submseteq; auto using NoDup_map_to_list. - intros [i x]. rewrite !elem_of_map_to_list; eauto using lookup_weaken. -Qed. -Lemma map_to_list_fmap {A B} (f : A → B) m : - map_to_list (f <$> m) ≡ₚ prod_map id f <$> map_to_list m. -Proof. - assert (NoDup ((prod_map id f <$> map_to_list m).*1)). - { erewrite <-list_fmap_compose, (list_fmap_ext _ fst) by done. - apply NoDup_fst_map_to_list. } - rewrite <-(map_of_to_list m) at 1. - by rewrite <-map_of_list_fmap, map_to_of_list. -Qed. - -Lemma map_to_list_empty_inv_alt {A} (m : M A) : map_to_list m ≡ₚ [] → m = ∅. -Proof. rewrite <-map_to_list_empty. apply map_to_list_inj. Qed. -Lemma map_to_list_empty_inv {A} (m : M A) : map_to_list m = [] → m = ∅. -Proof. intros Hm. apply map_to_list_empty_inv_alt. by rewrite Hm. Qed. -Lemma map_to_list_empty' {A} (m : M A) : map_to_list m = [] ↔ m = ∅. -Proof. - split. apply map_to_list_empty_inv. intros ->. apply map_to_list_empty. -Qed. - -Lemma map_to_list_insert_inv {A} (m : M A) l i x : - map_to_list m ≡ₚ (i,x) :: l → m = <[i:=x]>(map_of_list l). -Proof. - intros Hperm. apply map_to_list_inj. - assert (i ∉ l.*1 ∧ NoDup (l.*1)) as []. - { rewrite <-NoDup_cons. change (NoDup (((i,x)::l).*1)). rewrite <-Hperm. - auto using NoDup_fst_map_to_list. } - rewrite Hperm, map_to_list_insert, map_to_of_list; - auto using not_elem_of_map_of_list_1. -Qed. - -Lemma map_choose {A} (m : M A) : m ≠∅ → ∃ i x, m !! i = Some x. -Proof. - intros Hemp. destruct (map_to_list m) as [|[i x] l] eqn:Hm. - { destruct Hemp; eauto using map_to_list_empty_inv. } - exists i, x. rewrite <-elem_of_map_to_list, Hm. by left. -Qed. - -Global Instance map_eq_dec_empty {A} (m : M A) : Decision (m = ∅) | 20. -Proof. - refine (cast_if (decide (elements m = []))); - [apply _|by rewrite <-?map_to_list_empty' ..]. -Defined. - -(** Properties of the imap function *) -Lemma lookup_imap {A B} (f : K → A → option B) m i : - map_imap f m !! i = m !! i ≫= f i. -Proof. - unfold map_imap; destruct (m !! i ≫= f i) as [y|] eqn:Hi; simpl. - - destruct (m !! i) as [x|] eqn:?; simplify_eq/=. - apply elem_of_map_of_list_1'. - { intros y'; rewrite elem_of_list_omap; intros ([i' x']&Hi'&?). - by rewrite elem_of_map_to_list in Hi'; simplify_option_eq. } - apply elem_of_list_omap; exists (i,x); split; - [by apply elem_of_map_to_list|by simplify_option_eq]. - - apply not_elem_of_map_of_list; rewrite elem_of_list_fmap. - intros ([i' x]&->&Hi'); simplify_eq/=. - rewrite elem_of_list_omap in Hi'; destruct Hi' as ([j y]&Hj&?). - rewrite elem_of_map_to_list in Hj; simplify_option_eq. -Qed. - -(** ** Properties of conversion from collections *) -Section map_of_to_collection. - Context {A : Type} `{FinCollection B C}. - - Lemma lookup_map_of_collection (f : B → K * A) Y i x : - (∀ y y', y ∈ Y → y' ∈ Y → (f y).1 = (f y').1 → y = y') → - map_of_collection f Y !! i = Some x ↔ ∃ y, y ∈ Y ∧ f y = (i,x). - Proof. - intros Hinj. assert (∀ x', - (i, x) ∈ f <$> elements Y → (i, x') ∈ f <$> elements Y → x = x'). - { intros x'. intros (y&Hx&?%elem_of_elements)%elem_of_list_fmap. - intros (y'&Hx'&?%elem_of_elements)%elem_of_list_fmap. - cut (y = y'); [congruence|]. apply Hinj; auto. by rewrite <-Hx, <-Hx'. } - unfold map_of_collection; rewrite <-elem_of_map_of_list' by done. - rewrite elem_of_list_fmap. setoid_rewrite elem_of_elements; naive_solver. - Qed. - - Lemma elem_of_map_to_collection (f : K → A → B) (m : M A) (y : B) : - y ∈ map_to_collection f m ↔ ∃ i x, m !! i = Some x ∧ f i x = y. - Proof. - unfold map_to_collection; simpl. - rewrite elem_of_of_list, elem_of_list_fmap. split. - - intros ([i x] & ? & ?%elem_of_map_to_list); eauto. - - intros (i&x&?&?). exists (i,x). by rewrite elem_of_map_to_list. - Qed. - Lemma map_to_collection_empty (f : K → A → B) : map_to_collection f ∅ = ∅. - Proof. unfold map_to_collection; simpl. by rewrite map_to_list_empty. Qed. - Lemma map_to_collection_insert (f : K → A → B)(m : M A) i x : - m !! i = None → - map_to_collection (C:=C) f (<[i:=x]>m) ≡ {[f i x]} ∪ map_to_collection f m. - Proof. - intros. unfold map_to_collection; simpl. by rewrite map_to_list_insert. - Qed. - Lemma map_to_collection_insert_L `{!LeibnizEquiv C} (f : K → A → B) m i x : - m !! i = None → - map_to_collection (C:=C) f (<[i:=x]>m) = {[f i x]} ∪ map_to_collection f m. - Proof. unfold_leibniz. apply map_to_collection_insert. Qed. -End map_of_to_collection. - -Lemma lookup_map_of_collection_id `{FinCollection (K * A) C} (X : C) i x : - (∀ i y y', (i,y) ∈ X → (i,y') ∈ X → y = y') → - map_of_collection id X !! i = Some x ↔ (i,x) ∈ X. -Proof. - intros. etrans; [apply lookup_map_of_collection|naive_solver]. - intros [] [] ???; simplify_eq/=; eauto with f_equal. -Qed. - -Lemma elem_of_map_to_collection_pair `{FinCollection (K * A) C} (m : M A) i x : - (i,x) ∈ map_to_collection pair m ↔ m !! i = Some x. -Proof. rewrite elem_of_map_to_collection. naive_solver. Qed. - -(** ** Induction principles *) -Lemma map_ind {A} (P : M A → Prop) : - P ∅ → (∀ i x m, m !! i = None → P m → P (<[i:=x]>m)) → ∀ m, P m. -Proof. - intros ? Hins. cut (∀ l, NoDup (l.*1) → ∀ m, map_to_list m ≡ₚ l → P m). - { intros help m. - apply (help (map_to_list m)); auto using NoDup_fst_map_to_list. } - induction l as [|[i x] l IH]; intros Hnodup m Hml. - { apply map_to_list_empty_inv_alt in Hml. by subst. } - inversion_clear Hnodup. - apply map_to_list_insert_inv in Hml; subst m. apply Hins. - - by apply not_elem_of_map_of_list_1. - - apply IH; auto using map_to_of_list. -Qed. -Lemma map_to_list_length {A} (m1 m2 : M A) : - m1 ⊂ m2 → length (map_to_list m1) < length (map_to_list m2). -Proof. - revert m2. induction m1 as [|i x m ? IH] using map_ind. - { intros m2 Hm2. rewrite map_to_list_empty. simpl. - apply neq_0_lt. intros Hlen. symmetry in Hlen. - apply nil_length_inv, map_to_list_empty_inv in Hlen. - rewrite Hlen in Hm2. destruct (irreflexivity (⊂) ∅ Hm2). } - intros m2 Hm2. - destruct (insert_subset_inv m m2 i x) as (m2'&?&?&?); auto; subst. - rewrite !map_to_list_insert; simpl; auto with arith. -Qed. -Lemma map_wf {A} : wf (strict (@subseteq (M A) _)). -Proof. - apply (wf_projected (<) (length ∘ map_to_list)). - - by apply map_to_list_length. - - by apply lt_wf. -Qed. - -(** ** The fold operation *) -Lemma map_fold_empty {A B} (f : K → A → B → B) (b : B) : - map_fold f b ∅ = b. -Proof. unfold map_fold; simpl. by rewrite map_to_list_empty. Qed. - -Lemma map_fold_insert {A B} (R : relation B) `{!PreOrder R} - (f : K → A → B → B) (b : B) (i : K) (x : A) (m : M A) : - (∀ j z, Proper (R ==> R) (f j z)) → - (∀ j1 j2 z1 z2 y, R (f j1 z1 (f j2 z2 y)) (f j2 z2 (f j1 z1 y))) → - m !! i = None → - R (map_fold f b (<[i:=x]> m)) (f i x (map_fold f b m)). -Proof. - intros. unfold map_fold; simpl. - assert (∀ kz, Proper (R ==> R) (curry f kz)) by (intros []; apply _). - trans (foldr (curry f) b ((i, x) :: map_to_list m)); [|done]. - eapply (foldr_permutation R (curry f) b), map_to_list_insert; auto. - intros [] []; simpl; eauto. -Qed. - -Lemma map_fold_ind {A B} (P : B → M A → Prop) (f : K → A → B → B) (b : B) : - P b ∅ → - (∀ i x m r, m !! i = None → P r m → P (f i x r) (<[i:=x]> m)) → - ∀ m, P (map_fold f b m) m. -Proof. - intros Hemp Hinsert. - cut (∀ l, NoDup l → - ∀ m, (∀ i x, m !! i = Some x ↔ (i,x) ∈ l) → P (foldr (curry f) b l) m). - { intros help ?. apply help; [apply NoDup_map_to_list|]. - intros i x. by rewrite elem_of_map_to_list. } - induction 1 as [|[i x] l ?? IH]; simpl. - { intros m Hm. cut (m = ∅); [by intros ->|]. apply map_empty; intros i. - apply eq_None_not_Some; intros [x []%Hm%elem_of_nil]. } - intros m Hm. assert (m !! i = Some x) by (apply Hm; by left). - rewrite <-(insert_id m i x), <-insert_delete by done. - apply Hinsert; auto using lookup_delete. - apply IH. intros j y. rewrite lookup_delete_Some, Hm. split. - - by intros [? [[= ??]|?]%elem_of_cons]. - - intros ?; split; [intros ->|by right]. - assert (m !! j = Some y) by (apply Hm; by right). naive_solver. -Qed. - -(** ** Properties of the [map_Forall] predicate *) -Section map_Forall. -Context {A} (P : K → A → Prop). - -Lemma map_Forall_to_list m : map_Forall P m ↔ Forall (curry P) (map_to_list m). -Proof. - rewrite Forall_forall. split. - - intros Hforall [i x]. rewrite elem_of_map_to_list. by apply (Hforall i x). - - intros Hforall i x. rewrite <-elem_of_map_to_list. by apply (Hforall (i,x)). -Qed. -Lemma map_Forall_empty : map_Forall P ∅. -Proof. intros i x. by rewrite lookup_empty. Qed. -Lemma map_Forall_impl (Q : K → A → Prop) m : - map_Forall P m → (∀ i x, P i x → Q i x) → map_Forall Q m. -Proof. unfold map_Forall; naive_solver. Qed. -Lemma map_Forall_insert_11 m i x : map_Forall P (<[i:=x]>m) → P i x. -Proof. intros Hm. by apply Hm; rewrite lookup_insert. Qed. -Lemma map_Forall_insert_12 m i x : - m !! i = None → map_Forall P (<[i:=x]>m) → map_Forall P m. -Proof. - intros ? Hm j y ?; apply Hm. by rewrite lookup_insert_ne by congruence. -Qed. -Lemma map_Forall_insert_2 m i x : - P i x → map_Forall P m → map_Forall P (<[i:=x]>m). -Proof. intros ?? j y; rewrite lookup_insert_Some; naive_solver. Qed. -Lemma map_Forall_insert m i x : - m !! i = None → map_Forall P (<[i:=x]>m) ↔ P i x ∧ map_Forall P m. -Proof. - naive_solver eauto using map_Forall_insert_11, - map_Forall_insert_12, map_Forall_insert_2. -Qed. -Lemma map_Forall_ind (Q : M A → Prop) : - Q ∅ → - (∀ m i x, m !! i = None → P i x → map_Forall P m → Q m → Q (<[i:=x]>m)) → - ∀ m, map_Forall P m → Q m. -Proof. - intros Hnil Hinsert m. induction m using map_ind; auto. - rewrite map_Forall_insert by done; intros [??]; eauto. -Qed. - -Context `{∀ i x, Decision (P i x)}. -Global Instance map_Forall_dec m : Decision (map_Forall P m). -Proof. - refine (cast_if (decide (Forall (curry P) (map_to_list m)))); - by rewrite map_Forall_to_list. -Defined. -Lemma map_not_Forall (m : M A) : - ¬map_Forall P m ↔ ∃ i x, m !! i = Some x ∧ ¬P i x. -Proof. - split; [|intros (i&x&?&?) Hm; specialize (Hm i x); tauto]. - rewrite map_Forall_to_list. intros Hm. - apply (not_Forall_Exists _), Exists_exists in Hm. - destruct Hm as ([i x]&?&?). exists i, x. by rewrite <-elem_of_map_to_list. -Qed. -End map_Forall. - -(** ** Properties of the [merge] operation *) -Section merge. -Context {A} (f : option A → option A → option A) `{!DiagNone f}. -Global Instance: LeftId (=) None f → LeftId (=) ∅ (merge f). -Proof. - intros ??. apply map_eq. intros. - by rewrite !(lookup_merge f), lookup_empty, (left_id_L None f). -Qed. -Global Instance: RightId (=) None f → RightId (=) ∅ (merge f). -Proof. - intros ??. apply map_eq. intros. - by rewrite !(lookup_merge f), lookup_empty, (right_id_L None f). -Qed. -Lemma merge_comm m1 m2 : - (∀ i, f (m1 !! i) (m2 !! i) = f (m2 !! i) (m1 !! i)) → - merge f m1 m2 = merge f m2 m1. -Proof. intros. apply map_eq. intros. by rewrite !(lookup_merge f). Qed. -Global Instance merge_comm' : Comm (=) f → Comm (=) (merge f). -Proof. intros ???. apply merge_comm. intros. by apply (comm f). Qed. -Lemma merge_assoc m1 m2 m3 : - (∀ i, f (m1 !! i) (f (m2 !! i) (m3 !! i)) = - f (f (m1 !! i) (m2 !! i)) (m3 !! i)) → - merge f m1 (merge f m2 m3) = merge f (merge f m1 m2) m3. -Proof. intros. apply map_eq. intros. by rewrite !(lookup_merge f). Qed. -Global Instance merge_assoc' : Assoc (=) f → Assoc (=) (merge f). -Proof. intros ????. apply merge_assoc. intros. by apply (assoc_L f). Qed. -Lemma merge_idemp m1 : - (∀ i, f (m1 !! i) (m1 !! i) = m1 !! i) → merge f m1 m1 = m1. -Proof. intros. apply map_eq. intros. by rewrite !(lookup_merge f). Qed. -Global Instance merge_idemp' : IdemP (=) f → IdemP (=) (merge f). -Proof. intros ??. apply merge_idemp. intros. by apply (idemp f). Qed. -End merge. - -Section more_merge. -Context {A B C} (f : option A → option B → option C) `{!DiagNone f}. - -Lemma merge_Some m1 m2 m : - (∀ i, m !! i = f (m1 !! i) (m2 !! i)) ↔ merge f m1 m2 = m. -Proof. - split; [|intros <-; apply (lookup_merge _) ]. - intros Hlookup. apply map_eq; intros. rewrite Hlookup. apply (lookup_merge _). -Qed. -Lemma merge_empty : merge f ∅ ∅ = ∅. -Proof. apply map_eq. intros. by rewrite !(lookup_merge f), !lookup_empty. Qed. -Lemma partial_alter_merge g g1 g2 m1 m2 i : - g (f (m1 !! i) (m2 !! i)) = f (g1 (m1 !! i)) (g2 (m2 !! i)) → - partial_alter g i (merge f m1 m2) = - merge f (partial_alter g1 i m1) (partial_alter g2 i m2). -Proof. - intro. apply map_eq. intros j. destruct (decide (i = j)); subst. - - by rewrite (lookup_merge _), !lookup_partial_alter, !(lookup_merge _). - - by rewrite (lookup_merge _), !lookup_partial_alter_ne, (lookup_merge _). -Qed. -Lemma partial_alter_merge_l g g1 m1 m2 i : - g (f (m1 !! i) (m2 !! i)) = f (g1 (m1 !! i)) (m2 !! i) → - partial_alter g i (merge f m1 m2) = merge f (partial_alter g1 i m1) m2. -Proof. - intro. apply map_eq. intros j. destruct (decide (i = j)); subst. - - by rewrite (lookup_merge _), !lookup_partial_alter, !(lookup_merge _). - - by rewrite (lookup_merge _), !lookup_partial_alter_ne, (lookup_merge _). -Qed. -Lemma partial_alter_merge_r g g2 m1 m2 i : - g (f (m1 !! i) (m2 !! i)) = f (m1 !! i) (g2 (m2 !! i)) → - partial_alter g i (merge f m1 m2) = merge f m1 (partial_alter g2 i m2). -Proof. - intro. apply map_eq. intros j. destruct (decide (i = j)); subst. - - by rewrite (lookup_merge _), !lookup_partial_alter, !(lookup_merge _). - - by rewrite (lookup_merge _), !lookup_partial_alter_ne, (lookup_merge _). -Qed. -Lemma insert_merge m1 m2 i x y z : - f (Some y) (Some z) = Some x → - <[i:=x]>(merge f m1 m2) = merge f (<[i:=y]>m1) (<[i:=z]>m2). -Proof. by intros; apply partial_alter_merge. Qed. -Lemma merge_singleton i x y z : - f (Some y) (Some z) = Some x → merge f {[i := y]} {[i := z]} = {[i := x]}. -Proof. - intros. by erewrite <-!insert_empty, <-insert_merge, merge_empty by eauto. -Qed. -Lemma insert_merge_l m1 m2 i x y : - f (Some y) (m2 !! i) = Some x → - <[i:=x]>(merge f m1 m2) = merge f (<[i:=y]>m1) m2. -Proof. by intros; apply partial_alter_merge_l. Qed. -Lemma insert_merge_r m1 m2 i x z : - f (m1 !! i) (Some z) = Some x → - <[i:=x]>(merge f m1 m2) = merge f m1 (<[i:=z]>m2). -Proof. by intros; apply partial_alter_merge_r. Qed. -End more_merge. - -(** ** Properties on the [map_relation] relation *) -Section Forall2. -Context {A B} (R : A → B → Prop) (P : A → Prop) (Q : B → Prop). -Context `{∀ x y, Decision (R x y), ∀ x, Decision (P x), ∀ y, Decision (Q y)}. - -Let f (mx : option A) (my : option B) : option bool := - match mx, my with - | Some x, Some y => Some (bool_decide (R x y)) - | Some x, None => Some (bool_decide (P x)) - | None, Some y => Some (bool_decide (Q y)) - | None, None => None - end. -Lemma map_relation_alt (m1 : M A) (m2 : M B) : - map_relation R P Q m1 m2 ↔ map_Forall (λ _, Is_true) (merge f m1 m2). -Proof. - split. - - intros Hm i P'; rewrite lookup_merge by done; intros. - specialize (Hm i). destruct (m1 !! i), (m2 !! i); - simplify_eq/=; auto using bool_decide_pack. - - intros Hm i. specialize (Hm i). rewrite lookup_merge in Hm by done. - destruct (m1 !! i), (m2 !! i); simplify_eq/=; auto; - by eapply bool_decide_unpack, Hm. -Qed. -Global Instance map_relation_dec `{∀ x y, Decision (R x y), ∀ x, Decision (P x), - ∀ y, Decision (Q y)} m1 m2 : Decision (map_relation R P Q m1 m2). -Proof. - refine (cast_if (decide (map_Forall (λ _, Is_true) (merge f m1 m2)))); - abstract by rewrite map_relation_alt. -Defined. -(** Due to the finiteness of finite maps, we can extract a witness if the -relation does not hold. *) -Lemma map_not_Forall2 (m1 : M A) (m2 : M B) : - ¬map_relation R P Q m1 m2 ↔ ∃ i, - (∃ x y, m1 !! i = Some x ∧ m2 !! i = Some y ∧ ¬R x y) - ∨ (∃ x, m1 !! i = Some x ∧ m2 !! i = None ∧ ¬P x) - ∨ (∃ y, m1 !! i = None ∧ m2 !! i = Some y ∧ ¬Q y). -Proof. - split. - - rewrite map_relation_alt, (map_not_Forall _). intros (i&?&Hm&?); exists i. - rewrite lookup_merge in Hm by done. - destruct (m1 !! i), (m2 !! i); naive_solver auto 2 using bool_decide_pack. - - unfold map_relation, option_relation. - by intros [i[(x&y&?&?&?)|[(x&?&?&?)|(y&?&?&?)]]] Hm; - specialize (Hm i); simplify_option_eq. -Qed. -End Forall2. - -(** ** Properties on the disjoint maps *) -Lemma map_disjoint_spec {A} (m1 m2 : M A) : - m1 ⊥ₘ m2 ↔ ∀ i x y, m1 !! i = Some x → m2 !! i = Some y → False. -Proof. - split; intros Hm i; specialize (Hm i); - destruct (m1 !! i), (m2 !! i); naive_solver. -Qed. -Lemma map_disjoint_alt {A} (m1 m2 : M A) : - m1 ⊥ₘ m2 ↔ ∀ i, m1 !! i = None ∨ m2 !! i = None. -Proof. - split; intros Hm1m2 i; specialize (Hm1m2 i); - destruct (m1 !! i), (m2 !! i); naive_solver. -Qed. -Lemma map_not_disjoint {A} (m1 m2 : M A) : - ¬m1 ⊥ₘ m2 ↔ ∃ i x1 x2, m1 !! i = Some x1 ∧ m2 !! i = Some x2. -Proof. - unfold disjoint, map_disjoint. rewrite map_not_Forall2 by solve_decision. - split; [|naive_solver]. - intros [i[(x&y&?&?&?)|[(x&?&?&[])|(y&?&?&[])]]]; naive_solver. -Qed. -Global Instance map_disjoint_sym : Symmetric (map_disjoint : relation (M A)). -Proof. intros A m1 m2. rewrite !map_disjoint_spec. naive_solver. Qed. -Lemma map_disjoint_empty_l {A} (m : M A) : ∅ ⊥ₘ m. -Proof. rewrite !map_disjoint_spec. intros i x y. by rewrite lookup_empty. Qed. -Lemma map_disjoint_empty_r {A} (m : M A) : m ⊥ₘ ∅. -Proof. rewrite !map_disjoint_spec. intros i x y. by rewrite lookup_empty. Qed. -Lemma map_disjoint_weaken {A} (m1 m1' m2 m2' : M A) : - m1' ⊥ₘ m2' → m1 ⊆ m1' → m2 ⊆ m2' → m1 ⊥ₘ m2. -Proof. rewrite !map_subseteq_spec, !map_disjoint_spec. eauto. Qed. -Lemma map_disjoint_weaken_l {A} (m1 m1' m2 : M A) : - m1' ⊥ₘ m2 → m1 ⊆ m1' → m1 ⊥ₘ m2. -Proof. eauto using map_disjoint_weaken. Qed. -Lemma map_disjoint_weaken_r {A} (m1 m2 m2' : M A) : - m1 ⊥ₘ m2' → m2 ⊆ m2' → m1 ⊥ₘ m2. -Proof. eauto using map_disjoint_weaken. Qed. -Lemma map_disjoint_Some_l {A} (m1 m2 : M A) i x: - m1 ⊥ₘ m2 → m1 !! i = Some x → m2 !! i = None. -Proof. rewrite map_disjoint_spec, eq_None_not_Some. intros ?? [??]; eauto. Qed. -Lemma map_disjoint_Some_r {A} (m1 m2 : M A) i x: - m1 ⊥ₘ m2 → m2 !! i = Some x → m1 !! i = None. -Proof. rewrite (symmetry_iff map_disjoint). apply map_disjoint_Some_l. Qed. -Lemma map_disjoint_singleton_l {A} (m: M A) i x : {[i:=x]} ⊥ₘ m ↔ m !! i = None. -Proof. - split; [|rewrite !map_disjoint_spec]. - - intro. apply (map_disjoint_Some_l {[i := x]} _ _ x); - auto using lookup_singleton. - - intros ? j y1 y2. destruct (decide (i = j)) as [->|]. - + rewrite lookup_singleton. intuition congruence. - + by rewrite lookup_singleton_ne. -Qed. -Lemma map_disjoint_singleton_r {A} (m : M A) i x : - m ⊥ₘ {[i := x]} ↔ m !! i = None. -Proof. by rewrite (symmetry_iff map_disjoint), map_disjoint_singleton_l. Qed. -Lemma map_disjoint_singleton_l_2 {A} (m : M A) i x : - m !! i = None → {[i := x]} ⊥ₘ m. -Proof. by rewrite map_disjoint_singleton_l. Qed. -Lemma map_disjoint_singleton_r_2 {A} (m : M A) i x : - m !! i = None → m ⊥ₘ {[i := x]}. -Proof. by rewrite map_disjoint_singleton_r. Qed. -Lemma map_disjoint_delete_l {A} (m1 m2 : M A) i : m1 ⊥ₘ m2 → delete i m1 ⊥ₘ m2. -Proof. - rewrite !map_disjoint_alt. intros Hdisjoint j. destruct (Hdisjoint j); auto. - rewrite lookup_delete_None. tauto. -Qed. -Lemma map_disjoint_delete_r {A} (m1 m2 : M A) i : m1 ⊥ₘ m2 → m1 ⊥ₘ delete i m2. -Proof. symmetry. by apply map_disjoint_delete_l. Qed. - -(** ** Properties of the [union_with] operation *) -Section union_with. -Context {A} (f : A → A → option A). - -Lemma lookup_union_with m1 m2 i : - union_with f m1 m2 !! i = union_with f (m1 !! i) (m2 !! i). -Proof. by rewrite <-(lookup_merge _). Qed. -Lemma lookup_union_with_Some m1 m2 i z : - union_with f m1 m2 !! i = Some z ↔ - (m1 !! i = Some z ∧ m2 !! i = None) ∨ - (m1 !! i = None ∧ m2 !! i = Some z) ∨ - (∃ x y, m1 !! i = Some x ∧ m2 !! i = Some y ∧ f x y = Some z). -Proof. - rewrite lookup_union_with. - destruct (m1 !! i), (m2 !! i); compute; naive_solver. -Qed. -Global Instance: LeftId (@eq (M A)) ∅ (union_with f). -Proof. unfold union_with, map_union_with. apply _. Qed. -Global Instance: RightId (@eq (M A)) ∅ (union_with f). -Proof. unfold union_with, map_union_with. apply _. Qed. -Lemma union_with_comm m1 m2 : - (∀ i x y, m1 !! i = Some x → m2 !! i = Some y → f x y = f y x) → - union_with f m1 m2 = union_with f m2 m1. -Proof. - intros. apply (merge_comm _). intros i. - destruct (m1 !! i) eqn:?, (m2 !! i) eqn:?; simpl; eauto. -Qed. -Global Instance: Comm (=) f → Comm (@eq (M A)) (union_with f). -Proof. intros ???. apply union_with_comm. eauto. Qed. -Lemma union_with_idemp m : - (∀ i x, m !! i = Some x → f x x = Some x) → union_with f m m = m. -Proof. - intros. apply (merge_idemp _). intros i. - destruct (m !! i) eqn:?; simpl; eauto. -Qed. -Lemma alter_union_with (g : A → A) m1 m2 i : - (∀ x y, m1 !! i = Some x → m2 !! i = Some y → g <$> f x y = f (g x) (g y)) → - alter g i (union_with f m1 m2) = - union_with f (alter g i m1) (alter g i m2). -Proof. - intros. apply (partial_alter_merge _). - destruct (m1 !! i) eqn:?, (m2 !! i) eqn:?; simpl; eauto. -Qed. -Lemma alter_union_with_l (g : A → A) m1 m2 i : - (∀ x y, m1 !! i = Some x → m2 !! i = Some y → g <$> f x y = f (g x) y) → - (∀ y, m1 !! i = None → m2 !! i = Some y → g y = y) → - alter g i (union_with f m1 m2) = union_with f (alter g i m1) m2. -Proof. - intros. apply (partial_alter_merge_l _). - destruct (m1 !! i) eqn:?, (m2 !! i) eqn:?; f_equal/=; auto. -Qed. -Lemma alter_union_with_r (g : A → A) m1 m2 i : - (∀ x y, m1 !! i = Some x → m2 !! i = Some y → g <$> f x y = f x (g y)) → - (∀ x, m1 !! i = Some x → m2 !! i = None → g x = x) → - alter g i (union_with f m1 m2) = union_with f m1 (alter g i m2). -Proof. - intros. apply (partial_alter_merge_r _). - destruct (m1 !! i) eqn:?, (m2 !! i) eqn:?; f_equal/=; auto. -Qed. -Lemma delete_union_with m1 m2 i : - delete i (union_with f m1 m2) = union_with f (delete i m1) (delete i m2). -Proof. by apply (partial_alter_merge _). Qed. -Lemma foldr_delete_union_with (m1 m2 : M A) is : - foldr delete (union_with f m1 m2) is = - union_with f (foldr delete m1 is) (foldr delete m2 is). -Proof. induction is; simpl. done. by rewrite IHis, delete_union_with. Qed. -Lemma insert_union_with m1 m2 i x y z : - f x y = Some z → - <[i:=z]>(union_with f m1 m2) = union_with f (<[i:=x]>m1) (<[i:=y]>m2). -Proof. by intros; apply (partial_alter_merge _). Qed. -Lemma insert_union_with_l m1 m2 i x : - m2 !! i = None → <[i:=x]>(union_with f m1 m2) = union_with f (<[i:=x]>m1) m2. -Proof. - intros Hm2. unfold union_with, map_union_with. - by erewrite (insert_merge_l _) by (by rewrite Hm2). -Qed. -Lemma insert_union_with_r m1 m2 i x : - m1 !! i = None → <[i:=x]>(union_with f m1 m2) = union_with f m1 (<[i:=x]>m2). -Proof. - intros Hm1. unfold union_with, map_union_with. - by erewrite (insert_merge_r _) by (by rewrite Hm1). -Qed. -End union_with. - -(** ** Properties of the [union] operation *) -Global Instance: LeftId (@eq (M A)) ∅ (∪) := _. -Global Instance: RightId (@eq (M A)) ∅ (∪) := _. -Global Instance: Assoc (@eq (M A)) (∪). -Proof. - intros A m1 m2 m3. unfold union, map_union, union_with, map_union_with. - apply (merge_assoc _). intros i. - by destruct (m1 !! i), (m2 !! i), (m3 !! i). -Qed. -Global Instance: IdemP (@eq (M A)) (∪). -Proof. intros A ?. by apply union_with_idemp. Qed. -Lemma lookup_union_Some_raw {A} (m1 m2 : M A) i x : - (m1 ∪ m2) !! i = Some x ↔ - m1 !! i = Some x ∨ (m1 !! i = None ∧ m2 !! i = Some x). -Proof. - unfold union, map_union, union_with, map_union_with. rewrite (lookup_merge _). - destruct (m1 !! i), (m2 !! i); compute; intuition congruence. -Qed. -Lemma lookup_union_None {A} (m1 m2 : M A) i : - (m1 ∪ m2) !! i = None ↔ m1 !! i = None ∧ m2 !! i = None. -Proof. - unfold union, map_union, union_with, map_union_with. rewrite (lookup_merge _). - destruct (m1 !! i), (m2 !! i); compute; intuition congruence. -Qed. -Lemma map_positive_l {A} (m1 m2 : M A) : m1 ∪ m2 = ∅ → m1 = ∅. -Proof. - intros Hm. apply map_empty. intros i. apply (f_equal (!! i)) in Hm. - rewrite lookup_empty, lookup_union_None in Hm; tauto. -Qed. -Lemma map_positive_l_alt {A} (m1 m2 : M A) : m1 ≠∅ → m1 ∪ m2 ≠∅. -Proof. eauto using map_positive_l. Qed. -Lemma lookup_union_Some {A} (m1 m2 : M A) i x : - m1 ⊥ₘ m2 → (m1 ∪ m2) !! i = Some x ↔ m1 !! i = Some x ∨ m2 !! i = Some x. -Proof. - intros Hdisjoint. rewrite lookup_union_Some_raw. - intuition eauto using map_disjoint_Some_r. -Qed. -Lemma lookup_union_Some_l {A} (m1 m2 : M A) i x : - m1 !! i = Some x → (m1 ∪ m2) !! i = Some x. -Proof. intro. rewrite lookup_union_Some_raw; intuition. Qed. -Lemma lookup_union_Some_r {A} (m1 m2 : M A) i x : - m1 ⊥ₘ m2 → m2 !! i = Some x → (m1 ∪ m2) !! i = Some x. -Proof. intro. rewrite lookup_union_Some; intuition. Qed. -Lemma map_union_comm {A} (m1 m2 : M A) : m1 ⊥ₘ m2 → m1 ∪ m2 = m2 ∪ m1. -Proof. - intros Hdisjoint. apply (merge_comm (union_with (λ x _, Some x))). - intros i. specialize (Hdisjoint i). - destruct (m1 !! i), (m2 !! i); compute; naive_solver. -Qed. -Lemma map_subseteq_union {A} (m1 m2 : M A) : m1 ⊆ m2 → m1 ∪ m2 = m2. -Proof. - rewrite map_subseteq_spec. - intros Hm1m2. apply map_eq. intros i. apply option_eq. intros x. - rewrite lookup_union_Some_raw. split; [by intuition |]. - intros Hm2. specialize (Hm1m2 i). destruct (m1 !! i) as [y|]; [| by auto]. - rewrite (Hm1m2 y eq_refl) in Hm2. intuition congruence. -Qed. -Lemma map_union_subseteq_l {A} (m1 m2 : M A) : m1 ⊆ m1 ∪ m2. -Proof. - rewrite map_subseteq_spec. intros ? i x. rewrite lookup_union_Some_raw. tauto. -Qed. -Lemma map_union_subseteq_r {A} (m1 m2 : M A) : m1 ⊥ₘ m2 → m2 ⊆ m1 ∪ m2. -Proof. - intros. rewrite map_union_comm by done. by apply map_union_subseteq_l. -Qed. -Lemma map_union_subseteq_l_alt {A} (m1 m2 m3 : M A) : m1 ⊆ m2 → m1 ⊆ m2 ∪ m3. -Proof. intros. trans m2; auto using map_union_subseteq_l. Qed. -Lemma map_union_subseteq_r_alt {A} (m1 m2 m3 : M A) : - m2 ⊥ₘ m3 → m1 ⊆ m3 → m1 ⊆ m2 ∪ m3. -Proof. intros. trans m3; auto using map_union_subseteq_r. Qed. -Lemma map_union_preserving_l {A} (m1 m2 m3 : M A) : m1 ⊆ m2 → m3 ∪ m1 ⊆ m3 ∪ m2. -Proof. - rewrite !map_subseteq_spec. intros ???. - rewrite !lookup_union_Some_raw. naive_solver. -Qed. -Lemma map_union_preserving_r {A} (m1 m2 m3 : M A) : - m2 ⊥ₘ m3 → m1 ⊆ m2 → m1 ∪ m3 ⊆ m2 ∪ m3. -Proof. - intros. rewrite !(map_union_comm _ m3) - by eauto using map_disjoint_weaken_l. - by apply map_union_preserving_l. -Qed. -Lemma map_union_reflecting_l {A} (m1 m2 m3 : M A) : - m3 ⊥ₘ m1 → m3 ⊥ₘ m2 → m3 ∪ m1 ⊆ m3 ∪ m2 → m1 ⊆ m2. -Proof. - rewrite !map_subseteq_spec. intros Hm31 Hm32 Hm i x ?. specialize (Hm i x). - rewrite !lookup_union_Some in Hm by done. destruct Hm; auto. - by rewrite map_disjoint_spec in Hm31; destruct (Hm31 i x x). -Qed. -Lemma map_union_reflecting_r {A} (m1 m2 m3 : M A) : - m1 ⊥ₘ m3 → m2 ⊥ₘ m3 → m1 ∪ m3 ⊆ m2 ∪ m3 → m1 ⊆ m2. -Proof. - intros ??. rewrite !(map_union_comm _ m3) by done. - by apply map_union_reflecting_l. -Qed. -Lemma map_union_cancel_l {A} (m1 m2 m3 : M A) : - m1 ⊥ₘ m3 → m2 ⊥ₘ m3 → m3 ∪ m1 = m3 ∪ m2 → m1 = m2. -Proof. - intros. apply (anti_symm (⊆)); apply map_union_reflecting_l with m3; - auto using (reflexive_eq (R:=@subseteq (M A) _)). -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_symm (⊆)); apply map_union_reflecting_r with m3; - auto using (reflexive_eq (R:=@subseteq (M A) _)). -Qed. -Lemma map_disjoint_union_l {A} (m1 m2 m3 : M A) : - m1 ∪ m2 ⊥ₘ m3 ↔ m1 ⊥ₘ m3 ∧ m2 ⊥ₘ m3. -Proof. - rewrite !map_disjoint_alt. setoid_rewrite lookup_union_None. naive_solver. -Qed. -Lemma map_disjoint_union_r {A} (m1 m2 m3 : M A) : - m1 ⊥ₘ m2 ∪ m3 ↔ m1 ⊥ₘ m2 ∧ m1 ⊥ₘ m3. -Proof. - rewrite !map_disjoint_alt. setoid_rewrite lookup_union_None. naive_solver. -Qed. -Lemma map_disjoint_union_l_2 {A} (m1 m2 m3 : M A) : - m1 ⊥ₘ m3 → m2 ⊥ₘ m3 → m1 ∪ m2 ⊥ₘ m3. -Proof. by rewrite map_disjoint_union_l. Qed. -Lemma map_disjoint_union_r_2 {A} (m1 m2 m3 : M A) : - m1 ⊥ₘ m2 → m1 ⊥ₘ m3 → m1 ⊥ₘ m2 ∪ m3. -Proof. by rewrite map_disjoint_union_r. Qed. -Lemma insert_union_singleton_l {A} (m : M A) i x : <[i:=x]>m = {[i := x]} ∪ m. -Proof. - apply map_eq. intros j. apply option_eq. intros y. - rewrite lookup_union_Some_raw. - destruct (decide (i = j)); subst. - - rewrite !lookup_singleton, lookup_insert. intuition congruence. - - rewrite !lookup_singleton_ne, lookup_insert_ne; intuition congruence. -Qed. -Lemma insert_union_singleton_r {A} (m : M A) i x : - m !! i = None → <[i:=x]>m = m ∪ {[i := x]}. -Proof. - intro. rewrite insert_union_singleton_l, map_union_comm; [done |]. - by apply map_disjoint_singleton_l. -Qed. -Lemma map_disjoint_insert_l {A} (m1 m2 : M A) i x : - <[i:=x]>m1 ⊥ₘ m2 ↔ m2 !! i = None ∧ m1 ⊥ₘ m2. -Proof. - rewrite insert_union_singleton_l. - by rewrite map_disjoint_union_l, map_disjoint_singleton_l. -Qed. -Lemma map_disjoint_insert_r {A} (m1 m2 : M A) i x : - m1 ⊥ₘ <[i:=x]>m2 ↔ m1 !! i = None ∧ m1 ⊥ₘ m2. -Proof. - rewrite insert_union_singleton_l. - by rewrite map_disjoint_union_r, map_disjoint_singleton_r. -Qed. -Lemma map_disjoint_insert_l_2 {A} (m1 m2 : M A) i x : - m2 !! i = None → m1 ⊥ₘ m2 → <[i:=x]>m1 ⊥ₘ m2. -Proof. by rewrite map_disjoint_insert_l. Qed. -Lemma map_disjoint_insert_r_2 {A} (m1 m2 : M A) i x : - m1 !! i = None → m1 ⊥ₘ m2 → m1 ⊥ₘ <[i:=x]>m2. -Proof. by rewrite map_disjoint_insert_r. Qed. -Lemma insert_union_l {A} (m1 m2 : M A) i x : - <[i:=x]>(m1 ∪ m2) = <[i:=x]>m1 ∪ m2. -Proof. by rewrite !insert_union_singleton_l, (assoc_L (∪)). Qed. -Lemma insert_union_r {A} (m1 m2 : M A) i x : - m1 !! i = None → <[i:=x]>(m1 ∪ m2) = m1 ∪ <[i:=x]>m2. -Proof. - intro. rewrite !insert_union_singleton_l, !(assoc_L (∪)). - rewrite (map_union_comm m1); [done |]. - by apply map_disjoint_singleton_r. -Qed. -Lemma foldr_insert_union {A} (m : M A) l : - foldr (λ p, <[p.1:=p.2]>) m l = map_of_list l ∪ m. -Proof. - induction l as [|i l IH]; simpl; [by rewrite (left_id_L _ _)|]. - by rewrite IH, insert_union_l. -Qed. -Lemma delete_union {A} (m1 m2 : M A) i : - delete i (m1 ∪ m2) = delete i m1 ∪ delete i m2. -Proof. apply delete_union_with. Qed. - -(** ** Properties of the [union_list] operation *) -Lemma map_disjoint_union_list_l {A} (ms : list (M A)) (m : M A) : - ⋃ ms ⊥ₘ m ↔ Forall (.⊥ₘ m) ms. -Proof. - split. - - induction ms; simpl; rewrite ?map_disjoint_union_l; intuition. - - induction 1; simpl; [apply map_disjoint_empty_l |]. - by rewrite map_disjoint_union_l. -Qed. -Lemma map_disjoint_union_list_r {A} (ms : list (M A)) (m : M A) : - m ⊥ₘ ⋃ ms ↔ Forall (.⊥ₘ m) ms. -Proof. by rewrite (symmetry_iff map_disjoint), map_disjoint_union_list_l. Qed. -Lemma map_disjoint_union_list_l_2 {A} (ms : list (M A)) (m : M A) : - Forall (.⊥ₘ m) ms → ⋃ ms ⊥ₘ m. -Proof. by rewrite map_disjoint_union_list_l. Qed. -Lemma map_disjoint_union_list_r_2 {A} (ms : list (M A)) (m : M A) : - Forall (.⊥ₘ m) ms → m ⊥ₘ ⋃ ms. -Proof. by rewrite map_disjoint_union_list_r. Qed. - -(** ** Properties of the folding the [delete] function *) -Lemma lookup_foldr_delete {A} (m : M A) is j : - j ∈ is → foldr delete m is !! j = None. -Proof. - induction 1 as [|i j is]; simpl; [by rewrite lookup_delete|]. - by destruct (decide (i = j)) as [->|?]; - rewrite ?lookup_delete, ?lookup_delete_ne by done. -Qed. -Lemma lookup_foldr_delete_not_elem_of {A} (m : M A) is j : - j ∉ is → foldr delete m is !! j = m !! j. -Proof. - induction is; simpl; [done |]. rewrite elem_of_cons; intros. - rewrite lookup_delete_ne; intuition. -Qed. -Lemma foldr_delete_notin {A} (m : M A) is : - Forall (λ i, m !! i = None) is → foldr delete m is = m. -Proof. induction 1; simpl; [done |]. rewrite delete_notin; congruence. Qed. -Lemma foldr_delete_insert_ne {A} (m : M A) is j x : - j ∉ is → foldr delete (<[j:=x]>m) is = <[j:=x]>(foldr delete m is). -Proof. - induction is; simpl; [done |]. rewrite elem_of_cons. intros. - rewrite IHis, delete_insert_ne; intuition. -Qed. -Lemma map_disjoint_foldr_delete_l {A} (m1 m2 : M A) is : - m1 ⊥ₘ m2 → foldr delete m1 is ⊥ₘ m2. -Proof. induction is; simpl; auto using map_disjoint_delete_l. Qed. -Lemma map_disjoint_foldr_delete_r {A} (m1 m2 : M A) is : - m1 ⊥ₘ m2 → m1 ⊥ₘ foldr delete m2 is. -Proof. induction is; simpl; auto using map_disjoint_delete_r. Qed. -Lemma foldr_delete_union {A} (m1 m2 : M A) is : - foldr delete (m1 ∪ m2) is = foldr delete m1 is ∪ foldr delete m2 is. -Proof. apply foldr_delete_union_with. Qed. - -(** ** Properties on disjointness of conversion to lists *) -Lemma map_disjoint_of_list_l {A} (m : M A) ixs : - map_of_list ixs ⊥ₘ m ↔ Forall (λ ix, m !! ix.1 = None) ixs. -Proof. - split. - - induction ixs; simpl; rewrite ?map_disjoint_insert_l in *; intuition. - - induction 1; simpl; [apply map_disjoint_empty_l|]. - rewrite map_disjoint_insert_l. auto. -Qed. -Lemma map_disjoint_of_list_r {A} (m : M A) ixs : - m ⊥ₘ map_of_list ixs ↔ Forall (λ ix, m !! ix.1 = None) ixs. -Proof. by rewrite (symmetry_iff map_disjoint), map_disjoint_of_list_l. Qed. -Lemma map_disjoint_of_list_zip_l {A} (m : M A) is xs : - length is = length xs → - map_of_list (zip is xs) ⊥ₘ m ↔ Forall (λ i, m !! i = None) is. -Proof. - intro. rewrite map_disjoint_of_list_l. - rewrite <-(fst_zip is xs) at 2 by lia. by rewrite Forall_fmap. -Qed. -Lemma map_disjoint_of_list_zip_r {A} (m : M A) is xs : - length is = length xs → - m ⊥ₘ map_of_list (zip is xs) ↔ Forall (λ i, m !! i = None) is. -Proof. - intro. by rewrite (symmetry_iff map_disjoint), map_disjoint_of_list_zip_l. -Qed. -Lemma map_disjoint_of_list_zip_l_2 {A} (m : M A) is xs : - length is = length xs → Forall (λ i, m !! i = None) is → - map_of_list (zip is xs) ⊥ₘ m. -Proof. intro. by rewrite map_disjoint_of_list_zip_l. Qed. -Lemma map_disjoint_of_list_zip_r_2 {A} (m : M A) is xs : - length is = length xs → Forall (λ i, m !! i = None) is → - m ⊥ₘ map_of_list (zip is xs). -Proof. intro. by rewrite map_disjoint_of_list_zip_r. Qed. - -(** ** Properties of the [intersection_with] operation *) -Lemma lookup_intersection_with {A} (f : A → A → option A) m1 m2 i : - intersection_with f m1 m2 !! i = intersection_with f (m1 !! i) (m2 !! i). -Proof. by rewrite <-(lookup_merge _). Qed. -Lemma lookup_intersection_with_Some {A} (f : A → A → option A) m1 m2 i z : - intersection_with f m1 m2 !! i = Some z ↔ - (∃ x y, m1 !! i = Some x ∧ m2 !! i = Some y ∧ f x y = Some z). -Proof. - rewrite lookup_intersection_with. - destruct (m1 !! i), (m2 !! i); compute; naive_solver. -Qed. - -(** ** Properties of the [intersection] operation *) -Lemma lookup_intersection_Some {A} (m1 m2 : M A) i x : - (m1 ∩ m2) !! i = Some x ↔ m1 !! i = Some x ∧ is_Some (m2 !! i). -Proof. - unfold intersection, map_intersection. rewrite lookup_intersection_with. - destruct (m1 !! i), (m2 !! i); compute; naive_solver. -Qed. -Lemma lookup_intersection_None {A} (m1 m2 : M A) i : - (m1 ∩ m2) !! i = None ↔ m1 !! i = None ∨ m2 !! i = None. -Proof. - unfold intersection, map_intersection. rewrite lookup_intersection_with. - destruct (m1 !! i), (m2 !! i); compute; naive_solver. -Qed. - -(** ** Properties of the [difference_with] operation *) -Lemma lookup_difference_with {A} (f : A → A → option A) m1 m2 i : - difference_with f m1 m2 !! i = difference_with f (m1 !! i) (m2 !! i). -Proof. by rewrite <-lookup_merge by done. Qed. -Lemma lookup_difference_with_Some {A} (f : A → A → option A) m1 m2 i z : - difference_with f m1 m2 !! i = Some z ↔ - (m1 !! i = Some z ∧ m2 !! i = None) ∨ - (∃ x y, m1 !! i = Some x ∧ m2 !! i = Some y ∧ f x y = Some z). -Proof. - rewrite lookup_difference_with. - destruct (m1 !! i), (m2 !! i); compute; naive_solver. -Qed. - -(** ** Properties of the [difference] operation *) -Lemma lookup_difference_Some {A} (m1 m2 : M A) i x : - (m1 ∖ m2) !! i = Some x ↔ m1 !! i = Some x ∧ m2 !! i = None. -Proof. - unfold difference, map_difference; rewrite lookup_difference_with. - destruct (m1 !! i), (m2 !! i); compute; intuition congruence. -Qed. -Lemma lookup_difference_None {A} (m1 m2 : M A) i : - (m1 ∖ m2) !! i = None ↔ m1 !! i = None ∨ is_Some (m2 !! i). -Proof. - unfold difference, map_difference; rewrite lookup_difference_with. - destruct (m1 !! i), (m2 !! i); compute; naive_solver. -Qed. -Lemma map_disjoint_difference_l {A} (m1 m2 : M A) : m1 ⊆ m2 → m2 ∖ m1 ⊥ₘ m1. -Proof. - intros Hm i; specialize (Hm i). - unfold difference, map_difference; rewrite lookup_difference_with. - by destruct (m1 !! i), (m2 !! i). -Qed. -Lemma map_disjoint_difference_r {A} (m1 m2 : M A) : m1 ⊆ m2 → m1 ⊥ₘ m2 ∖ m1. -Proof. intros. symmetry. by apply map_disjoint_difference_l. Qed. -Lemma map_difference_union {A} (m1 m2 : M A) : - m1 ⊆ m2 → m1 ∪ m2 ∖ m1 = m2. -Proof. - rewrite map_subseteq_spec. intro Hm1m2. apply map_eq. intros i. - apply option_eq. intros v. specialize (Hm1m2 i). - unfold difference, map_difference, difference_with, map_difference_with. - rewrite lookup_union_Some_raw, (lookup_merge _). - destruct (m1 !! i) as [x'|], (m2 !! i); - try specialize (Hm1m2 x'); compute; intuition congruence. -Qed. -End theorems. - -(** * Tactics *) -(** The tactic [decompose_map_disjoint] simplifies occurrences of [disjoint] -in the hypotheses that involve the empty map [∅], the union [(∪)] or insert -[<[_:=_]>] operation, the singleton [{[_:= _]}] map, and disjointness of lists of -maps. This tactic does not yield any information loss as all simplifications -performed are reversible. *) -Ltac decompose_map_disjoint := repeat - match goal with - | H : _ ∪ _ ⊥ₘ _ |- _ => apply map_disjoint_union_l in H; destruct H - | H : _ ⊥ₘ _ ∪ _ |- _ => apply map_disjoint_union_r in H; destruct H - | H : {[ _ := _ ]} ⊥ₘ _ |- _ => apply map_disjoint_singleton_l in H - | H : _ ⊥ₘ {[ _ := _ ]} |- _ => apply map_disjoint_singleton_r in H - | H : <[_:=_]>_ ⊥ₘ _ |- _ => apply map_disjoint_insert_l in H; destruct H - | H : _ ⊥ₘ <[_:=_]>_ |- _ => apply map_disjoint_insert_r in H; destruct H - | H : ⋃ _ ⊥ₘ _ |- _ => apply map_disjoint_union_list_l in H - | H : _ ⊥ₘ ⋃ _ |- _ => apply map_disjoint_union_list_r in H - | H : ∅ ⊥ₘ _ |- _ => clear H - | H : _ ⊥ₘ ∅ |- _ => clear H - | H : Forall (.⊥ₘ _) _ |- _ => rewrite Forall_vlookup in H - | H : Forall (.⊥ₘ _) [] |- _ => clear H - | H : Forall (.⊥ₘ _) (_ :: _) |- _ => rewrite Forall_cons in H; destruct H - | H : Forall (.⊥ₘ _) (_ :: _) |- _ => rewrite Forall_app in H; destruct H - end. - -(** To prove a disjointness property, we first decompose all hypotheses, and -then use an auto database to prove the required property. *) -Create HintDb map_disjoint. -Ltac solve_map_disjoint := - solve [decompose_map_disjoint; auto with map_disjoint]. - -(** We declare these hints using [Hint Extern] instead of [Hint Resolve] as -[eauto] works badly with hints parametrized by type class constraints. *) -Hint Extern 1 (_ ⊥ₘ _) => done : map_disjoint. -Hint Extern 2 (∅ ⊥ₘ _) => apply map_disjoint_empty_l : map_disjoint. -Hint Extern 2 (_ ⊥ₘ ∅) => apply map_disjoint_empty_r : map_disjoint. -Hint Extern 2 ({[ _ := _ ]} ⊥ₘ _) => - apply map_disjoint_singleton_l_2 : map_disjoint. -Hint Extern 2 (_ ⊥ₘ {[ _ := _ ]}) => - apply map_disjoint_singleton_r_2 : map_disjoint. -Hint Extern 2 (_ ∪ _ ⊥ₘ _) => apply map_disjoint_union_l_2 : map_disjoint. -Hint Extern 2 (_ ⊥ₘ _ ∪ _) => apply map_disjoint_union_r_2 : map_disjoint. -Hint Extern 2 (<[_:=_]>_ ⊥ₘ _) => apply map_disjoint_insert_l_2 : map_disjoint. -Hint Extern 2 (_ ⊥ₘ <[_:=_]>_) => apply map_disjoint_insert_r_2 : map_disjoint. -Hint Extern 2 (delete _ _ ⊥ₘ _) => apply map_disjoint_delete_l : map_disjoint. -Hint Extern 2 (_ ⊥ₘ delete _ _) => apply map_disjoint_delete_r : map_disjoint. -Hint Extern 2 (map_of_list _ ⊥ₘ _) => - apply map_disjoint_of_list_zip_l_2 : mem_disjoint. -Hint Extern 2 (_ ⊥ₘ map_of_list _) => - apply map_disjoint_of_list_zip_r_2 : mem_disjoint. -Hint Extern 2 (⋃ _ ⊥ₘ _) => apply map_disjoint_union_list_l_2 : mem_disjoint. -Hint Extern 2 (_ ⊥ₘ ⋃ _) => apply map_disjoint_union_list_r_2 : mem_disjoint. -Hint Extern 2 (foldr delete _ _ ⊥ₘ _) => - apply map_disjoint_foldr_delete_l : map_disjoint. -Hint Extern 2 (_ ⊥ₘ foldr delete _ _) => - apply map_disjoint_foldr_delete_r : map_disjoint. - -(** The tactic [simpl_map by tac] simplifies occurrences of finite map look -ups. It uses [tac] to discharge generated inequalities. Look ups in unions do -not have nice equational properties, hence it invokes [tac] to prove that such -look ups yield [Some]. *) -Tactic Notation "simpl_map" "by" tactic3(tac) := repeat - match goal with - | H : context[ ∅ !! _ ] |- _ => rewrite lookup_empty in H - | H : context[ (<[_:=_]>_) !! _ ] |- _ => - rewrite lookup_insert in H || rewrite lookup_insert_ne in H by tac - | H : context[ (alter _ _ _) !! _] |- _ => - rewrite lookup_alter in H || rewrite lookup_alter_ne in H by tac - | H : context[ (delete _ _) !! _] |- _ => - rewrite lookup_delete in H || rewrite lookup_delete_ne in H by tac - | H : context[ {[ _ := _ ]} !! _ ] |- _ => - rewrite lookup_singleton in H || rewrite lookup_singleton_ne in H by tac - | H : context[ (_ <$> _) !! _ ] |- _ => rewrite lookup_fmap in H - | H : context[ (omap _ _) !! _ ] |- _ => rewrite lookup_omap in H - | H : context[ lookup (A:=?A) ?i (?m1 ∪ ?m2) ] |- _ => - let x := fresh in evar (x:A); - let x' := eval unfold x in x in clear x; - let E := fresh in - assert ((m1 ∪ m2) !! i = Some x') as E by (clear H; by tac); - rewrite E in H; clear E - | |- context[ ∅ !! _ ] => rewrite lookup_empty - | |- context[ (<[_:=_]>_) !! _ ] => - rewrite lookup_insert || rewrite lookup_insert_ne by tac - | |- context[ (alter _ _ _) !! _ ] => - rewrite lookup_alter || rewrite lookup_alter_ne by tac - | |- context[ (delete _ _) !! _ ] => - rewrite lookup_delete || rewrite lookup_delete_ne by tac - | |- context[ {[ _ := _ ]} !! _ ] => - rewrite lookup_singleton || rewrite lookup_singleton_ne by tac - | |- context[ (_ <$> _) !! _ ] => rewrite lookup_fmap - | |- context[ (omap _ _) !! _ ] => rewrite lookup_omap - | |- context [ lookup (A:=?A) ?i ?m ] => - let x := fresh in evar (x:A); - let x' := eval unfold x in x in clear x; - let E := fresh in - assert (m !! i = Some x') as E by tac; - rewrite E; clear E - end. - -Create HintDb simpl_map. -Tactic Notation "simpl_map" := simpl_map by eauto with simpl_map map_disjoint. - -Hint Extern 80 ((_ ∪ _) !! _ = Some _) => apply lookup_union_Some_l : simpl_map. -Hint Extern 81 ((_ ∪ _) !! _ = Some _) => apply lookup_union_Some_r : simpl_map. -Hint Extern 80 ({[ _:=_ ]} !! _ = Some _) => apply lookup_singleton : simpl_map. -Hint Extern 80 (<[_:=_]> _ !! _ = Some _) => apply lookup_insert : simpl_map. - -(** Now we take everything together and also discharge conflicting look ups, -simplify overlapping look ups, and perform cancellations of equalities -involving unions. *) -Tactic Notation "simplify_map_eq" "by" tactic3(tac) := - decompose_map_disjoint; - repeat match goal with - | _ => progress simpl_map by tac - | _ => progress simplify_eq/= - | _ => progress simpl_option by tac - | H : {[ _ := _ ]} !! _ = None |- _ => rewrite lookup_singleton_None in H - | H : {[ _ := _ ]} !! _ = Some _ |- _ => - rewrite lookup_singleton_Some in H; destruct H - | H1 : ?m1 !! ?i = Some ?x, H2 : ?m2 !! ?i = Some ?y |- _ => - let H3 := fresh in - feed pose proof (lookup_weaken_inv m1 m2 i x y) as H3; [done|by tac|done|]; - clear H2; symmetry in H3 - | H1 : ?m1 !! ?i = Some ?x, H2 : ?m2 !! ?i = None |- _ => - let H3 := fresh in - apply (lookup_weaken _ m2) in H1; [congruence|by tac] - | H : ?m ∪ _ = ?m ∪ _ |- _ => - apply map_union_cancel_l in H; [|by tac|by tac] - | H : _ ∪ ?m = _ ∪ ?m |- _ => - apply map_union_cancel_r in H; [|by tac|by tac] - | H : {[?i := ?x]} = ∅ |- _ => by destruct (map_non_empty_singleton i x) - | H : ∅ = {[?i := ?x]} |- _ => by destruct (map_non_empty_singleton i x) - | H : ?m !! ?i = Some _, H2 : ?m !! ?j = None |- _ => - unless (i ≠j) by done; - assert (i ≠j) by (by intros ?; simplify_eq) - end. -Tactic Notation "simplify_map_eq" "/=" "by" tactic3(tac) := - repeat (progress csimpl in * || simplify_map_eq by tac). -Tactic Notation "simplify_map_eq" := - simplify_map_eq by eauto with simpl_map map_disjoint. -Tactic Notation "simplify_map_eq" "/=" := - simplify_map_eq/= by eauto with simpl_map map_disjoint. diff --git a/theories/prelude/finite.v b/theories/prelude/finite.v deleted file mode 100644 index 55c7c1e15a3410eaed6e78b80c3c91c9f65dba80..0000000000000000000000000000000000000000 --- a/theories/prelude/finite.v +++ /dev/null @@ -1,354 +0,0 @@ -(* Copyright (c) 2012-2017, Robbert Krebbers. *) -(* This file is distributed under the terms of the BSD license. *) -From iris.prelude Require Export countable vector. -Set Default Proof Using "Type". - -Class Finite A `{EqDecision A} := { - enum : list A; - NoDup_enum : NoDup enum; - elem_of_enum x : x ∈ enum -}. -Arguments enum _ _ _ : clear implicits. -Arguments enum _ {_ _}. -Arguments NoDup_enum _ _ _ : clear implicits. -Arguments NoDup_enum _ {_ _}. -Definition card A `{Finite A} := length (enum A). -Program Instance finite_countable `{Finite A} : Countable A := {| - encode := λ x, - Pos.of_nat $ S $ from_option id 0 $ fst <$> list_find (x =) (enum A); - decode := λ p, enum A !! pred (Pos.to_nat p) -|}. -Arguments Pos.of_nat _ : simpl never. -Next Obligation. - intros ?? [xs Hxs HA] x; unfold encode, decode; simpl. - destruct (list_find_elem_of (x =) xs x) as [[i y] Hi]; auto. - rewrite Nat2Pos.id by done; simpl; rewrite Hi; simpl. - destruct (list_find_Some (x =) xs i y); naive_solver. -Qed. -Definition find `{Finite A} P `{∀ x, Decision (P x)} : option A := - list_find P (enum A) ≫= decode_nat ∘ fst. - -Lemma encode_lt_card `{finA: Finite A} x : encode_nat x < card A. -Proof. - destruct finA as [xs Hxs HA]; unfold encode_nat, encode, card; simpl. - rewrite Nat2Pos.id by done; simpl. - destruct (list_find _ xs) as [[i y]|] eqn:?; simpl. - - destruct (list_find_Some (x =) xs i y); eauto using lookup_lt_Some. - - destruct xs; simpl. exfalso; eapply not_elem_of_nil, (HA x). lia. -Qed. -Lemma encode_decode A `{finA: Finite A} i : - i < card A → ∃ x, decode_nat i = Some x ∧ encode_nat x = i. -Proof. - destruct finA as [xs Hxs HA]. - unfold encode_nat, decode_nat, encode, decode, card; simpl. - intros Hi. apply lookup_lt_is_Some in Hi. destruct Hi as [x Hx]. - exists x. rewrite !Nat2Pos.id by done; simpl. - destruct (list_find_elem_of (x =) xs x) as [[j y] Hj]; auto. - destruct (list_find_Some (x =) xs j y) as [? ->]; auto. - rewrite Hj; csimpl; eauto using NoDup_lookup. -Qed. -Lemma find_Some `{finA: Finite A} P `{∀ x, Decision (P x)} x : - find P = Some x → P x. -Proof. - destruct finA as [xs Hxs HA]; unfold find, decode_nat, decode; simpl. - intros Hx. destruct (list_find _ _) as [[i y]|] eqn:Hi; simplify_eq/=. - rewrite !Nat2Pos.id in Hx by done. - destruct (list_find_Some P xs i y); naive_solver. -Qed. -Lemma find_is_Some `{finA: Finite A} P `{∀ x, Decision (P x)} x : - P x → ∃ y, find P = Some y ∧ P y. -Proof. - destruct finA as [xs Hxs HA]; unfold find, decode; simpl. - intros Hx. destruct (list_find_elem_of P xs x) as [[i y] Hi]; auto. - rewrite Hi. destruct (list_find_Some P xs i y); simplify_eq/=; auto. - exists y. by rewrite !Nat2Pos.id by done. -Qed. - -Definition encode_fin `{Finite A} (x : A) : fin (card A) := - Fin.of_nat_lt (encode_lt_card x). -Program Definition decode_fin `{Finite A} (i : fin (card A)) : A := - match Some_dec (decode_nat i) return _ with - | inleft (exist x _) => x | inright _ => _ - end. -Next Obligation. - intros A ?? i ?; exfalso. - destruct (encode_decode A i); naive_solver auto using fin_to_nat_lt. -Qed. -Lemma decode_encode_fin `{Finite A} (x : A) : decode_fin (encode_fin x) = x. -Proof. - unfold decode_fin, encode_fin. destruct (Some_dec _) as [[x' Hx]|Hx]. - { by rewrite fin_to_of_nat, decode_encode_nat in Hx; simplify_eq. } - exfalso; by rewrite ->fin_to_of_nat, decode_encode_nat in Hx. -Qed. - -Lemma fin_choice {n} {B : fin n → Type} (P : ∀ i, B i → Prop) : - (∀ i, ∃ y, P i y) → ∃ f, ∀ i, P i (f i). -Proof. - induction n as [|n IH]; intros Hex. - { exists (fin_0_inv _); intros i; inv_fin i. } - destruct (IH _ _ (λ i, Hex (FS i))) as [f Hf], (Hex 0%fin) as [y Hy]. - exists (fin_S_inv _ y f); intros i; by inv_fin i. -Qed. -Lemma finite_choice `{Finite A} {B : A → Type} (P : ∀ x, B x → Prop) : - (∀ x, ∃ y, P x y) → ∃ f, ∀ x, P x (f x). -Proof. - intros Hex. destruct (fin_choice _ (λ i, Hex (decode_fin i))) as [f ?]. - exists (λ x, eq_rect _ _ (f(encode_fin x)) _ (decode_encode_fin x)); intros x. - destruct (decode_encode_fin x); simpl; auto. -Qed. - -Lemma card_0_inv P `{finA: Finite A} : card A = 0 → A → P. -Proof. - intros ? x. destruct finA as [[|??] ??]; simplify_eq. - by destruct (not_elem_of_nil x). -Qed. -Lemma finite_inhabited A `{finA: Finite A} : 0 < card A → Inhabited A. -Proof. - unfold card; intros. destruct finA as [[|x ?] ??]; simpl in *; [exfalso;lia|]. - constructor; exact x. -Qed. -Lemma finite_inj_submseteq `{finA: Finite A} `{finB: Finite B} (f: A → B) - `{!Inj (=) (=) f} : f <$> enum A ⊆+ enum B. -Proof. - intros. destruct finA, finB. apply NoDup_submseteq; auto using NoDup_fmap_2. -Qed. -Lemma finite_inj_Permutation `{Finite A} `{Finite B} (f : A → B) - `{!Inj (=) (=) f} : card A = card B → f <$> enum A ≡ₚ enum B. -Proof. - intros. apply submseteq_Permutation_length_eq. - - by rewrite fmap_length. - - by apply finite_inj_submseteq. -Qed. -Lemma finite_inj_surj `{Finite A} `{Finite B} (f : A → B) - `{!Inj (=) (=) f} : card A = card B → Surj (=) f. -Proof. - intros HAB y. destruct (elem_of_list_fmap_2 f (enum A) y) as (x&?&?); eauto. - rewrite finite_inj_Permutation; auto using elem_of_enum. -Qed. - -Lemma finite_surj A `{Finite A} B `{Finite B} : - 0 < card A ≤ card B → ∃ g : B → A, Surj (=) g. -Proof. - intros [??]. destruct (finite_inhabited A) as [x']; auto with lia. - exists (λ y : B, from_option id x' (decode_nat (encode_nat y))). - intros x. destruct (encode_decode B (encode_nat x)) as (y&Hy1&Hy2). - { pose proof (encode_lt_card x); lia. } - exists y. by rewrite Hy2, decode_encode_nat. -Qed. -Lemma finite_inj A `{Finite A} B `{Finite B} : - card A ≤ card B ↔ ∃ f : A → B, Inj (=) (=) f. -Proof. - split. - - intros. destruct (decide (card A = 0)) as [HA|?]. - { exists (card_0_inv B HA). intros y. apply (card_0_inv _ HA y). } - destruct (finite_surj A B) as (g&?); auto with lia. - destruct (surj_cancel g) as (f&?). exists f. apply cancel_inj. - - intros [f ?]. unfold card. rewrite <-(fmap_length f). - by apply submseteq_length, (finite_inj_submseteq f). -Qed. -Lemma finite_bijective A `{Finite A} B `{Finite B} : - card A = card B ↔ ∃ f : A → B, Inj (=) (=) f ∧ Surj (=) f. -Proof. - split. - - intros; destruct (proj1 (finite_inj A B)) as [f ?]; auto with lia. - exists f; auto using (finite_inj_surj f). - - intros (f&?&?). apply (anti_symm (≤)); apply finite_inj. - + by exists f. - + destruct (surj_cancel f) as (g&?); eauto using cancel_inj. -Qed. -Lemma inj_card `{Finite A} `{Finite B} (f : A → B) - `{!Inj (=) (=) f} : card A ≤ card B. -Proof. apply finite_inj. eauto. Qed. -Lemma surj_card `{Finite A} `{Finite B} (f : A → B) - `{!Surj (=) f} : card B ≤ card A. -Proof. - destruct (surj_cancel f) as (g&?). - apply inj_card with g, cancel_inj. -Qed. -Lemma bijective_card `{Finite A} `{Finite B} (f : A → B) - `{!Inj (=) (=) f} `{!Surj (=) f} : card A = card B. -Proof. apply finite_bijective. eauto. Qed. - -(** Decidability of quantification over finite types *) -Section forall_exists. - Context `{Finite A} (P : A → Prop). - - Lemma Forall_finite : Forall P (enum A) ↔ (∀ x, P x). - Proof. rewrite Forall_forall. intuition auto using elem_of_enum. Qed. - Lemma Exists_finite : Exists P (enum A) ↔ (∃ x, P x). - Proof. rewrite Exists_exists. naive_solver eauto using elem_of_enum. Qed. - - Context `{∀ x, Decision (P x)}. - - Global Instance forall_dec: Decision (∀ x, P x). - Proof using Type*. - refine (cast_if (decide (Forall P (enum A)))); - abstract by rewrite <-Forall_finite. - Defined. - Global Instance exists_dec: Decision (∃ x, P x). - Proof using Type*. - refine (cast_if (decide (Exists P (enum A)))); - abstract by rewrite <-Exists_finite. - Defined. -End forall_exists. - -(** Instances *) -Section enc_finite. - Context `{EqDecision A}. - Context (to_nat : A → nat) (of_nat : nat → A) (c : nat). - Context (of_to_nat : ∀ x, of_nat (to_nat x) = x). - Context (to_nat_c : ∀ x, to_nat x < c). - Context (to_of_nat : ∀ i, i < c → to_nat (of_nat i) = i). - - Program Instance enc_finite : Finite A := {| enum := of_nat <$> seq 0 c |}. - Next Obligation. - apply NoDup_alt. intros i j x. rewrite !list_lookup_fmap. intros Hi Hj. - destruct (seq _ _ !! i) as [i'|] eqn:Hi', - (seq _ _ !! j) as [j'|] eqn:Hj'; simplify_eq/=. - destruct (lookup_seq_inv _ _ _ _ Hi'), (lookup_seq_inv _ _ _ _ Hj'); subst. - rewrite <-(to_of_nat i), <-(to_of_nat j) by done. by f_equal. - Qed. - Next Obligation. - intros x. rewrite elem_of_list_fmap. exists (to_nat x). - split; auto. by apply elem_of_list_lookup_2 with (to_nat x), lookup_seq. - Qed. - Lemma enc_finite_card : card A = c. - Proof. unfold card. simpl. by rewrite fmap_length, seq_length. Qed. -End enc_finite. - -Section bijective_finite. - Context `{Finite A, EqDecision B} (f : A → B) (g : B → A). - Context `{!Inj (=) (=) f, !Cancel (=) f g}. - - Program Instance bijective_finite: Finite B := {| enum := f <$> enum A |}. - Next Obligation. apply (NoDup_fmap_2 _), NoDup_enum. Qed. - Next Obligation. - intros y. rewrite elem_of_list_fmap. eauto using elem_of_enum. - Qed. -End bijective_finite. - -Program Instance option_finite `{Finite A} : Finite (option A) := - {| enum := None :: Some <$> enum A |}. -Next Obligation. - constructor. - - rewrite elem_of_list_fmap. by intros (?&?&?). - - apply (NoDup_fmap_2 _); auto using NoDup_enum. -Qed. -Next Obligation. - intros ??? [x|]; [right|left]; auto. - apply elem_of_list_fmap. eauto using elem_of_enum. -Qed. -Lemma option_cardinality `{Finite A} : card (option A) = S (card A). -Proof. unfold card. simpl. by rewrite fmap_length. Qed. - -Program Instance unit_finite : Finite () := {| enum := [tt] |}. -Next Obligation. apply NoDup_singleton. Qed. -Next Obligation. intros []. by apply elem_of_list_singleton. Qed. -Lemma unit_card : card unit = 1. -Proof. done. Qed. - -Program Instance bool_finite : Finite bool := {| enum := [true; false] |}. -Next Obligation. - constructor. by rewrite elem_of_list_singleton. apply NoDup_singleton. -Qed. -Next Obligation. intros [|]. left. right; left. Qed. -Lemma bool_card : card bool = 2. -Proof. done. Qed. - -Program Instance sum_finite `{Finite A, Finite B} : Finite (A + B)%type := - {| enum := (inl <$> enum A) ++ (inr <$> enum B) |}. -Next Obligation. - intros. apply NoDup_app; split_and?. - - apply (NoDup_fmap_2 _). by apply NoDup_enum. - - intro. rewrite !elem_of_list_fmap. intros (?&?&?) (?&?&?); congruence. - - apply (NoDup_fmap_2 _). by apply NoDup_enum. -Qed. -Next Obligation. - intros ?????? [x|y]; rewrite elem_of_app, !elem_of_list_fmap; - eauto using @elem_of_enum. -Qed. -Lemma sum_card `{Finite A, Finite B} : card (A + B) = card A + card B. -Proof. unfold card. simpl. by rewrite app_length, !fmap_length. Qed. - -Program Instance prod_finite `{Finite A, Finite B} : Finite (A * B)%type := - {| enum := foldr (λ x, (pair x <$> enum B ++)) [] (enum A) |}. -Next Obligation. - intros ??????. induction (NoDup_enum A) as [|x xs Hx Hxs IH]; simpl. - { constructor. } - apply NoDup_app; split_and?. - - by apply (NoDup_fmap_2 _), NoDup_enum. - - intros [? y]. rewrite elem_of_list_fmap. intros (?&?&?); simplify_eq. - clear IH. induction Hxs as [|x' xs ?? IH]; simpl. - { rewrite elem_of_nil. tauto. } - rewrite elem_of_app, elem_of_list_fmap. - intros [(?&?&?)|?]; simplify_eq. - + destruct Hx. by left. - + destruct IH. by intro; destruct Hx; right. auto. - - done. -Qed. -Next Obligation. - intros ?????? [x y]. induction (elem_of_enum x); simpl. - - rewrite elem_of_app, !elem_of_list_fmap. eauto using @elem_of_enum. - - rewrite elem_of_app; eauto. -Qed. -Lemma prod_card `{Finite A} `{Finite B} : card (A * B) = card A * card B. -Proof. - unfold card; simpl. induction (enum A); simpl; auto. - rewrite app_length, fmap_length. auto. -Qed. - -Definition list_enum {A} (l : list A) : ∀ n, list { l : list A | length l = n } := - fix go n := - match n with - | 0 => [[]↾eq_refl] - | S n => foldr (λ x, (sig_map (x ::) (λ _ H, f_equal S H) <$> (go n) ++)) [] l - end. - -Program Instance list_finite `{Finite A} n : Finite { l | length l = n } := - {| enum := list_enum (enum A) n |}. -Next Obligation. - intros ????. induction n as [|n IH]; simpl; [apply NoDup_singleton |]. - revert IH. generalize (list_enum (enum A) n). intros l Hl. - induction (NoDup_enum A) as [|x xs Hx Hxs IH]; simpl; auto; [constructor |]. - apply NoDup_app; split_and?. - - by apply (NoDup_fmap_2 _). - - intros [k1 Hk1]. clear Hxs IH. rewrite elem_of_list_fmap. - intros ([k2 Hk2]&?&?) Hxk2; simplify_eq/=. destruct Hx. revert Hxk2. - induction xs as [|x' xs IH]; simpl in *; [by rewrite elem_of_nil |]. - rewrite elem_of_app, elem_of_list_fmap, elem_of_cons. - intros [([??]&?&?)|?]; simplify_eq/=; auto. - - apply IH. -Qed. -Next Obligation. - intros ???? [l Hl]. revert l Hl. - induction n as [|n IH]; intros [|x l] ?; simpl; simplify_eq. - { apply elem_of_list_singleton. by apply (sig_eq_pi _). } - revert IH. generalize (list_enum (enum A) n). intros k Hk. - induction (elem_of_enum x) as [x xs|x xs]; simpl in *. - - rewrite elem_of_app, elem_of_list_fmap. left. injection Hl. intros Hl'. - eexists (l↾Hl'). split. by apply (sig_eq_pi _). done. - - rewrite elem_of_app. eauto. -Qed. - -Lemma list_card `{Finite A} n : card { l | length l = n } = card A ^ n. -Proof. - unfold card; simpl. induction n as [|n IH]; simpl; auto. - rewrite <-IH. clear IH. generalize (list_enum (enum A) n). - induction (enum A) as [|x xs IH]; intros l; simpl; auto. - by rewrite app_length, fmap_length, IH. -Qed. - -Fixpoint fin_enum (n : nat) : list (fin n) := - match n with 0 => [] | S n => 0%fin :: FS <$> fin_enum n end. -Program Instance fin_finite n : Finite (fin n) := {| enum := fin_enum n |}. -Next Obligation. - intros n. induction n; simpl; constructor. - - rewrite elem_of_list_fmap. by intros (?&?&?). - - by apply (NoDup_fmap _). -Qed. -Next Obligation. - intros n i. induction i as [|n i IH]; simpl; - rewrite elem_of_cons, ?elem_of_list_fmap; eauto. -Qed. -Lemma fin_card n : card (fin n) = n. -Proof. unfold card; simpl. induction n; simpl; rewrite ?fmap_length; auto. Qed. diff --git a/theories/prelude/functions.v b/theories/prelude/functions.v deleted file mode 100644 index 901a3dbca9f1586ffd8900c2531f275b83c4ed9f..0000000000000000000000000000000000000000 --- a/theories/prelude/functions.v +++ /dev/null @@ -1,31 +0,0 @@ -From iris.prelude Require Export base tactics. -Set Default Proof Using "Type". - -Section definitions. - Context {A T : Type} `{EqDecision A}. - Global Instance fn_insert : Insert A T (A → T) := - λ a t f b, if decide (a = b) then t else f b. - Global Instance fn_alter : Alter A T (A → T) := - λ (g : T → T) a f b, if decide (a = b) then g (f a) else f b. -End definitions. - -(* TODO: For now, we only have the properties here that do not need a notion - of equality of functions. *) - -Section functions. - Context {A T : Type} `{!EqDecision A}. - - Lemma fn_lookup_insert (f : A → T) a t : <[a:=t]>f a = t. - Proof. unfold insert, fn_insert. by destruct (decide (a = a)). Qed. - Lemma fn_lookup_insert_rev (f : A → T) a t1 t2 : - <[a:=t1]>f a = t2 → t1 = t2. - Proof. rewrite fn_lookup_insert. congruence. Qed. - Lemma fn_lookup_insert_ne (f : A → T) a b t : a ≠b → <[a:=t]>f b = f b. - Proof. unfold insert, fn_insert. by destruct (decide (a = b)). Qed. - - Lemma fn_lookup_alter (g : T → T) (f : A → T) a : alter g a f a = g (f a). - Proof. unfold alter, fn_alter. by destruct (decide (a = a)). Qed. - Lemma fn_lookup_alter_ne (g : T → T) (f : A → T) a b : - a ≠b → alter g a f b = f b. - Proof. unfold alter, fn_alter. by destruct (decide (a = b)). Qed. -End functions. diff --git a/theories/prelude/gmap.v b/theories/prelude/gmap.v deleted file mode 100644 index 2daddef4aa726b58a035c1e41738e06e2f1f90a0..0000000000000000000000000000000000000000 --- a/theories/prelude/gmap.v +++ /dev/null @@ -1,240 +0,0 @@ -(* Copyright (c) 2012-2017, Robbert Krebbers. *) -(* This file is distributed under the terms of the BSD license. *) -(** This file implements finite maps and finite sets with keys of any countable -type. The implementation is based on [Pmap]s, radix-2 search trees. *) -From iris.prelude Require Export countable fin_maps fin_map_dom. -From iris.prelude Require Import pmap mapset set. -Set Default Proof Using "Type". - -(** * The data structure *) -(** We pack a [Pmap] together with a proof that ensures that all keys correspond -to codes of actual elements of the countable type. *) -Definition gmap_wf `{Countable K} {A} : Pmap A → Prop := - map_Forall (λ p _, encode <$> decode p = Some p). -Record gmap K `{Countable K} A := GMap { - gmap_car : Pmap A; - gmap_prf : bool_decide (gmap_wf gmap_car) -}. -Arguments GMap {_ _ _ _} _ _. -Arguments gmap_car {_ _ _ _} _. -Lemma gmap_eq `{Countable K} {A} (m1 m2 : gmap K A) : - m1 = m2 ↔ gmap_car m1 = gmap_car m2. -Proof. - split; [by intros ->|intros]. destruct m1, m2; simplify_eq/=. - f_equal; apply proof_irrel. -Qed. -Instance gmap_eq_eq `{Countable K, EqDecision A} : EqDecision (gmap K A). -Proof. - refine (λ m1 m2, cast_if (decide (gmap_car m1 = gmap_car m2))); - abstract (by rewrite gmap_eq). -Defined. - -(** * Operations on the data structure *) -Instance gmap_lookup `{Countable K} {A} : Lookup K A (gmap K A) := λ i m, - let (m,_) := m in m !! encode i. -Instance gmap_empty `{Countable K} {A} : Empty (gmap K A) := GMap ∅ I. -Global Opaque gmap_empty. -Lemma gmap_partial_alter_wf `{Countable K} {A} (f : option A → option A) m i : - gmap_wf m → gmap_wf (partial_alter f (encode i) m). -Proof. - intros Hm p x. destruct (decide (encode i = p)) as [<-|?]. - - rewrite decode_encode; eauto. - - rewrite lookup_partial_alter_ne by done. by apply Hm. -Qed. -Instance gmap_partial_alter `{Countable K} {A} : - PartialAlter K A (gmap K A) := λ f i m, - let (m,Hm) := m in GMap (partial_alter f (encode i) m) - (bool_decide_pack _ (gmap_partial_alter_wf f m i - (bool_decide_unpack _ Hm))). -Lemma gmap_fmap_wf `{Countable K} {A B} (f : A → B) m : - gmap_wf m → gmap_wf (f <$> m). -Proof. intros ? p x. rewrite lookup_fmap, fmap_Some; intros (?&?&?); eauto. Qed. -Instance gmap_fmap `{Countable K} : FMap (gmap K) := λ A B f m, - let (m,Hm) := m in GMap (f <$> m) - (bool_decide_pack _ (gmap_fmap_wf f m (bool_decide_unpack _ Hm))). -Lemma gmap_omap_wf `{Countable K} {A B} (f : A → option B) m : - gmap_wf m → gmap_wf (omap f m). -Proof. intros ? p x; rewrite lookup_omap, bind_Some; intros (?&?&?); eauto. Qed. -Instance gmap_omap `{Countable K} : OMap (gmap K) := λ A B f m, - let (m,Hm) := m in GMap (omap f m) - (bool_decide_pack _ (gmap_omap_wf f m (bool_decide_unpack _ Hm))). -Lemma gmap_merge_wf `{Countable K} {A B C} - (f : option A → option B → option C) m1 m2 : - let f' o1 o2 := match o1, o2 with None, None => None | _, _ => f o1 o2 end in - gmap_wf m1 → gmap_wf m2 → gmap_wf (merge f' m1 m2). -Proof. - intros f' Hm1 Hm2 p z; rewrite lookup_merge by done; intros. - destruct (m1 !! _) eqn:?, (m2 !! _) eqn:?; naive_solver. -Qed. -Instance gmap_merge `{Countable K} : Merge (gmap K) := λ A B C f m1 m2, - let (m1,Hm1) := m1 in let (m2,Hm2) := m2 in - let f' o1 o2 := match o1, o2 with None, None => None | _, _ => f o1 o2 end in - GMap (merge f' m1 m2) (bool_decide_pack _ (gmap_merge_wf f _ _ - (bool_decide_unpack _ Hm1) (bool_decide_unpack _ Hm2))). -Instance gmap_to_list `{Countable K} {A} : FinMapToList K A (gmap K A) := λ m, - let (m,_) := m in omap (λ ix : positive * A, - let (i,x) := ix in (,x) <$> decode i) (map_to_list m). - -(** * Instantiation of the finite map interface *) -Instance gmap_finmap `{Countable K} : FinMap K (gmap K). -Proof. - split. - - unfold lookup; intros A [m1 Hm1] [m2 Hm2] Hm. - apply gmap_eq, map_eq; intros i; simpl in *. - apply bool_decide_unpack in Hm1; apply bool_decide_unpack in Hm2. - apply option_eq; intros x; split; intros Hi. - + pose proof (Hm1 i x Hi); simpl in *. - by destruct (decode i); simplify_eq/=; rewrite <-Hm. - + pose proof (Hm2 i x Hi); simpl in *. - by destruct (decode i); simplify_eq/=; rewrite Hm. - - done. - - intros A f [m Hm] i; apply (lookup_partial_alter f m). - - intros A f [m Hm] i j Hs; apply (lookup_partial_alter_ne f m). - by contradict Hs; apply (inj encode). - - intros A B f [m Hm] i; apply (lookup_fmap f m). - - intros A [m Hm]; unfold map_to_list; simpl. - apply bool_decide_unpack, map_Forall_to_list in Hm; revert Hm. - induction (NoDup_map_to_list m) as [|[p x] l Hpx]; - inversion 1 as [|??? Hm']; simplify_eq/=; [by constructor|]. - destruct (decode p) as [i|] eqn:?; simplify_eq/=; constructor; eauto. - rewrite elem_of_list_omap; intros ([p' x']&?&?); simplify_eq/=. - feed pose proof (proj1 (Forall_forall _ _) Hm' (p',x')); simpl in *; auto. - by destruct (decode p') as [i'|]; simplify_eq/=. - - intros A [m Hm] i x; unfold map_to_list, lookup; simpl. - apply bool_decide_unpack in Hm; rewrite elem_of_list_omap; split. - + intros ([p' x']&Hp'&?); apply elem_of_map_to_list in Hp'. - feed pose proof (Hm p' x'); simpl in *; auto. - by destruct (decode p') as [i'|] eqn:?; simplify_eq/=. - + intros; exists (encode i,x); simpl. - by rewrite elem_of_map_to_list, decode_encode. - - intros A B f [m Hm] i; apply (lookup_omap f m). - - intros A B C f ? [m1 Hm1] [m2 Hm2] i; unfold merge, lookup; simpl. - set (f' o1 o2 := match o1, o2 with None,None => None | _, _ => f o1 o2 end). - by rewrite lookup_merge by done; destruct (m1 !! _), (m2 !! _). -Qed. - -Program Instance gmap_countable - `{Countable K, Countable A} : Countable (gmap K A) := { - encode m := encode (map_to_list m : list (K * A)); - decode p := map_of_list <$> decode p -}. -Next Obligation. - intros K ?? A ?? m; simpl. rewrite decode_encode; simpl. - by rewrite map_of_to_list. -Qed. - -(** * Curry and uncurry *) -Definition gmap_curry `{Countable K1, Countable K2} {A} : - gmap K1 (gmap K2 A) → gmap (K1 * K2) A := - map_fold (λ i1 m' macc, - map_fold (λ i2 x, <[(i1,i2):=x]>) macc m') ∅. -Definition gmap_uncurry `{Countable K1, Countable K2} {A} : - gmap (K1 * K2) A → gmap K1 (gmap K2 A) := - map_fold (λ '(i1,i2) x, - partial_alter (Some ∘ <[i2:=x]> ∘ from_option id ∅) i1) ∅. - -Section curry_uncurry. - Context `{Countable K1, Countable K2} {A : Type}. - - Lemma lookup_gmap_curry (m : gmap K1 (gmap K2 A)) i j : - gmap_curry m !! (i,j) = m !! i ≫= (!! j). - Proof. - apply (map_fold_ind (λ mr m, mr !! (i,j) = m !! i ≫= (!! j))). - { by rewrite !lookup_empty. } - clear m; intros i' m2 m m12 Hi' IH. - apply (map_fold_ind (λ m2r m2, m2r !! (i,j) = <[i':=m2]> m !! i ≫= (!! j))). - { rewrite IH. destruct (decide (i' = i)) as [->|]. - - rewrite lookup_insert, Hi'; simpl; by rewrite lookup_empty. - - by rewrite lookup_insert_ne by done. } - intros j' y m2' m12' Hj' IH'. destruct (decide (i = i')) as [->|]. - - rewrite lookup_insert; simpl. destruct (decide (j = j')) as [->|]. - + by rewrite !lookup_insert. - + by rewrite !lookup_insert_ne, IH', lookup_insert by congruence. - - by rewrite !lookup_insert_ne, IH', lookup_insert_ne by congruence. - Qed. - - Lemma lookup_gmap_uncurry (m : gmap (K1 * K2) A) i j : - gmap_uncurry m !! i ≫= (!! j) = m !! (i, j). - Proof. - apply (map_fold_ind (λ mr m, mr !! i ≫= (!! j) = m !! (i, j))). - { by rewrite !lookup_empty. } - clear m; intros [i' j'] x m12 mr Hij' IH. - destruct (decide (i = i')) as [->|]. - - rewrite lookup_partial_alter. destruct (decide (j = j')) as [->|]. - + destruct (mr !! i'); simpl; by rewrite !lookup_insert. - + destruct (mr !! i'); simpl; by rewrite !lookup_insert_ne by congruence. - - by rewrite lookup_partial_alter_ne, lookup_insert_ne by congruence. - Qed. - - Lemma gmap_curry_uncurry (m : gmap (K1 * K2) A) : - gmap_curry (gmap_uncurry m) = m. - Proof. - apply map_eq; intros [i j]. by rewrite lookup_gmap_curry, lookup_gmap_uncurry. - Qed. -End curry_uncurry. - -(** * Finite sets *) -Notation gset K := (mapset (gmap K)). -Instance gset_dom `{Countable K} {A} : Dom (gmap K A) (gset K) := mapset_dom. -Instance gset_dom_spec `{Countable K} : - FinMapDom K (gmap K) (gset K) := mapset_dom_spec. - -Definition of_gset `{Countable A} (X : gset A) : set A := mkSet (λ x, x ∈ X). -Lemma elem_of_of_gset `{Countable A} (X : gset A) x : x ∈ of_gset X ↔ x ∈ X. -Proof. done. Qed. - -Definition to_gmap `{Countable K} {A} (x : A) (X : gset K) : gmap K A := - (λ _, x) <$> mapset_car X. - -Lemma lookup_to_gmap `{Countable K} {A} (x : A) (X : gset K) i : - to_gmap x X !! i = guard (i ∈ X); Some x. -Proof. - destruct X as [X]; unfold to_gmap, elem_of, mapset_elem_of; simpl. - rewrite lookup_fmap. - case_option_guard; destruct (X !! i) as [[]|]; naive_solver. -Qed. -Lemma lookup_to_gmap_Some `{Countable K} {A} (x : A) (X : gset K) i y : - to_gmap x X !! i = Some y ↔ i ∈ X ∧ x = y. -Proof. rewrite lookup_to_gmap. simplify_option_eq; naive_solver. Qed. -Lemma lookup_to_gmap_None `{Countable K} {A} (x : A) (X : gset K) i : - to_gmap x X !! i = None ↔ i ∉ X. -Proof. rewrite lookup_to_gmap. simplify_option_eq; naive_solver. Qed. - -Lemma to_gmap_empty `{Countable K} {A} (x : A) : to_gmap x ∅ = ∅. -Proof. apply fmap_empty. Qed. -Lemma to_gmap_union_singleton `{Countable K} {A} (x : A) i Y : - to_gmap x ({[ i ]} ∪ Y) = <[i:=x]>(to_gmap x Y). -Proof. - apply map_eq; intros j; apply option_eq; intros y. - rewrite lookup_insert_Some, !lookup_to_gmap_Some, elem_of_union, - elem_of_singleton; destruct (decide (i = j)); intuition. -Qed. - -Lemma fmap_to_gmap `{Countable K} {A B} (f : A → B) (X : gset K) (x : A) : - f <$> to_gmap x X = to_gmap (f x) X. -Proof. - apply map_eq; intros j. rewrite lookup_fmap, !lookup_to_gmap. - by simplify_option_eq. -Qed. -Lemma to_gmap_dom `{Countable K} {A B} (m : gmap K A) (y : B) : - to_gmap y (dom _ m) = const y <$> m. -Proof. - apply map_eq; intros j. rewrite lookup_fmap, lookup_to_gmap. - destruct (m !! j) as [x|] eqn:?. - - by rewrite option_guard_True by (rewrite elem_of_dom; eauto). - - by rewrite option_guard_False by (rewrite not_elem_of_dom; eauto). -Qed. - -(** * Fresh elements *) -(* This is pretty ad-hoc and just for the case of [gset positive]. We need a -notion of countable non-finite types to generalize this. *) -Instance gset_positive_fresh : Fresh positive (gset positive) := λ X, - let 'Mapset (GMap m _) := X in fresh (dom _ m). -Instance gset_positive_fresh_spec : FreshSpec positive (gset positive). -Proof. - split. - - apply _. - - by intros X Y; rewrite <-elem_of_equiv_L; intros ->. - - intros [[m Hm]]; unfold fresh; simpl. - by intros ?; apply (is_fresh (dom Pset m)), elem_of_dom_2 with (). -Qed. diff --git a/theories/prelude/gmultiset.v b/theories/prelude/gmultiset.v deleted file mode 100644 index fefe1aed43b290c6d02e5ba61d7831c0387d01c4..0000000000000000000000000000000000000000 --- a/theories/prelude/gmultiset.v +++ /dev/null @@ -1,383 +0,0 @@ -(* Copyright (c) 2012-2016, Robbert Krebbers. *) -(* This file is distributed under the terms of the BSD license. *) -From iris.prelude Require Import gmap. -Set Default Proof Using "Type". - -Record gmultiset A `{Countable A} := GMultiSet { gmultiset_car : gmap A nat }. -Arguments GMultiSet {_ _ _} _. -Arguments gmultiset_car {_ _ _} _. - -Lemma gmultiset_eq_dec `{Countable A} : EqDecision (gmultiset A). -Proof. solve_decision. Defined. -Hint Extern 1 (Decision (@eq (gmultiset _) _ _)) => - eapply @gmultiset_eq_dec : typeclass_instances. - -Program Definition gmultiset_countable `{Countable A} : - Countable (gmultiset A) := {| - encode X := encode (gmultiset_car X); decode p := GMultiSet <$> decode p -|}. -Next Obligation. intros A ?? [X]; simpl. by rewrite decode_encode. Qed. -Hint Extern 1 (Countable (gmultiset _)) => - eapply @gmultiset_countable : typeclass_instances. - -Section definitions. - Context `{Countable A}. - - Definition multiplicity (x : A) (X : gmultiset A) : nat := - match gmultiset_car X !! x with Some n => S n | None => 0 end. - Instance gmultiset_elem_of : ElemOf A (gmultiset A) := λ x X, - 0 < multiplicity x X. - Instance gmultiset_subseteq : SubsetEq (gmultiset A) := λ X Y, ∀ x, - multiplicity x X ≤ multiplicity x Y. - - Instance gmultiset_elements : Elements A (gmultiset A) := λ X, - let (X) := X in '(x,n) ↠map_to_list X; replicate (S n) x. - Instance gmultiset_size : Size (gmultiset A) := length ∘ elements. - - Instance gmultiset_empty : Empty (gmultiset A) := GMultiSet ∅. - Instance gmultiset_singleton : Singleton A (gmultiset A) := λ x, - GMultiSet {[ x := 0 ]}. - Instance gmultiset_union : Union (gmultiset A) := λ X Y, - let (X) := X in let (Y) := Y in - GMultiSet $ union_with (λ x y, Some (S (x + y))) X Y. - Instance gmultiset_difference : Difference (gmultiset A) := λ X Y, - let (X) := X in let (Y) := Y in - GMultiSet $ difference_with (λ x y, - let z := x - y in guard (0 < z); Some (pred z)) X Y. - - Instance gmultiset_dom : Dom (gmultiset A) (gset A) := λ X, - let (X) := X in dom _ X. -End definitions. - -Typeclasses Opaque gmultiset_elem_of gmultiset_subseteq. -Typeclasses Opaque gmultiset_elements gmultiset_size gmultiset_empty. -Typeclasses Opaque gmultiset_singleton gmultiset_union gmultiset_difference. -Typeclasses Opaque gmultiset_dom. - -(** These instances are declared using [Hint Extern] to avoid too -eager type class search. *) -Hint Extern 1 (ElemOf _ (gmultiset _)) => - eapply @gmultiset_elem_of : typeclass_instances. -Hint Extern 1 (SubsetEq (gmultiset _)) => - eapply @gmultiset_subseteq : typeclass_instances. -Hint Extern 1 (Empty (gmultiset _)) => - eapply @gmultiset_empty : typeclass_instances. -Hint Extern 1 (Singleton _ (gmultiset _)) => - eapply @gmultiset_singleton : typeclass_instances. -Hint Extern 1 (Union (gmultiset _)) => - eapply @gmultiset_union : typeclass_instances. -Hint Extern 1 (Difference (gmultiset _)) => - eapply @gmultiset_difference : typeclass_instances. -Hint Extern 1 (Elements _ (gmultiset _)) => - eapply @gmultiset_elements : typeclass_instances. -Hint Extern 1 (Size (gmultiset _)) => - eapply @gmultiset_size : typeclass_instances. -Hint Extern 1 (Dom (gmultiset _) _) => - eapply @gmultiset_dom : typeclass_instances. - -Section lemmas. -Context `{Countable A}. -Implicit Types x y : A. -Implicit Types X Y : gmultiset A. - -Lemma gmultiset_eq X Y : X = Y ↔ ∀ x, multiplicity x X = multiplicity x Y. -Proof. - split; [by intros ->|intros HXY]. - destruct X as [X], Y as [Y]; f_equal; apply map_eq; intros x. - specialize (HXY x); unfold multiplicity in *; simpl in *. - repeat case_match; naive_solver. -Qed. - -(* Multiplicity *) -Lemma multiplicity_empty x : multiplicity x ∅ = 0. -Proof. done. Qed. -Lemma multiplicity_singleton x : multiplicity x {[ x ]} = 1. -Proof. unfold multiplicity; simpl. by rewrite lookup_singleton. Qed. -Lemma multiplicity_singleton_ne x y : x ≠y → multiplicity x {[ y ]} = 0. -Proof. intros. unfold multiplicity; simpl. by rewrite lookup_singleton_ne. Qed. -Lemma multiplicity_union X Y x : - multiplicity x (X ∪ Y) = multiplicity x X + multiplicity x Y. -Proof. - destruct X as [X], Y as [Y]; unfold multiplicity; simpl. - rewrite lookup_union_with. destruct (X !! _), (Y !! _); simpl; omega. -Qed. -Lemma multiplicity_difference X Y x : - multiplicity x (X ∖ Y) = multiplicity x X - multiplicity x Y. -Proof. - destruct X as [X], Y as [Y]; unfold multiplicity; simpl. - rewrite lookup_difference_with. - destruct (X !! _), (Y !! _); simplify_option_eq; omega. -Qed. - -(* Collection *) -Lemma elem_of_multiplicity x X : x ∈ X ↔ 0 < multiplicity x X. -Proof. done. Qed. - -Global Instance gmultiset_simple_collection : SimpleCollection A (gmultiset A). -Proof. - split. - - intros x. rewrite elem_of_multiplicity, multiplicity_empty. omega. - - intros x y. destruct (decide (x = y)) as [->|]. - + rewrite elem_of_multiplicity, multiplicity_singleton. split; auto with lia. - + rewrite elem_of_multiplicity, multiplicity_singleton_ne by done. - by split; auto with lia. - - intros X Y x. rewrite !elem_of_multiplicity, multiplicity_union. omega. -Qed. -Global Instance gmultiset_elem_of_dec x X : Decision (x ∈ X). -Proof. unfold elem_of, gmultiset_elem_of. apply _. Defined. - -(* Algebraic laws *) -Global Instance gmultiset_comm : Comm (@eq (gmultiset A)) (∪). -Proof. - intros X Y. apply gmultiset_eq; intros x. rewrite !multiplicity_union; omega. -Qed. -Global Instance gmultiset_assoc : Assoc (@eq (gmultiset A)) (∪). -Proof. - intros X Y Z. apply gmultiset_eq; intros x. rewrite !multiplicity_union; omega. -Qed. -Global Instance gmultiset_left_id : LeftId (@eq (gmultiset A)) ∅ (∪). -Proof. - intros X. apply gmultiset_eq; intros x. - by rewrite multiplicity_union, multiplicity_empty. -Qed. -Global Instance gmultiset_right_id : RightId (@eq (gmultiset A)) ∅ (∪). -Proof. intros X. by rewrite (comm_L (∪)), (left_id_L _ _). Qed. - -Global Instance gmultiset_union_inj_1 X : Inj (=) (=) (X ∪). -Proof. - intros Y1 Y2. rewrite !gmultiset_eq. intros HX x; generalize (HX x). - rewrite !multiplicity_union. omega. -Qed. -Global Instance gmultiset_union_inj_2 X : Inj (=) (=) (∪ X). -Proof. intros Y1 Y2. rewrite <-!(comm_L _ X). apply (inj _). Qed. - -Lemma gmultiset_non_empty_singleton x : {[ x ]} ≠(∅ : gmultiset A). -Proof. - rewrite gmultiset_eq. intros Hx; generalize (Hx x). - by rewrite multiplicity_singleton, multiplicity_empty. -Qed. - -(* Properties of the elements operation *) -Lemma gmultiset_elements_empty : elements (∅ : gmultiset A) = []. -Proof. - unfold elements, gmultiset_elements; simpl. by rewrite map_to_list_empty. -Qed. -Lemma gmultiset_elements_empty_inv X : elements X = [] → X = ∅. -Proof. - destruct X as [X]; unfold elements, gmultiset_elements; simpl. - intros; apply (f_equal GMultiSet). destruct (map_to_list X) - as [|[]] eqn:?; naive_solver eauto using map_to_list_empty_inv. -Qed. -Lemma gmultiset_elements_empty' X : elements X = [] ↔ X = ∅. -Proof. - split; intros HX; [by apply gmultiset_elements_empty_inv|]. - by rewrite HX, gmultiset_elements_empty. -Qed. -Lemma gmultiset_elements_singleton x : elements ({[ x ]} : gmultiset A) = [ x ]. -Proof. - unfold elements, gmultiset_elements; simpl. by rewrite map_to_list_singleton. -Qed. -Lemma gmultiset_elements_union X Y : - elements (X ∪ Y) ≡ₚ elements X ++ elements Y. -Proof. - destruct X as [X], Y as [Y]; unfold elements, gmultiset_elements. - set (f xn := let '(x, n) := xn in replicate (S n) x); simpl. - revert Y; induction X as [|x n X HX IH] using map_ind; intros Y. - { by rewrite (left_id_L _ _ Y), map_to_list_empty. } - destruct (Y !! x) as [n'|] eqn:HY. - - rewrite <-(insert_id Y x n'), <-(insert_delete Y) by done. - erewrite <-insert_union_with by done. - rewrite !map_to_list_insert, !bind_cons - by (by rewrite ?lookup_union_with, ?lookup_delete, ?HX). - rewrite (assoc_L _), <-(comm (++) (f (_,n'))), <-!(assoc_L _), <-IH. - rewrite (assoc_L _). f_equiv. - rewrite (comm _); simpl. by rewrite replicate_plus, Permutation_middle. - - rewrite <-insert_union_with_l, !map_to_list_insert, !bind_cons - by (by rewrite ?lookup_union_with, ?HX, ?HY). - by rewrite <-(assoc_L (++)), <-IH. -Qed. -Lemma gmultiset_elem_of_elements x X : x ∈ elements X ↔ x ∈ X. -Proof. - destruct X as [X]. unfold elements, gmultiset_elements. - set (f xn := let '(x, n) := xn in replicate (S n) x); simpl. - unfold elem_of at 2, gmultiset_elem_of, multiplicity; simpl. - rewrite elem_of_list_bind. split. - - intros [[??] [[<- ?]%elem_of_replicate ->%elem_of_map_to_list]]; lia. - - intros. destruct (X !! x) as [n|] eqn:Hx; [|omega]. - exists (x,n); split; [|by apply elem_of_map_to_list]. - apply elem_of_replicate; auto with omega. -Qed. -Lemma gmultiset_elem_of_dom x X : x ∈ dom (gset A) X ↔ x ∈ X. -Proof. - unfold dom, gmultiset_dom, elem_of at 2, gmultiset_elem_of, multiplicity. - destruct X as [X]; simpl; rewrite elem_of_dom, <-not_eq_None_Some. - destruct (X !! x); naive_solver omega. -Qed. - -(* Properties of the size operation *) -Lemma gmultiset_size_empty : size (∅ : gmultiset A) = 0. -Proof. done. Qed. -Lemma gmultiset_size_empty_inv X : size X = 0 → X = ∅. -Proof. - unfold size, gmultiset_size; simpl. rewrite length_zero_iff_nil. - apply gmultiset_elements_empty_inv. -Qed. -Lemma gmultiset_size_empty_iff X : size X = 0 ↔ X = ∅. -Proof. - split; [apply gmultiset_size_empty_inv|]. - by intros ->; rewrite gmultiset_size_empty. -Qed. -Lemma gmultiset_size_non_empty_iff X : size X ≠0 ↔ X ≠∅. -Proof. by rewrite gmultiset_size_empty_iff. Qed. - -Lemma gmultiset_choose_or_empty X : (∃ x, x ∈ X) ∨ X = ∅. -Proof. - destruct (elements X) as [|x l] eqn:HX; [right|left]. - - by apply gmultiset_elements_empty_inv. - - exists x. rewrite <-gmultiset_elem_of_elements, HX. by left. -Qed. -Lemma gmultiset_choose X : X ≠∅ → ∃ x, x ∈ X. -Proof. intros. by destruct (gmultiset_choose_or_empty X). Qed. -Lemma gmultiset_size_pos_elem_of X : 0 < size X → ∃ x, x ∈ X. -Proof. - intros Hsz. destruct (gmultiset_choose_or_empty X) as [|HX]; [done|]. - contradict Hsz. rewrite HX, gmultiset_size_empty; lia. -Qed. - -Lemma gmultiset_size_singleton x : size ({[ x ]} : gmultiset A) = 1. -Proof. - unfold size, gmultiset_size; simpl. by rewrite gmultiset_elements_singleton. -Qed. -Lemma gmultiset_size_union X Y : size (X ∪ Y) = size X + size Y. -Proof. - unfold size, gmultiset_size; simpl. - by rewrite gmultiset_elements_union, app_length. -Qed. - -(* Order stuff *) -Global Instance gmultiset_po : PartialOrder (@subseteq (gmultiset A) _). -Proof. - split; [split|]. - - by intros X x. - - intros X Y Z HXY HYZ x. by trans (multiplicity x Y). - - intros X Y HXY HYX; apply gmultiset_eq; intros x. by apply (anti_symm (≤)). -Qed. - -Lemma gmultiset_subseteq_alt X Y : - X ⊆ Y ↔ - map_relation (≤) (λ _, False) (λ _, True) (gmultiset_car X) (gmultiset_car Y). -Proof. - apply forall_proper; intros x. unfold multiplicity. - destruct (gmultiset_car X !! x), (gmultiset_car Y !! x); naive_solver omega. -Qed. -Global Instance gmultiset_subseteq_dec X Y : Decision (X ⊆ Y). -Proof. - refine (cast_if (decide (map_relation (≤) - (λ _, False) (λ _, True) (gmultiset_car X) (gmultiset_car Y)))); - by rewrite gmultiset_subseteq_alt. -Defined. - -Lemma gmultiset_subset_subseteq X Y : X ⊂ Y → X ⊆ Y. -Proof. apply strict_include. Qed. -Hint Resolve gmultiset_subset_subseteq. - -Lemma gmultiset_empty_subseteq X : ∅ ⊆ X. -Proof. intros x. rewrite multiplicity_empty. omega. Qed. - -Lemma gmultiset_union_subseteq_l X Y : X ⊆ X ∪ Y. -Proof. intros x. rewrite multiplicity_union. omega. Qed. -Lemma gmultiset_union_subseteq_r X Y : Y ⊆ X ∪ Y. -Proof. intros x. rewrite multiplicity_union. omega. Qed. -Lemma gmultiset_union_preserving X1 X2 Y1 Y2 : X1 ⊆ X2 → Y1 ⊆ Y2 → X1 ∪ Y1 ⊆ X2 ∪ Y2. -Proof. intros ?? x. rewrite !multiplicity_union. by apply Nat.add_le_mono. Qed. -Lemma gmultiset_union_preserving_l X Y1 Y2 : Y1 ⊆ Y2 → X ∪ Y1 ⊆ X ∪ Y2. -Proof. intros. by apply gmultiset_union_preserving. Qed. -Lemma gmultiset_union_preserving_r X1 X2 Y : X1 ⊆ X2 → X1 ∪ Y ⊆ X2 ∪ Y. -Proof. intros. by apply gmultiset_union_preserving. Qed. - -Lemma gmultiset_subset X Y : X ⊆ Y → size X < size Y → X ⊂ Y. -Proof. intros. apply strict_spec_alt; split; naive_solver auto with omega. Qed. -Lemma gmultiset_union_subset_l X Y : Y ≠∅ → X ⊂ X ∪ Y. -Proof. - intros HY%gmultiset_size_non_empty_iff. - apply gmultiset_subset; auto using gmultiset_union_subseteq_l. - rewrite gmultiset_size_union; omega. -Qed. -Lemma gmultiset_union_subset_r X Y : X ≠∅ → Y ⊂ X ∪ Y. -Proof. rewrite (comm_L (∪)). apply gmultiset_union_subset_l. Qed. - -Lemma gmultiset_elem_of_singleton_subseteq x X : x ∈ X ↔ {[ x ]} ⊆ X. -Proof. - rewrite elem_of_multiplicity. split. - - intros Hx y; destruct (decide (x = y)) as [->|]. - + rewrite multiplicity_singleton; omega. - + rewrite multiplicity_singleton_ne by done; omega. - - intros Hx. generalize (Hx x). rewrite multiplicity_singleton. omega. -Qed. - -Lemma gmultiset_elem_of_subseteq X1 X2 x : x ∈ X1 → X1 ⊆ X2 → x ∈ X2. -Proof. rewrite !gmultiset_elem_of_singleton_subseteq. by intros ->. Qed. - -Lemma gmultiset_union_difference X Y : X ⊆ Y → Y = X ∪ Y ∖ X. -Proof. - intros HXY. apply gmultiset_eq; intros x; specialize (HXY x). - rewrite multiplicity_union, multiplicity_difference; omega. -Qed. -Lemma gmultiset_union_difference' x Y : x ∈ Y → Y = {[ x ]} ∪ Y ∖ {[ x ]}. -Proof. - intros. by apply gmultiset_union_difference, - gmultiset_elem_of_singleton_subseteq. -Qed. - -Lemma gmultiset_size_difference X Y : Y ⊆ X → size (X ∖ Y) = size X - size Y. -Proof. - intros HX%gmultiset_union_difference. - rewrite HX at 2; rewrite gmultiset_size_union. omega. -Qed. - -Lemma gmultiset_non_empty_difference X Y : X ⊂ Y → Y ∖ X ≠∅. -Proof. - intros [_ HXY2] Hdiff; destruct HXY2; intros x. - generalize (f_equal (multiplicity x) Hdiff). - rewrite multiplicity_difference, multiplicity_empty; omega. -Qed. - -Lemma gmultiset_difference_subset X Y : X ≠∅ → X ⊆ Y → Y ∖ X ⊂ Y. -Proof. - intros. eapply strict_transitive_l; [by apply gmultiset_union_subset_r|]. - by rewrite <-(gmultiset_union_difference X Y). -Qed. - -(* Mononicity *) -Lemma gmultiset_elements_submseteq X Y : X ⊆ Y → elements X ⊆+ elements Y. -Proof. - intros ->%gmultiset_union_difference. rewrite gmultiset_elements_union. - by apply submseteq_inserts_r. -Qed. - -Lemma gmultiset_subseteq_size X Y : X ⊆ Y → size X ≤ size Y. -Proof. intros. by apply submseteq_length, gmultiset_elements_submseteq. Qed. - -Lemma gmultiset_subset_size X Y : X ⊂ Y → size X < size Y. -Proof. - intros HXY. assert (size (Y ∖ X) ≠0). - { by apply gmultiset_size_non_empty_iff, gmultiset_non_empty_difference. } - rewrite (gmultiset_union_difference X Y), gmultiset_size_union by auto. lia. -Qed. - -(* Well-foundedness *) -Lemma gmultiset_wf : wf (strict (@subseteq (gmultiset A) _)). -Proof. - apply (wf_projected (<) size); auto using gmultiset_subset_size, lt_wf. -Qed. - -Lemma gmultiset_ind (P : gmultiset A → Prop) : - P ∅ → (∀ x X, P X → P ({[ x ]} ∪ X)) → ∀ X, P X. -Proof. - intros Hemp Hinsert X. induction (gmultiset_wf X) as [X _ IH]. - destruct (gmultiset_choose_or_empty X) as [[x Hx]| ->]; auto. - rewrite (gmultiset_union_difference' x X) by done. - apply Hinsert, IH, gmultiset_difference_subset, - gmultiset_elem_of_singleton_subseteq; auto using gmultiset_non_empty_singleton. -Qed. -End lemmas. diff --git a/theories/prelude/hashset.v b/theories/prelude/hashset.v deleted file mode 100644 index 734c42372fda7b5ca00cc3288c098ddfd665d6c6..0000000000000000000000000000000000000000 --- a/theories/prelude/hashset.v +++ /dev/null @@ -1,174 +0,0 @@ -(* Copyright (c) 2012-2017, Robbert Krebbers. *) -(* This file is distributed under the terms of the BSD license. *) -(** This file implements finite set using hash maps. Hash sets are represented -using radix-2 search trees. Each hash bucket is thus indexed using an binary -integer of type [Z], and contains an unordered list without duplicates. *) -From iris.prelude Require Export fin_maps listset. -From iris.prelude Require Import zmap. -Set Default Proof Using "Type". - -Record hashset {A} (hash : A → Z) := Hashset { - hashset_car : Zmap (list A); - hashset_prf : - map_Forall (λ n l, Forall (λ x, hash x = n) l ∧ NoDup l) hashset_car -}. -Arguments Hashset {_ _} _ _. -Arguments hashset_car {_ _} _. - -Section hashset. -Context `{EqDecision A} (hash : A → Z). - -Instance hashset_elem_of: ElemOf A (hashset hash) := λ x m, ∃ l, - hashset_car m !! hash x = Some l ∧ x ∈ l. - -Program Instance hashset_empty: Empty (hashset hash) := Hashset ∅ _. -Next Obligation. by intros n X; simpl_map. Qed. -Program Instance hashset_singleton: Singleton A (hashset hash) := λ x, - Hashset {[ hash x := [x] ]} _. -Next Obligation. - intros x n l [<- <-]%lookup_singleton_Some. - rewrite Forall_singleton; auto using NoDup_singleton. -Qed. -Program Instance hashset_union: Union (hashset hash) := λ m1 m2, - let (m1,Hm1) := m1 in let (m2,Hm2) := m2 in - Hashset (union_with (λ l k, Some (list_union l k)) m1 m2) _. -Next Obligation. - intros _ _ m1 Hm1 m2 Hm2 n l'; rewrite lookup_union_with_Some. - intros [[??]|[[??]|(l&k&?&?&?)]]; simplify_eq/=; auto. - split; [apply Forall_list_union|apply NoDup_list_union]; - first [by eapply Hm1; eauto | by eapply Hm2; eauto]. -Qed. -Program Instance hashset_intersection: Intersection (hashset hash) := λ m1 m2, - let (m1,Hm1) := m1 in let (m2,Hm2) := m2 in - Hashset (intersection_with (λ l k, - let l' := list_intersection l k in guard (l' ≠[]); Some l') m1 m2) _. -Next Obligation. - intros _ _ m1 Hm1 m2 Hm2 n l'. rewrite lookup_intersection_with_Some. - intros (?&?&?&?&?); simplify_option_eq. - split; [apply Forall_list_intersection|apply NoDup_list_intersection]; - first [by eapply Hm1; eauto | by eapply Hm2; eauto]. -Qed. -Program Instance hashset_difference: Difference (hashset hash) := λ m1 m2, - let (m1,Hm1) := m1 in let (m2,Hm2) := m2 in - Hashset (difference_with (λ l k, - let l' := list_difference l k in guard (l' ≠[]); Some l') m1 m2) _. -Next Obligation. - intros _ _ m1 Hm1 m2 Hm2 n l'. rewrite lookup_difference_with_Some. - intros [[??]|(?&?&?&?&?)]; simplify_option_eq; auto. - split; [apply Forall_list_difference|apply NoDup_list_difference]; - first [by eapply Hm1; eauto | by eapply Hm2; eauto]. -Qed. -Instance hashset_elems: Elements A (hashset hash) := λ m, - map_to_list (hashset_car m) ≫= snd. - -Global Instance: FinCollection A (hashset hash). -Proof. - split; [split; [split| |]| |]. - - intros ? (?&?&?); simplify_map_eq/=. - - unfold elem_of, hashset_elem_of, singleton, hashset_singleton; simpl. - intros x y. setoid_rewrite lookup_singleton_Some. split. - { by intros (?&[? <-]&?); decompose_elem_of_list. } - intros ->; eexists [y]. by rewrite elem_of_list_singleton. - - unfold elem_of, hashset_elem_of, union, hashset_union. - intros [m1 Hm1] [m2 Hm2] x; simpl; setoid_rewrite lookup_union_with_Some. - split. - { intros (?&[[]|[[]|(l&k&?&?&?)]]&Hx); simplify_eq/=; eauto. - rewrite elem_of_list_union in Hx; destruct Hx; eauto. } - intros [(l&?&?)|(k&?&?)]. - + destruct (m2 !! hash x) as [k|]; eauto. - exists (list_union l k). rewrite elem_of_list_union. naive_solver. - + destruct (m1 !! hash x) as [l|]; eauto 6. - exists (list_union l k). rewrite elem_of_list_union. naive_solver. - - unfold elem_of, hashset_elem_of, intersection, hashset_intersection. - intros [m1 ?] [m2 ?] x; simpl. - setoid_rewrite lookup_intersection_with_Some. split. - { intros (?&(l&k&?&?&?)&Hx); simplify_option_eq. - rewrite elem_of_list_intersection in Hx; naive_solver. } - intros [(l&?&?) (k&?&?)]. assert (x ∈ list_intersection l k) - by (by rewrite elem_of_list_intersection). - exists (list_intersection l k); split; [exists l, k|]; split_and?; auto. - by rewrite option_guard_True by eauto using elem_of_not_nil. - - unfold elem_of, hashset_elem_of, intersection, hashset_intersection. - intros [m1 ?] [m2 ?] x; simpl. - setoid_rewrite lookup_difference_with_Some. split. - { intros (l'&[[??]|(l&k&?&?&?)]&Hx); simplify_option_eq; - rewrite ?elem_of_list_difference in Hx; naive_solver. } - intros [(l&?&?) Hm2]; destruct (m2 !! hash x) as [k|] eqn:?; eauto. - destruct (decide (x ∈ k)); [destruct Hm2; eauto|]. - assert (x ∈ list_difference l k) by (by rewrite elem_of_list_difference). - exists (list_difference l k); split; [right; exists l,k|]; split_and?; auto. - by rewrite option_guard_True by eauto using elem_of_not_nil. - - unfold elem_of at 2, hashset_elem_of, elements, hashset_elems. - intros [m Hm] x; simpl. setoid_rewrite elem_of_list_bind. split. - { intros ([n l]&Hx&Hn); simpl in *; rewrite elem_of_map_to_list in Hn. - cut (hash x = n); [intros <-; eauto|]. - eapply (Forall_forall (λ x, hash x = n) l); eauto. eapply Hm; eauto. } - intros (l&?&?). exists (hash x, l); simpl. by rewrite elem_of_map_to_list. - - unfold elements, hashset_elems. intros [m Hm]; simpl. - rewrite map_Forall_to_list in Hm. generalize (NoDup_fst_map_to_list m). - induction Hm as [|[n l] m' [??]]; - csimpl; inversion_clear 1 as [|?? Hn]; [constructor|]. - apply NoDup_app; split_and?; eauto. - setoid_rewrite elem_of_list_bind; intros x ? ([n' l']&?&?); simpl in *. - assert (hash x = n ∧ hash x = n') as [??]; subst. - { split; [eapply (Forall_forall (λ x, hash x = n) l); eauto|]. - eapply (Forall_forall (λ x, hash x = n') l'); eauto. - rewrite Forall_forall in Hm. eapply (Hm (_,_)); eauto. } - destruct Hn; rewrite elem_of_list_fmap; exists (hash x, l'); eauto. -Qed. -End hashset. - -Typeclasses Opaque hashset_elem_of. - -(** These instances are declared using [Hint Extern] to avoid too -eager type class search. *) -Hint Extern 1 (ElemOf _ (hashset _)) => - eapply @hashset_elem_of : typeclass_instances. -Hint Extern 1 (Empty (hashset _)) => - eapply @hashset_empty : typeclass_instances. -Hint Extern 1 (Singleton _ (hashset _)) => - eapply @hashset_singleton : typeclass_instances. -Hint Extern 1 (Union (hashset _)) => - eapply @hashset_union : typeclass_instances. -Hint Extern 1 (Intersection (hashset _)) => - eapply @hashset_intersection : typeclass_instances. -Hint Extern 1 (Difference (hashset _)) => - eapply @hashset_difference : typeclass_instances. -Hint Extern 1 (Elements _ (hashset _)) => - eapply @hashset_elems : typeclass_instances. - -Section remove_duplicates. -Context `{EqDecision A} (hash : A → Z). - -Definition remove_dups_fast (l : list A) : list A := - match l with - | [] => [] - | [x] => [x] - | _ => - let n : Z := length l in - elements (foldr (λ x, ({[ x ]} ∪)) ∅ l : - hashset (λ x, hash x `mod` (2 * n))%Z) - end. -Lemma elem_of_remove_dups_fast l x : x ∈ remove_dups_fast l ↔ x ∈ l. -Proof. - destruct l as [|x1 [|x2 l]]; try reflexivity. - unfold remove_dups_fast; generalize (x1 :: x2 :: l); clear l; intros l. - generalize (λ x, hash x `mod` (2 * length l))%Z; intros f. - rewrite elem_of_elements; split. - - revert x. induction l as [|y l IH]; intros x; simpl. - { by rewrite elem_of_empty. } - rewrite elem_of_union, elem_of_singleton. intros [->|]; [left|right]; eauto. - - induction 1; set_solver. -Qed. -Lemma NoDup_remove_dups_fast l : NoDup (remove_dups_fast l). -Proof. - unfold remove_dups_fast; destruct l as [|x1 [|x2 l]]. - apply NoDup_nil_2. apply NoDup_singleton. apply NoDup_elements. -Qed. -Definition listset_normalize (X : listset A) : listset A := - let (l) := X in Listset (remove_dups_fast l). -Lemma listset_normalize_correct X : listset_normalize X ≡ X. -Proof. - destruct X as [l]. apply elem_of_equiv; intro; apply elem_of_remove_dups_fast. -Qed. -End remove_duplicates. diff --git a/theories/prelude/hlist.v b/theories/prelude/hlist.v deleted file mode 100644 index 26077a1d539ee32dc03cef1a03a669a1591b3827..0000000000000000000000000000000000000000 --- a/theories/prelude/hlist.v +++ /dev/null @@ -1,61 +0,0 @@ -From iris.prelude Require Import tactics. -Set Default Proof Using "Type". -Local Set Universe Polymorphism. - -(* Not using [list Type] in order to avoid universe inconsistencies *) -Inductive tlist := tnil : tlist | tcons : Type → tlist → tlist. - -Inductive hlist : tlist → Type := - | hnil : hlist tnil - | hcons {A As} : A → hlist As → hlist (tcons A As). - -Fixpoint tapp (As Bs : tlist) : tlist := - match As with tnil => Bs | tcons A As => tcons A (tapp As Bs) end. -Fixpoint happ {As Bs} (xs : hlist As) (ys : hlist Bs) : hlist (tapp As Bs) := - match xs with hnil => ys | hcons _ _ x xs => hcons x (happ xs ys) end. - -Fixpoint hhead {A As} (xs : hlist (tcons A As)) : A := - match xs with hnil => () | hcons _ _ x _ => x end. -Fixpoint htail {A As} (xs : hlist (tcons A As)) : hlist As := - match xs with hnil => () | hcons _ _ _ xs => xs end. - -Fixpoint hheads {As Bs} : hlist (tapp As Bs) → hlist As := - match As with - | tnil => λ _, hnil - | tcons A As => λ xs, hcons (hhead xs) (hheads (htail xs)) - end. -Fixpoint htails {As Bs} : hlist (tapp As Bs) → hlist Bs := - match As with - | tnil => id - | tcons A As => λ xs, htails (htail xs) - end. - -Fixpoint himpl (As : tlist) (B : Type) : Type := - match As with tnil => B | tcons A As => A → himpl As B end. - -Definition hinit {B} (y : B) : himpl tnil B := y. -Definition hlam {A As B} (f : A → himpl As B) : himpl (tcons A As) B := f. -Arguments hlam _ _ _ _ _/. - -Definition hcurry {As B} (f : himpl As B) (xs : hlist As) : B := - (fix go As xs := - match xs in hlist As return himpl As B → B with - | hnil => λ f, f - | hcons A As x xs => λ f, go As xs (f x) - end) _ xs f. -Coercion hcurry : himpl >-> Funclass. - -Fixpoint huncurry {As B} : (hlist As → B) → himpl As B := - match As with - | tnil => λ f, f hnil - | tcons x xs => λ f, hlam (λ x, huncurry (f ∘ hcons x)) - end. - -Lemma hcurry_uncurry {As B} (f : hlist As → B) xs : huncurry f xs = f xs. -Proof. by induction xs as [|A As x xs IH]; simpl; rewrite ?IH. Qed. - -Fixpoint hcompose {As B C} (f : B → C) {struct As} : himpl As B → himpl As C := - match As with - | tnil => f - | tcons A As => λ g, hlam (λ x, hcompose f (g x)) - end. diff --git a/theories/prelude/lexico.v b/theories/prelude/lexico.v deleted file mode 100644 index 32db154ea587adebaa3a2c9dfc18748aaff7776f..0000000000000000000000000000000000000000 --- a/theories/prelude/lexico.v +++ /dev/null @@ -1,154 +0,0 @@ -(* Copyright (c) 2012-2017, 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. *) -From iris.prelude Require Import numbers. -Set Default Proof Using "Type". - -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.) *) lexico (p1.1) (p2.1) ∨ - (**i 2.) *) p1.1 = p2.1 ∧ lexico (p1.2) (p2.2). - -Instance bool_lexico : Lexico bool := λ b1 b2, - match b1, b2 with false, true => True | _, _ => False end. -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 - | x1 :: l1, x2 :: l2 => lexico (x1,l1) (x2,l2) - | _, _ => False - end. -Instance sig_lexico `{Lexico A} (P : A → Prop) `{∀ x, ProofIrrel (P x)} : - Lexico (sig P) := λ x1 x2, lexico (`x1) (`x2). - -Lemma prod_lexico_irreflexive `{Lexico A, Lexico B, !Irreflexive (@lexico A _)} - (x : A) (y : B) : complement lexico y y → complement lexico (x,y) (x,y). -Proof. intros ? [?|[??]]. by apply (irreflexivity lexico x). done. Qed. -Lemma prod_lexico_transitive `{Lexico A, Lexico B, !Transitive (@lexico A _)} - (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_eq/=; auto. - by left; trans x2. -Qed. - -Instance prod_lexico_po `{Lexico A, Lexico B, !StrictOrder (@lexico A _)} - `{!StrictOrder (@lexico B _)} : StrictOrder (@lexico (A * B) _). -Proof. - split. - - intros [x y]. apply prod_lexico_irreflexive. - by apply (irreflexivity lexico y). - - intros [??] [??] [??] ??. - eapply prod_lexico_transitive; eauto. apply transitivity. -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 (p1.1) (p2.1) with - | inleft (left _) => inleft (left _) - | inleft (right _) => cast_trichotomy (trichotomyT lexico (p1.2) (p2.2)) - | inright _ => inright _ - end); clear tA tB; - abstract (unfold lexico, prod_lexico; auto using injective_projections). -Defined. - -Instance bool_lexico_po : StrictOrder (@lexico bool _). -Proof. split. by intros [] ?. by intros [] [] [] ??. 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. - -Instance nat_lexico_po : StrictOrder (@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 (nat_compare_Lt_lt _ _ H)) - | Eq => λ H, inleft (right (nat_compare_eq _ _ H)) - | Gt => λ H, inright (nat_compare_Gt_gt _ _ H) - end eq_refl). -Defined. - -Instance N_lexico_po : StrictOrder (@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.compare_lt_iff _ _) H)) - | Eq => λ H, inleft (right (N.compare_eq _ _ H)) - | Gt => λ H, inright (proj1 (N.compare_gt_iff _ _) H) - end eq_refl). -Defined. - -Instance Z_lexico_po : StrictOrder (@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.compare_lt_iff _ _) H)) - | Eq => λ H, inleft (right (Z.compare_eq _ _ H)) - | Gt => λ H, inright (proj1 (Z.compare_gt_iff _ _) H) - end eq_refl). -Defined. - -Instance list_lexico_po `{Lexico A, !StrictOrder (@lexico A _)} : - StrictOrder (@lexico (list A) _). -Proof. - split. - - intros l. induction l. by intros ?. by apply prod_lexico_irreflexive. - - intros l1. induction l1 as [|x1 l1]; intros [|x2 l2] [|x3 l3] ??; try done. - eapply prod_lexico_transitive; eauto. -Qed. -Instance list_lexico_trichotomy `{Lexico A, tA : !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 tA go go'; - abstract (repeat (done || constructor || congruence || by inversion 1)). -Defined. - -Instance sig_lexico_po `{Lexico A, !StrictOrder (@lexico A _)} - (P : A → Prop) `{∀ x, ProofIrrel (P x)} : StrictOrder (@lexico (sig P) _). -Proof. - unfold lexico, sig_lexico. split. - - intros [x ?] ?. by apply (irreflexivity lexico x). - - intros [x1 ?] [x2 ?] [x3 ?] ??. by trans x2. -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. diff --git a/theories/prelude/list.v b/theories/prelude/list.v deleted file mode 100644 index a983b1118330e7ed6ba0477bd84e812f734945d2..0000000000000000000000000000000000000000 --- a/theories/prelude/list.v +++ /dev/null @@ -1,3724 +0,0 @@ -(* Copyright (c) 2012-2017, Robbert Krebbers. *) -(* This file is distributed under the terms of the BSD license. *) -(** This file collects general purpose definitions and theorems on lists that -are not in the Coq standard library. *) -From Coq Require Export Permutation. -From iris.prelude Require Export numbers base option. -Set Default Proof Using "Type*". - -Arguments length {_} _. -Arguments cons {_} _ _. -Arguments app {_} _ _. - -Instance: Params (@length) 1. -Instance: Params (@cons) 1. -Instance: Params (@app) 1. - -Notation tail := tl. -Notation take := firstn. -Notation drop := skipn. - -Arguments tail {_} _. -Arguments take {_} !_ !_ /. -Arguments drop {_} !_ !_ /. - -Instance: Params (@tail) 1. -Instance: Params (@take) 1. -Instance: Params (@drop) 1. - -Arguments Permutation {_} _ _. -Arguments Forall_cons {_} _ _ _ _ _. -Remove Hints Permutation_cons : typeclass_instances. - -Notation "(::)" := cons (only parsing) : C_scope. -Notation "( x ::)" := (cons x) (only parsing) : C_scope. -Notation "(:: l )" := (λ x, cons x l) (only parsing) : C_scope. -Notation "(++)" := app (only parsing) : C_scope. -Notation "( l ++)" := (app l) (only parsing) : C_scope. -Notation "(++ k )" := (λ l, app l k) (only parsing) : C_scope. - -Infix "≡ₚ" := Permutation (at level 70, no associativity) : C_scope. -Notation "(≡ₚ)" := Permutation (only parsing) : C_scope. -Notation "( x ≡ₚ)" := (Permutation x) (only parsing) : C_scope. -Notation "(≡ₚ x )" := (λ y, y ≡ₚ x) (only parsing) : C_scope. -Notation "(≢ₚ)" := (λ x y, ¬x ≡ₚ y) (only parsing) : C_scope. -Notation "x ≢ₚ y":= (¬x ≡ₚ y) (at level 70, no associativity) : C_scope. -Notation "( x ≢ₚ)" := (λ y, x ≢ₚ y) (only parsing) : C_scope. -Notation "(≢ₚ x )" := (λ y, y ≢ₚ x) (only parsing) : C_scope. - -Instance maybe_cons {A} : Maybe2 (@cons A) := λ l, - match l with x :: l => Some (x,l) | _ => None end. - -(** * Definitions *) -(** Setoid equality lifted to lists *) -Inductive list_equiv `{Equiv A} : Equiv (list A) := - | nil_equiv : [] ≡ [] - | cons_equiv x y l k : x ≡ y → l ≡ k → x :: l ≡ y :: k. -Existing Instance list_equiv. - -(** The operation [l !! i] gives the [i]th element of the list [l], or [None] -in case [i] is out of bounds. *) -Instance list_lookup {A} : Lookup nat A (list A) := - fix go i l {struct l} : option A := let _ : Lookup _ _ _ := @go in - match l with - | [] => None | x :: l => match i with 0 => Some x | S i => l !! i end - end. - -(** The operation [alter f i l] applies the function [f] to the [i]th element -of [l]. In case [i] is out of bounds, the list is returned unchanged. *) -Instance list_alter {A} : Alter nat A (list A) := λ f, - fix go i l {struct l} := - match l with - | [] => [] - | x :: l => match i with 0 => f x :: l | S i => x :: go i l end - end. - -(** The operation [<[i:=x]> l] overwrites the element at position [i] with the -value [x]. In case [i] is out of bounds, the list is returned unchanged. *) -Instance list_insert {A} : Insert nat A (list A) := - fix go i y l {struct l} := let _ : Insert _ _ _ := @go in - match l with - | [] => [] - | x :: l => match i with 0 => y :: l | S i => x :: <[i:=y]>l end - end. -Fixpoint list_inserts {A} (i : nat) (k l : list A) : list A := - match k with - | [] => l - | y :: k => <[i:=y]>(list_inserts (S i) k l) - end. -Instance: Params (@list_inserts) 1. - -(** The operation [delete i l] removes the [i]th element of [l] and moves -all consecutive elements one position ahead. In case [i] is out of bounds, -the list is returned unchanged. *) -Instance list_delete {A} : Delete nat (list A) := - fix go (i : nat) (l : list A) {struct l} : list A := - match l with - | [] => [] - | x :: l => match i with 0 => l | S i => x :: @delete _ _ go i l end - end. - -(** The function [option_list o] converts an element [Some x] into the -singleton list [[x]], and [None] into the empty list [[]]. *) -Definition option_list {A} : option A → list A := option_rect _ (λ x, [x]) []. -Instance: Params (@option_list) 1. -Instance maybe_list_singleton {A} : Maybe (λ x : A, [x]) := λ l, - match l with [x] => Some x | _ => None end. - -(** The function [filter P l] returns the list of elements of [l] that -satisfies [P]. The order remains unchanged. *) -Instance list_filter {A} : Filter A (list A) := - fix go P _ l := let _ : Filter _ _ := @go in - match l with - | [] => [] - | x :: l => if decide (P x) then x :: filter P l else filter P l - end. - -(** The function [list_find P l] returns the first index [i] whose element -satisfies the predicate [P]. *) -Definition list_find {A} P `{∀ x, Decision (P x)} : list A → option (nat * A) := - fix go l := - match l with - | [] => None - | x :: l => if decide (P x) then Some (0,x) else prod_map S id <$> go l - end. -Instance: Params (@list_find) 3. - -(** The function [replicate n x] generates a list with length [n] of elements -with value [x]. *) -Fixpoint replicate {A} (n : nat) (x : A) : list A := - match n with 0 => [] | S n => x :: replicate n x end. -Instance: Params (@replicate) 2. - -(** The function [reverse l] returns the elements of [l] in reverse order. *) -Definition reverse {A} (l : list A) : list A := rev_append l []. -Instance: Params (@reverse) 1. - -(** The function [last l] returns the last element of the list [l], or [None] -if the list [l] is empty. *) -Fixpoint last {A} (l : list A) : option A := - match l with [] => None | [x] => Some x | _ :: l => last l end. -Instance: Params (@last) 1. - -(** The function [resize n y l] takes the first [n] elements of [l] in case -[length l ≤ n], and otherwise appends elements with value [x] to [l] to obtain -a list of length [n]. *) -Fixpoint resize {A} (n : nat) (y : A) (l : list A) : list A := - match l with - | [] => replicate n y - | x :: l => match n with 0 => [] | S n => x :: resize n y l end - end. -Arguments resize {_} !_ _ !_. -Instance: Params (@resize) 2. - -(** The function [reshape k l] transforms [l] into a list of lists whose sizes -are specified by [k]. In case [l] is too short, the resulting list will be -padded with empty lists. In case [l] is too long, it will be truncated. *) -Fixpoint reshape {A} (szs : list nat) (l : list A) : list (list A) := - match szs with - | [] => [] | sz :: szs => take sz l :: reshape szs (drop sz l) - end. -Instance: Params (@reshape) 2. - -Definition sublist_lookup {A} (i n : nat) (l : list A) : option (list A) := - guard (i + n ≤ length l); Some (take n (drop i l)). -Definition sublist_alter {A} (f : list A → list A) - (i n : nat) (l : list A) : list A := - take i l ++ f (take n (drop i l)) ++ drop (i + n) l. - -(** Functions to fold over a list. We redefine [foldl] with the arguments in -the same order as in Haskell. *) -Notation foldr := fold_right. -Definition foldl {A B} (f : A → B → A) : A → list B → A := - fix go a l := match l with [] => a | x :: l => go (f a x) l end. - -(** The monadic operations. *) -Instance list_ret: MRet list := λ A x, x :: @nil A. -Instance list_fmap : FMap list := λ A B f, - fix go (l : list A) := match l with [] => [] | x :: l => f x :: go l end. -Instance list_omap : OMap list := λ A B f, - fix go (l : list A) := - match l with - | [] => [] - | x :: l => match f x with Some y => y :: go l | None => go l end - end. -Instance list_bind : MBind list := λ A B f, - fix go (l : list A) := match l with [] => [] | x :: l => f x ++ go l end. -Instance list_join: MJoin list := - fix go A (ls : list (list A)) : list A := - match ls with [] => [] | l :: ls => l ++ @mjoin _ go _ ls end. -Definition mapM `{MBind M, MRet M} {A B} (f : A → M B) : list A → M (list B) := - fix go l := - match l with [] => mret [] | x :: l => y ↠f x; k ↠go l; mret (y :: k) end. - -(** We define stronger variants of map and fold that allow the mapped -function to use the index of the elements. *) -Definition imap_go {A B} (f : nat → A → B) : nat → list A → list B := - fix go (n : nat) (l : list A) := - match l with [] => [] | x :: l => f n x :: go (S n) l end. -Definition imap {A B} (f : nat → A → B) : list A → list B := imap_go f 0. -Arguments imap : simpl never. - -Definition zipped_map {A B} (f : list A → list A → A → B) : - list A → list A → list B := fix go l k := - match k with [] => [] | x :: k => f l k x :: go (x :: l) k end. - -Definition imap2_go {A B C} (f : nat → A → B → C) : - nat → list A → list B → list C:= - fix go (n : nat) (l : list A) (k : list B) := - match l, k with - | [], _ |_, [] => [] | x :: l, y :: k => f n x y :: go (S n) l k - end. -Definition imap2 {A B C} (f : nat → A → B → C) : - list A → list B → list C := imap2_go f 0. - -Inductive zipped_Forall {A} (P : list A → list A → A → Prop) : - list A → list A → Prop := - | zipped_Forall_nil l : zipped_Forall P l [] - | zipped_Forall_cons l k x : - P l k x → zipped_Forall P (x :: l) k → zipped_Forall P l (x :: k). -Arguments zipped_Forall_nil {_ _} _. -Arguments zipped_Forall_cons {_ _} _ _ _ _ _. - -(** The function [mask f βs l] applies the function [f] to elements in [l] at -positions that are [true] in [βs]. *) -Fixpoint mask {A} (f : A → A) (βs : list bool) (l : list A) : list A := - match βs, l with - | β :: βs, x :: l => (if β then f x else x) :: mask f βs l - | _, _ => l - end. - -(** The function [permutations l] yields all permutations of [l]. *) -Fixpoint interleave {A} (x : A) (l : list A) : list (list A) := - match l with - | [] => [[x]]| y :: l => (x :: y :: l) :: ((y ::) <$> interleave x l) - end. -Fixpoint permutations {A} (l : list A) : list (list A) := - match l with [] => [[]] | x :: l => permutations l ≫= interleave x end. - -(** The predicate [suffix] holds if the first list is a suffix of the second. -The predicate [prefix] holds if the first list is a prefix of the second. *) -Definition suffix {A} : relation (list A) := λ l1 l2, ∃ k, l2 = k ++ l1. -Definition prefix {A} : relation (list A) := λ l1 l2, ∃ k, l2 = l1 ++ k. -Infix "`suffix_of`" := suffix (at level 70) : C_scope. -Infix "`prefix_of`" := prefix (at level 70) : C_scope. -Hint Extern 0 (_ `prefix_of` _) => reflexivity. -Hint Extern 0 (_ `suffix_of` _) => reflexivity. - -Section prefix_suffix_ops. - Context `{EqDecision A}. - - Definition max_prefix : list A → list A → list A * list A * list A := - fix go l1 l2 := - match l1, l2 with - | [], l2 => ([], l2, []) - | l1, [] => (l1, [], []) - | x1 :: l1, x2 :: l2 => - if decide_rel (=) x1 x2 - then prod_map id (x1 ::) (go l1 l2) else (x1 :: l1, x2 :: l2, []) - end. - Definition max_suffix (l1 l2 : list A) : list A * list A * list A := - match max_prefix (reverse l1) (reverse l2) with - | (k1, k2, k3) => (reverse k1, reverse k2, reverse k3) - end. - Definition strip_prefix (l1 l2 : list A) := (max_prefix l1 l2).1.2. - Definition strip_suffix (l1 l2 : list A) := (max_suffix l1 l2).1.2. -End prefix_suffix_ops. - -(** A list [l1] is a sublist of [l2] if [l2] is obtained by removing elements -from [l1] without changing the order. *) -Inductive sublist {A} : relation (list A) := - | sublist_nil : sublist [] [] - | sublist_skip x l1 l2 : sublist l1 l2 → sublist (x :: l1) (x :: l2) - | sublist_cons x l1 l2 : sublist l1 l2 → sublist l1 (x :: l2). -Infix "`sublist_of`" := sublist (at level 70) : C_scope. -Hint Extern 0 (_ `sublist_of` _) => reflexivity. - -(** A list [l2] submseteq a list [l1] if [l2] is obtained by removing elements -from [l1] while possiblity changing the order. *) -Inductive submseteq {A} : relation (list A) := - | submseteq_nil : submseteq [] [] - | submseteq_skip x l1 l2 : submseteq l1 l2 → submseteq (x :: l1) (x :: l2) - | submseteq_swap x y l : submseteq (y :: x :: l) (x :: y :: l) - | submseteq_cons x l1 l2 : submseteq l1 l2 → submseteq l1 (x :: l2) - | submseteq_trans l1 l2 l3 : submseteq l1 l2 → submseteq l2 l3 → submseteq l1 l3. -Infix "⊆+" := submseteq (at level 70) : C_scope. -Hint Extern 0 (_ ⊆+ _) => reflexivity. - -(** Removes [x] from the list [l]. The function returns a [Some] when the -+removal succeeds and [None] when [x] is not in [l]. *) -Fixpoint list_remove `{EqDecision A} (x : A) (l : list A) : option (list A) := - match l with - | [] => None - | y :: l => if decide (x = y) then Some l else (y ::) <$> list_remove x l - end. - -(** Removes all elements in the list [k] from the list [l]. The function returns -a [Some] when the removal succeeds and [None] some element of [k] is not in [l]. *) -Fixpoint list_remove_list `{EqDecision A} (k : list A) (l : list A) : option (list A) := - match k with - | [] => Some l | x :: k => list_remove x l ≫= list_remove_list k - end. - -Inductive Forall3 {A B C} (P : A → B → C → Prop) : - list A → list B → list C → Prop := - | Forall3_nil : Forall3 P [] [] [] - | Forall3_cons x y z l k k' : - P x y z → Forall3 P l k k' → Forall3 P (x :: l) (y :: k) (z :: k'). - -(** Set operations on lists *) -Instance list_subseteq {A} : SubsetEq (list A) := λ l1 l2, ∀ x, x ∈ l1 → x ∈ l2. - -Section list_set. - Context `{dec : EqDecision A}. - Global Instance elem_of_list_dec (x : A) : ∀ l, Decision (x ∈ l). - Proof. - refine ( - fix go l := - match l return Decision (x ∈ l) with - | [] => right _ - | y :: l => cast_if_or (decide (x = y)) (go l) - end); clear go dec; subst; try (by constructor); abstract by inversion 1. - Defined. - Fixpoint remove_dups (l : list A) : list A := - match l with - | [] => [] - | x :: l => - if decide_rel (∈) x l then remove_dups l else x :: remove_dups l - end. - Fixpoint list_difference (l k : list A) : list A := - match l with - | [] => [] - | x :: l => - if decide_rel (∈) x k - then list_difference l k else x :: list_difference l k - end. - Definition list_union (l k : list A) : list A := list_difference l k ++ k. - Fixpoint list_intersection (l k : list A) : list A := - match l with - | [] => [] - | x :: l => - if decide_rel (∈) x k - then x :: list_intersection l k else list_intersection l k - end. - Definition list_intersection_with (f : A → A → option A) : - list A → list A → list A := fix go l k := - match l with - | [] => [] - | x :: l => foldr (λ y, - match f x y with None => id | Some z => (z ::) end) (go l k) k - end. -End list_set. - -(** * Basic tactics on lists *) -(** The tactic [discriminate_list] discharges a goal if it submseteq -a list equality involving [(::)] and [(++)] of two lists that have a different -length as one of its hypotheses. *) -Tactic Notation "discriminate_list" hyp(H) := - apply (f_equal length) in H; - repeat (csimpl in H || rewrite app_length in H); exfalso; lia. -Tactic Notation "discriminate_list" := - match goal with H : @eq (list _) _ _ |- _ => discriminate_list H end. - -(** The tactic [simplify_list_eq] simplifies hypotheses involving -equalities on lists using injectivity of [(::)] and [(++)]. Also, it simplifies -lookups in singleton lists. *) -Lemma app_inj_1 {A} (l1 k1 l2 k2 : list A) : - length l1 = length k1 → l1 ++ l2 = k1 ++ k2 → l1 = k1 ∧ l2 = k2. -Proof. revert k1. induction l1; intros [|??]; naive_solver. Qed. -Lemma app_inj_2 {A} (l1 k1 l2 k2 : list A) : - length l2 = length k2 → l1 ++ l2 = k1 ++ k2 → l1 = k1 ∧ l2 = k2. -Proof. - intros ? Hl. apply app_inj_1; auto. - apply (f_equal length) in Hl. rewrite !app_length in Hl. lia. -Qed. -Ltac simplify_list_eq := - repeat match goal with - | _ => progress simplify_eq/= - | H : _ ++ _ = _ ++ _ |- _ => first - [ apply app_inv_head in H | apply app_inv_tail in H - | apply app_inj_1 in H; [destruct H|done] - | apply app_inj_2 in H; [destruct H|done] ] - | H : [?x] !! ?i = Some ?y |- _ => - destruct i; [change (Some x = Some y) in H | discriminate] - end. - -(** * General theorems *) -Section general_properties. -Context {A : Type}. -Implicit Types x y z : A. -Implicit Types l k : list A. - -Global Instance: Inj2 (=) (=) (=) (@cons A). -Proof. by injection 1. Qed. -Global Instance: ∀ k, Inj (=) (=) (k ++). -Proof. intros ???. apply app_inv_head. Qed. -Global Instance: ∀ k, Inj (=) (=) (++ k). -Proof. intros ???. apply app_inv_tail. Qed. -Global Instance: Assoc (=) (@app A). -Proof. intros ???. apply app_assoc. Qed. -Global Instance: LeftId (=) [] (@app A). -Proof. done. Qed. -Global Instance: RightId (=) [] (@app A). -Proof. intro. apply app_nil_r. Qed. - -Lemma app_nil l1 l2 : l1 ++ l2 = [] ↔ l1 = [] ∧ l2 = []. -Proof. split. apply app_eq_nil. by intros [-> ->]. Qed. -Lemma app_singleton l1 l2 x : - l1 ++ l2 = [x] ↔ l1 = [] ∧ l2 = [x] ∨ l1 = [x] ∧ l2 = []. -Proof. split. apply app_eq_unit. by intros [[-> ->]|[-> ->]]. Qed. -Lemma cons_middle x l1 l2 : l1 ++ x :: l2 = l1 ++ [x] ++ l2. -Proof. done. Qed. -Lemma list_eq l1 l2 : (∀ i, l1 !! i = l2 !! i) → l1 = l2. -Proof. - revert l2. induction l1 as [|x l1 IH]; intros [|y l2] H. - - done. - - discriminate (H 0). - - discriminate (H 0). - - f_equal; [by injection (H 0)|]. apply (IH _ $ λ i, H (S i)). -Qed. -Global Instance list_eq_dec {dec : EqDecision A} : EqDecision (list A) := - list_eq_dec dec. -Global Instance list_eq_nil_dec l : Decision (l = []). -Proof. by refine match l with [] => left _ | _ => right _ end. Defined. -Lemma list_singleton_reflect l : - option_reflect (λ x, l = [x]) (length l ≠1) (maybe (λ x, [x]) l). -Proof. by destruct l as [|? []]; constructor. Defined. - -Definition nil_length : length (@nil A) = 0 := eq_refl. -Definition cons_length x l : length (x :: l) = S (length l) := eq_refl. -Lemma nil_or_length_pos l : l = [] ∨ length l ≠0. -Proof. destruct l; simpl; auto with lia. Qed. -Lemma nil_length_inv l : length l = 0 → l = []. -Proof. by destruct l. Qed. -Lemma lookup_nil i : @nil A !! i = None. -Proof. by destruct i. Qed. -Lemma lookup_tail l i : tail l !! i = l !! S i. -Proof. by destruct l. Qed. -Lemma lookup_lt_Some l i x : l !! i = Some x → i < length l. -Proof. revert i. induction l; intros [|?] ?; naive_solver auto with arith. Qed. -Lemma lookup_lt_is_Some_1 l i : is_Some (l !! i) → i < length l. -Proof. intros [??]; eauto using lookup_lt_Some. Qed. -Lemma lookup_lt_is_Some_2 l i : i < length l → is_Some (l !! i). -Proof. revert i. induction l; intros [|?] ?; naive_solver eauto with lia. Qed. -Lemma lookup_lt_is_Some l i : is_Some (l !! i) ↔ i < length l. -Proof. split; auto using lookup_lt_is_Some_1, lookup_lt_is_Some_2. Qed. -Lemma lookup_ge_None l i : l !! i = None ↔ length l ≤ i. -Proof. rewrite eq_None_not_Some, lookup_lt_is_Some. lia. Qed. -Lemma lookup_ge_None_1 l i : l !! i = None → length l ≤ i. -Proof. by rewrite lookup_ge_None. Qed. -Lemma lookup_ge_None_2 l i : length l ≤ i → l !! i = None. -Proof. by rewrite lookup_ge_None. Qed. -Lemma list_eq_same_length l1 l2 n : - length l2 = n → length l1 = n → - (∀ i x y, i < n → l1 !! i = Some x → l2 !! i = Some y → x = y) → l1 = l2. -Proof. - intros <- Hlen Hl; apply list_eq; intros i. destruct (l2 !! i) as [x|] eqn:Hx. - - destruct (lookup_lt_is_Some_2 l1 i) as [y Hy]. - { rewrite Hlen; eauto using lookup_lt_Some. } - rewrite Hy; f_equal; apply (Hl i); eauto using lookup_lt_Some. - - by rewrite lookup_ge_None, Hlen, <-lookup_ge_None. -Qed. -Lemma lookup_app_l l1 l2 i : i < length l1 → (l1 ++ l2) !! i = l1 !! i. -Proof. revert i. induction l1; intros [|?]; naive_solver auto with lia. Qed. -Lemma lookup_app_l_Some l1 l2 i x : l1 !! i = Some x → (l1 ++ l2) !! i = Some x. -Proof. intros. rewrite lookup_app_l; eauto using lookup_lt_Some. Qed. -Lemma lookup_app_r l1 l2 i : - length l1 ≤ i → (l1 ++ l2) !! i = l2 !! (i - length l1). -Proof. revert i. induction l1; intros [|?]; simpl; auto with lia. Qed. -Lemma lookup_app_Some l1 l2 i x : - (l1 ++ l2) !! i = Some x ↔ - l1 !! i = Some x ∨ length l1 ≤ i ∧ l2 !! (i - length l1) = Some x. -Proof. - split. - - revert i. induction l1 as [|y l1 IH]; intros [|i] ?; - simplify_eq/=; auto with lia. - destruct (IH i) as [?|[??]]; auto with lia. - - intros [?|[??]]; auto using lookup_app_l_Some. by rewrite lookup_app_r. -Qed. -Lemma list_lookup_middle l1 l2 x n : - n = length l1 → (l1 ++ x :: l2) !! n = Some x. -Proof. intros ->. by induction l1. Qed. - -Lemma nth_lookup l i d : nth i l d = from_option id d (l !! i). -Proof. revert i. induction l as [|x l IH]; intros [|i]; simpl; auto. Qed. -Lemma nth_lookup_Some l i d x : l !! i = Some x → nth i l d = x. -Proof. rewrite nth_lookup. by intros ->. Qed. -Lemma nth_lookup_or_length l i d : {l !! i = Some (nth i l d)} + {length l ≤ i}. -Proof. - rewrite nth_lookup. destruct (l !! i) eqn:?; eauto using lookup_ge_None_1. -Qed. - -Lemma list_insert_alter l i x : <[i:=x]>l = alter (λ _, x) i l. -Proof. by revert i; induction l; intros []; intros; f_equal/=. Qed. -Lemma alter_length f l i : length (alter f i l) = length l. -Proof. revert i. by induction l; intros [|?]; f_equal/=. Qed. -Lemma insert_length l i x : length (<[i:=x]>l) = length l. -Proof. revert i. by induction l; intros [|?]; f_equal/=. Qed. -Lemma list_lookup_alter f l i : alter f i l !! i = f <$> l !! i. -Proof. revert i. induction l. done. intros [|i]. done. apply (IHl i). Qed. -Lemma list_lookup_alter_ne f l i j : i ≠j → alter f i l !! j = l !! j. -Proof. revert i j. induction l; [done|]. intros [] []; naive_solver. Qed. -Lemma list_lookup_insert l i x : i < length l → <[i:=x]>l !! i = Some x. -Proof. revert i. induction l; intros [|?] ?; f_equal/=; auto with lia. Qed. -Lemma list_lookup_insert_ne l i j x : i ≠j → <[i:=x]>l !! j = l !! j. -Proof. revert i j. induction l; [done|]. intros [] []; naive_solver. Qed. -Lemma list_lookup_insert_Some l i x j y : - <[i:=x]>l !! j = Some y ↔ - i = j ∧ x = y ∧ j < length l ∨ i ≠j ∧ l !! j = Some y. -Proof. - destruct (decide (i = j)) as [->|]; - [split|rewrite list_lookup_insert_ne by done; tauto]. - - intros Hy. assert (j < length l). - { rewrite <-(insert_length l j x); eauto using lookup_lt_Some. } - rewrite list_lookup_insert in Hy by done; naive_solver. - - intros [(?&?&?)|[??]]; rewrite ?list_lookup_insert; naive_solver. -Qed. -Lemma list_insert_commute l i j x y : - i ≠j → <[i:=x]>(<[j:=y]>l) = <[j:=y]>(<[i:=x]>l). -Proof. revert i j. by induction l; intros [|?] [|?] ?; f_equal/=; auto. Qed. -Lemma list_lookup_other l i x : - length l ≠1 → l !! i = Some x → ∃ j y, j ≠i ∧ l !! j = Some y. -Proof. - intros. destruct i, l as [|x0 [|x1 l]]; simplify_eq/=. - - by exists 1, x1. - - by exists 0, x0. -Qed. -Lemma alter_app_l f l1 l2 i : - i < length l1 → alter f i (l1 ++ l2) = alter f i l1 ++ l2. -Proof. revert i. induction l1; intros [|?] ?; f_equal/=; auto with lia. Qed. -Lemma alter_app_r f l1 l2 i : - alter f (length l1 + i) (l1 ++ l2) = l1 ++ alter f i l2. -Proof. revert i. induction l1; intros [|?]; f_equal/=; auto. Qed. -Lemma alter_app_r_alt f l1 l2 i : - length l1 ≤ i → alter f i (l1 ++ l2) = l1 ++ alter f (i - length l1) l2. -Proof. - intros. assert (i = length l1 + (i - length l1)) as Hi by lia. - rewrite Hi at 1. by apply alter_app_r. -Qed. -Lemma list_alter_id f l i : (∀ x, f x = x) → alter f i l = l. -Proof. intros ?. revert i. induction l; intros [|?]; f_equal/=; auto. Qed. -Lemma list_alter_ext f g l k i : - (∀ x, l !! i = Some x → f x = g x) → l = k → alter f i l = alter g i k. -Proof. intros H ->. revert i H. induction k; intros [|?] ?; f_equal/=; auto. Qed. -Lemma list_alter_compose f g l i : - alter (f ∘ g) i l = alter f i (alter g i l). -Proof. revert i. induction l; intros [|?]; f_equal/=; auto. Qed. -Lemma list_alter_commute f g l i j : - i ≠j → alter f i (alter g j l) = alter g j (alter f i l). -Proof. revert i j. induction l; intros [|?][|?] ?; f_equal/=; auto with lia. Qed. -Lemma insert_app_l l1 l2 i x : - i < length l1 → <[i:=x]>(l1 ++ l2) = <[i:=x]>l1 ++ l2. -Proof. revert i. induction l1; intros [|?] ?; f_equal/=; auto with lia. Qed. -Lemma insert_app_r l1 l2 i x : <[length l1+i:=x]>(l1 ++ l2) = l1 ++ <[i:=x]>l2. -Proof. revert i. induction l1; intros [|?]; f_equal/=; auto. Qed. -Lemma insert_app_r_alt l1 l2 i x : - length l1 ≤ i → <[i:=x]>(l1 ++ l2) = l1 ++ <[i - length l1:=x]>l2. -Proof. - intros. assert (i = length l1 + (i - length l1)) as Hi by lia. - rewrite Hi at 1. by apply insert_app_r. -Qed. -Lemma delete_middle l1 l2 x : delete (length l1) (l1 ++ x :: l2) = l1 ++ l2. -Proof. induction l1; f_equal/=; auto. Qed. - -Lemma inserts_length l i k : length (list_inserts i k l) = length l. -Proof. - revert i. induction k; intros ?; csimpl; rewrite ?insert_length; auto. -Qed. -Lemma list_lookup_inserts l i k j : - i ≤ j < i + length k → j < length l → - list_inserts i k l !! j = k !! (j - i). -Proof. - revert i j. induction k as [|y k IH]; csimpl; intros i j ??; [lia|]. - destruct (decide (i = j)) as [->|]. - { by rewrite list_lookup_insert, Nat.sub_diag - by (rewrite inserts_length; lia). } - rewrite list_lookup_insert_ne, IH by lia. - by replace (j - i) with (S (j - S i)) by lia. -Qed. -Lemma list_lookup_inserts_lt l i k j : - j < i → list_inserts i k l !! j = l !! j. -Proof. - revert i j. induction k; intros i j ?; csimpl; - rewrite ?list_lookup_insert_ne by lia; auto with lia. -Qed. -Lemma list_lookup_inserts_ge l i k j : - i + length k ≤ j → list_inserts i k l !! j = l !! j. -Proof. - revert i j. induction k; csimpl; intros i j ?; - rewrite ?list_lookup_insert_ne by lia; auto with lia. -Qed. -Lemma list_lookup_inserts_Some l i k j y : - list_inserts i k l !! j = Some y ↔ - (j < i ∨ i + length k ≤ j) ∧ l !! j = Some y ∨ - i ≤ j < i + length k ∧ j < length l ∧ k !! (j - i) = Some y. -Proof. - destruct (decide (j < i)). - { rewrite list_lookup_inserts_lt by done; intuition lia. } - destruct (decide (i + length k ≤ j)). - { rewrite list_lookup_inserts_ge by done; intuition lia. } - split. - - intros Hy. assert (j < length l). - { rewrite <-(inserts_length l i k); eauto using lookup_lt_Some. } - rewrite list_lookup_inserts in Hy by lia. intuition lia. - - intuition. by rewrite list_lookup_inserts by lia. -Qed. -Lemma list_insert_inserts_lt l i j x k : - i < j → <[i:=x]>(list_inserts j k l) = list_inserts j k (<[i:=x]>l). -Proof. - revert i j. induction k; intros i j ?; simpl; - rewrite 1?list_insert_commute by lia; auto with f_equal. -Qed. - -(** ** Properties of the [elem_of] predicate *) -Lemma not_elem_of_nil x : x ∉ []. -Proof. by inversion 1. Qed. -Lemma elem_of_nil x : x ∈ [] ↔ False. -Proof. intuition. by destruct (not_elem_of_nil x). Qed. -Lemma elem_of_nil_inv l : (∀ x, x ∉ l) → l = []. -Proof. destruct l. done. by edestruct 1; constructor. Qed. -Lemma elem_of_not_nil x l : x ∈ l → l ≠[]. -Proof. intros ? ->. by apply (elem_of_nil x). Qed. -Lemma elem_of_cons l x y : x ∈ y :: l ↔ x = y ∨ x ∈ l. -Proof. by split; [inversion 1; subst|intros [->|?]]; constructor. Qed. -Lemma not_elem_of_cons l x y : x ∉ y :: l ↔ x ≠y ∧ x ∉ l. -Proof. rewrite elem_of_cons. tauto. Qed. -Lemma elem_of_app l1 l2 x : x ∈ l1 ++ l2 ↔ x ∈ l1 ∨ x ∈ l2. -Proof. - induction l1. - - split; [by right|]. intros [Hx|]; [|done]. by destruct (elem_of_nil x). - - simpl. rewrite !elem_of_cons, IHl1. tauto. -Qed. -Lemma not_elem_of_app l1 l2 x : x ∉ l1 ++ l2 ↔ x ∉ l1 ∧ x ∉ l2. -Proof. rewrite elem_of_app. tauto. Qed. -Lemma elem_of_list_singleton x y : x ∈ [y] ↔ x = y. -Proof. rewrite elem_of_cons, elem_of_nil. tauto. Qed. -Global Instance elem_of_list_permutation_proper x : Proper ((≡ₚ) ==> iff) (x ∈). -Proof. induction 1; rewrite ?elem_of_nil, ?elem_of_cons; intuition. Qed. -Lemma elem_of_list_split l x : x ∈ l → ∃ l1 l2, l = l1 ++ x :: l2. -Proof. - induction 1 as [x l|x y l ? [l1 [l2 ->]]]; [by eexists [], l|]. - by exists (y :: l1), l2. -Qed. -Lemma elem_of_list_lookup_1 l x : x ∈ l → ∃ i, l !! i = Some x. -Proof. - induction 1 as [|???? IH]; [by exists 0 |]. - destruct IH as [i ?]; auto. by exists (S i). -Qed. -Lemma elem_of_list_lookup_2 l i x : l !! i = Some x → x ∈ l. -Proof. - revert i. induction l; intros [|i] ?; simplify_eq/=; constructor; eauto. -Qed. -Lemma elem_of_list_lookup l x : x ∈ l ↔ ∃ i, l !! i = Some x. -Proof. firstorder eauto using elem_of_list_lookup_1, elem_of_list_lookup_2. Qed. -Lemma elem_of_list_omap {B} (f : A → option B) l (y : B) : - y ∈ omap f l ↔ ∃ x, x ∈ l ∧ f x = Some y. -Proof. - split. - - induction l as [|x l]; csimpl; repeat case_match; inversion 1; subst; - setoid_rewrite elem_of_cons; naive_solver. - - intros (x&Hx&?). by induction Hx; csimpl; repeat case_match; - simplify_eq; try constructor; auto. -Qed. - -(** ** Properties of the [NoDup] predicate *) -Lemma NoDup_nil : NoDup (@nil A) ↔ True. -Proof. split; constructor. Qed. -Lemma NoDup_cons x l : NoDup (x :: l) ↔ x ∉ l ∧ NoDup l. -Proof. split. by inversion 1. intros [??]. by constructor. Qed. -Lemma NoDup_cons_11 x l : NoDup (x :: l) → x ∉ l. -Proof. rewrite NoDup_cons. by intros [??]. Qed. -Lemma NoDup_cons_12 x l : NoDup (x :: l) → NoDup l. -Proof. rewrite NoDup_cons. by intros [??]. Qed. -Lemma NoDup_singleton x : NoDup [x]. -Proof. constructor. apply not_elem_of_nil. constructor. Qed. -Lemma NoDup_app l k : NoDup (l ++ k) ↔ NoDup l ∧ (∀ x, x ∈ l → x ∉ k) ∧ NoDup k. -Proof. - induction l; simpl. - - rewrite NoDup_nil. setoid_rewrite elem_of_nil. naive_solver. - - rewrite !NoDup_cons. - setoid_rewrite elem_of_cons. setoid_rewrite elem_of_app. naive_solver. -Qed. -Global Instance NoDup_proper: Proper ((≡ₚ) ==> iff) (@NoDup A). -Proof. - induction 1 as [|x l k Hlk IH | |]. - - by rewrite !NoDup_nil. - - by rewrite !NoDup_cons, IH, Hlk. - - rewrite !NoDup_cons, !elem_of_cons. intuition. - - intuition. -Qed. -Lemma NoDup_lookup l i j x : - NoDup l → l !! i = Some x → l !! j = Some x → i = j. -Proof. - intros Hl. revert i j. induction Hl as [|x' l Hx Hl IH]. - { intros; simplify_eq. } - intros [|i] [|j] ??; simplify_eq/=; eauto with f_equal; - exfalso; eauto using elem_of_list_lookup_2. -Qed. -Lemma NoDup_alt l : - NoDup l ↔ ∀ i j x, l !! i = Some x → l !! j = Some x → i = j. -Proof. - split; eauto using NoDup_lookup. - induction l as [|x l IH]; intros Hl; constructor. - - rewrite elem_of_list_lookup. intros [i ?]. - by feed pose proof (Hl (S i) 0 x); auto. - - apply IH. intros i j x' ??. by apply (inj S), (Hl (S i) (S j) x'). -Qed. - -Section no_dup_dec. - Context `{!EqDecision A}. - Global Instance NoDup_dec: ∀ l, Decision (NoDup l) := - fix NoDup_dec l := - match l return Decision (NoDup l) with - | [] => left NoDup_nil_2 - | x :: l => - match decide_rel (∈) x l with - | left Hin => right (λ H, NoDup_cons_11 _ _ H Hin) - | right Hin => - match NoDup_dec l with - | left H => left (NoDup_cons_2 _ _ Hin H) - | right H => right (H ∘ NoDup_cons_12 _ _) - end - end - end. - Lemma elem_of_remove_dups l x : x ∈ remove_dups l ↔ x ∈ l. - Proof. - split; induction l; simpl; repeat case_decide; - rewrite ?elem_of_cons; intuition (simplify_eq; auto). - Qed. - Lemma NoDup_remove_dups l : NoDup (remove_dups l). - Proof. - induction l; simpl; repeat case_decide; try constructor; auto. - by rewrite elem_of_remove_dups. - Qed. -End no_dup_dec. - -(** ** Set operations on lists *) -Section list_set. - Lemma elem_of_list_intersection_with f l k x : - x ∈ list_intersection_with f l k ↔ ∃ x1 x2, - x1 ∈ l ∧ x2 ∈ k ∧ f x1 x2 = Some x. - Proof. - split. - - induction l as [|x1 l IH]; simpl; [by rewrite elem_of_nil|]. - intros Hx. setoid_rewrite elem_of_cons. - cut ((∃ x2, x2 ∈ k ∧ f x1 x2 = Some x) - ∨ x ∈ list_intersection_with f l k); [naive_solver|]. - clear IH. revert Hx. generalize (list_intersection_with f l k). - induction k; simpl; [by auto|]. - case_match; setoid_rewrite elem_of_cons; naive_solver. - - intros (x1&x2&Hx1&Hx2&Hx). induction Hx1 as [x1|x1 ? l ? IH]; simpl. - + generalize (list_intersection_with f l k). - induction Hx2; simpl; [by rewrite Hx; left |]. - case_match; simpl; try setoid_rewrite elem_of_cons; auto. - + generalize (IH Hx). clear Hx IH Hx2. - generalize (list_intersection_with f l k). - induction k; simpl; intros; [done|]. - case_match; simpl; rewrite ?elem_of_cons; auto. - Qed. - - Context `{!EqDecision A}. - Lemma elem_of_list_difference l k x : x ∈ list_difference l k ↔ x ∈ l ∧ x ∉ k. - Proof. - split; induction l; simpl; try case_decide; - rewrite ?elem_of_nil, ?elem_of_cons; intuition congruence. - Qed. - Lemma NoDup_list_difference l k : NoDup l → NoDup (list_difference l k). - Proof. - induction 1; simpl; try case_decide. - - constructor. - - done. - - constructor. rewrite elem_of_list_difference; intuition. done. - Qed. - Lemma elem_of_list_union l k x : x ∈ list_union l k ↔ x ∈ l ∨ x ∈ k. - Proof. - unfold list_union. rewrite elem_of_app, elem_of_list_difference. - intuition. case (decide (x ∈ k)); intuition. - Qed. - Lemma NoDup_list_union l k : NoDup l → NoDup k → NoDup (list_union l k). - Proof. - intros. apply NoDup_app. repeat split. - - by apply NoDup_list_difference. - - intro. rewrite elem_of_list_difference. intuition. - - done. - Qed. - Lemma elem_of_list_intersection l k x : - x ∈ list_intersection l k ↔ x ∈ l ∧ x ∈ k. - Proof. - split; induction l; simpl; repeat case_decide; - rewrite ?elem_of_nil, ?elem_of_cons; intuition congruence. - Qed. - Lemma NoDup_list_intersection l k : NoDup l → NoDup (list_intersection l k). - Proof. - induction 1; simpl; try case_decide. - - constructor. - - constructor. rewrite elem_of_list_intersection; intuition. done. - - done. - Qed. -End list_set. - -(** ** Properties of the [filter] function *) -Section filter. - Context (P : A → Prop) `{∀ x, Decision (P x)}. - Lemma elem_of_list_filter l x : x ∈ filter P l ↔ P x ∧ x ∈ l. - Proof. - unfold filter. induction l; simpl; repeat case_decide; - rewrite ?elem_of_nil, ?elem_of_cons; naive_solver. - Qed. - Lemma NoDup_filter l : NoDup l → NoDup (filter P l). - Proof. - unfold filter. induction 1; simpl; repeat case_decide; - rewrite ?NoDup_nil, ?NoDup_cons, ?elem_of_list_filter; tauto. - Qed. -End filter. - -(** ** Properties of the [find] function *) -Section find. - Context (P : A → Prop) `{∀ x, Decision (P x)}. - Lemma list_find_Some l i x : - list_find P l = Some (i,x) → l !! i = Some x ∧ P x. - Proof. - revert i; induction l; intros [] ?; repeat first - [ match goal with x : prod _ _ |- _ => destruct x end - | simplify_option_eq ]; eauto. - Qed. - Lemma list_find_elem_of l x : x ∈ l → P x → is_Some (list_find P l). - Proof. - induction 1 as [|x y l ? IH]; intros; simplify_option_eq; eauto. - by destruct IH as [[i x'] ->]; [|exists (S i, x')]. - Qed. -End find. - -(** ** Properties of the [reverse] function *) -Lemma reverse_nil : reverse [] = @nil A. -Proof. done. Qed. -Lemma reverse_singleton x : reverse [x] = [x]. -Proof. done. Qed. -Lemma reverse_cons l x : reverse (x :: l) = reverse l ++ [x]. -Proof. unfold reverse. by rewrite <-!rev_alt. Qed. -Lemma reverse_snoc l x : reverse (l ++ [x]) = x :: reverse l. -Proof. unfold reverse. by rewrite <-!rev_alt, rev_unit. Qed. -Lemma reverse_app l1 l2 : reverse (l1 ++ l2) = reverse l2 ++ reverse l1. -Proof. unfold reverse. rewrite <-!rev_alt. apply rev_app_distr. Qed. -Lemma reverse_length l : length (reverse l) = length l. -Proof. unfold reverse. rewrite <-!rev_alt. apply rev_length. Qed. -Lemma reverse_involutive l : reverse (reverse l) = l. -Proof. unfold reverse. rewrite <-!rev_alt. apply rev_involutive. Qed. -Lemma elem_of_reverse_2 x l : x ∈ l → x ∈ reverse l. -Proof. - induction 1; rewrite reverse_cons, elem_of_app, - ?elem_of_list_singleton; intuition. -Qed. -Lemma elem_of_reverse x l : x ∈ reverse l ↔ x ∈ l. -Proof. - split; auto using elem_of_reverse_2. - intros. rewrite <-(reverse_involutive l). by apply elem_of_reverse_2. -Qed. -Global Instance: Inj (=) (=) (@reverse A). -Proof. - intros l1 l2 Hl. - by rewrite <-(reverse_involutive l1), <-(reverse_involutive l2), Hl. -Qed. -Lemma sum_list_with_app (f : A → nat) l k : - sum_list_with f (l ++ k) = sum_list_with f l + sum_list_with f k. -Proof. induction l; simpl; lia. Qed. -Lemma sum_list_with_reverse (f : A → nat) l : - sum_list_with f (reverse l) = sum_list_with f l. -Proof. - induction l; simpl; rewrite ?reverse_cons, ?sum_list_with_app; simpl; lia. -Qed. - -(** ** Properties of the [last] function *) -Lemma last_snoc x l : last (l ++ [x]) = Some x. -Proof. induction l as [|? []]; simpl; auto. Qed. -Lemma last_reverse l : last (reverse l) = head l. -Proof. by destruct l as [|x l]; rewrite ?reverse_cons, ?last_snoc. Qed. -Lemma head_reverse l : head (reverse l) = last l. -Proof. by rewrite <-last_reverse, reverse_involutive. Qed. - -(** ** Properties of the [take] function *) -Definition take_drop i l : take i l ++ drop i l = l := firstn_skipn i l. -Lemma take_drop_middle l i x : - l !! i = Some x → take i l ++ x :: drop (S i) l = l. -Proof. - revert i x. induction l; intros [|?] ??; simplify_eq/=; f_equal; auto. -Qed. -Lemma take_nil n : take n (@nil A) = []. -Proof. by destruct n. Qed. -Lemma take_app l k : take (length l) (l ++ k) = l. -Proof. induction l; f_equal/=; auto. Qed. -Lemma take_app_alt l k n : n = length l → take n (l ++ k) = l. -Proof. intros ->. by apply take_app. Qed. -Lemma take_app3_alt l1 l2 l3 n : n = length l1 → take n ((l1 ++ l2) ++ l3) = l1. -Proof. intros ->. by rewrite <-(assoc_L (++)), take_app. Qed. -Lemma take_app_le l k n : n ≤ length l → take n (l ++ k) = take n l. -Proof. revert n. induction l; intros [|?] ?; f_equal/=; auto with lia. Qed. -Lemma take_plus_app l k n m : - length l = n → take (n + m) (l ++ k) = l ++ take m k. -Proof. intros <-. induction l; f_equal/=; auto. Qed. -Lemma take_app_ge l k n : - length l ≤ n → take n (l ++ k) = l ++ take (n - length l) k. -Proof. revert n. induction l; intros [|?] ?; f_equal/=; auto with lia. Qed. -Lemma take_ge l n : length l ≤ n → take n l = l. -Proof. revert n. induction l; intros [|?] ?; f_equal/=; auto with lia. Qed. -Lemma take_take l n m : take n (take m l) = take (min n m) l. -Proof. revert n m. induction l; intros [|?] [|?]; f_equal/=; auto. Qed. -Lemma take_idemp l n : take n (take n l) = take n l. -Proof. by rewrite take_take, Min.min_idempotent. Qed. -Lemma take_length l n : length (take n l) = min n (length l). -Proof. revert n. induction l; intros [|?]; f_equal/=; done. Qed. -Lemma take_length_le l n : n ≤ length l → length (take n l) = n. -Proof. rewrite take_length. apply Min.min_l. Qed. -Lemma take_length_ge l n : length l ≤ n → length (take n l) = length l. -Proof. rewrite take_length. apply Min.min_r. Qed. -Lemma take_drop_commute l n m : take n (drop m l) = drop m (take (m + n) l). -Proof. - revert n m. induction l; intros [|?][|?]; simpl; auto using take_nil with lia. -Qed. -Lemma lookup_take l n i : i < n → take n l !! i = l !! i. -Proof. revert n i. induction l; intros [|n] [|i] ?; simpl; auto with lia. Qed. -Lemma lookup_take_ge l n i : n ≤ i → take n l !! i = None. -Proof. revert n i. induction l; intros [|?] [|?] ?; simpl; auto with lia. Qed. -Lemma take_alter f l n i : n ≤ i → take n (alter f i l) = take n l. -Proof. - intros. apply list_eq. intros j. destruct (le_lt_dec n j). - - by rewrite !lookup_take_ge. - - by rewrite !lookup_take, !list_lookup_alter_ne by lia. -Qed. -Lemma take_insert l n i x : n ≤ i → take n (<[i:=x]>l) = take n l. -Proof. - intros. apply list_eq. intros j. destruct (le_lt_dec n j). - - by rewrite !lookup_take_ge. - - by rewrite !lookup_take, !list_lookup_insert_ne by lia. -Qed. - -(** ** Properties of the [drop] function *) -Lemma drop_0 l : drop 0 l = l. -Proof. done. Qed. -Lemma drop_nil n : drop n (@nil A) = []. -Proof. by destruct n. Qed. -Lemma drop_length l n : length (drop n l) = length l - n. -Proof. revert n. by induction l; intros [|i]; f_equal/=. Qed. -Lemma drop_ge l n : length l ≤ n → drop n l = []. -Proof. revert n. induction l; intros [|?]; simpl in *; auto with lia. Qed. -Lemma drop_all l : drop (length l) l = []. -Proof. by apply drop_ge. Qed. -Lemma drop_drop l n1 n2 : drop n1 (drop n2 l) = drop (n2 + n1) l. -Proof. revert n2. induction l; intros [|?]; simpl; rewrite ?drop_nil; auto. Qed. -Lemma drop_app_le l k n : - n ≤ length l → drop n (l ++ k) = drop n l ++ k. -Proof. revert n. induction l; intros [|?]; simpl; auto with lia. Qed. -Lemma drop_app l k : drop (length l) (l ++ k) = k. -Proof. by rewrite drop_app_le, drop_all. Qed. -Lemma drop_app_alt l k n : n = length l → drop n (l ++ k) = k. -Proof. intros ->. by apply drop_app. Qed. -Lemma drop_app3_alt l1 l2 l3 n : - n = length l1 → drop n ((l1 ++ l2) ++ l3) = l2 ++ l3. -Proof. intros ->. by rewrite <-(assoc_L (++)), drop_app. Qed. -Lemma drop_app_ge l k n : - length l ≤ n → drop n (l ++ k) = drop (n - length l) k. -Proof. - intros. rewrite <-(Nat.sub_add (length l) n) at 1 by done. - by rewrite Nat.add_comm, <-drop_drop, drop_app. -Qed. -Lemma drop_plus_app l k n m : - length l = n → drop (n + m) (l ++ k) = drop m k. -Proof. intros <-. by rewrite <-drop_drop, drop_app. Qed. -Lemma lookup_drop l n i : drop n l !! i = l !! (n + i). -Proof. revert n i. induction l; intros [|i] ?; simpl; auto. Qed. -Lemma drop_alter f l n i : i < n → drop n (alter f i l) = drop n l. -Proof. - intros. apply list_eq. intros j. - by rewrite !lookup_drop, !list_lookup_alter_ne by lia. -Qed. -Lemma drop_insert l n i x : i < n → drop n (<[i:=x]>l) = drop n l. -Proof. - intros. apply list_eq. intros j. - by rewrite !lookup_drop, !list_lookup_insert_ne by lia. -Qed. -Lemma delete_take_drop l i : delete i l = take i l ++ drop (S i) l. -Proof. revert i. induction l; intros [|?]; f_equal/=; auto. Qed. -Lemma take_take_drop l n m : take n l ++ take m (drop n l) = take (n + m) l. -Proof. revert n m. induction l; intros [|?] [|?]; f_equal/=; auto. Qed. -Lemma drop_take_drop l n m : n ≤ m → drop n (take m l) ++ drop m l = drop n l. -Proof. - revert n m. induction l; intros [|?] [|?] ?; - f_equal/=; auto using take_drop with lia. -Qed. - -(** ** Properties of the [replicate] function *) -Lemma replicate_length n x : length (replicate n x) = n. -Proof. induction n; simpl; auto. Qed. -Lemma lookup_replicate n x y i : - replicate n x !! i = Some y ↔ y = x ∧ i < n. -Proof. - split. - - revert i. induction n; intros [|?]; naive_solver auto with lia. - - intros [-> Hi]. revert i Hi. - induction n; intros [|?]; naive_solver auto with lia. -Qed. -Lemma elem_of_replicate n x y : y ∈ replicate n x ↔ y = x ∧ n ≠0. -Proof. - rewrite elem_of_list_lookup, Nat.neq_0_lt_0. - setoid_rewrite lookup_replicate; naive_solver eauto with lia. -Qed. -Lemma lookup_replicate_1 n x y i : - replicate n x !! i = Some y → y = x ∧ i < n. -Proof. by rewrite lookup_replicate. Qed. -Lemma lookup_replicate_2 n x i : i < n → replicate n x !! i = Some x. -Proof. by rewrite lookup_replicate. Qed. -Lemma lookup_replicate_None n x i : n ≤ i ↔ replicate n x !! i = None. -Proof. - rewrite eq_None_not_Some, Nat.le_ngt. split. - - intros Hin [x' Hx']; destruct Hin. rewrite lookup_replicate in Hx'; tauto. - - intros Hx ?. destruct Hx. exists x; auto using lookup_replicate_2. -Qed. -Lemma insert_replicate x n i : <[i:=x]>(replicate n x) = replicate n x. -Proof. revert i. induction n; intros [|?]; f_equal/=; auto. Qed. -Lemma elem_of_replicate_inv x n y : x ∈ replicate n y → x = y. -Proof. induction n; simpl; rewrite ?elem_of_nil, ?elem_of_cons; intuition. Qed. -Lemma replicate_S n x : replicate (S n) x = x :: replicate n x. -Proof. done. Qed. -Lemma replicate_plus n m x : - replicate (n + m) x = replicate n x ++ replicate m x. -Proof. induction n; f_equal/=; auto. Qed. -Lemma take_replicate n m x : take n (replicate m x) = replicate (min n m) x. -Proof. revert m. by induction n; intros [|?]; f_equal/=. Qed. -Lemma take_replicate_plus n m x : take n (replicate (n + m) x) = replicate n x. -Proof. by rewrite take_replicate, min_l by lia. Qed. -Lemma drop_replicate n m x : drop n (replicate m x) = replicate (m - n) x. -Proof. revert m. by induction n; intros [|?]; f_equal/=. Qed. -Lemma drop_replicate_plus n m x : drop n (replicate (n + m) x) = replicate m x. -Proof. rewrite drop_replicate. f_equal. lia. Qed. -Lemma replicate_as_elem_of x n l : - replicate n x = l ↔ length l = n ∧ ∀ y, y ∈ l → y = x. -Proof. - split; [intros <-; eauto using elem_of_replicate_inv, replicate_length|]. - intros [<- Hl]. symmetry. induction l as [|y l IH]; f_equal/=. - - apply Hl. by left. - - apply IH. intros ??. apply Hl. by right. -Qed. -Lemma reverse_replicate n x : reverse (replicate n x) = replicate n x. -Proof. - symmetry. apply replicate_as_elem_of. - rewrite reverse_length, replicate_length. split; auto. - intros y. rewrite elem_of_reverse. by apply elem_of_replicate_inv. -Qed. -Lemma replicate_false βs n : length βs = n → replicate n false =.>* βs. -Proof. intros <-. by induction βs; simpl; constructor. Qed. - -(** ** Properties of the [resize] function *) -Lemma resize_spec l n x : resize n x l = take n l ++ replicate (n - length l) x. -Proof. revert n. induction l; intros [|?]; f_equal/=; auto. Qed. -Lemma resize_0 l x : resize 0 x l = []. -Proof. by destruct l. Qed. -Lemma resize_nil n x : resize n x [] = replicate n x. -Proof. rewrite resize_spec. rewrite take_nil. f_equal/=. lia. Qed. -Lemma resize_ge l n x : - length l ≤ n → resize n x l = l ++ replicate (n - length l) x. -Proof. intros. by rewrite resize_spec, take_ge. Qed. -Lemma resize_le l n x : n ≤ length l → resize n x l = take n l. -Proof. - intros. rewrite resize_spec, (proj2 (Nat.sub_0_le _ _)) by done. - simpl. by rewrite (right_id_L [] (++)). -Qed. -Lemma resize_all l x : resize (length l) x l = l. -Proof. intros. by rewrite resize_le, take_ge. Qed. -Lemma resize_all_alt l n x : n = length l → resize n x l = l. -Proof. intros ->. by rewrite resize_all. Qed. -Lemma resize_plus l n m x : - resize (n + m) x l = resize n x l ++ resize m x (drop n l). -Proof. - revert n m. induction l; intros [|?] [|?]; f_equal/=; auto. - - by rewrite Nat.add_0_r, (right_id_L [] (++)). - - by rewrite replicate_plus. -Qed. -Lemma resize_plus_eq l n m x : - length l = n → resize (n + m) x l = l ++ replicate m x. -Proof. intros <-. by rewrite resize_plus, resize_all, drop_all, resize_nil. Qed. -Lemma resize_app_le l1 l2 n x : - n ≤ length l1 → resize n x (l1 ++ l2) = resize n x l1. -Proof. - intros. by rewrite !resize_le, take_app_le by (rewrite ?app_length; lia). -Qed. -Lemma resize_app l1 l2 n x : n = length l1 → resize n x (l1 ++ l2) = l1. -Proof. intros ->. by rewrite resize_app_le, resize_all. Qed. -Lemma resize_app_ge l1 l2 n x : - length l1 ≤ n → resize n x (l1 ++ l2) = l1 ++ resize (n - length l1) x l2. -Proof. - intros. rewrite !resize_spec, take_app_ge, (assoc_L (++)) by done. - do 2 f_equal. rewrite app_length. lia. -Qed. -Lemma resize_length l n x : length (resize n x l) = n. -Proof. rewrite resize_spec, app_length, replicate_length, take_length. lia. Qed. -Lemma resize_replicate x n m : resize n x (replicate m x) = replicate n x. -Proof. revert m. induction n; intros [|?]; f_equal/=; auto. Qed. -Lemma resize_resize l n m x : n ≤ m → resize n x (resize m x l) = resize n x l. -Proof. - revert n m. induction l; simpl. - - intros. by rewrite !resize_nil, resize_replicate. - - intros [|?] [|?] ?; f_equal/=; auto with lia. -Qed. -Lemma resize_idemp l n x : resize n x (resize n x l) = resize n x l. -Proof. by rewrite resize_resize. Qed. -Lemma resize_take_le l n m x : n ≤ m → resize n x (take m l) = resize n x l. -Proof. revert n m. induction l; intros [|?][|?] ?; f_equal/=; auto with lia. Qed. -Lemma resize_take_eq l n x : resize n x (take n l) = resize n x l. -Proof. by rewrite resize_take_le. Qed. -Lemma take_resize l n m x : take n (resize m x l) = resize (min n m) x l. -Proof. - revert n m. induction l; intros [|?][|?]; f_equal/=; auto using take_replicate. -Qed. -Lemma take_resize_le l n m x : n ≤ m → take n (resize m x l) = resize n x l. -Proof. intros. by rewrite take_resize, Min.min_l. Qed. -Lemma take_resize_eq l n x : take n (resize n x l) = resize n x l. -Proof. intros. by rewrite take_resize, Min.min_l. Qed. -Lemma take_resize_plus l n m x : take n (resize (n + m) x l) = resize n x l. -Proof. by rewrite take_resize, min_l by lia. Qed. -Lemma drop_resize_le l n m x : - n ≤ m → drop n (resize m x l) = resize (m - n) x (drop n l). -Proof. - revert n m. induction l; simpl. - - intros. by rewrite drop_nil, !resize_nil, drop_replicate. - - intros [|?] [|?] ?; simpl; try case_match; auto with lia. -Qed. -Lemma drop_resize_plus l n m x : - drop n (resize (n + m) x l) = resize m x (drop n l). -Proof. rewrite drop_resize_le by lia. f_equal. lia. Qed. -Lemma lookup_resize l n x i : i < n → i < length l → resize n x l !! i = l !! i. -Proof. - intros ??. destruct (decide (n < length l)). - - by rewrite resize_le, lookup_take by lia. - - by rewrite resize_ge, lookup_app_l by lia. -Qed. -Lemma lookup_resize_new l n x i : - length l ≤ i → i < n → resize n x l !! i = Some x. -Proof. - intros ??. rewrite resize_ge by lia. - replace i with (length l + (i - length l)) by lia. - by rewrite lookup_app_r, lookup_replicate_2 by lia. -Qed. -Lemma lookup_resize_old l n x i : n ≤ i → resize n x l !! i = None. -Proof. intros ?. apply lookup_ge_None_2. by rewrite resize_length. Qed. - -(** ** Properties of the [reshape] function *) -Lemma reshape_length szs l : length (reshape szs l) = length szs. -Proof. revert l. by induction szs; intros; f_equal/=. Qed. -Lemma join_reshape szs l : - sum_list szs = length l → mjoin (reshape szs l) = l. -Proof. - revert l. induction szs as [|sz szs IH]; simpl; intros l Hl; [by destruct l|]. - by rewrite IH, take_drop by (rewrite drop_length; lia). -Qed. -Lemma sum_list_replicate n m : sum_list (replicate m n) = m * n. -Proof. induction m; simpl; auto. Qed. -End general_properties. - -Section more_general_properties. -Context {A : Type}. -Implicit Types x y z : A. -Implicit Types l k : list A. - -(** ** Properties of [sublist_lookup] and [sublist_alter] *) -Lemma sublist_lookup_length l i n k : - sublist_lookup i n l = Some k → length k = n. -Proof. - unfold sublist_lookup; intros; simplify_option_eq. - rewrite take_length, drop_length; lia. -Qed. -Lemma sublist_lookup_all l n : length l = n → sublist_lookup 0 n l = Some l. -Proof. - intros. unfold sublist_lookup; case_option_guard; [|lia]. - by rewrite take_ge by (rewrite drop_length; lia). -Qed. -Lemma sublist_lookup_Some l i n : - i + n ≤ length l → sublist_lookup i n l = Some (take n (drop i l)). -Proof. by unfold sublist_lookup; intros; simplify_option_eq. Qed. -Lemma sublist_lookup_None l i n : - length l < i + n → sublist_lookup i n l = None. -Proof. by unfold sublist_lookup; intros; simplify_option_eq by lia. Qed. -Lemma sublist_eq l k n : - (n | length l) → (n | length k) → - (∀ i, sublist_lookup (i * n) n l = sublist_lookup (i * n) n k) → l = k. -Proof. - revert l k. assert (∀ l i, - n ≠0 → (n | length l) → ¬n * i `div` n + n ≤ length l → length l ≤ i). - { intros l i ? [j ->] Hjn. apply Nat.nlt_ge; contradict Hjn. - rewrite <-Nat.mul_succ_r, (Nat.mul_comm n). - apply Nat.mul_le_mono_r, Nat.le_succ_l, Nat.div_lt_upper_bound; lia. } - intros l k Hl Hk Hlookup. destruct (decide (n = 0)) as [->|]. - { by rewrite (nil_length_inv l), - (nil_length_inv k) by eauto using Nat.divide_0_l. } - apply list_eq; intros i. specialize (Hlookup (i `div` n)). - rewrite (Nat.mul_comm _ n) in Hlookup. - unfold sublist_lookup in *; simplify_option_eq; - [|by rewrite !lookup_ge_None_2 by auto]. - apply (f_equal (!! i `mod` n)) in Hlookup. - by rewrite !lookup_take, !lookup_drop, <-!Nat.div_mod in Hlookup - by (auto using Nat.mod_upper_bound with lia). -Qed. -Lemma sublist_eq_same_length l k j n : - length l = j * n → length k = j * n → - (∀ i,i < j → sublist_lookup (i * n) n l = sublist_lookup (i * n) n k) → l = k. -Proof. - intros Hl Hk ?. destruct (decide (n = 0)) as [->|]. - { by rewrite (nil_length_inv l), (nil_length_inv k) by lia. } - apply sublist_eq with n; [by exists j|by exists j|]. - intros i. destruct (decide (i < j)); [by auto|]. - assert (∀ m, m = j * n → m < i * n + n). - { intros ? ->. replace (i * n + n) with (S i * n) by lia. - apply Nat.mul_lt_mono_pos_r; lia. } - by rewrite !sublist_lookup_None by auto. -Qed. -Lemma sublist_lookup_reshape l i n m : - 0 < n → length l = m * n → - reshape (replicate m n) l !! i = sublist_lookup (i * n) n l. -Proof. - intros Hn Hl. unfold sublist_lookup. apply option_eq; intros x; split. - - intros Hx. case_option_guard as Hi. - { f_equal. clear Hi. revert i l Hl Hx. - induction m as [|m IH]; intros [|i] l ??; simplify_eq/=; auto. - rewrite <-drop_drop. apply IH; rewrite ?drop_length; auto with lia. } - destruct Hi. rewrite Hl, <-Nat.mul_succ_l. - apply Nat.mul_le_mono_r, Nat.le_succ_l. apply lookup_lt_Some in Hx. - by rewrite reshape_length, replicate_length in Hx. - - intros Hx. case_option_guard as Hi; simplify_eq/=. - revert i l Hl Hi. induction m as [|m IH]; [auto with lia|]. - intros [|i] l ??; simpl; [done|]. rewrite <-drop_drop. - rewrite IH; rewrite ?drop_length; auto with lia. -Qed. -Lemma sublist_lookup_compose l1 l2 l3 i n j m : - sublist_lookup i n l1 = Some l2 → sublist_lookup j m l2 = Some l3 → - sublist_lookup (i + j) m l1 = Some l3. -Proof. - unfold sublist_lookup; intros; simplify_option_eq; - repeat match goal with - | H : _ ≤ length _ |- _ => rewrite take_length, drop_length in H - end; rewrite ?take_drop_commute, ?drop_drop, ?take_take, - ?Min.min_l, Nat.add_assoc by lia; auto with lia. -Qed. -Lemma sublist_alter_length f l i n k : - sublist_lookup i n l = Some k → length (f k) = n → - length (sublist_alter f i n l) = length l. -Proof. - unfold sublist_alter, sublist_lookup. intros Hk ?; simplify_option_eq. - rewrite !app_length, Hk, !take_length, !drop_length; lia. -Qed. -Lemma sublist_lookup_alter f l i n k : - sublist_lookup i n l = Some k → length (f k) = n → - sublist_lookup i n (sublist_alter f i n l) = f <$> sublist_lookup i n l. -Proof. - unfold sublist_lookup. intros Hk ?. erewrite sublist_alter_length by eauto. - unfold sublist_alter; simplify_option_eq. - by rewrite Hk, drop_app_alt, take_app_alt by (rewrite ?take_length; lia). -Qed. -Lemma sublist_lookup_alter_ne f l i j n k : - sublist_lookup j n l = Some k → length (f k) = n → i + n ≤ j ∨ j + n ≤ i → - sublist_lookup i n (sublist_alter f j n l) = sublist_lookup i n l. -Proof. - unfold sublist_lookup. intros Hk Hi ?. erewrite sublist_alter_length by eauto. - unfold sublist_alter; simplify_option_eq; f_equal; rewrite Hk. - apply list_eq; intros ii. - destruct (decide (ii < length (f k))); [|by rewrite !lookup_take_ge by lia]. - rewrite !lookup_take, !lookup_drop by done. destruct (decide (i + ii < j)). - { by rewrite lookup_app_l, lookup_take by (rewrite ?take_length; lia). } - rewrite lookup_app_r by (rewrite take_length; lia). - rewrite take_length_le, lookup_app_r, lookup_drop by lia. f_equal; lia. -Qed. -Lemma sublist_alter_all f l n : length l = n → sublist_alter f 0 n l = f l. -Proof. - intros <-. unfold sublist_alter; simpl. - by rewrite drop_all, (right_id_L [] (++)), take_ge. -Qed. -Lemma sublist_alter_compose f g l i n k : - sublist_lookup i n l = Some k → length (f k) = n → length (g k) = n → - sublist_alter (f ∘ g) i n l = sublist_alter f i n (sublist_alter g i n l). -Proof. - unfold sublist_alter, sublist_lookup. intros Hk ??; simplify_option_eq. - by rewrite !take_app_alt, drop_app_alt, !(assoc_L (++)), drop_app_alt, - take_app_alt by (rewrite ?app_length, ?take_length, ?Hk; lia). -Qed. - -(** ** Properties of the [imap] function *) -Lemma imap_nil {B} (f : nat → A → B) : imap f [] = []. -Proof. done. Qed. -Lemma imap_app {B} (f : nat → A → B) l1 l2 : - imap f (l1 ++ l2) = imap f l1 ++ imap (λ n, f (length l1 + n)) l2. -Proof. - unfold imap. generalize 0. revert l2. - induction l1 as [|x l1 IH]; intros l2 n; f_equal/=; auto. - rewrite IH. f_equal. clear. revert n. - induction l2; simpl; auto with f_equal lia. -Qed. -Lemma imap_cons {B} (f : nat → A → B) x l : - imap f (x :: l) = f 0 x :: imap (f ∘ S) l. -Proof. apply (imap_app _ [_]). Qed. - -Lemma imap_ext {B} (f g : nat → A → B) l : - (∀ i x, l !! i = Some x → f i x = g i x) → imap f l = imap g l. -Proof. - revert f g; induction l as [|x l IH]; intros f g Hfg; auto. - rewrite !imap_cons; f_equal; eauto. -Qed. - -Lemma imap_fmap {B C} (f : nat → B → C) (g : A → B) l : - imap f (g <$> l) = imap (λ n, f n ∘ g) l. -Proof. unfold imap. generalize 0. induction l; csimpl; auto with f_equal. Qed. - -Lemma imap_const {B} (f : A → B) l : imap (const f) l = f <$> l. -Proof. unfold imap. generalize 0. induction l; csimpl; auto with f_equal. Qed. - -Lemma list_lookup_imap {B} (f : nat → A → B) l i : imap f l !! i = f i <$> l !! i. -Proof. - revert f i. induction l as [|x l IH]; intros f [|i]; try done. - rewrite imap_cons; simpl. by rewrite IH. -Qed. - -(** ** Properties of the [mask] function *) -Lemma mask_nil f βs : mask f βs (@nil A) = []. -Proof. by destruct βs. Qed. -Lemma mask_length f βs l : length (mask f βs l) = length l. -Proof. revert βs. induction l; intros [|??]; f_equal/=; auto. Qed. -Lemma mask_true f l n : length l ≤ n → mask f (replicate n true) l = f <$> l. -Proof. revert n. induction l; intros [|?] ?; f_equal/=; auto with lia. Qed. -Lemma mask_false f l n : mask f (replicate n false) l = l. -Proof. revert l. induction n; intros [|??]; f_equal/=; auto. Qed. -Lemma mask_app f βs1 βs2 l : - mask f (βs1 ++ βs2) l - = mask f βs1 (take (length βs1) l) ++ mask f βs2 (drop (length βs1) l). -Proof. revert l. induction βs1;intros [|??]; f_equal/=; auto using mask_nil. Qed. -Lemma mask_app_2 f βs l1 l2 : - mask f βs (l1 ++ l2) - = mask f (take (length l1) βs) l1 ++ mask f (drop (length l1) βs) l2. -Proof. revert βs. induction l1; intros [|??]; f_equal/=; auto. Qed. -Lemma take_mask f βs l n : take n (mask f βs l) = mask f (take n βs) (take n l). -Proof. revert n βs. induction l; intros [|?] [|[] ?]; f_equal/=; auto. Qed. -Lemma drop_mask f βs l n : drop n (mask f βs l) = mask f (drop n βs) (drop n l). -Proof. - revert n βs. induction l; intros [|?] [|[] ?]; f_equal/=; auto using mask_nil. -Qed. -Lemma sublist_lookup_mask f βs l i n : - sublist_lookup i n (mask f βs l) - = mask f (take n (drop i βs)) <$> sublist_lookup i n l. -Proof. - unfold sublist_lookup; rewrite mask_length; simplify_option_eq; auto. - by rewrite drop_mask, take_mask. -Qed. -Lemma mask_mask f g βs1 βs2 l : - (∀ x, f (g x) = f x) → βs1 =.>* βs2 → - mask f βs2 (mask g βs1 l) = mask f βs2 l. -Proof. - intros ? Hβs. revert l. by induction Hβs as [|[] []]; intros [|??]; f_equal/=. -Qed. -Lemma lookup_mask f βs l i : - βs !! i = Some true → mask f βs l !! i = f <$> l !! i. -Proof. - revert i βs. induction l; intros [] [] ?; simplify_eq/=; f_equal; auto. -Qed. -Lemma lookup_mask_notin f βs l i : - βs !! i ≠Some true → mask f βs l !! i = l !! i. -Proof. - revert i βs. induction l; intros [] [|[]] ?; simplify_eq/=; auto. -Qed. - -(** ** Properties of the [seq] function *) -Lemma fmap_seq j n : S <$> seq j n = seq (S j) n. -Proof. revert j. induction n; intros; f_equal/=; auto. Qed. -Lemma lookup_seq j n i : i < n → seq j n !! i = Some (j + i). -Proof. - revert j i. induction n as [|n IH]; intros j [|i] ?; simpl; auto with lia. - rewrite IH; auto with lia. -Qed. -Lemma lookup_seq_ge j n i : n ≤ i → seq j n !! i = None. -Proof. revert j i. induction n; intros j [|i] ?; simpl; auto with lia. Qed. -Lemma lookup_seq_inv j n i j' : seq j n !! i = Some j' → j' = j + i ∧ i < n. -Proof. - destruct (le_lt_dec n i); [by rewrite lookup_seq_ge|]. - rewrite lookup_seq by done. intuition congruence. -Qed. - -(** ** Properties of the [Permutation] predicate *) -Lemma Permutation_nil l : l ≡ₚ [] ↔ l = []. -Proof. split. by intro; apply Permutation_nil. by intros ->. Qed. -Lemma Permutation_singleton l x : l ≡ₚ [x] ↔ l = [x]. -Proof. split. by intro; apply Permutation_length_1_inv. by intros ->. Qed. -Definition Permutation_skip := @perm_skip A. -Definition Permutation_swap := @perm_swap A. -Definition Permutation_singleton_inj := @Permutation_length_1 A. - -Global Instance Permutation_cons : Proper ((≡ₚ) ==> (≡ₚ)) (@cons A x). -Proof. by constructor. Qed. -Global Existing Instance Permutation_app'. - -Global Instance: Proper ((≡ₚ) ==> (=)) (@length A). -Proof. induction 1; simpl; auto with lia. Qed. -Global Instance: Comm (≡ₚ) (@app A). -Proof. - intros l1. induction l1 as [|x l1 IH]; intros l2; simpl. - - by rewrite (right_id_L [] (++)). - - rewrite Permutation_middle, IH. simpl. by rewrite Permutation_middle. -Qed. -Global Instance: ∀ x : A, Inj (≡ₚ) (≡ₚ) (x ::). -Proof. red. eauto using Permutation_cons_inv. Qed. -Global Instance: ∀ k : list A, Inj (≡ₚ) (≡ₚ) (k ++). -Proof. - red. induction k as [|x k IH]; intros l1 l2; simpl; auto. - intros. by apply IH, (inj (x ::)). -Qed. -Global Instance: ∀ k : list A, Inj (≡ₚ) (≡ₚ) (++ k). -Proof. intros k l1 l2. rewrite !(comm (++) _ k). by apply (inj (k ++)). Qed. -Lemma replicate_Permutation n x l : replicate n x ≡ₚ l → replicate n x = l. -Proof. - intros Hl. apply replicate_as_elem_of. split. - - by rewrite <-Hl, replicate_length. - - intros y. rewrite <-Hl. by apply elem_of_replicate_inv. -Qed. -Lemma reverse_Permutation l : reverse l ≡ₚ l. -Proof. - induction l as [|x l IH]; [done|]. - by rewrite reverse_cons, (comm (++)), IH. -Qed. -Lemma delete_Permutation l i x : l !! i = Some x → l ≡ₚ x :: delete i l. -Proof. - revert i; induction l as [|y l IH]; intros [|i] ?; simplify_eq/=; auto. - by rewrite Permutation_swap, <-(IH i). -Qed. -Lemma elem_of_Permutation l x : x ∈ l → ∃ k, l ≡ₚ x :: k. -Proof. intros [i ?]%elem_of_list_lookup. eauto using delete_Permutation. Qed. - -(** ** Properties of the [prefix] and [suffix] predicates *) -Global Instance: PreOrder (@prefix A). -Proof. - split. - - intros ?. eexists []. by rewrite (right_id_L [] (++)). - - intros ???[k1->] [k2->]. exists (k1 ++ k2). by rewrite (assoc_L (++)). -Qed. -Lemma prefix_nil l : [] `prefix_of` l. -Proof. by exists l. Qed. -Lemma prefix_nil_not x l : ¬x :: l `prefix_of` []. -Proof. by intros [k ?]. Qed. -Lemma prefix_cons x l1 l2 : l1 `prefix_of` l2 → x :: l1 `prefix_of` x :: l2. -Proof. intros [k ->]. by exists k. Qed. -Lemma prefix_cons_alt x y l1 l2 : - x = y → l1 `prefix_of` l2 → x :: l1 `prefix_of` y :: l2. -Proof. intros ->. apply prefix_cons. Qed. -Lemma prefix_cons_inv_1 x y l1 l2 : x :: l1 `prefix_of` y :: l2 → x = y. -Proof. by intros [k ?]; simplify_eq/=. Qed. -Lemma prefix_cons_inv_2 x y l1 l2 : - x :: l1 `prefix_of` y :: l2 → l1 `prefix_of` l2. -Proof. intros [k ?]; simplify_eq/=. by exists k. Qed. -Lemma prefix_app k l1 l2 : l1 `prefix_of` l2 → k ++ l1 `prefix_of` k ++ l2. -Proof. intros [k' ->]. exists k'. by rewrite (assoc_L (++)). Qed. -Lemma prefix_app_alt k1 k2 l1 l2 : - k1 = k2 → l1 `prefix_of` l2 → k1 ++ l1 `prefix_of` k2 ++ l2. -Proof. intros ->. apply prefix_app. Qed. -Lemma prefix_app_l l1 l2 l3 : l1 ++ l3 `prefix_of` l2 → l1 `prefix_of` l2. -Proof. intros [k ->]. exists (l3 ++ k). by rewrite (assoc_L (++)). Qed. -Lemma prefix_app_r l1 l2 l3 : l1 `prefix_of` l2 → l1 `prefix_of` l2 ++ l3. -Proof. intros [k ->]. exists (k ++ l3). by rewrite (assoc_L (++)). Qed. -Lemma prefix_length l1 l2 : l1 `prefix_of` l2 → length l1 ≤ length l2. -Proof. intros [? ->]. rewrite app_length. lia. Qed. -Lemma prefix_snoc_not l x : ¬l ++ [x] `prefix_of` l. -Proof. intros [??]. discriminate_list. Qed. -Global Instance: PreOrder (@suffix A). -Proof. - split. - - intros ?. by eexists []. - - intros ???[k1->] [k2->]. exists (k2 ++ k1). by rewrite (assoc_L (++)). -Qed. -Global Instance prefix_dec `{!EqDecision A} : ∀ l1 l2, - Decision (l1 `prefix_of` l2) := fix go l1 l2 := - match l1, l2 return { l1 `prefix_of` l2 } + { ¬l1 `prefix_of` l2 } with - | [], _ => left (prefix_nil _) - | _, [] => right (prefix_nil_not _ _) - | x :: l1, y :: l2 => - match decide_rel (=) x y with - | left Hxy => - match go l1 l2 with - | left Hl1l2 => left (prefix_cons_alt _ _ _ _ Hxy Hl1l2) - | right Hl1l2 => right (Hl1l2 ∘ prefix_cons_inv_2 _ _ _ _) - end - | right Hxy => right (Hxy ∘ prefix_cons_inv_1 _ _ _ _) - end - end. - -Section prefix_ops. - Context `{!EqDecision A}. - Lemma max_prefix_fst l1 l2 : - l1 = (max_prefix l1 l2).2 ++ (max_prefix l1 l2).1.1. - Proof. - revert l2. induction l1; intros [|??]; simpl; - repeat case_decide; f_equal/=; auto. - Qed. - Lemma max_prefix_fst_alt l1 l2 k1 k2 k3 : - max_prefix l1 l2 = (k1, k2, k3) → l1 = k3 ++ k1. - Proof. - intros. pose proof (max_prefix_fst l1 l2). - by destruct (max_prefix l1 l2) as [[]?]; simplify_eq. - Qed. - Lemma max_prefix_fst_prefix l1 l2 : (max_prefix l1 l2).2 `prefix_of` l1. - Proof. eexists. apply max_prefix_fst. Qed. - Lemma max_prefix_fst_prefix_alt l1 l2 k1 k2 k3 : - max_prefix l1 l2 = (k1, k2, k3) → k3 `prefix_of` l1. - Proof. eexists. eauto using max_prefix_fst_alt. Qed. - Lemma max_prefix_snd l1 l2 : - l2 = (max_prefix l1 l2).2 ++ (max_prefix l1 l2).1.2. - Proof. - revert l2. induction l1; intros [|??]; simpl; - repeat case_decide; f_equal/=; auto. - Qed. - Lemma max_prefix_snd_alt l1 l2 k1 k2 k3 : - max_prefix l1 l2 = (k1, k2, k3) → l2 = k3 ++ k2. - Proof. - intro. pose proof (max_prefix_snd l1 l2). - by destruct (max_prefix l1 l2) as [[]?]; simplify_eq. - Qed. - Lemma max_prefix_snd_prefix l1 l2 : (max_prefix l1 l2).2 `prefix_of` l2. - Proof. eexists. apply max_prefix_snd. Qed. - Lemma max_prefix_snd_prefix_alt l1 l2 k1 k2 k3 : - max_prefix l1 l2 = (k1,k2,k3) → k3 `prefix_of` l2. - Proof. eexists. eauto using max_prefix_snd_alt. Qed. - Lemma max_prefix_max l1 l2 k : - k `prefix_of` l1 → k `prefix_of` l2 → k `prefix_of` (max_prefix l1 l2).2. - Proof. - intros [l1' ->] [l2' ->]. by induction k; simpl; repeat case_decide; - simpl; auto using prefix_nil, prefix_cons. - Qed. - Lemma max_prefix_max_alt l1 l2 k1 k2 k3 k : - max_prefix l1 l2 = (k1,k2,k3) → - k `prefix_of` l1 → k `prefix_of` l2 → k `prefix_of` k3. - Proof. - intro. pose proof (max_prefix_max l1 l2 k). - by destruct (max_prefix l1 l2) as [[]?]; simplify_eq. - Qed. - Lemma max_prefix_max_snoc l1 l2 k1 k2 k3 x1 x2 : - max_prefix l1 l2 = (x1 :: k1, x2 :: k2, k3) → x1 ≠x2. - Proof. - intros Hl ->. destruct (prefix_snoc_not k3 x2). - eapply max_prefix_max_alt; eauto. - - rewrite (max_prefix_fst_alt _ _ _ _ _ Hl). - apply prefix_app, prefix_cons, prefix_nil. - - rewrite (max_prefix_snd_alt _ _ _ _ _ Hl). - apply prefix_app, prefix_cons, prefix_nil. - Qed. -End prefix_ops. - -Lemma prefix_suffix_reverse l1 l2 : - l1 `prefix_of` l2 ↔ reverse l1 `suffix_of` reverse l2. -Proof. - split; intros [k E]; exists (reverse k). - - by rewrite E, reverse_app. - - by rewrite <-(reverse_involutive l2), E, reverse_app, reverse_involutive. -Qed. -Lemma suffix_prefix_reverse l1 l2 : - l1 `suffix_of` l2 ↔ reverse l1 `prefix_of` reverse l2. -Proof. by rewrite prefix_suffix_reverse, !reverse_involutive. Qed. -Lemma suffix_nil l : [] `suffix_of` l. -Proof. exists l. by rewrite (right_id_L [] (++)). Qed. -Lemma suffix_nil_inv l : l `suffix_of` [] → l = []. -Proof. by intros [[|?] ?]; simplify_list_eq. Qed. -Lemma suffix_cons_nil_inv x l : ¬x :: l `suffix_of` []. -Proof. by intros [[] ?]. Qed. -Lemma suffix_snoc l1 l2 x : - l1 `suffix_of` l2 → l1 ++ [x] `suffix_of` l2 ++ [x]. -Proof. intros [k ->]. exists k. by rewrite (assoc_L (++)). Qed. -Lemma suffix_snoc_alt x y l1 l2 : - x = y → l1 `suffix_of` l2 → l1 ++ [x] `suffix_of` l2 ++ [y]. -Proof. intros ->. apply suffix_snoc. Qed. -Lemma suffix_app l1 l2 k : l1 `suffix_of` l2 → l1 ++ k `suffix_of` l2 ++ k. -Proof. intros [k' ->]. exists k'. by rewrite (assoc_L (++)). Qed. -Lemma suffix_app_alt l1 l2 k1 k2 : - k1 = k2 → l1 `suffix_of` l2 → l1 ++ k1 `suffix_of` l2 ++ k2. -Proof. intros ->. apply suffix_app. Qed. -Lemma suffix_snoc_inv_1 x y l1 l2 : - l1 ++ [x] `suffix_of` l2 ++ [y] → x = y. -Proof. intros [k' E]. rewrite (assoc_L (++)) in E. by simplify_list_eq. Qed. -Lemma suffix_snoc_inv_2 x y l1 l2 : - l1 ++ [x] `suffix_of` l2 ++ [y] → l1 `suffix_of` l2. -Proof. - intros [k' E]. exists k'. rewrite (assoc_L (++)) in E. by simplify_list_eq. -Qed. -Lemma suffix_app_inv l1 l2 k : - l1 ++ k `suffix_of` l2 ++ k → l1 `suffix_of` l2. -Proof. - intros [k' E]. exists k'. rewrite (assoc_L (++)) in E. by simplify_list_eq. -Qed. -Lemma suffix_cons_l l1 l2 x : x :: l1 `suffix_of` l2 → l1 `suffix_of` l2. -Proof. intros [k ->]. exists (k ++ [x]). by rewrite <-(assoc_L (++)). Qed. -Lemma suffix_app_l l1 l2 l3 : l3 ++ l1 `suffix_of` l2 → l1 `suffix_of` l2. -Proof. intros [k ->]. exists (k ++ l3). by rewrite <-(assoc_L (++)). Qed. -Lemma suffix_cons_r l1 l2 x : l1 `suffix_of` l2 → l1 `suffix_of` x :: l2. -Proof. intros [k ->]. by exists (x :: k). Qed. -Lemma suffix_app_r l1 l2 l3 : l1 `suffix_of` l2 → l1 `suffix_of` l3 ++ l2. -Proof. intros [k ->]. exists (l3 ++ k). by rewrite (assoc_L (++)). Qed. -Lemma suffix_cons_inv l1 l2 x y : - x :: l1 `suffix_of` y :: l2 → x :: l1 = y :: l2 ∨ x :: l1 `suffix_of` l2. -Proof. - intros [[|? k] E]; [by left|]. right. simplify_eq/=. by apply suffix_app_r. -Qed. -Lemma suffix_length l1 l2 : l1 `suffix_of` l2 → length l1 ≤ length l2. -Proof. intros [? ->]. rewrite app_length. lia. Qed. -Lemma suffix_cons_not x l : ¬x :: l `suffix_of` l. -Proof. intros [??]. discriminate_list. Qed. -Global Instance suffix_dec `{!EqDecision A} l1 l2 : - Decision (l1 `suffix_of` l2). -Proof. - refine (cast_if (decide_rel prefix (reverse l1) (reverse l2))); - abstract (by rewrite suffix_prefix_reverse). -Defined. - -Section max_suffix. - Context `{!EqDecision A}. - - Lemma max_suffix_fst l1 l2 : - l1 = (max_suffix l1 l2).1.1 ++ (max_suffix l1 l2).2. - Proof. - rewrite <-(reverse_involutive l1) at 1. - rewrite (max_prefix_fst (reverse l1) (reverse l2)). unfold max_suffix. - destruct (max_prefix (reverse l1) (reverse l2)) as ((?&?)&?); simpl. - by rewrite reverse_app. - Qed. - Lemma max_suffix_fst_alt l1 l2 k1 k2 k3 : - max_suffix l1 l2 = (k1, k2, k3) → l1 = k1 ++ k3. - Proof. - intro. pose proof (max_suffix_fst l1 l2). - by destruct (max_suffix l1 l2) as [[]?]; simplify_eq. - Qed. - Lemma max_suffix_fst_suffix l1 l2 : (max_suffix l1 l2).2 `suffix_of` l1. - Proof. eexists. apply max_suffix_fst. Qed. - Lemma max_suffix_fst_suffix_alt l1 l2 k1 k2 k3 : - max_suffix l1 l2 = (k1, k2, k3) → k3 `suffix_of` l1. - Proof. eexists. eauto using max_suffix_fst_alt. Qed. - Lemma max_suffix_snd l1 l2 : - l2 = (max_suffix l1 l2).1.2 ++ (max_suffix l1 l2).2. - Proof. - rewrite <-(reverse_involutive l2) at 1. - rewrite (max_prefix_snd (reverse l1) (reverse l2)). unfold max_suffix. - destruct (max_prefix (reverse l1) (reverse l2)) as ((?&?)&?); simpl. - by rewrite reverse_app. - Qed. - Lemma max_suffix_snd_alt l1 l2 k1 k2 k3 : - max_suffix l1 l2 = (k1,k2,k3) → l2 = k2 ++ k3. - Proof. - intro. pose proof (max_suffix_snd l1 l2). - by destruct (max_suffix l1 l2) as [[]?]; simplify_eq. - Qed. - Lemma max_suffix_snd_suffix l1 l2 : (max_suffix l1 l2).2 `suffix_of` l2. - Proof. eexists. apply max_suffix_snd. Qed. - Lemma max_suffix_snd_suffix_alt l1 l2 k1 k2 k3 : - max_suffix l1 l2 = (k1,k2,k3) → k3 `suffix_of` l2. - Proof. eexists. eauto using max_suffix_snd_alt. Qed. - Lemma max_suffix_max l1 l2 k : - k `suffix_of` l1 → k `suffix_of` l2 → k `suffix_of` (max_suffix l1 l2).2. - Proof. - generalize (max_prefix_max (reverse l1) (reverse l2)). - rewrite !suffix_prefix_reverse. unfold max_suffix. - destruct (max_prefix (reverse l1) (reverse l2)) as ((?&?)&?); simpl. - rewrite reverse_involutive. auto. - Qed. - Lemma max_suffix_max_alt l1 l2 k1 k2 k3 k : - max_suffix l1 l2 = (k1, k2, k3) → - k `suffix_of` l1 → k `suffix_of` l2 → k `suffix_of` k3. - Proof. - intro. pose proof (max_suffix_max l1 l2 k). - by destruct (max_suffix l1 l2) as [[]?]; simplify_eq. - Qed. - Lemma max_suffix_max_snoc l1 l2 k1 k2 k3 x1 x2 : - max_suffix l1 l2 = (k1 ++ [x1], k2 ++ [x2], k3) → x1 ≠x2. - Proof. - intros Hl ->. destruct (suffix_cons_not x2 k3). - eapply max_suffix_max_alt; eauto. - - rewrite (max_suffix_fst_alt _ _ _ _ _ Hl). - by apply (suffix_app [x2]), suffix_app_r. - - rewrite (max_suffix_snd_alt _ _ _ _ _ Hl). - by apply (suffix_app [x2]), suffix_app_r. - Qed. -End max_suffix. - -(** ** Properties of the [sublist] predicate *) -Lemma sublist_length l1 l2 : l1 `sublist_of` l2 → length l1 ≤ length l2. -Proof. induction 1; simpl; auto with arith. Qed. -Lemma sublist_nil_l l : [] `sublist_of` l. -Proof. induction l; try constructor; auto. Qed. -Lemma sublist_nil_r l : l `sublist_of` [] ↔ l = []. -Proof. split. by inversion 1. intros ->. constructor. Qed. -Lemma sublist_app l1 l2 k1 k2 : - l1 `sublist_of` l2 → k1 `sublist_of` k2 → l1 ++ k1 `sublist_of` l2 ++ k2. -Proof. induction 1; simpl; try constructor; auto. Qed. -Lemma sublist_inserts_l k l1 l2 : l1 `sublist_of` l2 → l1 `sublist_of` k ++ l2. -Proof. induction k; try constructor; auto. Qed. -Lemma sublist_inserts_r k l1 l2 : l1 `sublist_of` l2 → l1 `sublist_of` l2 ++ k. -Proof. induction 1; simpl; try constructor; auto using sublist_nil_l. Qed. -Lemma sublist_cons_r x l k : - l `sublist_of` x :: k ↔ l `sublist_of` k ∨ ∃ l', l = x :: l' ∧ l' `sublist_of` k. -Proof. split. inversion 1; eauto. intros [?|(?&->&?)]; constructor; auto. Qed. -Lemma sublist_cons_l x l k : - x :: l `sublist_of` k ↔ ∃ k1 k2, k = k1 ++ x :: k2 ∧ l `sublist_of` k2. -Proof. - split. - - intros Hlk. induction k as [|y k IH]; inversion Hlk. - + eexists [], k. by repeat constructor. - + destruct IH as (k1&k2&->&?); auto. by exists (y :: k1), k2. - - intros (k1&k2&->&?). by apply sublist_inserts_l, sublist_skip. -Qed. -Lemma sublist_app_r l k1 k2 : - l `sublist_of` k1 ++ k2 ↔ - ∃ l1 l2, l = l1 ++ l2 ∧ l1 `sublist_of` k1 ∧ l2 `sublist_of` k2. -Proof. - split. - - revert l k2. induction k1 as [|y k1 IH]; intros l k2; simpl. - { eexists [], l. by repeat constructor. } - rewrite sublist_cons_r. intros [?|(l' & ? &?)]; subst. - + destruct (IH l k2) as (l1&l2&?&?&?); trivial; subst. - exists l1, l2. auto using sublist_cons. - + destruct (IH l' k2) as (l1&l2&?&?&?); trivial; subst. - exists (y :: l1), l2. auto using sublist_skip. - - intros (?&?&?&?&?); subst. auto using sublist_app. -Qed. -Lemma sublist_app_l l1 l2 k : - l1 ++ l2 `sublist_of` k ↔ - ∃ k1 k2, k = k1 ++ k2 ∧ l1 `sublist_of` k1 ∧ l2 `sublist_of` k2. -Proof. - split. - - revert l2 k. induction l1 as [|x l1 IH]; intros l2 k; simpl. - { eexists [], k. by repeat constructor. } - rewrite sublist_cons_l. intros (k1 & k2 &?&?); subst. - destruct (IH l2 k2) as (h1 & h2 &?&?&?); trivial; subst. - exists (k1 ++ x :: h1), h2. rewrite <-(assoc_L (++)). - auto using sublist_inserts_l, sublist_skip. - - intros (?&?&?&?&?); subst. auto using sublist_app. -Qed. -Lemma sublist_app_inv_l k l1 l2 : k ++ l1 `sublist_of` k ++ l2 → l1 `sublist_of` l2. -Proof. - induction k as [|y k IH]; simpl; [done |]. - rewrite sublist_cons_r. intros [Hl12|(?&?&?)]; [|simplify_eq; eauto]. - rewrite sublist_cons_l in Hl12. destruct Hl12 as (k1&k2&Hk&?). - apply IH. rewrite Hk. eauto using sublist_inserts_l, sublist_cons. -Qed. -Lemma sublist_app_inv_r k l1 l2 : l1 ++ k `sublist_of` l2 ++ k → l1 `sublist_of` l2. -Proof. - revert l1 l2. induction k as [|y k IH]; intros l1 l2. - { by rewrite !(right_id_L [] (++)). } - intros. feed pose proof (IH (l1 ++ [y]) (l2 ++ [y])) as Hl12. - { by rewrite <-!(assoc_L (++)). } - rewrite sublist_app_l in Hl12. destruct Hl12 as (k1&k2&E&?&Hk2). - destruct k2 as [|z k2] using rev_ind; [inversion Hk2|]. - rewrite (assoc_L (++)) in E; simplify_list_eq. - eauto using sublist_inserts_r. -Qed. -Global Instance: PartialOrder (@sublist A). -Proof. - split; [split|]. - - intros l. induction l; constructor; auto. - - intros l1 l2 l3 Hl12. revert l3. induction Hl12. - + auto using sublist_nil_l. - + intros ?. rewrite sublist_cons_l. intros (?&?&?&?); subst. - eauto using sublist_inserts_l, sublist_skip. - + intros ?. rewrite sublist_cons_l. intros (?&?&?&?); subst. - eauto using sublist_inserts_l, sublist_cons. - - intros l1 l2 Hl12 Hl21. apply sublist_length in Hl21. - induction Hl12; f_equal/=; auto with arith. - apply sublist_length in Hl12. lia. -Qed. -Lemma sublist_take l i : take i l `sublist_of` l. -Proof. rewrite <-(take_drop i l) at 2. by apply sublist_inserts_r. Qed. -Lemma sublist_drop l i : drop i l `sublist_of` l. -Proof. rewrite <-(take_drop i l) at 2. by apply sublist_inserts_l. Qed. -Lemma sublist_delete l i : delete i l `sublist_of` l. -Proof. revert i. by induction l; intros [|?]; simpl; constructor. Qed. -Lemma sublist_foldr_delete l is : foldr delete l is `sublist_of` l. -Proof. - induction is as [|i is IH]; simpl; [done |]. - trans (foldr delete l is); auto using sublist_delete. -Qed. -Lemma sublist_alt l1 l2 : l1 `sublist_of` l2 ↔ ∃ is, l1 = foldr delete l2 is. -Proof. - split; [|intros [is ->]; apply sublist_foldr_delete]. - intros Hl12. cut (∀ k, ∃ is, k ++ l1 = foldr delete (k ++ l2) is). - { intros help. apply (help []). } - induction Hl12 as [|x l1 l2 _ IH|x l1 l2 _ IH]; intros k. - - by eexists []. - - destruct (IH (k ++ [x])) as [is His]. exists is. - by rewrite <-!(assoc_L (++)) in His. - - destruct (IH k) as [is His]. exists (is ++ [length k]). - rewrite fold_right_app. simpl. by rewrite delete_middle. -Qed. -Lemma Permutation_sublist l1 l2 l3 : - l1 ≡ₚ l2 → l2 `sublist_of` l3 → ∃ l4, l1 `sublist_of` l4 ∧ l4 ≡ₚ l3. -Proof. - intros Hl1l2. revert l3. - induction Hl1l2 as [|x l1 l2 ? IH|x y l1|l1 l1' l2 ? IH1 ? IH2]. - - intros l3. by exists l3. - - intros l3. rewrite sublist_cons_l. intros (l3'&l3''&?&?); subst. - destruct (IH l3'') as (l4&?&Hl4); auto. exists (l3' ++ x :: l4). - split. by apply sublist_inserts_l, sublist_skip. by rewrite Hl4. - - intros l3. rewrite sublist_cons_l. intros (l3'&l3''&?& Hl3); subst. - rewrite sublist_cons_l in Hl3. destruct Hl3 as (l5'&l5''&?& Hl5); subst. - exists (l3' ++ y :: l5' ++ x :: l5''). split. - + by do 2 apply sublist_inserts_l, sublist_skip. - + by rewrite !Permutation_middle, Permutation_swap. - - intros l3 ?. destruct (IH2 l3) as (l3'&?&?); trivial. - destruct (IH1 l3') as (l3'' &?&?); trivial. exists l3''. - split. done. etrans; eauto. -Qed. -Lemma sublist_Permutation l1 l2 l3 : - l1 `sublist_of` l2 → l2 ≡ₚ l3 → ∃ l4, l1 ≡ₚ l4 ∧ l4 `sublist_of` l3. -Proof. - intros Hl1l2 Hl2l3. revert l1 Hl1l2. - induction Hl2l3 as [|x l2 l3 ? IH|x y l2|l2 l2' l3 ? IH1 ? IH2]. - - intros l1. by exists l1. - - intros l1. rewrite sublist_cons_r. intros [?|(l1'&l1''&?)]; subst. - { destruct (IH l1) as (l4&?&?); trivial. - exists l4. split. done. by constructor. } - destruct (IH l1') as (l4&?&Hl4); auto. exists (x :: l4). - split. by constructor. by constructor. - - intros l1. rewrite sublist_cons_r. intros [Hl1|(l1'&l1''&Hl1)]; subst. - { exists l1. split; [done|]. rewrite sublist_cons_r in Hl1. - destruct Hl1 as [?|(l1'&?&?)]; subst; by repeat constructor. } - rewrite sublist_cons_r in Hl1. destruct Hl1 as [?|(l1''&?&?)]; subst. - + exists (y :: l1'). by repeat constructor. - + exists (x :: y :: l1''). by repeat constructor. - - intros l1 ?. destruct (IH1 l1) as (l3'&?&?); trivial. - destruct (IH2 l3') as (l3'' &?&?); trivial. exists l3''. - split; [|done]. etrans; eauto. -Qed. - -(** Properties of the [submseteq] predicate *) -Lemma submseteq_length l1 l2 : l1 ⊆+ l2 → length l1 ≤ length l2. -Proof. induction 1; simpl; auto with lia. Qed. -Lemma submseteq_nil_l l : [] ⊆+ l. -Proof. induction l; constructor; auto. Qed. -Lemma submseteq_nil_r l : l ⊆+ [] ↔ l = []. -Proof. - split; [|intros ->; constructor]. - intros Hl. apply submseteq_length in Hl. destruct l; simpl in *; auto with lia. -Qed. -Global Instance: PreOrder (@submseteq A). -Proof. - split. - - intros l. induction l; constructor; auto. - - red. apply submseteq_trans. -Qed. -Lemma Permutation_submseteq l1 l2 : l1 ≡ₚ l2 → l1 ⊆+ l2. -Proof. induction 1; econstructor; eauto. Qed. -Lemma sublist_submseteq l1 l2 : l1 `sublist_of` l2 → l1 ⊆+ l2. -Proof. induction 1; constructor; auto. Qed. -Lemma submseteq_Permutation l1 l2 : l1 ⊆+ l2 → ∃ k, l2 ≡ₚ l1 ++ k. -Proof. - induction 1 as - [|x y l ? [k Hk]| |x l1 l2 ? [k Hk]|l1 l2 l3 ? [k Hk] ? [k' Hk']]. - - by eexists []. - - exists k. by rewrite Hk. - - eexists []. rewrite (right_id_L [] (++)). by constructor. - - exists (x :: k). by rewrite Hk, Permutation_middle. - - exists (k ++ k'). by rewrite Hk', Hk, (assoc_L (++)). -Qed. -Lemma submseteq_Permutation_length_le l1 l2 : - length l2 ≤ length l1 → l1 ⊆+ l2 → l1 ≡ₚ l2. -Proof. - intros Hl21 Hl12. destruct (submseteq_Permutation l1 l2) as [[|??] Hk]; auto. - - by rewrite Hk, (right_id_L [] (++)). - - rewrite Hk, app_length in Hl21; simpl in Hl21; lia. -Qed. -Lemma submseteq_Permutation_length_eq l1 l2 : - length l2 = length l1 → l1 ⊆+ l2 → l1 ≡ₚ l2. -Proof. intro. apply submseteq_Permutation_length_le. lia. Qed. -Global Instance: Proper ((≡ₚ) ==> (≡ₚ) ==> iff) (@submseteq A). -Proof. - intros l1 l2 ? k1 k2 ?. split; intros. - - trans l1. by apply Permutation_submseteq. - trans k1. done. by apply Permutation_submseteq. - - trans l2. by apply Permutation_submseteq. - trans k2. done. by apply Permutation_submseteq. -Qed. -Global Instance: AntiSymm (≡ₚ) (@submseteq A). -Proof. red. auto using submseteq_Permutation_length_le, submseteq_length. Qed. -Lemma submseteq_take l i : take i l ⊆+ l. -Proof. auto using sublist_take, sublist_submseteq. Qed. -Lemma submseteq_drop l i : drop i l ⊆+ l. -Proof. auto using sublist_drop, sublist_submseteq. Qed. -Lemma submseteq_delete l i : delete i l ⊆+ l. -Proof. auto using sublist_delete, sublist_submseteq. Qed. -Lemma submseteq_foldr_delete l is : foldr delete l is `sublist_of` l. -Proof. auto using sublist_foldr_delete, sublist_submseteq. Qed. -Lemma submseteq_sublist_l l1 l3 : l1 ⊆+ l3 ↔ ∃ l2, l1 `sublist_of` l2 ∧ l2 ≡ₚ l3. -Proof. - split. - { intros Hl13. elim Hl13; clear l1 l3 Hl13. - - by eexists []. - - intros x l1 l3 ? (l2&?&?). exists (x :: l2). by repeat constructor. - - intros x y l. exists (y :: x :: l). by repeat constructor. - - intros x l1 l3 ? (l2&?&?). exists (x :: l2). by repeat constructor. - - intros l1 l3 l5 ? (l2&?&?) ? (l4&?&?). - destruct (Permutation_sublist l2 l3 l4) as (l3'&?&?); trivial. - exists l3'. split; etrans; eauto. } - intros (l2&?&?). - trans l2; auto using sublist_submseteq, Permutation_submseteq. -Qed. -Lemma submseteq_sublist_r l1 l3 : - l1 ⊆+ l3 ↔ ∃ l2, l1 ≡ₚ l2 ∧ l2 `sublist_of` l3. -Proof. - rewrite submseteq_sublist_l. - split; intros (l2&?&?); eauto using sublist_Permutation, Permutation_sublist. -Qed. -Lemma submseteq_inserts_l k l1 l2 : l1 ⊆+ l2 → l1 ⊆+ k ++ l2. -Proof. induction k; try constructor; auto. Qed. -Lemma submseteq_inserts_r k l1 l2 : l1 ⊆+ l2 → l1 ⊆+ l2 ++ k. -Proof. rewrite (comm (++)). apply submseteq_inserts_l. Qed. -Lemma submseteq_skips_l k l1 l2 : l1 ⊆+ l2 → k ++ l1 ⊆+ k ++ l2. -Proof. induction k; try constructor; auto. Qed. -Lemma submseteq_skips_r k l1 l2 : l1 ⊆+ l2 → l1 ++ k ⊆+ l2 ++ k. -Proof. rewrite !(comm (++) _ k). apply submseteq_skips_l. Qed. -Lemma submseteq_app l1 l2 k1 k2 : l1 ⊆+ l2 → k1 ⊆+ k2 → l1 ++ k1 ⊆+ l2 ++ k2. -Proof. trans (l1 ++ k2); auto using submseteq_skips_l, submseteq_skips_r. Qed. -Lemma submseteq_cons_r x l k : - l ⊆+ x :: k ↔ l ⊆+ k ∨ ∃ l', l ≡ₚ x :: l' ∧ l' ⊆+ k. -Proof. - split. - - rewrite submseteq_sublist_r. intros (l'&E&Hl'). - rewrite sublist_cons_r in Hl'. destruct Hl' as [?|(?&?&?)]; subst. - + left. rewrite E. eauto using sublist_submseteq. - + right. eauto using sublist_submseteq. - - intros [?|(?&E&?)]; [|rewrite E]; by constructor. -Qed. -Lemma submseteq_cons_l x l k : x :: l ⊆+ k ↔ ∃ k', k ≡ₚ x :: k' ∧ l ⊆+ k'. -Proof. - split. - - rewrite submseteq_sublist_l. intros (l'&Hl'&E). - rewrite sublist_cons_l in Hl'. destruct Hl' as (k1&k2&?&?); subst. - exists (k1 ++ k2). split; eauto using submseteq_inserts_l, sublist_submseteq. - by rewrite Permutation_middle. - - intros (?&E&?). rewrite E. by constructor. -Qed. -Lemma submseteq_app_r l k1 k2 : - l ⊆+ k1 ++ k2 ↔ ∃ l1 l2, l ≡ₚ l1 ++ l2 ∧ l1 ⊆+ k1 ∧ l2 ⊆+ k2. -Proof. - split. - - rewrite submseteq_sublist_r. intros (l'&E&Hl'). - rewrite sublist_app_r in Hl'. destruct Hl' as (l1&l2&?&?&?); subst. - exists l1, l2. eauto using sublist_submseteq. - - intros (?&?&E&?&?). rewrite E. eauto using submseteq_app. -Qed. -Lemma submseteq_app_l l1 l2 k : - l1 ++ l2 ⊆+ k ↔ ∃ k1 k2, k ≡ₚ k1 ++ k2 ∧ l1 ⊆+ k1 ∧ l2 ⊆+ k2. -Proof. - split. - - rewrite submseteq_sublist_l. intros (l'&Hl'&E). - rewrite sublist_app_l in Hl'. destruct Hl' as (k1&k2&?&?&?); subst. - exists k1, k2. split. done. eauto using sublist_submseteq. - - intros (?&?&E&?&?). rewrite E. eauto using submseteq_app. -Qed. -Lemma submseteq_app_inv_l l1 l2 k : k ++ l1 ⊆+ k ++ l2 → l1 ⊆+ l2. -Proof. - induction k as [|y k IH]; simpl; [done |]. rewrite submseteq_cons_l. - intros (?&E&?). apply Permutation_cons_inv in E. apply IH. by rewrite E. -Qed. -Lemma submseteq_app_inv_r l1 l2 k : l1 ++ k ⊆+ l2 ++ k → l1 ⊆+ l2. -Proof. - revert l1 l2. induction k as [|y k IH]; intros l1 l2. - { by rewrite !(right_id_L [] (++)). } - intros. feed pose proof (IH (l1 ++ [y]) (l2 ++ [y])) as Hl12. - { by rewrite <-!(assoc_L (++)). } - rewrite submseteq_app_l in Hl12. destruct Hl12 as (k1&k2&E1&?&Hk2). - rewrite submseteq_cons_l in Hk2. destruct Hk2 as (k2'&E2&?). - rewrite E2, (Permutation_cons_append k2'), (assoc_L (++)) in E1. - apply Permutation_app_inv_r in E1. rewrite E1. eauto using submseteq_inserts_r. -Qed. -Lemma submseteq_cons_middle x l k1 k2 : l ⊆+ k1 ++ k2 → x :: l ⊆+ k1 ++ x :: k2. -Proof. rewrite <-Permutation_middle. by apply submseteq_skip. Qed. -Lemma submseteq_app_middle l1 l2 k1 k2 : - l2 ⊆+ k1 ++ k2 → l1 ++ l2 ⊆+ k1 ++ l1 ++ k2. -Proof. - rewrite !(assoc (++)), (comm (++) k1 l1), <-(assoc_L (++)). - by apply submseteq_skips_l. -Qed. -Lemma submseteq_middle l k1 k2 : l ⊆+ k1 ++ l ++ k2. -Proof. by apply submseteq_inserts_l, submseteq_inserts_r. Qed. - -Lemma Permutation_alt l1 l2 : l1 ≡ₚ l2 ↔ length l1 = length l2 ∧ l1 ⊆+ l2. -Proof. - split. - - by intros Hl; rewrite Hl. - - intros [??]; auto using submseteq_Permutation_length_eq. -Qed. - -Lemma NoDup_submseteq l k : NoDup l → (∀ x, x ∈ l → x ∈ k) → l ⊆+ k. -Proof. - intros Hl. revert k. induction Hl as [|x l Hx ? IH]. - { intros k Hk. by apply submseteq_nil_l. } - intros k Hlk. destruct (elem_of_list_split k x) as (l1&l2&?); subst. - { apply Hlk. by constructor. } - rewrite <-Permutation_middle. apply submseteq_skip, IH. - intros y Hy. rewrite elem_of_app. - specialize (Hlk y). rewrite elem_of_app, !elem_of_cons in Hlk. - by destruct Hlk as [?|[?|?]]; subst; eauto. -Qed. -Lemma NoDup_Permutation l k : NoDup l → NoDup k → (∀ x, x ∈ l ↔ x ∈ k) → l ≡ₚ k. -Proof. - intros. apply (anti_symm submseteq); apply NoDup_submseteq; naive_solver. -Qed. - -Section submseteq_dec. - Context `{!EqDecision A}. - - Lemma list_remove_Permutation l1 l2 k1 x : - l1 ≡ₚ l2 → list_remove x l1 = Some k1 → - ∃ k2, list_remove x l2 = Some k2 ∧ k1 ≡ₚ k2. - Proof. - intros Hl. revert k1. induction Hl - as [|y l1 l2 ? IH|y1 y2 l|l1 l2 l3 ? IH1 ? IH2]; simpl; intros k1 Hk1. - - done. - - case_decide; simplify_eq; eauto. - destruct (list_remove x l1) as [l|] eqn:?; simplify_eq. - destruct (IH l) as (?&?&?); simplify_option_eq; eauto. - - simplify_option_eq; eauto using Permutation_swap. - - destruct (IH1 k1) as (k2&?&?); trivial. - destruct (IH2 k2) as (k3&?&?); trivial. - exists k3. split; eauto. by trans k2. - Qed. - Lemma list_remove_Some l k x : list_remove x l = Some k → l ≡ₚ x :: k. - Proof. - revert k. induction l as [|y l IH]; simpl; intros k ?; [done |]. - simplify_option_eq; auto. by rewrite Permutation_swap, <-IH. - Qed. - Lemma list_remove_Some_inv l k x : - l ≡ₚ x :: k → ∃ k', list_remove x l = Some k' ∧ k ≡ₚ k'. - Proof. - intros. destruct (list_remove_Permutation (x :: k) l k x) as (k'&?&?). - - done. - - simpl; by case_decide. - - by exists k'. - Qed. - Lemma list_remove_list_submseteq l1 l2 : - l1 ⊆+ l2 ↔ is_Some (list_remove_list l1 l2). - Proof. - split. - - revert l2. induction l1 as [|x l1 IH]; simpl. - { intros l2 _. by exists l2. } - intros l2. rewrite submseteq_cons_l. intros (k&Hk&?). - destruct (list_remove_Some_inv l2 k x) as (k2&?&Hk2); trivial. - simplify_option_eq. apply IH. by rewrite <-Hk2. - - intros [k Hk]. revert l2 k Hk. - induction l1 as [|x l1 IH]; simpl; intros l2 k. - { intros. apply submseteq_nil_l. } - destruct (list_remove x l2) as [k'|] eqn:?; intros; simplify_eq. - rewrite submseteq_cons_l. eauto using list_remove_Some. - Qed. - Global Instance submseteq_dec l1 l2 : Decision (l1 ⊆+ l2). - Proof. - refine (cast_if (decide (is_Some (list_remove_list l1 l2)))); - abstract (rewrite list_remove_list_submseteq; tauto). - Defined. - Global Instance Permutation_dec l1 l2 : Decision (l1 ≡ₚ l2). - Proof. - refine (cast_if_and - (decide (length l1 = length l2)) (decide (l1 ⊆+ l2))); - abstract (rewrite Permutation_alt; tauto). - Defined. -End submseteq_dec. - -(** ** Properties of [included] *) -Global Instance list_subseteq_po : PreOrder (@subseteq (list A) _). -Proof. split; firstorder. Qed. -Lemma list_subseteq_nil l : [] ⊆ l. -Proof. intros x. by rewrite elem_of_nil. Qed. - -(** ** Properties of the [Forall] and [Exists] predicate *) -Lemma Forall_Exists_dec (P Q : A → Prop) (dec : ∀ x, {P x} + {Q x}) : - ∀ l, {Forall P l} + {Exists Q l}. -Proof. - refine ( - fix go l := - match l return {Forall P l} + {Exists Q l} with - | [] => left _ - | x :: l => cast_if_and (dec x) (go l) - end); clear go; intuition. -Defined. - -Definition Forall_nil_2 := @Forall_nil A. -Definition Forall_cons_2 := @Forall_cons A. -Global Instance Forall_proper: - Proper (pointwise_relation _ (↔) ==> (=) ==> (↔)) (@Forall A). -Proof. split; subst; induction 1; constructor; by firstorder auto. Qed. -Global Instance Exists_proper: - Proper (pointwise_relation _ (↔) ==> (=) ==> (↔)) (@Exists A). -Proof. split; subst; induction 1; constructor; by firstorder auto. Qed. - -Section Forall_Exists. - Context (P : A → Prop). - - Lemma Forall_forall l : Forall P l ↔ ∀ x, x ∈ l → P x. - Proof. - split; [induction 1; inversion 1; subst; auto|]. - intros Hin; induction l as [|x l IH]; constructor; [apply Hin; constructor|]. - apply IH. intros ??. apply Hin. by constructor. - Qed. - Lemma Forall_nil : Forall P [] ↔ True. - Proof. done. Qed. - Lemma Forall_cons_1 x l : Forall P (x :: l) → P x ∧ Forall P l. - Proof. by inversion 1. Qed. - Lemma Forall_cons x l : Forall P (x :: l) ↔ P x ∧ Forall P l. - Proof. split. by inversion 1. intros [??]. by constructor. Qed. - Lemma Forall_singleton x : Forall P [x] ↔ P x. - Proof. rewrite Forall_cons, Forall_nil; tauto. Qed. - Lemma Forall_app_2 l1 l2 : Forall P l1 → Forall P l2 → Forall P (l1 ++ l2). - Proof. induction 1; simpl; auto. Qed. - Lemma Forall_app l1 l2 : Forall P (l1 ++ l2) ↔ Forall P l1 ∧ Forall P l2. - Proof. - split; [induction l1; inversion 1; intuition|]. - intros [??]; auto using Forall_app_2. - Qed. - Lemma Forall_true l : (∀ x, P x) → Forall P l. - Proof. induction l; auto. Qed. - Lemma Forall_impl (Q : A → Prop) l : - Forall P l → (∀ x, P x → Q x) → Forall Q l. - Proof. intros H ?. induction H; auto. Defined. - Lemma Forall_iff l (Q : A → Prop) : - (∀ x, P x ↔ Q x) → Forall P l ↔ Forall Q l. - Proof. intros H. apply Forall_proper. red; apply H. done. Qed. - Lemma Forall_not l : length l ≠0 → Forall (not ∘ P) l → ¬Forall P l. - Proof. by destruct 2; inversion 1. Qed. - Lemma Forall_and {Q} l : Forall (λ x, P x ∧ Q x) l ↔ Forall P l ∧ Forall Q l. - Proof. - split; [induction 1; constructor; naive_solver|]. - intros [Hl Hl']; revert Hl'; induction Hl; inversion_clear 1; auto. - Qed. - Lemma Forall_and_l {Q} l : Forall (λ x, P x ∧ Q x) l → Forall P l. - Proof. rewrite Forall_and; tauto. Qed. - Lemma Forall_and_r {Q} l : Forall (λ x, P x ∧ Q x) l → Forall Q l. - Proof. rewrite Forall_and; tauto. Qed. - Lemma Forall_delete l i : Forall P l → Forall P (delete i l). - Proof. intros H. revert i. by induction H; intros [|i]; try constructor. Qed. - Lemma Forall_lookup l : Forall P l ↔ ∀ i x, l !! i = Some x → P x. - Proof. - rewrite Forall_forall. setoid_rewrite elem_of_list_lookup. naive_solver. - Qed. - Lemma Forall_lookup_1 l i x : Forall P l → l !! i = Some x → P x. - Proof. rewrite Forall_lookup. eauto. Qed. - Lemma Forall_lookup_2 l : (∀ i x, l !! i = Some x → P x) → Forall P l. - Proof. by rewrite Forall_lookup. Qed. - Lemma Forall_tail l : Forall P l → Forall P (tail l). - Proof. destruct 1; simpl; auto. Qed. - Lemma Forall_alter f l i : - Forall P l → (∀ x, l!!i = Some x → P x → P (f x)) → Forall P (alter f i l). - Proof. - intros Hl. revert i. induction Hl; simpl; intros [|i]; constructor; auto. - Qed. - Lemma Forall_alter_inv f l i : - Forall P (alter f i l) → (∀ x, l!!i = Some x → P (f x) → P x) → Forall P l. - Proof. - revert i. induction l; intros [|?]; simpl; - inversion_clear 1; constructor; eauto. - Qed. - Lemma Forall_insert l i x : Forall P l → P x → Forall P (<[i:=x]>l). - Proof. rewrite list_insert_alter; auto using Forall_alter. Qed. - Lemma Forall_inserts l i k : - Forall P l → Forall P k → Forall P (list_inserts i k l). - Proof. - intros Hl Hk; revert i. - induction Hk; simpl; auto using Forall_insert. - Qed. - Lemma Forall_replicate n x : P x → Forall P (replicate n x). - Proof. induction n; simpl; constructor; auto. Qed. - Lemma Forall_replicate_eq n (x : A) : Forall (x =) (replicate n x). - Proof using -(P). induction n; simpl; constructor; auto. Qed. - Lemma Forall_take n l : Forall P l → Forall P (take n l). - Proof. intros Hl. revert n. induction Hl; intros [|?]; simpl; auto. Qed. - Lemma Forall_drop n l : Forall P l → Forall P (drop n l). - Proof. intros Hl. revert n. induction Hl; intros [|?]; simpl; auto. Qed. - Lemma Forall_resize n x l : P x → Forall P l → Forall P (resize n x l). - Proof. - intros ? Hl. revert n. - induction Hl; intros [|?]; simpl; auto using Forall_replicate. - Qed. - Lemma Forall_resize_inv n x l : - length l ≤ n → Forall P (resize n x l) → Forall P l. - Proof. intros ?. rewrite resize_ge, Forall_app by done. by intros []. Qed. - Lemma Forall_sublist_lookup l i n k : - sublist_lookup i n l = Some k → Forall P l → Forall P k. - Proof. - unfold sublist_lookup. intros; simplify_option_eq. - auto using Forall_take, Forall_drop. - Qed. - Lemma Forall_sublist_alter f l i n k : - Forall P l → sublist_lookup i n l = Some k → Forall P (f k) → - Forall P (sublist_alter f i n l). - Proof. - unfold sublist_alter, sublist_lookup. intros; simplify_option_eq. - auto using Forall_app_2, Forall_drop, Forall_take. - Qed. - Lemma Forall_sublist_alter_inv f l i n k : - sublist_lookup i n l = Some k → - Forall P (sublist_alter f i n l) → Forall P (f k). - Proof. - unfold sublist_alter, sublist_lookup. intros ?; simplify_option_eq. - rewrite !Forall_app; tauto. - Qed. - Lemma Forall_reshape l szs : Forall P l → Forall (Forall P) (reshape szs l). - Proof. - revert l. induction szs; simpl; auto using Forall_take, Forall_drop. - Qed. - Lemma Forall_rev_ind (Q : list A → Prop) : - Q [] → (∀ x l, P x → Forall P l → Q l → Q (l ++ [x])) → - ∀ l, Forall P l → Q l. - Proof. - intros ?? l. induction l using rev_ind; auto. - rewrite Forall_app, Forall_singleton; intros [??]; auto. - Qed. - Lemma Exists_exists l : Exists P l ↔ ∃ x, x ∈ l ∧ P x. - Proof. - split. - - induction 1 as [x|y ?? [x [??]]]; exists x; by repeat constructor. - - intros [x [Hin ?]]. induction l; [by destruct (not_elem_of_nil x)|]. - inversion Hin; subst. by left. right; auto. - Qed. - Lemma Exists_inv x l : Exists P (x :: l) → P x ∨ Exists P l. - Proof. inversion 1; intuition trivial. Qed. - Lemma Exists_app l1 l2 : Exists P (l1 ++ l2) ↔ Exists P l1 ∨ Exists P l2. - Proof. - split. - - induction l1; inversion 1; intuition. - - intros [H|H]; [induction H | induction l1]; simpl; intuition. - Qed. - Lemma Exists_impl (Q : A → Prop) l : - Exists P l → (∀ x, P x → Q x) → Exists Q l. - Proof. intros H ?. induction H; auto. Defined. - - Lemma Exists_not_Forall l : Exists (not ∘ P) l → ¬Forall P l. - Proof. induction 1; inversion_clear 1; contradiction. Qed. - Lemma Forall_not_Exists l : Forall (not ∘ P) l → ¬Exists P l. - Proof. induction 1; inversion_clear 1; contradiction. Qed. - - Lemma Forall_list_difference `{!EqDecision A} l k : - Forall P l → Forall P (list_difference l k). - Proof. - rewrite !Forall_forall. - intros ? x; rewrite elem_of_list_difference; naive_solver. - Qed. - Lemma Forall_list_union `{!EqDecision A} l k : - Forall P l → Forall P k → Forall P (list_union l k). - Proof. intros. apply Forall_app; auto using Forall_list_difference. Qed. - Lemma Forall_list_intersection `{!EqDecision A} l k : - Forall P l → Forall P (list_intersection l k). - Proof. - rewrite !Forall_forall. - intros ? x; rewrite elem_of_list_intersection; naive_solver. - Qed. - - Context {dec : ∀ x, Decision (P x)}. - Lemma not_Forall_Exists l : ¬Forall P l → Exists (not ∘ P) l. - Proof. intro. by destruct (Forall_Exists_dec P (not ∘ P) dec l). Qed. - Lemma not_Exists_Forall l : ¬Exists P l → Forall (not ∘ P) l. - Proof. - by destruct (Forall_Exists_dec (not ∘ P) P - (λ x : A, swap_if (decide (P x))) l). - Qed. - Global Instance Forall_dec l : Decision (Forall P l) := - match Forall_Exists_dec P (not ∘ P) dec l with - | left H => left H - | right H => right (Exists_not_Forall _ H) - end. - Global Instance Exists_dec l : Decision (Exists P l) := - match Forall_Exists_dec (not ∘ P) P (λ x, swap_if (decide (P x))) l with - | left H => right (Forall_not_Exists _ H) - | right H => left H - end. -End Forall_Exists. - -Lemma replicate_as_Forall (x : A) n l : - replicate n x = l ↔ length l = n ∧ Forall (x =) l. -Proof. rewrite replicate_as_elem_of, Forall_forall. naive_solver. Qed. -Lemma replicate_as_Forall_2 (x : A) n l : - length l = n → Forall (x =) l → replicate n x = l. -Proof. by rewrite replicate_as_Forall. Qed. -End more_general_properties. - -Lemma Forall_swap {A B} (Q : A → B → Prop) l1 l2 : - Forall (λ y, Forall (Q y) l1) l2 ↔ Forall (λ x, Forall (flip Q x) l2) l1. -Proof. repeat setoid_rewrite Forall_forall. simpl. split; eauto. Qed. -Lemma Forall_seq (P : nat → Prop) i n : - Forall P (seq i n) ↔ ∀ j, i ≤ j < i + n → P j. -Proof. - rewrite Forall_lookup. split. - - intros H j [??]. apply (H (j - i)). - rewrite lookup_seq; auto with f_equal lia. - - intros H j x Hj. apply lookup_seq_inv in Hj. - destruct Hj; subst. auto with lia. -Qed. - -Lemma Forall2_same_length {A B} (l : list A) (k : list B) : - Forall2 (λ _ _, True) l k ↔ length l = length k. -Proof. - split; [by induction 1; f_equal/=|]. - revert k. induction l; intros [|??] ?; simplify_eq/=; auto. -Qed. - -(** ** Properties of the [Forall2] predicate *) -Lemma Forall_Forall2 {A} (Q : A → A → Prop) l : - Forall (λ x, Q x x) l → Forall2 Q l l. -Proof. induction 1; constructor; auto. Qed. -Lemma Forall2_forall `{Inhabited A} B C (Q : A → B → C → Prop) l k : - Forall2 (λ x y, ∀ z, Q z x y) l k ↔ ∀ z, Forall2 (Q z) l k. -Proof. - split; [induction 1; constructor; auto|]. - intros Hlk. induction (Hlk inhabitant) as [|x y l k _ _ IH]; constructor. - - intros z. by feed inversion (Hlk z). - - apply IH. intros z. by feed inversion (Hlk z). -Qed. - -Section Forall2. - Context {A B} (P : A → B → Prop). - Implicit Types x : A. - Implicit Types y : B. - Implicit Types l : list A. - Implicit Types k : list B. - - Lemma Forall2_length l k : Forall2 P l k → length l = length k. - Proof. by induction 1; f_equal/=. Qed. - Lemma Forall2_length_l l k n : Forall2 P l k → length l = n → length k = n. - Proof. intros ? <-; symmetry. by apply Forall2_length. Qed. - Lemma Forall2_length_r l k n : Forall2 P l k → length k = n → length l = n. - Proof. intros ? <-. by apply Forall2_length. Qed. - - Lemma Forall2_true l k : (∀ x y, P x y) → length l = length k → Forall2 P l k. - Proof. rewrite <-Forall2_same_length. induction 2; naive_solver. Qed. - Lemma Forall2_flip l k : Forall2 (flip P) k l ↔ Forall2 P l k. - Proof. split; induction 1; constructor; auto. Qed. - Lemma Forall2_transitive {C} (Q : B → C → Prop) (R : A → C → Prop) l k lC : - (∀ x y z, P x y → Q y z → R x z) → - Forall2 P l k → Forall2 Q k lC → Forall2 R l lC. - Proof. intros ? Hl. revert lC. induction Hl; inversion_clear 1; eauto. Qed. - Lemma Forall2_impl (Q : A → B → Prop) l k : - Forall2 P l k → (∀ x y, P x y → Q x y) → Forall2 Q l k. - Proof. intros H ?. induction H; auto. Defined. - Lemma Forall2_unique l k1 k2 : - Forall2 P l k1 → Forall2 P l k2 → - (∀ x y1 y2, P x y1 → P x y2 → y1 = y2) → k1 = k2. - Proof. - intros H. revert k2. induction H; inversion_clear 1; intros; f_equal; eauto. - Qed. - - Lemma Forall2_Forall_l (Q : A → Prop) l k : - Forall2 P l k → Forall (λ y, ∀ x, P x y → Q x) k → Forall Q l. - Proof. induction 1; inversion_clear 1; eauto. Qed. - Lemma Forall2_Forall_r (Q : B → Prop) l k : - Forall2 P l k → Forall (λ x, ∀ y, P x y → Q y) l → Forall Q k. - Proof. induction 1; inversion_clear 1; eauto. Qed. - - Lemma Forall2_nil_inv_l k : Forall2 P [] k → k = []. - Proof. by inversion 1. Qed. - Lemma Forall2_nil_inv_r l : Forall2 P l [] → l = []. - Proof. by inversion 1. Qed. - - Lemma Forall2_cons_inv x l y k : - Forall2 P (x :: l) (y :: k) → P x y ∧ Forall2 P l k. - Proof. by inversion 1. Qed. - Lemma Forall2_cons_inv_l x l k : - Forall2 P (x :: l) k → ∃ y k', P x y ∧ Forall2 P l k' ∧ k = y :: k'. - Proof. inversion 1; subst; eauto. Qed. - Lemma Forall2_cons_inv_r l k y : - Forall2 P l (y :: k) → ∃ x l', P x y ∧ Forall2 P l' k ∧ l = x :: l'. - Proof. inversion 1; subst; eauto. Qed. - Lemma Forall2_cons_nil_inv x l : Forall2 P (x :: l) [] → False. - Proof. by inversion 1. Qed. - Lemma Forall2_nil_cons_inv y k : Forall2 P [] (y :: k) → False. - Proof. by inversion 1. Qed. - - Lemma Forall2_app_l l1 l2 k : - Forall2 P l1 (take (length l1) k) → Forall2 P l2 (drop (length l1) k) → - Forall2 P (l1 ++ l2) k. - Proof. intros. rewrite <-(take_drop (length l1) k). by apply Forall2_app. Qed. - Lemma Forall2_app_r l k1 k2 : - Forall2 P (take (length k1) l) k1 → Forall2 P (drop (length k1) l) k2 → - Forall2 P l (k1 ++ k2). - Proof. intros. rewrite <-(take_drop (length k1) l). by apply Forall2_app. Qed. - Lemma Forall2_app_inv l1 l2 k1 k2 : - length l1 = length k1 → - Forall2 P (l1 ++ l2) (k1 ++ k2) → Forall2 P l1 k1 ∧ Forall2 P l2 k2. - Proof. - rewrite <-Forall2_same_length. induction 1; inversion 1; naive_solver. - Qed. - Lemma Forall2_app_inv_l l1 l2 k : - Forall2 P (l1 ++ l2) k ↔ - ∃ k1 k2, Forall2 P l1 k1 ∧ Forall2 P l2 k2 ∧ k = k1 ++ k2. - Proof. - split; [|intros (?&?&?&?&->); by apply Forall2_app]. - revert k. induction l1; inversion 1; naive_solver. - Qed. - Lemma Forall2_app_inv_r l k1 k2 : - Forall2 P l (k1 ++ k2) ↔ - ∃ l1 l2, Forall2 P l1 k1 ∧ Forall2 P l2 k2 ∧ l = l1 ++ l2. - Proof. - split; [|intros (?&?&?&?&->); by apply Forall2_app]. - revert l. induction k1; inversion 1; naive_solver. - Qed. - - Lemma Forall2_tail l k : Forall2 P l k → Forall2 P (tail l) (tail k). - Proof. destruct 1; simpl; auto. Qed. - Lemma Forall2_take l k n : Forall2 P l k → Forall2 P (take n l) (take n k). - Proof. intros Hl. revert n. induction Hl; intros [|?]; simpl; auto. Qed. - Lemma Forall2_drop l k n : Forall2 P l k → Forall2 P (drop n l) (drop n k). - Proof. intros Hl. revert n. induction Hl; intros [|?]; simpl; auto. Qed. - - Lemma Forall2_lookup l k : - Forall2 P l k ↔ ∀ i, option_Forall2 P (l !! i) (k !! i). - Proof. - split; [induction 1; intros [|?]; simpl; try constructor; eauto|]. - revert k. induction l as [|x l IH]; intros [| y k] H. - - done. - - feed inversion (H 0). - - feed inversion (H 0). - - constructor; [by feed inversion (H 0)|]. apply (IH _ $ λ i, H (S i)). - Qed. - Lemma Forall2_lookup_lr l k i x y : - Forall2 P l k → l !! i = Some x → k !! i = Some y → P x y. - Proof. rewrite Forall2_lookup; intros H; destruct (H i); naive_solver. Qed. - Lemma Forall2_lookup_l l k i x : - Forall2 P l k → l !! i = Some x → ∃ y, k !! i = Some y ∧ P x y. - Proof. rewrite Forall2_lookup; intros H; destruct (H i); naive_solver. Qed. - Lemma Forall2_lookup_r l k i y : - Forall2 P l k → k !! i = Some y → ∃ x, l !! i = Some x ∧ P x y. - Proof. rewrite Forall2_lookup; intros H; destruct (H i); naive_solver. Qed. - Lemma Forall2_same_length_lookup_2 l k : - length l = length k → - (∀ i x y, l !! i = Some x → k !! i = Some y → P x y) → Forall2 P l k. - Proof. - rewrite <-Forall2_same_length. intros Hl Hlookup. - induction Hl as [|?????? IH]; constructor; [by apply (Hlookup 0)|]. - apply IH. apply (λ i, Hlookup (S i)). - Qed. - Lemma Forall2_same_length_lookup l k : - Forall2 P l k ↔ - length l = length k ∧ - (∀ i x y, l !! i = Some x → k !! i = Some y → P x y). - Proof. - naive_solver eauto using Forall2_length, - Forall2_lookup_lr, Forall2_same_length_lookup_2. - Qed. - - Lemma Forall2_alter_l f l k i : - Forall2 P l k → - (∀ x y, l !! i = Some x → k !! i = Some y → P x y → P (f x) y) → - Forall2 P (alter f i l) k. - Proof. intros Hl. revert i. induction Hl; intros [|]; constructor; auto. Qed. - Lemma Forall2_alter_r f l k i : - Forall2 P l k → - (∀ x y, l !! i = Some x → k !! i = Some y → P x y → P x (f y)) → - Forall2 P l (alter f i k). - Proof. intros Hl. revert i. induction Hl; intros [|]; constructor; auto. Qed. - Lemma Forall2_alter f g l k i : - Forall2 P l k → - (∀ x y, l !! i = Some x → k !! i = Some y → P x y → P (f x) (g y)) → - Forall2 P (alter f i l) (alter g i k). - Proof. intros Hl. revert i. induction Hl; intros [|]; constructor; auto. Qed. - - Lemma Forall2_insert l k x y i : - Forall2 P l k → P x y → Forall2 P (<[i:=x]> l) (<[i:=y]> k). - Proof. intros Hl. revert i. induction Hl; intros [|]; constructor; auto. Qed. - Lemma Forall2_inserts l k l' k' i : - Forall2 P l k → Forall2 P l' k' → - Forall2 P (list_inserts i l' l) (list_inserts i k' k). - Proof. intros ? H. revert i. induction H; eauto using Forall2_insert. Qed. - - Lemma Forall2_delete l k i : - Forall2 P l k → Forall2 P (delete i l) (delete i k). - Proof. intros Hl. revert i. induction Hl; intros [|]; simpl; intuition. Qed. - Lemma Forall2_option_list mx my : - option_Forall2 P mx my → Forall2 P (option_list mx) (option_list my). - Proof. destruct 1; by constructor. Qed. - - Lemma Forall2_filter Q1 Q2 `{∀ x, Decision (Q1 x), ∀ y, Decision (Q2 y)} l k: - (∀ x y, P x y → Q1 x ↔ Q2 y) → - Forall2 P l k → Forall2 P (filter Q1 l) (filter Q2 k). - Proof. - intros HP; induction 1 as [|x y l k]; unfold filter; simpl; auto. - simplify_option_eq by (by rewrite <-(HP x y)); repeat constructor; auto. - Qed. - - Lemma Forall2_replicate_l k n x : - length k = n → Forall (P x) k → Forall2 P (replicate n x) k. - Proof. intros <-. induction 1; simpl; auto. Qed. - Lemma Forall2_replicate_r l n y : - length l = n → Forall (flip P y) l → Forall2 P l (replicate n y). - Proof. intros <-. induction 1; simpl; auto. Qed. - Lemma Forall2_replicate n x y : - P x y → Forall2 P (replicate n x) (replicate n y). - Proof. induction n; simpl; constructor; auto. Qed. - - Lemma Forall2_reverse l k : Forall2 P l k → Forall2 P (reverse l) (reverse k). - Proof. - induction 1; rewrite ?reverse_nil, ?reverse_cons; eauto using Forall2_app. - Qed. - Lemma Forall2_last l k : Forall2 P l k → option_Forall2 P (last l) (last k). - Proof. induction 1 as [|????? []]; simpl; repeat constructor; auto. Qed. - - Lemma Forall2_resize l k x y n : - P x y → Forall2 P l k → Forall2 P (resize n x l) (resize n y k). - Proof. - intros. rewrite !resize_spec, (Forall2_length l k) by done. - auto using Forall2_app, Forall2_take, Forall2_replicate. - Qed. - Lemma Forall2_resize_l l k x y n m : - P x y → Forall (flip P y) l → - Forall2 P (resize n x l) k → Forall2 P (resize m x l) (resize m y k). - Proof. - intros. destruct (decide (m ≤ n)). - { rewrite <-(resize_resize l m n) by done. by apply Forall2_resize. } - intros. assert (n = length k); subst. - { by rewrite <-(Forall2_length (resize n x l) k), resize_length. } - rewrite (le_plus_minus (length k) m), !resize_plus, - resize_all, drop_all, resize_nil by lia. - auto using Forall2_app, Forall2_replicate_r, - Forall_resize, Forall_drop, resize_length. - Qed. - Lemma Forall2_resize_r l k x y n m : - P x y → Forall (P x) k → - Forall2 P l (resize n y k) → Forall2 P (resize m x l) (resize m y k). - Proof. - intros. destruct (decide (m ≤ n)). - { rewrite <-(resize_resize k m n) by done. by apply Forall2_resize. } - assert (n = length l); subst. - { by rewrite (Forall2_length l (resize n y k)), resize_length. } - rewrite (le_plus_minus (length l) m), !resize_plus, - resize_all, drop_all, resize_nil by lia. - auto using Forall2_app, Forall2_replicate_l, - Forall_resize, Forall_drop, resize_length. - Qed. - Lemma Forall2_resize_r_flip l k x y n m : - P x y → Forall (P x) k → - length k = m → Forall2 P l (resize n y k) → Forall2 P (resize m x l) k. - Proof. - intros ?? <- ?. rewrite <-(resize_all k y) at 2. - apply Forall2_resize_r with n; auto using Forall_true. - Qed. - - Lemma Forall2_sublist_lookup_l l k n i l' : - Forall2 P l k → sublist_lookup n i l = Some l' → - ∃ k', sublist_lookup n i k = Some k' ∧ Forall2 P l' k'. - Proof. - unfold sublist_lookup. intros Hlk Hl. - exists (take i (drop n k)); simplify_option_eq. - - auto using Forall2_take, Forall2_drop. - - apply Forall2_length in Hlk; lia. - Qed. - Lemma Forall2_sublist_lookup_r l k n i k' : - Forall2 P l k → sublist_lookup n i k = Some k' → - ∃ l', sublist_lookup n i l = Some l' ∧ Forall2 P l' k'. - Proof. - intro. unfold sublist_lookup. - erewrite Forall2_length by eauto; intros; simplify_option_eq. - eauto using Forall2_take, Forall2_drop. - Qed. - Lemma Forall2_sublist_alter f g l k i n l' k' : - Forall2 P l k → sublist_lookup i n l = Some l' → - sublist_lookup i n k = Some k' → Forall2 P (f l') (g k') → - Forall2 P (sublist_alter f i n l) (sublist_alter g i n k). - Proof. - intro. unfold sublist_alter, sublist_lookup. - erewrite Forall2_length by eauto; intros; simplify_option_eq. - auto using Forall2_app, Forall2_drop, Forall2_take. - Qed. - Lemma Forall2_sublist_alter_l f l k i n l' k' : - Forall2 P l k → sublist_lookup i n l = Some l' → - sublist_lookup i n k = Some k' → Forall2 P (f l') k' → - Forall2 P (sublist_alter f i n l) k. - Proof. - intro. unfold sublist_lookup, sublist_alter. - erewrite <-Forall2_length by eauto; intros; simplify_option_eq. - apply Forall2_app_l; - rewrite ?take_length_le by lia; auto using Forall2_take. - apply Forall2_app_l; erewrite Forall2_length, take_length, - drop_length, <-Forall2_length, Min.min_l by eauto with lia; [done|]. - rewrite drop_drop; auto using Forall2_drop. - Qed. - - Global Instance Forall2_dec `{dec : ∀ x y, Decision (P x y)} : - ∀ l k, Decision (Forall2 P l k). - Proof. - refine ( - fix go l k : Decision (Forall2 P l k) := - match l, k with - | [], [] => left _ - | x :: l, y :: k => cast_if_and (decide (P x y)) (go l k) - | _, _ => right _ - end); clear dec go; abstract first [by constructor | by inversion 1]. - Defined. -End Forall2. - -Section Forall2_proper. - Context {A} (R : relation A). - - Global Instance: Reflexive R → Reflexive (Forall2 R). - Proof. intros ? l. induction l; by constructor. Qed. - Global Instance: Symmetric R → Symmetric (Forall2 R). - Proof. intros. induction 1; constructor; auto. Qed. - Global Instance: Transitive R → Transitive (Forall2 R). - Proof. intros ????. apply Forall2_transitive. by apply @transitivity. Qed. - Global Instance: Equivalence R → Equivalence (Forall2 R). - Proof. split; apply _. Qed. - Global Instance: PreOrder R → PreOrder (Forall2 R). - Proof. split; apply _. Qed. - Global Instance: AntiSymm (=) R → AntiSymm (=) (Forall2 R). - Proof. induction 2; inversion_clear 1; f_equal; auto. Qed. - - Global Instance: Proper (R ==> Forall2 R ==> Forall2 R) (::). - Proof. by constructor. Qed. - Global Instance: Proper (Forall2 R ==> Forall2 R ==> Forall2 R) (++). - Proof. repeat intro. by apply Forall2_app. Qed. - Global Instance: Proper (Forall2 R ==> (=)) length. - Proof. repeat intro. eauto using Forall2_length. Qed. - Global Instance: Proper (Forall2 R ==> Forall2 R) tail. - Proof. repeat intro. eauto using Forall2_tail. Qed. - Global Instance: Proper (Forall2 R ==> Forall2 R) (take n). - Proof. repeat intro. eauto using Forall2_take. Qed. - Global Instance: Proper (Forall2 R ==> Forall2 R) (drop n). - Proof. repeat intro. eauto using Forall2_drop. Qed. - - Global Instance: Proper (Forall2 R ==> option_Forall2 R) (lookup i). - Proof. repeat intro. by apply Forall2_lookup. Qed. - Global Instance: - Proper (R ==> R) f → Proper (Forall2 R ==> Forall2 R) (alter f i). - Proof. repeat intro. eauto using Forall2_alter. Qed. - Global Instance: Proper (R ==> Forall2 R ==> Forall2 R) (insert i). - Proof. repeat intro. eauto using Forall2_insert. Qed. - Global Instance: - Proper (Forall2 R ==> Forall2 R ==> Forall2 R) (list_inserts i). - Proof. repeat intro. eauto using Forall2_inserts. Qed. - Global Instance: Proper (Forall2 R ==> Forall2 R) (delete i). - Proof. repeat intro. eauto using Forall2_delete. Qed. - - Global Instance: Proper (option_Forall2 R ==> Forall2 R) option_list. - Proof. repeat intro. eauto using Forall2_option_list. Qed. - Global Instance: ∀ P `{∀ x, Decision (P x)}, - Proper (R ==> iff) P → Proper (Forall2 R ==> Forall2 R) (filter P). - Proof. repeat intro; eauto using Forall2_filter. Qed. - - Global Instance: Proper (R ==> Forall2 R) (replicate n). - Proof. repeat intro. eauto using Forall2_replicate. Qed. - Global Instance: Proper (Forall2 R ==> Forall2 R) reverse. - Proof. repeat intro. eauto using Forall2_reverse. Qed. - Global Instance: Proper (Forall2 R ==> option_Forall2 R) last. - Proof. repeat intro. eauto using Forall2_last. Qed. - Global Instance: Proper (R ==> Forall2 R ==> Forall2 R) (resize n). - Proof. repeat intro. eauto using Forall2_resize. Qed. -End Forall2_proper. - -Section Forall3. - Context {A B C} (P : A → B → C → Prop). - Hint Extern 0 (Forall3 _ _ _ _) => constructor. - - Lemma Forall3_app l1 l2 k1 k2 k1' k2' : - Forall3 P l1 k1 k1' → Forall3 P l2 k2 k2' → - Forall3 P (l1 ++ l2) (k1 ++ k2) (k1' ++ k2'). - Proof. induction 1; simpl; auto. Qed. - Lemma Forall3_cons_inv_l x l k k' : - Forall3 P (x :: l) k k' → ∃ y k2 z k2', - k = y :: k2 ∧ k' = z :: k2' ∧ P x y z ∧ Forall3 P l k2 k2'. - Proof. inversion_clear 1; naive_solver. Qed. - Lemma Forall3_app_inv_l l1 l2 k k' : - Forall3 P (l1 ++ l2) k k' → ∃ k1 k2 k1' k2', - k = k1 ++ k2 ∧ k' = k1' ++ k2' ∧ Forall3 P l1 k1 k1' ∧ Forall3 P l2 k2 k2'. - Proof. - revert k k'. induction l1 as [|x l1 IH]; simpl; inversion_clear 1. - - by repeat eexists; eauto. - - by repeat eexists; eauto. - - edestruct IH as (?&?&?&?&?&?&?&?); eauto; naive_solver. - Qed. - Lemma Forall3_cons_inv_m l y k k' : - Forall3 P l (y :: k) k' → ∃ x l2 z k2', - l = x :: l2 ∧ k' = z :: k2' ∧ P x y z ∧ Forall3 P l2 k k2'. - Proof. inversion_clear 1; naive_solver. Qed. - Lemma Forall3_app_inv_m l k1 k2 k' : - Forall3 P l (k1 ++ k2) k' → ∃ l1 l2 k1' k2', - l = l1 ++ l2 ∧ k' = k1' ++ k2' ∧ Forall3 P l1 k1 k1' ∧ Forall3 P l2 k2 k2'. - Proof. - revert l k'. induction k1 as [|x k1 IH]; simpl; inversion_clear 1. - - by repeat eexists; eauto. - - by repeat eexists; eauto. - - edestruct IH as (?&?&?&?&?&?&?&?); eauto; naive_solver. - Qed. - Lemma Forall3_cons_inv_r l k z k' : - Forall3 P l k (z :: k') → ∃ x l2 y k2, - l = x :: l2 ∧ k = y :: k2 ∧ P x y z ∧ Forall3 P l2 k2 k'. - Proof. inversion_clear 1; naive_solver. Qed. - Lemma Forall3_app_inv_r l k k1' k2' : - Forall3 P l k (k1' ++ k2') → ∃ l1 l2 k1 k2, - l = l1 ++ l2 ∧ k = k1 ++ k2 ∧ Forall3 P l1 k1 k1' ∧ Forall3 P l2 k2 k2'. - Proof. - revert l k. induction k1' as [|x k1' IH]; simpl; inversion_clear 1. - - by repeat eexists; eauto. - - by repeat eexists; eauto. - - edestruct IH as (?&?&?&?&?&?&?&?); eauto; naive_solver. - Qed. - Lemma Forall3_impl (Q : A → B → C → Prop) l k k' : - Forall3 P l k k' → (∀ x y z, P x y z → Q x y z) → Forall3 Q l k k'. - Proof. intros Hl ?; induction Hl; auto. Defined. - Lemma Forall3_length_lm l k k' : Forall3 P l k k' → length l = length k. - Proof. by induction 1; f_equal/=. Qed. - Lemma Forall3_length_lr l k k' : Forall3 P l k k' → length l = length k'. - Proof. by induction 1; f_equal/=. Qed. - Lemma Forall3_lookup_lmr l k k' i x y z : - Forall3 P l k k' → - l !! i = Some x → k !! i = Some y → k' !! i = Some z → P x y z. - Proof. - intros H. revert i. induction H; intros [|?] ???; simplify_eq/=; eauto. - Qed. - Lemma Forall3_lookup_l l k k' i x : - Forall3 P l k k' → l !! i = Some x → - ∃ y z, k !! i = Some y ∧ k' !! i = Some z ∧ P x y z. - Proof. - intros H. revert i. induction H; intros [|?] ?; simplify_eq/=; eauto. - Qed. - Lemma Forall3_lookup_m l k k' i y : - Forall3 P l k k' → k !! i = Some y → - ∃ x z, l !! i = Some x ∧ k' !! i = Some z ∧ P x y z. - Proof. - intros H. revert i. induction H; intros [|?] ?; simplify_eq/=; eauto. - Qed. - Lemma Forall3_lookup_r l k k' i z : - Forall3 P l k k' → k' !! i = Some z → - ∃ x y, l !! i = Some x ∧ k !! i = Some y ∧ P x y z. - Proof. - intros H. revert i. induction H; intros [|?] ?; simplify_eq/=; eauto. - Qed. - Lemma Forall3_alter_lm f g l k k' i : - Forall3 P l k k' → - (∀ x y z, l !! i = Some x → k !! i = Some y → k' !! i = Some z → - P x y z → P (f x) (g y) z) → - Forall3 P (alter f i l) (alter g i k) k'. - Proof. intros Hl. revert i. induction Hl; intros [|]; auto. Qed. -End Forall3. - -(** Setoids *) -Section setoid. - Context `{Equiv A}. - Implicit Types l k : list A. - - Lemma equiv_Forall2 l k : l ≡ k ↔ Forall2 (≡) l k. - Proof. split; induction 1; constructor; auto. Qed. - Lemma list_equiv_lookup l k : l ≡ k ↔ ∀ i, l !! i ≡ k !! i. - Proof. - rewrite equiv_Forall2, Forall2_lookup. - by setoid_rewrite equiv_option_Forall2. - Qed. - - Global Instance list_equivalence : - Equivalence ((≡) : relation A) → Equivalence ((≡) : relation (list A)). - Proof. - split. - - intros l. by apply equiv_Forall2. - - intros l k; rewrite !equiv_Forall2; by intros. - - intros l1 l2 l3; rewrite !equiv_Forall2; intros; by trans l2. - Qed. - Global Instance list_leibniz `{!LeibnizEquiv A} : LeibnizEquiv (list A). - Proof. induction 1; f_equal; fold_leibniz; auto. Qed. - - Global Instance cons_proper : Proper ((≡) ==> (≡) ==> (≡)) (@cons A). - Proof. by constructor. Qed. - Global Instance app_proper : Proper ((≡) ==> (≡) ==> (≡)) (@app A). - Proof. induction 1; intros ???; simpl; try constructor; auto. Qed. - Global Instance length_proper : Proper ((≡) ==> (=)) (@length A). - Proof. induction 1; f_equal/=; auto. Qed. - Global Instance tail_proper : Proper ((≡) ==> (≡)) (@tail A). - Proof. destruct 1; try constructor; auto. Qed. - Global Instance take_proper n : Proper ((≡) ==> (≡)) (@take A n). - Proof. induction n; destruct 1; constructor; auto. Qed. - Global Instance drop_proper n : Proper ((≡) ==> (≡)) (@drop A n). - Proof. induction n; destruct 1; simpl; try constructor; auto. Qed. - Global Instance list_lookup_proper i : - Proper ((≡) ==> (≡)) (lookup (M:=list A) i). - Proof. induction i; destruct 1; simpl; try constructor; auto. Qed. - Global Instance list_alter_proper f i : - Proper ((≡) ==> (≡)) f → Proper ((≡) ==> (≡)) (alter (M:=list A) f i). - Proof. intros. induction i; destruct 1; constructor; eauto. Qed. - Global Instance list_insert_proper i : - Proper ((≡) ==> (≡) ==> (≡)) (insert (M:=list A) i). - Proof. intros ???; induction i; destruct 1; constructor; eauto. Qed. - Global Instance list_inserts_proper i : - Proper ((≡) ==> (≡) ==> (≡)) (@list_inserts A i). - Proof. - intros k1 k2 Hk; revert i. - induction Hk; intros ????; simpl; try f_equiv; naive_solver. - Qed. - Global Instance list_delete_proper i : - Proper ((≡) ==> (≡)) (delete (M:=list A) i). - Proof. induction i; destruct 1; try constructor; eauto. Qed. - Global Instance option_list_proper : Proper ((≡) ==> (≡)) (@option_list A). - Proof. destruct 1; repeat constructor; auto. Qed. - Global Instance list_filter_proper P `{∀ x, Decision (P x)} : - Proper ((≡) ==> iff) P → Proper ((≡) ==> (≡)) (filter (B:=list A) P). - Proof. intros ???. rewrite !equiv_Forall2. by apply Forall2_filter. Qed. - Global Instance replicate_proper n : Proper ((≡) ==> (≡)) (@replicate A n). - Proof. induction n; constructor; auto. Qed. - Global Instance reverse_proper : Proper ((≡) ==> (≡)) (@reverse A). - Proof. - induction 1; rewrite ?reverse_cons; simpl; [constructor|]. - apply app_proper; repeat constructor; auto. - Qed. - Global Instance last_proper : Proper ((≡) ==> (≡)) (@last A). - Proof. induction 1 as [|????? []]; simpl; repeat constructor; auto. Qed. - Global Instance resize_proper n : Proper ((≡) ==> (≡) ==> (≡)) (@resize A n). - Proof. - induction n; destruct 2; simpl; repeat (constructor || f_equiv); auto. - Qed. -End setoid. - -(** * Properties of the monadic operations *) -Lemma list_fmap_id {A} (l : list A) : id <$> l = l. -Proof. induction l; f_equal/=; auto. Qed. - -Section fmap. - Context {A B : Type} (f : A → B). - - Lemma list_fmap_compose {C} (g : B → C) l : g ∘ f <$> l = g <$> f <$> l. - Proof. induction l; f_equal/=; auto. Qed. - Lemma list_fmap_ext (g : A → B) (l1 l2 : list A) : - (∀ x, f x = g x) → l1 = l2 → fmap f l1 = fmap g l2. - Proof. intros ? <-. induction l1; f_equal/=; auto. Qed. - Lemma list_fmap_equiv_ext `{Equiv B} (g : A → B) l : - (∀ x, f x ≡ g x) → f <$> l ≡ g <$> l. - Proof. induction l; constructor; auto. Qed. - - Global Instance: Inj (=) (=) f → Inj (=) (=) (fmap f). - Proof. - intros ? l1. induction l1 as [|x l1 IH]; [by intros [|??]|]. - intros [|??]; intros; f_equal/=; simplify_eq; auto. - Qed. - - Definition fmap_nil : f <$> [] = [] := eq_refl. - Definition fmap_cons x l : f <$> x :: l = f x :: f <$> l := eq_refl. - - Lemma fmap_app l1 l2 : f <$> l1 ++ l2 = (f <$> l1) ++ (f <$> l2). - Proof. by induction l1; f_equal/=. Qed. - Lemma fmap_nil_inv k : f <$> k = [] → k = []. - Proof. by destruct k. Qed. - Lemma fmap_cons_inv y l k : - f <$> l = y :: k → ∃ x l', y = f x ∧ k = f <$> l' ∧ l = x :: l'. - Proof. intros. destruct l; simplify_eq/=; eauto. Qed. - Lemma fmap_app_inv l k1 k2 : - f <$> l = k1 ++ k2 → ∃ l1 l2, k1 = f <$> l1 ∧ k2 = f <$> l2 ∧ l = l1 ++ l2. - Proof. - revert l. induction k1 as [|y k1 IH]; simpl; [intros l ?; by eexists [],l|]. - intros [|x l] ?; simplify_eq/=. - destruct (IH l) as (l1&l2&->&->&->); [done|]. by exists (x :: l1), l2. - Qed. - - Lemma fmap_length l : length (f <$> l) = length l. - Proof. by induction l; f_equal/=. Qed. - Lemma fmap_reverse l : f <$> reverse l = reverse (f <$> l). - Proof. - induction l as [|?? IH]; csimpl; by rewrite ?reverse_cons, ?fmap_app, ?IH. - Qed. - Lemma fmap_tail l : f <$> tail l = tail (f <$> l). - Proof. by destruct l. Qed. - Lemma fmap_last l : last (f <$> l) = f <$> last l. - Proof. induction l as [|? []]; simpl; auto. Qed. - Lemma fmap_replicate n x : f <$> replicate n x = replicate n (f x). - Proof. by induction n; f_equal/=. Qed. - Lemma fmap_take n l : f <$> take n l = take n (f <$> l). - Proof. revert n. by induction l; intros [|?]; f_equal/=. Qed. - Lemma fmap_drop n l : f <$> drop n l = drop n (f <$> l). - Proof. revert n. by induction l; intros [|?]; f_equal/=. Qed. - Lemma fmap_resize n x l : f <$> resize n x l = resize n (f x) (f <$> l). - Proof. - revert n. induction l; intros [|?]; f_equal/=; auto using fmap_replicate. - Qed. - Lemma const_fmap (l : list A) (y : B) : - (∀ x, f x = y) → f <$> l = replicate (length l) y. - Proof. intros; induction l; f_equal/=; auto. Qed. - Lemma list_lookup_fmap l i : (f <$> l) !! i = f <$> (l !! i). - Proof. revert i. induction l; intros [|n]; by try revert n. Qed. - Lemma list_lookup_fmap_inv l i x : - (f <$> l) !! i = Some x → ∃ y, x = f y ∧ l !! i = Some y. - Proof. - intros Hi. rewrite list_lookup_fmap in Hi. - destruct (l !! i) eqn:?; simplify_eq/=; eauto. - Qed. - Lemma list_alter_fmap (g : A → A) (h : B → B) l i : - Forall (λ x, f (g x) = h (f x)) l → f <$> alter g i l = alter h i (f <$> l). - Proof. intros Hl. revert i. by induction Hl; intros [|i]; f_equal/=. Qed. - - Lemma elem_of_list_fmap_1 l x : x ∈ l → f x ∈ f <$> l. - Proof. induction 1; csimpl; rewrite elem_of_cons; intuition. Qed. - Lemma elem_of_list_fmap_1_alt l x y : x ∈ l → y = f x → y ∈ f <$> l. - Proof. intros. subst. by apply elem_of_list_fmap_1. Qed. - Lemma elem_of_list_fmap_2 l x : x ∈ f <$> l → ∃ y, x = f y ∧ y ∈ l. - Proof. - induction l as [|y l IH]; simpl; inversion_clear 1. - - exists y. split; [done | by left]. - - destruct IH as [z [??]]. done. exists z. split; [done | by right]. - Qed. - Lemma elem_of_list_fmap l x : x ∈ f <$> l ↔ ∃ y, x = f y ∧ y ∈ l. - Proof. - naive_solver eauto using elem_of_list_fmap_1_alt, elem_of_list_fmap_2. - Qed. - - Lemma NoDup_fmap_1 l : NoDup (f <$> l) → NoDup l. - Proof. - induction l; simpl; inversion_clear 1; constructor; auto. - rewrite elem_of_list_fmap in *. naive_solver. - Qed. - Lemma NoDup_fmap_2 `{!Inj (=) (=) f} l : NoDup l → NoDup (f <$> l). - Proof. - induction 1; simpl; constructor; trivial. rewrite elem_of_list_fmap. - intros [y [Hxy ?]]. apply (inj f) in Hxy. by subst. - Qed. - Lemma NoDup_fmap `{!Inj (=) (=) f} l : NoDup (f <$> l) ↔ NoDup l. - Proof. split; auto using NoDup_fmap_1, NoDup_fmap_2. Qed. - - Global Instance fmap_sublist: Proper (sublist ==> sublist) (fmap f). - Proof. induction 1; simpl; econstructor; eauto. Qed. - Global Instance fmap_submseteq: Proper (submseteq ==> submseteq) (fmap f). - Proof. induction 1; simpl; econstructor; eauto. Qed. - Global Instance fmap_Permutation: Proper ((≡ₚ) ==> (≡ₚ)) (fmap f). - Proof. induction 1; simpl; econstructor; eauto. Qed. - - Lemma Forall_fmap_ext_1 (g : A → B) (l : list A) : - Forall (λ x, f x = g x) l → fmap f l = fmap g l. - Proof. by induction 1; f_equal/=. Qed. - Lemma Forall_fmap_ext (g : A → B) (l : list A) : - Forall (λ x, f x = g x) l ↔ fmap f l = fmap g l. - Proof. - split; [auto using Forall_fmap_ext_1|]. - induction l; simpl; constructor; simplify_eq; auto. - Qed. - Lemma Forall_fmap (P : B → Prop) l : Forall P (f <$> l) ↔ Forall (P ∘ f) l. - Proof. split; induction l; inversion_clear 1; constructor; auto. Qed. - Lemma Exists_fmap (P : B → Prop) l : Exists P (f <$> l) ↔ Exists (P ∘ f) l. - Proof. split; induction l; inversion 1; constructor; by auto. Qed. - - Lemma Forall2_fmap_l {C} (P : B → C → Prop) l1 l2 : - Forall2 P (f <$> l1) l2 ↔ Forall2 (P ∘ f) l1 l2. - Proof. - split; revert l2; induction l1; inversion_clear 1; constructor; auto. - Qed. - Lemma Forall2_fmap_r {C} (P : C → B → Prop) l1 l2 : - Forall2 P l1 (f <$> l2) ↔ Forall2 (λ x, P x ∘ f) l1 l2. - Proof. - split; revert l1; induction l2; inversion_clear 1; constructor; auto. - Qed. - Lemma Forall2_fmap_1 {C D} (g : C → D) (P : B → D → Prop) l1 l2 : - Forall2 P (f <$> l1) (g <$> l2) → Forall2 (λ x1 x2, P (f x1) (g x2)) l1 l2. - Proof. revert l2; induction l1; intros [|??]; inversion_clear 1; auto. Qed. - Lemma Forall2_fmap_2 {C D} (g : C → D) (P : B → D → Prop) l1 l2 : - Forall2 (λ x1 x2, P (f x1) (g x2)) l1 l2 → Forall2 P (f <$> l1) (g <$> l2). - Proof. induction 1; csimpl; auto. Qed. - Lemma Forall2_fmap {C D} (g : C → D) (P : B → D → Prop) l1 l2 : - Forall2 P (f <$> l1) (g <$> l2) ↔ Forall2 (λ x1 x2, P (f x1) (g x2)) l1 l2. - Proof. split; auto using Forall2_fmap_1, Forall2_fmap_2. Qed. - - Lemma list_fmap_bind {C} (g : B → list C) l : (f <$> l) ≫= g = l ≫= g ∘ f. - Proof. by induction l; f_equal/=. Qed. -End fmap. - -Lemma list_alter_fmap_mono {A} (f : A → A) (g : A → A) l i : - Forall (λ x, f (g x) = g (f x)) l → f <$> alter g i l = alter g i (f <$> l). -Proof. auto using list_alter_fmap. Qed. -Lemma NoDup_fmap_fst {A B} (l : list (A * B)) : - (∀ x y1 y2, (x,y1) ∈ l → (x,y2) ∈ l → y1 = y2) → NoDup l → NoDup (l.*1). -Proof. - intros Hunique. induction 1 as [|[x1 y1] l Hin Hnodup IH]; csimpl; constructor. - - rewrite elem_of_list_fmap. - intros [[x2 y2] [??]]; simpl in *; subst. destruct Hin. - rewrite (Hunique x2 y1 y2); rewrite ?elem_of_cons; auto. - - apply IH. intros. eapply Hunique; rewrite ?elem_of_cons; eauto. -Qed. - -Section bind. - Context {A B : Type} (f : A → list B). - - Lemma list_bind_ext (g : A → list B) l1 l2 : - (∀ x, f x = g x) → l1 = l2 → l1 ≫= f = l2 ≫= g. - Proof. intros ? <-. by induction l1; f_equal/=. Qed. - Lemma Forall_bind_ext (g : A → list B) (l : list A) : - Forall (λ x, f x = g x) l → l ≫= f = l ≫= g. - Proof. by induction 1; f_equal/=. Qed. - Global Instance bind_sublist: Proper (sublist ==> sublist) (mbind f). - Proof. - induction 1; simpl; auto; - [by apply sublist_app|by apply sublist_inserts_l]. - Qed. - Global Instance bind_submseteq: Proper (submseteq ==> submseteq) (mbind f). - Proof. - induction 1; csimpl; auto. - - by apply submseteq_app. - - by rewrite !(assoc_L (++)), (comm (++) (f _)). - - by apply submseteq_inserts_l. - - etrans; eauto. - Qed. - Global Instance bind_Permutation: Proper ((≡ₚ) ==> (≡ₚ)) (mbind f). - Proof. - induction 1; csimpl; auto. - - by f_equiv. - - by rewrite !(assoc_L (++)), (comm (++) (f _)). - - etrans; eauto. - Qed. - Lemma bind_cons x l : (x :: l) ≫= f = f x ++ l ≫= f. - Proof. done. Qed. - Lemma bind_singleton x : [x] ≫= f = f x. - Proof. csimpl. by rewrite (right_id_L _ (++)). Qed. - Lemma bind_app l1 l2 : (l1 ++ l2) ≫= f = (l1 ≫= f) ++ (l2 ≫= f). - Proof. by induction l1; csimpl; rewrite <-?(assoc_L (++)); f_equal. Qed. - Lemma elem_of_list_bind (x : B) (l : list A) : - x ∈ l ≫= f ↔ ∃ y, x ∈ f y ∧ y ∈ l. - Proof. - split. - - induction l as [|y l IH]; csimpl; [inversion 1|]. - rewrite elem_of_app. intros [?|?]. - + exists y. split; [done | by left]. - + destruct IH as [z [??]]. done. exists z. split; [done | by right]. - - intros [y [Hx Hy]]. induction Hy; csimpl; rewrite elem_of_app; intuition. - Qed. - Lemma Forall_bind (P : B → Prop) l : - Forall P (l ≫= f) ↔ Forall (Forall P ∘ f) l. - Proof. - split. - - induction l; csimpl; rewrite ?Forall_app; constructor; csimpl; intuition. - - induction 1; csimpl; rewrite ?Forall_app; auto. - Qed. - Lemma Forall2_bind {C D} (g : C → list D) (P : B → D → Prop) l1 l2 : - Forall2 (λ x1 x2, Forall2 P (f x1) (g x2)) l1 l2 → - Forall2 P (l1 ≫= f) (l2 ≫= g). - Proof. induction 1; csimpl; auto using Forall2_app. Qed. -End bind. - -Section ret_join. - Context {A : Type}. - - Lemma list_join_bind (ls : list (list A)) : mjoin ls = ls ≫= id. - Proof. by induction ls; f_equal/=. Qed. - Global Instance mjoin_Permutation: - Proper (@Permutation (list A) ==> (≡ₚ)) mjoin. - Proof. intros ?? E. by rewrite !list_join_bind, E. Qed. - Lemma elem_of_list_ret (x y : A) : x ∈ @mret list _ A y ↔ x = y. - Proof. apply elem_of_list_singleton. Qed. - Lemma elem_of_list_join (x : A) (ls : list (list A)) : - x ∈ mjoin ls ↔ ∃ l, x ∈ l ∧ l ∈ ls. - Proof. by rewrite list_join_bind, elem_of_list_bind. Qed. - Lemma join_nil (ls : list (list A)) : mjoin ls = [] ↔ Forall (= []) ls. - Proof. - split; [|by induction 1 as [|[|??] ?]]. - by induction ls as [|[|??] ?]; constructor; auto. - Qed. - Lemma join_nil_1 (ls : list (list A)) : mjoin ls = [] → Forall (= []) ls. - Proof. by rewrite join_nil. Qed. - Lemma join_nil_2 (ls : list (list A)) : Forall (= []) ls → mjoin ls = []. - Proof. by rewrite join_nil. Qed. - Lemma Forall_join (P : A → Prop) (ls: list (list A)) : - Forall (Forall P) ls → Forall P (mjoin ls). - Proof. induction 1; simpl; auto using Forall_app_2. Qed. - Lemma Forall2_join {B} (P : A → B → Prop) ls1 ls2 : - Forall2 (Forall2 P) ls1 ls2 → Forall2 P (mjoin ls1) (mjoin ls2). - Proof. induction 1; simpl; auto using Forall2_app. Qed. -End ret_join. - -Section mapM. - Context {A B : Type} (f : A → option B). - - Lemma mapM_ext (g : A → option B) l : (∀ x, f x = g x) → mapM f l = mapM g l. - Proof. intros Hfg. by induction l; simpl; rewrite ?Hfg, ?IHl. Qed. - Lemma Forall2_mapM_ext (g : A → option B) l k : - Forall2 (λ x y, f x = g y) l k → mapM f l = mapM g k. - Proof. induction 1 as [|???? Hfg ? IH]; simpl. done. by rewrite Hfg, IH. Qed. - Lemma Forall_mapM_ext (g : A → option B) l : - Forall (λ x, f x = g x) l → mapM f l = mapM g l. - Proof. induction 1 as [|?? Hfg ? IH]; simpl. done. by rewrite Hfg, IH. Qed. - Lemma mapM_Some_1 l k : mapM f l = Some k → Forall2 (λ x y, f x = Some y) l k. - Proof. - revert k. induction l as [|x l]; intros [|y k]; simpl; try done. - - destruct (f x); simpl; [|discriminate]. by destruct (mapM f l). - - destruct (f x) eqn:?; intros; simplify_option_eq; auto. - Qed. - Lemma mapM_Some_2 l k : Forall2 (λ x y, f x = Some y) l k → mapM f l = Some k. - Proof. - induction 1 as [|???? Hf ? IH]; simpl; [done |]. - rewrite Hf. simpl. by rewrite IH. - Qed. - Lemma mapM_Some l k : mapM f l = Some k ↔ Forall2 (λ x y, f x = Some y) l k. - Proof. split; auto using mapM_Some_1, mapM_Some_2. Qed. - Lemma mapM_length l k : mapM f l = Some k → length l = length k. - Proof. intros. by eapply Forall2_length, mapM_Some_1. Qed. - Lemma mapM_None_1 l : mapM f l = None → Exists (λ x, f x = None) l. - Proof. - induction l as [|x l IH]; simpl; [done|]. - destruct (f x) eqn:?; simpl; eauto. by destruct (mapM f l); eauto. - Qed. - Lemma mapM_None_2 l : Exists (λ x, f x = None) l → mapM f l = None. - Proof. - induction 1 as [x l Hx|x l ? IH]; simpl; [by rewrite Hx|]. - by destruct (f x); simpl; rewrite ?IH. - Qed. - Lemma mapM_None l : mapM f l = None ↔ Exists (λ x, f x = None) l. - Proof. split; auto using mapM_None_1, mapM_None_2. Qed. - Lemma mapM_is_Some_1 l : is_Some (mapM f l) → Forall (is_Some ∘ f) l. - Proof. - unfold compose. setoid_rewrite <-not_eq_None_Some. - rewrite mapM_None. apply (not_Exists_Forall _). - Qed. - Lemma mapM_is_Some_2 l : Forall (is_Some ∘ f) l → is_Some (mapM f l). - Proof. - unfold compose. setoid_rewrite <-not_eq_None_Some. - rewrite mapM_None. apply (Forall_not_Exists _). - Qed. - Lemma mapM_is_Some l : is_Some (mapM f l) ↔ Forall (is_Some ∘ f) l. - Proof. split; auto using mapM_is_Some_1, mapM_is_Some_2. Qed. - Lemma mapM_fmap_Some (g : B → A) (l : list B) : - (∀ x, f (g x) = Some x) → mapM f (g <$> l) = Some l. - Proof. intros. by induction l; simpl; simplify_option_eq. Qed. - Lemma mapM_fmap_Some_inv (g : B → A) (l : list B) (k : list A) : - (∀ x y, f y = Some x → y = g x) → mapM f k = Some l → k = g <$> l. - Proof. - intros Hgf. revert l; induction k as [|??]; intros [|??] ?; - simplify_option_eq; f_equiv; eauto. - Qed. -End mapM. - -(** ** Properties of the [permutations] function *) -Section permutations. - Context {A : Type}. - Implicit Types x y z : A. - Implicit Types l : list A. - - Lemma interleave_cons x l : x :: l ∈ interleave x l. - Proof. destruct l; simpl; rewrite elem_of_cons; auto. Qed. - Lemma interleave_Permutation x l l' : l' ∈ interleave x l → l' ≡ₚ x :: l. - Proof. - revert l'. induction l as [|y l IH]; intros l'; simpl. - - rewrite elem_of_list_singleton. by intros ->. - - rewrite elem_of_cons, elem_of_list_fmap. intros [->|[? [-> H]]]; [done|]. - rewrite (IH _ H). constructor. - Qed. - Lemma permutations_refl l : l ∈ permutations l. - Proof. - induction l; simpl; [by apply elem_of_list_singleton|]. - apply elem_of_list_bind. eauto using interleave_cons. - Qed. - Lemma permutations_skip x l l' : - l ∈ permutations l' → x :: l ∈ permutations (x :: l'). - Proof. intro. apply elem_of_list_bind; eauto using interleave_cons. Qed. - Lemma permutations_swap x y l : y :: x :: l ∈ permutations (x :: y :: l). - Proof. - simpl. apply elem_of_list_bind. exists (y :: l). split; simpl. - - destruct l; csimpl; rewrite !elem_of_cons; auto. - - apply elem_of_list_bind. simpl. - eauto using interleave_cons, permutations_refl. - Qed. - Lemma permutations_nil l : l ∈ permutations [] ↔ l = []. - Proof. simpl. by rewrite elem_of_list_singleton. Qed. - Lemma interleave_interleave_toggle x1 x2 l1 l2 l3 : - l1 ∈ interleave x1 l2 → l2 ∈ interleave x2 l3 → ∃ l4, - l1 ∈ interleave x2 l4 ∧ l4 ∈ interleave x1 l3. - Proof. - revert l1 l2. induction l3 as [|y l3 IH]; intros l1 l2; simpl. - { rewrite !elem_of_list_singleton. intros ? ->. exists [x1]. - change (interleave x2 [x1]) with ([[x2; x1]] ++ [[x1; x2]]). - by rewrite (comm (++)), elem_of_list_singleton. } - rewrite elem_of_cons, elem_of_list_fmap. - intros Hl1 [? | [l2' [??]]]; simplify_eq/=. - - rewrite !elem_of_cons, elem_of_list_fmap in Hl1. - destruct Hl1 as [? | [? | [l4 [??]]]]; subst. - + exists (x1 :: y :: l3). csimpl. rewrite !elem_of_cons. tauto. - + exists (x1 :: y :: l3). csimpl. rewrite !elem_of_cons. tauto. - + exists l4. simpl. rewrite elem_of_cons. auto using interleave_cons. - - rewrite elem_of_cons, elem_of_list_fmap in Hl1. - destruct Hl1 as [? | [l1' [??]]]; subst. - + exists (x1 :: y :: l3). csimpl. - rewrite !elem_of_cons, !elem_of_list_fmap. - split; [| by auto]. right. right. exists (y :: l2'). - rewrite elem_of_list_fmap. naive_solver. - + destruct (IH l1' l2') as [l4 [??]]; auto. exists (y :: l4). simpl. - rewrite !elem_of_cons, !elem_of_list_fmap. naive_solver. - Qed. - Lemma permutations_interleave_toggle x l1 l2 l3 : - l1 ∈ permutations l2 → l2 ∈ interleave x l3 → ∃ l4, - l1 ∈ interleave x l4 ∧ l4 ∈ permutations l3. - Proof. - revert l1 l2. induction l3 as [|y l3 IH]; intros l1 l2; simpl. - { rewrite elem_of_list_singleton. intros Hl1 ->. eexists []. - by rewrite elem_of_list_singleton. } - rewrite elem_of_cons, elem_of_list_fmap. - intros Hl1 [? | [l2' [? Hl2']]]; simplify_eq/=. - - rewrite elem_of_list_bind in Hl1. - destruct Hl1 as [l1' [??]]. by exists l1'. - - rewrite elem_of_list_bind in Hl1. setoid_rewrite elem_of_list_bind. - destruct Hl1 as [l1' [??]]. destruct (IH l1' l2') as (l1''&?&?); auto. - destruct (interleave_interleave_toggle y x l1 l1' l1'') as (?&?&?); eauto. - Qed. - Lemma permutations_trans l1 l2 l3 : - l1 ∈ permutations l2 → l2 ∈ permutations l3 → l1 ∈ permutations l3. - Proof. - revert l1 l2. induction l3 as [|x l3 IH]; intros l1 l2; simpl. - - rewrite !elem_of_list_singleton. intros Hl1 ->; simpl in *. - by rewrite elem_of_list_singleton in Hl1. - - rewrite !elem_of_list_bind. intros Hl1 [l2' [Hl2 Hl2']]. - destruct (permutations_interleave_toggle x l1 l2 l2') as [? [??]]; eauto. - Qed. - Lemma permutations_Permutation l l' : l' ∈ permutations l ↔ l ≡ₚ l'. - Proof. - split. - - revert l'. induction l; simpl; intros l''. - + rewrite elem_of_list_singleton. by intros ->. - + rewrite elem_of_list_bind. intros [l' [Hl'' ?]]. - rewrite (interleave_Permutation _ _ _ Hl''). constructor; auto. - - induction 1; eauto using permutations_refl, - permutations_skip, permutations_swap, permutations_trans. - Qed. -End permutations. - -(** ** Properties of the folding functions *) -Definition foldr_app := @fold_right_app. -Lemma foldl_app {A B} (f : A → B → A) (l k : list B) (a : A) : - foldl f a (l ++ k) = foldl f (foldl f a l) k. -Proof. revert a. induction l; simpl; auto. Qed. -Lemma foldr_permutation {A B} (R : relation B) `{!PreOrder R} - (f : A → B → B) (b : B) `{!∀ x, Proper (R ==> R) (f x)} - (Hf : ∀ a1 a2 b, R (f a1 (f a2 b)) (f a2 (f a1 b))) : - Proper ((≡ₚ) ==> R) (foldr f b). -Proof. induction 1; simpl; [done|by f_equiv|apply Hf|etrans; eauto]. Qed. - -(** ** Properties of the [zip_with] and [zip] functions *) -Section zip_with. - Context {A B C : Type} (f : A → B → C). - Implicit Types x : A. - Implicit Types y : B. - Implicit Types l : list A. - Implicit Types k : list B. - - Lemma zip_with_nil_r l : zip_with f l [] = []. - Proof. by destruct l. Qed. - Lemma zip_with_app l1 l2 k1 k2 : - length l1 = length k1 → - zip_with f (l1 ++ l2) (k1 ++ k2) = zip_with f l1 k1 ++ zip_with f l2 k2. - Proof. rewrite <-Forall2_same_length. induction 1; f_equal/=; auto. Qed. - Lemma zip_with_app_l l1 l2 k : - zip_with f (l1 ++ l2) k - = zip_with f l1 (take (length l1) k) ++ zip_with f l2 (drop (length l1) k). - Proof. - revert k. induction l1; intros [|??]; f_equal/=; auto. by destruct l2. - Qed. - Lemma zip_with_app_r l k1 k2 : - zip_with f l (k1 ++ k2) - = zip_with f (take (length k1) l) k1 ++ zip_with f (drop (length k1) l) k2. - Proof. revert l. induction k1; intros [|??]; f_equal/=; auto. Qed. - Lemma zip_with_flip l k : zip_with (flip f) k l = zip_with f l k. - Proof. revert k. induction l; intros [|??]; f_equal/=; auto. Qed. - Lemma zip_with_ext (g : A → B → C) l1 l2 k1 k2 : - (∀ x y, f x y = g x y) → l1 = l2 → k1 = k2 → - zip_with f l1 k1 = zip_with g l2 k2. - Proof. intros ? <-<-. revert k1. by induction l1; intros [|??]; f_equal/=. Qed. - Lemma Forall_zip_with_ext_l (g : A → B → C) l k1 k2 : - Forall (λ x, ∀ y, f x y = g x y) l → k1 = k2 → - zip_with f l k1 = zip_with g l k2. - Proof. intros Hl <-. revert k1. by induction Hl; intros [|??]; f_equal/=. Qed. - Lemma Forall_zip_with_ext_r (g : A → B → C) l1 l2 k : - l1 = l2 → Forall (λ y, ∀ x, f x y = g x y) k → - zip_with f l1 k = zip_with g l2 k. - Proof. intros <- Hk. revert l1. by induction Hk; intros [|??]; f_equal/=. Qed. - Lemma zip_with_fmap_l {D} (g : D → A) lD k : - zip_with f (g <$> lD) k = zip_with (λ z, f (g z)) lD k. - Proof. revert k. by induction lD; intros [|??]; f_equal/=. Qed. - Lemma zip_with_fmap_r {D} (g : D → B) l kD : - zip_with f l (g <$> kD) = zip_with (λ x z, f x (g z)) l kD. - Proof. revert kD. by induction l; intros [|??]; f_equal/=. Qed. - Lemma zip_with_nil_inv l k : zip_with f l k = [] → l = [] ∨ k = []. - Proof. destruct l, k; intros; simplify_eq/=; auto. Qed. - Lemma zip_with_cons_inv l k z lC : - zip_with f l k = z :: lC → - ∃ x y l' k', z = f x y ∧ lC = zip_with f l' k' ∧ l = x :: l' ∧ k = y :: k'. - Proof. intros. destruct l, k; simplify_eq/=; repeat eexists. Qed. - Lemma zip_with_app_inv l k lC1 lC2 : - zip_with f l k = lC1 ++ lC2 → - ∃ l1 k1 l2 k2, lC1 = zip_with f l1 k1 ∧ lC2 = zip_with f l2 k2 ∧ - l = l1 ++ l2 ∧ k = k1 ++ k2 ∧ length l1 = length k1. - Proof. - revert l k. induction lC1 as [|z lC1 IH]; simpl. - { intros l k ?. by eexists [], [], l, k. } - intros [|x l] [|y k] ?; simplify_eq/=. - destruct (IH l k) as (l1&k1&l2&k2&->&->&->&->&?); [done |]. - exists (x :: l1), (y :: k1), l2, k2; simpl; auto with congruence. - Qed. - Lemma zip_with_inj `{!Inj2 (=) (=) (=) f} l1 l2 k1 k2 : - length l1 = length k1 → length l2 = length k2 → - zip_with f l1 k1 = zip_with f l2 k2 → l1 = l2 ∧ k1 = k2. - Proof. - rewrite <-!Forall2_same_length. intros Hl. revert l2 k2. - induction Hl; intros ?? [] ?; f_equal; naive_solver. - Qed. - Lemma zip_with_length l k : - length (zip_with f l k) = min (length l) (length k). - Proof. revert k. induction l; intros [|??]; simpl; auto with lia. Qed. - Lemma zip_with_length_l l k : - length l ≤ length k → length (zip_with f l k) = length l. - Proof. rewrite zip_with_length; lia. Qed. - Lemma zip_with_length_l_eq l k : - length l = length k → length (zip_with f l k) = length l. - Proof. rewrite zip_with_length; lia. Qed. - Lemma zip_with_length_r l k : - length k ≤ length l → length (zip_with f l k) = length k. - Proof. rewrite zip_with_length; lia. Qed. - Lemma zip_with_length_r_eq l k : - length k = length l → length (zip_with f l k) = length k. - Proof. rewrite zip_with_length; lia. Qed. - Lemma zip_with_length_same_l P l k : - Forall2 P l k → length (zip_with f l k) = length l. - Proof. induction 1; simpl; auto. Qed. - Lemma zip_with_length_same_r P l k : - Forall2 P l k → length (zip_with f l k) = length k. - Proof. induction 1; simpl; auto. Qed. - Lemma lookup_zip_with l k i : - zip_with f l k !! i = x ↠l !! i; y ↠k !! i; Some (f x y). - Proof. - revert k i. induction l; intros [|??] [|?]; f_equal/=; auto. - by destruct (_ !! _). - Qed. - Lemma insert_zip_with l k i x y : - <[i:=f x y]>(zip_with f l k) = zip_with f (<[i:=x]>l) (<[i:=y]>k). - Proof. revert i k. induction l; intros [|?] [|??]; f_equal/=; auto. Qed. - Lemma fmap_zip_with_l (g : C → A) l k : - (∀ x y, g (f x y) = x) → length l ≤ length k → g <$> zip_with f l k = l. - Proof. revert k. induction l; intros [|??] ??; f_equal/=; auto with lia. Qed. - Lemma fmap_zip_with_r (g : C → B) l k : - (∀ x y, g (f x y) = y) → length k ≤ length l → g <$> zip_with f l k = k. - Proof. revert l. induction k; intros [|??] ??; f_equal/=; auto with lia. Qed. - Lemma zip_with_zip l k : zip_with f l k = curry f <$> zip l k. - Proof. revert k. by induction l; intros [|??]; f_equal/=. Qed. - Lemma zip_with_fst_snd lk : zip_with f (lk.*1) (lk.*2) = curry f <$> lk. - Proof. by induction lk as [|[]]; f_equal/=. Qed. - Lemma zip_with_replicate n x y : - zip_with f (replicate n x) (replicate n y) = replicate n (f x y). - Proof. by induction n; f_equal/=. Qed. - Lemma zip_with_replicate_l n x k : - length k ≤ n → zip_with f (replicate n x) k = f x <$> k. - Proof. revert n. induction k; intros [|?] ?; f_equal/=; auto with lia. Qed. - Lemma zip_with_replicate_r n y l : - length l ≤ n → zip_with f l (replicate n y) = flip f y <$> l. - Proof. revert n. induction l; intros [|?] ?; f_equal/=; auto with lia. Qed. - Lemma zip_with_replicate_r_eq n y l : - length l = n → zip_with f l (replicate n y) = flip f y <$> l. - Proof. intros; apply zip_with_replicate_r; lia. Qed. - Lemma zip_with_take n l k : - take n (zip_with f l k) = zip_with f (take n l) (take n k). - Proof. revert n k. by induction l; intros [|?] [|??]; f_equal/=. Qed. - Lemma zip_with_drop n l k : - drop n (zip_with f l k) = zip_with f (drop n l) (drop n k). - Proof. - revert n k. induction l; intros [] []; f_equal/=; auto using zip_with_nil_r. - Qed. - Lemma zip_with_take_l n l k : - length k ≤ n → zip_with f (take n l) k = zip_with f l k. - Proof. revert n k. induction l; intros [] [] ?; f_equal/=; auto with lia. Qed. - Lemma zip_with_take_r n l k : - length l ≤ n → zip_with f l (take n k) = zip_with f l k. - Proof. revert n k. induction l; intros [] [] ?; f_equal/=; auto with lia. Qed. - Lemma Forall_zip_with_fst (P : A → Prop) (Q : C → Prop) l k : - Forall P l → Forall (λ y, ∀ x, P x → Q (f x y)) k → - Forall Q (zip_with f l k). - Proof. intros Hl. revert k. induction Hl; destruct 1; simpl in *; auto. Qed. - Lemma Forall_zip_with_snd (P : B → Prop) (Q : C → Prop) l k : - Forall (λ x, ∀ y, P y → Q (f x y)) l → Forall P k → - Forall Q (zip_with f l k). - Proof. intros Hl. revert k. induction Hl; destruct 1; simpl in *; auto. Qed. -End zip_with. - -Lemma zip_with_sublist_alter {A B} (f : A → B → A) g l k i n l' k' : - length l = length k → - sublist_lookup i n l = Some l' → sublist_lookup i n k = Some k' → - length (g l') = length k' → zip_with f (g l') k' = g (zip_with f l' k') → - zip_with f (sublist_alter g i n l) k = sublist_alter g i n (zip_with f l k). -Proof. - unfold sublist_lookup, sublist_alter. intros Hlen; rewrite Hlen. - intros ?? Hl' Hk'. simplify_option_eq. - by rewrite !zip_with_app_l, !zip_with_drop, Hl', drop_drop, !zip_with_take, - !take_length_le, Hk' by (rewrite ?drop_length; auto with lia). -Qed. - -Section zip. - Context {A B : Type}. - Implicit Types l : list A. - Implicit Types k : list B. - Lemma fst_zip l k : length l ≤ length k → (zip l k).*1 = l. - Proof. by apply fmap_zip_with_l. Qed. - Lemma snd_zip l k : length k ≤ length l → (zip l k).*2 = k. - Proof. by apply fmap_zip_with_r. Qed. - Lemma zip_fst_snd (lk : list (A * B)) : zip (lk.*1) (lk.*2) = lk. - Proof. by induction lk as [|[]]; f_equal/=. Qed. - Lemma Forall2_fst P l1 l2 k1 k2 : - length l2 = length k2 → Forall2 P l1 k1 → - Forall2 (λ x y, P (x.1) (y.1)) (zip l1 l2) (zip k1 k2). - Proof. - rewrite <-Forall2_same_length. intros Hlk2 Hlk1. revert l2 k2 Hlk2. - induction Hlk1; intros ?? [|??????]; simpl; auto. - Qed. - Lemma Forall2_snd P l1 l2 k1 k2 : - length l1 = length k1 → Forall2 P l2 k2 → - Forall2 (λ x y, P (x.2) (y.2)) (zip l1 l2) (zip k1 k2). - Proof. - rewrite <-Forall2_same_length. intros Hlk1 Hlk2. revert l1 k1 Hlk1. - induction Hlk2; intros ?? [|??????]; simpl; auto. - Qed. -End zip. - -Lemma elem_of_zipped_map {A B} (f : list A → list A → A → B) l k x : - x ∈ zipped_map f l k ↔ - ∃ k' k'' y, k = k' ++ [y] ++ k'' ∧ x = f (reverse k' ++ l) k'' y. -Proof. - split. - - revert l. induction k as [|z k IH]; simpl; intros l; inversion_clear 1. - { by eexists [], k, z. } - destruct (IH (z :: l)) as (k'&k''&y&->&->); [done |]. - eexists (z :: k'), k'', y. by rewrite reverse_cons, <-(assoc_L (++)). - - intros (k'&k''&y&->&->). revert l. induction k' as [|z k' IH]; [by left|]. - intros l; right. by rewrite reverse_cons, <-!(assoc_L (++)). -Qed. -Section zipped_list_ind. - Context {A} (P : list A → list A → Prop). - Context (Pnil : ∀ l, P l []) (Pcons : ∀ l k x, P (x :: l) k → P l (x :: k)). - Fixpoint zipped_list_ind l k : P l k := - match k with - | [] => Pnil _ | x :: k => Pcons _ _ _ (zipped_list_ind (x :: l) k) - end. -End zipped_list_ind. -Lemma zipped_Forall_app {A} (P : list A → list A → A → Prop) l k k' : - zipped_Forall P l (k ++ k') → zipped_Forall P (reverse k ++ l) k'. -Proof. - revert l. induction k as [|x k IH]; simpl; [done |]. - inversion_clear 1. rewrite reverse_cons, <-(assoc_L (++)). by apply IH. -Qed. - -(** * Relection over lists *) -(** We define a simple data structure [rlist] to capture a syntactic -representation of lists consisting of constants, applications and the nil list. -Note that we represent [(x ::)] as [rapp (rnode [x])]. For now, we abstract -over the type of constants, but later we use [nat]s and a list representing -a corresponding environment. *) -Inductive rlist (A : Type) := - rnil : rlist A | rnode : A → rlist A | rapp : rlist A → rlist A → rlist A. -Arguments rnil {_}. -Arguments rnode {_} _. -Arguments rapp {_} _ _. - -Module rlist. -Fixpoint to_list {A} (t : rlist A) : list A := - match t with - | rnil => [] | rnode l => [l] | rapp t1 t2 => to_list t1 ++ to_list t2 - end. -Notation env A := (list (list A)) (only parsing). -Definition eval {A} (E : env A) : rlist nat → list A := - fix go t := - match t with - | rnil => [] - | rnode i => from_option id [] (E !! i) - | rapp t1 t2 => go t1 ++ go t2 - end. - -(** A simple quoting mechanism using type classes. [QuoteLookup E1 E2 x i] -means: starting in environment [E1], look up the index [i] corresponding to the -constant [x]. In case [x] has a corresponding index [i] in [E1], the original -environment is given back as [E2]. Otherwise, the environment [E2] is extended -with a binding [i] for [x]. *) -Section quote_lookup. - Context {A : Type}. - Class QuoteLookup (E1 E2 : list A) (x : A) (i : nat) := {}. - Global Instance quote_lookup_here E x : QuoteLookup (x :: E) (x :: E) x 0. - Global Instance quote_lookup_end x : QuoteLookup [] [x] x 0. - Global Instance quote_lookup_further E1 E2 x i y : - QuoteLookup E1 E2 x i → QuoteLookup (y :: E1) (y :: E2) x (S i) | 1000. -End quote_lookup. - -Section quote. - Context {A : Type}. - Class Quote (E1 E2 : env A) (l : list A) (t : rlist nat) := {}. - Global Instance quote_nil: Quote E1 E1 [] rnil. - Global Instance quote_node E1 E2 l i: - QuoteLookup E1 E2 l i → Quote E1 E2 l (rnode i) | 1000. - Global Instance quote_cons E1 E2 E3 x l i t : - QuoteLookup E1 E2 [x] i → - Quote E2 E3 l t → Quote E1 E3 (x :: l) (rapp (rnode i) t). - Global Instance quote_app E1 E2 E3 l1 l2 t1 t2 : - Quote E1 E2 l1 t1 → Quote E2 E3 l2 t2 → Quote E1 E3 (l1 ++ l2) (rapp t1 t2). -End quote. - -Section eval. - Context {A} (E : env A). - - Lemma eval_alt t : eval E t = to_list t ≫= from_option id [] ∘ (E !!). - Proof. - induction t; csimpl. - - done. - - by rewrite (right_id_L [] (++)). - - rewrite bind_app. by f_equal. - Qed. - Lemma eval_eq t1 t2 : to_list t1 = to_list t2 → eval E t1 = eval E t2. - Proof. intros Ht. by rewrite !eval_alt, Ht. Qed. - Lemma eval_Permutation t1 t2 : - to_list t1 ≡ₚ to_list t2 → eval E t1 ≡ₚ eval E t2. - Proof. intros Ht. by rewrite !eval_alt, Ht. Qed. - Lemma eval_submseteq t1 t2 : - to_list t1 ⊆+ to_list t2 → eval E t1 ⊆+ eval E t2. - Proof. intros Ht. by rewrite !eval_alt, Ht. Qed. -End eval. -End rlist. - -(** * Tactics *) -Ltac quote_Permutation := - match goal with - | |- ?l1 ≡ₚ ?l2 => - match type of (_ : rlist.Quote [] _ l1 _) with rlist.Quote _ ?E2 _ ?t1 => - match type of (_ : rlist.Quote E2 _ l2 _) with rlist.Quote _ ?E3 _ ?t2 => - change (rlist.eval E3 t1 ≡ₚ rlist.eval E3 t2) - end end - end. -Ltac solve_Permutation := - quote_Permutation; apply rlist.eval_Permutation; - apply (bool_decide_unpack _); by vm_compute. - -Ltac quote_submseteq := - match goal with - | |- ?l1 ⊆+ ?l2 => - match type of (_ : rlist.Quote [] _ l1 _) with rlist.Quote _ ?E2 _ ?t1 => - match type of (_ : rlist.Quote E2 _ l2 _) with rlist.Quote _ ?E3 _ ?t2 => - change (rlist.eval E3 t1 ⊆+ rlist.eval E3 t2) - end end - end. -Ltac solve_submseteq := - quote_submseteq; apply rlist.eval_submseteq; - apply (bool_decide_unpack _); by vm_compute. - -Ltac decompose_elem_of_list := repeat - match goal with - | H : ?x ∈ [] |- _ => by destruct (not_elem_of_nil x) - | H : _ ∈ _ :: _ |- _ => apply elem_of_cons in H; destruct H - | H : _ ∈ _ ++ _ |- _ => apply elem_of_app in H; destruct H - end. -Ltac solve_length := - simplify_eq/=; - repeat (rewrite fmap_length || rewrite app_length); - repeat match goal with - | H : @eq (list _) _ _ |- _ => apply (f_equal length) in H - | H : Forall2 _ _ _ |- _ => apply Forall2_length in H - | H : context[length (_ <$> _)] |- _ => rewrite fmap_length in H - end; done || congruence. -Ltac simplify_list_eq ::= repeat - match goal with - | _ => progress simplify_eq/= - | H : [?x] !! ?i = Some ?y |- _ => - destruct i; [change (Some x = Some y) in H | discriminate] - | H : _ <$> _ = [] |- _ => apply fmap_nil_inv in H - | H : [] = _ <$> _ |- _ => symmetry in H; apply fmap_nil_inv in H - | H : zip_with _ _ _ = [] |- _ => apply zip_with_nil_inv in H; destruct H - | H : [] = zip_with _ _ _ |- _ => symmetry in H - | |- context [(_ ++ _) ++ _] => rewrite <-(assoc_L (++)) - | H : context [(_ ++ _) ++ _] |- _ => rewrite <-(assoc_L (++)) in H - | H : context [_ <$> (_ ++ _)] |- _ => rewrite fmap_app in H - | |- context [_ <$> (_ ++ _)] => rewrite fmap_app - | |- context [_ ++ []] => rewrite (right_id_L [] (++)) - | H : context [_ ++ []] |- _ => rewrite (right_id_L [] (++)) in H - | |- context [take _ (_ <$> _)] => rewrite <-fmap_take - | H : context [take _ (_ <$> _)] |- _ => rewrite <-fmap_take in H - | |- context [drop _ (_ <$> _)] => rewrite <-fmap_drop - | H : context [drop _ (_ <$> _)] |- _ => rewrite <-fmap_drop in H - | H : _ ++ _ = _ ++ _ |- _ => - repeat (rewrite <-app_comm_cons in H || rewrite <-(assoc_L (++)) in H); - apply app_inj_1 in H; [destruct H|solve_length] - | H : _ ++ _ = _ ++ _ |- _ => - repeat (rewrite app_comm_cons in H || rewrite (assoc_L (++)) in H); - apply app_inj_2 in H; [destruct H|solve_length] - | |- context [zip_with _ (_ ++ _) (_ ++ _)] => - rewrite zip_with_app by solve_length - | |- context [take _ (_ ++ _)] => rewrite take_app_alt by solve_length - | |- context [drop _ (_ ++ _)] => rewrite drop_app_alt by solve_length - | H : context [zip_with _ (_ ++ _) (_ ++ _)] |- _ => - rewrite zip_with_app in H by solve_length - | H : context [take _ (_ ++ _)] |- _ => - rewrite take_app_alt in H by solve_length - | H : context [drop _ (_ ++ _)] |- _ => - rewrite drop_app_alt in H by solve_length - | H : ?l !! ?i = _, H2 : context [(_ <$> ?l) !! ?i] |- _ => - rewrite list_lookup_fmap, H in H2 - end. -Ltac decompose_Forall_hyps := - repeat match goal with - | H : Forall _ [] |- _ => clear H - | H : Forall _ (_ :: _) |- _ => rewrite Forall_cons in H; destruct H - | H : Forall _ (_ ++ _) |- _ => rewrite Forall_app in H; destruct H - | H : Forall2 _ [] [] |- _ => clear H - | H : Forall2 _ (_ :: _) [] |- _ => destruct (Forall2_cons_nil_inv _ _ _ H) - | H : Forall2 _ [] (_ :: _) |- _ => destruct (Forall2_nil_cons_inv _ _ _ H) - | H : Forall2 _ [] ?k |- _ => apply Forall2_nil_inv_l in H - | H : Forall2 _ ?l [] |- _ => apply Forall2_nil_inv_r in H - | H : Forall2 _ (_ :: _) (_ :: _) |- _ => - apply Forall2_cons_inv in H; destruct H - | H : Forall2 _ (_ :: _) ?k |- _ => - let k_hd := fresh k "_hd" in let k_tl := fresh k "_tl" in - apply Forall2_cons_inv_l in H; destruct H as (k_hd&k_tl&?&?&->); - rename k_tl into k - | H : Forall2 _ ?l (_ :: _) |- _ => - let l_hd := fresh l "_hd" in let l_tl := fresh l "_tl" in - apply Forall2_cons_inv_r in H; destruct H as (l_hd&l_tl&?&?&->); - rename l_tl into l - | H : Forall2 _ (_ ++ _) ?k |- _ => - let k1 := fresh k "_1" in let k2 := fresh k "_2" in - apply Forall2_app_inv_l in H; destruct H as (k1&k2&?&?&->) - | H : Forall2 _ ?l (_ ++ _) |- _ => - let l1 := fresh l "_1" in let l2 := fresh l "_2" in - apply Forall2_app_inv_r in H; destruct H as (l1&l2&?&?&->) - | _ => progress simplify_eq/= - | H : Forall3 _ _ (_ :: _) _ |- _ => - apply Forall3_cons_inv_m in H; destruct H as (?&?&?&?&?&?&?&?) - | H : Forall2 _ (_ :: _) ?k |- _ => - apply Forall2_cons_inv_l in H; destruct H as (?&?&?&?&?) - | H : Forall2 _ ?l (_ :: _) |- _ => - apply Forall2_cons_inv_r in H; destruct H as (?&?&?&?&?) - | H : Forall2 _ (_ ++ _) (_ ++ _) |- _ => - apply Forall2_app_inv in H; [destruct H|solve_length] - | H : Forall2 _ ?l (_ ++ _) |- _ => - apply Forall2_app_inv_r in H; destruct H as (?&?&?&?&?) - | H : Forall2 _ (_ ++ _) ?k |- _ => - apply Forall2_app_inv_l in H; destruct H as (?&?&?&?&?) - | H : Forall3 _ _ (_ ++ _) _ |- _ => - apply Forall3_app_inv_m in H; destruct H as (?&?&?&?&?&?&?&?) - | H : Forall ?P ?l, H1 : ?l !! _ = Some ?x |- _ => - (* to avoid some stupid loops, not fool proof *) - unless (P x) by auto using Forall_app_2, Forall_nil_2; - let E := fresh in - assert (P x) as E by (apply (Forall_lookup_1 P _ _ _ H H1)); lazy beta in E - | H : Forall2 ?P ?l ?k |- _ => - match goal with - | H1 : l !! ?i = Some ?x, H2 : k !! ?i = Some ?y |- _ => - unless (P x y) by done; let E := fresh in - assert (P x y) as E by (by apply (Forall2_lookup_lr P l k i x y)); - lazy beta in E - | H1 : l !! ?i = Some ?x |- _ => - try (match goal with _ : k !! i = Some _ |- _ => fail 2 end); - destruct (Forall2_lookup_l P _ _ _ _ H H1) as (?&?&?) - | H2 : k !! ?i = Some ?y |- _ => - try (match goal with _ : l !! i = Some _ |- _ => fail 2 end); - destruct (Forall2_lookup_r P _ _ _ _ H H2) as (?&?&?) - end - | H : Forall3 ?P ?l ?l' ?k |- _ => - lazymatch goal with - | H1:l !! ?i = Some ?x, H2:l' !! ?i = Some ?y, H3:k !! ?i = Some ?z |- _ => - unless (P x y z) by done; let E := fresh in - assert (P x y z) as E by (by apply (Forall3_lookup_lmr P l l' k i x y z)); - lazy beta in E - | H1 : l !! _ = Some ?x |- _ => - destruct (Forall3_lookup_l P _ _ _ _ _ H H1) as (?&?&?&?&?) - | H2 : l' !! _ = Some ?y |- _ => - destruct (Forall3_lookup_m P _ _ _ _ _ H H2) as (?&?&?&?&?) - | H3 : k !! _ = Some ?z |- _ => - destruct (Forall3_lookup_r P _ _ _ _ _ H H3) as (?&?&?&?&?) - end - end. -Ltac list_simplifier := - simplify_eq/=; - repeat match goal with - | _ => progress decompose_Forall_hyps - | _ => progress simplify_list_eq - | H : _ <$> _ = _ :: _ |- _ => - apply fmap_cons_inv in H; destruct H as (?&?&?&?&?) - | H : _ :: _ = _ <$> _ |- _ => symmetry in H - | H : _ <$> _ = _ ++ _ |- _ => - apply fmap_app_inv in H; destruct H as (?&?&?&?&?) - | H : _ ++ _ = _ <$> _ |- _ => symmetry in H - | H : zip_with _ _ _ = _ :: _ |- _ => - apply zip_with_cons_inv in H; destruct H as (?&?&?&?&?&?&?&?) - | H : _ :: _ = zip_with _ _ _ |- _ => symmetry in H - | H : zip_with _ _ _ = _ ++ _ |- _ => - apply zip_with_app_inv in H; destruct H as (?&?&?&?&?&?&?&?&?) - | H : _ ++ _ = zip_with _ _ _ |- _ => symmetry in H - end. -Ltac decompose_Forall := repeat - match goal with - | |- Forall _ _ => by apply Forall_true - | |- Forall _ [] => constructor - | |- Forall _ (_ :: _) => constructor - | |- Forall _ (_ ++ _) => apply Forall_app_2 - | |- Forall _ (_ <$> _) => apply Forall_fmap - | |- Forall _ (_ ≫= _) => apply Forall_bind - | |- Forall2 _ _ _ => apply Forall_Forall2 - | |- Forall2 _ [] [] => constructor - | |- Forall2 _ (_ :: _) (_ :: _) => constructor - | |- Forall2 _ (_ ++ _) (_ ++ _) => first - [ apply Forall2_app; [by decompose_Forall |] - | apply Forall2_app; [| by decompose_Forall]] - | |- Forall2 _ (_ <$> _) _ => apply Forall2_fmap_l - | |- Forall2 _ _ (_ <$> _) => apply Forall2_fmap_r - | _ => progress decompose_Forall_hyps - | H : Forall _ (_ <$> _) |- _ => rewrite Forall_fmap in H - | H : Forall _ (_ ≫= _) |- _ => rewrite Forall_bind in H - | |- Forall _ _ => - apply Forall_lookup_2; intros ???; progress decompose_Forall_hyps - | |- Forall2 _ _ _ => - apply Forall2_same_length_lookup_2; [solve_length|]; - intros ?????; progress decompose_Forall_hyps - end. - -(** The [simplify_suffix] tactic removes [suffix] hypotheses that are -tautologies, and simplifies [suffix] hypotheses involving [(::)] and -[(++)]. *) -Ltac simplify_suffix := repeat - match goal with - | H : suffix (_ :: _) _ |- _ => destruct (suffix_cons_not _ _ H) - | H : suffix (_ :: _) [] |- _ => apply suffix_nil_inv in H - | H : suffix (_ ++ _) (_ ++ _) |- _ => apply suffix_app_inv in H - | H : suffix (_ :: _) (_ :: _) |- _ => - destruct (suffix_cons_inv _ _ _ _ H); clear H - | H : suffix ?x ?x |- _ => clear H - | H : suffix ?x (_ :: ?x) |- _ => clear H - | H : suffix ?x (_ ++ ?x) |- _ => clear H - | _ => progress simplify_eq/= - end. - -(** The [solve_suffix] tactic tries to solve goals involving [suffix]. It -uses [simplify_suffix] to simplify hypotheses and tries to solve [suffix] -conclusions. This tactic either fails or proves the goal. *) -Ltac solve_suffix := by intuition (repeat - match goal with - | _ => done - | _ => progress simplify_suffix - | |- suffix [] _ => apply suffix_nil - | |- suffix _ _ => reflexivity - | |- suffix _ (_ :: _) => apply suffix_cons_r - | |- suffix _ (_ ++ _) => apply suffix_app_r - | H : suffix _ _ → False |- _ => destruct H - end). diff --git a/theories/prelude/listset.v b/theories/prelude/listset.v deleted file mode 100644 index 9e34359e6c07ed92e8d7ff7d7eb9ee9cbfb42952..0000000000000000000000000000000000000000 --- a/theories/prelude/listset.v +++ /dev/null @@ -1,98 +0,0 @@ -(* Copyright (c) 2012-2017, Robbert Krebbers. *) -(* This file is distributed under the terms of the BSD license. *) -(** This file implements finite set as unordered lists without duplicates -removed. This implementation forms a monad. *) -From iris.prelude Require Export collections list. -Set Default Proof Using "Type". - -Record listset A := Listset { listset_car: list A }. -Arguments listset_car {_} _. -Arguments Listset {_} _. - -Section listset. -Context {A : Type}. - -Instance listset_elem_of: ElemOf A (listset A) := λ x l, x ∈ listset_car l. -Instance listset_empty: Empty (listset A) := Listset []. -Instance listset_singleton: Singleton A (listset A) := λ x, Listset [x]. -Instance listset_union: Union (listset A) := λ l k, - let (l') := l in let (k') := k in Listset (l' ++ k'). -Global Opaque listset_singleton listset_empty. - -Global Instance: SimpleCollection A (listset A). -Proof. - split. - - by apply not_elem_of_nil. - - by apply elem_of_list_singleton. - - intros [?] [?]. apply elem_of_app. -Qed. -Lemma listset_empty_alt X : X ≡ ∅ ↔ listset_car X = []. -Proof. - destruct X as [l]; split; [|by intros; simplify_eq/=]. - rewrite elem_of_equiv_empty; intros Hl. - destruct l as [|x l]; [done|]. feed inversion (Hl x). left. -Qed. -Global Instance listset_empty_dec (X : listset A) : Decision (X ≡ ∅). -Proof. - refine (cast_if (decide (listset_car X = []))); - abstract (by rewrite listset_empty_alt). -Defined. - -Context `{!EqDecision A}. - -Instance listset_intersection: Intersection (listset A) := λ l k, - let (l') := l in let (k') := k in Listset (list_intersection l' k'). -Instance listset_difference: Difference (listset A) := λ l k, - let (l') := l in let (k') := k in Listset (list_difference l' k'). - -Instance: Collection A (listset A). -Proof. - split. - - apply _. - - intros [?] [?]. apply elem_of_list_intersection. - - intros [?] [?]. apply elem_of_list_difference. -Qed. -Instance listset_elems: Elements A (listset A) := remove_dups ∘ listset_car. -Global Instance: FinCollection A (listset A). -Proof. - split. - - apply _. - - intros. apply elem_of_remove_dups. - - intros. apply NoDup_remove_dups. -Qed. -End listset. - -(** These instances are declared using [Hint Extern] to avoid too -eager type class search. *) -Hint Extern 1 (ElemOf _ (listset _)) => - eapply @listset_elem_of : typeclass_instances. -Hint Extern 1 (Empty (listset _)) => - eapply @listset_empty : typeclass_instances. -Hint Extern 1 (Singleton _ (listset _)) => - eapply @listset_singleton : typeclass_instances. -Hint Extern 1 (Union (listset _)) => - eapply @listset_union : typeclass_instances. -Hint Extern 1 (Intersection (listset _)) => - eapply @listset_intersection : typeclass_instances. -Hint Extern 1 (Difference (listset _)) => - eapply @listset_difference : typeclass_instances. -Hint Extern 1 (Elements _ (listset _)) => - eapply @listset_elems : typeclass_instances. - -Instance listset_ret: MRet listset := λ A x, {[ x ]}. -Instance listset_fmap: FMap listset := λ A B f l, - let (l') := l in Listset (f <$> l'). -Instance listset_bind: MBind listset := λ A B f l, - let (l') := l in Listset (mbind (listset_car ∘ f) l'). -Instance listset_join: MJoin listset := λ A, mbind id. - -Instance: CollectionMonad listset. -Proof. - split. - - intros. apply _. - - intros ??? [?] ?. apply elem_of_list_bind. - - intros. apply elem_of_list_ret. - - intros ??? [?]. apply elem_of_list_fmap. - - intros ? [?] ?. unfold mjoin, listset_join, elem_of, listset_elem_of. - simpl. by rewrite elem_of_list_bind. -Qed. diff --git a/theories/prelude/listset_nodup.v b/theories/prelude/listset_nodup.v deleted file mode 100644 index 8e90b5c6336f70b82f9bf46260d79e7bbc79f9d6..0000000000000000000000000000000000000000 --- a/theories/prelude/listset_nodup.v +++ /dev/null @@ -1,62 +0,0 @@ -(* Copyright (c) 2012-2017, Robbert Krebbers. *) -(* This file is distributed under the terms of the BSD license. *) -(** This file implements finite as unordered lists without duplicates. -Although this implementation is slow, it is very useful as decidable equality -is the only constraint on the carrier set. *) -From iris.prelude Require Export collections list. -Set Default Proof Using "Type". - -Record listset_nodup A := ListsetNoDup { - listset_nodup_car : list A; listset_nodup_prf : NoDup listset_nodup_car -}. -Arguments ListsetNoDup {_} _ _. -Arguments listset_nodup_car {_} _. -Arguments listset_nodup_prf {_} _. - -Section list_collection. -Context `{EqDecision A}. -Notation C := (listset_nodup A). - -Instance listset_nodup_elem_of: ElemOf A C := λ x l, x ∈ listset_nodup_car l. -Instance listset_nodup_empty: Empty C := ListsetNoDup [] (@NoDup_nil_2 _). -Instance listset_nodup_singleton: Singleton A C := λ x, - ListsetNoDup [x] (NoDup_singleton x). -Instance listset_nodup_union: Union C := λ l k, - let (l',Hl) := l in let (k',Hk) := k - in ListsetNoDup _ (NoDup_list_union _ _ Hl Hk). -Instance listset_nodup_intersection: Intersection C := λ l k, - let (l',Hl) := l in let (k',Hk) := k - in ListsetNoDup _ (NoDup_list_intersection _ k' Hl). -Instance listset_nodup_difference: Difference C := λ l k, - let (l',Hl) := l in let (k',Hk) := k - in ListsetNoDup _ (NoDup_list_difference _ k' Hl). - -Instance: Collection A C. -Proof. - split; [split | | ]. - - by apply not_elem_of_nil. - - by apply elem_of_list_singleton. - - intros [??] [??] ?. apply elem_of_list_union. - - intros [??] [??] ?. apply elem_of_list_intersection. - - intros [??] [??] ?. apply elem_of_list_difference. -Qed. - -Global Instance listset_nodup_elems: Elements A C := listset_nodup_car. -Global Instance: FinCollection A C. -Proof. split. apply _. done. by intros [??]. Qed. -End list_collection. - -Hint Extern 1 (ElemOf _ (listset_nodup _)) => - eapply @listset_nodup_elem_of : typeclass_instances. -Hint Extern 1 (Empty (listset_nodup _)) => - eapply @listset_nodup_empty : typeclass_instances. -Hint Extern 1 (Singleton _ (listset_nodup _)) => - eapply @listset_nodup_singleton : typeclass_instances. -Hint Extern 1 (Union (listset_nodup _)) => - eapply @listset_nodup_union : typeclass_instances. -Hint Extern 1 (Intersection (listset_nodup _)) => - eapply @listset_nodup_intersection : typeclass_instances. -Hint Extern 1 (Difference (listset_nodup _)) => - eapply @listset_nodup_difference : typeclass_instances. -Hint Extern 1 (Elements _ (listset_nodup _)) => - eapply @listset_nodup_elems : typeclass_instances. diff --git a/theories/prelude/mapset.v b/theories/prelude/mapset.v deleted file mode 100644 index b141a10c19cf69f2a7c2af087e91ec56b7087023..0000000000000000000000000000000000000000 --- a/theories/prelude/mapset.v +++ /dev/null @@ -1,146 +0,0 @@ -(* Copyright (c) 2012-2017, Robbert Krebbers. *) -(* This file is distributed under the terms of the BSD license. *) -(** This files gives an implementation of finite sets using finite maps with -elements of the unit type. Since maps enjoy extensional equality, the -constructed finite sets do so as well. *) -From iris.prelude Require Export fin_map_dom. -(* FIXME: This file needs a 'Proof Using' hint. *) - -Record mapset (M : Type → Type) : Type := - Mapset { mapset_car: M (unit : Type) }. -Arguments Mapset {_} _. -Arguments mapset_car {_} _. - -Section mapset. -Context `{FinMap K M}. - -Instance mapset_elem_of: ElemOf K (mapset M) := λ x X, - mapset_car X !! x = Some (). -Instance mapset_empty: Empty (mapset M) := Mapset ∅. -Instance mapset_singleton: Singleton K (mapset M) := λ x, - Mapset {[ x := () ]}. -Instance mapset_union: Union (mapset M) := λ X1 X2, - let (m1) := X1 in let (m2) := X2 in Mapset (m1 ∪ m2). -Instance mapset_intersection: Intersection (mapset M) := λ X1 X2, - let (m1) := X1 in let (m2) := X2 in Mapset (m1 ∩ m2). -Instance mapset_difference: Difference (mapset M) := λ X1 X2, - let (m1) := X1 in let (m2) := X2 in Mapset (m1 ∖ m2). -Instance mapset_elems: Elements K (mapset M) := λ X, - let (m) := X in (map_to_list m).*1. - -Lemma mapset_eq (X1 X2 : mapset M) : X1 = X2 ↔ ∀ x, x ∈ X1 ↔ x ∈ X2. -Proof. - split; [by intros ->|]. - destruct X1 as [m1], X2 as [m2]. simpl. intros E. - f_equal. apply map_eq. intros i. apply option_eq. intros []. by apply E. -Qed. - -Instance: Collection K (mapset M). -Proof. - split; [split | | ]. - - unfold empty, elem_of, mapset_empty, mapset_elem_of. - simpl. intros. by simpl_map. - - unfold singleton, elem_of, mapset_singleton, mapset_elem_of. - simpl. by split; intros; simplify_map_eq. - - unfold union, elem_of, mapset_union, mapset_elem_of. - intros [m1] [m2] ?. simpl. rewrite lookup_union_Some_raw. - destruct (m1 !! x) as [[]|]; tauto. - - unfold intersection, elem_of, mapset_intersection, mapset_elem_of. - intros [m1] [m2] ?. simpl. rewrite lookup_intersection_Some. - assert (is_Some (m2 !! x) ↔ m2 !! x = Some ()). - { split; eauto. by intros [[] ?]. } - naive_solver. - - unfold difference, elem_of, mapset_difference, mapset_elem_of. - intros [m1] [m2] ?. simpl. rewrite lookup_difference_Some. - destruct (m2 !! x) as [[]|]; intuition congruence. -Qed. -Global Instance: LeibnizEquiv (mapset M). -Proof. intros ??. apply mapset_eq. Qed. -Global Instance: FinCollection K (mapset M). -Proof. - split. - - apply _. - - unfold elements, elem_of at 2, mapset_elems, mapset_elem_of. - intros [m] x. simpl. rewrite elem_of_list_fmap. split. - + intros ([y []] &?& Hy). subst. by rewrite <-elem_of_map_to_list. - + intros. exists (x, ()). by rewrite elem_of_map_to_list. - - unfold elements, mapset_elems. intros [m]. simpl. - apply NoDup_fst_map_to_list. -Qed. - -Section deciders. - Context `{EqDecision (M unit)}. - Global Instance mapset_eq_dec : EqDecision (mapset M) | 1. - Proof. - refine (λ X1 X2, - match X1, X2 with Mapset m1, Mapset m2 => cast_if (decide (m1 = m2)) end); - abstract congruence. - Defined. - Global Instance mapset_equiv_dec (X1 X2 : mapset M) : Decision (X1 ≡ X2) | 1. - Proof. refine (cast_if (decide (X1 = X2))); abstract (by fold_leibniz). Defined. - Global Instance mapset_elem_of_dec x (X : mapset M) : Decision (x ∈ X) | 1. - Proof. solve_decision. Defined. - Global Instance mapset_disjoint_dec (X1 X2 : mapset M) : Decision (X1 ⊥ X2). - Proof. - refine (cast_if (decide (X1 ∩ X2 = ∅))); - abstract (by rewrite disjoint_intersection_L). - Defined. - Global Instance mapset_subseteq_dec (X1 X2 : mapset M) : Decision (X1 ⊆ X2). - Proof. - refine (cast_if (decide (X1 ∪ X2 = X2))); - abstract (by rewrite subseteq_union_L). - Defined. -End deciders. - -Definition mapset_map_with {A B} (f : bool → A → option B) - (X : mapset M) : M A → M B := - let (mX) := X in merge (λ x y, - match x, y with - | Some _, Some a => f true a | None, Some a => f false a | _, None => None - end) mX. -Definition mapset_dom_with {A} (f : A → bool) (m : M A) : mapset M := - Mapset $ merge (λ x _, - match x with - | Some a => if f a then Some () else None | None => None - end) m (@empty (M A) _). - -Lemma lookup_mapset_map_with {A B} (f : bool → A → option B) X m i : - mapset_map_with f X m !! i = m !! i ≫= f (bool_decide (i ∈ X)). -Proof. - destruct X as [mX]. unfold mapset_map_with, elem_of, mapset_elem_of. - rewrite lookup_merge by done. simpl. - by case_bool_decide; destruct (mX !! i) as [[]|], (m !! i). -Qed. -Lemma elem_of_mapset_dom_with {A} (f : A → bool) m i : - i ∈ mapset_dom_with f m ↔ ∃ x, m !! i = Some x ∧ f x. -Proof. - unfold mapset_dom_with, elem_of, mapset_elem_of. - simpl. rewrite lookup_merge by done. destruct (m !! i) as [a|]. - - destruct (Is_true_reflect (f a)); naive_solver. - - naive_solver. -Qed. -Instance mapset_dom {A} : Dom (M A) (mapset M) := mapset_dom_with (λ _, true). -Instance mapset_dom_spec: FinMapDom K M (mapset M). -Proof. - split; try apply _. intros. unfold dom, mapset_dom, is_Some. - rewrite elem_of_mapset_dom_with; naive_solver. -Qed. -End mapset. - -(** These instances are declared using [Hint Extern] to avoid too -eager type class search. *) -Hint Extern 1 (ElemOf _ (mapset _)) => - eapply @mapset_elem_of : typeclass_instances. -Hint Extern 1 (Empty (mapset _)) => - eapply @mapset_empty : typeclass_instances. -Hint Extern 1 (Singleton _ (mapset _)) => - eapply @mapset_singleton : typeclass_instances. -Hint Extern 1 (Union (mapset _)) => - eapply @mapset_union : typeclass_instances. -Hint Extern 1 (Intersection (mapset _)) => - eapply @mapset_intersection : typeclass_instances. -Hint Extern 1 (Difference (mapset _)) => - eapply @mapset_difference : typeclass_instances. -Hint Extern 1 (Elements _ (mapset _)) => - eapply @mapset_elems : typeclass_instances. -Arguments mapset_eq_dec _ _ _ _ : simpl never. diff --git a/theories/prelude/natmap.v b/theories/prelude/natmap.v deleted file mode 100644 index eb291315992b27a5705794791ada87b0458bea42..0000000000000000000000000000000000000000 --- a/theories/prelude/natmap.v +++ /dev/null @@ -1,360 +0,0 @@ -(* Copyright (c) 2012-2017, Robbert Krebbers. *) -(* This file is distributed under the terms of the BSD license. *) -(** This files implements a type [natmap A] of finite maps whose keys range -over Coq's data type of unary natural numbers [nat]. The implementation equips -a list with a proof of canonicity. *) -From iris.prelude Require Import fin_maps mapset. -Set Default Proof Using "Type". - -Notation natmap_raw A := (list (option A)). -Definition natmap_wf {A} (l : natmap_raw A) := - match last l with None => True | Some x => is_Some x end. -Instance natmap_wf_pi {A} (l : natmap_raw A) : ProofIrrel (natmap_wf l). -Proof. unfold natmap_wf. case_match; apply _. Qed. - -Lemma natmap_wf_inv {A} (o : option A) (l : natmap_raw A) : - natmap_wf (o :: l) → natmap_wf l. -Proof. by destruct l. Qed. -Lemma natmap_wf_lookup {A} (l : natmap_raw A) : - natmap_wf l → l ≠[] → ∃ i x, mjoin (l !! i) = Some x. -Proof. - intros Hwf Hl. induction l as [|[x|] l IH]; simpl; [done| |]. - { exists 0. simpl. eauto. } - destruct IH as (i&x&?); eauto using natmap_wf_inv; [|by exists (S i), x]. - intros ->. by destruct Hwf. -Qed. - -Record natmap (A : Type) : Type := NatMap { - natmap_car : natmap_raw A; - natmap_prf : natmap_wf natmap_car -}. -Arguments NatMap {_} _ _. -Arguments natmap_car {_} _. -Arguments natmap_prf {_} _. -Lemma natmap_eq {A} (m1 m2 : natmap A) : - m1 = m2 ↔ natmap_car m1 = natmap_car m2. -Proof. - split; [by intros ->|intros]; destruct m1 as [t1 ?], m2 as [t2 ?]. - simplify_eq/=; f_equal; apply proof_irrel. -Qed. -Global Instance natmap_eq_dec `{EqDecision A} : EqDecision (natmap A) := λ m1 m2, - match decide (natmap_car m1 = natmap_car m2) with - | left H => left (proj2 (natmap_eq m1 m2) H) - | right H => right (H ∘ proj1 (natmap_eq m1 m2)) - end. - -Instance natmap_empty {A} : Empty (natmap A) := NatMap [] I. -Instance natmap_lookup {A} : Lookup nat A (natmap A) := λ i m, - let (l,_) := m in mjoin (l !! i). - -Fixpoint natmap_singleton_raw {A} (i : nat) (x : A) : natmap_raw A := - match i with 0 => [Some x]| S i => None :: natmap_singleton_raw i x end. -Lemma natmap_singleton_wf {A} (i : nat) (x : A) : - natmap_wf (natmap_singleton_raw i x). -Proof. unfold natmap_wf. induction i as [|[]]; simplify_eq/=; eauto. Qed. -Lemma natmap_lookup_singleton_raw {A} (i : nat) (x : A) : - mjoin (natmap_singleton_raw i x !! i) = Some x. -Proof. induction i; simpl; auto. Qed. -Lemma natmap_lookup_singleton_raw_ne {A} (i j : nat) (x : A) : - i ≠j → mjoin (natmap_singleton_raw i x !! j) = None. -Proof. revert j; induction i; intros [|?]; simpl; auto with congruence. Qed. -Hint Rewrite @natmap_lookup_singleton_raw : natmap. - -Definition natmap_cons_canon {A} (o : option A) (l : natmap_raw A) := - match o, l with None, [] => [] | _, _ => o :: l end. -Lemma natmap_cons_canon_wf {A} (o : option A) (l : natmap_raw A) : - natmap_wf l → natmap_wf (natmap_cons_canon o l). -Proof. unfold natmap_wf, last. destruct o, l; simpl; eauto. Qed. -Lemma natmap_cons_canon_O {A} (o : option A) (l : natmap_raw A) : - mjoin (natmap_cons_canon o l !! 0) = o. -Proof. by destruct o, l. Qed. -Lemma natmap_cons_canon_S {A} (o : option A) (l : natmap_raw A) i : - natmap_cons_canon o l !! S i = l !! i. -Proof. by destruct o, l. Qed. -Hint Rewrite @natmap_cons_canon_O @natmap_cons_canon_S : natmap. - -Definition natmap_alter_raw {A} (f : option A → option A) : - nat → natmap_raw A → natmap_raw A := - fix go i l {struct l} := - match l with - | [] => - match f None with - | Some x => natmap_singleton_raw i x | None => [] - end - | o :: l => - match i with - | 0 => natmap_cons_canon (f o) l | S i => natmap_cons_canon o (go i l) - end - end. -Lemma natmap_alter_wf {A} (f : option A → option A) i l : - natmap_wf l → natmap_wf (natmap_alter_raw f i l). -Proof. - revert i. induction l; [intro | intros [|?]]; simpl; repeat case_match; - eauto using natmap_singleton_wf, natmap_cons_canon_wf, natmap_wf_inv. -Qed. -Instance natmap_alter {A} : PartialAlter nat A (natmap A) := λ f i m, - let (l,Hl) := m in NatMap _ (natmap_alter_wf f i l Hl). -Lemma natmap_lookup_alter_raw {A} (f : option A → option A) i l : - mjoin (natmap_alter_raw f i l !! i) = f (mjoin (l !! i)). -Proof. - revert i. induction l; intros [|?]; simpl; repeat case_match; simpl; - autorewrite with natmap; auto. -Qed. -Lemma natmap_lookup_alter_raw_ne {A} (f : option A → option A) i j l : - i ≠j → mjoin (natmap_alter_raw f i l !! j) = mjoin (l !! j). -Proof. - revert i j. induction l; intros [|?] [|?] ?; simpl; - repeat case_match; simpl; autorewrite with natmap; auto with congruence. - rewrite natmap_lookup_singleton_raw_ne; congruence. -Qed. - -Definition natmap_omap_raw {A B} (f : A → option B) : - natmap_raw A → natmap_raw B := - fix go l := - match l with [] => [] | o :: l => natmap_cons_canon (o ≫= f) (go l) end. -Lemma natmap_omap_raw_wf {A B} (f : A → option B) l : - natmap_wf l → natmap_wf (natmap_omap_raw f l). -Proof. induction l; simpl; eauto using natmap_cons_canon_wf, natmap_wf_inv. Qed. -Lemma natmap_lookup_omap_raw {A B} (f : A → option B) l i : - mjoin (natmap_omap_raw f l !! i) = mjoin (l !! i) ≫= f. -Proof. - revert i. induction l; intros [|?]; simpl; autorewrite with natmap; auto. -Qed. -Hint Rewrite @natmap_lookup_omap_raw : natmap. -Global Instance natmap_omap: OMap natmap := λ A B f m, - let (l,Hl) := m in NatMap _ (natmap_omap_raw_wf f _ Hl). - -Definition natmap_merge_raw {A B C} (f : option A → option B → option C) : - natmap_raw A → natmap_raw B → natmap_raw C := - fix go l1 l2 := - match l1, l2 with - | [], l2 => natmap_omap_raw (f None ∘ Some) l2 - | l1, [] => natmap_omap_raw (flip f None ∘ Some) l1 - | o1 :: l1, o2 :: l2 => natmap_cons_canon (f o1 o2) (go l1 l2) - end. -Lemma natmap_merge_wf {A B C} (f : option A → option B → option C) l1 l2 : - natmap_wf l1 → natmap_wf l2 → natmap_wf (natmap_merge_raw f l1 l2). -Proof. - revert l2. induction l1; intros [|??]; simpl; - eauto using natmap_omap_raw_wf, natmap_cons_canon_wf, natmap_wf_inv. -Qed. -Lemma natmap_lookup_merge_raw {A B C} (f : option A → option B → option C) - l1 l2 i : f None None = None → - mjoin (natmap_merge_raw f l1 l2 !! i) = f (mjoin (l1 !! i)) (mjoin (l2 !! i)). -Proof. - intros. revert i l2. induction l1; intros [|?] [|??]; simpl; - autorewrite with natmap; auto; - match goal with |- context [?o ≫= _] => by destruct o end. -Qed. -Instance natmap_merge: Merge natmap := λ A B C f m1 m2, - let (l1, Hl1) := m1 in let (l2, Hl2) := m2 in - NatMap (natmap_merge_raw f l1 l2) (natmap_merge_wf _ _ _ Hl1 Hl2). - -Fixpoint natmap_to_list_raw {A} (i : nat) (l : natmap_raw A) : list (nat * A) := - match l with - | [] => [] - | None :: l => natmap_to_list_raw (S i) l - | Some x :: l => (i,x) :: natmap_to_list_raw (S i) l - end. -Lemma natmap_elem_of_to_list_raw_aux {A} j (l : natmap_raw A) i x : - (i,x) ∈ natmap_to_list_raw j l ↔ ∃ i', i = i' + j ∧ mjoin (l !! i') = Some x. -Proof. - split. - - revert j. induction l as [|[y|] l IH]; intros j; simpl. - + by rewrite elem_of_nil. - + rewrite elem_of_cons. intros [?|?]; simplify_eq. - * by exists 0. - * destruct (IH (S j)) as (i'&?&?); auto. - exists (S i'); simpl; auto with lia. - + intros. destruct (IH (S j)) as (i'&?&?); auto. - exists (S i'); simpl; auto with lia. - - intros (i'&?&Hi'). subst. revert i' j Hi'. - induction l as [|[y|] l IH]; intros i j ?; simpl. - + done. - + destruct i as [|i]; simplify_eq/=; [left|]. - right. rewrite <-Nat.add_succ_r. by apply (IH i (S j)). - + destruct i as [|i]; simplify_eq/=. - rewrite <-Nat.add_succ_r. by apply (IH i (S j)). -Qed. -Lemma natmap_elem_of_to_list_raw {A} (l : natmap_raw A) i x : - (i,x) ∈ natmap_to_list_raw 0 l ↔ mjoin (l !! i) = Some x. -Proof. - rewrite natmap_elem_of_to_list_raw_aux. setoid_rewrite Nat.add_0_r. - naive_solver. -Qed. -Lemma natmap_to_list_raw_nodup {A} i (l : natmap_raw A) : - NoDup (natmap_to_list_raw i l). -Proof. - revert i. induction l as [|[?|] ? IH]; simpl; try constructor; auto. - rewrite natmap_elem_of_to_list_raw_aux. intros (?&?&?). lia. -Qed. -Instance natmap_to_list {A} : FinMapToList nat A (natmap A) := λ m, - let (l,_) := m in natmap_to_list_raw 0 l. - -Definition natmap_map_raw {A B} (f : A → B) : natmap_raw A → natmap_raw B := - fmap (fmap f). -Lemma natmap_map_wf {A B} (f : A → B) l : - natmap_wf l → natmap_wf (natmap_map_raw f l). -Proof. - unfold natmap_map_raw, natmap_wf. rewrite fmap_last. - destruct (last l). by apply fmap_is_Some. done. -Qed. -Lemma natmap_lookup_map_raw {A B} (f : A → B) i l : - mjoin (natmap_map_raw f l !! i) = f <$> mjoin (l !! i). -Proof. - unfold natmap_map_raw. rewrite list_lookup_fmap. by destruct (l !! i). -Qed. -Instance natmap_map: FMap natmap := λ A B f m, - let (l,Hl) := m in NatMap (natmap_map_raw f l) (natmap_map_wf _ _ Hl). - -Instance: FinMap nat natmap. -Proof. - split. - - unfold lookup, natmap_lookup. intros A [l1 Hl1] [l2 Hl2] E. - apply natmap_eq. revert l2 Hl1 Hl2 E. simpl. - induction l1 as [|[x|] l1 IH]; intros [|[y|] l2] Hl1 Hl2 E; simpl in *. - + done. - + by specialize (E 0). - + destruct (natmap_wf_lookup (None :: l2)) as (i&?&?); auto with congruence. - + by specialize (E 0). - + f_equal. apply (E 0). apply IH; eauto using natmap_wf_inv. - intros i. apply (E (S i)). - + by specialize (E 0). - + destruct (natmap_wf_lookup (None :: l1)) as (i&?&?); auto with congruence. - + by specialize (E 0). - + f_equal. apply IH; eauto using natmap_wf_inv. intros i. apply (E (S i)). - - done. - - intros ?? [??] ?. apply natmap_lookup_alter_raw. - - intros ?? [??] ??. apply natmap_lookup_alter_raw_ne. - - intros ??? [??] ?. apply natmap_lookup_map_raw. - - intros ? [??]. by apply natmap_to_list_raw_nodup. - - intros ? [??] ??. by apply natmap_elem_of_to_list_raw. - - intros ??? [??] ?. by apply natmap_lookup_omap_raw. - - intros ????? [??] [??] ?. by apply natmap_lookup_merge_raw. -Qed. - -Fixpoint strip_Nones {A} (l : list (option A)) : list (option A) := - match l with None :: l => strip_Nones l | _ => l end. - -Lemma list_to_natmap_wf {A} (l : list (option A)) : - natmap_wf (reverse (strip_Nones (reverse l))). -Proof. - unfold natmap_wf. rewrite last_reverse. - induction (reverse l) as [|[]]; simpl; eauto. -Qed. -Definition list_to_natmap {A} (l : list (option A)) : natmap A := - NatMap (reverse (strip_Nones (reverse l))) (list_to_natmap_wf l). -Lemma list_to_natmap_spec {A} (l : list (option A)) i : - list_to_natmap l !! i = mjoin (l !! i). -Proof. - unfold lookup at 1, natmap_lookup, list_to_natmap; simpl. - rewrite <-(reverse_involutive l) at 2. revert i. - induction (reverse l) as [|[x|] l' IH]; intros i; simpl; auto. - rewrite reverse_cons, IH. clear IH. revert i. - induction (reverse l'); intros [|?]; simpl; auto. -Qed. - -(** Finally, we can construct sets of [nat]s satisfying extensional equality. *) -Notation natset := (mapset natmap). -Instance natmap_dom {A} : Dom (natmap A) natset := mapset_dom. -Instance: FinMapDom nat natmap natset := mapset_dom_spec. - -(* Fixpoint avoids this definition from being unfolded *) -Fixpoint of_bools (βs : list bool) : natset := - let f (β : bool) := if β then Some () else None in - Mapset $ list_to_natmap $ f <$> βs. -Definition to_bools (sz : nat) (X : natset) : list bool := - let f (mu : option ()) := match mu with Some _ => true | None => false end in - resize sz false $ f <$> natmap_car (mapset_car X). - -Lemma of_bools_unfold βs : - let f (β : bool) := if β then Some () else None in - of_bools βs = Mapset $ list_to_natmap $ f <$> βs. -Proof. by destruct βs. Qed. -Lemma elem_of_of_bools βs i : i ∈ of_bools βs ↔ βs !! i = Some true. -Proof. - rewrite of_bools_unfold; unfold elem_of, mapset_elem_of; simpl. - rewrite list_to_natmap_spec, list_lookup_fmap. - destruct (βs !! i) as [[]|]; compute; intuition congruence. -Qed. -Lemma of_bools_union βs1 βs2 : - length βs1 = length βs2 → - of_bools (βs1 ||* βs2) = of_bools βs1 ∪ of_bools βs2. -Proof. - rewrite <-Forall2_same_length; intros Hβs. - apply elem_of_equiv_L. intros i. rewrite elem_of_union, !elem_of_of_bools. - revert i. induction Hβs as [|[] []]; intros [|?]; naive_solver. -Qed. -Lemma to_bools_length (X : natset) sz : length (to_bools sz X) = sz. -Proof. apply resize_length. Qed. -Lemma lookup_to_bools_ge sz X i : sz ≤ i → to_bools sz X !! i = None. -Proof. by apply lookup_resize_old. Qed. -Lemma lookup_to_bools sz X i β : - i < sz → to_bools sz X !! i = Some β ↔ (i ∈ X ↔ β = true). -Proof. - unfold to_bools, elem_of, mapset_elem_of, lookup at 2, natmap_lookup; simpl. - intros. destruct (mapset_car X) as [l ?]; simpl. - destruct (l !! i) as [mu|] eqn:Hmu; simpl. - { rewrite lookup_resize, list_lookup_fmap, Hmu - by (rewrite ?fmap_length; eauto using lookup_lt_Some). - destruct mu as [[]|], β; simpl; intuition congruence. } - rewrite lookup_resize_new by (rewrite ?fmap_length; - eauto using lookup_ge_None_1); destruct β; intuition congruence. -Qed. -Lemma lookup_to_bools_true sz X i : - i < sz → to_bools sz X !! i = Some true ↔ i ∈ X. -Proof. intros. rewrite lookup_to_bools by done. intuition. Qed. -Lemma lookup_to_bools_false sz X i : - i < sz → to_bools sz X !! i = Some false ↔ i ∉ X. -Proof. intros. rewrite lookup_to_bools by done. naive_solver. Qed. -Lemma to_bools_union sz X1 X2 : - to_bools sz (X1 ∪ X2) = to_bools sz X1 ||* to_bools sz X2. -Proof. - apply list_eq; intros i; rewrite lookup_zip_with. - destruct (decide (i < sz)); [|by rewrite !lookup_to_bools_ge by lia]. - apply option_eq; intros β. - rewrite lookup_to_bools, elem_of_union by done; intros. - destruct (decide (i ∈ X1)), (decide (i ∈ X2)); repeat first - [ rewrite (λ X H, proj2 (lookup_to_bools_true sz X i H)) by done - | rewrite (λ X H, proj2 (lookup_to_bools_false sz X i H)) by done]; - destruct β; naive_solver. -Qed. -Lemma to_of_bools βs sz : to_bools sz (of_bools βs) = resize sz false βs. -Proof. - apply list_eq; intros i. destruct (decide (i < sz)); - [|by rewrite lookup_to_bools_ge, lookup_resize_old by lia]. - apply option_eq; intros β. - rewrite lookup_to_bools, elem_of_of_bools by done. - destruct (decide (i < length βs)). - { rewrite lookup_resize by done. - destruct (lookup_lt_is_Some_2 βs i) as [[]]; destruct β; naive_solver. } - rewrite lookup_resize_new, lookup_ge_None_2 by lia. destruct β; naive_solver. -Qed. - -(** A [natmap A] forms a stack with elements of type [A] and possible holes *) -Definition natmap_push {A} (o : option A) (m : natmap A) : natmap A := - let (l,Hl) := m in NatMap _ (natmap_cons_canon_wf o l Hl). - -Definition natmap_pop_raw {A} (l : natmap_raw A) : natmap_raw A := tail l. -Lemma natmap_pop_wf {A} (l : natmap_raw A) : - natmap_wf l → natmap_wf (natmap_pop_raw l). -Proof. destruct l; simpl; eauto using natmap_wf_inv. Qed. -Definition natmap_pop {A} (m : natmap A) : natmap A := - let (l,Hl) := m in NatMap _ (natmap_pop_wf _ Hl). - -Lemma lookup_natmap_push_O {A} o (m : natmap A) : natmap_push o m !! 0 = o. -Proof. by destruct o, m as [[|??]]. Qed. -Lemma lookup_natmap_push_S {A} o (m : natmap A) i : - natmap_push o m !! S i = m !! i. -Proof. by destruct o, m as [[|??]]. Qed. -Lemma lookup_natmap_pop {A} (m : natmap A) i : natmap_pop m !! i = m !! S i. -Proof. by destruct m as [[|??]]. Qed. -Lemma natmap_push_pop {A} (m : natmap A) : - natmap_push (m !! 0) (natmap_pop m) = m. -Proof. - apply map_eq. intros i. destruct i. - - by rewrite lookup_natmap_push_O. - - by rewrite lookup_natmap_push_S, lookup_natmap_pop. -Qed. -Lemma natmap_pop_push {A} o (m : natmap A) : natmap_pop (natmap_push o m) = m. -Proof. apply natmap_eq. by destruct o, m as [[|??]]. Qed. diff --git a/theories/prelude/nmap.v b/theories/prelude/nmap.v deleted file mode 100644 index fb8fe8e380da388af1904b58d0257e591b9c2e04..0000000000000000000000000000000000000000 --- a/theories/prelude/nmap.v +++ /dev/null @@ -1,103 +0,0 @@ -(* Copyright (c) 2012-2017, Robbert Krebbers. *) -(* This file is distributed under the terms of the BSD license. *) -(** This files extends the implementation of finite over [positive] to finite -maps whose keys range over Coq's data type of binary naturals [N]. *) -From iris.prelude Require Import pmap mapset. -From iris.prelude Require Export prelude fin_maps. -Set Default Proof Using "Type". - -Local Open Scope N_scope. - -Record Nmap (A : Type) : Type := NMap { Nmap_0 : option A; Nmap_pos : Pmap A }. -Arguments Nmap_0 {_} _. -Arguments Nmap_pos {_} _. -Arguments NMap {_} _ _. - -Instance Nmap_eq_dec `{EqDecision A} : EqDecision (Nmap A). -Proof. - refine (λ t1 t2, - match t1, t2 with - | NMap x t1, NMap y t2 => cast_if_and (decide (x = y)) (decide (t1 = t2)) - end); abstract congruence. -Defined. -Instance Nempty {A} : Empty (Nmap A) := NMap None ∅. -Global Opaque Nempty. -Instance Nlookup {A} : Lookup N A (Nmap A) := λ i t, - match i with - | N0 => Nmap_0 t - | Npos p => Nmap_pos t !! p - end. -Instance Npartial_alter {A} : PartialAlter N A (Nmap A) := λ f i t, - match i, t with - | N0, NMap o t => NMap (f o) t - | Npos p, NMap o t => NMap o (partial_alter f p t) - end. -Instance Nto_list {A} : FinMapToList N A (Nmap A) := λ t, - match t with - | NMap o t => - default [] o (λ x, [(0,x)]) ++ (prod_map Npos id <$> map_to_list t) - end. -Instance Nomap: OMap Nmap := λ A B f t, - match t with NMap o t => NMap (o ≫= f) (omap f t) end. -Instance Nmerge: Merge Nmap := λ A B C f t1 t2, - match t1, t2 with - | NMap o1 t1, NMap o2 t2 => NMap (f o1 o2) (merge f t1 t2) - end. -Instance Nfmap: FMap Nmap := λ A B f t, - match t with NMap o t => NMap (f <$> o) (f <$> t) end. - -Instance: FinMap N Nmap. -Proof. - split. - - intros ? [??] [??] H. f_equal; [apply (H 0)|]. - apply map_eq. intros i. apply (H (Npos i)). - - by intros ? [|?]. - - intros ? f [? t] [|i]; simpl; [done |]. apply lookup_partial_alter. - - intros ? f [? t] [|i] [|j]; simpl; try intuition congruence. - intros. apply lookup_partial_alter_ne. congruence. - - intros ??? [??] []; simpl. done. apply lookup_fmap. - - intros ? [[x|] t]; unfold map_to_list; simpl. - + constructor. - * rewrite elem_of_list_fmap. by intros [[??] [??]]. - * by apply (NoDup_fmap _), NoDup_map_to_list. - + apply (NoDup_fmap _), NoDup_map_to_list. - - intros ? t i x. unfold map_to_list. split. - + destruct t as [[y|] t]; simpl. - * rewrite elem_of_cons, elem_of_list_fmap. - intros [? | [[??] [??]]]; simplify_eq/=; [done |]. - by apply elem_of_map_to_list. - * rewrite elem_of_list_fmap; intros [[??] [??]]; simplify_eq/=. - by apply elem_of_map_to_list. - + destruct t as [[y|] t]; simpl. - * rewrite elem_of_cons, elem_of_list_fmap. - destruct i as [|i]; simpl; [intuition congruence |]. - intros. right. exists (i, x). by rewrite elem_of_map_to_list. - * rewrite elem_of_list_fmap. - destruct i as [|i]; simpl; [done |]. - intros. exists (i, x). by rewrite elem_of_map_to_list. - - intros ?? f [??] [|?]; simpl; [done|]; apply (lookup_omap f). - - intros ??? f ? [??] [??] [|?]; simpl; [done|]; apply (lookup_merge f). -Qed. - -(** * 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. - -(** * Fresh numbers *) -Definition Nfresh {A} (m : Nmap A) : N := - match m with NMap None _ => 0 | NMap _ m => Npos (Pfresh m) end. -Lemma Nfresh_fresh {A} (m : Nmap A) : m !! Nfresh m = None. -Proof. destruct m as [[]]. apply Pfresh_fresh. done. Qed. - -Instance Nset_fresh : Fresh N Nset := λ X, - let (m) := X in Nfresh m. -Instance Nset_fresh_spec : FreshSpec N Nset. -Proof. - split. - - apply _. - - intros X Y; rewrite <-elem_of_equiv_L. by intros ->. - - unfold elem_of, mapset_elem_of, fresh; intros [m]; simpl. - by rewrite Nfresh_fresh. -Qed. diff --git a/theories/prelude/numbers.v b/theories/prelude/numbers.v deleted file mode 100644 index 7094cd0d1556a121930d44c8444137e7ed450398..0000000000000000000000000000000000000000 --- a/theories/prelude/numbers.v +++ /dev/null @@ -1,600 +0,0 @@ -(* Copyright (c) 2012-2017, Robbert Krebbers. *) -(* This file is distributed under the terms of the BSD license. *) -(** This file collects some trivial facts on the Coq types [nat] and [N] for -natural numbers, and the type [Z] for integers. It also declares some useful -notations. *) -From Coq Require Export EqdepFacts PArith NArith ZArith NPeano. -From Coq Require Import QArith Qcanon. -From iris.prelude Require Export base decidable option. -Set Default Proof Using "Type". -Open Scope nat_scope. - -Coercion Z.of_nat : nat >-> Z. -Instance comparison_eq_dec : EqDecision comparison. -Proof. solve_decision. Defined. - -(** * Notations and properties of [nat] *) -Arguments minus !_ !_ /. -Reserved Notation "x ≤ y ≤ z" (at level 70, y at next level). -Reserved Notation "x ≤ y < z" (at level 70, y at next level). -Reserved Notation "x < y < z" (at level 70, y at next level). -Reserved Notation "x < y ≤ z" (at level 70, y at next level). -Reserved Notation "x ≤ y ≤ z ≤ z'" - (at level 70, y at next level, z at next level). - -Infix "≤" := le : nat_scope. -Notation "x ≤ y ≤ z" := (x ≤ y ∧ y ≤ z)%nat : nat_scope. -Notation "x ≤ y < z" := (x ≤ y ∧ y < z)%nat : nat_scope. -Notation "x < y < z" := (x < y ∧ y < z)%nat : nat_scope. -Notation "x < y ≤ z" := (x < y ∧ y ≤ z)%nat : nat_scope. -Notation "x ≤ y ≤ z ≤ z'" := (x ≤ y ∧ y ≤ z ∧ z ≤ z')%nat : nat_scope. -Notation "(≤)" := le (only parsing) : nat_scope. -Notation "(<)" := lt (only parsing) : nat_scope. - -Infix "`div`" := Nat.div (at level 35) : nat_scope. -Infix "`mod`" := Nat.modulo (at level 35) : nat_scope. -Infix "`max`" := Nat.max (at level 35) : nat_scope. -Infix "`min`" := Nat.min (at level 35) : nat_scope. - -Instance nat_eq_dec: EqDecision nat := eq_nat_dec. -Instance nat_le_dec: ∀ x y : nat, Decision (x ≤ y) := le_dec. -Instance nat_lt_dec: ∀ x y : nat, Decision (x < y) := lt_dec. -Instance nat_inhabited: Inhabited nat := populate 0%nat. -Instance S_inj: Inj (=) (=) S. -Proof. by injection 1. Qed. -Instance nat_le_po: PartialOrder (≤). -Proof. repeat split; repeat intro; auto with lia. Qed. - -Instance nat_le_pi: ∀ x y : nat, ProofIrrel (x ≤ y). -Proof. - assert (∀ x y (p : x ≤ y) y' (q : x ≤ y'), - y = y' → eq_dep nat (le x) y p y' q) as aux. - { fix 3. intros x ? [|y p] ? [|y' q]. - - done. - - clear nat_le_pi. intros; exfalso; auto with lia. - - clear nat_le_pi. intros; exfalso; auto with lia. - - injection 1. intros Hy. by case (nat_le_pi x y p y' q Hy). } - intros x y p q. - by apply (Eqdep_dec.eq_dep_eq_dec (λ x y, decide (x = y))), aux. -Qed. -Instance nat_lt_pi: ∀ x y : nat, ProofIrrel (x < y). -Proof. apply _. Qed. - -Definition sum_list_with {A} (f : A → nat) : list A → nat := - fix go l := - match l with - | [] => 0 - | x :: l => f x + go l - end. -Notation sum_list := (sum_list_with id). - -Lemma Nat_lt_succ_succ n : n < S (S n). -Proof. auto with arith. Qed. -Lemma Nat_mul_split_l n x1 x2 y1 y2 : - x2 < n → y2 < n → x1 * n + x2 = y1 * n + y2 → x1 = y1 ∧ x2 = y2. -Proof. - intros Hx2 Hy2 E. cut (x1 = y1); [intros; subst;lia |]. - revert y1 E. induction x1; simpl; intros [|?]; simpl; auto with lia. -Qed. -Lemma Nat_mul_split_r n x1 x2 y1 y2 : - x1 < n → y1 < n → x1 + x2 * n = y1 + y2 * n → x1 = y1 ∧ x2 = y2. -Proof. intros. destruct (Nat_mul_split_l n x2 x1 y2 y1); auto with lia. Qed. - -Notation lcm := Nat.lcm. -Notation divide := Nat.divide. -Notation "( x | y )" := (divide x y) : nat_scope. -Instance Nat_divide_dec x y : Decision (x | y). -Proof. - refine (cast_if (decide (lcm x y = y))); by rewrite Nat.divide_lcm_iff. -Defined. -Instance: PartialOrder divide. -Proof. - repeat split; try apply _. intros ??. apply Nat.divide_antisym_nonneg; lia. -Qed. -Hint Extern 0 (_ | _) => reflexivity. -Lemma Nat_divide_ne_0 x y : (x | y) → y ≠0 → x ≠0. -Proof. intros Hxy Hy ->. by apply Hy, Nat.divide_0_l. Qed. - -Lemma Nat_iter_S {A} n (f: A → A) x : Nat.iter (S n) f x = f (Nat.iter n f x). -Proof. done. Qed. -Lemma Nat_iter_S_r {A} n (f: A → A) x : Nat.iter (S n) f x = Nat.iter n f (f x). -Proof. induction n; f_equal/=; auto. Qed. - -(** * Notations and properties of [positive] *) -Open Scope positive_scope. - -Infix "≤" := Pos.le : positive_scope. -Notation "x ≤ y ≤ z" := (x ≤ y ∧ y ≤ z) : positive_scope. -Notation "x ≤ y < z" := (x ≤ y ∧ y < z) : positive_scope. -Notation "x < y < z" := (x < y ∧ y < z) : positive_scope. -Notation "x < y ≤ z" := (x < y ∧ y ≤ z) : positive_scope. -Notation "x ≤ y ≤ z ≤ z'" := (x ≤ y ∧ y ≤ z ∧ z ≤ z') : positive_scope. -Notation "(≤)" := Pos.le (only parsing) : positive_scope. -Notation "(<)" := Pos.lt (only parsing) : positive_scope. -Notation "(~0)" := xO (only parsing) : positive_scope. -Notation "(~1)" := xI (only parsing) : positive_scope. - -Arguments Pos.of_nat : simpl never. -Arguments Pmult : simpl never. - -Instance positive_eq_dec: EqDecision positive := Pos.eq_dec. -Instance positive_inhabited: Inhabited positive := populate 1. - -Instance maybe_xO : Maybe xO := λ p, match p with p~0 => Some p | _ => None end. -Instance maybe_x1 : Maybe xI := λ p, match p with p~1 => Some p | _ => None end. -Instance: Inj (=) (=) (~0). -Proof. by injection 1. Qed. -Instance: Inj (=) (=) (~1). -Proof. by injection 1. Qed. - -(** Since [positive] represents lists of bits, we define list operations -on it. These operations are in reverse, as positives are treated as snoc -lists instead of cons lists. *) -Fixpoint Papp (p1 p2 : positive) : positive := - match p2 with - | 1 => p1 - | p2~0 => (Papp p1 p2)~0 - | p2~1 => (Papp p1 p2)~1 - end. -Infix "++" := Papp : positive_scope. -Notation "(++)" := Papp (only parsing) : positive_scope. -Notation "( p ++)" := (Papp p) (only parsing) : positive_scope. -Notation "(++ q )" := (λ p, Papp p q) (only parsing) : positive_scope. - -Fixpoint Preverse_go (p1 p2 : positive) : positive := - match p2 with - | 1 => p1 - | p2~0 => Preverse_go (p1~0) p2 - | p2~1 => Preverse_go (p1~1) p2 - end. -Definition Preverse : positive → positive := Preverse_go 1. - -Global Instance: LeftId (=) 1 (++). -Proof. intros p. by induction p; intros; f_equal/=. Qed. -Global Instance: RightId (=) 1 (++). -Proof. done. Qed. -Global Instance: Assoc (=) (++). -Proof. intros ?? p. by induction p; intros; f_equal/=. Qed. -Global Instance: ∀ p : positive, Inj (=) (=) (++ p). -Proof. intros p ???. induction p; simplify_eq; auto. Qed. - -Lemma Preverse_go_app p1 p2 p3 : - Preverse_go p1 (p2 ++ p3) = Preverse_go p1 p3 ++ Preverse_go 1 p2. -Proof. - revert p3 p1 p2. - cut (∀ p1 p2 p3, Preverse_go (p2 ++ p3) p1 = p2 ++ Preverse_go p3 p1). - { by intros go p3; induction p3; intros p1 p2; simpl; auto; rewrite <-?go. } - intros p1; induction p1 as [p1 IH|p1 IH|]; intros p2 p3; simpl; auto. - - apply (IH _ (_~1)). - - apply (IH _ (_~0)). -Qed. -Lemma Preverse_app p1 p2 : Preverse (p1 ++ p2) = Preverse p2 ++ Preverse p1. -Proof. unfold Preverse. by rewrite Preverse_go_app. Qed. -Lemma Preverse_xO p : Preverse (p~0) = (1~0) ++ Preverse p. -Proof Preverse_app p (1~0). -Lemma Preverse_xI p : Preverse (p~1) = (1~1) ++ Preverse p. -Proof Preverse_app p (1~1). - -Fixpoint Plength (p : positive) : nat := - match p with 1 => 0%nat | p~0 | p~1 => S (Plength p) end. -Lemma Papp_length p1 p2 : Plength (p1 ++ p2) = (Plength p2 + Plength p1)%nat. -Proof. by induction p2; f_equal/=. Qed. - -Close Scope positive_scope. - -(** * Notations and properties of [N] *) -Infix "≤" := N.le : N_scope. -Notation "x ≤ y ≤ z" := (x ≤ y ∧ y ≤ z)%N : N_scope. -Notation "x ≤ y < z" := (x ≤ y ∧ y < z)%N : N_scope. -Notation "x < y < z" := (x < y ∧ y < z)%N : N_scope. -Notation "x < y ≤ z" := (x < y ∧ y ≤ z)%N : N_scope. -Notation "x ≤ y ≤ z ≤ z'" := (x ≤ y ∧ y ≤ z ∧ z ≤ z')%N : N_scope. -Notation "(≤)" := N.le (only parsing) : N_scope. -Notation "(<)" := N.lt (only parsing) : N_scope. -Infix "`div`" := N.div (at level 35) : N_scope. -Infix "`mod`" := N.modulo (at level 35) : N_scope. - -Arguments N.add _ _ : simpl never. - -Instance: Inj (=) (=) Npos. -Proof. by injection 1. Qed. - -Instance N_eq_dec: EqDecision N := N.eq_dec. -Program Instance N_le_dec (x y : N) : Decision (x ≤ y)%N := - match Ncompare x y with Gt => right _ | _ => left _ end. -Solve Obligations with naive_solver. -Program Instance N_lt_dec (x y : N) : Decision (x < y)%N := - match Ncompare x y with Lt => left _ | _ => right _ end. -Solve Obligations with naive_solver. -Instance N_inhabited: Inhabited N := populate 1%N. -Instance N_le_po: 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. - -Infix "≤" := Z.le : Z_scope. -Notation "x ≤ y ≤ z" := (x ≤ y ∧ y ≤ z) : Z_scope. -Notation "x ≤ y < z" := (x ≤ y ∧ y < z) : Z_scope. -Notation "x < y < z" := (x < y ∧ y < z) : Z_scope. -Notation "x < y ≤ z" := (x < y ∧ y ≤ z) : Z_scope. -Notation "x ≤ y ≤ z ≤ z'" := (x ≤ y ∧ y ≤ z ∧ z ≤ z') : Z_scope. -Notation "(≤)" := Z.le (only parsing) : Z_scope. -Notation "(<)" := Z.lt (only parsing) : Z_scope. - -Infix "`div`" := Z.div (at level 35) : Z_scope. -Infix "`mod`" := Z.modulo (at level 35) : Z_scope. -Infix "`quot`" := Z.quot (at level 35) : Z_scope. -Infix "`rem`" := Z.rem (at level 35) : Z_scope. -Infix "≪" := Z.shiftl (at level 35) : Z_scope. -Infix "≫" := Z.shiftr (at level 35) : Z_scope. - -Instance Zpos_inj : Inj (=) (=) Zpos. -Proof. by injection 1. Qed. -Instance Zneg_inj : Inj (=) (=) Zneg. -Proof. by injection 1. Qed. - -Instance Z_of_nat_inj : Inj (=) (=) Z.of_nat. -Proof. intros n1 n2. apply Nat2Z.inj. Qed. - -Instance Z_eq_dec: EqDecision Z := 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 Z_le_po : 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. - intros. rewrite <-Z.pow_succ_r, Z.succ_pred. done. by apply Z.lt_le_pred. -Qed. -Lemma Z_quot_range_nonneg k x y : 0 ≤ x < k → 0 < y → 0 ≤ x `quot` y < k. -Proof. - intros [??] ?. - destruct (decide (y = 1)); subst; [rewrite Z.quot_1_r; auto |]. - destruct (decide (x = 0)); subst; [rewrite Z.quot_0_l; auto with lia |]. - split. apply Z.quot_pos; lia. trans x; auto. apply Z.quot_lt; lia. -Qed. - -(* Note that we cannot disable simpl for [Z.of_nat] as that would break -tactics as [lia]. *) -Arguments Z.to_nat _ : simpl never. -Arguments Z.mul _ _ : simpl never. -Arguments Z.add _ _ : simpl never. -Arguments Z.opp _ : simpl never. -Arguments Z.pow _ _ : simpl never. -Arguments Z.div _ _ : simpl never. -Arguments Z.modulo _ _ : simpl never. -Arguments Z.quot _ _ : simpl never. -Arguments Z.rem _ _ : simpl never. - -Lemma Z_to_nat_neq_0_pos x : Z.to_nat x ≠0%nat → 0 < x. -Proof. by destruct x. Qed. -Lemma Z_to_nat_neq_0_nonneg x : Z.to_nat x ≠0%nat → 0 ≤ x. -Proof. by destruct x. Qed. -Lemma Z_mod_pos x y : 0 < y → 0 ≤ x `mod` y. -Proof. apply Z.mod_pos_bound. Qed. - -Hint Resolve Z.lt_le_incl : zpos. -Hint Resolve Z.add_nonneg_pos Z.add_pos_nonneg Z.add_nonneg_nonneg : zpos. -Hint Resolve Z.mul_nonneg_nonneg Z.mul_pos_pos : zpos. -Hint Resolve Z.pow_pos_nonneg Z.pow_nonneg: zpos. -Hint Resolve Z_mod_pos Z.div_pos : zpos. -Hint Extern 1000 => lia : zpos. - -Lemma Z_to_nat_nonpos x : x ≤ 0 → Z.to_nat x = 0%nat. -Proof. destruct x; simpl; auto using Z2Nat.inj_neg. by intros []. Qed. -Lemma Z2Nat_inj_pow (x y : nat) : Z.of_nat (x ^ y) = x ^ y. -Proof. - induction y as [|y IH]; [by rewrite Z.pow_0_r, Nat.pow_0_r|]. - by rewrite Nat.pow_succ_r, Nat2Z.inj_succ, Z.pow_succ_r, - Nat2Z.inj_mul, IH by auto with zpos. -Qed. -Lemma Nat2Z_divide n m : (Z.of_nat n | Z.of_nat m) ↔ (n | m)%nat. -Proof. - split. - - rewrite <-(Nat2Z.id m) at 2; intros [i ->]; exists (Z.to_nat i). - destruct (decide (0 ≤ i)%Z). - { by rewrite Z2Nat.inj_mul, Nat2Z.id by lia. } - by rewrite !Z_to_nat_nonpos by auto using Z.mul_nonpos_nonneg with lia. - - intros [i ->]. exists (Z.of_nat i). by rewrite Nat2Z.inj_mul. -Qed. -Lemma Z2Nat_divide n m : - 0 ≤ n → 0 ≤ m → (Z.to_nat n | Z.to_nat m)%nat ↔ (n | m). -Proof. intros. by rewrite <-Nat2Z_divide, !Z2Nat.id by done. Qed. -Lemma Z2Nat_inj_div x y : Z.of_nat (x `div` y) = x `div` y. -Proof. - destruct (decide (y = 0%nat)); [by subst; destruct x |]. - apply Z.div_unique with (x `mod` y)%nat. - { left. rewrite <-(Nat2Z.inj_le 0), <-Nat2Z.inj_lt. - apply Nat.mod_bound_pos; lia. } - by rewrite <-Nat2Z.inj_mul, <-Nat2Z.inj_add, <-Nat.div_mod. -Qed. -Lemma Z2Nat_inj_mod x y : Z.of_nat (x `mod` y) = x `mod` y. -Proof. - destruct (decide (y = 0%nat)); [by subst; destruct x |]. - apply Z.mod_unique with (x `div` y)%nat. - { left. rewrite <-(Nat2Z.inj_le 0), <-Nat2Z.inj_lt. - apply Nat.mod_bound_pos; lia. } - by rewrite <-Nat2Z.inj_mul, <-Nat2Z.inj_add, <-Nat.div_mod. -Qed. -Close Scope Z_scope. - -(** * Notations and properties of [Qc] *) -Open Scope Qc_scope. -Delimit Scope Qc_scope with Qc. -Notation "1" := (Q2Qc 1) : Qc_scope. -Notation "2" := (1+1) : Qc_scope. -Notation "- 1" := (Qcopp 1) : Qc_scope. -Notation "- 2" := (Qcopp 2) : Qc_scope. -Notation "x - y" := (x + -y) : Qc_scope. -Notation "x / y" := (x * /y) : Qc_scope. -Infix "≤" := Qcle : Qc_scope. -Notation "x ≤ y ≤ z" := (x ≤ y ∧ y ≤ z) : Qc_scope. -Notation "x ≤ y < z" := (x ≤ y ∧ y < z) : Qc_scope. -Notation "x < y < z" := (x < y ∧ y < z) : Qc_scope. -Notation "x < y ≤ z" := (x < y ∧ y ≤ z) : Qc_scope. -Notation "x ≤ y ≤ z ≤ z'" := (x ≤ y ∧ y ≤ z ∧ z ≤ z') : Qc_scope. -Notation "(≤)" := Qcle (only parsing) : Qc_scope. -Notation "(<)" := Qclt (only parsing) : Qc_scope. - -Hint Extern 1 (_ ≤ _) => reflexivity || discriminate. -Arguments Qred _ : simpl never. - -Instance Qc_eq_dec: EqDecision Qc := Qc_eq_dec. -Program Instance Qc_le_dec (x y : Qc) : Decision (x ≤ y) := - if Qclt_le_dec y x then right _ else left _. -Next Obligation. intros x y; apply Qclt_not_le. Qed. -Next Obligation. done. Qed. -Program Instance Qc_lt_dec (x y : Qc) : Decision (x < y) := - if Qclt_le_dec x y then left _ else right _. -Solve Obligations with done. -Next Obligation. intros x y; apply Qcle_not_lt. Qed. - -Instance: PartialOrder (≤). -Proof. - repeat split; red. apply Qcle_refl. apply Qcle_trans. apply Qcle_antisym. -Qed. -Instance: StrictOrder (<). -Proof. - split; red. intros x Hx. by destruct (Qclt_not_eq x x). apply Qclt_trans. -Qed. -Lemma Qcmult_0_l x : 0 * x = 0. -Proof. ring. Qed. -Lemma Qcmult_0_r x : x * 0 = 0. -Proof. ring. Qed. -Lemma Qcplus_diag x : (x + x)%Qc = (2 * x)%Qc. -Proof. ring. Qed. -Lemma Qcle_ngt (x y : Qc) : x ≤ y ↔ ¬y < x. -Proof. split; auto using Qcle_not_lt, Qcnot_lt_le. Qed. -Lemma Qclt_nge (x y : Qc) : x < y ↔ ¬y ≤ x. -Proof. split; auto using Qclt_not_le, Qcnot_le_lt. Qed. -Lemma Qcplus_le_mono_l (x y z : Qc) : x ≤ y ↔ z + x ≤ z + y. -Proof. - split; intros. - - by apply Qcplus_le_compat. - - replace x with ((0 - z) + (z + x)) by ring. - replace y with ((0 - z) + (z + y)) by ring. - by apply Qcplus_le_compat. -Qed. -Lemma Qcplus_le_mono_r (x y z : Qc) : x ≤ y ↔ x + z ≤ y + z. -Proof. rewrite !(Qcplus_comm _ z). apply Qcplus_le_mono_l. Qed. -Lemma Qcplus_lt_mono_l (x y z : Qc) : x < y ↔ z + x < z + y. -Proof. by rewrite !Qclt_nge, <-Qcplus_le_mono_l. Qed. -Lemma Qcplus_lt_mono_r (x y z : Qc) : x < y ↔ x + z < y + z. -Proof. by rewrite !Qclt_nge, <-Qcplus_le_mono_r. Qed. -Instance: Inj (=) (=) Qcopp. -Proof. - intros x y H. by rewrite <-(Qcopp_involutive x), H, Qcopp_involutive. -Qed. -Instance: ∀ z, Inj (=) (=) (Qcplus z). -Proof. - intros z x y H. by apply (anti_symm (≤)); - rewrite (Qcplus_le_mono_l _ _ z), H. -Qed. -Instance: ∀ z, Inj (=) (=) (λ x, x + z). -Proof. - intros z x y H. by apply (anti_symm (≤)); - rewrite (Qcplus_le_mono_r _ _ z), H. -Qed. -Lemma Qcplus_pos_nonneg (x y : Qc) : 0 < x → 0 ≤ y → 0 < x + y. -Proof. - intros. apply Qclt_le_trans with (x + 0); [by rewrite Qcplus_0_r|]. - by apply Qcplus_le_mono_l. -Qed. -Lemma Qcplus_nonneg_pos (x y : Qc) : 0 ≤ x → 0 < y → 0 < x + y. -Proof. rewrite (Qcplus_comm x). auto using Qcplus_pos_nonneg. Qed. -Lemma Qcplus_pos_pos (x y : Qc) : 0 < x → 0 < y → 0 < x + y. -Proof. auto using Qcplus_pos_nonneg, Qclt_le_weak. Qed. -Lemma Qcplus_nonneg_nonneg (x y : Qc) : 0 ≤ x → 0 ≤ y → 0 ≤ x + y. -Proof. - intros. trans (x + 0); [by rewrite Qcplus_0_r|]. - by apply Qcplus_le_mono_l. -Qed. -Lemma Qcplus_neg_nonpos (x y : Qc) : x < 0 → y ≤ 0 → x + y < 0. -Proof. - intros. apply Qcle_lt_trans with (x + 0); [|by rewrite Qcplus_0_r]. - by apply Qcplus_le_mono_l. -Qed. -Lemma Qcplus_nonpos_neg (x y : Qc) : x ≤ 0 → y < 0 → x + y < 0. -Proof. rewrite (Qcplus_comm x). auto using Qcplus_neg_nonpos. Qed. -Lemma Qcplus_neg_neg (x y : Qc) : x < 0 → y < 0 → x + y < 0. -Proof. auto using Qcplus_nonpos_neg, Qclt_le_weak. Qed. -Lemma Qcplus_nonpos_nonpos (x y : Qc) : x ≤ 0 → y ≤ 0 → x + y ≤ 0. -Proof. - intros. trans (x + 0); [|by rewrite Qcplus_0_r]. - by apply Qcplus_le_mono_l. -Qed. -Lemma Qcmult_le_mono_nonneg_l x y z : 0 ≤ z → x ≤ y → z * x ≤ z * y. -Proof. intros. rewrite !(Qcmult_comm z). by apply Qcmult_le_compat_r. Qed. -Lemma Qcmult_le_mono_nonneg_r x y z : 0 ≤ z → x ≤ y → x * z ≤ y * z. -Proof. intros. by apply Qcmult_le_compat_r. Qed. -Lemma Qcmult_le_mono_pos_l x y z : 0 < z → x ≤ y ↔ z * x ≤ z * y. -Proof. - split; auto using Qcmult_le_mono_nonneg_l, Qclt_le_weak. - rewrite !Qcle_ngt, !(Qcmult_comm z). - intuition auto using Qcmult_lt_compat_r. -Qed. -Lemma Qcmult_le_mono_pos_r x y z : 0 < z → x ≤ y ↔ x * z ≤ y * z. -Proof. rewrite !(Qcmult_comm _ z). by apply Qcmult_le_mono_pos_l. Qed. -Lemma Qcmult_lt_mono_pos_l x y z : 0 < z → x < y ↔ z * x < z * y. -Proof. intros. by rewrite !Qclt_nge, <-Qcmult_le_mono_pos_l. Qed. -Lemma Qcmult_lt_mono_pos_r x y z : 0 < z → x < y ↔ x * z < y * z. -Proof. intros. by rewrite !Qclt_nge, <-Qcmult_le_mono_pos_r. Qed. -Lemma Qcmult_pos_pos x y : 0 < x → 0 < y → 0 < x * y. -Proof. - intros. apply Qcle_lt_trans with (0 * y); [by rewrite Qcmult_0_l|]. - by apply Qcmult_lt_mono_pos_r. -Qed. -Lemma Qcmult_nonneg_nonneg x y : 0 ≤ x → 0 ≤ y → 0 ≤ x * y. -Proof. - intros. trans (0 * y); [by rewrite Qcmult_0_l|]. - by apply Qcmult_le_mono_nonneg_r. -Qed. - -Lemma inject_Z_Qred n : Qred (inject_Z n) = inject_Z n. -Proof. apply Qred_identity; auto using Z.gcd_1_r. Qed. -Coercion Qc_of_Z (n : Z) : Qc := Qcmake _ (inject_Z_Qred n). -Lemma Z2Qc_inj_0 : Qc_of_Z 0 = 0. -Proof. by apply Qc_is_canon. Qed. -Lemma Z2Qc_inj_1 : Qc_of_Z 1 = 1. -Proof. by apply Qc_is_canon. Qed. -Lemma Z2Qc_inj_2 : Qc_of_Z 2 = 2. -Proof. by apply Qc_is_canon. Qed. -Lemma Z2Qc_inj n m : Qc_of_Z n = Qc_of_Z m → n = m. -Proof. by injection 1. Qed. -Lemma Z2Qc_inj_iff n m : Qc_of_Z n = Qc_of_Z m ↔ n = m. -Proof. split. auto using Z2Qc_inj. by intros ->. Qed. -Lemma Z2Qc_inj_le n m : (n ≤ m)%Z ↔ Qc_of_Z n ≤ Qc_of_Z m. -Proof. by rewrite Zle_Qle. Qed. -Lemma Z2Qc_inj_lt n m : (n < m)%Z ↔ Qc_of_Z n < Qc_of_Z m. -Proof. by rewrite Zlt_Qlt. Qed. -Lemma Z2Qc_inj_add n m : Qc_of_Z (n + m) = Qc_of_Z n + Qc_of_Z m. -Proof. apply Qc_is_canon; simpl. by rewrite Qred_correct, inject_Z_plus. Qed. -Lemma Z2Qc_inj_mul n m : Qc_of_Z (n * m) = Qc_of_Z n * Qc_of_Z m. -Proof. apply Qc_is_canon; simpl. by rewrite Qred_correct, inject_Z_mult. Qed. -Lemma Z2Qc_inj_opp n : Qc_of_Z (-n) = -Qc_of_Z n. -Proof. apply Qc_is_canon; simpl. by rewrite Qred_correct, inject_Z_opp. Qed. -Lemma Z2Qc_inj_sub n m : Qc_of_Z (n - m) = Qc_of_Z n - Qc_of_Z m. -Proof. - apply Qc_is_canon; simpl. - by rewrite !Qred_correct, <-inject_Z_opp, <-inject_Z_plus. -Qed. -Close Scope Qc_scope. - -(** * Positive rationals *) -(** The theory of positive rationals is very incomplete. We merely provide -some operations and theorems that are relevant for fractional permissions. *) -Record Qp := mk_Qp { Qp_car :> Qc ; Qp_prf : (0 < Qp_car)%Qc }. -Hint Resolve Qp_prf. -Delimit Scope Qp_scope with Qp. -Bind Scope Qp_scope with Qp. -Arguments Qp_car _%Qp. - -Definition Qp_one : Qp := mk_Qp 1 eq_refl. -Program Definition Qp_plus (x y : Qp) : Qp := mk_Qp (x + y) _. -Next Obligation. by intros x y; apply Qcplus_pos_pos. Qed. -Definition Qp_minus (x y : Qp) : option Qp := - let z := (x - y)%Qc in - match decide (0 < z)%Qc with left Hz => Some (mk_Qp z Hz) | _ => None end. -Program Definition Qp_mult (x y : Qp) : Qp := mk_Qp (x * y) _. -Next Obligation. intros x y. apply Qcmult_pos_pos; apply Qp_prf. Qed. -Program Definition Qp_div (x : Qp) (y : positive) : Qp := mk_Qp (x / ('y)%Z) _. -Next Obligation. - intros x y. assert (0 < ('y)%Z)%Qc. - { apply (Z2Qc_inj_lt 0%Z (' y)), Pos2Z.is_pos. } - by rewrite (Qcmult_lt_mono_pos_r _ _ ('y)%Z), Qcmult_0_l, - <-Qcmult_assoc, Qcmult_inv_l, Qcmult_1_r. -Qed. - -Notation "1" := Qp_one : Qp_scope. -Infix "+" := Qp_plus : Qp_scope. -Infix "-" := Qp_minus : Qp_scope. -Infix "*" := Qp_mult : Qp_scope. -Infix "/" := Qp_div : Qp_scope. - -Lemma Qp_eq x y : x = y ↔ Qp_car x = Qp_car y. -Proof. - split; [by intros ->|]. - destruct x, y; intros; simplify_eq/=; f_equal; apply (proof_irrel _). -Qed. - -Instance Qp_inhabited : Inhabited Qp := populate 1%Qp. -Instance Qp_eq_dec : EqDecision Qp. -Proof. - refine (λ x y, cast_if (decide (Qp_car x = Qp_car y))); by rewrite Qp_eq. -Defined. - -Instance Qp_plus_assoc : Assoc (=) Qp_plus. -Proof. intros x y z; apply Qp_eq, Qcplus_assoc. Qed. -Instance Qp_plus_comm : Comm (=) Qp_plus. -Proof. intros x y; apply Qp_eq, Qcplus_comm. Qed. - -Lemma Qp_minus_diag x : (x - x)%Qp = None. -Proof. unfold Qp_minus. by rewrite Qcplus_opp_r. Qed. -Lemma Qp_op_minus x y : ((x + y) - x)%Qp = Some y. -Proof. - unfold Qp_minus; simpl. - rewrite (Qcplus_comm x), <- Qcplus_assoc, Qcplus_opp_r, Qcplus_0_r. - destruct (decide _) as [|[]]; auto. by f_equal; apply Qp_eq. -Qed. - -Instance Qp_mult_assoc : Assoc (=) Qp_mult. -Proof. intros x y z; apply Qp_eq, Qcmult_assoc. Qed. -Instance Qp_mult_comm : Comm (=) Qp_mult. -Proof. intros x y; apply Qp_eq, Qcmult_comm. Qed. -Lemma Qp_mult_plus_distr_r x y z: (x * (y + z) = x * y + x * z)%Qp. -Proof. apply Qp_eq, Qcmult_plus_distr_r. Qed. -Lemma Qp_mult_plus_distr_l x y z: ((x + y) * z = x * z + y * z)%Qp. -Proof. apply Qp_eq, Qcmult_plus_distr_l. Qed. -Lemma Qp_mult_1_l x: (1 * x)%Qp = x. -Proof. apply Qp_eq, Qcmult_1_l. Qed. -Lemma Qp_mult_1_r x: (x * 1)%Qp = x. -Proof. apply Qp_eq, Qcmult_1_r. Qed. - -Lemma Qp_div_1 x : (x / 1 = x)%Qp. -Proof. - apply Qp_eq; simpl. - rewrite <-(Qcmult_div_r x 1) at 2 by done. by rewrite Qcmult_1_l. -Qed. -Lemma Qp_div_S x y : (x / (2 * y) + x / (2 * y) = x / y)%Qp. -Proof. - apply Qp_eq; simpl. - rewrite <-Qcmult_plus_distr_l, Pos2Z.inj_mul, Z2Qc_inj_mul, Z2Qc_inj_2. - rewrite Qcplus_diag. by field_simplify. -Qed. -Lemma Qp_div_2 x : (x / 2 + x / 2 = x)%Qp. -Proof. - change 2%positive with (2 * 1)%positive. by rewrite Qp_div_S, Qp_div_1. -Qed. - -Lemma Qp_lower_bound q1 q2 : ∃ q q1' q2', (q1 = q + q1' ∧ q2 = q + q2')%Qp. -Proof. - revert q1 q2. cut (∀ q1 q2 : Qp, (q1 ≤ q2)%Qc → - ∃ q q1' q2', (q1 = q + q1' ∧ q2 = q + q2')%Qp). - { intros help q1 q2. - destruct (Qc_le_dec q1 q2) as [LE|LE%Qclt_nge%Qclt_le_weak]; [by eauto|]. - destruct (help q2 q1) as (q&q1'&q2'&?&?); eauto. } - intros q1 q2 Hq. exists (q1 / 2)%Qp, (q1 / 2)%Qp. - assert (0 < q2 - q1 / 2)%Qc as Hq2'. - { eapply Qclt_le_trans; [|by apply Qcplus_le_mono_r, Hq]. - replace (q1 - q1 / 2)%Qc with (q1 * (1 - 1/2))%Qc by ring. - replace 0%Qc with (0 * (1-1/2))%Qc by ring. by apply Qcmult_lt_compat_r. } - exists (mk_Qp (q2 - q1 / 2%Z) Hq2'). split; [by rewrite Qp_div_2|]. - apply Qp_eq; simpl. ring. -Qed. - -Lemma Qp_not_plus_q_ge_1 (q: Qp): ¬ ((1 + q)%Qp ≤ 1%Qp)%Qc. -Proof. - intros Hle. - apply (Qcplus_le_mono_l q 0 1) in Hle. - apply Qcle_ngt in Hle. apply Hle, Qp_prf. -Qed. - -Lemma Qp_ge_0 (q: Qp): (0 ≤ q)%Qc. -Proof. apply Qclt_le_weak, Qp_prf. Qed. diff --git a/theories/prelude/option.v b/theories/prelude/option.v deleted file mode 100644 index ead5bbfee577fb11c418da848a5b13053add2bf5..0000000000000000000000000000000000000000 --- a/theories/prelude/option.v +++ /dev/null @@ -1,416 +0,0 @@ -(* Copyright (c) 2012-2017, Robbert Krebbers. *) -(* This file is distributed under the terms of the BSD license. *) -(** This file collects general purpose definitions and theorems on the option -data type that are not in the Coq standard library. *) -From iris.prelude Require Export tactics. -Set Default Proof Using "Type". - -Inductive option_reflect {A} (P : A → Prop) (Q : Prop) : option A → Type := - | ReflectSome x : P x → option_reflect P Q (Some x) - | ReflectNone : Q → option_reflect P Q None. - -(** * General definitions and theorems *) -(** Basic properties about equality. *) -Lemma None_ne_Some {A} (x : A) : None ≠Some x. -Proof. congruence. Qed. -Lemma Some_ne_None {A} (x : A) : Some x ≠None. -Proof. congruence. Qed. -Lemma eq_None_ne_Some {A} (mx : option A) x : mx = None → mx ≠Some x. -Proof. congruence. Qed. -Instance Some_inj {A} : Inj (=) (=) (@Some A). -Proof. congruence. Qed. - -(** The [from_option] is the eliminator for option. *) -Definition from_option {A B} (f : A → B) (y : B) (mx : option A) : B := - match mx with None => y | Some x => f x end. -Instance: Params (@from_option) 3. -Arguments from_option {_ _} _ _ !_ /. - -(* The eliminator again, but with the arguments in different order, which is -sometimes more convenient. *) -Notation default y mx f := (from_option f y mx) (only parsing). - -(** An alternative, but equivalent, definition of equality on the option -data type. This theorem is useful to prove that two options are the same. *) -Lemma option_eq {A} (mx my: option A): mx = my ↔ ∀ x, mx = Some x ↔ my = Some x. -Proof. split; [by intros; by subst |]. destruct mx, my; naive_solver. Qed. -Lemma option_eq_1 {A} (mx my: option A) x : mx = my → mx = Some x → my = Some x. -Proof. congruence. Qed. -Lemma option_eq_1_alt {A} (mx my : option A) x : - mx = my → my = Some x → mx = Some x. -Proof. congruence. Qed. - -Definition is_Some {A} (mx : option A) := ∃ x, mx = Some x. -Instance: Params (@is_Some) 1. - -Lemma is_Some_alt {A} (mx : option A) : - is_Some mx ↔ match mx with Some _ => True | None => False end. -Proof. unfold is_Some. destruct mx; naive_solver. Qed. - -Lemma mk_is_Some {A} (mx : option A) x : mx = Some x → is_Some mx. -Proof. intros; red; subst; eauto. Qed. -Hint Resolve mk_is_Some. -Lemma is_Some_None {A} : ¬is_Some (@None A). -Proof. by destruct 1. Qed. -Hint Resolve is_Some_None. - -Lemma eq_None_not_Some {A} (mx : option A) : mx = None ↔ ¬is_Some mx. -Proof. rewrite is_Some_alt; destruct mx; naive_solver. Qed. -Lemma not_eq_None_Some {A} (mx : option A) : mx ≠None ↔ is_Some mx. -Proof. rewrite is_Some_alt; destruct mx; naive_solver. Qed. - -Instance is_Some_pi {A} (mx : option A) : ProofIrrel (is_Some mx). -Proof. - set (P (mx : option A) := match mx with Some _ => True | _ => False end). - set (f mx := match mx return P mx → is_Some mx with - Some _ => λ _, ex_intro _ _ eq_refl | None => False_rect _ end). - set (g mx (H : is_Some mx) := - match H return P mx with ex_intro _ p => eq_rect _ _ I _ (eq_sym p) end). - assert (∀ mx H, f mx (g mx H) = H) as f_g by (by intros ? [??]; subst). - intros p1 p2. rewrite <-(f_g _ p1), <-(f_g _ p2). by destruct mx, p1. -Qed. - -Instance is_Some_dec {A} (mx : option A) : Decision (is_Some mx) := - match mx with - | Some x => left (ex_intro _ x eq_refl) - | None => right is_Some_None - end. - -Definition is_Some_proj {A} {mx : option A} : is_Some mx → A := - match mx with Some x => λ _, x | None => False_rect _ ∘ is_Some_None end. - -Definition Some_dec {A} (mx : option A) : { x | mx = Some x } + { mx = None } := - match mx return { x | mx = Some x } + { mx = None } with - | Some x => inleft (x ↾ eq_refl _) - | None => inright eq_refl - end. - -(** Lifting a relation point-wise to option *) -Inductive option_Forall2 {A B} (R: A → B → Prop) : option A → option B → Prop := - | Some_Forall2 x y : R x y → option_Forall2 R (Some x) (Some y) - | None_Forall2 : option_Forall2 R None None. -Definition option_relation {A B} (R: A → B → Prop) (P: A → Prop) (Q: B → Prop) - (mx : option A) (my : option B) : Prop := - match mx, my with - | Some x, Some y => R x y - | Some x, None => P x - | None, Some y => Q y - | None, None => True - end. - -Section Forall2. - Context {A} (R : relation A). - - Global Instance option_Forall2_refl : Reflexive R → Reflexive (option_Forall2 R). - Proof. intros ? [?|]; by constructor. Qed. - Global Instance option_Forall2_sym : Symmetric R → Symmetric (option_Forall2 R). - Proof. destruct 2; by constructor. Qed. - Global Instance option_Forall2_trans : Transitive R → Transitive (option_Forall2 R). - Proof. destruct 2; inversion_clear 1; constructor; etrans; eauto. Qed. - Global Instance option_Forall2_equiv : Equivalence R → Equivalence (option_Forall2 R). - Proof. destruct 1; split; apply _. Qed. -End Forall2. - -(** Setoids *) -Instance option_equiv `{Equiv A} : Equiv (option A) := option_Forall2 (≡). - -Section setoids. - Context `{Equiv A}. - Implicit Types mx my : option A. - - Lemma equiv_option_Forall2 mx my : mx ≡ my ↔ option_Forall2 (≡) mx my. - Proof. done. Qed. - - Global Instance option_equivalence : - Equivalence ((≡) : relation A) → Equivalence ((≡) : relation (option A)). - Proof. apply _. Qed. - Global Instance Some_proper : Proper ((≡) ==> (≡)) (@Some A). - Proof. by constructor. Qed. - Global Instance Some_equiv_inj : Inj (≡) (≡) (@Some A). - Proof. by inversion_clear 1. Qed. - Global Instance option_leibniz `{!LeibnizEquiv A} : LeibnizEquiv (option A). - Proof. intros x y; destruct 1; f_equal; by apply leibniz_equiv. Qed. - - Lemma equiv_None mx : mx ≡ None ↔ mx = None. - Proof. split; [by inversion_clear 1|intros ->; constructor]. Qed. - Lemma equiv_Some_inv_l mx my x : - mx ≡ my → mx = Some x → ∃ y, my = Some y ∧ x ≡ y. - Proof. destruct 1; naive_solver. Qed. - Lemma equiv_Some_inv_r mx my y : - mx ≡ my → my = Some y → ∃ x, mx = Some x ∧ x ≡ y. - Proof. destruct 1; naive_solver. Qed. - Lemma equiv_Some_inv_l' my x : Some x ≡ my → ∃ x', Some x' = my ∧ x ≡ x'. - Proof. intros ?%(equiv_Some_inv_l _ _ x); naive_solver. Qed. - Lemma equiv_Some_inv_r' `{!Equivalence ((≡) : relation A)} mx y : - mx ≡ Some y → ∃ y', mx = Some y' ∧ y ≡ y'. - Proof. intros ?%(equiv_Some_inv_r _ _ y); naive_solver. Qed. - - Global Instance is_Some_proper : Proper ((≡) ==> iff) (@is_Some A). - Proof. inversion_clear 1; split; eauto. Qed. - Global Instance from_option_proper {B} (R : relation B) (f : A → B) : - Proper ((≡) ==> R) f → Proper (R ==> (≡) ==> R) (from_option f). - Proof. destruct 3; simpl; auto. Qed. -End setoids. - -Typeclasses Opaque option_equiv. - -(** Equality on [option] is decidable. *) -Instance option_eq_None_dec {A} (mx : option A) : Decision (mx = None) := - match mx with Some _ => right (Some_ne_None _) | None => left eq_refl end. -Instance option_None_eq_dec {A} (mx : option A) : Decision (None = mx) := - match mx with Some _ => right (None_ne_Some _) | None => left eq_refl end. -Instance option_eq_dec `{dec : EqDecision A} : EqDecision (option A). -Proof. - refine (λ mx my, - match mx, my with - | Some x, Some y => cast_if (decide (x = y)) - | None, None => left _ | _, _ => right _ - end); clear dec; abstract congruence. -Defined. - -(** * Monadic operations *) -Instance option_ret: MRet option := @Some. -Instance option_bind: MBind option := λ A B f mx, - match mx with Some x => f x | None => None end. -Instance option_join: MJoin option := λ A mmx, - match mmx with Some mx => mx | None => None end. -Instance option_fmap: FMap option := @option_map. -Instance option_guard: MGuard option := λ P dec A f, - match dec with left H => f H | _ => None end. - -Lemma fmap_is_Some {A B} (f : A → B) mx : is_Some (f <$> mx) ↔ is_Some mx. -Proof. unfold is_Some; destruct mx; naive_solver. Qed. -Lemma fmap_Some {A B} (f : A → B) mx y : - f <$> mx = Some y ↔ ∃ x, mx = Some x ∧ y = f x. -Proof. destruct mx; naive_solver. Qed. -Lemma fmap_Some_equiv {A B} `{Equiv B} `{!Equivalence ((≡) : relation B)} - (f : A → B) mx y : - f <$> mx ≡ Some y ↔ ∃ x, mx = Some x ∧ y ≡ f x. -Proof. - destruct mx; simpl; split. - - intros ?%Some_equiv_inj. eauto. - - intros (? & ->%Some_inj & ?). constructor. done. - - intros ?%symmetry%equiv_None. done. - - intros (? & ? & ?). done. -Qed. -Lemma fmap_Some_equiv_1 {A B} `{Equiv B} `{!Equivalence ((≡) : relation B)} - (f : A → B) mx y : - f <$> mx ≡ Some y → ∃ x, mx = Some x ∧ y ≡ f x. -Proof. by rewrite fmap_Some_equiv. Qed. -Lemma fmap_None {A B} (f : A → B) mx : f <$> mx = None ↔ mx = None. -Proof. by destruct mx. Qed. -Lemma option_fmap_id {A} (mx : option A) : id <$> mx = mx. -Proof. by destruct mx. Qed. -Lemma option_fmap_compose {A B} (f : A → B) {C} (g : B → C) mx : - g ∘ f <$> mx = g <$> f <$> mx. -Proof. by destruct mx. Qed. -Lemma option_fmap_ext {A B} (f g : A → B) mx : - (∀ x, f x = g x) → f <$> mx = g <$> mx. -Proof. intros; destruct mx; f_equal/=; auto. Qed. -Lemma option_fmap_equiv_ext `{Equiv A, Equiv B} (f g : A → B) mx : - (∀ x, f x ≡ g x) → f <$> mx ≡ g <$> mx. -Proof. destruct mx; constructor; auto. Qed. -Lemma option_fmap_bind {A B C} (f : A → B) (g : B → option C) mx : - (f <$> mx) ≫= g = mx ≫= g ∘ f. -Proof. by destruct mx. Qed. -Lemma option_bind_assoc {A B C} (f : A → option B) - (g : B → option C) (mx : option A) : (mx ≫= f) ≫= g = mx ≫= (mbind g ∘ f). -Proof. by destruct mx; simpl. Qed. -Lemma option_bind_ext {A B} (f g : A → option B) mx my : - (∀ x, f x = g x) → mx = my → mx ≫= f = my ≫= g. -Proof. destruct mx, my; naive_solver. Qed. -Lemma option_bind_ext_fun {A B} (f g : A → option B) mx : - (∀ x, f x = g x) → mx ≫= f = mx ≫= g. -Proof. intros. by apply option_bind_ext. Qed. -Lemma bind_Some {A B} (f : A → option B) (mx : option A) y : - mx ≫= f = Some y ↔ ∃ x, mx = Some x ∧ f x = Some y. -Proof. destruct mx; naive_solver. Qed. -Lemma bind_None {A B} (f : A → option B) (mx : option A) : - mx ≫= f = None ↔ mx = None ∨ ∃ x, mx = Some x ∧ f x = None. -Proof. destruct mx; naive_solver. Qed. -Lemma bind_with_Some {A} (mx : option A) : mx ≫= Some = mx. -Proof. by destruct mx. Qed. - -Instance option_fmap_proper `{Equiv A, Equiv B} (f : A → B) : - Proper ((≡) ==> (≡)) f → Proper ((≡) ==> (≡)) (fmap (M:=option) f). -Proof. destruct 2; constructor; auto. Qed. - -(** ** Inverses of constructors *) -(** We can do this in a fancy way using dependent types, but rewrite does -not particularly like type level reductions. *) -Class Maybe {A B : Type} (c : A → B) := - maybe : B → option A. -Arguments maybe {_ _} _ {_} !_ /. -Class Maybe2 {A1 A2 B : Type} (c : A1 → A2 → B) := - maybe2 : B → option (A1 * A2). -Arguments maybe2 {_ _ _} _ {_} !_ /. -Class Maybe3 {A1 A2 A3 B : Type} (c : A1 → A2 → A3 → B) := - maybe3 : B → option (A1 * A2 * A3). -Arguments maybe3 {_ _ _ _} _ {_} !_ /. -Class Maybe4 {A1 A2 A3 A4 B : Type} (c : A1 → A2 → A3 → A4 → B) := - maybe4 : B → option (A1 * A2 * A3 * A4). -Arguments maybe4 {_ _ _ _ _} _ {_} !_ /. - -Instance maybe_comp `{Maybe B C c1, Maybe A B c2} : Maybe (c1 ∘ c2) := λ x, - maybe c1 x ≫= maybe c2. -Arguments maybe_comp _ _ _ _ _ _ _ !_ /. - -Instance maybe_inl {A B} : Maybe (@inl A B) := λ xy, - match xy with inl x => Some x | _ => None end. -Instance maybe_inr {A B} : Maybe (@inr A B) := λ xy, - match xy with inr y => Some y | _ => None end. -Instance maybe_Some {A} : Maybe (@Some A) := id. -Arguments maybe_Some _ !_ /. - -(** * Union, intersection and difference *) -Instance option_union_with {A} : UnionWith A (option A) := λ f mx my, - match mx, my with - | Some x, Some y => f x y - | Some x, None => Some x - | None, Some y => Some y - | None, None => None - end. -Instance option_intersection_with {A} : IntersectionWith A (option A) := - λ f mx my, match mx, my with Some x, Some y => f x y | _, _ => None end. -Instance option_difference_with {A} : DifferenceWith A (option A) := λ f mx my, - match mx, my with - | Some x, Some y => f x y - | Some x, None => Some x - | None, _ => None - end. -Instance option_union {A} : Union (option A) := union_with (λ x _, Some x). - -Lemma option_union_Some {A} (mx my : option A) z : - mx ∪ my = Some z → mx = Some z ∨ my = Some z. -Proof. destruct mx, my; naive_solver. Qed. - -Class DiagNone {A B C} (f : option A → option B → option C) := - diag_none : f None None = None. - -Section union_intersection_difference. - Context {A} (f : A → A → option A). - - Global Instance union_with_diag_none : DiagNone (union_with f). - Proof. reflexivity. Qed. - Global Instance intersection_with_diag_none : DiagNone (intersection_with f). - Proof. reflexivity. Qed. - Global Instance difference_with_diag_none : DiagNone (difference_with f). - Proof. reflexivity. Qed. - Global Instance union_with_left_id : LeftId (=) None (union_with f). - Proof. by intros [?|]. Qed. - Global Instance union_with_right_id : RightId (=) None (union_with f). - Proof. by intros [?|]. Qed. - Global Instance union_with_comm : Comm (=) f → Comm (=) (union_with f). - Proof. by intros ? [?|] [?|]; compute; rewrite 1?(comm f). Qed. - Global Instance intersection_with_left_ab : LeftAbsorb (=) None (intersection_with f). - Proof. by intros [?|]. Qed. - Global Instance intersection_with_right_ab : RightAbsorb (=) None (intersection_with f). - Proof. by intros [?|]. Qed. - Global Instance difference_with_comm : Comm (=) f → Comm (=) (intersection_with f). - Proof. by intros ? [?|] [?|]; compute; rewrite 1?(comm f). Qed. - Global Instance difference_with_right_id : RightId (=) None (difference_with f). - Proof. by intros [?|]. Qed. -End union_intersection_difference. - -(** * Tactics *) -Tactic Notation "case_option_guard" "as" ident(Hx) := - match goal with - | H : context C [@mguard option _ ?P ?dec] |- _ => - change (@mguard option _ P dec) with (λ A (f : P → option A), - match @decide P dec with left H' => f H' | _ => None end) in *; - destruct_decide (@decide P dec) as Hx - | |- context C [@mguard option _ ?P ?dec] => - change (@mguard option _ P dec) with (λ A (f : P → option A), - match @decide P dec with left H' => f H' | _ => None end) in *; - destruct_decide (@decide P dec) as Hx - end. -Tactic Notation "case_option_guard" := - let H := fresh in case_option_guard as H. - -Lemma option_guard_True {A} P `{Decision P} (mx : option A) : - P → guard P; mx = mx. -Proof. intros. by case_option_guard. Qed. -Lemma option_guard_False {A} P `{Decision P} (mx : option A) : - ¬P → guard P; mx = None. -Proof. intros. by case_option_guard. Qed. -Lemma option_guard_iff {A} P Q `{Decision P, Decision Q} (mx : option A) : - (P ↔ Q) → guard P; mx = guard Q; mx. -Proof. intros [??]. repeat case_option_guard; intuition. Qed. - -Tactic Notation "simpl_option" "by" tactic3(tac) := - let assert_Some_None A mx H := first - [ let x := fresh in evar (x:A); let x' := eval unfold x in x in clear x; - assert (mx = Some x') as H by tac - | assert (mx = None) as H by tac ] - in repeat match goal with - | H : context [@mret _ _ ?A] |- _ => - change (@mret _ _ A) with (@Some A) in H - | |- context [@mret _ _ ?A] => change (@mret _ _ A) with (@Some A) - | H : context [mbind (M:=option) (A:=?A) ?f ?mx] |- _ => - let Hx := fresh in assert_Some_None A mx Hx; rewrite Hx in H; clear Hx - | H : context [fmap (M:=option) (A:=?A) ?f ?mx] |- _ => - let Hx := fresh in assert_Some_None A mx Hx; rewrite Hx in H; clear Hx - | H : context [from_option (A:=?A) _ _ ?mx] |- _ => - let Hx := fresh in assert_Some_None A mx Hx; rewrite Hx in H; clear Hx - | H : context [ match ?mx with _ => _ end ] |- _ => - match type of mx with - | option ?A => - let Hx := fresh in assert_Some_None A mx Hx; rewrite Hx in H; clear Hx - end - | |- context [mbind (M:=option) (A:=?A) ?f ?mx] => - let Hx := fresh in assert_Some_None A mx Hx; rewrite Hx; clear Hx - | |- context [fmap (M:=option) (A:=?A) ?f ?mx] => - let Hx := fresh in assert_Some_None A mx Hx; rewrite Hx; clear Hx - | |- context [from_option (A:=?A) _ _ ?mx] => - let Hx := fresh in assert_Some_None A mx Hx; rewrite Hx; clear Hx - | |- context [ match ?mx with _ => _ end ] => - match type of mx with - | option ?A => - let Hx := fresh in assert_Some_None A mx Hx; rewrite Hx; clear Hx - end - | H : context [decide _] |- _ => rewrite decide_True in H by tac - | H : context [decide _] |- _ => rewrite decide_False in H by tac - | H : context [mguard _ _] |- _ => rewrite option_guard_False in H by tac - | H : context [mguard _ _] |- _ => rewrite option_guard_True in H by tac - | _ => rewrite decide_True by tac - | _ => rewrite decide_False by tac - | _ => rewrite option_guard_True by tac - | _ => rewrite option_guard_False by tac - | H : context [None ∪ _] |- _ => rewrite (left_id_L None (∪)) in H - | H : context [_ ∪ None] |- _ => rewrite (right_id_L None (∪)) in H - | |- context [None ∪ _] => rewrite (left_id_L None (∪)) - | |- context [_ ∪ None] => rewrite (right_id_L None (∪)) - end. -Tactic Notation "simplify_option_eq" "by" tactic3(tac) := - repeat match goal with - | _ => progress simplify_eq/= - | _ => progress simpl_option by tac - | _ : maybe _ ?x = Some _ |- _ => is_var x; destruct x - | _ : maybe2 _ ?x = Some _ |- _ => is_var x; destruct x - | _ : maybe3 _ ?x = Some _ |- _ => is_var x; destruct x - | _ : maybe4 _ ?x = Some _ |- _ => is_var x; destruct x - | H : _ ∪ _ = Some _ |- _ => apply option_union_Some in H; destruct H - | H : mbind (M:=option) ?f ?mx = ?my |- _ => - match mx with Some _ => fail 1 | None => fail 1 | _ => idtac end; - match my with Some _ => idtac | None => idtac | _ => fail 1 end; - let x := fresh in destruct mx as [x|] eqn:?; - [change (f x = my) in H|change (None = my) in H] - | H : ?my = mbind (M:=option) ?f ?mx |- _ => - match mx with Some _ => fail 1 | None => fail 1 | _ => idtac end; - match my with Some _ => idtac | None => idtac | _ => fail 1 end; - let x := fresh in destruct mx as [x|] eqn:?; - [change (my = f x) in H|change (my = None) in H] - | H : fmap (M:=option) ?f ?mx = ?my |- _ => - match mx with Some _ => fail 1 | None => fail 1 | _ => idtac end; - match my with Some _ => idtac | None => idtac | _ => fail 1 end; - let x := fresh in destruct mx as [x|] eqn:?; - [change (Some (f x) = my) in H|change (None = my) in H] - | H : ?my = fmap (M:=option) ?f ?mx |- _ => - match mx with Some _ => fail 1 | None => fail 1 | _ => idtac end; - match my with Some _ => idtac | None => idtac | _ => fail 1 end; - let x := fresh in destruct mx as [x|] eqn:?; - [change (my = Some (f x)) in H|change (my = None) in H] - | _ => progress case_decide - | _ => progress case_option_guard - end. -Tactic Notation "simplify_option_eq" := simplify_option_eq by eauto. diff --git a/theories/prelude/orders.v b/theories/prelude/orders.v deleted file mode 100644 index 5c051ed566ebac32867ea7989205f02bdec47b05..0000000000000000000000000000000000000000 --- a/theories/prelude/orders.v +++ /dev/null @@ -1,102 +0,0 @@ -(* Copyright (c) 2012-2017, Robbert Krebbers. *) -(* This file is distributed under the terms of the BSD license. *) -(** Properties about arbitrary pre-, partial, and total orders. We do not use -the relation [⊆] because we often have multiple orders on the same structure *) -From iris.prelude Require Export tactics. -Set Default Proof Using "Type". - -Section orders. - Context {A} {R : relation A}. - Implicit Types X Y : A. - Infix "⊆" := R. - Notation "X ⊈ Y" := (¬X ⊆ Y). - Infix "⊂" := (strict R). - - Lemma reflexive_eq `{!Reflexive R} X Y : X = Y → X ⊆ Y. - Proof. by intros <-. Qed. - Lemma anti_symm_iff `{!PartialOrder R} X Y : X = Y ↔ R X Y ∧ R Y X. - Proof. split. by intros ->. by intros [??]; apply (anti_symm _). Qed. - Lemma strict_spec X Y : X ⊂ Y ↔ X ⊆ Y ∧ Y ⊈ X. - Proof. done. Qed. - Lemma strict_include X Y : X ⊂ Y → X ⊆ Y. - Proof. by intros [? _]. Qed. - Lemma strict_ne X Y : X ⊂ Y → X ≠Y. - Proof. by intros [??] <-. Qed. - Lemma strict_ne_sym X Y : X ⊂ Y → Y ≠X. - Proof. by intros [??] <-. Qed. - Lemma strict_transitive_l `{!Transitive R} X Y Z : X ⊂ Y → Y ⊆ Z → X ⊂ Z. - Proof. - intros [? HXY] ?. split; [by trans Y|]. - contradict HXY. by trans Z. - Qed. - Lemma strict_transitive_r `{!Transitive R} X Y Z : X ⊆ Y → Y ⊂ Z → X ⊂ Z. - Proof. - intros ? [? HYZ]. split; [by trans Y|]. - contradict HYZ. by trans X. - Qed. - Global Instance: Irreflexive (strict R). - Proof. firstorder. Qed. - Global Instance: Transitive R → StrictOrder (strict R). - Proof. - split; try apply _. - eauto using strict_transitive_r, strict_include. - Qed. - Global Instance preorder_subset_dec_slow `{∀ X Y, Decision (X ⊆ Y)} - (X Y : A) : Decision (X ⊂ Y) | 100 := _. - Lemma strict_spec_alt `{!AntiSymm (=) R} X Y : X ⊂ Y ↔ X ⊆ Y ∧ X ≠Y. - Proof. - split. - - intros [? HYX]. split. done. by intros <-. - - intros [? HXY]. split. done. by contradict HXY; apply (anti_symm R). - Qed. - Lemma po_eq_dec `{!PartialOrder R, ∀ X Y, Decision (X ⊆ Y)} : EqDecision A. - Proof. - refine (λ X Y, cast_if_and (decide (X ⊆ Y)) (decide (Y ⊆ X))); - abstract (rewrite anti_symm_iff; tauto). - Defined. - Lemma total_not `{!Total R} X Y : X ⊈ Y → Y ⊆ X. - Proof. intros. destruct (total R X Y); tauto. Qed. - Lemma total_not_strict `{!Total R} X Y : X ⊈ Y → Y ⊂ X. - Proof. red; auto using total_not. Qed. - Global Instance trichotomy_total - `{!Trichotomy (strict R), !Reflexive R} : Total R. - Proof. - intros X Y. - destruct (trichotomy (strict R) X Y) as [[??]|[<-|[??]]]; intuition. - Qed. -End orders. - -Section strict_orders. - Context {A} {R : relation A}. - Implicit Types X Y : A. - Infix "⊂" := R. - - Lemma irreflexive_eq `{!Irreflexive R} X Y : X = Y → ¬X ⊂ Y. - Proof. intros ->. apply (irreflexivity R). Qed. - Lemma strict_anti_symm `{!StrictOrder R} X Y : - X ⊂ Y → Y ⊂ X → False. - Proof. intros. apply (irreflexivity R X). by trans Y. Qed. - Global Instance trichotomyT_dec `{!TrichotomyT R, !StrictOrder R} X Y : - Decision (X ⊂ Y) := - match trichotomyT R X Y with - | inleft (left H) => left H - | inleft (right H) => right (irreflexive_eq _ _ H) - | inright H => right (strict_anti_symm _ _ H) - end. - Global Instance trichotomyT_trichotomy `{!TrichotomyT R} : Trichotomy R. - Proof. intros X Y. destruct (trichotomyT R X Y) as [[|]|]; tauto. Qed. -End strict_orders. - -Ltac simplify_order := repeat - match goal with - | _ => progress simplify_eq/= - | H : ?R ?x ?x |- _ => by destruct (irreflexivity _ _ H) - | H1 : ?R ?x ?y |- _ => - match goal with - | H2 : R y x |- _ => - assert (x = y) by (by apply (anti_symm R)); clear H1 H2 - | H2 : R y ?z |- _ => - unless (R x z) by done; - assert (R x z) by (by trans y) - end - end. diff --git a/theories/prelude/pmap.v b/theories/prelude/pmap.v deleted file mode 100644 index fc440c838434725f278f63b0a223fae49a6bf6b6..0000000000000000000000000000000000000000 --- a/theories/prelude/pmap.v +++ /dev/null @@ -1,379 +0,0 @@ -(* Copyright (c) 2012-2017, Robbert Krebbers. *) -(* This file is distributed under the terms of the BSD license. *) -(** This files implements an efficient implementation of finite maps whose keys -range over Coq's data type of positive binary naturals [positive]. The -implementation is based on Xavier Leroy's implementation of radix-2 search -trees (uncompressed Patricia trees) and guarantees logarithmic-time operations. -However, we extend Leroy's implementation by packing the trees into a Sigma -type such that canonicity of representation is ensured. This is necesarry for -Leibniz equality to become extensional. *) -From Coq Require Import PArith. -From iris.prelude Require Import mapset countable. -From iris.prelude Require Export fin_maps. -Set Default Proof Using "Type". - -Local Open Scope positive_scope. -Local Hint Extern 0 (@eq positive _ _) => congruence. -Local Hint Extern 0 (¬@eq positive _ _) => congruence. - -(** * The tree data structure *) -(** The data type [Pmap_raw] specifies radix-2 search trees. These trees do -not ensure canonical representations of maps. For example the empty map can -be represented as a binary tree of an arbitrary size that contains [None] at -all nodes. *) -Inductive Pmap_raw (A : Type) : Type := - | PLeaf: Pmap_raw A - | PNode: option A → Pmap_raw A → Pmap_raw A → Pmap_raw A. -Arguments PLeaf {_}. -Arguments PNode {_} _ _ _. - -Instance Pmap_raw_eq_dec `{EqDecision A} : EqDecision (Pmap_raw A). -Proof. solve_decision. Defined. - -Fixpoint Pmap_wf {A} (t : Pmap_raw A) : bool := - match t with - | PLeaf => true - | PNode None PLeaf PLeaf => false - | PNode _ l r => Pmap_wf l && Pmap_wf r - end. -Arguments Pmap_wf _ !_ / : simpl nomatch. -Lemma Pmap_wf_l {A} o (l r : Pmap_raw A) : Pmap_wf (PNode o l r) → Pmap_wf l. -Proof. destruct o, l, r; simpl; rewrite ?andb_True; tauto. Qed. -Lemma Pmap_wf_r {A} o (l r : Pmap_raw A) : Pmap_wf (PNode o l r) → Pmap_wf r. -Proof. destruct o, l, r; simpl; rewrite ?andb_True; tauto. Qed. -Local Hint Immediate Pmap_wf_l Pmap_wf_r. -Definition PNode' {A} (o : option A) (l r : Pmap_raw A) := - match l, o, r with PLeaf, None, PLeaf => PLeaf | _, _, _ => PNode o l r end. -Arguments PNode' _ _ _ _ : simpl never. -Lemma PNode_wf {A} o (l r : Pmap_raw A) : - Pmap_wf l → Pmap_wf r → Pmap_wf (PNode' o l r). -Proof. destruct o, l, r; simpl; auto. Qed. -Local Hint Resolve PNode_wf. - -(** Operations *) -Instance Pempty_raw {A} : Empty (Pmap_raw A) := PLeaf. -Instance Plookup_raw {A} : Lookup positive A (Pmap_raw A) := - fix go (i : positive) (t : Pmap_raw A) {struct t} : option A := - let _ : Lookup _ _ _ := @go in - match t with - | PLeaf => None - | PNode o l r => match i with 1 => o | i~0 => l !! i | i~1 => r !! i end - end. -Local Arguments lookup _ _ _ _ _ !_ / : simpl nomatch. -Fixpoint Psingleton_raw {A} (i : positive) (x : A) : Pmap_raw A := - match i with - | 1 => PNode (Some x) PLeaf PLeaf - | i~0 => PNode None (Psingleton_raw i x) PLeaf - | i~1 => PNode None PLeaf (Psingleton_raw i x) - end. -Fixpoint Ppartial_alter_raw {A} (f : option A → option A) - (i : positive) (t : Pmap_raw A) {struct t} : Pmap_raw A := - match t with - | PLeaf => match f None with None => PLeaf | Some x => Psingleton_raw i x end - | PNode o l r => - match i with - | 1 => PNode' (f o) l r - | i~0 => PNode' o (Ppartial_alter_raw f i l) r - | i~1 => PNode' o l (Ppartial_alter_raw f i r) - end - end. -Fixpoint Pfmap_raw {A B} (f : A → B) (t : Pmap_raw A) : Pmap_raw B := - match t with - | PLeaf => PLeaf - | PNode o l r => PNode (f <$> o) (Pfmap_raw f l) (Pfmap_raw f r) - end. -Fixpoint Pto_list_raw {A} (j : positive) (t : Pmap_raw A) - (acc : list (positive * A)) : list (positive * A) := - match t with - | PLeaf => acc - | PNode o l r => default [] o (λ x, [(Preverse j, x)]) ++ - Pto_list_raw (j~0) l (Pto_list_raw (j~1) r acc) - end%list. -Fixpoint Pomap_raw {A B} (f : A → option B) (t : Pmap_raw A) : Pmap_raw B := - match t with - | PLeaf => PLeaf - | PNode o l r => PNode' (o ≫= f) (Pomap_raw f l) (Pomap_raw f r) - end. -Fixpoint Pmerge_raw {A B C} (f : option A → option B → option C) - (t1 : Pmap_raw A) (t2 : Pmap_raw B) : Pmap_raw C := - match t1, t2 with - | PLeaf, t2 => Pomap_raw (f None ∘ Some) t2 - | t1, PLeaf => Pomap_raw (flip f None ∘ Some) t1 - | PNode o1 l1 r1, PNode o2 l2 r2 => - PNode' (f o1 o2) (Pmerge_raw f l1 l2) (Pmerge_raw f r1 r2) - end. - -(** Proofs *) -Lemma Pmap_wf_canon {A} (t : Pmap_raw A) : - (∀ i, t !! i = None) → Pmap_wf t → t = PLeaf. -Proof. - induction t as [|o l IHl r IHr]; intros Ht ?; auto. - assert (o = None) as -> by (apply (Ht 1)). - assert (l = PLeaf) as -> by (apply IHl; try apply (λ i, Ht (i~0)); eauto). - by assert (r = PLeaf) as -> by (apply IHr; try apply (λ i, Ht (i~1)); eauto). -Qed. -Lemma Pmap_wf_eq {A} (t1 t2 : Pmap_raw A) : - (∀ i, t1 !! i = t2 !! i) → Pmap_wf t1 → Pmap_wf t2 → t1 = t2. -Proof. - revert t2. - induction t1 as [|o1 l1 IHl r1 IHr]; intros [|o2 l2 r2] Ht ??; simpl; auto. - - discriminate (Pmap_wf_canon (PNode o2 l2 r2)); eauto. - - discriminate (Pmap_wf_canon (PNode o1 l1 r1)); eauto. - - f_equal; [apply (Ht 1)| |]. - + apply IHl; try apply (λ x, Ht (x~0)); eauto. - + apply IHr; try apply (λ x, Ht (x~1)); eauto. -Qed. -Lemma PNode_lookup {A} o (l r : Pmap_raw A) i : - PNode' o l r !! i = PNode o l r !! i. -Proof. by destruct i, o, l, r. Qed. - -Lemma Psingleton_wf {A} i (x : A) : Pmap_wf (Psingleton_raw i x). -Proof. induction i as [[]|[]|]; simpl; rewrite ?andb_true_r; auto. Qed. -Lemma Ppartial_alter_wf {A} f i (t : Pmap_raw A) : - Pmap_wf t → Pmap_wf (Ppartial_alter_raw f i t). -Proof. - revert i; induction t as [|o l IHl r IHr]; intros i ?; simpl. - - destruct (f None); auto using Psingleton_wf. - - destruct i; simpl; eauto. -Qed. -Lemma Pfmap_wf {A B} (f : A → B) t : Pmap_wf t → Pmap_wf (Pfmap_raw f t). -Proof. - induction t as [|[x|] [] ? [] ?]; simpl in *; rewrite ?andb_True; intuition. -Qed. -Lemma Pomap_wf {A B} (f : A → option B) t : Pmap_wf t → Pmap_wf (Pomap_raw f t). -Proof. induction t; simpl; eauto. Qed. -Lemma Pmerge_wf {A B C} (f : option A → option B → option C) t1 t2 : - Pmap_wf t1 → Pmap_wf t2 → Pmap_wf (Pmerge_raw f t1 t2). -Proof. revert t2. induction t1; intros []; simpl; eauto using Pomap_wf. Qed. - -Lemma Plookup_empty {A} i : (∅ : Pmap_raw A) !! i = None. -Proof. by destruct i. Qed. -Lemma Plookup_singleton {A} i (x : A) : Psingleton_raw i x !! i = Some x. -Proof. by induction i. Qed. -Lemma Plookup_singleton_ne {A} i j (x : A) : - i ≠j → Psingleton_raw i x !! j = None. -Proof. revert j. induction i; intros [?|?|]; simpl; auto with congruence. Qed. -Lemma Plookup_alter {A} f i (t : Pmap_raw A) : - Ppartial_alter_raw f i t !! i = f (t !! i). -Proof. - revert i; induction t as [|o l IHl r IHr]; intros i; simpl. - - by destruct (f None); rewrite ?Plookup_singleton. - - destruct i; simpl; rewrite PNode_lookup; simpl; auto. -Qed. -Lemma Plookup_alter_ne {A} f i j (t : Pmap_raw A) : - i ≠j → Ppartial_alter_raw f i t !! j = t !! j. -Proof. - revert i j; induction t as [|o l IHl r IHr]; simpl. - - by intros; destruct (f None); rewrite ?Plookup_singleton_ne. - - by intros [?|?|] [?|?|] ?; simpl; rewrite ?PNode_lookup; simpl; auto. -Qed. -Lemma Plookup_fmap {A B} (f : A → B) t i : (Pfmap_raw f t) !! i = f <$> t !! i. -Proof. revert i. by induction t; intros [?|?|]; simpl. Qed. -Lemma Pelem_of_to_list {A} (t : Pmap_raw A) j i acc x : - (i,x) ∈ Pto_list_raw j t acc ↔ - (∃ i', i = i' ++ Preverse j ∧ t !! i' = Some x) ∨ (i,x) ∈ acc. -Proof. - split. - { revert j acc. induction t as [|[y|] l IHl r IHr]; intros j acc; simpl. - - by right. - - rewrite elem_of_cons. intros [?|?]; simplify_eq. - { left; exists 1. by rewrite (left_id_L 1 (++))%positive. } - destruct (IHl (j~0) (Pto_list_raw j~1 r acc)) as [(i'&->&?)|?]; auto. - { left; exists (i' ~ 0). by rewrite Preverse_xO, (assoc_L _). } - destruct (IHr (j~1) acc) as [(i'&->&?)|?]; auto. - left; exists (i' ~ 1). by rewrite Preverse_xI, (assoc_L _). - - intros. - destruct (IHl (j~0) (Pto_list_raw j~1 r acc)) as [(i'&->&?)|?]; auto. - { left; exists (i' ~ 0). by rewrite Preverse_xO, (assoc_L _). } - destruct (IHr (j~1) acc) as [(i'&->&?)|?]; auto. - left; exists (i' ~ 1). by rewrite Preverse_xI, (assoc_L _). } - revert t j i acc. assert (∀ t j i acc, - (i, x) ∈ acc → (i, x) ∈ Pto_list_raw j t acc) as help. - { intros t; induction t as [|[y|] l IHl r IHr]; intros j i acc; - simpl; rewrite ?elem_of_cons; auto. } - intros t j ? acc [(i&->&Hi)|?]; [|by auto]. revert j i acc Hi. - induction t as [|[y|] l IHl r IHr]; intros j i acc ?; simpl. - - done. - - rewrite elem_of_cons. destruct i as [i|i|]; simplify_eq/=. - + right. apply help. specialize (IHr (j~1) i). - rewrite Preverse_xI, (assoc_L _) in IHr. by apply IHr. - + right. specialize (IHl (j~0) i). - rewrite Preverse_xO, (assoc_L _) in IHl. by apply IHl. - + left. by rewrite (left_id_L 1 (++))%positive. - - destruct i as [i|i|]; simplify_eq/=. - + apply help. specialize (IHr (j~1) i). - rewrite Preverse_xI, (assoc_L _) in IHr. by apply IHr. - + specialize (IHl (j~0) i). - rewrite Preverse_xO, (assoc_L _) in IHl. by apply IHl. -Qed. -Lemma Pto_list_nodup {A} j (t : Pmap_raw A) acc : - (∀ i x, (i ++ Preverse j, x) ∈ acc → t !! i = None) → - NoDup acc → NoDup (Pto_list_raw j t acc). -Proof. - revert j acc. induction t as [|[y|] l IHl r IHr]; simpl; intros j acc Hin ?. - - done. - - repeat constructor. - { rewrite Pelem_of_to_list. intros [(i&Hi&?)|Hj]. - { apply (f_equal Plength) in Hi. - rewrite Preverse_xO, !Papp_length in Hi; simpl in *; lia. } - rewrite Pelem_of_to_list in Hj. destruct Hj as [(i&Hi&?)|Hj]. - { apply (f_equal Plength) in Hi. - rewrite Preverse_xI, !Papp_length in Hi; simpl in *; lia. } - specialize (Hin 1 y). rewrite (left_id_L 1 (++))%positive in Hin. - discriminate (Hin Hj). } - apply IHl. - { intros i x. rewrite Pelem_of_to_list. intros [(?&Hi&?)|Hi]. - + rewrite Preverse_xO, Preverse_xI, !(assoc_L _) in Hi. - by apply (inj (++ _)) in Hi. - + apply (Hin (i~0) x). by rewrite Preverse_xO, (assoc_L _) in Hi. } - apply IHr; auto. intros i x Hi. - apply (Hin (i~1) x). by rewrite Preverse_xI, (assoc_L _) in Hi. - - apply IHl. - { intros i x. rewrite Pelem_of_to_list. intros [(?&Hi&?)|Hi]. - + rewrite Preverse_xO, Preverse_xI, !(assoc_L _) in Hi. - by apply (inj (++ _)) in Hi. - + apply (Hin (i~0) x). by rewrite Preverse_xO, (assoc_L _) in Hi. } - apply IHr; auto. intros i x Hi. - apply (Hin (i~1) x). by rewrite Preverse_xI, (assoc_L _) in Hi. -Qed. -Lemma Pomap_lookup {A B} (f : A → option B) t i : - Pomap_raw f t !! i = t !! i ≫= f. -Proof. - revert i. induction t as [|o l IHl r IHr]; intros [i|i|]; simpl; - rewrite ?PNode_lookup; simpl; auto. -Qed. -Lemma Pmerge_lookup {A B C} (f : option A → option B → option C) - (Hf : f None None = None) t1 t2 i : - Pmerge_raw f t1 t2 !! i = f (t1 !! i) (t2 !! i). -Proof. - revert t2 i; induction t1 as [|o1 l1 IHl1 r1 IHr1]; intros t2 i; simpl. - { rewrite Pomap_lookup. by destruct (t2 !! i). } - unfold compose, flip. - destruct t2 as [|l2 o2 r2]; rewrite PNode_lookup. - - by destruct i; rewrite ?Pomap_lookup; simpl; rewrite ?Pomap_lookup; - match goal with |- ?o ≫= _ = _ => destruct o end. - - destruct i; rewrite ?Pomap_lookup; simpl; auto. -Qed. - -(** Packed version and instance of the finite map type class *) -Inductive Pmap (A : Type) : Type := - PMap { pmap_car : Pmap_raw A; pmap_prf : Pmap_wf pmap_car }. -Arguments PMap {_} _ _. -Arguments pmap_car {_} _. -Arguments pmap_prf {_} _. -Lemma Pmap_eq {A} (m1 m2 : Pmap A) : m1 = m2 ↔ pmap_car m1 = pmap_car m2. -Proof. - split; [by intros ->|intros]; destruct m1 as [t1 ?], m2 as [t2 ?]. - simplify_eq/=; f_equal; apply proof_irrel. -Qed. -Instance Pmap_eq_dec `{EqDecision A} : EqDecision (Pmap A) := λ m1 m2, - match Pmap_raw_eq_dec (pmap_car m1) (pmap_car m2) with - | left H => left (proj2 (Pmap_eq m1 m2) H) - | right H => right (H ∘ proj1 (Pmap_eq m1 m2)) - end. -Instance Pempty {A} : Empty (Pmap A) := PMap ∅ I. -Instance Plookup {A} : Lookup positive A (Pmap A) := λ i m, pmap_car m !! i. -Instance Ppartial_alter {A} : PartialAlter positive A (Pmap A) := λ f i m, - let (t,Ht) := m in PMap (partial_alter f i t) (Ppartial_alter_wf f i _ Ht). -Instance Pfmap : FMap Pmap := λ A B f m, - let (t,Ht) := m in PMap (f <$> t) (Pfmap_wf f _ Ht). -Instance Pto_list {A} : FinMapToList positive A (Pmap A) := λ m, - let (t,Ht) := m in Pto_list_raw 1 t []. -Instance Pomap : OMap Pmap := λ A B f m, - let (t,Ht) := m in PMap (omap f t) (Pomap_wf f _ Ht). -Instance Pmerge : Merge Pmap := λ A B C f m1 m2, - let (t1,Ht1) := m1 in let (t2,Ht2) := m2 in PMap _ (Pmerge_wf f _ _ Ht1 Ht2). - -Instance Pmap_finmap : FinMap positive Pmap. -Proof. - split. - - by intros ? [t1 ?] [t2 ?] ?; apply Pmap_eq, Pmap_wf_eq. - - by intros ? []. - - intros ?? [??] ?. by apply Plookup_alter. - - intros ?? [??] ??. by apply Plookup_alter_ne. - - intros ??? [??]. by apply Plookup_fmap. - - intros ? [??]. apply Pto_list_nodup; [|constructor]. - intros ??. by rewrite elem_of_nil. - - intros ? [??] i x; unfold map_to_list, Pto_list. - rewrite Pelem_of_to_list, elem_of_nil. - split. by intros [(?&->&?)|]. by left; exists i. - - intros ?? ? [??] ?. by apply Pomap_lookup. - - intros ??? ?? [??] [??] ?. by apply Pmerge_lookup. -Qed. - -Program Instance Pmap_countable `{Countable A} : Countable (Pmap A) := { - encode m := encode (map_to_list m : list (positive * A)); - decode p := map_of_list <$> decode p -}. -Next Obligation. - intros A ?? m; simpl. rewrite decode_encode; simpl. by rewrite map_of_to_list. -Qed. - -(** * Finite sets *) -(** We construct sets of [positives]s satisfying extensional equality. *) -Notation Pset := (mapset Pmap). -Instance Pmap_dom {A} : Dom (Pmap A) Pset := mapset_dom. -Instance Pmap_dom_spec : FinMapDom positive Pmap Pset := mapset_dom_spec. - -(** * Fresh numbers *) -Fixpoint Pdepth {A} (m : Pmap_raw A) : nat := - match m with - | PLeaf | PNode None _ _ => O | PNode _ l _ => S (Pdepth l) - end. -Fixpoint Pfresh_at_depth {A} (m : Pmap_raw A) (d : nat) : option positive := - match d, m with - | O, (PLeaf | PNode None _ _) => Some 1 - | S d, PNode _ l r => - match Pfresh_at_depth l d with - | Some i => Some (i~0) | None => (~1) <$> Pfresh_at_depth r d - end - | _, _ => None - end. -Fixpoint Pfresh_go {A} (m : Pmap_raw A) (d : nat) : option positive := - match d with - | O => None - | S d => - match Pfresh_go m d with - | Some i => Some i | None => Pfresh_at_depth m d - end - end. -Definition Pfresh {A} (m : Pmap A) : positive := - let d := Pdepth (pmap_car m) in - match Pfresh_go (pmap_car m) d with - | Some i => i | None => Pos.shiftl_nat 1 d - end. - -Lemma Pfresh_at_depth_fresh {A} (m : Pmap_raw A) d i : - Pfresh_at_depth m d = Some i → m !! i = None. -Proof. - revert i m; induction d as [|d IH]. - { intros i [|[] l r] ?; naive_solver. } - intros i [|o l r] ?; simplify_eq/=. - destruct (Pfresh_at_depth l d) as [i'|] eqn:?, - (Pfresh_at_depth r d) as [i''|] eqn:?; simplify_eq/=; auto. -Qed. -Lemma Pfresh_go_fresh {A} (m : Pmap_raw A) d i : - Pfresh_go m d = Some i → m !! i = None. -Proof. - induction d as [|d IH]; intros; simplify_eq/=. - destruct (Pfresh_go m d); eauto using Pfresh_at_depth_fresh. -Qed. -Lemma Pfresh_depth {A} (m : Pmap_raw A) : - m !! Pos.shiftl_nat 1 (Pdepth m) = None. -Proof. induction m as [|[x|] l IHl r IHr]; auto. Qed. -Lemma Pfresh_fresh {A} (m : Pmap A) : m !! Pfresh m = None. -Proof. - destruct m as [m ?]; unfold lookup, Plookup, Pfresh; simpl. - destruct (Pfresh_go m _) eqn:?; eauto using Pfresh_go_fresh, Pfresh_depth. -Qed. - -Instance Pset_fresh : Fresh positive Pset := λ X, - let (m) := X in Pfresh m. -Instance Pset_fresh_spec : FreshSpec positive Pset. -Proof. - split. - - apply _. - - intros X Y; rewrite <-elem_of_equiv_L. by intros ->. - - unfold elem_of, mapset_elem_of, fresh; intros [m]; simpl. - by rewrite Pfresh_fresh. -Qed. diff --git a/theories/prelude/prelude.v b/theories/prelude/prelude.v deleted file mode 100644 index ed52dc05b765c479fae9a62bbc0192d8ab402398..0000000000000000000000000000000000000000 --- a/theories/prelude/prelude.v +++ /dev/null @@ -1,15 +0,0 @@ -(* Copyright (c) 2012-2017, Robbert Krebbers. *) -(* This file is distributed under the terms of the BSD license. *) -From iris.prelude Require Export - base - tactics - orders - option - vector - numbers - relations - collections - fin_collections - listset - list - lexico. diff --git a/theories/prelude/pretty.v b/theories/prelude/pretty.v deleted file mode 100644 index d20573f391034fb37f23b5faac96eeca6292047e..0000000000000000000000000000000000000000 --- a/theories/prelude/pretty.v +++ /dev/null @@ -1,72 +0,0 @@ -(* Copyright (c) 2012-2017, Robbert Krebbers. *) -(* This file is distributed under the terms of the BSD license. *) -From iris.prelude Require Export strings. -From iris.prelude Require Import relations. -From Coq Require Import Ascii. -Set Default Proof Using "Type". - -Class Pretty A := pretty : A → string. -Definition pretty_N_char (x : N) : ascii := - match x with - | 0 => "0" | 1 => "1" | 2 => "2" | 3 => "3" | 4 => "4" - | 5 => "5" | 6 => "6" | 7 => "7" | 8 => "8" | _ => "9" - end%char%N. -Fixpoint pretty_N_go_help (x : N) (acc : Acc (<)%N x) (s : string) : string := - match decide (0 < x)%N with - | left H => pretty_N_go_help (x `div` 10)%N - (Acc_inv acc (N.div_lt x 10 H eq_refl)) - (String (pretty_N_char (x `mod` 10)) s) - | right _ => s - end. -Definition pretty_N_go (x : N) : string → string := - pretty_N_go_help x (wf_guard 32 N.lt_wf_0 x). -Lemma pretty_N_go_0 s : pretty_N_go 0 s = s. -Proof. done. Qed. -Lemma pretty_N_go_help_irrel x acc1 acc2 s : - pretty_N_go_help x acc1 s = pretty_N_go_help x acc2 s. -Proof. - revert x acc1 acc2 s; fix 2; intros x [acc1] [acc2] s; simpl. - destruct (decide (0 < x)%N); auto. -Qed. -Lemma pretty_N_go_step x s : - (0 < x)%N → pretty_N_go x s - = pretty_N_go (x `div` 10) (String (pretty_N_char (x `mod` 10)) s). -Proof. - unfold pretty_N_go; intros; destruct (wf_guard 32 N.lt_wf_0 x). - destruct wf_guard. (* this makes coqchk happy. *) - unfold pretty_N_go_help at 1; fold pretty_N_go_help. - by destruct (decide (0 < x)%N); auto using pretty_N_go_help_irrel. -Qed. -Instance pretty_N : Pretty N := λ x, pretty_N_go x ""%string. -Lemma pretty_N_unfold x : pretty x = pretty_N_go x "". -Proof. done. Qed. -Instance pretty_N_inj : Inj (@eq N) (=) pretty. -Proof. - assert (∀ x y, x < 10 → y < 10 → - pretty_N_char x = pretty_N_char y → x = y)%N. - { compute; intros. by repeat (discriminate || case_match). } - cut (∀ x y s s', pretty_N_go x s = pretty_N_go y s' → - String.length s = String.length s' → x = y ∧ s = s'). - { intros help x y Hp. - eapply (help x y "" ""); [by rewrite <-!pretty_N_unfold|done]. } - assert (∀ x s, ¬String.length (pretty_N_go x s) < String.length s) as help. - { setoid_rewrite <-Nat.le_ngt. - intros x; induction (N.lt_wf_0 x) as [x _ IH]; intros s. - assert (x = 0 ∨ 0 < x)%N as [->|?] by lia; [by rewrite pretty_N_go_0|]. - rewrite pretty_N_go_step by done. - etrans; [|by eapply IH, N.div_lt]; simpl; lia. } - intros x; induction (N.lt_wf_0 x) as [x _ IH]; intros y s s'. - assert ((x = 0 ∨ 0 < x) ∧ (y = 0 ∨ 0 < y))%N as [[->|?] [->|?]] by lia; - rewrite ?pretty_N_go_0, ?pretty_N_go_step, ?(pretty_N_go_step y) by done. - { done. } - { intros -> Hlen; edestruct help; rewrite Hlen; simpl; lia. } - { intros <- Hlen; edestruct help; rewrite <-Hlen; simpl; lia. } - intros Hs Hlen; apply IH in Hs; destruct Hs; - simplify_eq/=; split_and?; auto using N.div_lt_upper_bound with lia. - rewrite (N.div_mod x 10), (N.div_mod y 10) by done. - auto using N.mod_lt with f_equal. -Qed. -Instance pretty_Z : Pretty Z := λ x, - match x with - | Z0 => "" | Zpos x => pretty (Npos x) | Zneg x => "-" +:+ pretty (Npos x) - end%string. diff --git a/theories/prelude/proof_irrel.v b/theories/prelude/proof_irrel.v deleted file mode 100644 index 694ccd8c6f1b563470c6815eb54266c8571e4c7f..0000000000000000000000000000000000000000 --- a/theories/prelude/proof_irrel.v +++ /dev/null @@ -1,43 +0,0 @@ -(* Copyright (c) 2012-2017, Robbert Krebbers. *) -(* This file is distributed under the terms of the BSD license. *) -(** This file collects facts on proof irrelevant types/propositions. *) -From iris.prelude Require Export base. -Set Default Proof Using "Type". - -Hint Extern 200 (ProofIrrel _) => progress (lazy beta) : typeclass_instances. - -Instance True_pi: ProofIrrel True. -Proof. intros [] []; reflexivity. Qed. -Instance False_pi: ProofIrrel False. -Proof. intros []. Qed. -Instance and_pi (A B : Prop) : - ProofIrrel A → ProofIrrel B → ProofIrrel (A ∧ B). -Proof. intros ?? [??] [??]. f_equal; trivial. Qed. -Instance prod_pi (A B : Type) : - ProofIrrel A → ProofIrrel B → ProofIrrel (A * B). -Proof. intros ?? [??] [??]. f_equal; trivial. Qed. -Instance eq_pi {A} (x : A) `{∀ z, Decision (x = z)} (y : A) : - ProofIrrel (x = y). -Proof. - set (f z (H : x = z) := - match decide (x = z) return x = z with - | left H => H | right H' => False_rect _ (H' H) - end). - assert (∀ z (H : x = z), - eq_trans (eq_sym (f x (eq_refl x))) (f z H) = H) as help. - { intros ? []. destruct (f x eq_refl); tauto. } - intros p q. rewrite <-(help _ p), <-(help _ q). - unfold f at 2 4. destruct (decide _). reflexivity. exfalso; tauto. -Qed. -Instance Is_true_pi (b : bool) : ProofIrrel (Is_true b). -Proof. destruct b; simpl; apply _. Qed. -Lemma sig_eq_pi `(P : A → Prop) `{∀ x, ProofIrrel (P x)} - (x y : sig P) : x = y ↔ `x = `y. -Proof. - split; [intros <-; reflexivity|]. - destruct x as [x Hx], y as [y Hy]; simpl; intros; subst. - f_equal. apply proof_irrel. -Qed. -Lemma exists_proj1_pi `(P : A → Prop) `{∀ x, ProofIrrel (P x)} - (x : sig P) p : `x ↾ p = x. -Proof. apply (sig_eq_pi _); reflexivity. Qed. diff --git a/theories/prelude/relations.v b/theories/prelude/relations.v deleted file mode 100644 index 7b2b3f09976fa647c1a52e81c51e5d4b4c4ab062..0000000000000000000000000000000000000000 --- a/theories/prelude/relations.v +++ /dev/null @@ -1,232 +0,0 @@ -(* Copyright (c) 2012-2017, Robbert Krebbers. *) -(* This file is distributed under the terms of the BSD license. *) -(** This file collects definitions and theorems on abstract rewriting systems. -These are particularly useful as we define the operational semantics as a -small step semantics. This file defines a hint database [ars] containing -some theorems on abstract rewriting systems. *) -From Coq Require Import Wf_nat. -From iris.prelude Require Export tactics base. -Set Default Proof Using "Type". - -(** * Definitions *) -Section definitions. - Context `(R : relation A). - - (** An element is reducible if a step is possible. *) - Definition red (x : A) := ∃ y, R x y. - - (** An element is in normal form if no further steps are possible. *) - Definition nf (x : A) := ¬red x. - - (** The reflexive transitive closure. *) - Inductive rtc : relation A := - | rtc_refl x : rtc x x - | rtc_l x y z : R x y → rtc y z → rtc x z. - - (** The reflexive transitive closure for setoids. *) - Inductive rtcS `{Equiv A} : relation A := - | rtcS_refl x y : x ≡ y → rtcS x y - | rtcS_l x y z : R x y → rtcS y z → rtcS x z. - - (** Reductions of exactly [n] steps. *) - Inductive nsteps : nat → relation A := - | nsteps_O x : nsteps 0 x x - | nsteps_l n x y z : R x y → nsteps n y z → nsteps (S n) x z. - - (** Reduction of at most [n] steps. *) - Inductive bsteps : nat → relation A := - | bsteps_refl n x : bsteps n x x - | bsteps_l n x y z : R x y → bsteps n y z → bsteps (S n) x z. - - (** The transitive closure. *) - Inductive tc : relation A := - | tc_once x y : R x y → tc x y - | tc_l x y z : R x y → tc y z → tc x z. - - (** An element [x] is universally looping if all paths starting at [x] - are infinite. *) - CoInductive all_loop : A → Prop := - | all_loop_do_step x : red x → (∀ y, R x y → all_loop y) → all_loop x. - - (** An element [x] is existentally looping if some path starting at [x] - is infinite. *) - CoInductive ex_loop : A → Prop := - | ex_loop_do_step x y : R x y → ex_loop y → ex_loop x. -End definitions. - -Hint Unfold nf red. - -(** * General theorems *) -Section rtc. - Context `{R : relation A}. - - Hint Constructors rtc nsteps bsteps tc. - - Global Instance rtc_reflexive: Reflexive (rtc R). - Proof. exact (@rtc_refl A R). Qed. - Lemma rtc_transitive x y z : rtc R x y → rtc R y z → rtc R x z. - Proof. induction 1; eauto. Qed. - Global Instance: Transitive (rtc R). - Proof. exact rtc_transitive. Qed. - Lemma rtc_once x y : R x y → rtc R x y. - Proof. eauto. Qed. - Lemma rtc_r x y z : rtc R x y → R y z → rtc R x z. - Proof. intros. etrans; eauto. Qed. - Lemma rtc_inv x z : rtc R x z → x = z ∨ ∃ y, R x y ∧ rtc R y z. - Proof. inversion_clear 1; eauto. Qed. - Lemma rtc_ind_l (P : A → Prop) (z : A) - (Prefl : P z) (Pstep : ∀ x y, R x y → rtc R y z → P y → P x) : - ∀ x, rtc R x z → P x. - Proof. induction 1; eauto. Qed. - Lemma rtc_ind_r_weak (P : A → A → Prop) - (Prefl : ∀ x, P x x) (Pstep : ∀ x y z, rtc R x y → R y z → P x y → P x z) : - ∀ x z, rtc R x z → P x z. - Proof. - cut (∀ y z, rtc R y z → ∀ x, rtc R x y → P x y → P x z). - { eauto using rtc_refl. } - induction 1; eauto using rtc_r. - Qed. - Lemma rtc_ind_r (P : A → Prop) (x : A) - (Prefl : P x) (Pstep : ∀ y z, rtc R x y → R y z → P y → P z) : - ∀ z, rtc R x z → P z. - Proof. - intros z p. revert x z p Prefl Pstep. refine (rtc_ind_r_weak _ _ _); eauto. - Qed. - Lemma rtc_inv_r x z : rtc R x z → x = z ∨ ∃ y, rtc R x y ∧ R y z. - Proof. revert z. apply rtc_ind_r; eauto. Qed. - - Lemma nsteps_once x y : R x y → nsteps R 1 x y. - Proof. eauto. Qed. - Lemma nsteps_trans n m x y z : - nsteps R n x y → nsteps R m y z → nsteps R (n + m) x z. - Proof. induction 1; simpl; eauto. Qed. - Lemma nsteps_r n x y z : nsteps R n x y → R y z → nsteps R (S n) x z. - Proof. induction 1; eauto. Qed. - Lemma nsteps_rtc n x y : nsteps R n x y → rtc R x y. - Proof. induction 1; eauto. Qed. - Lemma rtc_nsteps x y : rtc R x y → ∃ n, nsteps R n x y. - Proof. induction 1; firstorder eauto. Qed. - - Lemma bsteps_once n x y : R x y → bsteps R (S n) x y. - Proof. eauto. Qed. - Lemma bsteps_plus_r n m x y : - bsteps R n x y → bsteps R (n + m) x y. - Proof. induction 1; simpl; eauto. Qed. - Lemma bsteps_weaken n m x y : - n ≤ m → bsteps R n x y → bsteps R m x y. - Proof. - intros. rewrite (Minus.le_plus_minus n m); auto using bsteps_plus_r. - Qed. - Lemma bsteps_plus_l n m x y : - bsteps R n x y → bsteps R (m + n) x y. - Proof. apply bsteps_weaken. auto with arith. Qed. - Lemma bsteps_S n x y : bsteps R n x y → bsteps R (S n) x y. - Proof. apply bsteps_weaken. lia. Qed. - Lemma bsteps_trans n m x y z : - bsteps R n x y → bsteps R m y z → bsteps R (n + m) x z. - Proof. induction 1; simpl; eauto using bsteps_plus_l. Qed. - Lemma bsteps_r n x y z : bsteps R n x y → R y z → bsteps R (S n) x z. - Proof. induction 1; eauto. Qed. - Lemma bsteps_rtc n x y : bsteps R n x y → rtc R x y. - Proof. induction 1; eauto. Qed. - Lemma rtc_bsteps x y : rtc R x y → ∃ n, bsteps R n x y. - Proof. induction 1; [exists 0; constructor|]. naive_solver eauto. Qed. - Lemma bsteps_ind_r (P : nat → A → Prop) (x : A) - (Prefl : ∀ n, P n x) - (Pstep : ∀ n y z, bsteps R n x y → R y z → P n y → P (S n) z) : - ∀ n z, bsteps R n x z → P n z. - Proof. - cut (∀ m y z, bsteps R m y z → ∀ n, - bsteps R n x y → (∀ m', n ≤ m' ∧ m' ≤ n + m → P m' y) → P (n + m) z). - { intros help ?. change n with (0 + n). eauto. } - induction 1 as [|m x' y z p2 p3 IH]; [by eauto with arith|]. - intros n p1 H. rewrite <-plus_n_Sm. - apply (IH (S n)); [by eauto using bsteps_r |]. - intros [|m'] [??]; [lia |]. apply Pstep with x'. - - apply bsteps_weaken with n; intuition lia. - - done. - - apply H; intuition lia. - Qed. - - Lemma tc_transitive x y z : tc R x y → tc R y z → tc R x z. - Proof. induction 1; eauto. Qed. - Global Instance: Transitive (tc R). - Proof. exact tc_transitive. Qed. - Lemma tc_r x y z : tc R x y → R y z → tc R x z. - Proof. intros. etrans; eauto. Qed. - Lemma tc_rtc_l x y z : rtc R x y → tc R y z → tc R x z. - Proof. induction 1; eauto. Qed. - Lemma tc_rtc_r x y z : tc R x y → rtc R y z → tc R x z. - Proof. intros Hxy Hyz. revert x Hxy. induction Hyz; eauto using tc_r. Qed. - Lemma tc_rtc x y : tc R x y → rtc R x y. - Proof. induction 1; eauto. Qed. - - Lemma all_loop_red x : all_loop R x → red R x. - Proof. destruct 1; auto. Qed. - Lemma all_loop_step x y : all_loop R x → R x y → all_loop R y. - Proof. destruct 1; auto. Qed. - Lemma all_loop_rtc x y : all_loop R x → rtc R x y → all_loop R y. - Proof. induction 2; eauto using all_loop_step. Qed. - Lemma all_loop_alt x : - all_loop R x ↔ ∀ y, rtc R x y → red R y. - Proof. - split; [eauto using all_loop_red, all_loop_rtc|]. - intros H. cut (∀ z, rtc R x z → all_loop R z); [eauto|]. - cofix FIX. constructor; eauto using rtc_r. - Qed. -End rtc. - -Hint Constructors rtc nsteps bsteps tc : ars. -Hint Resolve rtc_once rtc_r tc_r rtc_transitive tc_rtc_l tc_rtc_r - tc_rtc bsteps_once bsteps_r bsteps_refl bsteps_trans : ars. - -(** * Theorems on sub relations *) -Section subrel. - Context {A} (R1 R2 : relation A). - Notation subrel := (∀ x y, R1 x y → R2 x y). - Lemma red_subrel x : subrel → red R1 x → red R2 x. - Proof. intros ? [y ?]; eauto. Qed. - Lemma nf_subrel x : subrel → nf R2 x → nf R1 x. - Proof. intros ? H1 H2; destruct H1; by apply red_subrel. Qed. -End subrel. - -(** * Theorems on well founded relations *) -Notation wf := well_founded. - -Section wf. - Context `{R : relation A}. - - (** A trick by Thomas Braibant to compute with well-founded recursions: - it lazily adds [2^n] [Acc_intro] constructors in front of a well foundedness - proof, so that the actual proof is never reached in practise. *) - Fixpoint wf_guard (n : nat) (wfR : wf R) : wf R := - match n with - | 0 => wfR - | S n => λ x, Acc_intro x (λ y _, wf_guard n (wf_guard n wfR) y) - end. - - Lemma wf_projected `(R2 : relation B) (f : A → B) : - (∀ x y, R x y → R2 (f x) (f y)) → - wf R2 → wf R. - Proof. - intros Hf Hwf. - cut (∀ y, Acc R2 y → ∀ x, y = f x → Acc R x). - { intros aux x. apply (aux (f x)); auto. } - induction 1 as [y _ IH]. intros x ?. subst. - constructor. intros. apply (IH (f y)); auto. - Qed. -End wf. - -(* Generally we do not want [wf_guard] to be expanded (neither by tactics, -nor by conversion tests in the kernel), but in some cases we do need it for -computation (that is, we cannot make it opaque). We use the [Strategy] -command to make its expanding behavior less eager. *) -Strategy 100 [wf_guard]. - -Lemma Fix_F_proper `{R : relation A} (B : A → Type) (E : ∀ x, relation (B x)) - (F : ∀ x, (∀ y, R y x → B y) → B x) - (HF : ∀ (x : A) (f g : ∀ y, R y x → B y), - (∀ y Hy Hy', E _ (f y Hy) (g y Hy')) → E _ (F x f) (F x g)) - (x : A) (acc1 acc2 : Acc R x) : - E _ (Fix_F B F acc1) (Fix_F B F acc2). -Proof. revert x acc1 acc2. fix 2. intros x [acc1] [acc2]; simpl; auto. Qed. diff --git a/theories/prelude/set.v b/theories/prelude/set.v deleted file mode 100644 index 7fc9dd5a59f0310001a3890ed516ee8deb834a39..0000000000000000000000000000000000000000 --- a/theories/prelude/set.v +++ /dev/null @@ -1,55 +0,0 @@ -(* Copyright (c) 2012-2017, Robbert Krebbers. *) -(* This file is distributed under the terms of the BSD license. *) -(** This file implements sets as functions into Prop. *) -From iris.prelude Require Export collections. -Set Default Proof Using "Type". - -Record set (A : Type) : Type := mkSet { set_car : A → Prop }. -Add Printing Constructor set. -Arguments mkSet {_} _. -Arguments set_car {_} _ _. -Notation "{[ x | P ]}" := (mkSet (λ x, P)) - (at level 1, format "{[ x | P ]}") : C_scope. - -Instance set_elem_of {A} : ElemOf A (set A) := λ x X, set_car X x. - -Instance set_top {A} : Top (set A) := {[ _ | True ]}. -Instance set_empty {A} : Empty (set A) := {[ _ | False ]}. -Instance set_singleton {A} : Singleton A (set A) := λ y, {[ x | y = x ]}. -Instance set_union {A} : Union (set A) := λ X1 X2, {[ x | x ∈ X1 ∨ x ∈ X2 ]}. -Instance set_intersection {A} : Intersection (set A) := λ X1 X2, - {[ x | x ∈ X1 ∧ x ∈ X2 ]}. -Instance set_difference {A} : Difference (set A) := λ X1 X2, - {[ x | x ∈ X1 ∧ x ∉ X2 ]}. -Instance set_collection : Collection A (set A). -Proof. split; [split | |]; by repeat intro. Qed. - -Lemma elem_of_top {A} (x : A) : x ∈ ⊤ ↔ True. -Proof. done. Qed. -Lemma elem_of_mkSet {A} (P : A → Prop) x : x ∈ {[ x | P x ]} ↔ P x. -Proof. done. Qed. -Lemma not_elem_of_mkSet {A} (P : A → Prop) x : x ∉ {[ x | P x ]} ↔ ¬P x. -Proof. done. Qed. -Lemma top_subseteq {A} (X : set A) : X ⊆ ⊤. -Proof. done. Qed. -Hint Resolve top_subseteq. - -Instance set_ret : MRet set := λ A (x : A), {[ x ]}. -Instance set_bind : MBind set := λ A B (f : A → set B) (X : set A), - mkSet (λ b, ∃ a, b ∈ f a ∧ a ∈ X). -Instance set_fmap : FMap set := λ A B (f : A → B) (X : set A), - {[ b | ∃ a, b = f a ∧ a ∈ X ]}. -Instance set_join : MJoin set := λ A (XX : set (set A)), - {[ a | ∃ X, a ∈ X ∧ X ∈ XX ]}. -Instance set_collection_monad : CollectionMonad set. -Proof. by split; try apply _. Qed. - -Instance set_unfold_set_all {A} (x : A) : SetUnfold (x ∈ (⊤ : set A)) True. -Proof. by constructor. Qed. -Instance set_unfold_mkSet {A} (P : A → Prop) x Q : - SetUnfoldSimpl (P x) Q → SetUnfold (x ∈ mkSet P) Q. -Proof. intros HPQ. constructor. apply HPQ. Qed. - -Global Opaque set_elem_of set_top set_empty set_singleton. -Global Opaque set_union set_intersection set_difference. -Global Opaque set_ret set_bind set_fmap set_join. diff --git a/theories/prelude/sorting.v b/theories/prelude/sorting.v deleted file mode 100644 index 709163129e114aa10bab38973ea62aecce99572c..0000000000000000000000000000000000000000 --- a/theories/prelude/sorting.v +++ /dev/null @@ -1,204 +0,0 @@ -(* Copyright (c) 2012-2017, Robbert Krebbers. *) -(* This file is distributed under the terms of the BSD license. *) -(** Merge sort. Adapted from the implementation of Hugo Herbelin in the Coq -standard library, but without using the module system. *) -From Coq Require Export Sorted. -From iris.prelude Require Export orders list. -Set Default Proof Using "Type". - -Section merge_sort. - Context {A} (R : relation A) `{∀ x y, Decision (R x y)}. - - Fixpoint list_merge (l1 : list A) : list A → list A := - fix list_merge_aux l2 := - match l1, l2 with - | [], _ => l2 - | _, [] => l1 - | x1 :: l1, x2 :: l2 => - if decide_rel R x1 x2 then x1 :: list_merge l1 (x2 :: l2) - else x2 :: list_merge_aux l2 - end. - Global Arguments list_merge !_ !_ /. - - Local Notation stack := (list (option (list A))). - Fixpoint merge_list_to_stack (st : stack) (l : list A) : stack := - match st with - | [] => [Some l] - | None :: st => Some l :: st - | Some l' :: st => None :: merge_list_to_stack st (list_merge l' l) - end. - Fixpoint merge_stack (st : stack) : list A := - match st with - | [] => [] - | None :: st => merge_stack st - | Some l :: st => list_merge l (merge_stack st) - end. - Fixpoint merge_sort_aux (st : stack) (l : list A) : list A := - match l with - | [] => merge_stack st - | x :: l => merge_sort_aux (merge_list_to_stack st [x]) l - end. - Definition merge_sort : list A → list A := merge_sort_aux []. -End merge_sort. - -(** ** Properties of the [Sorted] and [StronglySorted] predicate *) -Section sorted. - Context {A} (R : relation A). - - Lemma Sorted_StronglySorted `{!Transitive R} l : - Sorted R l → StronglySorted R l. - Proof. by apply Sorted.Sorted_StronglySorted. Qed. - Lemma StronglySorted_unique `{!AntiSymm (=) R} l1 l2 : - StronglySorted R l1 → StronglySorted R l2 → l1 ≡ₚ l2 → l1 = l2. - Proof. - intros Hl1; revert l2. induction Hl1 as [|x1 l1 ? IH Hx1]; intros l2 Hl2 E. - { symmetry. by apply Permutation_nil. } - destruct Hl2 as [|x2 l2 ? Hx2]. - { by apply Permutation_nil in E. } - assert (x1 = x2); subst. - { rewrite Forall_forall in Hx1, Hx2. - assert (x2 ∈ x1 :: l1) as Hx2' by (by rewrite E; left). - assert (x1 ∈ x2 :: l2) as Hx1' by (by rewrite <-E; left). - inversion Hx1'; inversion Hx2'; simplify_eq; auto. } - f_equal. by apply IH, (inj (x2 ::)). - Qed. - Lemma Sorted_unique `{!Transitive R, !AntiSymm (=) R} l1 l2 : - Sorted R l1 → Sorted R l2 → l1 ≡ₚ l2 → l1 = l2. - Proof. auto using StronglySorted_unique, Sorted_StronglySorted. Qed. - - Global Instance HdRel_dec x `{∀ y, Decision (R x y)} l : - Decision (HdRel R x l). - Proof. - refine - match l with - | [] => left _ - | y :: l => cast_if (decide (R x y)) - end; abstract first [by constructor | by inversion 1]. - Defined. - Global Instance Sorted_dec `{∀ x y, Decision (R x y)} : ∀ l, - Decision (Sorted R l). - Proof. - refine - (fix go l := - match l return Decision (Sorted R l) with - | [] => left _ - | x :: l => cast_if_and (decide (HdRel R x l)) (go l) - end); clear go; abstract first [by constructor | by inversion 1]. - Defined. - Global Instance StronglySorted_dec `{∀ x y, Decision (R x y)} : ∀ l, - Decision (StronglySorted R l). - Proof. - refine - (fix go l := - match l return Decision (StronglySorted R l) with - | [] => left _ - | x :: l => cast_if_and (decide (Forall (R x) l)) (go l) - end); clear go; abstract first [by constructor | by inversion 1]. - Defined. - - Context {B} (f : A → B). - Lemma HdRel_fmap (R1 : relation A) (R2 : relation B) x l : - (∀ y, R1 x y → R2 (f x) (f y)) → HdRel R1 x l → HdRel R2 (f x) (f <$> l). - Proof. destruct 2; constructor; auto. Qed. - Lemma Sorted_fmap (R1 : relation A) (R2 : relation B) l : - (∀ x y, R1 x y → R2 (f x) (f y)) → Sorted R1 l → Sorted R2 (f <$> l). - Proof. induction 2; simpl; constructor; eauto using HdRel_fmap. Qed. - Lemma StronglySorted_fmap (R1 : relation A) (R2 : relation B) l : - (∀ x y, R1 x y → R2 (f x) (f y)) → - StronglySorted R1 l → StronglySorted R2 (f <$> l). - Proof. - induction 2; csimpl; constructor; - rewrite ?Forall_fmap; eauto using Forall_impl. - Qed. -End sorted. - -(** ** Correctness of merge sort *) -Section merge_sort_correct. - Context {A} (R : relation A) `{∀ x y, Decision (R x y)}. - - Lemma list_merge_cons x1 x2 l1 l2 : - list_merge R (x1 :: l1) (x2 :: l2) = - if decide (R x1 x2) then x1 :: list_merge R l1 (x2 :: l2) - else x2 :: list_merge R (x1 :: l1) l2. - Proof. done. Qed. - Lemma HdRel_list_merge x l1 l2 : - HdRel R x l1 → HdRel R x l2 → HdRel R x (list_merge R l1 l2). - Proof. - destruct 1 as [|x1 l1 IH1], 1 as [|x2 l2 IH2]; - rewrite ?list_merge_cons; simpl; repeat case_decide; auto. - Qed. - Lemma Sorted_list_merge `{!Total R} l1 l2 : - Sorted R l1 → Sorted R l2 → Sorted R (list_merge R l1 l2). - Proof. - intros Hl1. revert l2. induction Hl1 as [|x1 l1 IH1]; - induction 1 as [|x2 l2 IH2]; rewrite ?list_merge_cons; simpl; - repeat case_decide; - constructor; eauto using HdRel_list_merge, HdRel_cons, total_not. - Qed. - Lemma merge_Permutation l1 l2 : list_merge R l1 l2 ≡ₚ l1 ++ l2. - Proof. - revert l2. induction l1 as [|x1 l1 IH1]; intros l2; - induction l2 as [|x2 l2 IH2]; rewrite ?list_merge_cons; simpl; - repeat case_decide; auto. - - by rewrite (right_id_L [] (++)). - - by rewrite IH2, Permutation_middle. - Qed. - - Local Notation stack := (list (option (list A))). - Inductive merge_stack_Sorted : stack → Prop := - | merge_stack_Sorted_nil : merge_stack_Sorted [] - | merge_stack_Sorted_cons_None st : - merge_stack_Sorted st → merge_stack_Sorted (None :: st) - | merge_stack_Sorted_cons_Some l st : - Sorted R l → merge_stack_Sorted st → merge_stack_Sorted (Some l :: st). - Fixpoint merge_stack_flatten (st : stack) : list A := - match st with - | [] => [] - | None :: st => merge_stack_flatten st - | Some l :: st => l ++ merge_stack_flatten st - end. - - Lemma Sorted_merge_list_to_stack `{!Total R} st l : - merge_stack_Sorted st → Sorted R l → - merge_stack_Sorted (merge_list_to_stack R st l). - Proof. - intros Hst. revert l. - induction Hst; repeat constructor; naive_solver auto using Sorted_list_merge. - Qed. - Lemma merge_list_to_stack_Permutation st l : - merge_stack_flatten (merge_list_to_stack R st l) ≡ₚ - l ++ merge_stack_flatten st. - Proof. - revert l. induction st as [|[l'|] st IH]; intros l; simpl; auto. - by rewrite IH, merge_Permutation, (assoc_L _), (comm (++) l). - Qed. - Lemma Sorted_merge_stack `{!Total R} st : - merge_stack_Sorted st → Sorted R (merge_stack R st). - Proof. induction 1; simpl; auto using Sorted_list_merge. Qed. - Lemma merge_stack_Permutation st : merge_stack R st ≡ₚ merge_stack_flatten st. - Proof. - induction st as [|[] ? IH]; intros; simpl; auto. - by rewrite merge_Permutation, IH. - Qed. - Lemma Sorted_merge_sort_aux `{!Total R} st l : - merge_stack_Sorted st → Sorted R (merge_sort_aux R st l). - Proof. - revert st. induction l; simpl; - auto using Sorted_merge_stack, Sorted_merge_list_to_stack. - Qed. - Lemma merge_sort_aux_Permutation st l : - merge_sort_aux R st l ≡ₚ merge_stack_flatten st ++ l. - Proof. - revert st. induction l as [|?? IH]; simpl; intros. - - by rewrite (right_id_L [] (++)), merge_stack_Permutation. - - rewrite IH, merge_list_to_stack_Permutation; simpl. - by rewrite Permutation_middle. - Qed. - Lemma Sorted_merge_sort `{!Total R} l : Sorted R (merge_sort R l). - Proof. apply Sorted_merge_sort_aux. by constructor. Qed. - Lemma merge_sort_Permutation l : merge_sort R l ≡ₚ l. - Proof. unfold merge_sort. by rewrite merge_sort_aux_Permutation. Qed. - Lemma StronglySorted_merge_sort `{!Transitive R, !Total R} l : - StronglySorted R (merge_sort R l). - Proof. auto using Sorted_StronglySorted, Sorted_merge_sort. Qed. -End merge_sort_correct. diff --git a/theories/prelude/streams.v b/theories/prelude/streams.v deleted file mode 100644 index 9ed4c886fc472d6cc7299deff2894739b2ca0fc2..0000000000000000000000000000000000000000 --- a/theories/prelude/streams.v +++ /dev/null @@ -1,56 +0,0 @@ -(* Copyright (c) 2012-2017, Robbert Krebbers. *) -(* This file is distributed under the terms of the BSD license. *) -From iris.prelude Require Export tactics. -Set Default Proof Using "Type". - -CoInductive stream (A : Type) : Type := scons : A → stream A → stream A. -Arguments scons {_} _ _. -Delimit Scope stream_scope with stream. -Bind Scope stream_scope with stream. -Open Scope stream_scope. -Infix ":.:" := scons (at level 60, right associativity) : stream_scope. - -Definition shead {A} (s : stream A) : A := match s with x :.: _ => x end. -Definition stail {A} (s : stream A) : stream A := match s with _ :.: s => s end. - -CoInductive stream_equiv' {A} (s1 s2 : stream A) : Prop := - scons_equiv' : - shead s1 = shead s2 → stream_equiv' (stail s1) (stail s2) → - stream_equiv' s1 s2. -Instance stream_equiv {A} : Equiv (stream A) := stream_equiv'. - -Reserved Infix "!.!" (at level 20). -Fixpoint slookup {A} (i : nat) (s : stream A) : A := - match i with O => shead s | S i => stail s !.! i end -where "s !.! i" := (slookup i s). - -Global Instance stream_fmap : FMap stream := λ A B f, - cofix go s := f (shead s) :.: go (stail s). - -Fixpoint stake {A} (n : nat) (s : stream A) := - match n with 0 => [] | S n => shead s :: stake n (stail s) end. -CoFixpoint srepeat {A} (x : A) : stream A := x :.: srepeat x. - -Section stream_properties. -Context {A : Type}. -Implicit Types x y : A. -Implicit Types s t : stream A. - -Lemma scons_equiv s1 s2 : shead s1 = shead s2 → stail s1 ≡ stail s2 → s1 ≡ s2. -Proof. by constructor. Qed. -Global Instance equal_equivalence : Equivalence (@equiv (stream A) _). -Proof. - split. - - now cofix; intros [??]; constructor. - - now cofix; intros ?? [??]; constructor. - - cofix; intros ??? [??] [??]; constructor; etrans; eauto. -Qed. -Global Instance scons_proper x : Proper ((≡) ==> (≡)) (scons x). -Proof. by constructor. Qed. -Global Instance shead_proper : Proper ((≡) ==> (=)) (@shead A). -Proof. by intros ?? [??]. Qed. -Global Instance stail_proper : Proper ((≡) ==> (≡)) (@stail A). -Proof. by intros ?? [??]. Qed. -Global Instance slookup_proper : Proper ((≡) ==> eq) (@slookup A i). -Proof. by induction i as [|i IH]; intros s1 s2 Hs; simpl; rewrite Hs. Qed. -End stream_properties. diff --git a/theories/prelude/stringmap.v b/theories/prelude/stringmap.v deleted file mode 100644 index 3e6bff39d6a88b2956e1657ef70da5b8f22cb351..0000000000000000000000000000000000000000 --- a/theories/prelude/stringmap.v +++ /dev/null @@ -1,64 +0,0 @@ -(* Copyright (c) 2012-2017, Robbert Krebbers. *) -(* This file is distributed under the terms of the BSD license. *) -(** This files implements an efficient implementation of finite maps whose keys -range over Coq's data type of strings [string]. The implementation uses radix-2 -search trees (uncompressed Patricia trees) as implemented in the file [pmap] -and guarantees logarithmic-time operations. *) -From iris.prelude Require Export fin_maps pretty. -From iris.prelude Require Import gmap. -Set Default Proof Using "Type". - -Notation stringmap := (gmap string). -Notation stringset := (gset string). - -(** * Generating fresh strings *) -Section stringmap. -Local Open Scope N_scope. -Let R {A} (s : string) (m : stringmap A) (n1 n2 : N) := - n2 < n1 ∧ is_Some (m !! (s +:+ pretty (n1 - 1))). -Lemma fresh_string_step {A} s (m : stringmap A) n x : - m !! (s +:+ pretty n) = Some x → R s m (1 + n) n. -Proof. split; [lia|]. replace (1 + n - 1) with n by lia; eauto. Qed. -Lemma fresh_string_R_wf {A} s (m : stringmap A) : wf (R s m). -Proof. - induction (map_wf m) as [m _ IH]. intros n1; constructor; intros n2 [Hn Hs]. - specialize (IH _ (delete_subset m (s +:+ pretty (n2 - 1)) Hs) n2). - cut (n2 - 1 < n2); [|lia]. clear n1 Hn Hs; revert IH; generalize (n2 - 1). - intros n1. induction 1 as [n2 _ IH]; constructor; intros n3 [??]. - apply IH; [|lia]; split; [lia|]. - by rewrite lookup_delete_ne by (intros ?; simplify_eq/=; lia). -Qed. -Definition fresh_string_go {A} (s : string) (m : stringmap A) (n : N) - (go : ∀ n', R s m n' n → string) : string := - let s' := s +:+ pretty n in - match Some_dec (m !! s') with - | inleft (_↾Hs') => go (1 + n)%N (fresh_string_step s m n _ Hs') - | inright _ => s' - end. -Definition fresh_string {A} (s : string) (m : stringmap A) : string := - match m !! s with - | None => s - | Some _ => - Fix_F _ (fresh_string_go s m) (wf_guard 32 (fresh_string_R_wf s m) 0) - end. -Lemma fresh_string_fresh {A} (m : stringmap A) s : m !! fresh_string s m = None. -Proof. - unfold fresh_string. destruct (m !! s) as [a|] eqn:Hs; [clear a Hs|done]. - generalize 0 (wf_guard 32 (fresh_string_R_wf s m) 0); revert m. - fix 3; intros m n [?]; simpl; unfold fresh_string_go at 1; simpl. - destruct (Some_dec (m !! _)) as [[??]|?]; auto. -Qed. -Definition fresh_string_of_set (s : string) (X : stringset) : string := - fresh_string s (mapset.mapset_car X). -Lemma fresh_string_of_set_fresh (X : stringset) s : fresh_string_of_set s X ∉ X. -Proof. apply eq_None_ne_Some, fresh_string_fresh. Qed. - -Fixpoint fresh_strings_of_set - (s : string) (n : nat) (X : stringset) : list string := - match n with - | 0 => [] - | S n => - let x := fresh_string_of_set s X in - x :: fresh_strings_of_set s n ({[ x ]} ∪ X) - end%nat. -End stringmap. diff --git a/theories/prelude/strings.v b/theories/prelude/strings.v deleted file mode 100644 index 100d49461e0b94a7af546ff101e1fdc6c3af7619..0000000000000000000000000000000000000000 --- a/theories/prelude/strings.v +++ /dev/null @@ -1,100 +0,0 @@ -(* Copyright (c) 2012-2017, Robbert Krebbers. *) -(* This file is distributed under the terms of the BSD license. *) -From Coq Require Import Ascii. -From Coq Require Export String. -From iris.prelude Require Export list. -From iris.prelude Require Import countable. -Set Default Proof Using "Type". - -(* To avoid randomly ending up with String.length because this module is -imported hereditarily somewhere. *) -Notation length := List.length. - -(** * Fix scopes *) -Open Scope string_scope. -Open Scope list_scope. -Infix "+:+" := String.append (at level 60, right associativity) : C_scope. -Arguments String.append _ _ : simpl never. - -(** * Decision of equality *) -Instance assci_eq_dec : EqDecision ascii := ascii_dec. -Instance string_eq_dec : EqDecision string. -Proof. solve_decision. Defined. -Instance string_app_inj : Inj (=) (=) (String.append s1). -Proof. intros s1 ???. induction s1; simplify_eq/=; f_equal/=; auto. Qed. - -(* Reverse *) -Fixpoint string_rev_app (s1 s2 : string) : string := - match s1 with - | "" => s2 - | String a s1 => string_rev_app s1 (String a s2) - end. -Definition string_rev (s : string) : string := string_rev_app s "". - -(* Break a string up into lists of words, delimited by white space *) -Definition is_space (x : Ascii.ascii) : bool := - match x with - | "009" | "010" | "011" | "012" | "013" | " " => true | _ => false - end%char. - -Fixpoint words_go (cur : option string) (s : string) : list string := - match s with - | "" => option_list (string_rev <$> cur) - | String a s => - if is_space a then option_list (string_rev <$> cur) ++ words_go None s - else words_go (Some (default (String a "") cur (String a))) s - end. -Definition words : string → list string := words_go None. - -Ltac words s := - match type of s with - | list string => s - | string => eval vm_compute in (words s) - end. - -(** * Encoding and decoding *) -(** In order to reuse or existing implementation of radix-2 search trees over -positive binary naturals [positive], we define an injection [string_to_pos] -from [string] into [positive]. *) -Fixpoint digits_to_pos (βs : list bool) : positive := - match βs with - | [] => xH - | false :: βs => (digits_to_pos βs)~0 - | true :: βs => (digits_to_pos βs)~1 - end%positive. -Definition ascii_to_digits (a : Ascii.ascii) : list bool := - match a with - | Ascii.Ascii β1 β2 β3 β4 β5 β6 β7 β8 => [β1;β2;β3;β4;β5;β6;β7;β8] - end. -Fixpoint string_to_pos (s : string) : positive := - match s with - | EmptyString => xH - | String a s => string_to_pos s ++ digits_to_pos (ascii_to_digits a) - end%positive. -Fixpoint digits_of_pos (p : positive) : list bool := - match p with - | xH => [] - | p~0 => false :: digits_of_pos p - | p~1 => true :: digits_of_pos p - end%positive. -Fixpoint ascii_of_digits (βs : list bool) : ascii := - match βs with - | [] => zero - | β :: βs => Ascii.shift β (ascii_of_digits βs) - end. -Fixpoint string_of_digits (βs : list bool) : string := - match βs with - | β1 :: β2 :: β3 :: β4 :: β5 :: β6 :: β7 :: β8 :: βs => - String (ascii_of_digits [β1;β2;β3;β4;β5;β6;β7;β8]) (string_of_digits βs) - | _ => EmptyString - end. -Definition string_of_pos (p : positive) : string := - string_of_digits (digits_of_pos p). -Lemma string_of_to_pos s : string_of_pos (string_to_pos s) = s. -Proof. - unfold string_of_pos. by induction s as [|[[][][][][][][][]]]; f_equal/=. -Qed. -Program Instance string_countable : Countable string := {| - encode := string_to_pos; decode p := Some (string_of_pos p) -|}. -Solve Obligations with naive_solver eauto using string_of_to_pos with f_equal. diff --git a/theories/prelude/tactics.v b/theories/prelude/tactics.v deleted file mode 100644 index 1d7d39ecdcf73c17897eb0f43bf83f327e9d1b4b..0000000000000000000000000000000000000000 --- a/theories/prelude/tactics.v +++ /dev/null @@ -1,516 +0,0 @@ -(* Copyright (c) 2012-2017, Robbert Krebbers. *) -(* This file is distributed under the terms of the BSD license. *) -(** This file collects general purpose tactics that are used throughout -the development. *) -From Coq Require Import Omega. -From Coq Require Export Lia. -From iris.prelude Require Export decidable. -Set Default Proof Using "Type". - -Lemma f_equal_dep {A B} (f g : ∀ x : A, B x) x : f = g → f x = g x. -Proof. intros ->; reflexivity. Qed. -Lemma f_equal_help {A B} (f g : A → B) x y : f = g → x = y → f x = g y. -Proof. intros -> ->; reflexivity. Qed. -Ltac f_equal := - let rec go := - match goal with - | _ => reflexivity - | _ => apply f_equal_help; [go|try reflexivity] - | |- ?f ?x = ?g ?x => apply (f_equal_dep f g); go - end in - try go. - -(** We declare hint databases [f_equal], [congruence] and [lia] and containing -solely the tactic corresponding to its name. These hint database are useful in -to be combined in combination with other hint database. *) -Hint Extern 998 (_ = _) => f_equal : f_equal. -Hint Extern 999 => congruence : congruence. -Hint Extern 1000 => lia : lia. -Hint Extern 1000 => omega : omega. -Hint Extern 1001 => progress subst : subst. (** backtracking on this one will -be very bad, so use with care! *) - -(** The tactic [intuition] expands to [intuition auto with *] by default. This -is rather efficient when having big hint databases, or expensive [Hint Extern] -declarations as the ones above. *) -Tactic Notation "intuition" := intuition auto. - -(* [done] can get slow as it calls "trivial". [fast_done] can solve way less - goals, but it will also always finish quickly. - We do 'reflexivity' last because for goals of the form ?x = y, if - we have x = y in the context, we will typically want to use the - assumption and not reflexivity *) -Ltac fast_done := - solve - [ eassumption - | symmetry; eassumption - | apply not_symmetry; eassumption - | reflexivity ]. -Tactic Notation "fast_by" tactic(tac) := - tac; fast_done. - -(** A slightly modified version of Ssreflect's finishing tactic [done]. It -also performs [reflexivity] and uses symmetry of negated equalities. Compared -to Ssreflect's [done], it does not compute the goal's [hnf] so as to avoid -unfolding setoid equalities. Note that this tactic performs much better than -Coq's [easy] tactic as it does not perform [inversion]. *) -Ltac done := - solve - [ repeat first - [ fast_done - | solve [trivial] - (* All the tactics below will introduce themselves anyway, or make no sense - for goals of product type. So this is a good place for us to do it. *) - | progress intros - | solve [symmetry; trivial] - | solve [apply not_symmetry; trivial] - | discriminate - | contradiction - | split - | match goal with H : ¬_ |- _ => case H; clear H; fast_done end ] - ]. -Tactic Notation "by" tactic(tac) := - tac; done. - -(** Aliases for trans and etrans that are easier to type *) -Tactic Notation "trans" constr(A) := transitivity A. -Tactic Notation "etrans" := etransitivity. - -(** Tactics for splitting conjunctions: - -- [split_and] : split the goal if is syntactically of the shape [_ ∧ _] -- [split_ands?] : split the goal repeatedly (perhaps zero times) while it is - of the shape [_ ∧ _]. -- [split_ands!] : works similarly, but at least one split should succeed. In - order to do so, it will head normalize the goal first to possibly expose a - conjunction. - -Note that [split_and] differs from [split] by only splitting conjunctions. The -[split] tactic splits any inductive with one constructor. *) -Tactic Notation "split_and" := - match goal with - | |- _ ∧ _ => split - | |- Is_true (_ && _) => apply andb_True; split - end. -Tactic Notation "split_and" "?" := repeat split_and. -Tactic Notation "split_and" "!" := hnf; split_and; split_and?. - -Tactic Notation "destruct_and" "?" := - repeat match goal with - | H : False |- _ => destruct H - | H : _ ∧ _ |- _ => destruct H - | H : Is_true (bool_decide _) |- _ => apply (bool_decide_unpack _) in H - | H : Is_true (_ && _) |- _ => apply andb_True in H; destruct H - end. -Tactic Notation "destruct_and" "!" := progress (destruct_and?). - -(** The tactic [case_match] destructs an arbitrary match in the conclusion or -assumptions, and generates a corresponding equality. This tactic is best used -together with the [repeat] tactical. *) -Ltac case_match := - match goal with - | H : context [ match ?x with _ => _ end ] |- _ => destruct x eqn:? - | |- context [ match ?x with _ => _ end ] => destruct x eqn:? - end. - -(** The tactic [unless T by tac_fail] succeeds if [T] is not provable by -the tactic [tac_fail]. *) -Tactic Notation "unless" constr(T) "by" tactic3(tac_fail) := - first [assert T by tac_fail; fail 1 | idtac]. - -(** The tactic [repeat_on_hyps tac] repeatedly applies [tac] in unspecified -order on all hypotheses until it cannot be applied to any hypothesis anymore. *) -Tactic Notation "repeat_on_hyps" tactic3(tac) := - repeat match goal with H : _ |- _ => progress tac H end. - -(** The tactic [clear dependent H1 ... Hn] clears the hypotheses [Hi] and -their dependencies. *) -Tactic Notation "clear" "dependent" hyp(H1) hyp(H2) := - clear dependent H1; clear dependent H2. -Tactic Notation "clear" "dependent" hyp(H1) hyp(H2) hyp(H3) := - clear dependent H1 H2; clear dependent H3. -Tactic Notation "clear" "dependent" hyp(H1) hyp(H2) hyp(H3) hyp(H4) := - clear dependent H1 H2 H3; clear dependent H4. -Tactic Notation "clear" "dependent" hyp(H1) hyp(H2) hyp(H3) hyp(H4) - hyp(H5) := clear dependent H1 H2 H3 H4; clear dependent H5. -Tactic Notation "clear" "dependent" hyp(H1) hyp(H2) hyp(H3) hyp(H4) hyp(H5) - hyp (H6) := clear dependent H1 H2 H3 H4 H5; clear dependent H6. -Tactic Notation "clear" "dependent" hyp(H1) hyp(H2) hyp(H3) hyp(H4) hyp(H5) - hyp (H6) hyp(H7) := clear dependent H1 H2 H3 H4 H5 H6; clear dependent H7. -Tactic Notation "clear" "dependent" hyp(H1) hyp(H2) hyp(H3) hyp(H4) hyp(H5) - hyp (H6) hyp(H7) hyp(H8) := - clear dependent H1 H2 H3 H4 H5 H6 H7; clear dependent H8. -Tactic Notation "clear" "dependent" hyp(H1) hyp(H2) hyp(H3) hyp(H4) hyp(H5) - hyp (H6) hyp(H7) hyp(H8) hyp(H9) := - clear dependent H1 H2 H3 H4 H5 H6 H7 H8; clear dependent H9. -Tactic Notation "clear" "dependent" hyp(H1) hyp(H2) hyp(H3) hyp(H4) hyp(H5) - hyp (H6) hyp(H7) hyp(H8) hyp(H9) hyp(H10) := - clear dependent H1 H2 H3 H4 H5 H6 H7 H8 H9; clear dependent H10. - -(** The tactic [is_non_dependent H] determines whether the goal's conclusion or -hypotheses depend on [H]. *) -Tactic Notation "is_non_dependent" constr(H) := - match goal with - | _ : context [ H ] |- _ => fail 1 - | |- context [ H ] => fail 1 - | _ => idtac - end. - -(** The tactic [var_eq x y] fails if [x] and [y] are unequal, and [var_neq] -does the converse. *) -Ltac var_eq x1 x2 := match x1 with x2 => idtac | _ => fail 1 end. -Ltac var_neq x1 x2 := match x1 with x2 => fail 1 | _ => idtac end. - -(** Operational type class projections in recursive calls are not folded back -appropriately by [simpl]. The tactic [csimpl] uses the [fold_classes] tactics -to refold recursive calls of [fmap], [mbind], [omap] and [alter]. A -self-contained example explaining the problem can be found in the following -Coq-club message: - -https://sympa.inria.fr/sympa/arc/coq-club/2012-10/msg00147.html *) -Ltac fold_classes := - repeat match goal with - | |- context [ ?F ] => - progress match type of F with - | FMap _ => - change F with (@fmap _ F); - repeat change (@fmap _ (@fmap _ F)) with (@fmap _ F) - | MBind _ => - change F with (@mbind _ F); - repeat change (@mbind _ (@mbind _ F)) with (@mbind _ F) - | OMap _ => - change F with (@omap _ F); - repeat change (@omap _ (@omap _ F)) with (@omap _ F) - | Alter _ _ _ => - change F with (@alter _ _ _ F); - repeat change (@alter _ _ _ (@alter _ _ _ F)) with (@alter _ _ _ F) - end - end. -Ltac fold_classes_hyps H := - repeat match type of H with - | context [ ?F ] => - progress match type of F with - | FMap _ => - change F with (@fmap _ F) in H; - repeat change (@fmap _ (@fmap _ F)) with (@fmap _ F) in H - | MBind _ => - change F with (@mbind _ F) in H; - repeat change (@mbind _ (@mbind _ F)) with (@mbind _ F) in H - | OMap _ => - change F with (@omap _ F) in H; - repeat change (@omap _ (@omap _ F)) with (@omap _ F) in H - | Alter _ _ _ => - change F with (@alter _ _ _ F) in H; - repeat change (@alter _ _ _ (@alter _ _ _ F)) with (@alter _ _ _ F) in H - end - end. -Tactic Notation "csimpl" "in" hyp(H) := - try (progress simpl in H; fold_classes_hyps H). -Tactic Notation "csimpl" := try (progress simpl; fold_classes). -Tactic Notation "csimpl" "in" "*" := - repeat_on_hyps (fun H => csimpl in H); csimpl. - -(** The tactic [simplify_eq] repeatedly substitutes, discriminates, -and injects equalities, and tries to contradict impossible inequalities. *) -Tactic Notation "simplify_eq" := repeat - match goal with - | H : _ ≠_ |- _ => by case H; try clear H - | H : _ = _ → False |- _ => by case H; try clear H - | H : ?x = _ |- _ => subst x - | H : _ = ?x |- _ => subst x - | H : _ = _ |- _ => discriminate H - | H : _ ≡ _ |- _ => apply leibniz_equiv in H - | H : ?f _ = ?f _ |- _ => apply (inj f) in H - | H : ?f _ _ = ?f _ _ |- _ => apply (inj2 f) in H; destruct H - (* before [injection] to circumvent bug #2939 in some situations *) - | H : ?f _ = ?f _ |- _ => progress injection H as H - (* first hyp will be named [H], subsequent hyps will be given fresh names *) - | H : ?f _ _ = ?f _ _ |- _ => progress injection H as H - | H : ?f _ _ _ = ?f _ _ _ |- _ => progress injection H as H - | H : ?f _ _ _ _ = ?f _ _ _ _ |- _ => progress injection H as H - | H : ?f _ _ _ _ _ = ?f _ _ _ _ _ |- _ => progress injection H as H - | H : ?f _ _ _ _ _ _ = ?f _ _ _ _ _ _ |- _ => progress injection H as H - | H : ?x = ?x |- _ => clear H - (* unclear how to generalize the below *) - | H1 : ?o = Some ?x, H2 : ?o = Some ?y |- _ => - assert (y = x) by congruence; clear H2 - | H1 : ?o = Some ?x, H2 : ?o = None |- _ => congruence - | H : @existT ?A _ _ _ = existT _ _ |- _ => - apply (Eqdep_dec.inj_pair2_eq_dec _ (decide_rel (@eq A))) in H - end. -Tactic Notation "simplify_eq" "/=" := - repeat (progress csimpl in * || simplify_eq). -Tactic Notation "f_equal" "/=" := csimpl in *; f_equal. - -Ltac setoid_subst_aux R x := - match goal with - | H : R x ?y |- _ => - is_var x; - try match y with x _ => fail 2 end; - repeat match goal with - | |- context [ x ] => setoid_rewrite H - | H' : context [ x ] |- _ => - try match H' with H => fail 2 end; - setoid_rewrite H in H' - end; - clear x H - end. -Ltac setoid_subst := - repeat match goal with - | _ => progress simplify_eq/= - | H : @equiv ?A ?e ?x _ |- _ => setoid_subst_aux (@equiv A e) x - | H : @equiv ?A ?e _ ?x |- _ => symmetry in H; setoid_subst_aux (@equiv A e) x - end. - -(** f_equiv works on goals of the form [f _ = f _], for any relation and any -number of arguments. It looks for an appropriate [Proper] instance, and applies -it. The tactic is somewhat limited, since it cannot be used to backtrack on -the Proper instances that has been found. To that end, we try to avoid the -trivial instance in which the resulting goals have an [eq]. More generally, -we try to "maintain" the relation of the current goal. For example, -when having [Proper (equiv ==> dist) f] and [Proper (dist ==> dist) f], it will -favor the second because the relation (dist) stays the same. *) -Ltac f_equiv := - match goal with - | _ => reflexivity - | |- pointwise_relation _ _ _ _ => intros ? - (* We support matches on both sides, *if* they concern the same variable, or - variables in some relation. *) - | |- ?R (match ?x with _ => _ end) (match ?x with _ => _ end) => - destruct x - | H : ?R ?x ?y |- ?R2 (match ?x with _ => _ end) (match ?y with _ => _ end) => - destruct H - (* First assume that the arguments need the same relation as the result *) - | |- ?R (?f ?x) _ => apply (_ : Proper (R ==> R) f) - (* For the case in which R is polymorphic, or an operational type class, - like equiv. *) - | |- (?R _) (?f ?x) _ => apply (_ : Proper (R _ ==> _) f) - | |- (?R _ _) (?f ?x) _ => apply (_ : Proper (R _ _ ==> _) f) - | |- (?R _ _ _) (?f ?x) _ => apply (_ : Proper (R _ _ _ ==> _) f) - | |- (?R _) (?f ?x ?y) _ => apply (_ : Proper (R _ ==> R _ ==> _) f) - | |- (?R _ _) (?f ?x ?y) _ => apply (_ : Proper (R _ _ ==> R _ _ ==> _) f) - | |- (?R _ _ _) (?f ?x ?y) _ => apply (_ : Proper (R _ _ _ ==> R _ _ _ ==> _) f) - (* Next, try to infer the relation. Unfortunately, there is an instance - of Proper for (eq ==> _), which will always be matched. *) - (* TODO: Can we exclude that instance? *) - (* TODO: If some of the arguments are the same, we could also - query for "pointwise_relation"'s. But that leads to a combinatorial - explosion about which arguments are and which are not the same. *) - | |- ?R (?f ?x) _ => apply (_ : Proper (_ ==> R) f) - | |- ?R (?f ?x ?y) _ => apply (_ : Proper (_ ==> _ ==> R) f) - (* In case the function symbol differs, but the arguments are the same, - maybe we have a pointwise_relation in our context. *) - | H : pointwise_relation _ ?R ?f ?g |- ?R (?f ?x) (?g ?x) => apply H - end; - try reflexivity. - -(* The tactic [preprocess_solve_proper] unfolds the first head symbol, so that -we proceed by repeatedly using [f_equiv]. *) -Ltac preprocess_solve_proper := - (* Introduce everything *) - intros; - repeat lazymatch goal with - | |- Proper _ _ => intros ??? - | |- (_ ==> _)%signature _ _ => intros ??? - | |- pointwise_relation _ _ _ _ => intros ? - | |- ?R ?f _ => try let f' := constr:(λ x, f x) in intros ? - end; simpl; - (* Unfold the head symbol, which is the one we are proving a new property about *) - lazymatch goal with - | |- ?R (?f _ _ _ _ _ _ _ _) (?f _ _ _ _ _ _ _ _) => unfold f - | |- ?R (?f _ _ _ _ _ _ _) (?f _ _ _ _ _ _ _) => unfold f - | |- ?R (?f _ _ _ _ _ _) (?f _ _ _ _ _ _) => unfold f - | |- ?R (?f _ _ _ _ _) (?f _ _ _ _ _) => unfold f - | |- ?R (?f _ _ _ _) (?f _ _ _ _) => unfold f - | |- ?R (?f _ _ _) (?f _ _ _) => unfold f - | |- ?R (?f _ _) (?f _ _) => unfold f - | |- ?R (?f _) (?f _) => unfold f - end; - simplify_eq. - -(** The tactic [solve_proper] solves goals of the form "Proper (R1 ==> R2)", for -any number of relations. The actual work is done by repeatedly applying -[f_equiv]. *) -Ltac solve_proper := - preprocess_solve_proper; - solve [repeat (f_equiv; try eassumption)]. - -(** The tactic [intros_revert tac] introduces all foralls/arrows, performs tac, -and then reverts them. *) -Ltac intros_revert tac := - lazymatch goal with - | |- ∀ _, _ => let H := fresh in intro H; intros_revert tac; revert H - | |- _ => tac - end. - -(** Given a tactic [tac2] generating a list of terms, [iter tac1 tac2] -runs [tac x] for each element [x] until [tac x] succeeds. If it does not -suceed for any element of the generated list, the whole tactic wil fail. *) -Tactic Notation "iter" tactic(tac) tactic(l) := - let rec go l := - match l with ?x :: ?l => tac x || go l end in go l. - -(** Given [H : A_1 → ... → A_n → B] (where each [A_i] is non-dependent), the -tactic [feed tac H tac_by] creates a subgoal for each [A_i] and calls [tac p] -with the generated proof [p] of [B]. *) -Tactic Notation "feed" tactic(tac) constr(H) := - let rec go H := - let T := type of H in - lazymatch eval hnf in T with - | ?T1 → ?T2 => - (* Use a separate counter for fresh names to make it more likely that - the generated name is "fresh" with respect to those generated before - calling the [feed] tactic. In particular, this hack makes sure that - tactics like [let H' := fresh in feed (fun p => pose proof p as H') H] do - not break. *) - let HT1 := fresh "feed" in assert T1 as HT1; - [| go (H HT1); clear HT1 ] - | ?T1 => tac H - end in go H. - -(** The tactic [efeed tac H] is similar to [feed], but it also instantiates -dependent premises of [H] with evars. *) -Tactic Notation "efeed" constr(H) "using" tactic3(tac) "by" tactic3 (bytac) := - let rec go H := - let T := type of H in - lazymatch eval hnf in T with - | ?T1 → ?T2 => - let HT1 := fresh "feed" in assert T1 as HT1; - [bytac | go (H HT1); clear HT1 ] - | ?T1 → _ => - let e := fresh "feed" in evar (e:T1); - let e' := eval unfold e in e in - clear e; go (H e') - | ?T1 => tac H - end in go H. -Tactic Notation "efeed" constr(H) "using" tactic3(tac) := - efeed H using tac by idtac. - -(** The following variants of [pose proof], [specialize], [inversion], and -[destruct], use the [feed] tactic before invoking the actual tactic. *) -Tactic Notation "feed" "pose" "proof" constr(H) "as" ident(H') := - feed (fun p => pose proof p as H') H. -Tactic Notation "feed" "pose" "proof" constr(H) := - feed (fun p => pose proof p) H. - -Tactic Notation "efeed" "pose" "proof" constr(H) "as" ident(H') := - efeed H using (fun p => pose proof p as H'). -Tactic Notation "efeed" "pose" "proof" constr(H) := - efeed H using (fun p => pose proof p). - -Tactic Notation "feed" "specialize" hyp(H) := - feed (fun p => specialize p) H. -Tactic Notation "efeed" "specialize" hyp(H) := - efeed H using (fun p => specialize p). - -Tactic Notation "feed" "inversion" constr(H) := - feed (fun p => let H':=fresh in pose proof p as H'; inversion H') H. -Tactic Notation "feed" "inversion" constr(H) "as" simple_intropattern(IP) := - feed (fun p => let H':=fresh in pose proof p as H'; inversion H' as IP) H. - -Tactic Notation "feed" "destruct" constr(H) := - feed (fun p => let H':=fresh in pose proof p as H'; destruct H') H. -Tactic Notation "feed" "destruct" constr(H) "as" simple_intropattern(IP) := - feed (fun p => let H':=fresh in pose proof p as H'; destruct H' as IP) H. - -(** The block definitions are taken from [Coq.Program.Equality] and can be used -by tactics to separate their goal from hypotheses they generalize over. *) -Definition block {A : Type} (a : A) := a. - -Ltac block_goal := match goal with [ |- ?T ] => change (block T) end. -Ltac unblock_goal := unfold block in *. - - -(** The following tactic can be used to add support for patterns to tactic notation: -It will search for the first subterm of the goal matching [pat], and then call [tac] -with that subterm. *) -Ltac find_pat pat tac := - match goal with - |- context [?x] => - unify pat x with typeclass_instances; - tryif tac x then idtac else fail 2 - end. - -(** Coq's [firstorder] tactic fails or loops on rather small goals already. In -particular, on those generated by the tactic [unfold_elem_ofs] which is used -to solve propositions on collections. The [naive_solver] tactic implements an -ad-hoc and incomplete [firstorder]-like solver using Ltac's backtracking -mechanism. The tactic suffers from the following limitations: -- It might leave unresolved evars as Ltac provides no way to detect that. -- To avoid the tactic becoming too slow, we allow a universally quantified - hypothesis to be instantiated only once during each search path. -- It does not perform backtracking on instantiation of universally quantified - assumptions. - -We use a counter to make the search breath first. Breath first search ensures -that a minimal number of hypotheses is instantiated, and thus reduced the -posibility that an evar remains unresolved. - -Despite these limitations, it works much better than Coq's [firstorder] tactic -for the purposes of this development. This tactic either fails or proves the -goal. *) -Lemma forall_and_distr (A : Type) (P Q : A → Prop) : - (∀ x, P x ∧ Q x) ↔ (∀ x, P x) ∧ (∀ x, Q x). -Proof. firstorder. Qed. - -(** The tactic [no_new_unsolved_evars tac] executes [tac] and fails if it -creates any new evars. This trick is by Jonathan Leivent, see: -https://coq.inria.fr/bugs/show_bug.cgi?id=3872 *) - -Ltac no_new_unsolved_evars tac := exact ltac:(tac). - -Tactic Notation "naive_solver" tactic(tac) := - unfold iff, not in *; - repeat match goal with - | H : context [∀ _, _ ∧ _ ] |- _ => - repeat setoid_rewrite forall_and_distr in H; revert H - end; - let rec go n := - repeat match goal with - (**i intros *) - | |- ∀ _, _ => intro - (**i simplification of assumptions *) - | H : False |- _ => destruct H - | H : _ ∧ _ |- _ => - (* Work around bug https://coq.inria.fr/bugs/show_bug.cgi?id=2901 *) - let H1 := fresh in let H2 := fresh in - destruct H as [H1 H2]; try clear H - | H : ∃ _, _ |- _ => - let x := fresh in let Hx := fresh in - destruct H as [x Hx]; try clear H - | H : ?P → ?Q, H2 : ?P |- _ => specialize (H H2) - | H : Is_true (bool_decide _) |- _ => apply (bool_decide_unpack _) in H - | H : Is_true (_ && _) |- _ => apply andb_True in H; destruct H - (**i simplify and solve equalities *) - | |- _ => progress simplify_eq/= - (**i solve the goal *) - | |- _ => fast_done - (**i operations that generate more subgoals *) - | |- _ ∧ _ => split - | |- Is_true (bool_decide _) => apply (bool_decide_pack _) - | |- Is_true (_ && _) => apply andb_True; split - | H : _ ∨ _ |- _ => - let H1 := fresh in destruct H as [H1|H1]; try clear H - (**i solve the goal using the user supplied tactic *) - | |- _ => solve [tac] - end; - (**i use recursion to enable backtracking on the following clauses. *) - match goal with - (**i instantiation of the conclusion *) - | |- ∃ x, _ => no_new_unsolved_evars ltac:(eexists; go n) - | |- _ ∨ _ => first [left; go n | right; go n] - | _ => - (**i instantiations of assumptions. *) - lazymatch n with - | S ?n' => - (**i we give priority to assumptions that fit on the conclusion. *) - match goal with - | H : _ → _ |- _ => - is_non_dependent H; - no_new_unsolved_evars - ltac:(first [eapply H | efeed pose proof H]; clear H; go n') - end - end - end - in iter (fun n' => go n') (eval compute in (seq 1 6)). -Tactic Notation "naive_solver" := naive_solver eauto. diff --git a/theories/prelude/vector.v b/theories/prelude/vector.v deleted file mode 100644 index 8fe1a843858d78201cbdc68fdb37b8e2ec193bcf..0000000000000000000000000000000000000000 --- a/theories/prelude/vector.v +++ /dev/null @@ -1,357 +0,0 @@ -(* Copyright (c) 2012-2017, Robbert Krebbers. *) -(* This file is distributed under the terms of the BSD license. *) -(** This file collects general purpose definitions and theorems on vectors -(lists of fixed length) and the fin type (bounded naturals). It uses the -definitions from the standard library, but renames or changes their notations, -so that it becomes more consistent with the naming conventions in this -development. *) -From iris.prelude Require Export list. -Set Default Proof Using "Type". -Open Scope vector_scope. - -(** * The fin type *) -(** The type [fin n] represents natural numbers [i] with [0 ≤ i < n]. We -define a scope [fin], in which we declare notations for small literals of the -[fin] type. Whereas the standard library starts counting at [1], we start -counting at [0]. This way, the embedding [fin_to_nat] preserves [0], and allows -us to define [fin_to_nat] as a coercion without introducing notational -ambiguity. *) -Notation fin := Fin.t. -Notation FS := Fin.FS. - -Delimit Scope fin_scope with fin. -Arguments Fin.FS _ _%fin. - -Notation "0" := Fin.F1 : fin_scope. Notation "1" := (FS 0) : fin_scope. -Notation "2" := (FS 1) : fin_scope. Notation "3" := (FS 2) : fin_scope. -Notation "4" := (FS 3) : fin_scope. Notation "5" := (FS 4) : fin_scope. -Notation "6" := (FS 5) : fin_scope. Notation "7" := (FS 6) : fin_scope. -Notation "8" := (FS 7) : fin_scope. Notation "9" := (FS 8) : fin_scope. -Notation "10" := (FS 9) : fin_scope. - -Fixpoint fin_to_nat {n} (i : fin n) : nat := - match i with 0%fin => 0 | FS _ i => S (fin_to_nat i) end. -Coercion fin_to_nat : fin >-> nat. - -Notation fin_of_nat := Fin.of_nat_lt. -Notation fin_rect2 := Fin.rect2. - -Instance fin_dec {n} : EqDecision (fin n). -Proof. - refine (fin_rect2 - (λ n (i j : fin n), { i = j } + { i ≠j }) - (λ _, left _) - (λ _ _, right _) - (λ _ _, right _) - (λ _ _ _ H, cast_if H)); - abstract (f_equal; by auto using Fin.FS_inj). -Defined. - -(** The inversion principle [fin_S_inv] is more convenient than its variant -[Fin.caseS] in the standard library, as we keep the parameter [n] fixed. -In the tactic [inv_fin i] to perform dependent case analysis on [i], we -therefore do not have to generalize over the index [n] and all assumptions -depending on it. Notice that contrary to [dependent destruction], which uses -the [JMeq_eq] axiom, the tactic [inv_fin] produces axiom free proofs.*) -Notation fin_0_inv := Fin.case0. - -Definition fin_S_inv {n} (P : fin (S n) → Type) - (H0 : P 0%fin) (HS : ∀ i, P (FS i)) (i : fin (S n)) : P i. -Proof. - revert P H0 HS. - refine match i with 0%fin => λ _ H0 _, H0 | FS _ i => λ _ _ HS, HS i end. -Defined. - -Ltac inv_fin i := - match type of i with - | fin 0 => - revert dependent i; match goal with |- ∀ i, @?P i => apply (fin_0_inv P) end - | fin (S ?n) => - revert dependent i; match goal with |- ∀ i, @?P i => apply (fin_S_inv P) end - end. - -Instance FS_inj: Inj (=) (=) (@FS n). -Proof. intros n i j. apply Fin.FS_inj. Qed. -Instance fin_to_nat_inj : Inj (=) (=) (@fin_to_nat n). -Proof. - intros n i. induction i; intros j; inv_fin j; intros; f_equal/=; auto with lia. -Qed. - -Lemma fin_to_nat_lt {n} (i : fin n) : fin_to_nat i < n. -Proof. induction i; simpl; lia. Qed. -Lemma fin_to_of_nat n m (H : n < m) : fin_to_nat (fin_of_nat H) = n. -Proof. - revert m H. induction n; intros [|?]; simpl; auto; intros; exfalso; lia. -Qed. -Lemma fin_of_to_nat {n} (i : fin n) H : @fin_of_nat (fin_to_nat i) n H = i. -Proof. apply (inj fin_to_nat), fin_to_of_nat. Qed. - -Fixpoint fin_plus_inv {n1 n2} : ∀ (P : fin (n1 + n2) → Type) - (H1 : ∀ i1 : fin n1, P (Fin.L n2 i1)) - (H2 : ∀ i2, P (Fin.R n1 i2)) (i : fin (n1 + n2)), P i := - match n1 with - | 0 => λ P H1 H2 i, H2 i - | S n => λ P H1 H2, fin_S_inv P (H1 0%fin) (fin_plus_inv _ (λ i, H1 (FS i)) H2) - end. - -Lemma fin_plus_inv_L {n1 n2} (P : fin (n1 + n2) → Type) - (H1: ∀ i1 : fin n1, P (Fin.L _ i1)) (H2: ∀ i2, P (Fin.R _ i2)) (i: fin n1) : - fin_plus_inv P H1 H2 (Fin.L n2 i) = H1 i. -Proof. - revert P H1 H2 i. - induction n1 as [|n1 IH]; intros P H1 H2 i; inv_fin i; simpl; auto. - intros i. apply (IH (λ i, P (FS i))). -Qed. - -Lemma fin_plus_inv_R {n1 n2} (P : fin (n1 + n2) → Type) - (H1: ∀ i1 : fin n1, P (Fin.L _ i1)) (H2: ∀ i2, P (Fin.R _ i2)) (i: fin n2) : - fin_plus_inv P H1 H2 (Fin.R n1 i) = H2 i. -Proof. - revert P H1 H2 i; induction n1 as [|n1 IH]; intros P H1 H2 i; simpl; auto. - apply (IH (λ i, P (FS i))). -Qed. - -(** * Vectors *) -(** The type [vec n] represents lists of consisting of exactly [n] elements. -Whereas the standard library declares exactly the same notations for vectors as -used for lists, we use slightly different notations so it becomes easier to use -lists and vectors together. *) -Notation vec := Vector.t. -Notation vnil := Vector.nil. -Arguments vnil {_}. -Notation vcons := Vector.cons. -Notation vapp := Vector.append. -Arguments vcons {_} _ {_} _. - -Infix ":::" := vcons (at level 60, right associativity) : vector_scope. -Notation "(:::)" := vcons (only parsing) : vector_scope. -Notation "( x :::)" := (vcons x) (only parsing) : vector_scope. -Notation "(::: v )" := (λ x, vcons x v) (only parsing) : vector_scope. -Notation "[# ] " := vnil : vector_scope. -Notation "[# x ] " := (vcons x vnil) : vector_scope. -Notation "[# x ; .. ; y ] " := (vcons x .. (vcons y vnil) ..) : vector_scope. -Infix "+++" := vapp (at level 60, right associativity) : vector_scope. -Notation "(+++)" := vapp (only parsing) : vector_scope. -Notation "( v +++)" := (vapp v) (only parsing) : vector_scope. -Notation "(+++ w )" := (λ v, vapp v w) (only parsing) : vector_scope. - -(** Notice that we cannot define [Vector.nth] as an instance of our [Lookup] -type class, as it has a dependent type. *) -Arguments Vector.nth {_ _} !_ !_%fin /. -Infix "!!!" := Vector.nth (at level 20) : vector_scope. - -(** The tactic [vec_double_ind v1 v2] performs double induction on [v1] and [v2] -provided that they have the same length. *) -Notation vec_rect2 := Vector.rect2. -Ltac vec_double_ind v1 v2 := - match type of v1 with - | vec _ ?n => - repeat match goal with - | H' : context [ n ] |- _ => var_neq v1 H'; var_neq v2 H'; revert H' - end; - revert n v1 v2; - match goal with |- ∀ n v1 v2, @?P n v1 v2 => apply (vec_rect2 P) end - end. - -Notation vcons_inj := VectorSpec.cons_inj. -Lemma vcons_inj_1 {A n} x y (v w : vec A n) : x ::: v = y ::: w → x = y. -Proof. apply vcons_inj. Qed. -Lemma vcons_inj_2 {A n} x y (v w : vec A n) : x ::: v = y ::: w → v = w. -Proof. apply vcons_inj. Qed. - -Lemma vec_eq {A n} (v w : vec A n) : (∀ i, v !!! i = w !!! i) → v = w. -Proof. - vec_double_ind v w; [done|]. intros n v w IH x y Hi. f_equal. - - apply (Hi 0%fin). - - apply IH. intros i. apply (Hi (FS i)). -Qed. - -Instance vec_dec {A} {dec : EqDecision A} {n} : EqDecision (vec A n). -Proof. - refine (vec_rect2 - (λ n (v w : vec A n), { v = w } + { v ≠w }) - (left _) - (λ _ _ _ H x y, cast_if_and (dec x y) H)); - f_equal; eauto using vcons_inj_1, vcons_inj_2. -Defined. - -(** Similar to [fin], we provide an inversion principle that keeps the length -fixed. We define a tactic [inv_vec v] to perform case analysis on [v], using -this inversion principle. *) -Notation vec_0_inv := Vector.case0. -Definition vec_S_inv {A n} (P : vec A (S n) → Type) - (Hcons : ∀ x v, P (x ::: v)) v : P v. -Proof. - revert P Hcons. - refine match v with [#] => tt | x ::: v => λ P Hcons, Hcons x v end. -Defined. - -Ltac inv_vec v := - let T := type of v in - match eval hnf in T with - | vec _ 0 => - revert dependent v; match goal with |- ∀ v, @?P v => apply (vec_0_inv P) end - | vec _ (S ?n) => - revert dependent v; match goal with |- ∀ v, @?P v => apply (vec_S_inv P) end; - try (let x := fresh "x" in intros x v; inv_vec v; revert x) - end. - -(** The following tactic performs case analysis on all hypotheses of the shape -[fin 0], [fin (S n)], [vec A 0] and [vec A (S n)] until no further case -analyses are possible. *) -Ltac inv_all_vec_fin := block_goal; - repeat match goal with - | v : vec _ _ |- _ => inv_vec v; intros - | i : fin _ |- _ => inv_fin i; intros - end; unblock_goal. - -(** We define a coercion from [vec] to [list] and show that it preserves the -operations on vectors. We also define a function to go in the other way, but -do not define it as a coercion, as it would otherwise introduce ambiguity. *) -Fixpoint vec_to_list {A n} (v : vec A n) : list A := - match v with [#] => [] | x ::: v => x :: vec_to_list v end. -Coercion vec_to_list : vec >-> list. -Notation list_to_vec := Vector.of_list. - -Lemma vec_to_list_cons {A n} x (v : vec A n) : - vec_to_list (x ::: v) = x :: vec_to_list v. -Proof. done. Qed. -Lemma vec_to_list_app {A n m} (v : vec A n) (w : vec A m) : - vec_to_list (v +++ w) = vec_to_list v ++ vec_to_list w. -Proof. by induction v; f_equal/=. Qed. -Lemma vec_to_list_of_list {A} (l : list A): vec_to_list (list_to_vec l) = l. -Proof. by induction l; f_equal/=. Qed. -Lemma vec_to_list_length {A n} (v : vec A n) : length (vec_to_list v) = n. -Proof. induction v; simpl; by f_equal. Qed. -Lemma vec_to_list_same_length {A B n} (v : vec A n) (w : vec B n) : - length v = length w. -Proof. by rewrite !vec_to_list_length. Qed. -Lemma vec_to_list_inj1 {A n m} (v : vec A n) (w : vec A m) : - vec_to_list v = vec_to_list w → n = m. -Proof. - revert m w. induction v; intros ? [|???] ?; - simplify_eq/=; f_equal; eauto. -Qed. -Lemma vec_to_list_inj2 {A n} (v : vec A n) (w : vec A n) : - vec_to_list v = vec_to_list w → v = w. -Proof. - revert w. induction v; intros w; inv_vec w; intros; - simplify_eq/=; f_equal; eauto. -Qed. -Lemma vlookup_middle {A n m} (v : vec A n) (w : vec A m) x : - ∃ i : fin (n + S m), x = (v +++ x ::: w) !!! i. -Proof. - induction v; simpl; [by eexists 0%fin|]. - destruct IHv as [i ?]. by exists (FS i). -Qed. -Lemma vec_to_list_lookup_middle {A n} (v : vec A n) (l k : list A) x : - vec_to_list v = l ++ x :: k → - ∃ i : fin n, l = take i v ∧ x = v !!! i ∧ k = drop (S i) v. -Proof. - intros H. - rewrite <-(vec_to_list_of_list l), <-(vec_to_list_of_list k) in H. - rewrite <-vec_to_list_cons, <-vec_to_list_app in H. - pose proof (vec_to_list_inj1 _ _ H); subst. - apply vec_to_list_inj2 in H; subst. induction l. simpl. - - eexists 0%fin. simpl. by rewrite vec_to_list_of_list. - - destruct IHl as [i ?]. exists (FS i). simpl. intuition congruence. -Qed. -Lemma vec_to_list_drop_lookup {A n} (v : vec A n) (i : fin n) : - drop i v = v !!! i :: drop (S i) v. -Proof. induction i; inv_vec v; simpl; intros; [done | by rewrite IHi]. Qed. -Lemma vec_to_list_take_drop_lookup {A n} (v : vec A n) (i : fin n) : - vec_to_list v = take i v ++ v !!! i :: drop (S i) v. -Proof. rewrite <-(take_drop i v) at 1. by rewrite vec_to_list_drop_lookup. Qed. - -Lemma vlookup_lookup {A n} (v : vec A n) (i : fin n) x : - v !!! i = x ↔ (v : list A) !! (i : nat) = Some x. -Proof. - induction v as [|? ? v IH]; inv_fin i. simpl; split; congruence. done. -Qed. -Lemma vlookup_lookup' {A n} (v : vec A n) (i : nat) x : - (∃ H : i < n, v !!! (fin_of_nat H) = x) ↔ (v : list A) !! i = Some x. -Proof. - split. - - intros [Hlt ?]. rewrite <-(fin_to_of_nat i n Hlt). by apply vlookup_lookup. - - intros Hvix. assert (Hlt:=lookup_lt_Some _ _ _ Hvix). - rewrite vec_to_list_length in Hlt. exists Hlt. - apply vlookup_lookup. by rewrite fin_to_of_nat. -Qed. -Lemma elem_of_vlookup {A n} (v : vec A n) x : - x ∈ vec_to_list v ↔ ∃ i, v !!! i = x. -Proof. - rewrite elem_of_list_lookup. setoid_rewrite <-vlookup_lookup'. - split; [by intros (?&?&?); eauto|]. intros [i Hx]. - exists i, (fin_to_nat_lt _). by rewrite fin_of_to_nat. -Qed. - -Lemma Forall_vlookup {A} (P : A → Prop) {n} (v : vec A n) : - Forall P (vec_to_list v) ↔ ∀ i, P (v !!! i). -Proof. rewrite Forall_forall. setoid_rewrite elem_of_vlookup. naive_solver. Qed. -Lemma Forall_vlookup_1 {A} (P : A → Prop) {n} (v : vec A n) i : - Forall P (vec_to_list v) → P (v !!! i). -Proof. by rewrite Forall_vlookup. Qed. -Lemma Forall_vlookup_2 {A} (P : A → Prop) {n} (v : vec A n) : - (∀ i, P (v !!! i)) → Forall P (vec_to_list v). -Proof. by rewrite Forall_vlookup. Qed. -Lemma Exists_vlookup {A} (P : A → Prop) {n} (v : vec A n) : - Exists P (vec_to_list v) ↔ ∃ i, P (v !!! i). -Proof. rewrite Exists_exists. setoid_rewrite elem_of_vlookup. naive_solver. Qed. -Lemma Forall2_vlookup {A B} (P : A → B → Prop) {n} - (v1 : vec A n) (v2 : vec B n) : - Forall2 P (vec_to_list v1) (vec_to_list v2) ↔ ∀ i, P (v1 !!! i) (v2 !!! i). -Proof. - split. - - vec_double_ind v1 v2; [intros _ i; inv_fin i |]. - intros n v1 v2 IH a b; simpl. inversion_clear 1. - intros i. inv_fin i; simpl; auto. - - vec_double_ind v1 v2; [constructor|]. - intros ??? IH ?? H. constructor. apply (H 0%fin). apply IH, (λ i, H (FS i)). -Qed. - -(** The function [vmap f v] applies a function [f] element wise to [v]. *) -Notation vmap := Vector.map. - -Lemma vlookup_map `(f : A → B) {n} (v : vec A n) i : - vmap f v !!! i = f (v !!! i). -Proof. by apply Vector.nth_map. Qed. -Lemma vec_to_list_map `(f : A → B) {n} (v : vec A n) : - vec_to_list (vmap f v) = f <$> vec_to_list v. -Proof. induction v; simpl. done. by rewrite IHv. Qed. - -(** The function [vzip_with f v w] combines the vectors [v] and [w] element -wise using the function [f]. *) -Notation vzip_with := Vector.map2. - -Lemma vlookup_zip_with `(f : A → B → C) {n} (v1 : vec A n) (v2 : vec B n) i : - vzip_with f v1 v2 !!! i = f (v1 !!! i) (v2 !!! i). -Proof. by apply Vector.nth_map2. Qed. -Lemma vec_to_list_zip_with `(f : A → B → C) {n} (v1 : vec A n) (v2 : vec B n) : - vec_to_list (vzip_with f v1 v2) = - zip_with f (vec_to_list v1) (vec_to_list v2). -Proof. - revert v2. induction v1; intros v2; inv_vec v2; intros; simpl; [done|]. - by rewrite IHv1. -Qed. - -(** Similar to vlookup, we cannot define [vinsert] as an instance of the -[Insert] type class, as it has a dependent type. *) -Fixpoint vinsert {A n} (i : fin n) (x : A) : vec A n → vec A n := - match i with - | 0%fin => vec_S_inv _ (λ _ v, x ::: v) - | FS _ i => vec_S_inv _ (λ y v, y ::: vinsert i x v) - end. - -Lemma vec_to_list_insert {A n} i x (v : vec A n) : - vec_to_list (vinsert i x v) = insert (fin_to_nat i) x (vec_to_list v). -Proof. induction v; inv_fin i. done. simpl. intros. by rewrite IHv. Qed. -Lemma vlookup_insert {A n} i x (v : vec A n) : vinsert i x v !!! i = x. -Proof. by induction i; inv_vec v. Qed. -Lemma vlookup_insert_ne {A n} i j x (v : vec A n) : - i ≠j → vinsert i x v !!! j = v !!! j. -Proof. - induction i; inv_fin j; inv_vec v; simpl; try done. - intros. apply IHi. congruence. -Qed. -Lemma vlookup_insert_self {A n} i (v : vec A n) : vinsert i (v !!! i) v = v. -Proof. by induction v; inv_fin i; intros; f_equal/=. Qed. diff --git a/theories/prelude/zmap.v b/theories/prelude/zmap.v deleted file mode 100644 index fffde67cc515ccc6dc635f68e39ced1b3814d4e5..0000000000000000000000000000000000000000 --- a/theories/prelude/zmap.v +++ /dev/null @@ -1,97 +0,0 @@ -(* Copyright (c) 2012-2017, Robbert Krebbers. *) -(* This file is distributed under the terms of the BSD license. *) -(** This files extends the implementation of finite over [positive] to finite -maps whose keys range over Coq's data type of binary naturals [Z]. *) -From iris.prelude Require Import pmap mapset. -From iris.prelude Require Export prelude fin_maps. -Set Default Proof Using "Type". -Local Open Scope Z_scope. - -Record Zmap (A : Type) : Type := - ZMap { Zmap_0 : option A; Zmap_pos : Pmap A; Zmap_neg : Pmap A }. -Arguments Zmap_0 {_} _. -Arguments Zmap_pos {_} _. -Arguments Zmap_neg {_} _. -Arguments ZMap {_} _ _ _. - -Instance Zmap_eq_dec `{EqDecision A} : EqDecision (Zmap A). -Proof. - refine (λ t1 t2, - match t1, t2 with - | ZMap x t1 t1', ZMap y t2 t2' => - cast_if_and3 (decide (x = y)) (decide (t1 = t2)) (decide (t1' = t2')) - end); abstract congruence. -Defined. -Instance Zempty {A} : Empty (Zmap A) := ZMap None ∅ ∅. -Instance Zlookup {A} : Lookup Z A (Zmap A) := λ i t, - match i with - | Z0 => Zmap_0 t | Zpos p => Zmap_pos t !! p | Zneg p => Zmap_neg t !! p - end. -Instance Zpartial_alter {A} : PartialAlter Z A (Zmap A) := λ f i t, - match i, t with - | Z0, ZMap o t t' => ZMap (f o) t t' - | Zpos p, ZMap o t t' => ZMap o (partial_alter f p t) t' - | Zneg p, ZMap o t t' => ZMap o t (partial_alter f p t') - end. -Instance Zto_list {A} : FinMapToList Z A (Zmap A) := λ t, - match t with - | ZMap o t t' => default [] o (λ x, [(0,x)]) ++ - (prod_map Zpos id <$> map_to_list t) ++ - (prod_map Zneg id <$> map_to_list t') - end. -Instance Zomap: OMap Zmap := λ A B f t, - match t with ZMap o t t' => ZMap (o ≫= f) (omap f t) (omap f t') end. -Instance Zmerge: Merge Zmap := λ A B C f t1 t2, - match t1, t2 with - | ZMap o1 t1 t1', ZMap o2 t2 t2' => - ZMap (f o1 o2) (merge f t1 t2) (merge f t1' t2') - end. -Instance Nfmap: FMap Zmap := λ A B f t, - match t with ZMap o t t' => ZMap (f <$> o) (f <$> t) (f <$> t') end. - -Instance: FinMap Z Zmap. -Proof. - split. - - intros ? [??] [??] H. f_equal. - + apply (H 0). - + apply map_eq. intros i. apply (H (Zpos i)). - + apply map_eq. intros i. apply (H (Zneg i)). - - by intros ? []. - - intros ? f [] [|?|?]; simpl; [done| |]; apply lookup_partial_alter. - - intros ? f [] [|?|?] [|?|?]; simpl; intuition congruence || - intros; apply lookup_partial_alter_ne; congruence. - - intros ??? [??] []; simpl; [done| |]; apply lookup_fmap. - - intros ? [o t t']; unfold map_to_list; simpl. - assert (NoDup ((prod_map Z.pos id <$> map_to_list t) ++ - prod_map Z.neg id <$> map_to_list t')). - { apply NoDup_app; split_and?. - - apply (NoDup_fmap_2 _), NoDup_map_to_list. - - intro. rewrite !elem_of_list_fmap. naive_solver. - - apply (NoDup_fmap_2 _), NoDup_map_to_list. } - destruct o; simpl; auto. constructor; auto. - rewrite elem_of_app, !elem_of_list_fmap. naive_solver. - - intros ? t i x. unfold map_to_list. split. - + destruct t as [[y|] t t']; simpl. - * rewrite elem_of_cons, elem_of_app, !elem_of_list_fmap. - intros [?|[[[??][??]]|[[??][??]]]]; simplify_eq/=; [done| |]; - by apply elem_of_map_to_list. - * rewrite elem_of_app, !elem_of_list_fmap. intros [[[??][??]]|[[??][??]]]; - simplify_eq/=; by apply elem_of_map_to_list. - + destruct t as [[y|] t t']; simpl. - * rewrite elem_of_cons, elem_of_app, !elem_of_list_fmap. - destruct i as [|i|i]; simpl; [intuition congruence| |]. - { right; left. exists (i, x). by rewrite elem_of_map_to_list. } - right; right. exists (i, x). by rewrite elem_of_map_to_list. - * rewrite elem_of_app, !elem_of_list_fmap. - destruct i as [|i|i]; simpl; [done| |]. - { left; exists (i, x). by rewrite elem_of_map_to_list. } - right; exists (i, x). by rewrite elem_of_map_to_list. - - intros ?? f [??] [|?|?]; simpl; [done| |]; apply (lookup_omap f). - - intros ??? f ? [??] [??] [|?|?]; simpl; [done| |]; apply (lookup_merge f). -Qed. - -(** * Finite sets *) -(** We construct sets of [Z]s satisfying extensional equality. *) -Notation Zset := (mapset Zmap). -Instance Zmap_dom {A} : Dom (Zmap A) Zset := mapset_dom. -Instance: FinMapDom Z Zmap Zset := mapset_dom_spec. diff --git a/theories/proofmode/class_instances.v b/theories/proofmode/class_instances.v index 89c70fa3a684f0a2bb35a6d8d03672f66003b3d6..3e985fc46c3c3ebde5a9993b0e70cb6fab5cce10 100644 --- a/theories/proofmode/class_instances.v +++ b/theories/proofmode/class_instances.v @@ -1,6 +1,6 @@ From iris.proofmode Require Export classes. From iris.algebra Require Import gmap. -From iris.prelude Require Import gmultiset. +From stdpp Require Import gmultiset. From iris.base_logic Require Import big_op. Set Default Proof Using "Type". Import uPred. diff --git a/theories/proofmode/coq_tactics.v b/theories/proofmode/coq_tactics.v index 724615853105ceaa7d586461ba0af5e909ac3494..7137e4ec08b65311ee9083bea9187c1c1b7deb1e 100644 --- a/theories/proofmode/coq_tactics.v +++ b/theories/proofmode/coq_tactics.v @@ -1,7 +1,7 @@ From iris.base_logic Require Export base_logic. From iris.base_logic Require Import big_op tactics. From iris.proofmode Require Export environments classes. -From iris.prelude Require Import stringmap hlist. +From stdpp Require Import stringmap hlist. Set Default Proof Using "Type". Import uPred. Import env_notations. diff --git a/theories/proofmode/environments.v b/theories/proofmode/environments.v index 3b2df1ec32b15b6b35c895fdc42f189bb92b0a83..8ed1a9bf68c27eff6218e374fdc5d9392c461a8a 100644 --- a/theories/proofmode/environments.v +++ b/theories/proofmode/environments.v @@ -1,7 +1,7 @@ -From iris.prelude Require Export strings. +From stdpp Require Export strings. From iris.proofmode Require Import strings. From iris.algebra Require Export base. -From iris.prelude Require Import stringmap. +From stdpp Require Import stringmap. Set Default Proof Using "Type". Inductive env (A : Type) : Type := diff --git a/theories/proofmode/intro_patterns.v b/theories/proofmode/intro_patterns.v index 99627a6f940357ae9886fcb485e8808f1fa5c9c3..c1cc121e820ccdfd68ad3b571b9a32d36d9982eb 100644 --- a/theories/proofmode/intro_patterns.v +++ b/theories/proofmode/intro_patterns.v @@ -1,4 +1,4 @@ -From iris.prelude Require Export strings. +From stdpp Require Export strings. Set Default Proof Using "Type". Inductive intro_pat := diff --git a/theories/proofmode/notation.v b/theories/proofmode/notation.v index ae93137134872f3e7fffd8278f78d655c89b88d4..ab6893379e1966040d2e98758527bf3f124dfd86 100644 --- a/theories/proofmode/notation.v +++ b/theories/proofmode/notation.v @@ -1,5 +1,5 @@ From iris.proofmode Require Import coq_tactics environments. -From iris.prelude Require Export strings. +From stdpp Require Export strings. Set Default Proof Using "Type". Delimit Scope proof_scope with env. diff --git a/theories/proofmode/sel_patterns.v b/theories/proofmode/sel_patterns.v index d520504b6f52bb2436f86934769e07e4738fd589..b019b2c53c5cbefaca75b16255500894c7758cba 100644 --- a/theories/proofmode/sel_patterns.v +++ b/theories/proofmode/sel_patterns.v @@ -1,4 +1,4 @@ -From iris.prelude Require Export strings. +From stdpp Require Export strings. Set Default Proof Using "Type". Inductive sel_pat := diff --git a/theories/proofmode/spec_patterns.v b/theories/proofmode/spec_patterns.v index 8c1d836d3d1d6892734aea8eba1b70faae9b057c..a33322ee4f02cdb52c054810959a026d71f469aa 100644 --- a/theories/proofmode/spec_patterns.v +++ b/theories/proofmode/spec_patterns.v @@ -1,4 +1,4 @@ -From iris.prelude Require Export strings. +From stdpp Require Export strings. Set Default Proof Using "Type". Record spec_goal := SpecGoal { diff --git a/theories/proofmode/strings.v b/theories/proofmode/strings.v index b3d547d0dde401ea4125ae4de923ad0c64fa53c8..bde47e5bfc932adce078ccbc0c4bbaf03cde8b4e 100644 --- a/theories/proofmode/strings.v +++ b/theories/proofmode/strings.v @@ -1,4 +1,4 @@ -From iris.prelude Require Import strings. +From stdpp Require Import strings. From iris.algebra Require Import base. From Coq Require Import Ascii. Set Default Proof Using "Type". diff --git a/theories/proofmode/tactics.v b/theories/proofmode/tactics.v index aec6cbf8dbe22b79aa5996986c0975c60f417e6c..0d99ef960f2a98643342024006ffebe8a81df446 100644 --- a/theories/proofmode/tactics.v +++ b/theories/proofmode/tactics.v @@ -3,7 +3,7 @@ From iris.proofmode Require Import intro_patterns spec_patterns sel_patterns. From iris.base_logic Require Export base_logic. From iris.proofmode Require Export classes notation. From iris.proofmode Require Import class_instances. -From iris.prelude Require Import stringmap hlist. +From stdpp Require Import stringmap hlist. From iris.proofmode Require Import strings. Set Default Proof Using "Type".