diff options
Diffstat (limited to 'stdlib')
35 files changed, 847 insertions, 130 deletions
diff --git a/stdlib/.cvsignore b/stdlib/.cvsignore index d583cf4ee..6921a35c0 100644 --- a/stdlib/.cvsignore +++ b/stdlib/.cvsignore @@ -1,2 +1,3 @@ camlheader camlheader_ur +labelled-*
\ No newline at end of file diff --git a/stdlib/.depend b/stdlib/.depend index 6c18ecadb..17cc04598 100644 --- a/stdlib/.depend +++ b/stdlib/.depend @@ -6,6 +6,8 @@ arg.cmo: array.cmi list.cmi printf.cmi string.cmi sys.cmi arg.cmi arg.cmx: array.cmx list.cmx printf.cmx string.cmx sys.cmx arg.cmi array.cmo: array.cmi array.cmx: array.cmi +arrayLabels.cmo: array.cmi arrayLabels.cmi +arrayLabels.cmx: array.cmx arrayLabels.cmi buffer.cmo: string.cmi sys.cmi buffer.cmi buffer.cmx: string.cmx sys.cmx buffer.cmi callback.cmo: obj.cmi callback.cmi @@ -34,6 +36,8 @@ lexing.cmo: string.cmi lexing.cmi lexing.cmx: string.cmx lexing.cmi list.cmo: array.cmi list.cmi list.cmx: array.cmx list.cmi +listLabels.cmo: list.cmi listLabels.cmi +listLabels.cmx: list.cmx listLabels.cmi map.cmo: map.cmi map.cmx: map.cmi marshal.cmo: string.cmi marshal.cmi @@ -64,10 +68,14 @@ sort.cmo: array.cmi sort.cmi sort.cmx: array.cmx sort.cmi stack.cmo: list.cmi stack.cmi stack.cmx: list.cmx stack.cmi +stdLabels.cmo: arrayLabels.cmi listLabels.cmi stringLabels.cmi stdLabels.cmi +stdLabels.cmx: arrayLabels.cmx listLabels.cmx stringLabels.cmx stdLabels.cmi stream.cmo: list.cmi obj.cmi string.cmi stream.cmi stream.cmx: list.cmx obj.cmx string.cmx stream.cmi string.cmo: char.cmi list.cmi string.cmi string.cmx: char.cmx list.cmx string.cmi +stringLabels.cmo: string.cmi stringLabels.cmi +stringLabels.cmx: string.cmx stringLabels.cmi sys.cmo: sys.cmi sys.cmx: sys.cmi weak.cmo: obj.cmi weak.cmi diff --git a/stdlib/Makefile b/stdlib/Makefile index 6c4cdd084..9a9d58823 100644 --- a/stdlib/Makefile +++ b/stdlib/Makefile @@ -23,13 +23,17 @@ CAMLOPT=$(RUNTIME) $(OPTCOMPILER) OPTCOMPFLAGS= CAMLDEP=../boot/ocamlrun ../tools/ocamldep -OBJS=pervasives.cmo array.cmo list.cmo char.cmo string.cmo sys.cmo \ +BASIC=pervasives.cmo array.cmo list.cmo char.cmo string.cmo sys.cmo \ hashtbl.cmo sort.cmo marshal.cmo obj.cmo \ lexing.cmo parsing.cmo \ set.cmo map.cmo stack.cmo queue.cmo stream.cmo \ buffer.cmo printf.cmo format.cmo arg.cmo printexc.cmo gc.cmo \ digest.cmo random.cmo oo.cmo genlex.cmo callback.cmo weak.cmo \ lazy.cmo filename.cmo int32.cmo int64.cmo nativeint.cmo +LABELLED=arrayLabels.ml listLabels.ml stringLabels.ml + +OBJS=$(BASIC) labelled.cmo stdLabels.cmo +ALLOBJS=$(BASIC) $(LABELLED:.ml=.cmo) stdLabels.cmo all: stdlib.cma std_exit.cmo camlheader camlheader_ur @@ -59,13 +63,13 @@ installopt-prof: cd $(LIBDIR); $(RANLIB) stdlib.p.a stdlib.cma: $(OBJS) - $(CAMLC) -a -o stdlib.cma $(OBJS) + $(CAMLC) -a -o stdlib.cma $(ALLOBJS) stdlib.cmxa: $(OBJS:.cmo=.cmx) - $(CAMLOPT) -a -o stdlib.cmxa $(OBJS:.cmo=.cmx) + $(CAMLOPT) -a -o stdlib.cmxa $(ALLOBJS:.cmo=.cmx) stdlib.p.cmxa: $(OBJS:.cmo=.p.cmx) - $(CAMLOPT) -a -o stdlib.p.cmxa $(OBJS:.cmo=.p.cmx) + $(CAMLOPT) -a -o stdlib.p.cmxa $(ALLOBJS:.cmo=.p.cmx) camlheader camlheader_ur: header.c ../config/Makefile if $(SHARPBANGSCRIPTS); then \ @@ -103,30 +107,42 @@ pervasives.p.cmx: pervasives.ml oo.cmi: oo.mli $(CAMLC) $(COMPFLAGS) -nopervasives -c oo.mli +# labelled modules require the -nolabels flag +labelled.cmo: + $(MAKE) EXTRAFLAGS=-nolabels $(LABELLED:.ml=.cmo) + touch $@ +labelled.cmx: + $(MAKE) EXTRAFLAGS=-nolabels $(LABELLED:.ml=.cmx) + touch $@ +labelled.p.cmx: + $(MAKE) EXTRAFLAGS=-nolabels $(LABELLED:.ml=.p.cmx) + touch $@ + .SUFFIXES: .mli .ml .cmi .cmo .cmx .p.cmx .mli.cmi: - $(CAMLC) $(COMPFLAGS) -c $< + $(CAMLC) $(COMPFLAGS) $(EXTRAFLAGS) -c $< .ml.cmo: - $(CAMLC) $(COMPFLAGS) -c $< + $(CAMLC) $(COMPFLAGS) $(EXTRAFLAGS) -c $< .ml.cmx: - $(CAMLOPT) $(OPTCOMPFLAGS) -c $< + $(CAMLOPT) $(OPTCOMPFLAGS) $(EXTRAFLAGS) -c $< .ml.p.cmx: @if test -f $*.cmx; then mv $*.cmx $*.n.cmx; else :; fi @if test -f $*.o; then mv $*.o $*.n.o; else :; fi - $(CAMLOPT) $(OPTCOMPFLAGS) -p -c $< + $(CAMLOPT) $(OPTCOMPFLAGS) $(EXTRAFLAGS) -p -c $< mv $*.cmx $*.p.cmx mv $*.o $*.p.o @if test -f $*.n.cmx; then mv $*.n.cmx $*.cmx; else :; fi @if test -f $*.n.o; then mv $*.n.o $*.o; else :; fi -$(OBJS) std_exit.cmo: pervasives.cmi $(COMPILER) -$(OBJS:.cmo=.cmx) std_exit.cmx: pervasives.cmi $(OPTCOMPILER) -$(OBJS:.cmo=.p.cmx) std_exit.p.cmx: pervasives.cmi $(OPTCOMPILER) -$(OBJS:.cmo=.cmi) std_exit.cmi: $(COMPILER) +$(ALLOBJS) labelled.cmo std_exit.cmo: pervasives.cmi $(COMPILER) +$(ALLOBJS:.cmo=.cmx) labelled.cmx std_exit.cmx: pervasives.cmi $(OPTCOMPILER) +$(ALLOBJS:.cmo=.p.cmx) labelled.p.cmx std_exit.p.cmx: pervasives.cmi $(OPTCOMPILER) +$(ALLOBJS:.cmo=.cmi) std_exit.cmi: $(COMPILER) +labelled.cmo labelled.cmx labelled.p.cmx: $(LABELLED) $(LABELLED:.ml=.mli) clean:: rm -f *.cm* *.o *.a diff --git a/stdlib/arg.mli b/stdlib/arg.mli index e6687b596..7e693704a 100644 --- a/stdlib/arg.mli +++ b/stdlib/arg.mli @@ -51,8 +51,8 @@ type spec = (* The concrete type describing the behavior associated with a keyword. *) -val parse : keywords:(string * spec * string) list -> - others:(string -> unit) -> errmsg:string -> unit +val parse : (string * spec * string) list -> + (string -> unit) -> string -> unit (* [Arg.parse speclist anonfun usage_msg] parses the command line. [speclist] is a list of triples [(key, spec, doc)]. @@ -85,7 +85,7 @@ exception Bad of string message to reject invalid arguments. *) -val usage : keywords:(string * spec * string) list -> errmsg:string -> unit +val usage : (string * spec * string) list -> string -> unit (* [Arg.usage speclist usage_msg] prints an error message including the list of valid options. This is the same message that diff --git a/stdlib/array.mli b/stdlib/array.mli index fce9dd300..dcff7ea8f 100644 --- a/stdlib/array.mli +++ b/stdlib/array.mli @@ -42,13 +42,13 @@ external create: int -> 'a -> 'a array = "make_vect" If the value of [x] is a floating-point number, then the maximum size is only [Sys.max_array_length / 2]. [Array.create] is a deprecated alias for [Array.make]. *) -val init: int -> f:(int -> 'a) -> 'a array +val init: int -> (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]. *) -val make_matrix: dimx:int -> dimy:int -> 'a -> 'a array array -val create_matrix: dimx:int -> dimy:int -> 'a -> 'a array array +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 (an array of arrays) with first dimension [dimx] and second dimension [dimy]. All the elements of this new matrix @@ -66,7 +66,7 @@ val append: 'a array -> 'a array -> 'a array 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 -> pos:int -> len:int -> 'a array +val sub: 'a array -> int -> int -> 'a array (* [Array.sub a start len] returns a fresh array of length [len], containing the elements number [start] to [start + len - 1] of array [a]. @@ -76,13 +76,12 @@ val sub: 'a array -> pos:int -> len:int -> 'a array val copy: 'a array -> 'a array (* [Array.copy a] returns a copy of [a], that is, a fresh array containing the same elements as [a]. *) -val fill: 'a array -> pos:int -> len:int -> 'a -> unit +val fill: 'a array -> int -> int -> 'a -> unit (* [Array.fill a ofs len x] modifies the array [a] in place, storing [x] in elements number [ofs] to [ofs + len - 1]. Raise [Invalid_argument "Array.fill"] if [ofs] and [len] do not designate a valid subarray of [a]. *) -val blit: src:'a array -> src_pos:int -> - dst:'a array -> dst_pos:int -> len:int -> unit +val blit: 'a array -> int -> 'a array -> int -> int -> unit (* [Array.blit v1 o1 v2 o2 len] copies [len] elements from array [v1], starting at element number [o1], to array [v2], starting at element number [o2]. It works correctly even if @@ -96,30 +95,30 @@ val to_list: 'a array -> 'a list val of_list: 'a list -> 'a array (* [Array.of_list l] returns a fresh array containing the elements of [l]. *) -val iter: f:('a -> unit) -> 'a array -> unit +val iter: ('a -> unit) -> 'a array -> unit (* [Array.iter f a] applies function [f] in turn to all the elements of [a]. It is equivalent to [f a.(0); f a.(1); ...; f a.(Array.length a - 1); ()]. *) -val map: f:('a -> 'b) -> 'a array -> 'b array +val map: ('a -> 'b) -> 'a array -> 'b array (* [Array.map f a] applies function [f] to all the elements of [a], and builds an array with the results returned by [f]: [[| f a.(0); f a.(1); ...; f a.(Array.length a - 1) |]]. *) -val iteri: f:(int -> 'a -> unit) -> 'a array -> unit -val mapi: f:(int -> 'a -> 'b) -> 'a array -> 'b array +val iteri: (int -> 'a -> unit) -> 'a array -> unit +val mapi: (int -> 'a -> 'b) -> 'a array -> 'b array (* Same as [Array.iter] and [Array.map] respectively, but the function is applied to the index of the element as first argument, and the element itself as second argument. *) -val fold_left: f:('a -> 'b -> 'a) -> init:'a -> 'b array -> 'a +val fold_left: ('a -> 'b -> 'a) -> 'a -> 'b array -> 'a (* [Array.fold_left f x a] computes [f (... (f (f x a.(0)) a.(1)) ...) a.(n-1)], where [n] is the length of the array [a]. *) -val fold_right: f:('b -> 'a -> 'a) -> 'b array -> init:'a -> 'a +val fold_right: ('b -> 'a -> 'a) -> 'b array -> 'a -> 'a (* [Array.fold_right f a x] computes [f a.(0) (f a.(1) ( ... (f a.(n-1) x) ...))], where [n] is the length of the array [a]. *) (** Sorting *) -val sort : cmp:('a -> 'a -> int) -> 'a array -> unit;; +val sort : ('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, @@ -134,7 +133,7 @@ val sort : cmp:('a -> 'a -> int) -> 'a array -> unit;; stack space. *) -val stable_sort : cmp:('a -> 'a -> int) -> 'a array -> unit;; +val stable_sort : ('a -> 'a -> int) -> 'a array -> unit;; (* Same as [Array.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] diff --git a/stdlib/arrayLabels.ml b/stdlib/arrayLabels.ml new file mode 100644 index 000000000..b5fd5e810 --- /dev/null +++ b/stdlib/arrayLabels.ml @@ -0,0 +1,17 @@ +(***********************************************************************) +(* *) +(* Objective Caml *) +(* *) +(* 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. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +(* Module [ArrayLabels]: labelled Array module *) + +include Array diff --git a/stdlib/arrayLabels.mli b/stdlib/arrayLabels.mli new file mode 100644 index 000000000..256477fa6 --- /dev/null +++ b/stdlib/arrayLabels.mli @@ -0,0 +1,148 @@ +(***********************************************************************) +(* *) +(* Objective Caml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1996 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. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +(* Module [Array]: array operations *) + +external length : 'a array -> int = "%array_length" + (* Return the length (number of elements) of the given array. *) +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]. *) +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]. + 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]. *) +external make: int -> 'a -> 'a array = "make_vect" +external create: int -> 'a -> 'a array = "make_vect" + (* [Array.make n x] returns a fresh array of length [n], + initialized with [x]. + All the elements of this new array are initially + physically equal to [x] (in the sense of the [==] predicate). + Consequently, if [x] is mutable, it is shared among all elements + of the array, and modifying [x] through one of the array entries + will modify all other entries at the same time. + Raise [Invalid_argument] if [n <= 0] or [n > Sys.max_array_length]. + If the value of [x] is a floating-point number, then the maximum + size is only [Sys.max_array_length / 2]. + [Array.create] is a deprecated alias for [Array.make]. *) +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]. *) +val make_matrix: dimx:int -> dimy:int -> 'a -> 'a array array +val create_matrix: dimx:int -> dimy:int -> 'a -> 'a array array + (* [Array.make_matrix dimx dimy e] returns a two-dimensional array + (an array of arrays) with first dimension [dimx] and + second dimension [dimy]. All the elements of this new matrix + are initially physically equal to [e]. + 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 + 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]. + [Array.create_matrix] is a deprecated alias for [Array.make_matrix]. + *) +val append: 'a array -> 'a array -> 'a array + (* [Array.append v1 v2] returns a fresh array containing the + 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 -> pos:int -> len:int -> 'a array + (* [Array.sub a start len] returns a fresh array of length [len], + containing the elements number [start] to [start + len - 1] + of array [a]. + Raise [Invalid_argument "Array.sub"] if [start] and [len] do not + designate a valid subarray of [a]; that is, if + [start < 0], or [len < 0], or [start + len > Array.length a]. *) +val copy: 'a array -> 'a array + (* [Array.copy a] returns a copy of [a], that is, a fresh array + containing the same elements as [a]. *) +val fill: 'a array -> pos:int -> len:int -> 'a -> unit + (* [Array.fill a ofs len x] modifies the array [a] in place, + storing [x] in elements number [ofs] to [ofs + len - 1]. + Raise [Invalid_argument "Array.fill"] if [ofs] and [len] do not + designate a valid subarray of [a]. *) +val blit: src:'a array -> src_pos:int -> + dst:'a array -> dst_pos:int -> len:int -> unit + (* [Array.blit v1 o1 v2 o2 len] copies [len] elements + from array [v1], starting at element number [o1], to array [v2], + starting at element number [o2]. It works correctly even if + [v1] and [v2] are the same array, and the source and + destination chunks overlap. + Raise [Invalid_argument "Array.blit"] if [o1] and [len] do not + designate a valid subarray of [v1], or if [o2] and [len] do not + designate a valid subarray of [v2]. *) +val to_list: 'a array -> 'a list + (* [Array.to_list a] returns the list of all the elements of [a]. *) +val of_list: 'a list -> 'a array + (* [Array.of_list l] returns a fresh array containing the elements + of [l]. *) +val iter: f:('a -> unit) -> 'a array -> unit + (* [Array.iter f a] applies function [f] in turn to all + the elements of [a]. It is equivalent to + [f a.(0); f a.(1); ...; f a.(Array.length a - 1); ()]. *) +val map: f:('a -> 'b) -> 'a array -> 'b array + (* [Array.map f a] applies function [f] to all the elements of [a], + and builds an array with the results returned by [f]: + [[| f a.(0); f a.(1); ...; f a.(Array.length a - 1) |]]. *) +val iteri: f:(int -> 'a -> unit) -> 'a array -> unit +val mapi: f:(int -> 'a -> 'b) -> 'a array -> 'b array + (* Same as [Array.iter] and [Array.map] respectively, but the + function is applied to the index of the element as first argument, + and the element itself as second argument. *) +val fold_left: f:('a -> 'b -> 'a) -> init:'a -> 'b array -> 'a + (* [Array.fold_left f x a] computes + [f (... (f (f x a.(0)) a.(1)) ...) a.(n-1)], + where [n] is the length of the array [a]. *) +val fold_right: f:('b -> 'a -> 'a) -> 'b array -> init:'a -> 'a + (* [Array.fold_right f a x] computes + [f a.(0) (f a.(1) ( ... (f a.(n-1) x) ...))], + where [n] is the length of the array [a]. *) + +(** Sorting *) +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 [compare] function is a suitable comparison function. + 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. + + The current implementation uses Heap Sort. It runs in constant + stack space. + *) + +val stable_sort : cmp:('a -> 'a -> int) -> 'a array -> unit;; + (* Same as [Array.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] + words of heap space, where [n] is the length of the array. + It is faster than the current implementation of [Array.sort]. + *) + +(*--*) + +external unsafe_get: 'a array -> int -> 'a = "%array_unsafe_get" +external unsafe_set: 'a array -> int -> 'a -> unit = "%array_unsafe_set" diff --git a/stdlib/buffer.mli b/stdlib/buffer.mli index adb7e3038..5b8499502 100644 --- a/stdlib/buffer.mli +++ b/stdlib/buffer.mli @@ -52,13 +52,13 @@ val add_char : t -> char -> unit val add_string : t -> string -> unit (* [add_string b s] appends the string [s] at the end of the buffer [b]. *) -val add_substring : t -> string -> pos:int -> len:int -> unit +val add_substring : t -> string -> int -> int -> unit (* [add_substring b s ofs len] takes [len] characters from offset [ofs] in string [s] and appends them at the end of the buffer [b]. *) -val add_buffer : t -> src:t -> unit +val add_buffer : t -> t -> unit (* [add_buffer b1 b2] appends the current contents of buffer [b2] at the end of buffer [b1]. [b2] is not modified. *) -val add_channel : t -> in_channel -> len:int -> unit +val add_channel : t -> in_channel -> int -> unit (* [add_channel b ic n] reads exactly [n] character from the input channel [ic] and stores them at the end of buffer [b]. Raise [End_of_file] if the channel contains fewer than [n] diff --git a/stdlib/digest.mli b/stdlib/digest.mli index dcba690f9..83d48b1e9 100644 --- a/stdlib/digest.mli +++ b/stdlib/digest.mli @@ -23,11 +23,11 @@ type t = string (* The type of digests: 16-character strings. *) val string: string -> t (* Return the digest of the given string. *) -val substring: string -> pos:int -> len:int -> t +val substring: string -> int -> int -> t (* [Digest.substring s ofs len] returns the digest of the substring of [s] starting at character number [ofs] and containing [len] characters. *) -external channel: in_channel -> len:int -> t = "md5_chan" +external channel: in_channel -> int -> t = "md5_chan" (* [Digest.channel ic len] reads [len] characters from channel [ic] and returns their digest. *) val file: string -> t diff --git a/stdlib/filename.mli b/stdlib/filename.mli index 2d3bf6513..1077bf08b 100644 --- a/stdlib/filename.mli +++ b/stdlib/filename.mli @@ -52,7 +52,7 @@ val dirname : string -> string 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 [Sys.chdir]. *) -val temp_file : prefix:string -> suffix:string -> string +val temp_file : string -> string -> string (* [temp_file prefix suffix] returns the name of a fresh temporary file in the temporary directory. The base name of the temporary file is formed by concatenating diff --git a/stdlib/format.ml b/stdlib/format.ml index ff26946cd..cbbb1a16a 100644 --- a/stdlib/format.ml +++ b/stdlib/format.ml @@ -566,7 +566,8 @@ let pp_set_formatter_output_functions state f g = let pp_get_formatter_output_functions state () = (state.pp_output_function, state.pp_flush_function);; -let pp_set_all_formatter_output_functions state f g h i = +let pp_set_all_formatter_output_functions state + ~out:f ~flush:g ~newline:h ~spaces:i = pp_set_formatter_output_functions state f g; state.pp_output_newline <- (function _ -> function () -> h ()); state.pp_output_spaces <- (function _ -> function n -> i n);; diff --git a/stdlib/format.mli b/stdlib/format.mli index 1ad568caa..72f2db390 100644 --- a/stdlib/format.mli +++ b/stdlib/format.mli @@ -234,8 +234,7 @@ val set_formatter_out_channel : out_channel -> unit;; (*** Changing the meaning of printing material *) val set_formatter_output_functions : - out:(buf:string -> pos:int -> len:int -> unit) -> - flush:(unit -> unit) -> unit;; + (string -> int -> int -> unit) -> (unit -> unit) -> unit;; (* [set_formatter_output_functions out flush] redirects the pretty-printer output to the functions [out] and [flush]. The [out] function performs the pretty-printer output. @@ -245,14 +244,13 @@ val set_formatter_output_functions : called whenever the pretty-printer is flushed using [print_flush] or [print_newline]. *) val get_formatter_output_functions : - unit -> (buf:string -> pos:int -> len:int -> unit) * (unit -> unit);; + unit -> (string -> int -> int -> unit) * (unit -> unit);; (* Return the current output functions of the pretty-printer. *) (*** Changing the meaning of pretty printing (indentation, line breaking, and printing material) *) val set_all_formatter_output_functions : - out:(buf:string -> pos:int -> len:int -> unit) -> - flush:(unit -> unit) -> - newline:(unit -> unit) -> space:(int -> unit) -> unit;; + out:(string -> int -> int -> unit) -> flush:(unit -> unit) -> + newline:(unit -> unit) -> spaces:(int -> unit) -> unit;; (* [set_all_formatter_output_functions out flush outnewline outspace] redirects the pretty-printer output to the functions [out] and [flush] as described in @@ -269,7 +267,7 @@ val set_all_formatter_output_functions : [outspace] and [outnewline] are [out (String.make n ' ') 0 n] and [out "\n" 0 1]. *) val get_all_formatter_output_functions : unit -> - (buf:string -> pos:int -> len:int -> unit) * (unit -> unit) * + (string -> int -> int -> unit) * (unit -> unit) * (unit -> unit) * (int -> unit);; (* Return the current output functions of the pretty-printer, including line breaking and indentation functions. *) @@ -323,8 +321,7 @@ val flush_str_formatter : unit -> string;; [str_formatter] is defined as [formatter_of_buffer stdbuf]. *) val make_formatter : - out:(buf:string -> pos:int -> len:int -> unit) -> - flush:(unit -> unit) -> formatter;; + (string -> int -> int -> unit) -> (unit -> unit) -> formatter;; (* [make_formatter out flush] returns a new formatter that writes according to the output function [out], and the flushing function [flush]. Hence, a formatter to out channel [oc] @@ -365,16 +362,14 @@ val pp_set_ellipsis_text : formatter -> string -> unit;; val pp_get_ellipsis_text : formatter -> unit -> string;; val pp_set_formatter_out_channel : formatter -> out_channel -> unit;; val pp_set_formatter_output_functions : formatter -> - out:(buf:string -> pos:int -> len:int -> unit) -> - flush:(unit -> unit) -> unit;; + (string -> int -> int -> unit) -> (unit -> unit) -> unit;; val pp_get_formatter_output_functions : formatter -> unit -> - (buf:string -> pos:int -> len:int -> unit) * (unit -> unit);; + (string -> int -> int -> unit) * (unit -> unit);; val pp_set_all_formatter_output_functions : formatter -> - out:(buf:string -> pos:int -> len:int -> unit) -> - flush:(unit -> unit) -> - newline:(unit -> unit) -> space:(int -> unit) -> unit;; + out:(string -> int -> int -> unit) -> flush:(unit -> unit) -> + newline:(unit -> unit) -> spaces:(int -> unit) -> unit;; val pp_get_all_formatter_output_functions : formatter -> unit -> - (buf:string -> pos:int -> len:int -> unit) * (unit -> unit) * + (string -> int -> int -> unit) * (unit -> unit) * (unit -> unit) * (int -> unit);; (* The basic functions to use with formatters. These functions are the basic ones: usual functions diff --git a/stdlib/hashtbl.ml b/stdlib/hashtbl.ml index 4fd386fe6..4a26087c5 100644 --- a/stdlib/hashtbl.ml +++ b/stdlib/hashtbl.ml @@ -177,7 +177,7 @@ module type S = val replace : 'a t -> key -> 'a -> unit val mem : 'a t -> key -> bool val iter: (key -> 'a -> unit) -> 'a t -> unit - val fold: f:(key:key -> data:'a -> 'b -> 'b) -> 'a t -> init:'b -> 'b + val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b end module Make(H: HashedType): (S with type key = H.t) = diff --git a/stdlib/hashtbl.mli b/stdlib/hashtbl.mli index c2cdd25a9..d56bbd352 100644 --- a/stdlib/hashtbl.mli +++ b/stdlib/hashtbl.mli @@ -31,7 +31,7 @@ val create : int -> ('a,'b) t val clear : ('a, 'b) t -> unit (* Empty a hash table. *) -val add : ('a, 'b) t -> key:'a -> data:'b -> 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 [Hashtbl.remove tbl x], @@ -56,21 +56,21 @@ val remove : ('a, 'b) t -> 'a -> unit restoring the previous binding if it exists. It does nothing if [x] is not bound in [tbl]. *) -val replace : ('a, 'b) t -> key:'a -> data:'b -> unit +val replace : ('a, 'b) t -> 'a -> 'b -> unit (* [Hashtbl.replace tbl x y] replaces the current binding of [x] in [tbl] by a binding of [x] to [y]. If [x] is unbound in [tbl], a binding of [x] to [y] is added to [tbl]. This is functionally equivalent to [Hashtbl.remove tbl x] followed by [Hashtbl.add tbl x y]. *) -val iter : f:(key:'a -> data:'b -> unit) -> ('a, 'b) t -> unit +val iter : ('a -> 'b -> unit) -> ('a, 'b) t -> unit (* [Hashtbl.iter f tbl] applies [f] to all bindings in table [tbl]. [f] receives the key as first argument, and the associated value as second argument. The order in which the bindings are passed to [f] is unspecified. Each binding is presented exactly once to [f]. *) -val fold : f:(key:'a -> data:'b -> 'c -> 'c) -> ('a, 'b) t -> init:'c -> 'c +val fold : ('a -> 'b -> 'c -> 'c) -> ('a, 'b) t -> 'c -> 'c (* [Hashtbl.fold f tbl init] computes [(f kN dN ... (f k1 d1 init)...)], where [k1 ... kN] are the keys of all bindings in [tbl], @@ -106,14 +106,14 @@ module type S = type 'a t val create: int -> 'a t val clear: 'a t -> unit - val add: 'a t -> key:key -> data:'a -> unit + val add: 'a t -> key -> '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 replace: 'a t -> key -> '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 iter: (key -> 'a -> unit) -> 'a t -> unit + val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b end module Make(H: HashedType): (S with type key = H.t) diff --git a/stdlib/lexing.mli b/stdlib/lexing.mli index d4dfb283a..1ee28e6a5 100644 --- a/stdlib/lexing.mli +++ b/stdlib/lexing.mli @@ -40,7 +40,7 @@ val from_string : string -> lexbuf the given string. Reading starts from the first character in the string. An end-of-input condition is generated when the end of the string is reached. *) -val from_function : (buf:string -> len:int -> int) -> lexbuf +val from_function : (string -> int -> int) -> lexbuf (* Create a lexer buffer with the given function as its reading method. When the scanner needs more characters, it will call the given function, giving it a character string [s] and a character diff --git a/stdlib/list.mli b/stdlib/list.mli index cacec6ef2..c94f92b4c 100644 --- a/stdlib/list.mli +++ b/stdlib/list.mli @@ -54,49 +54,49 @@ val flatten : 'a list list -> 'a list (** Iterators *) -val iter : f:('a -> unit) -> 'a list -> unit +val iter : ('a -> unit) -> 'a list -> unit (* [List.iter f [a1; ...; an]] applies function [f] in turn to [a1; ...; an]. It is equivalent to [begin f a1; f a2; ...; f an; () end]. *) -val map : f:('a -> 'b) -> 'a list -> 'b list +val map : ('a -> 'b) -> 'a list -> 'b list (* [List.map f [a1; ...; an]] applies function [f] to [a1, ..., an], and builds the list [[f a1; ...; f an]] with the results returned by [f]. Not tail-recursive. *) -val rev_map : f:('a -> 'b) -> 'a list -> 'b list +val rev_map : ('a -> 'b) -> 'a list -> 'b list (* [List.rev_map f l] gives the same result as [List.rev (List.map f l)], but is tail-recursive and more efficient. *) -val fold_left : f:('a -> 'b -> 'a) -> init:'a -> 'b list -> 'a +val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a (* [List.fold_left f a [b1; ...; bn]] is [f (... (f (f a b1) b2) ...) bn]. *) -val fold_right : f:('a -> 'b -> 'b) -> 'a list -> init:'b -> 'b +val fold_right : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b (* [List.fold_right f [a1; ...; an] b] is [f a1 (f a2 (... (f an b) ...))]. Not tail-recursive. *) (** Iterators on two lists *) -val iter2 : f:('a -> 'b -> unit) -> 'a list -> 'b list -> unit +val iter2 : ('a -> 'b -> unit) -> 'a list -> 'b list -> unit (* [List.iter2 f [a1; ...; an] [b1; ...; bn]] calls in turn [f a1 b1; ...; f an bn]. Raise [Invalid_argument] if the two lists have different lengths. *) -val map2 : f:('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list +val map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list (* [List.map2 f [a1; ...; an] [b1; ...; bn]] is [[f a1 b1; ...; f an bn]]. Raise [Invalid_argument] if the two lists have different lengths. Not tail-recursive. *) -val rev_map2 : f:('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list +val rev_map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list (* [List.rev_map2 f l] gives the same result as [List.rev (List.map2 f l)], but is tail-recursive and more efficient. *) val fold_left2 : - f:('a -> 'b -> 'c -> 'a) -> init:'a -> 'b list -> 'c list -> 'a + ('a -> 'b -> 'c -> 'a) -> 'a -> 'b list -> 'c list -> 'a (* [List.fold_left2 f a [b1; ...; bn] [c1; ...; cn]] is [f (... (f (f a b1 c1) b2 c2) ...) bn cn]. Raise [Invalid_argument] if the two lists have different lengths. *) val fold_right2 : - f:('a -> 'b -> 'c -> 'c) -> 'a list -> 'b list -> init:'c -> 'c + ('a -> 'b -> 'c -> 'c) -> 'a list -> 'b list -> 'c -> 'c (* [List.fold_right2 f [a1; ...; an] [b1; ...; bn] c] is [f a1 b1 (f a2 b2 (... (f an bn c) ...))]. Raise [Invalid_argument] if the two lists have @@ -104,16 +104,16 @@ val fold_right2 : (** List scanning *) -val for_all : f:('a -> bool) -> 'a list -> bool +val for_all : ('a -> bool) -> 'a list -> bool (* [for_all p [a1; ...; an]] checks if all elements of the list satisfy the predicate [p]. That is, it returns [(p a1) && (p a2) && ... && (p an)]. *) -val exists : f:('a -> bool) -> 'a list -> bool +val exists : ('a -> bool) -> 'a list -> bool (* [exists p [a1; ...; an]] checks if at least one element of the list satisfies the predicate [p]. That is, it returns [(p a1) || (p a2) || ... || (p an)]. *) -val for_all2 : f:('a -> 'b -> bool) -> 'a list -> 'b list -> bool -val exists2 : f:('a -> 'b -> bool) -> 'a list -> 'b list -> bool +val for_all2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool +val exists2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool (* Same as [for_all] and [exists], but for a two-argument predicate. Raise [Invalid_argument] if the two lists have different lengths. *) @@ -126,20 +126,20 @@ val memq : 'a -> 'a list -> bool (** List searching *) -val find : f:('a -> bool) -> 'a list -> 'a +val find : ('a -> bool) -> 'a list -> 'a (* [find p l] returns the first element of the list [l] that satisfies the predicate [p]. Raise [Not_found] if there is no value that satisfies [p] in the list [l]. *) -val filter : f:('a -> bool) -> 'a list -> 'a list -val find_all : f:('a -> bool) -> 'a list -> 'a list +val filter : ('a -> bool) -> 'a list -> 'a list +val find_all : ('a -> bool) -> 'a list -> 'a list (* [filter p l] returns all the elements of the list [l] that satisfy the predicate [p]. The order of the elements in the input list is preserved. [find_all] is another name for [filter]. *) -val partition : f:('a -> bool) -> 'a list -> 'a list * 'a list +val partition : ('a -> bool) -> 'a list -> 'a list * 'a list (* [partition p l] returns a pair of lists [(l1, l2)], where [l1] is the list of all the elements of [l] that satisfy the predicate [p], and [l2] is the list of all the @@ -190,7 +190,7 @@ val combine : 'a list -> 'b list -> ('a * 'b) list have different lengths. Not tail-recursive. *) (** Sorting *) -val sort : cmp:('a -> 'a -> int) -> 'a list -> 'a list;; +val sort : ('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 compare as equal, a positive integer if the first is greater, @@ -204,7 +204,7 @@ val sort : cmp:('a -> 'a -> int) -> 'a list -> 'a list;; The current implementation uses Merge Sort and is the same as [List.stable_sort]. *) -val stable_sort : cmp:('a -> 'a -> int) -> 'a list -> 'a list;; +val stable_sort : ('a -> 'a -> int) -> 'a list -> 'a list;; (* Same as [List.sort], but the sorting algorithm is stable. The current implementation is Merge Sort. It runs in constant diff --git a/stdlib/listLabels.ml b/stdlib/listLabels.ml new file mode 100644 index 000000000..1c33254d7 --- /dev/null +++ b/stdlib/listLabels.ml @@ -0,0 +1,17 @@ +(***********************************************************************) +(* *) +(* Objective Caml *) +(* *) +(* 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. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +(* Module [ListLabels]: labelled List module *) + +include List diff --git a/stdlib/listLabels.mli b/stdlib/listLabels.mli new file mode 100644 index 000000000..3c2f9d761 --- /dev/null +++ b/stdlib/listLabels.mli @@ -0,0 +1,212 @@ +(***********************************************************************) +(* *) +(* Objective Caml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1996 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. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +(* Module [List]: list operations *) + +(* Some functions are flagged as not tail-recursive. A tail-recursive + function uses constant stack space, while a non-tail-recursive function + uses stack space proportional to the length of its list argument, which + can be a problem with very long lists. When the function takes several + list arguments, an approximate formula giving stack usage (in some + unspecified constant unit) is shown in parentheses. + + The above considerations can usually be ignored if your lists are not + longer than about 10000 elements. +*) + +val length : 'a list -> int + (* Return the length (number of elements) of the given list. *) +val hd : 'a list -> 'a + (* Return the first element of the given list. Raise + [Failure "hd"] if the list is empty. *) +val tl : 'a list -> 'a list + (* Return the given list without its first element. Raise + [Failure "tl"] if the list is empty. *) +val nth : 'a list -> int -> 'a + (* 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. *) +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 [@]. + Not tail-recursive (length of the first argument). The [@] + operator is not tail-recursive either. *) +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 [rev_append] is + tail-recursive and more efficient. *) +val concat : 'a list list -> 'a list +val flatten : 'a list list -> 'a list + (* Catenate (flatten) a list of lists. Not tail-recursive + (length of the argument + length of the longest sub-list). *) + +(** Iterators *) + +val iter : f:('a -> unit) -> 'a list -> unit + (* [List.iter f [a1; ...; an]] applies function [f] in turn to + [a1; ...; an]. It is equivalent to + [begin f a1; f a2; ...; f an; () end]. *) +val map : f:('a -> 'b) -> 'a list -> 'b list + (* [List.map f [a1; ...; an]] applies function [f] to [a1, ..., an], + and builds the list [[f a1; ...; f an]] + with the results returned by [f]. Not tail-recursive. *) +val rev_map : f:('a -> 'b) -> 'a list -> 'b list + (* [List.rev_map f l] gives the same result as + [List.rev (List.map f l)], but is tail-recursive and + more efficient. *) +val fold_left : f:('a -> 'b -> 'a) -> init:'a -> 'b list -> 'a + (* [List.fold_left f a [b1; ...; bn]] is + [f (... (f (f a b1) b2) ...) bn]. *) +val fold_right : f:('a -> 'b -> 'b) -> 'a list -> init:'b -> 'b + (* [List.fold_right f [a1; ...; an] b] is + [f a1 (f a2 (... (f an b) ...))]. Not tail-recursive. *) + +(** Iterators on two lists *) + +val iter2 : f:('a -> 'b -> unit) -> 'a list -> 'b list -> unit + (* [List.iter2 f [a1; ...; an] [b1; ...; bn]] calls in turn + [f a1 b1; ...; f an bn]. + Raise [Invalid_argument] if the two lists have + different lengths. *) +val map2 : f:('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list + (* [List.map2 f [a1; ...; an] [b1; ...; bn]] is + [[f a1 b1; ...; f an bn]]. + Raise [Invalid_argument] if the two lists have + 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 + [List.rev (List.map2 f l)], but is tail-recursive and + more efficient. *) +val fold_left2 : + f:('a -> 'b -> 'c -> 'a) -> init:'a -> 'b list -> 'c list -> 'a + (* [List.fold_left2 f a [b1; ...; bn] [c1; ...; cn]] is + [f (... (f (f a b1 c1) b2 c2) ...) bn cn]. + Raise [Invalid_argument] if the two lists have + different lengths. *) +val fold_right2 : + f:('a -> 'b -> 'c -> 'c) -> 'a list -> 'b list -> init:'c -> 'c + (* [List.fold_right2 f [a1; ...; an] [b1; ...; bn] c] is + [f a1 b1 (f a2 b2 (... (f an bn c) ...))]. + Raise [Invalid_argument] if the two lists have + different lengths. Not tail-recursive. *) + +(** List scanning *) + +val for_all : f:('a -> bool) -> 'a list -> bool + (* [for_all p [a1; ...; an]] checks if all elements of the list + satisfy the predicate [p]. That is, it returns + [(p a1) && (p a2) && ... && (p an)]. *) +val exists : f:('a -> bool) -> 'a list -> bool + (* [exists p [a1; ...; an]] checks if at least one element of + the list satisfies the predicate [p]. That is, it returns + [(p a1) || (p a2) || ... || (p an)]. *) +val for_all2 : f:('a -> 'b -> bool) -> 'a list -> 'b list -> bool +val exists2 : f:('a -> 'b -> bool) -> 'a list -> 'b list -> bool + (* Same as [for_all] and [exists], but for a two-argument predicate. + Raise [Invalid_argument] if the two lists have + different lengths. *) +val mem : 'a -> set:'a list -> bool + (* [mem a l] is true if and only if [a] is equal + to an element of [l]. *) +val memq : 'a -> set:'a list -> bool + (* Same as [mem], but uses physical equality instead of structural + equality to compare list elements. *) + +(** List searching *) + +val find : f:('a -> bool) -> 'a list -> 'a + (* [find p l] returns the first element of the list [l] + that satisfies the predicate [p]. + Raise [Not_found] if there is no value that satisfies [p] in the + list [l]. *) + +val filter : f:('a -> bool) -> 'a list -> 'a list +val find_all : f:('a -> bool) -> 'a list -> 'a list + (* [filter p l] returns all the elements of the list [l] + that satisfy the predicate [p]. The order of the elements + in the input list is preserved. [find_all] is another name + for [filter]. *) + +val partition : f:('a -> bool) -> 'a list -> 'a list * 'a list + (* [partition p l] returns a pair of lists [(l1, l2)], where + [l1] is the list of all the elements of [l] that + satisfy the predicate [p], and [l2] is the list of all the + elements of [l] that do not satisfy [p]. + The order of the elements in the input list is preserved. *) + +(** Association lists *) + +val assoc : 'a -> map:('a * 'b) list -> 'b + (* [assoc a l] returns the value associated with key [a] in the list of + pairs [l]. That is, + [assoc a [ ...; (a,b); ...] = b] + if [(a,b)] is the leftmost binding of [a] in list [l]. + Raise [Not_found] if there is no value associated with [a] in the + list [l]. *) +val assq : 'a -> map:('a * 'b) list -> 'b + (* Same as [assoc], but uses physical equality instead of structural + equality to compare keys. *) + +val mem_assoc : 'a -> map:('a * 'b) list -> bool + (* Same as [assoc], but simply return true if a binding exists, + and false if no bindings exist for the given key. *) +val mem_assq : 'a -> map:('a * 'b) list -> bool + (* Same as [mem_assoc], but uses physical equality instead of + structural equality to compare keys. *) + +val remove_assoc : 'a -> map:('a * 'b) list -> ('a * 'b) list + (* [remove_assoc a l] returns the list of + pairs [l] without the first pair with key [a], if any. + Not tail-recursive. *) + +val remove_assq : 'a -> map:('a * 'b) list -> ('a * 'b) list + (* Same as [remove_assq], but uses physical equality instead + of structural equality to compare keys. Not tail-recursive. *) + +(** Lists of pairs *) + +val split : ('a * 'b) list -> 'a list * 'b list + (* Transform a list of pairs into a pair of lists: + [split [(a1,b1); ...; (an,bn)]] is [([a1; ...; an], [b1; ...; bn])]. + Not tail-recursive. + *) +val combine : 'a list -> 'b list -> ('a * 'b) list + (* Transform a pair of lists into a list of pairs: + [combine ([a1; ...; an], [b1; ...; bn])] is + [[(a1,b1); ...; (an,bn)]]. + Raise [Invalid_argument] if the two lists + have different lengths. Not tail-recursive. *) + +(** 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 + 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. + 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 + [List.stable_sort]. + *) +val stable_sort : cmp:('a -> 'a -> int) -> 'a list -> 'a list;; + (* Same as [List.sort], but the sorting algorithm is stable. + + The current implementation is Merge Sort. It runs in constant + heap space and logarithmic stack space. + *) diff --git a/stdlib/map.mli b/stdlib/map.mli index a3b4b9af9..4c638a738 100644 --- a/stdlib/map.mli +++ b/stdlib/map.mli @@ -44,7 +44,7 @@ module type S = (* The type of maps from type [key] to type ['a]. *) val empty: 'a t (* The empty map. *) - val add: key:key -> data:'a -> 'a t -> 'a t + val add: key -> 'a -> 'a t -> 'a t (* [add x y m] returns a map containing the same bindings as [m], plus a binding of [x] to [y]. If [x] was already bound in [m], its previous binding disappears. *) @@ -57,22 +57,22 @@ module type S = val mem: key -> 'a t -> bool (* [mem x m] returns [true] if [m] contains a binding for [x], and [false] otherwise. *) - val iter: f:(key:key -> data:'a -> unit) -> 'a t -> unit + val iter: (key -> 'a -> unit) -> 'a t -> unit (* [iter f m] applies [f] to all bindings in map [m]. [f] receives the key as first argument, and the associated value as second argument. The order in which the bindings are passed to [f] is unspecified. Only current bindings are presented to [f]: bindings hidden by more recent bindings are not passed to [f]. *) - val map: f:('a -> 'b) -> 'a t -> 'b t + val map: ('a -> 'b) -> 'a t -> 'b t (* [map f m] returns a map with same domain as [m], where the associated value [a] of all bindings of [m] has been replaced by the result of the application of [f] to [a]. The order in which the associated values are passed to [f] is unspecified. *) - val mapi: f:(key -> 'a -> 'b) -> 'a t -> 'b t + val mapi: (key -> 'a -> 'b) -> 'a t -> 'b t (* Same as [map], but the function receives as arguments both the key and the associated value for each binding of the map. *) - val fold: f:(key:key -> data:'a -> 'b -> 'b) -> 'a t -> init:'b -> 'b + val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b (* [fold f m a] computes [(f kN dN ... (f k1 d1 a)...)], where [k1 ... kN] are the keys of all bindings in [m], and [d1 ... dN] are the associated data. diff --git a/stdlib/marshal.mli b/stdlib/marshal.mli index 8a436fd45..b3bfcba80 100644 --- a/stdlib/marshal.mli +++ b/stdlib/marshal.mli @@ -47,7 +47,7 @@ type extern_flags = | Closures (* Send function closures *) (* The flags to the [Marshal.to_*] functions below. *) -val to_channel: out_channel -> 'a -> mode:extern_flags list -> unit +val to_channel: out_channel -> 'a -> extern_flags list -> unit (* [Marshal.to_channel chan v flags] writes the representation of [v] on channel [chan]. The [flags] argument is a possibly empty list of flags that governs the marshaling @@ -77,15 +77,14 @@ val to_channel: out_channel -> 'a -> mode:extern_flags list -> unit at un-marshaling time, using an MD5 digest of the code transmitted along with the code position.) *) -external to_string: 'a -> mode:extern_flags list -> string +external to_string: 'a -> extern_flags list -> string = "output_value_to_string" (* [Marshal.to_string v flags] returns a string containing the representation of [v] as a sequence of bytes. The [flags] argument has the same meaning as for [Marshal.to_channel]. *) -val to_buffer: string -> pos:int -> len:int -> - 'a -> mode:extern_flags list -> int +val to_buffer: string -> int -> int -> 'a -> extern_flags list -> int (* [Marshal.to_buffer buff ofs len v flags] marshals the value [v], storing its byte representation in the string [buff], starting at character number [ofs], and writing at most @@ -100,15 +99,15 @@ val from_channel: in_channel -> 'a one of the [Marshal.to_*] functions, and reconstructs and returns the corresponding value.*) -val from_string: string -> pos:int -> 'a +val from_string: string -> int -> 'a (* [Marshal.from_string buff ofs] unmarshals a structured value like [Marshal.from_channel] does, except that the byte representation is not read from a channel, but taken from the string [buff], starting at position [ofs]. *) val header_size : int -val data_size : string -> pos:int -> int -val total_size : string -> pos:int -> int +val data_size : string -> int -> int +val total_size : string -> int -> int (* The bytes representing a marshaled value are composed of a fixed-size header and a variable-sized data part, whose size can be determined from the header. diff --git a/stdlib/obj.mli b/stdlib/obj.mli index 0a3be860a..c854da66e 100644 --- a/stdlib/obj.mli +++ b/stdlib/obj.mli @@ -27,9 +27,9 @@ external tag : t -> int = "obj_tag" external size : t -> int = "%obj_size" external field : t -> int -> t = "%obj_field" external set_field : t -> int -> t -> unit = "%obj_set_field" -external new_block : int -> len:int -> t = "obj_block" +external new_block : int -> int -> t = "obj_block" external dup : t -> t = "obj_dup" -external truncate : t -> len:int -> unit = "obj_truncate" +external truncate : t -> int -> unit = "obj_truncate" val no_scan_tag : int val closure_tag : int diff --git a/stdlib/pervasives.mli b/stdlib/pervasives.mli index cf513e9c3..a749529b9 100644 --- a/stdlib/pervasives.mli +++ b/stdlib/pervasives.mli @@ -472,7 +472,7 @@ val open_out_bin : string -> out_channel so that no translation takes place during writes. On operating systems that do not distinguish between text mode and binary mode, this function behaves like [open_out]. *) -val open_out_gen : mode:open_flag list -> perm:int -> string -> out_channel +val open_out_gen : open_flag list -> int -> string -> out_channel (* Open the named file for writing, as above. The extra argument [mode] specify the opening mode. The extra argument [perm] specifies the file permissions, in case the file must be created. @@ -486,7 +486,7 @@ val output_char : out_channel -> char -> unit (* Write the character on the given output channel. *) val output_string : out_channel -> string -> unit (* Write the string on the given output channel. *) -val output : out_channel -> buf:string -> pos:int -> len:int -> unit +val output : out_channel -> string -> int -> int -> unit (* Write [len] characters from string [buf], starting at offset [pos], to the given output channel. Raise [Invalid_argument "output"] if [pos] and [len] do not @@ -543,7 +543,7 @@ val open_in_bin : string -> in_channel so that no translation takes place during reads. On operating systems that do not distinguish between text mode and binary mode, this function behaves like [open_in]. *) -val open_in_gen : mode:open_flag list -> perm:int -> string -> in_channel +val open_in_gen : open_flag list -> int -> string -> in_channel (* Open the named file for reading, as above. The extra arguments [mode] and [perm] specify the opening mode and file permissions. [open_in] and [open_in_bin] are special cases of this function. *) @@ -556,7 +556,7 @@ val input_line : in_channel -> string all characters read, without the newline character at the end. Raise [End_of_file] if the end of the file is reached at the beginning of line. *) -val input : in_channel -> buf:string -> pos:int -> len:int -> int +val input : in_channel -> string -> int -> int -> int (* Read up to [len] characters from the given channel, storing them in string [buf], starting at character number [pos]. It returns the actual number of characters read, between 0 and @@ -571,7 +571,7 @@ val input : in_channel -> buf:string -> pos:int -> len:int -> int exactly [len] characters.) Exception [Invalid_argument "input"] is raised if [pos] and [len] do not designate a valid substring of [buf]. *) -val really_input : in_channel -> buf:string -> pos:int -> len:int -> unit +val really_input : in_channel -> string -> int -> int -> unit (* Read [len] characters from the given channel, storing them in string [buf], starting at character number [pos]. Raise [End_of_file] if the end of file is reached before [len] diff --git a/stdlib/queue.mli b/stdlib/queue.mli index 1f10951a1..3eb6af717 100644 --- a/stdlib/queue.mli +++ b/stdlib/queue.mli @@ -32,11 +32,11 @@ val take: 'a t -> 'a val peek: 'a t -> 'a (* [peek q] returns the first element in queue [q], without removing it from the queue, or raises [Empty] if the queue is empty. *) -val clear : 'a t -> unit +val clear: 'a t -> unit (* Discard all elements from a queue. *) val length: 'a t -> int (* Return the number of elements in a queue. *) -val iter: f:('a -> unit) -> 'a t -> unit +val iter: ('a -> unit) -> 'a t -> unit (* [iter f q] applies [f] in turn to all elements of [q], from the least recently entered to the most recently entered. The queue itself is unchanged. *) diff --git a/stdlib/set.mli b/stdlib/set.mli index a47a33ff8..8756094dc 100644 --- a/stdlib/set.mli +++ b/stdlib/set.mli @@ -69,25 +69,25 @@ module type S = val subset: t -> t -> bool (* [subset s1 s2] tests whether the set [s1] is a subset of the set [s2]. *) - val iter: f:(elt -> unit) -> t -> unit + val iter: (elt -> unit) -> t -> unit (* [iter f s] applies [f] in turn to all elements of [s]. The order in which the elements of [s] are presented to [f] is unspecified. *) - val fold: f:(elt -> 'a -> 'a) -> t -> init:'a -> 'a + val fold: (elt -> 'a -> 'a) -> t -> 'a -> 'a (* [fold f s a] computes [(f xN ... (f x2 (f x1 a))...)], where [x1 ... xN] are the elements of [s]. The order in which elements of [s] are presented to [f] is unspecified. *) - val for_all: f:(elt -> bool) -> t -> bool + val for_all: (elt -> bool) -> t -> bool (* [for_all p s] checks if all elements of the set satisfy the predicate [p]. *) - val exists: f:(elt -> bool) -> t -> bool + val exists: (elt -> bool) -> t -> bool (* [exists p s] checks if at least one element of the set satisfies the predicate [p]. *) - val filter: f:(elt -> bool) -> t -> t + val filter: (elt -> bool) -> t -> t (* [filter p s] returns the set of all elements in [s] that satisfy predicate [p]. *) - val partition: f:(elt -> bool) -> t -> t * t + val partition: (elt -> bool) -> t -> t * t (* [partition p s] returns a pair of sets [(s1, s2)], where [s1] is the set of all the elements of [s] that satisfy the predicate [p], and [s2] is the set of all the elements of diff --git a/stdlib/sort.mli b/stdlib/sort.mli index 684fb41d0..ce137b8bb 100644 --- a/stdlib/sort.mli +++ b/stdlib/sort.mli @@ -19,19 +19,19 @@ The new functions are faster and use less memory. *) -val list : order:('a -> 'a -> bool) -> 'a list -> 'a list +val list : ('a -> 'a -> bool) -> 'a list -> 'a list (* Sort a list in increasing order according to an ordering predicate. The predicate should return [true] if its first argument is less than or equal to its second argument. *) -val array : order:('a -> 'a -> bool) -> 'a array -> unit +val array : ('a -> 'a -> bool) -> 'a array -> unit (* Sort an array in increasing order according to an ordering predicate. The predicate should return [true] if its first argument is less than or equal to its second argument. The array is sorted in place. *) -val merge : order:('a -> 'a -> bool) -> 'a list -> 'a list -> 'a list +val merge : ('a -> 'a -> bool) -> 'a list -> 'a list -> 'a list (* Merge two lists according to the given predicate. Assuming the two argument lists are sorted according to the predicate, [merge] returns a sorted list containing the elements diff --git a/stdlib/stack.mli b/stdlib/stack.mli index e46288a63..ccb40797d 100644 --- a/stdlib/stack.mli +++ b/stdlib/stack.mli @@ -32,11 +32,11 @@ val pop: 'a t -> 'a val top: 'a t -> 'a (* [top s] returns the topmost element in stack [s], or raises [Empty] if the stack is empty. *) -val clear : 'a t -> unit +val clear: 'a t -> unit (* Discard all elements from a stack. *) val length: 'a t -> int (* Return the number of elements in a stack. *) -val iter: f:('a -> unit) -> 'a t -> unit +val iter: ('a -> unit) -> 'a t -> unit (* [iter f s] applies [f] in turn to all elements of [s], from the element at the top of the stack to the element at the bottom of the stack. The stack itself is unchanged. *) diff --git a/stdlib/stdLabels.ml b/stdlib/stdLabels.ml new file mode 100644 index 000000000..b79792e9d --- /dev/null +++ b/stdlib/stdLabels.ml @@ -0,0 +1,21 @@ +(***********************************************************************) +(* *) +(* Objective Caml *) +(* *) +(* 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. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +(* Module [StdLabels]: meta-module for labelled libraries *) + +module Array = ArrayLabels + +module List = ListLabels + +module String = StringLabels diff --git a/stdlib/stdLabels.mli b/stdlib/stdLabels.mli new file mode 100644 index 000000000..47c53301f --- /dev/null +++ b/stdlib/stdLabels.mli @@ -0,0 +1,124 @@ +(***********************************************************************) +(* *) +(* Objective Caml *) +(* *) +(* 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. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +(* Module [StdLabels]: meta-module for labelled libraries *) +(* See the real interfaces in ArrayLabels, ListLabels and StringLabels *) + +module Array : sig + external length : 'a array -> int = "%array_length" + external get : 'a array -> int -> 'a = "%array_safe_get" + external set : 'a array -> int -> 'a -> unit = "%array_safe_set" + external make : int -> 'a -> 'a array = "make_vect" + external create : int -> 'a -> 'a array = "make_vect" + val init : int -> f:(int -> 'a) -> 'a array + val make_matrix : dimx:int -> dimy:int -> 'a -> 'a array array + val create_matrix : dimx:int -> dimy:int -> 'a -> 'a array array + val append : 'a array -> 'a array -> 'a array + val concat : 'a array list -> 'a array + val sub : 'a array -> pos:int -> len:int -> 'a array + val copy : 'a array -> 'a array + val fill : 'a array -> pos:int -> len:int -> 'a -> unit + val blit : + src:'a array -> src_pos:int -> + dst:'a array -> dst_pos:int -> len:int -> unit + val to_list : 'a array -> 'a list + val of_list : 'a list -> 'a array + val iter : f:('a -> unit) -> 'a array -> unit + val map : f:('a -> 'b) -> 'a array -> 'b array + val iteri : f:(int -> 'a -> unit) -> 'a array -> unit + val mapi : f:(int -> 'a -> 'b) -> 'a array -> 'b array + val fold_left : f:('a -> 'b -> 'a) -> init:'a -> 'b array -> 'a + val fold_right : f:('a -> 'b -> 'b) -> 'a array -> init:'b -> 'b + val sort : cmp:('a -> 'a -> int) -> 'a array -> unit + val stable_sort : cmp:('a -> 'a -> int) -> 'a array -> unit + external unsafe_get : 'a array -> int -> 'a = "%array_unsafe_get" + external unsafe_set : 'a array -> int -> 'a -> unit = "%array_unsafe_set" +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 : f:('a -> unit) -> 'a list -> unit + val map : f:('a -> 'b) -> 'a list -> 'b list + val rev_map : f:('a -> 'b) -> 'a list -> 'b list + val fold_left : f:('a -> 'b -> 'a) -> init:'a -> 'b list -> 'a + val fold_right : f:('a -> 'b -> 'b) -> 'a list -> init:'b -> 'b + val iter2 : f:('a -> 'b -> unit) -> 'a list -> 'b list -> unit + val map2 : f:('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list + val rev_map2 : f:('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list + val fold_left2 : + f:('a -> 'b -> 'c -> 'a) -> init:'a -> 'b list -> 'c list -> 'a + val fold_right2 : + f:('a -> 'b -> 'c -> 'c) -> 'a list -> 'b list -> init:'c -> 'c + val for_all : f:('a -> bool) -> 'a list -> bool + val exists : f:('a -> bool) -> 'a list -> bool + val for_all2 : f:('a -> 'b -> bool) -> 'a list -> 'b list -> bool + val exists2 : f:('a -> 'b -> bool) -> 'a list -> 'b list -> bool + val mem : 'a -> set:'a list -> bool + val memq : 'a -> set:'a list -> bool + val find : f:('a -> bool) -> 'a list -> 'a + val filter : f:('a -> bool) -> 'a list -> 'a list + val find_all : f:('a -> bool) -> 'a list -> 'a list + val partition : f:('a -> bool) -> 'a list -> 'a list * 'a list + val assoc : 'a -> map:('a * 'b) list -> 'b + val assq : 'a -> map:('a * 'b) list -> 'b + val mem_assoc : 'a -> map:('a * 'b) list -> bool + val mem_assq : 'a -> map:('a * 'b) list -> bool + val remove_assoc : 'a -> map:('a * 'b) list -> ('a * 'b) list + val remove_assq : 'a -> map:('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 : cmp:('a -> 'a -> int) -> 'a list -> 'a list + val stable_sort : cmp:('a -> 'a -> int) -> 'a list -> 'a list +end + +module String : sig + external length : string -> int = "%string_length" + external get : string -> int -> char = "%string_safe_get" + external set : string -> int -> char -> unit = "%string_safe_set" + external create : int -> string = "create_string" + val make : int -> char -> string + val copy : string -> string + val sub : string -> pos:int -> len:int -> string + val fill : string -> pos:int -> len:int -> char -> unit + val blit : + src:string -> src_pos:int -> dst:string -> dst_pos:int -> len:int -> unit + val concat : sep:string -> string list -> 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 + external unsafe_get : string -> int -> char = "%string_unsafe_get" + external unsafe_set : string -> int -> char -> unit = "%string_unsafe_set" + external unsafe_blit : + src:string -> src_pos:int -> dst:string -> dst_pos:int -> len:int -> unit + = "blit_string" "noalloc" + external unsafe_fill : string -> pos:int -> len:int -> char -> unit + = "fill_string" "noalloc" +end diff --git a/stdlib/stream.mli b/stdlib/stream.mli index d12f23255..20495ecbf 100644 --- a/stdlib/stream.mli +++ b/stdlib/stream.mli @@ -45,7 +45,7 @@ val of_channel : in_channel -> char t;; (** Stream iterator *) -val iter : f:('a -> unit) -> 'a t -> unit;; +val iter : ('a -> unit) -> 'a t -> unit;; (* [Stream.iter f s] scans the whole stream s, applying function [f] in turn to each stream element encountered. *) diff --git a/stdlib/string.ml b/stdlib/string.ml index 21543abfb..bf5e14c05 100644 --- a/stdlib/string.ml +++ b/stdlib/string.ml @@ -17,7 +17,7 @@ external length : string -> int = "%string_length" external get : string -> int -> char = "%string_safe_get" external set : string -> int -> char -> unit = "%string_safe_set" -external create: int -> string = "create_string" +external create : int -> string = "create_string" external unsafe_get : string -> int -> char = "%string_unsafe_get" external unsafe_set : string -> int -> char -> unit = "%string_unsafe_set" external unsafe_blit : string -> int -> string -> int -> int -> unit @@ -56,6 +56,9 @@ let blit s1 ofs1 s2 ofs2 len = then invalid_arg "String.blit" else unsafe_blit s1 ofs1 s2 ofs2 len +let iter f a = + for i = 0 to length a - 1 do f(unsafe_get a i) done + let concat sep l = match l with [] -> "" diff --git a/stdlib/string.mli b/stdlib/string.mli index 22025fc15..afddc66a0 100644 --- a/stdlib/string.mli +++ b/stdlib/string.mli @@ -43,21 +43,20 @@ val make : int -> char -> string *) val copy : string -> string (* Return a copy of the given string. *) -val sub : string -> pos:int -> len:int -> 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]. 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]. *) -val fill : string -> pos:int -> len:int -> char -> unit +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]. Raise [Invalid_argument] if [start] and [len] do not designate a valid substring of [s]. *) -val blit : src:string -> src_pos:int -> - dst:string -> dst_pos:int -> len:int -> unit +val blit : string -> int -> string -> int -> int -> unit (* [String.blit src srcoff dst dstoff len] copies [len] characters from string [src], starting at character number [srcoff], to string [dst], starting at character number [dstoff]. It works @@ -67,10 +66,15 @@ val blit : src:string -> src_pos:int -> designate a valid substring of [src], or if [dstoff] and [len] do not designate a valid substring of [dst]. *) -val concat : sep:string -> string list -> string +val concat : string -> string list -> string (* [String.concat sep sl] catenates the list of strings [sl], inserting the separator string [sep] between each. *) +val iter : (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); ()]. *) + val escaped: string -> string (* Return a copy of the argument, with special characters represented by escape sequences, following the lexical @@ -127,9 +131,7 @@ val uncapitalize: string -> string external unsafe_get : string -> int -> char = "%string_unsafe_get" external unsafe_set : string -> int -> char -> unit = "%string_unsafe_set" -external unsafe_blit : - src:string -> src_pos:int -> - dst:string -> dst_pos:int -> len:int -> unit +external unsafe_blit : string -> int -> string -> int -> int -> unit = "blit_string" "noalloc" -external unsafe_fill : string -> pos:int -> len:int -> char -> unit +external unsafe_fill : string -> int -> int -> char -> unit = "fill_string" "noalloc" diff --git a/stdlib/stringLabels.ml b/stdlib/stringLabels.ml new file mode 100644 index 000000000..008eda92f --- /dev/null +++ b/stdlib/stringLabels.ml @@ -0,0 +1,17 @@ +(***********************************************************************) +(* *) +(* Objective Caml *) +(* *) +(* 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. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +(* Module [SringLabels]: labelled String module *) + +include String diff --git a/stdlib/stringLabels.mli b/stdlib/stringLabels.mli new file mode 100644 index 000000000..15555e836 --- /dev/null +++ b/stdlib/stringLabels.mli @@ -0,0 +1,138 @@ +(***********************************************************************) +(* *) +(* Objective Caml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1996 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. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +(* Module [String]: string operations *) + +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]. + 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]. *) +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]. *) + +external create : int -> string = "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]. + *) +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 + (* Return a copy of the given string. *) +val sub : string -> pos:int -> len: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]. + 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]. *) +val fill : string -> pos:int -> len: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]. + Raise [Invalid_argument] if [start] and [len] do not + designate a valid substring of [s]. *) +val blit : src:string -> src_pos:int -> + dst:string -> dst_pos:int -> len:int -> unit + (* [String.blit src srcoff dst dstoff len] copies [len] characters + 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. + 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]. *) + +val concat : sep:string -> string list -> string + (* [String.concat sep sl] catenates the list of strings [sl], + inserting the separator string [sep] between each. *) + +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); ()]. *) + +val escaped: string -> string + (* Return a copy of the argument, with special characters represented + by escape sequences, following the lexical conventions of + Objective Caml. *) + +val index: string -> char -> int + (* [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 + (* [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 [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 contains : string -> char -> bool + (* [String.contains s c] tests if character [c] + appears in the string [s]. *) +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]. *) +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]. *) + +val uppercase: string -> string + (* Return a copy of the argument, with all lowercase letters + translated to uppercase, including accented letters of the ISO + Latin-1 (8859-1) character set. *) +val lowercase: string -> string + (* Return a copy of the argument, with all uppercase letters + translated to lowercase, including accented letters of the ISO + Latin-1 (8859-1) character set. *) +val capitalize: string -> string + (* Return a copy of the argument, with the first letter + set to uppercase. *) +val uncapitalize: string -> string + (* Return a copy of the argument, with the first letter + set to lowercase. *) + +(*--*) + +external unsafe_get : string -> int -> char = "%string_unsafe_get" +external unsafe_set : string -> int -> char -> unit = "%string_unsafe_set" +external unsafe_blit : + src:string -> src_pos:int -> + dst:string -> dst_pos:int -> len:int -> unit + = "blit_string" "noalloc" +external unsafe_fill : string -> pos:int -> len:int -> char -> unit + = "fill_string" "noalloc" diff --git a/stdlib/sys.mli b/stdlib/sys.mli index cb493f77f..4768d571e 100644 --- a/stdlib/sys.mli +++ b/stdlib/sys.mli @@ -23,7 +23,7 @@ external file_exists: string -> bool = "sys_file_exists" (* Test if a file with the given name exists. *) external remove: string -> unit = "sys_remove" (* Remove the given file name from the file system. *) -external rename : src:string -> dst:string -> unit = "sys_rename" +external rename: string -> string -> unit = "sys_rename" (* Rename a file. The first argument is the old name and the second is the new name. *) external getenv: string -> string = "sys_getenv" diff --git a/stdlib/weak.mli b/stdlib/weak.mli index b326dba38..1327086d3 100644 --- a/stdlib/weak.mli +++ b/stdlib/weak.mli @@ -62,13 +62,12 @@ val check: 'a t -> int -> bool;; full, [false] if it is empty. Note that even if [Weak.check ar n] returns [true], a subsequent [Weak.get ar n] can return [None]. *) -val fill: 'a t -> pos:int -> len:int -> 'a option -> unit;; +val fill: 'a t -> int -> int -> 'a option -> unit;; (* [Weak.fill ar ofs len el] sets to [el] all pointers of [ar] from [ofs] to [ofs + len - 1]. Raise [Invalid_argument "Weak.fill"] if [ofs] and [len] do not designate a valid subarray of [a]. *) -val blit : src:'a t -> src_pos:int -> - dst:'a t -> dst_pos:int -> len:int -> unit;; +val blit : 'a t -> int -> 'a t -> int -> int -> unit;; (* [Weak.blit ar1 off1 ar2 off2 len] copies [len] weak pointers from [ar1] (starting at [off1]) to [ar2] (starting at [off2]). It works correctly even if [ar1] and [ar2] are the same. |