theories/gmap.v

-(* Copyright (c) 2012-2017, Robbert Krebbers. *)
-(* This file is distributed under the terms of the BSD license. *)
-(** This file implements finite maps and finite sets with keys of any countable
-type. The implementation is based on [Pmap]s, radix-2 search trees. *)
-From stdpp Require Export countable fin_maps fin_map_dom.
-From stdpp Require Import pmap mapset set.
-Set Default Proof Using "Type".
-
-(** * The data structure *)
-(** We pack a [Pmap] together with a proof that ensures that all keys correspond
-to codes of actual elements of the countable type. *)
-Definition gmap_wf `{Countable K} {A} : Pmap A → Prop :=
-  map_Forall (λ p _, encode <$> decode p = Some p).
-Record gmap K `{Countable K} A := GMap {
-  gmap_car : Pmap A;
-  gmap_prf : bool_decide (gmap_wf gmap_car)
-}.
-Arguments GMap {_ _ _ _} _ _.
-Arguments gmap_car {_ _ _ _} _.
-Lemma gmap_eq `{Countable K} {A} (m1 m2 : gmap K A) :
-  m1 = m2 ↔ gmap_car m1 = gmap_car m2.
-Proof.
-  split; [by intros ->|intros]. destruct m1, m2; simplify_eq/=.
-  f_equal; apply proof_irrel.
-Qed.
-Instance gmap_eq_eq `{Countable K, EqDecision A} : EqDecision (gmap K A).
-Proof.
- refine (λ m1 m2, cast_if (decide (gmap_car m1 = gmap_car m2)));
-  abstract (by rewrite gmap_eq).
-Defined.
-
-(** * Operations on the data structure *)
-Instance gmap_lookup `{Countable K} {A} : Lookup K A (gmap K A) := λ i m,
-  let (m,_) := m in m !! encode i.
-Instance gmap_empty `{Countable K} {A} : Empty (gmap K A) := GMap ∅ I.
-Global Opaque gmap_empty.
-Lemma gmap_partial_alter_wf `{Countable K} {A} (f : option A → option A) m i :
-  gmap_wf m → gmap_wf (partial_alter f (encode i) m).
-Proof.
-  intros Hm p x. destruct (decide (encode i = p)) as [<-|?].
-  - rewrite decode_encode; eauto.
-  - rewrite lookup_partial_alter_ne by done. by apply Hm.
-Qed.
-Instance gmap_partial_alter `{Countable K} {A} :
-    PartialAlter K A (gmap K A) := λ f i m,
-  let (m,Hm) := m in GMap (partial_alter f (encode i) m)
-    (bool_decide_pack _ (gmap_partial_alter_wf f m i
-    (bool_decide_unpack _ Hm))).
-Lemma gmap_fmap_wf `{Countable K} {A B} (f : A → B) m :
-  gmap_wf m → gmap_wf (f <$> m).
-Proof. intros ? p x. rewrite lookup_fmap, fmap_Some; intros (?&?&?); eauto. Qed.
-Instance gmap_fmap `{Countable K} : FMap (gmap K) := λ A B f m,
-  let (m,Hm) := m in GMap (f <$> m)
-    (bool_decide_pack _ (gmap_fmap_wf f m (bool_decide_unpack _ Hm))).
-Lemma gmap_omap_wf `{Countable K} {A B} (f : A → option B) m :
-  gmap_wf m → gmap_wf (omap f m).
-Proof. intros ? p x; rewrite lookup_omap, bind_Some; intros (?&?&?); eauto. Qed.
-Instance gmap_omap `{Countable K} : OMap (gmap K) := λ A B f m,
-  let (m,Hm) := m in GMap (omap f m)
-    (bool_decide_pack _ (gmap_omap_wf f m (bool_decide_unpack _ Hm))).
-Lemma gmap_merge_wf `{Countable K} {A B C}
-    (f : option A → option B → option C) m1 m2 :
-  let f' o1 o2 := match o1, o2 with None, None => None | _, _ => f o1 o2 end in
-  gmap_wf m1 → gmap_wf m2 → gmap_wf (merge f' m1 m2).
-Proof.
-  intros f' Hm1 Hm2 p z; rewrite lookup_merge by done; intros.
-  destruct (m1 !! _) eqn:?, (m2 !! _) eqn:?; naive_solver.
-Qed.
-Instance gmap_merge `{Countable K} : Merge (gmap K) := λ A B C f m1 m2,
-  let (m1,Hm1) := m1 in let (m2,Hm2) := m2 in
-  let f' o1 o2 := match o1, o2 with None, None => None | _, _ => f o1 o2 end in
-  GMap (merge f' m1 m2) (bool_decide_pack _ (gmap_merge_wf f _ _
-    (bool_decide_unpack _ Hm1) (bool_decide_unpack _ Hm2))).
-Instance gmap_to_list `{Countable K} {A} : FinMapToList K A (gmap K A) := λ m,
-  let (m,_) := m in omap (λ ix : positive * A,
-    let (i,x) := ix in (,x) <$> decode i) (map_to_list m).
-
-(** * Instantiation of the finite map interface *)
-Instance gmap_finmap `{Countable K} : FinMap K (gmap K).
-Proof.
-  split.
-  - unfold lookup; intros A [m1 Hm1] [m2 Hm2] Hm.
-    apply gmap_eq, map_eq; intros i; simpl in *.
-    apply bool_decide_unpack in Hm1; apply bool_decide_unpack in Hm2.
-    apply option_eq; intros x; split; intros Hi.
-    + pose proof (Hm1 i x Hi); simpl in *.
-      by destruct (decode i); simplify_eq/=; rewrite <-Hm.
-    + pose proof (Hm2 i x Hi); simpl in *.
-      by destruct (decode i); simplify_eq/=; rewrite Hm.
-  - done.
-  - intros A f [m Hm] i; apply (lookup_partial_alter f m).
-  - intros A f [m Hm] i j Hs; apply (lookup_partial_alter_ne f m).
-    by contradict Hs; apply (inj encode).
-  - intros A B f [m Hm] i; apply (lookup_fmap f m).
-  - intros A [m Hm]; unfold map_to_list; simpl.
-    apply bool_decide_unpack, map_Forall_to_list in Hm; revert Hm.
-    induction (NoDup_map_to_list m) as [|[p x] l Hpx];
-      inversion 1 as [|??? Hm']; simplify_eq/=; [by constructor|].
-    destruct (decode p) as [i|] eqn:?; simplify_eq/=; constructor; eauto.
-    rewrite elem_of_list_omap; intros ([p' x']&?&?); simplify_eq/=.
-    feed pose proof (proj1 (Forall_forall _ _) Hm' (p',x')); simpl in *; auto.
-    by destruct (decode p') as [i'|]; simplify_eq/=.
-  - intros A [m Hm] i x; unfold map_to_list, lookup; simpl.
-    apply bool_decide_unpack in Hm; rewrite elem_of_list_omap; split.
-    + intros ([p' x']&Hp'&?); apply elem_of_map_to_list in Hp'.
-      feed pose proof (Hm p' x'); simpl in *; auto.
-      by destruct (decode p') as [i'|] eqn:?; simplify_eq/=.
-    + intros; exists (encode i,x); simpl.
-      by rewrite elem_of_map_to_list, decode_encode.
-  - intros A B f [m Hm] i; apply (lookup_omap f m).
-  - intros A B C f ? [m1 Hm1] [m2 Hm2] i; unfold merge, lookup; simpl.
-    set (f' o1 o2 := match o1, o2 with None,None => None | _, _ => f o1 o2 end).
-    by rewrite lookup_merge by done; destruct (m1 !! _), (m2 !! _).
-Qed.
-
-Program Instance gmap_countable
-    `{Countable K, Countable A} : Countable (gmap K A) := {
-  encode m := encode (map_to_list m : list (K * A));
-  decode p := map_of_list <$> decode p
-}.
-Next Obligation.
-  intros K ?? A ?? m; simpl. rewrite decode_encode; simpl.
-  by rewrite map_of_to_list.
-Qed.
-
-(** * Curry and uncurry *)
-Definition gmap_curry `{Countable K1, Countable K2} {A} :
-    gmap K1 (gmap K2 A) → gmap (K1 * K2) A :=
-  map_fold (λ i1 m' macc,
-    map_fold (λ i2 x, <[(i1,i2):=x]>) macc m') ∅.
-Definition gmap_uncurry `{Countable K1, Countable K2} {A} :
-    gmap (K1 * K2) A → gmap K1 (gmap K2 A) :=
-  map_fold (λ '(i1,i2) x,
-    partial_alter (Some ∘ <[i2:=x]> ∘ from_option id ∅) i1) ∅.
-
-Section curry_uncurry.
-  Context `{Countable K1, Countable K2} {A : Type}.
-
-  Lemma lookup_gmap_curry (m : gmap K1 (gmap K2 A)) i j :
-    gmap_curry m !! (i,j) = m !! i ≫= (!! j).
-  Proof.
-    apply (map_fold_ind (λ mr m, mr !! (i,j) = m !! i ≫= (!! j))).
-    { by rewrite !lookup_empty. }
-    clear m; intros i' m2 m m12 Hi' IH.
-    apply (map_fold_ind (λ m2r m2, m2r !! (i,j) = <[i':=m2]> m !! i ≫= (!! j))).
-    { rewrite IH. destruct (decide (i' = i)) as [->|].
-      - rewrite lookup_insert, Hi'; simpl; by rewrite lookup_empty.
-      - by rewrite lookup_insert_ne by done. }
-    intros j' y m2' m12' Hj' IH'. destruct (decide (i = i')) as [->|].
-    - rewrite lookup_insert; simpl. destruct (decide (j = j')) as [->|].
-      + by rewrite !lookup_insert.
-      + by rewrite !lookup_insert_ne, IH', lookup_insert by congruence.
-    - by rewrite !lookup_insert_ne, IH', lookup_insert_ne by congruence.
-  Qed.
-
-  Lemma lookup_gmap_uncurry (m : gmap (K1 * K2) A) i j :
-    gmap_uncurry m !! i ≫= (!! j) = m !! (i, j).
-  Proof.
-    apply (map_fold_ind (λ mr m, mr !! i ≫= (!! j) = m !! (i, j))).
-    { by rewrite !lookup_empty. }
-    clear m; intros [i' j'] x m12 mr Hij' IH.
-    destruct (decide (i = i')) as [->|].
-    - rewrite lookup_partial_alter. destruct (decide (j = j')) as [->|].
-      + destruct (mr !! i'); simpl; by rewrite !lookup_insert.
-      + destruct (mr !! i'); simpl; by rewrite !lookup_insert_ne by congruence.
-    - by rewrite lookup_partial_alter_ne, lookup_insert_ne by congruence.
-  Qed.
-
-  Lemma gmap_curry_uncurry (m : gmap (K1 * K2) A) :
-    gmap_curry (gmap_uncurry m) = m.
-  Proof.
-   apply map_eq; intros [i j]. by rewrite lookup_gmap_curry, lookup_gmap_uncurry.
-  Qed.
-End curry_uncurry.
-
-(** * Finite sets *)
-Notation gset K := (mapset (gmap K)).
-Instance gset_dom `{Countable K} {A} : Dom (gmap K A) (gset K) := mapset_dom.
-Instance gset_dom_spec `{Countable K} :
-  FinMapDom K (gmap K) (gset K) := mapset_dom_spec.
-
-Definition of_gset `{Countable A} (X : gset A) : set A := mkSet (λ x, x ∈ X).
-Lemma elem_of_of_gset `{Countable A} (X : gset A) x : x ∈ of_gset X ↔ x ∈ X.
-Proof. done. Qed.
-
-Definition to_gmap `{Countable K} {A} (x : A) (X : gset K) : gmap K A :=
-  (λ _, x) <$> mapset_car X.
-
-Lemma lookup_to_gmap `{Countable K} {A} (x : A) (X : gset K) i :
-  to_gmap x X !! i = guard (i ∈ X); Some x.
-Proof.
-  destruct X as [X]; unfold to_gmap, elem_of, mapset_elem_of; simpl.
-  rewrite lookup_fmap.
-  case_option_guard; destruct (X !! i) as [[]|]; naive_solver.
-Qed.
-Lemma lookup_to_gmap_Some `{Countable K} {A} (x : A) (X : gset K) i y :
-  to_gmap x X !! i = Some y ↔ i ∈ X ∧ x = y.
-Proof. rewrite lookup_to_gmap. simplify_option_eq; naive_solver. Qed.
-Lemma lookup_to_gmap_None `{Countable K} {A} (x : A) (X : gset K) i :
-  to_gmap x X !! i = None ↔ i ∉ X.
-Proof. rewrite lookup_to_gmap. simplify_option_eq; naive_solver. Qed.
-
-Lemma to_gmap_empty `{Countable K} {A} (x : A) : to_gmap x ∅ = ∅.
-Proof. apply fmap_empty. Qed.
-Lemma to_gmap_union_singleton `{Countable K} {A} (x : A) i Y :
-  to_gmap x ({[ i ]} ∪ Y) = <[i:=x]>(to_gmap x Y).
-Proof.
-  apply map_eq; intros j; apply option_eq; intros y.
-  rewrite lookup_insert_Some, !lookup_to_gmap_Some, elem_of_union,
-    elem_of_singleton; destruct (decide (i = j)); intuition.
-Qed.
-
-Lemma fmap_to_gmap `{Countable K} {A B} (f : A → B) (X : gset K) (x : A) :
-  f <$> to_gmap x X = to_gmap (f x) X.
-Proof.
-  apply map_eq; intros j. rewrite lookup_fmap, !lookup_to_gmap.
-  by simplify_option_eq.
-Qed.
-Lemma to_gmap_dom `{Countable K} {A B} (m : gmap K A) (y : B) :
-  to_gmap y (dom _ m) = const y <$> m.
-Proof.
-  apply map_eq; intros j. rewrite lookup_fmap, lookup_to_gmap.
-  destruct (m !! j) as [x|] eqn:?.
-  - by rewrite option_guard_True by (rewrite elem_of_dom; eauto).
-  - by rewrite option_guard_False by (rewrite not_elem_of_dom; eauto).
-Qed.
-
-(** * Fresh elements *)
-(* This is pretty ad-hoc and just for the case of [gset positive]. We need a
-notion of countable non-finite types to generalize this. *)
-Instance gset_positive_fresh : Fresh positive (gset positive) := λ X,
-  let 'Mapset (GMap m _) := X in fresh (dom _ m).
-Instance gset_positive_fresh_spec : FreshSpec positive (gset positive).
-Proof.
-  split.
-  - apply _.
-  - by intros X Y; rewrite <-elem_of_equiv_L; intros ->.
-  - intros [[m Hm]]; unfold fresh; simpl.
-    by intros ?; apply (is_fresh (dom Pset m)), elem_of_dom_2 with ().
-Qed.

theories/gmultiset.v

-(* Copyright (c) 2012-2016, Robbert Krebbers. *)
-(* This file is distributed under the terms of the BSD license. *)
-From stdpp Require Import gmap.
-Set Default Proof Using "Type".
-
-Record gmultiset A `{Countable A} := GMultiSet { gmultiset_car : gmap A nat }.
-Arguments GMultiSet {_ _ _} _.
-Arguments gmultiset_car {_ _ _} _.
-
-Lemma gmultiset_eq_dec `{Countable A} : EqDecision (gmultiset A).
-Proof. solve_decision. Defined.
-Hint Extern 1 (Decision (@eq (gmultiset _) _ _)) =>
-  eapply @gmultiset_eq_dec : typeclass_instances.
-
-Program Definition gmultiset_countable `{Countable A} :
-    Countable (gmultiset A) := {|
-  encode X := encode (gmultiset_car X);  decode p := GMultiSet <$> decode p
-|}.
-Next Obligation. intros A ?? [X]; simpl. by rewrite decode_encode. Qed.
-Hint Extern 1 (Countable (gmultiset _)) =>
-  eapply @gmultiset_countable : typeclass_instances.
-
-Section definitions.
-  Context `{Countable A}.
-
-  Definition multiplicity (x : A) (X : gmultiset A) : nat :=
-    match gmultiset_car X !! x with Some n => S n | None => 0 end.
-  Instance gmultiset_elem_of : ElemOf A (gmultiset A) := λ x X,
-    0 < multiplicity x X.
-  Instance gmultiset_subseteq : SubsetEq (gmultiset A) := λ X Y, ∀ x,
-    multiplicity x X ≤ multiplicity x Y.
-
-  Instance gmultiset_elements : Elements A (gmultiset A) := λ X,
-    let (X) := X in '(x,n) ← map_to_list X; replicate (S n) x.
-  Instance gmultiset_size : Size (gmultiset A) := length ∘ elements.
-
-  Instance gmultiset_empty : Empty (gmultiset A) := GMultiSet ∅.
-  Instance gmultiset_singleton : Singleton A (gmultiset A) := λ x,
-    GMultiSet {[ x := 0 ]}.
-  Instance gmultiset_union : Union (gmultiset A) := λ X Y,
-    let (X) := X in let (Y) := Y in
-    GMultiSet $ union_with (λ x y, Some (S (x + y))) X Y.
-  Instance gmultiset_difference : Difference (gmultiset A) := λ X Y,
-    let (X) := X in let (Y) := Y in
-    GMultiSet $ difference_with (λ x y,
-      let z := x - y in guard (0 < z); Some (pred z)) X Y.
-
-  Instance gmultiset_dom : Dom (gmultiset A) (gset A) := λ X,
-    let (X) := X in dom _ X.
-End definitions.
-
-Typeclasses Opaque gmultiset_elem_of gmultiset_subseteq.
-Typeclasses Opaque gmultiset_elements gmultiset_size gmultiset_empty.
-Typeclasses Opaque gmultiset_singleton gmultiset_union gmultiset_difference.
-Typeclasses Opaque gmultiset_dom.
-
-(** These instances are declared using [Hint Extern] to avoid too
-eager type class search. *)
-Hint Extern 1 (ElemOf _ (gmultiset _)) =>
-  eapply @gmultiset_elem_of : typeclass_instances.
-Hint Extern 1 (SubsetEq (gmultiset _)) =>
-  eapply @gmultiset_subseteq : typeclass_instances.
-Hint Extern 1 (Empty (gmultiset _)) =>
-  eapply @gmultiset_empty : typeclass_instances.
-Hint Extern 1 (Singleton _ (gmultiset _)) =>
-  eapply @gmultiset_singleton : typeclass_instances.
-Hint Extern 1 (Union (gmultiset _)) =>
-  eapply @gmultiset_union : typeclass_instances.
-Hint Extern 1 (Difference (gmultiset _)) =>
-  eapply @gmultiset_difference : typeclass_instances.
-Hint Extern 1 (Elements _ (gmultiset _)) =>
-  eapply @gmultiset_elements : typeclass_instances.
-Hint Extern 1 (Size (gmultiset _)) =>
-  eapply @gmultiset_size : typeclass_instances.
-Hint Extern 1 (Dom (gmultiset _) _) =>
-  eapply @gmultiset_dom : typeclass_instances.
-
-Section lemmas.
-Context `{Countable A}.
-Implicit Types x y : A.
-Implicit Types X Y : gmultiset A.
-
-Lemma gmultiset_eq X Y : X = Y ↔ ∀ x, multiplicity x X = multiplicity x Y.
-Proof.
-  split; [by intros ->|intros HXY].
-  destruct X as [X], Y as [Y]; f_equal; apply map_eq; intros x.
-  specialize (HXY x); unfold multiplicity in *; simpl in *.
-  repeat case_match; naive_solver.
-Qed.
-
-(* Multiplicity *)
-Lemma multiplicity_empty x : multiplicity x ∅ = 0.
-Proof. done. Qed.
-Lemma multiplicity_singleton x : multiplicity x {[ x ]} = 1.
-Proof. unfold multiplicity; simpl. by rewrite lookup_singleton. Qed.
-Lemma multiplicity_singleton_ne x y : x ≠ y → multiplicity x {[ y ]} = 0.
-Proof. intros. unfold multiplicity; simpl. by rewrite lookup_singleton_ne. Qed.
-Lemma multiplicity_union X Y x :
-  multiplicity x (X ∪ Y) = multiplicity x X + multiplicity x Y.
-Proof.
-  destruct X as [X], Y as [Y]; unfold multiplicity; simpl.
-  rewrite lookup_union_with. destruct (X !! _), (Y !! _); simpl; omega.
-Qed.
-Lemma multiplicity_difference X Y x :
-  multiplicity x (X ∖ Y) = multiplicity x X - multiplicity x Y.
-Proof.
-  destruct X as [X], Y as [Y]; unfold multiplicity; simpl.
-  rewrite lookup_difference_with.
-  destruct (X !! _), (Y !! _); simplify_option_eq; omega.
-Qed.
-
-(* Collection *)
-Lemma elem_of_multiplicity x X : x ∈ X ↔ 0 < multiplicity x X.
-Proof. done. Qed.
-
-Global Instance gmultiset_simple_collection : SimpleCollection A (gmultiset A).
-Proof.
-  split.
-  - intros x. rewrite elem_of_multiplicity, multiplicity_empty. omega.
-  - intros x y. destruct (decide (x = y)) as [->|].
-    + rewrite elem_of_multiplicity, multiplicity_singleton. split; auto with lia.
-    + rewrite elem_of_multiplicity, multiplicity_singleton_ne by done.
-      by split; auto with lia.
-  - intros X Y x. rewrite !elem_of_multiplicity, multiplicity_union. omega.
-Qed.
-Global Instance gmultiset_elem_of_dec x X : Decision (x ∈ X).
-Proof. unfold elem_of, gmultiset_elem_of. apply _. Defined.
-
-(* Algebraic laws *)
-Global Instance gmultiset_comm : Comm (@eq (gmultiset A)) (∪).
-Proof.
-  intros X Y. apply gmultiset_eq; intros x. rewrite !multiplicity_union; omega.
-Qed.
-Global Instance gmultiset_assoc : Assoc (@eq (gmultiset A)) (∪).
-Proof.
-  intros X Y Z. apply gmultiset_eq; intros x. rewrite !multiplicity_union; omega.
-Qed.
-Global Instance gmultiset_left_id : LeftId (@eq (gmultiset A)) ∅ (∪).
-Proof.
-  intros X. apply gmultiset_eq; intros x.
-  by rewrite multiplicity_union, multiplicity_empty.
-Qed.
-Global Instance gmultiset_right_id : RightId (@eq (gmultiset A)) ∅ (∪).
-Proof. intros X. by rewrite (comm_L (∪)), (left_id_L _ _). Qed.
-
-Global Instance gmultiset_union_inj_1 X : Inj (=) (=) (X ∪).
-Proof.
-  intros Y1 Y2. rewrite !gmultiset_eq. intros HX x; generalize (HX x).
-  rewrite !multiplicity_union. omega.
-Qed.
-Global Instance gmultiset_union_inj_2 X : Inj (=) (=) (∪ X).
-Proof. intros Y1 Y2. rewrite <-!(comm_L _ X). apply (inj _). Qed.
-
-Lemma gmultiset_non_empty_singleton x : {[ x ]} ≠ (∅ : gmultiset A).
-Proof.
-  rewrite gmultiset_eq. intros Hx; generalize (Hx x).
-  by rewrite multiplicity_singleton, multiplicity_empty.
-Qed.
-
-(* Properties of the elements operation *)
-Lemma gmultiset_elements_empty : elements (∅ : gmultiset A) = [].
-Proof.
-  unfold elements, gmultiset_elements; simpl. by rewrite map_to_list_empty.
-Qed.
-Lemma gmultiset_elements_empty_inv X : elements X = [] → X = ∅.
-Proof.
-  destruct X as [X]; unfold elements, gmultiset_elements; simpl.
-  intros; apply (f_equal GMultiSet). destruct (map_to_list X)
-    as [|[]] eqn:?; naive_solver eauto using map_to_list_empty_inv.
-Qed.
-Lemma gmultiset_elements_empty' X : elements X = [] ↔ X = ∅.
-Proof.
-  split; intros HX; [by apply gmultiset_elements_empty_inv|].
-  by rewrite HX, gmultiset_elements_empty.
-Qed.
-Lemma gmultiset_elements_singleton x : elements ({[ x ]} : gmultiset A) = [ x ].
-Proof.
-  unfold elements, gmultiset_elements; simpl. by rewrite map_to_list_singleton.
-Qed.
-Lemma gmultiset_elements_union X Y :
-  elements (X ∪ Y) ≡ₚ elements X ++ elements Y.
-Proof.
-  destruct X as [X], Y as [Y]; unfold elements, gmultiset_elements.
-  set (f xn := let '(x, n) := xn in replicate (S n) x); simpl.
-  revert Y; induction X as [|x n X HX IH] using map_ind; intros Y.
-  { by rewrite (left_id_L _ _ Y), map_to_list_empty. }
-  destruct (Y !! x) as [n'|] eqn:HY.
-  - rewrite <-(insert_id Y x n'), <-(insert_delete Y) by done.
-    erewrite <-insert_union_with by done.
-    rewrite !map_to_list_insert, !bind_cons
-      by (by rewrite ?lookup_union_with, ?lookup_delete, ?HX).
-    rewrite (assoc_L _), <-(comm (++) (f (_,n'))), <-!(assoc_L _), <-IH.
-    rewrite (assoc_L _). f_equiv.
-    rewrite (comm _); simpl. by rewrite replicate_plus, Permutation_middle.
-  - rewrite <-insert_union_with_l, !map_to_list_insert, !bind_cons
-      by (by rewrite ?lookup_union_with, ?HX, ?HY).
-    by rewrite <-(assoc_L (++)), <-IH.
-Qed.
-Lemma gmultiset_elem_of_elements x X : x ∈ elements X ↔ x ∈ X.
-Proof.
-  destruct X as [X]. unfold elements, gmultiset_elements.
-  set (f xn := let '(x, n) := xn in replicate (S n) x); simpl.
-  unfold elem_of at 2, gmultiset_elem_of, multiplicity; simpl.
-  rewrite elem_of_list_bind. split.
-  - intros [[??] [[<- ?]%elem_of_replicate ->%elem_of_map_to_list]]; lia.
-  - intros. destruct (X !! x) as [n|] eqn:Hx; [|omega].
-    exists (x,n); split; [|by apply elem_of_map_to_list].
-    apply elem_of_replicate; auto with omega.
-Qed.
-Lemma gmultiset_elem_of_dom x X : x ∈ dom (gset A) X ↔ x ∈ X.
-Proof.
-  unfold dom, gmultiset_dom, elem_of at 2, gmultiset_elem_of, multiplicity.
-  destruct X as [X]; simpl; rewrite elem_of_dom, <-not_eq_None_Some.
-  destruct (X !! x); naive_solver omega.
-Qed.
-
-(* Properties of the size operation *)
-Lemma gmultiset_size_empty : size (∅ : gmultiset A) = 0.
-Proof. done. Qed.
-Lemma gmultiset_size_empty_inv X : size X = 0 → X = ∅.
-Proof.
-  unfold size, gmultiset_size; simpl. rewrite length_zero_iff_nil.
-  apply gmultiset_elements_empty_inv.
-Qed.
-Lemma gmultiset_size_empty_iff X : size X = 0 ↔ X = ∅.
-Proof.
-  split; [apply gmultiset_size_empty_inv|].
-  by intros ->; rewrite gmultiset_size_empty.
-Qed.
-Lemma gmultiset_size_non_empty_iff X : size X ≠ 0 ↔ X ≠ ∅.
-Proof. by rewrite gmultiset_size_empty_iff. Qed.
-
-Lemma gmultiset_choose_or_empty X : (∃ x, x ∈ X) ∨ X = ∅.
-Proof.
-  destruct (elements X) as [|x l] eqn:HX; [right|left].
-  - by apply gmultiset_elements_empty_inv.
-  - exists x. rewrite <-gmultiset_elem_of_elements, HX. by left.
-Qed.
-Lemma gmultiset_choose X : X ≠ ∅ → ∃ x, x ∈ X.
-Proof. intros. by destruct (gmultiset_choose_or_empty X). Qed.
-Lemma gmultiset_size_pos_elem_of X : 0 < size X → ∃ x, x ∈ X.
-Proof.
-  intros Hsz. destruct (gmultiset_choose_or_empty X) as [|HX]; [done|].
-  contradict Hsz. rewrite HX, gmultiset_size_empty; lia.
-Qed.
-
-Lemma gmultiset_size_singleton x : size ({[ x ]} : gmultiset A) = 1.
-Proof.
-  unfold size, gmultiset_size; simpl. by rewrite gmultiset_elements_singleton.
-Qed.
-Lemma gmultiset_size_union X Y : size (X ∪ Y) = size X + size Y.
-Proof.
-  unfold size, gmultiset_size; simpl.
-  by rewrite gmultiset_elements_union, app_length.
-Qed.
-
-(* Order stuff *)
-Global Instance gmultiset_po : PartialOrder (@subseteq (gmultiset A) _).
-Proof.
-  split; [split|].
-  - by intros X x.
-  - intros X Y Z HXY HYZ x. by trans (multiplicity x Y).
-  - intros X Y HXY HYX; apply gmultiset_eq; intros x. by apply (anti_symm (≤)).
-Qed.
-
-Lemma gmultiset_subseteq_alt X Y :
-  X ⊆ Y ↔
-  map_relation (≤) (λ _, False) (λ _, True) (gmultiset_car X) (gmultiset_car Y).
-Proof.
-  apply forall_proper; intros x. unfold multiplicity.
-  destruct (gmultiset_car X !! x), (gmultiset_car Y !! x); naive_solver omega.
-Qed.
-Global Instance gmultiset_subseteq_dec X Y : Decision (X ⊆ Y).
-Proof.
- refine (cast_if (decide (map_relation (≤)
-   (λ _, False) (λ _, True) (gmultiset_car X) (gmultiset_car Y))));
-   by rewrite gmultiset_subseteq_alt.
-Defined.
-
-Lemma gmultiset_subset_subseteq X Y : X ⊂ Y → X ⊆ Y.
-Proof. apply strict_include. Qed.
-Hint Resolve gmultiset_subset_subseteq.
-
-Lemma gmultiset_empty_subseteq X : ∅ ⊆ X.
-Proof. intros x. rewrite multiplicity_empty. omega. Qed.
-
-Lemma gmultiset_union_subseteq_l X Y : X ⊆ X ∪ Y.
-Proof. intros x. rewrite multiplicity_union. omega. Qed.
-Lemma gmultiset_union_subseteq_r X Y : Y ⊆ X ∪ Y.
-Proof. intros x. rewrite multiplicity_union. omega. Qed.
-Lemma gmultiset_union_preserving X1 X2 Y1 Y2 : X1 ⊆ X2 → Y1 ⊆ Y2 → X1 ∪ Y1 ⊆ X2 ∪ Y2.
-Proof. intros ?? x. rewrite !multiplicity_union. by apply Nat.add_le_mono. Qed.
-Lemma gmultiset_union_preserving_l X Y1 Y2 : Y1 ⊆ Y2 → X ∪ Y1 ⊆ X ∪ Y2.
-Proof. intros. by apply gmultiset_union_preserving. Qed.
-Lemma gmultiset_union_preserving_r X1 X2 Y : X1 ⊆ X2 → X1 ∪ Y ⊆ X2 ∪ Y.
-Proof. intros. by apply gmultiset_union_preserving. Qed.
-
-Lemma gmultiset_subset X Y : X ⊆ Y → size X < size Y → X ⊂ Y.
-Proof. intros. apply strict_spec_alt; split; naive_solver auto with omega. Qed.
-Lemma gmultiset_union_subset_l X Y : Y ≠ ∅ → X ⊂ X ∪ Y.
-Proof.
-  intros HY%gmultiset_size_non_empty_iff.
-  apply gmultiset_subset; auto using gmultiset_union_subseteq_l.
-  rewrite gmultiset_size_union; omega.
-Qed.
-Lemma gmultiset_union_subset_r X Y : X ≠ ∅ → Y ⊂ X ∪ Y.
-Proof. rewrite (comm_L (∪)). apply gmultiset_union_subset_l. Qed.
-
-Lemma gmultiset_elem_of_singleton_subseteq x X : x ∈ X ↔ {[ x ]} ⊆ X.
-Proof.
-  rewrite elem_of_multiplicity. split.
-  - intros Hx y; destruct (decide (x = y)) as [->|].
-    + rewrite multiplicity_singleton; omega.
-    + rewrite multiplicity_singleton_ne by done; omega.
-  - intros Hx. generalize (Hx x). rewrite multiplicity_singleton. omega.
-Qed.
-
-Lemma gmultiset_elem_of_subseteq X1 X2 x : x ∈ X1 → X1 ⊆ X2 → x ∈ X2.
-Proof. rewrite !gmultiset_elem_of_singleton_subseteq. by intros ->. Qed.
-
-Lemma gmultiset_union_difference X Y : X ⊆ Y → Y = X ∪ Y ∖ X.
-Proof.
-  intros HXY. apply gmultiset_eq; intros x; specialize (HXY x).
-  rewrite multiplicity_union, multiplicity_difference; omega.
-Qed.
-Lemma gmultiset_union_difference' x Y : x ∈ Y → Y = {[ x ]} ∪ Y ∖ {[ x ]}.
-Proof.
-  intros. by apply gmultiset_union_difference,
-    gmultiset_elem_of_singleton_subseteq.
-Qed.
-
-Lemma gmultiset_size_difference X Y : Y ⊆ X → size (X ∖ Y) = size X - size Y.
-Proof.
-  intros HX%gmultiset_union_difference.
-  rewrite HX at 2; rewrite gmultiset_size_union. omega.
-Qed.
-
-Lemma gmultiset_non_empty_difference X Y : X ⊂ Y → Y ∖ X ≠ ∅.
-Proof.
-  intros [_ HXY2] Hdiff; destruct HXY2; intros x.
-  generalize (f_equal (multiplicity x) Hdiff).
-  rewrite multiplicity_difference, multiplicity_empty; omega.
-Qed.
-
-Lemma gmultiset_difference_subset X Y : X ≠ ∅ → X ⊆ Y → Y ∖ X ⊂ Y.
-Proof.
-  intros. eapply strict_transitive_l; [by apply gmultiset_union_subset_r|].
-  by rewrite <-(gmultiset_union_difference X Y).
-Qed.
-
-(* Mononicity *)
-Lemma gmultiset_elements_submseteq X Y : X ⊆ Y → elements X ⊆+ elements Y.
-Proof.
-  intros ->%gmultiset_union_difference. rewrite gmultiset_elements_union.
-  by apply submseteq_inserts_r.
-Qed.
-
-Lemma gmultiset_subseteq_size X Y : X ⊆ Y → size X ≤ size Y.
-Proof. intros. by apply submseteq_length, gmultiset_elements_submseteq. Qed.
-
-Lemma gmultiset_subset_size X Y : X ⊂ Y → size X < size Y.
-Proof.
-  intros HXY. assert (size (Y ∖ X) ≠ 0).
-  { by apply gmultiset_size_non_empty_iff, gmultiset_non_empty_difference. }
-  rewrite (gmultiset_union_difference X Y), gmultiset_size_union by auto. lia.
-Qed.
-
-(* Well-foundedness *)
-Lemma gmultiset_wf : wf (strict (@subseteq (gmultiset A) _)).
-Proof.
-  apply (wf_projected (<) size); auto using gmultiset_subset_size, lt_wf.
-Qed.
-
-Lemma gmultiset_ind (P : gmultiset A → Prop) :
-  P ∅ → (∀ x X, P X → P ({[ x ]} ∪ X)) → ∀ X, P X.
-Proof.
-  intros Hemp Hinsert X. induction (gmultiset_wf X) as [X _ IH].
-  destruct (gmultiset_choose_or_empty X) as [[x Hx]| ->]; auto.
-  rewrite (gmultiset_union_difference' x X) by done.
-  apply Hinsert, IH, gmultiset_difference_subset,
-    gmultiset_elem_of_singleton_subseteq; auto using gmultiset_non_empty_singleton.
-Qed.
-End lemmas.

theories/listset_nodup.v

-(* Copyright (c) 2012-2017, Robbert Krebbers. *)
-(* This file is distributed under the terms of the BSD license. *)
-(** This file implements finite as unordered lists without duplicates.
-Although this implementation is slow, it is very useful as decidable equality
-is the only constraint on the carrier set. *)
-From stdpp Require Export collections list.
-Set Default Proof Using "Type".
-
-Record listset_nodup A := ListsetNoDup {
-  listset_nodup_car : list A; listset_nodup_prf : NoDup listset_nodup_car
-}.
-Arguments ListsetNoDup {_} _ _.
-Arguments listset_nodup_car {_} _.
-Arguments listset_nodup_prf {_} _.
-
-Section list_collection.
-Context `{EqDecision A}.
-Notation C := (listset_nodup A).
-
-Instance listset_nodup_elem_of: ElemOf A C := λ x l, x ∈ listset_nodup_car l.
-Instance listset_nodup_empty: Empty C := ListsetNoDup [] (@NoDup_nil_2 _).
-Instance listset_nodup_singleton: Singleton A C := λ x,
-  ListsetNoDup [x] (NoDup_singleton x).
-Instance listset_nodup_union: Union C := λ l k,
-  let (l',Hl) := l in let (k',Hk) := k
-  in ListsetNoDup _ (NoDup_list_union _ _ Hl Hk).
-Instance listset_nodup_intersection: Intersection C := λ l k,
-  let (l',Hl) := l in let (k',Hk) := k
-  in ListsetNoDup _ (NoDup_list_intersection _ k' Hl).
-Instance listset_nodup_difference: Difference C := λ l k,
-  let (l',Hl) := l in let (k',Hk) := k
-  in ListsetNoDup _ (NoDup_list_difference _ k' Hl).
-
-Instance: Collection A C.
-Proof.
-  split; [split | | ].
-  - by apply not_elem_of_nil.
-  - by apply elem_of_list_singleton.
-  - intros [??] [??] ?. apply elem_of_list_union.
-  - intros [??] [??] ?. apply elem_of_list_intersection.
-  - intros [??] [??] ?. apply elem_of_list_difference.
-Qed.
-
-Global Instance listset_nodup_elems: Elements A C := listset_nodup_car.
-Global Instance: FinCollection A C.
-Proof. split. apply _. done. by intros [??]. Qed.
-End list_collection.
-
-Hint Extern 1 (ElemOf _ (listset_nodup _)) =>
-  eapply @listset_nodup_elem_of : typeclass_instances.
-Hint Extern 1 (Empty (listset_nodup _)) =>
-  eapply @listset_nodup_empty : typeclass_instances.
-Hint Extern 1 (Singleton _ (listset_nodup _)) =>
-  eapply @listset_nodup_singleton : typeclass_instances.
-Hint Extern 1 (Union (listset_nodup _)) =>
-  eapply @listset_nodup_union : typeclass_instances.
-Hint Extern 1 (Intersection (listset_nodup _)) =>
-  eapply @listset_nodup_intersection : typeclass_instances.
-Hint Extern 1 (Difference (listset_nodup _)) =>
-  eapply @listset_nodup_difference : typeclass_instances.
-Hint Extern 1 (Elements _ (listset_nodup _)) =>
-  eapply @listset_nodup_elems : typeclass_instances.

theories/numbers.v

-(* Copyright (c) 2012-2017, Robbert Krebbers. *)
-(* This file is distributed under the terms of the BSD license. *)
-(** This file collects some trivial facts on the Coq types [nat] and [N] for
-natural numbers, and the type [Z] for integers. It also declares some useful
-notations. *)
-From Coq Require Export EqdepFacts PArith NArith ZArith NPeano.
-From Coq Require Import QArith Qcanon.
-From stdpp Require Export base decidable option.
-Set Default Proof Using "Type".
-Open Scope nat_scope.
-
-Coercion Z.of_nat : nat >-> Z.
-Instance comparison_eq_dec : EqDecision comparison.
-Proof. solve_decision. Defined.
-
-(** * Notations and properties of [nat] *)
-Arguments minus !_ !_ /.
-Reserved Notation "x ≤ y ≤ z" (at level 70, y at next level).
-Reserved Notation "x ≤ y < z" (at level 70, y at next level).
-Reserved Notation "x < y < z" (at level 70, y at next level).
-Reserved Notation "x < y ≤ z" (at level 70, y at next level).
-Reserved Notation "x ≤ y ≤ z ≤ z'"
-  (at level 70, y at next level, z at next level).
-
-Infix "≤" := le : nat_scope.
-Notation "x ≤ y ≤ z" := (x ≤ y ∧ y ≤ z)%nat : nat_scope.
-Notation "x ≤ y < z" := (x ≤ y ∧ y < z)%nat : nat_scope.
-Notation "x < y < z" := (x < y ∧ y < z)%nat : nat_scope.
-Notation "x < y ≤ z" := (x < y ∧ y ≤ z)%nat : nat_scope.
-Notation "x ≤ y ≤ z ≤ z'" := (x ≤ y ∧ y ≤ z ∧ z ≤ z')%nat : nat_scope.
-Notation "(≤)" := le (only parsing) : nat_scope.
-Notation "(<)" := lt (only parsing) : nat_scope.
-
-Infix "`div`" := Nat.div (at level 35) : nat_scope.
-Infix "`mod`" := Nat.modulo (at level 35) : nat_scope.
-Infix "`max`" := Nat.max (at level 35) : nat_scope.
-Infix "`min`" := Nat.min (at level 35) : nat_scope.
-
-Instance nat_eq_dec: EqDecision nat := eq_nat_dec.
-Instance nat_le_dec: ∀ x y : nat, Decision (x ≤ y) := le_dec.
-Instance nat_lt_dec: ∀ x y : nat, Decision (x < y) := lt_dec.
-Instance nat_inhabited: Inhabited nat := populate 0%nat.
-Instance S_inj: Inj (=) (=) S.
-Proof. by injection 1. Qed.
-Instance nat_le_po: PartialOrder (≤).
-Proof. repeat split; repeat intro; auto with lia. Qed.
-
-Instance nat_le_pi: ∀ x y : nat, ProofIrrel (x ≤ y).
-Proof.
-  assert (∀ x y (p : x ≤ y) y' (q : x ≤ y'),
-    y = y' → eq_dep nat (le x) y p y' q) as aux.
-  { fix 3. intros x ? [|y p] ? [|y' q].
-    - done.
-    - clear nat_le_pi. intros; exfalso; auto with lia.
-    - clear nat_le_pi. intros; exfalso; auto with lia.
-    - injection 1. intros Hy. by case (nat_le_pi x y p y' q Hy). }
-  intros x y p q.
-  by apply (Eqdep_dec.eq_dep_eq_dec (λ x y, decide (x = y))), aux.
-Qed.
-Instance nat_lt_pi: ∀ x y : nat, ProofIrrel (x < y).
-Proof. apply _. Qed.
-
-Definition sum_list_with {A} (f : A → nat) : list A → nat :=
-  fix go l :=
-  match l with
-  | [] => 0
-  | x :: l => f x + go l
-  end.
-Notation sum_list := (sum_list_with id).
-
-Lemma Nat_lt_succ_succ n : n < S (S n).
-Proof. auto with arith. Qed.
-Lemma Nat_mul_split_l n x1 x2 y1 y2 :
-  x2 < n → y2 < n → x1 * n + x2 = y1 * n + y2 → x1 = y1 ∧ x2 = y2.
-Proof.
-  intros Hx2 Hy2 E. cut (x1 = y1); [intros; subst;lia |].
-  revert y1 E. induction x1; simpl; intros [|?]; simpl; auto with lia.
-Qed.
-Lemma Nat_mul_split_r n x1 x2 y1 y2 :
-  x1 < n → y1 < n → x1 + x2 * n = y1 + y2 * n → x1 = y1 ∧ x2 = y2.
-Proof. intros. destruct (Nat_mul_split_l n x2 x1 y2 y1); auto with lia. Qed.
-
-Notation lcm := Nat.lcm.
-Notation divide := Nat.divide.
-Notation "( x | y )" := (divide x y) : nat_scope.
-Instance Nat_divide_dec x y : Decision (x | y).
-Proof.
-  refine (cast_if (decide (lcm x y = y))); by rewrite Nat.divide_lcm_iff.
-Defined.
-Instance: PartialOrder divide.
-Proof.
-  repeat split; try apply _. intros ??. apply Nat.divide_antisym_nonneg; lia.
-Qed.
-Hint Extern 0 (_ | _) => reflexivity.
-Lemma Nat_divide_ne_0 x y : (x | y) → y ≠ 0 → x ≠ 0.
-Proof. intros Hxy Hy ->. by apply Hy, Nat.divide_0_l. Qed.
-
-Lemma Nat_iter_S {A} n (f: A → A) x : Nat.iter (S n) f x = f (Nat.iter n f x).
-Proof. done. Qed.
-Lemma Nat_iter_S_r {A} n (f: A → A) x : Nat.iter (S n) f x = Nat.iter n f (f x).
-Proof. induction n; f_equal/=; auto. Qed.
-
-(** * Notations and properties of [positive] *)
-Open Scope positive_scope.
-
-Infix "≤" := Pos.le : positive_scope.
-Notation "x ≤ y ≤ z" := (x ≤ y ∧ y ≤ z) : positive_scope.
-Notation "x ≤ y < z" := (x ≤ y ∧ y < z) : positive_scope.
-Notation "x < y < z" := (x < y ∧ y < z) : positive_scope.
-Notation "x < y ≤ z" := (x < y ∧ y ≤ z) : positive_scope.
-Notation "x ≤ y ≤ z ≤ z'" := (x ≤ y ∧ y ≤ z ∧ z ≤ z') : positive_scope.
-Notation "(≤)" := Pos.le (only parsing) : positive_scope.
-Notation "(<)" := Pos.lt (only parsing) : positive_scope.
-Notation "(~0)" := xO (only parsing) : positive_scope.
-Notation "(~1)" := xI (only parsing) : positive_scope.
-
-Arguments Pos.of_nat : simpl never.
-Arguments Pmult : simpl never.
-
-Instance positive_eq_dec: EqDecision positive := Pos.eq_dec.
-Instance positive_inhabited: Inhabited positive := populate 1.
-
-Instance maybe_xO : Maybe xO := λ p, match p with p~0 => Some p | _ => None end.
-Instance maybe_x1 : Maybe xI := λ p, match p with p~1 => Some p | _ => None end.
-Instance: Inj (=) (=) (~0).
-Proof. by injection 1. Qed.
-Instance: Inj (=) (=) (~1).
-Proof. by injection 1. Qed.
-
-(** Since [positive] represents lists of bits, we define list operations
-on it. These operations are in reverse, as positives are treated as snoc
-lists instead of cons lists. *)
-Fixpoint Papp (p1 p2 : positive) : positive :=
-  match p2 with
-  | 1 => p1
-  | p2~0 => (Papp p1 p2)~0
-  | p2~1 => (Papp p1 p2)~1
-  end.
-Infix "++" := Papp : positive_scope.
-Notation "(++)" := Papp (only parsing) : positive_scope.
-Notation "( p ++)" := (Papp p) (only parsing) : positive_scope.
-Notation "(++ q )" := (λ p, Papp p q) (only parsing) : positive_scope.
-
-Fixpoint Preverse_go (p1 p2 : positive) : positive :=
-  match p2 with
-  | 1 => p1
-  | p2~0 => Preverse_go (p1~0) p2
-  | p2~1 => Preverse_go (p1~1) p2
-  end.
-Definition Preverse : positive → positive := Preverse_go 1.
-
-Global Instance: LeftId (=) 1 (++).
-Proof. intros p. by induction p; intros; f_equal/=. Qed.
-Global Instance: RightId (=) 1 (++).
-Proof. done. Qed.
-Global Instance: Assoc (=) (++).
-Proof. intros ?? p. by induction p; intros; f_equal/=. Qed.
-Global Instance: ∀ p : positive, Inj (=) (=) (++ p).
-Proof. intros p ???. induction p; simplify_eq; auto. Qed.
-
-Lemma Preverse_go_app p1 p2 p3 :
-  Preverse_go p1 (p2 ++ p3) = Preverse_go p1 p3 ++ Preverse_go 1 p2.
-Proof.
-  revert p3 p1 p2.
-  cut (∀ p1 p2 p3, Preverse_go (p2 ++ p3) p1 = p2 ++ Preverse_go p3 p1).
-  { by intros go p3; induction p3; intros p1 p2; simpl; auto; rewrite <-?go. }
-  intros p1; induction p1 as [p1 IH|p1 IH|]; intros p2 p3; simpl; auto.
-  - apply (IH _ (_~1)).
-  - apply (IH _ (_~0)).
-Qed.
-Lemma Preverse_app p1 p2 : Preverse (p1 ++ p2) = Preverse p2 ++ Preverse p1.
-Proof. unfold Preverse. by rewrite Preverse_go_app. Qed.
-Lemma Preverse_xO p : Preverse (p~0) = (1~0) ++ Preverse p.
-Proof Preverse_app p (1~0).
-Lemma Preverse_xI p : Preverse (p~1) = (1~1) ++ Preverse p.
-Proof Preverse_app p (1~1).
-
-Fixpoint Plength (p : positive) : nat :=
-  match p with 1 => 0%nat | p~0 | p~1 => S (Plength p) end.
-Lemma Papp_length p1 p2 : Plength (p1 ++ p2) = (Plength p2 + Plength p1)%nat.
-Proof. by induction p2; f_equal/=. Qed.
-
-Close Scope positive_scope.
-
-(** * Notations and properties of [N] *)
-Infix "≤" := N.le : N_scope.
-Notation "x ≤ y ≤ z" := (x ≤ y ∧ y ≤ z)%N : N_scope.
-Notation "x ≤ y < z" := (x ≤ y ∧ y < z)%N : N_scope.
-Notation "x < y < z" := (x < y ∧ y < z)%N : N_scope.
-Notation "x < y ≤ z" := (x < y ∧ y ≤ z)%N : N_scope.
-Notation "x ≤ y ≤ z ≤ z'" := (x ≤ y ∧ y ≤ z ∧ z ≤ z')%N : N_scope.
-Notation "(≤)" := N.le (only parsing) : N_scope.
-Notation "(<)" := N.lt (only parsing) : N_scope.
-Infix "`div`" := N.div (at level 35) : N_scope.
-Infix "`mod`" := N.modulo (at level 35) : N_scope.
-
-Arguments N.add _ _ : simpl never.
-
-Instance: Inj (=) (=) Npos.
-Proof. by injection 1. Qed.
-
-Instance N_eq_dec: EqDecision N := N.eq_dec.
-Program Instance N_le_dec (x y : N) : Decision (x ≤ y)%N :=
-  match Ncompare x y with Gt => right _ | _ => left _ end.
-Solve Obligations with naive_solver.
-Program Instance N_lt_dec (x y : N) : Decision (x < y)%N :=
-  match Ncompare x y with Lt => left _ | _ => right _ end.
-Solve Obligations with naive_solver.
-Instance N_inhabited: Inhabited N := populate 1%N.
-Instance N_le_po: PartialOrder (≤)%N.
-Proof.
-  repeat split; red. apply N.le_refl. apply N.le_trans. apply N.le_antisymm.
-Qed.
-Hint Extern 0 (_ ≤ _)%N => reflexivity.
-
-(** * Notations and properties of [Z] *)
-Open Scope Z_scope.
-
-Infix "≤" := Z.le : Z_scope.
-Notation "x ≤ y ≤ z" := (x ≤ y ∧ y ≤ z) : Z_scope.
-Notation "x ≤ y < z" := (x ≤ y ∧ y < z) : Z_scope.
-Notation "x < y < z" := (x < y ∧ y < z) : Z_scope.
-Notation "x < y ≤ z" := (x < y ∧ y ≤ z) : Z_scope.
-Notation "x ≤ y ≤ z ≤ z'" := (x ≤ y ∧ y ≤ z ∧ z ≤ z') : Z_scope.
-Notation "(≤)" := Z.le (only parsing) : Z_scope.
-Notation "(<)" := Z.lt (only parsing) : Z_scope.
-
-Infix "`div`" := Z.div (at level 35) : Z_scope.
-Infix "`mod`" := Z.modulo (at level 35) : Z_scope.
-Infix "`quot`" := Z.quot (at level 35) : Z_scope.
-Infix "`rem`" := Z.rem (at level 35) : Z_scope.
-Infix "≪" := Z.shiftl (at level 35) : Z_scope.
-Infix "≫" := Z.shiftr (at level 35) : Z_scope.
-
-Instance Zpos_inj : Inj (=) (=) Zpos.
-Proof. by injection 1. Qed.
-Instance Zneg_inj : Inj (=) (=) Zneg.
-Proof. by injection 1. Qed.
-
-Instance Z_of_nat_inj : Inj (=) (=) Z.of_nat.
-Proof. intros n1 n2. apply Nat2Z.inj. Qed.
-
-Instance Z_eq_dec: EqDecision Z := Z.eq_dec.
-Instance Z_le_dec: ∀ x y : Z, Decision (x ≤ y) := Z_le_dec.
-Instance Z_lt_dec: ∀ x y : Z, Decision (x < y) := Z_lt_dec.
-Instance Z_inhabited: Inhabited Z := populate 1.
-Instance Z_le_po : PartialOrder (≤).
-Proof.
-  repeat split; red. apply Z.le_refl. apply Z.le_trans. apply Z.le_antisymm.
-Qed.
-
-Lemma Z_pow_pred_r n m : 0 < m → n * n ^ (Z.pred m) = n ^ m.
-Proof.
-  intros. rewrite <-Z.pow_succ_r, Z.succ_pred. done. by apply Z.lt_le_pred.
-Qed.
-Lemma Z_quot_range_nonneg k x y : 0 ≤ x < k → 0 < y → 0 ≤ x `quot` y < k.
-Proof.
-  intros [??] ?.
-  destruct (decide (y = 1)); subst; [rewrite Z.quot_1_r; auto |].
-  destruct (decide (x = 0)); subst; [rewrite Z.quot_0_l; auto with lia |].
-  split. apply Z.quot_pos; lia. trans x; auto. apply Z.quot_lt; lia.
-Qed.
-
-(* Note that we cannot disable simpl for [Z.of_nat] as that would break
-tactics as [lia]. *)
-Arguments Z.to_nat _ : simpl never.
-Arguments Z.mul _ _ : simpl never.
-Arguments Z.add _ _ : simpl never.
-Arguments Z.opp _ : simpl never.
-Arguments Z.pow _ _ : simpl never.
-Arguments Z.div _ _ : simpl never.
-Arguments Z.modulo _ _ : simpl never.
-Arguments Z.quot _ _ : simpl never.
-Arguments Z.rem _ _ : simpl never.
-
-Lemma Z_to_nat_neq_0_pos x : Z.to_nat x ≠ 0%nat → 0 < x.
-Proof. by destruct x. Qed.
-Lemma Z_to_nat_neq_0_nonneg x : Z.to_nat x ≠ 0%nat → 0 ≤ x.
-Proof. by destruct x. Qed.
-Lemma Z_mod_pos x y : 0 < y → 0 ≤ x `mod` y.
-Proof. apply Z.mod_pos_bound. Qed.
-
-Hint Resolve Z.lt_le_incl : zpos.
-Hint Resolve Z.add_nonneg_pos Z.add_pos_nonneg Z.add_nonneg_nonneg : zpos.
-Hint Resolve Z.mul_nonneg_nonneg Z.mul_pos_pos : zpos.
-Hint Resolve Z.pow_pos_nonneg Z.pow_nonneg: zpos.
-Hint Resolve Z_mod_pos Z.div_pos : zpos.
-Hint Extern 1000 => lia : zpos.
-
-Lemma Z_to_nat_nonpos x : x ≤ 0 → Z.to_nat x = 0%nat.
-Proof. destruct x; simpl; auto using Z2Nat.inj_neg. by intros []. Qed.
-Lemma Z2Nat_inj_pow (x y : nat) : Z.of_nat (x ^ y) = x ^ y.
-Proof.
-  induction y as [|y IH]; [by rewrite Z.pow_0_r, Nat.pow_0_r|].
-  by rewrite Nat.pow_succ_r, Nat2Z.inj_succ, Z.pow_succ_r,
-    Nat2Z.inj_mul, IH by auto with zpos.
-Qed.
-Lemma Nat2Z_divide n m : (Z.of_nat n | Z.of_nat m) ↔ (n | m)%nat.
-Proof.
-  split.
-  - rewrite <-(Nat2Z.id m) at 2; intros [i ->]; exists (Z.to_nat i).
-    destruct (decide (0 ≤ i)%Z).
-    { by rewrite Z2Nat.inj_mul, Nat2Z.id by lia. }
-    by rewrite !Z_to_nat_nonpos by auto using Z.mul_nonpos_nonneg with lia.
-  - intros [i ->]. exists (Z.of_nat i). by rewrite Nat2Z.inj_mul.
-Qed.
-Lemma Z2Nat_divide n m :
-  0 ≤ n → 0 ≤ m → (Z.to_nat n | Z.to_nat m)%nat ↔ (n | m).
-Proof. intros. by rewrite <-Nat2Z_divide, !Z2Nat.id by done. Qed.
-Lemma Z2Nat_inj_div x y : Z.of_nat (x `div` y) = x `div` y.
-Proof.
-  destruct (decide (y = 0%nat)); [by subst; destruct x |].
-  apply Z.div_unique with (x `mod` y)%nat.
-  { left. rewrite <-(Nat2Z.inj_le 0), <-Nat2Z.inj_lt.
-    apply Nat.mod_bound_pos; lia. }
-  by rewrite <-Nat2Z.inj_mul, <-Nat2Z.inj_add, <-Nat.div_mod.
-Qed.
-Lemma Z2Nat_inj_mod x y : Z.of_nat (x `mod` y) = x `mod` y.
-Proof.
-  destruct (decide (y = 0%nat)); [by subst; destruct x |].
-  apply Z.mod_unique with (x `div` y)%nat.
-  { left. rewrite <-(Nat2Z.inj_le 0), <-Nat2Z.inj_lt.
-    apply Nat.mod_bound_pos; lia. }
-  by rewrite <-Nat2Z.inj_mul, <-Nat2Z.inj_add, <-Nat.div_mod.
-Qed.
-Close Scope Z_scope.
-
-(** * Notations and properties of [Qc] *)
-Open Scope Qc_scope.
-Delimit Scope Qc_scope with Qc.
-Notation "1" := (Q2Qc 1) : Qc_scope.
-Notation "2" := (1+1) : Qc_scope.
-Notation "- 1" := (Qcopp 1) : Qc_scope.
-Notation "- 2" := (Qcopp 2) : Qc_scope.
-Notation "x - y" := (x + -y) : Qc_scope.
-Notation "x / y" := (x * /y) : Qc_scope.
-Infix "≤" := Qcle : Qc_scope.
-Notation "x ≤ y ≤ z" := (x ≤ y ∧ y ≤ z) : Qc_scope.
-Notation "x ≤ y < z" := (x ≤ y ∧ y < z) : Qc_scope.
-Notation "x < y < z" := (x < y ∧ y < z) : Qc_scope.
-Notation "x < y ≤ z" := (x < y ∧ y ≤ z) : Qc_scope.
-Notation "x ≤ y ≤ z ≤ z'" := (x ≤ y ∧ y ≤ z ∧ z ≤ z') : Qc_scope.
-Notation "(≤)" := Qcle (only parsing) : Qc_scope.
-Notation "(<)" := Qclt (only parsing) : Qc_scope.
-
-Hint Extern 1 (_ ≤ _) => reflexivity || discriminate.
-Arguments Qred _ : simpl never.
-
-Instance Qc_eq_dec: EqDecision Qc := Qc_eq_dec.
-Program Instance Qc_le_dec (x y : Qc) : Decision (x ≤ y) :=
-  if Qclt_le_dec y x then right _ else left _.
-Next Obligation. intros x y; apply Qclt_not_le. Qed.
-Next Obligation. done. Qed.
-Program Instance Qc_lt_dec (x y : Qc) : Decision (x < y) :=
-  if Qclt_le_dec x y then left _ else right _.
-Solve Obligations with done.
-Next Obligation. intros x y; apply Qcle_not_lt. Qed.
-
-Instance: PartialOrder (≤).
-Proof.
-  repeat split; red. apply Qcle_refl. apply Qcle_trans. apply Qcle_antisym.
-Qed.
-Instance: StrictOrder (<).
-Proof.
-  split; red. intros x Hx. by destruct (Qclt_not_eq x x). apply Qclt_trans.
-Qed.
-Lemma Qcmult_0_l x : 0 * x = 0.
-Proof. ring. Qed.
-Lemma Qcmult_0_r x : x * 0 = 0.
-Proof. ring. Qed.
-Lemma Qcplus_diag x : (x + x)%Qc = (2 * x)%Qc.
-Proof. ring. Qed.
-Lemma Qcle_ngt (x y : Qc) : x ≤ y ↔ ¬y < x.
-Proof. split; auto using Qcle_not_lt, Qcnot_lt_le. Qed.
-Lemma Qclt_nge (x y : Qc) : x < y ↔ ¬y ≤ x.
-Proof. split; auto using Qclt_not_le, Qcnot_le_lt. Qed.
-Lemma Qcplus_le_mono_l (x y z : Qc) : x ≤ y ↔ z + x ≤ z + y.
-Proof.
-  split; intros.
-  - by apply Qcplus_le_compat.
-  - replace x with ((0 - z) + (z + x)) by ring.
-    replace y with ((0 - z) + (z + y)) by ring.
-    by apply Qcplus_le_compat.
-Qed.
-Lemma Qcplus_le_mono_r (x y z : Qc) : x ≤ y ↔ x + z ≤ y + z.
-Proof. rewrite !(Qcplus_comm _ z). apply Qcplus_le_mono_l. Qed.
-Lemma Qcplus_lt_mono_l (x y z : Qc) : x < y ↔ z + x < z + y.
-Proof. by rewrite !Qclt_nge, <-Qcplus_le_mono_l. Qed.
-Lemma Qcplus_lt_mono_r (x y z : Qc) : x < y ↔ x + z < y + z.
-Proof. by rewrite !Qclt_nge, <-Qcplus_le_mono_r. Qed.
-Instance: Inj (=) (=) Qcopp.
-Proof.
-  intros x y H. by rewrite <-(Qcopp_involutive x), H, Qcopp_involutive.
-Qed.
-Instance: ∀ z, Inj (=) (=) (Qcplus z).
-Proof.
-  intros z x y H. by apply (anti_symm (≤));
-    rewrite (Qcplus_le_mono_l _ _ z), H.
-Qed.
-Instance: ∀ z, Inj (=) (=) (λ x, x + z).
-Proof.
-  intros z x y H. by apply (anti_symm (≤));
-    rewrite (Qcplus_le_mono_r _ _ z), H.
-Qed.
-Lemma Qcplus_pos_nonneg (x y : Qc) : 0 < x → 0 ≤ y → 0 < x + y.
-Proof.
-  intros. apply Qclt_le_trans with (x + 0); [by rewrite Qcplus_0_r|].
-  by apply Qcplus_le_mono_l.
-Qed.
-Lemma Qcplus_nonneg_pos (x y : Qc) : 0 ≤ x → 0 < y → 0 < x + y.
-Proof. rewrite (Qcplus_comm x). auto using Qcplus_pos_nonneg. Qed. 
-Lemma Qcplus_pos_pos (x y : Qc) : 0 < x → 0 < y → 0 < x + y.
-Proof. auto using Qcplus_pos_nonneg, Qclt_le_weak. Qed.
-Lemma Qcplus_nonneg_nonneg (x y : Qc) : 0 ≤ x → 0 ≤ y → 0 ≤ x + y.
-Proof.
-  intros. trans (x + 0); [by rewrite Qcplus_0_r|].
-  by apply Qcplus_le_mono_l.
-Qed.
-Lemma Qcplus_neg_nonpos (x y : Qc) : x < 0 → y ≤ 0 → x + y < 0.
-Proof.
-  intros. apply Qcle_lt_trans with (x + 0); [|by rewrite Qcplus_0_r].
-  by apply Qcplus_le_mono_l.
-Qed.
-Lemma Qcplus_nonpos_neg (x y : Qc) : x ≤ 0 → y < 0 → x + y < 0.
-Proof. rewrite (Qcplus_comm x). auto using Qcplus_neg_nonpos. Qed.
-Lemma Qcplus_neg_neg (x y : Qc) : x < 0 → y < 0 → x + y < 0.
-Proof. auto using Qcplus_nonpos_neg, Qclt_le_weak. Qed.
-Lemma Qcplus_nonpos_nonpos (x y : Qc) : x ≤ 0 → y ≤ 0 → x + y ≤ 0.
-Proof.
-  intros. trans (x + 0); [|by rewrite Qcplus_0_r].
-  by apply Qcplus_le_mono_l.
-Qed.
-Lemma Qcmult_le_mono_nonneg_l x y z : 0 ≤ z → x ≤ y → z * x ≤ z * y.
-Proof. intros. rewrite !(Qcmult_comm z). by apply Qcmult_le_compat_r. Qed.
-Lemma Qcmult_le_mono_nonneg_r x y z : 0 ≤ z → x ≤ y → x * z ≤ y * z.
-Proof. intros. by apply Qcmult_le_compat_r. Qed.
-Lemma Qcmult_le_mono_pos_l x y z : 0 < z → x ≤ y ↔ z * x ≤ z * y.
-Proof.
-  split; auto using Qcmult_le_mono_nonneg_l, Qclt_le_weak.
-  rewrite !Qcle_ngt, !(Qcmult_comm z).
-  intuition auto using Qcmult_lt_compat_r.
-Qed.
-Lemma Qcmult_le_mono_pos_r x y z : 0 < z → x ≤ y ↔ x * z ≤ y * z.
-Proof. rewrite !(Qcmult_comm _ z). by apply Qcmult_le_mono_pos_l. Qed.
-Lemma Qcmult_lt_mono_pos_l x y z : 0 < z → x < y ↔ z * x < z * y.
-Proof. intros. by rewrite !Qclt_nge, <-Qcmult_le_mono_pos_l. Qed.
-Lemma Qcmult_lt_mono_pos_r x y z : 0 < z → x < y ↔ x * z < y * z.
-Proof. intros. by rewrite !Qclt_nge, <-Qcmult_le_mono_pos_r. Qed.
-Lemma Qcmult_pos_pos x y : 0 < x → 0 < y → 0 < x * y.
-Proof.
-  intros. apply Qcle_lt_trans with (0 * y); [by rewrite Qcmult_0_l|].
-  by apply Qcmult_lt_mono_pos_r.
-Qed.
-Lemma Qcmult_nonneg_nonneg x y : 0 ≤ x → 0 ≤ y → 0 ≤ x * y.
-Proof.
-  intros. trans (0 * y); [by rewrite Qcmult_0_l|].
-  by apply Qcmult_le_mono_nonneg_r.
-Qed.
-
-Lemma inject_Z_Qred n : Qred (inject_Z n) = inject_Z n.
-Proof. apply Qred_identity; auto using Z.gcd_1_r. Qed.
-Coercion Qc_of_Z (n : Z) : Qc := Qcmake _ (inject_Z_Qred n).
-Lemma Z2Qc_inj_0 : Qc_of_Z 0 = 0.
-Proof. by apply Qc_is_canon. Qed.
-Lemma Z2Qc_inj_1 : Qc_of_Z 1 = 1.
-Proof. by apply Qc_is_canon. Qed.
-Lemma Z2Qc_inj_2 : Qc_of_Z 2 = 2.
-Proof. by apply Qc_is_canon. Qed.
-Lemma Z2Qc_inj n m : Qc_of_Z n = Qc_of_Z m → n = m.
-Proof. by injection 1. Qed.
-Lemma Z2Qc_inj_iff n m : Qc_of_Z n = Qc_of_Z m ↔ n = m.
-Proof. split. auto using Z2Qc_inj. by intros ->. Qed.
-Lemma Z2Qc_inj_le n m : (n ≤ m)%Z ↔ Qc_of_Z n ≤ Qc_of_Z m.
-Proof. by rewrite Zle_Qle. Qed.
-Lemma Z2Qc_inj_lt n m : (n < m)%Z ↔ Qc_of_Z n < Qc_of_Z m.
-Proof. by rewrite Zlt_Qlt. Qed.
-Lemma Z2Qc_inj_add n m : Qc_of_Z (n + m) = Qc_of_Z n + Qc_of_Z m.
-Proof. apply Qc_is_canon; simpl. by rewrite Qred_correct, inject_Z_plus. Qed.
-Lemma Z2Qc_inj_mul n m : Qc_of_Z (n * m) = Qc_of_Z n * Qc_of_Z m.
-Proof. apply Qc_is_canon; simpl. by rewrite Qred_correct, inject_Z_mult. Qed.
-Lemma Z2Qc_inj_opp n : Qc_of_Z (-n) = -Qc_of_Z n.
-Proof. apply Qc_is_canon; simpl. by rewrite Qred_correct, inject_Z_opp. Qed.
-Lemma Z2Qc_inj_sub n m : Qc_of_Z (n - m) = Qc_of_Z n - Qc_of_Z m.
-Proof.
-  apply Qc_is_canon; simpl.
-  by rewrite !Qred_correct, <-inject_Z_opp, <-inject_Z_plus.
-Qed.
-Close Scope Qc_scope.
-
-(** * Positive rationals *)
-(** The theory of positive rationals is very incomplete. We merely provide
-some operations and theorems that are relevant for fractional permissions. *)
-Record Qp := mk_Qp { Qp_car :> Qc ; Qp_prf : (0 < Qp_car)%Qc }.
-Hint Resolve Qp_prf.
-Delimit Scope Qp_scope with Qp.
-Bind Scope Qp_scope with Qp.
-Arguments Qp_car _%Qp.
-
-Definition Qp_one : Qp := mk_Qp 1 eq_refl.
-Program Definition Qp_plus (x y : Qp) : Qp := mk_Qp (x + y) _.
-Next Obligation. by intros x y; apply Qcplus_pos_pos. Qed.
-Definition Qp_minus (x y : Qp) : option Qp :=
-  let z := (x - y)%Qc in
-  match decide (0 < z)%Qc with left Hz => Some (mk_Qp z Hz) | _ => None end.
-Program Definition Qp_mult (x y : Qp) : Qp := mk_Qp (x * y) _.
-Next Obligation. intros x y. apply Qcmult_pos_pos; apply Qp_prf. Qed.
-Program Definition Qp_div (x : Qp) (y : positive) : Qp := mk_Qp (x / ('y)%Z) _.  
-Next Obligation.
-  intros x y. assert (0 < ('y)%Z)%Qc.
-  { apply (Z2Qc_inj_lt 0%Z (' y)), Pos2Z.is_pos. }
-  by rewrite (Qcmult_lt_mono_pos_r _ _ ('y)%Z), Qcmult_0_l,
-    <-Qcmult_assoc, Qcmult_inv_l, Qcmult_1_r.
-Qed.
-
-Notation "1" := Qp_one : Qp_scope.
-Infix "+" := Qp_plus : Qp_scope.
-Infix "-" := Qp_minus : Qp_scope.
-Infix "*" := Qp_mult : Qp_scope.
-Infix "/" := Qp_div : Qp_scope.
-
-Lemma Qp_eq x y : x = y ↔ Qp_car x = Qp_car y.
-Proof.
-  split; [by intros ->|].
-  destruct x, y; intros; simplify_eq/=; f_equal; apply (proof_irrel _).
-Qed.
-
-Instance Qp_inhabited : Inhabited Qp := populate 1%Qp.
-Instance Qp_eq_dec : EqDecision Qp.
-Proof.
- refine (λ x y, cast_if (decide (Qp_car x = Qp_car y))); by rewrite Qp_eq.
-Defined.
-
-Instance Qp_plus_assoc : Assoc (=) Qp_plus.
-Proof. intros x y z; apply Qp_eq, Qcplus_assoc. Qed.
-Instance Qp_plus_comm : Comm (=) Qp_plus.
-Proof. intros x y; apply Qp_eq, Qcplus_comm. Qed.
-
-Lemma Qp_minus_diag x : (x - x)%Qp = None.
-Proof. unfold Qp_minus. by rewrite Qcplus_opp_r. Qed.
-Lemma Qp_op_minus x y : ((x + y) - x)%Qp = Some y.
-Proof.
-  unfold Qp_minus; simpl.
-  rewrite (Qcplus_comm x), <- Qcplus_assoc, Qcplus_opp_r, Qcplus_0_r.
-  destruct (decide _) as [|[]]; auto. by f_equal; apply Qp_eq.
-Qed.
-
-Instance Qp_mult_assoc : Assoc (=) Qp_mult.
-Proof. intros x y z; apply Qp_eq, Qcmult_assoc. Qed.
-Instance Qp_mult_comm : Comm (=) Qp_mult.
-Proof. intros x y; apply Qp_eq, Qcmult_comm. Qed.
-Lemma Qp_mult_plus_distr_r x y z: (x * (y + z) = x * y + x * z)%Qp.
-Proof. apply Qp_eq, Qcmult_plus_distr_r. Qed.
-Lemma Qp_mult_plus_distr_l x y z: ((x + y) * z = x * z + y * z)%Qp.
-Proof. apply Qp_eq, Qcmult_plus_distr_l. Qed.
-Lemma Qp_mult_1_l x: (1 * x)%Qp = x.
-Proof. apply Qp_eq, Qcmult_1_l. Qed.
-Lemma Qp_mult_1_r x: (x * 1)%Qp = x.
-Proof. apply Qp_eq, Qcmult_1_r. Qed.
-
-Lemma Qp_div_1 x : (x / 1 = x)%Qp.
-Proof.
-  apply Qp_eq; simpl.
-  rewrite <-(Qcmult_div_r x 1) at 2 by done. by rewrite Qcmult_1_l.
-Qed.
-Lemma Qp_div_S x y : (x / (2 * y) + x / (2 * y) = x / y)%Qp.
-Proof.
-  apply Qp_eq; simpl.
-  rewrite <-Qcmult_plus_distr_l, Pos2Z.inj_mul, Z2Qc_inj_mul, Z2Qc_inj_2.
-  rewrite Qcplus_diag. by field_simplify.
-Qed.
-Lemma Qp_div_2 x : (x / 2 + x / 2 = x)%Qp.
-Proof.
-  change 2%positive with (2 * 1)%positive. by rewrite Qp_div_S, Qp_div_1.
-Qed.
-
-Lemma Qp_lower_bound q1 q2 : ∃ q q1' q2', (q1 = q + q1' ∧ q2 = q + q2')%Qp.
-Proof.
-  revert q1 q2. cut (∀ q1 q2 : Qp, (q1 ≤ q2)%Qc →
-    ∃ q q1' q2', (q1 = q + q1' ∧ q2 = q + q2')%Qp).
-  { intros help q1 q2.
-    destruct (Qc_le_dec q1 q2) as [LE|LE%Qclt_nge%Qclt_le_weak]; [by eauto|].
-    destruct (help q2 q1) as (q&q1'&q2'&?&?); eauto. }
-  intros q1 q2 Hq. exists (q1 / 2)%Qp, (q1 / 2)%Qp.
-  assert (0 < q2 - q1 / 2)%Qc as Hq2'.
-  { eapply Qclt_le_trans; [|by apply Qcplus_le_mono_r, Hq].
-    replace (q1 - q1 / 2)%Qc with (q1 * (1 - 1/2))%Qc by ring.
-    replace 0%Qc with (0 * (1-1/2))%Qc by ring. by apply Qcmult_lt_compat_r. }
-  exists (mk_Qp (q2 - q1 / 2%Z) Hq2'). split; [by rewrite Qp_div_2|].
-  apply Qp_eq; simpl. ring.
-Qed.
-
-Lemma Qp_not_plus_q_ge_1 (q: Qp): ¬ ((1 + q)%Qp ≤ 1%Qp)%Qc.
-Proof.
-  intros Hle.
-  apply (Qcplus_le_mono_l q 0 1) in Hle.
-  apply Qcle_ngt in Hle. apply Hle, Qp_prf.
-Qed.
-
-Lemma Qp_ge_0 (q: Qp): (0 ≤ q)%Qc.
-Proof. apply Qclt_le_weak, Qp_prf. Qed.

theories/pmap.v

-(* Copyright (c) 2012-2017, Robbert Krebbers. *)
-(* This file is distributed under the terms of the BSD license. *)
-(** This files implements an efficient implementation of finite maps whose keys
-range over Coq's data type of positive binary naturals [positive]. The
-implementation is based on Xavier Leroy's implementation of radix-2 search
-trees (uncompressed Patricia trees) and guarantees logarithmic-time operations.
-However, we extend Leroy's implementation by packing the trees into a Sigma
-type such that canonicity of representation is ensured. This is necesarry for
-Leibniz equality to become extensional. *)
-From Coq Require Import PArith.
-From stdpp Require Import mapset countable.
-From stdpp Require Export fin_maps.
-Set Default Proof Using "Type".
-
-Local Open Scope positive_scope.
-Local Hint Extern 0 (@eq positive _ _) => congruence.
-Local Hint Extern 0 (¬@eq positive _ _) => congruence.
-
-(** * The tree data structure *)
-(** The data type [Pmap_raw] specifies radix-2 search trees. These trees do
-not ensure canonical representations of maps. For example the empty map can
-be represented as a binary tree of an arbitrary size that contains [None] at
-all nodes. *)
-Inductive Pmap_raw (A : Type) : Type :=
-  | PLeaf: Pmap_raw A
-  | PNode: option A → Pmap_raw A → Pmap_raw A → Pmap_raw A.
-Arguments PLeaf {_}.
-Arguments PNode {_} _ _ _.
-
-Instance Pmap_raw_eq_dec `{EqDecision A} : EqDecision (Pmap_raw A).
-Proof. solve_decision. Defined.
-
-Fixpoint Pmap_wf {A} (t : Pmap_raw A) : bool :=
-  match t with
-  | PLeaf => true
-  | PNode None PLeaf PLeaf => false
-  | PNode _ l r => Pmap_wf l && Pmap_wf r
-  end.
-Arguments Pmap_wf _ !_ / : simpl nomatch.
-Lemma Pmap_wf_l {A} o (l r : Pmap_raw A) : Pmap_wf (PNode o l r) → Pmap_wf l.
-Proof. destruct o, l, r; simpl; rewrite ?andb_True; tauto. Qed.
-Lemma Pmap_wf_r {A} o (l r : Pmap_raw A) : Pmap_wf (PNode o l r) → Pmap_wf r.
-Proof. destruct o, l, r; simpl; rewrite ?andb_True; tauto. Qed.
-Local Hint Immediate Pmap_wf_l Pmap_wf_r.
-Definition PNode' {A} (o : option A) (l r : Pmap_raw A) :=
-  match l, o, r with PLeaf, None, PLeaf => PLeaf | _, _, _ => PNode o l r end.
-Arguments PNode' _ _ _ _ : simpl never.
-Lemma PNode_wf {A} o (l r : Pmap_raw A) :
-  Pmap_wf l → Pmap_wf r → Pmap_wf (PNode' o l r).
-Proof. destruct o, l, r; simpl; auto. Qed.
-Local Hint Resolve PNode_wf.
-
-(** Operations *)
-Instance Pempty_raw {A} : Empty (Pmap_raw A) := PLeaf.
-Instance Plookup_raw {A} : Lookup positive A (Pmap_raw A) :=
-  fix go (i : positive) (t : Pmap_raw A) {struct t} : option A :=
-  let _ : Lookup _ _ _ := @go in
-  match t with
-  | PLeaf => None
-  | PNode o l r => match i with 1 => o | i~0 => l !! i | i~1 => r !! i end
-  end.
-Local Arguments lookup _ _ _ _ _ !_ / : simpl nomatch.
-Fixpoint Psingleton_raw {A} (i : positive) (x : A) : Pmap_raw A :=
-  match i with
-  | 1 => PNode (Some x) PLeaf PLeaf
-  | i~0 => PNode None (Psingleton_raw i x) PLeaf
-  | i~1 => PNode None PLeaf (Psingleton_raw i x)
-  end.
-Fixpoint Ppartial_alter_raw {A} (f : option A → option A)
-    (i : positive) (t : Pmap_raw A) {struct t} : Pmap_raw A :=
-  match t with
-  | PLeaf => match f None with None => PLeaf | Some x => Psingleton_raw i x end
-  | PNode o l r =>
-     match i with
-     | 1 => PNode' (f o) l r
-     | i~0 => PNode' o (Ppartial_alter_raw f i l) r
-     | i~1 => PNode' o l (Ppartial_alter_raw f i r)
-     end
-  end.
-Fixpoint Pfmap_raw {A B} (f : A → B) (t : Pmap_raw A) : Pmap_raw B :=
-  match t with
-  | PLeaf => PLeaf
-  | PNode o l r => PNode (f <$> o) (Pfmap_raw f l) (Pfmap_raw f r)
-  end.
-Fixpoint Pto_list_raw {A} (j : positive) (t : Pmap_raw A)
-    (acc : list (positive * A)) : list (positive * A) :=
-  match t with
-  | PLeaf => acc
-  | PNode o l r => default [] o (λ x, [(Preverse j, x)]) ++
-     Pto_list_raw (j~0) l (Pto_list_raw (j~1) r acc)
-  end%list.
-Fixpoint Pomap_raw {A B} (f : A → option B) (t : Pmap_raw A) : Pmap_raw B :=
-  match t with
-  | PLeaf => PLeaf
-  | PNode o l r => PNode' (o ≫= f) (Pomap_raw f l) (Pomap_raw f r)
-  end.
-Fixpoint Pmerge_raw {A B C} (f : option A → option B → option C)
-    (t1 : Pmap_raw A) (t2 : Pmap_raw B) : Pmap_raw C :=
-  match t1, t2 with
-  | PLeaf, t2 => Pomap_raw (f None ∘ Some) t2
-  | t1, PLeaf => Pomap_raw (flip f None ∘ Some) t1
-  | PNode o1 l1 r1, PNode o2 l2 r2 =>
-      PNode' (f o1 o2) (Pmerge_raw f l1 l2) (Pmerge_raw f r1 r2)
-  end.
-
-(** Proofs *)
-Lemma Pmap_wf_canon {A} (t : Pmap_raw A) :
-  (∀ i, t !! i = None) → Pmap_wf t → t = PLeaf.
-Proof.
-  induction t as [|o l IHl r IHr]; intros Ht ?; auto.
-  assert (o = None) as -> by (apply (Ht 1)).
-  assert (l = PLeaf) as -> by (apply IHl; try apply (λ i, Ht (i~0)); eauto).
-  by assert (r = PLeaf) as -> by (apply IHr; try apply (λ i, Ht (i~1)); eauto).
-Qed.
-Lemma Pmap_wf_eq {A} (t1 t2 : Pmap_raw A) :
-  (∀ i, t1 !! i = t2 !! i) → Pmap_wf t1 → Pmap_wf t2 → t1 = t2.
-Proof.
-  revert t2.
-  induction t1 as [|o1 l1 IHl r1 IHr]; intros [|o2 l2 r2] Ht ??; simpl; auto.
-  - discriminate (Pmap_wf_canon (PNode o2 l2 r2)); eauto.
-  - discriminate (Pmap_wf_canon (PNode o1 l1 r1)); eauto.
-  - f_equal; [apply (Ht 1)| |].
-    + apply IHl; try apply (λ x, Ht (x~0)); eauto.
-    + apply IHr; try apply (λ x, Ht (x~1)); eauto.
-Qed.
-Lemma PNode_lookup {A} o (l r : Pmap_raw A) i :
-  PNode' o l r !! i = PNode o l r !! i.
-Proof. by destruct i, o, l, r. Qed.
-
-Lemma Psingleton_wf {A} i (x : A) : Pmap_wf (Psingleton_raw i x).
-Proof. induction i as [[]|[]|]; simpl; rewrite ?andb_true_r; auto. Qed.
-Lemma Ppartial_alter_wf {A} f i (t : Pmap_raw A) :
-  Pmap_wf t → Pmap_wf (Ppartial_alter_raw f i t).
-Proof.
-  revert i; induction t as [|o l IHl r IHr]; intros i ?; simpl.
-  - destruct (f None); auto using Psingleton_wf.
-  - destruct i; simpl; eauto.
-Qed.
-Lemma Pfmap_wf {A B} (f : A → B) t : Pmap_wf t → Pmap_wf (Pfmap_raw f t).
-Proof.
-  induction t as [|[x|] [] ? [] ?]; simpl in *; rewrite ?andb_True; intuition.
-Qed.
-Lemma Pomap_wf {A B} (f : A → option B) t : Pmap_wf t → Pmap_wf (Pomap_raw f t).
-Proof. induction t; simpl; eauto. Qed.
-Lemma Pmerge_wf {A B C} (f : option A → option B → option C) t1 t2 :
-  Pmap_wf t1 → Pmap_wf t2 → Pmap_wf (Pmerge_raw f t1 t2).
-Proof. revert t2. induction t1; intros []; simpl; eauto using Pomap_wf. Qed.
-
-Lemma Plookup_empty {A} i : (∅ : Pmap_raw A) !! i = None.
-Proof. by destruct i. Qed.
-Lemma Plookup_singleton {A} i (x : A) : Psingleton_raw i x !! i = Some x.
-Proof. by induction i. Qed.
-Lemma Plookup_singleton_ne {A} i j (x : A) :
-  i ≠ j → Psingleton_raw i x !! j = None.
-Proof. revert j. induction i; intros [?|?|]; simpl; auto with congruence. Qed.
-Lemma Plookup_alter {A} f i (t : Pmap_raw A) :
-  Ppartial_alter_raw f i t !! i = f (t !! i).
-Proof.
-  revert i; induction t as [|o l IHl r IHr]; intros i; simpl.
-  - by destruct (f None); rewrite ?Plookup_singleton.
-  - destruct i; simpl; rewrite PNode_lookup; simpl; auto.
-Qed.
-Lemma Plookup_alter_ne {A} f i j (t : Pmap_raw A) :
-  i ≠ j → Ppartial_alter_raw f i t !! j = t !! j.
-Proof.
-  revert i j; induction t as [|o l IHl r IHr]; simpl.
-  - by intros; destruct (f None); rewrite ?Plookup_singleton_ne.
-  - by intros [?|?|] [?|?|] ?; simpl; rewrite ?PNode_lookup; simpl; auto.
-Qed.
-Lemma Plookup_fmap {A B} (f : A → B) t i : (Pfmap_raw f t) !! i = f <$> t !! i.
-Proof. revert i. by induction t; intros [?|?|]; simpl. Qed.
-Lemma Pelem_of_to_list {A} (t : Pmap_raw A) j i acc x :
-  (i,x) ∈ Pto_list_raw j t acc ↔
-    (∃ i', i = i' ++ Preverse j ∧ t !! i' = Some x) ∨ (i,x) ∈ acc.
-Proof.
-  split.
-  { revert j acc. induction t as [|[y|] l IHl r IHr]; intros j acc; simpl.
-    - by right.
-    - rewrite elem_of_cons. intros [?|?]; simplify_eq.
-      { left; exists 1. by rewrite (left_id_L 1 (++))%positive. }
-      destruct (IHl (j~0) (Pto_list_raw j~1 r acc)) as [(i'&->&?)|?]; auto.
-      { left; exists (i' ~ 0). by rewrite Preverse_xO, (assoc_L _). }
-      destruct (IHr (j~1) acc) as [(i'&->&?)|?]; auto.
-      left; exists (i' ~ 1). by rewrite Preverse_xI, (assoc_L _).
-    - intros.
-      destruct (IHl (j~0) (Pto_list_raw j~1 r acc)) as [(i'&->&?)|?]; auto.
-      { left; exists (i' ~ 0). by rewrite Preverse_xO, (assoc_L _). }
-      destruct (IHr (j~1) acc) as [(i'&->&?)|?]; auto.
-      left; exists (i' ~ 1). by rewrite Preverse_xI, (assoc_L _). }
-  revert t j i acc. assert (∀ t j i acc,
-    (i, x) ∈ acc → (i, x) ∈ Pto_list_raw j t acc) as help.
-  { intros t; induction t as [|[y|] l IHl r IHr]; intros j i acc;
-      simpl; rewrite ?elem_of_cons; auto. }
-  intros t j ? acc [(i&->&Hi)|?]; [|by auto]. revert j i acc Hi.
-  induction t as [|[y|] l IHl r IHr]; intros j i acc ?; simpl.
-  - done.
-  - rewrite elem_of_cons. destruct i as [i|i|]; simplify_eq/=.
-    + right. apply help. specialize (IHr (j~1) i).
-      rewrite Preverse_xI, (assoc_L _) in IHr. by apply IHr.
-    + right. specialize (IHl (j~0) i).
-      rewrite Preverse_xO, (assoc_L _) in IHl. by apply IHl.
-    + left. by rewrite (left_id_L 1 (++))%positive.
-  - destruct i as [i|i|]; simplify_eq/=.
-    + apply help. specialize (IHr (j~1) i).
-      rewrite Preverse_xI, (assoc_L _) in IHr. by apply IHr.
-    + specialize (IHl (j~0) i).
-      rewrite Preverse_xO, (assoc_L _) in IHl. by apply IHl.
-Qed.
-Lemma Pto_list_nodup {A} j (t : Pmap_raw A) acc :
-  (∀ i x, (i ++ Preverse j, x) ∈ acc → t !! i = None) →
-  NoDup acc → NoDup (Pto_list_raw j t acc).
-Proof.
-  revert j acc. induction t as [|[y|] l IHl r IHr]; simpl; intros j acc Hin ?.
-  - done.
-  - repeat constructor.
-    { rewrite Pelem_of_to_list. intros [(i&Hi&?)|Hj].
-      { apply (f_equal Plength) in Hi.
-        rewrite Preverse_xO, !Papp_length in Hi; simpl in *; lia. }
-      rewrite Pelem_of_to_list in Hj. destruct Hj as [(i&Hi&?)|Hj].
-      { apply (f_equal Plength) in Hi.
-        rewrite Preverse_xI, !Papp_length in Hi; simpl in *; lia. }
-      specialize (Hin 1 y). rewrite (left_id_L 1 (++))%positive in Hin.
-      discriminate (Hin Hj). }
-    apply IHl.
-    { intros i x. rewrite Pelem_of_to_list. intros [(?&Hi&?)|Hi].
-      + rewrite Preverse_xO, Preverse_xI, !(assoc_L _) in Hi.
-        by apply (inj (++ _)) in Hi.
-      + apply (Hin (i~0) x). by rewrite Preverse_xO, (assoc_L _) in Hi. }
-    apply IHr; auto. intros i x Hi.
-    apply (Hin (i~1) x). by rewrite Preverse_xI, (assoc_L _) in Hi.
-  - apply IHl.
-    { intros i x. rewrite Pelem_of_to_list. intros [(?&Hi&?)|Hi].
-      + rewrite Preverse_xO, Preverse_xI, !(assoc_L _) in Hi.
-        by apply (inj (++ _)) in Hi.
-      + apply (Hin (i~0) x). by rewrite Preverse_xO, (assoc_L _) in Hi. }
-    apply IHr; auto. intros i x Hi.
-    apply (Hin (i~1) x). by rewrite Preverse_xI, (assoc_L _) in Hi.
-Qed.
-Lemma Pomap_lookup {A B} (f : A → option B) t i :
-  Pomap_raw f t !! i = t !! i ≫= f.
-Proof.
-  revert i. induction t as [|o l IHl r IHr]; intros [i|i|]; simpl;
-    rewrite ?PNode_lookup; simpl; auto.
-Qed.
-Lemma Pmerge_lookup {A B C} (f : option A → option B → option C)
-    (Hf : f None None = None) t1 t2 i :
-  Pmerge_raw f t1 t2 !! i = f (t1 !! i) (t2 !! i).
-Proof.
-  revert t2 i; induction t1 as [|o1 l1 IHl1 r1 IHr1]; intros t2 i; simpl.
-  { rewrite Pomap_lookup. by destruct (t2 !! i). }
-  unfold compose, flip.
-  destruct t2 as [|l2 o2 r2]; rewrite PNode_lookup.
-  - by destruct i; rewrite ?Pomap_lookup; simpl; rewrite ?Pomap_lookup;
-      match goal with |- ?o ≫= _ = _ => destruct o end.
-  - destruct i; rewrite ?Pomap_lookup; simpl; auto.
-Qed.
-
-(** Packed version and instance of the finite map type class *)
-Inductive Pmap (A : Type) : Type :=
-  PMap { pmap_car : Pmap_raw A; pmap_prf : Pmap_wf pmap_car }.
-Arguments PMap {_} _ _.
-Arguments pmap_car {_} _.
-Arguments pmap_prf {_} _.
-Lemma Pmap_eq {A} (m1 m2 : Pmap A) : m1 = m2 ↔ pmap_car m1 = pmap_car m2.
-Proof.
-  split; [by intros ->|intros]; destruct m1 as [t1 ?], m2 as [t2 ?].
-  simplify_eq/=; f_equal; apply proof_irrel.
-Qed.
-Instance Pmap_eq_dec `{EqDecision A} : EqDecision (Pmap A) := λ m1 m2,
-  match Pmap_raw_eq_dec (pmap_car m1) (pmap_car m2) with
-  | left H => left (proj2 (Pmap_eq m1 m2) H)
-  | right H => right (H ∘ proj1 (Pmap_eq m1 m2))
-  end.
-Instance Pempty {A} : Empty (Pmap A) := PMap ∅ I.
-Instance Plookup {A} : Lookup positive A (Pmap A) := λ i m, pmap_car m !! i.
-Instance Ppartial_alter {A} : PartialAlter positive A (Pmap A) := λ f i m,
-  let (t,Ht) := m in PMap (partial_alter f i t) (Ppartial_alter_wf f i _ Ht).
-Instance Pfmap : FMap Pmap := λ A B f m,
-  let (t,Ht) := m in PMap (f <$> t) (Pfmap_wf f _ Ht).
-Instance Pto_list {A} : FinMapToList positive A (Pmap A) := λ m,
-  let (t,Ht) := m in Pto_list_raw 1 t [].
-Instance Pomap : OMap Pmap := λ A B f m,
-  let (t,Ht) := m in PMap (omap f t) (Pomap_wf f _ Ht).
-Instance Pmerge : Merge Pmap := λ A B C f m1 m2,
-  let (t1,Ht1) := m1 in let (t2,Ht2) := m2 in PMap _ (Pmerge_wf f _ _ Ht1 Ht2).
-
-Instance Pmap_finmap : FinMap positive Pmap.
-Proof.
-  split.
-  - by intros ? [t1 ?] [t2 ?] ?; apply Pmap_eq, Pmap_wf_eq.
-  - by intros ? [].
-  - intros ?? [??] ?. by apply Plookup_alter.
-  - intros ?? [??] ??. by apply Plookup_alter_ne.
-  - intros ??? [??]. by apply Plookup_fmap.
-  - intros ? [??]. apply Pto_list_nodup; [|constructor].
-    intros ??. by rewrite elem_of_nil.
-  - intros ? [??] i x; unfold map_to_list, Pto_list.
-    rewrite Pelem_of_to_list, elem_of_nil.
-    split. by intros [(?&->&?)|]. by left; exists i.
-  - intros ?? ? [??] ?. by apply Pomap_lookup.
-  - intros ??? ?? [??] [??] ?. by apply Pmerge_lookup.
-Qed.
-
-Program Instance Pmap_countable `{Countable A} : Countable (Pmap A) := {
-  encode m := encode (map_to_list m : list (positive * A));
-  decode p := map_of_list <$> decode p
-}.
-Next Obligation.
-  intros A ?? m; simpl. rewrite decode_encode; simpl. by rewrite map_of_to_list.
-Qed.
-
-(** * Finite sets *)
-(** We construct sets of [positives]s satisfying extensional equality. *)
-Notation Pset := (mapset Pmap).
-Instance Pmap_dom {A} : Dom (Pmap A) Pset := mapset_dom.
-Instance Pmap_dom_spec : FinMapDom positive Pmap Pset := mapset_dom_spec.
-
-(** * Fresh numbers *)
-Fixpoint Pdepth {A} (m : Pmap_raw A) : nat :=
-  match m with
-  | PLeaf | PNode None _ _ => O | PNode _ l _ => S (Pdepth l)
-  end.
-Fixpoint Pfresh_at_depth {A} (m : Pmap_raw A) (d : nat) : option positive :=
-  match d, m with
-  | O, (PLeaf | PNode None _ _) => Some 1
-  | S d, PNode _ l r =>
-     match Pfresh_at_depth l d with
-     | Some i => Some (i~0) | None => (~1) <$> Pfresh_at_depth r d
-     end
-  | _, _ => None
-  end.
-Fixpoint Pfresh_go {A} (m : Pmap_raw A) (d : nat) : option positive :=
-  match d with
-  | O => None
-  | S d =>
-     match Pfresh_go m d with
-     | Some i => Some i | None => Pfresh_at_depth m d
-     end
-  end.
-Definition Pfresh {A} (m : Pmap A) : positive :=
-  let d := Pdepth (pmap_car m) in
-  match Pfresh_go (pmap_car m) d with
-  | Some i => i | None => Pos.shiftl_nat 1 d
-  end.
-
-Lemma Pfresh_at_depth_fresh {A} (m : Pmap_raw A) d i :
-  Pfresh_at_depth m d = Some i → m !! i = None.
-Proof.
-  revert i m; induction d as [|d IH].
-  { intros i [|[] l r] ?; naive_solver. }
-  intros i [|o l r] ?; simplify_eq/=.
-  destruct (Pfresh_at_depth l d) as [i'|] eqn:?,
-    (Pfresh_at_depth r d) as [i''|] eqn:?; simplify_eq/=; auto.
-Qed.
-Lemma Pfresh_go_fresh {A} (m : Pmap_raw A) d i :
-  Pfresh_go m d = Some i → m !! i = None.
-Proof.
-  induction d as [|d IH]; intros; simplify_eq/=.
-  destruct (Pfresh_go m d); eauto using Pfresh_at_depth_fresh.
-Qed.
-Lemma Pfresh_depth {A} (m : Pmap_raw A) :
-  m !! Pos.shiftl_nat 1 (Pdepth m) = None.
-Proof. induction m as [|[x|] l IHl r IHr]; auto. Qed.
-Lemma Pfresh_fresh {A} (m : Pmap A) : m !! Pfresh m = None.
-Proof.
-  destruct m as [m ?]; unfold lookup, Plookup, Pfresh; simpl.
-  destruct (Pfresh_go m _) eqn:?; eauto using Pfresh_go_fresh, Pfresh_depth.
-Qed.
-
-Instance Pset_fresh : Fresh positive Pset := λ X,
-  let (m) := X in Pfresh m.
-Instance Pset_fresh_spec : FreshSpec positive Pset.
-Proof.
-  split.
-  - apply _.
-  - intros X Y; rewrite <-elem_of_equiv_L. by intros ->.
-  - unfold elem_of, mapset_elem_of, fresh; intros [m]; simpl.
-    by rewrite Pfresh_fresh.
-Qed.

theories/set.v

-(* Copyright (c) 2012-2017, Robbert Krebbers. *)
-(* This file is distributed under the terms of the BSD license. *)
-(** This file implements sets as functions into Prop. *)
-From stdpp Require Export collections.
-Set Default Proof Using "Type".
-
-Record set (A : Type) : Type := mkSet { set_car : A → Prop }.
-Add Printing Constructor set.
-Arguments mkSet {_} _.
-Arguments set_car {_} _ _.
-Notation "{[ x | P ]}" := (mkSet (λ x, P))
-  (at level 1, format "{[  x  |  P  ]}") : C_scope.
-
-Instance set_elem_of {A} : ElemOf A (set A) := λ x X, set_car X x.
-
-Instance set_top {A} : Top (set A) := {[ _ | True ]}.
-Instance set_empty {A} : Empty (set A) := {[ _ | False ]}.
-Instance set_singleton {A} : Singleton A (set A) := λ y, {[ x | y = x ]}.
-Instance set_union {A} : Union (set A) := λ X1 X2, {[ x | x ∈ X1 ∨ x ∈ X2 ]}.
-Instance set_intersection {A} : Intersection (set A) := λ X1 X2,
-  {[ x | x ∈ X1 ∧ x ∈ X2 ]}.
-Instance set_difference {A} : Difference (set A) := λ X1 X2,
-  {[ x | x ∈ X1 ∧ x ∉ X2 ]}.
-Instance set_collection : Collection A (set A).
-Proof. split; [split | |]; by repeat intro. Qed.
-
-Lemma elem_of_top {A} (x : A) : x ∈ ⊤ ↔ True.
-Proof. done. Qed.
-Lemma elem_of_mkSet {A} (P : A → Prop) x : x ∈ {[ x | P x ]} ↔ P x.
-Proof. done. Qed.
-Lemma not_elem_of_mkSet {A} (P : A → Prop) x : x ∉ {[ x | P x ]} ↔ ¬P x.
-Proof. done. Qed.
-Lemma top_subseteq {A} (X : set A) : X ⊆ ⊤.
-Proof. done. Qed.
-Hint Resolve top_subseteq.
-
-Instance set_ret : MRet set := λ A (x : A), {[ x ]}.
-Instance set_bind : MBind set := λ A B (f : A → set B) (X : set A),
-  mkSet (λ b, ∃ a, b ∈ f a ∧ a ∈ X).
-Instance set_fmap : FMap set := λ A B (f : A → B) (X : set A),
-  {[ b | ∃ a, b = f a ∧ a ∈ X ]}.
-Instance set_join : MJoin set := λ A (XX : set (set A)),
-  {[ a | ∃ X, a ∈ X ∧ X ∈ XX ]}.
-Instance set_collection_monad : CollectionMonad set.
-Proof. by split; try apply _. Qed.
-
-Instance set_unfold_set_all {A} (x : A) : SetUnfold (x ∈ (⊤ : set A)) True.
-Proof. by constructor. Qed.
-Instance set_unfold_mkSet {A} (P : A → Prop) x Q :
-  SetUnfoldSimpl (P x) Q → SetUnfold (x ∈ mkSet P) Q.
-Proof. intros HPQ. constructor. apply HPQ. Qed.
-
-Global Opaque set_elem_of set_top set_empty set_singleton.
-Global Opaque set_union set_intersection set_difference.
-Global Opaque set_ret set_bind set_fmap set_join.

theories/strings.v

-(* Copyright (c) 2012-2017, Robbert Krebbers. *)
-(* This file is distributed under the terms of the BSD license. *)
-From Coq Require Import Ascii.
-From Coq Require Export String.
-From stdpp Require Export list.
-From stdpp Require Import countable.
-Set Default Proof Using "Type".
-
-(* To avoid randomly ending up with String.length because this module is
-imported hereditarily somewhere. *)
-Notation length := List.length.
-
-(** * Fix scopes *)
-Open Scope string_scope.
-Open Scope list_scope.
-Infix "+:+" := String.append (at level 60, right associativity) : C_scope.
-Arguments String.append _ _ : simpl never.
-
-(** * Decision of equality *)
-Instance assci_eq_dec : EqDecision ascii := ascii_dec.
-Instance string_eq_dec : EqDecision string.
-Proof. solve_decision. Defined.
-Instance string_app_inj : Inj (=) (=) (String.append s1).
-Proof. intros s1 ???. induction s1; simplify_eq/=; f_equal/=; auto. Qed.
-
-(* Reverse *)
-Fixpoint string_rev_app (s1 s2 : string) : string :=
-  match s1 with
-  | "" => s2
-  | String a s1 => string_rev_app s1 (String a s2)
-  end.
-Definition string_rev (s : string) : string := string_rev_app s "".
-
-(* Break a string up into lists of words, delimited by white space *)
-Definition is_space (x : Ascii.ascii) : bool :=
-  match x with
-  | "009" | "010" | "011" | "012" | "013" | " " => true | _ => false
-  end%char.
-
-Fixpoint words_go (cur : option string) (s : string) : list string :=
-  match s with
-  | "" => option_list (string_rev <$> cur)
-  | String a s =>
-     if is_space a then option_list (string_rev <$> cur) ++ words_go None s
-     else words_go (Some (default (String a "") cur (String a))) s
-  end.
-Definition words : string → list string := words_go None.
-
-Ltac words s :=
-  match type of s with
-  | list string => s
-  | string => eval vm_compute in (words s)
-  end.
-
-(** * Encoding and decoding *)
-(** In order to reuse or existing implementation of radix-2 search trees over
-positive binary naturals [positive], we define an injection [string_to_pos]
-from [string] into [positive]. *)
-Fixpoint digits_to_pos (βs : list bool) : positive :=
-  match βs with
-  | [] => xH
-  | false :: βs => (digits_to_pos βs)~0
-  | true :: βs => (digits_to_pos βs)~1
-  end%positive.
-Definition ascii_to_digits (a : Ascii.ascii) : list bool :=
-  match a with
-  | Ascii.Ascii β1 β2 β3 β4 β5 β6 β7 β8 => [β1;β2;β3;β4;β5;β6;β7;β8]
-  end.
-Fixpoint string_to_pos (s : string) : positive :=
-  match s with
-  | EmptyString => xH
-  | String a s => string_to_pos s ++ digits_to_pos (ascii_to_digits a)
-  end%positive.
-Fixpoint digits_of_pos (p : positive) : list bool :=
-  match p with
-  | xH => []
-  | p~0 => false :: digits_of_pos p
-  | p~1 => true :: digits_of_pos p
-  end%positive.
-Fixpoint ascii_of_digits (βs : list bool) : ascii :=
-  match βs with
-  | [] => zero
-  | β :: βs => Ascii.shift β (ascii_of_digits βs)
-  end.
-Fixpoint string_of_digits (βs : list bool) : string :=
-  match βs with
-  | β1 :: β2 :: β3 :: β4 :: β5 :: β6 :: β7 :: β8 :: βs =>
-     String (ascii_of_digits [β1;β2;β3;β4;β5;β6;β7;β8]) (string_of_digits βs)
-  | _ => EmptyString
-  end.
-Definition string_of_pos (p : positive) : string :=
-  string_of_digits (digits_of_pos p).
-Lemma string_of_to_pos s : string_of_pos (string_to_pos s) = s.
-Proof.
-  unfold string_of_pos. by induction s as [|[[][][][][][][][]]]; f_equal/=.
-Qed.
-Program Instance string_countable : Countable string := {|
-  encode := string_to_pos; decode p := Some (string_of_pos p)
-|}.
-Solve Obligations with naive_solver eauto using string_of_to_pos with f_equal.