From 95933de17c122f254bd91231d04b9cab89f134c3 Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Mon, 27 Apr 1998 09:55:50 +0000 Subject: [PATCH] Corrections mineures sur la documentation git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@1933 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02 --- stdlib/arg.mli | 17 ++++---- stdlib/array.ml | 2 +- stdlib/array.mli | 6 ++- stdlib/digest.mli | 2 +- stdlib/filename.ml | 18 +++++---- stdlib/filename.mli | 7 +++- stdlib/format.mli | 22 +++++----- stdlib/hashtbl.mli | 10 ++--- stdlib/lazy.mli | 2 +- stdlib/lexing.mli | 2 +- stdlib/list.mli | 6 +++ stdlib/marshal.mli | 4 +- stdlib/pervasives.mli | 93 ++++++++++++++++++++++++------------------- stdlib/printf.mli | 6 ++- stdlib/set.ml | 17 ++++++-- stdlib/set.mli | 13 +++++- stdlib/string.mli | 21 +++++----- stdlib/sys.mli | 6 ++- 18 files changed, 152 insertions(+), 102 deletions(-) diff --git a/stdlib/arg.mli b/stdlib/arg.mli index f5e2acf68..ec5106806 100644 --- a/stdlib/arg.mli +++ b/stdlib/arg.mli @@ -52,7 +52,7 @@ type spec = val parse : (string * spec * string) list -> (string -> unit) -> string -> unit (* - [parse speclist anonfun usage_msg] parses the command line. + [Arg.parse speclist anonfun usage_msg] parses the command line. [speclist] is a list of triples [(key, spec, doc)]. [key] is the option keyword, it must start with a ['-'] character. [spec] gives the option type and the function to call when this option @@ -62,8 +62,8 @@ val parse : (string * spec * string) list -> (string -> unit) -> string -> unit The functions in [spec] and [anonfun] are called in the same order as their arguments appear on the command line. - If an error occurs, [parse] exits the program, after printing an error - message as follows: + If an error occurs, [Arg.parse] exits the program, after printing + an error message as follows: - The reason for the error: unknown option, invalid or missing argument, etc. - [usage_msg] - The list of options, each followed by the corresponding [doc] string. @@ -79,19 +79,20 @@ val parse : (string * spec * string) list -> (string -> unit) -> string -> unit exception Bad of string (* - Functions in [spec] or [anonfun] can raise [Bad] with an error + Functions in [spec] or [anonfun] can raise [Arg.Bad] with an error message to reject invalid arguments. *) val usage: (string * spec * string) list -> string -> unit (* - [usage speclist usage_msg] - [speclist] and [usage_msg] are the same as for [parse]. [usage] - prints the same error message that [parse] prints in case of error. + [Arg.usage speclist usage_msg] prints an error message including + the list of valid options. This is the same message that + [Arg.parse] prints in case of error. + [speclist] and [usage_msg] are the same as for [Arg.parse]. *) val current: int ref;; (* Position (in [Sys.argv]) of the argument being processed. You can - change this value, e.g. to force [parse] to skip some arguments. + change this value, e.g. to force [Arg.parse] to skip some arguments. *) diff --git a/stdlib/array.ml b/stdlib/array.ml index 3c012062b..0b753d3a3 100644 --- a/stdlib/array.ml +++ b/stdlib/array.ml @@ -50,7 +50,7 @@ let copy a = let append a1 a2 = let l1 = length a1 and l2 = length a2 in - if l1 = 0 & l2 = 0 then [||] else begin + if l1 = 0 && l2 = 0 then [||] else begin let r = create (l1 + l2) (unsafe_get (if l1 > 0 then a1 else a2) 0) in for i = 0 to l1 - 1 do unsafe_set r i (unsafe_get a1 i) done; for i = 0 to l2 - 1 do unsafe_set r (i + l1) (unsafe_get a2 i) done; diff --git a/stdlib/array.mli b/stdlib/array.mli index cc0665165..e2933d46c 100644 --- a/stdlib/array.mli +++ b/stdlib/array.mli @@ -39,7 +39,9 @@ external create: int -> 'a -> 'a array = "make_vect" will modify all other entries at the same time. *) val init: int -> (int -> 'a) -> 'a array (* [Array.init n f] returns a fresh array of length [n], - with element number [i] equal to [f i]. *) + with element number [i] initialized to the result of [f i]. + In other terms, [Array.init n f] tabulates the results of [f] + applied to the integers [0] to [n-1]. *) val make_matrix: int -> int -> 'a -> 'a array array val create_matrix: int -> int -> 'a -> 'a array array (* [Array.make_matrix dimx dimy e] returns a two-dimensional array @@ -50,7 +52,7 @@ val create_matrix: int -> int -> 'a -> 'a array array with the notation [m.(x).(y)]. *) val append: 'a array -> 'a array -> 'a array (* [Array.append v1 v2] returns a fresh array containing the - concatenation of arrays [v1] and [v2]. *) + concatenation of the arrays [v1] and [v2]. *) val concat: 'a array list -> 'a array (* Same as [Array.append], but catenates a list of arrays. *) val sub: 'a array -> int -> int -> 'a array diff --git a/stdlib/digest.mli b/stdlib/digest.mli index c01332b36..dc83f0464 100644 --- a/stdlib/digest.mli +++ b/stdlib/digest.mli @@ -14,7 +14,7 @@ (* Module [Digest]: MD5 message digest *) (* This module provides functions to compute 128-bit ``digests'' of - arbitrary-length strings or files. The digests are cryptographic + arbitrary-length strings or files. The digests are of cryptographic quality: it is very hard, given a digest, to forge a string having that digest. The algorithm used is MD5. *) diff --git a/stdlib/filename.ml b/stdlib/filename.ml index 5ec18a217..1193a094f 100644 --- a/stdlib/filename.ml +++ b/stdlib/filename.ml @@ -191,12 +191,16 @@ external close_desc: int -> unit = "sys_close" let temp_file prefix suffix = let rec try_name counter = - let name = - concat temporary_directory (prefix ^ string_of_int counter ^ suffix) in - try - close_desc(open_desc name [Open_wronly; Open_creat; Open_excl] 0o666); - name - with Sys_error _ -> - try_name (counter + 1) + if counter >= 1000 then + invalid_arg "Filename.temp_file: temp dir nonexistent or full" + else begin + let name = + concat temporary_directory (prefix ^ string_of_int counter ^ suffix) in + try + close_desc(open_desc name [Open_wronly; Open_creat; Open_excl] 0o666); + name + with Sys_error _ -> + try_name (counter + 1) + end in try_name 0 diff --git a/stdlib/filename.mli b/stdlib/filename.mli index e09f88616..b4b114f05 100644 --- a/stdlib/filename.mli +++ b/stdlib/filename.mli @@ -47,7 +47,7 @@ val dirname : string -> string which is equivalent to [name]. Moreover, after setting the current directory to [dirname name] (with [Sys.chdir]), references to [basename name] (which is a relative file name) - designate the same file as [name] before the call to [chdir]. *) + designate the same file as [name] before the call to [Sys.chdir]. *) val temp_file: string -> string -> string (* [temp_file prefix suffix] returns the name of a non-existent temporary file in the temporary directory. @@ -57,4 +57,7 @@ val temp_file: string -> string -> string the value of the environment variable [TMPDIR] is used instead. Under Windows, the name of the temporary directory is the value of the environment variable [TEMP], - or [C:\temp] by default. *) + or [C:\temp] by default. + Under MacOS, the name of the temporary directory is given + by the environment variable [TempFolder]; if not set, + temporary files are created in the current directory. *) diff --git a/stdlib/format.mli b/stdlib/format.mli index 6979006bc..e25fef461 100644 --- a/stdlib/format.mli +++ b/stdlib/format.mli @@ -21,7 +21,7 @@ (* Rule of thumb for casual users: - use simple boxes (as obtained by [open_box 0]); - use simple break hints (as obtained by [print_cut ()] that outputs a - simple break hint, or by [print_space ()] that ouputs a space + simple break hint, or by [print_space ()] that outputs a space indicating a break hint); - once a box is opened, display its material with basic printing functions (e. g. [print_int] and [print_string]); @@ -311,26 +311,28 @@ val fprintf : formatter -> ('a, formatter, unit) format -> 'a;; indications. The pretty-printing indication characters are introduced by a [@] character, and their meanings are: -- [\[]: open a pretty-printing box. The type and offset of the +- [@\[]: open a pretty-printing box. The type and offset of the box may be optionally specified with the following syntax: the [<] character, followed by an optional box type indication, then an optional integer offset, and the closing [>] character. Box type is one of [h], [v], [hv], or [hov], which stand respectively for an horizontal, vertical, ``horizontal-vertical'' and ``horizontal or vertical'' box. -- [\]]: close the most recently opened pretty-printing box. -- [,]: output a good break as with [print_cut ()]. -- [ ]: output a space, as with [print_space ()]. -- [\n]: force a newline, as with [force_newline ()]. -- [;]: output a good break as with [print_break]. The + For instance, [@\[] opens an ``horizontal or vertical'' + box with indentation 2. +- [@\]]: close the most recently opened pretty-printing box. +- [@,]: output a good break as with [print_cut ()]. +- [@ ]: output a space, as with [print_space ()]. +- [@\n]: force a newline, as with [force_newline ()]. +- [@;]: output a good break as with [print_break]. The [nspaces] and [offset] parameters of the break may be optionally specified with the following syntax: the [<] character, followed by an integer [nspaces] value, then an integer offset, and a closing [>] character. -- [?]: flush the pretty printer as with [print_flush ()]. -- [.]: flush the pretty printer and output a new line, as with +- [@?]: flush the pretty printer as with [print_flush ()]. +- [@.]: flush the pretty printer and output a new line, as with [print_newline ()]. -- [@]: a plain [@] character. *) +- [@@]: print a plain [@] character. *) val printf : ('a, formatter, unit) format -> 'a;; (* Same as [fprintf], but output on [std_formatter]. *) diff --git a/stdlib/hashtbl.mli b/stdlib/hashtbl.mli index 1564af791..d34804e8d 100644 --- a/stdlib/hashtbl.mli +++ b/stdlib/hashtbl.mli @@ -25,7 +25,7 @@ val create : int -> ('a,'b) t initial size [n]. The table grows as needed, so [n] is just an initial guess. Better results are said to be achieved when [n] is a prime number. - Raise [Invalid_argument "hashtbl__new"] if [n] is less than 1. *) + Raise [Invalid_argument] if [n] is less than 1. *) val clear : ('a, 'b) t -> unit (* Empty a hash table. *) @@ -33,9 +33,9 @@ val clear : ('a, 'b) t -> unit val add : ('a, 'b) t -> 'a -> 'b -> unit (* [Hashtbl.add tbl x y] adds a binding of [x] to [y] in table [tbl]. Previous bindings for [x] are not removed, but simply - hidden. That is, after performing [remove tbl x], the previous - binding for [x], if any, is restored. - (This is the semantics of association lists.) *) + hidden. That is, after performing [Hashtbl.remove tbl x], + the previous binding for [x], if any, is restored. + (Same behavior as with association lists.) *) val find : ('a, 'b) t -> 'a -> 'b (* [Hashtbl.find tbl x] returns the current binding of [x] in [tbl], @@ -76,7 +76,7 @@ module type HashedType = by [hash]. Examples: suitable ([equal], [hash]) pairs for arbitrary key types include - ([(=)], [Hashtbl.hash]) for comparing objects by structure, + ([(=)], [Hashtbl.hash]) for comparing objects by structure, and ([(==)], [Hashtbl.hash]) for comparing objects by addresses (e.g. for mutable or cyclic keys). *) diff --git a/stdlib/lazy.mli b/stdlib/lazy.mli index 43a4001af..da0566a54 100644 --- a/stdlib/lazy.mli +++ b/stdlib/lazy.mli @@ -20,7 +20,7 @@ type 'a status = ;; type 'a t = 'a status ref;; -(* A value of type ['a Lazy.t] is a deferred computation (called a +(* A value of type ['a Lazy.t] is a deferred computation (also called a suspension) that computes a result of type ['a]. The expression [lazy (expr)] returns a suspension that computes [expr]. *) diff --git a/stdlib/lexing.mli b/stdlib/lexing.mli index 849a775a4..42c68f7ab 100644 --- a/stdlib/lexing.mli +++ b/stdlib/lexing.mli @@ -55,7 +55,7 @@ val from_function : (string -> int -> int) -> lexbuf access to the character string matched by the regular expression associated with the semantic action. These functions must be applied to the argument [lexbuf], which, in the code generated by - [camllex], is bound to the lexer buffer passed to the parsing + [ocamllex], is bound to the lexer buffer passed to the parsing function. *) val lexeme : lexbuf -> string diff --git a/stdlib/list.mli b/stdlib/list.mli index f8542c7ba..66e7486e0 100644 --- a/stdlib/list.mli +++ b/stdlib/list.mli @@ -27,6 +27,12 @@ val nth : 'a list -> int -> 'a Raise [Failure "nth"] if the list is too short. *) val rev : 'a list -> 'a list (* List reversal. *) +val append : 'a list -> 'a list -> 'a list + (* Catenate two lists. Same function as the infix operator [@]. *) +val rev_append : 'a list -> 'a list -> 'a list + (* [List.rev_append l1 l2] reverses [l1] and catenates it to [l2]. + This is equivalent to [List.rev l1 @ l2], but is more efficient + as no intermediate lists are built. *) val concat : 'a list list -> 'a list val flatten : 'a list list -> 'a list (* Catenate (flatten) a list of lists. *) diff --git a/stdlib/marshal.mli b/stdlib/marshal.mli index 35160d81d..d770b6548 100644 --- a/stdlib/marshal.mli +++ b/stdlib/marshal.mli @@ -125,7 +125,7 @@ val total_size : string -> int -> int [Marshal.header_size] characters into the buffer, then determine the length of the remainder of the representation using [Marshal.data_size], - make sure the buffer is large enough to hold the variable - size, then read it, and finally call [Marshal.from_string] + make sure the buffer is large enough to hold the remaining + data, then read it, and finally call [Marshal.from_string] to unmarshal the value. *) diff --git a/stdlib/pervasives.mli b/stdlib/pervasives.mli index 9b707b654..8966d56f4 100644 --- a/stdlib/pervasives.mli +++ b/stdlib/pervasives.mli @@ -113,8 +113,9 @@ external (>) : 'a -> 'a -> bool = "%greaterthan" external (<=) : 'a -> 'a -> bool = "%lessequal" external (>=) : 'a -> 'a -> bool = "%greaterequal" (* Structural ordering functions. These functions coincide with - the usual orderings over integer, string and floating-point - numbers, and extend them to a total ordering over all types. + the usual orderings over integers, characters, strings + and floating-point numbers, and extend them to a + total ordering over all types. The ordering is compatible with [(=)]. As in the case of [(=)], mutable structures are compared by contents. Comparison between functional values raises [Invalid_argument]. @@ -143,15 +144,15 @@ external (!=) : 'a -> 'a -> bool = "%noteq" external not : bool -> bool = "%boolnot" (* The boolean negation. *) -external (&) : bool -> bool -> bool = "%sequand" external (&&) : bool -> bool -> bool = "%sequand" +external (&) : bool -> bool -> bool = "%sequand" (* The boolean ``and''. Evaluation is sequential, left-to-right: - in [e1 & e2], [e1] is evaluated first, and if it returns [false], + in [e1 && e2], [e1] is evaluated first, and if it returns [false], [e2] is not evaluated at all. *) -external (or) : bool -> bool -> bool = "%sequor" external (||) : bool -> bool -> bool = "%sequor" +external (or) : bool -> bool -> bool = "%sequor" (* The boolean ``or''. Evaluation is sequential, left-to-right: - in [e1 or e2], [e1] is evaluated first, and if it returns [true], + in [e1 || e2], [e1] is evaluated first, and if it returns [true], [e2] is not evaluated at all. *) (*** Integer arithmetic *) @@ -173,11 +174,16 @@ external (-) : int -> int -> int = "%subint" external ( * ) : int -> int -> int = "%mulint" (* Integer multiplication. *) external (/) : int -> int -> int = "%divint" + (* Integer division. + Raise [Division_by_zero] if the second argument is 0. *) external (mod) : int -> int -> int = "%modint" - (* Integer division and remainder. - Raise [Division_by_zero] if the second argument is 0. - If one of the arguments is negative, the result is - platform-dependent. *) + (* Integer remainder. If [x >= 0] and [y > 0], the result + of [x mod y] satisfies the following properties: + [0 <= x mod y < y] and + [x = (x / y) * y + x mod y]. + If [y = 0], [x mod y] raises [Division_by_zero]. + If [x < 0] or [y < 0], the result of [x mod y] is + not specified and depends on the platform. *) val abs : int -> int (* Return the absolute value of the argument. *) val max_int: int @@ -224,47 +230,48 @@ external (/.) : float -> float -> float = "%divfloat" (* Floating-point division. *) external ( ** ) : float -> float -> float = "power_float" "pow" "float" (* Exponentiation *) +external sqrt : float -> float = "sqrt_float" "sqrt" "float" + (* Square root *) external exp : float -> float = "exp_float" "exp" "float" - +external log : float -> float = "log_float" "log" "float" +external log10 : float -> float = "log10_float" "log10" "float" + (* Exponential, natural logarithm, base 10 logarithm. *) +external cos : float -> float = "cos_float" "cos" "float" +external sin : float -> float = "sin_float" "sin" "float" +external tan : float -> float = "tan_float" "tan" "float" external acos : float -> float = "acos_float" "acos" "float" external asin : float -> float = "asin_float" "asin" "float" external atan : float -> float = "atan_float" "atan" "float" external atan2 : float -> float -> float = "atan2_float" "atan2" "float" -external cos : float -> float = "cos_float" "cos" "float" + (* The usual trignonmetric functions *) external cosh : float -> float = "cosh_float" "cosh" "float" - -external log : float -> float = "log_float" "log" "float" -external log10 : float -> float = "log10_float" "log10" "float" - -external sin : float -> float = "sin_float" "sin" "float" external sinh : float -> float = "sinh_float" "sinh" "float" -external sqrt : float -> float = "sqrt_float" "sqrt" "float" -external tan : float -> float = "tan_float" "tan" "float" external tanh : float -> float = "tanh_float" "tanh" "float" - (* Usual transcendental functions on floating-point numbers. *) + (* The usual hyperbolic trigonometric functions *) external ceil : float -> float = "ceil_float" "ceil" "float" external floor : float -> float = "floor_float" "floor" "float" - (* Round the given float to an integer value. - [floor f] returns the greatest integer value less than or - equal to [f]. - [ceil f] returns the least integer value greater than or - equal to [f]. *) + (* Round the given float to an integer value. + [floor f] returns the greatest integer value less than or + equal to [f]. + [ceil f] returns the least integer value greater than or + equal to [f]. *) external abs_float : float -> float = "%absfloat" (* Return the absolute value of the argument. *) external mod_float : float -> float -> float = "fmod_float" "fmod" "float" - (* [fmod a b] returns the remainder of [a] with respect to - [b]. *) + (* [mod_float a b] returns the remainder of [a] with respect to + [b]. The returned value is [a -. n *. b], where [n] + is the quotient [a /. b] rounded towards zero to an integer. *) external frexp : float -> float * int = "frexp_float" - (* [frexp f] returns the pair of the significant - and the exponent of [f] (when [f] is zero, the - significant [x] and the exponent [n] of [f] are equal to - zero; when [f] is non-zero, they are defined by - [f = x *. 2 ** n]). *) + (* [frexp f] returns the pair of the significant + and the exponent of [f]. When [f] is zero, the + significant [x] and the exponent [n] of [f] are equal to + zero. When [f] is non-zero, they are defined by + [f = x *. 2 ** n] and [0.5 <= x < 1.0]. *) external ldexp : float -> int -> float = "ldexp_float" - (* [ldexp x n] returns [x *. 2 ** n]. *) + (* [ldexp x n] returns [x *. 2 ** n]. *) external modf : float -> float * float = "modf_float" "modf" - (* [modf f] returns the pair of the fractional and integral - part of [f]. *) + (* [modf f] returns the pair of the fractional and integral + part of [f]. *) external float : int -> float = "%floatofint" (* Convert an integer to floating-point. *) external truncate : float -> int = "%intoffloat" @@ -537,16 +544,16 @@ external ref : 'a -> 'a ref = "%makemutable" (* Return a fresh reference containing the given value. *) external (!) : 'a ref -> 'a = "%field0" (* [!r] returns the current contents of reference [r]. - Could be defined as [fun r -> r.contents]. *) + Equivalent to [fun r -> r.contents]. *) external (:=) : 'a ref -> 'a -> unit = "%setfield0" (* [r := a] stores the value of [a] in reference [r]. - Could be defined as [fun r v -> r.contents <- v]. *) + Equivalent to [fun r v -> r.contents <- v]. *) external incr : int ref -> unit = "%incr" (* Increment the integer contained in the given reference. - Could be defined as [fun r -> r := succ !r]. *) + Equivalent to [fun r -> r := succ !r]. *) external decr : int ref -> unit = "%decr" (* Decrement the integer contained in the given reference. - Could be defined as [fun r -> r := pred !r]. *) + Equivalent to [fun r -> r := pred !r]. *) (*** Program termination *) @@ -562,9 +569,11 @@ val exit : int -> 'a val at_exit: (unit -> unit) -> unit (* Register the given function to be called at program termination time. The functions registered with [at_exit] - will be called in some unspecified order when the program - executes [exit]. They will not be called if the program - terminates because of an uncaught exception. *) + will be called when the program executes [exit]. + They will not be called if the program + terminates because of an uncaught exception. + The functions are called in ``last in, first out'' order: + the function most recently added with [at_exit] is called first. *) (*--*) diff --git a/stdlib/printf.mli b/stdlib/printf.mli index 628529c2b..3414d2bfb 100644 --- a/stdlib/printf.mli +++ b/stdlib/printf.mli @@ -49,6 +49,7 @@ val fprintf: out_channel -> ('a, out_channel, unit) format -> 'a in the output of [fprintf] at the current point. - [t]: same as [%a], but takes only one argument (with type [out_channel -> unit]) and apply it to [outchan]. +- [%]: take no argument and output one [%] character. - Refer to the C library [printf] function for the meaning of flags and field width specifiers. @@ -62,5 +63,6 @@ val eprintf: ('a, out_channel, unit) format -> 'a (* Same as [fprintf], but output on [stderr]. *) val sprintf: ('a, unit, string) format -> 'a - (* Same as [printf], but return the result of formatting in a - string. *) + (* Same as [printf], but instead of printing on an output channel, + return a string containing the result of formatting + the arguments. *) diff --git a/stdlib/set.ml b/stdlib/set.ml index 94d7fee21..8ff08b8ea 100644 --- a/stdlib/set.ml +++ b/stdlib/set.ml @@ -38,6 +38,8 @@ module type S = val fold: (elt -> 'a -> 'a) -> t -> 'a -> 'a val cardinal: t -> int val elements: t -> elt list + val min_elt: t -> elt + val max_elt: t -> elt val choose: t -> elt end @@ -150,8 +152,7 @@ module Make(Ord: OrderedType) = Empty -> false | Node(l, v, r, _) -> let c = Ord.compare x v in - if c = 0 then true else - if c < 0 then mem x l else mem x r + c = 0 || mem x (if c < 0 then l else r) let rec add x = function Empty -> Node(Empty, x, Empty, 1) @@ -253,8 +254,16 @@ module Make(Ord: OrderedType) = let elements s = elements_aux [] s - let rec choose = function + let rec min_elt = function Empty -> raise Not_found | Node(Empty, v, r, _) -> v - | Node(l, v, r, _) -> choose l + | Node(l, v, r, _) -> min_elt l + + let rec max_elt = function + Empty -> raise Not_found + | Node(l, v, Empty, _) -> v + | Node(l, v, r, _) -> max_elt r + + let choose = min_elt + end diff --git a/stdlib/set.mli b/stdlib/set.mli index f846d7b36..76d80a8f8 100644 --- a/stdlib/set.mli +++ b/stdlib/set.mli @@ -62,7 +62,7 @@ module type S = for doing sets of sets. *) val equal: t -> t -> bool (* [equal s1 s2] tests whether the sets [s1] and [s2] are - equal, that is, contain the same elements. *) + equal, that is, contain equal elements. *) val subset: t -> t -> bool (* [subset s1 s2] tests whether the set [s1] is a subset of the set [s2]. *) @@ -79,7 +79,16 @@ module type S = (* Return the number of elements of a set. *) val elements: t -> elt list (* Return the list of all elements of the given set. - The elements appear in the list in some unspecified order. *) + The returned list is sorted in increasing order with respect + to the ordering [Ord.compare], where [Ord] is the argument + given to [Set.Make]. *) + val min_elt: t -> elt + (* Return the smallest element of the given set + (with respect to the [Ord.compare] ordering), or raise + [Not_found] if the set is empty. *) + val max_elt: t -> elt + (* Same as [min_elt], but returns the largest element of the + given set. *) val choose: t -> elt (* Return one element of the given set, or raise [Not_found] if the set is empty. Which element is chosen is unspecified, diff --git a/stdlib/string.mli b/stdlib/string.mli index d5985a3b3..a98276039 100644 --- a/stdlib/string.mli +++ b/stdlib/string.mli @@ -71,19 +71,20 @@ val escaped: string -> string Objective Caml. *) val index: string -> char -> int - (* [index s c] returns the position of the leftmost occurrence of - character [c] in string [s]. Raise [Not_found] if [c] does not - occur in [s]. *) + (* [String.index s c] returns the position of the leftmost + occurrence of character [c] in string [s]. + Raise [Not_found] if [c] does not occur in [s]. *) val rindex: string -> char -> int - (* [rindex s c] returns the position of the rightmost occurrence of - character [c] in string [s]. Raise [Not_found] if [c] does not - occur in [s]. *) + (* [String.rindex s c] returns the position of the rightmost + occurrence of character [c] in string [s]. + Raise [Not_found] if [c] does not occur in [s]. *) val index_from: string -> int -> char -> int val rindex_from: string -> int -> char -> int - (* Same as [index] and [rindex], but start searching at the character - position given as second argument. [index s c] is equivalent - to [index_from s 0 c], and [rindex s c] to - [rindex_from s (String.length s - 1) c]. *) + (* Same as [String.index] and [String.rindex], but start + searching at the character position given as second argument. + [String.index s c] is equivalent to [String.index_from s 0 c], + and [String.rindex s c] to + [String.rindex_from s (String.length s - 1) c]. *) val uppercase: string -> string (* Return a copy of the argument, with all lowercase letters diff --git a/stdlib/sys.mli b/stdlib/sys.mli index 53f6c5c49..2178df5da 100644 --- a/stdlib/sys.mli +++ b/stdlib/sys.mli @@ -16,7 +16,8 @@ val argv: string array (* The command line arguments given to the process. The first element is the command name used to invoke the program. - The following elements are the arguments given to the program. *) + The following elements are the command-line arguments + given to the program. *) external file_exists: string -> bool = "sys_file_exists" (* Test if a file with the given name exists. *) external remove: string -> unit = "sys_remove" @@ -39,7 +40,7 @@ external getcwd: unit -> string = "sys_getcwd" val interactive: bool ref (* This reference is initially set to [false] in standalone programs and to [true] if the code is being executed under - the interactive toplevel [csltop]. *) + the interactive toplevel system [ocaml]. *) val os_type: string (* Operating system currently executing the Caml program. One of ["Unix"], ["Win32"], or ["MacOS"]. *) @@ -59,6 +60,7 @@ type signal_behavior = | Signal_handle of (int -> unit) (* What to do when receiving a signal: - [Signal_default]: take the default behavior + (usually: abort the program) - [Signal_ignore]: ignore the signal - [Signal_handle f]: call function [f], giving it the signal number as argument. *)