(************************************************************************)
(*         *      The Rocq Prover / The Rocq Development Team           *)
(*  v      *         Copyright INRIA, CNRS and contributors             *)
(* <O___,, * (see version control and CREDITS file for authors & dates) *)
(*   \VV/  **************************************************************)
(*    //   *    This file is distributed under the terms of the         *)
(*         *     GNU Lesser General Public License Version 2.1          *)
(*         *     (see LICENSE file for the text of the license)         *)
(************************************************************************)
(** * Finite sets library *)
(** This file proposes an implementation of the non-dependent interface [MSetWeakInterface.S] using lists without redundancy. *)
Set Implicit Arguments.
Unset Strict Implicit.
Local Ltac Tauto.intuition_solver ::= auto with typeclass_instances.
(** * Functions over lists  First, we provide sets as lists which are (morally) without redundancy. The specs are proved under the additional condition of no redundancy. And the functions returning sets are proved to preserve this invariant. *)
(** ** The set operations. *)
Module Ops (X: DecidableType) <: WOps X.
Definition elt := X.t.
Definition t := list elt.
Definition empty : t := nil.
Definition is_empty (l : t) : bool := if l then true else false.
Fixpoint mem (x : elt) (s : t) : bool :=
match s with
| nil => false
| y :: l =>
if X.eq_dec x y then true else mem x l
end.
Fixpoint add (x : elt) (s : t) : t :=
match s with
| nil => x :: nil
| y :: l =>
if X.eq_dec x y then s else y :: add x l
end.
Definition singleton (x : elt) : t := x :: nil.
Fixpoint remove (x : elt) (s : t) : t :=
match s with
| nil => nil
| y :: l =>
if X.eq_dec x y then l else y :: remove x l
end.
Definition fold (B : Type) (f : elt -> B -> B) : t -> B -> B :=
fold_left (flip f).
Definition union (s : t) : t -> t := fold add s.
Definition diff (s s' : t) : t := fold remove s' s.
Definition inter (s s': t) : t :=
fold (fun x s => if mem x s' then add x s else s) s nil.
Definition subset (s s' : t) : bool := is_empty (diff s s').
Definition equal (s s' : t) : bool := andb (subset s s') (subset s' s).
Fixpoint filter (f : elt -> bool) (s : t) : t :=
match s with
| nil => nil
| x :: l => if f x then x :: filter f l else filter f l
end.
Fixpoint for_all (f : elt -> bool) (s : t) : bool :=
match s with
| nil => true
| x :: l => if f x then for_all f l else false
end.
Fixpoint exists_ (f : elt -> bool) (s : t) : bool :=
match s with
| nil => false
| x :: l => if f x then true else exists_ f l
end.
Fixpoint partition (f : elt -> bool) (s : t) : t * t :=
match s with
| nil => (nil, nil)
| x :: l =>
let (s1, s2) := partition f l in
if f x then (x :: s1, s2) else (s1, x :: s2)
end.
Definition cardinal (s : t) : nat := length s.
Definition elements (s : t) : list elt := s.
Definition choose (s : t) : option elt :=
match s with
| nil => None
| x::_ => Some x
end.
End Ops.
(** ** Proofs of set operation specifications. *)
Module MakeRaw (X:DecidableType) <: WRawSets X.
Include Ops X.
Section ForNotations.
Notation NoDup := (NoDupA X.eq).
Notation In := (InA X.eq).
(* TODO: modify proofs in order to avoid these hints *)
Let eqr:= (@Equivalence_Reflexive _ _ X.eq_equiv).
Let eqsym:= (@Equivalence_Symmetric _ _ X.eq_equiv).
Let eqtrans:= (@Equivalence_Transitive _ _ X.eq_equiv).
#[local]
Hint Resolve eqr eqtrans : core.
#[local]
Hint Immediate eqsym : core.
Definition IsOk := NoDup.
Class Ok (s:t) : Prop := ok : NoDup s.
#[local]
Hint Unfold Ok : core.
#[local]
Hint Resolve ok : core.
Instance NoDup_Ok s (nd : NoDup s) : Ok s := { ok := nd }.
Ltac inv_ok := match goal with
| H:Ok (_ :: _) |- _ => inversion_clear H; inv_ok
| H:Ok nil |- _ => clear H; inv_ok
| H:NoDup ?l |- _ => change (Ok l) in H; inv_ok
| _ => idtac
end.
Ltac inv := invlist InA; inv_ok.
Ltac constructors := repeat constructor.
Fixpoint isok l := match l with
| nil => true
| a::l => negb (mem a l) && isok l
end.
Definition Equal s s' := forall a : elt, In a s <-> In a s'.
Definition Subset s s' := forall a : elt, In a s -> In a s'.
Definition Empty s := forall a : elt, ~ In a s.
Definition For_all (P : elt -> Prop) s := forall x, In x s -> P x.
Definition Exists (P : elt -> Prop) s := exists x, In x s /\ P x.

Lemma add_spec :
forall (s : t) (x y : elt) {Hs : Ok s},
In y (add x s) <-> X.eq y x \/ In y s.