listset_nodup.v 3.83 KB
Newer Older
Robbert Krebbers's avatar
Robbert Krebbers committed
1
(* Copyright (c) 2012-2014, Robbert Krebbers. *)
Robbert Krebbers's avatar
Robbert Krebbers committed
2 3 4 5 6 7 8
(* 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. *)
Require Export base decidable collections list.

Record listset_nodup A := ListsetNoDup {
9
  listset_nodup_car : list A; listset_nodup_prf : NoDup listset_nodup_car
Robbert Krebbers's avatar
Robbert Krebbers committed
10 11 12 13 14 15 16 17 18 19 20
}.
Arguments ListsetNoDup {_} _ _.
Arguments listset_nodup_car {_} _.
Arguments listset_nodup_prf {_} _.

Section list_collection.
Context {A : Type} `{ x y : A, Decision (x = y)}.

Notation C := (listset_nodup A).
Notation LS := ListsetNoDup.

21 22
Instance listset_nodup_elem_of: ElemOf A C := λ x l, x  listset_nodup_car l.
Instance listset_nodup_empty: Empty C := LS [] (@NoDup_nil_2 _).
Robbert Krebbers's avatar
Robbert Krebbers committed
23 24 25
Instance listset_nodup_singleton: Singleton A C := λ x,
  LS [x] (NoDup_singleton x).
Instance listset_nodup_difference: Difference C := λ l k,
26
  let (l',Hl) := l in let (k',Hk) := k in LS _ (list_difference_nodup _ k' Hl).
Robbert Krebbers's avatar
Robbert Krebbers committed
27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45

Definition listset_nodup_union_raw (l k : list A) : list A :=
  list_difference l k ++ k.
Lemma elem_of_listset_nodup_union_raw l k x :
  x  listset_nodup_union_raw l k  x  l  x  k.
Proof.
  unfold listset_nodup_union_raw.
  rewrite elem_of_app, elem_of_list_difference.
  intuition. case (decide (x  k)); intuition.
Qed.
Lemma listset_nodup_union_raw_nodup l k :
  NoDup l  NoDup k  NoDup (listset_nodup_union_raw l k).
Proof.
  intros. apply NoDup_app. repeat split.
  * by apply list_difference_nodup.
  * intro. rewrite elem_of_list_difference. intuition.
  * done.
Qed.
Instance listset_nodup_union: Union C := λ l k,
46 47
  let (l',Hl) := l in let (k',Hk) := k
  in LS _ (listset_nodup_union_raw_nodup _ _ Hl Hk).
Robbert Krebbers's avatar
Robbert Krebbers committed
48
Instance listset_nodup_intersection: Intersection C := λ l k,
49 50 51 52 53 54 55
  let (l',Hl) := l in let (k',Hk) := k
  in LS _ (list_intersection_nodup _ k' Hl).
Instance listset_nodup_intersection_with: IntersectionWith A C := λ f l k,
  let (l',Hl) := l in let (k',Hk) := k
  in LS (remove_dups (list_intersection_with f l' k')) (remove_dups_nodup _).
Instance listset_nodup_filter: Filter A C := λ P _ l,
  let (l',Hl) := l in LS _ (filter_nodup P _ Hl).
Robbert Krebbers's avatar
Robbert Krebbers committed
56

57
Instance: Collection A C.
Robbert Krebbers's avatar
Robbert Krebbers committed
58
Proof.
59
  split; [split | | ].
Robbert Krebbers's avatar
Robbert Krebbers committed
60 61
  * by apply not_elem_of_nil.
  * by apply elem_of_list_singleton.
62 63 64
  * intros [??] [??] ?. apply elem_of_listset_nodup_union_raw.
  * intros [??] [??] ?. apply elem_of_list_intersection.
  * intros [??] [??] ?. apply elem_of_list_difference.
Robbert Krebbers's avatar
Robbert Krebbers committed
65 66 67 68 69 70 71 72 73 74
Qed.

Global Instance listset_nodup_elems: Elements A C := listset_nodup_car.
Global Instance: FinCollection A C.
Proof.
  split.
  * apply _.
  * done.
  * by intros [??].
Qed.
75 76 77 78
Global Instance: CollectionOps A C.
Proof.
  split.
  * apply _.
79 80
  * intros ? [??] [??] ?. unfold intersection_with, elem_of,
      listset_nodup_intersection_with, listset_nodup_elem_of; simpl.
81
    rewrite elem_of_remove_dups. by apply elem_of_list_intersection_with.
82
  * intros [??] ???. apply elem_of_list_filter.
83
Qed.
Robbert Krebbers's avatar
Robbert Krebbers committed
84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101
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.
Hint Extern 1 (Filter _ (listset_nodup _)) =>
  eapply @listset_nodup_filter : typeclass_instances.