diff --git a/stdlib/arrayLabels.mli b/stdlib/arrayLabels.mli index 7f8750a64..f45f70c6d 100644 --- a/stdlib/arrayLabels.mli +++ b/stdlib/arrayLabels.mli @@ -22,17 +22,18 @@ external get : 'a array -> int -> 'a = "%array_safe_get" (** [Array.get a n] returns the element number [n] of array [a]. The first element has number 0. The last element has number [Array.length a - 1]. - Raise [Invalid_argument "Array.get"] if [n] is outside the range - 0 to [(Array.length a - 1)]. - You can also write [a.(n)] instead of [Array.get a n]. *) + You can also write [a.(n)] instead of [Array.get a n]. + + Raise [Invalid_argument "index out of bounds"] + if [n] is outside the range 0 to [(Array.length a - 1)]. *) external set : 'a array -> int -> 'a -> unit = "%array_safe_set" (** [Array.set a n x] modifies array [a] in place, replacing element number [n] with [x]. + You can also write [a.(n) <- x] instead of [Array.set a n x]. - Raise [Invalid_argument "Array.set"] if [n] is outside the range - 0 to [Array.length a - 1]. - You can also write [a.(n) <- x] instead of [Array.set a n x]. *) + Raise [Invalid_argument "index out of bounds"] + if [n] is outside the range 0 to [Array.length a - 1]. *) external make : int -> 'a -> 'a array = "caml_make_vect" (** [Array.make n x] returns a fresh array of length [n], @@ -54,7 +55,11 @@ val init : int -> f:(int -> 'a) -> 'a array (** [Array.init n f] returns a fresh array of length [n], 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]. *) + applied to the integers [0] to [n-1]. + + Raise [Invalid_argument] if [n < 0] or [n > Sys.max_array_length]. + If the return type of [f] is [float], then the maximum + size is only [Sys.max_array_length / 2].*) val make_matrix : dimx:int -> dimy:int -> 'a -> 'a array array (** [Array.make_matrix dimx dimy e] returns a two-dimensional array @@ -64,7 +69,7 @@ val make_matrix : dimx:int -> dimy:int -> 'a -> 'a array array The element ([x,y]) of a matrix [m] is accessed with the notation [m.(x).(y)]. - Raise [Invalid_argument] if [dimx] or [dimy] is less than 1 or + Raise [Invalid_argument] if [dimx] or [dimy] is negative or greater than [Sys.max_array_length]. If the value of [e] is a floating-point number, then the maximum size is only [Sys.max_array_length / 2]. *) @@ -151,7 +156,6 @@ val fold_right : f:('b -> 'a -> 'a) -> 'b array -> init:'a -> 'a where [n] is the length of the array [a]. *) - (** {6 Sorting} *) @@ -159,24 +163,36 @@ val sort : cmp:('a -> 'a -> int) -> 'a array -> unit (** Sort an array in increasing order according to a comparison function. The comparison function must return 0 if its arguments compare as equal, a positive integer if the first is greater, - and a negative integer if the first is smaller. For example, - the {!Pervasives.compare} function is a suitable comparison function. - After calling [Array.sort], the array is sorted in place in - increasing order. + and a negative integer if the first is smaller (see below for a + complete specification). For example, {!Pervasives.compare} is + a suitable comparison function, provided there are no floating-point + NaN values in the data. After calling [Array.sort], the + array is sorted in place in increasing order. [Array.sort] is guaranteed to run in constant heap space - and logarithmic stack space. - + and (at most) logarithmic stack space. The current implementation uses Heap Sort. It runs in constant stack space. + + Specification of the comparison function: + Let [a] be the array and [cmp] the comparison function. The following + must be true for all x, y, z in a : +- [cmp x y] > 0 if and only if [cmp y x] < 0 +- if [cmp x y] >= 0 and [cmp y z] >= 0 then [cmp x z] >= 0 + + When [Array.sort] returns, [a] contains the same elements as before, + reordered in such a way that for all i and j valid indices of [a] : +- [cmp a.(i) a.(j)] >= 0 if and only if i >= j *) val stable_sort : cmp:('a -> 'a -> int) -> 'a array -> unit -(** Same as {!ArrayLabels.sort}, but the sorting algorithm is stable and - not guaranteed to use a fixed amount of heap memory. - The current implementation is Merge Sort. It uses [n/2] +(** Same as {!ArrayLabels.sort}, but the sorting algorithm is stable (i.e. + elements that compare equal are kept in their original order) and + not guaranteed to run in constant heap space. + + The current implementation uses Merge Sort. It uses [n/2] words of heap space, where [n] is the length of the array. - It is faster than the current implementation of {!ArrayLabels.sort}. + It is usually faster than the current implementation of {!ArrayLabels.sort}. *) val fast_sort : cmp:('a -> 'a -> int) -> 'a array -> unit diff --git a/stdlib/listLabels.mli b/stdlib/listLabels.mli index 1cf43ee09..1f6a4ead4 100644 --- a/stdlib/listLabels.mli +++ b/stdlib/listLabels.mli @@ -13,7 +13,6 @@ (* $Id$ *) - (** List operations. Some functions are flagged as not tail-recursive. A tail-recursive @@ -39,9 +38,10 @@ val tl : 'a list -> 'a list [Failure "tl"] if the list is empty. *) val nth : 'a list -> int -> 'a -(** Return the n-th element of the given list. +(** Return the [n]-th element of the given list. The first element (head of the list) is at position 0. - Raise [Failure "nth"] if the list is too short. *) + Raise [Failure "nth"] if the list is too short. + Raise [Invalid_argument "List.nth"] if [n] is negative. *) val rev : 'a list -> 'a list (** List reversal. *) @@ -57,11 +57,13 @@ val rev_append : 'a list -> 'a list -> 'a list tail-recursive and more efficient. *) val concat : 'a list list -> 'a list -(** Concatenate a list of lists. Not tail-recursive +(** Concatenate a list of lists. The elements of the argument are all + concatenated together (in the same order) to give the result. + Not tail-recursive (length of the argument + length of the longest sub-list). *) val flatten : 'a list list -> 'a list -(** Flatten a list of lists. Not tail-recursive +(** Same as [concat]. Not tail-recursive (length of the argument + length of the longest sub-list). *) @@ -108,8 +110,8 @@ val map2 : f:('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list different lengths. Not tail-recursive. *) val rev_map2 : f:('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list -(** [List.rev_map2 f l] gives the same result as - {!ListLabels.rev}[ (]{!ListLabels.map2}[ f l)], but is tail-recursive and +(** [List.rev_map2 f l1 l2] gives the same result as + {!ListLabels.rev}[ (]{!ListLabels.map2}[ f l1 l2)], but is tail-recursive and more efficient. *) val fold_left2 : @@ -127,8 +129,6 @@ val fold_right2 : different lengths. Not tail-recursive. *) - - (** {6 List scanning} *) @@ -161,8 +161,6 @@ val memq : 'a -> set:'a list -> bool equality to compare list elements. *) - - (** {6 List searching} *) @@ -188,8 +186,6 @@ val partition : f:('a -> bool) -> 'a list -> 'a list * 'a list The order of the elements in the input list is preserved. *) - - (** {6 Association lists} *) @@ -202,8 +198,8 @@ val assoc : 'a -> ('a * 'b) list -> 'b list [l]. *) val assq : 'a -> ('a * 'b) list -> 'b -(** Same as {!ListLabels.assoc}, but uses physical equality instead of structural - equality to compare keys. *) +(** Same as {!ListLabels.assoc}, but uses physical equality instead of + structural equality to compare keys. *) val mem_assoc : 'a -> map:('a * 'b) list -> bool (** Same as {!ListLabels.assoc}, but simply return true if a binding exists, @@ -219,12 +215,10 @@ val remove_assoc : 'a -> ('a * 'b) list -> ('a * 'b) list Not tail-recursive. *) val remove_assq : 'a -> ('a * 'b) list -> ('a * 'b) list -(** Same as {!ListLabels.remove_assq}, but uses physical equality instead +(** Same as {!ListLabels.remove_assoc}, but uses physical equality instead of structural equality to compare keys. Not tail-recursive. *) - - (** {6 Lists of pairs} *) @@ -242,29 +236,31 @@ val combine : 'a list -> 'b list -> ('a * 'b) list have different lengths. Not tail-recursive. *) - (** {6 Sorting} *) val sort : cmp:('a -> 'a -> int) -> 'a list -> 'a list (** Sort a list in increasing order according to a comparison - function. The comparison function must return 0 if it arguments + function. The comparison function must return 0 if its arguments compare as equal, a positive integer if the first is greater, - and a negative integer if the first is smaller. For example, - the [compare] function is a suitable comparison function. + and a negative integer if the first is smaller (see Array.sort for + a complete specification). For example, + {!Pervasives.compare} is a suitable comparison function. The resulting list is sorted in increasing order. [List.sort] is guaranteed to run in constant heap space (in addition to the size of the result list) and logarithmic stack space. - The current implementation uses Merge Sort and is the same as - {!ListLabels.stable_sort}. + The current implementation uses Merge Sort. It runs in constant + heap space and logarithmic stack space. *) val stable_sort : cmp:('a -> 'a -> int) -> 'a list -> 'a list -(** Same as {!ListLabels.sort}, but the sorting algorithm is stable. +(** Same as {!ListLabels.sort}, but the sorting algorithm is guaranteed to + be stable (i.e. elements that compare equal are kept in their + original order) . - The current implementation is Merge Sort. It runs in constant + The current implementation uses Merge Sort. It runs in constant heap space and logarithmic stack space. *) diff --git a/stdlib/stringLabels.mli b/stdlib/stringLabels.mli index 7ea72bafe..9cbee708b 100644 --- a/stdlib/stringLabels.mli +++ b/stdlib/stringLabels.mli @@ -22,16 +22,18 @@ external get : string -> int -> char = "%string_safe_get" (** [String.get s n] returns character number [n] in string [s]. The first character is character number 0. The last character is character number [String.length s - 1]. - Raise [Invalid_argument] if [n] is outside the range - 0 to [(String.length s - 1)]. - You can also write [s.[n]] instead of [String.get s n]. *) + You can also write [s.[n]] instead of [String.get s n]. + + Raise [Invalid_argument "index out of bounds"] + if [n] is outside the range 0 to [(String.length s - 1)]. *) + external set : string -> int -> char -> unit = "%string_safe_set" (** [String.set s n c] modifies string [s] in place, replacing the character number [n] by [c]. - Raise [Invalid_argument] if [n] is outside the range - 0 to [(String.length s - 1)]. - You can also write [s.[n] <- c] instead of [String.set s n c]. *) + You can also write [s.[n] <- c] instead of [String.set s n c]. + Raise [Invalid_argument "index out of bounds"] + if [n] is outside the range 0 to [(String.length s - 1)]. *) external create : int -> string = "caml_create_string" (** [String.create n] returns a fresh string of length [n]. @@ -80,7 +82,7 @@ val concat : sep:string -> string list -> string val iter : f:(char -> unit) -> string -> unit (** [String.iter f s] applies function [f] in turn to all the characters of [s]. It is equivalent to - [f s.(0); f s.(1); ...; f s.(String.length s - 1); ()]. *) + [f s.[0]; f s.[1]; ...; f s.[String.length s - 1]; ()]. *) val escaped : string -> string (** Return a copy of the argument, with special characters @@ -137,10 +139,10 @@ val lowercase : string -> string Latin-1 (8859-1) character set. *) val capitalize : string -> string -(** Return a copy of the argument, with the first letter set to uppercase. *) +(** Return a copy of the argument, with the first character set to uppercase. *) val uncapitalize : string -> string -(** Return a copy of the argument, with the first letter set to lowercase. *) +(** Return a copy of the argument, with the first character set to lowercase. *) type t = string (** An alias for the type of strings. *)