sig
  module OOChannel :
    sig
      class type ['a] obj_input_channel =
        object method close_in : unit -> unit method get : unit -> 'end
      class type ['a] obj_output_channel =
        object
          method close_out : unit -> unit
          method flush : unit -> unit
          method put : '-> unit
        end
      class ['a] channel_of_stream : 'Stream.t -> ['a] obj_input_channel
      val stream_of_channel : '#obj_input_channel -> 'Stream.t
      class type char_input_channel =
        object
          method close_in : unit -> unit
          method input : string -> int -> int -> int
        end
      class type char_output_channel =
        object
          method close_out : unit -> unit
          method flush : unit -> unit
          method output : string -> int -> int -> int
        end
      class char_input_channel_of :
        char #obj_input_channel -> char_input_channel
      class char_obj_input_channel_of :
        char_input_channel -> [char] obj_input_channel
      class char_output_channel_of :
        char #obj_output_channel -> char_output_channel
      class char_obj_output_channel_of :
        char_output_channel -> [char] obj_output_channel
      class of_in_channel : in_channel -> char_input_channel
      class of_out_channel : out_channel -> char_output_channel
    end
  module UChar :
    sig
      type t = CamomileLibrary.UChar.t
      exception Out_of_range
      val char_of : t -> char
      val of_char : char -> t
      val code : t -> int
      val chr : int -> t
      external uint_code : t -> int = "%identity"
      val chr_of_uint : int -> t
      val eq : t -> t -> bool
      val compare : t -> t -> int
      type uchar = t
      val int_of : uchar -> int
      val of_int : int -> uchar
    end
  module USet :
    sig
      type t = CamomileLibrary.USet.t
      val empty : t
      val is_empty : t -> bool
      val mem : CamomileLibrary.UChar.t -> t -> bool
      val add : CamomileLibrary.UChar.t -> t -> t
      val add_range :
        CamomileLibrary.UChar.t -> CamomileLibrary.UChar.t -> t -> t
      val singleton : CamomileLibrary.UChar.t -> t
      val remove : CamomileLibrary.UChar.t -> t -> t
      val remove_range :
        CamomileLibrary.UChar.t -> CamomileLibrary.UChar.t -> t -> t
      val union : t -> t -> t
      val inter : t -> t -> t
      val diff : t -> t -> t
      val compl : t -> t
      val compare : t -> t -> int
      val equal : t -> t -> bool
      val subset : t -> t -> bool
      val from : CamomileLibrary.UChar.t -> t -> t
      val after : CamomileLibrary.UChar.t -> t -> t
      val until : CamomileLibrary.UChar.t -> t -> t
      val before : CamomileLibrary.UChar.t -> t -> t
      val iter : (CamomileLibrary.UChar.t -> unit) -> t -> unit
      val iter_range :
        (CamomileLibrary.UChar.t -> CamomileLibrary.UChar.t -> unit) ->
        t -> unit
      val fold : (CamomileLibrary.UChar.t -> '-> 'a) -> t -> '-> 'a
      val fold_range :
        (CamomileLibrary.UChar.t -> CamomileLibrary.UChar.t -> '-> 'a) ->
        t -> '-> 'a
      val for_all : (CamomileLibrary.UChar.t -> bool) -> t -> bool
      val exists : (CamomileLibrary.UChar.t -> bool) -> t -> bool
      val filter : (CamomileLibrary.UChar.t -> bool) -> t -> t
      val partition : (CamomileLibrary.UChar.t -> bool) -> t -> t * t
      val cardinal : t -> int
      val elements : t -> CamomileLibrary.UChar.t list
      val ranges :
        t -> (CamomileLibrary.UChar.t * CamomileLibrary.UChar.t) list
      val min_elt : t -> CamomileLibrary.UChar.t
      val max_elt : t -> CamomileLibrary.UChar.t
      val choose : t -> CamomileLibrary.UChar.t
      val uset_of_iset : ISet.t -> t
      val iset_of_uset : t -> ISet.t
    end
  module UMap :
    sig
      type 'a t = 'CamomileLibrary.UMap.t
      val empty : 'a t
      val is_empty : 'a t -> bool
      val add :
        ?eq:('-> '-> bool) ->
        CamomileLibrary.UChar.t -> '-> 'a t -> 'a t
      val add_range :
        ?eq:('-> '-> bool) ->
        CamomileLibrary.UChar.t ->
        CamomileLibrary.UChar.t -> '-> 'a t -> 'a t
      val find : CamomileLibrary.UChar.t -> 'a t -> 'a
      val remove : CamomileLibrary.UChar.t -> 'a t -> 'a t
      val remove_range :
        CamomileLibrary.UChar.t -> CamomileLibrary.UChar.t -> 'a t -> 'a t
      val from : CamomileLibrary.UChar.t -> 'a t -> 'a t
      val after : CamomileLibrary.UChar.t -> 'a t -> 'a t
      val until : CamomileLibrary.UChar.t -> 'a t -> 'a t
      val before : CamomileLibrary.UChar.t -> 'a t -> 'a t
      val mem : CamomileLibrary.UChar.t -> 'a t -> bool
      val iter : (CamomileLibrary.UChar.t -> '-> unit) -> 'a t -> unit
      val iter_range :
        (CamomileLibrary.UChar.t -> CamomileLibrary.UChar.t -> '-> unit) ->
        'a t -> unit
      val map : ?eq:('-> '-> bool) -> ('-> 'a) -> 'b t -> 'a t
      val mapi :
        ?eq:('-> '-> bool) ->
        (CamomileLibrary.UChar.t -> '-> 'a) -> 'b t -> 'a t
      val fold :
        (CamomileLibrary.UChar.t -> '-> '-> 'b) -> 'a t -> '-> 'b
      val fold_range :
        (CamomileLibrary.UChar.t -> CamomileLibrary.UChar.t -> '-> '-> 'b) ->
        'a t -> '-> 'b
      val set_to_map : CamomileLibrary.USet.t -> '-> 'a t
      val domain : 'a t -> CamomileLibrary.USet.t
      val map_to_set : ('-> bool) -> 'a t -> CamomileLibrary.USet.t
      val umap_of_imap : 'IMap.t -> 'a t
      val imap_of_umap : 'a t -> 'IMap.t
    end
  module UCharTbl :
    sig
      type 'a tbl = 'CamomileLibrary.UCharTbl.tbl
      type 'a t = 'a tbl
      val get : 'a tbl -> CamomileLibrary.UChar.t -> 'a
      module type Type =
        sig
          type elt
          type t = elt tbl
          val get : elt tbl -> CamomileLibrary.UChar.t -> elt
          val of_map : elt -> elt CamomileLibrary.UMap.t -> t
        end
      module Make :
        functor (H : Hashtbl.HashedType->
          sig
            type elt = H.t
            type t = elt tbl
            val get : elt tbl -> CamomileLibrary.UChar.t -> elt
            val of_map : elt -> elt CamomileLibrary.UMap.t -> t
          end
      module Bool :
        sig
          type t = CamomileLibrary.UCharTbl.Bool.t
          val get : t -> CamomileLibrary.UChar.t -> bool
          val of_set : CamomileLibrary.USet.t -> t
        end
      module Bits :
        sig
          type t = CamomileLibrary.UCharTbl.Bits.t
          val of_map : int -> int CamomileLibrary.UMap.t -> t
          val get : t -> CamomileLibrary.UChar.t -> int
        end
      module Bytes :
        sig
          type t = CamomileLibrary.UCharTbl.Bytes.t
          val of_map : int -> int CamomileLibrary.UMap.t -> t
          val get : t -> CamomileLibrary.UChar.t -> int
        end
      module Char :
        sig
          type t = CamomileLibrary.UCharTbl.Char.t
          val of_map : char -> char CamomileLibrary.UMap.t -> t
          val get : t -> CamomileLibrary.UChar.t -> char
        end
    end
  module UnicodeString :
    sig
      module type Type =
        sig
          type t
          val get : t -> int -> CamomileLibrary.UChar.t
          val init : int -> (int -> CamomileLibrary.UChar.t) -> t
          val length : t -> int
          type index
          val look : t -> index -> CamomileLibrary.UChar.t
          val nth : t -> int -> index
          val next : t -> index -> index
          val prev : t -> index -> index
          val out_of_range : t -> index -> bool
          val iter : (CamomileLibrary.UChar.t -> unit) -> t -> unit
          val compare : t -> t -> int
          val first : t -> index
          val last : t -> index
          val move : t -> index -> int -> index
          val compare_index : t -> index -> index -> int
          module Buf :
            sig
              type buf
              val create : int -> buf
              val contents : buf -> t
              val clear : buf -> unit
              val reset : buf -> unit
              val add_char : buf -> CamomileLibrary.UChar.t -> unit
              val add_string : buf -> t -> unit
              val add_buffer : buf -> buf -> unit
            end
        end
    end
  module UText :
    sig
      type mutability = [ `Immutable | `Mutable ]
      type 'a text = 'CamomileLibrary.UText.text
      type utext = [ `Immutable ] text
      type ustring = [ `Mutable ] text
      type t = utext
      val utext_of_ustring : ustring -> utext
      val ustring_of_utext : utext -> ustring
      val get : 'a text -> int -> CamomileLibrary.UChar.t
      val set : ustring -> int -> CamomileLibrary.UChar.t -> unit
      type index = CamomileLibrary.UText.index
      val look : 'a text -> index -> CamomileLibrary.UChar.t
      val nth : 'a text -> int -> index
      val first : 'a text -> index
      val last : 'a text -> index
      val out_of_range : 'a text -> index -> bool
      val compare_index : 'a text -> index -> index -> int
      val next : 'a text -> index -> index
      val prev : 'a text -> index -> index
      val move : 'a text -> index -> int -> index
      val length : 'a text -> int
      val of_string : string -> utext
      val init : int -> (int -> CamomileLibrary.UChar.t) -> utext
      val init_ustring : int -> (int -> CamomileLibrary.UChar.t) -> ustring
      val make : int -> CamomileLibrary.UChar.t -> ustring
      val copy : ustring -> ustring
      val sub : 'a text -> int -> int -> 'a text
      val fill : ustring -> int -> int -> CamomileLibrary.UChar.t -> unit
      val blit : 'a text -> int -> ustring -> int -> int -> unit
      val append : 'a text -> 'b text -> 'a text
      val iter : (CamomileLibrary.UChar.t -> unit) -> 'a text -> unit
      val compare : 'a text -> 'b text -> int
      module Buf :
        sig
          type buf = CamomileLibrary.UText.Buf.buf
          val create : int -> buf
          val contents : buf -> t
          val contents_string : buf -> ustring
          val length : buf -> int
          val clear : buf -> unit
          val reset : buf -> unit
          val add_char : buf -> CamomileLibrary.UChar.t -> unit
          val add_string : buf -> 'a text -> unit
          val add_buffer : buf -> buf -> unit
        end
    end
  module XString :
    sig
      type xstring = CamomileLibrary.XString.xstring
      type t = xstring
      val get : xstring -> int -> CamomileLibrary.UChar.t
      val set : xstring -> int -> CamomileLibrary.UChar.t -> unit
      val length : xstring -> int
      val init : int -> (int -> CamomileLibrary.UChar.t) -> xstring
      type index = CamomileLibrary.XString.index
      val look : xstring -> index -> CamomileLibrary.UChar.t
      val nth : xstring -> int -> index
      val first : xstring -> index
      val last : xstring -> index
      val out_of_range : xstring -> index -> bool
      val next : xstring -> index -> index
      val prev : xstring -> index -> index
      val move : xstring -> index -> int -> index
      val compare_index : xstring -> index -> index -> int
      val make : ?bufsize:int -> int -> CamomileLibrary.UChar.t -> xstring
      val clear : xstring -> unit
      val reset : xstring -> unit
      val copy : xstring -> xstring
      val sub : xstring -> int -> int -> xstring
      val add_char : xstring -> CamomileLibrary.UChar.t -> unit
      val add_text : xstring -> 'CamomileLibrary.UText.text -> unit
      val add_xstring : xstring -> xstring -> unit
      val shrink : xstring -> int -> unit
      val append : xstring -> xstring -> xstring
      val utext_of : xstring -> CamomileLibrary.UText.t
      val ustring_of : xstring -> CamomileLibrary.UText.ustring
      val iter : (CamomileLibrary.UChar.t -> unit) -> xstring -> unit
      val compare : t -> t -> int
      module Buf :
        sig
          type buf = CamomileLibrary.XString.Buf.buf
          val create : int -> buf
          val contents : buf -> t
          val length : buf -> int
          val clear : buf -> unit
          val reset : buf -> unit
          val add_char : buf -> CamomileLibrary.UChar.t -> unit
          val add_string : buf -> t -> unit
          val add_buffer : buf -> buf -> unit
        end
    end
  module SubText :
    sig
      module type Type =
        sig
          type t
          val get : t -> int -> CamomileLibrary.UChar.t
          val init : int -> (int -> CamomileLibrary.UChar.t) -> t
          val length : t -> int
          type index
          val look : t -> index -> CamomileLibrary.UChar.t
          val nth : t -> int -> index
          val first : t -> index
          val last : t -> index
          val next : t -> index -> index
          val prev : t -> index -> index
          val move : t -> index -> int -> index
          val out_of_range : t -> index -> bool
          val compare_index : t -> index -> index -> int
          val iter : (CamomileLibrary.UChar.t -> unit) -> t -> unit
          val compare : t -> t -> int
          module Buf :
            sig
              type buf
              val create : int -> buf
              val contents : buf -> t
              val clear : buf -> unit
              val reset : buf -> unit
              val add_char : buf -> CamomileLibrary.UChar.t -> unit
              val add_string : buf -> t -> unit
              val add_buffer : buf -> buf -> unit
            end
          type ur_text
          type ur_index
          val refer : ur_text -> ur_index -> ur_index -> t
          val excerpt : t -> ur_text
          val context : t -> ur_text * ur_index * ur_index
          val ur_index_of : t -> index -> ur_index
        end
      module Make :
        functor (Text : CamomileLibrary.UnicodeString.Type->
          sig
            type t = CamomileLibrary.SubText.Make(Text).t
            val get : t -> int -> CamomileLibrary.UChar.t
            val init : int -> (int -> CamomileLibrary.UChar.t) -> t
            val length : t -> int
            type index = CamomileLibrary.SubText.Make(Text).index
            val look : t -> index -> CamomileLibrary.UChar.t
            val nth : t -> int -> index
            val first : t -> index
            val last : t -> index
            val next : t -> index -> index
            val prev : t -> index -> index
            val move : t -> index -> int -> index
            val out_of_range : t -> index -> bool
            val compare_index : t -> index -> index -> int
            val iter : (CamomileLibrary.UChar.t -> unit) -> t -> unit
            val compare : t -> t -> int
            module Buf :
              sig
                type buf = CamomileLibrary.SubText.Make(Text).Buf.buf
                val create : int -> buf
                val contents : buf -> t
                val clear : buf -> unit
                val reset : buf -> unit
                val add_char : buf -> CamomileLibrary.UChar.t -> unit
                val add_string : buf -> t -> unit
                val add_buffer : buf -> buf -> unit
              end
            type ur_text = Text.t
            type ur_index = Text.index
            val refer : ur_text -> ur_index -> ur_index -> t
            val excerpt : t -> ur_text
            val context : t -> ur_text * ur_index * ur_index
            val ur_index_of : t -> index -> ur_index
          end
    end
  module ULine :
    sig
      type separator = [ `CR | `CRLF | `LF | `LS | `NEL | `PS ]
      class input :
        separator ->
        CamomileLibrary.UChar.t #CamomileLibrary.OOChannel.obj_input_channel ->
        [CamomileLibrary.UChar.t] CamomileLibrary.OOChannel.obj_input_channel
      class output :
        separator ->
        CamomileLibrary.UChar.t #CamomileLibrary.OOChannel.obj_output_channel ->
        [CamomileLibrary.UChar.t]
        CamomileLibrary.OOChannel.obj_output_channel
      module type Type =
        sig
          type text
          class input_line :
            CamomileLibrary.UChar.t
            #CamomileLibrary.OOChannel.obj_input_channel ->
            [text] CamomileLibrary.OOChannel.obj_input_channel
          class output_line :
            ?sp:separator ->
            CamomileLibrary.UChar.t
            #CamomileLibrary.OOChannel.obj_output_channel ->
            [text] CamomileLibrary.OOChannel.obj_output_channel
        end
      module Make :
        functor (Text : CamomileLibrary.UnicodeString.Type->
          sig
            type text = Text.t
            class input_line :
              CamomileLibrary.UChar.t
              #CamomileLibrary.OOChannel.obj_input_channel ->
              [text] CamomileLibrary.OOChannel.obj_input_channel
            class output_line :
              ?sp:separator ->
              CamomileLibrary.UChar.t
              #CamomileLibrary.OOChannel.obj_output_channel ->
              [text] CamomileLibrary.OOChannel.obj_output_channel
          end
    end
  module Locale :
    sig
      type t = string
      val read : string -> string -> (in_channel -> 'a) -> string -> 'a
      val contain : string -> string -> bool
    end
  module CharEncoding :
    sig
      exception Malformed_code
      exception Out_of_range
      type t = CamomileLibrary.CharEncoding.Configure(Config).t
      val automatic : string -> t list -> t -> t
      val new_enc : string -> t -> unit
      val alias : string -> string -> unit
      val of_name : string -> t
      val name_of : t -> string
      val ascii : t
      val latin1 : t
      val utf8 : t
      val utf16 : t
      val utf16be : t
      val utf16le : t
      val utf32 : t
      val utf32be : t
      val utf32le : t
      val ucs4 : t
      val recode_string : in_enc:t -> out_enc:t -> string -> string
      class uchar_input_channel_of :
        t ->
        CamomileLibrary.OOChannel.char_input_channel ->
        [CamomileLibrary.UChar.t] CamomileLibrary.OOChannel.obj_input_channel
      class uchar_output_channel_of :
        t ->
        CamomileLibrary.OOChannel.char_output_channel ->
        [CamomileLibrary.UChar.t]
        CamomileLibrary.OOChannel.obj_output_channel
      class convert_uchar_input :
        t ->
        CamomileLibrary.UChar.t CamomileLibrary.OOChannel.obj_input_channel ->
        CamomileLibrary.OOChannel.char_input_channel
      class convert_uchar_output :
        t ->
        CamomileLibrary.UChar.t CamomileLibrary.OOChannel.obj_output_channel ->
        CamomileLibrary.OOChannel.char_output_channel
      class convert_input :
        in_enc:t ->
        out_enc:t ->
        CamomileLibrary.OOChannel.char_input_channel ->
        CamomileLibrary.OOChannel.char_input_channel
      class convert_output :
        in_enc:t ->
        out_enc:t ->
        CamomileLibrary.OOChannel.char_output_channel ->
        CamomileLibrary.OOChannel.char_output_channel
      class out_channel :
        t ->
        out_channel ->
        [CamomileLibrary.UChar.t]
        CamomileLibrary.OOChannel.obj_output_channel
      class in_channel :
        t ->
        in_channel ->
        [CamomileLibrary.UChar.t] CamomileLibrary.OOChannel.obj_input_channel
      val ustream_of : t -> char Stream.t -> CamomileLibrary.UChar.t Stream.t
      val char_stream_of :
        t -> CamomileLibrary.UChar.t Stream.t -> char Stream.t
      module type Type =
        sig
          type text
          val decode : t -> string -> text
          val encode : t -> text -> string
        end
      module Make :
        functor (Text : CamomileLibrary.UnicodeString.Type->
          sig
            type text = Text.t
            val decode : t -> string -> text
            val encode : t -> text -> string
          end
    end
  module UTF8 :
    sig
      type t = string
      exception Malformed_code
      val validate : t -> unit
      val get : t -> int -> CamomileLibrary.UChar.t
      val init : int -> (int -> CamomileLibrary.UChar.t) -> t
      val length : t -> int
      type index = int
      val nth : t -> int -> index
      val first : t -> index
      val last : t -> index
      val look : t -> index -> CamomileLibrary.UChar.t
      val out_of_range : t -> index -> bool
      val compare_index : t -> index -> index -> int
      val next : t -> index -> index
      val prev : t -> index -> index
      val move : t -> index -> int -> index
      val iter : (CamomileLibrary.UChar.t -> unit) -> t -> unit
      val compare : t -> t -> int
      module Buf :
        sig
          type buf = Buffer.t
          val create : int -> buf
          val contents : buf -> t
          val clear : buf -> unit
          val reset : buf -> unit
          val add_char : buf -> CamomileLibrary.UChar.t -> unit
          val add_string : buf -> t -> unit
          val add_buffer : buf -> buf -> unit
        end
    end
  module UTF16 :
    sig
      type t =
          (int, Bigarray.int16_unsigned_elt, Bigarray.c_layout)
          Bigarray.Array1.t
      exception Malformed_code
      val validate : t -> unit
      val get : t -> int -> CamomileLibrary.UChar.t
      exception Out_of_range
      val init : int -> (int -> CamomileLibrary.UChar.t) -> t
      val length : t -> int
      type index = int
      val nth : t -> int -> index
      val first : t -> index
      val last : t -> index
      val look : t -> index -> CamomileLibrary.UChar.t
      val out_of_range : t -> index -> bool
      val compare_index : t -> index -> index -> int
      val next : t -> index -> index
      val prev : t -> index -> index
      val move : t -> index -> int -> index
      val iter : (CamomileLibrary.UChar.t -> unit) -> t -> unit
      val compare : t -> t -> int
      module Buf :
        sig
          type buf = CamomileLibrary.UTF16.Buf.buf
          val create : int -> buf
          val contents : buf -> t
          val clear : buf -> unit
          val reset : buf -> unit
          val add_char : buf -> CamomileLibrary.UChar.t -> unit
          val add_string : buf -> t -> unit
          val add_buffer : buf -> buf -> unit
        end
    end
  module UCS4 :
    sig
      type t =
          (int32, Bigarray.int32_elt, Bigarray.c_layout) Bigarray.Array1.t
      exception Malformed_code
      val validate : t -> unit
      val get : t -> int -> CamomileLibrary.UChar.t
      val init : int -> (int -> CamomileLibrary.UChar.t) -> t
      val length : t -> int
      type index = int
      val nth : t -> int -> index
      val first : t -> index
      val last : t -> index
      val look : t -> index -> CamomileLibrary.UChar.t
      val out_of_range : t -> index -> bool
      val compare_index : t -> index -> index -> int
      val next : t -> index -> index
      val prev : t -> index -> index
      val move : t -> index -> int -> index
      val iter : (CamomileLibrary.UChar.t -> unit) -> t -> unit
      val compare : t -> t -> int
      module Buf :
        sig
          type buf = CamomileLibrary.UCS4.Buf.buf
          val create : int -> buf
          val contents : buf -> t
          val clear : buf -> unit
          val reset : buf -> unit
          val add_char : buf -> CamomileLibrary.UChar.t -> unit
          val add_string : buf -> t -> unit
          val add_buffer : buf -> buf -> unit
        end
    end
  module UPervasives :
    sig
      type uchar = CamomileLibrary.UChar.t
      val int_of_uchar : uchar -> int
      val uchar_of_int : int -> uchar
      val escaped_uchar : uchar -> string
      val escaped_utf8 : string -> string
      val printer_utf8 : Format.formatter -> string -> unit
      val printer_uchar : Format.formatter -> uchar -> unit
    end
  module URe :
    sig
      type regexp =
          [ `After of regexp
          | `Alt of regexp * regexp
          | `Before of regexp
          | `BoS
          | `EoS
          | `Epsilon
          | `Group of regexp
          | `OneChar
          | `Rep of regexp
          | `Repn of regexp * int * int option
          | `Seq of regexp * regexp
          | `Set of CamomileLibrary.USet.t
          | `String of CamomileLibrary.UChar.t list ]
      type match_semantics = [ `First | `Longest | `Shortest ]
      val no_group : regexp -> regexp
      module type Type =
        sig
          type text
          type index
          type compiled_regexp
          module SubText :
            sig
              type t
              val get : t -> int -> CamomileLibrary.UChar.t
              val init : int -> (int -> CamomileLibrary.UChar.t) -> t
              val length : t -> int
              type index
              val look : t -> index -> CamomileLibrary.UChar.t
              val nth : t -> int -> index
              val first : t -> index
              val last : t -> index
              val next : t -> index -> index
              val prev : t -> index -> index
              val move : t -> index -> int -> index
              val out_of_range : t -> index -> bool
              val compare_index : t -> index -> index -> int
              val iter : (CamomileLibrary.UChar.t -> unit) -> t -> unit
              val compare : t -> t -> int
              module Buf :
                sig
                  type buf
                  val create : int -> buf
                  val contents : buf -> t
                  val clear : buf -> unit
                  val reset : buf -> unit
                  val add_char : buf -> CamomileLibrary.UChar.t -> unit
                  val add_string : buf -> t -> unit
                  val add_buffer : buf -> buf -> unit
                end
              type ur_text = text
              type ur_index = index
              val refer : ur_text -> ur_index -> ur_index -> t
              val excerpt : t -> ur_text
              val context : t -> ur_text * ur_index * ur_index
              val ur_index_of : t -> index -> ur_index
            end
          val compile : regexp -> compiled_regexp
          val regexp_match :
            ?sem:match_semantics ->
            compiled_regexp -> text -> index -> SubText.t option array option
          val string_match : compiled_regexp -> text -> index -> bool
          val search_forward :
            ?sem:match_semantics ->
            compiled_regexp -> text -> index -> SubText.t option array option
        end
      module Make :
        functor (Text : CamomileLibrary.UnicodeString.Type->
          sig
            type text = Text.t
            type index = Text.index
            type compiled_regexp =
                CamomileLibrary.URe.Make(Text).compiled_regexp
            module SubText :
              sig
                type t = CamomileLibrary.URe.Make(Text).SubText.t
                val get : t -> int -> CamomileLibrary.UChar.t
                val init : int -> (int -> CamomileLibrary.UChar.t) -> t
                val length : t -> int
                type index = CamomileLibrary.URe.Make(Text).SubText.index
                val look : t -> index -> CamomileLibrary.UChar.t
                val nth : t -> int -> index
                val first : t -> index
                val last : t -> index
                val next : t -> index -> index
                val prev : t -> index -> index
                val move : t -> index -> int -> index
                val out_of_range : t -> index -> bool
                val compare_index : t -> index -> index -> int
                val iter : (CamomileLibrary.UChar.t -> unit) -> t -> unit
                val compare : t -> t -> int
                module Buf :
                  sig
                    type buf = CamomileLibrary.URe.Make(Text).SubText.Buf.buf
                    val create : int -> buf
                    val contents : buf -> t
                    val clear : buf -> unit
                    val reset : buf -> unit
                    val add_char : buf -> CamomileLibrary.UChar.t -> unit
                    val add_string : buf -> t -> unit
                    val add_buffer : buf -> buf -> unit
                  end
                type ur_text = text
                type ur_index = index
                val refer : ur_text -> ur_index -> ur_index -> t
                val excerpt : t -> ur_text
                val context : t -> ur_text * ur_index * ur_index
                val ur_index_of : t -> index -> ur_index
              end
            val compile : regexp -> compiled_regexp
            val regexp_match :
              ?sem:match_semantics ->
              compiled_regexp ->
              text -> index -> SubText.t option array option
            val string_match : compiled_regexp -> text -> index -> bool
            val search_forward :
              ?sem:match_semantics ->
              compiled_regexp ->
              text -> index -> SubText.t option array option
          end
    end
  module UCharInfo :
    sig
      type general_category_type =
          [ `Cc
          | `Cf
          | `Cn
          | `Co
          | `Cs
          | `Ll
          | `Lm
          | `Lo
          | `Lt
          | `Lu
          | `Mc
          | `Me
          | `Mn
          | `Nd
          | `Nl
          | `No
          | `Pc
          | `Pd
          | `Pe
          | `Pf
          | `Pi
          | `Po
          | `Ps
          | `Sc
          | `Sk
          | `Sm
          | `So
          | `Zl
          | `Zp
          | `Zs ]
      val general_category : CamomileLibrary.UChar.t -> general_category_type
      val load_general_category_map :
        unit -> general_category_type CamomileLibrary.UMap.t
      type character_property_type =
          [ `Alphabetic
          | `Ascii_Hex_Digit
          | `Bidi_Control
          | `Default_Ignorable_Code_Point
          | `Deprecated
          | `Diacritic
          | `Extender
          | `Grapheme_Base
          | `Grapheme_Extend
          | `Grapheme_Link
          | `Hex_Digit
          | `Hyphen
          | `IDS_Binary_Operator
          | `IDS_Trinary_Operator
          | `ID_Continue
          | `ID_Start
          | `Ideographic
          | `Logical_Order_Exception
          | `Lowercase
          | `Math
          | `Noncharacter_Code_Point
          | `Other_Alphabetic
          | `Other_Grapheme_Extend
          | `Other_Lowercase
          | `Other_Math
          | `Other_Uppercase
          | `Other_default_Ignorable_Code_Point
          | `Quotation_Mark
          | `Radical
          | `Soft_Dotted
          | `Terminal_Punctuation
          | `Unified_Ideograph
          | `Uppercase
          | `White_Space
          | `XID_Continue
          | `XID_Start ]
      val load_property_tbl :
        character_property_type -> CamomileLibrary.UCharTbl.Bool.t
      val load_property_tbl_by_name :
        string -> CamomileLibrary.UCharTbl.Bool.t
      val load_property_set :
        character_property_type -> CamomileLibrary.USet.t
      val load_property_set_by_name : string -> CamomileLibrary.USet.t
      type script_type =
          [ `Arabic
          | `Armenian
          | `Bengali
          | `Bopomofo
          | `Buhid
          | `Canadian_Aboriginal
          | `Cherokee
          | `Common
          | `Cyrillic
          | `Deseret
          | `Devanagari
          | `Ethiopic
          | `Georgian
          | `Gothic
          | `Greek
          | `Gujarati
          | `Gurmukhi
          | `Han
          | `Hangul
          | `Hanunoo
          | `Hebrew
          | `Hiragana
          | `Inherited
          | `Kannada
          | `Katakana
          | `Khmer
          | `Lao
          | `Latin
          | `Malayalam
          | `Mongolian
          | `Myanmar
          | `Ogham
          | `Old_Italic
          | `Oriya
          | `Runic
          | `Sinhala
          | `Syriac
          | `Tagalog
          | `Tagbanwa
          | `Tamil
          | `Telugu
          | `Thaana
          | `Thai
          | `Tibetan
          | `Yi ]
      val script : CamomileLibrary.UChar.t -> script_type
      val load_script_map : unit -> script_type CamomileLibrary.UMap.t
      type version_type =
          [ `Nc | `v1_0 | `v1_1 | `v2_0 | `v2_1 | `v3_0 | `v3_1 | `v3_2 ]
      val age : CamomileLibrary.UChar.t -> version_type
      val older : version_type -> version_type -> bool
      val load_to_lower1_tbl :
        unit -> CamomileLibrary.UChar.t CamomileLibrary.UCharTbl.t
      val load_to_upper1_tbl :
        unit -> CamomileLibrary.UChar.t CamomileLibrary.UCharTbl.t
      val load_to_title1_tbl :
        unit -> CamomileLibrary.UChar.t CamomileLibrary.UCharTbl.t
      type casemap_condition =
          [ `AfterSoftDotted
          | `BeforeDot
          | `FinalSigma
          | `Locale of string
          | `MoreAbove
          | `Not of casemap_condition ]
      type special_casing_property =
        CamomileLibrary.UCharInfo.Make(Config).special_casing_property = {
        lower : CamomileLibrary.UChar.t list;
        title : CamomileLibrary.UChar.t list;
        upper : CamomileLibrary.UChar.t list;
        condition : casemap_condition list;
      }
      val load_conditional_casing_tbl :
        unit -> special_casing_property list CamomileLibrary.UCharTbl.t
      val load_casefolding_tbl :
        unit -> CamomileLibrary.UChar.t list CamomileLibrary.UCharTbl.t
      val combined_class : CamomileLibrary.UChar.t -> int
      type decomposition_type =
          [ `Canon
          | `Circle
          | `Compat
          | `Final
          | `Font
          | `Fraction
          | `Initial
          | `Isolated
          | `Medial
          | `Narrow
          | `NoBreak
          | `Small
          | `Square
          | `Sub
          | `Super
          | `Vertical
          | `Wide ]
      type decomposition_info =
          [ `Canonform
          | `Composite of decomposition_type * CamomileLibrary.UChar.t list
          | `HangulSyllable ]
      val load_decomposition_tbl :
        unit -> decomposition_info CamomileLibrary.UCharTbl.t
      val load_composition_tbl :
        unit ->
        (CamomileLibrary.UChar.t * CamomileLibrary.UChar.t) list
        CamomileLibrary.UCharTbl.t
      val load_composition_exclusion_tbl :
        unit -> CamomileLibrary.UCharTbl.Bool.t
    end
  module UNF :
    sig
      module type Type = CamomileLibrary.UNF.Type
      module Make :
        functor (Text : CamomileLibrary.UnicodeString.Type->
          sig
            type text = Text.t
            class nfd :
              CamomileLibrary.UChar.t
              #CamomileLibrary.OOChannel.obj_output_channel ->
              [CamomileLibrary.UChar.t]
              CamomileLibrary.OOChannel.obj_output_channel
            class nfc :
              CamomileLibrary.UChar.t
              #CamomileLibrary.OOChannel.obj_output_channel ->
              [CamomileLibrary.UChar.t]
              CamomileLibrary.OOChannel.obj_output_channel
            class nfkd :
              CamomileLibrary.UChar.t
              #CamomileLibrary.OOChannel.obj_output_channel ->
              [CamomileLibrary.UChar.t]
              CamomileLibrary.OOChannel.obj_output_channel
            class nfkc :
              CamomileLibrary.UChar.t
              #CamomileLibrary.OOChannel.obj_output_channel ->
              [CamomileLibrary.UChar.t]
              CamomileLibrary.OOChannel.obj_output_channel
            val nfd : text -> text
            val nfkd : text -> text
            val nfc : text -> text
            val nfkc : text -> text
            module NFCBuf :
              sig
                type buf = CamomileLibrary.UNF.Make(Config)(Text).NFCBuf.buf
                val create : int -> buf
                val contents : buf -> text
                val clear : buf -> unit
                val reset : buf -> unit
                val add_char : buf -> CamomileLibrary.UChar.t -> unit
                val add_string : buf -> text -> unit
                val add_buffer : buf -> buf -> unit
              end
            val nfc_append : text -> text -> text
            val put_nfd : CamomileLibrary.XString.t -> text -> unit
            val put_nfkd : CamomileLibrary.XString.t -> text -> unit
            val put_nfc : CamomileLibrary.XString.t -> text -> unit
            val put_nfkc : CamomileLibrary.XString.t -> text -> unit
            type index = Text.index
            val nfd_inc :
              text ->
              index ->
              ([ `Inc of CamomileLibrary.UChar.t list * index * 'a lazy_t ]
               as 'a)
            val canon_compare : text -> text -> int
            val nfd_decompose :
              CamomileLibrary.UChar.t -> CamomileLibrary.UChar.t list
            val nfkd_decompose :
              CamomileLibrary.UChar.t -> CamomileLibrary.UChar.t list
          end
    end
  module UCol :
    sig
      type variable_option =
          [ `Blanked | `Non_ignorable | `Shift_Trimmed | `Shifted ]
      type precision = [ `Primary | `Quaternary | `Secondary | `Tertiary ]
      module type Type = CamomileLibrary.UCol.Type
      module Make :
        functor (Text : CamomileLibrary.UnicodeString.Type->
          sig
            type text = Text.t
            type index = Text.index
            val compare :
              ?locale:string ->
              ?prec:CamomileLibrary.UCol.precision ->
              ?variable:CamomileLibrary.UCol.variable_option ->
              text -> text -> int
            val sort_key :
              ?locale:string ->
              ?prec:CamomileLibrary.UCol.precision ->
              ?variable:CamomileLibrary.UCol.variable_option ->
              text -> string
            val compare_with_key :
              ?locale:string ->
              ?prec:CamomileLibrary.UCol.precision ->
              ?variable:CamomileLibrary.UCol.variable_option ->
              string -> text -> int
            val search_with_key :
              ?locale:string ->
              ?prec:CamomileLibrary.UCol.precision ->
              ?variable:CamomileLibrary.UCol.variable_option ->
              string -> text -> index -> index * index
            val search :
              ?locale:string ->
              ?prec:CamomileLibrary.UCol.precision ->
              ?variable:CamomileLibrary.UCol.variable_option ->
              text -> text -> index -> index * index
          end
    end
  module CaseMap :
    sig
      module type Type = CamomileLibrary.CaseMap.Type
      module Make :
        functor (Text : CamomileLibrary.UnicodeString.Type->
          sig
            type text = Text.t
            val lowercase : ?locale:string -> text -> text
            val uppercase : ?locale:string -> text -> text
            val titlecase : ?locale:string -> text -> text
            val casefolding : text -> text
            val compare_caseless : text -> text -> int
          end
    end
  module UReStr :
    sig
      type regexp = CamomileLibrary.URe.regexp
      val regexp : string -> regexp
      val quote : string -> string
      val regexp_string : string -> regexp
      module type Type =
        sig
          type text
          type index
          type compiled_regexp
          module SubText :
            sig
              type t
              val get : t -> int -> CamomileLibrary.UChar.t
              val init : int -> (int -> CamomileLibrary.UChar.t) -> t
              val length : t -> int
              type index
              val look : t -> index -> CamomileLibrary.UChar.t
              val nth : t -> int -> index
              val first : t -> index
              val last : t -> index
              val next : t -> index -> index
              val prev : t -> index -> index
              val move : t -> index -> int -> index
              val out_of_range : t -> index -> bool
              val compare_index : t -> index -> index -> int
              val iter : (CamomileLibrary.UChar.t -> unit) -> t -> unit
              val compare : t -> t -> int
              module Buf :
                sig
                  type buf
                  val create : int -> buf
                  val contents : buf -> t
                  val clear : buf -> unit
                  val reset : buf -> unit
                  val add_char : buf -> CamomileLibrary.UChar.t -> unit
                  val add_string : buf -> t -> unit
                  val add_buffer : buf -> buf -> unit
                end
              type ur_text = text
              type ur_index = index
              val refer : ur_text -> ur_index -> ur_index -> t
              val excerpt : t -> ur_text
              val context : t -> ur_text * ur_index * ur_index
              val ur_index_of : t -> index -> ur_index
            end
          val compile : regexp -> compiled_regexp
          val regexp_match :
            ?sem:CamomileLibrary.URe.match_semantics ->
            compiled_regexp -> text -> index -> SubText.t option array option
          val string_match : compiled_regexp -> text -> index -> bool
          val search_forward :
            ?sem:CamomileLibrary.URe.match_semantics ->
            compiled_regexp -> text -> index -> SubText.t option array option
        end
      module Make :
        functor (Text : CamomileLibrary.UnicodeString.Type->
          sig
            type text = Text.t
            type index = Text.index
            type compiled_regexp =
                CamomileLibrary.UReStr.Configure(Config).Make(Text).compiled_regexp
            module SubText :
              sig
                type t =
                    CamomileLibrary.UReStr.Configure(Config).Make(Text).SubText.t
                val get : t -> int -> CamomileLibrary.UChar.t
                val init : int -> (int -> CamomileLibrary.UChar.t) -> t
                val length : t -> int
                type index =
                    CamomileLibrary.UReStr.Configure(Config).Make(Text).SubText.index
                val look : t -> index -> CamomileLibrary.UChar.t
                val nth : t -> int -> index
                val first : t -> index
                val last : t -> index
                val next : t -> index -> index
                val prev : t -> index -> index
                val move : t -> index -> int -> index
                val out_of_range : t -> index -> bool
                val compare_index : t -> index -> index -> int
                val iter : (CamomileLibrary.UChar.t -> unit) -> t -> unit
                val compare : t -> t -> int
                module Buf :
                  sig
                    type buf =
                        CamomileLibrary.UReStr.Configure(Config).Make(Text).SubText.Buf.buf
                    val create : int -> buf
                    val contents : buf -> t
                    val clear : buf -> unit
                    val reset : buf -> unit
                    val add_char : buf -> CamomileLibrary.UChar.t -> unit
                    val add_string : buf -> t -> unit
                    val add_buffer : buf -> buf -> unit
                  end
                type ur_text = text
                type ur_index = index
                val refer : ur_text -> ur_index -> ur_index -> t
                val excerpt : t -> ur_text
                val context : t -> ur_text * ur_index * ur_index
                val ur_index_of : t -> index -> ur_index
              end
            val compile : regexp -> compiled_regexp
            val regexp_match :
              ?sem:CamomileLibrary.URe.match_semantics ->
              compiled_regexp ->
              text -> index -> SubText.t option array option
            val string_match : compiled_regexp -> text -> index -> bool
            val search_forward :
              ?sem:CamomileLibrary.URe.match_semantics ->
              compiled_regexp ->
              text -> index -> SubText.t option array option
          end
    end
  module StringPrep :
    sig
      module type Type = CamomileLibrary.StringPrep.Type
      module Make :
        functor (Text : CamomileLibrary.UnicodeString.Type->
          sig
            type text = Text.t
            exception Prohibited of CamomileLibrary.UChar.t
            exception Bad_bidi
            type profile =
                [ `Iscsi
                | `Mib
                | `Nameprep
                | `Nodeprep
                | `Resourceprep
                | `Saslprep
                | `Trace ]
            val stringprep : profile -> text -> text
          end
    end
end