/usr/lib/ocaml/moreLabels.mli is in ocaml-nox 4.01.0-3ubuntu3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 | (***********************************************************************)
(* *)
(* OCaml *)
(* *)
(* Jacques Garrigue, Kyoto University RIMS *)
(* *)
(* Copyright 2001 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(** Extra labeled libraries.
This meta-module provides labelized version of the {!Hashtbl},
{!Map} and {!Set} modules.
They only differ by their labels. They are provided to help
porting from previous versions of OCaml.
The contents of this module are subject to change.
*)
module Hashtbl : sig
type ('a, 'b) t = ('a, 'b) Hashtbl.t
val create : ?random:bool -> int -> ('a, 'b) t
val clear : ('a, 'b) t -> unit
val reset : ('a, 'b) t -> unit
val copy : ('a, 'b) t -> ('a, 'b) t
val add : ('a, 'b) t -> key:'a -> data:'b -> unit
val find : ('a, 'b) t -> 'a -> 'b
val find_all : ('a, 'b) t -> 'a -> 'b list
val mem : ('a, 'b) t -> 'a -> bool
val remove : ('a, 'b) t -> 'a -> unit
val replace : ('a, 'b) t -> key:'a -> data:'b -> unit
val iter : f:(key:'a -> data:'b -> unit) -> ('a, 'b) t -> unit
val fold :
f:(key:'a -> data:'b -> 'c -> 'c) ->
('a, 'b) t -> init:'c -> 'c
val length : ('a, 'b) t -> int
val randomize : unit -> unit
type statistics = Hashtbl.statistics
val stats : ('a, 'b) t -> statistics
module type HashedType = Hashtbl.HashedType
module type SeededHashedType = Hashtbl.SeededHashedType
module type S =
sig
type key
and 'a t
val create : int -> 'a t
val clear : 'a t -> unit
val reset : 'a t -> unit
val copy : 'a t -> 'a t
val add : 'a t -> key:key -> data:'a -> unit
val remove : 'a t -> key -> unit
val find : 'a t -> key -> 'a
val find_all : 'a t -> key -> 'a list
val replace : 'a t -> key:key -> data:'a -> unit
val mem : 'a t -> key -> bool
val iter : f:(key:key -> data:'a -> unit) -> 'a t -> unit
val fold :
f:(key:key -> data:'a -> 'b -> 'b) ->
'a t -> init:'b -> 'b
val length : 'a t -> int
val stats: 'a t -> statistics
end
module type SeededS =
sig
type key
and 'a t
val create : ?random:bool -> int -> 'a t
val clear : 'a t -> unit
val reset : 'a t -> unit
val copy : 'a t -> 'a t
val add : 'a t -> key:key -> data:'a -> unit
val remove : 'a t -> key -> unit
val find : 'a t -> key -> 'a
val find_all : 'a t -> key -> 'a list
val replace : 'a t -> key:key -> data:'a -> unit
val mem : 'a t -> key -> bool
val iter : f:(key:key -> data:'a -> unit) -> 'a t -> unit
val fold :
f:(key:key -> data:'a -> 'b -> 'b) ->
'a t -> init:'b -> 'b
val length : 'a t -> int
val stats: 'a t -> statistics
end
module Make : functor (H : HashedType) -> S with type key = H.t
module MakeSeeded (H : SeededHashedType) : SeededS with type key = H.t
val hash : 'a -> int
val seeded_hash : int -> 'a -> int
val hash_param : int -> int -> 'a -> int
val seeded_hash_param : int -> int -> int -> 'a -> int
end
module Map : sig
module type OrderedType = Map.OrderedType
module type S =
sig
type key
and (+'a) t
val empty : 'a t
val is_empty: 'a t -> bool
val mem : key -> 'a t -> bool
val add : key:key -> data:'a -> 'a t -> 'a t
val singleton: key -> 'a -> 'a t
val remove : key -> 'a t -> 'a t
val merge:
f:(key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
val compare: cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int
val equal: cmp:('a -> 'a -> bool) -> 'a t -> 'a t -> bool
val iter : f:(key:key -> data:'a -> unit) -> 'a t -> unit
val fold :
f:(key:key -> data:'a -> 'b -> 'b) ->
'a t -> init:'b -> 'b
val for_all: f:(key -> 'a -> bool) -> 'a t -> bool
val exists: f:(key -> 'a -> bool) -> 'a t -> bool
val filter: f:(key -> 'a -> bool) -> 'a t -> 'a t
val partition: f:(key -> 'a -> 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 : f:('a -> 'b) -> 'a t -> 'b t
val mapi : f:(key -> 'a -> 'b) -> 'a t -> 'b t
end
module Make : functor (Ord : OrderedType) -> S with type key = Ord.t
end
module Set : sig
module type OrderedType = Set.OrderedType
module type S =
sig
type elt
and 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 : f:(elt -> unit) -> t -> unit
val fold : f:(elt -> 'a -> 'a) -> t -> init:'a -> 'a
val for_all : f:(elt -> bool) -> t -> bool
val exists : f:(elt -> bool) -> t -> bool
val filter : f:(elt -> bool) -> t -> t
val partition : f:(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
end
module Make : functor (Ord : OrderedType) -> S with type elt = Ord.t
end
|