Source file Baby.ml

# 1 "Baby.cppo.ml"
(******************************************************************************)
(*                                                                            *)
(*                                    Baby                                    *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*                                                                            *)
(*       Copyright 2024--2024 Inria. All rights reserved. This file is        *)
(*       distributed under the terms of the GNU Library General Public        *)
(*       License, with an exception, as described in the file LICENSE.        *)
(*                                                                            *)
(******************************************************************************)

include Signatures

(* -------------------------------------------------------------------------- *)

(* The functor [Baby.Make] constructs balanced binary search trees
   based on a user-supplied balancing scheme. *)

module[@inline] Make
(E : OrderedType)
(T : CORE with type key = E.t)
= struct
include T


# 1 "Macros.frag.ml"
(******************************************************************************)
(*                                                                            *)
(*                                    Baby                                    *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*                                                                            *)
(*       Copyright 2024--2024 Inria. All rights reserved. This file is        *)
(*       distributed under the terms of the GNU Library General Public        *)
(*       License, with an exception, as described in the file LICENSE.        *)
(*                                                                            *)
(******************************************************************************)

(* Derived macros. *)

(* [EMPTY(t)] determines whether the tree [t] is empty, that is, a leaf. *)


# 19 "Macros.frag.ml"
(* [BOTH_EMPTY(l,r)] determines whether the trees [l] and [r] are both empty. *)

# 1 "Common.frag.ml"
(******************************************************************************)
(*                                                                            *)
(*                                    Baby                                    *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*                                                                            *)
(*       Copyright 2024--2024 Inria. All rights reserved. This file is        *)
(*       distributed under the terms of the GNU Library General Public        *)
(*       License, with an exception, as described in the file LICENSE.        *)
(*                                                                            *)
(******************************************************************************)

(* -------------------------------------------------------------------------- *)

(* Types. *)

type elt = key
type set = tree
type t = set

(* -------------------------------------------------------------------------- *)

(* Operations. *)

# 1 "Empty.frag.ml"
(******************************************************************************)
(*                                                                            *)
(*                                    Baby                                    *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*                                                                            *)
(*       Copyright 2024--2024 Inria. All rights reserved. This file is        *)
(*       distributed under the terms of the GNU Library General Public        *)
(*       License, with an exception, as described in the file LICENSE.        *)
(*                                                                            *)
(******************************************************************************)

let empty : tree =
  leaf

let is_empty (t : tree) : bool =
  match 
# 17 "Empty.frag.ml"
               (view t)  
# 17 "Empty.frag.ml"
                with
  | 
# 18 "Empty.frag.ml"
              Leaf  
# 18 "Empty.frag.ml"
         ->
      true
  | 
# 20 "Empty.frag.ml"
     Node (_,  _,  _)  
# 20 "Empty.frag.ml"
                  ->
      false
# 1 "MinMax.frag.ml"
(******************************************************************************)
(*                                                                            *)
(*                                    Baby                                    *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*                                                                            *)
(*       Copyright 2024--2024 Inria. All rights reserved. This file is        *)
(*       distributed under the terms of the GNU Library General Public        *)
(*       License, with an exception, as described in the file LICENSE.        *)
(*                                                                            *)
(******************************************************************************)

let rec min_elt_1 (default : key) (t : tree) : key =
  match 
# 14 "MinMax.frag.ml"
               (view t)  
# 14 "MinMax.frag.ml"
                with
  | 
# 15 "MinMax.frag.ml"
              Leaf  
# 15 "MinMax.frag.ml"
         ->
      default
  | 
# 17 "MinMax.frag.ml"
     Node (l,  v,  _)  
# 17 "MinMax.frag.ml"
                  ->
      min_elt_1 v l

let min_elt (t : tree) : key =
  match 
# 21 "MinMax.frag.ml"
               (view t)  
# 21 "MinMax.frag.ml"
                with
  | 
# 22 "MinMax.frag.ml"
              Leaf  
# 22 "MinMax.frag.ml"
         ->
      raise Not_found
  | 
# 24 "MinMax.frag.ml"
     Node (l,  v,  _)  
# 24 "MinMax.frag.ml"
                  ->
      min_elt_1 v l

let rec min_elt_opt_1 (default : key) (t : tree) : key option =
  match 
# 28 "MinMax.frag.ml"
               (view t)  
# 28 "MinMax.frag.ml"
                with
  | 
# 29 "MinMax.frag.ml"
              Leaf  
# 29 "MinMax.frag.ml"
         ->
      Some default
  | 
# 31 "MinMax.frag.ml"
     Node (l,  v,  _)  
# 31 "MinMax.frag.ml"
                  ->
      min_elt_opt_1 v l

let min_elt_opt (t : tree) : key option =
  match 
# 35 "MinMax.frag.ml"
               (view t)  
# 35 "MinMax.frag.ml"
                with
  | 
# 36 "MinMax.frag.ml"
              Leaf  
# 36 "MinMax.frag.ml"
         ->
      None
  | 
# 38 "MinMax.frag.ml"
     Node (l,  v,  _)  
# 38 "MinMax.frag.ml"
                  ->
      min_elt_opt_1 v l

let rec max_elt_1 (default : key) (t : tree) : key =
  match 
# 42 "MinMax.frag.ml"
               (view t)  
# 42 "MinMax.frag.ml"
                with
  | 
# 43 "MinMax.frag.ml"
              Leaf  
# 43 "MinMax.frag.ml"
         ->
      default
  | 
# 45 "MinMax.frag.ml"
     Node (_,  v,  r)  
# 45 "MinMax.frag.ml"
                  ->
      max_elt_1 v r

let max_elt (t : tree) : key =
  match 
# 49 "MinMax.frag.ml"
               (view t)  
# 49 "MinMax.frag.ml"
                with
  | 
# 50 "MinMax.frag.ml"
              Leaf  
# 50 "MinMax.frag.ml"
         ->
      raise Not_found
  | 
# 52 "MinMax.frag.ml"
     Node (_,  v,  r)  
# 52 "MinMax.frag.ml"
                  ->
      max_elt_1 v r

let rec max_elt_opt_1 (default : key) (t : tree) : key option =
  match 
# 56 "MinMax.frag.ml"
               (view t)  
# 56 "MinMax.frag.ml"
                with
  | 
# 57 "MinMax.frag.ml"
              Leaf  
# 57 "MinMax.frag.ml"
         ->
      Some default
  | 
# 59 "MinMax.frag.ml"
     Node (_,  v,  r)  
# 59 "MinMax.frag.ml"
                  ->
      max_elt_opt_1 v r

let max_elt_opt (t : tree) : key option =
  match 
# 63 "MinMax.frag.ml"
               (view t)  
# 63 "MinMax.frag.ml"
                with
  | 
# 64 "MinMax.frag.ml"
              Leaf  
# 64 "MinMax.frag.ml"
         ->
      None
  | 
# 66 "MinMax.frag.ml"
     Node (_,  v,  r)  
# 66 "MinMax.frag.ml"
                  ->
      max_elt_opt_1 v r

(* As in OCaml's Set library, [choose] and [choose_opt] choose the minimum
   element of the set. This is slow (logarithmic time), but guarantees that
   [choose] respects equality: that is, if the sets [s1] and [s2] are equal
   then [choose s1] and [choose s2] are equal. *)

let choose =
  min_elt

let choose_opt =
  min_elt_opt
# 1 "Mem.frag.ml"
(******************************************************************************)
(*                                                                            *)
(*                                    Baby                                    *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*                                                                            *)
(*       Copyright 2024--2024 Inria. All rights reserved. This file is        *)
(*       distributed under the terms of the GNU Library General Public        *)
(*       License, with an exception, as described in the file LICENSE.        *)
(*                                                                            *)
(******************************************************************************)

(* -------------------------------------------------------------------------- *)

(* Membership. *)

let rec mem (x : key) (t : tree) : bool =
  match 
# 18 "Mem.frag.ml"
               (view t)  
# 18 "Mem.frag.ml"
                with
  | 
# 19 "Mem.frag.ml"
              Leaf  
# 19 "Mem.frag.ml"
         ->
      false
  | 
# 21 "Mem.frag.ml"
     Node (l,  v,  r)  
# 21 "Mem.frag.ml"
                  ->
      let c = E.compare x v in
      c = 0 || mem x (if c < 0 then l else r)
# 1 "Find.frag.ml"
(******************************************************************************)
(*                                                                            *)
(*                                    Baby                                    *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*                                                                            *)
(*       Copyright 2024--2024 Inria. All rights reserved. This file is        *)
(*       distributed under the terms of the GNU Library General Public        *)
(*       License, with an exception, as described in the file LICENSE.        *)
(*                                                                            *)
(******************************************************************************)

let rec find (x : key) (t : tree) : key =
  match 
# 14 "Find.frag.ml"
               (view t)  
# 14 "Find.frag.ml"
                with
  | 
# 15 "Find.frag.ml"
              Leaf  
# 15 "Find.frag.ml"
         ->
      raise Not_found
  | 
# 17 "Find.frag.ml"
     Node (l,  v,  r)  
# 17 "Find.frag.ml"
                  ->
      let c = E.compare x v in
      if c = 0 then
        v
      else if c < 0 then
        find x l
      else
        find x r

let rec find_opt (x : key) (t : tree) : key option =
  match 
# 27 "Find.frag.ml"
               (view t)  
# 27 "Find.frag.ml"
                with
  | 
# 28 "Find.frag.ml"
              Leaf  
# 28 "Find.frag.ml"
         ->
      None
  | 
# 30 "Find.frag.ml"
     Node (l,  v,  r)  
# 30 "Find.frag.ml"
                  ->
      let c = E.compare x v in
      if c = 0 then
        Some v
      else if c < 0 then
        find_opt x l
      else
        find_opt x r

(* -------------------------------------------------------------------------- *)

(* [find_first] and its variants are as in OCaml's Set library. *)

(* A lot of repetitive code. *)

(* It is worth noting that [find_first] is not a naive linear search.
   Instead, it assumes that [f] is a monotonically increasing function
   of elements to Booleans. This implies that there is at most one
   position in the increasing sequence of the set elements where the
   value of [f] changes, and it changes from [false] to [true]. This
   position can be found in logarithmic time. *)

let rec find_first_aux v0 f (t : tree) =
  match 
# 53 "Find.frag.ml"
               (view t)  
# 53 "Find.frag.ml"
                with
  | 
# 54 "Find.frag.ml"
              Leaf  
# 54 "Find.frag.ml"
         ->
      v0
  | 
# 56 "Find.frag.ml"
     Node (l,  v,  r)  
# 56 "Find.frag.ml"
                  ->
      if f v then
        find_first_aux v f l
      else
        find_first_aux v0 f r

let rec find_first f (t : tree) =
  match 
# 63 "Find.frag.ml"
               (view t)  
# 63 "Find.frag.ml"
                with
  | 
# 64 "Find.frag.ml"
              Leaf  
# 64 "Find.frag.ml"
         ->
      raise Not_found
  | 
# 66 "Find.frag.ml"
     Node (l,  v,  r)  
# 66 "Find.frag.ml"
                  ->
      if f v then
        find_first_aux v f l
      else
        find_first f r

let rec find_first_opt_aux v0 f (t : tree) =
  match 
# 73 "Find.frag.ml"
               (view t)  
# 73 "Find.frag.ml"
                with
  | 
# 74 "Find.frag.ml"
              Leaf  
# 74 "Find.frag.ml"
         ->
      Some v0
  | 
# 76 "Find.frag.ml"
     Node (l,  v,  r)  
# 76 "Find.frag.ml"
                  ->
      if f v then
        find_first_opt_aux v f l
      else
        find_first_opt_aux v0 f r

let rec find_first_opt f (t : tree) =
  match 
# 83 "Find.frag.ml"
               (view t)  
# 83 "Find.frag.ml"
                with
  | 
# 84 "Find.frag.ml"
              Leaf  
# 84 "Find.frag.ml"
         ->
      None
  | 
# 86 "Find.frag.ml"
     Node (l,  v,  r)  
# 86 "Find.frag.ml"
                  ->
      if f v then
        find_first_opt_aux v f l
      else
        find_first_opt f r

let rec find_last_aux v0 f (t : tree) =
  match 
# 93 "Find.frag.ml"
               (view t)  
# 93 "Find.frag.ml"
                with
  | 
# 94 "Find.frag.ml"
              Leaf  
# 94 "Find.frag.ml"
         ->
      v0
  | 
# 96 "Find.frag.ml"
     Node (l,  v,  r)  
# 96 "Find.frag.ml"
                  ->
      if f v then
        find_last_aux v f r
      else
        find_last_aux v0 f l

let rec find_last f (t : tree) =
  match 
# 103 "Find.frag.ml"
               (view t)  
# 103 "Find.frag.ml"
                with
  | 
# 104 "Find.frag.ml"
              Leaf  
# 104 "Find.frag.ml"
         ->
      raise Not_found
  | 
# 106 "Find.frag.ml"
     Node (l,  v,  r)  
# 106 "Find.frag.ml"
                  ->
      if f v then
        find_last_aux v f r
      else
        find_last f l

let rec find_last_opt_aux v0 f (t : tree) =
  match 
# 113 "Find.frag.ml"
               (view t)  
# 113 "Find.frag.ml"
                with
  | 
# 114 "Find.frag.ml"
              Leaf  
# 114 "Find.frag.ml"
         ->
      Some v0
  | 
# 116 "Find.frag.ml"
     Node (l,  v,  r)  
# 116 "Find.frag.ml"
                  ->
      if f v then
        find_last_opt_aux v f r
      else
        find_last_opt_aux v0 f l

let rec find_last_opt f (t : tree) =
  match 
# 123 "Find.frag.ml"
               (view t)  
# 123 "Find.frag.ml"
                with
  | 
# 124 "Find.frag.ml"
              Leaf  
# 124 "Find.frag.ml"
         ->
      None
  | 
# 126 "Find.frag.ml"
     Node (l,  v,  r)  
# 126 "Find.frag.ml"
                  ->
      if f v then
        find_last_opt_aux v f r
      else
        find_last_opt f l
# 1 "Add.frag.ml"
(******************************************************************************)
(*                                                                            *)
(*                                    Baby                                    *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*                                                                            *)
(*       Copyright 2024--2024 Inria. All rights reserved. This file is        *)
(*       distributed under the terms of the GNU Library General Public        *)
(*       License, with an exception, as described in the file LICENSE.        *)
(*                                                                            *)
(******************************************************************************)

(* This is insertion in the style of BFS. *)

(* (Disabled.)

let add (k : key) (t : tree) : tree =
  let l, _, r = split k t in
  join l k r

 *)

(* This is a less elegant but more efficient version of insertion. *)

(* This implementation is taken from OCaml's Set library. *)

let rec add (x : key) (t : tree) : tree =
  match 
# 28 "Add.frag.ml"
               (view t)  
# 28 "Add.frag.ml"
                with
  | 
# 29 "Add.frag.ml"
              Leaf  
# 29 "Add.frag.ml"
         ->
      singleton x
  | 
# 31 "Add.frag.ml"
     Node (l,  v,  r)  
# 31 "Add.frag.ml"
                  ->
      let c = E.compare x v in
      if c = 0 then
        t
      else if c < 0 then
        let l' = add x l in
        if l == l' then t else join_neighbors l' v r
      else
        let r' = add x r in
        if r == r' then t else join_neighbors l v r'
# 1 "Remove.frag.ml"
(******************************************************************************)
(*                                                                            *)
(*                                    Baby                                    *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*                                                                            *)
(*       Copyright 2024--2024 Inria. All rights reserved. This file is        *)
(*       distributed under the terms of the GNU Library General Public        *)
(*       License, with an exception, as described in the file LICENSE.        *)
(*                                                                            *)
(******************************************************************************)

(* [remove_min_elt_1 l v r] removes the minimum element of the tree
   [NODE(l, v, r)]. *)

let rec remove_min_elt_1 (l : tree) (v : key) (r : tree) : tree =
  match 
# 17 "Remove.frag.ml"
               (view l)  
# 17 "Remove.frag.ml"
                with
  | 
# 18 "Remove.frag.ml"
              Leaf  
# 18 "Remove.frag.ml"
         ->
      r
  | 
# 20 "Remove.frag.ml"
     Node (ll,  lv,  lr)  
# 20 "Remove.frag.ml"
                     ->
      let l = remove_min_elt_1 ll lv lr in
      join_neighbors l v r

(* [remove_min_elt t] removes the minimum element of the tree [t]. *)

let remove_min_elt (t : tree) : tree =
  match 
# 27 "Remove.frag.ml"
               (view t)  
# 27 "Remove.frag.ml"
                with
  | 
# 28 "Remove.frag.ml"
              Leaf  
# 28 "Remove.frag.ml"
         ->
      raise Not_found
  | 
# 30 "Remove.frag.ml"
     Node (l,  v,  r)  
# 30 "Remove.frag.ml"
                  ->
      remove_min_elt_1 l v r

(* [remove_max_elt_1 l v r] removes the maximum element of the tree
   [NODE(l, v, r)]. *)

let rec remove_max_elt_1 (l : tree) (v : key) (r : tree) : tree =
  match 
# 37 "Remove.frag.ml"
               (view r)  
# 37 "Remove.frag.ml"
                with
  | 
# 38 "Remove.frag.ml"
              Leaf  
# 38 "Remove.frag.ml"
         ->
      l
  | 
# 40 "Remove.frag.ml"
     Node (rl,  rv,  rr)  
# 40 "Remove.frag.ml"
                     ->
      let r = remove_max_elt_1 rl rv rr in
      join_neighbors l v r

(* [remove_max_elt t] removes the maximum element of the tree [t]. *)

let remove_max_elt (t : tree) : tree =
  match 
# 47 "Remove.frag.ml"
               (view t)  
# 47 "Remove.frag.ml"
                with
  | 
# 48 "Remove.frag.ml"
              Leaf  
# 48 "Remove.frag.ml"
         ->
      raise Not_found
  | 
# 50 "Remove.frag.ml"
     Node (l,  v,  r)  
# 50 "Remove.frag.ml"
                  ->
      remove_max_elt_1 l v r

(* [join2_siblings l r] is analogous to [join2 l r], but requires the
   subtrees [l] and [r] to be siblings in a valid tree. *)

(* [join2_siblings] is named [merge] in OCaml's Set library. *)

(* This implementation arbitrarily chooses to place the minimum element of the
   tree [r] at the root. One could also choose to place the maximum element of
   the tree [l] at the root. One could imagine choosing between these
   alternatives, based on the weights or heights of the trees [l] and [r], if
   such a notion exists. That would remove the need for rebalancing. However,
   this seems to make essentially no difference in practice. *)

let join2_siblings (l : tree) (r : tree) : tree =
  match 
# 66 "Remove.frag.ml"
               (view l) 
# 66 "Remove.frag.ml"
               , 
# 66 "Remove.frag.ml"
                        (view r)  
# 66 "Remove.frag.ml"
                         with
  | _, 
# 67 "Remove.frag.ml"
                 Leaf  
# 67 "Remove.frag.ml"
            ->
      l
  | 
# 69 "Remove.frag.ml"
              Leaf 
# 69 "Remove.frag.ml"
        , _ ->
      r
  | _, 
# 71 "Remove.frag.ml"
        Node (rl,  rv,  rr)  
# 71 "Remove.frag.ml"
                        ->
      join_neighbors
        l
        (min_elt_1 rv rl)           (* same as [min_elt r] *)
        (remove_min_elt_1 rl rv rr) (* same as [remove_min_elt r] *)

(* This is removal in the style of BFS. *)

(* (Disabled.)

let remove (k : key) (t : tree) : tree =
  let l, _, r = split k t in
  join2 l r

 *)

(* This is a less elegant but more efficient version of removal. *)

(* This implementation is taken from OCaml's Set library. *)

let rec remove (x : key) (t : tree) : tree =
  match 
# 92 "Remove.frag.ml"
               (view t)  
# 92 "Remove.frag.ml"
                with
  | 
# 93 "Remove.frag.ml"
              Leaf  
# 93 "Remove.frag.ml"
         ->
      empty
  | 
# 95 "Remove.frag.ml"
     Node (l,  v,  r)  
# 95 "Remove.frag.ml"
                  ->
      let c = E.compare x v in
      if c = 0 then
        join2_siblings l r
      else if c < 0 then
        let l' = remove x l in
        if l == l' then t else join_neighbors l' v r
      else
        let r' = remove x r in
        if r == r' then t else join_neighbors l v r'
# 1 "Split.frag.ml"
(******************************************************************************)
(*                                                                            *)
(*                                    Baby                                    *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*                                                                            *)
(*       Copyright 2024--2024 Inria. All rights reserved. This file is        *)
(*       distributed under the terms of the GNU Library General Public        *)
(*       License, with an exception, as described in the file LICENSE.        *)
(*                                                                            *)
(******************************************************************************)

(* [split] is implemented in the same way in OCaml's Set library and by BFS. *)

(* We use the same code, but add a physical equality test that allows us to
   preserve sharing (and avoid memory allocation) in some cases. *)

let rec split (k : key) (t : tree) : tree * bool * tree =
  match 
# 19 "Split.frag.ml"
               (view t)  
# 19 "Split.frag.ml"
                with
  | 
# 20 "Split.frag.ml"
              Leaf  
# 20 "Split.frag.ml"
         ->
      leaf, false, leaf
  | 
# 22 "Split.frag.ml"
     Node (l,  m,  r)  
# 22 "Split.frag.ml"
                  ->
      let c = E.compare k m in
      if c = 0 then
        l, true, r
      else if c < 0 then
        let ll, b, lr = split k l in
        ll, b, (if lr == l then t else join lr m r)
      else
        let rl, b, rr = split k r in
        (if rl == r then t else join l m rl), b, rr

(* A specialized version of [split] that returns just the Boolean component
   of the result is [mem]. *)

(* [split13] is a variant of [split] that returns only the first and third
   components of the result. *)

let rec split13 (k : key) (t : tree) : tree * tree =
  match 
# 40 "Split.frag.ml"
               (view t)  
# 40 "Split.frag.ml"
                with
  | 
# 41 "Split.frag.ml"
              Leaf  
# 41 "Split.frag.ml"
         ->
      leaf, leaf
  | 
# 43 "Split.frag.ml"
     Node (l,  m,  r)  
# 43 "Split.frag.ml"
                  ->
      let c = E.compare k m in
      if c = 0 then
        l, r
      else if c < 0 then
        let ll, lr = split13 k l in
        ll, (if lr == l then t else join lr m r)
      else
        let rl, rr = split13 k r in
        (if rl == r then t else join l m rl), rr

(* [join2] is known as [concat] in OCaml's Set library. *)

(* This is the code proposed by BFS. Their [split_last] function
   corresponds to our functions [min_elt] and [remove_min_elt_1].

let rec split_last (l : tree) (k : key) (r : tree) : tree * key =
  match VIEW(r) with
  | LEAF ->
      l, k
  | NODE(l', k', r') ->
      let r, m = split_last l' k' r' in
      join l k r, m

let join2 (l : tree) (r : tree) : tree =
  match VIEW(l) with
  | LEAF ->
      r
  | NODE(ll, m, lr) ->
      let l', k = split_last ll m lr in
      join l' k r

 *)

(* [join2 l r] is implemented by extracting the maximum element of [l]
   or the minimum element of [r] and letting [join] do the rest of the
   work. *)

(* In order to maintain a better balance, one might wish to extract an
   element from the tree that seems larger. However, this seems to
   bring no improvement in practice, so we avoid this complication. *)

let join2 (l : tree) (r : tree) : tree =
  match 
# 86 "Split.frag.ml"
               (view l) 
# 86 "Split.frag.ml"
               , 
# 86 "Split.frag.ml"
                        (view r)  
# 86 "Split.frag.ml"
                         with
  | 
# 87 "Split.frag.ml"
              Leaf 
# 87 "Split.frag.ml"
        , _ ->
      r
  | _, 
# 89 "Split.frag.ml"
                 Leaf  
# 89 "Split.frag.ml"
            ->
      l
  | _, 
# 91 "Split.frag.ml"
        Node (rl,  rv,  rr)  
# 91 "Split.frag.ml"
                        ->
      join
        l
        (min_elt_1 rv rl)           (* same as [min_elt r] *)
        (remove_min_elt_1 rl rv rr) (* same as [remove_min_elt r] *)
# 1 "Enum.frag.ml"
(******************************************************************************)
(*                                                                            *)
(*                                    Baby                                    *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*                                                                            *)
(*       Copyright 2024--2024 Inria. All rights reserved. This file is        *)
(*       distributed under the terms of the GNU Library General Public        *)
(*       License, with an exception, as described in the file LICENSE.        *)
(*                                                                            *)
(******************************************************************************)

(* -------------------------------------------------------------------------- *)

(* Enumerations. *)

module Enum = struct

  type tree = t

  type enum =
    | End
    | More of elt * t * enum

  type t = enum

  let empty : enum =
    End

  let[@inline] is_empty (e : enum) : bool =
    match e with
    | End -> true
    | More _ -> false

  (* [cat_tree_enum t e] concatenates the tree [t] in front of the
     enumeration [e]. *)

  (* This function is named [cons_enum] in OCaml's Set library. *)

  let rec cat_tree_enum (t : tree) (e : enum) : enum =
    match 
# 41 "Enum.frag.ml"
                 (view t)  
# 41 "Enum.frag.ml"
                  with
    | 
# 42 "Enum.frag.ml"
                Leaf  
# 42 "Enum.frag.ml"
           ->
        e
    | 
# 44 "Enum.frag.ml"
       Node (l,  v,  r)  
# 44 "Enum.frag.ml"
                    ->
        cat_tree_enum l (More (v, r, e))

  (* [enum] converts a tree to an enumeration. *)

  let[@inline] enum (t : tree) : enum =
    cat_tree_enum t empty

  (* [filter_tree low t e] constructs an enumeration whose elements are: 1-
     the elements [x] of the tree [t] such that [low <= x] holds, followed
     with 2- all elements of the enumeration [e]. *)

  (* In [filter_tree low t e], only the tree [t] is filtered by the constraint
     [low <= x]. The enumeration [e] is not filtered (typically because it is
     already known that all of its elements satisfy this constraint). This is
     in contrast with [filter_tree_enum low t e] (below), where both [t] and
     [e] are filtered. *)

  let rec filter_tree (low : key) (t : tree) (e : enum) : enum =
    match 
# 63 "Enum.frag.ml"
                 (view t)  
# 63 "Enum.frag.ml"
                  with
    | 
# 64 "Enum.frag.ml"
                Leaf  
# 64 "Enum.frag.ml"
           ->
        e
    | 
# 66 "Enum.frag.ml"
       Node (l,  v,  r)  
# 66 "Enum.frag.ml"
                    ->
        let c = E.compare v low in
        if c = 0 then
          More (v, r, e)
        else if c < 0 then
          filter_tree low r e
        else
          filter_tree low l (More (v, r, e))

  let[@inline] from_enum (low : key) (t : tree) : enum =
    filter_tree low t empty

  (* [filter_tree_enum low r e] extracts the elements [x] that satisfy the
     constraint [low <= x] out of the sequence of the elements of the tree [r]
     and of the enumeration [e]. *)

  (* Thus, it is equivalent to [from low (cat_tree_enum r e)],
     but the function [from] has not been defined yet.
     [filter_tree_enum] is in fact used to define [from]. *)

  (* Both the tree [r] and the enumeration [e] are filtered. *)

  let rec filter_tree_enum (low : key) (r : tree) (e : enum) : enum =
    (* Peek past [r] at the first element [v'] of [e], if there is one. *)
    match e with
    | More (v', r', e') ->
        let c = E.compare low v' in
        if c > 0 then
          (* [v'] is below the threshold.
             The subtree [r] and the value [v'] must be discarded.
             Continue with [r'] and [e']. *)
          filter_tree_enum low r' e'
        else if c = 0 then
          (* [v'] is at the threshold.
             The subtree [r] must be discarded. [e] must be kept. *)
          e
        else (* c < 0 *)
          (* [v'] is above the threshold. *)
          (* No part of [e] must be discarded. *)
          (* Keep part of [r], followed with [e]. *)
          filter_tree low r e
    | End ->
        (* [e] is empty. Keep part of [r]. *)
        filter_tree low r e

  (* [from low e] extracts from the enumeration [e]
     the elements that lie at or above the threshold [low] . *)

  (* One could define [from low e] as [filter_tree_enum low leaf e].
     However, the following code is slightly more efficient. *)

  let from (low : key) (e : enum) : enum =
    match e with
    | More (v, r, e') ->
        if E.compare low v <= 0 then
          (* [v] is at or above the threshold. Keep all elements. *)
          e
        else
          (* [v] is below the threshold. [v] must be discarded. *)
          filter_tree_enum low r e'
    | End ->
        End

  let head (e : enum) : key =
    match e with
    | End            -> raise Not_found
    | More (v, _, _) -> v

  let tail (e : enum) : enum =
    match e with
    | End            -> raise Not_found
    | More (_, r, e) -> cat_tree_enum r e

  let head_opt (e : enum) : key option =
    match e with
    | End            -> None
    | More (v, _, _) -> Some v

  let tail_opt (e : enum) : enum option =
    match e with
    | End            -> None
    | More (_, r, e) -> Some (cat_tree_enum r e)

  (* [compare e1 e2] compares the enumerations [e1] and [e2]
     according to a lexicographic ordering. *)

  let rec compare (e1 : enum) (e2 : enum) : int =
    match e1, e2 with
    | End, End ->
        0
    | End, More _ ->
        -1
    | More _, End ->
        1
    | More (v1, r1, e1), More (v2, r2, e2) ->
        let c = E.compare v1 v2 in
        if c <> 0 then c else
        compare (cat_tree_enum r1 e1) (cat_tree_enum r2 e2)

  (* [to_seq] converts an enumeration to an OCaml sequence. *)

  let rec to_seq_node (e : enum) : key Seq.node =
    match e with
    | End ->
        Seq.Nil
    | More (v, r, e) ->
        Seq.Cons (v, fun () -> to_seq_node (cat_tree_enum r e))

  let to_seq (e : enum) : key Seq.t =
    fun () -> to_seq_node e

  (* [elements] converts an enumeration back to a tree. *)

  (* It is the only function in this file that constructs a tree.
     It exploits the construction function [join].
     It performs no key comparisons. *)

  (* I believe, but have not proved, that, thanks to the remarkable
     properties of [join], the time complexity of [elements] is only
     O(log n). *)

  let rec elements (v : key) (r : tree) (e : enum) : tree =
    match e with
    | End ->
        join leaf v r
    | More (v', r', e) ->
        elements v (join r v' r') e

  let elements (e : enum) : tree =
    match e with
    | End ->
        leaf
    | More (v, r, e) ->
        elements v r e

  (* Disjointness. *)

  exception NotDisjoint

  (* [filter_tree_disjoint low t e] returns the same result as
     [filter_tree low t e], except that it raises [NotDisjoint]
     if the key [low] appears in its result. *)

  let rec filter_tree_disjoint (low : key) (t : tree) (e : enum) : enum =
    match 
# 210 "Enum.frag.ml"
                 (view t)  
# 210 "Enum.frag.ml"
                  with
    | 
# 211 "Enum.frag.ml"
                Leaf  
# 211 "Enum.frag.ml"
           ->
        e
    | 
# 213 "Enum.frag.ml"
       Node (l,  v,  r)  
# 213 "Enum.frag.ml"
                    ->
        let c = E.compare v low in
        if c = 0 then
          raise NotDisjoint
        else if c < 0 then
          filter_tree_disjoint low r e
        else
          filter_tree_disjoint low l (More (v, r, e))

  (* [filter_tree_enum_disjoint low r e] returns the same result as
     [filter_tree_enum low r e], except that it raises [NotDisjoint]
     if the key [low] appears in its result. *)

  let rec filter_tree_enum_disjoint (low : key) (r : tree) (e : enum) : enum =
    match e with
    | More (v', r', e') ->
        let c = E.compare low v' in
        if c > 0 then
          filter_tree_enum_disjoint low r' e'
        else if c = 0 then
          raise NotDisjoint
        else
          filter_tree_disjoint low r e
    | End ->
        filter_tree_disjoint low r e

  (* [disjoint_more_more v1 r1 e1 v2 r2 e2] requires [v1 < v2]. It determines
     whether the enumerations [More (v1, r1, e1)] and [More (v2, r2, e2)] are
     disjoint. It either returns [true] or raises [NotDisjoint]. *)

  (* This is Veldhuizen's leapfrog join algorithm. *)

  let rec disjoint_more_more v1 r1 e1 v2 r2 e2 =
    assert (E.compare v1 v2 < 0);
    (* Skip past [v2] in the enumeration [e1]. *)
    (* If [v2] appears in [e1], fail. *)
    let e1 = filter_tree_enum_disjoint v2 r1 e1 in
    match e1 with
    | End ->
        (* If [e1] is now empty, we are done. *)
        true
    | More (v1, r1, e1) ->
        (* If [e1] is nonempty, then its front value [v1] must be greater than
           [v2]. Exchange the roles of the two enumerations and continue. *)
        assert (E.compare v2 v1 < 0);
        disjoint_more_more v2 r2 e2 v1 r1 e1

  (* [disjoint e1 e2] determines whether the enumerations [e1] and [e2] are
     disjoint. *)

  let disjoint (e1 : enum) (e2 : enum) : bool =
    match e1, e2 with
    | End, _
    | _, End ->
        true
    | More (v1, r1, e1), More (v2, r2, e2) ->
        let c = E.compare v1 v2 in
        if c = 0 then
          false
        else
          try
            if c < 0 then
              disjoint_more_more v1 r1 e1 v2 r2 e2
            else
              disjoint_more_more v2 r2 e2 v1 r1 e1
          with NotDisjoint ->
            false

  (* [length e] computes the length of the enumeration [e]. If we have
     a constant-time [cardinal] function on sets, then its complexity
     is logarithmic. Otherwise, its complexity is linear. *)

  let rec length_aux accu (e : enum) : int =
    match e with
    | End ->
        accu
    | More (_, r, e) ->
        length_aux (accu + cardinal r + 1) e

  let[@inline] length (e : enum) : int =
    length_aux 0 e

end (* Enum *)

(* -------------------------------------------------------------------------- *)

(* Enumerations in reverse (decreasing order). *)

(* I would rather avoid this code duplication, but we must provide at least
   [to_rev_seq], for compatibility with OCaml's Set library. *)

module RevEnum = struct

  type tree = t

  (* In the enumeration [More (e, l, v)], we have [e < l < v], but the
     enumeration is consumed (by the user) from the right to the left,
     so [v] is produced first, followed with the elements of the tree
     [l], followed with the elements of the enumeration [e]. *)

  type enum =
    | End
    | More of enum * t * elt

  let empty : enum =
    End

  (* [cat_enum_tree e t] concatenates the enumeration [e] in front of
     the tree [t]. It requires [e < t]. *)

  (* This function corresponds to [snoc_enum] in OCaml's Set library. *)

  let rec cat_enum_tree (e : enum) (t : tree) : enum =
    match 
# 326 "Enum.frag.ml"
                 (view t)  
# 326 "Enum.frag.ml"
                  with
    | 
# 327 "Enum.frag.ml"
                Leaf  
# 327 "Enum.frag.ml"
           ->
        e
    | 
# 329 "Enum.frag.ml"
       Node (l,  v,  r)  
# 329 "Enum.frag.ml"
                    ->
        cat_enum_tree (More (e, l, v)) r

  (* [enum] converts a tree to an enumeration. *)

  let[@inline] enum (t : tree) : enum =
    cat_enum_tree empty t

  (* [to_seq] converts an enumeration to an OCaml sequence. *)

  let rec to_seq_node (e : enum) : key Seq.node =
    match e with
    | End ->
        Seq.Nil
    | More (e, l, v) ->
        Seq.Cons (v, fun () -> to_seq_node (cat_enum_tree e l))

  (* let to_seq (e : enum) : key Seq.t = *)
  (*   fun () -> to_seq_node e *)

end
# 1 "Compare.frag.ml"
(******************************************************************************)
(*                                                                            *)
(*                                    Baby                                    *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*                                                                            *)
(*       Copyright 2024--2024 Inria. All rights reserved. This file is        *)
(*       distributed under the terms of the GNU Library General Public        *)
(*       License, with an exception, as described in the file LICENSE.        *)
(*                                                                            *)
(******************************************************************************)

(* -------------------------------------------------------------------------- *)

(* Comparison. *)

(* Instead of using enumerations of the trees [t1] and [t2], one could perform
   a recursive traversal of [t1], while consuming an enumeration of [t2]. I
   have benchmarked this variant: it allocates less memory, and can be faster,
   but can also be about twice slower. *)

let compare (t1 : tree) (t2 : tree) : int =
  if t1 == t2 then 0 else (* fast path *)
  Enum.(compare (enum t1) (enum t2))
# 1 "Equal.frag.ml"
(******************************************************************************)
(*                                                                            *)
(*                                    Baby                                    *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*                                                                            *)
(*       Copyright 2024--2024 Inria. All rights reserved. This file is        *)
(*       distributed under the terms of the GNU Library General Public        *)
(*       License, with an exception, as described in the file LICENSE.        *)
(*                                                                            *)
(******************************************************************************)

(* -------------------------------------------------------------------------- *)

(* Equality. *)

(* Equality can be implemented in several ways. E.g., [equal t1 t2] could be
   implemented in one line by [subset t1 t2 && subset t2 t1] or also in one
   line by [is_empty (xor t1 t2)]. (The latter idea could be optimized, so
   as to avoid actually constructing the tree [xor t1 t2] in memory.) Some
   experiments suggest that either of these approaches is more expensive
   than the following approach, which is based on [compare]. *)

(* In weight-balanced trees, the weight of a tree can be determined in
   constant time. This yields a fast path: if the weights and [t1] and [t2]
   differ, then they cannot possibly be equal. In height-balanced trees, the
   [weight] function returns a constant value, so this fast path is
   disabled. *)

let[@inline] equal t1 t2 =
  weight t1 = weight t2 && (* fast path *)
  compare t1 t2 = 0
# 1 "Union.frag.ml"
(******************************************************************************)
(*                                                                            *)
(*                                    Baby                                    *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*                                                                            *)
(*       Copyright 2024--2024 Inria. All rights reserved. This file is        *)
(*       distributed under the terms of the GNU Library General Public        *)
(*       License, with an exception, as described in the file LICENSE.        *)
(*                                                                            *)
(******************************************************************************)

(* -------------------------------------------------------------------------- *)

(* Union. *)

(* This is the simple, elegant version of [union] given by BFS.

let rec union (t1 : tree) (t2 : tree) : tree =
  match VIEW(t1), VIEW(t2) with
  | LEAF, _
  | _, LEAF ->
      leaf
  | NODE(_, _, _), NODE(l2, k2, r2) ->
      let l1, r1 = split13 k2 t1 in
      let l = union l1 l2
      and r = union r1 r2 in
      join l k2 r

 *)

(* Our implementation of [union] is in the same style as [inter].
   It inherits two features of OCaml's Set library:
   - the tree that seems smaller is split;
   - if a subtree is a singleton then [union] degenerates to [add].
   Furthermore, compared with OCaml's Set library, it is able to exploit
   physical equality when present, and it offers a stronger guarantee
   regarding the preservation of physical equality. *)

(* The recursive function [union] ensures that if the result is
   equal to [t2] then the result is physically equal to [t2]. *)

(* In the case where [t2] is a singleton, we have already checked that
   [t1] is neither empty nor a singleton, so the result of the union
   cannot possibly be equal to [t2]. Thus, the obligation to preserve
   sharing disappears in this case: using [add k2 t1] is safe. *)

let rec union (t1 : tree) (t2 : tree) : tree =
  match 
# 49 "Union.frag.ml"
               (view t1) 
# 49 "Union.frag.ml"
                , 
# 49 "Union.frag.ml"
                         (view t2)  
# 49 "Union.frag.ml"
                           with
  | 
# 50 "Union.frag.ml"
              Leaf 
# 50 "Union.frag.ml"
        , _ ->
      t2
  | _, 
# 52 "Union.frag.ml"
                 Leaf  
# 52 "Union.frag.ml"
            ->
      t1
  | 
# 54 "Union.frag.ml"
     Node (l1,  k1,  r1) 
# 54 "Union.frag.ml"
                    , 
# 54 "Union.frag.ml"
                       Node (l2,  k2,  r2)  
# 54 "Union.frag.ml"
                                       ->
      if 
# 55 "Union.frag.ml"
          (        (match        (view l1)  with           Leaf  -> true | _ -> false)  &&         (match        (view  r1)  with           Leaf  -> true | _ -> false) )  
# 55 "Union.frag.ml"
                            then add k1 t2 else
      if 
# 56 "Union.frag.ml"
          (        (match        (view l2)  with           Leaf  -> true | _ -> false)  &&         (match        (view  r2)  with           Leaf  -> true | _ -> false) )  
# 56 "Union.frag.ml"
                            then add k2 t1 else
      let l1, r1 = split13 k2 t1 in
      let l = union l1 l2
      and r = union r1 r2 in
      if l == l2 && r == r2 then t2 else (* preserve sharing *)
      join l k2 r

(* This toplevel wrapper tests which of the two arguments seems larger. (With
   weight-balanced trees, this is an exact test. With height-balanced trees,
   it is a heuristic test.) This argument, one may hope, might also be the
   result. Therefore, the recursive function [union] (above) is invoked with
   this argument as its second argument. Compared with [inter], this is the
   other way around. *)

let union t1 t2 =
  if t1 == t2 then t1 else (* fast path *)
  if seems_smaller t1 t2 then
    union t1 t2
  else
    union t2 t1
# 1 "Inter.frag.ml"
(******************************************************************************)
(*                                                                            *)
(*                                    Baby                                    *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*                                                                            *)
(*       Copyright 2024--2024 Inria. All rights reserved. This file is        *)
(*       distributed under the terms of the GNU Library General Public        *)
(*       License, with an exception, as described in the file LICENSE.        *)
(*                                                                            *)
(******************************************************************************)

(* -------------------------------------------------------------------------- *)

(* Intersection. *)

(* This is the simple, elegant version of [inter] given by BFS.

let rec inter (t1 : tree) (t2 : tree) : tree =
  match VIEW(t1), VIEW(t2) with
  | LEAF, _
  | _, LEAF ->
      leaf
  | NODE(_, _, _), NODE(l2, k2, r2) ->
      let l1, b, r1 = split k2 t1 in
      let l = inter l1 l2
      and r = inter r1 r2 in
      if b then join l k2 r else join2 l r

 *)

(* The recursive function [inter] ensures that if the result is
   equal to [t2] then the result is physically equal to [t2]. *)

(* Compared with the simple version (above),

   + there is a fast path for the case where [t1 == t2] holds;
   + there is specialized code for the case where [t2] is a
     singleton; in that case there is no need to use [split];
   + the code guarantees that if the result is equal to [t2]
     then [t2] itself is returned. *)

(* Adding specialized code for the case where [t1] is a singleton can lead
   to small gains or losses in speed; the effect seems unclear. *)

(* Adding specialized code for the cases where one of [l2] or [r2] is empty
   saves a few percent in time, and is not worth the extra complexity. *)

let rec inter (t1 : tree) (t2 : tree) : tree =
  match 
# 50 "Inter.frag.ml"
               (view t1) 
# 50 "Inter.frag.ml"
                , 
# 50 "Inter.frag.ml"
                         (view t2)  
# 50 "Inter.frag.ml"
                           with
  | 
# 51 "Inter.frag.ml"
              Leaf 
# 51 "Inter.frag.ml"
        , _
  | _, 
# 52 "Inter.frag.ml"
                 Leaf  
# 52 "Inter.frag.ml"
            ->
      leaf
  | 
# 54 "Inter.frag.ml"
     Node (_,  _,  _) 
# 54 "Inter.frag.ml"
                 , 
# 54 "Inter.frag.ml"
                    Node (l2,  k2,  r2)  
# 54 "Inter.frag.ml"
                                    ->
      if t1 == t2 then t2 else (* fast path *)
      if 
# 56 "Inter.frag.ml"
          (        (match        (view l2)  with           Leaf  -> true | _ -> false)  &&         (match        (view  r2)  with           Leaf  -> true | _ -> false) )  
# 56 "Inter.frag.ml"
                            then
        (* The tree [t2] is [singleton k2]. *)
        if mem k2 t1 then t2 else leaf
      else
        let l1, b, r1 = split k2 t1 in
        let l = inter l1 l2
        and r = inter r1 r2 in
        if b then
          if l == l2 && r == r2 then t2 else (* preserve sharing *)
          join l k2 r
        else
          join2 l r

(* This toplevel wrapper serves two purposes. First, it contains a fast path
   for the case where [t1 == t2] holds. Second, it tests which of the two
   arguments seems smaller. (With weight-balanced trees, this is an exact
   test. With height-balanced trees, it is a heuristic test.) This argument,
   one may hope, might also be the result. Therefore, the recursive function
   [inter] (above) is invoked with this argument as its second argument. *)

let inter t1 t2 =
  if t1 == t2 then t1 else (* fast path *)
  if seems_smaller t1 t2 then
    inter t2 t1
  else
    inter t1 t2
# 1 "Diff.frag.ml"
(******************************************************************************)
(*                                                                            *)
(*                                    Baby                                    *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*                                                                            *)
(*       Copyright 2024--2024 Inria. All rights reserved. This file is        *)
(*       distributed under the terms of the GNU Library General Public        *)
(*       License, with an exception, as described in the file LICENSE.        *)
(*                                                                            *)
(******************************************************************************)

(* -------------------------------------------------------------------------- *)

(* Difference. *)

(* This is a simple, elegant version of [diff]. This version splits the
   tree [t1].

let rec diff (t1 : tree) (t2 : tree) : tree =
  match VIEW(t1), VIEW(t2) with
  | LEAF, _ ->
      leaf
  | _, LEAF ->
      t1
  | NODE(_, _, _), NODE(l2, k2, r2) ->
      let l1, r1 = split13 k2 t1 in
      let l = diff l1 l2
      and r = diff r1 r2 in
      join2 l r

 *)

(* This version of [diff] guarantees that if the result is equal to [t1]
   then [t1] itself is returned. *)

let rec diff (t1 : tree) (t2 : tree) : tree =
  match 
# 38 "Diff.frag.ml"
               (view t1) 
# 38 "Diff.frag.ml"
                , 
# 38 "Diff.frag.ml"
                         (view t2)  
# 38 "Diff.frag.ml"
                           with
  | 
# 39 "Diff.frag.ml"
              Leaf 
# 39 "Diff.frag.ml"
        , _ ->
      leaf
  | _, 
# 41 "Diff.frag.ml"
                 Leaf  
# 41 "Diff.frag.ml"
            ->
      t1
  | 
# 43 "Diff.frag.ml"
     Node (l1,  k1,  r1) 
# 43 "Diff.frag.ml"
                    , 
# 43 "Diff.frag.ml"
                       Node (l2,  k2,  r2)  
# 43 "Diff.frag.ml"
                                       ->
      if t1 == t2 then leaf else (* fast path *)
      if 
# 45 "Diff.frag.ml"
          (        (match        (view l1)  with           Leaf  -> true | _ -> false)  &&         (match        (view  r1)  with           Leaf  -> true | _ -> false) )  
# 45 "Diff.frag.ml"
                            then
        (* [t1] is [singleton k1]. *)
        if mem k1 t2 then leaf else t1
      else if 
# 48 "Diff.frag.ml"
               (        (match        (view l2)  with           Leaf  -> true | _ -> false)  &&         (match        (view  r2)  with           Leaf  -> true | _ -> false) )  
# 48 "Diff.frag.ml"
                                 then
        (* [t2] is [singleton k2]. *)
        remove k2 t1
      else
        let l2, b, r2 = split k1 t2 in
        let l = diff l1 l2
        and r = diff r1 r2 in
        if b then
          join2 l r
        else
          if l == l1 && r == r1 then t1 else (* preserve sharing *)
          join l k1 r
# 1 "Xor.frag.ml"
(******************************************************************************)
(*                                                                            *)
(*                                    Baby                                    *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*                                                                            *)
(*       Copyright 2024--2024 Inria. All rights reserved. This file is        *)
(*       distributed under the terms of the GNU Library General Public        *)
(*       License, with an exception, as described in the file LICENSE.        *)
(*                                                                            *)
(******************************************************************************)

(* -------------------------------------------------------------------------- *)

(* Symmetric difference. *)

(* This is a simple, elegant version of [xor].

let rec xor (t1 : tree) (t2 : tree) : tree =
  match VIEW(t1), VIEW(t2) with
  | LEAF, _ ->
      t2
  | _, LEAF ->
      t1
  | NODE(_, _, _), NODE(l2, k2, r2) ->
      let l1, b, r1 = split k2 t1 in
      let l = xor l1 l2
      and r = xor r1 r2 in
      if b then join2 l r else join l k2 r

 *)

(* Except in the case where [t1] or [t2] is empty, [xor t1 t2] cannot be
   equal to [t1] or [t2]. So there is no need to attempt to preserve
   sharing when constructing new nodes. *)

let rec xor (t1 : tree) (t2 : tree) : tree =
  match 
# 38 "Xor.frag.ml"
               (view t1) 
# 38 "Xor.frag.ml"
                , 
# 38 "Xor.frag.ml"
                         (view t2)  
# 38 "Xor.frag.ml"
                           with
  | 
# 39 "Xor.frag.ml"
              Leaf 
# 39 "Xor.frag.ml"
        , _ ->
      t2
  | _, 
# 41 "Xor.frag.ml"
                 Leaf  
# 41 "Xor.frag.ml"
            ->
      t1
  | 
# 43 "Xor.frag.ml"
     Node (_,  _,  _) 
# 43 "Xor.frag.ml"
                 , 
# 43 "Xor.frag.ml"
                    Node (l2,  k2,  r2)  
# 43 "Xor.frag.ml"
                                    ->
      if t1 == t2 then leaf else (* fast path *)
      if 
# 45 "Xor.frag.ml"
          (        (match        (view l2)  with           Leaf  -> true | _ -> false)  &&         (match        (view  r2)  with           Leaf  -> true | _ -> false) )  
# 45 "Xor.frag.ml"
                            then
        (* [t2] is [singleton k2]. *)
        if mem k2 t1 then
          remove k2 t1
        else
          add k2 t1
      else
        let l1, b, r1 = split k2 t1 in
        let l = xor l1 l2
        and r = xor r1 r2 in
        if b then
          join2 l r
        else
          join l k2 r
# 1 "Disjoint.frag.ml"
(******************************************************************************)
(*                                                                            *)
(*                                    Baby                                    *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*                                                                            *)
(*       Copyright 2024--2024 Inria. All rights reserved. This file is        *)
(*       distributed under the terms of the GNU Library General Public        *)
(*       License, with an exception, as described in the file LICENSE.        *)
(*                                                                            *)
(******************************************************************************)

(* -------------------------------------------------------------------------- *)

(* Disjointness. *)

(* This simple version of [disjoint] has the same structure as [inter]. *)

(* (Disabled.)

let rec disjoint (t1 : tree) (t2 : tree) : bool =
  match VIEW(t1), VIEW(t2) with
  | LEAF, _
  | _, LEAF ->
      true
  | NODE(_, _, _), NODE(l2, k2, r2) ->
      let l1, b, r1 = split k2 t1 in
      not b && disjoint l1 l2 && disjoint r1 r2

 *)

(* The above code can be improved by adding a fast path (based on physical
   equality), by adding special cases for singletons, and by using a copy of
   [split] that does not construct the subtrees [l] and [r] if the Boolean
   result [b] is true. *)

(* I have played with these variations, but I find them to be consistently
   slower than the following approach, which is based on [Enum.disjoint]. *)

let disjoint t1 t2 =
  match 
# 41 "Disjoint.frag.ml"
               (view t1) 
# 41 "Disjoint.frag.ml"
                , 
# 41 "Disjoint.frag.ml"
                         (view t2)  
# 41 "Disjoint.frag.ml"
                           with
  | 
# 42 "Disjoint.frag.ml"
              Leaf 
# 42 "Disjoint.frag.ml"
        , _
  | _, 
# 43 "Disjoint.frag.ml"
                 Leaf  
# 43 "Disjoint.frag.ml"
            ->
      true (* fast path *)
  | _, _ ->
      t1 != t2 && (* fast path *)
      Enum.(disjoint (enum t1) (enum t2))

(* I have also played with a version of [disjoint] that does not use [split],
   therefore does not construct new trees; it does not allocate memory or
   perform rebalancing work. It can be fast, but I believe that its worst-case
   time complexity is not optimal. *)
# 1 "Subset.frag.ml"
(******************************************************************************)
(*                                                                            *)
(*                                    Baby                                    *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*                                                                            *)
(*       Copyright 2024--2024 Inria. All rights reserved. This file is        *)
(*       distributed under the terms of the GNU Library General Public        *)
(*       License, with an exception, as described in the file LICENSE.        *)
(*                                                                            *)
(******************************************************************************)

(* -------------------------------------------------------------------------- *)

(* Inclusion. *)

(* This simple version of [subset] has canonical structure. *)

(* (Disabled.)

let rec subset (t1 : tree) (t2 : tree) : bool =
  match VIEW(t1), VIEW(t2) with
  | LEAF, _ ->
      true
  | _, LEAF ->
      false
  | NODE(_, _, _), NODE(l2, k2, r2) ->
      let l1, r1 = split13 k2 t1 in
      subset l1 l2 && subset r1 r2

 *)

(* This version adds a positive fast path (based on physical equality), a
   negative fast path (based on weights), and a special treatment of the case
   where [t1] is a singleton. (There is no need to add special treatment of
   the case where [t2] is a singleton. Indeed, the subcases where [t1] is
   empty or a singleton are taken care of already, and the subcase where [t1]
   has more than one element is caught by the weight test.) *)

(* In weight-balanced trees, the weight of a tree can be determined in time
   O(1). This yields a negative fast path: if [weight t1 <= weight t2] does
   not hold, then [subset t1 t2] returns false. In height-balanced trees, the
   [weight] function returns a constant value, so this fast path is
   disabled. *)

let rec subset (t1 : tree) (t2 : tree) : bool =
  match 
# 47 "Subset.frag.ml"
               (view t1) 
# 47 "Subset.frag.ml"
                , 
# 47 "Subset.frag.ml"
                         (view t2)  
# 47 "Subset.frag.ml"
                           with
  | 
# 48 "Subset.frag.ml"
              Leaf 
# 48 "Subset.frag.ml"
        , _ ->
      true
  | _, 
# 50 "Subset.frag.ml"
                 Leaf  
# 50 "Subset.frag.ml"
            ->
      false
  | 
# 52 "Subset.frag.ml"
     Node (l1,  k1,  r1) 
# 52 "Subset.frag.ml"
                    , 
# 52 "Subset.frag.ml"
                       Node (l2,  k2,  r2)  
# 52 "Subset.frag.ml"
                                       ->
      t1 == t2 || (* fast path *)
      if 
# 54 "Subset.frag.ml"
          (        (match        (view l1)  with           Leaf  -> true | _ -> false)  &&         (match        (view  r1)  with           Leaf  -> true | _ -> false) )  
# 54 "Subset.frag.ml"
                            then
        (* The tree [t1] is [singleton k1]. *)
        mem k1 t2
      else
        weight t1 <= weight t2 && (* fast path *)
        let l1, r1 = split13 k2 t1 in
        subset l1 l2 && subset r1 r2
# 1 "Conversions.frag.ml"
(******************************************************************************)
(*                                                                            *)
(*                                    Baby                                    *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*                                                                            *)
(*       Copyright 2024--2024 Inria. All rights reserved. This file is        *)
(*       distributed under the terms of the GNU Library General Public        *)
(*       License, with an exception, as described in the file LICENSE.        *)
(*                                                                            *)
(******************************************************************************)

(* -------------------------------------------------------------------------- *)

(* [elements] converts a set, in linear time, to a sorted list. *)

let rec elements (t : tree) (k : elt list) : elt list =
  match 
# 18 "Conversions.frag.ml"
               (view t)  
# 18 "Conversions.frag.ml"
                with
  | 
# 19 "Conversions.frag.ml"
              Leaf  
# 19 "Conversions.frag.ml"
         ->
      k
  | 
# 21 "Conversions.frag.ml"
     Node (l,  v,  r)  
# 21 "Conversions.frag.ml"
                  ->
      elements l (v :: elements r k)

let[@inline] elements (t : tree) : elt list =
  elements t []

let to_list =
  elements

(* -------------------------------------------------------------------------- *)

(* [to_seq] constructs the increasing sequence of the elements of the
   tree [t]. *)

let to_seq (t : tree) : key Seq.t =
  fun () -> Enum.(to_seq_node (enum t))

(* [to_seq_from low t] constructs the increasing sequence of the
   elements [x] of the tree [t] such that [low <= x] holds. *)

let to_seq_from (low : key) (t : tree) : key Seq.t =
  fun () -> Enum.(to_seq_node (from_enum low t))

(* [to_rev_seq] constructs the decreasing sequence of the elements of
   the tree [t]. *)

let to_rev_seq (t : tree) : key Seq.t =
  fun () -> RevEnum.(to_seq_node (enum t))

(* -------------------------------------------------------------------------- *)

(* [to_array_slice t a i] writes the elements of the tree [t] to the
   array slice determined by the array [a] and the start index [i].
   It returns the end index of this slice. *)

let rec to_array_slice (t : tree) a i : int =
  assert (0 <= i && i + cardinal t <= Array.length a);
  match 
# 58 "Conversions.frag.ml"
               (view t)  
# 58 "Conversions.frag.ml"
                with
  | 
# 59 "Conversions.frag.ml"
              Leaf  
# 59 "Conversions.frag.ml"
         ->
      i
  | 
# 61 "Conversions.frag.ml"
     Node (l,  v,  r)  
# 61 "Conversions.frag.ml"
                  ->
      let i = to_array_slice l a i in
      a.(i) <- v;
      let i = i + 1 in
      to_array_slice r a i

(* -------------------------------------------------------------------------- *)

(* [to_array] converts a set, in linear time, to a sorted array. *)

let to_array (t : tree) : key array =
  match 
# 72 "Conversions.frag.ml"
               (view t)  
# 72 "Conversions.frag.ml"
                with
  | 
# 73 "Conversions.frag.ml"
              Leaf  
# 73 "Conversions.frag.ml"
         ->
      [||]
  | 
# 75 "Conversions.frag.ml"
     Node (_,  dummy,  _)  
# 75 "Conversions.frag.ml"
                      ->
      let n = cardinal t in
      let a = Array.make n dummy in
      let j = to_array_slice t a 0 in
      assert (n = j);
      a

(* -------------------------------------------------------------------------- *)

(* [of_sorted_unique_array_slice a i j] requires the array slice defined by
   array [a], start index [i], and end index [j] to be sorted and to contain
   no duplicate elements. It converts this array slice, in linear time, to a
   set. *)

let rec of_sorted_unique_array_slice a i j =
  assert (0 <= i && i <= j && j <= Array.length a);
  let n = j - i in
  match n with
  | 0 ->
      empty
  | 1 ->
      let x = a.(i) in
      singleton x
  | 2 ->
      let x = a.(i)
      and y = a.(i+1) in
      doubleton x y
  | 3 ->
      let x = a.(i)
      and y = a.(i+1)
      and z = a.(i+2) in
      tripleton x y z
  | _ ->
      let k = i + n/2 in
      let l = of_sorted_unique_array_slice a i k
      and v = a.(k)
      and r = of_sorted_unique_array_slice a (k+1) j in
      join_weight_balanced l v r

(* -------------------------------------------------------------------------- *)

(* [of_sorted_unique_array a] requires the array [a] to be sorted and to
   contain no duplicate elements. It converts this array, in linear time,
   to a set. *)

(* Because this function is unsafe (the user can provide an array that
   is not sorted and/or that has duplicate elements), it is disabled.
   [to_array] (below) is safe and is almost just as fast.

let[@inline] of_sorted_unique_array a =
  of_sorted_unique_array_slice a 0 (Array.length a)

 *)

(* -------------------------------------------------------------------------- *)

(* [of_array] converts an array to a set. This algorithm is adaptive. If the
   array is sorted, then its time complexity is O(n). If the array is not
   sorted, then its time complexity gradually degenerates to O(n.log n). *)

(* Each run of consecutive increasing elements is converted to a set, in
   linear time in the length of this run. Then, the union of these sets
   is computed. *)

let of_array a =
  let yield accu i j = union accu (of_sorted_unique_array_slice a i j) in
  ArrayExtra.foreach_increasing_run E.compare yield empty a

(* -------------------------------------------------------------------------- *)

(* [of_list] converts a list to a set. It is adaptive. *)

(* OCaml's Set library constructs a sorted list (using [List.sort_uniq]) and
   converts it directly to a tree. Instead, we convert the list to an array
   and use [of_array]. On random data, our approach seems slower by about 50%.
   On sorted data, our approach can be 2x or 3x faster. One drawback of our
   approach is that it requires linear auxiliary storage. *)

let of_list xs =
  xs |> Array.of_list |> of_array

(* -------------------------------------------------------------------------- *)

(* [of_seq] converts a sequence to a set. It is adaptive. *)

(* [of_seq] in OCaml's Set library is implemented using [add_seq], which
   itself is naively implemented by iterated insertions, so its complexity
   is O(n.log n), whereas it could be O(n). *)

let of_seq xs =
  xs |> Array.of_seq |> of_array

(* [add_seq] inserts a sequence into a set. *)

let add_seq xs t =
  union (of_seq xs) t
# 1 "Map.frag.ml"
(******************************************************************************)
(*                                                                            *)
(*                                    Baby                                    *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*                                                                            *)
(*       Copyright 2024--2024 Inria. All rights reserved. This file is        *)
(*       distributed under the terms of the GNU Library General Public        *)
(*       License, with an exception, as described in the file LICENSE.        *)
(*                                                                            *)
(******************************************************************************)

(* -------------------------------------------------------------------------- *)

(* [map] is defined in the same way as in OCaml's Set library. *)

(* [tree_below_key] and [key_below_tree] invoke [min_elt] or [max_elt],
   whose cost is the height of the subtree. The cumulative cost of
   these calls, during the execution of [map], is of the form
   1 * n/2 + 2 * n/4 + 3 * n/8 + ..., that is, O(n). *)

(* If the function [f] is monotone, then the tests in [lax_join]
   always succeed, so [join] is invoked at every node, and every
   such call runs in constant time, since no rebalancing is
   required. Thus, in this case, [map] runs in linear time. *)

(* Otherwise, I believe (but have not carefully checked) that the
   complexity of [map] is O(n.log n). *)

let[@inline] tree_below_key (t : tree) (x : key) : bool =
  match 
# 31 "Map.frag.ml"
               (view t)  
# 31 "Map.frag.ml"
                with
  | 
# 32 "Map.frag.ml"
              Leaf  
# 32 "Map.frag.ml"
         ->
      true
  | 
# 34 "Map.frag.ml"
     Node (_,  v,  r)  
# 34 "Map.frag.ml"
                  ->
      E.compare (max_elt_1 v r) x < 0

let[@inline] key_below_tree (x : key) (t : tree) : bool =
  match 
# 38 "Map.frag.ml"
               (view t)  
# 38 "Map.frag.ml"
                with
  | 
# 39 "Map.frag.ml"
              Leaf  
# 39 "Map.frag.ml"
         ->
      true
  | 
# 41 "Map.frag.ml"
     Node (l,  v,  _)  
# 41 "Map.frag.ml"
                  ->
      E.compare x (min_elt_1 v l) < 0

(* [lax_join l v r] is analogous to [join l v r], but does not
   require [l < v < r]. *)

let[@inline] lax_join l v r =
  if tree_below_key l v && key_below_tree v r then
    join l v r
  else
    union l (add v r)

let rec map f (t : tree) =
  match 
# 54 "Map.frag.ml"
               (view t)  
# 54 "Map.frag.ml"
                with
  | 
# 55 "Map.frag.ml"
              Leaf  
# 55 "Map.frag.ml"
         ->
      leaf
  | 
# 57 "Map.frag.ml"
     Node (l,  v,  r)  
# 57 "Map.frag.ml"
                  ->
     (* Enforce left-to-right evaluation order. *)
     let l' = map f l in
     let v' = f v in
     let r' = map f r in
     if l == l' && v == v' && r == r' then t (* preserve sharing *)
     else lax_join l' v' r'

(* -------------------------------------------------------------------------- *)

(* [lax_join2] plays the role of [try_concat] in OCaml's Set library,
   but is implemented in a slightly better way. *)

let lax_join2 t1 t2 =
  match 
# 71 "Map.frag.ml"
               (view t1) 
# 71 "Map.frag.ml"
                , 
# 71 "Map.frag.ml"
                         (view t2)  
# 71 "Map.frag.ml"
                           with
  | 
# 72 "Map.frag.ml"
              Leaf 
# 72 "Map.frag.ml"
        , _ ->
      t2
  | _, 
# 74 "Map.frag.ml"
                 Leaf  
# 74 "Map.frag.ml"
            ->
      t1
  | _, _ ->
      if E.compare (max_elt t1) (min_elt t2) < 0 then
        join2 t1 t2
      else
        union t1 t2

(* [filter_map] is defined in the same way as in OCaml's Set library. *)

let rec filter_map f (t : tree) =
  match 
# 85 "Map.frag.ml"
               (view t)  
# 85 "Map.frag.ml"
                with
  | 
# 86 "Map.frag.ml"
              Leaf  
# 86 "Map.frag.ml"
         ->
      leaf
  | 
# 88 "Map.frag.ml"
     Node (l,  v,  r)  
# 88 "Map.frag.ml"
                  ->
     (* Enforce left-to-right evaluation order. *)
     let l' = filter_map f l in
     let v' = f v in
     let r' = filter_map f r in
     match v' with
     | Some v' ->
         if l == l' && v == v' && r == r' then t (* preserve sharing *)
         else lax_join l' v' r'
     | None ->
         lax_join2 l' r'
# 1 "Filter.frag.ml"
(******************************************************************************)
(*                                                                            *)
(*                                    Baby                                    *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*                                                                            *)
(*       Copyright 2024--2024 Inria. All rights reserved. This file is        *)
(*       distributed under the terms of the GNU Library General Public        *)
(*       License, with an exception, as described in the file LICENSE.        *)
(*                                                                            *)
(******************************************************************************)

(* [filter] is the same as in OCaml's Set library. *)

(* Because [join] and [join2] have logarithmic cost, this implementation
   of [filter] has linear time complexity. *)

(* One could imagine a completely different implementation of [filter],
   also with linear time complexity, as follows: copy the data to an
   array, filter the array, reconstruct a tree. However, this approach
   would require linear auxiliary storage, may be slower in practice, and
   would be less effective at preserving sharing in scenarios where many
   elements are retained. *)

let rec filter p (t : tree) : tree =
  match 
# 26 "Filter.frag.ml"
               (view t)  
# 26 "Filter.frag.ml"
                with
  | 
# 27 "Filter.frag.ml"
              Leaf  
# 27 "Filter.frag.ml"
         ->
      leaf
  | 
# 29 "Filter.frag.ml"
     Node (l,  v,  r)  
# 29 "Filter.frag.ml"
                  ->
      (* Enforce left-to-right evaluation order. *)
      let l' = filter p l in
      let pv = p v in
      let r' = filter p r in
      if pv then
        if l == l' && r == r' then t else join l' v r'
      else
        join2 l' r'

(* [partition] is the same as in OCaml's Set library, with one extra
   optimization: as in [filter], we attempt to preserve sharing where
   possible. *)

let rec partition p (t : tree) : tree * tree =
  match 
# 44 "Filter.frag.ml"
               (view t)  
# 44 "Filter.frag.ml"
                with
  | 
# 45 "Filter.frag.ml"
              Leaf  
# 45 "Filter.frag.ml"
         ->
      leaf, leaf
  | 
# 47 "Filter.frag.ml"
     Node (l,  v,  r)  
# 47 "Filter.frag.ml"
                  ->
      (* Enforce left-to-right evaluation order. *)
      let lt, lf = partition p l in
      let pv = p v in
      let rt, rf = partition p r in
      if pv then
        (if lt == l && rt == r then t else join lt v rt),
        join2 lf rf
      else
        join2 lt rt,
        (if lf == l && rf == r then t else join lf v rf)
# 1 "RandomAccess.frag.ml"
(******************************************************************************)
(*                                                                            *)
(*                                    Baby                                    *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*                                                                            *)
(*       Copyright 2024--2024 Inria. All rights reserved. This file is        *)
(*       distributed under the terms of the GNU Library General Public        *)
(*       License, with an exception, as described in the file LICENSE.        *)
(*                                                                            *)
(******************************************************************************)

(* The functions in this file assume that we have a constant-time [cardinal]
   function. *)

(* -------------------------------------------------------------------------- *)

(* Access to an element, based on its index. *)

(* [get] has logarithmic complexity. *)

(* If [cardinal] requires linear time then this implementation of [get] has
   quadratic time complexity, which is unacceptable. In that case, it is
   preferable to just use [to_array], which has linear time complexity,
   followed with [Array.get]. *)

let rec get (t : tree) (i : int) : key =
  assert (0 <= i && i < cardinal t);
  match 
# 29 "RandomAccess.frag.ml"
               (view t)  
# 29 "RandomAccess.frag.ml"
                with
  | 
# 30 "RandomAccess.frag.ml"
              Leaf  
# 30 "RandomAccess.frag.ml"
         ->
      assert false
  | 
# 32 "RandomAccess.frag.ml"
     Node (l,  v,  r)  
# 32 "RandomAccess.frag.ml"
                  ->
      let cl = cardinal l in
      if i = cl then
        v
      else if i < cl then
        get l i
      else
        get r (i - (cl + 1))

let get (t : tree) (i : int) : key =
  if constant_time_cardinal then
    if 0 <= i && i < cardinal t then
      get t i
    else
      Printf.sprintf "get: index %d is out of expected range [0, %d)"
        i (cardinal t)
      |> invalid_arg
  else
    failwith "get: operation is not available"

(* -------------------------------------------------------------------------- *)

(* Discovering the index of an element, based on its value. *)

(* [index] has logarithmic complexity. *)

(* [index] is roughly analogous to [List.find_index], but has a different
   type; [index] expects an element [x], whereas [List.find_index] expects
   a predicate of type [elt -> bool]. *)

(* We could offer [find_index] on sets, with linear time complexity, but
   this seems pointless. The user can implement this function using an
   enumeration, if she so wishes. *)

let rec index (i : int) (x : key) (t : tree) : int =
  match 
# 67 "RandomAccess.frag.ml"
               (view t)  
# 67 "RandomAccess.frag.ml"
                with
  | 
# 68 "RandomAccess.frag.ml"
              Leaf  
# 68 "RandomAccess.frag.ml"
         ->
      raise Not_found
  | 
# 70 "RandomAccess.frag.ml"
     Node (l,  v,  r)  
# 70 "RandomAccess.frag.ml"
                  ->
      let c = E.compare x v in
      if c < 0 then
        index i x l
      else
        let i = i + cardinal l in
        if c = 0 then
          i
        else
          index (i + 1) x r

let[@inline] index x t =
  index 0 x t

let index x t =
  if constant_time_cardinal then
    index x t
  else
    failwith "index: operation is not available"

(* -------------------------------------------------------------------------- *)

(* Splitting by index -- in two parts. *)

let rec cut (t : tree) (i : int) : tree * tree =
  assert (0 <= i && i <= cardinal t);
  if i = 0 then
    leaf, t
  else if i = cardinal t then
    t, leaf
  else
    match 
# 101 "RandomAccess.frag.ml"
                 (view t)  
# 101 "RandomAccess.frag.ml"
                  with
    | 
# 102 "RandomAccess.frag.ml"
                Leaf  
# 102 "RandomAccess.frag.ml"
           ->
        assert false
    | 
# 104 "RandomAccess.frag.ml"
       Node (l,  v,  r)  
# 104 "RandomAccess.frag.ml"
                    ->
        let cl = cardinal l in
        if i <= cl then
          let ll, lr = cut l i in
          assert (lr != l);
          ll, join lr v r
        else (* [cl < i] *)
          let rl, rr = cut r (i - (cl + 1)) in
          assert (rl != r);
          join l v rl, rr

let cut (t : tree) (i : int) : tree * tree =
  if constant_time_cardinal then
    if 0 <= i && i <= cardinal t then
      cut t i
    else
      Printf.sprintf "cut: index %d is out of expected range [0, %d]"
        i (cardinal t)
      |> invalid_arg
  else
    failwith "cut: operation is not available"

(* -------------------------------------------------------------------------- *)

(* Splitting by index -- in three parts. *)

let rec cut_and_get (t : tree) (i : int) : tree * key * tree =
  assert (0 <= i && i < cardinal t);
  match 
# 132 "RandomAccess.frag.ml"
               (view t)  
# 132 "RandomAccess.frag.ml"
                with
  | 
# 133 "RandomAccess.frag.ml"
              Leaf  
# 133 "RandomAccess.frag.ml"
         ->
      assert false
  | 
# 135 "RandomAccess.frag.ml"
     Node (l,  v,  r)  
# 135 "RandomAccess.frag.ml"
                  ->
      let cl = cardinal l in
      if i = cl then
        l, v, r
      else if i < cl then
        let ll, lv, lr = cut_and_get l i in
        ll, lv, join lr v r
      else
        let rl, rv, rr = cut_and_get r (i - (cl + 1)) in
        join l v rl, rv, rr

let cut_and_get (t : tree) (i : int) : tree * key * tree =
  if constant_time_cardinal then
    if 0 <= i && i < cardinal t then
      cut_and_get t i
    else
      Printf.sprintf "cut_and_get: index %d is out of expected range [0, %d)"
        i (cardinal t)
      |> invalid_arg
  else
    failwith "cut_and_get: operation is not available"
# 1 "Iter.frag.ml"
(******************************************************************************)
(*                                                                            *)
(*                                    Baby                                    *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*                                                                            *)
(*       Copyright 2024--2024 Inria. All rights reserved. This file is        *)
(*       distributed under the terms of the GNU Library General Public        *)
(*       License, with an exception, as described in the file LICENSE.        *)
(*                                                                            *)
(******************************************************************************)

let rec iter f (t : tree) =
  match 
# 14 "Iter.frag.ml"
               (view t)  
# 14 "Iter.frag.ml"
                with
  | 
# 15 "Iter.frag.ml"
              Leaf  
# 15 "Iter.frag.ml"
         ->
      ()
  | 
# 17 "Iter.frag.ml"
     Node (l,  v,  r)  
# 17 "Iter.frag.ml"
                  ->
      iter f l; f v; iter f r

let rec fold f (t : tree) accu =
  match 
# 21 "Iter.frag.ml"
               (view t)  
# 21 "Iter.frag.ml"
                with
  | 
# 22 "Iter.frag.ml"
              Leaf  
# 22 "Iter.frag.ml"
         ->
      accu
  | 
# 24 "Iter.frag.ml"
     Node (l,  v,  r)  
# 24 "Iter.frag.ml"
                  ->
      fold f r (f v (fold f l accu))

let rec for_all p (t : tree) =
  match 
# 28 "Iter.frag.ml"
               (view t)  
# 28 "Iter.frag.ml"
                with
  | 
# 29 "Iter.frag.ml"
              Leaf  
# 29 "Iter.frag.ml"
         ->
      true
  | 
# 31 "Iter.frag.ml"
     Node (l,  v,  r)  
# 31 "Iter.frag.ml"
                  ->
      p v && for_all p l && for_all p r

let rec exists p (t : tree) =
  match 
# 35 "Iter.frag.ml"
               (view t)  
# 35 "Iter.frag.ml"
                with
  | 
# 36 "Iter.frag.ml"
              Leaf  
# 36 "Iter.frag.ml"
         ->
      false
  | 
# 38 "Iter.frag.ml"
     Node (l,  v,  r)  
# 38 "Iter.frag.ml"
                  ->
      p v || exists p l || exists p r

# 33 "Baby.cppo.ml"
end

(* -------------------------------------------------------------------------- *)

(* The module [Baby.H] provides ready-made height-balanced binary
   search trees. *)

(* Unfortunately, the OCaml compiler is pretty bad at optimization. In my
   experience, although it does usually inline functions when requested, it
   does not subsequently perform the simplifications that one might naturally
   expect. In particular, it does not simplify match-of-match, and cannot even
   simplify match-of-constructor. *)

(* For this reason, instead of applying the functor [Make] (above), we inline
   it, using a preprocessor hack. Thus, we avoid the overhead of going through
   a [view] function; instead, we have a [VIEW] macro. *)

module H = H

(* -------------------------------------------------------------------------- *)

(* The module [Baby.W] provides ready-made weight-balanced binary
   search trees. *)

module W = W

(* -------------------------------------------------------------------------- *)

(* The following modules must be exported, because they are (or may be) used
   in the benchmarks. Because they are somewhat unlikely to be useful to an
   end user, their existence is not advertised. *)

module Height = Height
module Weight = Weight