(************************************************************************)
(*         *      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 [MSetInterface.S] using strictly ordered list. *)
Require Export MSetInterface OrdersFacts OrdersLists.
Set Implicit Arguments.
Unset Strict Implicit.
(** * Functions over lists  First, we provide sets as lists which are not necessarily sorted. The specs are proved under the additional condition of being sorted. And the functions returning sets are proved to preserve this invariant. *)
Module Ops (X:OrderedType) <: WOps X.
Definition elt := X.t.
Definition t := list elt.
Definition empty : t := nil.
Definition is_empty (l : t) := if l then true else false.
(** ** The set operations. *)
Fixpoint mem x s :=
match s with
| nil => false
| y :: l =>
match X.compare x y with
| Lt => false
| Eq => true
| Gt => mem x l
end
end.
Fixpoint add x s :=
match s with
| nil => x :: nil
| y :: l =>
match X.compare x y with
| Lt => x :: s
| Eq => s
| Gt => y :: add x l
end
end.
Definition singleton (x : elt) := x :: nil.
Fixpoint remove x s : t :=
match s with
| nil => nil
| y :: l =>
match X.compare x y with
| Lt => s
| Eq => l
| Gt => y :: remove x l
end
end.
Fixpoint union (s : t) : t -> t :=
match s with
| nil => fun s' => s'
| x :: l =>
(fix union_aux (s' : t) : t :=
match s' with
| nil => s
| x' :: l' =>
match X.compare x x' with
| Lt => x :: union l s'
| Eq => x :: union l l'
| Gt => x' :: union_aux l'
end
end)
end.
Fixpoint inter (s : t) : t -> t :=
match s with
| nil => fun _ => nil
| x :: l =>
(fix inter_aux (s' : t) : t :=
match s' with
| nil => nil
| x' :: l' =>
match X.compare x x' with
| Lt => inter l s'
| Eq => x :: inter l l'
| Gt => inter_aux l'
end
end)
end.
Fixpoint diff (s : t) : t -> t :=
match s with
| nil => fun _ => nil
| x :: l =>
(fix diff_aux (s' : t) : t :=
match s' with
| nil => s
| x' :: l' =>
match X.compare x x' with
| Lt => x :: diff l s'
| Eq => diff l l'
| Gt => diff_aux l'
end
end)
end.
Fixpoint equal (s : t) : t -> bool :=
fun s' : t =>
match s, s' with
| nil, nil => true
| x :: l, x' :: l' =>
match X.compare x x' with
| Eq => equal l l'
| _ => false
end
| _, _ => false
end.
Fixpoint subset s s' :=
match s, s' with
| nil, _ => true
| x :: l, x' :: l' =>
match X.compare x x' with
| Lt => false
| Eq => subset l l'
| Gt => subset s l'
end
| _, _ => false
end.
Definition fold (B : Type) (f : elt -> B -> B) (s : t) (i : B) : B :=
fold_left (flip f) s i.
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 (x : t) : list elt := x.
Definition min_elt (s : t) : option elt :=
match s with
| nil => None
| x :: _ => Some x
end.
Fixpoint max_elt (s : t) : option elt :=
match s with
| nil => None
| x :: nil => Some x
| _ :: l => max_elt l
end.
Definition choose := min_elt.
Fixpoint compare s s' :=
match s, s' with
| nil, nil => Eq
| nil, _ => Lt
| _, nil => Gt
| x::s, x'::s' =>
match X.compare x x' with
| Eq => compare s s'
| Lt => Lt
| Gt => Gt
end
end.
End Ops.
Module MakeRaw (X: OrderedType) <: RawSets X.
Module Import MX := OrderedTypeFacts X.
Module Import ML := OrderedTypeLists X.
Include Ops X.
(** ** Proofs of set operation specifications. *)
Section ForNotations.
Definition inf x l :=
match l with
| nil => true
| y::_ => match X.compare x y with Lt => true | _ => false end
end.
Fixpoint isok l :=
match l with
| nil => true
| x::l => inf x l && isok l
end.
Notation Sort l := (isok l = true).
Notation Inf := (lelistA X.lt).
Notation In := (InA X.eq).
Existing Instance X.eq_equiv.
#[local]
Hint Extern 20 => solve [order] : core.
Definition IsOk s := Sort s.
Class Ok (s:t) : Prop := ok : Sort s.
#[local]
Hint Resolve ok : core.
#[local]
Hint Unfold Ok : core.
Instance Sort_Ok s `(Hs : Sort s) : Ok s := { ok := Hs }.

(* Specifications: *)
Lemma inf_iff : forall x l, Inf x l <-> inf x l = true.
Lemma isok_iff : forall l, sort X.lt l <-> Ok l.
#[local]
Hint Extern 1 (Ok _) => rewrite <- isok_iff : core.