Commit 7b80dd85 authored by Robbert's avatar Robbert

Merge branch 'robbert/infinite' into 'master'

Overhaul of the `Infinite`/`Fresh` infrastructure

See merge request !58
parents 0a0bd5d2 c04c1337
Pipeline #15170 passed with stage
in 9 minutes and 22 seconds
...@@ -6,6 +6,7 @@ abstract interfaces for ordered structures, sets, and various other data ...@@ -6,6 +6,7 @@ abstract interfaces for ordered structures, sets, and various other data
structures. *) structures. *)
From Coq Require Export Morphisms RelationClasses List Bool Utf8 Setoid. From Coq Require Export Morphisms RelationClasses List Bool Utf8 Setoid.
From Coq Require Import Permutation.
Set Default Proof Using "Type". Set Default Proof Using "Type".
Export ListNotations. Export ListNotations.
From Coq.Program Require Export Basics Syntax. From Coq.Program Require Export Basics Syntax.
...@@ -1210,17 +1211,26 @@ Class MonadSet M `{∀ A, ElemOf A (M A), ...@@ -1210,17 +1211,26 @@ Class MonadSet M `{∀ A, ElemOf A (M A),
elem_of_join {A} (X : M (M A)) (x : A) : x mjoin X Y, x Y Y X elem_of_join {A} (X : M (M A)) (x : A) : x mjoin X Y, x Y Y X
}. }.
(** The function [fresh X] yields an element that is not contained in [X]. We (** The [Infinite A] class axiomatizes types [A] with infinitely many elements.
will later prove that [fresh] is [Proper] with respect to the induced setoid It contains a function [fresh : list A → A] that given a list [xs] gives an
equality on sets. *) element [fresh xs ∉ xs].
We do not directly make [fresh] a field of the [Infinite] class, but use a
separate operational type class [Fresh] for it. That way we can overload [fresh]
to pick fresh elements from other data structure like sets. See the file
[fin_sets], where we define [fresh : C → A] for any finite set implementation
[FinSet C A].
Note: we require [fresh] to respect permutations, which is needed to define the
aforementioned [fresh] function on finite sets that respects set equality. *)
Class Fresh A C := fresh: C A. Class Fresh A C := fresh: C A.
Hint Mode Fresh - ! : typeclass_instances. Hint Mode Fresh - ! : typeclass_instances.
Instance: Params (@fresh) 3 := {}. Instance: Params (@fresh) 3 := {}.
Class FreshSpec A C `{ElemOf A C,
Empty C, Singleton A C, Union C, Fresh A C} : Prop := { Class Infinite A := {
fresh_set_semi_set :>> SemiSet A C; infinite_fresh :> Fresh A (list A);
fresh_proper_alt X Y : ( x, x X x Y) fresh X = fresh Y; infinite_is_fresh (xs : list A) : fresh xs xs;
is_fresh (X : C) : fresh X X infinite_fresh_Permutation :> Proper (@Permutation A ==> (=)) fresh;
}. }.
(** * Miscellaneous *) (** * Miscellaneous *)
......
...@@ -7,7 +7,9 @@ From stdpp Require Import relations. ...@@ -7,7 +7,9 @@ From stdpp Require Import relations.
From stdpp Require Export numbers sets. From stdpp Require Export numbers sets.
Set Default Proof Using "Type*". Set Default Proof Using "Type*".
(** Operations *)
Instance set_size `{Elements A C} : Size C := length elements. Instance set_size `{Elements A C} : Size C := length elements.
Definition set_fold `{Elements A C} {B} Definition set_fold `{Elements A C} {B}
(f : A B B) (b : B) : C B := foldr f b elements. (f : A B B) (b : B) : C B := foldr f b elements.
...@@ -21,6 +23,28 @@ Definition set_map `{Elements A C, Singleton B D, Empty D, Union D} ...@@ -21,6 +23,28 @@ Definition set_map `{Elements A C, Singleton B D, Empty D, Union D}
list_to_set (f <$> elements X). list_to_set (f <$> elements X).
Typeclasses Opaque set_map. Typeclasses Opaque set_map.
Instance set_fresh `{Elements A C, Fresh A (list A)} : Fresh A C :=
fresh elements.
Typeclasses Opaque set_filter.
(** We generalize the [fresh] operation on sets to generate lists of fresh
elements w.r.t. a set [X]. *)
Fixpoint fresh_list `{Fresh A C, Union C, Singleton A C}
(n : nat) (X : C) : list A :=
match n with
| 0 => []
| S n => let x := fresh X in x :: fresh_list n ({[ x ]} X)
end.
Instance: Params (@fresh_list) 6 := {}.
(** The following inductive predicate classifies that a list of elements is
in fact fresh w.r.t. a set [X]. *)
Inductive Forall_fresh `{ElemOf A C} (X : C) : list A Prop :=
| Forall_fresh_nil : Forall_fresh X []
| Forall_fresh_cons x xs :
x xs x X Forall_fresh X xs Forall_fresh X (x :: xs).
(** Properties **)
Section fin_set. Section fin_set.
Context `{FinSet A C}. Context `{FinSet A C}.
Implicit Types X Y : C. Implicit Types X Y : C.
...@@ -342,4 +366,58 @@ Proof. ...@@ -342,4 +366,58 @@ Proof.
- intros Hinf X. destruct (Hinf (elements X)). set_solver. - intros Hinf X. destruct (Hinf (elements X)). set_solver.
- intros Hinf xs. destruct (Hinf (list_to_set xs)). set_solver. - intros Hinf xs. destruct (Hinf (list_to_set xs)). set_solver.
Qed. Qed.
Section infinite.
Context `{Infinite A}.
(** Properties about the [fresh] operation on finite sets *)
Global Instance fresh_proper: Proper ((@{C}) ==> (=)) fresh.
Proof. unfold fresh, set_fresh. solve_proper. Qed.
Lemma is_fresh X : fresh X X.
Proof.
unfold fresh, set_fresh. rewrite <-elem_of_elements. apply infinite_is_fresh.
Qed.
Lemma exist_fresh X : x, x X.
Proof. exists (fresh X). apply is_fresh. Qed.
(** Properties about the [fresh_list] operation on finite sets *)
Global Instance fresh_list_proper n : Proper ((@{C}) ==> (=)) (fresh_list n).
Proof. induction n as [|n IH]; intros ?? E; by setoid_subst. Qed.
Lemma Forall_fresh_NoDup X xs : Forall_fresh X xs NoDup xs.
Proof. induction 1; by constructor. Qed.
Lemma Forall_fresh_elem_of X xs x : Forall_fresh X xs x xs x X.
Proof.
intros HX; revert x; rewrite <-Forall_forall. by induction HX; constructor.
Qed.
Lemma Forall_fresh_alt X xs :
Forall_fresh X xs NoDup xs x, x xs x X.
Proof.
split; eauto using Forall_fresh_NoDup, Forall_fresh_elem_of.
rewrite <-Forall_forall.
intros [Hxs Hxs']. induction Hxs; decompose_Forall_hyps; constructor; auto.
Qed.
Lemma Forall_fresh_subseteq X Y xs :
Forall_fresh X xs Y X Forall_fresh Y xs.
Proof. rewrite !Forall_fresh_alt; set_solver. Qed.
Lemma fresh_list_length n X : length (fresh_list n X) = n.
Proof. revert X. induction n; simpl; auto. Qed.
Lemma fresh_list_is_fresh n X x : x fresh_list n X x X.
Proof.
revert X. induction n as [|n IH]; intros X; simpl;[by rewrite elem_of_nil|].
rewrite elem_of_cons; intros [->| Hin]; [apply is_fresh|].
apply IH in Hin; set_solver.
Qed.
Lemma NoDup_fresh_list n X : NoDup (fresh_list n X).
Proof.
revert X. induction n; simpl; constructor; auto.
intros Hin; apply fresh_list_is_fresh in Hin; set_solver.
Qed.
Lemma Forall_fresh_list X n : Forall_fresh X (fresh_list n X).
Proof.
rewrite Forall_fresh_alt; eauto using NoDup_fresh_list, fresh_list_is_fresh.
Qed.
End infinite.
End fin_set. End fin_set.
...@@ -264,9 +264,3 @@ Proof. ...@@ -264,9 +264,3 @@ Proof.
- by rewrite option_guard_True by (rewrite elem_of_dom; eauto). - by rewrite option_guard_True by (rewrite elem_of_dom; eauto).
- by rewrite option_guard_False by (rewrite not_elem_of_dom; eauto). - by rewrite option_guard_False by (rewrite not_elem_of_dom; eauto).
Qed. Qed.
(** * Fresh elements *)
Instance gset_fresh `{Countable A, Infinite A} : Fresh A (gset A) :=
fresh_generic.
Instance gset_fresh_spec `{Countable A, Infinite A} : FreshSpec A (gset A) :=
fresh_generic_spec.
This diff is collapsed.
...@@ -84,20 +84,3 @@ Qed. ...@@ -84,20 +84,3 @@ Qed.
Notation Nset := (mapset Nmap). 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.
(** * Fresh numbers *)
Definition Nfresh {A} (m : Nmap A) : N :=
match m with NMap None _ => 0 | NMap _ m => Npos (Pfresh m) end.
Lemma Nfresh_fresh {A} (m : Nmap A) : m !! Nfresh m = None.
Proof. destruct m as [[]]. apply Pfresh_fresh. done. Qed.
Instance Nset_fresh : Fresh N Nset := λ X,
let (m) := X in Nfresh m.
Instance Nset_fresh_spec : FreshSpec N Nset.
Proof.
split.
- apply _.
- intros X Y; rewrite <-elem_of_equiv_L. by intros ->.
- unfold elem_of, mapset_elem_of, fresh; intros [m]; simpl.
by rewrite Nfresh_fresh.
Qed.
...@@ -314,66 +314,3 @@ Qed. ...@@ -314,66 +314,3 @@ Qed.
Notation Pset := (mapset Pmap). Notation Pset := (mapset Pmap).
Instance Pmap_dom {A} : Dom (Pmap A) Pset := mapset_dom. Instance Pmap_dom {A} : Dom (Pmap A) Pset := mapset_dom.
Instance Pmap_dom_spec : FinMapDom positive Pmap Pset := mapset_dom_spec. 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.
...@@ -865,69 +865,6 @@ Section more_quantifiers. ...@@ -865,69 +865,6 @@ Section more_quantifiers.
Proof. unfold set_Exists. naive_solver. Qed. Proof. unfold set_Exists. naive_solver. Qed.
End more_quantifiers. End more_quantifiers.
(** * Fresh elements *)
(** We collect some properties on the [fresh] operation. In particular we
generalize [fresh] to generate lists of fresh elements. *)
Fixpoint fresh_list `{Fresh A C, Union C, Singleton A C}
(n : nat) (X : C) : list A :=
match n with
| 0 => []
| S n => let x := fresh X in x :: fresh_list n ({[ x ]} X)
end.
Instance: Params (@fresh_list) 6 := {}.
Inductive Forall_fresh `{ElemOf A C} (X : C) : list A Prop :=
| Forall_fresh_nil : Forall_fresh X []
| Forall_fresh_cons x xs :
x xs x X Forall_fresh X xs Forall_fresh X (x :: xs).
Section fresh.
Context `{FreshSpec A C}.
Implicit Types X Y : C.
Global Instance fresh_proper: Proper ((@{C}) ==> (=)) fresh.
Proof. intros ???. by apply fresh_proper_alt, elem_of_equiv. Qed.
Global Instance fresh_list_proper n : Proper ((@{C}) ==> (=)) (fresh_list n).
Proof. induction n as [|n IH]; intros ?? E; by setoid_subst. Qed.
Lemma exist_fresh X : x, x X.
Proof. exists (fresh X). apply is_fresh. Qed.
Lemma Forall_fresh_NoDup X xs : Forall_fresh X xs NoDup xs.
Proof. induction 1; by constructor. Qed.
Lemma Forall_fresh_elem_of X xs x : Forall_fresh X xs x xs x X.
Proof.
intros HX; revert x; rewrite <-Forall_forall. by induction HX; constructor.
Qed.
Lemma Forall_fresh_alt X xs :
Forall_fresh X xs NoDup xs x, x xs x X.
Proof.
split; eauto using Forall_fresh_NoDup, Forall_fresh_elem_of.
rewrite <-Forall_forall.
intros [Hxs Hxs']. induction Hxs; decompose_Forall_hyps; constructor; auto.
Qed.
Lemma Forall_fresh_subseteq X Y xs :
Forall_fresh X xs Y X Forall_fresh Y xs.
Proof. rewrite !Forall_fresh_alt; set_solver. Qed.
Lemma fresh_list_length n X : length (fresh_list n X) = n.
Proof. revert X. induction n; simpl; auto. Qed.
Lemma fresh_list_is_fresh n X x : x fresh_list n X x X.
Proof.
revert X. induction n as [|n IH]; intros X; simpl;[by rewrite elem_of_nil|].
rewrite elem_of_cons; intros [->| Hin]; [apply is_fresh|].
apply IH in Hin; set_solver.
Qed.
Lemma NoDup_fresh_list n X : NoDup (fresh_list n X).
Proof.
revert X. induction n; simpl; constructor; auto.
intros Hin; apply fresh_list_is_fresh in Hin; set_solver.
Qed.
Lemma Forall_fresh_list X n : Forall_fresh X (fresh_list n X).
Proof.
rewrite Forall_fresh_alt; eauto using NoDup_fresh_list, fresh_list_is_fresh.
Qed.
End fresh.
(** * Properties of implementations of sets that form a monad *) (** * Properties of implementations of sets that form a monad *)
Section set_monad. Section set_monad.
Context `{MonadSet M}. Context `{MonadSet M}.
...@@ -1003,6 +940,11 @@ Section pred_finite_infinite. ...@@ -1003,6 +940,11 @@ Section pred_finite_infinite.
Lemma pred_not_infinite_finite {A} (P : A Prop) : Lemma pred_not_infinite_finite {A} (P : A Prop) :
pred_infinite P pred_finite P False. pred_infinite P pred_finite P False.
Proof. intros Hinf [xs ?]. destruct (Hinf xs). set_solver. Qed. Proof. intros Hinf [xs ?]. destruct (Hinf xs). set_solver. Qed.
Lemma pred_infinite_True `{Infinite A} : pred_infinite (λ _: A, True).
Proof.
intros xs. exists (fresh xs). split; [done|]. apply infinite_is_fresh.
Qed.
End pred_finite_infinite. End pred_finite_infinite.
Section set_finite_infinite. Section set_finite_infinite.
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment