open Prims
type color =
  | R 
  | B 
let uu___is_R (projectee : color) : Prims.bool=
  match projectee with | R -> true | uu___ -> false
let uu___is_B (projectee : color) : Prims.bool=
  match projectee with | B -> true | uu___ -> false
type 'a rbset =
  | L 
  | N of (color * 'a rbset * 'a * 'a rbset) 
let uu___is_L (projectee : 'a rbset) : Prims.bool=
  match projectee with | L -> true | uu___ -> false
let uu___is_N (projectee : 'a rbset) : Prims.bool=
  match projectee with | N _0 -> true | uu___ -> false
let __proj__N__item___0 (projectee : 'a rbset) :
  (color * 'a rbset * 'a * 'a rbset)= match projectee with | N _0 -> _0
type 'a t = 'a rbset
let empty (uu___ : unit) : 'uuuuu rbset= L
let singleton (x : 'a) : 'a rbset= N (R, L, x, L)
let is_empty (uu___ : unit) : 'uuuuu rbset -> Prims.bool= uu___is_L
let balance (c : color) (l : 'uuuuu rbset) (x : 'uuuuu) (r : 'uuuuu rbset) :
  'uuuuu rbset=
  match (c, l, x, r) with
  | (B, N (R, N (R, a, x1, b), y, c1), z, d) ->
      N (R, (N (B, a, x1, b)), y, (N (B, c1, z, d)))
  | (B, a, x1, N (R, N (R, b, y, c1), z, d)) ->
      N (R, (N (B, a, x1, b)), y, (N (B, c1, z, d)))
  | (B, N (R, a, x1, N (R, b, y, c1)), z, d) ->
      N (R, (N (B, a, x1, b)), y, (N (B, c1, z, d)))
  | (B, a, x1, N (R, b, y, N (R, c1, z, d))) ->
      N (R, (N (B, a, x1, b)), y, (N (B, c1, z, d)))
  | (c1, l1, x1, r1) -> N (c1, l1, x1, r1)
let blackroot (t1 : 'a rbset) : 'a rbset=
  match t1 with | N (uu___, l, x, r) -> N (B, l, x, r)
let add (uu___ : 'a FStarC_Class_Ord.ord) (x : 'a) (s : 'a rbset) : 'a rbset=
  let rec add' s1 =
    match s1 with
    | L -> N (R, L, x, L)
    | N (c, a1, y, b) ->
        let uu___1 = FStarC_Class_Ord.op_Less_Question uu___ x y in
        if uu___1
        then let uu___2 = add' a1 in balance c uu___2 y b
        else
          (let uu___3 = FStarC_Class_Ord.op_Greater_Question uu___ x y in
           if uu___3
           then let uu___4 = add' b in balance c a1 y uu___4
           else s1) in
  let uu___1 = add' s in blackroot uu___1
let filter (uu___ : 'a FStarC_Class_Ord.ord) (predicate : 'a -> Prims.bool)
  (set : 'a rbset) : 'a rbset=
  let rec aux acc uu___1 =
    match uu___1 with
    | L -> acc
    | N (uu___2, l, v, r) ->
        let uu___3 =
          let uu___4 =
            let uu___5 = predicate v in
            if uu___5 then add uu___ v acc else acc in
          aux uu___4 l in
        aux uu___3 r in
  aux (empty ()) set
let rec extract_min :
  'a . 'a FStarC_Class_Ord.ord -> 'a rbset -> ('a rbset * 'a) =
  fun uu___ t1 ->
    match t1 with
    | N (uu___1, L, x, r) -> (r, x)
    | N (c, a1, x, b) ->
        let uu___1 = extract_min uu___ a1 in
        (match uu___1 with | (a', y) -> ((balance c a' x b), y))
let rec remove : 'a . 'a FStarC_Class_Ord.ord -> 'a -> 'a rbset -> 'a rbset =
  fun uu___ x t1 ->
    match t1 with
    | L -> L
    | N (c, l, y, r) ->
        let uu___1 = FStarC_Class_Ord.op_Less_Question uu___ x y in
        if uu___1
        then let uu___2 = remove uu___ x l in balance c uu___2 y r
        else
          (let uu___3 = FStarC_Class_Ord.op_Greater_Question uu___ x y in
           if uu___3
           then let uu___4 = remove uu___ x r in balance c l y uu___4
           else
             if uu___is_L r
             then l
             else
               (let uu___6 = extract_min uu___ r in
                match uu___6 with | (r', y') -> balance c l y' r'))
let rec mem : 'a . 'a FStarC_Class_Ord.ord -> 'a -> 'a rbset -> Prims.bool =
  fun uu___ x s ->
    match s with
    | L -> false
    | N (uu___1, a1, y, b) ->
        let uu___2 = FStarC_Class_Ord.op_Less_Question uu___ x y in
        if uu___2
        then mem uu___ x a1
        else
          (let uu___4 = FStarC_Class_Ord.op_Greater_Question uu___ x y in
           if uu___4 then mem uu___ x b else true)
let rec elems : 'a . 'a rbset -> 'a Prims.list =
  fun s ->
    match s with
    | L -> []
    | N (uu___, a1, x, b) ->
        let uu___1 = elems a1 in
        let uu___2 = let uu___3 = elems b in FStarC_List.op_At [x] uu___3 in
        FStarC_List.op_At uu___1 uu___2
let equal (uu___ : 'a FStarC_Class_Ord.ord) (s1 : 'a rbset) (s2 : 'a rbset) :
  Prims.bool=
  let uu___1 = elems s1 in
  let uu___2 = elems s2 in
  FStarC_Class_Deq.op_Equals_Question
    (FStarC_Class_Ord.ord_eq (FStarC_Class_Ord.ord_list uu___)) uu___1 uu___2
let rec union :
  'a . 'a FStarC_Class_Ord.ord -> 'a rbset -> 'a rbset -> 'a rbset =
  fun uu___ s1 s2 ->
    match s1 with
    | L -> s2
    | N (c, a1, x, b) ->
        let uu___1 = let uu___2 = add uu___ x s2 in union uu___ b uu___2 in
        union uu___ a1 uu___1
let inter (uu___ : 'a FStarC_Class_Ord.ord) (s1 : 'a rbset) (s2 : 'a rbset) :
  'a rbset=
  let rec aux s11 acc =
    match s11 with
    | L -> acc
    | N (uu___1, a1, x, b) ->
        let uu___2 = mem uu___ x s2 in
        if uu___2
        then
          let uu___3 = let uu___4 = aux b acc in aux a1 uu___4 in
          add uu___ x uu___3
        else (let uu___4 = aux b acc in aux a1 uu___4) in
  aux s1 L
let rec diff :
  'a . 'a FStarC_Class_Ord.ord -> 'a rbset -> 'a rbset -> 'a rbset =
  fun uu___ s1 s2 ->
    match s2 with
    | L -> s1
    | N (uu___1, a1, x, b) ->
        let uu___2 = let uu___3 = remove uu___ x s1 in diff uu___ uu___3 a1 in
        diff uu___ uu___2 b
let rec subset :
  'a . 'a FStarC_Class_Ord.ord -> 'a rbset -> 'a rbset -> Prims.bool =
  fun uu___ s1 s2 ->
    match s1 with
    | L -> true
    | N (uu___1, a1, x, b) ->
        ((mem uu___ x s2) && (subset uu___ a1 s2)) && (subset uu___ b s2)
let rec for_all : 'a . ('a -> Prims.bool) -> 'a rbset -> Prims.bool =
  fun p s ->
    match s with
    | L -> true
    | N (uu___, a1, x, b) -> ((p x) && (for_all p a1)) && (for_all p b)
let rec for_any : 'a . ('a -> Prims.bool) -> 'a rbset -> Prims.bool =
  fun p s ->
    match s with
    | L -> false
    | N (uu___, a1, x, b) -> ((p x) || (for_any p a1)) || (for_any p b)
let from_list (uu___ : 'a FStarC_Class_Ord.ord) (xs : 'a Prims.list) :
  'a rbset= FStarC_List.fold_left (fun s e -> add uu___ e s) L xs
let addn (uu___ : 'a FStarC_Class_Ord.ord) (xs : 'a Prims.list)
  (s : 'a rbset) : 'a rbset=
  FStarC_List.fold_left (fun s1 e -> add uu___ e s1) s xs
let collect (uu___ : 'a FStarC_Class_Ord.ord) (f : 'a -> 'a rbset)
  (l : 'a Prims.list) : 'a rbset=
  FStarC_List.fold_left (fun s e -> let uu___1 = f e in union uu___ uu___1 s)
    L l
let setlike_rbset (uu___ : 'a FStarC_Class_Ord.ord) :
  ('a, 'a t) FStarC_Class_Setlike.setlike=
  {
    FStarC_Class_Setlike.empty = empty;
    FStarC_Class_Setlike.singleton = singleton;
    FStarC_Class_Setlike.is_empty = (is_empty ());
    FStarC_Class_Setlike.add = (add uu___);
    FStarC_Class_Setlike.remove = (remove uu___);
    FStarC_Class_Setlike.mem = (mem uu___);
    FStarC_Class_Setlike.equal = (equal uu___);
    FStarC_Class_Setlike.subset = (subset uu___);
    FStarC_Class_Setlike.union = (union uu___);
    FStarC_Class_Setlike.inter = (inter uu___);
    FStarC_Class_Setlike.diff = (diff uu___);
    FStarC_Class_Setlike.for_all = for_all;
    FStarC_Class_Setlike.for_any = for_any;
    FStarC_Class_Setlike.elems = elems;
    FStarC_Class_Setlike.filter = (filter uu___);
    FStarC_Class_Setlike.collect = (collect uu___);
    FStarC_Class_Setlike.from_list = (from_list uu___);
    FStarC_Class_Setlike.addn = (addn uu___)
  }
let showable_rbset (uu___ : 'a FStarC_Class_Show.showable) :
  'a t FStarC_Class_Show.showable=
  {
    FStarC_Class_Show.show =
      (fun s ->
         let uu___1 =
           let uu___2 = elems s in
           FStarC_Class_Show.show (FStarC_Class_Show.show_list uu___) uu___2 in
         Prims.strcat "RBSet " uu___1)
  }
