(* Un tipo di valori totalmente ordinati *)

module type ORDERED =
sig
  type t
  val eq  : t * t -> bool
  val lt  : t * t -> bool
  val leq : t * t -> bool
end;;

module IntOrdered:(ORDERED with type t = int) =
struct
  type t = int
  let eq (i1,i2) = (i1 = i2)
  let lt (i1,i2) = (i1 < i2)
  let leq (i1,i2) = (i1 <= i2)
end;;

(* un insieme *)

module type SET =
sig
  type t
  type set
  val empty     : set
  val member    : t -> set -> bool
  val insert    : t -> set -> set
end

(* alberi rosso-neri *)

module RedBlackTree(Elt:ORDERED) : (SET with type t = Elt.t) =
struct
  type t = Elt.t
  type color = R | B
  type tree = E | T of color * tree * t * tree

  type set = tree

  (* funzioni private *)
  let forceB t = match t with
    E -> E
  | T(B,_,_,_) -> t
  | T(R,a,y,b) -> T(B,a,y,b)

  let balance color l v r = match (color,l,v,r) with
    (B,T(R,T(R,a,x,b),y,c),z,d) -> T(R,T(B,a,x,b),y,T(B,c,z,d))
  | (B,T(R,a,x,T(R,b,y,c)),z,d) -> T(R,T(B,a,x,b),y,T(B,c,z,d))
  | (B,a,x,T(R,T(R,b,y,c),z,d)) -> T(R,T(B,a,x,b),y,T(B,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))
  | (_,_,_,_) -> T(color,l,v,r)

  let empty = E

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

  let insert x s =
    let rec ins t = match t with
      E -> T(R,E,x,E)
    | T(color,a,y,b) ->
        if Elt.lt(x,y) then balance color (ins a) y b
        else if Elt.lt(y,x) then balance color a y (ins b)
        else s
    in forceB (ins s)
end

module IntRedBlackTree = RedBlackTree(IntOrdered)