module RBTreeFunctor (Element : Set.ORDERED) :
  (Set.SET with type elem = Element.elem) =
struct
  type elem = Element.elem

  type color = R | B
  type tree = E | T of color * tree * elem * tree
  type set = tree

  let empty() = E

  let rec member s x =
    match s with
      | E -> false
      | T (_, a, y, b) ->
          if Element.lt x y then member a x
          else if Element.lt y x then member b x
          else true

  let balance = function
    | B, T (R, T (R, a, x, b), y, c), z, d
    | B, T (R, a, x, T (R, b, y, c)), z, d
    | B, a, x, T (R, T (R, b, y, c), z, d)
    | B, a, x, T (R, b, y, T (R, c, z, d)) ->
        T (R, T (B, a, x, b), y, T (B, c, z, d))
    | a, b, c, d -> T (a, b, c, d)

  exception Unproper_use_of_set

  let insert s x =
    let rec ins = function
      | E -> T (R, E, x, E)
      | T (color, a, y, b) as s ->
          if Element.lt x y then balance (color, ins a, y, b)
          else if Element.lt y x then balance (color, a, y, ins b)
          else s in
    match ins s with  (* guaranteed to be non-empty *)
    | T (_, a, y, b) -> T (B, a, y, b)
    | _ -> raise Unproper_use_of_set

  exception Set_is_empty

  let remove s x = s (* to be implemented *)
end