Module R.
Inductive t : Type := Nil | Cons (lo hi: Z) (tl: t).
Fixpoint In (x: Z) (s: t) :=
match s with
| Nil => False
| Cons l h s' => l <= x < h \/ In x s'
end.
Inductive ok: t -> Prop :=
| ok_nil: ok Nil
| ok_cons: forall l h s
(BOUNDS: l < h)
(BELOW: forall x, In x s -> h < x)
(OK: ok s),
ok (Cons l h s).
Fixpoint mem (x: Z) (s: t) : bool :=
match s with
| Nil => false
| Cons l h s' => if zlt x h then zle l x else mem x s'
end.
Fixpoint contains (L H: Z) (s: t) : bool :=
match s with
| Nil => false
| Cons l h s' => (zle H h && zle l L) || contains L H s'
end.
Fixpoint add (L H: Z) (s: t) {struct s} : t :=
match s with
| Nil => Cons L H Nil
| Cons l h s' =>
if zlt h L then Cons l h (add L H s')
else if zlt H l then Cons L H s
else add (Z.min l L) (Z.max h H) s'
end.
Fixpoint remove (L H: Z) (s: t) {struct s} : t :=
match s with
| Nil => Nil
| Cons l h s' =>
if zlt h L then Cons l h (remove L H s')
else if zlt H l then s
else if zlt l L then
if zlt H h then Cons l L (Cons H h s') else Cons l L (remove L H s')
else
if zlt H h then Cons H h s' else remove L H s'
end.
Fixpoint inter (s1 s2: t) {struct s1} : t :=
let fix intr (s2: t) : t :=
match s1, s2 with
| Nil, _ => Nil
| _, Nil => Nil
| Cons l1 h1 s1', Cons l2 h2 s2' =>
if zle h1 l2 then inter s1' s2
else if zle h2 l1 then intr s2'
else if zle l1 l2 then
if zle h2 h1 then Cons l2 h2 (intr s2') else Cons l2 h1 (inter s1' s2)
else
if zle h1 h2 then Cons l1 h1 (inter s1' s2) else Cons l1 h2 (intr s2')
end
in intr s2.
Fixpoint union (s1 s2: t) : t :=
match s1, s2 with
| Nil, _ => s2
| _, Nil => s1
| Cons l1 h1 s1', Cons l2 h2 s2' => add l1 h1 (add l2 h2 (union s1' s2'))
end.
Fixpoint beq (s1 s2: t) : bool :=
match s1, s2 with
| Nil, Nil => true
| Cons l1 h1 t1, Cons l2 h2 t2 => zeq l1 l2 && zeq h1 h2 && beq t1 t2
| _, _ => false
end.
End R.
(** Exported interface, wrapping the [ok] invariant in a dependent type. *)
Definition t := { r: R.t | R.ok r }.
Program Definition In (x: Z) (s: t) := R.In x s.
Program Definition empty : t := R.Nil.
Next Obligation. constructor. Qed.
Program Definition interval (l h: Z) : t :=
if zlt l h then R.Cons l h R.Nil else R.Nil.
Next Obligation.
constructor; auto. simpl; tauto. constructor.
Qed.
Next Obligation.
constructor.
Qed.
Program Definition add (l h: Z) (s: t) : t :=
if zlt l h then R.add l h s else s.
Next Obligation.
apply R.add_ok. apply proj2_sig. auto.
Qed.
Program Definition remove (l h: Z) (s: t) : t :=
if zlt l h then R.remove l h s else s.
Next Obligation.
apply R.remove_ok. auto. apply proj2_sig.
Qed.
Program Definition inter (s1 s2: t) : t := R.inter s1 s2.
Next Obligation. apply R.inter_ok; apply proj2_sig. Qed.
Program Definition union (s1 s2: t) : t := R.union s1 s2.
Next Obligation.
destruct (R.In_ok_union _ (proj2_sig s1) _ (proj2_sig s2)). auto.
Qed.

Theorem In_union: forall x s1 s2, In x (union s1 s2) <-> In x s1 \/ In x s2.