let balance_left l x r =
    match l, x, r with
      | Red(Red(a, x, b), y, c), z, d
      | Red(a, x, Red(b, y, c)), z, d ->
          Red(Black(a, x, b), y, Black(c, z, d))
      | l, x, r ->
          Black(l, x, r)

  let balance_right l x r =
    match l, x, r with
      | a, x, Red(Red(b, y, c), z, d)
      | a, x, Red(b, y, Red(c, z, d)) ->
          Red(Black(a, x, b), y, Black(c, z, d))
      | l, x, r ->
          Black(l, x, r)

  let unbalanced_left = function
    | Red(Black(a, x, b), y, c) -> balance_left (Red(a, x, b)) y c, false
    | Black(Black(a, x, b), y, c) -> balance_left (Red(a, x, b)) y c, true
    | Black(Red(a, x, Black(b, y, c)), z, d) -> Black(a, x, balance_left (Red(b, y, c)) z d), false
    | _ -> assert false

  let unbalanced_right = function
    | Red(a, x, Black(b, y, c)) -> balance_right a x (Red(b, y, c)), false
    | Black(a, x, Black(b, y, c)) -> balance_right a x (Red(b, y, c)), true
    | Black(a, x, Red(Black(b, y, c), z, d)) -> Black(balance_right a x (Red(b, y, c)), z, d), false
    | _ -> assert false


  let rec remove_min = function
    | Empty
    | Black(Empty, _, Black(_)) ->
        assert false
    | Black(Empty, x, Empty) ->
        Empty, x, true
    | Black(Empty, x, Red(l, y, r)) ->
        Black(l, y, r), x, false
    | Red(Empty, x, r) ->
        r, x, false
    | Black(l, x, r) ->
        let l, y, d = remove_min l in
        let s = Black(l, x, r) in
          if d then
            let s, d = unbalanced_right s in s, y, d
          else
            s, y, false
    | Red(l, x, r) ->
        let l, y, d = remove_min l in
        let s = Red(l, x, r) in
          if d then
            let s, d = unbalanced_right s in s, y, d
          else
            s, y, false

  let remove x s =
    let rec remove_aux = function
      | Empty ->
          Empty, false
      | Black(l, y, r) ->
          let c = Ord.compare x y in
            if c < 0 then
              let l, d = remove_aux l in
              let s = Black(l, y, r) in
                if d then unbalanced_right s else s, false
            else if c > 0 then
              let r, d = remove_aux r in
              let s = Black(l, y, r) in
                if d then unbalanced_left s else s, false
            else
              begin match r with
                | Empty ->
                    blackify l
                | _ ->
                    let r, y, d = remove_min r in
                    let s = Black(l, y, r) in
                      if d then unbalanced_left s else s, false
              end
      | Red(l, y, r) ->
          let c = Ord.compare x y in
            if c < 0 then
              let l, d = remove_aux l in
              let s = Red(l, y, r) in
                if d then unbalanced_right s else s, false
            else if c > 0 then
              let r, d = remove_aux r in
              let s = Red(l, y, r) in
                if d then unbalanced_left s else s, false
            else
              begin match r with
                | Empty ->
                    l, false
                | _ ->
                    let r, y, d = remove_min r in
                    let s = Red(l, y, r) in
                      if d then unbalanced_left s else s, false
              end
    in fst (remove_aux s)