Commit 02f213ce authored by Robbert Krebbers's avatar Robbert Krebbers

Port to Coq 8.5 beta 2.

The port makes the following notable changes:

* The carrier types of separation algebras and integer environments are no
  longer in Set. Now they have a type at a fixed type level above Set. This
  both works better in 8.5 and makes the formalization more general.
  I have tried putting them at polymorphic type levels, but that increased the
  compilation time by an order of magnitude.
* I am using a custom f_equal tactic written in Ltac to circumvent bug #4069.
  That bug has been fixed, so this custom tactic can be removed when the next
  beta of 8.5 is out.
parent 462ea92a
...@@ -269,7 +269,7 @@ End assoc. ...@@ -269,7 +269,7 @@ End assoc.
(** * Finite sets *) (** * Finite sets *)
(** We construct finite sets using the above implementation of maps. *) (** We construct finite sets using the above implementation of maps. *)
Notation assoc_set K := (mapset (assoc K unit)). Notation assoc_set K := (mapset (assoc K)).
Instance assoc_map_dom `{Lexico K, !TrichotomyT (@lexico K _), Instance assoc_map_dom `{Lexico K, !TrichotomyT (@lexico K _),
!StrictOrder lexico} {A} : Dom (assoc K A) (assoc_set K) := mapset_dom. !StrictOrder lexico} {A} : Dom (assoc K A) (assoc_set K) := mapset_dom.
Instance assoc_map_dom_spec `{Lexico K} `{!TrichotomyT (@lexico K _)} Instance assoc_map_dom_spec `{Lexico K} `{!TrichotomyT (@lexico K _)}
......
...@@ -6,6 +6,7 @@ abstract interfaces for ordered structures, collections, and various other data ...@@ -6,6 +6,7 @@ abstract interfaces for ordered structures, collections, and various other data
structures. *) structures. *)
Global Generalizable All Variables. Global Generalizable All Variables.
Global Set Automatic Coercions Import. Global Set Automatic Coercions Import.
Global Set Asymmetric Patterns.
Require Export Morphisms RelationClasses List Bool Utf8 Program Setoid. Require Export Morphisms RelationClasses List Bool Utf8 Program Setoid.
(** * General *) (** * General *)
...@@ -418,23 +419,23 @@ Notation "(≫= f )" := (mbind f) (only parsing) : C_scope. ...@@ -418,23 +419,23 @@ Notation "(≫= f )" := (mbind f) (only parsing) : C_scope.
Notation "(≫=)" := (λ m f, mbind f m) (only parsing) : C_scope. Notation "(≫=)" := (λ m f, mbind f m) (only parsing) : C_scope.
Notation "x ← y ; z" := (y = (λ x : _, z)) Notation "x ← y ; z" := (y = (λ x : _, z))
(at level 65, next at level 35, only parsing, right associativity) : C_scope. (at level 65, only parsing, right associativity) : C_scope.
Infix "<$>" := fmap (at level 60, right associativity) : C_scope. Infix "<$>" := fmap (at level 60, right associativity) : C_scope.
Notation "' ( x1 , x2 ) ← y ; z" := Notation "' ( x1 , x2 ) ← y ; z" :=
(y = (λ x : _, let ' (x1, x2) := x in z)) (y = (λ x : _, let ' (x1, x2) := x in z))
(at level 65, next at level 35, only parsing, right associativity) : C_scope. (at level 65, only parsing, right associativity) : C_scope.
Notation "' ( x1 , x2 , x3 ) ← y ; z" := Notation "' ( x1 , x2 , x3 ) ← y ; z" :=
(y = (λ x : _, let ' (x1,x2,x3) := x in z)) (y = (λ x : _, let ' (x1,x2,x3) := x in z))
(at level 65, next at level 35, only parsing, right associativity) : C_scope. (at level 65, only parsing, right associativity) : C_scope.
Notation "' ( x1 , x2 , x3 , x4 ) ← y ; z" := Notation "' ( x1 , x2 , x3 , x4 ) ← y ; z" :=
(y = (λ x : _, let ' (x1,x2,x3,x4) := x in z)) (y = (λ x : _, let ' (x1,x2,x3,x4) := x in z))
(at level 65, next at level 35, only parsing, right associativity) : C_scope. (at level 65, only parsing, right associativity) : C_scope.
Notation "' ( x1 , x2 , x3 , x4 , x5 ) ← y ; z" := Notation "' ( x1 , x2 , x3 , x4 , x5 ) ← y ; z" :=
(y = (λ x : _, let ' (x1,x2,x3,x4,x5) := x in z)) (y = (λ x : _, let ' (x1,x2,x3,x4,x5) := x in z))
(at level 65, next at level 35, only parsing, right associativity) : C_scope. (at level 65, only parsing, right associativity) : C_scope.
Notation "' ( x1 , x2 , x3 , x4 , x5 , x6 ) ← y ; z" := Notation "' ( x1 , x2 , x3 , x4 , x5 , x6 ) ← y ; z" :=
(y = (λ x : _, let ' (x1,x2,x3,x4,x5,x6) := x in z)) (y = (λ x : _, let ' (x1,x2,x3,x4,x5,x6) := x in z))
(at level 65, next at level 35, only parsing, right associativity) : C_scope. (at level 65, only parsing, right associativity) : C_scope.
Notation "ps .*1" := (fmap (M:=list) fst ps) Notation "ps .*1" := (fmap (M:=list) fst ps)
(at level 10, format "ps .*1"). (at level 10, format "ps .*1").
...@@ -445,9 +446,9 @@ Class MGuard (M : Type → Type) := ...@@ -445,9 +446,9 @@ Class MGuard (M : Type → Type) :=
mguard: P {dec : Decision P} {A}, (P M A) M A. mguard: P {dec : Decision P} {A}, (P M A) M A.
Arguments mguard _ _ _ !_ _ _ /. Arguments mguard _ _ _ !_ _ _ /.
Notation "'guard' P ; o" := (mguard P (λ _, o)) Notation "'guard' P ; o" := (mguard P (λ _, o))
(at level 65, next at level 35, only parsing, right associativity) : C_scope. (at level 65, only parsing, right associativity) : C_scope.
Notation "'guard' P 'as' H ; o" := (mguard P (λ H, o)) Notation "'guard' P 'as' H ; o" := (mguard P (λ H, o))
(at level 65, next at level 35, only parsing, right associativity) : C_scope. (at level 65, only parsing, right associativity) : C_scope.
(** ** Operations on maps *) (** ** Operations on maps *)
(** In this section we define operational type classes for the operations (** In this section we define operational type classes for the operations
......
...@@ -109,8 +109,7 @@ Section of_option_list. ...@@ -109,8 +109,7 @@ Section of_option_list.
Proof. Proof.
split. split.
* induction l; simpl; [by rewrite elem_of_empty|]. * induction l; simpl; [by rewrite elem_of_empty|].
rewrite elem_of_union, elem_of_singleton; rewrite elem_of_union,elem_of_singleton; intros [->|?]; constructor; auto.
intros [->|?]; constructor (auto).
* induction 1; simpl; rewrite elem_of_union, elem_of_singleton; auto. * induction 1; simpl; rewrite elem_of_union, elem_of_singleton; auto.
Qed. Qed.
End of_option_list. End of_option_list.
......
...@@ -68,7 +68,7 @@ Lemma surjective_cancel `{Countable A} `{∀ x y : B, Decision (x = y)} ...@@ -68,7 +68,7 @@ Lemma surjective_cancel `{Countable A} `{∀ x y : B, Decision (x = y)}
(f : A B) `{!Surjective (=) f} : { g : B A & Cancel (=) f g }. (f : A B) `{!Surjective (=) f} : { g : B A & Cancel (=) f g }.
Proof. Proof.
exists (λ y, choose (λ x, f x = y) (surjective f y)). exists (λ y, choose (λ x, f x = y) (surjective f y)).
intros y. by rewrite (choose_correct (λ _, _) (surjective f y)). intros y. by rewrite (choose_correct (λ x, f x = y) (surjective f y)).
Qed. Qed.
(** ** Instances *) (** ** Instances *)
...@@ -200,7 +200,7 @@ Program Instance list_countable `{Countable A} : Countable (list A) := {| ...@@ -200,7 +200,7 @@ Program Instance list_countable `{Countable A} : Countable (list A) := {|
decode p := list_decode p = mapM decode decode p := list_decode p = mapM decode
|}. |}.
Next Obligation. Next Obligation.
intros ??? l. rewrite list_decode_encode. simpl. intros ??? l; simpl; rewrite list_decode_encode; simpl.
apply mapM_fmap_Some; auto using decode_encode. apply mapM_fmap_Some; auto using decode_encode.
Qed. Qed.
...@@ -227,5 +227,5 @@ Program Instance nat_countable : Countable nat := {| ...@@ -227,5 +227,5 @@ Program Instance nat_countable : Countable nat := {|
decode p := N.to_nat <$> decode p decode p := N.to_nat <$> decode p
|}. |}.
Next Obligation. Next Obligation.
intros x. rewrite decode_encode; csimpl. by rewrite Nat2N.id. intros x; lazy beta; rewrite decode_encode; csimpl. by rewrite Nat2N.id.
Qed. Qed.
...@@ -125,13 +125,9 @@ Proof. repeat case_bool_decide; tauto. Qed. ...@@ -125,13 +125,9 @@ Proof. repeat case_bool_decide; tauto. Qed.
(** Leibniz equality on Sigma types requires the equipped proofs to be (** Leibniz equality on Sigma types requires the equipped proofs to be
equal as Coq does not support proof irrelevance. For decidable we equal as Coq does not support proof irrelevance. For decidable we
propositions we define the type [dsig P] whose Leibniz equality is proof propositions we define the type [dsig P] whose Leibniz equality is proof
irrelevant. That is [∀ x y : dsig P, x = y ↔ `x = `y]. Due to the absence of irrelevant. That is [∀ x y : dsig P, x = y ↔ `x = `y]. *)
universe polymorpic definitions we also define a variant [dsigS] for types
in [Set]. *)
Definition dsig `(P : A Prop) `{ x : A, Decision (P x)} := Definition dsig `(P : A Prop) `{ x : A, Decision (P x)} :=
{ x | bool_decide (P x) }. { x | bool_decide (P x) }.
Definition dsigS {A : Set} (P : A Prop) `{ x : A, Decision (P x)} : Set :=
{ x | bool_decide (P x) }.
Definition proj2_dsig `{ x : A, Decision (P x)} (x : dsig P) : P (`x) := Definition proj2_dsig `{ x : A, Decision (P x)} (x : dsig P) : P (`x) :=
bool_decide_unpack _ (proj2_sig x). bool_decide_unpack _ (proj2_sig x).
......
...@@ -27,7 +27,7 @@ Definition error_guard {E} P {dec : Decision P} {S A} ...@@ -27,7 +27,7 @@ Definition error_guard {E} P {dec : Decision P} {S A}
(e : E) (f : P error S E A) : error S E A := (e : E) (f : P error S E A) : error S E A :=
match decide P with left H => f H | right _ => fail e end. match decide P with left H => f H | right _ => fail e end.
Notation "'guard' P 'with' e ; o" := (error_guard P e (λ _, o)) Notation "'guard' P 'with' e ; o" := (error_guard P e (λ _, o))
(at level 65, next at level 35, only parsing, right associativity) : C_scope. (at level 65, only parsing, right associativity) : C_scope.
Definition error_of_option {S A E} (x : option A) (e : E) : error S E A := Definition error_of_option {S A E} (x : option A) (e : E) : error S E A :=
match x with Some a => mret a | None => fail e end. match x with Some a => mret a | None => fail e end.
......
...@@ -586,7 +586,7 @@ Proof. destruct l. done. by edestruct 1; constructor. Qed. ...@@ -586,7 +586,7 @@ Proof. destruct l. done. by edestruct 1; constructor. Qed.
Lemma elem_of_not_nil x l : x ∈ l → l ≠ []. Lemma elem_of_not_nil x l : x ∈ l → l ≠ [].
Proof. intros ? ->. by apply (elem_of_nil x). Qed. Proof. intros ? ->. by apply (elem_of_nil x). Qed.
Lemma elem_of_cons l x y : x ∈ y :: l ↔ x = y ∨ x ∈ l. Lemma elem_of_cons l x y : x ∈ y :: l ↔ x = y ∨ x ∈ l.
Proof. split; [inversion 1; subst|intros [->|?]]; constructor (done). Qed. Proof. by split; [inversion 1; subst|intros [->|?]]; constructor. Qed.
Lemma not_elem_of_cons l x y : x ∉ y :: l ↔ x ≠ y ∧ x ∉ l. Lemma not_elem_of_cons l x y : x ∉ y :: l ↔ x ≠ y ∧ x ∉ l.
Proof. rewrite elem_of_cons. tauto. Qed. Proof. rewrite elem_of_cons. tauto. Qed.
Lemma elem_of_app l1 l2 x : x ∈ l1 ++ l2 ↔ x ∈ l1 ∨ x ∈ l2. Lemma elem_of_app l1 l2 x : x ∈ l1 ++ l2 ↔ x ∈ l1 ∨ x ∈ l2.
...@@ -623,8 +623,8 @@ Proof. ...@@ -623,8 +623,8 @@ Proof.
split. split.
* induction l as [|x l]; csimpl; repeat case_match; inversion 1; subst; * induction l as [|x l]; csimpl; repeat case_match; inversion 1; subst;
setoid_rewrite elem_of_cons; naive_solver. setoid_rewrite elem_of_cons; naive_solver.
* intros (x&Hx&?). induction Hx; csimpl; repeat case_match; * intros (x&Hx&?). by induction Hx; csimpl; repeat case_match;
simplify_equality; auto; constructor (by auto). simplify_equality; try constructor; auto.
Qed. Qed.
(** ** Properties of the [NoDup] predicate *) (** ** Properties of the [NoDup] predicate *)
...@@ -1311,7 +1311,7 @@ Definition Permutation_skip := @perm_skip A. ...@@ -1311,7 +1311,7 @@ Definition Permutation_skip := @perm_skip A.
Definition Permutation_swap := @perm_swap A. Definition Permutation_swap := @perm_swap A.
Definition Permutation_singleton_inj := @Permutation_length_1 A. Definition Permutation_singleton_inj := @Permutation_length_1 A.
Global Existing Instance Permutation_app'_Proper. Global Existing Instance Permutation_app'.
Global Instance: Proper ((≡ₚ) ==> (=)) (@length A). Global Instance: Proper ((≡ₚ) ==> (=)) (@length A).
Proof. induction 1; simpl; auto with lia. Qed. Proof. induction 1; simpl; auto with lia. Qed.
Global Instance: Commutative (≡ₚ) (@app A). Global Instance: Commutative (≡ₚ) (@app A).
...@@ -2037,7 +2037,7 @@ Section Forall_Exists. ...@@ -2037,7 +2037,7 @@ Section Forall_Exists.
Proof. intros H ?. induction H; auto. Defined. Proof. intros H ?. induction H; auto. Defined.
Global Instance Forall_proper: Global Instance Forall_proper:
Proper (pointwise_relation _ (↔) ==> (=) ==> (↔)) (@Forall A). Proper (pointwise_relation _ (↔) ==> (=) ==> (↔)) (@Forall A).
Proof. split; subst; induction 1; constructor (by firstorder auto). Qed. Proof. split; subst; induction 1; constructor; by firstorder auto. Qed.
Lemma Forall_iff l (Q : A → Prop) : Lemma Forall_iff l (Q : A → Prop) :
(∀ 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.
...@@ -2150,7 +2150,7 @@ Section Forall_Exists. ...@@ -2150,7 +2150,7 @@ Section Forall_Exists.
Proof. intros H ?. induction H; auto. Defined. Proof. intros H ?. induction H; auto. Defined.
Global Instance Exists_proper: Global Instance Exists_proper:
Proper (pointwise_relation _ (↔) ==> (=) ==> (↔)) (@Exists A). Proper (pointwise_relation _ (↔) ==> (=) ==> (↔)) (@Exists A).
Proof. split; subst; induction 1; constructor (by firstorder auto). Qed. Proof. split; subst; induction 1; constructor; by firstorder auto. 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; inversion_clear 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.
...@@ -2466,7 +2466,7 @@ Section Forall2_order. ...@@ -2466,7 +2466,7 @@ Section Forall2_order.
Global Instance: Symmetric R → Symmetric (Forall2 R). Global Instance: Symmetric R → Symmetric (Forall2 R).
Proof. intros. induction 1; constructor; auto. Qed. Proof. intros. induction 1; constructor; auto. Qed.
Global Instance: Transitive R → Transitive (Forall2 R). Global Instance: Transitive R → Transitive (Forall2 R).
Proof. intros ????. apply Forall2_transitive. apply transitivity. Qed. Proof. intros ????. apply Forall2_transitive. by apply @transitivity. Qed.
Global Instance: Equivalence R → Equivalence (Forall2 R). Global Instance: Equivalence R → Equivalence (Forall2 R).
Proof. split; apply _. Qed. Proof. split; apply _. Qed.
Global Instance: PreOrder R → PreOrder (Forall2 R). Global Instance: PreOrder R → PreOrder (Forall2 R).
...@@ -2658,7 +2658,7 @@ Section fmap. ...@@ -2658,7 +2658,7 @@ Section fmap.
Lemma Forall_fmap (P : B → Prop) l : Forall P (f <$> l) ↔ Forall (P ∘ f) l. 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. 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. 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. Proof. split; induction l; inversion 1; constructor; by auto. Qed.
Lemma Forall2_fmap_l {C} (P : B → C → Prop) l1 l2 : Lemma Forall2_fmap_l {C} (P : B → C → Prop) l1 l2 :
Forall2 P (f <$> l1) l2 ↔ Forall2 (P ∘ f) l1 l2. Forall2 P (f <$> l1) l2 ↔ Forall2 (P ∘ f) l1 l2.
Proof. Proof.
......
...@@ -5,28 +5,29 @@ elements of the unit type. Since maps enjoy extensional equality, the ...@@ -5,28 +5,29 @@ elements of the unit type. Since maps enjoy extensional equality, the
constructed finite sets do so as well. *) constructed finite sets do so as well. *)
Require Export fin_map_dom. Require Export fin_map_dom.
Record mapset (Mu : Type) := Mapset { mapset_car: Mu }. Record mapset (M : Type Type) : Type :=
Mapset { mapset_car: M (unit : Type) }.
Arguments Mapset {_} _. Arguments Mapset {_} _.
Arguments mapset_car {_} _. Arguments mapset_car {_} _.
Section mapset. Section mapset.
Context `{FinMap K M}. Context `{FinMap K M}.
Instance mapset_elem_of: ElemOf K (mapset (M unit)) := λ x X, Instance mapset_elem_of: ElemOf K (mapset M) := λ x X,
mapset_car X !! x = Some (). mapset_car X !! x = Some ().
Instance mapset_empty: Empty (mapset (M unit)) := Mapset . Instance mapset_empty: Empty (mapset M) := Mapset .
Instance mapset_singleton: Singleton K (mapset (M unit)) := λ x, Instance mapset_singleton: Singleton K (mapset M) := λ x,
Mapset {[ (x,()) ]}. Mapset {[ (x,()) ]}.
Instance mapset_union: Union (mapset (M unit)) := λ X1 X2, Instance mapset_union: Union (mapset M) := λ X1 X2,
let (m1) := X1 in let (m2) := X2 in Mapset (m1 m2). let (m1) := X1 in let (m2) := X2 in Mapset (m1 m2).
Instance mapset_intersection: Intersection (mapset (M unit)) := λ X1 X2, Instance mapset_intersection: Intersection (mapset M) := λ X1 X2,
let (m1) := X1 in let (m2) := X2 in Mapset (m1 m2). let (m1) := X1 in let (m2) := X2 in Mapset (m1 m2).
Instance mapset_difference: Difference (mapset (M unit)) := λ X1 X2, Instance mapset_difference: Difference (mapset M) := λ X1 X2,
let (m1) := X1 in let (m2) := X2 in Mapset (m1 m2). let (m1) := X1 in let (m2) := X2 in Mapset (m1 m2).
Instance mapset_elems: Elements K (mapset (M unit)) := λ X, Instance mapset_elems: Elements K (mapset M) := λ X,
let (m) := X in (map_to_list m).*1. let (m) := X in (map_to_list m).*1.
Lemma mapset_eq (X1 X2 : mapset (M unit)) : X1 = X2 x, x X1 x X2. Lemma mapset_eq (X1 X2 : mapset M) : X1 = X2 x, x X1 x X2.
Proof. Proof.
split; [by intros ->|]. split; [by intros ->|].
destruct X1 as [m1], X2 as [m2]. simpl. intros E. destruct X1 as [m1], X2 as [m2]. simpl. intros E.
...@@ -34,17 +35,16 @@ Proof. ...@@ -34,17 +35,16 @@ Proof.
Qed. Qed.
Global Instance mapset_eq_dec `{ m1 m2 : M unit, Decision (m1 = m2)} Global Instance mapset_eq_dec `{ m1 m2 : M unit, Decision (m1 = m2)}
(X1 X2 : mapset (M unit)) : Decision (X1 = X2) | 1. (X1 X2 : mapset M) : Decision (X1 = X2) | 1.
Proof. Proof.
refine refine
match X1, X2 with Mapset m1, Mapset m2 => cast_if (decide (m1 = m2)) end; match X1, X2 with Mapset m1, Mapset m2 => cast_if (decide (m1 = m2)) end;
abstract congruence. abstract congruence.
Defined. Defined.
Global Instance mapset_elem_of_dec x (X : mapset (M unit)) : Global Instance mapset_elem_of_dec x (X : mapset M) : Decision (x X) | 1.
Decision (x X) | 1.
Proof. solve_decision. Defined. Proof. solve_decision. Defined.
Instance: Collection K (mapset (M unit)). Instance: Collection K (mapset M).
Proof. Proof.
split; [split | | ]. split; [split | | ].
* unfold empty, elem_of, mapset_empty, mapset_elem_of. * unfold empty, elem_of, mapset_empty, mapset_elem_of.
...@@ -63,9 +63,9 @@ Proof. ...@@ -63,9 +63,9 @@ Proof.
intros [m1] [m2] ?. simpl. rewrite lookup_difference_Some. intros [m1] [m2] ?. simpl. rewrite lookup_difference_Some.
destruct (m2 !! x) as [[]|]; intuition congruence. destruct (m2 !! x) as [[]|]; intuition congruence.
Qed. Qed.
Global Instance: PartialOrder (@subseteq (mapset (M unit)) _). Global Instance: PartialOrder (@subseteq (mapset M) _).
Proof. split; try apply _. intros ????. apply mapset_eq. intuition. Qed. Proof. split; try apply _. intros ????. apply mapset_eq. intuition. Qed.
Global Instance: FinCollection K (mapset (M unit)). Global Instance: FinCollection K (mapset M).
Proof. Proof.
split. split.
* apply _. * apply _.
...@@ -78,12 +78,12 @@ Proof. ...@@ -78,12 +78,12 @@ Proof.
Qed. Qed.
Definition mapset_map_with {A B} (f : bool A option B) Definition mapset_map_with {A B} (f : bool A option B)
(X : mapset (M unit)) : M A M B := (X : mapset M) : M A M B :=
let (mX) := X in merge (λ x y, let (mX) := X in merge (λ x y,
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 unit) := Definition mapset_dom_with {A} (f : A bool) (m : M A) : mapset M :=
Mapset $ merge (λ x _, Mapset $ merge (λ x _,
match x with match x with
| Some a => if f a then Some () else None | None => None | Some a => if f a then Some () else None | None => None
...@@ -104,9 +104,8 @@ Proof. ...@@ -104,9 +104,8 @@ Proof.
* destruct (Is_true_reflect (f a)); naive_solver. * destruct (Is_true_reflect (f a)); naive_solver.
* naive_solver. * naive_solver.
Qed. Qed.
Instance mapset_dom {A} : Dom (M A) (mapset (M unit)) := Instance mapset_dom {A} : Dom (M A) (mapset M) := mapset_dom_with (λ _, true).
mapset_dom_with (λ _, true). Instance mapset_dom_spec: FinMapDom K M (mapset M).
Instance mapset_dom_spec: FinMapDom K M (mapset (M unit)).
Proof. Proof.
split; try apply _. intros. unfold dom, mapset_dom, is_Some. split; try apply _. intros. unfold dom, mapset_dom, is_Some.
rewrite elem_of_mapset_dom_with; naive_solver. rewrite elem_of_mapset_dom_with; naive_solver.
......
...@@ -255,7 +255,7 @@ Proof. ...@@ -255,7 +255,7 @@ Proof.
Qed. Qed.
(** Finally, we can construct sets of [nat]s satisfying extensional equality. *) (** Finally, we can construct sets of [nat]s satisfying extensional equality. *)
Notation natset := (mapset (natmap unit)). Notation natset := (mapset natmap).
Instance natmap_dom {A} : Dom (natmap A) natset := mapset_dom. Instance natmap_dom {A} : Dom (natmap A) natset := mapset_dom.
Instance: FinMapDom nat natmap natset := mapset_dom_spec. Instance: FinMapDom nat natmap natset := mapset_dom_spec.
......
...@@ -7,7 +7,7 @@ Require Export prelude fin_maps. ...@@ -7,7 +7,7 @@ Require Export prelude fin_maps.
Local Open Scope N_scope. Local Open Scope N_scope.
Record Nmap A := NMap { Nmap_0 : option A; Nmap_pos : Pmap A }. Record Nmap (A : Type) : Type := NMap { Nmap_0 : option A; Nmap_pos : Pmap A }.
Arguments Nmap_0 {_} _. Arguments Nmap_0 {_} _.
Arguments Nmap_pos {_} _. Arguments Nmap_pos {_} _.
Arguments NMap {_} _ _. Arguments NMap {_} _ _.
...@@ -81,7 +81,7 @@ Qed. ...@@ -81,7 +81,7 @@ Qed.
(** * Finite sets *) (** * Finite sets *)
(** We construct sets of [N]s satisfying extensional equality. *) (** We construct sets of [N]s satisfying extensional equality. *)
Notation Nset := (mapset (Nmap unit)). Notation Nset := (mapset Nmap).
Instance Nmap_dom {A} : Dom (Nmap A) Nset := mapset_dom. Instance Nmap_dom {A} : Dom (Nmap A) Nset := mapset_dom.
Instance: FinMapDom N Nmap Nset := mapset_dom_spec. Instance: FinMapDom N Nmap Nset := mapset_dom_spec.
......
...@@ -28,8 +28,8 @@ Notation "x ≤ y ≤ z ≤ z'" := (x ≤ y ∧ y ≤ z ∧ z ≤ z')%nat : nat_ ...@@ -28,8 +28,8 @@ Notation "x ≤ y ≤ z ≤ z'" := (x ≤ y ∧ y ≤ z ∧ z ≤ z')%nat : nat_
Notation "(≤)" := le (only parsing) : nat_scope. Notation "(≤)" := le (only parsing) : nat_scope.
Notation "(<)" := lt (only parsing) : nat_scope. Notation "(<)" := lt (only parsing) : nat_scope.
Infix "`div`" := NPeano.div (at level 35) : nat_scope. Infix "`div`" := Nat.div (at level 35) : nat_scope.
Infix "`mod`" := NPeano.modulo (at level 35) : nat_scope. Infix "`mod`" := Nat.modulo (at level 35) : nat_scope.
Instance nat_eq_dec: x y : nat, Decision (x = y) := eq_nat_dec. Instance nat_eq_dec: x y : nat, Decision (x = y) := eq_nat_dec.
Instance nat_le_dec: x y : nat, Decision (x y) := le_dec. Instance nat_le_dec: x y : nat, Decision (x y) := le_dec.
......
...@@ -80,9 +80,8 @@ Qed. ...@@ -80,9 +80,8 @@ Qed.
End optionmap. End optionmap.
(** * Finite sets *) (** * Finite sets *)
Notation optionset M := (mapset (optionmap M unit)). Notation optionset M := (mapset (optionmap M)).
Instance optionmap_dom {M : Type Type} `{ A, Empty (M A), Merge M} {A} : Instance optionmap_dom {M : Type Type} `{ A, Empty (M A), Merge M} {A} :
Dom (optionmap M A) (optionset M) := mapset_dom. Dom (optionmap M A) (optionset M) := mapset_dom.
Instance optionmap_domspec `{FinMap K M} : Instance optionmap_domspec `{FinMap K M} :
FinMapDom (option K) (optionmap M) (optionset M) := mapset_dom_spec. FinMapDom (option K) (optionmap M) (optionset M) := mapset_dom_spec.
...@@ -18,7 +18,7 @@ Section orders. ...@@ -18,7 +18,7 @@ Section orders.
Lemma reflexive_eq `{!Reflexive R} X Y : X = Y X Y. Lemma reflexive_eq `{!Reflexive R} X Y : X = Y X Y.
Proof. by intros <-. Qed. Proof. by intros <-. Qed.
Lemma anti_symmetric_iff `{!PartialOrder R} X Y : X = Y R X Y R Y X. Lemma anti_symmetric_iff `{!PartialOrder R} X Y : X = Y R X Y R Y X.
Proof. intuition (subst; auto). Qed. Proof. split. by intros ->. by intros [??]; apply (anti_symmetric _). Qed.
Lemma strict_spec X Y : X Y X Y Y X. Lemma strict_spec X Y : X Y X Y Y X.
Proof. done. Qed. Proof. done. Qed.
Lemma strict_include X Y : X Y X Y. Lemma strict_include X Y : X Y X Y.
......
...@@ -19,7 +19,7 @@ Local Hint Extern 0 (¬@eq positive _ _) => congruence. ...@@ -19,7 +19,7 @@ Local Hint Extern 0 (¬@eq positive _ _) => congruence.
not ensure canonical representations of maps. For example the empty map can 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 be represented as a binary tree of an arbitrary size that contains [None] at
all nodes. *) all nodes. *)
Inductive Pmap_raw A := Inductive Pmap_raw (A : Type) : Type :=
| PLeaf: Pmap_raw A | PLeaf: Pmap_raw A
| PNode: Pmap_raw A option A Pmap_raw A Pmap_raw A. | PNode: Pmap_raw A option A Pmap_raw A Pmap_raw A.
Arguments PLeaf {_}. Arguments PLeaf {_}.
...@@ -44,7 +44,7 @@ Proof. ...@@ -44,7 +44,7 @@ Proof.
| PLeaf => right _ | PLeaf => right _
| PNode _ (Some x) _ => left _ | PNode _ (Some x) _ => left _
| PNode l Node r => cast_if_or (go l) (go r) | PNode l Node r => cast_if_or (go l) (go r)
end); clear go; abstract first [constructor (by auto)|by inversion 1]. end); clear go; abstract first [constructor; by auto|by inversion 1].
Defined. Defined.
(** The following predicate describes well well formed trees. A tree is well (** The following predicate describes well well formed trees. A tree is well
...@@ -65,12 +65,12 @@ Proof. ...@@ -65,12 +65,12 @@ Proof.
| PNode l (Some x) r => cast_if_and (go l) (go r) | PNode l (Some x) r => cast_if_and (go l) (go r)
| PNode l Node r => | PNode l Node r =>
cast_if_and3 (decide (Pmap_ne l Pmap_ne r)) (go l) (go r) cast_if_and3 (decide (Pmap_ne l Pmap_ne r)) (go l) (go r)
end); clear go; abstract first [constructor (by auto)|by inversion 1]. end); clear go; abstract first [constructor; by auto|by inversion 1].
Defined. Defined.
(** Now we restrict the data type of trees to those that are well formed and (** Now we restrict the data type of trees to those that are well formed and
thereby obtain a data type that ensures canonicity. *) thereby obtain a data type that ensures canonicity. *)