diff options
Diffstat (limited to 'stdlib')
-rw-r--r-- | stdlib/lexing.mli | 7 | ||||
-rw-r--r-- | stdlib/string.mli | 82 |
2 files changed, 56 insertions, 33 deletions
diff --git a/stdlib/lexing.mli b/stdlib/lexing.mli index 1868825ce..884bf3844 100644 --- a/stdlib/lexing.mli +++ b/stdlib/lexing.mli @@ -62,10 +62,11 @@ type lexbuf = The lexer buffer holds the current state of the scanner, plus a function to refill the buffer from the input. - Note that the lexing engine will only change the [pos_cnum] field + At each token, the lexing engine will copy [lex_curr_p] to + [lex_start_p], then change the [pos_cnum] field of [lex_curr_p] by updating it with the number of characters read - since the start of the [lexbuf]. The other fields are copied - without change by the lexing engine. In order to keep them + since the start of the [lexbuf]. The other fields are left + unchanged by the lexing engine. In order to keep them accurate, they must be initialised before the first use of the lexbuf, and updated by the relevant lexer actions (i.e. at each end of line -- see also [new_line]). diff --git a/stdlib/string.mli b/stdlib/string.mli index 203d42d12..21bfb7c0e 100644 --- a/stdlib/string.mli +++ b/stdlib/string.mli @@ -13,37 +13,47 @@ (* $Id$ *) -(** String operations. *) +(** String operations. + Given a string [s] of length [l], we call character number in [s] + the index of a character in [s]. Indexes start at [0], and we will + call a character number valid in [s] if it falls within the range + [[0...l-1]]. A position is the point between two characters or at + the beginning or end of the string. We call a position valid + in [s] if it falls within the range [[0...l]]. Note that character + number [n] is between positions [n] and [n+1]. + + Two parameters [start] and [len] are said to designate a valid + substring of [s] if [len >= 0] and [start] and [start+len] are + valid positions in [s]. + *) external length : string -> int = "%string_length" (** Return the length (number of characters) of the given string. *) 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]. 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)]. *) + Raise [Invalid_argument] if [n] not a valid character number in [s]. *) 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]. 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)]. *) + + Raise [Invalid_argument] if [n] is not a valid character number in [s]. *) external create : int -> string = "caml_create_string" (** [String.create n] returns a fresh string of length [n]. The string initially contains arbitrary characters. - Raise [Invalid_argument] if [n < 0] or [n > Sys.max_string_length]. -*) + + Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. *) val make : int -> char -> string (** [String.make n c] returns a fresh string of length [n], filled with the character [c]. + Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}.*) val copy : string -> string @@ -51,16 +61,16 @@ val copy : string -> string val sub : string -> int -> int -> string (** [String.sub s start len] returns a fresh string of length [len], - containing the characters number [start] to [start + len - 1] - of string [s]. + containing the substring of [s] that starts at position [start] and + has length [len]. + Raise [Invalid_argument] if [start] and [len] do not - designate a valid substring of [s]; that is, if [start < 0], - or [len < 0], or [start + len > ]{!String.length}[ s]. *) + designate a valid substring of [s]. *) val fill : string -> int -> int -> char -> unit (** [String.fill s start len c] modifies string [s] in place, - replacing the characters number [start] to [start + len - 1] - by [c]. + replacing [len] characters by [c], starting at [start]. + Raise [Invalid_argument] if [start] and [len] do not designate a valid substring of [s]. *) @@ -69,7 +79,8 @@ val blit : string -> int -> string -> int -> int -> unit from string [src], starting at character number [srcoff], to string [dst], starting at character number [dstoff]. It works correctly even if [src] and [dst] are the same string, - and the source and destination chunks overlap. + and the source and destination intervals overlap. + Raise [Invalid_argument] if [srcoff] and [len] do not designate a valid substring of [src], or if [dstoff] and [len] do not designate a valid substring of [dst]. *) @@ -91,25 +102,33 @@ val escaped : string -> string not a copy. *) val index : string -> char -> int -(** [String.index s c] returns the position of the leftmost +(** [String.index s c] returns the character number of the first occurrence of character [c] in string [s]. + Raise [Not_found] if [c] does not occur in [s]. *) val rindex : string -> char -> int -(** [String.rindex s c] returns the position of the rightmost +(** [String.rindex s c] returns the character number of the last occurrence of character [c] in string [s]. + Raise [Not_found] if [c] does not occur in [s]. *) val index_from : string -> int -> char -> int -(** Same as {!String.index}, but start - searching at the character position given as second argument. - [String.index s c] is equivalent to [String.index_from s 0 c].*) +(** [String.index_from s i c] returns the character number of the + first occurrence of character [c] in string [s] after position [i]. + [String.index s c] is equivalent to [String.index_from s 0 c]. + + Raise [Invalid_argument] if [i] is not a valid position in [s]. + Raise [Not_found] if [c] does not occur in [s] after position [i]. *) val rindex_from : string -> int -> char -> int -(** Same as {!String.rindex}, but start - searching at the character position given as second argument. +(** [String.rindex_from s i c] returns the character number of the + last occurrence of character [c] in string [s] before position [i+1]. [String.rindex s c] is equivalent to - [String.rindex_from s (String.length s - 1) c]. *) + [String.rindex_from s (String.length s - 1) c]. + + Raise [Invalid_argument] if [i+1] is not a valid position in [s]. + Raise [Not_found] if [c] does not occur in [s] before position [i+1]. *) val contains : string -> char -> bool (** [String.contains s c] tests if character [c] @@ -117,15 +136,18 @@ val contains : string -> char -> bool val contains_from : string -> int -> char -> bool (** [String.contains_from s start c] tests if character [c] - appears in the substring of [s] starting from [start] to the end - of [s]. - Raise [Invalid_argument] if [start] is not a valid index of [s]. *) + appears in [s] after position [start]. + [String.contains s c] is equivalent to + [String.contains_from s 0 c]. + + Raise [Invalid_argument] if [start] is not a valid position in [s]. *) val rcontains_from : string -> int -> char -> bool (** [String.rcontains_from s stop c] tests if character [c] - appears in the substring of [s] starting from the beginning - of [s] to index [stop]. - Raise [Invalid_argument] if [stop] is not a valid index of [s]. *) + appears in [s] before position [stop+1]. + + Raise [Invalid_argument] if [stop < 0] or [stop+1] is not a valid + position in [s]. *) val uppercase : string -> string (** Return a copy of the argument, with all lowercase letters |