Skip to content
Snippets Groups Projects

Compare revisions

Changes are shown as if the source revision was being merged into the target revision. Learn more about comparing revisions.

Source

Select target project
No results found

Target

Select target project
  • iris/stdpp
  • johannes/stdpp
  • proux1/stdpp
  • dosualdo/stdpp
  • benoit/coq-stdpp
  • dfrumin/coq-stdpp
  • haidang/stdpp
  • amintimany/coq-stdpp
  • swasey/coq-stdpp
  • simongregersen/stdpp
  • proux/stdpp
  • janno/coq-stdpp
  • amaurremi/coq-stdpp
  • msammler/stdpp
  • tchajed/stdpp
  • YaZko/stdpp
  • maximedenes/stdpp
  • jakobbotsch/stdpp
  • Blaisorblade/stdpp
  • simonspies/stdpp
  • lepigre/stdpp
  • devilhena/stdpp
  • simonfv/stdpp
  • jihgfee/stdpp
  • snyke7/stdpp
  • Armael/stdpp
  • gmalecha/stdpp
  • olaure01/stdpp
  • sarahzrf/stdpp
  • atrieu/stdpp
  • herbelin/stdpp
  • arthuraa/stdpp
  • lgaeher/stdpp
  • mrhaandi/stdpp
  • mattam82/stdpp
  • Quarkbeast/stdpp
  • aa755/stdpp
  • gmevel/stdpp
  • lstefane/stdpp
  • jung/stdpp
  • vsiles/stdpp
  • dlesbre/stdpp
  • bergwerf/stdpp
  • marijnvanwezel/stdpp
  • ivanbakel/stdpp
  • tperami/stdpp
  • adamAndMath/stdpp
  • Villetaneuse/stdpp
  • sanjit/stdpp
  • yiyunliu/stdpp
  • thomas-lamiaux/stdpp
  • Tragicus/stdpp
  • kbedarka/stdpp
53 results
Show changes
Hide whitespace changes
Inline Side-by-side
Showing
with 4790 additions and 263 deletions
theories/list.v → stdpp/list_relations.v
View file @ 9274984b
(** This file collects general purpose definitions and theorems on lists that
are not in the Coq standard library. *)
From Coq Require Export Permutation. From Coq Require Export Permutation.
From stdpp Require Export numbers base option. From stdpp Require Export numbers base option list_basics.
From stdpp Require Import options. From stdpp Require Import options.
(** FIXME: Workaround for https://github.com/coq/coq/issues/14571 *) Global Instance: Params (@Forall) 1 := {}.
(** Remove the instances [Permutation_cons] and [Permutation_app'] since their Global Instance: Params (@Exists) 1 := {}.
priorities are 10, which is above the priority 5 of [proper_relation], and add Global Instance: Params (@NoDup) 1 := {}.
them back with the right priority (default = 0, since these instances have no
premises). *)
Global Remove Hints Permutation_cons Permutation_app' : typeclass_instances.
Global Existing Instances Permutation_cons Permutation_app'.
(* Pick up extra assumptions from section parameters. *)
Set Default Proof Using "Type*".
Global Arguments length {_} _ : assert.
Global Arguments cons {_} _ _ : assert.
Global Arguments app {_} _ _ : assert.
Global Instance: Params (@length) 1 := {}.
Global Instance: Params (@cons) 1 := {}.
Global Instance: Params (@app) 1 := {}.
(** [head] and [tail] are defined as [parsing only] for [hd_error] and [tl] in
the Coq standard library. We redefine these notations to make sure they also
pretty print properly. *)
Notation head := hd_error.
Notation tail := tl.
Notation take := firstn.
Notation drop := skipn.
Global Arguments head {_} _ : assert.
Global Arguments tail {_} _ : assert.
Global Arguments take {_} !_ !_ / : assert.
Global Arguments drop {_} !_ !_ / : assert.
Global Instance: Params (@head) 1 := {}.
Global Instance: Params (@tail) 1 := {}.
Global Instance: Params (@take) 1 := {}.
Global Instance: Params (@drop) 1 := {}.
Global Arguments Permutation {_} _ _ : assert. Global Arguments Permutation {_} _ _ : assert.
Global Arguments Forall_cons {_} _ _ _ _ _ : assert. Global Arguments Forall_cons {_} _ _ _ _ _ : assert.
Notation "(::)" := cons (only parsing) : list_scope.
Notation "( x ::.)" := (cons x) (only parsing) : list_scope.
Notation "(.:: l )" := (λ x, cons x l) (only parsing) : list_scope.
Notation "(++)" := app (only parsing) : list_scope.
Notation "( l ++.)" := (app l) (only parsing) : list_scope.
Notation "(.++ k )" := (λ l, app l k) (only parsing) : list_scope.
Infix "≡ₚ" := Permutation (at level 70, no associativity) : stdpp_scope. Infix "≡ₚ" := Permutation (at level 70, no associativity) : stdpp_scope.
Notation "(≡ₚ)" := Permutation (only parsing) : stdpp_scope. Notation "(≡ₚ)" := Permutation (only parsing) : stdpp_scope.
Notation "( x ≡ₚ.)" := (Permutation x) (only parsing) : stdpp_scope. Notation "( x ≡ₚ.)" := (Permutation x) (only parsing) : stdpp_scope.
...@@ -66,220 +22,12 @@ Infix "≡ₚ@{ A }" := ...@@ -66,220 +22,12 @@ Infix "≡ₚ@{ A }" :=
(@Permutation A) (at level 70, no associativity, only parsing) : stdpp_scope. (@Permutation A) (at level 70, no associativity, only parsing) : stdpp_scope.
Notation "(≡ₚ@{ A } )" := (@Permutation A) (only parsing) : stdpp_scope. Notation "(≡ₚ@{ A } )" := (@Permutation A) (only parsing) : stdpp_scope.
Global Instance maybe_cons {A} : Maybe2 (@cons A) := λ l,
match l with x :: l => Some (x,l) | _ => None end.
(** * Definitions *)
(** Setoid equality lifted to lists *) (** Setoid equality lifted to lists *)
Inductive list_equiv `{Equiv A} : Equiv (list A) := Inductive list_equiv `{Equiv A} : Equiv (list A) :=
| nil_equiv : [] ≡ [] | nil_equiv : [] ≡ []
| cons_equiv x y l k : x ≡ y → l ≡ k → x :: l ≡ y :: k. | cons_equiv x y l k : x ≡ y → l ≡ k → x :: l ≡ y :: k.
Global Existing Instance list_equiv. Global 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. *)
Global 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 [l !!! i] is a total version of the lookup operation
[l !! i]. *)
Global Instance list_lookup_total `{!Inhabited A} : LookupTotal nat A (list A) :=
fix go i l {struct l} : A := let _ : LookupTotal _ _ _ := @go in
match l with
| [] => inhabitant
| x :: l => match i with 0 => 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. *)
Global 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. *)
Global 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.
Global 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. *)
Global 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]) [].
Global Instance: Params (@option_list) 1 := {}.
Global 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. *)
Global 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.
Global 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.
Global Instance: Params (@replicate) 2 := {}.
(** The function [rotate n l] rotates the list [l] by [n], e.g., [rotate 1
[x0; x1; ...; xm]] becomes [x1; ...; xm; x0]. Rotating by a multiple of
[length l] is the identity function. **)
Definition rotate {A} (n : nat) (l : list A) : list A :=
drop (n `mod` length l) l ++ take (n `mod` length l) l.
Global Instance: Params (@rotate) 2 := {}.
(** The function [rotate_take s e l] returns the range between the
indices [s] (inclusive) and [e] (exclusive) of [l]. If [e ≤ s], all
elements after [s] and before [e] are returned. *)
Definition rotate_take {A} (s e : nat) (l : list A) : list A :=
take (rotate_nat_sub s e (length l)) (rotate s l).
Global Instance: Params (@rotate_take) 3 := {}.
(** The function [reverse l] returns the elements of [l] in reverse order. *)
Definition reverse {A} (l : list A) : list A := rev_append l [].
Global 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.
Global Instance: Params (@last) 1 := {}.
Global Arguments last : simpl nomatch.
(** 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.
Global Arguments resize {_} !_ _ !_ : assert.
Global 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.
Global 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. *)
Global Instance list_ret: MRet list := λ A x, x :: @nil A.
Global Instance list_fmap : FMap list := λ A B f,
fix go (l : list A) := match l with [] => [] | x :: l => f x :: go l end.
Global 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.
Global Instance list_bind : MBind list := λ A B f,
fix go (l : list A) := match l with [] => [] | x :: l => f x ++ go l end.
Global 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 the map function that allow the mapped
function to use the index of the elements. *)
Fixpoint imap {A B} (f : nat → A → B) (l : list A) : list B :=
match l with
| [] => []
| x :: l => f 0 x :: imap (f ∘ S) l
end.
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.
Fixpoint imap2 {A B C} (f : nat → A → B → C) (l : list A) (k : list B) : list C :=
match l, k with
| [], _ | _, [] => []
| x :: l, y :: k => f 0 x y :: imap2 (f ∘ S) l k
end.
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).
Global Arguments zipped_Forall_nil {_ _} _ : assert.
Global Arguments zipped_Forall_cons {_ _} _ _ _ _ _ : assert.
(** 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 [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. *) 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 suffix {A} : relation (list A) := λ l1 l2, ∃ k, l2 = k ++ l1.
...@@ -289,25 +37,9 @@ Infix "`prefix_of`" := prefix (at level 70) : stdpp_scope. ...@@ -289,25 +37,9 @@ Infix "`prefix_of`" := prefix (at level 70) : stdpp_scope.
Global Hint Extern 0 (_ `prefix_of` _) => reflexivity : core. Global Hint Extern 0 (_ `prefix_of` _) => reflexivity : core.
Global Hint Extern 0 (_ `suffix_of` _) => reflexivity : core. Global Hint Extern 0 (_ `suffix_of` _) => reflexivity : core.
Section prefix_suffix_ops. (** A list is a "subset" of another if each element of the first also appears
Context `{EqDecision A}. somewhere in the second. *)
Global Instance list_subseteq {A} : SubsetEq (list A) := λ l1 l2, ∀ x, x ∈ l1 → x ∈ l2.
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 (** A list [l1] is a sublist of [l2] if [l2] is obtained by removing elements
from [l1] without changing the order. *) from [l1] without changing the order. *)
...@@ -319,7 +51,7 @@ Infix "`sublist_of`" := sublist (at level 70) : stdpp_scope. ...@@ -319,7 +51,7 @@ Infix "`sublist_of`" := sublist (at level 70) : stdpp_scope.
Global Hint Extern 0 (_ `sublist_of` _) => reflexivity : core. Global Hint Extern 0 (_ `sublist_of` _) => reflexivity : core.
(** A list [l2] submseteq a list [l1] if [l2] is obtained by removing elements (** A list [l2] submseteq a list [l1] if [l2] is obtained by removing elements
from [l1] while possiblity changing the order. *) from [l1] while possibly changing the order. *)
Inductive submseteq {A} : relation (list A) := Inductive submseteq {A} : relation (list A) :=
| submseteq_nil : submseteq [] [] | submseteq_nil : submseteq [] []
| submseteq_skip x l1 l2 : submseteq l1 l2 → submseteq (x :: l1) (x :: l2) | submseteq_skip x l1 l2 : submseteq l1 l2 → submseteq (x :: l1) (x :: l2)
...@@ -329,20 +61,25 @@ Inductive submseteq {A} : relation (list A) := ...@@ -329,20 +61,25 @@ Inductive submseteq {A} : relation (list A) :=
Infix "⊆+" := submseteq (at level 70) : stdpp_scope. Infix "⊆+" := submseteq (at level 70) : stdpp_scope.
Global Hint Extern 0 (_ ⊆+ _) => reflexivity : core. Global Hint Extern 0 (_ ⊆+ _) => reflexivity : core.
(** Removes [x] from the list [l]. The function returns a [Some] when the Section prefix_suffix_ops.
+removal succeeds and [None] when [x] is not in [l]. *) Context `{EqDecision A}.
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 Definition max_prefix : list A → list A → list A * list A * list A :=
a [Some] when the removal succeeds and [None] some element of [k] is not in [l]. *) fix go l1 l2 :=
Fixpoint list_remove_list `{EqDecision A} (k : list A) (l : list A) : option (list A) := match l1, l2 with
match k with | [], l2 => ([], l2, [])
| [] => Some l | x :: k => list_remove x l ≫= list_remove_list k | l1, [] => (l1, [], [])
end. | 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.
Inductive Forall3 {A B C} (P : A → B → C → Prop) : Inductive Forall3 {A B C} (P : A → B → C → Prop) :
list A → list B → list C → Prop := list A → list B → list C → Prop :=
...@@ -350,600 +87,16 @@ Inductive Forall3 {A B C} (P : A → B → C → Prop) : ...@@ -350,600 +87,16 @@ Inductive Forall3 {A B C} (P : A → B → C → Prop) :
| Forall3_cons x y z l k k' : | 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'). P x y z → Forall3 P l k k' → Forall3 P (x :: l) (y :: k) (z :: k').
(** Set operations on lists *)
Global 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 : RelDecision (∈@{list A}).
Proof.
refine (
fix go x l :=
match l return Decision (x ∈ l) with
| [] => right _
| y :: l => cast_if_or (decide (x = y)) (go x 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.
(** These next functions allow to efficiently encode lists of positives (bit
strings) into a single positive and go in the other direction as well. This is
for example used for the countable instance of lists and in namespaces.
The main functions are [positives_flatten] and [positives_unflatten]. *)
Fixpoint positives_flatten_go (xs : list positive) (acc : positive) : positive :=
match xs with
| [] => acc
| x :: xs => positives_flatten_go xs (acc~1~0 ++ Preverse (Pdup x))
end.
(** Flatten a list of positives into a single positive by duplicating the bits
of each element, so that:
- [0 -> 00]
- [1 -> 11]
and then separating each element with [10]. *)
Definition positives_flatten (xs : list positive) : positive :=
positives_flatten_go xs 1.
Fixpoint positives_unflatten_go
(p : positive)
(acc_xs : list positive)
(acc_elm : positive)
: option (list positive) :=
match p with
| 1 => Some acc_xs
| p'~0~0 => positives_unflatten_go p' acc_xs (acc_elm~0)
| p'~1~1 => positives_unflatten_go p' acc_xs (acc_elm~1)
| p'~1~0 => positives_unflatten_go p' (acc_elm :: acc_xs) 1
| _ => None
end%positive.
(** Unflatten a positive into a list of positives, assuming the encoding
used by [positives_flatten]. *)
Definition positives_unflatten (p : positive) : option (list positive) :=
positives_unflatten_go p [] 1.
(** * 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 : _ =@{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. Section general_properties.
Context {A : Type}. Context {A : Type}.
Implicit Types x y z : A. Implicit Types x y z : A.
Implicit Types l k : list 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_cons_ne_0 l x i : i ≠ 0 → (x :: l) !! i = l !! pred i.
Proof. by destruct i. Qed.
Lemma lookup_total_cons_ne_0 `{!Inhabited A} l x i :
i ≠ 0 → (x :: l) !!! i = l !!! pred i.
Proof. by destruct i. Qed.
Lemma lookup_nil i : @nil A !! i = None.
Proof. by destruct i. Qed.
Lemma lookup_total_nil `{!Inhabited A} i : @nil A !!! i = inhabitant.
Proof. by destruct i. Qed.
Lemma lookup_tail l i : tail l !! i = l !! S i.
Proof. by destruct l. Qed.
Lemma lookup_total_tail `{!Inhabited A} 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 nth_lookup l i d : nth i l d = default 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_lookup_total_alt `{!Inhabited A} l i :
l !!! i = default inhabitant (l !! i).
Proof. revert i. induction l; intros []; naive_solver. Qed.
Lemma list_lookup_total_correct `{!Inhabited A} l i x :
l !! i = Some x → l !!! i = x.
Proof. rewrite list_lookup_total_alt. by intros ->. Qed.
Lemma list_lookup_lookup_total `{!Inhabited A} l i :
is_Some (l !! i) → l !! i = Some (l !!! i).
Proof. rewrite list_lookup_total_alt; by intros [x ->]. Qed.
Lemma list_lookup_lookup_total_lt `{!Inhabited A} l i :
i < length l → l !! i = Some (l !!! i).
Proof. intros ?. by apply list_lookup_lookup_total, lookup_lt_is_Some_2. Qed.
Lemma list_lookup_alt `{!Inhabited A} l i x :
l !! i = Some x ↔ i < length l ∧ l !!! i = x.
Proof.
naive_solver eauto using list_lookup_lookup_total_lt,
list_lookup_total_correct, lookup_lt_Some.
Qed.
Lemma lookup_app l1 l2 i :
(l1 ++ l2) !! i =
match l1 !! i with Some x => Some x | None => l2 !! (i - length l1) end.
Proof. revert i. induction l1 as [|x l1 IH]; intros [|i]; naive_solver. Qed.
Lemma lookup_app_l l1 l2 i : i < length l1 → (l1 ++ l2) !! i = l1 !! i.
Proof. rewrite lookup_app. by intros [? ->]%lookup_lt_is_Some. Qed.
Lemma lookup_total_app_l `{!Inhabited A} l1 l2 i :
i < length l1 → (l1 ++ l2) !!! i = l1 !!! i.
Proof. intros. by rewrite !list_lookup_total_alt, lookup_app_l. Qed.
Lemma lookup_app_l_Some l1 l2 i x : l1 !! i = Some x → (l1 ++ l2) !! i = Some x.
Proof. rewrite lookup_app. by intros ->. Qed.
Lemma lookup_app_r l1 l2 i :
length l1 ≤ i → (l1 ++ l2) !! i = l2 !! (i - length l1).
Proof. rewrite lookup_app. by intros ->%lookup_ge_None. Qed.
Lemma lookup_total_app_r `{!Inhabited A} l1 l2 i :
length l1 ≤ i → (l1 ++ l2) !!! i = l2 !!! (i - length l1).
Proof. intros. by rewrite !list_lookup_total_alt, lookup_app_r. 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.
rewrite lookup_app. destruct (l1 !! i) eqn:Hi.
- apply lookup_lt_Some in Hi. naive_solver lia.
- apply lookup_ge_None in Hi. naive_solver lia.
Qed.
Lemma lookup_cons x l i :
(x :: l) !! i =
match i with 0 => Some x | S i => l !! i end.
Proof. reflexivity. Qed.
Lemma lookup_cons_Some x l i y :
(x :: l) !! i = Some y ↔
(i = 0 ∧ x = y) ∨ (1 ≤ i ∧ l !! (i - 1) = Some y).
Proof.
rewrite lookup_cons. destruct i as [|i].
- naive_solver lia.
- replace (S i - 1) with i by lia. naive_solver lia.
Qed.
Lemma list_lookup_singleton x i :
[x] !! i =
match i with 0 => Some x | S _ => None end.
Proof. reflexivity. Qed.
Lemma list_lookup_singleton_Some x i y :
[x] !! i = Some y ↔ i = 0 ∧ x = y.
Proof. rewrite lookup_cons_Some. naive_solver. 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 list_lookup_total_middle `{!Inhabited A} l1 l2 x n :
n = length l1 → (l1 ++ x :: l2) !!! n = x.
Proof. intros. by rewrite !list_lookup_total_alt, list_lookup_middle. 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 as [|?? IHl]; [done|].
intros [|i]; [done|]. apply (IHl i).
Qed.
Lemma list_lookup_total_alter `{!Inhabited A} f l i :
i < length l → alter f i l !!! i = f (l !!! i).
Proof.
intros [x Hx]%lookup_lt_is_Some_2.
by rewrite !list_lookup_total_alt, list_lookup_alter, Hx.
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_total_alter_ne `{!Inhabited A} f l i j :
i ≠ j → alter f i l !!! j = l !!! j.
Proof. intros. by rewrite !list_lookup_total_alt, list_lookup_alter_ne. 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_total_insert `{!Inhabited A} l i x :
i < length l → <[i:=x]>l !!! i = x.
Proof. intros. by rewrite !list_lookup_total_alt, list_lookup_insert. 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_total_insert_ne `{!Inhabited A} l i j x :
i ≠ j → <[i:=x]>l !!! j = l !!! j.
Proof. intros. by rewrite !list_lookup_total_alt, list_lookup_insert_ne. 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_insert_id' l i x : (i < length l → l !! i = Some x) → <[i:=x]>l = l.
Proof. revert i. induction l; intros [|i] ?; f_equal/=; naive_solver lia. Qed.
Lemma list_insert_id l i x : l !! i = Some x → <[i:=x]>l = l.
Proof. intros ?. by apply list_insert_id'. Qed.
Lemma list_insert_ge l i x : length l ≤ i → <[i:=x]>l = l.
Proof. revert i. induction l; intros [|i] ?; f_equal/=; auto with lia. Qed.
Lemma list_insert_insert l i x y : <[i:=x]> (<[i:=y]> l) = <[i:=x]> l.
Proof. revert i. induction l; intros [|i]; 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 length_delete l i :
is_Some (l !! i) → length (delete i l) = length l - 1.
Proof.
rewrite lookup_lt_is_Some. revert i.
induction l as [|x l IH]; intros [|i] ?; simpl in *; [lia..|].
rewrite IH by lia. lia.
Qed.
Lemma lookup_delete_lt l i j : j < i → delete i l !! j = l !! j.
Proof. revert i j; induction l; intros [] []; naive_solver eauto with lia. Qed.
Lemma lookup_total_delete_lt `{!Inhabited A} l i j :
j < i → delete i l !!! j = l !!! j.
Proof. intros. by rewrite !list_lookup_total_alt, lookup_delete_lt. Qed.
Lemma lookup_delete_ge l i j : i ≤ j → delete i l !! j = l !! S j.
Proof. revert i j; induction l; intros [] []; naive_solver eauto with lia. Qed.
Lemma lookup_total_delete_ge `{!Inhabited A} l i j :
i ≤ j → delete i l !!! j = l !!! S j.
Proof. intros. by rewrite !list_lookup_total_alt, lookup_delete_ge. 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_total_inserts `{!Inhabited A} l i k j :
i ≤ j < i + length k → j < length l →
list_inserts i k l !!! j = k !!! (j - i).
Proof. intros. by rewrite !list_lookup_total_alt, list_lookup_inserts. 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_total_inserts_lt `{!Inhabited A}l i k j :
j < i → list_inserts i k l !!! j = l !!! j.
Proof. intros. by rewrite !list_lookup_total_alt, list_lookup_inserts_lt. 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_total_inserts_ge `{!Inhabited A} l i k j :
i + length k ≤ j → list_inserts i k l !!! j = l !!! j.
Proof. intros. by rewrite !list_lookup_total_alt, list_lookup_inserts_ge. 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.
Lemma list_inserts_app_l l1 l2 l3 i :
list_inserts i (l1 ++ l2) l3 = list_inserts (length l1 + i) l2 (list_inserts i l1 l3).
Proof.
revert i; induction l1 as [|x l1 IH]; [done|].
intro i. simpl. rewrite IH, Nat.add_succ_r. apply list_insert_inserts_lt. lia.
Qed.
Lemma list_inserts_app_r l1 l2 l3 i :
list_inserts (length l2 + i) l1 (l2 ++ l3) = l2 ++ list_inserts i l1 l3.
Proof.
revert i; induction l1 as [|x l1 IH]; [done|].
intros i. simpl. by rewrite plus_n_Sm, IH, insert_app_r.
Qed.
Lemma list_inserts_nil l1 i : list_inserts i l1 [] = [].
Proof.
revert i; induction l1 as [|x l1 IH]; [done|].
intro i. simpl. by rewrite IH.
Qed.
Lemma list_inserts_cons l1 l2 i x :
list_inserts (S i) l1 (x :: l2) = x :: list_inserts i l1 l2.
Proof.
revert i; induction l1 as [|y l1 IH]; [done|].
intro i. simpl. by rewrite IH.
Qed.
Lemma list_inserts_0_r l1 l2 l3 :
length l1 = length l2 → list_inserts 0 l1 (l2 ++ l3) = l1 ++ l3.
Proof.
revert l2. induction l1 as [|x l1 IH]; intros [|y l2] ?; simplify_eq/=; [done|].
rewrite list_inserts_cons. simpl. by rewrite IH.
Qed.
Lemma list_inserts_0_l l1 l2 l3 :
length l1 = length l3 → list_inserts 0 (l1 ++ l2) l3 = l1.
Proof.
revert l3. induction l1 as [|x l1 IH]; intros [|z l3] ?; simplify_eq/=.
{ by rewrite list_inserts_nil. }
rewrite list_inserts_cons. simpl. by rewrite IH.
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 as [|y l1 IH]; simpl.
- rewrite elem_of_nil. naive_solver.
- rewrite !elem_of_cons, IH. naive_solver.
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.
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_total_1 `{!Inhabited A} l x :
x ∈ l → ∃ i, i < length l ∧ l !!! i = x.
Proof.
intros [i Hi]%elem_of_list_lookup_1.
eauto using lookup_lt_Some, list_lookup_total_correct.
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_total_2 `{!Inhabited A} l i :
i < length l → l !!! i ∈ l.
Proof. intros. by eapply elem_of_list_lookup_2, list_lookup_lookup_total_lt. 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_lookup_total `{!Inhabited A} l x :
x ∈ l ↔ ∃ i, i < length l ∧ l !!! i = x.
Proof.
naive_solver eauto using elem_of_list_lookup_total_1, elem_of_list_lookup_total_2.
Qed.
Lemma elem_of_list_split_length l i x :
l !! i = Some x → ∃ l1 l2, l = l1 ++ x :: l2 ∧ i = length l1.
Proof.
revert i; induction l as [|y l IH]; intros [|i] Hl; simplify_eq/=.
- exists []; eauto.
- destruct (IH _ Hl) as (?&?&?&?); simplify_eq/=.
eexists (y :: _); eauto.
Qed.
Lemma elem_of_list_split l x : x ∈ l → ∃ l1 l2, l = l1 ++ x :: l2.
Proof.
intros [? (?&?&?&_)%elem_of_list_split_length]%elem_of_list_lookup_1; eauto.
Qed.
Lemma elem_of_list_split_l `{EqDecision A} l x :
x ∈ l → ∃ l1 l2, l = l1 ++ x :: l2 ∧ x ∉ l1.
Proof.
induction 1 as [x l|x y l ? IH].
{ exists [], l. rewrite elem_of_nil. naive_solver. }
destruct (decide (x = y)) as [->|?].
- exists [], l. rewrite elem_of_nil. naive_solver.
- destruct IH as (l1 & l2 & -> & ?).
exists (y :: l1), l2. rewrite elem_of_cons. naive_solver.
Qed.
Lemma elem_of_list_split_r `{EqDecision A} l x :
x ∈ l → ∃ l1 l2, l = l1 ++ x :: l2 ∧ x ∉ l2.
Proof.
induction l as [|y l IH] using rev_ind.
{ by rewrite elem_of_nil. }
destruct (decide (x = y)) as [->|].
- exists l, []. rewrite elem_of_nil. naive_solver.
- rewrite elem_of_app, elem_of_list_singleton. intros [?| ->]; try done.
destruct IH as (l1 & l2 & -> & ?); auto.
exists l1, (l2 ++ [y]).
rewrite elem_of_app, elem_of_list_singleton, <-(assoc_L (++)). naive_solver.
Qed.
Lemma list_elem_of_insert l i x : i < length l → x ∈ <[i:=x]>l.
Proof. intros. by eapply elem_of_list_lookup_2, list_lookup_insert. Qed.
Lemma nth_elem_of l i d : i < length l → nth i l d ∈ l.
Proof.
intros; eapply elem_of_list_lookup_2.
destruct (nth_lookup_or_length l i d); [done | by lia].
Qed.
(** ** Properties of the [NoDup] predicate *) (** ** Properties of the [NoDup] predicate *)
Lemma NoDup_nil : NoDup (@nil A) ↔ True. Lemma NoDup_nil : NoDup (@nil A) ↔ True.
Proof. split; constructor. Qed. Proof. split; constructor. Qed.
Lemma NoDup_cons x l : NoDup (x :: l) ↔ x ∉ l ∧ NoDup l. Lemma NoDup_cons x l : NoDup (x :: l) ↔ x ∉ l ∧ NoDup l.
Proof. split; [by inversion 1|]. intros [??]. by constructor. Qed. Proof. split; [by inv 1|]. intros [??]. by constructor. Qed.
Lemma NoDup_cons_1_1 x l : NoDup (x :: l) → x ∉ l. Lemma NoDup_cons_1_1 x l : NoDup (x :: l) → x ∉ l.
Proof. rewrite NoDup_cons. by intros [??]. Qed. Proof. rewrite NoDup_cons. by intros [??]. Qed.
Lemma NoDup_cons_1_2 x l : NoDup (x :: l) → NoDup l. Lemma NoDup_cons_1_2 x l : NoDup (x :: l) → NoDup l.
...@@ -971,10 +124,17 @@ Proof. ...@@ -971,10 +124,17 @@ Proof.
split; eauto using NoDup_lookup. split; eauto using NoDup_lookup.
induction l as [|x l IH]; intros Hl; constructor. induction l as [|x l IH]; intros Hl; constructor.
- rewrite elem_of_list_lookup. intros [i ?]. - rewrite elem_of_list_lookup. intros [i ?].
by feed pose proof (Hl (S i) 0 x); auto. opose proof* (Hl (S i) 0); by auto.
- apply IH. intros i j x' ??. by apply (inj S), (Hl (S i) (S j) x'). - apply IH. intros i j x' ??. by apply (inj S), (Hl (S i) (S j) x').
Qed. Qed.
Lemma NoDup_filter (P : A → Prop) `{∀ x, Decision (P x)} l :
NoDup l → NoDup (filter P l).
Proof.
induction 1; rewrite ?filter_cons; repeat case_decide;
rewrite ?NoDup_nil, ?NoDup_cons, ?elem_of_list_filter; tauto.
Qed.
Section no_dup_dec. Section no_dup_dec.
Context `{!EqDecision A}. Context `{!EqDecision A}.
Global Instance NoDup_dec: ∀ l, Decision (NoDup l) := Global Instance NoDup_dec: ∀ l, Decision (NoDup l) :=
...@@ -1001,38 +161,7 @@ Section no_dup_dec. ...@@ -1001,38 +161,7 @@ Section no_dup_dec.
induction l; simpl; repeat case_decide; try constructor; auto. induction l; simpl; repeat case_decide; try constructor; auto.
by rewrite elem_of_remove_dups. by rewrite elem_of_remove_dups.
Qed. 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 l|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). Lemma NoDup_list_difference l k : NoDup l → NoDup (list_difference l k).
Proof. Proof.
induction 1; simpl; try case_decide. induction 1; simpl; try case_decide.
...@@ -1040,11 +169,6 @@ Section list_set. ...@@ -1040,11 +169,6 @@ Section list_set.
- done. - done.
- constructor; [|done]. rewrite elem_of_list_difference; intuition. - constructor; [|done]. rewrite elem_of_list_difference; intuition.
Qed. 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). Lemma NoDup_list_union l k : NoDup l → NoDup k → NoDup (list_union l k).
Proof. Proof.
intros. apply NoDup_app. repeat split. intros. apply NoDup_app. repeat split.
...@@ -1052,12 +176,6 @@ Section list_set. ...@@ -1052,12 +176,6 @@ Section list_set.
- intro. rewrite elem_of_list_difference. intuition. - intro. rewrite elem_of_list_difference. intuition.
- done. - done.
Qed. 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). Lemma NoDup_list_intersection l k : NoDup l → NoDup (list_intersection l k).
Proof. Proof.
induction 1; simpl; try case_decide. induction 1; simpl; try case_decide.
...@@ -1065,725 +183,31 @@ Section list_set. ...@@ -1065,725 +183,31 @@ Section list_set.
- constructor; [|done]. rewrite elem_of_list_intersection; intuition. - constructor; [|done]. rewrite elem_of_list_intersection; intuition.
- done. - done.
Qed. Qed.
End list_set.
(** ** Properties of the [reverse] function *) End no_dup_dec.
Lemma reverse_nil : reverse [] =@{list 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.
(** ** Properties of the [last] function *) (** ** Properties of the [Permutation] predicate *)
Lemma last_nil : last [] =@{option A} None. Lemma Permutation_nil_r l : l ≡ₚ [] ↔ l = [].
Proof. done. Qed. Proof. split; [by intro; apply Permutation_nil | by intros ->]. Qed.
Lemma last_singleton x : last [x] = Some x. Lemma Permutation_singleton_r l x : l ≡ₚ [x] ↔ l = [x].
Proof. done. Qed. Proof. split; [by intro; apply Permutation_length_1_inv | by intros ->]. Qed.
Lemma last_cons_cons x1 x2 l : last (x1 :: x2 :: l) = last (x2 :: l). Lemma Permutation_nil_l l : [] ≡ₚ l ↔ [] = l.
Proof. done. Qed. Proof. by rewrite (symmetry_iff (≡ₚ)), Permutation_nil_r. Qed.
Lemma Permutation_singleton_l l x : [x] ≡ₚ l ↔ [x] = l.
Proof. by rewrite (symmetry_iff (≡ₚ)), Permutation_singleton_r. Qed.
Lemma last_None l : last l = None ↔ l = []. Lemma Permutation_skip x l l' : l ≡ₚ l' → x :: l ≡ₚ x :: l'.
Proof. Proof. apply perm_skip. Qed.
split; [|by intros ->]. Lemma Permutation_swap x y l : y :: x :: l ≡ₚ x :: y :: l.
induction l as [|x1 [|x2 l] IH]; naive_solver. Proof. apply perm_swap. Qed.
Qed. Lemma Permutation_singleton_inj x y : [x] ≡ₚ [y] → x = y.
Lemma last_is_Some l : is_Some (last l) ↔ l ≠ []. Proof. apply Permutation_length_1. Qed.
Proof. rewrite <-not_eq_None_Some, last_None. naive_solver. Qed.
Lemma last_cons x l : Global Instance length_Permutation_proper : Proper ((≡ₚ) ==> (=)) (@length A).
last (x :: l) = match last l with Some y => Some y | None => Some x end. Proof. induction 1; simpl; auto with lia. Qed.
Proof. Global Instance elem_of_Permutation_proper x : Proper ((≡ₚ) ==> iff) (x ∈.).
destruct l as [|x' l]; simpl; [done|]. Proof. induction 1; rewrite ?elem_of_nil, ?elem_of_cons; intuition. Qed.
destruct (last (x' :: l)) eqn:Hlast; [done|]. Global Instance NoDup_Permutation_proper: Proper ((≡ₚ) ==> iff) (@NoDup A).
by apply last_None in Hlast.
Qed.
Lemma last_snoc x l : last (l ++ [x]) = Some x.
Proof. induction l as [|? []]; simpl; auto. Qed.
Lemma last_lookup l : last l = l !! pred (length l).
Proof. by induction l as [| ?[]]. Qed.
Lemma last_reverse l : last (reverse l) = head l.
Proof. destruct l as [|x l]; simpl; by rewrite ?reverse_cons, ?last_snoc. Qed.
(** ** Properties of the [head] function *)
Lemma head_nil : head [] =@{option A} None.
Proof. done. Qed.
Lemma head_cons x l : head (x :: l) = Some x.
Proof. done. Qed.
Lemma head_None l : head l = None ↔ l = [].
Proof. split; [|by intros ->]. by destruct l. Qed.
Lemma head_is_Some l : is_Some (head l) ↔ l ≠ [].
Proof. rewrite <-not_eq_None_Some, head_None. naive_solver. Qed.
Lemma head_snoc x l :
head (l ++ [x]) = match head l with Some y => Some y | None => Some x end.
Proof. by destruct l. Qed.
Lemma head_snoc_snoc x1 x2 l :
head (l ++ [x1; x2]) = head (l ++ [x1]).
Proof. by destruct l. Qed.
Lemma head_lookup l : head l = l !! 0.
Proof. by destruct l. 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_0 l : take 0 l = [].
Proof. reflexivity. Qed.
Lemma take_nil n : take n [] =@{list A} [].
Proof. by destruct n. Qed.
Lemma take_S_r l n x : l !! n = Some x → take (S n) l = take n l ++ [x].
Proof. revert n. induction l; intros []; naive_solver eauto with f_equal. 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_total_take `{!Inhabited A} l n i : i < n → take n l !!! i = l !!! i.
Proof. intros. by rewrite !list_lookup_total_alt, lookup_take. 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 lookup_total_take_ge `{!Inhabited A} l n i : n ≤ i → take n l !!! i = inhabitant.
Proof. intros. by rewrite list_lookup_total_alt, lookup_take_ge. Qed.
Lemma lookup_take_Some l n i a : take n l !! i = Some a ↔ l !! i = Some a ∧ i < n.
Proof.
split.
- destruct (decide (i < n)).
+ rewrite lookup_take; naive_solver.
+ rewrite lookup_take_ge; [done|lia].
- intros [??]. by rewrite lookup_take.
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.
Lemma take_insert_lt l n i x : i < n → take n (<[i:=x]>l) = <[i:=x]>(take n l).
Proof.
revert l i. induction n as [|? IHn]; auto; simpl.
intros [|] [|] ?; auto; simpl. by rewrite IHn 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 [] =@{list A} [].
Proof. by destruct n. Qed.
Lemma drop_S l x n :
l !! n = Some x → drop n l = x :: drop (S n) l.
Proof. revert n. induction l; intros []; naive_solver. 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 lookup_total_drop `{!Inhabited A} l n i : drop n l !!! i = l !!! (n + i).
Proof. by rewrite !list_lookup_total_alt, lookup_drop. 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_le l n i x : n ≤ i → drop n (<[i:=x]>l) = <[i-n:=x]>(drop n l).
Proof. revert i n. induction l; intros [] []; naive_solver lia. Qed.
Lemma drop_insert_gt 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.
Lemma insert_take_drop l i x :
i < length l →
<[i:=x]> l = take i l ++ x :: drop (S i) l.
Proof.
intros Hi.
rewrite <-(take_drop_middle (<[i:=x]> l) i x).
2:{ by rewrite list_lookup_insert. }
rewrite take_insert by done.
rewrite drop_insert_gt by lia.
done.
Qed.
Lemma app_eq_inv l1 l2 k1 k2 :
l1 ++ l2 = k1 ++ k2 →
(∃ k, l1 = k1 ++ k ∧ k2 = k ++ l2) ∨ (∃ k, k1 = l1 ++ k ∧ l2 = k ++ k2).
Proof.
intros Hlk. destruct (decide (length l1 < length k1)).
- right. rewrite <-(take_drop (length l1) k1), <-(assoc_L _) in Hlk.
apply app_inj_1 in Hlk as [Hl1 Hl2]; [|rewrite take_length; lia].
exists (drop (length l1) k1). by rewrite Hl1 at 1; rewrite take_drop.
- left. rewrite <-(take_drop (length k1) l1), <-(assoc_L _) in Hlk.
apply app_inj_1 in Hlk as [Hk1 Hk2]; [|rewrite take_length; lia].
exists (drop (length k1) l1). by rewrite <-Hk1 at 1; rewrite take_drop.
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_total_replicate_2 `{!Inhabited A} n x i :
i < n → replicate n x !!! i = x.
Proof. intros. by rewrite list_lookup_total_alt, lookup_replicate_2. 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 insert_replicate_lt x y n i :
i < n →
<[i:=y]>(replicate n x) = replicate i x ++ y :: replicate (n - S i) x.
Proof.
revert i. induction n as [|n IH]; intros [|i] Hi; simpl; [lia..| |].
- by rewrite Nat.sub_0_r.
- by rewrite IH by lia.
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_S_end n x : replicate (S n) x = replicate n x ++ [x].
Proof. induction n; f_equal/=; auto. 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 replicate_cons_app n x :
x :: replicate n x = replicate n x ++ [x].
Proof. induction n; f_equal/=; eauto. 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.
Lemma tail_replicate x n : tail (replicate n x) = replicate (pred n) x.
Proof. by destruct n. 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_total_resize `{!Inhabited A} l n x i :
i < n → i < length l → resize n x l !!! i = l !!! i.
Proof. intros. by rewrite !list_lookup_total_alt, lookup_resize. 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_total_resize_new `{!Inhabited A} l n x i :
length l ≤ i → i < n → resize n x l !!! i = x.
Proof. intros. by rewrite !list_lookup_total_alt, lookup_resize_new. 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.
Lemma lookup_total_resize_old `{!Inhabited A} l n x i :
n ≤ i → resize n x l !!! i = inhabitant.
Proof. intros. by rewrite !list_lookup_total_alt, lookup_resize_old. Qed.
(** ** Properties of the [rotate] function *)
Lemma rotate_replicate n1 n2 x:
rotate n1 (replicate n2 x) = replicate n2 x.
Proof.
unfold rotate. rewrite drop_replicate, take_replicate, <-replicate_plus.
f_equal. lia.
Qed.
Lemma rotate_length l n:
length (rotate n l) = length l.
Proof. unfold rotate. rewrite app_length, drop_length, take_length. lia. Qed.
Lemma lookup_rotate_r l n i:
i < length l →
rotate n l !! i = l !! rotate_nat_add n i (length l).
Proof.
intros Hlen. pose proof (Nat.mod_upper_bound n (length l)) as ?.
unfold rotate. rewrite rotate_nat_add_add_mod, rotate_nat_add_alt by lia.
remember (n `mod` length l) as n'.
case_decide.
- by rewrite lookup_app_l, lookup_drop by (rewrite drop_length; lia).
- rewrite lookup_app_r, lookup_take, drop_length by (rewrite drop_length; lia).
f_equal. lia.
Qed.
Lemma lookup_rotate_r_Some l n i x:
rotate n l !! i = Some x ↔
l !! rotate_nat_add n i (length l) = Some x ∧ i < length l.
Proof.
split.
- intros Hl. pose proof (lookup_lt_Some _ _ _ Hl) as Hlen.
rewrite rotate_length in Hlen. by rewrite <-lookup_rotate_r.
- intros [??]. by rewrite lookup_rotate_r.
Qed.
Lemma lookup_rotate_l l n i:
i < length l → rotate n l !! rotate_nat_sub n i (length l) = l !! i.
Proof.
intros ?. rewrite lookup_rotate_r, rotate_nat_add_sub;[done..|].
apply rotate_nat_sub_lt. lia.
Qed.
Lemma elem_of_rotate l n x:
x ∈ rotate n l ↔ x ∈ l.
Proof.
unfold rotate. rewrite <-(take_drop (n `mod` length l) l) at 5.
rewrite !elem_of_app. naive_solver.
Qed.
Lemma rotate_insert_l l n i x:
i < length l →
rotate n (<[rotate_nat_add n i (length l):=x]> l) = <[i:=x]> (rotate n l).
Proof.
intros Hlen. pose proof (Nat.mod_upper_bound n (length l)) as ?. unfold rotate.
rewrite insert_length, rotate_nat_add_add_mod, rotate_nat_add_alt by lia.
remember (n `mod` length l) as n'.
case_decide.
- rewrite take_insert, drop_insert_le, insert_app_l
by (rewrite ?drop_length; lia). do 2 f_equal. lia.
- rewrite take_insert_lt, drop_insert_gt, insert_app_r_alt, drop_length
by (rewrite ?drop_length; lia). do 2 f_equal. lia.
Qed.
Lemma rotate_insert_r l n i x:
i < length l →
rotate n (<[i:=x]> l) = <[rotate_nat_sub n i (length l):=x]> (rotate n l).
Proof.
intros ?. rewrite <-rotate_insert_l, rotate_nat_add_sub;[done..|].
apply rotate_nat_sub_lt. lia.
Qed.
(** ** Properties of the [rotate_take] function *)
Lemma rotate_take_insert l s e i x:
i < length l →
rotate_take s e (<[i:=x]>l) =
if decide (rotate_nat_sub s i (length l) < rotate_nat_sub s e (length l)) then
<[rotate_nat_sub s i (length l):=x]> (rotate_take s e l) else rotate_take s e l.
Proof.
intros ?. unfold rotate_take. rewrite rotate_insert_r, insert_length by done.
case_decide; [rewrite take_insert_lt | rewrite take_insert]; naive_solver lia.
Qed.
Lemma rotate_take_add l b i :
i < length l →
rotate_take b (rotate_nat_add b i (length l)) l = take i (rotate b l).
Proof. intros ?. unfold rotate_take. by rewrite rotate_nat_sub_add. 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.
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 [mask] function *)
Lemma mask_nil f βs : mask f βs [] =@{list 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 [Permutation] predicate *)
Lemma Permutation_nil_r l : l ≡ₚ [] ↔ l = [].
Proof. split; [by intro; apply Permutation_nil | by intros ->]. Qed.
Lemma Permutation_singleton_r l x : l ≡ₚ [x] ↔ l = [x].
Proof. split; [by intro; apply Permutation_length_1_inv | by intros ->]. Qed.
Lemma Permutation_nil_l l : [] ≡ₚ l ↔ [] = l.
Proof. by rewrite (symmetry_iff (≡ₚ)), Permutation_nil_r. Qed.
Lemma Permutation_singleton_l l x : [x] ≡ₚ l ↔ [x] = l.
Proof. by rewrite (symmetry_iff (≡ₚ)), Permutation_singleton_r. Qed.
Lemma Permutation_skip x l l' : l ≡ₚ l' → x :: l ≡ₚ x :: l'.
Proof. apply perm_skip. Qed.
Lemma Permutation_swap x y l : y :: x :: l ≡ₚ x :: y :: l.
Proof. apply perm_swap. Qed.
Lemma Permutation_singleton_inj x y : [x] ≡ₚ [y] → x = y.
Proof. apply Permutation_length_1. Qed.
Global Instance length_Permutation_proper : Proper ((≡ₚ) ==> (=)) (@length A).
Proof. induction 1; simpl; auto with lia. Qed.
Global Instance elem_of_Permutation_proper x : Proper ((≡ₚ) ==> iff) (x ∈.).
Proof. induction 1; rewrite ?elem_of_nil, ?elem_of_cons; intuition. Qed.
Global Instance NoDup_Permutation_proper: Proper ((≡ₚ) ==> iff) (@NoDup A).
Proof. Proof.
induction 1 as [|x l k Hlk IH | |]. induction 1 as [|x l k Hlk IH | |].
- by rewrite !NoDup_nil. - by rewrite !NoDup_nil.
...@@ -1817,7 +241,7 @@ Proof. intros l1 l2. rewrite !(comm (++) _ k). by apply (inj (k ++.)). Qed. ...@@ -1817,7 +241,7 @@ Proof. intros l1 l2. rewrite !(comm (++) _ k). by apply (inj (k ++.)). Qed.
Lemma replicate_Permutation n x l : replicate n x ≡ₚ l → replicate n x = l. Lemma replicate_Permutation n x l : replicate n x ≡ₚ l → replicate n x = l.
Proof. Proof.
intros Hl. apply replicate_as_elem_of. split. intros Hl. apply replicate_as_elem_of. split.
- by rewrite <-Hl, replicate_length. - by rewrite <-Hl, length_replicate.
- intros y. rewrite <-Hl. by apply elem_of_replicate_inv. - intros y. rewrite <-Hl. by apply elem_of_replicate_inv.
Qed. Qed.
Lemma reverse_Permutation l : reverse l ≡ₚ l. Lemma reverse_Permutation l : reverse l ≡ₚ l.
...@@ -1903,88 +327,11 @@ Proof. ...@@ -1903,88 +327,11 @@ Proof.
by rewrite Nat.sub_0_r, <-Hl. by rewrite Nat.sub_0_r, <-Hl.
Qed. Qed.
(** ** Properties of the [filter] function *) Global Instance filter_Permutation (P : A → Prop) `{∀ x, Decision (P x)} :
Section filter. Proper ((≡ₚ) ==> (≡ₚ)) (filter P).
Context (P : A → Prop) `{∀ x, Decision (P x)}.
Local Arguments filter {_ _ _} _ {_} !_ /.
Lemma filter_nil : filter P [] = [].
Proof. done. Qed.
Lemma filter_cons x l :
filter P (x :: l) = if decide (P x) then x :: filter P l else filter P l.
Proof. done. Qed.
Lemma filter_cons_True x l : P x → filter P (x :: l) = x :: filter P l.
Proof. intros. by rewrite filter_cons, decide_True. Qed.
Lemma filter_cons_False x l : ¬P x → filter P (x :: l) = filter P l.
Proof. intros. by rewrite filter_cons, decide_False. Qed.
Lemma filter_app l1 l2 : filter P (l1 ++ l2) = filter P l1 ++ filter P l2.
Proof.
induction l1 as [|x l1 IH]; simpl; [done| ].
case_decide; [|done].
by rewrite IH.
Qed.
Lemma elem_of_list_filter l x : x ∈ filter P l ↔ P x ∧ x ∈ l.
Proof.
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.
induction 1; simpl; repeat case_decide;
rewrite ?NoDup_nil, ?NoDup_cons, ?elem_of_list_filter; tauto.
Qed.
Global Instance filter_Permutation : Proper ((≡ₚ) ==> (≡ₚ)) (filter P).
Proof. induction 1; repeat (simpl; repeat case_decide); by econstructor. Qed.
Lemma filter_length l : length (filter P l) ≤ length l.
Proof. induction l; simpl; repeat case_decide; simpl; lia. Qed.
Lemma filter_length_lt l x : x ∈ l → ¬P x → length (filter P l) < length l.
Proof.
intros [k ->]%elem_of_Permutation ?; simpl.
rewrite decide_False, Nat.lt_succ_r by done. apply filter_length.
Qed.
End filter.
Lemma list_filter_iff (P1 P2 : A → Prop)
`{!∀ x, Decision (P1 x), !∀ x, Decision (P2 x)} (l : list A) :
(∀ x, P1 x ↔ P2 x) →
filter P1 l = filter P2 l.
Proof.
intros HPiff. induction l as [|a l IH]; [done|].
destruct (decide (P1 a)).
- rewrite !filter_cons_True by naive_solver. by rewrite IH.
- rewrite !filter_cons_False by naive_solver. by rewrite IH.
Qed.
Lemma list_filter_filter (P1 P2 : A → Prop)
`{!∀ x, Decision (P1 x), !∀ x, Decision (P2 x)} (l : list A) :
filter P1 (filter P2 l) = filter (λ a, P1 a ∧ P2 a) l.
Proof.
induction l as [|x l IH]; [done|].
rewrite !filter_cons. case (decide (P2 x)) as [HP2|HP2].
- rewrite filter_cons, IH. apply decide_iff. naive_solver.
- rewrite IH. symmetry. apply decide_False. by intros [_ ?].
Qed.
Lemma list_filter_filter_l (P1 P2 : A → Prop)
`{!∀ x, Decision (P1 x), !∀ x, Decision (P2 x)} (l : list A) :
(∀ x, P1 x → P2 x) →
filter P1 (filter P2 l) = filter P1 l.
Proof.
intros HPimp. rewrite list_filter_filter.
apply list_filter_iff. naive_solver.
Qed.
Lemma list_filter_filter_r (P1 P2 : A → Prop)
`{!∀ x, Decision (P1 x), !∀ x, Decision (P2 x)} (l : list A) :
(∀ x, P2 x → P1 x) →
filter P1 (filter P2 l) = filter P2 l.
Proof. Proof.
intros HPimp. rewrite list_filter_filter. induction 1; rewrite ?filter_cons;
apply list_filter_iff. naive_solver. repeat (simpl; repeat case_decide); by econstructor.
Qed. Qed.
(** ** Properties of the [prefix] and [suffix] predicates *) (** ** Properties of the [prefix] and [suffix] predicates *)
...@@ -2017,17 +364,30 @@ Proof. intros [k' ->]. exists k'. by rewrite (assoc_L (++)). Qed. ...@@ -2017,17 +364,30 @@ Proof. intros [k' ->]. exists k'. by rewrite (assoc_L (++)). Qed.
Lemma prefix_app_alt k1 k2 l1 l2 : Lemma prefix_app_alt k1 k2 l1 l2 :
k1 = k2 → l1 `prefix_of` l2 → k1 ++ l1 `prefix_of` k2 ++ l2. k1 = k2 → l1 `prefix_of` l2 → k1 ++ l1 `prefix_of` k2 ++ l2.
Proof. intros ->. apply prefix_app. Qed. Proof. intros ->. apply prefix_app. Qed.
Lemma prefix_app_inv k l1 l2 :
k ++ l1 `prefix_of` k ++ l2 → l1 `prefix_of` l2.
Proof.
intros [k' E]. exists k'. rewrite <-(assoc_L (++)) in E. by simplify_list_eq.
Qed.
Lemma prefix_app_l l1 l2 l3 : l1 ++ l3 `prefix_of` l2 → l1 `prefix_of` l2. 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. 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. 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. Proof. intros [k ->]. exists (k ++ l3). by rewrite (assoc_L (++)). Qed.
Lemma prefix_lookup l1 l2 i x : Lemma prefix_take l n : take n l `prefix_of` l.
Proof. rewrite <-(take_drop n l) at 2. apply prefix_app_r. done. Qed.
Lemma prefix_lookup_lt l1 l2 i :
i < length l1 → l1 `prefix_of` l2 → l1 !! i = l2 !! i.
Proof. intros ? [? ->]. by rewrite lookup_app_l. Qed.
Lemma prefix_lookup_Some l1 l2 i x :
l1 !! i = Some x → l1 `prefix_of` l2 → l2 !! i = Some x. l1 !! i = Some x → l1 `prefix_of` l2 → l2 !! i = Some x.
Proof. intros ? [k ->]. rewrite lookup_app_l; eauto using lookup_lt_Some. Qed. Proof. intros ? [k ->]. rewrite lookup_app_l; eauto using lookup_lt_Some. Qed.
Lemma prefix_length l1 l2 : l1 `prefix_of` l2 → length l1 ≤ length l2. Lemma prefix_length l1 l2 : l1 `prefix_of` l2 → length l1 ≤ length l2.
Proof. intros [? ->]. rewrite app_length. lia. Qed. Proof. intros [? ->]. rewrite length_app. lia. Qed.
Lemma prefix_snoc_not l x : ¬l ++ [x] `prefix_of` l. Lemma prefix_snoc_not l x : ¬l ++ [x] `prefix_of` l.
Proof. intros [??]. discriminate_list. Qed. Proof. intros [??]. discriminate_list. Qed.
Lemma elem_of_prefix l1 l2 x :
x ∈ l1 → l1 `prefix_of` l2 → x ∈ l2.
Proof. intros Hin [l' ->]. apply elem_of_app. by left. Qed.
(* [prefix] is not a total order, but [l1] and [l2] are always comparable if (* [prefix] is not a total order, but [l1] and [l2] are always comparable if
they are both prefixes of some [l3]. *) they are both prefixes of some [l3]. *)
Lemma prefix_weak_total l1 l2 l3 : Lemma prefix_weak_total l1 l2 l3 :
...@@ -2058,6 +418,24 @@ Global Instance prefix_dec `{!EqDecision A} : RelDecision prefix := ...@@ -2058,6 +418,24 @@ Global Instance prefix_dec `{!EqDecision A} : RelDecision prefix :=
| right Hxy => right (Hxy ∘ prefix_cons_inv_1 _ _ _ _) | right Hxy => right (Hxy ∘ prefix_cons_inv_1 _ _ _ _)
end end
end. end.
Lemma prefix_not_elem_of_app_cons_inv x y l1 l2 k1 k2 :
x ∉ k1 → y ∉ l1 →
(l1 ++ x :: l2) `prefix_of` (k1 ++ y :: k2) →
l1 = k1 ∧ x = y ∧ l2 `prefix_of` k2.
Proof.
intros Hin1 Hin2 [k Hle]. rewrite <-(assoc_L (++)) in Hle.
apply not_elem_of_app_cons_inv_l in Hle; [|done..]. unfold prefix. naive_solver.
Qed.
Lemma prefix_length_eq l1 l2 :
l1 `prefix_of` l2 → length l2 ≤ length l1 → l1 = l2.
Proof.
intros Hprefix Hlen. assert (length l1 = length l2).
{ apply prefix_length in Hprefix. lia. }
eapply list_eq_same_length with (length l1); [done..|].
intros i x y _ ??. assert (l2 !! i = Some x) by eauto using prefix_lookup_Some.
congruence.
Qed.
Section prefix_ops. Section prefix_ops.
Context `{!EqDecision A}. Context `{!EqDecision A}.
...@@ -2168,15 +546,32 @@ Lemma suffix_cons_r l1 l2 x : l1 `suffix_of` l2 → l1 `suffix_of` x :: l2. ...@@ -2168,15 +546,32 @@ Lemma suffix_cons_r l1 l2 x : l1 `suffix_of` l2 → l1 `suffix_of` x :: l2.
Proof. intros [k ->]. by exists (x :: k). Qed. Proof. intros [k ->]. by exists (x :: k). Qed.
Lemma suffix_app_r l1 l2 l3 : l1 `suffix_of` l2 → l1 `suffix_of` l3 ++ l2. 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. Proof. intros [k ->]. exists (l3 ++ k). by rewrite (assoc_L (++)). Qed.
Lemma suffix_drop l n : drop n l `suffix_of` l.
Proof. rewrite <-(take_drop n l) at 2. apply suffix_app_r. done. Qed.
Lemma suffix_cons_inv l1 l2 x y : Lemma suffix_cons_inv l1 l2 x y :
x :: l1 `suffix_of` y :: l2 → x :: l1 = y :: l2 ∨ x :: l1 `suffix_of` l2. x :: l1 `suffix_of` y :: l2 → x :: l1 = y :: l2 ∨ x :: l1 `suffix_of` l2.
Proof. Proof.
intros [[|? k] E]; [by left|]. right. simplify_eq/=. by apply suffix_app_r. intros [[|? k] E]; [by left|]. right. simplify_eq/=. by apply suffix_app_r.
Qed. Qed.
Lemma suffix_lookup_lt l1 l2 i :
i < length l1 →
l1 `suffix_of` l2 →
l1 !! i = l2 !! (i + (length l2 - length l1)).
Proof.
intros Hi [k ->]. rewrite length_app, lookup_app_r by lia. f_equal; lia.
Qed.
Lemma suffix_lookup_Some l1 l2 i x :
l1 !! i = Some x →
l1 `suffix_of` l2 →
l2 !! (i + (length l2 - length l1)) = Some x.
Proof. intros. by rewrite <-suffix_lookup_lt by eauto using lookup_lt_Some. Qed.
Lemma suffix_length l1 l2 : l1 `suffix_of` l2 → length l1 ≤ length l2. Lemma suffix_length l1 l2 : l1 `suffix_of` l2 → length l1 ≤ length l2.
Proof. intros [? ->]. rewrite app_length. lia. Qed. Proof. intros [? ->]. rewrite length_app. lia. Qed.
Lemma suffix_cons_not x l : ¬x :: l `suffix_of` l. Lemma suffix_cons_not x l : ¬x :: l `suffix_of` l.
Proof. intros [??]. discriminate_list. Qed. Proof. intros [??]. discriminate_list. Qed.
Lemma elem_of_suffix l1 l2 x :
x ∈ l1 → l1 `suffix_of` l2 → x ∈ l2.
Proof. intros Hin [l' ->]. apply elem_of_app. by right. Qed.
(* [suffix] is not a total order, but [l1] and [l2] are always comparable if (* [suffix] is not a total order, but [l1] and [l2] are always comparable if
they are both suffixes of some [l3]. *) they are both suffixes of some [l3]. *)
Lemma suffix_weak_total l1 l2 l3 : Lemma suffix_weak_total l1 l2 l3 :
...@@ -2190,6 +585,22 @@ Proof. ...@@ -2190,6 +585,22 @@ Proof.
refine (λ l1 l2, cast_if (decide_rel prefix (reverse l1) (reverse l2))); refine (λ l1 l2, cast_if (decide_rel prefix (reverse l1) (reverse l2)));
abstract (by rewrite suffix_prefix_reverse). abstract (by rewrite suffix_prefix_reverse).
Defined. Defined.
Lemma suffix_not_elem_of_app_cons_inv x y l1 l2 k1 k2 :
x ∉ k2 → y ∉ l2 →
(l1 ++ x :: l2) `suffix_of` (k1 ++ y :: k2) →
l1 `suffix_of` k1 ∧ x = y ∧ l2 = k2.
Proof.
intros Hin1 Hin2 [k Hle]. rewrite (assoc_L (++)) in Hle.
apply not_elem_of_app_cons_inv_r in Hle; [|done..]. unfold suffix. naive_solver.
Qed.
Lemma suffix_length_eq l1 l2 :
l1 `suffix_of` l2 → length l2 ≤ length l1 → l1 = l2.
Proof.
intros. apply (inj reverse), prefix_length_eq.
- by apply suffix_prefix_reverse.
- by rewrite !length_reverse.
Qed.
Section max_suffix. Section max_suffix.
Context `{!EqDecision A}. Context `{!EqDecision A}.
...@@ -2265,7 +676,7 @@ Proof. induction 1; simpl; auto with arith. Qed. ...@@ -2265,7 +676,7 @@ Proof. induction 1; simpl; auto with arith. Qed.
Lemma sublist_nil_l l : [] `sublist_of` l. Lemma sublist_nil_l l : [] `sublist_of` l.
Proof. induction l; try constructor; auto. Qed. Proof. induction l; try constructor; auto. Qed.
Lemma sublist_nil_r l : l `sublist_of` [] ↔ l = []. Lemma sublist_nil_r l : l `sublist_of` [] ↔ l = [].
Proof. split; [by inversion 1|]. intros ->. constructor. Qed. Proof. split; [by inv 1|]. intros ->. constructor. Qed.
Lemma sublist_app l1 l2 k1 k2 : Lemma sublist_app l1 l2 k1 k2 :
l1 `sublist_of` l2 → k1 `sublist_of` k2 → l1 ++ k1 `sublist_of` l2 ++ k2. l1 `sublist_of` l2 → k1 `sublist_of` k2 → l1 ++ k1 `sublist_of` l2 ++ k2.
Proof. induction 1; simpl; try constructor; auto. Qed. Proof. induction 1; simpl; try constructor; auto. Qed.
...@@ -2275,12 +686,12 @@ Lemma sublist_inserts_r k l1 l2 : l1 `sublist_of` l2 → l1 `sublist_of` l2 ++ k ...@@ -2275,12 +686,12 @@ 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. Proof. induction 1; simpl; try constructor; auto using sublist_nil_l. Qed.
Lemma sublist_cons_r x l k : Lemma sublist_cons_r x l k :
l `sublist_of` x :: k ↔ l `sublist_of` k ∨ ∃ l', l = x :: l' ∧ l' `sublist_of` 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. Proof. split; [inv 1; eauto|]. intros [?|(?&->&?)]; constructor; auto. Qed.
Lemma sublist_cons_l x l k : Lemma sublist_cons_l x l k :
x :: l `sublist_of` k ↔ ∃ k1 k2, k = k1 ++ x :: k2 ∧ l `sublist_of` k2. x :: l `sublist_of` k ↔ ∃ k1 k2, k = k1 ++ x :: k2 ∧ l `sublist_of` k2.
Proof. Proof.
split. split.
- intros Hlk. induction k as [|y k IH]; inversion Hlk. - intros Hlk. induction k as [|y k IH]; inv Hlk.
+ eexists [], k. by repeat constructor. + eexists [], k. by repeat constructor.
+ destruct IH as (k1&k2&->&?); auto. by exists (y :: k1), k2. + destruct IH as (k1&k2&->&?); auto. by exists (y :: k1), k2.
- intros (k1&k2&->&?). by apply sublist_inserts_l, sublist_skip. - intros (k1&k2&->&?). by apply sublist_inserts_l, sublist_skip.
...@@ -2323,10 +734,10 @@ Lemma sublist_app_inv_r k l1 l2 : l1 ++ k `sublist_of` l2 ++ k → l1 `sublist_o ...@@ -2323,10 +734,10 @@ Lemma sublist_app_inv_r k l1 l2 : l1 ++ k `sublist_of` l2 ++ k → l1 `sublist_o
Proof. Proof.
revert l1 l2. induction k as [|y k IH]; intros l1 l2. revert l1 l2. induction k as [|y k IH]; intros l1 l2.
{ by rewrite !(right_id_L [] (++)). } { by rewrite !(right_id_L [] (++)). }
intros. feed pose proof (IH (l1 ++ [y]) (l2 ++ [y])) as Hl12. intros. opose proof* (IH (l1 ++ [_]) (l2 ++ [_])) as Hl12.
{ by rewrite <-!(assoc_L (++)). } { by rewrite <-!(assoc_L (++)). }
rewrite sublist_app_l in Hl12. destruct Hl12 as (k1&k2&E&?&Hk2). rewrite sublist_app_l in Hl12. destruct Hl12 as (k1&k2&E&?&Hk2).
destruct k2 as [|z k2] using rev_ind; [inversion Hk2|]. destruct k2 as [|z k2] using rev_ind; [inv Hk2|].
rewrite (assoc_L (++)) in E; simplify_list_eq. rewrite (assoc_L (++)) in E; simplify_list_eq.
eauto using sublist_inserts_r. eauto using sublist_inserts_r.
Qed. Qed.
...@@ -2441,16 +852,7 @@ Proof. ...@@ -2441,16 +852,7 @@ Proof.
- exists (x :: k). by rewrite Hk, Permutation_middle. - exists (x :: k). by rewrite Hk, Permutation_middle.
- exists (k ++ k'). by rewrite Hk', Hk, (assoc_L (++)). - exists (k ++ k'). by rewrite Hk', Hk, (assoc_L (++)).
Qed. 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). Global Instance: Proper ((≡ₚ) ==> (≡ₚ) ==> iff) (@submseteq A).
Proof. Proof.
intros l1 l2 ? k1 k2 ?. split; intros. intros l1 l2 ? k1 k2 ?. split; intros.
...@@ -2459,8 +861,20 @@ Proof. ...@@ -2459,8 +861,20 @@ Proof.
- trans l2; [by apply Permutation_submseteq|]. - trans l2; [by apply Permutation_submseteq|].
trans k2; [done|]. by apply Permutation_submseteq. trans k2; [done|]. by apply Permutation_submseteq.
Qed. Qed.
Lemma submseteq_length_Permutation l1 l2 :
l1 ⊆+ l2 → length l2 ≤ length l1 → l1 ≡ₚ l2.
Proof.
intros Hsub Hlen. destruct (submseteq_Permutation l1 l2) as [[|??] Hk]; auto.
- by rewrite Hk, (right_id_L [] (++)).
- rewrite Hk, length_app in Hlen. simpl in *; lia.
Qed.
Global Instance: AntiSymm (≡ₚ) (@submseteq A). Global Instance: AntiSymm (≡ₚ) (@submseteq A).
Proof. red. auto using submseteq_Permutation_length_le, submseteq_length. Qed. Proof.
intros l1 l2 ??.
apply submseteq_length_Permutation; auto using submseteq_length.
Qed.
Lemma elem_of_submseteq l k x : x ∈ l → l ⊆+ k → x ∈ k. Lemma elem_of_submseteq l k x : x ∈ l → l ⊆+ k → x ∈ k.
Proof. intros ? [l' ->]%submseteq_Permutation. apply elem_of_app; auto. Qed. Proof. intros ? [l' ->]%submseteq_Permutation. apply elem_of_app; auto. Qed.
...@@ -2555,16 +969,7 @@ Proof. ...@@ -2555,16 +969,7 @@ Proof.
intros (?&E%(inj (cons y))&?). apply IH. by rewrite E. intros (?&E%(inj (cons y))&?). apply IH. by rewrite E.
Qed. Qed.
Lemma submseteq_app_inv_r l1 l2 k : l1 ++ k ⊆+ l2 ++ k → l1 ⊆+ l2. Lemma submseteq_app_inv_r l1 l2 k : l1 ++ k ⊆+ l2 ++ k → l1 ⊆+ l2.
Proof. Proof. rewrite <-!(comm (++) k). apply submseteq_app_inv_l. Qed.
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. 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. Proof. rewrite <-Permutation_middle. by apply submseteq_skip. Qed.
Lemma submseteq_app_middle l1 l2 k1 k2 : Lemma submseteq_app_middle l1 l2 k1 k2 :
...@@ -2576,13 +981,6 @@ Qed. ...@@ -2576,13 +981,6 @@ Qed.
Lemma submseteq_middle l k1 k2 : l ⊆+ k1 ++ l ++ k2. Lemma submseteq_middle l k1 k2 : l ⊆+ k1 ++ l ++ k2.
Proof. by apply submseteq_inserts_l, submseteq_inserts_r. Qed. 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. Lemma NoDup_submseteq l k : NoDup l → (∀ x, x ∈ l → x ∈ k) → l ⊆+ k.
Proof. Proof.
intros Hl. revert k. induction Hl as [|x l Hx ? IH]. intros Hl. revert k. induction Hl as [|x l Hx ? IH].
...@@ -2629,76 +1027,52 @@ Proof. rewrite singleton_submseteq_l. apply elem_of_list_singleton. Qed. ...@@ -2629,76 +1027,52 @@ Proof. rewrite singleton_submseteq_l. apply elem_of_list_singleton. Qed.
Section submseteq_dec. Section submseteq_dec.
Context `{!EqDecision A}. Context `{!EqDecision A}.
Lemma list_remove_Permutation l1 l2 k1 x : Local Program Fixpoint elem_of_or_Permutation x l :
l1 ≡ₚ l2 → list_remove x l1 = Some k1 → (x ∉ l) + { k | l ≡ₚ x :: k } :=
∃ k2, list_remove x l2 = Some k2 ∧ k1 ≡ₚ k2. match l with
Proof. | [] => inl _
intros Hl. revert k1. induction Hl | y :: l =>
as [|y l1 l2 ? IH|y1 y2 l|l1 l2 l3 ? IH1 ? IH2]; simpl; intros k1 Hk1. if decide (x = y) then inr (l ↾ _) else
- done. match elem_of_or_Permutation x l return _ with
- case_decide; simplify_eq; eauto. | inl _ => inl _ | inr (k ↾ _) => inr ((y :: k) ↾ _)
destruct (list_remove x l1) as [l|] eqn:?; simplify_eq. end
destruct (IH l) as (?&?&?); simplify_option_eq; eauto. end.
- simplify_option_eq; eauto using Permutation_swap. Next Obligation. inv 2. Qed.
- destruct (IH1 k1) as (k2&?&?); trivial. Next Obligation. naive_solver. Qed.
destruct (IH2 k2) as (k3&?&?); trivial. Next Obligation. intros ? x y l <- ??. by rewrite not_elem_of_cons. Qed.
exists k3. split; eauto. by trans k2. Next Obligation.
Qed. intros ? x y l <- ? _ k Hl. simpl. by rewrite Hl, Permutation_swap.
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. Qed.
Lemma list_remove_Some_inv l k x :
l ≡ₚ x :: k → ∃ k', list_remove x l = Some k' ∧ k ≡ₚ k'. Global Program Instance submseteq_dec : RelDecision (@submseteq A) :=
Proof. fix go l1 l2 :=
intros. destruct (list_remove_Permutation (x :: k) l k x) as (k'&?&?). match l1 with
- done. | [] => left _
- simpl; by case_decide. | x :: l1 =>
- by exists k'. match elem_of_or_Permutation x l2 return _ with
| inl _ => right _
| inr (l2 ↾ _) => cast_if (go l1 l2)
end
end.
Next Obligation. intros _ l1 l2 _. apply submseteq_nil_l. Qed.
Next Obligation.
intros _ ? l2 x l1 <- Hx Hxl1. eapply Hx, elem_of_submseteq, Hxl1. by left.
Qed. Qed.
Lemma list_remove_list_submseteq l1 l2 : Next Obligation. intros _ ?? x l1 <- _ l2 -> Hl. by apply submseteq_skip. Qed.
l1 ⊆+ l2 ↔ is_Some (list_remove_list l1 l2). Next Obligation.
Proof. intros _ ?? x l1 <- _ l2 -> Hl (l2' & Hl2%(inj _) & ?)%submseteq_cons_l.
split. apply Hl. by rewrite Hl2.
- 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. Qed.
Global Instance submseteq_dec : RelDecision (submseteq : relation (list A)).
Proof.
refine (λ l1 l2, cast_if (decide (is_Some (list_remove_list l1 l2))));
abstract (rewrite list_remove_list_submseteq; tauto).
Defined.
Global Instance Permutation_dec : RelDecision (≡ₚ@{A}). Global Instance Permutation_dec : RelDecision (≡ₚ@{A}).
Proof. Proof using Type*.
refine (λ l1 l2, cast_if_and refine (λ l1 l2, cast_if_and
(decide (length l1 = length l2)) (decide (l1 ⊆+ l2))); (decide (l1 ⊆+ l2)) (decide (length l2 ≤ length l1)));
abstract (rewrite Permutation_alt; tauto). [by apply submseteq_length_Permutation
|abstract (intros He; by rewrite He in *)..].
Defined. Defined.
End submseteq_dec. End submseteq_dec.
(** ** Properties of [included] *)
Global Instance list_subseteq_po : PreOrder (⊆@{list A}).
Proof. split; firstorder. Qed.
Lemma list_subseteq_nil l : [] ⊆ l.
Proof. intros x. by rewrite elem_of_nil. Qed.
Lemma list_nil_subseteq l : l ⊆ [] → l = [].
Proof.
intro Hl. destruct l as [|x l1]; [done|]. exfalso.
rewrite <-(elem_of_nil x).
apply Hl, elem_of_cons. by left.
Qed.
Global Instance list_subseteq_Permutation: Proper ((≡ₚ) ==> (≡ₚ) ==> (↔)) (⊆@{list A}) .
Proof. intros l1 l2 Hl k1 k2 Hk. apply forall_proper; intros x. by rewrite Hl, Hk. Qed.
(** ** Properties of the [Forall] and [Exists] predicate *) (** ** Properties of the [Forall] and [Exists] predicate *)
Lemma Forall_Exists_dec (P Q : A → Prop) (dec : ∀ x, {P x} + {Q x}) : Lemma Forall_Exists_dec (P Q : A → Prop) (dec : ∀ x, {P x} + {Q x}) :
...@@ -2728,23 +1102,23 @@ Section Forall_Exists. ...@@ -2728,23 +1102,23 @@ Section Forall_Exists.
Lemma Forall_forall l : Forall P l ↔ ∀ x, x ∈ l → P x. Lemma Forall_forall l : Forall P l ↔ ∀ x, x ∈ l → P x.
Proof. Proof.
split; [induction 1; inversion 1; subst; auto|]. split; [induction 1; inv 1; auto|].
intros Hin; induction l as [|x l IH]; constructor; [apply Hin; constructor|]. intros Hin; induction l as [|x l IH]; constructor; [apply Hin; constructor|].
apply IH. intros ??. apply Hin. by constructor. apply IH. intros ??. apply Hin. by constructor.
Qed. Qed.
Lemma Forall_nil : Forall P [] ↔ True. Lemma Forall_nil : Forall P [] ↔ True.
Proof. done. Qed. Proof. done. Qed.
Lemma Forall_cons_1 x l : Forall P (x :: l) → P x ∧ Forall P l. Lemma Forall_cons_1 x l : Forall P (x :: l) → P x ∧ Forall P l.
Proof. by inversion 1. Qed. Proof. by inv 1. Qed.
Lemma Forall_cons x l : Forall P (x :: l) ↔ P x ∧ Forall P l. Lemma Forall_cons x l : Forall P (x :: l) ↔ P x ∧ Forall P l.
Proof. split; [by inversion 1|]. intros [??]. by constructor. Qed. Proof. split; [by inv 1|]. intros [??]. by constructor. Qed.
Lemma Forall_singleton x : Forall P [x] ↔ P x. Lemma Forall_singleton x : Forall P [x] ↔ P x.
Proof. rewrite Forall_cons, Forall_nil; tauto. Qed. Proof. rewrite Forall_cons, Forall_nil; tauto. Qed.
Lemma Forall_app_2 l1 l2 : Forall P l1 → Forall P l2 → Forall P (l1 ++ l2). Lemma Forall_app_2 l1 l2 : Forall P l1 → Forall P l2 → Forall P (l1 ++ l2).
Proof. induction 1; simpl; auto. Qed. Proof. induction 1; simpl; auto. Qed.
Lemma Forall_app l1 l2 : Forall P (l1 ++ l2) ↔ Forall P l1 ∧ Forall P l2. Lemma Forall_app l1 l2 : Forall P (l1 ++ l2) ↔ Forall P l1 ∧ Forall P l2.
Proof. Proof.
split; [induction l1; inversion 1; intuition|]. split; [induction l1; inv 1; naive_solver|].
intros [??]; auto using Forall_app_2. intros [??]; auto using Forall_app_2.
Qed. Qed.
Lemma Forall_true l : (∀ x, P x) → Forall P l. Lemma Forall_true l : (∀ x, P x) → Forall P l.
...@@ -2756,11 +1130,11 @@ Section Forall_Exists. ...@@ -2756,11 +1130,11 @@ Section Forall_Exists.
(∀ x, P x ↔ Q x) → Forall P l ↔ Forall Q l. (∀ x, P x ↔ Q x) → Forall P l ↔ Forall Q l.
Proof. intros H. apply Forall_proper. { red; apply H. } done. Qed. 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. Lemma Forall_not l : length l ≠ 0 → Forall (not ∘ P) l → ¬Forall P l.
Proof. by destruct 2; inversion 1. Qed. Proof. by destruct 2; inv 1. Qed.
Lemma Forall_and {Q} l : Forall (λ x, P x ∧ Q x) l ↔ Forall P l ∧ Forall Q l. Lemma Forall_and {Q} l : Forall (λ x, P x ∧ Q x) l ↔ Forall P l ∧ Forall Q l.
Proof. Proof.
split; [induction 1; constructor; naive_solver|]. split; [induction 1; constructor; naive_solver|].
intros [Hl Hl']; revert Hl'; induction Hl; inversion_clear 1; auto. intros [Hl Hl']; revert Hl'; induction Hl; inv 1; auto.
Qed. Qed.
Lemma Forall_and_l {Q} l : Forall (λ x, P x ∧ Q x) l → Forall P l. Lemma Forall_and_l {Q} l : Forall (λ x, P x ∧ Q x) l → Forall P l.
Proof. rewrite Forall_and; tauto. Qed. Proof. rewrite Forall_and; tauto. Qed.
...@@ -2811,7 +1185,7 @@ Section Forall_Exists. ...@@ -2811,7 +1185,7 @@ Section Forall_Exists.
Forall P (alter f i l) → (∀ x, l !! i = Some x → P (f x) → P x) → Forall P l. Forall P (alter f i l) → (∀ x, l !! i = Some x → P (f x) → P x) → Forall P l.
Proof. Proof.
revert i. induction l; intros [|?]; simpl; revert i. induction l; intros [|?]; simpl;
inversion_clear 1; constructor; eauto. inv 1; constructor; eauto.
Qed. Qed.
Lemma Forall_insert l i x : Forall P l → P x → Forall P (<[i:=x]>l). 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. Proof. rewrite list_insert_alter; auto using Forall_alter. Qed.
...@@ -2829,75 +1203,37 @@ Section Forall_Exists. ...@@ -2829,75 +1203,37 @@ Section Forall_Exists.
Proof. intros Hl. revert n. induction Hl; intros [|?]; simpl; auto. Qed. Proof. intros Hl. revert n. induction Hl; intros [|?]; simpl; auto. Qed.
Lemma Forall_drop n l : Forall P l → Forall P (drop n l). Lemma Forall_drop n l : Forall P l → Forall P (drop n l).
Proof. intros Hl. revert n. induction Hl; intros [|?]; simpl; auto. Qed. 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). Lemma Forall_rev_ind (Q : list A → Prop) :
Proof. Q [] → (∀ x l, P x → Forall P l → Q l → Q (l ++ [x])) →
intros ? Hl. revert n. ∀ l, Forall P l → Q l.
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. Proof.
unfold sublist_lookup. intros; simplify_option_eq. intros ?? l. induction l using rev_ind; auto.
auto using Forall_take, Forall_drop. rewrite Forall_app, Forall_singleton; intros [??]; auto.
Qed. Qed.
Lemma Forall_sublist_alter f l i n k :
Forall P l → sublist_lookup i n l = Some k → Forall P (f k) → Lemma Exists_exists l : Exists P l ↔ ∃ x, x ∈ l ∧ P x.
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.
Global Instance Forall_Permutation: Proper ((≡ₚ) ==> (↔)) (Forall P).
Proof. intros l1 l2 Hl. rewrite !Forall_forall. by setoid_rewrite Hl. Qed.
Lemma Exists_exists l : Exists P l ↔ ∃ x, x ∈ l ∧ P x.
Proof. Proof.
split. split.
- induction 1 as [x|y ?? [x [??]]]; exists x; by repeat constructor. - induction 1 as [x|y ?? [x [??]]]; exists x; by repeat constructor.
- intros [x [Hin ?]]. induction l; [by destruct (not_elem_of_nil x)|]. - intros [x [Hin ?]]. induction l; [by destruct (not_elem_of_nil x)|].
inversion Hin; subst; [left|right]; auto. inv Hin; subst; [left|right]; auto.
Qed. Qed.
Lemma Exists_inv x l : Exists P (x :: l) → P x ∨ Exists P l. Lemma Exists_inv x l : Exists P (x :: l) → P x ∨ Exists P l.
Proof. inversion 1; intuition trivial. Qed. Proof. inv 1; intuition trivial. Qed.
Lemma Exists_app l1 l2 : Exists P (l1 ++ l2) ↔ Exists P l1 ∨ Exists P l2. Lemma Exists_app l1 l2 : Exists P (l1 ++ l2) ↔ Exists P l1 ∨ Exists P l2.
Proof. Proof.
split. split.
- induction l1; inversion 1; intuition. - induction l1; inv 1; naive_solver.
- intros [H|H]; [induction H | induction l1]; simpl; intuition. - intros [H|H]; [induction H | induction l1]; simpl; intuition.
Qed. Qed.
Lemma Exists_impl (Q : A → Prop) l : Lemma Exists_impl (Q : A → Prop) l :
Exists P l → (∀ x, P x → Q x) → Exists Q l. Exists P l → (∀ x, P x → Q x) → Exists Q l.
Proof. intros H ?. induction H; auto. Defined. Proof. intros H ?. induction H; auto. Defined.
Global Instance Exists_Permutation: Proper ((≡ₚ) ==> (↔)) (Exists P).
Proof. intros l1 l2 Hl. rewrite !Exists_exists. by setoid_rewrite Hl. Qed.
Lemma Exists_not_Forall l : Exists (not ∘ P) l → ¬Forall P l. Lemma Exists_not_Forall l : Exists (not ∘ P) l → ¬Forall P l.
Proof. induction 1; inversion_clear 1; contradiction. Qed. Proof. induction 1; inv 1; contradiction. Qed.
Lemma Forall_not_Exists l : Forall (not ∘ P) l → ¬Exists P l. Lemma Forall_not_Exists l : Forall (not ∘ P) l → ¬Exists P l.
Proof. induction 1; inversion_clear 1; contradiction. Qed. Proof. induction 1; inv 1; contradiction. Qed.
Lemma Forall_list_difference `{!EqDecision A} l k : Lemma Forall_list_difference `{!EqDecision A} l k :
Forall P l → Forall P (list_difference l k). Forall P l → Forall P (list_difference l k).
...@@ -2917,9 +1253,9 @@ Section Forall_Exists. ...@@ -2917,9 +1253,9 @@ Section Forall_Exists.
Context {dec : ∀ x, Decision (P x)}. Context {dec : ∀ x, Decision (P x)}.
Lemma not_Forall_Exists l : ¬Forall P l → Exists (not ∘ P) l. 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. Proof using Type*. intro. by destruct (Forall_Exists_dec P (not ∘ P) dec l). Qed.
Lemma not_Exists_Forall l : ¬Exists P l → Forall (not ∘ P) l. Lemma not_Exists_Forall l : ¬Exists P l → Forall (not ∘ P) l.
Proof. Proof using Type*.
by destruct (Forall_Exists_dec (not ∘ P) P by destruct (Forall_Exists_dec (not ∘ P) P
(λ x : A, swap_if (decide (P x))) l). (λ x : A, swap_if (decide (P x))) l).
Qed. Qed.
...@@ -2935,6 +1271,40 @@ Section Forall_Exists. ...@@ -2935,6 +1271,40 @@ Section Forall_Exists.
end. end.
End Forall_Exists. End Forall_Exists.
Global Instance Forall_Permutation :
Proper (pointwise_relation _ (↔) ==> (≡ₚ) ==> (↔)) (@Forall A).
Proof.
intros P1 P2 HP l1 l2 Hl. rewrite !Forall_forall.
apply forall_proper; intros x. by rewrite Hl, (HP x).
Qed.
Global Instance Exists_Permutation :
Proper (pointwise_relation _ (↔) ==> (≡ₚ) ==> (↔)) (@Exists A).
Proof.
intros P1 P2 HP l1 l2 Hl. rewrite !Exists_exists.
f_equiv; intros x. by rewrite Hl, (HP x).
Qed.
Lemma head_filter_Some P `{!∀ x : A, Decision (P x)} l x :
head (filter P l) = Some x →
∃ l1 l2, l = l1 ++ x :: l2 ∧ Forall (λ z, ¬P z) l1.
Proof.
intros Hl. induction l as [|x' l IH]; [done|].
rewrite filter_cons in Hl. case_decide; simplify_eq/=.
- exists [], l. repeat constructor.
- destruct IH as (l1&l2&->&?); [done|].
exists (x' :: l1), l2. by repeat constructor.
Qed.
Lemma last_filter_Some P `{!∀ x : A, Decision (P x)} l x :
last (filter P l) = Some x →
∃ l1 l2, l = l1 ++ x :: l2 ∧ Forall (λ z, ¬P z) l2.
Proof.
rewrite <-(reverse_involutive (filter P l)), last_reverse, <-filter_reverse.
intros (l1&l2&Heq&Hl)%head_filter_Some.
exists (reverse l2), (reverse l1).
rewrite <-(reverse_involutive l), Heq, reverse_app, reverse_cons, <-(assoc_L (++)).
split; [done|by apply Forall_reverse].
Qed.
Lemma list_exist_dec P l : Lemma list_exist_dec P l :
(∀ x, Decision (P x)) → Decision (∃ x, x ∈ l ∧ P x). (∀ x, Decision (P x)) → Decision (∃ x, x ∈ l ∧ P x).
Proof. Proof.
...@@ -2965,19 +1335,12 @@ Proof. rewrite replicate_as_elem_of, Forall_forall. naive_solver. Qed. ...@@ -2965,19 +1335,12 @@ Proof. rewrite replicate_as_elem_of, Forall_forall. naive_solver. Qed.
Lemma replicate_as_Forall_2 (x : A) n l : Lemma replicate_as_Forall_2 (x : A) n l :
length l = n → Forall (x =.) l → replicate n x = l. length l = n → Forall (x =.) l → replicate n x = l.
Proof. by rewrite replicate_as_Forall. Qed. Proof. by rewrite replicate_as_Forall. Qed.
End more_general_properties. End general_properties.
Lemma Forall_swap {A B} (Q : A → B → Prop) l1 l2 : 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. 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. Proof. repeat setoid_rewrite Forall_forall. simpl. split; eauto. 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 *) (** ** Properties of the [Forall2] predicate *)
Lemma Forall_Forall2_diag {A} (Q : A → A → Prop) l : Lemma Forall_Forall2_diag {A} (Q : A → A → Prop) l :
Forall (λ x, Q x x) l → Forall2 Q l l. Forall (λ x, Q x x) l → Forall2 Q l l.
...@@ -2988,8 +1351,15 @@ Lemma Forall2_forall `{Inhabited A} B C (Q : A → B → C → Prop) l k : ...@@ -2988,8 +1351,15 @@ Lemma Forall2_forall `{Inhabited A} B C (Q : A → B → C → Prop) l k :
Proof. Proof.
split; [induction 1; constructor; auto|]. split; [induction 1; constructor; auto|].
intros Hlk. induction (Hlk inhabitant) as [|x y l k _ _ IH]; constructor. intros Hlk. induction (Hlk inhabitant) as [|x y l k _ _ IH]; constructor.
- intros z. by feed inversion (Hlk z). - intros z. by oinv Hlk.
- apply IH. intros z. by feed inversion (Hlk z). - apply IH. intros z. by oinv Hlk.
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. Qed.
Lemma Forall2_Forall {A} P (l1 l2 : list A) : Lemma Forall2_Forall {A} P (l1 l2 : list A) :
...@@ -3021,7 +1391,7 @@ Section Forall2. ...@@ -3021,7 +1391,7 @@ Section Forall2.
Lemma Forall2_transitive {C} (Q : B → C → Prop) (R : A → C → Prop) l k lC : 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) → (∀ x y z, P x y → Q y z → R x z) →
Forall2 P l k → Forall2 Q k lC → Forall2 R l lC. Forall2 P l k → Forall2 Q k lC → Forall2 R l lC.
Proof. intros ? Hl. revert lC. induction Hl; inversion_clear 1; eauto. Qed. Proof. intros ? Hl. revert lC. induction Hl; inv 1; eauto. Qed.
Lemma Forall2_impl (Q : A → B → Prop) l k : 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. Forall2 P l k → (∀ x y, P x y → Q x y) → Forall2 Q l k.
Proof. intros H ?. induction H; auto. Defined. Proof. intros H ?. induction H; auto. Defined.
...@@ -3029,43 +1399,43 @@ Section Forall2. ...@@ -3029,43 +1399,43 @@ Section Forall2.
Forall2 P l k1 → Forall2 P l k2 → Forall2 P l k1 → Forall2 P l k2 →
(∀ x y1 y2, P x y1 → P x y2 → y1 = y2) → k1 = k2. (∀ x y1 y2, P x y1 → P x y2 → y1 = y2) → k1 = k2.
Proof. Proof.
intros H. revert k2. induction H; inversion_clear 1; intros; f_equal; eauto. intros H. revert k2. induction H; inv 1; intros; f_equal; eauto.
Qed. Qed.
Lemma Forall_Forall2_l l k : Lemma Forall_Forall2_l l k :
length l = length k → Forall (λ x, ∀ y, P x y) l → Forall2 P l k. length l = length k → Forall (λ x, ∀ y, P x y) l → Forall2 P l k.
Proof. rewrite <-Forall2_same_length. induction 1; inversion 1; auto. Qed. Proof. rewrite <-Forall2_same_length. induction 1; inv 1; auto. Qed.
Lemma Forall_Forall2_r l k : Lemma Forall_Forall2_r l k :
length l = length k → Forall (λ y, ∀ x, P x y) k → Forall2 P l k. length l = length k → Forall (λ y, ∀ x, P x y) k → Forall2 P l k.
Proof. rewrite <-Forall2_same_length. induction 1; inversion 1; auto. Qed. Proof. rewrite <-Forall2_same_length. induction 1; inv 1; auto. Qed.
Lemma Forall2_Forall_l (Q : A → Prop) l k : 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. Forall2 P l k → Forall (λ y, ∀ x, P x y → Q x) k → Forall Q l.
Proof. induction 1; inversion_clear 1; eauto. Qed. Proof. induction 1; inv 1; eauto. Qed.
Lemma Forall2_Forall_r (Q : B → Prop) l k : 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. Forall2 P l k → Forall (λ x, ∀ y, P x y → Q y) l → Forall Q k.
Proof. induction 1; inversion_clear 1; eauto. Qed. Proof. induction 1; inv 1; eauto. Qed.
Lemma Forall2_nil_inv_l k : Forall2 P [] k → k = []. Lemma Forall2_nil_inv_l k : Forall2 P [] k → k = [].
Proof. by inversion 1. Qed. Proof. by inv 1. Qed.
Lemma Forall2_nil_inv_r l : Forall2 P l [] → l = []. Lemma Forall2_nil_inv_r l : Forall2 P l [] → l = [].
Proof. by inversion 1. Qed. Proof. by inv 1. Qed.
Lemma Forall2_nil : Forall2 P [] [] ↔ True. Lemma Forall2_nil : Forall2 P [] [] ↔ True.
Proof. done. Qed. Proof. done. Qed.
Lemma Forall2_cons_1 x l y k : Lemma Forall2_cons_1 x l y k :
Forall2 P (x :: l) (y :: k) → P x y ∧ Forall2 P l k. Forall2 P (x :: l) (y :: k) → P x y ∧ Forall2 P l k.
Proof. by inversion 1. Qed. Proof. by inv 1. Qed.
Lemma Forall2_cons_inv_l x l k : 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'. Forall2 P (x :: l) k → ∃ y k', P x y ∧ Forall2 P l k' ∧ k = y :: k'.
Proof. inversion 1; subst; eauto. Qed. Proof. inv 1; eauto. Qed.
Lemma Forall2_cons_inv_r l k y : 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'. Forall2 P l (y :: k) → ∃ x l', P x y ∧ Forall2 P l' k ∧ l = x :: l'.
Proof. inversion 1; subst; eauto. Qed. Proof. inv 1; eauto. Qed.
Lemma Forall2_cons_nil_inv x l : Forall2 P (x :: l) [] → False. Lemma Forall2_cons_nil_inv x l : Forall2 P (x :: l) [] → False.
Proof. by inversion 1. Qed. Proof. by inv 1. Qed.
Lemma Forall2_nil_cons_inv y k : Forall2 P [] (y :: k) → False. Lemma Forall2_nil_cons_inv y k : Forall2 P [] (y :: k) → False.
Proof. by inversion 1. Qed. Proof. by inv 1. Qed.
Lemma Forall2_cons x l y k : Lemma Forall2_cons x l y k :
Forall2 P (x :: l) (y :: k) ↔ P x y ∧ Forall2 P l k. Forall2 P (x :: l) (y :: k) ↔ P x y ∧ Forall2 P l k.
...@@ -3085,21 +1455,21 @@ Section Forall2. ...@@ -3085,21 +1455,21 @@ Section Forall2.
length l1 = length k1 → length l1 = length k1 →
Forall2 P (l1 ++ l2) (k1 ++ k2) → Forall2 P l1 k1 ∧ Forall2 P l2 k2. Forall2 P (l1 ++ l2) (k1 ++ k2) → Forall2 P l1 k1 ∧ Forall2 P l2 k2.
Proof. Proof.
rewrite <-Forall2_same_length. induction 1; inversion 1; naive_solver. rewrite <-Forall2_same_length. induction 1; inv 1; naive_solver.
Qed. Qed.
Lemma Forall2_app_inv_l l1 l2 k : Lemma Forall2_app_inv_l l1 l2 k :
Forall2 P (l1 ++ l2) k ↔ Forall2 P (l1 ++ l2) k ↔
∃ k1 k2, Forall2 P l1 k1 ∧ Forall2 P l2 k2 ∧ k = k1 ++ k2. ∃ k1 k2, Forall2 P l1 k1 ∧ Forall2 P l2 k2 ∧ k = k1 ++ k2.
Proof. Proof.
split; [|intros (?&?&?&?&->); by apply Forall2_app]. split; [|intros (?&?&?&?&->); by apply Forall2_app].
revert k. induction l1; inversion 1; naive_solver. revert k. induction l1; inv 1; naive_solver.
Qed. Qed.
Lemma Forall2_app_inv_r l k1 k2 : Lemma Forall2_app_inv_r l k1 k2 :
Forall2 P l (k1 ++ k2) ↔ Forall2 P l (k1 ++ k2) ↔
∃ l1 l2, Forall2 P l1 k1 ∧ Forall2 P l2 k2 ∧ l = l1 ++ l2. ∃ l1 l2, Forall2 P l1 k1 ∧ Forall2 P l2 k2 ∧ l = l1 ++ l2.
Proof. Proof.
split; [|intros (?&?&?&?&->); by apply Forall2_app]. split; [|intros (?&?&?&?&->); by apply Forall2_app].
revert l. induction k1; inversion 1; naive_solver. revert l. induction k1; inv 1; naive_solver.
Qed. Qed.
Lemma Forall2_tail l k : Forall2 P l k → Forall2 P (tail l) (tail k). Lemma Forall2_tail l k : Forall2 P l k → Forall2 P (tail l) (tail k).
...@@ -3115,9 +1485,9 @@ Section Forall2. ...@@ -3115,9 +1485,9 @@ Section Forall2.
split; [induction 1; intros [|?]; simpl; try constructor; eauto|]. split; [induction 1; intros [|?]; simpl; try constructor; eauto|].
revert k. induction l as [|x l IH]; intros [| y k] H. revert k. induction l as [|x l IH]; intros [| y k] H.
- done. - done.
- feed inversion (H 0). - oinv (H 0).
- feed inversion (H 0). - oinv (H 0).
- constructor; [by feed inversion (H 0)|]. apply (IH _ $ λ i, H (S i)). - constructor; [by oinv (H 0)|]. apply (IH _ $ λ i, H (S i)).
Qed. Qed.
Lemma Forall2_lookup_lr l k i x y : Lemma Forall2_lookup_lr l k i x y :
Forall2 P l k → l !! i = Some x → k !! i = Some y → P x y. Forall2 P l k → l !! i = Some x → k !! i = Some y → P x y.
...@@ -3194,19 +1564,6 @@ Section Forall2. ...@@ -3194,19 +1564,6 @@ Section Forall2.
P x y → Forall2 P (replicate n x) (replicate n y). P x y → Forall2 P (replicate n x) (replicate n y).
Proof. induction n; simpl; constructor; auto. Qed. Proof. induction n; simpl; constructor; auto. Qed.
Lemma Forall2_rotate n l k :
Forall2 P l k → Forall2 P (rotate n l) (rotate n k).
Proof.
intros HAll. unfold rotate. rewrite (Forall2_length _ _ HAll).
eauto using Forall2_app, Forall2_take, Forall2_drop.
Qed.
Lemma Forall2_rotate_take s e l k :
Forall2 P l k → Forall2 P (rotate_take s e l) (rotate_take s e k).
Proof.
intros HAll. unfold rotate_take. rewrite (Forall2_length _ _ HAll).
eauto using Forall2_take, Forall2_rotate.
Qed.
Lemma Forall2_reverse l k : Forall2 P l k → Forall2 P (reverse l) (reverse k). Lemma Forall2_reverse l k : Forall2 P l k → Forall2 P (reverse l) (reverse k).
Proof. Proof.
induction 1; rewrite ?reverse_nil, ?reverse_cons; eauto using Forall2_app. induction 1; rewrite ?reverse_nil, ?reverse_cons; eauto using Forall2_app.
...@@ -3214,85 +1571,6 @@ Section Forall2. ...@@ -3214,85 +1571,6 @@ Section Forall2.
Lemma Forall2_last l k : Forall2 P l k → option_Forall2 P (last l) (last k). 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. 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)} : Global Instance Forall2_dec `{dec : ∀ x y, Decision (P x y)} :
RelDecision (Forall2 P). RelDecision (Forall2 P).
...@@ -3303,7 +1581,7 @@ Section Forall2. ...@@ -3303,7 +1581,7 @@ Section Forall2.
| [], [] => left _ | [], [] => left _
| x :: l, y :: k => cast_if_and (decide (P x y)) (go l k) | x :: l, y :: k => cast_if_and (decide (P x y)) (go l k)
| _, _ => right _ | _, _ => right _
end); clear dec go; abstract first [by constructor | by inversion 1]. end); clear dec go; abstract first [by constructor | by inv 1].
Defined. Defined.
End Forall2. End Forall2.
...@@ -3321,7 +1599,7 @@ Section Forall2_proper. ...@@ -3321,7 +1599,7 @@ Section Forall2_proper.
Global Instance: PreOrder R → PreOrder (Forall2 R). Global Instance: PreOrder R → PreOrder (Forall2 R).
Proof. split; apply _. Qed. Proof. split; apply _. Qed.
Global Instance: AntiSymm (=) R → AntiSymm (=) (Forall2 R). Global Instance: AntiSymm (=) R → AntiSymm (=) (Forall2 R).
Proof. induction 2; inversion_clear 1; f_equal; auto. Qed. Proof. induction 2; inv 1; f_equal; auto. Qed.
Global Instance: Proper (R ==> Forall2 R ==> Forall2 R) (::). Global Instance: Proper (R ==> Forall2 R ==> Forall2 R) (::).
Proof. by constructor. Qed. Proof. by constructor. Qed.
...@@ -3338,9 +1616,9 @@ Section Forall2_proper. ...@@ -3338,9 +1616,9 @@ Section Forall2_proper.
Global Instance: ∀ i, Proper (Forall2 R ==> option_Forall2 R) (lookup i). Global Instance: ∀ i, Proper (Forall2 R ==> option_Forall2 R) (lookup i).
Proof. repeat intro. by apply Forall2_lookup. Qed. Proof. repeat intro. by apply Forall2_lookup. Qed.
Global Instance: ∀ f i, Global Instance:
Proper (R ==> R) f → Proper (Forall2 R ==> Forall2 R) (alter f i). Proper ((R ==> R) ==> (=) ==> Forall2 R ==> Forall2 R) (alter (M:=list A)).
Proof. repeat intro. eauto using Forall2_alter. Qed. Proof. repeat intro. subst. eauto using Forall2_alter. Qed.
Global Instance: ∀ i, Proper (R ==> Forall2 R ==> Forall2 R) (insert i). Global Instance: ∀ i, Proper (R ==> Forall2 R ==> Forall2 R) (insert i).
Proof. repeat intro. eauto using Forall2_insert. Qed. Proof. repeat intro. eauto using Forall2_insert. Qed.
Global Instance: ∀ i, Global Instance: ∀ i,
...@@ -3357,16 +1635,10 @@ Section Forall2_proper. ...@@ -3357,16 +1635,10 @@ Section Forall2_proper.
Global Instance: ∀ n, Proper (R ==> Forall2 R) (replicate n). Global Instance: ∀ n, Proper (R ==> Forall2 R) (replicate n).
Proof. repeat intro. eauto using Forall2_replicate. Qed. Proof. repeat intro. eauto using Forall2_replicate. Qed.
Global Instance: ∀ n, Proper (Forall2 R ==> Forall2 R) (rotate n).
Proof. repeat intro. eauto using Forall2_rotate. Qed.
Global Instance: ∀ s e, Proper (Forall2 R ==> Forall2 R) (rotate_take s e).
Proof. repeat intro. eauto using Forall2_rotate_take. Qed.
Global Instance: Proper (Forall2 R ==> Forall2 R) reverse. Global Instance: Proper (Forall2 R ==> Forall2 R) reverse.
Proof. repeat intro. eauto using Forall2_reverse. Qed. Proof. repeat intro. eauto using Forall2_reverse. Qed.
Global Instance: Proper (Forall2 R ==> option_Forall2 R) last. Global Instance: Proper (Forall2 R ==> option_Forall2 R) last.
Proof. repeat intro. eauto using Forall2_last. Qed. Proof. repeat intro. eauto using Forall2_last. Qed.
Global Instance: ∀ n, Proper (R ==> Forall2 R ==> Forall2 R) (resize n).
Proof. repeat intro. eauto using Forall2_resize. Qed.
End Forall2_proper. End Forall2_proper.
Section Forall3. Section Forall3.
...@@ -3380,12 +1652,12 @@ Section Forall3. ...@@ -3380,12 +1652,12 @@ Section Forall3.
Lemma Forall3_cons_inv_l x l k k' : Lemma Forall3_cons_inv_l x l k k' :
Forall3 P (x :: l) k k' → ∃ y k2 z k2', 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'. k = y :: k2 ∧ k' = z :: k2' ∧ P x y z ∧ Forall3 P l k2 k2'.
Proof. inversion_clear 1; naive_solver. Qed. Proof. inv 1; naive_solver. Qed.
Lemma Forall3_app_inv_l l1 l2 k k' : Lemma Forall3_app_inv_l l1 l2 k k' :
Forall3 P (l1 ++ l2) k k' → ∃ k1 k2 k1' k2', 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'. k = k1 ++ k2 ∧ k' = k1' ++ k2' ∧ Forall3 P l1 k1 k1' ∧ Forall3 P l2 k2 k2'.
Proof. Proof.
revert k k'. induction l1 as [|x l1 IH]; simpl; inversion_clear 1. revert k k'. induction l1 as [|x l1 IH]; simpl; inv 1.
- by repeat eexists; eauto. - by repeat eexists; eauto.
- by repeat eexists; eauto. - by repeat eexists; eauto.
- edestruct IH as (?&?&?&?&?&?&?&?); eauto; naive_solver. - edestruct IH as (?&?&?&?&?&?&?&?); eauto; naive_solver.
...@@ -3393,12 +1665,12 @@ Section Forall3. ...@@ -3393,12 +1665,12 @@ Section Forall3.
Lemma Forall3_cons_inv_m l y k k' : Lemma Forall3_cons_inv_m l y k k' :
Forall3 P l (y :: k) k' → ∃ x l2 z k2', 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'. l = x :: l2 ∧ k' = z :: k2' ∧ P x y z ∧ Forall3 P l2 k k2'.
Proof. inversion_clear 1; naive_solver. Qed. Proof. inv 1; naive_solver. Qed.
Lemma Forall3_app_inv_m l k1 k2 k' : Lemma Forall3_app_inv_m l k1 k2 k' :
Forall3 P l (k1 ++ k2) k' → ∃ l1 l2 k1' k2', 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'. l = l1 ++ l2 ∧ k' = k1' ++ k2' ∧ Forall3 P l1 k1 k1' ∧ Forall3 P l2 k2 k2'.
Proof. Proof.
revert l k'. induction k1 as [|x k1 IH]; simpl; inversion_clear 1. revert l k'. induction k1 as [|x k1 IH]; simpl; inv 1.
- by repeat eexists; eauto. - by repeat eexists; eauto.
- by repeat eexists; eauto. - by repeat eexists; eauto.
- edestruct IH as (?&?&?&?&?&?&?&?); eauto; naive_solver. - edestruct IH as (?&?&?&?&?&?&?&?); eauto; naive_solver.
...@@ -3406,12 +1678,12 @@ Section Forall3. ...@@ -3406,12 +1678,12 @@ Section Forall3.
Lemma Forall3_cons_inv_r l k z k' : Lemma Forall3_cons_inv_r l k z k' :
Forall3 P l k (z :: k') → ∃ x l2 y k2, 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'. l = x :: l2 ∧ k = y :: k2 ∧ P x y z ∧ Forall3 P l2 k2 k'.
Proof. inversion_clear 1; naive_solver. Qed. Proof. inv 1; naive_solver. Qed.
Lemma Forall3_app_inv_r l k k1' k2' : Lemma Forall3_app_inv_r l k k1' k2' :
Forall3 P l k (k1' ++ k2') → ∃ l1 l2 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'. l = l1 ++ l2 ∧ k = k1 ++ k2 ∧ Forall3 P l1 k1 k1' ∧ Forall3 P l2 k2 k2'.
Proof. Proof.
revert l k. induction k1' as [|x k1' IH]; simpl; inversion_clear 1. revert l k. induction k1' as [|x k1' IH]; simpl; inv 1.
- by repeat eexists; eauto. - by repeat eexists; eauto.
- by repeat eexists; eauto. - by repeat eexists; eauto.
- edestruct IH as (?&?&?&?&?&?&?&?); eauto; naive_solver. - edestruct IH as (?&?&?&?&?&?&?&?); eauto; naive_solver.
...@@ -3455,26 +1727,91 @@ Section Forall3. ...@@ -3455,26 +1727,91 @@ Section Forall3.
Proof. intros Hl. revert i. induction Hl; intros [|]; auto. Qed. Proof. intros Hl. revert i. induction Hl; intros [|]; auto. Qed.
End Forall3. End Forall3.
(** ** Properties of [subseteq] *)
Section subseteq.
Context {A : Type}.
Implicit Types x y z : A.
Implicit Types l k : list A.
Global Instance list_subseteq_po : PreOrder (⊆@{list A}).
Proof. split; firstorder. Qed.
Lemma list_subseteq_nil l : [] ⊆ l.
Proof. intros x. by rewrite elem_of_nil. Qed.
Lemma list_nil_subseteq l : l ⊆ [] → l = [].
Proof.
intro Hl. destruct l as [|x l1]; [done|]. exfalso.
rewrite <-(elem_of_nil x).
apply Hl, elem_of_cons. by left.
Qed.
Lemma list_subseteq_skip x l1 l2 : l1 ⊆ l2 → x :: l1 ⊆ x :: l2.
Proof.
intros Hin y Hy%elem_of_cons.
destruct Hy as [-> | Hy]; [by left|]. right. by apply Hin.
Qed.
Lemma list_subseteq_cons x l1 l2 : l1 ⊆ l2 → l1 ⊆ x :: l2.
Proof. intros Hin y Hy. right. by apply Hin. Qed.
Lemma list_subseteq_app_l l1 l2 l : l1 ⊆ l2 → l1 ⊆ l2 ++ l.
Proof. unfold subseteq, list_subseteq. setoid_rewrite elem_of_app. naive_solver. Qed.
Lemma list_subseteq_app_r l1 l2 l : l1 ⊆ l2 → l1 ⊆ l ++ l2.
Proof. unfold subseteq, list_subseteq. setoid_rewrite elem_of_app. naive_solver. Qed.
Lemma list_subseteq_app_iff_l l1 l2 l :
l1 ++ l2 ⊆ l ↔ l1 ⊆ l ∧ l2 ⊆ l.
Proof. unfold subseteq, list_subseteq. setoid_rewrite elem_of_app. naive_solver. Qed.
Lemma list_subseteq_cons_iff x l1 l2 :
x :: l1 ⊆ l2 ↔ x ∈ l2 ∧ l1 ⊆ l2.
Proof. unfold subseteq, list_subseteq. setoid_rewrite elem_of_cons. naive_solver. Qed.
Lemma list_delete_subseteq i l : delete i l ⊆ l.
Proof.
revert i. induction l as [|x l IHl]; intros i; [done|].
destruct i as [|i];
[by apply list_subseteq_cons|by apply list_subseteq_skip].
Qed.
Lemma list_filter_subseteq P `{!∀ x : A, Decision (P x)} l :
filter P l ⊆ l.
Proof.
induction l as [|x l IHl]; [done|]. rewrite filter_cons.
destruct (decide (P x));
[by apply list_subseteq_skip|by apply list_subseteq_cons].
Qed.
Lemma subseteq_drop n l : drop n l ⊆ l.
Proof. rewrite <-(take_drop n l) at 2. apply list_subseteq_app_r. done. Qed.
Lemma subseteq_take n l : take n l ⊆ l.
Proof. rewrite <-(take_drop n l) at 2. apply list_subseteq_app_l. done. Qed.
Global Instance list_subseteq_Permutation:
Proper ((≡ₚ) ==> (≡ₚ) ==> (↔)) (⊆@{list A}) .
Proof.
intros l1 l2 Hl k1 k2 Hk. apply forall_proper; intros x. by rewrite Hl, Hk.
Qed.
Global Program Instance list_subseteq_dec `{!EqDecision A} : RelDecision (⊆@{list A}) :=
λ xs ys, cast_if (decide (Forall (λ x, x ∈ ys) xs)).
Next Obligation. intros ???. by rewrite Forall_forall. Qed.
Next Obligation. intros ???. by rewrite Forall_forall. Qed.
End subseteq.
(** Setoids *) (** Setoids *)
Section setoid. Section setoid.
Context `{Equiv A}. Context `{Equiv A}.
Implicit Types l k : list A. Implicit Types l k : list A.
Lemma equiv_Forall2 l k : l ≡ k ↔ Forall2 (≡) l k. Lemma list_equiv_Forall2 l k : l ≡ k ↔ Forall2 (≡) l k.
Proof. split; induction 1; constructor; auto. Qed. Proof. split; induction 1; constructor; auto. Qed.
Lemma list_equiv_lookup l k : l ≡ k ↔ ∀ i, l !! i ≡ k !! i. Lemma list_equiv_lookup l k : l ≡ k ↔ ∀ i, l !! i ≡ k !! i.
Proof. Proof.
rewrite equiv_Forall2, Forall2_lookup. rewrite list_equiv_Forall2, Forall2_lookup.
by setoid_rewrite equiv_option_Forall2. by setoid_rewrite option_equiv_Forall2.
Qed. Qed.
Global Instance list_equivalence : Global Instance list_equivalence :
Equivalence (≡@{A}) → Equivalence (≡@{list A}). Equivalence (≡@{A}) → Equivalence (≡@{list A}).
Proof. Proof.
split. split.
- intros l. by apply equiv_Forall2. - intros l. by apply list_equiv_Forall2.
- intros l k; rewrite !equiv_Forall2; by intros. - intros l k; rewrite !list_equiv_Forall2; by intros.
- intros l1 l2 l3; rewrite !equiv_Forall2; intros; by trans l2. - intros l1 l2 l3; rewrite !list_equiv_Forall2; intros; by trans l2.
Qed. Qed.
Global Instance list_leibniz `{!LeibnizEquiv A} : LeibnizEquiv (list A). Global Instance list_leibniz `{!LeibnizEquiv A} : LeibnizEquiv (list A).
Proof. induction 1; f_equal; fold_leibniz; auto. Qed. Proof. induction 1; f_equal; fold_leibniz; auto. Qed.
...@@ -3494,12 +1831,14 @@ Section setoid. ...@@ -3494,12 +1831,14 @@ Section setoid.
Global Instance list_lookup_proper i : Proper ((≡@{list A}) ==> (≡)) (lookup i). Global Instance list_lookup_proper i : Proper ((≡@{list A}) ==> (≡)) (lookup i).
Proof. induction i; destruct 1; simpl; try constructor; auto. Qed. Proof. induction i; destruct 1; simpl; try constructor; auto. Qed.
Global Instance list_lookup_total_proper `{!Inhabited A} i : Global Instance list_lookup_total_proper `{!Inhabited A} i :
Proper (≡) inhabitant → Proper (≡@{A}) inhabitant →
Proper ((≡@{list A}) ==> (≡)) (lookup_total i). Proper ((≡@{list A}) ==> (≡)) (lookup_total i).
Proof. intros ?. induction i; destruct 1; simpl; auto. Qed. Proof. intros ?. induction i; destruct 1; simpl; auto. Qed.
Global Instance list_alter_proper f i : Global Instance list_alter_proper :
Proper ((≡) ==> (≡)) f → Proper ((≡) ==> (≡@{list A})) (alter f i). Proper (((≡) ==> (≡)) ==> (=) ==> (≡) ==> (≡@{list A})) alter.
Proof. intros. induction i; destruct 1; constructor; eauto. Qed. Proof.
intros f1 f2 Hf i ? <-. induction i; destruct 1; constructor; eauto.
Qed.
Global Instance list_insert_proper i : Global Instance list_insert_proper i :
Proper ((≡) ==> (≡) ==> (≡@{list A})) (insert i). Proper ((≡) ==> (≡) ==> (≡@{list A})) (insert i).
Proof. intros ???; induction i; destruct 1; constructor; eauto. Qed. Proof. intros ???; induction i; destruct 1; constructor; eauto. Qed.
...@@ -3516,13 +1855,9 @@ Section setoid. ...@@ -3516,13 +1855,9 @@ Section setoid.
Proof. destruct 1; repeat constructor; auto. Qed. Proof. destruct 1; repeat constructor; auto. Qed.
Global Instance list_filter_proper P `{∀ x, Decision (P x)} : Global Instance list_filter_proper P `{∀ x, Decision (P x)} :
Proper ((≡) ==> iff) P → Proper ((≡) ==> (≡@{list A})) (filter P). Proper ((≡) ==> iff) P → Proper ((≡) ==> (≡@{list A})) (filter P).
Proof. intros ???. rewrite !equiv_Forall2. by apply Forall2_filter. Qed. Proof. intros ???. rewrite !list_equiv_Forall2. by apply Forall2_filter. Qed.
Global Instance replicate_proper n : Proper ((≡@{A}) ==> (≡)) (replicate n). Global Instance replicate_proper n : Proper ((≡@{A}) ==> (≡)) (replicate n).
Proof. induction n; constructor; auto. Qed. Proof. induction n; constructor; auto. Qed.
Global Instance rotate_proper n : Proper ((≡@{list A}) ==> (≡)) (rotate n).
Proof. intros ??. rewrite !equiv_Forall2. by apply Forall2_rotate. Qed.
Global Instance rotate_take_proper s e : Proper ((≡@{list A}) ==> (≡)) (rotate_take s e).
Proof. intros ??. rewrite !equiv_Forall2. by apply Forall2_rotate_take. Qed.
Global Instance reverse_proper : Proper ((≡) ==> (≡@{list A})) reverse. Global Instance reverse_proper : Proper ((≡) ==> (≡@{list A})) reverse.
Proof. Proof.
induction 1; rewrite ?reverse_cons; simpl; [constructor|]. induction 1; rewrite ?reverse_cons; simpl; [constructor|].
...@@ -3530,22 +1865,21 @@ Section setoid. ...@@ -3530,22 +1865,21 @@ Section setoid.
Qed. Qed.
Global Instance last_proper : Proper ((≡) ==> (≡)) (@last A). Global Instance last_proper : Proper ((≡) ==> (≡)) (@last A).
Proof. induction 1 as [|????? []]; simpl; repeat constructor; auto. Qed. Proof. induction 1 as [|????? []]; simpl; repeat constructor; auto. Qed.
Global Instance resize_proper n : Proper ((≡) ==> (≡) ==> (≡@{list A})) (resize n).
Proof.
induction n; destruct 2; simpl; repeat (constructor || f_equiv); auto.
Qed.
Lemma nil_equiv_eq mx : mx ≡ [] ↔ mx = []. Global Instance cons_equiv_inj : Inj2 (≡) (≡) (≡) (@cons A).
Proof. split; [by inversion_clear 1|intros ->; constructor]. Qed. Proof. inv 1; auto. Qed.
Lemma nil_equiv_eq l : l ≡ [] ↔ l = [].
Proof. split; [by inv 1|intros ->; constructor]. Qed.
Lemma cons_equiv_eq l x k : l ≡ x :: k ↔ ∃ x' k', l = x' :: k' ∧ x' ≡ x ∧ k' ≡ k. Lemma cons_equiv_eq l x k : l ≡ x :: k ↔ ∃ x' k', l = x' :: k' ∧ x' ≡ x ∧ k' ≡ k.
Proof. split; [inversion 1; naive_solver|naive_solver (by constructor)]. Qed. Proof. split; [inv 1; naive_solver|naive_solver (by constructor)]. Qed.
Lemma list_singleton_equiv_eq l x : l ≡ [x] ↔ ∃ x', l = [x'] ∧ x' ≡ x. Lemma list_singleton_equiv_eq l x : l ≡ [x] ↔ ∃ x', l = [x'] ∧ x' ≡ x.
Proof. rewrite cons_equiv_eq. setoid_rewrite nil_equiv_eq. naive_solver. Qed. Proof. rewrite cons_equiv_eq. setoid_rewrite nil_equiv_eq. naive_solver. Qed.
Lemma app_equiv_eq l k1 k2 : Lemma app_equiv_eq l k1 k2 :
l ≡ k1 ++ k2 ↔ ∃ k1' k2', l = k1' ++ k2' ∧ k1' ≡ k1 ∧ k2' ≡ k2. l ≡ k1 ++ k2 ↔ ∃ k1' k2', l = k1' ++ k2' ∧ k1' ≡ k1 ∧ k2' ≡ k2.
Proof. Proof.
split; [|intros (?&?&->&?&?); by f_equiv]. split; [|intros (?&?&->&?&?); by f_equiv].
setoid_rewrite equiv_Forall2. rewrite Forall2_app_inv_r. naive_solver. setoid_rewrite list_equiv_Forall2. rewrite Forall2_app_inv_r. naive_solver.
Qed. Qed.
Lemma equiv_Permutation l1 l2 l3 : Lemma equiv_Permutation l1 l2 l3 :
...@@ -3570,1002 +1904,6 @@ Section setoid. ...@@ -3570,1002 +1904,6 @@ Section setoid.
Qed. Qed.
End setoid. End setoid.
(** * Properties of the [find] function *)
Section find.
Context {A} (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 ∧ ∀ j y, l !! j = Some y → j < i → ¬P y.
Proof.
revert i. induction l as [|y l IH]; intros i; csimpl; [naive_solver|].
case_decide.
- split; [naive_solver lia|]. intros (Hi&HP&Hlt).
destruct i as [|i]; simplify_eq/=; [done|].
destruct (Hlt 0 y); naive_solver lia.
- split.
+ intros ([i' x']&Hl&?)%fmap_Some; simplify_eq/=.
apply IH in Hl as (?&?&Hlt). split_and!; [done..|].
intros [|j] ?; naive_solver lia.
+ intros (?&?&Hlt). destruct i as [|i]; simplify_eq/=; [done|].
rewrite (proj2 (IH i)); [done|]. split_and!; [done..|].
intros j z ???. destruct (Hlt (S j) z); naive_solver lia.
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.
Lemma list_find_None l :
list_find P l = None ↔ Forall (λ x, ¬P x) l.
Proof.
rewrite eq_None_not_Some, Forall_forall. split.
- intros Hl x Hx HP. destruct Hl. eauto using list_find_elem_of.
- intros HP [[i x] (?%elem_of_list_lookup_2&?&?)%list_find_Some]; naive_solver.
Qed.
Lemma list_find_app_None l1 l2 :
list_find P (l1 ++ l2) = None ↔ list_find P l1 = None ∧ list_find P l2 = None.
Proof. by rewrite !list_find_None, Forall_app. Qed.
Lemma list_find_app_Some l1 l2 i x :
list_find P (l1 ++ l2) = Some (i,x) ↔
list_find P l1 = Some (i,x) ∨
length l1 ≤ i ∧ list_find P l1 = None ∧ list_find P l2 = Some (i - length l1,x).
Proof.
split.
- intros ([?|[??]]%lookup_app_Some&?&Hleast)%list_find_Some.
+ left. apply list_find_Some; eauto using lookup_app_l_Some.
+ right. split; [lia|]. split.
{ apply list_find_None, Forall_lookup. intros j z ??.
assert (j < length l1) by eauto using lookup_lt_Some.
naive_solver eauto using lookup_app_l_Some with lia. }
apply list_find_Some. split_and!; [done..|].
intros j z ??. eapply (Hleast (length l1 + j)); [|lia].
by rewrite lookup_app_r, minus_plus by lia.
- intros [(?&?&Hleast)%list_find_Some|(?&Hl1&(?&?&Hleast)%list_find_Some)].
+ apply list_find_Some. split_and!; [by auto using lookup_app_l_Some..|].
assert (i < length l1) by eauto using lookup_lt_Some.
intros j y ?%lookup_app_Some; naive_solver eauto with lia.
+ rewrite list_find_Some, lookup_app_Some. split_and!; [by auto..|].
intros j y [?|?]%lookup_app_Some ?; [|naive_solver auto with lia].
by eapply (Forall_lookup_1 (not ∘ P) l1); [by apply list_find_None|..].
Qed.
Lemma list_find_app_l l1 l2 i x:
list_find P l1 = Some (i, x) → list_find P (l1 ++ l2) = Some (i, x).
Proof. rewrite list_find_app_Some. auto. Qed.
Lemma list_find_app_r l1 l2:
list_find P l1 = None →
list_find P (l1 ++ l2) = prod_map (λ x, x + length l1) id <$> list_find P l2.
Proof.
intros. apply option_eq; intros [j y]. rewrite list_find_app_Some. split.
- intros [?|(?&?&->)]; naive_solver auto with f_equal lia.
- intros ([??]&->&?)%fmap_Some; naive_solver auto with f_equal lia.
Qed.
Lemma list_find_insert_Some l i j x y :
list_find P (<[i:=x]> l) = Some (j,y) ↔
(j < i ∧ list_find P l = Some (j,y)) ∨
(i = j ∧ x = y ∧ j < length l ∧ P x ∧ ∀ k z, l !! k = Some z → k < i → ¬P z) ∨
(i < j ∧ ¬P x ∧ list_find P l = Some (j,y) ∧ ∀ z, l !! i = Some z → ¬P z) ∨
(∃ z, i < j ∧ ¬P x ∧ P y ∧ P z ∧ l !! i = Some z ∧ l !! j = Some y ∧
∀ k z, l !! k = Some z → k ≠ i → k < j → ¬P z).
Proof.
split.
- intros ([(->&->&?)|[??]]%list_lookup_insert_Some&?&Hleast)%list_find_Some.
{ right; left. split_and!; [done..|]. intros k z ??.
apply (Hleast k); [|lia]. by rewrite list_lookup_insert_ne by lia. }
assert (j < i ∨ i < j) as [?|?] by lia.
{ left. rewrite list_find_Some. split_and!; [by auto..|]. intros k z ??.
apply (Hleast k); [|lia]. by rewrite list_lookup_insert_ne by lia. }
right; right. assert (j < length l) by eauto using lookup_lt_Some.
destruct (lookup_lt_is_Some_2 l i) as [z ?]; [lia|].
destruct (decide (P z)).
{ right. exists z. split_and!; [done| |done..|].
+ apply (Hleast i); [|done]. by rewrite list_lookup_insert by lia.
+ intros k z' ???.
apply (Hleast k); [|lia]. by rewrite list_lookup_insert_ne by lia. }
left. split_and!; [done|..|naive_solver].
+ apply (Hleast i); [|done]. by rewrite list_lookup_insert by lia.
+ apply list_find_Some. split_and!; [by auto..|]. intros k z' ??.
destruct (decide (k = i)) as [->|]; [naive_solver|].
apply (Hleast k); [|lia]. by rewrite list_lookup_insert_ne by lia.
- intros [[? Hl]|[(->&->&?&?&Hleast)|[(?&?&Hl&Hnot)|(z&?&?&?&?&?&?&?Hleast)]]];
apply list_find_Some.
+ apply list_find_Some in Hl as (?&?&Hleast).
rewrite list_lookup_insert_ne by lia. split_and!; [done..|].
intros k z [(->&->&?)|[??]]%list_lookup_insert_Some; eauto with lia.
+ rewrite list_lookup_insert by done. split_and!; [by auto..|].
intros k z [(->&->&?)|[??]]%list_lookup_insert_Some; eauto with lia.
+ apply list_find_Some in Hl as (?&?&Hleast).
rewrite list_lookup_insert_ne by lia. split_and!; [done..|].
intros k z [(->&->&?)|[??]]%list_lookup_insert_Some; eauto with lia.
+ rewrite list_lookup_insert_ne by lia. split_and!; [done..|].
intros k z' [(->&->&?)|[??]]%list_lookup_insert_Some; eauto with lia.
Qed.
Lemma list_find_fmap {B : Type} (f : B → A) (l : list B) :
list_find P (f <$> l) = prod_map id f <$> list_find (P ∘ f) l.
Proof.
induction l as [|x l IH]; [done|]; csimpl. (* csimpl re-folds fmap *)
case_decide; [done|].
rewrite IH. by destruct (list_find (P ∘ f) l).
Qed.
Lemma list_find_ext (Q : A → Prop) `{∀ x, Decision (Q x)} l :
(∀ x, P x ↔ Q x) →
list_find P l = list_find Q l.
Proof.
intros HPQ. induction l as [|x l IH]; simpl; [done|].
by rewrite (decide_iff (P x) (Q x)), IH by done.
Qed.
End find.
(** * 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).
Implicit Types l : list A.
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 list_fmap_proper `{!Equiv A, !Equiv B} :
Proper ((≡) ==> (≡)) f → Proper ((≡) ==> (≡)) (fmap f).
Proof. induction 2; simpl; [constructor|solve_proper]. Qed.
Global Instance fmap_inj: Inj (=) (=) f → Inj (=@{list A}) (=) (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 list_fmap_singleton x : f <$> [x] = [f x].
Proof. reflexivity. Qed.
Lemma fmap_app l1 l2 : f <$> l1 ++ l2 = (f <$> l1) ++ (f <$> l2).
Proof. by induction l1; f_equal/=. Qed.
Lemma fmap_snoc l x : f <$> l ++ [x] = (f <$> l) ++ [f x].
Proof. rewrite fmap_app, list_fmap_singleton. done. 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 list_fmap_alt l :
f <$> l = omap (λ x, Some (f x)) l.
Proof. induction l; simplify_eq/=; done. 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_total_fmap `{!Inhabited A, !Inhabited B} l i :
i < length l → (f <$> l) !!! i = f (l !!! i).
Proof.
intros [x Hx]%lookup_lt_is_Some_2.
by rewrite !list_lookup_total_alt, list_lookup_fmap, Hx.
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_fmap_insert l i x: f <$> <[i:=x]>l = <[i:=f x]>(f <$> l).
Proof. revert i. by induction l; intros [|i]; f_equal/=. 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 elem_of_list_fmap_2_inj `{!Inj (=) (=) f} l x : f x ∈ f <$> l → x ∈ l.
Proof.
intros (y, (E, I))%elem_of_list_fmap_2. by rewrite (inj f) in I.
Qed.
Lemma elem_of_list_fmap_inj `{!Inj (=) (=) f} l x : f x ∈ f <$> l ↔ x ∈ l.
Proof.
naive_solver eauto using elem_of_list_fmap_1, elem_of_list_fmap_2_inj.
Qed.
(** A version of [NoDup_fmap_2] that does not require [f] to be injective for
*all* inputs. *)
Lemma NoDup_fmap_2_strong l :
(∀ x y, x ∈ l → y ∈ l → f x = f y → x = y) →
NoDup l →
NoDup (f <$> l).
Proof.
intros Hinj. induction 1 as [|x l ?? IH]; simpl; constructor.
- intros [y [Hxy ?]]%elem_of_list_fmap.
apply Hinj in Hxy; [by subst|by constructor..].
- apply IH. clear- Hinj.
intros x' y Hx' Hy. apply Hinj; by constructor.
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. apply NoDup_fmap_2_strong. intros ?? _ _. apply (inj f). 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) l k :
Forall2 P (f <$> l) k ↔ Forall2 (P ∘ f) l k.
Proof.
split; revert k; induction l; inversion_clear 1; constructor; auto.
Qed.
Lemma Forall2_fmap_r {C} (P : C → B → Prop) k l :
Forall2 P k (f <$> l) ↔ Forall2 (λ x, P x ∘ f) k l.
Proof.
split; revert k; induction l; inversion_clear 1; constructor; auto.
Qed.
Lemma Forall2_fmap_1 {C D} (g : C → D) (P : B → D → Prop) l k :
Forall2 P (f <$> l) (g <$> k) → Forall2 (λ x1 x2, P (f x1) (g x2)) l k.
Proof. revert k; induction l; intros [|??]; inversion_clear 1; auto. Qed.
Lemma Forall2_fmap_2 {C D} (g : C → D) (P : B → D → Prop) l k :
Forall2 (λ x1 x2, P (f x1) (g x2)) l k → Forall2 P (f <$> l) (g <$> k).
Proof. induction 1; csimpl; auto. Qed.
Lemma Forall2_fmap {C D} (g : C → D) (P : B → D → Prop) l k :
Forall2 P (f <$> l) (g <$> k) ↔ Forall2 (λ x1 x2, P (f x1) (g x2)) l k.
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 omap.
Context {A B : Type} (f : A → option B).
Implicit Types l : list A.
Lemma list_fmap_omap {C} (g : B → C) l :
g <$> omap f l = omap (λ x, g <$> (f x)) l.
Proof.
induction l as [|x y IH]; [done|]. csimpl.
destruct (f x); csimpl; [|done]. by f_equal.
Qed.
Lemma list_omap_ext {A'} (g : A' → option B) l1 (l2 : list A') :
Forall2 (λ a b, f a = g b) l1 l2 →
omap f l1 = omap g l2.
Proof.
induction 1 as [|x y l l' Hfg ? IH]; [done|].
csimpl. rewrite Hfg. destruct (g y); [|done]. by f_equal.
Qed.
Global Instance list_omap_proper `{!Equiv A, !Equiv B} :
Proper ((≡) ==> (≡)) f → Proper ((≡) ==> (≡)) (omap f).
Proof.
intros Hf. induction 1 as [|x1 x2 l1 l2 Hx Hl]; csimpl; [constructor|].
destruct (Hf _ _ Hx); by repeat f_equiv.
Qed.
Lemma elem_of_list_omap l y : 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.
Global Instance omap_Permutation : Proper ((≡ₚ) ==> (≡ₚ)) (omap f).
Proof. induction 1; simpl; repeat case_match; econstructor; eauto. Qed.
End omap.
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 list_bind_proper `{!Equiv A, !Equiv B} :
Proper ((≡) ==> (≡)) f → Proper ((≡) ==> (≡)) (mbind f).
Proof. induction 2; simpl; [constructor|solve_proper]. 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}.
Global Instance list_join_proper `{!Equiv A} : Proper ((≡) ==> (≡)) (mjoin (A:=A)).
Proof. induction 1; simpl; [constructor|solve_proper]. Qed.
Lemma list_join_bind (ls : list (list A)) : mjoin ls = ls ≫= id.
Proof. by induction ls; f_equal/=. Qed.
Global Instance join_Permutation : Proper ((≡ₚ@{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 : list A, 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 as [|?? IHl]; simpl; rewrite ?Hfg, ?IHl. Qed.
Global Instance mapM_proper `{!Equiv A, !Equiv B} :
Proper ((≡) ==> (≡)) f → Proper ((≡) ==> (≡)) (mbind f).
Proof. induction 2; simpl; [solve_proper|constructor]. 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_Forall_Some (g : B → A) (l : list B) :
Forall (λ x, f (g x) = Some x) l → mapM f (g <$> l) = Some l.
Proof. by induction 1; simpl; simplify_option_eq. 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 apply mapM_fmap_Forall_Some, Forall_true. Qed.
Lemma mapM_fmap_Forall2_Some_inv (g : B → A) (l : list A) (k : list B) :
mapM f l = Some k → Forall2 (λ x y, f x = Some y → g y = x) l k → g <$> k = l.
Proof. induction 2; simplify_option_eq; naive_solver. Qed.
Lemma mapM_fmap_Some_inv (g : B → A) (l : list A) (k : list B) :
mapM f l = Some k → (∀ x y, f x = Some y → g y = x) → g <$> k = l.
Proof. eauto using mapM_fmap_Forall2_Some_inv, Forall2_true, mapM_length. Qed.
End mapM.
Lemma imap_const {A B} (f : A → B) l : imap (const f) l = f <$> l.
Proof. induction l; f_equal/=; auto. Qed.
Section imap.
Context {A B : Type} (f : nat → A → B).
Lemma imap_ext g 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_equal/=; eauto. Qed.
Global Instance imap_proper `{!Equiv A, !Equiv B} :
(∀ i, Proper ((≡) ==> (≡)) (f i)) → Proper ((≡) ==> (≡)) (imap f).
Proof.
intros Hf l1 l2 Hl. revert f Hf.
induction Hl; intros f Hf; simpl; [constructor|repeat f_equiv; naive_solver].
Qed.
Lemma imap_nil : imap f [] = [].
Proof. done. Qed.
Lemma imap_app l1 l2 :
imap f (l1 ++ l2) = imap f l1 ++ imap (λ n, f (length l1 + n)) l2.
Proof.
revert f. induction l1 as [|x l1 IH]; intros f; f_equal/=; auto.
by rewrite IH.
Qed.
Lemma imap_cons x l : imap f (x :: l) = f 0 x :: imap (f ∘ S) l.
Proof. done. Qed.
Lemma imap_fmap {C} (g : C → A) l : imap f (g <$> l) = imap (λ n, f n ∘ g) l.
Proof. revert f. induction l; intros; f_equal/=; eauto. Qed.
Lemma fmap_imap {C} (g : B → C) l : g <$> imap f l = imap (λ n, g ∘ f n) l.
Proof. revert f. induction l; intros; f_equal/=; eauto. Qed.
Lemma list_lookup_imap l i : imap f l !! i = f i <$> l !! i.
Proof.
revert f i. induction l as [|x l IH]; intros f [|i]; f_equal/=; auto.
by rewrite IH.
Qed.
Lemma list_lookup_total_imap `{!Inhabited A, !Inhabited B} l i :
i < length l → imap f l !!! i = f i (l !!! i).
Proof.
intros [x Hx]%lookup_lt_is_Some_2.
by rewrite !list_lookup_total_alt, list_lookup_imap, Hx.
Qed.
Lemma imap_length l : length (imap f l) = length l.
Proof. revert f. induction l; simpl; eauto. Qed.
Lemma elem_of_lookup_imap_1 l x :
x ∈ imap f l → ∃ i y, x = f i y ∧ l !! i = Some y.
Proof.
intros [i Hin]%elem_of_list_lookup. rewrite list_lookup_imap in Hin.
simplify_option_eq; naive_solver.
Qed.
Lemma elem_of_lookup_imap_2 l x i : l !! i = Some x → f i x ∈ imap f l.
Proof.
intros Hl. rewrite elem_of_list_lookup.
exists i. by rewrite list_lookup_imap, Hl.
Qed.
Lemma elem_of_lookup_imap l x :
x ∈ imap f l ↔ ∃ i y, x = f i y ∧ l !! i = Some y.
Proof. naive_solver eauto using elem_of_lookup_imap_1, elem_of_lookup_imap_2. Qed.
End imap.
(** ** 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_fmap {A B C} (f : B → A → A) x (l : list C) g :
foldr f x (g <$> l) = foldr (λ b a, f (g b) a) x l.
Proof. induction l; f_equal/=; auto. Qed.
Lemma foldr_ext {A B} (f1 f2 : B → A → A) x1 x2 l1 l2 :
(∀ b a, f1 b a = f2 b a) → l1 = l2 → x1 = x2 → foldr f1 x1 l1 = foldr f2 x2 l2.
Proof. intros Hf -> ->. induction l2 as [|x l2 IH]; f_equal/=; by rewrite Hf, IH. Qed.
Lemma foldr_permutation {A B} (R : relation B) `{!PreOrder R}
(f : A → B → B) (b : B) `{Hf : !∀ x, Proper (R ==> R) (f x)} (l1 l2 : list A) :
(∀ j1 a1 j2 a2 b,
j1 ≠ j2 → l1 !! j1 = Some a1 → l1 !! j2 = Some a2 →
R (f a1 (f a2 b)) (f a2 (f a1 b))) →
l1 ≡ₚ l2 → R (foldr f b l1) (foldr f b l2).
Proof.
intros Hf'. induction 1 as [|x l1 l2 _ IH|x y l|l1 l2 l3 Hl12 IH _ IH']; simpl.
- done.
- apply Hf, IH; eauto.
- apply (Hf' 0 _ 1); eauto.
- etrans; [eapply IH, Hf'|].
apply IH'; intros j1 a1 j2 a2 b' ???.
symmetry in Hl12; apply Permutation_inj in Hl12 as [_ (g&?&Hg)].
apply (Hf' (g j1) _ (g j2)); [naive_solver|by rewrite <-Hg..].
Qed.
Lemma foldr_permutation_proper {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. intros l1 l2 Hl. apply foldr_permutation; auto. Qed.
Global Instance foldr_permutation_proper' {A} (R : relation A) `{!PreOrder R}
(f : A → A → A) (a : A) `{!∀ a, Proper (R ==> R) (f a), !Assoc R f, !Comm R f} :
Proper ((≡ₚ) ==> R) (foldr f a).
Proof.
apply (foldr_permutation_proper R f); [solve_proper|].
assert (Proper (R ==> R ==> R) f).
{ intros a1 a2 Ha b1 b2 Hb. by rewrite Hb, (comm f a1), Ha, (comm f). }
intros a1 a2 b.
by rewrite (assoc f), (comm f _ b), (assoc f), (comm f b), (comm f _ a2).
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.
Global Instance zip_with_proper `{!Equiv A, !Equiv B, !Equiv C} :
Proper ((≡) ==> (≡) ==> (≡)) f → Proper ((≡) ==> (≡) ==> (≡)) (zip_with f).
Proof. induction 2; destruct 1; simpl; [constructor..|repeat f_equiv; auto]. Qed.
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 lookup_total_zip_with `{!Inhabited A, !Inhabited B, !Inhabited C} l k i :
i < length l → i < length k → zip_with f l k !!! i = f (l !!! i) (k !!! i).
Proof.
intros [x Hx]%lookup_lt_is_Some_2 [y Hy]%lookup_lt_is_Some_2.
by rewrite !list_lookup_total_alt, lookup_zip_with, Hx, Hy.
Qed.
Lemma lookup_zip_with_Some l k i z :
zip_with f l k !! i = Some z
↔ ∃ x y, z = f x y ∧ l !! i = Some x ∧ k !! i = Some y.
Proof. rewrite lookup_zip_with. destruct (l !! i), (k !! i); naive_solver. 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 = uncurry 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) = uncurry 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.
Lemma elem_of_lookup_zip_with_1 l k (z : C) :
z ∈ zip_with f l k → ∃ i x y, z = f x y ∧ l !! i = Some x ∧ k !! i = Some y.
Proof.
intros [i Hin]%elem_of_list_lookup. rewrite lookup_zip_with in Hin.
simplify_option_eq; naive_solver.
Qed.
Lemma elem_of_lookup_zip_with_2 l k x y (z : C) i :
l !! i = Some x → k !! i = Some y → f x y ∈ zip_with f l k.
Proof.
intros Hl Hk. rewrite elem_of_list_lookup.
exists i. by rewrite lookup_zip_with, Hl, Hk.
Qed.
Lemma elem_of_lookup_zip_with l k (z : C) :
z ∈ zip_with f l k ↔ ∃ i x y, z = f x y ∧ l !! i = Some x ∧ k !! i = Some y.
Proof.
naive_solver eauto using
elem_of_lookup_zip_with_1, elem_of_lookup_zip_with_2.
Qed.
Lemma elem_of_zip_with l k (z : C) :
z ∈ zip_with f l k → ∃ x y, z = f x y ∧ x ∈ l ∧ y ∈ k.
Proof.
intros ?%elem_of_lookup_zip_with.
naive_solver eauto using elem_of_list_lookup_2.
Qed.
End zip_with.
Lemma zip_with_diag {A C} (f : A → A → C) l :
zip_with f l l = (λ x, f x x) <$> l.
Proof. induction l as [|?? IH]; [done|]. simpl. rewrite IH. done. Qed.
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.
Lemma elem_of_zip_l x1 x2 l k :
(x1, x2) ∈ zip l k → x1 ∈ l.
Proof. intros ?%elem_of_zip_with. naive_solver. Qed.
Lemma elem_of_zip_r x1 x2 l k :
(x1, x2) ∈ zip l k → x2 ∈ k.
Proof. intros ?%elem_of_zip_with. naive_solver. Qed.
End zip.
Lemma zip_diag {A} (l : list A) :
zip l l = (λ x, (x, x)) <$> l.
Proof. apply zip_with_diag. Qed.
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.
Lemma TCForall_Forall {A} (P : A → Prop) xs : TCForall P xs ↔ Forall P xs. Lemma TCForall_Forall {A} (P : A → Prop) xs : TCForall P xs ↔ Forall P xs.
Proof. split; induction 1; constructor; auto. Qed. Proof. split; induction 1; constructor; auto. Qed.
...@@ -4573,415 +1911,9 @@ Global Instance TCForall_app {A} (P : A → Prop) xs ys : ...@@ -4573,415 +1911,9 @@ Global Instance TCForall_app {A} (P : A → Prop) xs ys :
TCForall P xs → TCForall P ys → TCForall P (xs ++ ys). TCForall P xs → TCForall P ys → TCForall P (xs ++ ys).
Proof. rewrite !TCForall_Forall. apply Forall_app_2. Qed. Proof. rewrite !TCForall_Forall. apply Forall_app_2. Qed.
Lemma TCForall2_Forall2 {A B} (P : A → B → Prop) xs ys : TCForall2 P xs ys ↔ Forall2 P xs ys. Lemma TCForall2_Forall2 {A B} (P : A → B → Prop) xs ys :
TCForall2 P xs ys ↔ Forall2 P xs ys.
Proof. split; induction 1; constructor; auto. Qed. Proof. split; induction 1; constructor; auto. Qed.
Lemma TCExists_Exists {A} (P : A → Prop) l : TCExists P l ↔ Exists P l. Lemma TCExists_Exists {A} (P : A → Prop) l : TCExists P l ↔ Exists P l.
Proof. split; induction 1; constructor; solve [auto]. Qed. Proof. split; induction 1; constructor; solve [auto]. Qed.
Section positives_flatten_unflatten.
Local Open Scope positive_scope.
Lemma positives_flatten_go_app xs acc :
positives_flatten_go xs acc = acc ++ positives_flatten_go xs 1.
Proof.
revert acc.
induction xs as [|x xs IH]; intros acc; simpl.
- reflexivity.
- rewrite IH.
rewrite (IH (6 ++ _)).
rewrite 2!(assoc_L (++)).
reflexivity.
Qed.
Lemma positives_unflatten_go_app p suffix xs acc :
positives_unflatten_go (suffix ++ Preverse (Pdup p)) xs acc =
positives_unflatten_go suffix xs (acc ++ p).
Proof.
revert suffix acc.
induction p as [p IH|p IH|]; intros acc suffix; simpl.
- rewrite 2!Preverse_xI.
rewrite 2!(assoc_L (++)).
rewrite IH.
reflexivity.
- rewrite 2!Preverse_xO.
rewrite 2!(assoc_L (++)).
rewrite IH.
reflexivity.
- reflexivity.
Qed.
Lemma positives_unflatten_flatten_go suffix xs acc :
positives_unflatten_go (suffix ++ positives_flatten_go xs 1) acc 1 =
positives_unflatten_go suffix (xs ++ acc) 1.
Proof.
revert suffix acc.
induction xs as [|x xs IH]; intros suffix acc; simpl.
- reflexivity.
- rewrite positives_flatten_go_app.
rewrite (assoc_L (++)).
rewrite IH.
rewrite (assoc_L (++)).
rewrite positives_unflatten_go_app.
simpl.
rewrite (left_id_L 1 (++)).
reflexivity.
Qed.
Lemma positives_unflatten_flatten xs :
positives_unflatten (positives_flatten xs) = Some xs.
Proof.
unfold positives_flatten, positives_unflatten.
replace (positives_flatten_go xs 1)
with (1 ++ positives_flatten_go xs 1)
by apply (left_id_L 1 (++)).
rewrite positives_unflatten_flatten_go.
simpl.
rewrite (right_id_L [] (++)%list).
reflexivity.
Qed.
Lemma positives_flatten_app xs ys :
positives_flatten (xs ++ ys) = positives_flatten xs ++ positives_flatten ys.
Proof.
unfold positives_flatten.
revert ys.
induction xs as [|x xs IH]; intros ys; simpl.
- rewrite (left_id_L 1 (++)).
reflexivity.
- rewrite positives_flatten_go_app, (positives_flatten_go_app xs).
rewrite IH.
rewrite (assoc_L (++)).
reflexivity.
Qed.
Lemma positives_flatten_cons x xs :
positives_flatten (x :: xs) = 1~1~0 ++ Preverse (Pdup x) ++ positives_flatten xs.
Proof.
change (x :: xs) with ([x] ++ xs)%list.
rewrite positives_flatten_app.
rewrite (assoc_L (++)).
reflexivity.
Qed.
Lemma positives_flatten_suffix (l k : list positive) :
l `suffix_of` k → ∃ q, positives_flatten k = q ++ positives_flatten l.
Proof.
intros [l' ->].
exists (positives_flatten l').
apply positives_flatten_app.
Qed.
Lemma positives_flatten_suffix_eq p1 p2 (xs ys : list positive) :
length xs = length ys →
p1 ++ positives_flatten xs = p2 ++ positives_flatten ys →
xs = ys.
Proof.
revert p1 p2 ys; induction xs as [|x xs IH];
intros p1 p2 [|y ys] ?; simplify_eq/=; auto.
rewrite !positives_flatten_cons, !(assoc _); intros Hl.
assert (xs = ys) as <- by eauto; clear IH; f_equal.
apply (inj (.++ positives_flatten xs)) in Hl.
rewrite 2!Preverse_Pdup in Hl.
apply (Pdup_suffix_eq _ _ p1 p2) in Hl.
by apply (inj Preverse).
Qed.
End positives_flatten_unflatten.
(** * 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.
Global Arguments rnil {_} : assert.
Global Arguments rnode {_} _ : assert.
Global Arguments rapp {_} _ _ : assert.
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 => default [] (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 E1 : 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 ≫= default [] ∘ (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;
compute_done.
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;
compute_done.
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 : _ =@{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_1 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_diag
| |- 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).
stdpp/list_tactics.v 0 → 100644
View file @ 9274984b
From Coq Require Export Permutation.
From stdpp Require Export numbers base option list_basics list_relations list_monad.
From stdpp Require Import options.
(** * Reflection 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.
Global Arguments rnil {_} : assert.
Global Arguments rnode {_} _ : assert.
Global Arguments rapp {_} _ _ : assert.
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 => default [] (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 E1 : 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 ≫= default [] ∘ (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;
compute_done.
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;
compute_done.
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 length_fmap || rewrite length_app);
repeat match goal with
| H : _ =@{list _} _ |- _ => apply (f_equal length) in H
| H : Forall2 _ _ _ |- _ => apply Forall2_length in H
| H : context[length (_ <$> _)] |- _ => rewrite length_fmap 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_length' by solve_length
| |- context [drop _ (_ ++ _)] => rewrite drop_app_length' by solve_length
| H : context [zip_with _ (_ ++ _) (_ ++ _)] |- _ =>
rewrite zip_with_app in H by solve_length
| H : context [take _ (_ ++ _)] |- _ =>
rewrite take_app_length' in H by solve_length
| H : context [drop _ (_ ++ _)] |- _ =>
rewrite drop_app_length' 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_1 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_diag
| |- 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).
theories/listset.v → stdpp/listset.v
View file @ 9274984b
...@@ -28,7 +28,7 @@ Lemma listset_empty_alt X : X ≡ ∅ ↔ listset_car X = []. ...@@ -28,7 +28,7 @@ Lemma listset_empty_alt X : X ≡ ∅ ↔ listset_car X = [].
Proof. Proof.
destruct X as [l]; split; [|by intros; simplify_eq/=]. destruct X as [l]; split; [|by intros; simplify_eq/=].
rewrite elem_of_equiv_empty; intros Hl. rewrite elem_of_equiv_empty; intros Hl.
destruct l as [|x l]; [done|]. feed inversion (Hl x). left. destruct l as [|x l]; [done|]. oinversion Hl. left.
Qed. Qed.
Global Instance listset_empty_dec (X : listset A) : Decision (X ≡ ∅). Global Instance listset_empty_dec (X : listset A) : Decision (X ≡ ∅).
Proof. Proof.
......
theories/listset_nodup.v → stdpp/listset_nodup.v
View file @ 9274984b
File moved
theories/mapset.v → stdpp/mapset.v
View file @ 9274984b
...@@ -8,8 +8,14 @@ From stdpp Require Import options. ...@@ -8,8 +8,14 @@ From stdpp Require Import options.
locally (or things moved out of sections) as no default works well enough. *) locally (or things moved out of sections) as no default works well enough. *)
Unset Default Proof Using. Unset Default Proof Using.
Record mapset (M : Type → Type) : Type := (** Given a type of maps [M : Type → Type], we construct sets as [M ()], i.e.,
Mapset { mapset_car: M (unit : Type) }. maps with unit values. To avoid unnecessary universe constraints, we first
define [mapset' Munit] with [Munit : Type] as a record, and then [mapset M] with
[M : Type → Type] as a notation. See [tests/universes.v] for a test case that
fails otherwise. *)
Record mapset' (Munit : Type) : Type :=
Mapset { mapset_car: Munit }.
Notation mapset M := (mapset' (M unit)).
Global Arguments Mapset {_} _ : assert. Global Arguments Mapset {_} _ : assert.
Global Arguments mapset_car {_} _ : assert. Global Arguments mapset_car {_} _ : assert.
...@@ -103,11 +109,9 @@ Definition mapset_map_with {A B} (f : bool → A → option B) ...@@ -103,11 +109,9 @@ Definition mapset_map_with {A B} (f : bool → A → option B)
match x, y with match x, y with
| Some _, Some a => f true a | None, Some a => f false a | _, None => None | Some _, Some a => f true a | None, Some a => f false a | _, None => None
end) mX. end) mX.
Definition mapset_dom_with {A} (f : A → bool) (m : M A) : mapset M := Definition mapset_dom_with {A} (f : A → bool) (m : M A) : mapset M :=
Mapset $ merge (λ x _, Mapset $ omap (λ a, if f a then Some () else None) m.
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 : 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)). mapset_map_with f X m !! i = m !! i ≫= f (bool_decide (i ∈ X)).
...@@ -120,15 +124,18 @@ Lemma elem_of_mapset_dom_with {A} (f : A → bool) m i : ...@@ -120,15 +124,18 @@ 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. i ∈ mapset_dom_with f m ↔ ∃ x, m !! i = Some x ∧ f x.
Proof. Proof.
unfold mapset_dom_with, elem_of, mapset_elem_of. unfold mapset_dom_with, elem_of, mapset_elem_of.
simpl. rewrite lookup_merge, lookup_empty. destruct (m !! i) as [a|]; simpl. simpl. rewrite lookup_omap. destruct (m !! i) as [a|]; simpl.
- destruct (Is_true_reflect (f a)); naive_solver. - destruct (Is_true_reflect (f a)); naive_solver.
- naive_solver. - naive_solver.
Qed. Qed.
Local Instance mapset_dom {A} : Dom (M A) (mapset M) := mapset_dom_with (λ _, true).
Local Instance mapset_dom {A} : Dom (M A) (mapset M) := λ m,
Mapset $ fmap (λ _, ()) m.
Local Instance mapset_dom_spec: FinMapDom K M (mapset M). Local Instance mapset_dom_spec: FinMapDom K M (mapset M).
Proof. Proof.
split; try apply _. intros. unfold dom, mapset_dom, is_Some. split; try apply _. intros A m i.
rewrite elem_of_mapset_dom_with; naive_solver. unfold dom, mapset_dom, is_Some, elem_of, mapset_elem_of; simpl.
rewrite lookup_fmap. destruct (m !! i); naive_solver.
Qed. Qed.
End mapset. End mapset.
......
theories/namespaces.v → stdpp/namespaces.v
View file @ 9274984b
...@@ -4,21 +4,21 @@ From stdpp Require Import options. ...@@ -4,21 +4,21 @@ From stdpp Require Import options.
Definition namespace := list positive. Definition namespace := list positive.
Global Instance namespace_eq_dec : EqDecision namespace := _. Global Instance namespace_eq_dec : EqDecision namespace := _.
Global Instance namespace_countable : Countable namespace := _. Global Instance namespace_countable : Countable namespace := _.
Typeclasses Opaque namespace. Global Typeclasses Opaque namespace.
Definition nroot : namespace := nil. Definition nroot : namespace := nil.
Definition ndot_def `{Countable A} (N : namespace) (x : A) : namespace := Local Definition ndot_def `{Countable A} (N : namespace) (x : A) : namespace :=
encode x :: N. encode x :: N.
Definition ndot_aux : seal (@ndot_def). by eexists. Qed. Local Definition ndot_aux : seal (@ndot_def). by eexists. Qed.
Definition ndot {A A_dec A_count}:= unseal ndot_aux A A_dec A_count. Definition ndot {A A_dec A_count}:= unseal ndot_aux A A_dec A_count.
Definition ndot_eq : @ndot = @ndot_def := seal_eq ndot_aux. Local Definition ndot_unseal : @ndot = @ndot_def := seal_eq ndot_aux.
Definition nclose_def (N : namespace) : coPset := Local Definition nclose_def (N : namespace) : coPset :=
coPset_suffixes (positives_flatten N). coPset_suffixes (positives_flatten N).
Definition nclose_aux : seal (@nclose_def). by eexists. Qed. Local Definition nclose_aux : seal (@nclose_def). by eexists. Qed.
Global Instance nclose : UpClose namespace coPset := unseal nclose_aux. Global Instance nclose : UpClose namespace coPset := unseal nclose_aux.
Definition nclose_eq : @nclose = @nclose_def := seal_eq nclose_aux. Local Definition nclose_unseal : @nclose = @nclose_def := seal_eq nclose_aux.
Notation "N .@ x" := (ndot N x) Notation "N .@ x" := (ndot N x)
(at level 19, left associativity, format "N .@ x") : stdpp_scope. (at level 19, left associativity, format "N .@ x") : stdpp_scope.
...@@ -33,14 +33,14 @@ Section namespace. ...@@ -33,14 +33,14 @@ Section namespace.
Implicit Types E : coPset. Implicit Types E : coPset.
Global Instance ndot_inj : Inj2 (=) (=) (=) (@ndot A _ _). Global Instance ndot_inj : Inj2 (=) (=) (=) (@ndot A _ _).
Proof. intros N1 x1 N2 x2; rewrite !ndot_eq; naive_solver. Qed. Proof. intros N1 x1 N2 x2; rewrite !ndot_unseal; naive_solver. Qed.
Lemma nclose_nroot : ↑nroot = (⊤:coPset). Lemma nclose_nroot : ↑nroot = (⊤:coPset).
Proof. rewrite nclose_eq. by apply (sig_eq_pi _). Qed. Proof. rewrite nclose_unseal. by apply (sig_eq_pi _). Qed.
Lemma nclose_subseteq N x : ↑N.@x ⊆ (↑N : coPset). Lemma nclose_subseteq N x : ↑N.@x ⊆ (↑N : coPset).
Proof. Proof.
intros p. unfold up_close. rewrite !nclose_eq, !ndot_eq. intros p. unfold up_close. rewrite !nclose_unseal, !ndot_unseal.
unfold nclose_def, ndot_def; rewrite !elem_coPset_suffixes. unfold nclose_def, ndot_def; rewrite !elem_coPset_suffixes.
intros [q ->]. destruct (positives_flatten_suffix N (ndot_def N x)) as [q' ?]. intros [q ->]. destruct (positives_flatten_suffix N (ndot_def N x)) as [q' ?].
{ by exists [encode x]. } { by exists [encode x]. }
...@@ -51,11 +51,11 @@ Section namespace. ...@@ -51,11 +51,11 @@ Section namespace.
Proof. intros. etrans; eauto using nclose_subseteq. Qed. Proof. intros. etrans; eauto using nclose_subseteq. Qed.
Lemma nclose_infinite N : ¬set_finite (↑ N : coPset). Lemma nclose_infinite N : ¬set_finite (↑ N : coPset).
Proof. rewrite nclose_eq. apply coPset_suffixes_infinite. Qed. Proof. rewrite nclose_unseal. apply coPset_suffixes_infinite. Qed.
Lemma ndot_ne_disjoint N x y : x ≠ y → N.@x ## N.@y. Lemma ndot_ne_disjoint N x y : x ≠ y → N.@x ## N.@y.
Proof. Proof.
intros Hxy a. unfold up_close. rewrite !nclose_eq, !ndot_eq. intros Hxy a. unfold up_close. rewrite !nclose_unseal, !ndot_unseal.
unfold nclose_def, ndot_def; rewrite !elem_coPset_suffixes. unfold nclose_def, ndot_def; rewrite !elem_coPset_suffixes.
intros [qx ->] [qy Hqy]. intros [qx ->] [qy Hqy].
revert Hqy. by intros [= ?%(inj encode)]%positives_flatten_suffix_eq. revert Hqy. by intros [= ?%(inj encode)]%positives_flatten_suffix_eq.
...@@ -102,6 +102,13 @@ Local Definition coPset_disjoint_empty_l := disjoint_empty_l (C:=coPset). ...@@ -102,6 +102,13 @@ Local Definition coPset_disjoint_empty_l := disjoint_empty_l (C:=coPset).
Global Hint Resolve coPset_disjoint_empty_l : ndisj. Global Hint Resolve coPset_disjoint_empty_l : ndisj.
Local Definition coPset_disjoint_empty_r := disjoint_empty_r (C:=coPset). Local Definition coPset_disjoint_empty_r := disjoint_empty_r (C:=coPset).
Global Hint Resolve coPset_disjoint_empty_r : ndisj. Global Hint Resolve coPset_disjoint_empty_r : ndisj.
(** If-and-only-if rules for ∪ on the left/right. *)
Local Definition coPset_disjoint_union_l X1 X2 Y :=
proj2 (disjoint_union_l (C:=coPset) X1 X2 Y).
Global Hint Resolve coPset_disjoint_union_l : ndisj.
Local Definition coPset_disjoint_union_r X Y1 Y2 :=
proj2 (disjoint_union_r (C:=coPset) X Y1 Y2).
Global Hint Resolve coPset_disjoint_union_r : ndisj.
(** We prefer ∖ on the left of ## (for the [disjoint_difference] lemmas to (** We prefer ∖ on the left of ## (for the [disjoint_difference] lemmas to
apply), so try moving it there. *) apply), so try moving it there. *)
Global Hint Extern 10 (_ ## (_ ∖ _)) => Global Hint Extern 10 (_ ## (_ ∖ _)) =>
......
theories/nat_cancel.v → stdpp/nat_cancel.v
View file @ 9274984b
...@@ -64,22 +64,22 @@ Module nat_cancel. ...@@ -64,22 +64,22 @@ Module nat_cancel.
Global Instance make_nat_S_1 n : MakeNatS 1 n (S n). Global Instance make_nat_S_1 n : MakeNatS 1 n (S n).
Proof. done. Qed. Proof. done. Qed.
Class MakeNatPlus (n1 n2 m : nat) := make_nat_plus : m = n1 + n2. Class MakeNatAdd (n1 n2 m : nat) := make_nat_add : m = n1 + n2.
Global Instance make_nat_plus_0_l n : MakeNatPlus 0 n n. Global Instance make_nat_add_0_l n : MakeNatAdd 0 n n.
Proof. done. Qed. Proof. done. Qed.
Global Instance make_nat_plus_0_r n : MakeNatPlus n 0 n. Global Instance make_nat_add_0_r n : MakeNatAdd n 0 n.
Proof. unfold MakeNatPlus. by rewrite Nat.add_0_r. Qed. Proof. unfold MakeNatAdd. by rewrite Nat.add_0_r. Qed.
Global Instance make_nat_plus_default n1 n2 : MakeNatPlus n1 n2 (n1 + n2) | 100. Global Instance make_nat_add_default n1 n2 : MakeNatAdd n1 n2 (n1 + n2) | 100.
Proof. done. Qed. Proof. done. Qed.
Global Instance nat_cancel_leaf_here m : NatCancelR m m 0 0 | 0. Global Instance nat_cancel_leaf_here m : NatCancelR m m 0 0 | 0.
Proof. by unfold NatCancelR, NatCancelL. Qed. Proof. by unfold NatCancelR, NatCancelL. Qed.
Global Instance nat_cancel_leaf_else m n : NatCancelR m n m n | 100. Global Instance nat_cancel_leaf_else m n : NatCancelR m n m n | 100.
Proof. by unfold NatCancelR. Qed. Proof. by unfold NatCancelR. Qed.
Global Instance nat_cancel_leaf_plus m m' m'' n1 n2 n1' n2' n1'n2' : Global Instance nat_cancel_leaf_add m m' m'' n1 n2 n1' n2' n1'n2' :
NatCancelR m n1 m' n1' → NatCancelR m' n2 m'' n2' → NatCancelR m n1 m' n1' → NatCancelR m' n2 m'' n2' →
MakeNatPlus n1' n2' n1'n2' → NatCancelR m (n1 + n2) m'' n1'n2' | 2. MakeNatAdd n1' n2' n1'n2' → NatCancelR m (n1 + n2) m'' n1'n2' | 2.
Proof. unfold NatCancelR, NatCancelL, MakeNatPlus. lia. Qed. Proof. unfold NatCancelR, NatCancelL, MakeNatAdd. lia. Qed.
Global Instance nat_cancel_leaf_S_here m n m' n' : Global Instance nat_cancel_leaf_S_here m n m' n' :
NatCancelR m n m' n' → NatCancelR (S m) (S n) m' n' | 3. NatCancelR m n m' n' → NatCancelR (S m) (S n) m' n' | 3.
Proof. unfold NatCancelR, NatCancelL. lia. Qed. Proof. unfold NatCancelR, NatCancelL. lia. Qed.
...@@ -92,10 +92,10 @@ Module nat_cancel. ...@@ -92,10 +92,10 @@ Module nat_cancel.
Global Instance nat_cancel_S_both m n m' n' : Global Instance nat_cancel_S_both m n m' n' :
NatCancelL m n m' n' → NatCancelL (S m) (S n) m' n' | 1. NatCancelL m n m' n' → NatCancelL (S m) (S n) m' n' | 1.
Proof. unfold NatCancelL. lia. Qed. Proof. unfold NatCancelL. lia. Qed.
Global Instance nat_cancel_plus m1 m2 m1' m2' m1'm2' n n' n'' : Global Instance nat_cancel_add m1 m2 m1' m2' m1'm2' n n' n'' :
NatCancelL m1 n m1' n' → NatCancelL m2 n' m2' n'' → NatCancelL m1 n m1' n' → NatCancelL m2 n' m2' n'' →
MakeNatPlus m1' m2' m1'm2' → NatCancelL (m1 + m2) n m1'm2' n'' | 2. MakeNatAdd m1' m2' m1'm2' → NatCancelL (m1 + m2) n m1'm2' n'' | 2.
Proof. unfold NatCancelL, MakeNatPlus. lia. Qed. Proof. unfold NatCancelL, MakeNatAdd. lia. Qed.
Global Instance nat_cancel_S m m' m'' Sm' n n' n'' : Global Instance nat_cancel_S m m' m'' Sm' n n' n'' :
NatCancelL m n m' n' → NatCancelR 1 n' m'' n'' → NatCancelL m n m' n' → NatCancelR 1 n' m'' n'' →
MakeNatS m'' m' Sm' → NatCancelL (S m) n Sm' n'' | 3. MakeNatS m'' m' Sm' → NatCancelL (S m) n Sm' n'' | 3.
......
theories/natmap.v → stdpp/natmap.v
View file @ 9274984b
...@@ -26,9 +26,11 @@ Record natmap (A : Type) : Type := NatMap { ...@@ -26,9 +26,11 @@ Record natmap (A : Type) : Type := NatMap {
natmap_car : natmap_raw A; natmap_car : natmap_raw A;
natmap_prf : natmap_wf natmap_car natmap_prf : natmap_wf natmap_car
}. }.
Add Printing Constructor natmap.
Global Arguments NatMap {_} _ _ : assert. Global Arguments NatMap {_} _ _ : assert.
Global Arguments natmap_car {_} _ : assert. Global Arguments natmap_car {_} _ : assert.
Global Arguments natmap_prf {_} _ : assert. Global Arguments natmap_prf {_} _ : assert.
Lemma natmap_eq {A} (m1 m2 : natmap A) : Lemma natmap_eq {A} (m1 m2 : natmap A) :
m1 = m2 ↔ natmap_car m1 = natmap_car m2. m1 = m2 ↔ natmap_car m1 = natmap_car m2.
Proof. Proof.
...@@ -56,7 +58,7 @@ Proof. induction i; simpl; auto. Qed. ...@@ -56,7 +58,7 @@ Proof. induction i; simpl; auto. Qed.
Lemma natmap_lookup_singleton_raw_ne {A} (i j : nat) (x : A) : Lemma natmap_lookup_singleton_raw_ne {A} (i j : nat) (x : A) :
i ≠ j → mjoin (natmap_singleton_raw i x !! j) = None. i ≠ j → mjoin (natmap_singleton_raw i x !! j) = None.
Proof. revert j; induction i; intros [|?]; simpl; auto with congruence. Qed. Proof. revert j; induction i; intros [|?]; simpl; auto with congruence. Qed.
Hint Rewrite @natmap_lookup_singleton_raw : natmap. Local Hint Rewrite @natmap_lookup_singleton_raw : natmap.
Definition natmap_cons_canon {A} (o : option A) (l : natmap_raw A) := Definition natmap_cons_canon {A} (o : option A) (l : natmap_raw A) :=
match o, l with None, [] => [] | _, _ => o :: l end. match o, l with None, [] => [] | _, _ => o :: l end.
...@@ -69,9 +71,9 @@ Proof. by destruct o, l. Qed. ...@@ -69,9 +71,9 @@ Proof. by destruct o, l. Qed.
Lemma natmap_cons_canon_S {A} (o : option A) (l : natmap_raw A) i : Lemma natmap_cons_canon_S {A} (o : option A) (l : natmap_raw A) i :
natmap_cons_canon o l !! S i = l !! i. natmap_cons_canon o l !! S i = l !! i.
Proof. by destruct o, l. Qed. Proof. by destruct o, l. Qed.
Hint Rewrite @natmap_cons_canon_O @natmap_cons_canon_S : natmap. Local Hint Rewrite @natmap_cons_canon_O @natmap_cons_canon_S : natmap.
Definition natmap_alter_raw {A} (f : option A → option A) : Definition natmap_partial_alter_raw {A} (f : option A → option A) :
nat → natmap_raw A → natmap_raw A := nat → natmap_raw A → natmap_raw A :=
fix go i l {struct l} := fix go i l {struct l} :=
match l with match l with
...@@ -84,28 +86,44 @@ Definition natmap_alter_raw {A} (f : option A → option A) : ...@@ -84,28 +86,44 @@ Definition natmap_alter_raw {A} (f : option A → option A) :
| 0 => natmap_cons_canon (f o) l | S i => natmap_cons_canon o (go i l) | 0 => natmap_cons_canon (f o) l | S i => natmap_cons_canon o (go i l)
end end
end. end.
Lemma natmap_alter_wf {A} (f : option A → option A) i l : Lemma natmap_partial_alter_wf {A} (f : option A → option A) i l :
natmap_wf l → natmap_wf (natmap_alter_raw f i l). natmap_wf l → natmap_wf (natmap_partial_alter_raw f i l).
Proof. Proof.
revert i. induction l; [intro | intros [|?]]; simpl; repeat case_match; revert i. induction l; [intro | intros [|?]]; simpl; repeat case_match;
eauto using natmap_singleton_wf, natmap_cons_canon_wf, natmap_wf_inv. eauto using natmap_singleton_wf, natmap_cons_canon_wf, natmap_wf_inv.
Qed. Qed.
Global Instance natmap_alter {A} : PartialAlter nat A (natmap A) := λ f i m, Global Instance natmap_partial_alter {A} : PartialAlter nat A (natmap A) := λ f i m,
let (l,Hl) := m in NatMap _ (natmap_alter_wf f i l Hl). let (l,Hl) := m in NatMap _ (natmap_partial_alter_wf f i l Hl).
Lemma natmap_lookup_alter_raw {A} (f : option A → option A) i l : Lemma natmap_lookup_partial_alter_raw {A} (f : option A → option A) i l :
mjoin (natmap_alter_raw f i l !! i) = f (mjoin (l !! i)). mjoin (natmap_partial_alter_raw f i l !! i) = f (mjoin (l !! i)).
Proof. Proof.
revert i. induction l; intros [|?]; simpl; repeat case_match; simpl; revert i. induction l; intros [|?]; simpl; repeat case_match; simpl;
autorewrite with natmap; auto. autorewrite with natmap; auto.
Qed. Qed.
Lemma natmap_lookup_alter_raw_ne {A} (f : option A → option A) i j l : Lemma natmap_lookup_partial_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). i ≠ j → mjoin (natmap_partial_alter_raw f i l !! j) = mjoin (l !! j).
Proof. Proof.
revert i j. induction l; intros [|?] [|?] ?; simpl; revert i j. induction l; intros [|?] [|?] ?; simpl;
repeat case_match; simpl; autorewrite with natmap; auto with congruence. repeat case_match; simpl; autorewrite with natmap; auto with congruence.
rewrite natmap_lookup_singleton_raw_ne; congruence. rewrite natmap_lookup_singleton_raw_ne; congruence.
Qed. Qed.
Definition natmap_fmap_raw {A B} (f : A → B) : natmap_raw A → natmap_raw B :=
fmap (fmap (M:=option) f).
Lemma natmap_fmap_wf {A B} (f : A → B) l :
natmap_wf l → natmap_wf (natmap_fmap_raw f l).
Proof.
unfold natmap_fmap_raw, natmap_wf. rewrite fmap_last.
destruct (last l); [|done]. by apply fmap_is_Some.
Qed.
Lemma natmap_lookup_fmap_raw {A B} (f : A → B) i l :
mjoin (natmap_fmap_raw f l !! i) = f <$> mjoin (l !! i).
Proof.
unfold natmap_fmap_raw. rewrite list_lookup_fmap. by destruct (l !! i).
Qed.
Global Instance natmap_fmap : FMap natmap := λ A B f m,
let (l,Hl) := m in NatMap (natmap_fmap_raw f l) (natmap_fmap_wf _ _ Hl).
Definition natmap_omap_raw {A B} (f : A → option B) : Definition natmap_omap_raw {A B} (f : A → option B) :
natmap_raw A → natmap_raw B := natmap_raw A → natmap_raw B :=
fix go l := fix go l :=
...@@ -118,7 +136,7 @@ Lemma natmap_lookup_omap_raw {A B} (f : A → option B) l i : ...@@ -118,7 +136,7 @@ Lemma natmap_lookup_omap_raw {A B} (f : A → option B) l i :
Proof. Proof.
revert i. induction l; intros [|?]; simpl; autorewrite with natmap; auto. revert i. induction l; intros [|?]; simpl; autorewrite with natmap; auto.
Qed. Qed.
Hint Rewrite @natmap_lookup_omap_raw : natmap. Local Hint Rewrite @natmap_lookup_omap_raw : natmap.
Global Instance natmap_omap: OMap natmap := λ A B f m, Global Instance natmap_omap: OMap natmap := λ A B f m,
let (l,Hl) := m in NatMap _ (natmap_omap_raw_wf f _ Hl). let (l,Hl) := m in NatMap _ (natmap_omap_raw_wf f _ Hl).
...@@ -147,64 +165,64 @@ Global Instance natmap_merge: Merge natmap := λ A B C f m1 m2, ...@@ -147,64 +165,64 @@ Global Instance natmap_merge: Merge natmap := λ A B C f m1 m2,
let (l1, Hl1) := m1 in let (l2, Hl2) := m2 in let (l1, Hl1) := m1 in let (l2, Hl2) := m2 in
NatMap (natmap_merge_raw f l1 l2) (natmap_merge_wf _ _ _ Hl1 Hl2). 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) := Fixpoint natmap_fold_raw {A B} (f : nat → A → B → B)
(j : nat) (b : B) (l : natmap_raw A) : B :=
match l with match l with
| [] => [] | [] => b
| None :: l => natmap_to_list_raw (S i) l | mx :: l => natmap_fold_raw f (S j)
| Some x :: l => (i,x) :: natmap_to_list_raw (S i) l match mx with Some x => f j x b | None => b end l
end. 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.
Global 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 := Lemma natmap_fold_raw_cons_canon {A B} (f : nat → A → B → B) j b mx l :
fmap (fmap (M:=option) f). natmap_fold_raw f j b (natmap_cons_canon mx l)
Lemma natmap_map_wf {A B} (f : A → B) l : = natmap_fold_raw f (S j) match mx with Some x => f j x b | None => b end l.
natmap_wf l → natmap_wf (natmap_map_raw f l). Proof. by destruct mx, l. Qed.
Proof.
unfold natmap_map_raw, natmap_wf. rewrite fmap_last. Lemma natmap_fold_raw_ind {A} (P : natmap_raw A → Prop) :
destruct (last l); [|done]. by apply fmap_is_Some. P [] →
Qed. (∀ i x l,
Lemma natmap_lookup_map_raw {A B} (f : A → B) i l : natmap_wf l →
mjoin (natmap_map_raw f l !! i) = f <$> mjoin (l !! i). mjoin (l !! i) = None →
(∀ j A' B (f : nat → A' → B → B) (g : A → A') b x',
natmap_fold_raw f j b
(natmap_partial_alter_raw (λ _, Some x') i (natmap_fmap_raw g l))
= f (i + j) x' (natmap_fold_raw f j b (natmap_fmap_raw g l))) →
P l → P (natmap_partial_alter_raw (λ _, Some x) i l)) →
∀ l, natmap_wf l → P l.
Proof. Proof.
unfold natmap_map_raw. rewrite list_lookup_fmap. by destruct (l !! i). intros Hemp Hinsert l Hl. revert P Hemp Hinsert Hl.
induction l as [|mx l IH]; intros P Hemp Hinsert Hxl; simpl in *; [done|].
assert (natmap_wf l) as Hl by (by destruct l).
replace (mx :: l) with (natmap_cons_canon mx l)
by (destruct mx, l; done || by destruct Hxl).
apply (IH (λ l, P (natmap_cons_canon mx l))); [..|done].
{ destruct mx as [x|]; [|done].
change (natmap_cons_canon (Some x) [])
with (natmap_partial_alter_raw (λ _, Some x) 0 []).
by apply (Hinsert 0). }
intros i x l' Hl' ? Hfold.
replace (natmap_cons_canon mx (natmap_partial_alter_raw (λ _, Some x) i l'))
with (natmap_partial_alter_raw (λ _, Some x) (S i) (natmap_cons_canon mx l'))
by (by destruct i, mx, l').
apply Hinsert.
- by apply natmap_cons_canon_wf.
- by destruct mx, l'.
- intros j A' B f g b x'.
replace (natmap_partial_alter_raw (λ _, Some x') (S i)
(natmap_fmap_raw g (natmap_cons_canon mx l')))
with (natmap_cons_canon (g <$> mx)
(natmap_partial_alter_raw (λ _, Some x') i (natmap_fmap_raw g l')))
by (by destruct i, mx, l').
replace (natmap_fmap_raw g (natmap_cons_canon mx l'))
with (natmap_cons_canon (g <$> mx) (natmap_fmap_raw g l'))
by (by destruct i, mx, l').
rewrite !natmap_fold_raw_cons_canon, Nat.add_succ_comm. simpl; auto.
Qed. Qed.
Global Instance natmap_map: FMap natmap := λ A B f m,
let (l,Hl) := m in NatMap (natmap_map_raw f l) (natmap_map_wf _ _ Hl).
Global Instance: FinMap nat natmap. Global Instance natmap_fold {A} : MapFold nat A (natmap A) := λ B f d m,
let (l,_) := m in natmap_fold_raw f 0 d l.
Global Instance natmap_map : FinMap nat natmap.
Proof. Proof.
split. split.
- unfold lookup, natmap_lookup. intros A [l1 Hl1] [l2 Hl2] E. - unfold lookup, natmap_lookup. intros A [l1 Hl1] [l2 Hl2] E.
...@@ -223,13 +241,20 @@ Proof. ...@@ -223,13 +241,20 @@ Proof.
+ by specialize (E 0). + by specialize (E 0).
+ f_equal. apply IH; eauto using natmap_wf_inv. intros i. apply (E (S i)). + f_equal. apply IH; eauto using natmap_wf_inv. intros i. apply (E (S i)).
- done. - done.
- intros ?? [??] ?. apply natmap_lookup_alter_raw. - intros ?? [??] ?. apply natmap_lookup_partial_alter_raw.
- intros ?? [??] ??. apply natmap_lookup_alter_raw_ne. - intros ?? [??] ??. apply natmap_lookup_partial_alter_raw_ne.
- intros ??? [??] ?. apply natmap_lookup_map_raw. - intros ??? [??] ?. apply natmap_lookup_fmap_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_omap_raw.
- intros ???? [??] [??] ?. apply natmap_lookup_merge_raw. - intros ???? [??] [??] ?. apply natmap_lookup_merge_raw.
- done.
- intros A P Hemp Hins [l Hl]. refine (natmap_fold_raw_ind
(λ l, ∀ Hl, P (NatMap l Hl)) _ _ l Hl Hl); clear l Hl.
{ intros Hl.
by replace (NatMap _ Hl) with (∅ : natmap A) by (by apply natmap_eq). }
intros i x l Hl ? Hfold H Hxl.
replace (NatMap _ Hxl) with (<[i:=x]> (NatMap _ Hl)) by (by apply natmap_eq).
apply Hins; [done| |done].
intros A' B f g b x'. rewrite <-(Nat.add_0_r i) at 2. apply (Hfold 0).
Qed. Qed.
Fixpoint strip_Nones {A} (l : list (option A)) : list (option A) := Fixpoint strip_Nones {A} (l : list (option A)) : list (option A) :=
...@@ -284,8 +309,8 @@ Proof. ...@@ -284,8 +309,8 @@ Proof.
apply set_eq. intros i. rewrite elem_of_union, !elem_of_bools_to_natset. apply set_eq. intros i. rewrite elem_of_union, !elem_of_bools_to_natset.
revert i. induction Hβs as [|[] []]; intros [|?]; naive_solver. revert i. induction Hβs as [|[] []]; intros [|?]; naive_solver.
Qed. Qed.
Lemma natset_to_bools_length (X : natset) sz : length (natset_to_bools sz X) = sz. Lemma length_natset_to_bools (X : natset) sz : length (natset_to_bools sz X) = sz.
Proof. apply resize_length. Qed. Proof. apply length_resize. Qed.
Lemma lookup_natset_to_bools_ge sz X i : sz ≤ i → natset_to_bools sz X !! i = None. Lemma lookup_natset_to_bools_ge sz X i : sz ≤ i → natset_to_bools sz X !! i = None.
Proof. by apply lookup_resize_old. Qed. Proof. by apply lookup_resize_old. Qed.
Lemma lookup_natset_to_bools sz X i β : Lemma lookup_natset_to_bools sz X i β :
...@@ -295,9 +320,9 @@ Proof. ...@@ -295,9 +320,9 @@ Proof.
intros. destruct (mapset_car X) as [l ?]; simpl. intros. destruct (mapset_car X) as [l ?]; simpl.
destruct (l !! i) as [mu|] eqn:Hmu; simpl. destruct (l !! i) as [mu|] eqn:Hmu; simpl.
{ rewrite lookup_resize, list_lookup_fmap, Hmu { rewrite lookup_resize, list_lookup_fmap, Hmu
by (rewrite ?fmap_length; eauto using lookup_lt_Some). by (rewrite ?length_fmap; eauto using lookup_lt_Some).
destruct mu as [[]|], β; simpl; intuition congruence. } destruct mu as [[]|], β; simpl; intuition congruence. }
rewrite lookup_resize_new by (rewrite ?fmap_length; rewrite lookup_resize_new by (rewrite ?length_fmap;
eauto using lookup_ge_None_1); destruct β; intuition congruence. eauto using lookup_ge_None_1); destruct β; intuition congruence.
Qed. Qed.
Lemma lookup_natset_to_bools_true sz X i : Lemma lookup_natset_to_bools_true sz X i :
......
theories/nmap.v → stdpp/nmap.v
View file @ 9274984b
...@@ -7,6 +7,7 @@ From stdpp Require Import options. ...@@ -7,6 +7,7 @@ From stdpp Require Import options.
Local Open Scope N_scope. Local Open Scope N_scope.
Record Nmap (A : Type) : Type := NMap { Nmap_0 : option A; Nmap_pos : Pmap A }. Record Nmap (A : Type) : Type := NMap { Nmap_0 : option A; Nmap_pos : Pmap A }.
Add Printing Constructor Nmap.
Global Arguments Nmap_0 {_} _ : assert. Global Arguments Nmap_0 {_} _ : assert.
Global Arguments Nmap_pos {_} _ : assert. Global Arguments Nmap_pos {_} _ : assert.
Global Arguments NMap {_} _ _ : assert. Global Arguments NMap {_} _ _ : assert.
...@@ -18,63 +19,52 @@ Proof. ...@@ -18,63 +19,52 @@ Proof.
| NMap x t1, NMap y t2 => cast_if_and (decide (x = y)) (decide (t1 = t2)) | NMap x t1, NMap y t2 => cast_if_and (decide (x = y)) (decide (t1 = t2))
end); abstract congruence. end); abstract congruence.
Defined. Defined.
Global Instance Nempty {A} : Empty (Nmap A) := NMap None ∅. Global Instance Nmap_empty {A} : Empty (Nmap A) := NMap None ∅.
Global Opaque Nempty. Global Opaque Nmap_empty.
Global Instance Nlookup {A} : Lookup N A (Nmap A) := λ i t, Global Instance Nmap_lookup {A} : Lookup N A (Nmap A) := λ i t,
match i with match i with
| N0 => Nmap_0 t | 0 => Nmap_0 t
| Npos p => Nmap_pos t !! p | N.pos p => Nmap_pos t !! p
end. end.
Global Instance Npartial_alter {A} : PartialAlter N A (Nmap A) := λ f i t, Global Instance Nmap_partial_alter {A} : PartialAlter N A (Nmap A) := λ f i t,
match i, t with match i, t with
| N0, NMap o t => NMap (f o) t | 0, NMap o t => NMap (f o) t
| Npos p, NMap o t => NMap o (partial_alter f p t) | N.pos p, NMap o t => NMap o (partial_alter f p t)
end. end.
Global Instance Nto_list {A} : FinMapToList N A (Nmap A) := λ t, Global Instance Nmap_fmap: FMap Nmap := λ A B f t,
match t with match t with NMap o t => NMap (f <$> o) (f <$> t) end.
| NMap o t => Global Instance Nmap_omap: OMap Nmap := λ A B f t,
from_option (λ x, [(0,x)]) [] o ++ (prod_map Npos id <$> map_to_list t)
end.
Global Instance Nomap: OMap Nmap := λ A B f t,
match t with NMap o t => NMap (o ≫= f) (omap f t) end. match t with NMap o t => NMap (o ≫= f) (omap f t) end.
Global Instance Nmerge: Merge Nmap := λ A B C f t1 t2, Global Instance Nmap_merge: Merge Nmap := λ A B C f t1 t2,
match t1, t2 with match t1, t2 with
| NMap o1 t1, NMap o2 t2 => NMap (diag_None f o1 o2) (merge f t1 t2) | NMap o1 t1, NMap o2 t2 => NMap (diag_None f o1 o2) (merge f t1 t2)
end. end.
Global Instance Nfmap: FMap Nmap := λ A B f t, Global Instance Nmap_fold {A} : MapFold N A (Nmap A) := λ B f d t,
match t with NMap o t => NMap (f <$> o) (f <$> t) end. match t with
| NMap mx t =>
map_fold (f ∘ N.pos) match mx with Some x => f 0 x d | None => d end t
end.
Global Instance: FinMap N Nmap. Global Instance Nmap_map: FinMap N Nmap.
Proof. Proof.
split. split.
- intros ? [??] [??] H. f_equal; [apply (H 0)|]. - intros ? [??] [??] H. f_equal; [apply (H 0)|].
apply map_eq. intros i. apply (H (Npos i)). apply map_eq. intros i. apply (H (N.pos i)).
- by intros ? [|?]. - by intros ? [|?].
- intros ? f [? t] [|i]; simpl; [done |]. apply lookup_partial_alter. - intros ? f [? t] [|i]; simpl; [done |]. apply lookup_partial_alter.
- intros ? f [? t] [|i] [|j]; simpl; try intuition congruence. - intros ? f [? t] [|i] [|j]; simpl; try intuition congruence.
intros. apply lookup_partial_alter_ne. congruence. intros. apply lookup_partial_alter_ne. congruence.
- intros ??? [??] []; simpl; [done|]. apply lookup_fmap. - 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_omap f).
- intros ??? f [??] [??] [|?]; simpl; [done|]; apply (lookup_merge f). - intros ??? f [??] [??] [|?]; simpl; [done|]; apply (lookup_merge f).
- done.
- intros A P Hemp Hins [mx t].
induction t as [|i x t ? Hfold IH] using map_fold_fmap_ind.
{ destruct mx as [x|]; [|done].
replace (NMap (Some x) ∅) with (<[0:=x]> ∅ : Nmap _) by done.
by apply Hins. }
apply (Hins (N.pos i) x (NMap mx t)); [done| |done].
intros A' B f g b. apply Hfold.
Qed. Qed.
(** * Finite sets *) (** * Finite sets *)
......
stdpp/numbers.v 0 → 100644
View file @ 9274984b
(** This file provides various tweaks and extensions to Coq's theory of numbers
(natural numbers [nat] and [N], positive numbers [positive], integers [Z], and
rationals [Qc]). In addition, this file defines a new type of positive rational
numbers [Qp], which is used extensively in Iris to represent fractional
permissions.
The organization of this file follows mostly Coq's standard library.
- We put all results in modules. For example, the module [Nat] collects the
results for type [nat]. Since the Coq stdlib already defines a module [Nat],
our module [Nat] exports Coq's module so that our module [Nat] contains the
union of the results from the Coq stdlib and std++.
- We follow the naming convention of Coq's "numbers" library to prefer
[succ]/[add]/[sub]/[mul] over [S]/[plus]/[minus]/[mult].
- One typically does not [Import] modules such as [Nat], and refers to the
results using [Nat.lem]. As a consequence, all [Hint]s [Instance]s in the modules in
this file are [Global] and not [Export]. Other things like [Arguments] are outside
the modules, since for them [Global] works like [Export].
The results for [Qc] are not yet in a module. This is in part because they
still follow the old/non-module style in Coq's standard library. See also
https://gitlab.mpi-sws.org/iris/stdpp/-/issues/147. *)
From Coq Require Export EqdepFacts PArith NArith ZArith.
From Coq Require Import QArith Qcanon.
From stdpp Require Export base decidable option.
From stdpp Require Import well_founded.
From stdpp Require Import options.
Local Open Scope nat_scope.
Global Instance comparison_eq_dec : EqDecision comparison.
Proof. solve_decision. Defined.
(** * Notations and properties of [nat] *)
Global Arguments Nat.sub !_ !_ / : assert.
Global Arguments Nat.max : simpl nomatch.
(** We do not make [Nat.lt] since it is an alias for [lt], which contains the
actual definition that we want to make opaque. *)
Global Typeclasses Opaque lt.
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.
(** We do *not* add notation for [≥] mapping to [ge], and we do also not use the
[>] notation from the Coq standard library. Using such notations leads to
annoying problems: if you have [x < y] in the context and need [y > x] for some
lemma, [assumption] won't work because [x < y] and [y > x] are not
definitionally equal. It is just generally frustrating to deal with this
mismatch, and much preferable to state logically equivalent things in syntactically
equal ways.
As an alternative, we could define [>] and [≥] as [parsing only] notation that
maps to [<] and [≤], respectively (similar to math-comp). This would change the
notation for [<] from the Coq standard library to something that is not
definitionally equal, so we avoid that as well.
This concern applies to all number types: [nat], [N], [Z], [positive], [Qc] and
[Qp]. *)
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.
(** TODO: Consider removing these notations to avoid populting the global
scope? *)
Notation lcm := Nat.lcm.
Notation divide := Nat.divide.
Notation "( x | y )" := (divide x y) : nat_scope.
Module Nat.
Export PeanoNat.Nat.
Global Instance add_assoc' : Assoc (=) Nat.add := Nat.add_assoc.
Global Instance add_comm' : Comm (=) Nat.add := Nat.add_comm.
Global Instance add_left_id : LeftId (=) 0 Nat.add := Nat.add_0_l.
Global Instance add_right_id : RightId (=) 0 Nat.add := Nat.add_0_r.
Global Instance sub_right_id : RightId (=) 0 Nat.sub := Nat.sub_0_r.
Global Instance mul_assoc' : Assoc (=) Nat.mul := Nat.mul_assoc.
Global Instance mul_comm' : Comm (=) Nat.mul := Nat.mul_comm.
Global Instance mul_left_id : LeftId (=) 1 Nat.mul := Nat.mul_1_l.
Global Instance mul_right_id : RightId (=) 1 Nat.mul := Nat.mul_1_r.
Global Instance mul_left_absorb : LeftAbsorb (=) 0 Nat.mul := Nat.mul_0_l.
Global Instance mul_right_absorb : RightAbsorb (=) 0 Nat.mul := Nat.mul_0_r.
Global Instance div_right_id : RightId (=) 1 Nat.div := Nat.div_1_r.
Global Instance eq_dec: EqDecision nat := eq_nat_dec.
Global Instance le_dec: RelDecision le := le_dec.
Global Instance lt_dec: RelDecision lt := lt_dec.
Global Instance inhabited: Inhabited nat := populate 0.
Global Instance succ_inj: Inj (=) (=) Nat.succ.
Proof. by injection 1. Qed.
Global Instance le_po: PartialOrder (≤).
Proof. repeat split; repeat intro; auto with lia. Qed.
Global Instance le_total: Total (≤).
Proof. repeat intro; lia. Qed.
Global Instance 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 FIX 3. intros x ? [|y p] ? [|y' q].
- done.
- clear FIX. intros; exfalso; auto with lia.
- clear FIX. intros; exfalso; auto with lia.
- injection 1. intros Hy. by case (FIX 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.
Global Instance lt_pi: ∀ x y : nat, ProofIrrel (x < y).
Proof. unfold Peano.lt. apply _. Qed.
(** Given a measure/size [f : B → nat], you can do induction on the size of
[b : B] using [induction (lt_wf_0_projected f b)]. *)
Lemma lt_wf_0_projected {B} (f : B → nat) : well_founded (λ x y, f x < f y).
Proof. by apply (wf_projected (<) f), lt_wf_0. Qed.
Lemma le_sum (x y : nat) : x ≤ y ↔ ∃ z, y = x + z.
Proof. split; [exists (y - x); lia | intros [z ->]; lia]. Qed.
(** This is similar to but slightly different than Coq's
[add_sub : ∀ n m : nat, n + m - m = n]. *)
Lemma add_sub' n m : n + m - n = m.
Proof. lia. Qed.
Lemma le_add_sub n m : n ≤ m → m = n + (m - n).
Proof. lia. Qed.
(** Cancellation for multiplication. Coq's stdlib has these lemmas for [Z],
but those for [nat] are missing. We use the naming scheme of Coq's stdlib. *)
Lemma mul_reg_l n m p : p ≠ 0 → p * n = p * m → n = m.
Proof.
pose proof (Z.mul_reg_l (Z.of_nat n) (Z.of_nat m) (Z.of_nat p)). lia.
Qed.
Lemma mul_reg_r n m p : p ≠ 0 → n * p = m * p → n = m.
Proof. rewrite <-!(Nat.mul_comm p). apply mul_reg_l. Qed.
Lemma lt_succ_succ n : n < S (S n).
Proof. auto with arith. Qed.
Lemma 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 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 (mul_split_l n x2 x1 y2 y1); auto with lia. Qed.
Global Instance divide_dec : RelDecision Nat.divide.
Proof.
refine (λ x y, cast_if (decide (lcm x y = y)));
abstract (by rewrite Nat.divide_lcm_iff).
Defined.
Global Instance divide_po : PartialOrder divide.
Proof.
repeat split; try apply _. intros ??. apply Nat.divide_antisym; lia.
Qed.
Global Hint Extern 0 (_ | _) => reflexivity : core.
Lemma divide_ne_0 x y : (x | y) → y ≠ 0 → x ≠ 0.
Proof. intros Hxy Hy ->. by apply Hy, Nat.divide_0_l. Qed.
Lemma iter_succ {A} n (f: A → A) x : Nat.iter (S n) f x = f (Nat.iter n f x).
Proof. done. Qed.
Lemma iter_succ_r {A} n (f: A → A) x : Nat.iter (S n) f x = Nat.iter n f (f x).
Proof. induction n; by f_equal/=. Qed.
Lemma iter_add {A} n1 n2 (f : A → A) x :
Nat.iter (n1 + n2) f x = Nat.iter n1 f (Nat.iter n2 f x).
Proof. induction n1; by f_equal/=. Qed.
Lemma iter_mul {A} n1 n2 (f : A → A) x :
Nat.iter (n1 * n2) f x = Nat.iter n1 (Nat.iter n2 f) x.
Proof.
intros. induction n1 as [|n1 IHn1]; [done|].
simpl. by rewrite iter_add, IHn1.
Qed.
Lemma iter_ind {A} (P : A → Prop) f x k :
P x → (∀ y, P y → P (f y)) → P (Nat.iter k f x).
Proof. induction k; simpl; auto. Qed.
(** FIXME: Coq 8.17 deprecated some lemmas in https://github.com/coq/coq/pull/16203.
We cannot use the intended replacements since we support Coq 8.16. We also do
not want to disable [deprecated-syntactic-definition] everywhere, so instead
we provide non-deprecated duplicates of those deprecated lemmas that we need
in std++ and Iris. *)
Local Set Warnings "-deprecated-syntactic-definition".
Lemma add_mod_idemp_l a b n : n ≠ 0 → (a mod n + b) mod n = (a + b) mod n.
Proof. auto using add_mod_idemp_l. Qed.
Lemma div_lt_upper_bound a b q : b ≠ 0 → a < b * q → a / b < q.
Proof. auto using div_lt_upper_bound. Qed.
End Nat.
(** * Notations and properties of [positive] *)
Local Open Scope positive_scope.
Global Typeclasses Opaque Pos.le.
Global Typeclasses Opaque Pos.lt.
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 ≤ 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.
Infix "`max`" := Pos.max : positive_scope.
Infix "`min`" := Pos.min : positive_scope.
Global Arguments Pos.pred : simpl never.
Global Arguments Pos.succ : simpl never.
Global Arguments Pos.of_nat : simpl never.
Global Arguments Pos.to_nat : simpl never.
Global Arguments Pos.mul : simpl never.
Global Arguments Pos.add : simpl never.
Global Arguments Pos.sub : simpl never.
Global Arguments Pos.pow : simpl never.
Global Arguments Pos.shiftl : simpl never.
Global Arguments Pos.shiftr : simpl never.
Global Arguments Pos.gcd : simpl never.
Global Arguments Pos.min : simpl never.
Global Arguments Pos.max : simpl never.
Global Arguments Pos.lor : simpl never.
Global Arguments Pos.land : simpl never.
Global Arguments Pos.lxor : simpl never.
Global Arguments Pos.square : simpl never.
Module Pos.
Export BinPos.Pos.
Global Instance add_assoc' : Assoc (=) Pos.add := Pos.add_assoc.
Global Instance add_comm' : Comm (=) Pos.add := Pos.add_comm.
Global Instance mul_assoc' : Assoc (=) Pos.mul := Pos.mul_assoc.
Global Instance mul_comm' : Comm (=) Pos.mul := Pos.mul_comm.
Global Instance mul_left_id : LeftId (=) 1 Pos.mul := Pos.mul_1_l.
Global Instance mul_right_id : RightId (=) 1 Pos.mul := Pos.mul_1_r.
Global Instance eq_dec: EqDecision positive := Pos.eq_dec.
Global Instance le_dec: RelDecision Pos.le.
Proof. refine (λ x y, decide ((x ?= y) ≠ Gt)). Defined.
Global Instance lt_dec: RelDecision Pos.lt.
Proof. refine (λ x y, decide ((x ?= y) = Lt)). Defined.
Global Instance le_total: Total Pos.le.
Proof. repeat intro; lia. Qed.
Global Instance inhabited: Inhabited positive := populate 1.
Global Instance maybe_xO : Maybe xO := λ p, match p with p~0 => Some p | _ => None end.
Global Instance maybe_xI : Maybe xI := λ p, match p with p~1 => Some p | _ => None end.
Global Instance xO_inj : Inj (=) (=) (~0).
Proof. by injection 1. Qed.
Global Instance xI_inj : 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 app (p1 p2 : positive) : positive :=
match p2 with
| 1 => p1
| p2~0 => (app p1 p2)~0
| p2~1 => (app p1 p2)~1
end.
Module Import app_notations.
Infix "++" := app : positive_scope.
Notation "(++)" := app (only parsing) : positive_scope.
Notation "( p ++.)" := (app p) (only parsing) : positive_scope.
Notation "(.++ q )" := (λ p, app p q) (only parsing) : positive_scope.
End app_notations.
Fixpoint reverse_go (p1 p2 : positive) : positive :=
match p2 with
| 1 => p1
| p2~0 => reverse_go (p1~0) p2
| p2~1 => reverse_go (p1~1) p2
end.
Definition reverse : positive → positive := reverse_go 1.
Global Instance app_1_l : LeftId (=) 1 (++).
Proof. intros p. by induction p; intros; f_equal/=. Qed.
Global Instance app_1_r : RightId (=) 1 (++).
Proof. done. Qed.
Global Instance app_assoc : Assoc (=) (++).
Proof. intros ?? p. by induction p; intros; f_equal/=. Qed.
Global Instance app_inj p : Inj (=) (=) (.++ p).
Proof. intros ???. induction p; simplify_eq; auto. Qed.
Lemma reverse_go_app p1 p2 p3 :
reverse_go p1 (p2 ++ p3) = reverse_go p1 p3 ++ reverse_go 1 p2.
Proof.
revert p3 p1 p2.
cut (∀ p1 p2 p3, reverse_go (p2 ++ p3) p1 = p2 ++ reverse_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 reverse_app p1 p2 : reverse (p1 ++ p2) = reverse p2 ++ reverse p1.
Proof. unfold reverse. by rewrite reverse_go_app. Qed.
Lemma reverse_xO p : reverse (p~0) = (1~0) ++ reverse p.
Proof. apply (reverse_app p (1~0)). Qed.
Lemma reverse_xI p : reverse (p~1) = (1~1) ++ reverse p.
Proof. apply (reverse_app p (1~1)). Qed.
Lemma reverse_involutive p : reverse (reverse p) = p.
Proof.
induction p as [p IH|p IH|]; simpl.
- by rewrite reverse_xI, reverse_app, IH.
- by rewrite reverse_xO, reverse_app, IH.
- reflexivity.
Qed.
Global Instance reverse_inj : Inj (=) (=) reverse.
Proof.
intros p q eq.
rewrite <-(reverse_involutive p).
rewrite <-(reverse_involutive q).
by rewrite eq.
Qed.
Fixpoint length (p : positive) : nat :=
match p with 1 => 0%nat | p~0 | p~1 => S (length p) end.
Lemma length_app p1 p2 : length (p1 ++ p2) = (length p2 + length p1)%nat.
Proof. by induction p2; f_equal/=. Qed.
Lemma lt_sum (x y : positive) : x < y ↔ ∃ z, y = x + z.
Proof.
split.
- exists (y - x)%positive. symmetry. apply Pplus_minus. lia.
- intros [z ->]. lia.
Qed.
(** Duplicate the bits of a positive, i.e. 1~0~1 -> 1~0~0~1~1 and
1~1~0~0 -> 1~1~1~0~0~0~0 *)
Fixpoint dup (p : positive) : positive :=
match p with
| 1 => 1
| p'~0 => (dup p')~0~0
| p'~1 => (dup p')~1~1
end.
Lemma dup_app p q :
dup (p ++ q) = dup p ++ dup q.
Proof.
revert p.
induction q as [p IH|p IH|]; intros q; simpl.
- by rewrite IH.
- by rewrite IH.
- reflexivity.
Qed.
Lemma dup_suffix_eq p q s1 s2 :
s1~1~0 ++ dup p = s2~1~0 ++ dup q → p = q.
Proof.
revert q.
induction p as [p IH|p IH|]; intros [q|q|] eq; simplify_eq/=.
- by rewrite (IH q).
- by rewrite (IH q).
- reflexivity.
Qed.
Global Instance dup_inj : Inj (=) (=) dup.
Proof.
intros p q eq.
apply (dup_suffix_eq _ _ 1 1).
by rewrite eq.
Qed.
Lemma reverse_dup p :
reverse (dup p) = dup (reverse p).
Proof.
induction p as [p IH|p IH|]; simpl.
- rewrite 3!reverse_xI.
rewrite (assoc_L (++)).
rewrite IH.
rewrite dup_app.
reflexivity.
- rewrite 3!reverse_xO.
rewrite (assoc_L (++)).
rewrite IH.
rewrite dup_app.
reflexivity.
- reflexivity.
Qed.
End Pos.
Export Pos.app_notations.
Local Close Scope positive_scope.
(** * Notations and properties of [N] *)
Local Open Scope N_scope.
Global Typeclasses Opaque N.le.
Global Typeclasses Opaque N.lt.
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 ≤ 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.
Infix "`max`" := N.max (at level 35) : N_scope.
Infix "`min`" := N.min (at level 35) : N_scope.
Global Arguments N.pred : simpl never.
Global Arguments N.succ : simpl never.
Global Arguments N.of_nat : simpl never.
Global Arguments N.to_nat : simpl never.
Global Arguments N.mul : simpl never.
Global Arguments N.add : simpl never.
Global Arguments N.sub : simpl never.
Global Arguments N.pow : simpl never.
Global Arguments N.div : simpl never.
Global Arguments N.modulo : simpl never.
Global Arguments N.shiftl : simpl never.
Global Arguments N.shiftr : simpl never.
Global Arguments N.gcd : simpl never.
Global Arguments N.lcm : simpl never.
Global Arguments N.min : simpl never.
Global Arguments N.max : simpl never.
Global Arguments N.lor : simpl never.
Global Arguments N.land : simpl never.
Global Arguments N.lxor : simpl never.
Global Arguments N.lnot : simpl never.
Global Arguments N.square : simpl never.
Global Hint Extern 0 (_ ≤ _)%N => reflexivity : core.
Module N.
Export BinNat.N.
Global Instance add_assoc' : Assoc (=) N.add := N.add_assoc.
Global Instance add_comm' : Comm (=) N.add := N.add_comm.
Global Instance add_left_id : LeftId (=) 0 N.add := N.add_0_l.
Global Instance add_right_id : RightId (=) 0 N.add := N.add_0_r.
Global Instance sub_right_id : RightId (=) 0 N.sub := N.sub_0_r.
Global Instance mul_assoc' : Assoc (=) N.mul := N.mul_assoc.
Global Instance mul_comm' : Comm (=) N.mul := N.mul_comm.
Global Instance mul_left_id : LeftId (=) 1 N.mul := N.mul_1_l.
Global Instance mul_right_id : RightId (=) 1 N.mul := N.mul_1_r.
Global Instance mul_left_absorb : LeftAbsorb (=) 0 N.mul := N.mul_0_l.
Global Instance mul_right_absorb : RightAbsorb (=) 0 N.mul := N.mul_0_r.
Global Instance div_right_id : RightId (=) 1 N.div := N.div_1_r.
Global Instance pos_inj : Inj (=) (=) N.pos.
Proof. by injection 1. Qed.
Global Instance eq_dec : EqDecision N := N.eq_dec.
Global Program Instance le_dec : RelDecision N.le := λ x y,
match N.compare x y with Gt => right _ | _ => left _ end.
Solve Obligations with naive_solver.
Global Program Instance lt_dec : RelDecision N.lt := λ x y,
match N.compare x y with Lt => left _ | _ => right _ end.
Solve Obligations with naive_solver.
Global Instance inhabited : Inhabited N := populate 1%N.
Global Instance lt_pi x y : ProofIrrel (x < y)%N.
Proof. unfold N.lt. apply _. Qed.
Global Instance le_po : PartialOrder (≤)%N.
Proof.
repeat split; red; [apply N.le_refl | apply N.le_trans | apply N.le_antisymm].
Qed.
Global Instance le_total : Total (≤)%N.
Proof. repeat intro; lia. Qed.
Lemma lt_wf_0_projected {B} (f : B → N) : well_founded (λ x y, f x < f y).
Proof. by apply (wf_projected (<) f), lt_wf_0. Qed.
(** FIXME: Coq 8.17 deprecated some lemmas in https://github.com/coq/coq/pull/16203.
We cannot use the intended replacements since we support Coq 8.16. We also do
not want to disable [deprecated-syntactic-definition] everywhere, so instead
we provide non-deprecated duplicates of those deprecated lemmas that we need
in std++ and Iris. *)
Local Set Warnings "-deprecated-syntactic-definition".
Lemma add_mod_idemp_l a b n : n ≠ 0 → (a mod n + b) mod n = (a + b) mod n.
Proof. auto using add_mod_idemp_l. Qed.
Lemma div_lt_upper_bound a b q : b ≠ 0 → a < b * q → a / b < q.
Proof. auto using div_lt_upper_bound. Qed.
End N.
Local Close Scope N_scope.
(** * Notations and properties of [Z] *)
Local Open Scope Z_scope.
Global Typeclasses Opaque Z.le.
Global Typeclasses Opaque Z.lt.
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.
Infix "`max`" := Z.max (at level 35) : Z_scope.
Infix "`min`" := Z.min (at level 35) : Z_scope.
Global Arguments Z.pred : simpl never.
Global Arguments Z.succ : simpl never.
Global Arguments Z.of_nat : simpl never.
Global Arguments Z.to_nat : simpl never.
Global Arguments Z.mul : simpl never.
Global Arguments Z.add : simpl never.
Global Arguments Z.sub : simpl never.
Global Arguments Z.opp : simpl never.
Global Arguments Z.pow : simpl never.
Global Arguments Z.div : simpl never.
Global Arguments Z.modulo : simpl never.
Global Arguments Z.quot : simpl never.
Global Arguments Z.rem : simpl never.
Global Arguments Z.shiftl : simpl never.
Global Arguments Z.shiftr : simpl never.
Global Arguments Z.gcd : simpl never.
Global Arguments Z.lcm : simpl never.
Global Arguments Z.min : simpl never.
Global Arguments Z.max : simpl never.
Global Arguments Z.lor : simpl never.
Global Arguments Z.land : simpl never.
Global Arguments Z.lxor : simpl never.
Global Arguments Z.lnot : simpl never.
Global Arguments Z.square : simpl never.
Global Arguments Z.abs : simpl never.
Module Z.
Export BinInt.Z.
Global Instance add_assoc' : Assoc (=) Z.add := Z.add_assoc.
Global Instance add_comm' : Comm (=) Z.add := Z.add_comm.
Global Instance add_left_id : LeftId (=) 0 Z.add := Z.add_0_l.
Global Instance add_right_id : RightId (=) 0 Z.add := Z.add_0_r.
Global Instance sub_right_id : RightId (=) 0 Z.sub := Z.sub_0_r.
Global Instance mul_assoc' : Assoc (=) Z.mul := Z.mul_assoc.
Global Instance mul_comm' : Comm (=) Z.mul := Z.mul_comm.
Global Instance mul_left_id : LeftId (=) 1 Z.mul := Z.mul_1_l.
Global Instance mul_right_id : RightId (=) 1 Z.mul := Z.mul_1_r.
Global Instance mul_left_absorb : LeftAbsorb (=) 0 Z.mul := Z.mul_0_l.
Global Instance mul_right_absorb : RightAbsorb (=) 0 Z.mul := Z.mul_0_r.
Global Instance div_right_id : RightId (=) 1 Z.div := Z.div_1_r.
Global Instance pos_inj : Inj (=) (=) Z.pos.
Proof. by injection 1. Qed.
Global Instance neg_inj : Inj (=) (=) Z.neg.
Proof. by injection 1. Qed.
Global Instance eq_dec: EqDecision Z := Z.eq_dec.
Global Instance le_dec: RelDecision Z.le := Z_le_dec.
Global Instance lt_dec: RelDecision Z.lt := Z_lt_dec.
Global Instance ge_dec: RelDecision Z.ge := Z_ge_dec.
Global Instance gt_dec: RelDecision Z.gt := Z_gt_dec.
Global Instance inhabited: Inhabited Z := populate 1.
Global Instance lt_pi x y : ProofIrrel (x < y).
Proof. unfold Z.lt. apply _. Qed.
Global Instance le_po : PartialOrder (≤).
Proof.
repeat split; red; [apply Z.le_refl | apply Z.le_trans | apply Z.le_antisymm].
Qed.
Global Instance le_total: Total Z.le.
Proof. repeat intro; lia. Qed.
Lemma lt_wf_projected {B} (f : B → Z) z : well_founded (λ x y, z ≤ f x < f y).
Proof. by apply (wf_projected (λ x y, z ≤ x < y) f), lt_wf. Qed.
Lemma 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 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.
Lemma mod_pos x y : 0 < y → 0 ≤ x `mod` y.
Proof. apply Z.mod_pos_bound. Qed.
Global Hint Resolve Z.lt_le_incl : zpos.
Global Hint Resolve Z.add_nonneg_pos Z.add_pos_nonneg Z.add_nonneg_nonneg : zpos.
Global Hint Resolve Z.mul_nonneg_nonneg Z.mul_pos_pos : zpos.
Global Hint Resolve Z.pow_pos_nonneg Z.pow_nonneg: zpos.
Global Hint Resolve Z.mod_pos Z.div_pos : zpos.
Global Hint Extern 1000 => lia : zpos.
Lemma succ_pred_induction y (P : Z → Prop) :
P y →
(∀ x, y ≤ x → P x → P (Z.succ x)) →
(∀ x, x ≤ y → P x → P (Z.pred x)) →
(∀ x, P x).
Proof. intros H0 HS HP. by apply (Z.order_induction' _ _ y). Qed.
Lemma mod_in_range q a c :
q * c ≤ a < (q + 1) * c →
a `mod` c = a - q * c.
Proof. intros ?. symmetry. apply Z.mod_unique_pos with q; lia. Qed.
Lemma ones_spec n m:
0 ≤ m → 0 ≤ n →
Z.testbit (Z.ones n) m = bool_decide (m < n).
Proof.
intros. case_bool_decide.
- by rewrite Z.ones_spec_low by lia.
- by rewrite Z.ones_spec_high by lia.
Qed.
Lemma bounded_iff_bits_nonneg k n :
0 ≤ k → 0 ≤ n →
n < 2^k ↔ ∀ l, k ≤ l → Z.testbit n l = false.
Proof.
intros. destruct (decide (n = 0)) as [->|].
{ naive_solver eauto using Z.bits_0, Z.pow_pos_nonneg with lia. }
split.
{ intros Hb%Z.log2_lt_pow2 l Hl; [|lia]. apply Z.bits_above_log2; lia. }
intros Hl. apply Z.nle_gt; intros ?.
assert (Z.testbit n (Z.log2 n) = false) as Hbit.
{ apply Hl, Z.log2_le_pow2; lia. }
by rewrite Z.bit_log2 in Hbit by lia.
Qed.
(* Goals of the form [0 ≤ n ≤ 2^k] appear often. So we also define the
derived version [Z_bounded_iff_bits_nonneg'] that does not require
proving [0 ≤ n] twice in that case. *)
Lemma bounded_iff_bits_nonneg' k n :
0 ≤ k → 0 ≤ n →
0 ≤ n < 2^k ↔ ∀ l, k ≤ l → Z.testbit n l = false.
Proof. intros ??. rewrite <-bounded_iff_bits_nonneg; lia. Qed.
Lemma bounded_iff_bits k n :
0 ≤ k →
-2^k ≤ n < 2^k ↔ ∀ l, k ≤ l → Z.testbit n l = bool_decide (n < 0).
Proof.
intros Hk.
case_bool_decide; [ | rewrite <-bounded_iff_bits_nonneg; lia].
assert(n = - Z.abs n)%Z as -> by lia.
split.
{ intros [? _] l Hl.
rewrite Z.bits_opp, negb_true_iff by lia.
apply bounded_iff_bits_nonneg with k; lia. }
intros Hbit. split.
- rewrite <-Z.opp_le_mono, <-Z.lt_pred_le.
apply bounded_iff_bits_nonneg; [lia..|]. intros l Hl.
rewrite <-negb_true_iff, <-Z.bits_opp by lia.
by apply Hbit.
- etrans; [|apply Z.pow_pos_nonneg]; lia.
Qed.
Lemma add_nocarry_lor a b :
Z.land a b = 0 →
a + b = Z.lor a b.
Proof. intros ?. rewrite <-Z.lxor_lor by done. by rewrite Z.add_nocarry_lxor. Qed.
Lemma opp_lnot a : -a - 1 = Z.lnot a.
Proof. pose proof (Z.add_lnot_diag a). lia. Qed.
End Z.
Module Nat2Z.
Export Znat.Nat2Z.
Global Instance inj' : Inj (=) (=) Z.of_nat.
Proof. intros n1 n2. apply Nat2Z.inj. Qed.
Lemma 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). lia.
- intros [i ->]. exists (Z.of_nat i). by rewrite Nat2Z.inj_mul.
Qed.
Lemma inj_div x y : Z.of_nat (x `div` y) = (Z.of_nat x) `div` (Z.of_nat y).
Proof.
destruct (decide (y = 0%nat)); [by subst; destruct x |].
apply Z.div_unique with (Z.of_nat $ 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 inj_mod x y : Z.of_nat (x `mod` y) = (Z.of_nat x) `mod` (Z.of_nat y).
Proof.
destruct (decide (y = 0%nat)); [by subst; destruct x |].
apply Z.mod_unique with (Z.of_nat $ 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.
End Nat2Z.
Module Z2Nat.
Export Znat.Z2Nat.
Lemma neq_0_pos x : Z.to_nat x ≠ 0%nat → 0 < x.
Proof. by destruct x. Qed.
Lemma neq_0_nonneg x : Z.to_nat x ≠ 0%nat → 0 ≤ x.
Proof. by destruct x. Qed.
Lemma nonpos x : x ≤ 0 → Z.to_nat x = 0%nat.
Proof. destruct x; simpl; auto using Z2Nat.inj_neg. by intros []. Qed.
Lemma inj_pow (x y : nat) : Z.of_nat (x ^ y) = (Z.of_nat x) ^ (Z.of_nat 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 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 inj_div x y :
0 ≤ x → 0 ≤ y →
Z.to_nat (x `div` y) = (Z.to_nat x `div` Z.to_nat y)%nat.
Proof.
intros. destruct (decide (y = Z.of_nat 0%nat)); [by subst; destruct x|].
pose proof (Z.div_pos x y).
apply (base.inj Z.of_nat). by rewrite Nat2Z.inj_div, !Z2Nat.id by lia.
Qed.
Lemma inj_mod x y :
0 ≤ x → 0 ≤ y →
Z.to_nat (x `mod` y) = (Z.to_nat x `mod` Z.to_nat y)%nat.
Proof.
intros. destruct (decide (y = Z.of_nat 0%nat)); [by subst; destruct x|].
pose proof (Z.mod_pos x y).
apply (base.inj Z.of_nat). by rewrite Nat2Z.inj_mod, !Z2Nat.id by lia.
Qed.
End Z2Nat.
(** ** [bool_to_Z] *)
Definition bool_to_Z (b : bool) : Z :=
if b then 1 else 0.
Lemma bool_to_Z_bound b : 0 ≤ bool_to_Z b < 2.
Proof. destruct b; simpl; lia. Qed.
Lemma bool_to_Z_eq_0 b : bool_to_Z b = 0 ↔ b = false.
Proof. destruct b; naive_solver. Qed.
Lemma bool_to_Z_neq_0 b : bool_to_Z b ≠ 0 ↔ b = true.
Proof. destruct b; naive_solver. Qed.
Lemma bool_to_Z_spec b n : Z.testbit (bool_to_Z b) n = bool_decide (n = 0) && b.
Proof. by destruct b, n. Qed.
Local Close Scope Z_scope.
(** * Injectivity of casts *)
Module Nat2N.
Export Nnat.Nat2N.
Global Instance inj' : Inj (=) (=) N.of_nat := Nat2N.inj.
End Nat2N.
Module N2Nat.
Export Nnat.N2Nat.
Global Instance inj' : Inj (=) (=) N.to_nat := N2Nat.inj.
End N2Nat.
Module Pos2Nat.
Export Pnat.Pos2Nat.
Global Instance inj' : Inj (=) (=) Pos.to_nat := Pos2Nat.inj.
End Pos2Nat.
Module SuccNat2Pos.
Export Pnat.SuccNat2Pos.
Global Instance inj' : Inj (=) (=) Pos.of_succ_nat := SuccNat2Pos.inj.
End SuccNat2Pos.
Module N2Z.
Export Znat.N2Z.
Global Instance inj' : Inj (=) (=) Z.of_N := N2Z.inj.
End N2Z.
(* Add others here. *)
(** * Notations and properties of [Qc] *)
Global Typeclasses Opaque Qcle.
Global Typeclasses Opaque Qclt.
Local 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.
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.
Global Hint Extern 1 (_ ≤ _) => reflexivity || discriminate : core.
Global Arguments Qred : simpl never.
Global Instance Qcplus_assoc' : Assoc (=) Qcplus := Qcplus_assoc.
Global Instance Qcplus_comm' : Comm (=) Qcplus := Qcplus_comm.
Global Instance Qcplus_left_id : LeftId (=) 0 Qcplus := Qcplus_0_l.
Global Instance Qcplus_right_id : RightId (=) 0 Qcplus := Qcplus_0_r.
Global Instance Qcminus_right_id : RightId (=) 0 Qcminus.
Proof. unfold RightId. intros. ring. Qed.
Global Instance Qcmult_assoc' : Assoc (=) Qcmult := Qcmult_assoc.
Global Instance Qcmult_comm' : Comm (=) Qcmult := Qcmult_comm.
Global Instance Qcmult_left_id : LeftId (=) 1 Qcmult := Qcmult_1_l.
Global Instance Qcmult_right_id : RightId (=) 1 Qcmult := Qcmult_1_r.
Global Instance Qcmult_left_absorb : LeftAbsorb (=) 0 Qcmult := Qcmult_0_l.
Global Instance Qcmult_right_absorb : RightAbsorb (=) 0 Qcmult := Qcmult_0_r.
Global Instance Qcdiv_right_id : RightId (=) 1 Qcdiv.
Proof. intros x. rewrite <-(Qcmult_1_l (x / 1)), Qcmult_div_r; done. Qed.
Lemma inject_Z_Qred n : Qred (inject_Z n) = inject_Z n.
Proof. apply Qred_identity; auto using Z.gcd_1_r. Qed.
Definition Qc_of_Z (n : Z) : Qc := Qcmake _ (inject_Z_Qred n).
Global Instance Qc_eq_dec: EqDecision Qc := Qc_eq_dec.
Global Program Instance Qc_le_dec: RelDecision Qcle := λ 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.
Global Program Instance Qc_lt_dec: RelDecision Qclt := λ x y,
if Qclt_le_dec x y then left _ else right _.
Next Obligation. done. Qed.
Next Obligation. intros x y; apply Qcle_not_lt. Qed.
Global Instance Qc_lt_pi x y : ProofIrrel (x < y).
Proof. unfold Qclt. apply _. Qed.
Global Instance Qc_le_po: PartialOrder (≤).
Proof.
repeat split; red; [apply Qcle_refl | apply Qcle_trans | apply Qcle_antisym].
Qed.
Global Instance Qc_lt_strict: StrictOrder (<).
Proof.
split; red; [|apply Qclt_trans].
intros x Hx. by destruct (Qclt_not_eq x x).
Qed.
Global Instance Qc_le_total: Total Qcle.
Proof. intros x y. destruct (Qclt_le_dec x y); auto using Qclt_le_weak. 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.
Global Instance Qcopp_inj : Inj (=) (=) Qcopp.
Proof.
intros x y H. by rewrite <-(Qcopp_involutive x), H, Qcopp_involutive.
Qed.
Global Instance Qcplus_inj_r z : Inj (=) (=) (Qcplus z).
Proof.
intros x y H. by apply (anti_symm (≤));rewrite (Qcplus_le_mono_l _ _ z), H.
Qed.
Global Instance Qcplus_inj_l z : Inj (=) (=) (λ x, x + z).
Proof.
intros 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 Qcinv_pos x : 0 < x → 0 < /x.
Proof.
intros. assert (0 ≠ x) by (by apply Qclt_not_eq).
by rewrite (Qcmult_lt_mono_pos_r _ _ x), Qcmult_0_l, Qcmult_inv_l by done.
Qed.
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.
Local Close Scope Qc_scope.
(** * Positive rationals *)
Declare Scope Qp_scope.
Delimit Scope Qp_scope with Qp.
Record Qp := mk_Qp { Qp_to_Qc : Qc ; Qp_prf : (0 < Qp_to_Qc)%Qc }.
Add Printing Constructor Qp.
Bind Scope Qp_scope with Qp.
Global Arguments Qp_to_Qc _%Qp : assert.
Program Definition pos_to_Qp (n : positive) : Qp := mk_Qp (Qc_of_Z $ Z.pos n) _.
Next Obligation. intros n. by rewrite <-Z2Qc_inj_0, <-Z2Qc_inj_lt. Qed.
Global Arguments pos_to_Qp : simpl never.
Local Open Scope Qp_scope.
Module Qp.
Lemma to_Qc_inj_iff p q : Qp_to_Qc p = Qp_to_Qc q ↔ p = q.
Proof.
split; [|by intros ->].
destruct p, q; intros; simplify_eq/=; f_equal; apply (proof_irrel _).
Qed.
Global Instance eq_dec : EqDecision Qp.
Proof.
refine (λ p q, cast_if (decide (Qp_to_Qc p = Qp_to_Qc q)));
abstract (by rewrite <-to_Qc_inj_iff).
Defined.
Definition add (p q : Qp) : Qp :=
let 'mk_Qp p Hp := p in let 'mk_Qp q Hq := q in
mk_Qp (p + q) (Qcplus_pos_pos _ _ Hp Hq).
Global Arguments add : simpl never.
Definition sub (p q : Qp) : option Qp :=
let 'mk_Qp p Hp := p in let 'mk_Qp q Hq := q in
let pq := (p - q)%Qc in
Hpq ← guard (0 < pq)%Qc; Some (mk_Qp pq Hpq).
Global Arguments sub : simpl never.
Definition mul (p q : Qp) : Qp :=
let 'mk_Qp p Hp := p in let 'mk_Qp q Hq := q in
mk_Qp (p * q) (Qcmult_pos_pos _ _ Hp Hq).
Global Arguments mul : simpl never.
Definition inv (q : Qp) : Qp :=
let 'mk_Qp q Hq := q return _ in
mk_Qp (/ q)%Qc (Qcinv_pos _ Hq).
Global Arguments inv : simpl never.
Definition div (p q : Qp) : Qp := mul p (inv q).
Global Typeclasses Opaque div.
Global Arguments div : simpl never.
Definition le (p q : Qp) : Prop :=
let 'mk_Qp p _ := p in let 'mk_Qp q _ := q in (p ≤ q)%Qc.
Definition lt (p q : Qp) : Prop :=
let 'mk_Qp p _ := p in let 'mk_Qp q _ := q in (p < q)%Qc.
Lemma to_Qc_inj_add p q : Qp_to_Qc (add p q) = (Qp_to_Qc p + Qp_to_Qc q)%Qc.
Proof. by destruct p, q. Qed.
Lemma to_Qc_inj_mul p q : Qp_to_Qc (mul p q) = (Qp_to_Qc p * Qp_to_Qc q)%Qc.
Proof. by destruct p, q. Qed.
Lemma to_Qc_inj_le p q : le p q ↔ (Qp_to_Qc p ≤ Qp_to_Qc q)%Qc.
Proof. by destruct p, q. Qed.
Lemma to_Qc_inj_lt p q : lt p q ↔ (Qp_to_Qc p < Qp_to_Qc q)%Qc.
Proof. by destruct p, q. Qed.
Global Instance le_dec : RelDecision le.
Proof.
refine (λ p q, cast_if (decide (Qp_to_Qc p ≤ Qp_to_Qc q)%Qc));
abstract (by rewrite to_Qc_inj_le).
Defined.
Global Instance lt_dec : RelDecision lt.
Proof.
refine (λ p q, cast_if (decide (Qp_to_Qc p < Qp_to_Qc q)%Qc));
abstract (by rewrite to_Qc_inj_lt).
Defined.
Global Instance lt_pi p q : ProofIrrel (lt p q).
Proof. destruct p, q; apply _. Qed.
Definition max (q p : Qp) : Qp := if decide (le q p) then p else q.
Definition min (q p : Qp) : Qp := if decide (le q p) then q else p.
Module Import notations.
Infix "+" := add : Qp_scope.
Infix "-" := sub : Qp_scope.
Infix "*" := mul : Qp_scope.
Notation "/ q" := (inv q) : Qp_scope.
Infix "/" := div : Qp_scope.
Notation "1" := (pos_to_Qp 1) : Qp_scope.
Notation "2" := (pos_to_Qp 2) : Qp_scope.
Notation "3" := (pos_to_Qp 3) : Qp_scope.
Notation "4" := (pos_to_Qp 4) : Qp_scope.
Infix "≤" := le : Qp_scope.
Infix "<" := lt : Qp_scope.
Notation "p ≤ q ≤ r" := (p ≤ q ∧ q ≤ r) : Qp_scope.
Notation "p ≤ q < r" := (p ≤ q ∧ q < r) : Qp_scope.
Notation "p < q < r" := (p < q ∧ q < r) : Qp_scope.
Notation "p < q ≤ r" := (p < q ∧ q ≤ r) : Qp_scope.
Notation "p ≤ q ≤ r ≤ r'" := (p ≤ q ∧ q ≤ r ∧ r ≤ r') : Qp_scope.
Notation "(≤)" := le (only parsing) : Qp_scope.
Notation "(<)" := lt (only parsing) : Qp_scope.
Infix "`max`" := max : Qp_scope.
Infix "`min`" := min : Qp_scope.
End notations.
Global Hint Extern 0 (_ ≤ _)%Qp => reflexivity : core.
Global Instance inhabited : Inhabited Qp := populate 1.
Global Instance add_assoc : Assoc (=) add.
Proof. intros [p ?] [q ?] [r ?]; apply to_Qc_inj_iff, Qcplus_assoc. Qed.
Global Instance add_comm : Comm (=) add.
Proof. intros [p ?] [q ?]; apply to_Qc_inj_iff, Qcplus_comm. Qed.
Global Instance add_inj_r p : Inj (=) (=) (add p).
Proof.
destruct p as [p ?].
intros [q1 ?] [q2 ?]. rewrite <-!to_Qc_inj_iff; simpl. apply (inj (Qcplus p)).
Qed.
Global Instance add_inj_l p : Inj (=) (=) (λ q, q + p).
Proof.
destruct p as [p ?].
intros [q1 ?] [q2 ?]. rewrite <-!to_Qc_inj_iff; simpl. apply (inj (λ q, q + p)%Qc).
Qed.
Global Instance mul_assoc : Assoc (=) mul.
Proof. intros [p ?] [q ?] [r ?]. apply Qp.to_Qc_inj_iff, Qcmult_assoc. Qed.
Global Instance mul_comm : Comm (=) mul.
Proof. intros [p ?] [q ?]; apply Qp.to_Qc_inj_iff, Qcmult_comm. Qed.
Global Instance mul_inj_r p : Inj (=) (=) (mul p).
Proof.
destruct p as [p ?]. intros [q1 ?] [q2 ?]. rewrite <-!Qp.to_Qc_inj_iff; simpl.
intros Hpq.
apply (anti_symm Qcle); apply (Qcmult_le_mono_pos_l _ _ p); by rewrite ?Hpq.
Qed.
Global Instance mul_inj_l p : Inj (=) (=) (λ q, q * p).
Proof.
intros q1 q2 Hpq. apply (inj (mul p)). by rewrite !(comm_L mul p).
Qed.
Lemma mul_add_distr_l p q r : p * (q + r) = p * q + p * r.
Proof. destruct p, q, r; by apply Qp.to_Qc_inj_iff, Qcmult_plus_distr_r. Qed.
Lemma mul_add_distr_r p q r : (p + q) * r = p * r + q * r.
Proof. destruct p, q, r; by apply Qp.to_Qc_inj_iff, Qcmult_plus_distr_l. Qed.
Lemma mul_1_l p : 1 * p = p.
Proof. destruct p; apply Qp.to_Qc_inj_iff, Qcmult_1_l. Qed.
Lemma mul_1_r p : p * 1 = p.
Proof. destruct p; apply Qp.to_Qc_inj_iff, Qcmult_1_r. Qed.
Global Instance mul_left_id : LeftId (=) 1 mul := mul_1_l.
Global Instance mul_right_id : RightId (=) 1 mul := mul_1_r.
Lemma add_1_1 : 1 + 1 = 2.
Proof. compute_done. Qed.
Lemma add_diag p : p + p = 2 * p.
Proof. by rewrite <-add_1_1, mul_add_distr_r, !mul_1_l. Qed.
Lemma mul_inv_l p : /p * p = 1.
Proof.
destruct p as [p ?]; apply Qp.to_Qc_inj_iff; simpl.
by rewrite Qcmult_inv_l, Z2Qc_inj_1 by (by apply not_symmetry, Qclt_not_eq).
Qed.
Lemma mul_inv_r p : p * /p = 1.
Proof. by rewrite (comm_L mul), mul_inv_l. Qed.
Lemma inv_mul_distr p q : /(p * q) = /p * /q.
Proof.
apply (inj (mul (p * q))).
rewrite mul_inv_r, (comm_L mul p), <-(assoc_L _), (assoc_L mul p).
by rewrite mul_inv_r, mul_1_l, mul_inv_r.
Qed.
Lemma inv_involutive p : / /p = p.
Proof.
rewrite <-(mul_1_l (/ /p)), <-(mul_inv_r p), <-(assoc_L _).
by rewrite mul_inv_r, mul_1_r.
Qed.
Global Instance inv_inj : Inj (=) (=) inv.
Proof.
intros p1 p2 Hp. apply (inj (mul (/p1))).
by rewrite mul_inv_l, Hp, mul_inv_l.
Qed.
Lemma inv_1 : /1 = 1.
Proof. compute_done. Qed.
Lemma inv_half_half : /2 + /2 = 1.
Proof. compute_done. Qed.
Lemma inv_quarter_quarter : /4 + /4 = /2.
Proof. compute_done. Qed.
Lemma div_diag p : p / p = 1.
Proof. apply mul_inv_r. Qed.
Lemma mul_div_l p q : (p / q) * q = p.
Proof. unfold div. by rewrite <-(assoc_L _), mul_inv_l, mul_1_r. Qed.
Lemma mul_div_r p q : q * (p / q) = p.
Proof. by rewrite (comm_L mul q), mul_div_l. Qed.
Lemma div_add_distr p q r : (p + q) / r = p / r + q / r.
Proof. apply mul_add_distr_r. Qed.
Lemma div_div p q r : (p / q) / r = p / (q * r).
Proof. unfold div. by rewrite inv_mul_distr, (assoc_L _). Qed.
Lemma div_mul_cancel_l p q r : (r * p) / (r * q) = p / q.
Proof.
rewrite <-div_div. f_equiv. unfold div.
by rewrite (comm_L mul r), <-(assoc_L _), mul_inv_r, mul_1_r.
Qed.
Lemma div_mul_cancel_r p q r : (p * r) / (q * r) = p / q.
Proof. by rewrite <-!(comm_L mul r), div_mul_cancel_l. Qed.
Lemma div_1 p : p / 1 = p.
Proof. by rewrite <-(mul_1_r (p / 1)), mul_div_l. Qed.
Lemma div_2 p : p / 2 + p / 2 = p.
Proof.
rewrite <-div_add_distr, add_diag.
rewrite <-(mul_1_r 2) at 2. by rewrite div_mul_cancel_l, div_1.
Qed.
Lemma div_2_mul p q : p / (2 * q) + p / (2 * q) = p / q.
Proof. by rewrite <-div_add_distr, add_diag, div_mul_cancel_l. Qed.
Global Instance div_right_id : RightId (=) 1 div := div_1.
Lemma half_half : 1 / 2 + 1 / 2 = 1.
Proof. compute_done. Qed.
Lemma quarter_quarter : 1 / 4 + 1 / 4 = 1 / 2.
Proof. compute_done. Qed.
Lemma quarter_three_quarter : 1 / 4 + 3 / 4 = 1.
Proof. compute_done. Qed.
Lemma three_quarter_quarter : 3 / 4 + 1 / 4 = 1.
Proof. compute_done. Qed.
Global Instance div_inj_r p : Inj (=) (=) (div p).
Proof. unfold div; apply _. Qed.
Global Instance div_inj_l p : Inj (=) (=) (λ q, q / p)%Qp.
Proof. unfold div; apply _. Qed.
Global Instance le_po : PartialOrder (≤).
Proof.
split; [split|].
- intros p. by apply to_Qc_inj_le.
- intros p q r. rewrite !to_Qc_inj_le. by etrans.
- intros p q. rewrite !to_Qc_inj_le, <-to_Qc_inj_iff. apply Qcle_antisym.
Qed.
Global Instance lt_strict : StrictOrder (<).
Proof.
split.
- intros p ?%to_Qc_inj_lt. by apply (irreflexivity (<)%Qc (Qp_to_Qc p)).
- intros p q r. rewrite !to_Qc_inj_lt. by etrans.
Qed.
Global Instance le_total: Total (≤).
Proof. intros p q. rewrite !to_Qc_inj_le. apply (total Qcle). Qed.
Lemma lt_le_incl p q : p < q → p ≤ q.
Proof. rewrite to_Qc_inj_lt, to_Qc_inj_le. apply Qclt_le_weak. Qed.
Lemma le_lteq p q : p ≤ q ↔ p < q ∨ p = q.
Proof.
rewrite to_Qc_inj_lt, to_Qc_inj_le, <-Qp.to_Qc_inj_iff. split.
- intros [?| ->]%Qcle_lt_or_eq; auto.
- intros [?| ->]; auto using Qclt_le_weak.
Qed.
Lemma lt_ge_cases p q : {p < q} + {q ≤ p}.
Proof.
refine (cast_if (Qclt_le_dec (Qp_to_Qc p) (Qp_to_Qc q)%Qc));
[by apply to_Qc_inj_lt|by apply to_Qc_inj_le].
Defined.
Lemma le_lt_trans p q r : p ≤ q → q < r → p < r.
Proof. rewrite !to_Qc_inj_lt, to_Qc_inj_le. apply Qcle_lt_trans. Qed.
Lemma lt_le_trans p q r : p < q → q ≤ r → p < r.
Proof. rewrite !to_Qc_inj_lt, to_Qc_inj_le. apply Qclt_le_trans. Qed.
Lemma le_ngt p q : p ≤ q ↔ ¬q < p.
Proof.
rewrite !to_Qc_inj_lt, to_Qc_inj_le.
split; auto using Qcle_not_lt, Qcnot_lt_le.
Qed.
Lemma lt_nge p q : p < q ↔ ¬q ≤ p.
Proof.
rewrite !to_Qc_inj_lt, to_Qc_inj_le.
split; auto using Qclt_not_le, Qcnot_le_lt.
Qed.
Lemma add_le_mono_l p q r : p ≤ q ↔ r + p ≤ r + q.
Proof. rewrite !to_Qc_inj_le. destruct p, q, r; apply Qcplus_le_mono_l. Qed.
Lemma add_le_mono_r p q r : p ≤ q ↔ p + r ≤ q + r.
Proof. rewrite !(comm_L add _ r). apply add_le_mono_l. Qed.
Lemma add_le_mono q p n m : q ≤ n → p ≤ m → q + p ≤ n + m.
Proof. intros. etrans; [by apply add_le_mono_l|by apply add_le_mono_r]. Qed.
Lemma add_lt_mono_l p q r : p < q ↔ r + p < r + q.
Proof. by rewrite !lt_nge, <-add_le_mono_l. Qed.
Lemma add_lt_mono_r p q r : p < q ↔ p + r < q + r.
Proof. by rewrite !lt_nge, <-add_le_mono_r. Qed.
Lemma add_lt_mono q p n m : q < n → p < m → q + p < n + m.
Proof. intros. etrans; [by apply add_lt_mono_l|by apply add_lt_mono_r]. Qed.
Lemma mul_le_mono_l p q r : p ≤ q ↔ r * p ≤ r * q.
Proof.
rewrite !to_Qc_inj_le. destruct p, q, r; by apply Qcmult_le_mono_pos_l.
Qed.
Lemma mul_le_mono_r p q r : p ≤ q ↔ p * r ≤ q * r.
Proof. rewrite !(comm_L mul _ r). apply mul_le_mono_l. Qed.
Lemma mul_le_mono q p n m : q ≤ n → p ≤ m → q * p ≤ n * m.
Proof. intros. etrans; [by apply mul_le_mono_l|by apply mul_le_mono_r]. Qed.
Lemma mul_lt_mono_l p q r : p < q ↔ r * p < r * q.
Proof.
rewrite !to_Qc_inj_lt. destruct p, q, r; by apply Qcmult_lt_mono_pos_l.
Qed.
Lemma mul_lt_mono_r p q r : p < q ↔ p * r < q * r.
Proof. rewrite !(comm_L mul _ r). apply mul_lt_mono_l. Qed.
Lemma mul_lt_mono q p n m : q < n → p < m → q * p < n * m.
Proof. intros. etrans; [by apply mul_lt_mono_l|by apply mul_lt_mono_r]. Qed.
Lemma lt_add_l p q : p < p + q.
Proof.
destruct p as [p ?], q as [q ?]. apply to_Qc_inj_lt; simpl.
rewrite <- (Qcplus_0_r p) at 1. by rewrite <-Qcplus_lt_mono_l.
Qed.
Lemma lt_add_r p q : q < p + q.
Proof. rewrite (comm_L add). apply lt_add_l. Qed.
Lemma not_add_le_l p q : ¬(p + q ≤ p).
Proof. apply lt_nge, lt_add_l. Qed.
Lemma not_add_le_r p q : ¬(p + q ≤ q).
Proof. apply lt_nge, lt_add_r. Qed.
Lemma add_id_free q p : q + p ≠ q.
Proof. intro Heq. apply (not_add_le_l q p). by rewrite Heq. Qed.
Lemma le_add_l p q : p ≤ p + q.
Proof. apply lt_le_incl, lt_add_l. Qed.
Lemma le_add_r p q : q ≤ p + q.
Proof. apply lt_le_incl, lt_add_r. Qed.
Lemma sub_Some p q r : p - q = Some r ↔ p = q + r.
Proof.
destruct p as [p Hp], q as [q Hq], r as [r Hr].
unfold sub, add; simpl; rewrite <-Qp.to_Qc_inj_iff; simpl. split.
- intros; simplify_option_eq. unfold Qcminus.
by rewrite (Qcplus_comm p), Qcplus_assoc, Qcplus_opp_r, Qcplus_0_l.
- intros ->. unfold Qcminus.
rewrite <-Qcplus_assoc, (Qcplus_comm r), Qcplus_assoc.
rewrite Qcplus_opp_r, Qcplus_0_l. simplify_option_eq; [|done].
f_equal. by apply Qp.to_Qc_inj_iff.
Qed.
Lemma lt_sum p q : p < q ↔ ∃ r, q = p + r.
Proof.
destruct p as [p Hp], q as [q Hq]. rewrite to_Qc_inj_lt; simpl.
split.
- intros Hlt%Qclt_minus_iff. exists (mk_Qp (q - p) Hlt).
apply Qp.to_Qc_inj_iff; simpl. unfold Qcminus.
by rewrite (Qcplus_comm q), Qcplus_assoc, Qcplus_opp_r, Qcplus_0_l.
- intros [[r ?] ?%Qp.to_Qc_inj_iff]; simplify_eq/=.
rewrite <-(Qcplus_0_r p) at 1. by apply Qcplus_lt_mono_l.
Qed.
Lemma sub_None p q : p - q = None ↔ p ≤ q.
Proof.
rewrite le_ngt, lt_sum, eq_None_not_Some.
by setoid_rewrite <-sub_Some.
Qed.
Lemma sub_diag p : p - p = None.
Proof. by apply sub_None. Qed.
Lemma add_sub p q : (p + q) - q = Some p.
Proof. apply sub_Some. by rewrite (comm_L add). Qed.
Lemma inv_lt_mono p q : p < q ↔ /q < /p.
Proof.
revert p q. cut (∀ p q, p < q → / q < / p).
{ intros help p q. split; [apply help|]. intros.
rewrite <-(inv_involutive p), <-(inv_involutive q). by apply help. }
intros p q Hpq. apply (mul_lt_mono_l _ _ q). rewrite mul_inv_r.
apply (mul_lt_mono_r _ _ p). rewrite <-(assoc_L _), mul_inv_l.
by rewrite mul_1_l, mul_1_r.
Qed.
Lemma inv_le_mono p q : p ≤ q ↔ /q ≤ /p.
Proof. by rewrite !le_ngt, inv_lt_mono. Qed.
Lemma div_le_mono_l p q r : q ≤ p ↔ r / p ≤ r / q.
Proof. unfold div. by rewrite <-mul_le_mono_l, inv_le_mono. Qed.
Lemma div_le_mono_r p q r : p ≤ q ↔ p / r ≤ q / r.
Proof. apply mul_le_mono_r. Qed.
Lemma div_lt_mono_l p q r : q < p ↔ r / p < r / q.
Proof. unfold div. by rewrite <-mul_lt_mono_l, inv_lt_mono. Qed.
Lemma div_lt_mono_r p q r : p < q ↔ p / r < q / r.
Proof. apply mul_lt_mono_r. Qed.
Lemma div_lt p q : 1 < q → p / q < p.
Proof. by rewrite (div_lt_mono_l _ _ p), div_1. Qed.
Lemma div_le p q : 1 ≤ q → p / q ≤ p.
Proof. by rewrite (div_le_mono_l _ _ p), div_1. Qed.
Lemma lower_bound q1 q2 : ∃ q q1' q2', q1 = q + q1' ∧ q2 = q + q2'.
Proof.
revert q1 q2. cut (∀ q1 q2 : Qp, q1 ≤ q2 →
∃ q q1' q2', q1 = q + q1' ∧ q2 = q + q2').
{ intros help q1 q2.
destruct (lt_ge_cases q2 q1) as [Hlt|Hle]; eauto.
destruct (help q2 q1) as (q&q1'&q2'&?&?); eauto using lt_le_incl. }
intros q1 q2 Hq. exists (q1 / 2)%Qp, (q1 / 2)%Qp.
assert (q1 / 2 < q2) as [q2' ->]%lt_sum.
{ eapply lt_le_trans, Hq. by apply div_lt. }
eexists; split; [|done]. by rewrite div_2.
Qed.
Lemma lower_bound_lt q1 q2 : ∃ q : Qp, q < q1 ∧ q < q2.
Proof.
destruct (lower_bound q1 q2) as (qmin & q1' & q2' & [-> ->]).
exists qmin. split; eapply lt_sum; eauto.
Qed.
Lemma cross_split a b c d :
a + b = c + d →
∃ ac ad bc bd, ac + ad = a ∧ bc + bd = b ∧ ac + bc = c ∧ ad + bd = d.
Proof.
intros H. revert a b c d H. cut (∀ a b c d : Qp,
a < c → a + b = c + d →
∃ ac ad bc bd, ac + ad = a ∧ bc + bd = b ∧ ac + bc = c ∧ ad + bd = d)%Qp.
{ intros help a b c d Habcd.
destruct (lt_ge_cases a c) as [?|[?| ->]%le_lteq].
- auto.
- destruct (help c d a b); [done..|]. naive_solver.
- apply (inj (add a)) in Habcd as ->.
destruct (lower_bound a d) as (q&a'&d'&->&->).
exists a', q, q, d'. repeat split; done || by rewrite (comm_L add). }
intros a b c d [e ->]%lt_sum. rewrite <-(assoc_L _). intros ->%(inj (add a)).
destruct (lower_bound a d) as (q&a'&d'&->&->).
eexists a', q, (q + e)%Qp, d'; split_and?; [by rewrite (comm_L add)|..|done].
- by rewrite (assoc_L _), (comm_L add e).
- by rewrite (assoc_L _), (comm_L add a').
Qed.
Lemma bounded_split p r : ∃ q1 q2 : Qp, q1 ≤ r ∧ p = q1 + q2.
Proof.
destruct (lt_ge_cases r p) as [[q ->]%lt_sum|?].
{ by exists r, q. }
exists (p / 2)%Qp, (p / 2)%Qp; split.
+ trans p; [|done]. by apply div_le.
+ by rewrite div_2.
Qed.
Lemma max_spec q p : (q < p ∧ q `max` p = p) ∨ (p ≤ q ∧ q `max` p = q).
Proof.
unfold max.
destruct (decide (q ≤ p)) as [[?| ->]%le_lteq|?]; [by auto..|].
right. split; [|done]. by apply lt_le_incl, lt_nge.
Qed.
Lemma max_spec_le q p : (q ≤ p ∧ q `max` p = p) ∨ (p ≤ q ∧ q `max` p = q).
Proof. destruct (max_spec q p) as [[?%lt_le_incl?]|]; [left|right]; done. Qed.
Global Instance max_assoc : Assoc (=) max.
Proof.
intros q p o. unfold max. destruct (decide (q ≤ p)), (decide (p ≤ o));
try by rewrite ?decide_True by (by etrans).
rewrite decide_False by done.
by rewrite decide_False by (apply lt_nge; etrans; by apply lt_nge).
Qed.
Global Instance max_comm : Comm (=) max.
Proof.
intros q p.
destruct (max_spec_le q p) as [[?->]|[?->]],
(max_spec_le p q) as [[?->]|[?->]]; done || by apply (anti_symm (≤)).
Qed.
Lemma max_id q : q `max` q = q.
Proof. by destruct (max_spec q q) as [[_->]|[_->]]. Qed.
Lemma le_max_l q p : q ≤ q `max` p.
Proof. unfold max. by destruct (decide (q ≤ p)). Qed.
Lemma le_max_r q p : p ≤ q `max` p.
Proof. rewrite (comm_L max q). apply le_max_l. Qed.
Lemma max_add q p : q `max` p ≤ q + p.
Proof.
unfold max.
destruct (decide (q ≤ p)); [apply le_add_r|apply le_add_l].
Qed.
Lemma max_lub_l q p o : q `max` p ≤ o → q ≤ o.
Proof. unfold max. destruct (decide (q ≤ p)); [by etrans|done]. Qed.
Lemma max_lub_r q p o : q `max` p ≤ o → p ≤ o.
Proof. rewrite (comm _ q). apply max_lub_l. Qed.
Lemma min_spec q p : (q < p ∧ q `min` p = q) ∨ (p ≤ q ∧ q `min` p = p).
Proof.
unfold min.
destruct (decide (q ≤ p)) as [[?| ->]%le_lteq|?]; [by auto..|].
right. split; [|done]. by apply lt_le_incl, lt_nge.
Qed.
Lemma min_spec_le q p : (q ≤ p ∧ q `min` p = q) ∨ (p ≤ q ∧ q `min` p = p).
Proof. destruct (min_spec q p) as [[?%lt_le_incl ?]|]; [left|right]; done. Qed.
Global Instance min_assoc : Assoc (=) min.
Proof.
intros q p o. unfold min.
destruct (decide (q ≤ p)), (decide (p ≤ o)); eauto using decide_False.
- by rewrite !decide_True by (by etrans).
- by rewrite decide_False by (apply lt_nge; etrans; by apply lt_nge).
Qed.
Global Instance min_comm : Comm (=) min.
Proof.
intros q p.
destruct (min_spec_le q p) as [[?->]|[?->]],
(min_spec_le p q) as [[? ->]|[? ->]]; done || by apply (anti_symm (≤)).
Qed.
Lemma min_id q : q `min` q = q.
Proof. by destruct (min_spec q q) as [[_->]|[_->]]. Qed.
Lemma le_min_r q p : q `min` p ≤ p.
Proof. by destruct (min_spec_le q p) as [[?->]|[?->]]. Qed.
Lemma le_min_l p q : p `min` q ≤ p.
Proof. rewrite (comm_L min p). apply le_min_r. Qed.
Lemma min_l_iff q p : q `min` p = q ↔ q ≤ p.
Proof.
destruct (min_spec_le q p) as [[?->]|[?->]]; [done|].
split; [by intros ->|]. intros. by apply (anti_symm (≤)).
Qed.
Lemma min_r_iff q p : q `min` p = p ↔ p ≤ q.
Proof. rewrite (comm_L min q). apply min_l_iff. Qed.
End Qp.
Export Qp.notations.
Lemma pos_to_Qp_1 : pos_to_Qp 1 = 1.
Proof. compute_done. Qed.
Lemma pos_to_Qp_inj n m : pos_to_Qp n = pos_to_Qp m → n = m.
Proof. by injection 1. Qed.
Lemma pos_to_Qp_inj_iff n m : pos_to_Qp n = pos_to_Qp m ↔ n = m.
Proof. split; [apply pos_to_Qp_inj|by intros ->]. Qed.
Lemma pos_to_Qp_inj_le n m : (n ≤ m)%positive ↔ pos_to_Qp n ≤ pos_to_Qp m.
Proof. rewrite Qp.to_Qc_inj_le; simpl. by rewrite <-Z2Qc_inj_le. Qed.
Lemma pos_to_Qp_inj_lt n m : (n < m)%positive ↔ pos_to_Qp n < pos_to_Qp m.
Proof. by rewrite Pos.lt_nle, Qp.lt_nge, <-pos_to_Qp_inj_le. Qed.
Lemma pos_to_Qp_add x y : pos_to_Qp x + pos_to_Qp y = pos_to_Qp (x + y).
Proof. apply Qp.to_Qc_inj_iff; simpl. by rewrite Pos2Z.inj_add, Z2Qc_inj_add. Qed.
Lemma pos_to_Qp_mul x y : pos_to_Qp x * pos_to_Qp y = pos_to_Qp (x * y).
Proof. apply Qp.to_Qc_inj_iff; simpl. by rewrite Pos2Z.inj_mul, Z2Qc_inj_mul. Qed.
Local Close Scope Qp_scope.
(** * Helper for working with accessing lists with wrap-around
See also [rotate] and [rotate_take] in [list.v] *)
(** [rotate_nat_add base offset len] computes [(base + offset) `mod`
len]. This is useful in combination with the [rotate] function on
lists, since the index [i] of [rotate n l] corresponds to the index
[rotate_nat_add n i (length i)] of the original list. The definition
uses [Z] for consistency with [rotate_nat_sub]. **)
Definition rotate_nat_add (base offset len : nat) : nat :=
Z.to_nat ((Z.of_nat base + Z.of_nat offset) `mod` Z.of_nat len)%Z.
(** [rotate_nat_sub base offset len] is the inverse of [rotate_nat_add
base offset len]. The definition needs to use modulo on [Z] instead of
on nat since otherwise we need the sidecondition [base < len] on
[rotate_nat_sub_add]. **)
Definition rotate_nat_sub (base offset len : nat) : nat :=
Z.to_nat ((Z.of_nat len + Z.of_nat offset - Z.of_nat base) `mod` Z.of_nat len)%Z.
Lemma rotate_nat_add_add_mod base offset len:
rotate_nat_add base offset len =
rotate_nat_add (base `mod` len) offset len.
Proof. unfold rotate_nat_add. by rewrite Nat2Z.inj_mod, Zplus_mod_idemp_l. Qed.
Lemma rotate_nat_add_alt base offset len:
base < len → offset < len →
rotate_nat_add base offset len =
if decide (base + offset < len) then base + offset else base + offset - len.
Proof.
unfold rotate_nat_add. intros ??. case_decide.
- rewrite Z.mod_small by lia. by rewrite <-Nat2Z.inj_add, Nat2Z.id.
- rewrite (Z.mod_in_range 1) by lia.
by rewrite Z.mul_1_l, <-Nat2Z.inj_add, <-Nat2Z.inj_sub,Nat2Z.id by lia.
Qed.
Lemma rotate_nat_sub_alt base offset len:
base < len → offset < len →
rotate_nat_sub base offset len =
if decide (offset < base) then len + offset - base else offset - base.
Proof.
unfold rotate_nat_sub. intros ??. case_decide.
- rewrite Z.mod_small by lia.
by rewrite <-Nat2Z.inj_add, <-Nat2Z.inj_sub, Nat2Z.id by lia.
- rewrite (Z.mod_in_range 1) by lia.
rewrite Z.mul_1_l, <-Nat2Z.inj_add, <-!Nat2Z.inj_sub,Nat2Z.id; lia.
Qed.
Lemma rotate_nat_add_0 base len :
base < len → rotate_nat_add base 0 len = base.
Proof.
intros ?. unfold rotate_nat_add.
rewrite Z.mod_small by lia. by rewrite Z.add_0_r, Nat2Z.id.
Qed.
Lemma rotate_nat_sub_0 base len :
base < len → rotate_nat_sub base base len = 0.
Proof. intros ?. rewrite rotate_nat_sub_alt by done. case_decide; lia. Qed.
Lemma rotate_nat_add_lt base offset len :
0 < len → rotate_nat_add base offset len < len.
Proof.
unfold rotate_nat_add. intros ?.
pose proof (Nat.mod_upper_bound (base + offset) len).
rewrite Z2Nat.inj_mod, Z2Nat.inj_add, !Nat2Z.id; lia.
Qed.
Lemma rotate_nat_sub_lt base offset len :
0 < len → rotate_nat_sub base offset len < len.
Proof.
unfold rotate_nat_sub. intros ?.
pose proof (Z_mod_lt (Z.of_nat len + Z.of_nat offset - Z.of_nat base) (Z.of_nat len)).
apply Nat2Z.inj_lt. rewrite Z2Nat.id; lia.
Qed.
Lemma rotate_nat_add_sub base len offset:
offset < len →
rotate_nat_add base (rotate_nat_sub base offset len) len = offset.
Proof.
intros ?. unfold rotate_nat_add, rotate_nat_sub.
rewrite Z2Nat.id by (apply Z.mod_pos; lia). rewrite Zplus_mod_idemp_r.
replace (Z.of_nat base + (Z.of_nat len + Z.of_nat offset - Z.of_nat base))%Z
with (Z.of_nat len + Z.of_nat offset)%Z by lia.
rewrite (Z.mod_in_range 1) by lia.
rewrite Z.mul_1_l, <-Nat2Z.inj_add, <-!Nat2Z.inj_sub,Nat2Z.id; lia.
Qed.
Lemma rotate_nat_sub_add base len offset:
offset < len →
rotate_nat_sub base (rotate_nat_add base offset len) len = offset.
Proof.
intros ?. unfold rotate_nat_add, rotate_nat_sub.
rewrite Z2Nat.id by (apply Z.mod_pos; lia).
assert (∀ n, (Z.of_nat len + n - Z.of_nat base) = ((Z.of_nat len - Z.of_nat base) + n))%Z
as -> by naive_solver lia.
rewrite Zplus_mod_idemp_r.
replace (Z.of_nat len - Z.of_nat base + (Z.of_nat base + Z.of_nat offset))%Z with
(Z.of_nat len + Z.of_nat offset)%Z by lia.
rewrite (Z.mod_in_range 1) by lia.
rewrite Z.mul_1_l, <-Nat2Z.inj_add, <-!Nat2Z.inj_sub,Nat2Z.id; lia.
Qed.
Lemma rotate_nat_add_add base offset len n:
0 < len →
rotate_nat_add base (offset + n) len =
(rotate_nat_add base offset len + n) `mod` len.
Proof.
intros ?. unfold rotate_nat_add.
rewrite !Z2Nat.inj_mod, !Z2Nat.inj_add, !Nat2Z.id by lia.
by rewrite Nat.add_assoc, Nat.add_mod_idemp_l by lia.
Qed.
Lemma rotate_nat_add_S base offset len:
0 < len →
rotate_nat_add base (S offset) len =
S (rotate_nat_add base offset len) `mod` len.
Proof. intros ?. by rewrite <-Nat.add_1_r, rotate_nat_add_add, Nat.add_1_r. Qed.
theories/option.v → stdpp/option.v
View file @ 9274984b
...@@ -13,8 +13,12 @@ Lemma None_ne_Some {A} (x : A) : None ≠ Some x. ...@@ -13,8 +13,12 @@ Lemma None_ne_Some {A} (x : A) : None ≠ Some x.
Proof. congruence. Qed. Proof. congruence. Qed.
Lemma Some_ne_None {A} (x : A) : Some x ≠ None. Lemma Some_ne_None {A} (x : A) : Some x ≠ None.
Proof. congruence. Qed. Proof. congruence. Qed.
Lemma eq_None_ne_Some {A} (mx : option A) x : mx = None → mx ≠ Some x. Lemma eq_None_ne_Some {A} (mx : option A) : (∀ x, mx ≠ Some x) ↔ mx = None.
Proof. congruence. Qed. Proof. destruct mx; split; congruence. Qed.
Lemma eq_None_ne_Some_1 {A} (mx : option A) x : mx = None → mx ≠ Some x.
Proof. intros ?. by apply eq_None_ne_Some. Qed.
Lemma eq_None_ne_Some_2 {A} (mx : option A) : (∀ x, mx ≠ Some x) → mx = None.
Proof. intros ?. by apply eq_None_ne_Some. Qed.
Global Instance Some_inj {A} : Inj (=) (=) (@Some A). Global Instance Some_inj {A} : Inj (=) (=) (@Some A).
Proof. congruence. Qed. Proof. congruence. Qed.
...@@ -106,9 +110,17 @@ Section Forall2. ...@@ -106,9 +110,17 @@ Section Forall2.
Global Instance option_Forall2_sym : Symmetric R → Symmetric (option_Forall2 R). Global Instance option_Forall2_sym : Symmetric R → Symmetric (option_Forall2 R).
Proof. destruct 2; by constructor. Qed. Proof. destruct 2; by constructor. Qed.
Global Instance option_Forall2_trans : Transitive R → Transitive (option_Forall2 R). Global Instance option_Forall2_trans : Transitive R → Transitive (option_Forall2 R).
Proof. destruct 2; inversion_clear 1; constructor; etrans; eauto. Qed. Proof. destruct 2; inv 1; constructor; etrans; eauto. Qed.
Global Instance option_Forall2_equiv : Equivalence R → Equivalence (option_Forall2 R). Global Instance option_Forall2_equiv : Equivalence R → Equivalence (option_Forall2 R).
Proof. destruct 1; split; apply _. Qed. Proof. destruct 1; split; apply _. Qed.
Lemma option_eq_Forall2 (mx my : option A) :
mx = my ↔ option_Forall2 eq mx my.
Proof.
split.
- intros ->. destruct my; constructor; done.
- intros [|]; naive_solver.
Qed.
End Forall2. End Forall2.
(** Setoids *) (** Setoids *)
...@@ -118,7 +130,7 @@ Section setoids. ...@@ -118,7 +130,7 @@ Section setoids.
Context `{Equiv A}. Context `{Equiv A}.
Implicit Types mx my : option A. Implicit Types mx my : option A.
Lemma equiv_option_Forall2 mx my : mx ≡ my ↔ option_Forall2 (≡) mx my. Lemma option_equiv_Forall2 mx my : mx ≡ my ↔ option_Forall2 (≡) mx my.
Proof. done. Qed. Proof. done. Qed.
Global Instance option_equivalence : Global Instance option_equivalence :
...@@ -130,21 +142,21 @@ Section setoids. ...@@ -130,21 +142,21 @@ Section setoids.
Global Instance Some_proper : Proper ((≡) ==> (≡@{option A})) Some. Global Instance Some_proper : Proper ((≡) ==> (≡@{option A})) Some.
Proof. by constructor. Qed. Proof. by constructor. Qed.
Global Instance Some_equiv_inj : Inj (≡) (≡@{option A}) Some. Global Instance Some_equiv_inj : Inj (≡) (≡@{option A}) Some.
Proof. by inversion_clear 1. Qed. Proof. by inv 1. Qed.
Lemma None_equiv_eq mx : mx ≡ None ↔ mx = None. Lemma None_equiv_eq mx : mx ≡ None ↔ mx = None.
Proof. split; [by inversion_clear 1|intros ->; constructor]. Qed. Proof. split; [by inv 1|intros ->; constructor]. Qed.
Lemma Some_equiv_eq mx y : mx ≡ Some y ↔ ∃ y', mx = Some y' ∧ y' ≡ y. Lemma Some_equiv_eq mx y : mx ≡ Some y ↔ ∃ y', mx = Some y' ∧ y' ≡ y.
Proof. split; [inversion 1; naive_solver|naive_solver (by constructor)]. Qed. Proof. split; [inv 1; naive_solver|naive_solver (by constructor)]. Qed.
Global Instance is_Some_proper : Proper ((≡@{option A}) ==> iff) is_Some. Global Instance is_Some_proper : Proper ((≡@{option A}) ==> iff) is_Some.
Proof. by inversion_clear 1. Qed. Proof. by inv 1. Qed.
Global Instance from_option_proper {B} (R : relation B) : Global Instance from_option_proper {B} (R : relation B) :
Proper (((≡@{A}) ==> R) ==> R ==> (≡) ==> R) from_option. Proper (((≡@{A}) ==> R) ==> R ==> (≡) ==> R) from_option.
Proof. destruct 3; simpl; auto. Qed. Proof. destruct 3; simpl; auto. Qed.
End setoids. End setoids.
Typeclasses Opaque option_equiv. Global Typeclasses Opaque option_equiv.
(** Equality on [option] is decidable. *) (** Equality on [option] is decidable. *)
Global Instance option_eq_None_dec {A} (mx : option A) : Decision (mx = None) := Global Instance option_eq_None_dec {A} (mx : option A) : Decision (mx = None) :=
...@@ -167,15 +179,20 @@ Global Instance option_bind: MBind option := λ A B f mx, ...@@ -167,15 +179,20 @@ Global Instance option_bind: MBind option := λ A B f mx,
Global Instance option_join: MJoin option := λ A mmx, Global Instance option_join: MJoin option := λ A mmx,
match mmx with Some mx => mx | None => None end. match mmx with Some mx => mx | None => None end.
Global Instance option_fmap: FMap option := @option_map. Global Instance option_fmap: FMap option := @option_map.
Global Instance option_guard: MGuard option := λ P dec A f, Global Instance option_mfail: MFail option := λ _ _, None.
match dec with left H => f H | _ => None end.
Global Instance option_fmap_inj {A B} (f : A → B) : Lemma option_fmap_inj {A B} (R1 : A → A → Prop) (R2 : B → B → Prop) (f : A → B) :
Inj R1 R2 f → Inj (option_Forall2 R1) (option_Forall2 R2) (fmap f).
Proof. intros ? [?|] [?|]; inv 1; constructor; auto. Qed.
Global Instance option_fmap_eq_inj {A B} (f : A → B) :
Inj (=) (=) f → Inj (=@{option A}) (=@{option B}) (fmap f). Inj (=) (=) f → Inj (=@{option A}) (=@{option B}) (fmap f).
Proof. intros ? [x1|] [x2|] [=]; naive_solver. Qed. Proof.
intros ?%option_fmap_inj ?? ?%option_eq_Forall2%(inj _).
by apply option_eq_Forall2.
Qed.
Global Instance option_fmap_equiv_inj `{Equiv A, Equiv B} (f : A → B) : Global Instance option_fmap_equiv_inj `{Equiv A, Equiv B} (f : A → B) :
Inj (≡) (≡) f → Inj (≡@{option A}) (≡@{option B}) (fmap f). Inj (≡) (≡) f → Inj (≡@{option A}) (≡@{option B}) (fmap f).
Proof. intros ? [x1|] [x2|]; inversion 1; subst; constructor; by apply (inj _). Qed. Proof. apply option_fmap_inj. Qed.
Lemma fmap_is_Some {A B} (f : A → B) mx : is_Some (f <$> mx) ↔ is_Some mx. 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. Proof. unfold is_Some; destruct mx; naive_solver. Qed.
...@@ -230,7 +247,7 @@ Lemma bind_Some {A B} (f : A → option B) (mx : option A) y : ...@@ -230,7 +247,7 @@ Lemma bind_Some {A B} (f : A → option B) (mx : option A) y :
Proof. destruct mx; naive_solver. Qed. Proof. destruct mx; naive_solver. Qed.
Lemma bind_Some_equiv {A} `{Equiv B} (f : A → option B) (mx : option A) y : Lemma bind_Some_equiv {A} `{Equiv B} (f : A → option B) (mx : option A) y :
mx ≫= f ≡ Some y ↔ ∃ x, mx = Some x ∧ f x ≡ Some y. mx ≫= f ≡ Some y ↔ ∃ x, mx = Some x ∧ f x ≡ Some y.
Proof. destruct mx; (split; [inversion 1|]); naive_solver. Qed. Proof. destruct mx; split; first [by inv 1|naive_solver]. Qed.
Lemma bind_None {A B} (f : A → option B) (mx : option A) : Lemma bind_None {A B} (f : A → option B) (mx : option A) :
mx ≫= f = None ↔ mx = None ∨ ∃ x, mx = Some x ∧ f x = None. mx ≫= f = None ↔ mx = None ∨ ∃ x, mx = Some x ∧ f x = None.
Proof. destruct mx; naive_solver. Qed. Proof. destruct mx; naive_solver. Qed.
...@@ -292,9 +309,56 @@ Global Instance option_difference_with {A} : DifferenceWith A (option A) := λ f ...@@ -292,9 +309,56 @@ Global Instance option_difference_with {A} : DifferenceWith A (option A) := λ f
end. end.
Global Instance option_union {A} : Union (option A) := union_with (λ x _, Some x). Global Instance option_union {A} : Union (option A) := union_with (λ x _, Some x).
Lemma option_union_Some {A} (mx my : option A) z : Lemma union_Some {A} (mx my : option A) z :
mx ∪ my = Some z → mx = Some z ∨ my = Some z. mx ∪ my = Some z ↔ mx = Some z ∨ (mx = None ∧ my = Some z).
Proof. destruct mx, my; naive_solver. Qed.
Lemma union_Some_l {A} x (my : option A) :
Some x ∪ my = Some x.
Proof. destruct my; done. Qed.
Lemma union_Some_r {A} (mx : option A) y :
mx ∪ Some y = Some (default y mx).
Proof. destruct mx; done. Qed.
Lemma union_None {A} (mx my : option A) :
mx ∪ my = None ↔ mx = None ∧ my = None.
Proof. destruct mx, my; naive_solver. Qed.
Lemma union_is_Some {A} (mx my : option A) :
is_Some (mx ∪ my) ↔ is_Some mx ∨ is_Some my.
Proof. destruct mx, my; naive_solver. Qed.
Global Instance option_union_left_id {A} : LeftId (=@{option A}) None union.
Proof. by intros [?|]. Qed.
Global Instance option_union_right_id {A} : RightId (=@{option A}) None union.
Proof. by intros [?|]. Qed.
Global Instance option_intersection {A} : Intersection (option A) :=
intersection_with (λ x _, Some x).
Lemma intersection_Some {A} (mx my : option A) x :
mx ∩ my = Some x ↔ mx = Some x ∧ is_Some my.
Proof. destruct mx, my; unfold is_Some; naive_solver. Qed.
Lemma intersection_is_Some {A} (mx my : option A) :
is_Some (mx ∩ my) ↔ is_Some mx ∧ is_Some my.
Proof. destruct mx, my; unfold is_Some; naive_solver. Qed.
Lemma intersection_Some_r {A} (mx : option A) (y : A) :
mx ∩ Some y = mx.
Proof. by destruct mx. Qed.
Lemma intersection_None {A} (mx my : option A) :
mx ∩ my = None ↔ mx = None ∨ my = None.
Proof. destruct mx, my; naive_solver. Qed. Proof. destruct mx, my; naive_solver. Qed.
Lemma intersection_None_l {A} (my : option A) :
None ∩ my = None.
Proof. destruct my; done. Qed.
Lemma intersection_None_r {A} (mx : option A) :
mx ∩ None = None.
Proof. destruct mx; done. Qed.
Global Instance option_intersection_right_absorb {A} :
RightAbsorb (=@{option A}) None intersection.
Proof. by intros [?|]. Qed.
Global Instance option_intersection_left_absorb {A} :
LeftAbsorb (=@{option A}) None intersection.
Proof. by intros [?|]. Qed.
Section union_intersection_difference. Section union_intersection_difference.
Context {A} (f : A → A → option A). Context {A} (f : A → A → option A).
...@@ -306,10 +370,27 @@ Section union_intersection_difference. ...@@ -306,10 +370,27 @@ Section union_intersection_difference.
Global Instance union_with_comm : Global Instance union_with_comm :
Comm (=) f → Comm (=@{option A}) (union_with f). Comm (=) f → Comm (=@{option A}) (union_with f).
Proof. by intros ? [?|] [?|]; compute; rewrite 1?(comm f). Qed. Proof. by intros ? [?|] [?|]; compute; rewrite 1?(comm f). Qed.
(** These are duplicates of the above [LeftId]/[RightId] instances, but easier to
find with [SearchAbout]. *)
Lemma union_with_None_l my : union_with f None my = my.
Proof. destruct my; done. Qed.
Lemma union_with_None_r mx : union_with f mx None = mx.
Proof. destruct mx; done. Qed.
Global Instance intersection_with_left_ab : LeftAbsorb (=) None (intersection_with f). Global Instance intersection_with_left_ab : LeftAbsorb (=) None (intersection_with f).
Proof. by intros [?|]. Qed. Proof. by intros [?|]. Qed.
Global Instance intersection_with_right_ab : RightAbsorb (=) None (intersection_with f). Global Instance intersection_with_right_ab : RightAbsorb (=) None (intersection_with f).
Proof. by intros [?|]. Qed. Proof. by intros [?|]. Qed.
Global Instance intersection_with_comm :
Comm (=) f → Comm (=@{option A}) (intersection_with f).
Proof. by intros ? [?|] [?|]; compute; rewrite 1?(comm f). Qed.
(** These are duplicates of the above [LeftAbsorb]/[RightAbsorb] instances, but
easier to find with [SearchAbout]. *)
Lemma intersection_with_None_l my : intersection_with f None my = None.
Proof. destruct my; done. Qed.
Lemma intersection_with_None_r mx : intersection_with f mx None = None.
Proof. destruct mx; done. Qed.
Global Instance difference_with_comm : Global Instance difference_with_comm :
Comm (=) f → Comm (=@{option A}) (intersection_with f). Comm (=) f → Comm (=@{option A}) (intersection_with f).
Proof. by intros ? [?|] [?|]; compute; rewrite 1?(comm f). Qed. Proof. by intros ? [?|] [?|]; compute; rewrite 1?(comm f). Qed.
...@@ -330,34 +411,27 @@ Section union_intersection_difference. ...@@ -330,34 +411,27 @@ Section union_intersection_difference.
Proof. apply union_with_proper. by constructor. Qed. Proof. apply union_with_proper. by constructor. Qed.
End union_intersection_difference. End union_intersection_difference.
(** * Tactics *) (** This lemma includes a bind, to avoid equalities of proofs. We cannot have
Tactic Notation "case_option_guard" "as" ident(Hx) := [guard P = Some p ↔ P] unless [P] is proof irrelant. The best (but less usable)
match goal with self-contained alternative would be [guard P = Some p ↔ decide P = left p]. *)
| 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) : Lemma option_guard_True {A} P `{Decision P} (mx : option A) :
P → mguard P (λ _, mx) = mx. P → (guard P;; mx) = mx.
Proof. intros. by case_option_guard. Qed. Proof. intros. by case_guard. Qed.
Lemma option_guard_True_pi {A} P `{Decision P, ProofIrrel P} (f : P → option A) Lemma option_guard_True_pi P `{Decision P, ProofIrrel P} (HP : P) :
(HP : P) : guard P = Some HP.
mguard P f = f HP. Proof. case_guard; [|done]. f_equal; apply proof_irrel. Qed.
Proof. intros. case_option_guard; [|done]. f_equal; apply proof_irrel. Qed. Lemma option_guard_False P `{Decision P} :
Lemma option_guard_False {A} P `{Decision P} (f : P → option A) : ¬P → guard P = None.
¬P → mguard P f = None. Proof. intros. by case_guard. Qed.
Proof. intros. by case_option_guard. Qed.
Lemma option_guard_iff {A} P Q `{Decision P, Decision Q} (mx : option A) : Lemma option_guard_iff {A} P Q `{Decision P, Decision Q} (mx : option A) :
(P ↔ Q) → (guard P; mx) = guard Q; mx. (P ↔ Q) → (guard P;; mx) = (guard Q;; mx).
Proof. intros [??]. repeat case_option_guard; intuition. Qed. Proof. intros [??]. repeat case_guard; intuition. Qed.
Lemma option_guard_decide {A} P `{Decision P} (mx : option A) :
(guard P;; mx) = if decide P then mx else None.
Proof. by case_guard. Qed.
Lemma option_guard_bool_decide {A} P `{Decision P} (mx : option A) :
(guard P;; mx) = if bool_decide P then mx else None.
Proof. by rewrite option_guard_decide, decide_bool_decide. Qed.
Tactic Notation "simpl_option" "by" tactic3(tac) := Tactic Notation "simpl_option" "by" tactic3(tac) :=
let assert_Some_None A mx H := first let assert_Some_None A mx H := first
...@@ -392,8 +466,8 @@ Tactic Notation "simpl_option" "by" tactic3(tac) := ...@@ -392,8 +466,8 @@ Tactic Notation "simpl_option" "by" tactic3(tac) :=
end end
| H : context [decide _] |- _ => rewrite decide_True in H by tac | H : context [decide _] |- _ => rewrite decide_True in H by tac
| H : context [decide _] |- _ => rewrite decide_False 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 [guard _] |- _ => rewrite option_guard_False in H by tac
| H : context [mguard _ _] |- _ => rewrite option_guard_True in H by tac | H : context [guard _] |- _ => rewrite option_guard_True in H by tac
| _ => rewrite decide_True by tac | _ => rewrite decide_True by tac
| _ => rewrite decide_False by tac | _ => rewrite decide_False by tac
| _ => rewrite option_guard_True by tac | _ => rewrite option_guard_True by tac
...@@ -411,7 +485,7 @@ Tactic Notation "simplify_option_eq" "by" tactic3(tac) := ...@@ -411,7 +485,7 @@ Tactic Notation "simplify_option_eq" "by" tactic3(tac) :=
| _ : maybe2 _ ?x = Some _ |- _ => is_var x; destruct x | _ : maybe2 _ ?x = Some _ |- _ => is_var x; destruct x
| _ : maybe3 _ ?x = Some _ |- _ => is_var x; destruct x | _ : maybe3 _ ?x = Some _ |- _ => is_var x; destruct x
| _ : maybe4 _ ?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 : _ ∪ _ = Some _ |- _ => apply union_Some in H; destruct H
| H : mbind (M:=option) ?f ?mx = ?my |- _ => | H : mbind (M:=option) ?f ?mx = ?my |- _ =>
match mx with Some _ => fail 1 | None => fail 1 | _ => idtac end; match mx with Some _ => fail 1 | None => fail 1 | _ => idtac end;
match my with Some _ => idtac | None => idtac | _ => fail 1 end; match my with Some _ => idtac | None => idtac | _ => fail 1 end;
...@@ -433,6 +507,6 @@ Tactic Notation "simplify_option_eq" "by" tactic3(tac) := ...@@ -433,6 +507,6 @@ Tactic Notation "simplify_option_eq" "by" tactic3(tac) :=
let x := fresh in destruct mx as [x|] eqn:?; let x := fresh in destruct mx as [x|] eqn:?;
[change (my = Some (f x)) in H|change (my = None) in H] [change (my = Some (f x)) in H|change (my = None) in H]
| _ => progress case_decide | _ => progress case_decide
| _ => progress case_option_guard | _ => progress case_guard
end. end.
Tactic Notation "simplify_option_eq" := simplify_option_eq by eauto. Tactic Notation "simplify_option_eq" := simplify_option_eq by eauto.
theories/options.v → stdpp/options.v
View file @ 9274984b
(** Coq configuration for std++ (not meant to leak to clients) *) (** Coq configuration for std++ (not meant to leak to clients).
If you are a user of std++, note that importing this file means
you are implicitly opting-in to every new option we will add here
in the future. We are *not* guaranteeing any kind of stability here.
Instead our advice is for you to have your own options file; then
you can re-export the std++ file there but if we ever add an option
you disagree with you can easily overwrite it in one central location. *)
(* Everything here should be [Export Set], which means when this (* Everything here should be [Export Set], which means when this
file is *imported*, the option will only apply on the import site file is *imported*, the option will only apply on the import site
but not transitively. *) but not transitively. *)
Export Set Default Proof Using "Type". (** Allow async proof-checking of sections. *)
#[export] Set Default Proof Using "Type".
(* FIXME: cannot enable this yet as some files disable 'Default Proof Using'. (* FIXME: cannot enable this yet as some files disable 'Default Proof Using'.
Export Set Suggest Proof Using. *) #[export] Set Suggest Proof Using. *)
Export Set Default Goal Selector "!".
(** Enforces that every tactic is executed with a single focused goal, meaning
that bullets and curly braces must be used to structure the proof. *)
#[export] Set Default Goal Selector "!".
(* "Fake" import to whitelist this file for the check that ensures we import (* "Fake" import to whitelist this file for the check that ensures we import
this file everywhere. this file everywhere.
......
theories/orders.v → stdpp/orders.v
View file @ 9274984b
File moved
stdpp/pmap.v 0 → 100644
View file @ 9274984b
(** This files implements an efficient implementation of finite maps whose keys
range over Coq's data type of positive binary naturals [positive]. The
data structure is based on the "canonical" binary tries representation by Appel
and Leroy, https://hal.inria.fr/hal-03372247. It has various good properties:
- It guarantees logarithmic-time [lookup] and [partial_alter], and linear-time
[merge]. It has a low constant factor for computation in Coq compared to other
versions (see the Appel and Leroy paper for benchmarks).
- It satisfies extensional equality, i.e., [(∀ i, m1 !! i = m2 !! i) → m1 = m2].
- It can be used in nested recursive definitions, e.g.,
[Inductive test := Test : Pmap test → test]. This is possible because we do
_not_ use a Sigma type to ensure canonical representations (a Sigma type would
break Coq's strict positivity check). *)
From stdpp Require Export countable fin_maps fin_map_dom.
From stdpp Require Import mapset.
From stdpp Require Import options.
Local Open Scope positive_scope.
(** * The trie data structure *)
(** To obtain canonical representations, we need to make sure that the "empty"
trie is represented uniquely. That is, each node should either have a value, a
non-empty left subtrie, or a non-empty right subtrie. The [Pmap_ne] type
enumerates all ways of constructing non-empty canonical trie. *)
Inductive Pmap_ne (A : Type) :=
| PNode001 : Pmap_ne A → Pmap_ne A
| PNode010 : A → Pmap_ne A
| PNode011 : A → Pmap_ne A → Pmap_ne A
| PNode100 : Pmap_ne A → Pmap_ne A
| PNode101 : Pmap_ne A → Pmap_ne A → Pmap_ne A
| PNode110 : Pmap_ne A → A → Pmap_ne A
| PNode111 : Pmap_ne A → A → Pmap_ne A → Pmap_ne A.
Global Arguments PNode001 {A} _ : assert.
Global Arguments PNode010 {A} _ : assert.
Global Arguments PNode011 {A} _ _ : assert.
Global Arguments PNode100 {A} _ : assert.
Global Arguments PNode101 {A} _ _ : assert.
Global Arguments PNode110 {A} _ _ : assert.
Global Arguments PNode111 {A} _ _ _ : assert.
(** Using [Variant] we suppress the generation of the induction scheme. We use
the induction scheme [Pmap_ind] in terms of the smart constructors to reduce the
number of cases, similar to Appel and Leroy. *)
Variant Pmap (A : Type) := PEmpty : Pmap A | PNodes : Pmap_ne A → Pmap A.
Global Arguments PEmpty {A}.
Global Arguments PNodes {A} _.
Global Instance Pmap_ne_eq_dec `{EqDecision A} : EqDecision (Pmap_ne A).
Proof. solve_decision. Defined.
Global Instance Pmap_eq_dec `{EqDecision A} : EqDecision (Pmap A).
Proof. solve_decision. Defined.
(** The smart constructor [PNode] and eliminator [Pmap_ne_case] are used to
reduce the number of cases, similar to Appel and Leroy. *)
Local Definition PNode {A} (ml : Pmap A) (mx : option A) (mr : Pmap A) : Pmap A :=
match ml, mx, mr with
| PEmpty, None, PEmpty => PEmpty
| PEmpty, None, PNodes r => PNodes (PNode001 r)
| PEmpty, Some x, PEmpty => PNodes (PNode010 x)
| PEmpty, Some x, PNodes r => PNodes (PNode011 x r)
| PNodes l, None, PEmpty => PNodes (PNode100 l)
| PNodes l, None, PNodes r => PNodes (PNode101 l r)
| PNodes l, Some x, PEmpty => PNodes (PNode110 l x)
| PNodes l, Some x, PNodes r => PNodes (PNode111 l x r)
end.
Local Definition Pmap_ne_case {A B} (t : Pmap_ne A)
(f : Pmap A → option A → Pmap A → B) : B :=
match t with
| PNode001 r => f PEmpty None (PNodes r)
| PNode010 x => f PEmpty (Some x) PEmpty
| PNode011 x r => f PEmpty (Some x) (PNodes r)
| PNode100 l => f (PNodes l) None PEmpty
| PNode101 l r => f (PNodes l) None (PNodes r)
| PNode110 l x => f (PNodes l) (Some x) PEmpty
| PNode111 l x r => f (PNodes l) (Some x) (PNodes r)
end.
(** Operations *)
Global Instance Pmap_ne_lookup {A} : Lookup positive A (Pmap_ne A) :=
fix go i t {struct t} :=
let _ : Lookup _ _ _ := @go in
match t, i with
| (PNode010 x | PNode011 x _ | PNode110 _ x | PNode111 _ x _), 1 => Some x
| (PNode100 l | PNode110 l _ | PNode101 l _ | PNode111 l _ _), i~0 => l !! i
| (PNode001 r | PNode011 _ r | PNode101 _ r | PNode111 _ _ r), i~1 => r !! i
| _, _ => None
end.
Global Instance Pmap_lookup {A} : Lookup positive A (Pmap A) := λ i mt,
match mt with PEmpty => None | PNodes t => t !! i end.
Local Arguments lookup _ _ _ _ _ !_ / : simpl nomatch, assert.
Global Instance Pmap_empty {A} : Empty (Pmap A) := PEmpty.
(** Block reduction, even on concrete [Pmap]s.
Marking [Pmap_empty] as [simpl never] would not be enough, because of
https://github.com/coq/coq/issues/2972 and
https://github.com/coq/coq/issues/2986.
And marking [Pmap] consumers as [simpl never] does not work either, see:
https://gitlab.mpi-sws.org/iris/stdpp/-/merge_requests/171#note_53216 *)
Global Opaque Pmap_empty.
Local Fixpoint Pmap_ne_singleton {A} (i : positive) (x : A) : Pmap_ne A :=
match i with
| 1 => PNode010 x
| i~0 => PNode100 (Pmap_ne_singleton i x)
| i~1 => PNode001 (Pmap_ne_singleton i x)
end.
Local Definition Pmap_partial_alter_aux {A} (go : positive → Pmap_ne A → Pmap A)
(f : option A → option A) (i : positive) (mt : Pmap A) : Pmap A :=
match mt with
| PEmpty =>
match f None with
| None => PEmpty | Some x => PNodes (Pmap_ne_singleton i x)
end
| PNodes t => go i t
end.
Local Definition Pmap_ne_partial_alter {A} (f : option A → option A) :
positive → Pmap_ne A → Pmap A :=
fix go i t {struct t} :=
Pmap_ne_case t $ λ ml mx mr,
match i with
| 1 => PNode ml (f mx) mr
| i~0 => PNode (Pmap_partial_alter_aux go f i ml) mx mr
| i~1 => PNode ml mx (Pmap_partial_alter_aux go f i mr)
end.
Global Instance Pmap_partial_alter {A} : PartialAlter positive A (Pmap A) := λ f,
Pmap_partial_alter_aux (Pmap_ne_partial_alter f) f.
Local Definition Pmap_ne_fmap {A B} (f : A → B) : Pmap_ne A → Pmap_ne B :=
fix go t :=
match t with
| PNode001 r => PNode001 (go r)
| PNode010 x => PNode010 (f x)
| PNode011 x r => PNode011 (f x) (go r)
| PNode100 l => PNode100 (go l)
| PNode101 l r => PNode101 (go l) (go r)
| PNode110 l x => PNode110 (go l) (f x)
| PNode111 l x r => PNode111 (go l) (f x) (go r)
end.
Global Instance Pmap_fmap : FMap Pmap := λ {A B} f mt,
match mt with PEmpty => PEmpty | PNodes t => PNodes (Pmap_ne_fmap f t) end.
Local Definition Pmap_omap_aux {A B} (go : Pmap_ne A → Pmap B) (tm : Pmap A) : Pmap B :=
match tm with PEmpty => PEmpty | PNodes t' => go t' end.
Local Definition Pmap_ne_omap {A B} (f : A → option B) : Pmap_ne A → Pmap B :=
fix go t :=
Pmap_ne_case t $ λ ml mx mr,
PNode (Pmap_omap_aux go ml) (mx ≫= f) (Pmap_omap_aux go mr).
Global Instance Pmap_omap : OMap Pmap := λ {A B} f,
Pmap_omap_aux (Pmap_ne_omap f).
Local Definition Pmap_merge_aux {A B C} (go : Pmap_ne A → Pmap_ne B → Pmap C)
(f : option A → option B → option C) (mt1 : Pmap A) (mt2 : Pmap B) : Pmap C :=
match mt1, mt2 with
| PEmpty, PEmpty => PEmpty
| PNodes t1', PEmpty => Pmap_ne_omap (λ x, f (Some x) None) t1'
| PEmpty, PNodes t2' => Pmap_ne_omap (λ x, f None (Some x)) t2'
| PNodes t1', PNodes t2' => go t1' t2'
end.
Local Definition Pmap_ne_merge {A B C} (f : option A → option B → option C) :
Pmap_ne A → Pmap_ne B → Pmap C :=
fix go t1 t2 {struct t1} :=
Pmap_ne_case t1 $ λ ml1 mx1 mr1,
Pmap_ne_case t2 $ λ ml2 mx2 mr2,
PNode (Pmap_merge_aux go f ml1 ml2) (diag_None f mx1 mx2)
(Pmap_merge_aux go f mr1 mr2).
Global Instance Pmap_merge : Merge Pmap := λ {A B C} f,
Pmap_merge_aux (Pmap_ne_merge f) f.
Local Definition Pmap_fold_aux {A B} (go : positive → B → Pmap_ne A → B)
(i : positive) (y : B) (mt : Pmap A) : B :=
match mt with PEmpty => y | PNodes t => go i y t end.
Local Definition Pmap_ne_fold {A B} (f : positive → A → B → B) :
positive → B → Pmap_ne A → B :=
fix go i y t :=
Pmap_ne_case t $ λ ml mx mr,
Pmap_fold_aux go i~1
(Pmap_fold_aux go i~0
match mx with None => y | Some x => f (Pos.reverse i) x y end ml) mr.
Global Instance Pmap_fold {A} : MapFold positive A (Pmap A) := λ {B} f,
Pmap_fold_aux (Pmap_ne_fold f) 1.
(** Proofs *)
Local Definition PNode_valid {A} (ml : Pmap A) (mx : option A) (mr : Pmap A) :=
match ml, mx, mr with PEmpty, None, PEmpty => False | _, _, _ => True end.
Local Lemma Pmap_ind {A} (P : Pmap A → Prop) :
P PEmpty →
(∀ ml mx mr, PNode_valid ml mx mr → P ml → P mr → P (PNode ml mx mr)) →
∀ mt, P mt.
Proof.
intros Hemp Hnode [|t]; [done|]. induction t.
- by apply (Hnode PEmpty None (PNodes _)).
- by apply (Hnode PEmpty (Some _) PEmpty).
- by apply (Hnode PEmpty (Some _) (PNodes _)).
- by apply (Hnode (PNodes _) None PEmpty).
- by apply (Hnode (PNodes _) None (PNodes _)).
- by apply (Hnode (PNodes _) (Some _) PEmpty).
- by apply (Hnode (PNodes _) (Some _) (PNodes _)).
Qed.
Local Lemma Pmap_lookup_PNode {A} (ml mr : Pmap A) mx i :
PNode ml mx mr !! i = match i with 1 => mx | i~0 => ml !! i | i~1 => mr !! i end.
Proof. by destruct ml, mx, mr, i. Qed.
Local Lemma Pmap_ne_lookup_not_None {A} (t : Pmap_ne A) : ∃ i, t !! i ≠ None.
Proof.
induction t; repeat select (∃ _, _) (fun H => destruct H);
try first [by eexists 1|by eexists _~0|by eexists _~1].
Qed.
Local Lemma Pmap_eq_empty {A} (mt : Pmap A) : (∀ i, mt !! i = None) → mt = ∅.
Proof.
intros Hlookup. destruct mt as [|t]; [done|].
destruct (Pmap_ne_lookup_not_None t); naive_solver.
Qed.
Local Lemma Pmap_eq {A} (mt1 mt2 : Pmap A) : (∀ i, mt1 !! i = mt2 !! i) → mt1 = mt2.
Proof.
revert mt2. induction mt1 as [|ml1 mx1 mr1 _ IHl IHr] using Pmap_ind;
intros mt2 Hlookup; destruct mt2 as [|ml2 mx2 mr2 _ _ _] using Pmap_ind.
- done.
- symmetry. apply Pmap_eq_empty. naive_solver.
- apply Pmap_eq_empty. naive_solver.
- f_equal.
+ apply IHl. intros i. generalize (Hlookup (i~0)).
by rewrite !Pmap_lookup_PNode.
+ generalize (Hlookup 1). by rewrite !Pmap_lookup_PNode.
+ apply IHr. intros i. generalize (Hlookup (i~1)).
by rewrite !Pmap_lookup_PNode.
Qed.
Local Lemma Pmap_ne_lookup_singleton {A} i (x : A) :
Pmap_ne_singleton i x !! i = Some x.
Proof. by induction i. Qed.
Local Lemma Pmap_ne_lookup_singleton_ne {A} i j (x : A) :
i ≠ j → Pmap_ne_singleton i x !! j = None.
Proof. revert j. induction i; intros [?|?|]; naive_solver. Qed.
Local Lemma Pmap_partial_alter_PNode {A} (f : option A → option A) i ml mx mr :
PNode_valid ml mx mr →
partial_alter f i (PNode ml mx mr) =
match i with
| 1 => PNode ml (f mx) mr
| i~0 => PNode (partial_alter f i ml) mx mr
| i~1 => PNode ml mx (partial_alter f i mr)
end.
Proof. by destruct ml, mx, mr. Qed.
Local Lemma Pmap_lookup_partial_alter {A} (f : option A → option A)
(mt : Pmap A) i :
partial_alter f i mt !! i = f (mt !! i).
Proof.
revert i. induction mt using Pmap_ind.
{ intros i. unfold partial_alter; simpl. destruct (f None); simpl; [|done].
by rewrite Pmap_ne_lookup_singleton. }
intros []; by rewrite Pmap_partial_alter_PNode, !Pmap_lookup_PNode by done.
Qed.
Local Lemma Pmap_lookup_partial_alter_ne {A} (f : option A → option A)
(mt : Pmap A) i j :
i ≠ j → partial_alter f i mt !! j = mt !! j.
Proof.
revert i j; induction mt using Pmap_ind.
{ intros i j ?; unfold partial_alter; simpl. destruct (f None); simpl; [|done].
by rewrite Pmap_ne_lookup_singleton_ne. }
intros [] [] ?;
rewrite Pmap_partial_alter_PNode, !Pmap_lookup_PNode by done; auto with lia.
Qed.
Local Lemma Pmap_lookup_fmap {A B} (f : A → B) (mt : Pmap A) i :
(f <$> mt) !! i = f <$> mt !! i.
Proof.
destruct mt as [|t]; simpl; [done|].
revert i. induction t; intros []; by simpl.
Qed.
Local Lemma Pmap_omap_PNode {A B} (f : A → option B) ml mx mr :
PNode_valid ml mx mr →
omap f (PNode ml mx mr) = PNode (omap f ml) (mx ≫= f) (omap f mr).
Proof. by destruct ml, mx, mr. Qed.
Local Lemma Pmap_lookup_omap {A B} (f : A → option B) (mt : Pmap A) i :
omap f mt !! i = mt !! i ≫= f.
Proof.
revert i. induction mt using Pmap_ind; [done|].
intros []; by rewrite Pmap_omap_PNode, !Pmap_lookup_PNode by done.
Qed.
Section Pmap_merge.
Context {A B C} (f : option A → option B → option C).
Local Lemma Pmap_merge_PNode_PEmpty ml mx mr :
PNode_valid ml mx mr →
merge f (PNode ml mx mr) ∅ =
PNode (omap (λ x, f (Some x) None) ml) (diag_None f mx None)
(omap (λ x, f (Some x) None) mr).
Proof. by destruct ml, mx, mr. Qed.
Local Lemma Pmap_merge_PEmpty_PNode ml mx mr :
PNode_valid ml mx mr →
merge f ∅ (PNode ml mx mr) =
PNode (omap (λ x, f None (Some x)) ml) (diag_None f None mx)
(omap (λ x, f None (Some x)) mr).
Proof. by destruct ml, mx, mr. Qed.
Local Lemma Pmap_merge_PNode_PNode ml1 ml2 mx1 mx2 mr1 mr2 :
PNode_valid ml1 mx1 mr1 → PNode_valid ml2 mx2 mr2 →
merge f (PNode ml1 mx1 mr1) (PNode ml2 mx2 mr2) =
PNode (merge f ml1 ml2) (diag_None f mx1 mx2) (merge f mr1 mr2).
Proof. by destruct ml1, mx1, mr1, ml2, mx2, mr2. Qed.
Local Lemma Pmap_lookup_merge (mt1 : Pmap A) (mt2 : Pmap B) i :
merge f mt1 mt2 !! i = diag_None f (mt1 !! i) (mt2 !! i).
Proof.
revert mt2 i; induction mt1 using Pmap_ind; intros mt2 i.
{ induction mt2 using Pmap_ind; [done|].
rewrite Pmap_merge_PEmpty_PNode, Pmap_lookup_PNode by done.
destruct i; rewrite ?Pmap_lookup_omap, Pmap_lookup_PNode; simpl;
by repeat destruct (_ !! _). }
destruct mt2 using Pmap_ind.
{ rewrite Pmap_merge_PNode_PEmpty, Pmap_lookup_PNode by done.
destruct i; rewrite ?Pmap_lookup_omap, Pmap_lookup_PNode; simpl;
by repeat destruct (_ !! _). }
rewrite Pmap_merge_PNode_PNode by done.
destruct i; by rewrite ?Pmap_lookup_PNode.
Qed.
End Pmap_merge.
Section Pmap_fold.
Local Notation Pmap_fold f := (Pmap_fold_aux (Pmap_ne_fold f)).
Local Lemma Pmap_fold_PNode {A B} (f : positive → A → B → B) i y ml mx mr :
Pmap_fold f i y (PNode ml mx mr) = Pmap_fold f i~1
(Pmap_fold f i~0
match mx with None => y | Some x => f (Pos.reverse i) x y end ml) mr.
Proof. by destruct ml, mx, mr. Qed.
Local Lemma Pmap_fold_ind {A} (P : Pmap A → Prop) :
P PEmpty →
(∀ i x mt,
mt !! i = None →
(∀ j A' B (f : positive → A' → B → B) (g : A → A') b x',
Pmap_fold f j b (<[i:=x']> (g <$> mt))
= f (Pos.reverse_go i j) x' (Pmap_fold f j b (g <$> mt))) →
P mt → P (<[i:=x]> mt)) →
∀ mt, P mt.
Proof.
intros Hemp Hinsert mt. revert P Hemp Hinsert.
induction mt as [|ml mx mr ? IHl IHr] using Pmap_ind;
intros P Hemp Hinsert; [done|].
apply (IHr (λ mt, P (PNode ml mx mt))).
{ apply (IHl (λ mt, P (PNode mt mx PEmpty))).
{ destruct mx as [x|]; [|done].
replace (PNode PEmpty (Some x) PEmpty)
with (<[1:=x]> PEmpty : Pmap A) by done.
by apply Hinsert. }
intros i x mt ? Hfold ?.
replace (PNode (<[i:=x]> mt) mx PEmpty)
with (<[i~0:=x]> (PNode mt mx PEmpty)) by (by destruct mt, mx).
apply Hinsert.
- by rewrite Pmap_lookup_PNode.
- intros j A' B f g b x'.
replace (<[i~0:=x']> (g <$> PNode mt mx PEmpty))
with (PNode (<[i:=x']> (g <$> mt)) (g <$> mx) PEmpty)
by (by destruct mt, mx).
replace (g <$> PNode mt mx PEmpty)
with (PNode (g <$> mt) (g <$> mx) PEmpty) by (by destruct mt, mx).
rewrite !Pmap_fold_PNode; simpl; auto.
- done. }
intros i x mt r ? Hfold.
replace (PNode ml mx (<[i:=x]> mt))
with (<[i~1:=x]> (PNode ml mx mt)) by (by destruct ml, mx, mt).
apply Hinsert.
- by rewrite Pmap_lookup_PNode.
- intros j A' B f g b x'.
replace (<[i~1:=x']> (g <$> PNode ml mx mt))
with (PNode (g <$> ml) (g <$> mx) (<[i:=x']> (g <$> mt)))
by (by destruct ml, mx, mt).
replace (g <$> PNode ml mx mt)
with (PNode (g <$> ml) (g <$> mx) (g <$> mt)) by (by destruct ml, mx, mt).
rewrite !Pmap_fold_PNode; simpl; auto.
- done.
Qed.
End Pmap_fold.
(** Instance of the finite map type class *)
Global Instance Pmap_finmap : FinMap positive Pmap.
Proof.
split.
- intros. by apply Pmap_eq.
- done.
- intros. apply Pmap_lookup_partial_alter.
- intros. by apply Pmap_lookup_partial_alter_ne.
- intros. apply Pmap_lookup_fmap.
- intros. apply Pmap_lookup_omap.
- intros. apply Pmap_lookup_merge.
- done.
- intros A P Hemp Hinsert. apply Pmap_fold_ind; [done|].
intros i x mt ? Hfold. apply Hinsert; [done|]. apply (Hfold 1).
Qed.
(** Type annotation [list (positive * A)] seems needed in Coq 8.14, not in more
recent versions. *)
Global Program Instance Pmap_countable `{Countable A} : Countable (Pmap A) := {
encode m := encode (map_to_list m : list (positive * A));
decode p := list_to_map <$> decode p
}.
Next Obligation.
intros A ?? m; simpl. rewrite decode_encode; simpl. by rewrite list_to_map_to_list.
Qed.
(** * Finite sets *)
(** We construct sets of [positives]s satisfying extensional equality. *)
Notation Pset := (mapset Pmap).
Global Instance Pmap_dom {A} : Dom (Pmap A) Pset := mapset_dom.
Global Instance Pmap_dom_spec : FinMapDom positive Pmap Pset := mapset_dom_spec.
theories/prelude.v → stdpp/prelude.v
View file @ 9274984b
File moved
theories/pretty.v → stdpp/pretty.v
View file @ 9274984b
...@@ -113,7 +113,7 @@ Proof. apply _. Qed. ...@@ -113,7 +113,7 @@ Proof. apply _. Qed.
Global Instance pretty_Z : Pretty Z := λ x, Global Instance pretty_Z : Pretty Z := λ x,
match x with match x with
| Z0 => "0" | Zpos x => pretty x | Zneg x => "-" +:+ pretty x | Z0 => "0" | Zpos x => pretty x | Zneg x => "-" +:+ pretty x
end%string. end.
Global Instance pretty_Z_inj : Inj (=@{Z}) (=) pretty. Global Instance pretty_Z_inj : Inj (=@{Z}) (=) pretty.
Proof. Proof.
unfold pretty, pretty_Z. unfold pretty, pretty_Z.
......
theories/proof_irrel.v → stdpp/proof_irrel.v
View file @ 9274984b
File moved
theories/propset.v → stdpp/propset.v
View file @ 9274984b
...@@ -6,8 +6,14 @@ Record propset (A : Type) : Type := PropSet { propset_car : A → Prop }. ...@@ -6,8 +6,14 @@ Record propset (A : Type) : Type := PropSet { propset_car : A → Prop }.
Add Printing Constructor propset. Add Printing Constructor propset.
Global Arguments PropSet {_} _ : assert. Global Arguments PropSet {_} _ : assert.
Global Arguments propset_car {_} _ _ : assert. Global Arguments propset_car {_} _ _ : assert.
(** Here we are using the notation "as pattern" because we want to
be compatible with all the rules that start with [ {[ TERM ] such as
records, singletons, and map singletons. See
https://coq.inria.fr/refman/user-extensions/syntax-extensions.html#binders-bound-in-the-notation-and-parsed-as-terms
and https://gitlab.mpi-sws.org/iris/stdpp/-/merge_requests/533#note_98003.
We don't set a level to be consistent with the notation for singleton sets. *)
Notation "{[ x | P ]}" := (PropSet (λ x, P)) Notation "{[ x | P ]}" := (PropSet (λ x, P))
(at level 1, format "{[ x | P ]}") : stdpp_scope. (at level 1, x as pattern, format "{[ x | P ]}") : stdpp_scope.
Global Instance propset_elem_of {A} : ElemOf A (propset A) := λ x X, propset_car X x. Global Instance propset_elem_of {A} : ElemOf A (propset A) := λ x X, propset_car X x.
......
theories/relations.v → stdpp/relations.v
View file @ 9274984b
...@@ -110,7 +110,7 @@ Section general. ...@@ -110,7 +110,7 @@ Section general.
Lemma rtc_r x y z : rtc R x y → R y z → rtc R x z. Lemma rtc_r x y z : rtc R x y → R y z → rtc R x z.
Proof. intros. etrans; eauto. Qed. Proof. intros. etrans; eauto. Qed.
Lemma rtc_inv x z : rtc R x z → x = z ∨ ∃ y, R x y ∧ rtc R y z. 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. Proof. inv 1; eauto. Qed.
Lemma rtc_ind_l (P : A → Prop) (z : A) 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) : (Prefl : P z) (Pstep : ∀ x y, R x y → rtc R y z → P y → P x) :
∀ x, rtc R x z → P x. ∀ x, rtc R x z → P x.
...@@ -143,25 +143,25 @@ Section general. ...@@ -143,25 +143,25 @@ Section general.
Lemma nsteps_once x y : R x y → nsteps R 1 x y. Lemma nsteps_once x y : R x y → nsteps R 1 x y.
Proof. eauto. Qed. Proof. eauto. Qed.
Lemma nsteps_once_inv x y : nsteps R 1 x y → R x y. Lemma nsteps_once_inv x y : nsteps R 1 x y → R x y.
Proof. inversion 1 as [|???? Hhead Htail]; inversion Htail; by subst. Qed. Proof. inv 1 as [|???? Hhead Htail]; by inv Htail. Qed.
Lemma nsteps_trans n m x y z : Lemma nsteps_trans n m x y z :
nsteps R n x y → nsteps R m y z → nsteps R (n + m) x z. nsteps R n x y → nsteps R m y z → nsteps R (n + m) x z.
Proof. induction 1; simpl; eauto. Qed. 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. 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. Proof. induction 1; eauto. Qed.
Lemma nsteps_plus_inv n m x z : Lemma nsteps_add_inv n m x z :
nsteps R (n + m) x z → ∃ y, nsteps R n x y ∧ nsteps R m y z. nsteps R (n + m) x z → ∃ y, nsteps R n x y ∧ nsteps R m y z.
Proof. Proof.
revert x. revert x.
induction n as [|n IH]; intros x Hx; simpl; [by eauto|]. induction n as [|n IH]; intros x Hx; simpl; [by eauto|].
inversion Hx; naive_solver. inv Hx; naive_solver.
Qed. Qed.
Lemma nsteps_inv_r n x z : nsteps R (S n) x z → ∃ y, nsteps R n x y ∧ R y z. Lemma nsteps_inv_r n x z : nsteps R (S n) x z → ∃ y, nsteps R n x y ∧ R y z.
Proof. Proof.
rewrite <- PeanoNat.Nat.add_1_r. rewrite <- PeanoNat.Nat.add_1_r.
intros (?&?&?%nsteps_once_inv)%nsteps_plus_inv; eauto. intros (?&?&?%nsteps_once_inv)%nsteps_add_inv; eauto.
Qed. Qed.
Lemma nsteps_congruence {B} (f : A → B) (R' : relation B) n x y : Lemma nsteps_congruence {B} (f : A → B) (R' : relation B) n x y :
...@@ -171,22 +171,22 @@ Section general. ...@@ -171,22 +171,22 @@ Section general.
(** ** Results about [bsteps] *) (** ** Results about [bsteps] *)
Lemma bsteps_once n x y : R x y → bsteps R (S n) x y. Lemma bsteps_once n x y : R x y → bsteps R (S n) x y.
Proof. eauto. Qed. Proof. eauto. Qed.
Lemma bsteps_plus_r n m x y : Lemma bsteps_add_r n m x y :
bsteps R n x y → bsteps R (n + m) x y. bsteps R n x y → bsteps R (n + m) x y.
Proof. induction 1; simpl; eauto. Qed. Proof. induction 1; simpl; eauto. Qed.
Lemma bsteps_weaken n m x y : Lemma bsteps_weaken n m x y :
n ≤ m → bsteps R n x y → bsteps R m x y. n ≤ m → bsteps R n x y → bsteps R m x y.
Proof. Proof.
intros. rewrite (Minus.le_plus_minus n m); auto using bsteps_plus_r. intros. rewrite (Nat.le_add_sub n m); auto using bsteps_add_r.
Qed. Qed.
Lemma bsteps_plus_l n m x y : Lemma bsteps_add_l n m x y :
bsteps R n x y → bsteps R (m + n) x y. bsteps R n x y → bsteps R (m + n) x y.
Proof. apply bsteps_weaken. auto with arith. Qed. 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. Lemma bsteps_S n x y : bsteps R n x y → bsteps R (S n) x y.
Proof. apply bsteps_weaken. lia. Qed. Proof. apply bsteps_weaken. lia. Qed.
Lemma bsteps_trans n m x y z : Lemma bsteps_trans n m x y z :
bsteps R n x y → bsteps R m y z → bsteps R (n + m) x 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. Proof. induction 1; simpl; eauto using bsteps_add_l. Qed.
Lemma bsteps_r n x y z : bsteps R n x y → R y z → bsteps R (S n) x z. 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. Proof. induction 1; eauto. Qed.
Lemma bsteps_ind_r (P : nat → A → Prop) (x : A) Lemma bsteps_ind_r (P : nat → A → Prop) (x : A)
...@@ -354,7 +354,7 @@ Section general. ...@@ -354,7 +354,7 @@ Section general.
Lemma ex_loop_inv x : Lemma ex_loop_inv x :
ex_loop R x → ex_loop R x →
∃ x', R x x' ∧ ex_loop R x'. ∃ x', R x x' ∧ ex_loop R x'.
Proof. inversion 1; eauto. Qed. Proof. inv 1; eauto. Qed.
End general. End general.
...@@ -424,8 +424,8 @@ Section properties. ...@@ -424,8 +424,8 @@ Section properties.
constructor; simpl; intros x' Hxx'. constructor; simpl; intros x' Hxx'.
assert (x' ∈ xs) as (xs1&xs2&->)%elem_of_list_split by eauto using tc_once. assert (x' ∈ xs) as (xs1&xs2&->)%elem_of_list_split by eauto using tc_once.
refine (IH (length xs1 + length xs2) _ _ (xs1 ++ xs2) _ _); refine (IH (length xs1 + length xs2) _ _ (xs1 ++ xs2) _ _);
[rewrite app_length; simpl; lia..|]. [rewrite length_app; simpl; lia..|].
intros x'' Hx'x''. feed pose proof (Hfin x'') as Hx''; [by econstructor|]. intros x'' Hx'x''. opose proof* (Hfin x'') as Hx''; [by econstructor|].
cut (x' ≠ x''); [set_solver|]. cut (x' ≠ x''); [set_solver|].
intros ->. by apply (Hirr x''). intros ->. by apply (Hirr x'').
Qed. Qed.
......
theories/sets.v → stdpp/sets.v
View file @ 9274984b
...@@ -17,7 +17,7 @@ Global Instance set_subseteq_instance `{ElemOf A C} : SubsetEq C | 20 := λ X Y, ...@@ -17,7 +17,7 @@ Global Instance set_subseteq_instance `{ElemOf A C} : SubsetEq C | 20 := λ X Y,
∀ x, x ∈ X → x ∈ Y. ∀ x, x ∈ X → x ∈ Y.
Global Instance set_disjoint_instance `{ElemOf A C} : Disjoint C | 20 := λ X Y, Global Instance set_disjoint_instance `{ElemOf A C} : Disjoint C | 20 := λ X Y,
∀ x, x ∈ X → x ∈ Y → False. ∀ x, x ∈ X → x ∈ Y → False.
Typeclasses Opaque set_equiv_instance set_subseteq_instance set_disjoint_instance. Global Typeclasses Opaque set_equiv_instance set_subseteq_instance set_disjoint_instance.
(** * Setoids *) (** * Setoids *)
Section setoids_simple. Section setoids_simple.
...@@ -46,6 +46,8 @@ Section setoids_simple. ...@@ -46,6 +46,8 @@ Section setoids_simple.
Proof. Proof.
intros X1 X2 HX Y1 Y2 HY. apply forall_proper; intros x. by rewrite HX, HY. intros X1 X2 HX Y1 Y2 HY. apply forall_proper; intros x. by rewrite HX, HY.
Qed. Qed.
Global Instance subset_proper : Proper ((≡@{C}) ==> (≡@{C}) ==> iff) (⊂).
Proof. solve_proper. Qed.
End setoids_simple. End setoids_simple.
Section setoids. Section setoids.
...@@ -93,7 +95,7 @@ involving just [∈]. For example, [A → x ∈ X ∪ ∅] becomes [A → x ∈ ...@@ -93,7 +95,7 @@ involving just [∈]. For example, [A → x ∈ X ∪ ∅] becomes [A → x ∈
This transformation is implemented using type classes instead of setoid 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 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. *) deal with occurrences of the set operations under binders. *)
Class SetUnfold (P Q : Prop) := { set_unfold : P ↔ Q }. Class SetUnfold (P Q : Prop) := { set_unfold : P ↔ Q }.
Global Arguments set_unfold _ _ {_} : assert. Global Arguments set_unfold _ _ {_} : assert.
Global Hint Mode SetUnfold + - : typeclass_instances. Global Hint Mode SetUnfold + - : typeclass_instances.
...@@ -285,6 +287,15 @@ Section set_unfold_list. ...@@ -285,6 +287,15 @@ Section set_unfold_list.
intros ??; constructor. intros ??; constructor.
by rewrite elem_of_app, (set_unfold_elem_of x l P), (set_unfold_elem_of x k Q). by rewrite elem_of_app, (set_unfold_elem_of x l P), (set_unfold_elem_of x k Q).
Qed. Qed.
Global Instance set_unfold_list_cprod {B} (x : A * B) l (k : list B) P Q :
SetUnfoldElemOf x.1 l P → SetUnfoldElemOf x.2 k Q →
SetUnfoldElemOf x (cprod l k) (P ∧ Q).
Proof.
intros ??; constructor.
by rewrite elem_of_list_cprod, (set_unfold_elem_of x.1 l P),
(set_unfold_elem_of x.2 k Q).
Qed.
Global Instance set_unfold_included l k (P Q : A → Prop) : Global Instance set_unfold_included l k (P Q : A → Prop) :
(∀ x, SetUnfoldElemOf x l (P x)) → (∀ x, SetUnfoldElemOf x k (Q x)) → (∀ x, SetUnfoldElemOf x l (P x)) → (∀ x, SetUnfoldElemOf x k (Q x)) →
SetUnfold (l ⊆ k) (∀ x, P x → Q x). SetUnfold (l ⊆ k) (∀ x, P x → Q x).
...@@ -308,6 +319,10 @@ Section set_unfold_list. ...@@ -308,6 +319,10 @@ Section set_unfold_list.
SetUnfoldElemOf x l P → SetUnfoldElemOf x (rotate n l) P. SetUnfoldElemOf x l P → SetUnfoldElemOf x (rotate n l) P.
Proof. constructor. by rewrite elem_of_rotate, (set_unfold_elem_of x l P). Qed. Proof. constructor. by rewrite elem_of_rotate, (set_unfold_elem_of x l P). Qed.
Global Instance set_unfold_list_bind {B} (f : A → list B) l P Q y :
(∀ x, SetUnfoldElemOf x l (P x)) → (∀ x, SetUnfoldElemOf y (f x) (Q x)) →
SetUnfoldElemOf y (l ≫= f) (∃ x, Q x ∧ P x).
Proof. constructor. rewrite elem_of_list_bind. naive_solver. Qed.
End set_unfold_list. End set_unfold_list.
Tactic Notation "set_unfold" := Tactic Notation "set_unfold" :=
...@@ -343,7 +358,7 @@ Tactic Notation "set_solver" "-" hyp_list(Hs) "by" tactic3(tac) := ...@@ -343,7 +358,7 @@ Tactic Notation "set_solver" "-" hyp_list(Hs) "by" tactic3(tac) :=
clear Hs; set_solver by tac. clear Hs; set_solver by tac.
Tactic Notation "set_solver" "+" hyp_list(Hs) "by" tactic3(tac) := Tactic Notation "set_solver" "+" hyp_list(Hs) "by" tactic3(tac) :=
clear -Hs; set_solver by tac. clear -Hs; set_solver by tac.
Tactic Notation "set_solver" := set_solver by idtac. Tactic Notation "set_solver" := set_solver by eauto.
Tactic Notation "set_solver" "-" hyp_list(Hs) := clear Hs; set_solver. Tactic Notation "set_solver" "-" hyp_list(Hs) := clear Hs; set_solver.
Tactic Notation "set_solver" "+" hyp_list(Hs) := clear -Hs; set_solver. Tactic Notation "set_solver" "+" hyp_list(Hs) := clear -Hs; set_solver.
...@@ -444,7 +459,7 @@ Section semi_set. ...@@ -444,7 +459,7 @@ Section semi_set.
Proof. set_solver. Qed. Proof. set_solver. Qed.
Lemma elem_of_equiv_empty X : X ≡ ∅ ↔ ∀ x, x ∉ X. Lemma elem_of_equiv_empty X : X ≡ ∅ ↔ ∀ x, x ∉ X.
Proof. set_solver. Qed. Proof. set_solver. Qed.
Lemma elem_of_empty x : x ∈ (∅ : C) ↔ False. Lemma elem_of_empty x : x ∈@{C} ∅ ↔ False.
Proof. set_solver. Qed. Proof. set_solver. Qed.
Lemma equiv_empty X : X ⊆ ∅ → X ≡ ∅. Lemma equiv_empty X : X ⊆ ∅ → X ≡ ∅.
Proof. set_solver. Qed. Proof. set_solver. Qed.
...@@ -456,19 +471,19 @@ Section semi_set. ...@@ -456,19 +471,19 @@ Section semi_set.
Proof. set_solver. Qed. Proof. set_solver. Qed.
(** Singleton *) (** Singleton *)
Lemma elem_of_singleton_1 x y : x ∈ ({[y]} : C) → x = y. Lemma elem_of_singleton_1 x y : x ∈@{C} {[y]} → x = y.
Proof. by rewrite elem_of_singleton. Qed. Proof. by rewrite elem_of_singleton. Qed.
Lemma elem_of_singleton_2 x y : x = y → x ∈ ({[y]} : C). Lemma elem_of_singleton_2 x y : x = y → x ∈@{C} {[y]}.
Proof. by rewrite elem_of_singleton. Qed. Proof. by rewrite elem_of_singleton. Qed.
Lemma elem_of_subseteq_singleton x X : x ∈ X ↔ {[ x ]} ⊆ X. Lemma elem_of_subseteq_singleton x X : x ∈ X ↔ {[ x ]} ⊆ X.
Proof. set_solver. Qed. Proof. set_solver. Qed.
Lemma non_empty_singleton x : ({[ x ]} : C) ≢ ∅. Lemma non_empty_singleton x : {[ x ]} ≢@{C} ∅.
Proof. set_solver. Qed. Proof. set_solver. Qed.
Lemma not_elem_of_singleton x y : x ∉ ({[ y ]} : C) ↔ x ≠ y. Lemma not_elem_of_singleton x y : x ∉@{C} {[ y ]} ↔ x ≠ y.
Proof. by rewrite elem_of_singleton. Qed. Proof. by rewrite elem_of_singleton. Qed.
Lemma not_elem_of_singleton_1 x y : x ∉ ({[ y ]} : C) → x ≠ y. Lemma not_elem_of_singleton_1 x y : x ∉@{C} {[ y ]} → x ≠ y.
Proof. apply not_elem_of_singleton. Qed. Proof. apply not_elem_of_singleton. Qed.
Lemma not_elem_of_singleton_2 x y : x ≠ y → x ∉ ({[ y ]} : C). Lemma not_elem_of_singleton_2 x y : x ≠ y → x ∉@{C} {[ y ]}.
Proof. apply not_elem_of_singleton. Qed. Proof. apply not_elem_of_singleton. Qed.
Lemma singleton_subseteq_l x X : {[ x ]} ⊆ X ↔ x ∈ X. Lemma singleton_subseteq_l x X : {[ x ]} ⊆ X ↔ x ∈ X.
...@@ -524,6 +539,7 @@ Section semi_set. ...@@ -524,6 +539,7 @@ Section semi_set.
Qed. Qed.
Lemma union_list_mono Xs Ys : Xs ⊆* Ys → ⋃ Xs ⊆ ⋃ Ys. Lemma union_list_mono Xs Ys : Xs ⊆* Ys → ⋃ Xs ⊆ ⋃ Ys.
Proof. induction 1; simpl; auto using union_mono. Qed. Proof. induction 1; simpl; auto using union_mono. Qed.
Lemma empty_union_list Xs : ⋃ Xs ≡ ∅ ↔ Forall (.≡ ∅) Xs. Lemma empty_union_list Xs : ⋃ Xs ≡ ∅ ↔ Forall (.≡ ∅) Xs.
Proof. Proof.
split. split.
...@@ -583,7 +599,7 @@ Section semi_set. ...@@ -583,7 +599,7 @@ Section semi_set.
Proof. unfold_leibniz. apply non_empty_inhabited. Qed. Proof. unfold_leibniz. apply non_empty_inhabited. Qed.
(** Singleton *) (** Singleton *)
Lemma non_empty_singleton_L x : {[ x ]} ≠ (∅ : C). Lemma non_empty_singleton_L x : {[ x ]} ≠@{C} ∅.
Proof. unfold_leibniz. apply non_empty_singleton. Qed. Proof. unfold_leibniz. apply non_empty_singleton. Qed.
(** Big unions *) (** Big unions *)
...@@ -593,8 +609,9 @@ Section semi_set. ...@@ -593,8 +609,9 @@ Section semi_set.
Proof. unfold_leibniz. apply union_list_app. Qed. Proof. unfold_leibniz. apply union_list_app. Qed.
Lemma union_list_reverse_L Xs : ⋃ (reverse Xs) = ⋃ Xs. Lemma union_list_reverse_L Xs : ⋃ (reverse Xs) = ⋃ Xs.
Proof. unfold_leibniz. apply union_list_reverse. Qed. Proof. unfold_leibniz. apply union_list_reverse. Qed.
Lemma empty_union_list_L Xs : ⋃ Xs = ∅ ↔ Forall (.= ∅) Xs. Lemma empty_union_list_L Xs : ⋃ Xs = ∅ ↔ Forall (.= ∅) Xs.
Proof. unfold_leibniz. by rewrite empty_union_list. Qed. Proof. unfold_leibniz. apply empty_union_list. Qed.
End leibniz. End leibniz.
Lemma not_elem_of_iff `{!RelDecision (∈@{C})} X Y x : Lemma not_elem_of_iff `{!RelDecision (∈@{C})} X Y x :
...@@ -603,26 +620,31 @@ Section semi_set. ...@@ -603,26 +620,31 @@ Section semi_set.
Section dec. Section dec.
Context `{!RelDecision (≡@{C})}. Context `{!RelDecision (≡@{C})}.
Lemma set_subseteq_inv X Y : X ⊆ Y → X ⊂ Y ∨ X ≡ Y. Lemma set_subseteq_inv X Y : X ⊆ Y → X ⊂ Y ∨ X ≡ Y.
Proof. destruct (decide (X ≡ Y)); [by right|left;set_solver]. Qed. Proof. destruct (decide (X ≡ Y)); [by right|left;set_solver]. Qed.
Lemma set_not_subset_inv X Y : X ⊄ Y → X ⊈ Y ∨ X ≡ Y. Lemma set_not_subset_inv X Y : X ⊄ Y → X ⊈ Y ∨ X ≡ Y.
Proof. destruct (decide (X ≡ Y)); [by right|left;set_solver]. Qed. Proof. destruct (decide (X ≡ Y)); [by right|left;set_solver]. Qed.
Lemma non_empty_union X Y : X ∪ Y ≢ ∅ ↔ X ≢ ∅ ∨ Y ≢ ∅. Lemma non_empty_union X Y : X ∪ Y ≢ ∅ ↔ X ≢ ∅ ∨ Y ≢ ∅.
Proof. rewrite empty_union. destruct (decide (X ≡ ∅)); intuition. Qed. Proof. destruct (decide (X ≡ ∅)); set_solver. Qed.
Lemma non_empty_union_list Xs : ⋃ Xs ≢ ∅ → Exists (.≢ ∅) Xs. Lemma non_empty_union_list Xs : ⋃ Xs ≢ ∅ → Exists (.≢ ∅) Xs.
Proof. rewrite empty_union_list. apply (not_Forall_Exists _). Qed. Proof. rewrite empty_union_list. apply (not_Forall_Exists _). Qed.
End dec.
Section dec_leibniz.
Context `{!RelDecision (≡@{C}), !LeibnizEquiv C}.
Context `{!LeibnizEquiv C}.
Lemma set_subseteq_inv_L X Y : X ⊆ Y → X ⊂ Y ∨ X = Y. Lemma set_subseteq_inv_L X Y : X ⊆ Y → X ⊂ Y ∨ X = Y.
Proof. unfold_leibniz. apply set_subseteq_inv. Qed. Proof. unfold_leibniz. apply set_subseteq_inv. Qed.
Lemma set_not_subset_inv_L X Y : X ⊄ Y → X ⊈ Y ∨ X = Y. Lemma set_not_subset_inv_L X Y : X ⊄ Y → X ⊈ Y ∨ X = Y.
Proof. unfold_leibniz. apply set_not_subset_inv. Qed. Proof. unfold_leibniz. apply set_not_subset_inv. Qed.
Lemma non_empty_union_L X Y : X ∪ Y ≠ ∅ ↔ X ≠ ∅ ∨ Y ≠ ∅. Lemma non_empty_union_L X Y : X ∪ Y ≠ ∅ ↔ X ≠ ∅ ∨ Y ≠ ∅.
Proof. unfold_leibniz. apply non_empty_union. Qed. Proof. unfold_leibniz. apply non_empty_union. Qed.
Lemma non_empty_union_list_L Xs : ⋃ Xs ≠ ∅ → Exists (.≠ ∅) Xs. Lemma non_empty_union_list_L Xs : ⋃ Xs ≠ ∅ → Exists (.≠ ∅) Xs.
Proof. unfold_leibniz. apply non_empty_union_list. Qed. Proof. unfold_leibniz. apply non_empty_union_list. Qed.
End dec. End dec_leibniz.
End semi_set. End semi_set.
...@@ -666,7 +688,7 @@ Section set. ...@@ -666,7 +688,7 @@ Section set.
Global Instance intersection_empty_r: RightAbsorb (≡@{C}) ∅ (∩). Global Instance intersection_empty_r: RightAbsorb (≡@{C}) ∅ (∩).
Proof. intros X; set_solver. Qed. Proof. intros X; set_solver. Qed.
Lemma intersection_singletons x : ({[x]} : C) ∩ {[x]} ≡ {[x]}. Lemma intersection_singletons x : {[x]} ∩ {[x]} ≡@{C} {[x]}.
Proof. set_solver. Qed. Proof. set_solver. Qed.
Lemma union_intersection_l X Y Z : X ∪ (Y ∩ Z) ≡ (X ∪ Y) ∩ (X ∪ Z). Lemma union_intersection_l X Y Z : X ∪ (Y ∩ Z) ≡ (X ∪ Y) ∩ (X ∪ Z).
...@@ -697,7 +719,7 @@ Section set. ...@@ -697,7 +719,7 @@ Section set.
Proof. set_solver. Qed. Proof. set_solver. Qed.
Lemma subset_difference_elem_of x X : x ∈ X → X ∖ {[ x ]} ⊂ X. Lemma subset_difference_elem_of x X : x ∈ X → X ∖ {[ x ]} ⊂ X.
Proof. set_solver. Qed. Proof. set_solver. Qed.
Lemma difference_difference X Y Z : (X ∖ Y) ∖ Z ≡ X ∖ (Y ∪ Z). Lemma difference_difference_l X Y Z : (X ∖ Y) ∖ Z ≡ X ∖ (Y ∪ Z).
Proof. set_solver. Qed. Proof. set_solver. Qed.
Lemma difference_mono X1 X2 Y1 Y2 : Lemma difference_mono X1 X2 Y1 Y2 :
...@@ -748,7 +770,7 @@ Section set. ...@@ -748,7 +770,7 @@ Section set.
Global Instance intersection_empty_r_L: RightAbsorb (=@{C}) ∅ (∩). Global Instance intersection_empty_r_L: RightAbsorb (=@{C}) ∅ (∩).
Proof. intros ?. unfold_leibniz. apply (right_absorb _ _). Qed. Proof. intros ?. unfold_leibniz. apply (right_absorb _ _). Qed.
Lemma intersection_singletons_L x : {[x]} ∩ {[x]} = ({[x]} : C). Lemma intersection_singletons_L x : {[x]} ∩ {[x]} =@{C} {[x]}.
Proof. unfold_leibniz. apply intersection_singletons. Qed. Proof. unfold_leibniz. apply intersection_singletons. Qed.
Lemma union_intersection_l_L X Y Z : X ∪ (Y ∩ Z) = (X ∪ Y) ∩ (X ∪ Z). Lemma union_intersection_l_L X Y Z : X ∪ (Y ∩ Z) = (X ∪ Y) ∩ (X ∪ Z).
...@@ -778,8 +800,8 @@ Section set. ...@@ -778,8 +800,8 @@ Section set.
Proof. unfold_leibniz. apply difference_intersection_distr_l. Qed. Proof. unfold_leibniz. apply difference_intersection_distr_l. Qed.
Lemma difference_disjoint_L X Y : X ## Y → X ∖ Y = X. Lemma difference_disjoint_L X Y : X ## Y → X ∖ Y = X.
Proof. unfold_leibniz. apply difference_disjoint. Qed. Proof. unfold_leibniz. apply difference_disjoint. Qed.
Lemma difference_difference_L X Y Z : (X ∖ Y) ∖ Z = X ∖ (Y ∪ Z). Lemma difference_difference_l_L X Y Z : (X ∖ Y) ∖ Z = X ∖ (Y ∪ Z).
Proof. unfold_leibniz. apply difference_difference. Qed. Proof. unfold_leibniz. apply difference_difference_l. Qed.
(** Disjointness *) (** Disjointness *)
Lemma disjoint_intersection_L X Y : X ## Y ↔ X ∩ Y = ∅. Lemma disjoint_intersection_L X Y : X ## Y ↔ X ∩ Y = ∅.
...@@ -788,6 +810,7 @@ Section set. ...@@ -788,6 +810,7 @@ Section set.
Section dec. Section dec.
Context `{!RelDecision (∈@{C})}. Context `{!RelDecision (∈@{C})}.
Lemma not_elem_of_intersection x X Y : x ∉ X ∩ Y ↔ x ∉ X ∨ x ∉ Y. 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. 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. Lemma not_elem_of_difference x X Y : x ∉ X ∖ Y ↔ x ∉ X ∨ x ∈ Y.
...@@ -804,6 +827,11 @@ Section set. ...@@ -804,6 +827,11 @@ Section set.
intros x. rewrite !elem_of_union; rewrite elem_of_difference. intros x. rewrite !elem_of_union; rewrite elem_of_difference.
split; [ | destruct (decide (x ∈ Y)) ]; intuition. split; [ | destruct (decide (x ∈ Y)) ]; intuition.
Qed. Qed.
Lemma difference_difference_r X Y Z : X ∖ (Y ∖ Z) ≡ (X ∖ Y) ∪ (X ∩ Z).
Proof. intros x. destruct (decide (x ∈ Z)); set_solver. Qed.
Lemma difference_union_intersection X Y : (X ∖ Y) ∪ (X ∩ Y) ≡ X.
Proof. rewrite union_intersection_l, difference_union. set_solver. Qed.
Lemma subseteq_disjoint_union X Y : X ⊆ Y ↔ ∃ Z, Y ≡ X ∪ Z ∧ X ## Z. Lemma subseteq_disjoint_union X Y : X ⊆ Y ↔ ∃ Z, Y ≡ X ∪ Z ∧ X ## Z.
Proof. Proof.
split; [|set_solver]. split; [|set_solver].
...@@ -816,8 +844,11 @@ Section set. ...@@ -816,8 +844,11 @@ Section set.
Lemma singleton_union_difference X Y x : Lemma singleton_union_difference X Y x :
{[x]} ∪ (X ∖ Y) ≡ ({[x]} ∪ X) ∖ (Y ∖ {[x]}). {[x]} ∪ (X ∖ Y) ≡ ({[x]} ∪ X) ∖ (Y ∖ {[x]}).
Proof. intro y; destruct (decide (y ∈@{C} {[x]})); set_solver. Qed. Proof. intro y; destruct (decide (y ∈@{C} {[x]})); set_solver. Qed.
End dec.
Section dec_leibniz.
Context `{!RelDecision (∈@{C}), !LeibnizEquiv C}.
Context `{!LeibnizEquiv C}.
Lemma union_difference_L X Y : X ⊆ Y → Y = X ∪ Y ∖ X. Lemma union_difference_L X Y : X ⊆ Y → Y = X ∪ Y ∖ X.
Proof. unfold_leibniz. apply union_difference. Qed. Proof. unfold_leibniz. apply union_difference. Qed.
Lemma union_difference_singleton_L x Y : x ∈ Y → Y = {[x]} ∪ Y ∖ {[x]}. Lemma union_difference_singleton_L x Y : x ∈ Y → Y = {[x]} ∪ Y ∖ {[x]}.
...@@ -833,7 +864,12 @@ Section set. ...@@ -833,7 +864,12 @@ Section set.
Lemma singleton_union_difference_L X Y x : Lemma singleton_union_difference_L X Y x :
{[x]} ∪ (X ∖ Y) = ({[x]} ∪ X) ∖ (Y ∖ {[x]}). {[x]} ∪ (X ∖ Y) = ({[x]} ∪ X) ∖ (Y ∖ {[x]}).
Proof. unfold_leibniz. apply singleton_union_difference. Qed. Proof. unfold_leibniz. apply singleton_union_difference. Qed.
End dec. Lemma difference_difference_r_L X Y Z : X ∖ (Y ∖ Z) = (X ∖ Y) ∪ (X ∩ Z).
Proof. unfold_leibniz. apply difference_difference_r. Qed.
Lemma difference_union_intersection_L X Y : (X ∖ Y) ∪ (X ∩ Y) = X.
Proof. unfold_leibniz. apply difference_union_intersection. Qed.
End dec_leibniz.
End set. End set.
...@@ -890,11 +926,15 @@ Section option_and_list_to_set. ...@@ -890,11 +926,15 @@ Section option_and_list_to_set.
Global Instance list_to_set_perm : Proper ((≡ₚ) ==> (≡)) (list_to_set (C:=C)). Global Instance list_to_set_perm : Proper ((≡ₚ) ==> (≡)) (list_to_set (C:=C)).
Proof. induction 1; set_solver. Qed. Proof. induction 1; set_solver. Qed.
Context `{!LeibnizEquiv C}. Section leibniz.
Lemma list_to_set_app_L l1 l2 : list_to_set (l1 ++ l2) =@{C} list_to_set l1 ∪ list_to_set l2. Context `{!LeibnizEquiv C}.
Proof. set_solver. Qed.
Global Instance list_to_set_perm_L : Proper ((≡ₚ) ==> (=)) (list_to_set (C:=C)). Lemma list_to_set_app_L l1 l2 :
Proof. induction 1; set_solver. Qed. list_to_set (l1 ++ l2) =@{C} list_to_set l1 ∪ list_to_set l2.
Proof. set_solver. Qed.
Global Instance list_to_set_perm_L : Proper ((≡ₚ) ==> (=)) (list_to_set (C:=C)).
Proof. induction 1; set_solver. Qed.
End leibniz.
End option_and_list_to_set. End option_and_list_to_set.
(** * Finite types to sets. *) (** * Finite types to sets. *)
...@@ -914,27 +954,39 @@ Section fin_to_set. ...@@ -914,27 +954,39 @@ Section fin_to_set.
End fin_to_set. End fin_to_set.
(** * Guard *) (** * Guard *)
Global Instance set_guard `{MonadSet M} : MGuard M := Global Instance set_mfail `{MonadSet M} : MFail M := λ _ _, ∅.
λ P dec A x, match dec with left H => x H | _ => ∅ end. Global Typeclasses Opaque set_mfail.
Section set_monad_base. Section set_monad_base.
Context `{MonadSet M}. Context `{MonadSet M}.
Lemma elem_of_mfail {A} x : x ∈@{M A} mfail ↔ False.
Proof. unfold mfail, set_mfail. by rewrite elem_of_empty. Qed.
Global Instance set_unfold_elem_of_mfail {A} (x : A) :
SetUnfoldElemOf x (mfail : M A) False.
Proof. constructor. by apply elem_of_mfail. Qed.
(** This lemma includes a bind, to avoid equalities of proofs. We cannot have
[p ∈ guard P ↔ P] unless [P] is proof irrelant. The best (but less usable)
self-contained alternative would be [p ∈ guard P ↔ decide P = left p]. *)
Lemma elem_of_guard `{Decision P} {A} (x : A) (X : M A) : Lemma elem_of_guard `{Decision P} {A} (x : A) (X : M A) :
(x ∈ guard P; X) ↔ P ∧ x ∈ X. x ∈ (guard P;; X) ↔ P ∧ x ∈ X.
Proof. Proof.
unfold mguard, set_guard; simpl; case_match; case_guard; rewrite elem_of_bind;
rewrite ?elem_of_empty; naive_solver. [setoid_rewrite elem_of_ret | setoid_rewrite elem_of_mfail];
naive_solver.
Qed. Qed.
Lemma elem_of_guard_2 `{Decision P} {A} (x : A) (X : M A) : Lemma elem_of_guard_2 `{Decision P} {A} (x : A) (X : M A) :
P → x ∈ X → x ∈ guard P; X. P → x ∈ X → x ∈ (guard P;; X).
Proof. by rewrite elem_of_guard. Qed. Proof. by rewrite elem_of_guard. Qed.
Lemma guard_empty `{Decision P} {A} (X : M A) : (guard P; X) ≡ ∅ ↔ ¬P ∨ X ≡ ∅. Lemma guard_empty `{Decision P} {A} (X : M A) : (guard P;; X) ≡ ∅ ↔ ¬P ∨ X ≡ ∅.
Proof. Proof.
rewrite !elem_of_equiv_empty; setoid_rewrite elem_of_guard. rewrite !elem_of_equiv_empty; setoid_rewrite elem_of_guard.
destruct (decide P); naive_solver. destruct (decide P); naive_solver.
Qed. Qed.
Global Instance set_unfold_guard `{Decision P} {A} (x : A) (X : M A) Q : Global Instance set_unfold_guard `{Decision P} {A} (x : A) (X : M A) Q :
SetUnfoldElemOf x X Q → SetUnfoldElemOf x (guard P; X) (P ∧ Q). SetUnfoldElemOf x X Q → SetUnfoldElemOf x (guard P;; X) (P ∧ Q).
Proof. constructor. by rewrite elem_of_guard, (set_unfold (x ∈ X) Q). Qed. Proof. constructor. by rewrite elem_of_guard, (set_unfold (x ∈ X) Q). Qed.
Lemma bind_empty {A B} (f : A → M B) X : Lemma bind_empty {A B} (f : A → M B) X :
X ≫= f ≡ ∅ ↔ X ≡ ∅ ∨ ∀ x, x ∈ X → f x ≡ ∅. X ≫= f ≡ ∅ ↔ X ≡ ∅ ∨ ∀ x, x ∈ X → f x ≡ ∅.
...@@ -950,33 +1002,50 @@ Section quantifiers. ...@@ -950,33 +1002,50 @@ Section quantifiers.
Context `{SemiSet A C} (P : A → Prop). Context `{SemiSet A C} (P : A → Prop).
Implicit Types X Y : C. Implicit Types X Y : C.
Global Instance set_unfold_set_Forall X (QX QP : A → Prop) :
(∀ x, SetUnfoldElemOf x X (QX x)) →
(∀ x, SetUnfold (P x) (QP x)) →
SetUnfold (set_Forall P X) (∀ x, QX x → QP x).
Proof.
intros HX HP; constructor. unfold set_Forall. apply forall_proper; intros x.
by rewrite (set_unfold (x ∈ X) _), (set_unfold (P x) _).
Qed.
Global Instance set_unfold_set_Exists X (QX QP : A → Prop) :
(∀ x, SetUnfoldElemOf x X (QX x)) →
(∀ x, SetUnfold (P x) (QP x)) →
SetUnfold (set_Exists P X) (∃ x, QX x ∧ QP x).
Proof.
intros HX HP; constructor. unfold set_Exists. f_equiv; intros x.
by rewrite (set_unfold (x ∈ X) _), (set_unfold (P x) _).
Qed.
Lemma set_Forall_empty : set_Forall P (∅ : C). Lemma set_Forall_empty : set_Forall P (∅ : C).
Proof. unfold set_Forall. set_solver. Qed. Proof. set_solver. Qed.
Lemma set_Forall_singleton x : set_Forall P ({[ x ]} : C) ↔ P x. Lemma set_Forall_singleton x : set_Forall P ({[ x ]} : C) ↔ P x.
Proof. unfold set_Forall. set_solver. Qed. Proof. set_solver. Qed.
Lemma set_Forall_union X Y : Lemma set_Forall_union X Y :
set_Forall P X → set_Forall P Y → set_Forall P (X ∪ Y). set_Forall P X → set_Forall P Y → set_Forall P (X ∪ Y).
Proof. unfold set_Forall. set_solver. Qed. Proof. set_solver. Qed.
Lemma set_Forall_union_inv_1 X Y : set_Forall P (X ∪ Y) → set_Forall P X. Lemma set_Forall_union_inv_1 X Y : set_Forall P (X ∪ Y) → set_Forall P X.
Proof. unfold set_Forall. set_solver. Qed. Proof. set_solver. Qed.
Lemma set_Forall_union_inv_2 X Y : set_Forall P (X ∪ Y) → set_Forall P Y. Lemma set_Forall_union_inv_2 X Y : set_Forall P (X ∪ Y) → set_Forall P Y.
Proof. unfold set_Forall. set_solver. Qed. Proof. set_solver. Qed.
Lemma set_Forall_list_to_set l : set_Forall P (list_to_set (C:=C) l) ↔ Forall P l. Lemma set_Forall_list_to_set l : set_Forall P (list_to_set (C:=C) l) ↔ Forall P l.
Proof. rewrite Forall_forall. unfold set_Forall. set_solver. Qed. Proof. rewrite Forall_forall. set_solver. Qed.
Lemma set_Exists_empty : ¬set_Exists P (∅ : C). Lemma set_Exists_empty : ¬set_Exists P (∅ : C).
Proof. unfold set_Exists. set_solver. Qed. Proof. set_solver. Qed.
Lemma set_Exists_singleton x : set_Exists P ({[ x ]} : C) ↔ P x. Lemma set_Exists_singleton x : set_Exists P ({[ x ]} : C) ↔ P x.
Proof. unfold set_Exists. set_solver. Qed. Proof. set_solver. Qed.
Lemma set_Exists_union_1 X Y : set_Exists P X → set_Exists P (X ∪ Y). Lemma set_Exists_union_1 X Y : set_Exists P X → set_Exists P (X ∪ Y).
Proof. unfold set_Exists. set_solver. Qed. Proof. set_solver. Qed.
Lemma set_Exists_union_2 X Y : set_Exists P Y → set_Exists P (X ∪ Y). Lemma set_Exists_union_2 X Y : set_Exists P Y → set_Exists P (X ∪ Y).
Proof. unfold set_Exists. set_solver. Qed. Proof. set_solver. Qed.
Lemma set_Exists_union_inv X Y : Lemma set_Exists_union_inv X Y :
set_Exists P (X ∪ Y) → set_Exists P X ∨ set_Exists P Y. set_Exists P (X ∪ Y) → set_Exists P X ∨ set_Exists P Y.
Proof. unfold set_Exists. set_solver. Qed. Proof. set_solver. Qed.
Lemma set_Exists_list_to_set l : set_Exists P (list_to_set (C:=C) l) ↔ Exists P l. Lemma set_Exists_list_to_set l : set_Exists P (list_to_set (C:=C) l) ↔ Exists P l.
Proof. rewrite Exists_exists. unfold set_Exists. set_solver. Qed. Proof. rewrite Exists_exists. set_solver. Qed.
End quantifiers. End quantifiers.
Section more_quantifiers. Section more_quantifiers.
...@@ -985,10 +1054,10 @@ Section more_quantifiers. ...@@ -985,10 +1054,10 @@ Section more_quantifiers.
Lemma set_Forall_impl (P Q : A → Prop) X : Lemma set_Forall_impl (P Q : A → Prop) X :
set_Forall P X → (∀ x, P x → Q x) → set_Forall Q X. set_Forall P X → (∀ x, P x → Q x) → set_Forall Q X.
Proof. unfold set_Forall. naive_solver. Qed. Proof. set_solver. Qed.
Lemma set_Exists_impl (P Q : A → Prop) X : Lemma set_Exists_impl (P Q : A → Prop) X :
set_Exists P X → (∀ x, P x → Q x) → set_Exists Q X. set_Exists P X → (∀ x, P x → Q x) → set_Exists Q X.
Proof. unfold set_Exists. naive_solver. Qed. Proof. set_solver. Qed.
End more_quantifiers. End more_quantifiers.
(** * Properties of implementations of sets that form a monad *) (** * Properties of implementations of sets that form a monad *)
...@@ -1007,7 +1076,7 @@ Section set_monad. ...@@ -1007,7 +1076,7 @@ Section set_monad.
Lemma set_bind_singleton {A B} (f : A → M B) x : {[ x ]} ≫= f ≡ f x. Lemma set_bind_singleton {A B} (f : A → M B) x : {[ x ]} ≫= f ≡ f x.
Proof. set_solver. Qed. Proof. set_solver. Qed.
Lemma set_guard_True {A} `{Decision P} (X : M A) : P → (guard P; X) ≡ X. Lemma set_guard_True {A} `{Decision P} (X : M A) : P → (guard P;; X) ≡ X.
Proof. set_solver. Qed. Proof. set_solver. Qed.
Lemma set_fmap_compose {A B C} (f : A → B) (g : B → C) (X : M A) : Lemma set_fmap_compose {A B C} (f : A → B) (g : B → C) (X : M A) :
g ∘ f <$> X ≡ g <$> (f <$> X). g ∘ f <$> X ≡ g <$> (f <$> X).
...@@ -1029,7 +1098,7 @@ Section set_monad. ...@@ -1029,7 +1098,7 @@ Section set_monad.
- revert l. induction k; set_solver by eauto. - revert l. induction k; set_solver by eauto.
- induction 1; set_solver. - induction 1; set_solver.
Qed. Qed.
Lemma set_mapM_length {A B} (f : A → M B) l k : Lemma length_set_mapM {A B} (f : A → M B) l k :
l ∈ mapM f k → length l = length k. l ∈ mapM f k → length l = length k.
Proof. revert l; induction k; set_solver by eauto. Qed. 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 : Lemma elem_of_mapM_fmap {A B} (f : A → B) (g : B → M A) l k :
...@@ -1043,8 +1112,26 @@ Section set_monad. ...@@ -1043,8 +1112,26 @@ Section set_monad.
Forall2 P l1 l2. Forall2 P l1 l2.
Proof. Proof.
rewrite elem_of_mapM. intros Hl1. revert l2. rewrite elem_of_mapM. intros Hl1. revert l2.
induction Hl1; inversion_clear 1; constructor; auto. induction Hl1; inv 1; constructor; auto.
Qed.
Global Instance monadset_cprod {A B} : CProd (M A) (M B) (M (A * B)) := λ X Y,
x ← X; fmap (x,.) Y.
Lemma elem_of_monadset_cprod {A B} (X : M A) (Y : M B) (x : A * B) :
x ∈ cprod X Y ↔ x.1 ∈ X ∧ x.2 ∈ Y.
Proof. unfold cprod, monadset_cprod. destruct x; set_solver. Qed.
Global Instance set_unfold_monadset_cprod {A B} (X : M A) (Y : M B) P Q x :
SetUnfoldElemOf x.1 X P →
SetUnfoldElemOf x.2 Y Q →
SetUnfoldElemOf x (cprod X Y) (P ∧ Q).
Proof.
constructor.
by rewrite elem_of_monadset_cprod, (set_unfold_elem_of x.1 X P),
(set_unfold_elem_of x.2 Y Q).
Qed. Qed.
End set_monad. End set_monad.
(** Finite sets *) (** Finite sets *)
...@@ -1169,6 +1256,37 @@ Proof. ...@@ -1169,6 +1256,37 @@ Proof.
intros xs. exists (fresh xs). split; [set_solver|]. apply infinite_is_fresh. intros xs. exists (fresh xs). split; [set_solver|]. apply infinite_is_fresh.
Qed. Qed.
(** This formulation of finiteness is stronger than [pred_finite]: when equality
is decidable, it is equivalent to the predicate being finite AND decidable. *)
Lemma dec_pred_finite_alt {A} (P : A → Prop) `{!∀ x, Decision (P x)} :
pred_finite P ↔ ∃ xs : list A, ∀ x, P x ↔ x ∈ xs.
Proof.
split; intros [xs ?].
- exists (filter P xs). intros x. rewrite elem_of_list_filter. naive_solver.
- exists xs. naive_solver.
Qed.
Lemma finite_sig_pred_finite {A} (P : A → Prop) `{Finite (sig P)} :
pred_finite P.
Proof.
exists (proj1_sig <$> enum _). intros x px.
apply elem_of_list_fmap_1_alt with (x ↾ px); [apply elem_of_enum|]; done.
Qed.
Lemma pred_finite_arg2 {A B} (P : A → B → Prop) x :
pred_finite (uncurry P) → pred_finite (P x).
Proof.
intros [xys ?]. exists (xys.*2). intros y ?.
apply elem_of_list_fmap_1_alt with (x, y); by auto.
Qed.
Lemma pred_finite_arg1 {A B} (P : A → B → Prop) y :
pred_finite (uncurry P) → pred_finite (flip P y).
Proof.
intros [xys ?]. exists (xys.*1). intros x ?.
apply elem_of_list_fmap_1_alt with (x, y); by auto.
Qed.
(** Sets of sequences of natural numbers *) (** Sets of sequences of natural numbers *)
(* The set [seq_seq start len] of natural numbers contains the sequence (* The set [seq_seq start len] of natural numbers contains the sequence
[start, start + 1, ..., start + (len-1)]. *) [start, start + 1, ..., start + (len-1)]. *)
...@@ -1214,17 +1332,17 @@ Section set_seq. ...@@ -1214,17 +1332,17 @@ Section set_seq.
- rewrite set_seq_subseteq; lia. - rewrite set_seq_subseteq; lia.
Qed. Qed.
Lemma set_seq_plus_disjoint start len1 len2 : Lemma set_seq_add_disjoint start len1 len2 :
set_seq (C:=C) start len1 ## set_seq (start + len1) len2. set_seq (C:=C) start len1 ## set_seq (start + len1) len2.
Proof. set_solver by lia. Qed. Proof. set_solver by lia. Qed.
Lemma set_seq_plus start len1 len2 : Lemma set_seq_add start len1 len2 :
set_seq (C:=C) start (len1 + len2) set_seq (C:=C) start (len1 + len2)
≡ set_seq start len1 ∪ set_seq (start + len1) len2. ≡ set_seq start len1 ∪ set_seq (start + len1) len2.
Proof. set_solver by lia. Qed. Proof. set_solver by lia. Qed.
Lemma set_seq_plus_L `{!LeibnizEquiv C} start len1 len2 : Lemma set_seq_add_L `{!LeibnizEquiv C} start len1 len2 :
set_seq (C:=C) start (len1 + len2) set_seq (C:=C) start (len1 + len2)
= set_seq start len1 ∪ set_seq (start + len1) len2. = set_seq start len1 ∪ set_seq (start + len1) len2.
Proof. unfold_leibniz. apply set_seq_plus. Qed. Proof. unfold_leibniz. apply set_seq_add. Qed.
Lemma set_seq_S_start_disjoint start len : Lemma set_seq_S_start_disjoint start len :
{[ start ]} ## set_seq (C:=C) (S start) len. {[ start ]} ## set_seq (C:=C) (S start) len.
...@@ -1257,7 +1375,7 @@ End set_seq. ...@@ -1257,7 +1375,7 @@ End set_seq.
Definition minimal `{ElemOf A C} (R : relation A) (x : A) (X : C) : Prop := Definition minimal `{ElemOf A C} (R : relation A) (x : A) (X : C) : Prop :=
∀ y, y ∈ X → R y x → R x y. ∀ y, y ∈ X → R y x → R x y.
Global Instance: Params (@minimal) 5 := {}. Global Instance: Params (@minimal) 5 := {}.
Typeclasses Opaque minimal. Global Typeclasses Opaque minimal.
Section minimal. Section minimal.
Context `{SemiSet A C} {R : relation A}. Context `{SemiSet A C} {R : relation A}.
......