sig
  exception Ocsigen_Internal_Error of string
  exception Input_is_too_large
  exception Ocsigen_Bad_Request
  exception Ocsigen_Request_too_long
  val ( >>= ) : 'Lwt.t -> ('-> 'Lwt.t) -> 'Lwt.t
  val ( >|= ) : 'Lwt.t -> ('-> 'b) -> 'Lwt.t
  val ( !! ) : 'Lazy.t -> 'a
  val ( |> ) : '-> ('-> 'b) -> 'b
  val ( @@ ) : ('-> 'b) -> '-> 'b
  external id : '-> 'a = "%identity"
  val comp : ('-> 'b) -> ('-> 'a) -> '-> 'b
  val curry : ('a * '-> 'c) -> '-> '-> 'c
  val uncurry : ('-> '-> 'c) -> 'a * '-> 'c
  module Tuple3 :
    sig
      val fst : 'a * 'b * '-> 'a
      val snd : 'a * 'b * '-> 'b
      val thd : 'a * 'b * '-> 'c
    end
  type poly = Ocsigen_lib.poly
  val to_poly : '-> poly
  val from_poly : poly -> 'a
  type yesnomaybe = Ocsigen_lib_base.yesnomaybe = Yes | No | Maybe
  type ('a, 'b) leftright =
    ('a, 'b) Ocsigen_lib_base.leftright =
      Left of 'a
    | Right of 'b
  val advert : string
  module Option :
    sig
      type 'a t = 'a option
      val map : ('-> 'b) -> 'a t -> 'b t
      val get : (unit -> 'a) -> 'a t -> 'a
      val get' : '-> 'a t -> 'a
      val iter : ('-> unit) -> 'a t -> unit
      val return : '-> 'a t
      val bind : 'a t -> ('-> 'b t) -> 'b t
      val to_list : 'a t -> 'a list
      module Lwt :
        sig
          val map : ('-> 'Lwt.t) -> 'a t -> 'b t Lwt.t
          val get : (unit -> 'Lwt.t) -> 'a t -> 'Lwt.t
          val get' : 'Lwt.t -> 'a t -> 'Lwt.t
          val iter : ('-> unit Lwt.t) -> 'a t -> unit Lwt.t
          val bind : 'a t -> ('-> 'b t Lwt.t) -> 'b t Lwt.t
        end
    end
  module List :
    sig
      val length : 'a list -> int
      val hd : 'a list -> 'a
      val tl : 'a list -> 'a list
      val nth : 'a list -> int -> 'a
      val rev : 'a list -> 'a list
      val append : 'a list -> 'a list -> 'a list
      val rev_append : 'a list -> 'a list -> 'a list
      val concat : 'a list list -> 'a list
      val flatten : 'a list list -> 'a list
      val iter : ('-> unit) -> 'a list -> unit
      val iteri : (int -> '-> unit) -> 'a list -> unit
      val map : ('-> 'b) -> 'a list -> 'b list
      val mapi : (int -> '-> 'b) -> 'a list -> 'b list
      val rev_map : ('-> 'b) -> 'a list -> 'b list
      val fold_left : ('-> '-> 'a) -> '-> 'b list -> 'a
      val fold_right : ('-> '-> 'b) -> 'a list -> '-> 'b
      val iter2 : ('-> '-> unit) -> 'a list -> 'b list -> unit
      val map2 : ('-> '-> 'c) -> 'a list -> 'b list -> 'c list
      val rev_map2 : ('-> '-> 'c) -> 'a list -> 'b list -> 'c list
      val fold_left2 :
        ('-> '-> '-> 'a) -> '-> 'b list -> 'c list -> 'a
      val fold_right2 :
        ('-> '-> '-> 'c) -> 'a list -> 'b list -> '-> 'c
      val for_all : ('-> bool) -> 'a list -> bool
      val exists : ('-> bool) -> 'a list -> bool
      val for_all2 : ('-> '-> bool) -> 'a list -> 'b list -> bool
      val exists2 : ('-> '-> bool) -> 'a list -> 'b list -> bool
      val mem : '-> 'a list -> bool
      val memq : '-> 'a list -> bool
      val find : ('-> bool) -> 'a list -> 'a
      val filter : ('-> bool) -> 'a list -> 'a list
      val find_all : ('-> bool) -> 'a list -> 'a list
      val partition : ('-> bool) -> 'a list -> 'a list * 'a list
      val assoc : '-> ('a * 'b) list -> 'b
      val assq : '-> ('a * 'b) list -> 'b
      val mem_assoc : '-> ('a * 'b) list -> bool
      val mem_assq : '-> ('a * 'b) list -> bool
      val remove_assoc : '-> ('a * 'b) list -> ('a * 'b) list
      val remove_assq : '-> ('a * 'b) list -> ('a * 'b) list
      val split : ('a * 'b) list -> 'a list * 'b list
      val combine : 'a list -> 'b list -> ('a * 'b) list
      val sort : ('-> '-> int) -> 'a list -> 'a list
      val stable_sort : ('-> '-> int) -> 'a list -> 'a list
      val fast_sort : ('-> '-> int) -> 'a list -> 'a list
      val sort_uniq : ('-> '-> int) -> 'a list -> 'a list
      val merge : ('-> '-> int) -> 'a list -> 'a list -> 'a list
      val map_filter : ('-> 'b option) -> 'a list -> 'b list
      val last : 'a list -> 'a
      val assoc_remove : '-> ('a * 'b) list -> 'b * ('a * 'b) list
      val remove_first_if_any : '-> 'a list -> 'a list
      val remove_first_if_any_q : '-> 'a list -> 'a list
      val remove_first : '-> 'a list -> 'a list
      val remove_first_q : '-> 'a list -> 'a list
      val remove_all : '-> 'a list -> 'a list
      val remove_all_q : '-> 'a list -> 'a list
      val remove_all_assoc : '-> ('a * 'b) list -> ('a * 'b) list
      val remove_all_assoc_q : '-> ('a * 'b) list -> ('a * 'b) list
      val is_prefix : 'a list -> 'a list -> bool
      val chop : int -> 'a list -> 'a list
    end
  module Clist :
    sig
      type 'a t = 'Ocsigen_lib_base.Clist.t
      type 'a node = 'Ocsigen_lib_base.Clist.node
      val make : '-> 'a node
      val create : unit -> 'a t
      val insert : 'a t -> 'a node -> unit
      val remove : 'a node -> unit
      val value : 'a node -> 'a
      val in_list : 'a node -> bool
      val is_empty : 'a t -> bool
      val iter : ('-> unit) -> 'a t -> unit
      val fold_left : ('-> '-> 'a) -> '-> 'b t -> 'a
    end
  module Int :
    sig
      module Table :
        sig
          type key = int
          type +'a t
          val empty : 'a t
          val is_empty : 'a t -> bool
          val mem : key -> 'a t -> bool
          val add : key -> '-> 'a t -> 'a t
          val singleton : key -> '-> 'a t
          val remove : key -> 'a t -> 'a t
          val merge :
            (key -> 'a option -> 'b option -> 'c option) ->
            'a t -> 'b t -> 'c t
          val compare : ('-> '-> int) -> 'a t -> 'a t -> int
          val equal : ('-> '-> bool) -> 'a t -> 'a t -> bool
          val iter : (key -> '-> unit) -> 'a t -> unit
          val fold : (key -> '-> '-> 'b) -> 'a t -> '-> 'b
          val for_all : (key -> '-> bool) -> 'a t -> bool
          val exists : (key -> '-> bool) -> 'a t -> bool
          val filter : (key -> '-> bool) -> 'a t -> 'a t
          val partition : (key -> '-> bool) -> 'a t -> 'a t * 'a t
          val cardinal : 'a t -> int
          val bindings : 'a t -> (key * 'a) list
          val min_binding : 'a t -> key * 'a
          val max_binding : 'a t -> key * 'a
          val choose : 'a t -> key * 'a
          val split : key -> 'a t -> 'a t * 'a option * 'a t
          val find : key -> 'a t -> 'a
          val map : ('-> 'b) -> 'a t -> 'b t
          val mapi : (key -> '-> 'b) -> 'a t -> 'b t
        end
    end
  module String_base :
    sig
      external length : string -> int = "%string_length"
      external get : string -> int -> char = "%string_safe_get"
      external set : bytes -> int -> char -> unit = "%string_safe_set"
      external create : int -> bytes = "caml_create_string"
      val make : int -> char -> string
      val init : int -> (int -> char) -> string
      val copy : string -> string
      val sub : string -> int -> int -> string
      val fill : bytes -> int -> int -> char -> unit
      val blit : string -> int -> bytes -> int -> int -> unit
      val concat : string -> string list -> string
      val iter : (char -> unit) -> string -> unit
      val iteri : (int -> char -> unit) -> string -> unit
      val map : (char -> char) -> string -> string
      val mapi : (int -> char -> char) -> string -> string
      val trim : string -> string
      val escaped : string -> string
      val index : string -> char -> int
      val rindex : string -> char -> int
      val index_from : string -> int -> char -> int
      val rindex_from : string -> int -> char -> int
      val contains : string -> char -> bool
      val contains_from : string -> int -> char -> bool
      val rcontains_from : string -> int -> char -> bool
      val uppercase : string -> string
      val lowercase : string -> string
      val capitalize : string -> string
      val uncapitalize : string -> string
      type t = string
      val compare : t -> t -> int
      external unsafe_get : string -> int -> char = "%string_unsafe_get"
      external unsafe_set : bytes -> int -> char -> unit
        = "%string_unsafe_set"
      external unsafe_blit : string -> int -> bytes -> int -> int -> unit
        = "caml_blit_string" "noalloc"
      external unsafe_fill : bytes -> int -> int -> char -> unit
        = "caml_fill_string" "noalloc"
      val remove_spaces : string -> int -> int -> string
      val basic_sep : char -> string -> string * string
      val sep : char -> string -> string * string
      val split : ?multisep:bool -> char -> string -> string list
      val may_append : string -> sep:string -> string -> string
      val may_concat : string -> sep:string -> string -> string
      val first_diff : string -> string -> int -> int -> int
      module Table :
        sig
          type key = string
          type +'a t
          val empty : 'a t
          val is_empty : 'a t -> bool
          val mem : key -> 'a t -> bool
          val add : key -> '-> 'a t -> 'a t
          val singleton : key -> '-> 'a t
          val remove : key -> 'a t -> 'a t
          val merge :
            (key -> 'a option -> 'b option -> 'c option) ->
            'a t -> 'b t -> 'c t
          val compare : ('-> '-> int) -> 'a t -> 'a t -> int
          val equal : ('-> '-> bool) -> 'a t -> 'a t -> bool
          val iter : (key -> '-> unit) -> 'a t -> unit
          val fold : (key -> '-> '-> 'b) -> 'a t -> '-> 'b
          val for_all : (key -> '-> bool) -> 'a t -> bool
          val exists : (key -> '-> bool) -> 'a t -> bool
          val filter : (key -> '-> bool) -> 'a t -> 'a t
          val partition : (key -> '-> bool) -> 'a t -> 'a t * 'a t
          val cardinal : 'a t -> int
          val bindings : 'a t -> (key * 'a) list
          val min_binding : 'a t -> key * 'a
          val max_binding : 'a t -> key * 'a
          val choose : 'a t -> key * 'a
          val split : key -> 'a t -> 'a t * 'a option * 'a t
          val find : key -> 'a t -> 'a
          val map : ('-> 'b) -> 'a t -> 'b t
          val mapi : (key -> '-> 'b) -> 'a t -> 'b t
        end
      module Set :
        sig
          type elt = string
          type t
          val empty : t
          val is_empty : t -> bool
          val mem : elt -> t -> bool
          val add : elt -> t -> t
          val singleton : elt -> t
          val remove : elt -> t -> t
          val union : t -> t -> t
          val inter : t -> t -> t
          val diff : t -> t -> t
          val compare : t -> t -> int
          val equal : t -> t -> bool
          val subset : t -> t -> bool
          val iter : (elt -> unit) -> t -> unit
          val fold : (elt -> '-> 'a) -> t -> '-> 'a
          val for_all : (elt -> bool) -> t -> bool
          val exists : (elt -> bool) -> t -> bool
          val filter : (elt -> bool) -> t -> t
          val partition : (elt -> bool) -> t -> t * t
          val cardinal : t -> int
          val elements : t -> elt list
          val min_elt : t -> elt
          val max_elt : t -> elt
          val choose : t -> elt
          val split : elt -> t -> t * bool * t
          val find : elt -> t -> elt
          val of_list : elt list -> t
        end
      module Map :
        sig
          type key = string
          type +'a t
          val empty : 'a t
          val is_empty : 'a t -> bool
          val mem : key -> 'a t -> bool
          val add : key -> '-> 'a t -> 'a t
          val singleton : key -> '-> 'a t
          val remove : key -> 'a t -> 'a t
          val merge :
            (key -> 'a option -> 'b option -> 'c option) ->
            'a t -> 'b t -> 'c t
          val compare : ('-> '-> int) -> 'a t -> 'a t -> int
          val equal : ('-> '-> bool) -> 'a t -> 'a t -> bool
          val iter : (key -> '-> unit) -> 'a t -> unit
          val fold : (key -> '-> '-> 'b) -> 'a t -> '-> 'b
          val for_all : (key -> '-> bool) -> 'a t -> bool
          val exists : (key -> '-> bool) -> 'a t -> bool
          val filter : (key -> '-> bool) -> 'a t -> 'a t
          val partition : (key -> '-> bool) -> 'a t -> 'a t * 'a t
          val cardinal : 'a t -> int
          val bindings : 'a t -> (key * 'a) list
          val min_binding : 'a t -> key * 'a
          val max_binding : 'a t -> key * 'a
          val choose : 'a t -> key * 'a
          val split : key -> 'a t -> 'a t * 'a option * 'a t
          val find : key -> 'a t -> 'a
          val map : ('-> 'b) -> 'a t -> 'b t
          val mapi : (key -> '-> 'b) -> 'a t -> 'b t
        end
    end
  module Url_base :
    sig
      type t = string
      type uri = string
      val make_absolute_url :
        https:bool -> host:string -> port:int -> uri -> t
      type path = string list
      val remove_dotdot : path -> path
      val remove_end_slash : string -> string
      val remove_internal_slash : path -> path
      val change_empty_list : path -> path
      val add_end_slash_if_missing : path -> path
      val remove_slash_at_end : path -> path
      val remove_slash_at_beginning : path -> path
      val is_prefix_skip_end_slash : string list -> string list -> bool
      val split_fragment : string -> string * string option
    end
  module Printexc :
    sig
      val to_string : exn -> string
      val print : ('-> 'b) -> '-> 'b
      val catch : ('-> 'b) -> '-> 'b
      val print_backtrace : out_channel -> unit
      val get_backtrace : unit -> string
      val record_backtrace : bool -> unit
      val backtrace_status : unit -> bool
      val register_printer : (exn -> string option) -> unit
      type raw_backtrace
      val get_raw_backtrace : unit -> raw_backtrace
      val print_raw_backtrace : out_channel -> raw_backtrace -> unit
      val raw_backtrace_to_string : raw_backtrace -> string
      val get_callstack : int -> raw_backtrace
      val set_uncaught_exception_handler :
        (exn -> raw_backtrace -> unit) -> unit
      type backtrace_slot
      val backtrace_slots : raw_backtrace -> backtrace_slot array option
      type location = {
        filename : string;
        line_number : int;
        start_char : int;
        end_char : int;
      }
      module Slot :
        sig
          type t = backtrace_slot
          val is_raise : t -> bool
          val location : t -> location option
          val format : int -> t -> string option
        end
      type raw_backtrace_slot
      val raw_backtrace_length : raw_backtrace -> int
      val get_raw_backtrace_slot : raw_backtrace -> int -> raw_backtrace_slot
      val convert_raw_backtrace_slot : raw_backtrace_slot -> backtrace_slot
      val exn_slot_id : exn -> int
      val exn_slot_name : exn -> string
      val register_exn_printer : ((exn -> string) -> exn -> string) -> unit
    end
  module Lwt_ops :
    sig
      val ( >>= ) : 'Lwt.t -> ('-> 'Lwt.t) -> 'Lwt.t
      val ( =<< ) : ('-> 'Lwt.t) -> 'Lwt.t -> 'Lwt.t
      val ( >|= ) : 'Lwt.t -> ('-> 'b) -> 'Lwt.t
      val ( =|< ) : ('-> 'b) -> 'Lwt.t -> 'Lwt.t
    end
  module type Map_S =
    sig
      type key
      type +'a t
      val empty : 'a t
      val is_empty : 'a t -> bool
      val mem : key -> 'a t -> bool
      val add : key -> '-> 'a t -> 'a t
      val singleton : key -> '-> 'a t
      val remove : key -> 'a t -> 'a t
      val merge :
        (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
      val compare : ('-> '-> int) -> 'a t -> 'a t -> int
      val equal : ('-> '-> bool) -> 'a t -> 'a t -> bool
      val iter : (key -> '-> unit) -> 'a t -> unit
      val fold : (key -> '-> '-> 'b) -> 'a t -> '-> 'b
      val for_all : (key -> '-> bool) -> 'a t -> bool
      val exists : (key -> '-> bool) -> 'a t -> bool
      val filter : (key -> '-> bool) -> 'a t -> 'a t
      val partition : (key -> '-> bool) -> 'a t -> 'a t * 'a t
      val cardinal : 'a t -> int
      val bindings : 'a t -> (key * 'a) list
      val min_binding : 'a t -> key * 'a
      val max_binding : 'a t -> key * 'a
      val choose : 'a t -> key * 'a
      val split : key -> 'a t -> 'a t * 'a option * 'a t
      val find : key -> 'a t -> 'a
      val map : ('-> 'b) -> 'a t -> 'b t
      val mapi : (key -> '-> 'b) -> 'a t -> 'b t
      val from_list : (key * 'a) list -> 'a t
      val to_string : ?sep:string -> ('-> string) -> 'a t -> string
    end
  module Int64_map :
    sig
      type key = int64
      type 'a t = 'Eliom_lib_base.Int64_map.t
      val empty : 'a t
      val is_empty : 'a t -> bool
      val mem : key -> 'a t -> bool
      val add : key -> '-> 'a t -> 'a t
      val singleton : key -> '-> 'a t
      val remove : key -> 'a t -> 'a t
      val merge :
        (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
      val compare : ('-> '-> int) -> 'a t -> 'a t -> int
      val equal : ('-> '-> bool) -> 'a t -> 'a t -> bool
      val iter : (key -> '-> unit) -> 'a t -> unit
      val fold : (key -> '-> '-> 'b) -> 'a t -> '-> 'b
      val for_all : (key -> '-> bool) -> 'a t -> bool
      val exists : (key -> '-> bool) -> 'a t -> bool
      val filter : (key -> '-> bool) -> 'a t -> 'a t
      val partition : (key -> '-> bool) -> 'a t -> 'a t * 'a t
      val cardinal : 'a t -> int
      val bindings : 'a t -> (key * 'a) list
      val min_binding : 'a t -> key * 'a
      val max_binding : 'a t -> key * 'a
      val choose : 'a t -> key * 'a
      val split : key -> 'a t -> 'a t * 'a option * 'a t
      val find : key -> 'a t -> 'a
      val map : ('-> 'b) -> 'a t -> 'b t
      val mapi : (key -> '-> 'b) -> 'a t -> 'b t
      val from_list : (key * 'a) list -> 'a t
      val to_string : ?sep:string -> ('-> string) -> 'a t -> string
    end
  module Int_map :
    sig
      type key = int
      type 'a t = 'Eliom_lib_base.Int_map.t
      val empty : 'a t
      val is_empty : 'a t -> bool
      val mem : key -> 'a t -> bool
      val add : key -> '-> 'a t -> 'a t
      val singleton : key -> '-> 'a t
      val remove : key -> 'a t -> 'a t
      val merge :
        (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
      val compare : ('-> '-> int) -> 'a t -> 'a t -> int
      val equal : ('-> '-> bool) -> 'a t -> 'a t -> bool
      val iter : (key -> '-> unit) -> 'a t -> unit
      val fold : (key -> '-> '-> 'b) -> 'a t -> '-> 'b
      val for_all : (key -> '-> bool) -> 'a t -> bool
      val exists : (key -> '-> bool) -> 'a t -> bool
      val filter : (key -> '-> bool) -> 'a t -> 'a t
      val partition : (key -> '-> bool) -> 'a t -> 'a t * 'a t
      val cardinal : 'a t -> int
      val bindings : 'a t -> (key * 'a) list
      val min_binding : 'a t -> key * 'a
      val max_binding : 'a t -> key * 'a
      val choose : 'a t -> key * 'a
      val split : key -> 'a t -> 'a t * 'a option * 'a t
      val find : key -> 'a t -> 'a
      val map : ('-> 'b) -> 'a t -> 'b t
      val mapi : (key -> '-> 'b) -> 'a t -> 'b t
      val from_list : (key * 'a) list -> 'a t
      val to_string : ?sep:string -> ('-> string) -> 'a t -> string
    end
  module String_map :
    sig
      type key = string
      type 'a t = 'Eliom_lib_base.String_map.t
      val empty : 'a t
      val is_empty : 'a t -> bool
      val mem : key -> 'a t -> bool
      val add : key -> '-> 'a t -> 'a t
      val singleton : key -> '-> 'a t
      val remove : key -> 'a t -> 'a t
      val merge :
        (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
      val compare : ('-> '-> int) -> 'a t -> 'a t -> int
      val equal : ('-> '-> bool) -> 'a t -> 'a t -> bool
      val iter : (key -> '-> unit) -> 'a t -> unit
      val fold : (key -> '-> '-> 'b) -> 'a t -> '-> 'b
      val for_all : (key -> '-> bool) -> 'a t -> bool
      val exists : (key -> '-> bool) -> 'a t -> bool
      val filter : (key -> '-> bool) -> 'a t -> 'a t
      val partition : (key -> '-> bool) -> 'a t -> 'a t * 'a t
      val cardinal : 'a t -> int
      val bindings : 'a t -> (key * 'a) list
      val min_binding : 'a t -> key * 'a
      val max_binding : 'a t -> key * 'a
      val choose : 'a t -> key * 'a
      val split : key -> 'a t -> 'a t * 'a option * 'a t
      val find : key -> 'a t -> 'a
      val map : ('-> 'b) -> 'a t -> 'b t
      val mapi : (key -> '-> 'b) -> 'a t -> 'b t
      val from_list : (key * 'a) list -> 'a t
      val to_string : ?sep:string -> ('-> string) -> 'a t -> string
    end
  type pos = Lexing.position * Lexing.position
  val pos_to_string : pos -> string
  module Client_value_server_repr :
    sig
      type +'a t
      val create : closure_id:int64 -> instance_id:int64 -> 'a t
      val closure_id : 'a t -> int64
      val instance_id : 'a t -> int64
    end
  type escaped_value = Ocsigen_lib_base.poly
  val fresh_ix : unit -> int64
  module RawXML :
    sig
      type separator = Space | Comma
      val separator_to_string : separator -> string
      type cookie_info = bool * string list
      module Json_cookie_info :
        sig
          type a = bool * string list
          val t : a Deriving_Json.t
          val write : Buffer.t -> a -> unit
          val read : Deriving_Json_lexer.lexbuf -> a
          val to_string : a -> string
          val from_string : string -> a
          val match_variant : [ `Cst of int | `NCst of int ] -> bool
          val read_variant :
            Deriving_Json_lexer.lexbuf -> [ `Cst of int | `NCst of int ] -> a
        end
      type -'a caml_event_handler =
          CE_registered_closure of string *
            ('Js.t -> unit) Client_value_server_repr.t
        | CE_client_closure of ('Js.t -> unit)
        | CE_call_service of
            ([ `A | `Form_get | `Form_post ] * cookie_info option *
             string option)
            option Eliom_lazy.request
        constraint 'a = #Dom_html.event
      class type biggest_event =
        object
          method _type : Js.js_string Js.t Js.readonly_prop
          method altKey : bool Js.t Js.readonly_prop
          method button : int Js.readonly_prop
          method charCode : int Js.optdef Js.readonly_prop
          method clientX : int Js.readonly_prop
          method clientY : int Js.readonly_prop
          method ctrlKey : bool Js.t Js.readonly_prop
          method currentTarget :
            Dom_html.element Js.t Js.opt Js.readonly_prop
          method fromElement :
            Dom_html.element Js.t Js.opt Js.optdef Js.readonly_prop
          method keyCode : int Js.readonly_prop
          method keyIdentifier : Js.js_string Js.t Js.optdef Js.readonly_prop
          method metaKey : bool Js.t Js.readonly_prop
          method pageX : int Js.optdef Js.readonly_prop
          method pageY : int Js.optdef Js.readonly_prop
          method relatedTarget :
            Dom_html.element Js.t Js.opt Js.optdef Js.readonly_prop
          method screenX : int Js.readonly_prop
          method screenY : int Js.readonly_prop
          method shiftKey : bool Js.t Js.readonly_prop
          method srcElement : Dom_html.element Js.t Js.opt Js.readonly_prop
          method target : Dom_html.element Js.t Js.opt Js.readonly_prop
          method toElement :
            Dom_html.element Js.t Js.opt Js.optdef Js.readonly_prop
          method which : Dom_html.mouse_button Js.optdef Js.readonly_prop
        end
      type internal_event_handler =
          Raw of string
        | Caml of biggest_event caml_event_handler
      type uri = string Eliom_lazy.request
      val string_of_uri : uri -> string
      val uri_of_string : string -> uri
      val uri_of_fun : (unit -> string) -> uri
      val internal_event_handler_of_service :
        ([ `A | `Form_get | `Form_post ] * cookie_info option * string option)
        option Eliom_lazy.request -> internal_event_handler
      val ce_registered_closure_class : string
      val ce_registered_attr_class : string
      val ce_call_service_class : string
      val process_node_class : string
      val request_node_class : string
      val ce_call_service_attrib : string
      val ce_template_attrib : string
      val node_id_attrib : string
      val closure_attr_prefix : string
      val closure_name_prefix : string
      val client_attr_prefix : string
      val client_name_prefix : string
      type aname = string
      type acontent =
          AFloat of float
        | AInt of int
        | AStr of string
        | AStrL of separator * string list
      type racontent =
          RA of acontent
        | RAReact of acontent option React.signal
        | RACamlEventHandler of biggest_event caml_event_handler
        | RALazyStr of string Eliom_lazy.request
        | RALazyStrL of separator * string Eliom_lazy.request list
        | RAClient of string * attrib option *
            attrib Client_value_server_repr.t
      and attrib = aname * racontent
      val aname : attrib -> aname
      val acontent : attrib -> acontent
      val racontent : attrib -> racontent
      val react_float_attrib : aname -> float React.signal -> attrib
      val react_int_attrib : aname -> int React.signal -> attrib
      val react_string_attrib : aname -> string React.signal -> attrib
      val react_space_sep_attrib :
        aname -> string list React.signal -> attrib
      val react_comma_sep_attrib :
        aname -> string list React.signal -> attrib
      val react_poly_attrib : aname -> string -> bool React.signal -> attrib
      val float_attrib : aname -> float -> attrib
      val int_attrib : aname -> int -> attrib
      val string_attrib : aname -> string -> attrib
      val space_sep_attrib : aname -> string list -> attrib
      val comma_sep_attrib : aname -> string list -> attrib
      val internal_event_handler_attrib :
        aname -> internal_event_handler -> attrib
      val uri_attrib : aname -> string Eliom_lazy.request -> attrib
      val uris_attrib : aname -> string Eliom_lazy.request list -> attrib
      type ename = string
      type node_id = NoId | ProcessId of string | RequestId of string
      module ClosureMap :
        sig
          type key = string
          type +'a t
          val empty : 'a t
          val is_empty : 'a t -> bool
          val mem : key -> 'a t -> bool
          val add : key -> '-> 'a t -> 'a t
          val singleton : key -> '-> 'a t
          val remove : key -> 'a t -> 'a t
          val merge :
            (key -> 'a option -> 'b option -> 'c option) ->
            'a t -> 'b t -> 'c t
          val compare : ('-> '-> int) -> 'a t -> 'a t -> int
          val equal : ('-> '-> bool) -> 'a t -> 'a t -> bool
          val iter : (key -> '-> unit) -> 'a t -> unit
          val fold : (key -> '-> '-> 'b) -> 'a t -> '-> 'b
          val for_all : (key -> '-> bool) -> 'a t -> bool
          val exists : (key -> '-> bool) -> 'a t -> bool
          val filter : (key -> '-> bool) -> 'a t -> 'a t
          val partition : (key -> '-> bool) -> 'a t -> 'a t * 'a t
          val cardinal : 'a t -> int
          val bindings : 'a t -> (key * 'a) list
          val min_binding : 'a t -> key * 'a
          val max_binding : 'a t -> key * 'a
          val choose : 'a t -> key * 'a
          val split : key -> 'a t -> 'a t * 'a option * 'a t
          val find : key -> 'a t -> 'a
          val map : ('-> 'b) -> 'a t -> 'b t
          val mapi : (key -> '-> 'b) -> 'a t -> 'b t
        end
      type event_handler_table =
          (biggest_event Js.t -> unit) Client_value_server_repr.t
          ClosureMap.t
      type client_attrib_table =
          attrib Client_value_server_repr.t ClosureMap.t
      val filter_class_attribs :
        node_id -> (string * racontent) list -> (string * racontent) list
    end
  val tyxml_unwrap_id_int : int
  val client_value_unwrap_id_int : int
  type client_value_datum =
    Eliom_lib_base.client_value_datum = {
    closure_id : int64;
    instance_id : int64;
    loc : pos option;
    args : Ocsigen_lib_base.poly;
  }
  type 'a compilation_unit_global_data =
    'Eliom_lib_base.compilation_unit_global_data = {
    server_sections_data : client_value_datum list Queue.t;
    client_sections_data : 'Eliom_lib_base.injection_datum list Queue.t;
  }
  type request_data = Eliom_lib_base.request_data
  val global_data_unwrap_id_int : int
  type 'a client_value = 'a
  exception Eliom_Internal_Error of string
  exception Exception_on_server of string
  type file_info = File.file Js.t
  val to_json : ?typ:'-> '-> string
  val of_json : ?typ:'-> string -> 'b
  exception False
  module Url :
    sig
      type t = string
      type uri = string
      val make_absolute_url :
        https:bool -> host:string -> port:int -> uri -> t
      type path = string list
      val remove_dotdot : path -> path
      val remove_end_slash : string -> string
      val remove_internal_slash : path -> path
      val change_empty_list : path -> path
      val add_end_slash_if_missing : path -> path
      val remove_slash_at_end : path -> path
      val remove_slash_at_beginning : path -> path
      val is_prefix_skip_end_slash : string list -> string list -> bool
      val split_fragment : string -> string * string option
      val urldecode : string -> string
      val urlencode : ?with_plus:bool -> string -> string
      type http_url = {
        hu_host : string;
        hu_port : int;
        hu_path : string list;
        hu_path_string : string;
        hu_arguments : (string * string) list;
        hu_fragment : string;
      }
      type file_url = {
        fu_path : string list;
        fu_path_string : string;
        fu_arguments : (string * string) list;
        fu_fragment : string;
      }
      type url = Http of http_url | Https of http_url | File of file_url
      val default_http_port : int
      val default_https_port : int
      val path_of_path_string : string -> string list
      val encode_arguments : (string * string) list -> string
      val decode_arguments : string -> (string * string) list
      val url_of_string : string -> url option
      val string_of_url : url -> string
      module Current :
        sig
          val host : string
          val port : int option
          val protocol : string
          val path_string : string
          val path : string list
          val arguments : (string * string) list
          val get_fragment : unit -> string
          val set_fragment : string -> unit
          val get : unit -> url option
          val set : url -> unit
          val as_string : string
        end
      val decode : string -> string
      val encode : ?plus:bool -> string -> string
      val make_encoded_parameters : (string * string) list -> string
      val split_path : string -> string list
      val get_ssl : string -> bool option
    end
  module String :
    sig
      external length : string -> int = "%string_length"
      external get : string -> int -> char = "%string_safe_get"
      external set : bytes -> int -> char -> unit = "%string_safe_set"
      external create : int -> bytes = "caml_create_string"
      val make : int -> char -> string
      val init : int -> (int -> char) -> string
      val copy : string -> string
      val sub : string -> int -> int -> string
      val fill : bytes -> int -> int -> char -> unit
      val blit : string -> int -> bytes -> int -> int -> unit
      val concat : string -> string list -> string
      val iter : (char -> unit) -> string -> unit
      val iteri : (int -> char -> unit) -> string -> unit
      val map : (char -> char) -> string -> string
      val mapi : (int -> char -> char) -> string -> string
      val trim : string -> string
      val escaped : string -> string
      val index : string -> char -> int
      val rindex : string -> char -> int
      val index_from : string -> int -> char -> int
      val rindex_from : string -> int -> char -> int
      val contains : string -> char -> bool
      val contains_from : string -> int -> char -> bool
      val rcontains_from : string -> int -> char -> bool
      val uppercase : string -> string
      val lowercase : string -> string
      val capitalize : string -> string
      val uncapitalize : string -> string
      type t = string
      val compare : t -> t -> int
      external unsafe_get : string -> int -> char = "%string_unsafe_get"
      external unsafe_set : bytes -> int -> char -> unit
        = "%string_unsafe_set"
      external unsafe_blit : string -> int -> bytes -> int -> int -> unit
        = "caml_blit_string" "noalloc"
      external unsafe_fill : bytes -> int -> int -> char -> unit
        = "caml_fill_string" "noalloc"
      val remove_spaces : string -> int -> int -> string
      val basic_sep : char -> string -> string * string
      val sep : char -> string -> string * string
      val split : ?multisep:bool -> char -> string -> string list
      val may_append : string -> sep:string -> string -> string
      val may_concat : string -> sep:string -> string -> string
      val first_diff : string -> string -> int -> int -> int
      module Table :
        sig
          type key = string
          type +'a t
          val empty : 'a t
          val is_empty : 'a t -> bool
          val mem : key -> 'a t -> bool
          val add : key -> '-> 'a t -> 'a t
          val singleton : key -> '-> 'a t
          val remove : key -> 'a t -> 'a t
          val merge :
            (key -> 'a option -> 'b option -> 'c option) ->
            'a t -> 'b t -> 'c t
          val compare : ('-> '-> int) -> 'a t -> 'a t -> int
          val equal : ('-> '-> bool) -> 'a t -> 'a t -> bool
          val iter : (key -> '-> unit) -> 'a t -> unit
          val fold : (key -> '-> '-> 'b) -> 'a t -> '-> 'b
          val for_all : (key -> '-> bool) -> 'a t -> bool
          val exists : (key -> '-> bool) -> 'a t -> bool
          val filter : (key -> '-> bool) -> 'a t -> 'a t
          val partition : (key -> '-> bool) -> 'a t -> 'a t * 'a t
          val cardinal : 'a t -> int
          val bindings : 'a t -> (key * 'a) list
          val min_binding : 'a t -> key * 'a
          val max_binding : 'a t -> key * 'a
          val choose : 'a t -> key * 'a
          val split : key -> 'a t -> 'a t * 'a option * 'a t
          val find : key -> 'a t -> 'a
          val map : ('-> 'b) -> 'a t -> 'b t
          val mapi : (key -> '-> 'b) -> 'a t -> 'b t
        end
      module Set :
        sig
          type elt = string
          type t
          val empty : t
          val is_empty : t -> bool
          val mem : elt -> t -> bool
          val add : elt -> t -> t
          val singleton : elt -> t
          val remove : elt -> t -> t
          val union : t -> t -> t
          val inter : t -> t -> t
          val diff : t -> t -> t
          val compare : t -> t -> int
          val equal : t -> t -> bool
          val subset : t -> t -> bool
          val iter : (elt -> unit) -> t -> unit
          val fold : (elt -> '-> 'a) -> t -> '-> 'a
          val for_all : (elt -> bool) -> t -> bool
          val exists : (elt -> bool) -> t -> bool
          val filter : (elt -> bool) -> t -> t
          val partition : (elt -> bool) -> t -> t * t
          val cardinal : t -> int
          val elements : t -> elt list
          val min_elt : t -> elt
          val max_elt : t -> elt
          val choose : t -> elt
          val split : elt -> t -> t * bool * t
          val find : elt -> t -> elt
          val of_list : elt list -> t
        end
      module Map :
        sig
          type key = string
          type +'a t
          val empty : 'a t
          val is_empty : 'a t -> bool
          val mem : key -> 'a t -> bool
          val add : key -> '-> 'a t -> 'a t
          val singleton : key -> '-> 'a t
          val remove : key -> 'a t -> 'a t
          val merge :
            (key -> 'a option -> 'b option -> 'c option) ->
            'a t -> 'b t -> 'c t
          val compare : ('-> '-> int) -> 'a t -> 'a t -> int
          val equal : ('-> '-> bool) -> 'a t -> 'a t -> bool
          val iter : (key -> '-> unit) -> 'a t -> unit
          val fold : (key -> '-> '-> 'b) -> 'a t -> '-> 'b
          val for_all : (key -> '-> bool) -> 'a t -> bool
          val exists : (key -> '-> bool) -> 'a t -> bool
          val filter : (key -> '-> bool) -> 'a t -> 'a t
          val partition : (key -> '-> bool) -> 'a t -> 'a t * 'a t
          val cardinal : 'a t -> int
          val bindings : 'a t -> (key * 'a) list
          val min_binding : 'a t -> key * 'a
          val max_binding : 'a t -> key * 'a
          val choose : 'a t -> key * 'a
          val split : key -> 'a t -> 'a t * 'a option * 'a t
          val find : key -> 'a t -> 'a
          val map : ('-> 'b) -> 'a t -> 'b t
          val mapi : (key -> '-> 'b) -> 'a t -> 'b t
        end
      val remove_eols : string -> string
    end
  module Lwt_log :
    sig
      type level =
        Lwt_log_core.level =
          Debug
        | Info
        | Notice
        | Warning
        | Error
        | Fatal
      type logger = Lwt_log_core.logger
      type section = Lwt_log_core.section
      val string_of_level : level -> string
      val load_rules : string -> unit
      val add_rule : string -> level -> unit
      val append_rule : string -> level -> unit
      val reset_rules : unit -> unit
      module Section :
        sig
          type t = Lwt_log_core.section
          val make : string -> Lwt_log_core.section
          val name : Lwt_log_core.section -> string
          val main : Lwt_log_core.section
          val level : Lwt_log_core.section -> Lwt_log_core.level
          val set_level : Lwt_log_core.section -> Lwt_log_core.level -> unit
          val reset_level : Lwt_log_core.section -> unit
        end
      type template = Lwt_log_core.template
      val render :
        buffer:Buffer.t ->
        template:template ->
        section:section -> level:level -> message:string -> unit
      val location_key : (string * int * int) Lwt.key
      exception Logger_closed
      val make :
        output:(section -> level -> string list -> unit Lwt.t) ->
        close:(unit -> unit Lwt.t) -> logger
      val close : logger -> unit Lwt.t
      val default : logger ref
      val broadcast : logger list -> logger
      val dispatch : (section -> level -> logger) -> logger
      val null : logger
      val console : Lwt_log.logger
      val log :
        ?inspect:'->
        ?exn:exn ->
        ?section:section ->
        ?location:string * int * int ->
        ?logger:logger -> level:level -> string -> unit Lwt.t
      val log_f :
        ?inspect:'->
        ?exn:exn ->
        ?section:section ->
        ?location:string * int * int ->
        ?logger:logger ->
        level:level -> ('a, unit, string, unit Lwt.t) format4 -> 'a
      val ign_log :
        ?inspect:'->
        ?exn:exn ->
        ?section:section ->
        ?location:string * int * int ->
        ?logger:logger -> level:level -> string -> unit
      val ign_log_f :
        ?inspect:'->
        ?exn:exn ->
        ?section:section ->
        ?location:string * int * int ->
        ?logger:logger ->
        level:level -> ('a, unit, string, unit) format4 -> 'a
      val debug :
        ?inspect:'->
        ?exn:exn ->
        ?section:section ->
        ?location:string * int * int ->
        ?logger:logger -> string -> unit Lwt.t
      val debug_f :
        ?inspect:'->
        ?exn:exn ->
        ?section:section ->
        ?location:string * int * int ->
        ?logger:logger -> ('a, unit, string, unit Lwt.t) format4 -> 'a
      val ign_debug :
        ?inspect:'->
        ?exn:exn ->
        ?section:section ->
        ?location:string * int * int -> ?logger:logger -> string -> unit
      val ign_debug_f :
        ?inspect:'->
        ?exn:exn ->
        ?section:section ->
        ?location:string * int * int ->
        ?logger:logger -> ('a, unit, string, unit) format4 -> 'a
      val info :
        ?inspect:'->
        ?exn:exn ->
        ?section:section ->
        ?location:string * int * int ->
        ?logger:logger -> string -> unit Lwt.t
      val info_f :
        ?inspect:'->
        ?exn:exn ->
        ?section:section ->
        ?location:string * int * int ->
        ?logger:logger -> ('a, unit, string, unit Lwt.t) format4 -> 'a
      val ign_info :
        ?inspect:'->
        ?exn:exn ->
        ?section:section ->
        ?location:string * int * int -> ?logger:logger -> string -> unit
      val ign_info_f :
        ?inspect:'->
        ?exn:exn ->
        ?section:section ->
        ?location:string * int * int ->
        ?logger:logger -> ('a, unit, string, unit) format4 -> 'a
      val notice :
        ?inspect:'->
        ?exn:exn ->
        ?section:section ->
        ?location:string * int * int ->
        ?logger:logger -> string -> unit Lwt.t
      val notice_f :
        ?inspect:'->
        ?exn:exn ->
        ?section:section ->
        ?location:string * int * int ->
        ?logger:logger -> ('a, unit, string, unit Lwt.t) format4 -> 'a
      val ign_notice :
        ?inspect:'->
        ?exn:exn ->
        ?section:section ->
        ?location:string * int * int -> ?logger:logger -> string -> unit
      val ign_notice_f :
        ?inspect:'->
        ?exn:exn ->
        ?section:section ->
        ?location:string * int * int ->
        ?logger:logger -> ('a, unit, string, unit) format4 -> 'a
      val warning :
        ?inspect:'->
        ?exn:exn ->
        ?section:section ->
        ?location:string * int * int ->
        ?logger:logger -> string -> unit Lwt.t
      val warning_f :
        ?inspect:'->
        ?exn:exn ->
        ?section:section ->
        ?location:string * int * int ->
        ?logger:logger -> ('a, unit, string, unit Lwt.t) format4 -> 'a
      val ign_warning :
        ?inspect:'->
        ?exn:exn ->
        ?section:section ->
        ?location:string * int * int -> ?logger:logger -> string -> unit
      val ign_warning_f :
        ?inspect:'->
        ?exn:exn ->
        ?section:section ->
        ?location:string * int * int ->
        ?logger:logger -> ('a, unit, string, unit) format4 -> 'a
      val error :
        ?inspect:'->
        ?exn:exn ->
        ?section:section ->
        ?location:string * int * int ->
        ?logger:logger -> string -> unit Lwt.t
      val error_f :
        ?inspect:'->
        ?exn:exn ->
        ?section:section ->
        ?location:string * int * int ->
        ?logger:logger -> ('a, unit, string, unit Lwt.t) format4 -> 'a
      val ign_error :
        ?inspect:'->
        ?exn:exn ->
        ?section:section ->
        ?location:string * int * int -> ?logger:logger -> string -> unit
      val ign_error_f :
        ?inspect:'->
        ?exn:exn ->
        ?section:section ->
        ?location:string * int * int ->
        ?logger:logger -> ('a, unit, string, unit) format4 -> 'a
      val fatal :
        ?inspect:'->
        ?exn:exn ->
        ?section:section ->
        ?location:string * int * int ->
        ?logger:logger -> string -> unit Lwt.t
      val fatal_f :
        ?inspect:'->
        ?exn:exn ->
        ?section:section ->
        ?location:string * int * int ->
        ?logger:logger -> ('a, unit, string, unit Lwt.t) format4 -> 'a
      val ign_fatal :
        ?inspect:'->
        ?exn:exn ->
        ?section:section ->
        ?location:string * int * int -> ?logger:logger -> string -> unit
      val ign_fatal_f :
        ?inspect:'->
        ?exn:exn ->
        ?section:section ->
        ?location:string * int * int ->
        ?logger:logger -> ('a, unit, string, unit) format4 -> 'a
      val raise_error :
        ?inspect:'->
        ?exn:exn ->
        ?section:section ->
        ?location:string * int * int -> ?logger:logger -> string -> 'a
      val raise_error_f :
        ?inspect:'->
        ?exn:exn ->
        ?section:section ->
        ?location:string * int * int ->
        ?logger:logger -> ('a, unit, string, 'any) Pervasives.format4 -> 'a
      val eliom : section
    end
  val error : ('a, unit, string, 'b) Pervasives.format4 -> 'a
  val error_any : '-> ('a, unit, string, 'b) Pervasives.format4 -> 'a
  val debug : ('a, unit, string, unit) Pervasives.format4 -> 'a
  val debug_exn : ('a, unit, string, unit) Pervasives.format4 -> exn -> 'a
  val jsdebug : '-> unit
  val alert : ('a, unit, string, unit) Pervasives.format4 -> 'a
  val jsalert : Js.js_string Js.t -> unit
  val debug_var : string -> '-> unit
  val trace : ('a, unit, string, unit) Pervasives.format4 -> 'a
  val lwt_ignore : ?message:string -> unit Lwt.t -> unit
  val encode_form_value : '-> string
  val unmarshal_js : Js.js_string Js.t -> 'a
  val encode_header_value : '-> string
  type injection_datum = poly Eliom_lib_base.injection_datum
  type global_data = unit
end