Source file W.ml

# 1 "W.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.        *)
(*                                                                            *)
(******************************************************************************)

open Signatures



# 1 "ConcreteView.macros"
(* In the concrete view, to deconstruct a tree [t], one matches the tree [t]
   directly against the patterns [TLeaf] and [TNode _]. This requires the
   concrete definition of the type [tree] to be visible. *)

(* In the map variant, a pair must be constructed. This is rather painful,
   as it cannot be done in a pattern, on the left-hand side of the arrow;
   it must be done in an expression, on the right-hand side of the arrow.
   This forces the macro [NODE] to include the arrow itself. *)







# 1 "Derived.macros"
(******************************************************************************)
(*                                                                            *)
(*                                    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 "Derived.macros"
(* [BOTH_EMPTY(l,r)] determines whether the trees [l] and [r] are both empty. *)


# 19 "W.cppo.ml"
module Set = struct
  module type OrderedType = OrderedType
  module type S = SET
  module[@inline] Make (E : OrderedType) = struct
    include WeightSet
# 1 "UpperLayer.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. *)

(* A key is a value of the ordered type [E.t]. *)

(* In the set variant, a set element and a key are the same thing.

   In the map variant, a map element is a binding, that is, a key-data pair.
   Therefore, a key is just the first component of a map element. *)

(* The following types exist in both variants:

   + [key] is the type of a key;
   + [DATA] is the type of a datum;
   + [ELT] is the type of an element;
   + [TREE] is the type of a tree.

   [DATA], [ELT], and [TREE] may contain a wildcard, so they can be used only
   in type annotations (as opposed to type definitions, signatures, etc.).

   The following macros exist in both variants:

   + [EXTRA(x)] expands to nothing in the set variant
                and to [x] in the map variant;
   + [GET_KEY(v)] extracts the key component of the element [v];
   + [GET_DATA(v)] extracts the data component of the element [v];
 *)

type key = E.t


# 48 "UpperLayer.frag.ml"
type elt = key
type set = elt tree
type t = set




# 74 "UpperLayer.frag.ml"
(* The total order on elements. *)

let[@inline] compare_elts (x : 
# 76 "UpperLayer.frag.ml"
                                         elt 
# 76 "UpperLayer.frag.ml"
                                  ) (y : 
# 76 "UpperLayer.frag.ml"
                                                   elt 
# 76 "UpperLayer.frag.ml"
                                            ) : int =
  E.compare (
# 77 "UpperLayer.frag.ml"
                (x) 
# 77 "UpperLayer.frag.ml"
                       ) (
# 77 "UpperLayer.frag.ml"
                             (y) 
# 77 "UpperLayer.frag.ml"
                                    )

(* The following macro is used by [union] and [inter] on maps.
   We could also make it a function and mark it [@inline]. *)


# 85 "UpperLayer.frag.ml"
(* The following macros abstract away the distinction between
   [if] on a Boolean value and [match] on an option. *)


# 96 "UpperLayer.frag.ml"
(* The following macro applies the function [f] directly to [v] in the set
   variant and separately to the two components of the pair [v] in the map
   variant. *)


# 108 "UpperLayer.frag.ml"
(* -------------------------------------------------------------------------- *)

(* 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 : 
# 13 "Empty.frag.ml"
                              elt  tree  
# 13 "Empty.frag.ml"
                 =
  leaf

let is_empty (t : 
# 16 "Empty.frag.ml"
                                    elt  tree 
# 16 "Empty.frag.ml"
                      ) : bool =
  match 
# 17 "Empty.frag.ml"
         
  (t)  
# 17 "Empty.frag.ml"
                with
  | 
# 18 "Empty.frag.ml"
     
  TLeaf  
# 18 "Empty.frag.ml"
         ->
      true
  | 
# 20 "Empty.frag.ml"
     
  TNode { l = _; v =  _; r =  _; _ } -> 
      
# 21 "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 : 
# 13 "MinMax.frag.ml"
                                       elt 
# 13 "MinMax.frag.ml"
                                ) (t : 
# 13 "MinMax.frag.ml"
                                                         elt  tree 
# 13 "MinMax.frag.ml"
                                           ) : 
# 13 "MinMax.frag.ml"
                                                         elt  
# 13 "MinMax.frag.ml"
                                                   =
  match 
# 14 "MinMax.frag.ml"
         
  (t)  
# 14 "MinMax.frag.ml"
                with
  | 
# 15 "MinMax.frag.ml"
     
  TLeaf  
# 15 "MinMax.frag.ml"
         ->
      default
  | 
# 17 "MinMax.frag.ml"
     
  TNode { l = l; v =  v; r =  _; _ } -> 
      
# 18 "MinMax.frag.ml"
      min_elt_1 v l

let min_elt (t : 
# 20 "MinMax.frag.ml"
                                   elt  tree 
# 20 "MinMax.frag.ml"
                     ) : 
# 20 "MinMax.frag.ml"
                                   elt  
# 20 "MinMax.frag.ml"
                             =
  match 
# 21 "MinMax.frag.ml"
         
  (t)  
# 21 "MinMax.frag.ml"
                with
  | 
# 22 "MinMax.frag.ml"
     
  TLeaf  
# 22 "MinMax.frag.ml"
         ->
      raise Not_found
  | 
# 24 "MinMax.frag.ml"
     
  TNode { l = l; v =  v; r =  _; _ } -> 
      
# 25 "MinMax.frag.ml"
      min_elt_1 v l

let rec min_elt_opt_1 (default : 
# 27 "MinMax.frag.ml"
                                           elt 
# 27 "MinMax.frag.ml"
                                    ) (t : 
# 27 "MinMax.frag.ml"
                                                             elt  tree 
# 27 "MinMax.frag.ml"
                                               ) : 
# 27 "MinMax.frag.ml"
                                                             elt  
# 27 "MinMax.frag.ml"
                                                       option =
  match 
# 28 "MinMax.frag.ml"
         
  (t)  
# 28 "MinMax.frag.ml"
                with
  | 
# 29 "MinMax.frag.ml"
     
  TLeaf  
# 29 "MinMax.frag.ml"
         ->
      Some default
  | 
# 31 "MinMax.frag.ml"
     
  TNode { l = l; v =  v; r =  _; _ } -> 
      
# 32 "MinMax.frag.ml"
      min_elt_opt_1 v l

let min_elt_opt (t : 
# 34 "MinMax.frag.ml"
                                       elt  tree 
# 34 "MinMax.frag.ml"
                         ) : 
# 34 "MinMax.frag.ml"
                                       elt  
# 34 "MinMax.frag.ml"
                                 option =
  match 
# 35 "MinMax.frag.ml"
         
  (t)  
# 35 "MinMax.frag.ml"
                with
  | 
# 36 "MinMax.frag.ml"
     
  TLeaf  
# 36 "MinMax.frag.ml"
         ->
      None
  | 
# 38 "MinMax.frag.ml"
     
  TNode { l = l; v =  v; r =  _; _ } -> 
      
# 39 "MinMax.frag.ml"
      min_elt_opt_1 v l

let rec max_elt_1 (default : 
# 41 "MinMax.frag.ml"
                                       elt 
# 41 "MinMax.frag.ml"
                                ) (t : 
# 41 "MinMax.frag.ml"
                                                         elt  tree 
# 41 "MinMax.frag.ml"
                                           ) : 
# 41 "MinMax.frag.ml"
                                                         elt  
# 41 "MinMax.frag.ml"
                                                   =
  match 
# 42 "MinMax.frag.ml"
         
  (t)  
# 42 "MinMax.frag.ml"
                with
  | 
# 43 "MinMax.frag.ml"
     
  TLeaf  
# 43 "MinMax.frag.ml"
         ->
      default
  | 
# 45 "MinMax.frag.ml"
     
  TNode { l = _; v =  v; r =  r; _ } -> 
      
# 46 "MinMax.frag.ml"
      max_elt_1 v r

let max_elt (t : 
# 48 "MinMax.frag.ml"
                                   elt  tree 
# 48 "MinMax.frag.ml"
                     ) : 
# 48 "MinMax.frag.ml"
                                   elt  
# 48 "MinMax.frag.ml"
                             =
  match 
# 49 "MinMax.frag.ml"
         
  (t)  
# 49 "MinMax.frag.ml"
                with
  | 
# 50 "MinMax.frag.ml"
     
  TLeaf  
# 50 "MinMax.frag.ml"
         ->
      raise Not_found
  | 
# 52 "MinMax.frag.ml"
     
  TNode { l = _; v =  v; r =  r; _ } -> 
      
# 53 "MinMax.frag.ml"
      max_elt_1 v r

let rec max_elt_opt_1 (default : 
# 55 "MinMax.frag.ml"
                                           elt 
# 55 "MinMax.frag.ml"
                                    ) (t : 
# 55 "MinMax.frag.ml"
                                                             elt  tree 
# 55 "MinMax.frag.ml"
                                               ) : 
# 55 "MinMax.frag.ml"
                                                             elt  
# 55 "MinMax.frag.ml"
                                                       option =
  match 
# 56 "MinMax.frag.ml"
         
  (t)  
# 56 "MinMax.frag.ml"
                with
  | 
# 57 "MinMax.frag.ml"
     
  TLeaf  
# 57 "MinMax.frag.ml"
         ->
      Some default
  | 
# 59 "MinMax.frag.ml"
     
  TNode { l = _; v =  v; r =  r; _ } -> 
      
# 60 "MinMax.frag.ml"
      max_elt_opt_1 v r

let max_elt_opt (t : 
# 62 "MinMax.frag.ml"
                                       elt  tree 
# 62 "MinMax.frag.ml"
                         ) : 
# 62 "MinMax.frag.ml"
                                       elt  
# 62 "MinMax.frag.ml"
                                 option =
  match 
# 63 "MinMax.frag.ml"
         
  (t)  
# 63 "MinMax.frag.ml"
                with
  | 
# 64 "MinMax.frag.ml"
     
  TLeaf  
# 64 "MinMax.frag.ml"
         ->
      None
  | 
# 66 "MinMax.frag.ml"
     
  TNode { l = _; v =  v; r =  r; _ } -> 
      
# 67 "MinMax.frag.ml"
      max_elt_opt_1 v r

(* In the map variant, the above operations have different names. *)


# 78 "MinMax.frag.ml"
(* 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.        *)
(*                                                                            *)
(******************************************************************************)

(* The value [v] that is extracted out of the tree has type [ELT]. In the set
   variant, it is an element of the set. In the map variant, it is a pair of
   a key and a value. In either case, [GET_KEY(v)] is a key. *)

let rec mem (x : key) (t : 
# 17 "Mem.frag.ml"
                                             elt  tree 
# 17 "Mem.frag.ml"
                               ) : bool =
  match 
# 18 "Mem.frag.ml"
         
  (t)  
# 18 "Mem.frag.ml"
                with
  | 
# 19 "Mem.frag.ml"
     
  TLeaf  
# 19 "Mem.frag.ml"
         ->
      false
  | 
# 21 "Mem.frag.ml"
     
  TNode { l = l; v =  v; r =  r; _ } -> 
      
# 22 "Mem.frag.ml"
      let c = E.compare x (
# 22 "Mem.frag.ml"
                              (v) 
# 22 "Mem.frag.ml"
                                     ) 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 : 
# 13 "Find.frag.ml"
                                              elt  tree 
# 13 "Find.frag.ml"
                                ) : 
# 13 "Find.frag.ml"
                                             elt  
# 13 "Find.frag.ml"
                                         =
  match 
# 14 "Find.frag.ml"
         
  (t)  
# 14 "Find.frag.ml"
                with
  | 
# 15 "Find.frag.ml"
     
  TLeaf  
# 15 "Find.frag.ml"
         ->
      raise Not_found
  | 
# 17 "Find.frag.ml"
     
  TNode { l = l; v =  v; r =  r; _ } -> 
      
# 18 "Find.frag.ml"
      let c = E.compare x (
# 18 "Find.frag.ml"
                              (v) 
# 18 "Find.frag.ml"
                                     ) in
      if c = 0 then
        
# 20 "Find.frag.ml"
          (v) 
      
# 21 "Find.frag.ml"
      else if c < 0 then
        find x l
      else
        find x r

let rec find_opt (x : key) (t : 
# 26 "Find.frag.ml"
                                                  elt  tree 
# 26 "Find.frag.ml"
                                    ) : 
# 26 "Find.frag.ml"
                                                 elt  
# 26 "Find.frag.ml"
                                             option =
  match 
# 27 "Find.frag.ml"
         
  (t)  
# 27 "Find.frag.ml"
                with
  | 
# 28 "Find.frag.ml"
     
  TLeaf  
# 28 "Find.frag.ml"
         ->
      None
  | 
# 30 "Find.frag.ml"
     
  TNode { l = l; v =  v; r =  r; _ } -> 
      
# 31 "Find.frag.ml"
      let c = E.compare x (
# 31 "Find.frag.ml"
                              (v) 
# 31 "Find.frag.ml"
                                     ) in
      if c = 0 then
        Some (
# 33 "Find.frag.ml"
                (v) 
# 33 "Find.frag.ml"
                         )
      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 : 
# 52 "Find.frag.ml"
                                       elt 
# 52 "Find.frag.ml"
                                ) (f : key -> bool) (t : 
# 52 "Find.frag.ml"
                                                                           elt  tree 
# 52 "Find.frag.ml"
                                                             ) : 
# 52 "Find.frag.ml"
                                                                           elt  
# 52 "Find.frag.ml"
                                                                     =
  match 
# 53 "Find.frag.ml"
         
  (t)  
# 53 "Find.frag.ml"
                with
  | 
# 54 "Find.frag.ml"
     
  TLeaf  
# 54 "Find.frag.ml"
         ->
      v0
  | 
# 56 "Find.frag.ml"
     
  TNode { l = l; v =  v; r =  r; _ } -> 
      
# 57 "Find.frag.ml"
      if f (
# 57 "Find.frag.ml"
               (v) 
# 57 "Find.frag.ml"
                      ) then
        find_first_aux v f l
      else
        find_first_aux v0 f r

let rec find_first (f : key -> bool) (t : 
# 62 "Find.frag.ml"
                                                            elt  tree 
# 62 "Find.frag.ml"
                                              ) : 
# 62 "Find.frag.ml"
                                                            elt  
# 62 "Find.frag.ml"
                                                      =
  match 
# 63 "Find.frag.ml"
         
  (t)  
# 63 "Find.frag.ml"
                with
  | 
# 64 "Find.frag.ml"
     
  TLeaf  
# 64 "Find.frag.ml"
         ->
      raise Not_found
  | 
# 66 "Find.frag.ml"
     
  TNode { l = l; v =  v; r =  r; _ } -> 
      
# 67 "Find.frag.ml"
      if f (
# 67 "Find.frag.ml"
               (v) 
# 67 "Find.frag.ml"
                      ) then
        find_first_aux v f l
      else
        find_first f r

let rec find_first_opt_aux (v0 : 
# 72 "Find.frag.ml"
                                           elt 
# 72 "Find.frag.ml"
                                    ) (f : key -> bool) (t : 
# 72 "Find.frag.ml"
                                                                               elt  tree 
# 72 "Find.frag.ml"
                                                                 ) : 
# 72 "Find.frag.ml"
                                                                               elt  
# 72 "Find.frag.ml"
                                                                         option =
  match 
# 73 "Find.frag.ml"
         
  (t)  
# 73 "Find.frag.ml"
                with
  | 
# 74 "Find.frag.ml"
     
  TLeaf  
# 74 "Find.frag.ml"
         ->
      Some v0
  | 
# 76 "Find.frag.ml"
     
  TNode { l = l; v =  v; r =  r; _ } -> 
      
# 77 "Find.frag.ml"
      if f (
# 77 "Find.frag.ml"
               (v) 
# 77 "Find.frag.ml"
                      ) then
        find_first_opt_aux v f l
      else
        find_first_opt_aux v0 f r

let rec find_first_opt (f : key -> bool) (t : 
# 82 "Find.frag.ml"
                                                                elt  tree 
# 82 "Find.frag.ml"
                                                  ) : 
# 82 "Find.frag.ml"
                                                                elt  
# 82 "Find.frag.ml"
                                                          option =
  match 
# 83 "Find.frag.ml"
         
  (t)  
# 83 "Find.frag.ml"
                with
  | 
# 84 "Find.frag.ml"
     
  TLeaf  
# 84 "Find.frag.ml"
         ->
      None
  | 
# 86 "Find.frag.ml"
     
  TNode { l = l; v =  v; r =  r; _ } -> 
      
# 87 "Find.frag.ml"
      if f (
# 87 "Find.frag.ml"
               (v) 
# 87 "Find.frag.ml"
                      ) then
        find_first_opt_aux v f l
      else
        find_first_opt f r

let rec find_last_aux (v0 : 
# 92 "Find.frag.ml"
                                      elt 
# 92 "Find.frag.ml"
                               ) (f : key -> bool) (t : 
# 92 "Find.frag.ml"
                                                                          elt  tree 
# 92 "Find.frag.ml"
                                                            ) : 
# 92 "Find.frag.ml"
                                                                          elt  
# 92 "Find.frag.ml"
                                                                    =
  match 
# 93 "Find.frag.ml"
         
  (t)  
# 93 "Find.frag.ml"
                with
  | 
# 94 "Find.frag.ml"
     
  TLeaf  
# 94 "Find.frag.ml"
         ->
      v0
  | 
# 96 "Find.frag.ml"
     
  TNode { l = l; v =  v; r =  r; _ } -> 
      
# 97 "Find.frag.ml"
      if f (
# 97 "Find.frag.ml"
               (v) 
# 97 "Find.frag.ml"
                      ) then
        find_last_aux v f r
      else
        find_last_aux v0 f l

let rec find_last (f : key -> bool) (t : 
# 102 "Find.frag.ml"
                                                           elt  tree 
# 102 "Find.frag.ml"
                                             ) : 
# 102 "Find.frag.ml"
                                                           elt  
# 102 "Find.frag.ml"
                                                     =
  match 
# 103 "Find.frag.ml"
         
  (t)  
# 103 "Find.frag.ml"
                with
  | 
# 104 "Find.frag.ml"
     
  TLeaf  
# 104 "Find.frag.ml"
         ->
      raise Not_found
  | 
# 106 "Find.frag.ml"
     
  TNode { l = l; v =  v; r =  r; _ } -> 
      
# 107 "Find.frag.ml"
      if f (
# 107 "Find.frag.ml"
               (v) 
# 107 "Find.frag.ml"
                      ) then
        find_last_aux v f r
      else
        find_last f l

let rec find_last_opt_aux (v0 : 
# 112 "Find.frag.ml"
                                          elt 
# 112 "Find.frag.ml"
                                   ) (f : key -> bool) (t : 
# 112 "Find.frag.ml"
                                                                              elt  tree 
# 112 "Find.frag.ml"
                                                                ) : 
# 112 "Find.frag.ml"
                                                                              elt  
# 112 "Find.frag.ml"
                                                                        option =
  match 
# 113 "Find.frag.ml"
         
  (t)  
# 113 "Find.frag.ml"
                with
  | 
# 114 "Find.frag.ml"
     
  TLeaf  
# 114 "Find.frag.ml"
         ->
      Some v0
  | 
# 116 "Find.frag.ml"
     
  TNode { l = l; v =  v; r =  r; _ } -> 
      
# 117 "Find.frag.ml"
      if f (
# 117 "Find.frag.ml"
               (v) 
# 117 "Find.frag.ml"
                      ) then
        find_last_opt_aux v f r
      else
        find_last_opt_aux v0 f l

let rec find_last_opt (f : key -> bool) (t : 
# 122 "Find.frag.ml"
                                                               elt  tree 
# 122 "Find.frag.ml"
                                                 ) : 
# 122 "Find.frag.ml"
                                                               elt  
# 122 "Find.frag.ml"
                                                         option =
  match 
# 123 "Find.frag.ml"
         
  (t)  
# 123 "Find.frag.ml"
                with
  | 
# 124 "Find.frag.ml"
     
  TLeaf  
# 124 "Find.frag.ml"
         ->
      None
  | 
# 126 "Find.frag.ml"
     
  TNode { l = l; v =  v; r =  r; _ } -> 
      
# 127 "Find.frag.ml"
      if f (
# 127 "Find.frag.ml"
               (v) 
# 127 "Find.frag.ml"
                      ) 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.) (Set variant only.)

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

 *)


# 25 "Add.frag.ml"
(* This is a less elegant but more efficient version of insertion. *)

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

(* If an equivalent element is already present in the set, then the
   existing element is retained, so the set is unchanged. *)

let rec add (x : key) (t : 
# 32 "Add.frag.ml"
                                             elt  tree 
# 32 "Add.frag.ml"
                               ) : 
# 32 "Add.frag.ml"
                                                     elt  tree  
# 32 "Add.frag.ml"
                                        =
  match 
# 33 "Add.frag.ml"
         
  (t)  
# 33 "Add.frag.ml"
                with
  | 
# 34 "Add.frag.ml"
     
  TLeaf  
# 34 "Add.frag.ml"
         ->
      singleton x
  | 
# 36 "Add.frag.ml"
     
  TNode { l = l; v =  v; r =  r; _ } -> 
      
# 37 "Add.frag.ml"
      let c = E.compare x v in
      if c = 0 then
        (* Retain the existing element: *)
        t
      else if c < 0 then
        let l' = add x l in
        if l == l' then t else join_quasi_siblings l' v r
      else
        let r' = add x r in
        if r == r' then t else join_quasi_siblings l v r'

(* [add_absent] is currently used by [xor]. We could optimize it,
   a little, by removing one test. *)

let add_absent = add

# 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 : 
# 16 "Remove.frag.ml"
                                                elt  tree 
# 16 "Remove.frag.ml"
                                  ) (v : 
# 16 "Remove.frag.ml"
                                                   elt 
# 16 "Remove.frag.ml"
                                            ) (r : 
# 16 "Remove.frag.ml"
                                                                     elt  tree 
# 16 "Remove.frag.ml"
                                                       ) : 
# 16 "Remove.frag.ml"
                                                                             elt  tree  
# 16 "Remove.frag.ml"
                                                                =
  match 
# 17 "Remove.frag.ml"
         
  (l)  
# 17 "Remove.frag.ml"
                with
  | 
# 18 "Remove.frag.ml"
     
  TLeaf  
# 18 "Remove.frag.ml"
         ->
      r
  | 
# 20 "Remove.frag.ml"
     
  TNode { l = ll; v =  lv; r =  lr; _ } -> 
      
# 21 "Remove.frag.ml"
      let l = remove_min_elt_1 ll lv lr in
      join_quasi_siblings l v r

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

let remove_min_elt (t : 
# 26 "Remove.frag.ml"
                                          elt  tree 
# 26 "Remove.frag.ml"
                            ) : 
# 26 "Remove.frag.ml"
                                                  elt  tree  
# 26 "Remove.frag.ml"
                                     =
  match 
# 27 "Remove.frag.ml"
         
  (t)  
# 27 "Remove.frag.ml"
                with
  | 
# 28 "Remove.frag.ml"
     
  TLeaf  
# 28 "Remove.frag.ml"
         ->
      raise Not_found
  | 
# 30 "Remove.frag.ml"
     
  TNode { l = l; v =  v; r =  r; _ } -> 
      
# 31 "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 : 
# 36 "Remove.frag.ml"
                                                elt  tree 
# 36 "Remove.frag.ml"
                                  ) (v : 
# 36 "Remove.frag.ml"
                                                   elt 
# 36 "Remove.frag.ml"
                                            ) (r : 
# 36 "Remove.frag.ml"
                                                                     elt  tree 
# 36 "Remove.frag.ml"
                                                       ) : 
# 36 "Remove.frag.ml"
                                                                             elt  tree  
# 36 "Remove.frag.ml"
                                                                =
  match 
# 37 "Remove.frag.ml"
         
  (r)  
# 37 "Remove.frag.ml"
                with
  | 
# 38 "Remove.frag.ml"
     
  TLeaf  
# 38 "Remove.frag.ml"
         ->
      l
  | 
# 40 "Remove.frag.ml"
     
  TNode { l = rl; v =  rv; r =  rr; _ } -> 
      
# 41 "Remove.frag.ml"
      let r = remove_max_elt_1 rl rv rr in
      join_quasi_siblings l v r

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

let remove_max_elt (t : 
# 46 "Remove.frag.ml"
                                          elt  tree 
# 46 "Remove.frag.ml"
                            ) : 
# 46 "Remove.frag.ml"
                                                  elt  tree  
# 46 "Remove.frag.ml"
                                     =
  match 
# 47 "Remove.frag.ml"
         
  (t)  
# 47 "Remove.frag.ml"
                with
  | 
# 48 "Remove.frag.ml"
     
  TLeaf  
# 48 "Remove.frag.ml"
         ->
      raise Not_found
  | 
# 50 "Remove.frag.ml"
     
  TNode { l = l; v =  v; r =  r; _ } -> 
      
# 51 "Remove.frag.ml"
      remove_max_elt_1 l v r

(* In the map variant, the above operations have different names. *)


# 60 "Remove.frag.ml"
(* [join2_siblings l r] is analogous to [join2 l r], but requires the
   subtrees [l] and [r] to be siblings. *)

(* [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 : 
# 72 "Remove.frag.ml"
                                          elt  tree 
# 72 "Remove.frag.ml"
                            ) (r : 
# 72 "Remove.frag.ml"
                                                     elt  tree 
# 72 "Remove.frag.ml"
                                       ) : 
# 72 "Remove.frag.ml"
                                                             elt  tree  
# 72 "Remove.frag.ml"
                                                =
  assert (siblings l r);
  match 
# 74 "Remove.frag.ml"
         
  (l) 
# 74 "Remove.frag.ml"
               , 
# 74 "Remove.frag.ml"
                  
  (r)  
# 74 "Remove.frag.ml"
                         with
  | _, 
# 75 "Remove.frag.ml"
        
  TLeaf  
# 75 "Remove.frag.ml"
            ->
      l
  | 
# 77 "Remove.frag.ml"
     
  TLeaf 
# 77 "Remove.frag.ml"
        , _ ->
      r
  | _, 
# 79 "Remove.frag.ml"
        
  TNode { l = rl; v =  rv; r =  rr; _ } -> 
      
# 80 "Remove.frag.ml"
      join_quasi_siblings
        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.) (Set variant only.)

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 : 
# 99 "Remove.frag.ml"
                                                elt  tree 
# 99 "Remove.frag.ml"
                                  ) : 
# 99 "Remove.frag.ml"
                                                        elt  tree  
# 99 "Remove.frag.ml"
                                           =
  match 
# 100 "Remove.frag.ml"
         
  (t)  
# 100 "Remove.frag.ml"
                with
  | 
# 101 "Remove.frag.ml"
     
  TLeaf  
# 101 "Remove.frag.ml"
         ->
      empty
  | 
# 103 "Remove.frag.ml"
     
  TNode { l = l; v =  v; r =  r; _ } -> 
      
# 104 "Remove.frag.ml"
      let c = E.compare x (
# 104 "Remove.frag.ml"
                              (v) 
# 104 "Remove.frag.ml"
                                     ) 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_quasi_siblings l' v r
      else
        let r' = remove x r in
        if r == r' then t else join_quasi_siblings 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. *)

(* In the set variant, the second component of the result has type [bool].
   In the map variant, it has type [DATA option]. *)




# 33 "Split.frag.ml"
let rec split (k : key) (t : 
# 33 "Split.frag.ml"
                                               elt  tree 
# 33 "Split.frag.ml"
                                 ) : 
# 33 "Split.frag.ml"
                                                       elt  tree  
# 33 "Split.frag.ml"
                                          * 
# 33 "Split.frag.ml"
                                                 bool  
# 33 "Split.frag.ml"
                                                   * 
# 33 "Split.frag.ml"
                                                                       elt  tree  
# 33 "Split.frag.ml"
                                                          =
  match 
# 34 "Split.frag.ml"
         
  (t)  
# 34 "Split.frag.ml"
                with
  | 
# 35 "Split.frag.ml"
     
  TLeaf  
# 35 "Split.frag.ml"
         ->
      leaf, 
# 36 "Split.frag.ml"
                 false 
# 36 "Split.frag.ml"
                  , leaf
  | 
# 37 "Split.frag.ml"
     
  TNode { l = l; v =  v; r =  r; _ } -> 
      
# 38 "Split.frag.ml"
      let c = E.compare k (
# 38 "Split.frag.ml"
                              (v) 
# 38 "Split.frag.ml"
                                     ) in
      if c = 0 then
        l, 
# 40 "Split.frag.ml"
               true 
# 40 "Split.frag.ml"
                  , r
      else if c < 0 then
        let ll, b, lr = split k l in
        ll, b, (if lr == l then t else join lr v r)
      else
        let rl, b, rr = split k r in
        (if rl == r then t else join l v rl), b, rr



# 52 "Split.frag.ml"
(* 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 : 'a tree) : 'a tree * 'a tree =
  match 
# 59 "Split.frag.ml"
         
  (t)  
# 59 "Split.frag.ml"
                with
  | 
# 60 "Split.frag.ml"
     
  TLeaf  
# 60 "Split.frag.ml"
         ->
      leaf, leaf
  | 
# 62 "Split.frag.ml"
     
  TNode { l = l; v =  v; r =  r; _ } -> 
      
# 63 "Split.frag.ml"
      let c = E.compare k v 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 v r)
      else
        let rl, rr = split13 k r in
        (if rl == r then t else join l v rl), rr

# 1 "Join.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.        *)
(*                                                                            *)
(******************************************************************************)

(* [join2 l r] requires [l < r]. It joins the trees [l] and [r]
   into a single tree. *)

(* [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].
   (Set variant only.)

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 : 
# 48 "Join.frag.ml"
                                 elt  tree 
# 48 "Join.frag.ml"
                   ) (r : 
# 48 "Join.frag.ml"
                                            elt  tree 
# 48 "Join.frag.ml"
                              ) : 
# 48 "Join.frag.ml"
                                                    elt  tree  
# 48 "Join.frag.ml"
                                       =
  match 
# 49 "Join.frag.ml"
         
  (l) 
# 49 "Join.frag.ml"
               , 
# 49 "Join.frag.ml"
                  
  (r)  
# 49 "Join.frag.ml"
                         with
  | 
# 50 "Join.frag.ml"
     
  TLeaf 
# 50 "Join.frag.ml"
        , _ ->
      r
  | _, 
# 52 "Join.frag.ml"
        
  TLeaf  
# 52 "Join.frag.ml"
            ->
      l
  | _, 
# 54 "Join.frag.ml"
        
  TNode { l = rl; v =  rv; r =  rr; _ } -> 
      
# 55 "Join.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

  (* An enumeration can be viewed as a list of pairs of an element and
     a (sub)tree. It is sorted in increasing order of keys. *)

  (* There is no structural difference between the set variant and the
     map variant. In the map variant, we do not flatten the key-data
     pair into the constructor [More], as this seems unlikely to lead
     to a gain in performance. *)

  (* In both variants, the type [ienum] is parameterized with ['v].
     This type is internal (not public). *)

  type 'v ienum =
    | End
    | More of 'v * 'v tree * 'v ienum

  (* The public type [enum] is unparameterized in the set variant and
     parameterized with ['a] in the map variant. *)

  
# 36 "Enum.frag.ml"
  type enum = elt ienum
  type t = enum

  
# 43 "Enum.frag.ml"
  let empty : 'v ienum =
    End

  let[@inline] is_empty (e : 'v ienum) : 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 : 'v tree) (e : 'v ienum) : 'v ienum =
    match 
# 57 "Enum.frag.ml"
           
  (t)  
# 57 "Enum.frag.ml"
                  with
    | 
# 58 "Enum.frag.ml"
       
  TLeaf  
# 58 "Enum.frag.ml"
           ->
        e
    | 
# 60 "Enum.frag.ml"
       
  TNode { l = l; v =  v; r =  r; _ } -> 
        
# 61 "Enum.frag.ml"
        cat_tree_enum l (More (v, r, e))

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

  let[@inline] enum (t : 'v tree) : 'v ienum =
    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 : 'v tree) (e : 'v ienum) : 'v ienum =
    match 
# 79 "Enum.frag.ml"
           
  (t)  
# 79 "Enum.frag.ml"
                  with
    | 
# 80 "Enum.frag.ml"
       
  TLeaf  
# 80 "Enum.frag.ml"
           ->
        e
    | 
# 82 "Enum.frag.ml"
       
  TNode { l = l; v =  v; r =  r; _ } -> 
        
# 83 "Enum.frag.ml"
        let c = E.compare (
# 83 "Enum.frag.ml"
                              (v) 
# 83 "Enum.frag.ml"
                                     ) 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 : 'v tree) : 'v ienum =
    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 : 'v tree) (e : 'v ienum) : 'v ienum =
    (* 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 (
# 108 "Enum.frag.ml"
                                  (v') 
# 108 "Enum.frag.ml"
                                          ) 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 : 'v ienum) : 'v ienum =
    match e with
    | More (v, r, e') ->
        if E.compare low (
# 136 "Enum.frag.ml"
                             (v) 
# 136 "Enum.frag.ml"
                                    ) <= 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 : 'v ienum) : 
# 145 "Enum.frag.ml"
                                      elt  
# 145 "Enum.frag.ml"
                                =
    match e with
    | End            -> raise Not_found
    | More (v, _, _) -> v

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

  let head_opt (e : 'v ienum) : 
# 155 "Enum.frag.ml"
                                          elt  
# 155 "Enum.frag.ml"
                                    option =
    match e with
    | End            -> None
    | More (v, _, _) -> Some v

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

  (* [equal e1 e2] compares the enumerations [e1] and [e2]. *)

  (* In the map variant, [equal] takes an extra argument, [eq], which is used
     to compare the data components of two values. In the set variant, this
     argument is absent; there are no data components, and one can think of
     [eq] as the constant function [true]. *)

  let rec equal 
# 172 "Enum.frag.ml"
                  
# 172 "Enum.frag.ml"
                          (e1 : _ ienum) (e2 : _ ienum) : bool =
    match e1, e2 with
    | End, End ->
        true
    | End, More _
    | More _, End ->
        false
    | More (v1, r1, e1), More (v2, r2, e2) ->
        compare_elts v1 v2 = 0 &&
        
# 184 "Enum.frag.ml"
        equal 
# 184 "Enum.frag.ml"
                
# 184 "Enum.frag.ml"
                        (cat_tree_enum r1 e1) (cat_tree_enum r2 e2)

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

  (* In the map variant, [compare] takes an extra argument, [cmp], which is
     used to compare the data components of two values. In the set variant,
     this argument is absent; there are no data components, and one can think
     of [cmp] as the constant function [0]. *)

  let rec compare 
# 194 "Enum.frag.ml"
                    
# 194 "Enum.frag.ml"
                             (e1 : _ ienum) (e2 : _ ienum) : int =
    match e1, e2 with
    | End, End ->
        0
    | End, More _ ->
        -1
    | More _, End ->
        1
    | More (v1, r1, e1), More (v2, r2, e2) ->
        let c = compare_elts v1 v2 in
        if c <> 0 then c else
        
# 209 "Enum.frag.ml"
        compare 
# 209 "Enum.frag.ml"
                  
# 209 "Enum.frag.ml"
                           (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 : 'v ienum) : 
# 213 "Enum.frag.ml"
                                                 elt  
# 213 "Enum.frag.ml"
                                           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 : 'v ienum) : 
# 220 "Enum.frag.ml"
                                        elt  
# 220 "Enum.frag.ml"
                                  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 : 
# 233 "Enum.frag.ml"
                                  elt 
# 233 "Enum.frag.ml"
                           ) (r : 'v tree) (e : 'v ienum) : 'v tree =
    match e with
    | End ->
        join leaf v r
    | More (v', r', e) ->
        elements v (join r v' r') e

  let elements (e : 'v ienum) : 'v 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 : 'v tree) (e : 'v ienum) : 'v ienum =
    match 
# 256 "Enum.frag.ml"
           
  (t)  
# 256 "Enum.frag.ml"
                  with
    | 
# 257 "Enum.frag.ml"
       
  TLeaf  
# 257 "Enum.frag.ml"
           ->
        e
    | 
# 259 "Enum.frag.ml"
       
  TNode { l = l; v =  v; r =  r; _ } -> 
        
# 260 "Enum.frag.ml"
        let c = E.compare (
# 260 "Enum.frag.ml"
                              (v) 
# 260 "Enum.frag.ml"
                                     ) 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 : 'v tree) (e : 'v ienum) : 'v ienum =
    match e with
    | More (v', r', e') ->
        let c = E.compare low (
# 275 "Enum.frag.ml"
                                  (v') 
# 275 "Enum.frag.ml"
                                          ) 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. *)

  (* In the map variant, a type annotation is required, because this function
     is polymorphic recursive. Indeed, the final recursive call exchanges the
     two sides. *)

  let rec disjoint_more_more
  
# 302 "Enum.frag.ml"
  = fun v1 r1 e1 v2 r2 e2 ->
    assert (compare_elts v1 v2 < 0);
    (* Skip past [v2] in the enumeration [e1]. *)
    (* If [v2] appears in [e1], fail. *)
    let e1 = filter_tree_enum_disjoint (
# 306 "Enum.frag.ml"
                                           (v2) 
# 306 "Enum.frag.ml"
                                                   ) 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 (compare_elts 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 : _ ienum) (e2 : _ ienum) : bool =
    match e1, e2 with
    | End, _
    | _, End ->
        true
    | More (v1, r1, e1), More (v2, r2, e2) ->
        let c = compare_elts 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 : 'v ienum) : int =
    match e with
    | End ->
        accu
    | More (_, r, e) ->
        length_aux (accu + cardinal r + 1) e

  let[@inline] length (e : 'v ienum) : 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

  (* 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 'v ienum =
    | End
    | More of 'v ienum * 'v tree * 'v

  let empty : 'v ienum =
    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 : 'v ienum) (t : 'v tree) : 'v ienum =
    match 
# 381 "Enum.frag.ml"
           
  (t)  
# 381 "Enum.frag.ml"
                  with
    | 
# 382 "Enum.frag.ml"
       
  TLeaf  
# 382 "Enum.frag.ml"
           ->
        e
    | 
# 384 "Enum.frag.ml"
       
  TNode { l = l; v =  v; r =  r; _ } -> 
        
# 385 "Enum.frag.ml"
        cat_enum_tree (More (e, l, v)) r

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

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

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

  let rec to_seq_node (e : 'v ienum) : 
# 394 "Enum.frag.ml"
                                                 elt  
# 394 "Enum.frag.ml"
                                           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 
# 22 "Compare.frag.ml"
              
# 22 "Compare.frag.ml"
                       (t1 : 
# 22 "Compare.frag.ml"
                                               elt  tree 
# 22 "Compare.frag.ml"
                                 ) (t2 : 
# 22 "Compare.frag.ml"
                                                           elt  tree 
# 22 "Compare.frag.ml"
                                             ) : int =
  
# 24 "Compare.frag.ml"
  if t1 == t2 then 0 else (* fast path *)
  
# 26 "Compare.frag.ml"
  Enum.(compare 
# 26 "Compare.frag.ml"
                  
# 26 "Compare.frag.ml"
                           (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 of sets 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 compares two enumerations. Furthermore, this
   approach works for both sets and maps. *)

(* 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 equal 
# 31 "Equal.frag.ml"
            
# 31 "Equal.frag.ml"
                    t1 t2 =
  
# 33 "Equal.frag.ml"
  t1 == t2 || (* fast path *)
  
# 35 "Equal.frag.ml"
  weight t1 = weight t2 && (* fast path *)
  Enum.(equal 
# 36 "Equal.frag.ml"
                
# 36 "Equal.frag.ml"
                        (enum t1) (enum t2))
# 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. *)

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

(* The set variant. *)


# 21 "Union.frag.ml"
(* 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
  | NODENODE(_, _, _, l2, v2, r2)
      let l1, r1 = split13 v2 t1 in
      let l = union l1 l2
      and r = union r1 r2 in
      join l v2 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 v2 t1] is safe. *)

(* We are able to use [split13] because, as soon as we know that [v2] is
   present on the right-hand side, we do not care whether it is absent or
   present on the left-hand side. In the map variant, however, we must use
   [split] instead. *)

let rec union (t1 : 'v tree) (t2 : 'v tree) : 'v tree =
  match 
# 58 "Union.frag.ml"
         
  (t1) 
# 58 "Union.frag.ml"
                , 
# 58 "Union.frag.ml"
                   
  (t2)  
# 58 "Union.frag.ml"
                           with
  | 
# 59 "Union.frag.ml"
     
  TLeaf 
# 59 "Union.frag.ml"
        , _ ->
      t2
  | _, 
# 61 "Union.frag.ml"
        
  TLeaf  
# 61 "Union.frag.ml"
            ->
      t1
  | 
# 63 "Union.frag.ml"
     
  TNode { l = l1; v =  v1; r =  r1; _ }, 
  TNode { l =  l2; v =  v2; r =  r2; _ } -> 
      
# 64 "Union.frag.ml"
      if 
# 64 "Union.frag.ml"
          (        (match  
  (l1)  with  
  TLeaf  -> true | _ -> false)  &&         (match  
  ( r1)  with  
  TLeaf  -> true | _ -> false) )  
# 64 "Union.frag.ml"
                            then add v1 t2 else
      if 
# 65 "Union.frag.ml"
          (        (match  
  (l2)  with  
  TLeaf  -> true | _ -> false)  &&         (match  
  ( r2)  with  
  TLeaf  -> true | _ -> false) )  
# 65 "Union.frag.ml"
                            then add v2 t1 else
      let l1, r1 = split13 v2 t1 in
      let l = union l1 l2
      and r = union r1 r2 in
      let v = v2 in
      if l == l2 && r == r2 then t2 else (* preserve sharing *)
      join l v 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. *)

(* The fast path, based on the test [t1 == t2], is sound because [union s s]
   is [s]. *)

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

(* In the set variant, [override] is [union]. It is commutative. *)

let override = union

# 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. *)

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

(* The set variant. *)


# 21 "Inter.frag.ml"
(* 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
  | NODENODE(_, _, _, 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 : 
# 53 "Inter.frag.ml"
                                      elt  tree 
# 53 "Inter.frag.ml"
                        ) (t2 : 
# 53 "Inter.frag.ml"
                                                  elt  tree 
# 53 "Inter.frag.ml"
                                    ) : 
# 53 "Inter.frag.ml"
                                                          elt  tree  
# 53 "Inter.frag.ml"
                                             =
  match 
# 54 "Inter.frag.ml"
         
  (t1) 
# 54 "Inter.frag.ml"
                , 
# 54 "Inter.frag.ml"
                   
  (t2)  
# 54 "Inter.frag.ml"
                           with
  | 
# 55 "Inter.frag.ml"
     
  TLeaf 
# 55 "Inter.frag.ml"
        , _
  | _, 
# 56 "Inter.frag.ml"
        
  TLeaf  
# 56 "Inter.frag.ml"
            ->
      leaf
  | 
# 58 "Inter.frag.ml"
     
  TNode { l = _; v =  _; r =  _; _ }, 
  TNode { l =  l2; v =  k2; r =  r2; _ } -> 
      
# 59 "Inter.frag.ml"
      if t1 == t2 then t2 else (* fast path *)
      if 
# 60 "Inter.frag.ml"
          (        (match  
  (l2)  with  
  TLeaf  -> true | _ -> false)  &&         (match  
  ( r2)  with  
  TLeaf  -> true | _ -> false) )  
# 60 "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]. (Set variant only.)

let rec diff (t1 : TREE) (t2 : TREE) : TREE =
  match VIEW(t1), VIEW(t2) with
  | LEAF, _ ->
      leaf
  | _, LEAF ->
      t1
  | NODENODE(_, _, _, 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. It splits the tree [t2]. *)

let rec diff (t1 : 
# 37 "Diff.frag.ml"
                                     elt  tree 
# 37 "Diff.frag.ml"
                       ) (t2 : 
# 37 "Diff.frag.ml"
                                                 elt  tree 
# 37 "Diff.frag.ml"
                                   ) : 
# 37 "Diff.frag.ml"
                                                         elt  tree  
# 37 "Diff.frag.ml"
                                            =
  match 
# 38 "Diff.frag.ml"
         
  (t1) 
# 38 "Diff.frag.ml"
                , 
# 38 "Diff.frag.ml"
                   
  (t2)  
# 38 "Diff.frag.ml"
                           with
  | 
# 39 "Diff.frag.ml"
     
  TLeaf 
# 39 "Diff.frag.ml"
        , _ ->
      leaf
  | _, 
# 41 "Diff.frag.ml"
        
  TLeaf  
# 41 "Diff.frag.ml"
            ->
      t1
  | 
# 43 "Diff.frag.ml"
     
  TNode { l = l1; v =  v1; r =  r1; _ }, 
  TNode { l =  l2; v =  v2; r =  r2; _ } -> 
      
# 44 "Diff.frag.ml"
      let k1 = 
# 44 "Diff.frag.ml"
                  (v1)  
# 44 "Diff.frag.ml"
                           in
      
# 46 "Diff.frag.ml"
      if t1 == t2 then leaf else (* fast path *)
      
# 48 "Diff.frag.ml"
      if 
# 48 "Diff.frag.ml"
          (        (match  
  (l1)  with  
  TLeaf  -> true | _ -> false)  &&         (match  
  ( r1)  with  
  TLeaf  -> true | _ -> false) )  
# 48 "Diff.frag.ml"
                            then
        (* [t1] is [singleton v1]. *)
        if mem k1 t2 then leaf else t1
      else if 
# 51 "Diff.frag.ml"
               (        (match  
  (l2)  with  
  TLeaf  -> true | _ -> false)  &&         (match  
  ( r2)  with  
  TLeaf  -> true | _ -> false) )  
# 51 "Diff.frag.ml"
                                 then
        (* [t2] is [singleton v2]. *)
        let k2 = 
# 53 "Diff.frag.ml"
                    (v2)  
# 53 "Diff.frag.ml"
                             in
        remove k2 t1
      else
        let l2, b, r2 = split k1 t2 in
        let l = diff l1 l2
        and r = diff r1 r2 in
        
# 59 "Diff.frag.ml"
         if b then 
          
# 60 "Diff.frag.ml"
          join2 l r
        
# 61 "Diff.frag.ml"
          else 
          
# 62 "Diff.frag.ml"
          if l == l1 && r == r1 then t1 else (* preserve sharing *)
          join l v1 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]. (Set variant only.)

let rec xor (t1 : TREE) (t2 : TREE) : TREE =
  match VIEW(t1), VIEW(t2) with
  | LEAF, _ ->
      t2
  | _, LEAF ->
      t1
  | NODENODE(_, _, _, 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 : 
# 37 "Xor.frag.ml"
                                    elt  tree 
# 37 "Xor.frag.ml"
                      ) (t2 : 
# 37 "Xor.frag.ml"
                                                elt  tree 
# 37 "Xor.frag.ml"
                                  ) : 
# 37 "Xor.frag.ml"
                                                        elt  tree  
# 37 "Xor.frag.ml"
                                           =
  match 
# 38 "Xor.frag.ml"
         
  (t1) 
# 38 "Xor.frag.ml"
                , 
# 38 "Xor.frag.ml"
                   
  (t2)  
# 38 "Xor.frag.ml"
                           with
  | 
# 39 "Xor.frag.ml"
     
  TLeaf 
# 39 "Xor.frag.ml"
        , _ ->
      t2
  | _, 
# 41 "Xor.frag.ml"
        
  TLeaf  
# 41 "Xor.frag.ml"
            ->
      t1
  | 
# 43 "Xor.frag.ml"
     
  TNode { l = _; v =  _; r =  _; _ }, 
  TNode { l =  l2; v =  v2; r =  r2; _ } -> 
      
# 44 "Xor.frag.ml"
      if t1 == t2 then leaf else (* fast path *)
      let k2 = 
# 45 "Xor.frag.ml"
                  (v2)  
# 45 "Xor.frag.ml"
                           in
      if 
# 46 "Xor.frag.ml"
          (        (match  
  (l2)  with  
  TLeaf  -> true | _ -> false)  &&         (match  
  ( r2)  with  
  TLeaf  -> true | _ -> false) )  
# 46 "Xor.frag.ml"
                            then
        (* [t2] is [singleton v2]. *)
        if mem k2 t1 then
          remove k2 t1
        else
          add_absent v2 t1
      else
        let l1, b, r1 = split k2 t1 in
        let l = xor l1 l2
        and r = xor r1 r2 in
        
# 56 "Xor.frag.ml"
         if b then 
          
# 57 "Xor.frag.ml"
          join2 l r
        
# 58 "Xor.frag.ml"
          else 
          
# 59 "Xor.frag.ml"
          join l v2 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.) (Set variant only.)

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"
         
  (t1) 
# 41 "Disjoint.frag.ml"
                , 
# 41 "Disjoint.frag.ml"
                   
  (t2)  
# 41 "Disjoint.frag.ml"
                           with
  | 
# 42 "Disjoint.frag.ml"
     
  TLeaf 
# 42 "Disjoint.frag.ml"
        , _
  | _, 
# 43 "Disjoint.frag.ml"
        
  TLeaf  
# 43 "Disjoint.frag.ml"
            ->
      true (* fast path *)
  | _, _ ->
      
# 47 "Disjoint.frag.ml"
      t1 != t2 && (* fast path *)
      
# 49 "Disjoint.frag.ml"
      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. *)

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

(* The set variant. *)


# 21 "Subset.frag.ml"
(* This simple version of [subset] has canonical structure. *)

(* (Disabled.)

let rec subset (t1 : set) (t2 : set) : bool =
  match VIEW(t1), VIEW(t2) with
  | LEAF, _ ->
      true
  | _, LEAF ->
      false
  | NODENODE(_, _, _, l2, v2, r2)
      let l1, r1 = split13 v2 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 : set) (t2 : set) : bool =
  match 
# 51 "Subset.frag.ml"
         
  (t1) 
# 51 "Subset.frag.ml"
                , 
# 51 "Subset.frag.ml"
                   
  (t2)  
# 51 "Subset.frag.ml"
                           with
  | 
# 52 "Subset.frag.ml"
     
  TLeaf 
# 52 "Subset.frag.ml"
        , _ ->
      true
  | _, 
# 54 "Subset.frag.ml"
        
  TLeaf  
# 54 "Subset.frag.ml"
            ->
      false
  | 
# 56 "Subset.frag.ml"
     
  TNode { l = l1; v =  v1; r =  r1; _ }, 
  TNode { l =  l2; v =  v2; r =  r2; _ } -> 
      
# 57 "Subset.frag.ml"
      t1 == t2 || (* fast path *)
      if 
# 58 "Subset.frag.ml"
          (        (match  
  (l1)  with  
  TLeaf  -> true | _ -> false)  &&         (match  
  ( r1)  with  
  TLeaf  -> true | _ -> false) )  
# 58 "Subset.frag.ml"
                            then
        (* The tree [t1] is [singleton v1]. *)
        mem v1 t2
      else
        weight t1 <= weight t2 && (* fast path *)
        let l1, r1 = split13 v2 t1 in
        subset l1 l2 && subset r1 r2

# 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] and [filter_map]. *)

(* The set variant is more complex because the function [f] is not
   necessarily monotone. The map variant is simpler because its API is
   less expressive; by construction, the key component is preserved
   and the function [f] transforms only the data component, so the
   transformation that is applied to the key-data pair is monotone. *)


# 23 "Map.frag.ml"
(* -------------------------------------------------------------------------- *)

(* The set variant. *)

(* [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 : 
# 42 "Map.frag.ml"
                                                   elt  tree 
# 42 "Map.frag.ml"
                                     ) (x : key) : bool =
  match 
# 43 "Map.frag.ml"
         
  (t)  
# 43 "Map.frag.ml"
                with
  | 
# 44 "Map.frag.ml"
     
  TLeaf  
# 44 "Map.frag.ml"
         ->
      true
  | 
# 46 "Map.frag.ml"
     
  TNode { l = _; v =  v; r =  r; _ } -> 
      
# 47 "Map.frag.ml"
      E.compare (max_elt_1 v r) x < 0

let[@inline] key_below_tree (x : key) (t : 
# 49 "Map.frag.ml"
                                                             elt  tree 
# 49 "Map.frag.ml"
                                               ) : bool =
  match 
# 50 "Map.frag.ml"
         
  (t)  
# 50 "Map.frag.ml"
                with
  | 
# 51 "Map.frag.ml"
     
  TLeaf  
# 51 "Map.frag.ml"
         ->
      true
  | 
# 53 "Map.frag.ml"
     
  TNode { l = l; v =  v; r =  _; _ } -> 
      
# 54 "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 : 
# 65 "Map.frag.ml"
                                     elt  tree 
# 65 "Map.frag.ml"
                       ) =
  match 
# 66 "Map.frag.ml"
         
  (t)  
# 66 "Map.frag.ml"
                with
  | 
# 67 "Map.frag.ml"
     
  TLeaf  
# 67 "Map.frag.ml"
         ->
      leaf
  | 
# 69 "Map.frag.ml"
     
  TNode { l = l; v =  v; r =  r; _ } -> 
     
# 70 "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 
# 83 "Map.frag.ml"
         
  (t1) 
# 83 "Map.frag.ml"
                , 
# 83 "Map.frag.ml"
                   
  (t2)  
# 83 "Map.frag.ml"
                           with
  | 
# 84 "Map.frag.ml"
     
  TLeaf 
# 84 "Map.frag.ml"
        , _ ->
      t2
  | _, 
# 86 "Map.frag.ml"
        
  TLeaf  
# 86 "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 : 
# 96 "Map.frag.ml"
                                            elt  tree 
# 96 "Map.frag.ml"
                              ) =
  match 
# 97 "Map.frag.ml"
         
  (t)  
# 97 "Map.frag.ml"
                with
  | 
# 98 "Map.frag.ml"
     
  TLeaf  
# 98 "Map.frag.ml"
         ->
      leaf
  | 
# 100 "Map.frag.ml"
     
  TNode { l = l; v =  v; r =  r; _ } -> 
      
# 101 "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 : 
# 25 "Filter.frag.ml"
                                        elt  tree 
# 25 "Filter.frag.ml"
                          ) : 
# 25 "Filter.frag.ml"
                                                elt  tree  
# 25 "Filter.frag.ml"
                                   =
  match 
# 26 "Filter.frag.ml"
         
  (t)  
# 26 "Filter.frag.ml"
                with
  | 
# 27 "Filter.frag.ml"
     
  TLeaf  
# 27 "Filter.frag.ml"
         ->
      leaf
  | 
# 29 "Filter.frag.ml"
     
  TNode { l = l; v =  v; r =  r; _ } -> 
      
# 30 "Filter.frag.ml"
      (* Enforce left-to-right evaluation order. *)
      let l' = filter p l in
      let keep = 
# 32 "Filter.frag.ml"
                      ((p) ( v))  
# 32 "Filter.frag.ml"
                             in
      let r' = filter p r in
      if keep 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 : 
# 43 "Filter.frag.ml"
                                           elt  tree 
# 43 "Filter.frag.ml"
                             ) : 
# 43 "Filter.frag.ml"
                                                   elt  tree  
# 43 "Filter.frag.ml"
                                      * 
# 43 "Filter.frag.ml"
                                                          elt  tree  
# 43 "Filter.frag.ml"
                                             =
  match 
# 44 "Filter.frag.ml"
         
  (t)  
# 44 "Filter.frag.ml"
                with
  | 
# 45 "Filter.frag.ml"
     
  TLeaf  
# 45 "Filter.frag.ml"
         ->
      leaf, leaf
  | 
# 47 "Filter.frag.ml"
     
  TNode { l = l; v =  v; r =  r; _ } -> 
      
# 48 "Filter.frag.ml"
      (* Enforce left-to-right evaluation order. *)
      let lt, lf = partition p l in
      let keep = 
# 50 "Filter.frag.ml"
                      ((p) ( v))  
# 50 "Filter.frag.ml"
                             in
      let rt, rf = partition p r in
      if keep 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 "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 to_list (t : 
# 17 "Conversions.frag.ml"
                                       elt  tree 
# 17 "Conversions.frag.ml"
                         ) (k : 
# 17 "Conversions.frag.ml"
                                          elt  
# 17 "Conversions.frag.ml"
                                    list) : 
# 17 "Conversions.frag.ml"
                                                      elt  
# 17 "Conversions.frag.ml"
                                                list =
  match 
# 18 "Conversions.frag.ml"
         
  (t)  
# 18 "Conversions.frag.ml"
                with
  | 
# 19 "Conversions.frag.ml"
     
  TLeaf  
# 19 "Conversions.frag.ml"
         ->
      k
  | 
# 21 "Conversions.frag.ml"
     
  TNode { l = l; v =  v; r =  r; _ } -> 
      
# 22 "Conversions.frag.ml"
      to_list l (v :: to_list r k)

let[@inline] to_list (t : 
# 24 "Conversions.frag.ml"
                                            elt  tree 
# 24 "Conversions.frag.ml"
                              ) : 
# 24 "Conversions.frag.ml"
                                            elt  
# 24 "Conversions.frag.ml"
                                      list =
  to_list t []

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

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

let to_seq (t : 
# 32 "Conversions.frag.ml"
                                  elt  tree 
# 32 "Conversions.frag.ml"
                    ) : 
# 32 "Conversions.frag.ml"
                                  elt  
# 32 "Conversions.frag.ml"
                            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 : 
# 38 "Conversions.frag.ml"
                                                   elt  tree 
# 38 "Conversions.frag.ml"
                                     ) : 
# 38 "Conversions.frag.ml"
                                                   elt  
# 38 "Conversions.frag.ml"
                                             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 : 
# 44 "Conversions.frag.ml"
                                      elt  tree 
# 44 "Conversions.frag.ml"
                        ) : 
# 44 "Conversions.frag.ml"
                                      elt  
# 44 "Conversions.frag.ml"
                                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 : 
# 53 "Conversions.frag.ml"
                                              elt  tree 
# 53 "Conversions.frag.ml"
                                ) a i : int =
  assert (0 <= i && i + cardinal t <= Array.length a);
  match 
# 55 "Conversions.frag.ml"
         
  (t)  
# 55 "Conversions.frag.ml"
                with
  | 
# 56 "Conversions.frag.ml"
     
  TLeaf  
# 56 "Conversions.frag.ml"
         ->
      i
  | 
# 58 "Conversions.frag.ml"
     
  TNode { l = l; v =  v; r =  r; _ } -> 
      
# 59 "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 : 
# 68 "Conversions.frag.ml"
                                    elt  tree 
# 68 "Conversions.frag.ml"
                      ) : 
# 68 "Conversions.frag.ml"
                                    elt  
# 68 "Conversions.frag.ml"
                              array =
  match 
# 69 "Conversions.frag.ml"
         
  (t)  
# 69 "Conversions.frag.ml"
                with
  | 
# 70 "Conversions.frag.ml"
     
  TLeaf  
# 70 "Conversions.frag.ml"
         ->
      [||]
  | 
# 72 "Conversions.frag.ml"
     
  TNode { l = _; v =  dummy; r =  _; _ } -> 
      
# 73 "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] is available as part of the [BASE_SET]
   or [BASE_MAP] signature. *)

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

(* [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. *)

(* [override] is [union] with priority to the right-hand argument. So,
   in the map variant, if a key appears twice in the list, the rightmost
   binding takes over. *)

let of_array a =
  let yield accu i j = override accu (of_sorted_unique_array_slice a i j) in
  ArrayExtra.foreach_increasing_run compare_elts 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 =
  override t (of_seq xs)
# 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 : 
# 27 "RandomAccess.frag.ml"
                                   elt  tree 
# 27 "RandomAccess.frag.ml"
                     ) (i : int) : 
# 27 "RandomAccess.frag.ml"
                                             elt  
# 27 "RandomAccess.frag.ml"
                                       =
  assert (0 <= i && i < cardinal t);
  match 
# 29 "RandomAccess.frag.ml"
         
  (t)  
# 29 "RandomAccess.frag.ml"
                with
  | 
# 30 "RandomAccess.frag.ml"
     
  TLeaf  
# 30 "RandomAccess.frag.ml"
         ->
      assert false
  | 
# 32 "RandomAccess.frag.ml"
     
  TNode { l = l; v =  v; r =  r; _ } -> 
      
# 33 "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 : 
# 41 "RandomAccess.frag.ml"
                               elt  tree 
# 41 "RandomAccess.frag.ml"
                 ) (i : int) : 
# 41 "RandomAccess.frag.ml"
                                         elt  
# 41 "RandomAccess.frag.ml"
                                   =
  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 : 
# 66 "RandomAccess.frag.ml"
                                                         elt  tree 
# 66 "RandomAccess.frag.ml"
                                           ) : int =
  match 
# 67 "RandomAccess.frag.ml"
         
  (t)  
# 67 "RandomAccess.frag.ml"
                with
  | 
# 68 "RandomAccess.frag.ml"
     
  TLeaf  
# 68 "RandomAccess.frag.ml"
         ->
      raise Not_found
  | 
# 70 "RandomAccess.frag.ml"
     
  TNode { l = l; v =  v; r =  r; _ } -> 
      
# 71 "RandomAccess.frag.ml"
      let c = E.compare x (
# 71 "RandomAccess.frag.ml"
                              (v) 
# 71 "RandomAccess.frag.ml"
                                     ) 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 : 
# 94 "RandomAccess.frag.ml"
                                   elt  tree 
# 94 "RandomAccess.frag.ml"
                     ) (i : int) : 
# 94 "RandomAccess.frag.ml"
                                                     elt  tree  
# 94 "RandomAccess.frag.ml"
                                        * 
# 94 "RandomAccess.frag.ml"
                                                            elt  tree  
# 94 "RandomAccess.frag.ml"
                                               =
  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"
           
  (t)  
# 101 "RandomAccess.frag.ml"
                  with
    | 
# 102 "RandomAccess.frag.ml"
       
  TLeaf  
# 102 "RandomAccess.frag.ml"
           ->
        assert false
    | 
# 104 "RandomAccess.frag.ml"
       
  TNode { l = l; v =  v; r =  r; _ } -> 
        
# 105 "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 : 
# 115 "RandomAccess.frag.ml"
                               elt  tree 
# 115 "RandomAccess.frag.ml"
                 ) (i : int) : 
# 115 "RandomAccess.frag.ml"
                                                 elt  tree  
# 115 "RandomAccess.frag.ml"
                                    * 
# 115 "RandomAccess.frag.ml"
                                                        elt  tree  
# 115 "RandomAccess.frag.ml"
                                           =
  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 : 
# 130 "RandomAccess.frag.ml"
                                           elt  tree 
# 130 "RandomAccess.frag.ml"
                             ) (i : int) : 
# 130 "RandomAccess.frag.ml"
                                                             elt  tree  
# 130 "RandomAccess.frag.ml"
                                                * 
# 130 "RandomAccess.frag.ml"
                                                            elt  
# 130 "RandomAccess.frag.ml"
                                                      * 
# 130 "RandomAccess.frag.ml"
                                                                          elt  tree  
# 130 "RandomAccess.frag.ml"
                                                             =
  assert (0 <= i && i < cardinal t);
  match 
# 132 "RandomAccess.frag.ml"
         
  (t)  
# 132 "RandomAccess.frag.ml"
                with
  | 
# 133 "RandomAccess.frag.ml"
     
  TLeaf  
# 133 "RandomAccess.frag.ml"
         ->
      assert false
  | 
# 135 "RandomAccess.frag.ml"
     
  TNode { l = l; v =  v; r =  r; _ } -> 
      
# 136 "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 : 
# 146 "RandomAccess.frag.ml"
                                       elt  tree 
# 146 "RandomAccess.frag.ml"
                         ) (i : int) : 
# 146 "RandomAccess.frag.ml"
                                                         elt  tree  
# 146 "RandomAccess.frag.ml"
                                            * 
# 146 "RandomAccess.frag.ml"
                                                        elt  
# 146 "RandomAccess.frag.ml"
                                                  * 
# 146 "RandomAccess.frag.ml"
                                                                      elt  tree  
# 146 "RandomAccess.frag.ml"
                                                         =
  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 : 
# 13 "Iter.frag.ml"
                                      elt  tree 
# 13 "Iter.frag.ml"
                        ) =
  match 
# 14 "Iter.frag.ml"
         
  (t)  
# 14 "Iter.frag.ml"
                with
  | 
# 15 "Iter.frag.ml"
     
  TLeaf  
# 15 "Iter.frag.ml"
         ->
      ()
  | 
# 17 "Iter.frag.ml"
     
  TNode { l = l; v =  v; r =  r; _ } -> 
      
# 18 "Iter.frag.ml"
      iter f l; 
# 18 "Iter.frag.ml"
                     ((f) ( v)) 
# 18 "Iter.frag.ml"
                           ; iter f r

let rec fold f (t : 
# 20 "Iter.frag.ml"
                                      elt  tree 
# 20 "Iter.frag.ml"
                        ) accu =
  match 
# 21 "Iter.frag.ml"
         
  (t)  
# 21 "Iter.frag.ml"
                with
  | 
# 22 "Iter.frag.ml"
     
  TLeaf  
# 22 "Iter.frag.ml"
         ->
      accu
  | 
# 24 "Iter.frag.ml"
     
  TNode { l = l; v =  v; r =  r; _ } -> 
      
# 25 "Iter.frag.ml"
      fold f r (
# 25 "Iter.frag.ml"
                 ((f) ( v) ( fold f l accu)) 
# 25 "Iter.frag.ml"
                                           )

let rec for_all p (t : 
# 27 "Iter.frag.ml"
                                         elt  tree 
# 27 "Iter.frag.ml"
                           ) =
  match 
# 28 "Iter.frag.ml"
         
  (t)  
# 28 "Iter.frag.ml"
                with
  | 
# 29 "Iter.frag.ml"
     
  TLeaf  
# 29 "Iter.frag.ml"
         ->
      true
  | 
# 31 "Iter.frag.ml"
     
  TNode { l = l; v =  v; r =  r; _ } -> 
      
# 32 "Iter.frag.ml"
           ((p) ( v))  
# 32 "Iter.frag.ml"
                  && for_all p l && for_all p r

let rec exists p (t : 
# 34 "Iter.frag.ml"
                                        elt  tree 
# 34 "Iter.frag.ml"
                          ) =
  match 
# 35 "Iter.frag.ml"
         
  (t)  
# 35 "Iter.frag.ml"
                with
  | 
# 36 "Iter.frag.ml"
     
  TLeaf  
# 36 "Iter.frag.ml"
         ->
      false
  | 
# 38 "Iter.frag.ml"
     
  TNode { l = l; v =  v; r =  r; _ } -> 
      
# 39 "Iter.frag.ml"
           ((p) ( v))  
# 39 "Iter.frag.ml"
                  || exists p l || exists p r


# 137 "UpperLayer.frag.ml"
(* In the set API, [to_list] is published under the name [elements]. *)

let elements = to_list


# 155 "UpperLayer.frag.ml"
(* -------------------------------------------------------------------------- *)

  
# 25 "W.cppo.ml"
  end
end




# 1 "ConcreteView.macros"
(* In the concrete view, to deconstruct a tree [t], one matches the tree [t]
   directly against the patterns [TLeaf] and [TNode _]. This requires the
   concrete definition of the type [tree] to be visible. *)

(* In the map variant, a pair must be constructed. This is rather painful,
   as it cannot be done in a pattern, on the left-hand side of the arrow;
   it must be done in an expression, on the right-hand side of the arrow.
   This forces the macro [NODE] to include the arrow itself. *)







# 1 "Derived.macros"
(******************************************************************************)
(*                                                                            *)
(*                                    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 "Derived.macros"
(* [BOTH_EMPTY(l,r)] determines whether the trees [l] and [r] are both empty. *)


# 35 "W.cppo.ml"
module Map = struct
  module type OrderedType = OrderedType
  module type S = MAP
  module[@inline] Make (E : OrderedType) = struct
    include WeightMap
# 1 "UpperLayer.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. *)

(* A key is a value of the ordered type [E.t]. *)

(* In the set variant, a set element and a key are the same thing.

   In the map variant, a map element is a binding, that is, a key-data pair.
   Therefore, a key is just the first component of a map element. *)

(* The following types exist in both variants:

   + [key] is the type of a key;
   + [DATA] is the type of a datum;
   + [ELT] is the type of an element;
   + [TREE] is the type of a tree.

   [DATA], [ELT], and [TREE] may contain a wildcard, so they can be used only
   in type annotations (as opposed to type definitions, signatures, etc.).

   The following macros exist in both variants:

   + [EXTRA(x)] expands to nothing in the set variant
                and to [x] in the map variant;
   + [GET_KEY(v)] extracts the key component of the element [v];
   + [GET_DATA(v)] extracts the data component of the element [v];
 *)

type key = E.t


# 60 "UpperLayer.frag.ml"
type 'a binding = key * 'a
type 'a map = 'a binding tree
type 'a t = 'a map




# 74 "UpperLayer.frag.ml"
(* The total order on elements. *)

let[@inline] compare_elts (x : 
# 76 "UpperLayer.frag.ml"
                                         (key *          _ ) 
# 76 "UpperLayer.frag.ml"
                                  ) (y : 
# 76 "UpperLayer.frag.ml"
                                                   (key *          _ ) 
# 76 "UpperLayer.frag.ml"
                                            ) : int =
  E.compare (
# 77 "UpperLayer.frag.ml"
                (let (_k, _) = x in _k) 
# 77 "UpperLayer.frag.ml"
                       ) (
# 77 "UpperLayer.frag.ml"
                             (let (_k, _) = y in _k) 
# 77 "UpperLayer.frag.ml"
                                    )

(* The following macro is used by [union] and [inter] on maps.
   We could also make it a function and mark it [@inline]. *)


# 85 "UpperLayer.frag.ml"
(* The following macros abstract away the distinction between
   [if] on a Boolean value and [match] on an option. *)


# 96 "UpperLayer.frag.ml"
(* The following macro applies the function [f] directly to [v] in the set
   variant and separately to the two components of the pair [v] in the map
   variant. *)


# 108 "UpperLayer.frag.ml"
(* -------------------------------------------------------------------------- *)

(* 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 : 
# 13 "Empty.frag.ml"
                              (key *          _ )  tree  
# 13 "Empty.frag.ml"
                 =
  leaf

let is_empty (t : 
# 16 "Empty.frag.ml"
                                    (key *          _ )  tree 
# 16 "Empty.frag.ml"
                      ) : bool =
  match 
# 17 "Empty.frag.ml"
         
  (t)  
# 17 "Empty.frag.ml"
                with
  | 
# 18 "Empty.frag.ml"
     
  TLeaf  
# 18 "Empty.frag.ml"
         ->
      true
  | 
# 20 "Empty.frag.ml"
     
  TNode { l = _; k = _k; d = _d; r =  _; _ } -> 
    let  _ = (_k, _d) in 
      
# 21 "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 : 
# 13 "MinMax.frag.ml"
                                       (key *          _ ) 
# 13 "MinMax.frag.ml"
                                ) (t : 
# 13 "MinMax.frag.ml"
                                                         (key *          _ )  tree 
# 13 "MinMax.frag.ml"
                                           ) : 
# 13 "MinMax.frag.ml"
                                                         (key *          _ )  
# 13 "MinMax.frag.ml"
                                                   =
  match 
# 14 "MinMax.frag.ml"
         
  (t)  
# 14 "MinMax.frag.ml"
                with
  | 
# 15 "MinMax.frag.ml"
     
  TLeaf  
# 15 "MinMax.frag.ml"
         ->
      default
  | 
# 17 "MinMax.frag.ml"
     
  TNode { l = l; k = _k; d = _d; r =  _; _ } -> 
    let  v = (_k, _d) in 
      
# 18 "MinMax.frag.ml"
      min_elt_1 v l

let min_elt (t : 
# 20 "MinMax.frag.ml"
                                   (key *          _ )  tree 
# 20 "MinMax.frag.ml"
                     ) : 
# 20 "MinMax.frag.ml"
                                   (key *          _ )  
# 20 "MinMax.frag.ml"
                             =
  match 
# 21 "MinMax.frag.ml"
         
  (t)  
# 21 "MinMax.frag.ml"
                with
  | 
# 22 "MinMax.frag.ml"
     
  TLeaf  
# 22 "MinMax.frag.ml"
         ->
      raise Not_found
  | 
# 24 "MinMax.frag.ml"
     
  TNode { l = l; k = _k; d = _d; r =  _; _ } -> 
    let  v = (_k, _d) in 
      
# 25 "MinMax.frag.ml"
      min_elt_1 v l

let rec min_elt_opt_1 (default : 
# 27 "MinMax.frag.ml"
                                           (key *          _ ) 
# 27 "MinMax.frag.ml"
                                    ) (t : 
# 27 "MinMax.frag.ml"
                                                             (key *          _ )  tree 
# 27 "MinMax.frag.ml"
                                               ) : 
# 27 "MinMax.frag.ml"
                                                             (key *          _ )  
# 27 "MinMax.frag.ml"
                                                       option =
  match 
# 28 "MinMax.frag.ml"
         
  (t)  
# 28 "MinMax.frag.ml"
                with
  | 
# 29 "MinMax.frag.ml"
     
  TLeaf  
# 29 "MinMax.frag.ml"
         ->
      Some default
  | 
# 31 "MinMax.frag.ml"
     
  TNode { l = l; k = _k; d = _d; r =  _; _ } -> 
    let  v = (_k, _d) in 
      
# 32 "MinMax.frag.ml"
      min_elt_opt_1 v l

let min_elt_opt (t : 
# 34 "MinMax.frag.ml"
                                       (key *          _ )  tree 
# 34 "MinMax.frag.ml"
                         ) : 
# 34 "MinMax.frag.ml"
                                       (key *          _ )  
# 34 "MinMax.frag.ml"
                                 option =
  match 
# 35 "MinMax.frag.ml"
         
  (t)  
# 35 "MinMax.frag.ml"
                with
  | 
# 36 "MinMax.frag.ml"
     
  TLeaf  
# 36 "MinMax.frag.ml"
         ->
      None
  | 
# 38 "MinMax.frag.ml"
     
  TNode { l = l; k = _k; d = _d; r =  _; _ } -> 
    let  v = (_k, _d) in 
      
# 39 "MinMax.frag.ml"
      min_elt_opt_1 v l

let rec max_elt_1 (default : 
# 41 "MinMax.frag.ml"
                                       (key *          _ ) 
# 41 "MinMax.frag.ml"
                                ) (t : 
# 41 "MinMax.frag.ml"
                                                         (key *          _ )  tree 
# 41 "MinMax.frag.ml"
                                           ) : 
# 41 "MinMax.frag.ml"
                                                         (key *          _ )  
# 41 "MinMax.frag.ml"
                                                   =
  match 
# 42 "MinMax.frag.ml"
         
  (t)  
# 42 "MinMax.frag.ml"
                with
  | 
# 43 "MinMax.frag.ml"
     
  TLeaf  
# 43 "MinMax.frag.ml"
         ->
      default
  | 
# 45 "MinMax.frag.ml"
     
  TNode { l = _; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
      
# 46 "MinMax.frag.ml"
      max_elt_1 v r

let max_elt (t : 
# 48 "MinMax.frag.ml"
                                   (key *          _ )  tree 
# 48 "MinMax.frag.ml"
                     ) : 
# 48 "MinMax.frag.ml"
                                   (key *          _ )  
# 48 "MinMax.frag.ml"
                             =
  match 
# 49 "MinMax.frag.ml"
         
  (t)  
# 49 "MinMax.frag.ml"
                with
  | 
# 50 "MinMax.frag.ml"
     
  TLeaf  
# 50 "MinMax.frag.ml"
         ->
      raise Not_found
  | 
# 52 "MinMax.frag.ml"
     
  TNode { l = _; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
      
# 53 "MinMax.frag.ml"
      max_elt_1 v r

let rec max_elt_opt_1 (default : 
# 55 "MinMax.frag.ml"
                                           (key *          _ ) 
# 55 "MinMax.frag.ml"
                                    ) (t : 
# 55 "MinMax.frag.ml"
                                                             (key *          _ )  tree 
# 55 "MinMax.frag.ml"
                                               ) : 
# 55 "MinMax.frag.ml"
                                                             (key *          _ )  
# 55 "MinMax.frag.ml"
                                                       option =
  match 
# 56 "MinMax.frag.ml"
         
  (t)  
# 56 "MinMax.frag.ml"
                with
  | 
# 57 "MinMax.frag.ml"
     
  TLeaf  
# 57 "MinMax.frag.ml"
         ->
      Some default
  | 
# 59 "MinMax.frag.ml"
     
  TNode { l = _; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
      
# 60 "MinMax.frag.ml"
      max_elt_opt_1 v r

let max_elt_opt (t : 
# 62 "MinMax.frag.ml"
                                       (key *          _ )  tree 
# 62 "MinMax.frag.ml"
                         ) : 
# 62 "MinMax.frag.ml"
                                       (key *          _ )  
# 62 "MinMax.frag.ml"
                                 option =
  match 
# 63 "MinMax.frag.ml"
         
  (t)  
# 63 "MinMax.frag.ml"
                with
  | 
# 64 "MinMax.frag.ml"
     
  TLeaf  
# 64 "MinMax.frag.ml"
         ->
      None
  | 
# 66 "MinMax.frag.ml"
     
  TNode { l = _; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
      
# 67 "MinMax.frag.ml"
      max_elt_opt_1 v r

(* In the map variant, the above operations have different names. *)

# 72 "MinMax.frag.ml"
let min_binding = min_elt
let min_binding_opt = min_elt_opt
let max_binding = max_elt
let max_binding_opt = max_elt_opt

# 78 "MinMax.frag.ml"
(* 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.        *)
(*                                                                            *)
(******************************************************************************)

(* The value [v] that is extracted out of the tree has type [ELT]. In the set
   variant, it is an element of the set. In the map variant, it is a pair of
   a key and a value. In either case, [GET_KEY(v)] is a key. *)

let rec mem (x : key) (t : 
# 17 "Mem.frag.ml"
                                             (key *          _ )  tree 
# 17 "Mem.frag.ml"
                               ) : bool =
  match 
# 18 "Mem.frag.ml"
         
  (t)  
# 18 "Mem.frag.ml"
                with
  | 
# 19 "Mem.frag.ml"
     
  TLeaf  
# 19 "Mem.frag.ml"
         ->
      false
  | 
# 21 "Mem.frag.ml"
     
  TNode { l = l; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
      
# 22 "Mem.frag.ml"
      let c = E.compare x (
# 22 "Mem.frag.ml"
                              (let (_k, _) = v in _k) 
# 22 "Mem.frag.ml"
                                     ) 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 : 
# 13 "Find.frag.ml"
                                              (key *          _ )  tree 
# 13 "Find.frag.ml"
                                ) : 
# 13 "Find.frag.ml"
                                             _  
# 13 "Find.frag.ml"
                                         =
  match 
# 14 "Find.frag.ml"
         
  (t)  
# 14 "Find.frag.ml"
                with
  | 
# 15 "Find.frag.ml"
     
  TLeaf  
# 15 "Find.frag.ml"
         ->
      raise Not_found
  | 
# 17 "Find.frag.ml"
     
  TNode { l = l; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
      
# 18 "Find.frag.ml"
      let c = E.compare x (
# 18 "Find.frag.ml"
                              (let (_k, _) = v in _k) 
# 18 "Find.frag.ml"
                                     ) in
      if c = 0 then
        
# 20 "Find.frag.ml"
          (let (_, _d) = v in _d) 
      
# 21 "Find.frag.ml"
      else if c < 0 then
        find x l
      else
        find x r

let rec find_opt (x : key) (t : 
# 26 "Find.frag.ml"
                                                  (key *          _ )  tree 
# 26 "Find.frag.ml"
                                    ) : 
# 26 "Find.frag.ml"
                                                 _  
# 26 "Find.frag.ml"
                                             option =
  match 
# 27 "Find.frag.ml"
         
  (t)  
# 27 "Find.frag.ml"
                with
  | 
# 28 "Find.frag.ml"
     
  TLeaf  
# 28 "Find.frag.ml"
         ->
      None
  | 
# 30 "Find.frag.ml"
     
  TNode { l = l; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
      
# 31 "Find.frag.ml"
      let c = E.compare x (
# 31 "Find.frag.ml"
                              (let (_k, _) = v in _k) 
# 31 "Find.frag.ml"
                                     ) in
      if c = 0 then
        Some (
# 33 "Find.frag.ml"
                (let (_, _d) = v in _d) 
# 33 "Find.frag.ml"
                         )
      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 : 
# 52 "Find.frag.ml"
                                       (key *          _ ) 
# 52 "Find.frag.ml"
                                ) (f : key -> bool) (t : 
# 52 "Find.frag.ml"
                                                                           (key *          _ )  tree 
# 52 "Find.frag.ml"
                                                             ) : 
# 52 "Find.frag.ml"
                                                                           (key *          _ )  
# 52 "Find.frag.ml"
                                                                     =
  match 
# 53 "Find.frag.ml"
         
  (t)  
# 53 "Find.frag.ml"
                with
  | 
# 54 "Find.frag.ml"
     
  TLeaf  
# 54 "Find.frag.ml"
         ->
      v0
  | 
# 56 "Find.frag.ml"
     
  TNode { l = l; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
      
# 57 "Find.frag.ml"
      if f (
# 57 "Find.frag.ml"
               (let (_k, _) = v in _k) 
# 57 "Find.frag.ml"
                      ) then
        find_first_aux v f l
      else
        find_first_aux v0 f r

let rec find_first (f : key -> bool) (t : 
# 62 "Find.frag.ml"
                                                            (key *          _ )  tree 
# 62 "Find.frag.ml"
                                              ) : 
# 62 "Find.frag.ml"
                                                            (key *          _ )  
# 62 "Find.frag.ml"
                                                      =
  match 
# 63 "Find.frag.ml"
         
  (t)  
# 63 "Find.frag.ml"
                with
  | 
# 64 "Find.frag.ml"
     
  TLeaf  
# 64 "Find.frag.ml"
         ->
      raise Not_found
  | 
# 66 "Find.frag.ml"
     
  TNode { l = l; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
      
# 67 "Find.frag.ml"
      if f (
# 67 "Find.frag.ml"
               (let (_k, _) = v in _k) 
# 67 "Find.frag.ml"
                      ) then
        find_first_aux v f l
      else
        find_first f r

let rec find_first_opt_aux (v0 : 
# 72 "Find.frag.ml"
                                           (key *          _ ) 
# 72 "Find.frag.ml"
                                    ) (f : key -> bool) (t : 
# 72 "Find.frag.ml"
                                                                               (key *          _ )  tree 
# 72 "Find.frag.ml"
                                                                 ) : 
# 72 "Find.frag.ml"
                                                                               (key *          _ )  
# 72 "Find.frag.ml"
                                                                         option =
  match 
# 73 "Find.frag.ml"
         
  (t)  
# 73 "Find.frag.ml"
                with
  | 
# 74 "Find.frag.ml"
     
  TLeaf  
# 74 "Find.frag.ml"
         ->
      Some v0
  | 
# 76 "Find.frag.ml"
     
  TNode { l = l; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
      
# 77 "Find.frag.ml"
      if f (
# 77 "Find.frag.ml"
               (let (_k, _) = v in _k) 
# 77 "Find.frag.ml"
                      ) then
        find_first_opt_aux v f l
      else
        find_first_opt_aux v0 f r

let rec find_first_opt (f : key -> bool) (t : 
# 82 "Find.frag.ml"
                                                                (key *          _ )  tree 
# 82 "Find.frag.ml"
                                                  ) : 
# 82 "Find.frag.ml"
                                                                (key *          _ )  
# 82 "Find.frag.ml"
                                                          option =
  match 
# 83 "Find.frag.ml"
         
  (t)  
# 83 "Find.frag.ml"
                with
  | 
# 84 "Find.frag.ml"
     
  TLeaf  
# 84 "Find.frag.ml"
         ->
      None
  | 
# 86 "Find.frag.ml"
     
  TNode { l = l; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
      
# 87 "Find.frag.ml"
      if f (
# 87 "Find.frag.ml"
               (let (_k, _) = v in _k) 
# 87 "Find.frag.ml"
                      ) then
        find_first_opt_aux v f l
      else
        find_first_opt f r

let rec find_last_aux (v0 : 
# 92 "Find.frag.ml"
                                      (key *          _ ) 
# 92 "Find.frag.ml"
                               ) (f : key -> bool) (t : 
# 92 "Find.frag.ml"
                                                                          (key *          _ )  tree 
# 92 "Find.frag.ml"
                                                            ) : 
# 92 "Find.frag.ml"
                                                                          (key *          _ )  
# 92 "Find.frag.ml"
                                                                    =
  match 
# 93 "Find.frag.ml"
         
  (t)  
# 93 "Find.frag.ml"
                with
  | 
# 94 "Find.frag.ml"
     
  TLeaf  
# 94 "Find.frag.ml"
         ->
      v0
  | 
# 96 "Find.frag.ml"
     
  TNode { l = l; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
      
# 97 "Find.frag.ml"
      if f (
# 97 "Find.frag.ml"
               (let (_k, _) = v in _k) 
# 97 "Find.frag.ml"
                      ) then
        find_last_aux v f r
      else
        find_last_aux v0 f l

let rec find_last (f : key -> bool) (t : 
# 102 "Find.frag.ml"
                                                           (key *          _ )  tree 
# 102 "Find.frag.ml"
                                             ) : 
# 102 "Find.frag.ml"
                                                           (key *          _ )  
# 102 "Find.frag.ml"
                                                     =
  match 
# 103 "Find.frag.ml"
         
  (t)  
# 103 "Find.frag.ml"
                with
  | 
# 104 "Find.frag.ml"
     
  TLeaf  
# 104 "Find.frag.ml"
         ->
      raise Not_found
  | 
# 106 "Find.frag.ml"
     
  TNode { l = l; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
      
# 107 "Find.frag.ml"
      if f (
# 107 "Find.frag.ml"
               (let (_k, _) = v in _k) 
# 107 "Find.frag.ml"
                      ) then
        find_last_aux v f r
      else
        find_last f l

let rec find_last_opt_aux (v0 : 
# 112 "Find.frag.ml"
                                          (key *          _ ) 
# 112 "Find.frag.ml"
                                   ) (f : key -> bool) (t : 
# 112 "Find.frag.ml"
                                                                              (key *          _ )  tree 
# 112 "Find.frag.ml"
                                                                ) : 
# 112 "Find.frag.ml"
                                                                              (key *          _ )  
# 112 "Find.frag.ml"
                                                                        option =
  match 
# 113 "Find.frag.ml"
         
  (t)  
# 113 "Find.frag.ml"
                with
  | 
# 114 "Find.frag.ml"
     
  TLeaf  
# 114 "Find.frag.ml"
         ->
      Some v0
  | 
# 116 "Find.frag.ml"
     
  TNode { l = l; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
      
# 117 "Find.frag.ml"
      if f (
# 117 "Find.frag.ml"
               (let (_k, _) = v in _k) 
# 117 "Find.frag.ml"
                      ) then
        find_last_opt_aux v f r
      else
        find_last_opt_aux v0 f l

let rec find_last_opt (f : key -> bool) (t : 
# 122 "Find.frag.ml"
                                                               (key *          _ )  tree 
# 122 "Find.frag.ml"
                                                 ) : 
# 122 "Find.frag.ml"
                                                               (key *          _ )  
# 122 "Find.frag.ml"
                                                         option =
  match 
# 123 "Find.frag.ml"
         
  (t)  
# 123 "Find.frag.ml"
                with
  | 
# 124 "Find.frag.ml"
     
  TLeaf  
# 124 "Find.frag.ml"
         ->
      None
  | 
# 126 "Find.frag.ml"
     
  TNode { l = l; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
      
# 127 "Find.frag.ml"
      if f (
# 127 "Find.frag.ml"
               (let (_k, _) = v in _k) 
# 127 "Find.frag.ml"
                      ) 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.) (Set variant only.)

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

 *)


# 55 "Add.frag.ml"
(* If a binding for this key is already present in the map, then this
   existing binding is replaced with a new binding. *)

(* This implementation is adapted from OCaml's Map library. *)

let rec replace (x : key) (d : 
# 60 "Add.frag.ml"
                                        _ 
# 60 "Add.frag.ml"
                                   ) (t : 
# 60 "Add.frag.ml"
                                                            (key *          _ )  tree 
# 60 "Add.frag.ml"
                                              ) : 
# 60 "Add.frag.ml"
                                                                    (key *          _ )  tree  
# 60 "Add.frag.ml"
                                                       =
  match 
# 61 "Add.frag.ml"
         
  (t)  
# 61 "Add.frag.ml"
                with
  | 
# 62 "Add.frag.ml"
     
  TLeaf  
# 62 "Add.frag.ml"
         ->
      let v = (x, d) in
      singleton v
  | 
# 65 "Add.frag.ml"
     
  TNode { l = l; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
      
# 66 "Add.frag.ml"
      let c = E.compare x (
# 66 "Add.frag.ml"
                              (let (_k, _) = v in _k) 
# 66 "Add.frag.ml"
                                     ) in
      if c = 0 then
        (* Overwrite the existing element: *)
        if 
# 69 "Add.frag.ml"
             (let (_, _d) = v in _d)  
# 69 "Add.frag.ml"
                       == d then t else
        let v = (x, d) in
        join_siblings l v r
      else if c < 0 then
        let l' = replace x d l in
        if l == l' then t else join_quasi_siblings l' v r
      else
        let r' = replace x d r in
        if r == r' then t else join_quasi_siblings l v r'

(* [replace] is published under the name [add], but one should be
   aware that [add] and [replace] are really two distinct functions,
   as they differ in the way they choose between the existing element
   and the new element. *)

let add = replace

(* See also [update] and [union1]. *)

(* [add_absent] is currently used by [xor]. It takes a key-data pair. *)

let add_absent (x, d) t =
  add x d t

# 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 : 
# 16 "Remove.frag.ml"
                                                (key *          _ )  tree 
# 16 "Remove.frag.ml"
                                  ) (v : 
# 16 "Remove.frag.ml"
                                                   (key *          _ ) 
# 16 "Remove.frag.ml"
                                            ) (r : 
# 16 "Remove.frag.ml"
                                                                     (key *          _ )  tree 
# 16 "Remove.frag.ml"
                                                       ) : 
# 16 "Remove.frag.ml"
                                                                             (key *          _ )  tree  
# 16 "Remove.frag.ml"
                                                                =
  match 
# 17 "Remove.frag.ml"
         
  (l)  
# 17 "Remove.frag.ml"
                with
  | 
# 18 "Remove.frag.ml"
     
  TLeaf  
# 18 "Remove.frag.ml"
         ->
      r
  | 
# 20 "Remove.frag.ml"
     
  TNode { l = ll; k = _k; d = _d; r =  lr; _ } -> 
    let  lv = (_k, _d) in 
      
# 21 "Remove.frag.ml"
      let l = remove_min_elt_1 ll lv lr in
      join_quasi_siblings l v r

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

let remove_min_elt (t : 
# 26 "Remove.frag.ml"
                                          (key *          _ )  tree 
# 26 "Remove.frag.ml"
                            ) : 
# 26 "Remove.frag.ml"
                                                  (key *          _ )  tree  
# 26 "Remove.frag.ml"
                                     =
  match 
# 27 "Remove.frag.ml"
         
  (t)  
# 27 "Remove.frag.ml"
                with
  | 
# 28 "Remove.frag.ml"
     
  TLeaf  
# 28 "Remove.frag.ml"
         ->
      raise Not_found
  | 
# 30 "Remove.frag.ml"
     
  TNode { l = l; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
      
# 31 "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 : 
# 36 "Remove.frag.ml"
                                                (key *          _ )  tree 
# 36 "Remove.frag.ml"
                                  ) (v : 
# 36 "Remove.frag.ml"
                                                   (key *          _ ) 
# 36 "Remove.frag.ml"
                                            ) (r : 
# 36 "Remove.frag.ml"
                                                                     (key *          _ )  tree 
# 36 "Remove.frag.ml"
                                                       ) : 
# 36 "Remove.frag.ml"
                                                                             (key *          _ )  tree  
# 36 "Remove.frag.ml"
                                                                =
  match 
# 37 "Remove.frag.ml"
         
  (r)  
# 37 "Remove.frag.ml"
                with
  | 
# 38 "Remove.frag.ml"
     
  TLeaf  
# 38 "Remove.frag.ml"
         ->
      l
  | 
# 40 "Remove.frag.ml"
     
  TNode { l = rl; k = _k; d = _d; r =  rr; _ } -> 
    let  rv = (_k, _d) in 
      
# 41 "Remove.frag.ml"
      let r = remove_max_elt_1 rl rv rr in
      join_quasi_siblings l v r

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

let remove_max_elt (t : 
# 46 "Remove.frag.ml"
                                          (key *          _ )  tree 
# 46 "Remove.frag.ml"
                            ) : 
# 46 "Remove.frag.ml"
                                                  (key *          _ )  tree  
# 46 "Remove.frag.ml"
                                     =
  match 
# 47 "Remove.frag.ml"
         
  (t)  
# 47 "Remove.frag.ml"
                with
  | 
# 48 "Remove.frag.ml"
     
  TLeaf  
# 48 "Remove.frag.ml"
         ->
      raise Not_found
  | 
# 50 "Remove.frag.ml"
     
  TNode { l = l; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
      
# 51 "Remove.frag.ml"
      remove_max_elt_1 l v r

(* In the map variant, the above operations have different names. *)

# 56 "Remove.frag.ml"
let remove_min_binding = remove_min_elt
let remove_max_binding = remove_max_elt

# 60 "Remove.frag.ml"
(* [join2_siblings l r] is analogous to [join2 l r], but requires the
   subtrees [l] and [r] to be siblings. *)

(* [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 : 
# 72 "Remove.frag.ml"
                                          (key *          _ )  tree 
# 72 "Remove.frag.ml"
                            ) (r : 
# 72 "Remove.frag.ml"
                                                     (key *          _ )  tree 
# 72 "Remove.frag.ml"
                                       ) : 
# 72 "Remove.frag.ml"
                                                             (key *          _ )  tree  
# 72 "Remove.frag.ml"
                                                =
  assert (siblings l r);
  match 
# 74 "Remove.frag.ml"
         
  (l) 
# 74 "Remove.frag.ml"
               , 
# 74 "Remove.frag.ml"
                  
  (r)  
# 74 "Remove.frag.ml"
                         with
  | _, 
# 75 "Remove.frag.ml"
        
  TLeaf  
# 75 "Remove.frag.ml"
            ->
      l
  | 
# 77 "Remove.frag.ml"
     
  TLeaf 
# 77 "Remove.frag.ml"
        , _ ->
      r
  | _, 
# 79 "Remove.frag.ml"
        
  TNode { l = rl; k = _k; d = _d; r =  rr; _ } -> 
    let  rv = (_k, _d) in 
      
# 80 "Remove.frag.ml"
      join_quasi_siblings
        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.) (Set variant only.)

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 : 
# 99 "Remove.frag.ml"
                                                (key *          _ )  tree 
# 99 "Remove.frag.ml"
                                  ) : 
# 99 "Remove.frag.ml"
                                                        (key *          _ )  tree  
# 99 "Remove.frag.ml"
                                           =
  match 
# 100 "Remove.frag.ml"
         
  (t)  
# 100 "Remove.frag.ml"
                with
  | 
# 101 "Remove.frag.ml"
     
  TLeaf  
# 101 "Remove.frag.ml"
         ->
      empty
  | 
# 103 "Remove.frag.ml"
     
  TNode { l = l; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
      
# 104 "Remove.frag.ml"
      let c = E.compare x (
# 104 "Remove.frag.ml"
                              (let (_k, _) = v in _k) 
# 104 "Remove.frag.ml"
                                     ) 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_quasi_siblings l' v r
      else
        let r' = remove x r in
        if r == r' then t else join_quasi_siblings l v r'


# 116 "Remove.frag.ml"
(* [update] generalizes [add], [replace], and [remove] by letting the user
   choose how to transform the information associated with a specific key. *)

(* This code is essentially the same as in OCaml's Map library. *)

let rec update
  (x : key) (f : 'a option -> 'a option)
  (t : 'a binding tree) : 'a binding tree =
  match 
# 124 "Remove.frag.ml"
         
  (t)  
# 124 "Remove.frag.ml"
                with
  | 
# 125 "Remove.frag.ml"
     
  TLeaf  
# 125 "Remove.frag.ml"
         ->
      begin match f None with
      | None ->
          t
      | Some d ->
          let v = (x, d) in
          singleton v
      end
  | 
# 133 "Remove.frag.ml"
     
  TNode { l = l; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
      
# 134 "Remove.frag.ml"
      let (k, d) = v in
      let c = E.compare x k in
      if c = 0 then begin
        match f (Some d) with
        | None ->
            join2_siblings l r
        | Some d' ->
            if d == d' then t else
            let v = (k, d') in
            join_siblings l v r
      end
      else if c < 0 then
        let l' = update x f l in
        if l == l' then t else join_quasi_siblings l' v r
      else
        let r' = update x f r in
        if r == r' then t else join_quasi_siblings l v r'

(* [add_to_list] is taken from OCaml's Map library (and reformulated). *)

let[@inline] flatten (ods : 'a list option) : 'a list =
  match ods with None -> [] | Some ds -> ds

let add_to_list x d m =
  let add ods = Some (d :: flatten ods) in
  update x add m

# 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. *)

(* In the set variant, the second component of the result has type [bool].
   In the map variant, it has type [DATA option]. *)




# 33 "Split.frag.ml"
let rec split (k : key) (t : 
# 33 "Split.frag.ml"
                                               (key *          _ )  tree 
# 33 "Split.frag.ml"
                                 ) : 
# 33 "Split.frag.ml"
                                                       (key *          _ )  tree  
# 33 "Split.frag.ml"
                                          * 
# 33 "Split.frag.ml"
                                                          _  option  
# 33 "Split.frag.ml"
                                                   * 
# 33 "Split.frag.ml"
                                                                       (key *          _ )  tree  
# 33 "Split.frag.ml"
                                                          =
  match 
# 34 "Split.frag.ml"
         
  (t)  
# 34 "Split.frag.ml"
                with
  | 
# 35 "Split.frag.ml"
     
  TLeaf  
# 35 "Split.frag.ml"
         ->
      leaf, 
# 36 "Split.frag.ml"
                 None 
# 36 "Split.frag.ml"
                  , leaf
  | 
# 37 "Split.frag.ml"
     
  TNode { l = l; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
      
# 38 "Split.frag.ml"
      let c = E.compare k (
# 38 "Split.frag.ml"
                              (let (_k, _) = v in _k) 
# 38 "Split.frag.ml"
                                     ) in
      if c = 0 then
        l, 
# 40 "Split.frag.ml"
               Some (  (let (_, _d) = v in _d) ) 
# 40 "Split.frag.ml"
                  , r
      else if c < 0 then
        let ll, b, lr = split k l in
        ll, b, (if lr == l then t else join lr v r)
      else
        let rl, b, rr = split k r in
        (if rl == r then t else join l v rl), b, rr


# 1 "Join.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.        *)
(*                                                                            *)
(******************************************************************************)

(* [join2 l r] requires [l < r]. It joins the trees [l] and [r]
   into a single tree. *)

(* [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].
   (Set variant only.)

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 : 
# 48 "Join.frag.ml"
                                 (key *          _ )  tree 
# 48 "Join.frag.ml"
                   ) (r : 
# 48 "Join.frag.ml"
                                            (key *          _ )  tree 
# 48 "Join.frag.ml"
                              ) : 
# 48 "Join.frag.ml"
                                                    (key *          _ )  tree  
# 48 "Join.frag.ml"
                                       =
  match 
# 49 "Join.frag.ml"
         
  (l) 
# 49 "Join.frag.ml"
               , 
# 49 "Join.frag.ml"
                  
  (r)  
# 49 "Join.frag.ml"
                         with
  | 
# 50 "Join.frag.ml"
     
  TLeaf 
# 50 "Join.frag.ml"
        , _ ->
      r
  | _, 
# 52 "Join.frag.ml"
        
  TLeaf  
# 52 "Join.frag.ml"
            ->
      l
  | _, 
# 54 "Join.frag.ml"
        
  TNode { l = rl; k = _k; d = _d; r =  rr; _ } -> 
    let  rv = (_k, _d) in 
      
# 55 "Join.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] *)

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


# 64 "Join.frag.ml"
(* [ojoin] is known as [concat_or_join] in OCaml's Map library. *)

(* [ojoin] is defined only in the map variant. *)

let ojoin t1 k od t2 =
  match od with
  | None ->
      join2 t1 t2
  | Some d ->
      join t1 (k, d) t2

# 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

  (* An enumeration can be viewed as a list of pairs of an element and
     a (sub)tree. It is sorted in increasing order of keys. *)

  (* There is no structural difference between the set variant and the
     map variant. In the map variant, we do not flatten the key-data
     pair into the constructor [More], as this seems unlikely to lead
     to a gain in performance. *)

  (* In both variants, the type [ienum] is parameterized with ['v].
     This type is internal (not public). *)

  type 'v ienum =
    | End
    | More of 'v * 'v tree * 'v ienum

  (* The public type [enum] is unparameterized in the set variant and
     parameterized with ['a] in the map variant. *)

  
# 39 "Enum.frag.ml"
  type 'a enum = 'a binding ienum
  type 'a t = 'a enum

  
# 43 "Enum.frag.ml"
  let empty : 'v ienum =
    End

  let[@inline] is_empty (e : 'v ienum) : 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 : 'v tree) (e : 'v ienum) : 'v ienum =
    match 
# 57 "Enum.frag.ml"
           
  (t)  
# 57 "Enum.frag.ml"
                  with
    | 
# 58 "Enum.frag.ml"
       
  TLeaf  
# 58 "Enum.frag.ml"
           ->
        e
    | 
# 60 "Enum.frag.ml"
       
  TNode { l = l; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
        
# 61 "Enum.frag.ml"
        cat_tree_enum l (More (v, r, e))

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

  let[@inline] enum (t : 'v tree) : 'v ienum =
    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 : 'v tree) (e : 'v ienum) : 'v ienum =
    match 
# 79 "Enum.frag.ml"
           
  (t)  
# 79 "Enum.frag.ml"
                  with
    | 
# 80 "Enum.frag.ml"
       
  TLeaf  
# 80 "Enum.frag.ml"
           ->
        e
    | 
# 82 "Enum.frag.ml"
       
  TNode { l = l; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
        
# 83 "Enum.frag.ml"
        let c = E.compare (
# 83 "Enum.frag.ml"
                              (let (_k, _) = v in _k) 
# 83 "Enum.frag.ml"
                                     ) 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 : 'v tree) : 'v ienum =
    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 : 'v tree) (e : 'v ienum) : 'v ienum =
    (* 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 (
# 108 "Enum.frag.ml"
                                  (let (_k, _) = v' in _k) 
# 108 "Enum.frag.ml"
                                          ) 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 : 'v ienum) : 'v ienum =
    match e with
    | More (v, r, e') ->
        if E.compare low (
# 136 "Enum.frag.ml"
                             (let (_k, _) = v in _k) 
# 136 "Enum.frag.ml"
                                    ) <= 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 : 'v ienum) : 
# 145 "Enum.frag.ml"
                                      (key *          _ )  
# 145 "Enum.frag.ml"
                                =
    match e with
    | End            -> raise Not_found
    | More (v, _, _) -> v

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

  let head_opt (e : 'v ienum) : 
# 155 "Enum.frag.ml"
                                          (key *          _ )  
# 155 "Enum.frag.ml"
                                    option =
    match e with
    | End            -> None
    | More (v, _, _) -> Some v

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

  (* [equal e1 e2] compares the enumerations [e1] and [e2]. *)

  (* In the map variant, [equal] takes an extra argument, [eq], which is used
     to compare the data components of two values. In the set variant, this
     argument is absent; there are no data components, and one can think of
     [eq] as the constant function [true]. *)

  let rec equal 
# 172 "Enum.frag.ml"
                     (eq)  
# 172 "Enum.frag.ml"
                          (e1 : _ ienum) (e2 : _ ienum) : bool =
    match e1, e2 with
    | End, End ->
        true
    | End, More _
    | More _, End ->
        false
    | More (v1, r1, e1), More (v2, r2, e2) ->
        compare_elts v1 v2 = 0 &&
        
# 182 "Enum.frag.ml"
        eq (
# 182 "Enum.frag.ml"
              (let (_, _d) = v1 in _d) 
# 182 "Enum.frag.ml"
                        ) (
# 182 "Enum.frag.ml"
                             (let (_, _d) = v2 in _d) 
# 182 "Enum.frag.ml"
                                       ) &&
        
# 184 "Enum.frag.ml"
        equal 
# 184 "Enum.frag.ml"
                   (eq)  
# 184 "Enum.frag.ml"
                        (cat_tree_enum r1 e1) (cat_tree_enum r2 e2)

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

  (* In the map variant, [compare] takes an extra argument, [cmp], which is
     used to compare the data components of two values. In the set variant,
     this argument is absent; there are no data components, and one can think
     of [cmp] as the constant function [0]. *)

  let rec compare 
# 194 "Enum.frag.ml"
                       (cmp)  
# 194 "Enum.frag.ml"
                             (e1 : _ ienum) (e2 : _ ienum) : int =
    match e1, e2 with
    | End, End ->
        0
    | End, More _ ->
        -1
    | More _, End ->
        1
    | More (v1, r1, e1), More (v2, r2, e2) ->
        let c = compare_elts v1 v2 in
        if c <> 0 then c else
        
# 206 "Enum.frag.ml"
        let c = cmp (
# 206 "Enum.frag.ml"
                       (let (_, _d) = v1 in _d) 
# 206 "Enum.frag.ml"
                                 ) (
# 206 "Enum.frag.ml"
                                      (let (_, _d) = v2 in _d) 
# 206 "Enum.frag.ml"
                                                ) in
        if c <> 0 then c else
        
# 209 "Enum.frag.ml"
        compare 
# 209 "Enum.frag.ml"
                     (cmp)  
# 209 "Enum.frag.ml"
                           (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 : 'v ienum) : 
# 213 "Enum.frag.ml"
                                                 (key *          _ )  
# 213 "Enum.frag.ml"
                                           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 : 'v ienum) : 
# 220 "Enum.frag.ml"
                                        (key *          _ )  
# 220 "Enum.frag.ml"
                                  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 : 
# 233 "Enum.frag.ml"
                                  (key *          _ ) 
# 233 "Enum.frag.ml"
                           ) (r : 'v tree) (e : 'v ienum) : 'v tree =
    match e with
    | End ->
        join leaf v r
    | More (v', r', e) ->
        elements v (join r v' r') e

  let elements (e : 'v ienum) : 'v 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 : 'v tree) (e : 'v ienum) : 'v ienum =
    match 
# 256 "Enum.frag.ml"
           
  (t)  
# 256 "Enum.frag.ml"
                  with
    | 
# 257 "Enum.frag.ml"
       
  TLeaf  
# 257 "Enum.frag.ml"
           ->
        e
    | 
# 259 "Enum.frag.ml"
       
  TNode { l = l; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
        
# 260 "Enum.frag.ml"
        let c = E.compare (
# 260 "Enum.frag.ml"
                              (let (_k, _) = v in _k) 
# 260 "Enum.frag.ml"
                                     ) 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 : 'v tree) (e : 'v ienum) : 'v ienum =
    match e with
    | More (v', r', e') ->
        let c = E.compare low (
# 275 "Enum.frag.ml"
                                  (let (_k, _) = v' in _k) 
# 275 "Enum.frag.ml"
                                          ) 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. *)

  (* In the map variant, a type annotation is required, because this function
     is polymorphic recursive. Indeed, the final recursive call exchanges the
     two sides. *)

  let rec disjoint_more_more
  
# 297 "Enum.frag.ml"
  : 'a1 'a2 .
    'a1 binding -> 'a1 binding tree -> 'a1 binding ienum ->
    'a2 binding -> 'a2 binding tree -> 'a2 binding ienum ->
    bool
  
# 302 "Enum.frag.ml"
  = fun v1 r1 e1 v2 r2 e2 ->
    assert (compare_elts v1 v2 < 0);
    (* Skip past [v2] in the enumeration [e1]. *)
    (* If [v2] appears in [e1], fail. *)
    let e1 = filter_tree_enum_disjoint (
# 306 "Enum.frag.ml"
                                           (let (_k, _) = v2 in _k) 
# 306 "Enum.frag.ml"
                                                   ) 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 (compare_elts 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 : _ ienum) (e2 : _ ienum) : bool =
    match e1, e2 with
    | End, _
    | _, End ->
        true
    | More (v1, r1, e1), More (v2, r2, e2) ->
        let c = compare_elts 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 : 'v ienum) : int =
    match e with
    | End ->
        accu
    | More (_, r, e) ->
        length_aux (accu + cardinal r + 1) e

  let[@inline] length (e : 'v ienum) : 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

  (* 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 'v ienum =
    | End
    | More of 'v ienum * 'v tree * 'v

  let empty : 'v ienum =
    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 : 'v ienum) (t : 'v tree) : 'v ienum =
    match 
# 381 "Enum.frag.ml"
           
  (t)  
# 381 "Enum.frag.ml"
                  with
    | 
# 382 "Enum.frag.ml"
       
  TLeaf  
# 382 "Enum.frag.ml"
           ->
        e
    | 
# 384 "Enum.frag.ml"
       
  TNode { l = l; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
        
# 385 "Enum.frag.ml"
        cat_enum_tree (More (e, l, v)) r

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

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

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

  let rec to_seq_node (e : 'v ienum) : 
# 394 "Enum.frag.ml"
                                                 (key *          _ )  
# 394 "Enum.frag.ml"
                                           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 
# 22 "Compare.frag.ml"
                 (cmp)  
# 22 "Compare.frag.ml"
                       (t1 : 
# 22 "Compare.frag.ml"
                                               (key *          _ )  tree 
# 22 "Compare.frag.ml"
                                 ) (t2 : 
# 22 "Compare.frag.ml"
                                                           (key *          _ )  tree 
# 22 "Compare.frag.ml"
                                             ) : int =
  
# 26 "Compare.frag.ml"
  Enum.(compare 
# 26 "Compare.frag.ml"
                     (cmp)  
# 26 "Compare.frag.ml"
                           (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 of sets 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 compares two enumerations. Furthermore, this
   approach works for both sets and maps. *)

(* 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 equal 
# 31 "Equal.frag.ml"
               (eq)  
# 31 "Equal.frag.ml"
                    t1 t2 =
  
# 35 "Equal.frag.ml"
  weight t1 = weight t2 && (* fast path *)
  Enum.(equal 
# 36 "Equal.frag.ml"
                   (eq)  
# 36 "Equal.frag.ml"
                        (enum t1) (enum t2))
# 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. *)

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

(* The set variant. *)


# 96 "Union.frag.ml"
(* -------------------------------------------------------------------------- *)

(* The map variant. *)

(* In accordance with the API of OCaml's Map library, [union] expects a
   function [f], which specifies how two values must be combined.

   Furthermore, the internal functions [union1] and [union] expect a
   Boolean flag [flip], which indicates whether the arguments of [f]
   should be exchanged. *)

(* [union1] can be viewed as a generalization of [add] and [replace]
   where the manner in which the existing element and the new element
   must be combined is determined by the parameters [flip] and [f].
   It can also be viewed as a special case of [union] where the first
   map is a singleton. *)

(* [union1] assumes that [t1] is [singleton (k1, d1)]. Carrying this
   extra parameter lets us save one allocation in the base case
   where the key [k1] does not appear in the tree [t2]. *)

let rec union1
  (flip : bool) (f : key -> 'a -> 'a -> 'a option)
  (k1 : key) (d1 : 'a) (t1 : 'a binding tree)
  (t2 : 'a binding tree) : 'a binding tree =
  match 
# 121 "Union.frag.ml"
         
  (t2)  
# 121 "Union.frag.ml"
                 with
  | 
# 122 "Union.frag.ml"
     
  TLeaf  
# 122 "Union.frag.ml"
         ->
      (* This is equivalent to [singleton (k1, d1)]. *)
      t1
  | 
# 125 "Union.frag.ml"
     
  TNode { l = l2; k = _k; d = _d; r =  r2; _ } -> 
    let  v2 = (_k, _d) in 
      
# 126 "Union.frag.ml"
      let (k2, d2) = v2 in
      let c = E.compare k1 k2 in
      if c = 0 then
        let k = k2 in
        match 
# 130 "Union.frag.ml"
               
  (if flip then  f  k  d2  d1 else  f  k  d1  d2)  
# 130 "Union.frag.ml"
                                          with
        | None ->
            join2_siblings l2 r2
        | Some d ->
            if d == d2 then t2 else
            let v2 = (k, d) in
            join_siblings l2 v2 r2
      else if c < 0 then
        let l'2 = union1 flip f k1 d1 t1 l2 in
        if l2 == l'2 then t2 else join_quasi_siblings l'2 v2 r2
      else
        let r'2 = union1 flip f k1 d1 t1 r2 in
        if r2 == r'2 then t2 else join_quasi_siblings l2 v2 r'2

(* Re-package [union1] to take [(k1, d1)] as a pair. *)

let[@inline] union1 flip f (k1, d1) t1 t2 =
  union1 flip f k1 d1 t1 t2

(* [union] does not offer a physical equality guarantee about its result.
   (This does not seem to be possible. One would need to require [f] to
   preserve physical equality, but it is impossible to predict which
   argument of [f] should be favored.) *)

(* As in the set variant, we try to preserve physical equality with the
   second argument, which is likely to be the larger tree. *)

let rec union
  (flip : bool) (f : key -> 'a -> 'a -> 'a option)
  (t1 : 'a binding tree) (t2 : 'a binding tree) : 'a binding tree =
  match 
# 160 "Union.frag.ml"
         
  (t1) 
# 160 "Union.frag.ml"
                , 
# 160 "Union.frag.ml"
                   
  (t2)  
# 160 "Union.frag.ml"
                           with
  | 
# 161 "Union.frag.ml"
     
  TLeaf 
# 161 "Union.frag.ml"
        , _ ->
      t2
  | _, 
# 163 "Union.frag.ml"
        
  TLeaf  
# 163 "Union.frag.ml"
            ->
      t1
  | 
# 165 "Union.frag.ml"
     
  TNode { l = l1; k = _k1; d = _d1; r =  r1; _ }, 
  TNode { l =  l2; k = _k2; d = _d2; r =  r2; _ } -> 
    let  v1 = (_k1, _d1) 
    and  v2 = (_k2, _d2) in 
      
# 166 "Union.frag.ml"
      if 
# 166 "Union.frag.ml"
          (        (match  
  (l1)  with  
  TLeaf  -> true | _ -> false)  &&         (match  
  ( r1)  with  
  TLeaf  -> true | _ -> false) )  
# 166 "Union.frag.ml"
                            then union1 flip f v1 t1 t2 else
      if 
# 167 "Union.frag.ml"
          (        (match  
  (l2)  with  
  TLeaf  -> true | _ -> false)  &&         (match  
  ( r2)  with  
  TLeaf  -> true | _ -> false) )  
# 167 "Union.frag.ml"
                            then union1 (not flip) f v2 t2 t1 else
      let (k2, d2) = v2 in
      let l1, od1, r1 = split k2 t1 in
      let l = union flip f l1 l2
      and r = union flip f r1 r2 in
      match od1 with
      | None ->
          let v = v2 in
          if l == l2 && r == r2 then t2 else
          join l v r
      | Some d1 ->
          let k = k2 in
          match 
# 179 "Union.frag.ml"
                 
  (if flip then  f  k  d2  d1 else  f  k  d1  d2)  
# 179 "Union.frag.ml"
                                            with
          | None ->
              join2 l r
          | Some d ->
              if l == l2 && d == d2 && r == r2 then t2 else
              let v = (k, d) in
              join l v r

(* The toplevel wrapper tests which of the two arguments seems larger. This
   guarantees that we split the smaller tree. (As in the set variant, this
   test is performed just once at the top level, not at every level.) *)

(* The fast path, based on the test [t1 == t2], disappears in the map
   variant. It would be sound if we could require [f x x = Some x]
   for all [x]. *)

let union f t1 t2 =
  if seems_smaller t1 t2 then
    let flip = false in
    union flip f t1 t2
  else
    let flip = true in
    union flip f t2 t1

(* In the [merge] functions, we assume that [f None None] is [None], and
   never actually evaluate [f None None]. *)

(* [merge_no_left] is the special case of [merge] where the left-hand tree
   [t1] is empty. *)

let rec merge_no_left f t2 =
  match 
# 210 "Union.frag.ml"
         
  (t2)  
# 210 "Union.frag.ml"
                 with
  | 
# 211 "Union.frag.ml"
     
  TLeaf  
# 211 "Union.frag.ml"
         ->
      leaf
  | 
# 213 "Union.frag.ml"
     
  TNode { l = l2; k = _k; d = _d; r =  r2; _ } -> 
    let  v2 = (_k, _d) in 
      
# 214 "Union.frag.ml"
      let (k2, d2) = v2 in
      let k = k2
      and od1 = None
      and od2 = Some d2 in
      ojoin (merge_no_left f l2) k (f k od1 od2) (merge_no_left f r2)

(* [merge_no_right] is the special case of [merge] where the right-hand
   tree [t2] is empty. *)

let rec merge_no_right f t1 =
  match 
# 224 "Union.frag.ml"
         
  (t1)  
# 224 "Union.frag.ml"
                 with
  | 
# 225 "Union.frag.ml"
     
  TLeaf  
# 225 "Union.frag.ml"
         ->
      leaf
  | 
# 227 "Union.frag.ml"
     
  TNode { l = l1; k = _k; d = _d; r =  r1; _ } -> 
    let  v1 = (_k, _d) in 
      
# 228 "Union.frag.ml"
      let (k1, d1) = v1 in
      let k = k1
      and od1 = Some d1
      and od2 = None in
      ojoin (merge_no_right f l1) k (f k od1 od2) (merge_no_right f r1)

(* [merge] does not attempt to preserve physical equality. *)

(* As soon as we discover that one of the two arguments is an empty tree,
   we switch to [merge_no_left] or [merge_no_right]. This should be more
   efficient, and makes the code simpler. *)

let rec merge f t1 t2 =
  match 
# 241 "Union.frag.ml"
         
  (t1) 
# 241 "Union.frag.ml"
                , 
# 241 "Union.frag.ml"
                   
  (t2)  
# 241 "Union.frag.ml"
                           with
  | 
# 242 "Union.frag.ml"
     
  TLeaf 
# 242 "Union.frag.ml"
        , 
# 242 "Union.frag.ml"
           
  TLeaf  
# 242 "Union.frag.ml"
               ->
      leaf
  | 
# 244 "Union.frag.ml"
     
  TLeaf 
# 244 "Union.frag.ml"
        , _ ->
      merge_no_left f t2
  | _, 
# 246 "Union.frag.ml"
        
  TLeaf  
# 246 "Union.frag.ml"
            ->
      merge_no_right f t1
  | 
# 248 "Union.frag.ml"
     
  TNode { l = l1; k = _k1; d = _d1; r =  r1; _ }, 
  TNode { l =  l2; k = _k2; d = _d2; r =  r2; _ } -> 
    let  v1 = (_k1, _d1) 
    and  v2 = (_k2, _d2) in 
      
# 249 "Union.frag.ml"
      if seems_smaller t1 t2 then
        (* Split the smaller tree, namely [t1]. *)
        let (k2, d2) = v2 in
        let k = k2 in
        let l1, od1, r1 = split k2 t1 in
        let od2 = Some d2 in
        ojoin (merge f l1 l2) k (f k od1 od2) (merge f r1 r2)
      else
        (* Split the smaller tree, namely [t2]. *)
        let (k1, d1) = v1 in
        let k = k1 in
        let od1 = Some d1 in
        let l2, od2, r2 = split k1 t2 in
        ojoin (merge f l1 l2) k (f k od1 od2) (merge f r1 r2)

(* In the map variant, [override] is [union] with priority to the right-hand
   argument. It is not commutative. It is used internally; for example, the
   functions [of_array] and [add_seq] rely on it. *)

let override t1 t2 =
  union (fun _k _v1 v2 -> Some v2) t1 t2

# 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. *)

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

(* The set variant. *)


# 89 "Inter.frag.ml"
(* -------------------------------------------------------------------------- *)

(* The map variant. *)

(* Like [union], [inter] expects a function [f], which specifies how two
   values must be combined. In contrast with [union], [inter] admits a more
   general type, where the two input maps and the output map can have three
   distinct types of values. *)

(* The physical equality tests, whose purpose was to preserve sharing, are
   abandoned, because they impose undesirable type equality constraints. *)

(* [inter1l] represents the special case where the left-hand tree is a
   singleton [singleton (k1, d1)]. *)

let inter1l f (k1, d1) t2 =
  match find_opt k1 t2 with
  | None ->
      empty
  | Some d2 ->
      let k = k1 in
      match f k d1 d2 with
      | None ->
          empty
      | Some d ->
          singleton (k, d)

let rec inter f t1 t2 =
  match 
# 117 "Inter.frag.ml"
         
  (t1) 
# 117 "Inter.frag.ml"
                , 
# 117 "Inter.frag.ml"
                   
  (t2)  
# 117 "Inter.frag.ml"
                           with
  | 
# 118 "Inter.frag.ml"
     
  TLeaf 
# 118 "Inter.frag.ml"
        , _
  | _, 
# 119 "Inter.frag.ml"
        
  TLeaf  
# 119 "Inter.frag.ml"
            ->
      leaf
  | 
# 121 "Inter.frag.ml"
     
  TNode { l = l1; k = _k1; d = _d1; r =  r1; _ }, 
  TNode { l =  l2; k = _k2; d = _d2; r =  r2; _ } -> 
    let  v1 = (_k1, _d1) 
    and  v2 = (_k2, _d2) in 
      
# 122 "Inter.frag.ml"
      if 
# 122 "Inter.frag.ml"
          (        (match  
  (l1)  with  
  TLeaf  -> true | _ -> false)  &&         (match  
  ( r1)  with  
  TLeaf  -> true | _ -> false) )  
# 122 "Inter.frag.ml"
                            then inter1l f v1 t2 else
      let (k2, d2) = v2 in
      let l1, od1, r1 = split k2 t1 in
      let l = inter f l1 l2
      and r = inter f r1 r2 in
      match od1 with
      | None ->
          join2 l r
      | Some d1 ->
          let k = k2 in
          let od = f k d1 d2 in
          ojoin l k od r

(* The toplevel wrapper tests which of the two arguments seems larger. This
   guarantees that we split the smaller tree. (As in the set variant, this
   test is performed just once at the top level, not at every level.) *)

let inter f t1 t2 =
  if seems_smaller t1 t2 then
    inter f t1 t2
  else
    inter (fun k d1 d2 -> f k d2 d1) t2 t1
      (* We could avoid creating this closure, which adds overhead to
         every call to [f], by duplicating the code of [inter1l] and
         [inter] for the case where the arguments of [f] are flipped.
         It would be great if the compiler would create a specialized
         copy of [inter] for this situation. *)

# 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]. (Set variant only.)

let rec diff (t1 : TREE) (t2 : TREE) : TREE =
  match VIEW(t1), VIEW(t2) with
  | LEAF, _ ->
      leaf
  | _, LEAF ->
      t1
  | NODENODE(_, _, _, 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. It splits the tree [t2]. *)

let rec diff (t1 : 
# 37 "Diff.frag.ml"
                                     (key *          _ )  tree 
# 37 "Diff.frag.ml"
                       ) (t2 : 
# 37 "Diff.frag.ml"
                                                 (key *          _ )  tree 
# 37 "Diff.frag.ml"
                                   ) : 
# 37 "Diff.frag.ml"
                                                         (key *          _ )  tree  
# 37 "Diff.frag.ml"
                                            =
  match 
# 38 "Diff.frag.ml"
         
  (t1) 
# 38 "Diff.frag.ml"
                , 
# 38 "Diff.frag.ml"
                   
  (t2)  
# 38 "Diff.frag.ml"
                           with
  | 
# 39 "Diff.frag.ml"
     
  TLeaf 
# 39 "Diff.frag.ml"
        , _ ->
      leaf
  | _, 
# 41 "Diff.frag.ml"
        
  TLeaf  
# 41 "Diff.frag.ml"
            ->
      t1
  | 
# 43 "Diff.frag.ml"
     
  TNode { l = l1; k = _k1; d = _d1; r =  r1; _ }, 
  TNode { l =  l2; k = _k2; d = _d2; r =  r2; _ } -> 
    let  v1 = (_k1, _d1) 
    and  v2 = (_k2, _d2) in 
      
# 44 "Diff.frag.ml"
      let k1 = 
# 44 "Diff.frag.ml"
                  (let (_k, _) = v1 in _k)  
# 44 "Diff.frag.ml"
                           in
      
# 48 "Diff.frag.ml"
      if 
# 48 "Diff.frag.ml"
          (        (match  
  (l1)  with  
  TLeaf  -> true | _ -> false)  &&         (match  
  ( r1)  with  
  TLeaf  -> true | _ -> false) )  
# 48 "Diff.frag.ml"
                            then
        (* [t1] is [singleton v1]. *)
        if mem k1 t2 then leaf else t1
      else if 
# 51 "Diff.frag.ml"
               (        (match  
  (l2)  with  
  TLeaf  -> true | _ -> false)  &&         (match  
  ( r2)  with  
  TLeaf  -> true | _ -> false) )  
# 51 "Diff.frag.ml"
                                 then
        (* [t2] is [singleton v2]. *)
        let k2 = 
# 53 "Diff.frag.ml"
                    (let (_k, _) = v2 in _k)  
# 53 "Diff.frag.ml"
                             in
        remove k2 t1
      else
        let l2, b, r2 = split k1 t2 in
        let l = diff l1 l2
        and r = diff r1 r2 in
        
# 59 "Diff.frag.ml"
         match b with Some _ -> 
          
# 60 "Diff.frag.ml"
          join2 l r
        
# 61 "Diff.frag.ml"
          | None -> 
          
# 62 "Diff.frag.ml"
          if l == l1 && r == r1 then t1 else (* preserve sharing *)
          join l v1 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]. (Set variant only.)

let rec xor (t1 : TREE) (t2 : TREE) : TREE =
  match VIEW(t1), VIEW(t2) with
  | LEAF, _ ->
      t2
  | _, LEAF ->
      t1
  | NODENODE(_, _, _, 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 : 
# 37 "Xor.frag.ml"
                                    (key *          _ )  tree 
# 37 "Xor.frag.ml"
                      ) (t2 : 
# 37 "Xor.frag.ml"
                                                (key *          _ )  tree 
# 37 "Xor.frag.ml"
                                  ) : 
# 37 "Xor.frag.ml"
                                                        (key *          _ )  tree  
# 37 "Xor.frag.ml"
                                           =
  match 
# 38 "Xor.frag.ml"
         
  (t1) 
# 38 "Xor.frag.ml"
                , 
# 38 "Xor.frag.ml"
                   
  (t2)  
# 38 "Xor.frag.ml"
                           with
  | 
# 39 "Xor.frag.ml"
     
  TLeaf 
# 39 "Xor.frag.ml"
        , _ ->
      t2
  | _, 
# 41 "Xor.frag.ml"
        
  TLeaf  
# 41 "Xor.frag.ml"
            ->
      t1
  | 
# 43 "Xor.frag.ml"
     
  TNode { l = _; k = _k1; d = _d1; r =  _; _ }, 
  TNode { l =  l2; k = _k2; d = _d2; r =  r2; _ } -> 
    let  _ = (_k1, _d1) 
    and  v2 = (_k2, _d2) in 
      
# 44 "Xor.frag.ml"
      if t1 == t2 then leaf else (* fast path *)
      let k2 = 
# 45 "Xor.frag.ml"
                  (let (_k, _) = v2 in _k)  
# 45 "Xor.frag.ml"
                           in
      if 
# 46 "Xor.frag.ml"
          (        (match  
  (l2)  with  
  TLeaf  -> true | _ -> false)  &&         (match  
  ( r2)  with  
  TLeaf  -> true | _ -> false) )  
# 46 "Xor.frag.ml"
                            then
        (* [t2] is [singleton v2]. *)
        if mem k2 t1 then
          remove k2 t1
        else
          add_absent v2 t1
      else
        let l1, b, r1 = split k2 t1 in
        let l = xor l1 l2
        and r = xor r1 r2 in
        
# 56 "Xor.frag.ml"
         match b with Some _ -> 
          
# 57 "Xor.frag.ml"
          join2 l r
        
# 58 "Xor.frag.ml"
          | None -> 
          
# 59 "Xor.frag.ml"
          join l v2 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.) (Set variant only.)

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"
         
  (t1) 
# 41 "Disjoint.frag.ml"
                , 
# 41 "Disjoint.frag.ml"
                   
  (t2)  
# 41 "Disjoint.frag.ml"
                           with
  | 
# 42 "Disjoint.frag.ml"
     
  TLeaf 
# 42 "Disjoint.frag.ml"
        , _
  | _, 
# 43 "Disjoint.frag.ml"
        
  TLeaf  
# 43 "Disjoint.frag.ml"
            ->
      true (* fast path *)
  | _, _ ->
      
# 49 "Disjoint.frag.ml"
      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. *)

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

(* The set variant. *)


# 68 "Subset.frag.ml"
(* -------------------------------------------------------------------------- *)

(* The map variant. *)

(* In the map variant, the name [subset] does not seem appropriate.
   I prefer to name this function [sub]. *)

(* [sub] is parameterized with a data comparison function [f]. *)

(* The physical equality tests disappear, because they impose undesirable
   type equality constraints. *)

let rec sub
  (f : 'a1 -> 'a2 -> bool)
  (t1 : 'a1 binding tree) (t2 : 'a2 binding tree) : bool =
  match 
# 83 "Subset.frag.ml"
         
  (t1) 
# 83 "Subset.frag.ml"
                , 
# 83 "Subset.frag.ml"
                   
  (t2)  
# 83 "Subset.frag.ml"
                           with
  | 
# 84 "Subset.frag.ml"
     
  TLeaf 
# 84 "Subset.frag.ml"
        , _ ->
      true
  | _, 
# 86 "Subset.frag.ml"
        
  TLeaf  
# 86 "Subset.frag.ml"
            ->
      false
  | 
# 88 "Subset.frag.ml"
     
  TNode { l = l1; k = _k1; d = _d1; r =  r1; _ }, 
  TNode { l =  l2; k = _k2; d = _d2; r =  r2; _ } -> 
    let  v1 = (_k1, _d1) 
    and  v2 = (_k2, _d2) in 
      
# 89 "Subset.frag.ml"
      let (k1, d1) = v1 in
      if 
# 90 "Subset.frag.ml"
          (        (match  
  (l1)  with  
  TLeaf  -> true | _ -> false)  &&         (match  
  ( r1)  with  
  TLeaf  -> true | _ -> false) )  
# 90 "Subset.frag.ml"
                            then begin
        (* The tree [t1] is [singleton v1]. *)
        match find_opt k1 t2 with
        | None ->
            false
        | Some d2 ->
            f d1 d2
      end
      else
        weight t1 <= weight t2 && (* fast path *)
        let (k2, d2) = v2 in
        let l1, od1, r1 = split k2 t1 in
        (match od1 with None -> true | Some d1 -> f d1 d2) &&
        sub f l1 l2 && sub f r1 r2

# 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] and [filter_map]. *)

(* The set variant is more complex because the function [f] is not
   necessarily monotone. The map variant is simpler because its API is
   less expressive; by construction, the key component is preserved
   and the function [f] transforms only the data component, so the
   transformation that is applied to the key-data pair is monotone. *)


# 114 "Map.frag.ml"
(* -------------------------------------------------------------------------- *)

(* The map variant. *)

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

let rec map f t =
  match 
# 121 "Map.frag.ml"
         
  (t)  
# 121 "Map.frag.ml"
                with
  | 
# 122 "Map.frag.ml"
     
  TLeaf  
# 122 "Map.frag.ml"
         ->
      leaf
  | 
# 124 "Map.frag.ml"
     
  TNode { l = l; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
      
# 125 "Map.frag.ml"
      (* Enforce left-to-right evaluation order. *)
      let l' = map f l in
      let (k, d) = v in
      let d' = f d in
      let r' = map f r in
      let v' = (k, d') in
      join_siblings l' v' r'

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

let rec mapi f t =
  match 
# 136 "Map.frag.ml"
         
  (t)  
# 136 "Map.frag.ml"
                with
  | 
# 137 "Map.frag.ml"
     
  TLeaf  
# 137 "Map.frag.ml"
         ->
      leaf
  | 
# 139 "Map.frag.ml"
     
  TNode { l = l; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
      
# 140 "Map.frag.ml"
      (* Enforce left-to-right evaluation order. *)
      let l' = mapi f l in
      let (k, d) = v in
      let d' = f k d in
      let r' = mapi f r in
      let v' = (k, d') in
      join_siblings l' v' r'

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

let rec filter_map f t =
  match 
# 151 "Map.frag.ml"
         
  (t)  
# 151 "Map.frag.ml"
                with
  | 
# 152 "Map.frag.ml"
     
  TLeaf  
# 152 "Map.frag.ml"
         ->
      leaf
  | 
# 154 "Map.frag.ml"
     
  TNode { l = l; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
      
# 155 "Map.frag.ml"
      (* Enforce left-to-right evaluation order. *)
      let l' = filter_map f l in
      let (k, d) = v in
      let od' = f k d in
      let r' = filter_map f r in
      ojoin l' k od' 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 : 
# 25 "Filter.frag.ml"
                                        (key *          _ )  tree 
# 25 "Filter.frag.ml"
                          ) : 
# 25 "Filter.frag.ml"
                                                (key *          _ )  tree  
# 25 "Filter.frag.ml"
                                   =
  match 
# 26 "Filter.frag.ml"
         
  (t)  
# 26 "Filter.frag.ml"
                with
  | 
# 27 "Filter.frag.ml"
     
  TLeaf  
# 27 "Filter.frag.ml"
         ->
      leaf
  | 
# 29 "Filter.frag.ml"
     
  TNode { l = l; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
      
# 30 "Filter.frag.ml"
      (* Enforce left-to-right evaluation order. *)
      let l' = filter p l in
      let keep = 
# 32 "Filter.frag.ml"
                      (let (_k, _d) =  v in p _k _d)  
# 32 "Filter.frag.ml"
                             in
      let r' = filter p r in
      if keep 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 : 
# 43 "Filter.frag.ml"
                                           (key *          _ )  tree 
# 43 "Filter.frag.ml"
                             ) : 
# 43 "Filter.frag.ml"
                                                   (key *          _ )  tree  
# 43 "Filter.frag.ml"
                                      * 
# 43 "Filter.frag.ml"
                                                          (key *          _ )  tree  
# 43 "Filter.frag.ml"
                                             =
  match 
# 44 "Filter.frag.ml"
         
  (t)  
# 44 "Filter.frag.ml"
                with
  | 
# 45 "Filter.frag.ml"
     
  TLeaf  
# 45 "Filter.frag.ml"
         ->
      leaf, leaf
  | 
# 47 "Filter.frag.ml"
     
  TNode { l = l; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
      
# 48 "Filter.frag.ml"
      (* Enforce left-to-right evaluation order. *)
      let lt, lf = partition p l in
      let keep = 
# 50 "Filter.frag.ml"
                      (let (_k, _d) =  v in p _k _d)  
# 50 "Filter.frag.ml"
                             in
      let rt, rf = partition p r in
      if keep 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 "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 to_list (t : 
# 17 "Conversions.frag.ml"
                                       (key *          _ )  tree 
# 17 "Conversions.frag.ml"
                         ) (k : 
# 17 "Conversions.frag.ml"
                                          (key *          _ )  
# 17 "Conversions.frag.ml"
                                    list) : 
# 17 "Conversions.frag.ml"
                                                      (key *          _ )  
# 17 "Conversions.frag.ml"
                                                list =
  match 
# 18 "Conversions.frag.ml"
         
  (t)  
# 18 "Conversions.frag.ml"
                with
  | 
# 19 "Conversions.frag.ml"
     
  TLeaf  
# 19 "Conversions.frag.ml"
         ->
      k
  | 
# 21 "Conversions.frag.ml"
     
  TNode { l = l; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
      
# 22 "Conversions.frag.ml"
      to_list l (v :: to_list r k)

let[@inline] to_list (t : 
# 24 "Conversions.frag.ml"
                                            (key *          _ )  tree 
# 24 "Conversions.frag.ml"
                              ) : 
# 24 "Conversions.frag.ml"
                                            (key *          _ )  
# 24 "Conversions.frag.ml"
                                      list =
  to_list t []

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

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

let to_seq (t : 
# 32 "Conversions.frag.ml"
                                  (key *          _ )  tree 
# 32 "Conversions.frag.ml"
                    ) : 
# 32 "Conversions.frag.ml"
                                  (key *          _ )  
# 32 "Conversions.frag.ml"
                            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 : 
# 38 "Conversions.frag.ml"
                                                   (key *          _ )  tree 
# 38 "Conversions.frag.ml"
                                     ) : 
# 38 "Conversions.frag.ml"
                                                   (key *          _ )  
# 38 "Conversions.frag.ml"
                                             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 : 
# 44 "Conversions.frag.ml"
                                      (key *          _ )  tree 
# 44 "Conversions.frag.ml"
                        ) : 
# 44 "Conversions.frag.ml"
                                      (key *          _ )  
# 44 "Conversions.frag.ml"
                                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 : 
# 53 "Conversions.frag.ml"
                                              (key *          _ )  tree 
# 53 "Conversions.frag.ml"
                                ) a i : int =
  assert (0 <= i && i + cardinal t <= Array.length a);
  match 
# 55 "Conversions.frag.ml"
         
  (t)  
# 55 "Conversions.frag.ml"
                with
  | 
# 56 "Conversions.frag.ml"
     
  TLeaf  
# 56 "Conversions.frag.ml"
         ->
      i
  | 
# 58 "Conversions.frag.ml"
     
  TNode { l = l; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
      
# 59 "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 : 
# 68 "Conversions.frag.ml"
                                    (key *          _ )  tree 
# 68 "Conversions.frag.ml"
                      ) : 
# 68 "Conversions.frag.ml"
                                    (key *          _ )  
# 68 "Conversions.frag.ml"
                              array =
  match 
# 69 "Conversions.frag.ml"
         
  (t)  
# 69 "Conversions.frag.ml"
                with
  | 
# 70 "Conversions.frag.ml"
     
  TLeaf  
# 70 "Conversions.frag.ml"
         ->
      [||]
  | 
# 72 "Conversions.frag.ml"
     
  TNode { l = _; k = _k; d = _d; r =  _; _ } -> 
    let  dummy = (_k, _d) in 
      
# 73 "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] is available as part of the [BASE_SET]
   or [BASE_MAP] signature. *)

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

(* [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. *)

(* [override] is [union] with priority to the right-hand argument. So,
   in the map variant, if a key appears twice in the list, the rightmost
   binding takes over. *)

let of_array a =
  let yield accu i j = override accu (of_sorted_unique_array_slice a i j) in
  ArrayExtra.foreach_increasing_run compare_elts 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 =
  override t (of_seq xs)
# 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 : 
# 27 "RandomAccess.frag.ml"
                                   (key *          _ )  tree 
# 27 "RandomAccess.frag.ml"
                     ) (i : int) : 
# 27 "RandomAccess.frag.ml"
                                             (key *          _ )  
# 27 "RandomAccess.frag.ml"
                                       =
  assert (0 <= i && i < cardinal t);
  match 
# 29 "RandomAccess.frag.ml"
         
  (t)  
# 29 "RandomAccess.frag.ml"
                with
  | 
# 30 "RandomAccess.frag.ml"
     
  TLeaf  
# 30 "RandomAccess.frag.ml"
         ->
      assert false
  | 
# 32 "RandomAccess.frag.ml"
     
  TNode { l = l; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
      
# 33 "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 : 
# 41 "RandomAccess.frag.ml"
                               (key *          _ )  tree 
# 41 "RandomAccess.frag.ml"
                 ) (i : int) : 
# 41 "RandomAccess.frag.ml"
                                         (key *          _ )  
# 41 "RandomAccess.frag.ml"
                                   =
  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 : 
# 66 "RandomAccess.frag.ml"
                                                         (key *          _ )  tree 
# 66 "RandomAccess.frag.ml"
                                           ) : int =
  match 
# 67 "RandomAccess.frag.ml"
         
  (t)  
# 67 "RandomAccess.frag.ml"
                with
  | 
# 68 "RandomAccess.frag.ml"
     
  TLeaf  
# 68 "RandomAccess.frag.ml"
         ->
      raise Not_found
  | 
# 70 "RandomAccess.frag.ml"
     
  TNode { l = l; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
      
# 71 "RandomAccess.frag.ml"
      let c = E.compare x (
# 71 "RandomAccess.frag.ml"
                              (let (_k, _) = v in _k) 
# 71 "RandomAccess.frag.ml"
                                     ) 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 : 
# 94 "RandomAccess.frag.ml"
                                   (key *          _ )  tree 
# 94 "RandomAccess.frag.ml"
                     ) (i : int) : 
# 94 "RandomAccess.frag.ml"
                                                     (key *          _ )  tree  
# 94 "RandomAccess.frag.ml"
                                        * 
# 94 "RandomAccess.frag.ml"
                                                            (key *          _ )  tree  
# 94 "RandomAccess.frag.ml"
                                               =
  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"
           
  (t)  
# 101 "RandomAccess.frag.ml"
                  with
    | 
# 102 "RandomAccess.frag.ml"
       
  TLeaf  
# 102 "RandomAccess.frag.ml"
           ->
        assert false
    | 
# 104 "RandomAccess.frag.ml"
       
  TNode { l = l; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
        
# 105 "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 : 
# 115 "RandomAccess.frag.ml"
                               (key *          _ )  tree 
# 115 "RandomAccess.frag.ml"
                 ) (i : int) : 
# 115 "RandomAccess.frag.ml"
                                                 (key *          _ )  tree  
# 115 "RandomAccess.frag.ml"
                                    * 
# 115 "RandomAccess.frag.ml"
                                                        (key *          _ )  tree  
# 115 "RandomAccess.frag.ml"
                                           =
  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 : 
# 130 "RandomAccess.frag.ml"
                                           (key *          _ )  tree 
# 130 "RandomAccess.frag.ml"
                             ) (i : int) : 
# 130 "RandomAccess.frag.ml"
                                                             (key *          _ )  tree  
# 130 "RandomAccess.frag.ml"
                                                * 
# 130 "RandomAccess.frag.ml"
                                                            (key *          _ )  
# 130 "RandomAccess.frag.ml"
                                                      * 
# 130 "RandomAccess.frag.ml"
                                                                          (key *          _ )  tree  
# 130 "RandomAccess.frag.ml"
                                                             =
  assert (0 <= i && i < cardinal t);
  match 
# 132 "RandomAccess.frag.ml"
         
  (t)  
# 132 "RandomAccess.frag.ml"
                with
  | 
# 133 "RandomAccess.frag.ml"
     
  TLeaf  
# 133 "RandomAccess.frag.ml"
         ->
      assert false
  | 
# 135 "RandomAccess.frag.ml"
     
  TNode { l = l; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
      
# 136 "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 : 
# 146 "RandomAccess.frag.ml"
                                       (key *          _ )  tree 
# 146 "RandomAccess.frag.ml"
                         ) (i : int) : 
# 146 "RandomAccess.frag.ml"
                                                         (key *          _ )  tree  
# 146 "RandomAccess.frag.ml"
                                            * 
# 146 "RandomAccess.frag.ml"
                                                        (key *          _ )  
# 146 "RandomAccess.frag.ml"
                                                  * 
# 146 "RandomAccess.frag.ml"
                                                                      (key *          _ )  tree  
# 146 "RandomAccess.frag.ml"
                                                         =
  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 : 
# 13 "Iter.frag.ml"
                                      (key *          _ )  tree 
# 13 "Iter.frag.ml"
                        ) =
  match 
# 14 "Iter.frag.ml"
         
  (t)  
# 14 "Iter.frag.ml"
                with
  | 
# 15 "Iter.frag.ml"
     
  TLeaf  
# 15 "Iter.frag.ml"
         ->
      ()
  | 
# 17 "Iter.frag.ml"
     
  TNode { l = l; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
      
# 18 "Iter.frag.ml"
      iter f l; 
# 18 "Iter.frag.ml"
                     (let (_k, _d) =  v in f _k _d) 
# 18 "Iter.frag.ml"
                           ; iter f r

let rec fold f (t : 
# 20 "Iter.frag.ml"
                                      (key *          _ )  tree 
# 20 "Iter.frag.ml"
                        ) accu =
  match 
# 21 "Iter.frag.ml"
         
  (t)  
# 21 "Iter.frag.ml"
                with
  | 
# 22 "Iter.frag.ml"
     
  TLeaf  
# 22 "Iter.frag.ml"
         ->
      accu
  | 
# 24 "Iter.frag.ml"
     
  TNode { l = l; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
      
# 25 "Iter.frag.ml"
      fold f r (
# 25 "Iter.frag.ml"
                 (let (_k, _d) =  v in f _k _d ( fold f l accu)) 
# 25 "Iter.frag.ml"
                                           )

let rec for_all p (t : 
# 27 "Iter.frag.ml"
                                         (key *          _ )  tree 
# 27 "Iter.frag.ml"
                           ) =
  match 
# 28 "Iter.frag.ml"
         
  (t)  
# 28 "Iter.frag.ml"
                with
  | 
# 29 "Iter.frag.ml"
     
  TLeaf  
# 29 "Iter.frag.ml"
         ->
      true
  | 
# 31 "Iter.frag.ml"
     
  TNode { l = l; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
      
# 32 "Iter.frag.ml"
           (let (_k, _d) =  v in p _k _d)  
# 32 "Iter.frag.ml"
                  && for_all p l && for_all p r

let rec exists p (t : 
# 34 "Iter.frag.ml"
                                        (key *          _ )  tree 
# 34 "Iter.frag.ml"
                          ) =
  match 
# 35 "Iter.frag.ml"
         
  (t)  
# 35 "Iter.frag.ml"
                with
  | 
# 36 "Iter.frag.ml"
     
  TLeaf  
# 36 "Iter.frag.ml"
         ->
      false
  | 
# 38 "Iter.frag.ml"
     
  TNode { l = l; k = _k; d = _d; r =  r; _ } -> 
    let  v = (_k, _d) in 
      
# 39 "Iter.frag.ml"
           (let (_k, _d) =  v in p _k _d)  
# 39 "Iter.frag.ml"
                  || exists p l || exists p r


# 143 "UpperLayer.frag.ml"
(* Our internal function [singleton] expects a pair [(k, d)], but the
   public function [singleton] expects separate arguments [k] and [d]. *)

let[@inline] singleton k d =
  singleton (k, d)

(* In the map API, [to_list] is published under the name [bindings]. *)

let bindings = to_list


# 155 "UpperLayer.frag.ml"
(* -------------------------------------------------------------------------- *)

  
# 41 "W.cppo.ml"
  end
end


module[@inline] Make (E : OrderedType) = struct

  module Set = Set.Make(E)
  module Map = Map.Make(E)

  (* Because we have access to the concrete view of sets and maps, and because
     we know that sets and maps use the same balancing scheme, we can copy the
     balancing information (that is, the field [w]). We save the cost of
     recomputing this information at each node. *)

  (* Because we use concrete data constructors (as opposed to smart
     constructor functions), we can annotate these recursive functions with
     [@tail_mod_cons], which presumably makes them faster. *)

  let[@tail_mod_cons] rec domain m =
    match m with
    | WeightMap.TLeaf ->
        WeightSet.TLeaf
    | WeightMap.TNode { l; k; d; r; w } ->
        ignore d;
        let l = domain l in
        let v = k in
        WeightSet.TNode { l; v; r = domain r; w }

  let[@tail_mod_cons] rec lift f s =
    match s with
    | WeightSet.TLeaf ->
        WeightMap.TLeaf
    | WeightSet.TNode { l; v; r; w } ->
        (* Enforce left-to-right evaluation order. *)
        let l = lift f l in
        let k = v in
        let d = f k in
        WeightMap.TNode { l; k; d; r = lift f r; w }

end