port to the latest ocaml (2004/06/18)gcaml

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/gcaml@6419 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

29 files changed, 606 insertions, 518 deletions

diff --git a/stdlib/Makefile b/stdlib/Makefile
index 38a4c85e76..570849ff0a 100644
--- a/stdlib/Makefile
+++ b/stdlib/Makefile
@@ -18,14 +18,17 @@ include ../config/Makefile
 RUNTIME=../boot/ocamlrun
 COMPILER=../ocamlc
 CAMLC=$(RUNTIME) $(COMPILER)
-COMPFLAGS=-warn-error A -nostdlib
+COMPFLAGS=-g -warn-error A -nostdlib
 OPTCOMPILER=../ocamlopt
 CAMLOPT=$(RUNTIME) $(OPTCOMPILER)
 OPTCOMPFLAGS=-warn-error A -nostdlib
 CAMLDEP=../boot/ocamlrun ../tools/ocamldep
 
-BASIC=builtintypes.cmo \
-  pervasives.cmo array.cmo list.cmo char.cmo string.cmo sys.cmo \
+NOBUILTINFLAG=-nobuiltintypes
+
+OBJS=builtintypes.cmo \
+  pervasives.cmo $(OTHERS)
+OTHERS=array.cmo list.cmo char.cmo string.cmo sys.cmo \
   hashtbl.cmo sort.cmo marshal.cmo obj.cmo \
   int32.cmo int64.cmo nativeint.cmo \
   lexing.cmo parsing.cmo \
@@ -35,11 +38,17 @@ BASIC=builtintypes.cmo \
   digest.cmo random.cmo callback.cmo camlinternalOO.cmo oo.cmo \
   genlex.cmo weak.cmo \
   lazy.cmo filename.cmo complex.cmo \
-  rtype.cmo
-LABELLED=arrayLabels.ml listLabels.ml stringLabels.ml moreLabels.ml
-
-OBJS=$(BASIC) labelled.cmo stdLabels.cmo
-ALLOBJS=$(BASIC) $(LABELLED:.ml=.cmo) stdLabels.cmo
+  rtype.cmo \
+  arrayLabels.cmo listLabels.cmo stringLabels.cmo moreLabels.cmo stdLabels.cmo
+
+# make MODE=migration when you want to port gcaml to the latest ocaml-cvs
+ifeq ($(MODE),migration)
+ifeq ($(CAMLC),../boot/ocamlrun ../boot/ocamlc)
+# migration + coldstart
+NOBUILTINFLAG:=
+OBJS:=pervasives.cmo $(OTHERS)
+endif
+endif
 
 all: stdlib.cma std_exit.cmo camlheader camlheader_ur
 
@@ -48,6 +57,7 @@ allopt: stdlib.cmxa std_exit.cmx allopt-$(PROFILING)
 allopt-noprof:
 
 allopt-prof: stdlib.p.cmxa std_exit.p.cmx
+	rm -f std_exit.p.cmi
 
 install:
 	cp stdlib.cma std_exit.cmo *.cmi *.mli *.ml camlheader camlheader_ur \
@@ -71,13 +81,13 @@ installopt-prof:
 	cd $(LIBDIR); $(RANLIB) stdlib.p.a
 
 stdlib.cma: $(OBJS)
-	$(CAMLC) -a -o stdlib.cma $(ALLOBJS)
+	$(CAMLC) -a -o stdlib.cma $(OBJS)
 
 stdlib.cmxa: $(OBJS:.cmo=.cmx)
-	$(CAMLOPT) -a -o stdlib.cmxa $(ALLOBJS:.cmo=.cmx)
+	$(CAMLOPT) -a -o stdlib.cmxa $(OBJS:.cmo=.cmx)
 
 stdlib.p.cmxa: $(OBJS:.cmo=.p.cmx)
-	$(CAMLOPT) -a -o stdlib.p.cmxa $(ALLOBJS:.cmo=.p.cmx)
+	$(CAMLOPT) -a -o stdlib.p.cmxa $(OBJS:.cmo=.p.cmx)
 
 camlheader camlheader_ur: header.c ../config/Makefile
 	if $(SHARPBANGSCRIPTS); then \
@@ -118,20 +128,20 @@ pervasives.p.cmx: pervasives.ml
            then mv pervasives.n.o pervasives.o; else :; fi
 
 builtintypes.cmi: builtintypes.mli
-	$(CAMLC) $(COMPFLAGS) -nobuiltintypes -c builtintypes.mli
+	$(CAMLC) $(COMPFLAGS) $(NOBUILTINFLAG) -c builtintypes.mli
 
 builtintypes.cmo: builtintypes.ml
-	$(CAMLC) $(COMPFLAGS) -nobuiltintypes -c builtintypes.ml
+	$(CAMLC) $(COMPFLAGS) $(NOBUILTINFLAG) -c builtintypes.ml
 
 builtintypes.cmx: builtintypes.ml
-	$(CAMLOPT) $(OPTCOMPFLAGS) -nobuiltintypes -c builtintypes.ml
+	$(CAMLOPT) $(OPTCOMPFLAGS) $(NOBUILTINFLAG) -c builtintypes.ml
 
 builtintypes.p.cmx: builtintypes.ml
 	@if test -f builtintypes.cmx; \
            then mv builtintypes.cmx builtintypes.n.cmx; else :; fi
 	@if test -f builtintypes.o; \
            then mv builtintypes.o builtintypes.n.o; else :; fi
-	$(CAMLOPT) $(OPTCOMPFLAGS) -p -nobuiltintypes -c builtintypes.ml
+	$(CAMLOPT) $(OPTCOMPFLAGS) -p $(NOBUILTINFLAG) -c builtintypes.ml
 	mv builtintypes.cmx builtintypes.p.cmx
 	mv builtintypes.o builtintypes.p.o
 	@if test -f builtintypes.n.cmx; \
@@ -184,28 +194,30 @@ labelled.p.cmx:
 .SUFFIXES: .mli .ml .cmi .cmo .cmx .p.cmx
 
 .mli.cmi:
-	$(CAMLC) $(COMPFLAGS) $(EXTRAFLAGS) -c $<
+	$(CAMLC) $(COMPFLAGS) `./Compflags $@` -c $<
 
 .ml.cmo:
-	$(CAMLC) $(COMPFLAGS) $(EXTRAFLAGS) -c $<
+	$(CAMLC) $(COMPFLAGS) `./Compflags $@` -c $<
 
 .ml.cmx:
-	$(CAMLOPT) $(OPTCOMPFLAGS) $(EXTRAFLAGS) -c $<
+	$(CAMLOPT) $(OPTCOMPFLAGS) `./Compflags $@` -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) $(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
-
-$(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)
+	$(CAMLOPT) $(OPTCOMPFLAGS) `./Compflags $@` -p -c -o $*.p.cmx $<
+
+# Dependencies on the compiler
+$(OBJS) std_exit.cmo: $(COMPILER)
+$(OBJS:.cmo=.cmi) std_exit.cmi: $(COMPILER)
+$(OBJS:.cmo=.cmx) std_exit.cmx: $(OPTCOMPILER)
+$(OBJS:.cmo=.p.cmx) std_exit.p.cmx: $(OPTCOMPILER)
+
+# Dependencies on Pervasives (not tracked by ocamldep)
+$(OBJS) std_exit.cmo: pervasives.cmi
+$(OTHERS:.cmo=.cmi) std_exit.cmi: pervasives.cmi
+$(OBJS:.cmo=.cmx) std_exit.cmx: pervasives.cmi
+$(OBJS:.cmo=.p.cmx) std_exit.p.cmx: pervasives.cmi
+$(OTHERS:.cmo=.cmx) std_exit.cmx: pervasives.cmx
+$(OTHERS:.cmo=.p.cmx) std_exit.p.cmx: pervasives.cmx
 
 clean::
 	rm -f *.cm* *.o *.a
diff --git a/stdlib/Makefile.nt b/stdlib/Makefile.nt
index 140ae4b2dc..5df7c7ea4e 100644
--- a/stdlib/Makefile.nt
+++ b/stdlib/Makefile.nt
@@ -18,24 +18,24 @@ include ../config/Makefile
 RUNTIME=../boot/ocamlrun
 COMPILER=../ocamlc
 CAMLC=$(RUNTIME) $(COMPILER)
+COMPFLAGS=-warn-error A -nostdlib
 OPTCOMPILER=../ocamlopt
 CAMLOPT=$(RUNTIME) $(OPTCOMPILER)
+OPTCOMPFLAGS=-warn-error A -nostdlib
 CAMLDEP=../boot/ocamlrun ../tools/ocamldep
 
-BASIC=pervasives.cmo array.cmo list.cmo char.cmo string.cmo sys.cmo \
+OBJS=pervasives.cmo $(OTHERS)
+OTHERS=array.cmo list.cmo char.cmo string.cmo sys.cmo \
   hashtbl.cmo sort.cmo marshal.cmo obj.cmo \
   int32.cmo int64.cmo nativeint.cmo \
   lexing.cmo parsing.cmo \
   set.cmo map.cmo stack.cmo queue.cmo stream.cmo buffer.cmo \
   printf.cmo format.cmo scanf.cmo \
   arg.cmo printexc.cmo gc.cmo \
-  digest.cmo random.cmo camlinternalOO.cmo oo.cmo \
-  genlex.cmo callback.cmo weak.cmo \
-  lazy.cmo filename.cmo complex.cmo
-LABELLED=arrayLabels.ml listLabels.ml stringLabels.ml moreLabels.ml
-
-OBJS=$(BASIC) labelled.cmo stdLabels.cmo
-ALLOBJS=$(BASIC) $(LABELLED:.ml=.cmo) stdLabels.cmo
+  digest.cmo random.cmo callback.cmo camlinternalOO.cmo oo.cmo \
+  genlex.cmo weak.cmo \
+  lazy.cmo filename.cmo complex.cmo \
+  arrayLabels.cmo listLabels.cmo stringLabels.cmo moreLabels.cmo stdLabels.cmo
 
 all: stdlib.cma std_exit.cmo camlheader camlheader_ur
 
@@ -48,10 +48,10 @@ installopt:
 	cp stdlib.cmxa stdlib.$(A) std_exit.$(O) *.cmx $(LIBDIR)
 
 stdlib.cma: $(OBJS)
-	$(CAMLC) -a -o stdlib.cma $(ALLOBJS)
+	$(CAMLC) -a -o stdlib.cma $(OBJS)
 
 stdlib.cmxa: $(OBJS:.cmo=.cmx)
-	$(CAMLOPT) -a -o stdlib.cmxa $(ALLOBJS:.cmo=.cmx)
+	$(CAMLOPT) -a -o stdlib.cmxa $(OBJS:.cmo=.cmx)
 
 camlheader camlheader_ur: headernt.c ../config/Makefile
 	$(BYTECC) $(BYTECCCOMPOPTS) $(BYTECCLINKOPTS) -o camlheader.exe headernt.c
@@ -61,46 +61,30 @@ camlheader camlheader_ur: headernt.c ../config/Makefile
 clean::
 	rm -f camlheader camlheader_ur
 
-pervasives.cmi: pervasives.mli
-	$(CAMLC) $(COMPFLAGS) -nopervasives -c pervasives.mli
-
-pervasives.cmo: pervasives.ml
-	$(CAMLC) $(COMPFLAGS) -nopervasives -c pervasives.ml
-
-pervasives.cmx: pervasives.ml
-	$(CAMLOPT) $(COMPFLAGS) -nopervasives -c pervasives.ml
-
-# camlinternalOO.cmi must be compiled with -nopervasives for applets
-camlinternalOO.cmi: camlinternalOO.mli
-	$(CAMLC) $(COMPFLAGS) -nopervasives -c camlinternalOO.mli
-
-# labelled modules require the -nolabels flag
-labelled.cmo:
-	$(MAKEREC) EXTRAFLAGS=-nolabels RUNTIME=$(RUNTIME) COMPILER=$(COMPILER) $(LABELLED:.ml=.cmo)
-	touch $@
-labelled.cmx:
-	$(MAKEREC) EXTRAFLAGS=-nolabels $(LABELLED:.ml=.cmx)
-	touch $@
-labelled.p.cmx:
-	$(MAKEREC) EXTRAFLAGS=-nolabels $(LABELLED:.ml=.p.cmx)
-	touch $@
-
-# generic rules
 .SUFFIXES: .mli .ml .cmi .cmo .cmx
 
 .mli.cmi:
-	$(CAMLC) $(COMPFLAGS) $(EXTRAFLAGS) -c $<
+	$(CAMLC) $(COMPFLAGS) `./Compflags $@` -c $<
 
 .ml.cmo:
-	$(CAMLC) $(COMPFLAGS) $(EXTRAFLAGS) -c $<
+	$(CAMLC) $(COMPFLAGS) `./Compflags $@` -c $<
 
 .ml.cmx:
-	$(CAMLOPT) $(COMPFLAGS) $(EXTRAFLAGS) -c $<
-
-$(ALLOBJS) labelled.cmo std_exit.cmo: pervasives.cmi $(COMPILER)
-$(ALLOBJS:.cmo=.cmx) labelled.cmx std_exit.cmx: pervasives.cmi $(OPTCOMPILER)
-$(ALLOBJS:.cmo=.cmi) std_exit.cmi: $(COMPILER)
-labelled.cmo labelled.cmx: $(LABELLED) $(LABELLED:.ml=.mli)
+	$(CAMLOPT) $(OPTCOMPFLAGS) `./Compflags $@` -c $<
+
+# Dependencies on the compiler
+$(OBJS) std_exit.cmo: $(COMPILER)
+$(OBJS:.cmo=.cmi) std_exit.cmi: $(COMPILER)
+$(OBJS:.cmo=.cmx) std_exit.cmx: $(OPTCOMPILER)
+$(OBJS:.cmo=.p.cmx) std_exit.p.cmx: $(OPTCOMPILER)
+
+# Dependencies on Pervasives (not tracked by ocamldep)
+$(OBJS) std_exit.cmo: pervasives.cmi
+$(OTHERS:.cmo=.cmi) std_exit.cmi: pervasives.cmi
+$(OBJS:.cmo=.cmx) std_exit.cmx: pervasives.cmi
+$(OBJS:.cmo=.p.cmx) std_exit.p.cmx: pervasives.cmi
+$(OTHERS:.cmo=.cmx) std_exit.cmx: pervasives.cmx
+$(OTHERS:.cmo=.p.cmx) std_exit.p.cmx: pervasives.cmx
 
 clean::
 	rm -f *.cm* *.$(O) *.$(A)
diff --git a/stdlib/arg.ml b/stdlib/arg.ml
index 5ed20e1c49..9514b95576 100644
--- a/stdlib/arg.ml
+++ b/stdlib/arg.ml
@@ -70,13 +70,24 @@ let print_spec buf (key, spec, doc) =
   | _ -> bprintf buf "  %s %s\n" key doc
 ;;
 
+let help_action () = raise (Stop (Unknown "-help"));;
+
+let add_help speclist =
+  let add1 =
+    try ignore (assoc3 "-help" speclist); []
+    with Not_found ->
+            ["-help", Unit help_action, " Display this list of options"]
+  and add2 =
+    try ignore (assoc3 "--help" speclist); []
+    with Not_found ->
+            ["--help", Unit help_action, " Display this list of options"]
+  in
+  speclist @ (add1 @ add2)
+;;
+
 let usage_b buf speclist errmsg =
   bprintf buf "%s\n" errmsg;
-  List.iter (print_spec buf) speclist;
-  try ignore (assoc3 "-help" speclist)
-  with Not_found -> bprintf buf "  -help   Display this list of options\n";
-  try ignore (assoc3 "--help" speclist)
-  with Not_found -> bprintf buf "  --help  Display this list of options\n";
+  List.iter (print_spec buf) (add_help speclist);
 ;;
 
 let usage speclist errmsg =
@@ -202,3 +213,35 @@ let parse l f msg =
   | Bad msg -> eprintf "%s" msg; exit 2;
   | Help msg -> printf "%s" msg; exit 0;
 ;;
+
+let rec second_word s =
+  let len = String.length s in
+  let rec loop n =
+    if n >= len then len
+    else if s.[n] = ' ' then loop (n+1)
+    else n
+  in
+  try loop (String.index s ' ')
+  with Not_found -> len
+;;
+
+let max_arg_len cur (kwd, _, doc) =
+  max cur (String.length kwd + second_word doc)
+;;
+
+let add_padding len ksd =
+  match ksd with
+  | (_, Symbol _, _) -> ksd
+  | (kwd, spec, msg) ->
+      let cutcol = second_word msg in
+      let spaces = String.make (len - String.length kwd - cutcol) ' ' in
+      let prefix = String.sub msg 0 cutcol in
+      let suffix = String.sub msg cutcol (String.length msg - cutcol) in
+      (kwd, spec, prefix ^ spaces ^ suffix)
+;;
+
+let align speclist =
+  let completed = add_help speclist in
+  let len = List.fold_left max_arg_len 0 completed in
+  List.map (add_padding len) completed
+;;
diff --git a/stdlib/arg.mli b/stdlib/arg.mli
index a7258ada68..8203e83133 100644
--- a/stdlib/arg.mli
+++ b/stdlib/arg.mli
@@ -58,7 +58,6 @@ type spec =
                                    call the function with the symbol *)
   | Rest of (string -> unit)   (** Stop interpreting keywords and call the 
                                    function with each remaining argument *)
-
 (** The concrete type describing the behavior associated
    with a keyword. *)
 
@@ -121,6 +120,13 @@ val usage : (key * spec * doc) list -> usage_msg -> unit
     {!Arg.parse} prints in case of error.
     [speclist] and [usage_msg] are the same as for [Arg.parse]. *)
 
+val align: (key * spec * doc) list -> (key * spec * doc) list;;
+(** Align the documentation strings by inserting spaces at the first
+    space, according to the length of the keyword.  Use a
+    space as the first character in a doc string if you want to
+    align the whole string.  The doc strings corresponding to
+    [Symbol] arguments are not aligned. *)
+
 val current : int ref
 (** Position (in {!Sys.argv}) of the argument being processed.  You can
     change this value, e.g. to force {!Arg.parse} to skip some arguments.
diff --git a/stdlib/buffer.ml b/stdlib/buffer.ml
index dcde111ecd..cafec4444c 100644
--- a/stdlib/buffer.ml
+++ b/stdlib/buffer.ml
@@ -11,6 +11,8 @@
 (*                                                                     *)
 (***********************************************************************)
 
+(* $Id$ *)
+
 (* Extensible buffers *)
 
 type t =
@@ -27,6 +29,22 @@ let create n =
 
 let contents b = String.sub b.buffer 0 b.position
 
+let sub b ofs len =
+  if ofs < 0 || len < 0 || ofs > b.position - len 
+  then invalid_arg "Buffer.sub"
+  else begin
+    let r = String.create len in
+    String.blit b.buffer ofs r 0 len;
+    r
+  end
+;;
+
+let nth b ofs = 
+  if ofs < 0 || ofs >= b.position then 
+   invalid_arg "Buffer.nth"
+  else String.get b.buffer ofs
+;;
+
 let length b = b.position
 
 let clear b = b.position <- 0
@@ -87,9 +105,9 @@ let closing = function
   | _ -> assert false;;
 
 (* opening and closing: open and close characters, typically ( and )
-   k balance of opening and closing chars
-   s the string where we are searching
-   start the index where we start the search *)
+   k: balance of opening and closing chars
+   s: the string where we are searching
+   start: the index where we start the search. *)
 let advance_to_closing opening closing k s start =
   let rec advance k i lim =
     if i >= lim then raise Not_found else
@@ -110,7 +128,7 @@ let advance_to_non_alpha s start =
     | _ -> i in
   advance start (String.length s);;
 
-(* We are just at the beginning of an ident in s, starting at start *)
+(* We are just at the beginning of an ident in s, starting at start. *)
 let find_ident s start =
   match s.[start] with
   (* Parenthesized ident ? *)
diff --git a/stdlib/buffer.mli b/stdlib/buffer.mli
index 73e02e299b..6fc76148ad 100644
--- a/stdlib/buffer.mli
+++ b/stdlib/buffer.mli
@@ -11,6 +11,8 @@
 (*                                                                     *)
 (***********************************************************************)
 
+(* $Id$ *)
+
 (** Extensible string buffers.
 
    This module implements string buffers that automatically expand
@@ -40,6 +42,16 @@ val contents : t -> string
 (** Return a copy of the current contents of the buffer.
    The buffer itself is unchanged. *)
 
+val sub : t -> int -> int -> string
+(** [Buffer.sub b off len] returns (a copy of) the substring of the
+current contents of the buffer [b] starting at offset [off] of length
+[len] bytes. May raise [Invalid_argument] if out of bounds request. The
+buffer itself is unaffected. *)
+
+val nth : t -> int -> char
+(** get the n-th character of the buffer. Raise [Invalid_argument] if
+index out of bounds *)
+
 val length : t -> int
 (** Return the number of characters currently contained in the buffer. *)
 
diff --git a/stdlib/camlinternalOO.ml b/stdlib/camlinternalOO.ml
index 95f07456f4..fff08b49f5 100644
--- a/stdlib/camlinternalOO.ml
+++ b/stdlib/camlinternalOO.ml
@@ -54,185 +54,36 @@ let params = {
 (**** Parameters ****)
 
 let step = Sys.word_size / 16
-let first_bucket = 0
-let bucket_size = 32                    (* Must be 256 or less *)
 let initial_object_size = 2
 
-(**** Index ****)
-
-type label = int
-
-let label_count = ref 0
-
-let next label =
-  incr label_count;
-  let label = label + step in
-  if label mod (step * bucket_size) = 0 then
-    label + step * (65536 - bucket_size)
-  else
-    label
-
-let decode label =
-  (label / 65536 / step, (label mod (step * bucket_size)) / step)
-
 (**** Items ****)
 
-type item
+type item = DummyA | DummyB | DummyC of int
 
 let dummy_item = (magic () : item)
 
-(**** Buckets ****)
-
-type bucket = item array
-
-let version = ref 0
-
-let set_bucket_version (bucket : bucket) =
-  bucket.(bucket_size) <- (magic !version : item)
-
-let bucket_version bucket =
-  (magic bucket.(bucket_size) : int)
-
-let bucket_list = ref []
-
-let empty_bucket = [| |]
-
-let new_bucket () =
-  let bucket = Array.create (bucket_size + 1) dummy_item in
-  set_bucket_version bucket;
-  bucket_list := bucket :: !bucket_list;
-  bucket
-
-let copy_bucket bucket =
-  let bucket = Array.copy bucket in
-  set_bucket_version bucket;
-  bucket.(bucket_size) <- (magic !version : item);
-  bucket_list := bucket :: !bucket_list;
-  bucket
-
-(**** Make a clean bucket ****)
-
-let new_filled_bucket pos methods =
-  let bucket = new_bucket () in
-  List.iter
-    (fun (lab, met) ->
-       let (buck, elem) = decode lab in
-       if buck = pos then
-         bucket.(elem) <- (magic met : item))
-    (List.rev methods);
-  bucket
-
-(**** Bucket merging ****)
-
-let small_buckets = ref (Array.create 10 [| |])
-let small_bucket_count = ref 0
-
-let insert_bucket bucket =
-  let length = Array.length !small_buckets in
-  if !small_bucket_count >= length then begin
-    let new_array = Array.create (2 * length) [| |] in
-    Array.blit !small_buckets 0 new_array 0 length;
-    small_buckets := new_array
-  end;
-  !small_buckets.(!small_bucket_count) <- bucket;
-  incr small_bucket_count
-
-let remove_bucket n =
-  !small_buckets.(n) <- !small_buckets.(!small_bucket_count - 1);
-  decr small_bucket_count
-
-let bucket_used b =
-  let n = ref 0 in
-  for i = 0 to bucket_size - 1 do
-    if b.(i) != dummy_item then incr n
-  done;
-  !n
-
-let small_bucket b = bucket_used b <= params.bucket_small_size
-
-exception Failed
-
-let rec except e =
-  function
-    [] -> []
-  | e'::l -> if e == e' then l else e'::(except e l)
-
-let merge_buckets b1 b2 =
-  for i = 0 to bucket_size - 1 do
-    if
-      (b2.(i) != dummy_item) && (b1.(i) != dummy_item) && (b2.(i) != b1.(i))
-    then
-      raise Failed
-  done;
-  for i = 0 to bucket_size - 1 do
-    if b2.(i) != dummy_item then
-      b1.(i) <- b2.(i)
-  done;
-  bucket_list := except b2 !bucket_list;
-  b1
-
-let prng = Random.State.make [| 0 |];;
-
-let rec choose bucket i =
-  if (i > 0) && (!small_bucket_count > 0) then begin
-    let n = Random.State.int prng !small_bucket_count in
-    if not (small_bucket !small_buckets.(n)) then begin
-      remove_bucket n; choose bucket i
-    end else
-      try
-        merge_buckets !small_buckets.(n) bucket
-      with Failed ->
-        choose bucket (i - 1)
-  end else begin
-    insert_bucket bucket;
-    bucket
-  end
-
-let compact b =
-  if
-    (b != empty_bucket) && (bucket_version b = !version) && (small_bucket b)
-  then
-    choose b params.retry_count
-  else
-    b
+(**** Types ****)
 
-let compact_buckets buckets =
-  for i = first_bucket to Array.length buckets - 1 do
-    buckets.(i) <- compact buckets.(i)
-  done
+type tag
+type label = int
+type closure = item
+type t = DummyA | DummyB | DummyC of int
+type obj = t array
+external ret : (obj -> 'a) -> closure = "%identity"
 
 (**** Labels ****)
 
-let first_label = first_bucket * 65536 * step
-
-let last_label = ref first_label
-let methods = Hashtbl.create 101
-
-let new_label () =
-  let label = !last_label in
-  last_label := next !last_label;
-  label
-
-let new_method met =
-  try
-    Hashtbl.find methods met
-  with Not_found ->
-    let label = new_label () in
-    Hashtbl.add methods met label;
-    label
-
-let public_method_label met =
-  try
-    Hashtbl.find methods met
-  with Not_found ->
-    invalid_arg "Oo.public_method_label"
-
-let new_anonymous_method =
-  new_label
-
-(**** Types ****)
-
-type obj = t array
+let public_method_label s : tag =
+  let accu = ref 0 in
+  for i = 0 to String.length s - 1 do
+    accu := 223 * !accu + Char.code s.[i]
+  done;
+  (* reduce to 31 bits *)
+  accu := !accu land (1 lsl 31 - 1);
+  (* make it signed for 64 bits architectures *)
+  let tag = if !accu > 0x3FFFFFFF then !accu - (1 lsl 31) else !accu in
+  (* Printf.eprintf "%s = %d\n" s tag; flush stderr; *)
+  magic tag
 
 (**** Sparse array ****)
 
@@ -247,7 +98,7 @@ type labs = bool Labs.t
 (* The compiler assumes that the first field of this structure is [size]. *)
 type table =
  { mutable size: int;
-   mutable buckets: bucket array;
+   mutable methods: closure array;
    mutable methods_by_name: meths;
    mutable methods_by_label: labs;
    mutable previous_states:
@@ -258,20 +109,31 @@ type table =
    mutable initializers: (obj -> unit) list }
 
 let dummy_table =
-  { buckets = [| |];
+  { methods = [| dummy_item |];
     methods_by_name = Meths.empty;
     methods_by_label = Labs.empty;
     previous_states = [];
     hidden_meths = [];
     vars = Vars.empty;
     initializers = [];
-    size = initial_object_size }
+    size = 0 }
 
 let table_count = ref 0
 
-let new_table () =
+let null_item : item = Obj.obj (Obj.field (Obj.repr 0n) 1)
+
+let rec fit_size n =
+  if n <= 2 then n else
+  fit_size ((n+1)/2) * 2
+
+let new_table pub_labels =
   incr table_count;
-  { buckets = [| |];
+  let len = Array.length pub_labels in
+  let methods = Array.create (len*2+2) null_item in
+  methods.(0) <- magic len;
+  methods.(1) <- magic (fit_size len * Sys.word_size / 8 - 1);
+  for i = 0 to len - 1 do methods.(i*2+3) <- magic pub_labels.(i) done;
+  { methods = methods;
     methods_by_name = Meths.empty;
     methods_by_label = Labs.empty;
     previous_states = [];
@@ -281,40 +143,42 @@ let new_table () =
     size = initial_object_size }
 
 let resize array new_size =
-  let old_size = Array.length array.buckets in
+  let old_size = Array.length array.methods in
   if new_size > old_size then begin
-    let new_buck = Array.create new_size empty_bucket in
-    Array.blit array.buckets 0 new_buck 0 old_size;
-    array.buckets <- new_buck
+    let new_buck = Array.create new_size null_item in
+    Array.blit array.methods 0 new_buck 0 old_size;
+    array.methods <- new_buck
  end
 
 let put array label element =
-  let (buck, elem) = decode label in
-  resize array (buck + 1);
-  let bucket = ref (array.buckets.(buck)) in
-  if !bucket == empty_bucket then begin
-    bucket := new_bucket ();
-    array.buckets.(buck) <- !bucket
-  end;
-  !bucket.(elem) <- element
+  resize array (label + 1);
+  array.methods.(label) <- element
 
 (**** Classes ****)
 
 let method_count = ref 0
 let inst_var_count = ref 0
 
-type t
+(* type t *)
 type meth = item
 
+let new_method table =
+  let index = Array.length table.methods in
+  resize table (index + 1);
+  index
+
 let get_method_label table name =
   try
     Meths.find name table.methods_by_name
   with Not_found ->
-    let label = new_anonymous_method () in
+    let label = new_method table in
     table.methods_by_name <- Meths.add name label table.methods_by_name;
     table.methods_by_label <- Labs.add label true table.methods_by_label;
     label
 
+let get_method_labels table names =
+  Array.map (get_method_label table) names
+
 let set_method table label element =
   incr method_count;
   if Labs.find label table.methods_by_label then
@@ -323,9 +187,8 @@ let set_method table label element =
     table.hidden_meths <- (label, element) :: table.hidden_meths
 
 let get_method table label =
-  try List.assoc label table.hidden_meths with Not_found ->
-  let (buck, elem) = decode label in
-  table.buckets.(buck).(elem)
+  try List.assoc label table.hidden_meths
+  with Not_found -> table.methods.(label)
 
 let to_list arr =
   if arr == magic 0 then [] else Array.to_list arr
@@ -403,25 +266,39 @@ let new_variables table names =
 let get_variable table name =
   Vars.find name table.vars
 
+let get_variables table names =
+  Array.map (get_variable table) names
+
 let add_initializer table f =
   table.initializers <- f::table.initializers
 
+(*
+module Keys = Map.Make(struct type t = tag array let compare = compare end)
+let key_map = ref Keys.empty
+let get_key tags : item =
+  try magic (Keys.find tags !key_map : tag array)
+  with Not_found ->
+    key_map := Keys.add tags tags !key_map;
+    magic tags
+*)
+
 let create_table public_methods =
-  let table = new_table () in
-  if public_methods != magic 0 then
-    Array.iter
-      (function met ->
-        let lab = new_method met in
-        table.methods_by_name  <- Meths.add met lab table.methods_by_name;
-        table.methods_by_label <- Labs.add lab true table.methods_by_label)
-      public_methods;
+  if public_methods == magic 0 then new_table [||] else
+  (* [public_methods] must be in ascending order for bytecode *)
+  let tags = Array.map public_method_label public_methods in
+  let table = new_table tags in
+  Array.iteri
+    (fun i met ->
+      let lab = i*2+2 in
+      table.methods_by_name  <- Meths.add met lab table.methods_by_name;
+      table.methods_by_label <- Labs.add lab true table.methods_by_label)
+    public_methods;
   table
 
 let init_class table =
   inst_var_count := !inst_var_count + table.size - 1;
-  if params.compact_table then
-    compact_buckets table.buckets;
-  table.initializers <- List.rev table.initializers
+  table.initializers <- List.rev table.initializers;
+  resize table (3 + magic table.methods.(1) * 16 / Sys.word_size)
 
 let inherits cla vals virt_meths concr_meths (_, super, _, env) top =
   narrow cla vals virt_meths concr_meths;
@@ -451,7 +328,7 @@ let create_object table =
   (* XXX Appel de [obj_block] *)
   let obj = Obj.new_block Obj.object_tag table.size in
   (* XXX Appel de [caml_modify] *)
-  Obj.set_field obj 0 (Obj.repr table.buckets);
+  Obj.set_field obj 0 (Obj.repr table.methods);
   set_id obj last_id;
   (Obj.obj obj)
 
@@ -460,7 +337,7 @@ let create_object_opt obj_0 table =
     (* XXX Appel de [obj_block] *)
     let obj = Obj.new_block Obj.object_tag table.size in
     (* XXX Appel de [caml_modify] *)
-    Obj.set_field obj 0 (Obj.repr table.buckets);
+    Obj.set_field obj 0 (Obj.repr table.methods);
     set_id obj last_id;
     (Obj.obj obj)
   end
@@ -490,17 +367,20 @@ let create_object_and_run_initializers obj_0 table =
   end
 
 (* Equivalent primitive below
-let send obj lab =
-  let (buck, elem) = decode lab in
-  (magic obj : (obj -> t) array array array).(0).(buck).(elem) obj
+let sendself obj lab =
+  (magic obj : (obj -> t) array array).(0).(lab) obj
 *)
-external send : obj -> label -> 'a = "%send"
+external send : obj -> tag -> 'a = "%send"
+external sendcache : obj -> tag -> t -> int -> 'a = "%sendcache"
+external sendself : obj -> label -> 'a = "%sendself"
+external get_public_method : obj -> tag -> closure
+    = "caml_get_public_method" "noalloc"
 
 (**** table collection access ****)
 
-type tables = Empty | Cons of table * tables * tables
+type tables = Empty | Cons of closure * tables * tables
 type mut_tables =
-    {key: table; mutable data: tables; mutable next: tables}
+    {key: closure; mutable data: tables; mutable next: tables}
 external mut : tables -> mut_tables = "%identity"
 
 let build_path n keys tables =
@@ -533,34 +413,61 @@ let lookup_tables root keys =
 
 (**** builtin methods ****)
 
-type closure = item
-external ret : (obj -> 'a) -> closure = "%identity"
-
 let get_const x = ret (fun obj -> x)
 let get_var n   = ret (fun obj -> Array.unsafe_get obj n)
-let get_env e n = ret (fun obj -> Obj.field (Array.unsafe_get obj e) n)
-let get_meth n  = ret (fun obj -> send obj n)
+let get_env e n =
+  ret (fun obj ->
+    Array.unsafe_get (Obj.magic (Array.unsafe_get obj e) : obj) n)
+let get_meth n  = ret (fun obj -> sendself obj n)
 let set_var n   = ret (fun obj x -> Array.unsafe_set obj n x)
 let app_const f x = ret (fun obj -> f x)
 let app_var f n   = ret (fun obj -> f (Array.unsafe_get obj n))
-let app_env f e n = ret (fun obj -> f (Obj.field (Array.unsafe_get obj e) n))
-let app_meth f n  = ret (fun obj -> f (send obj n))
+let app_env f e n =
+  ret (fun obj ->
+    f (Array.unsafe_get (Obj.magic (Array.unsafe_get obj e) : obj) n))
+let app_meth f n  = ret (fun obj -> f (sendself obj n))
 let app_const_const f x y = ret (fun obj -> f x y)
 let app_const_var f x n   = ret (fun obj -> f x (Array.unsafe_get obj n))
-let app_const_meth f x n = ret (fun obj -> f x (send obj n))
+let app_const_meth f x n = ret (fun obj -> f x (sendself obj n))
 let app_var_const f n x = ret (fun obj -> f (Array.unsafe_get obj n) x)
-let app_meth_const f n x = ret (fun obj -> f (send obj n) x)
+let app_meth_const f n x = ret (fun obj -> f (sendself obj n) x)
 let app_const_env f x e n =
-  ret (fun obj -> f x (Obj.field (Array.unsafe_get obj e) n))
+  ret (fun obj ->
+    f x (Array.unsafe_get (Obj.magic (Array.unsafe_get obj e) : obj) n))
 let app_env_const f e n x =
-  ret (fun obj -> f (Obj.field (Array.unsafe_get obj e) n) x)
-let meth_app_const n x = ret (fun obj -> (send obj n) x)
+  ret (fun obj ->
+    f (Array.unsafe_get (Obj.magic (Array.unsafe_get obj e) : obj) n) x)
+let meth_app_const n x = ret (fun obj -> (sendself obj n) x)
 let meth_app_var n m =
-  ret (fun obj -> (send obj n) (Array.unsafe_get obj m))
+  ret (fun obj -> (sendself obj n) (Array.unsafe_get obj m))
 let meth_app_env n e m =
-  ret (fun obj -> (send obj n) (Obj.field (Array.unsafe_get obj e) m))
+  ret (fun obj -> (sendself obj n)
+      (Array.unsafe_get (Obj.magic (Array.unsafe_get obj e) : obj) m))
 let meth_app_meth n m =
-  ret (fun obj -> (send obj n) (send obj m))
+  ret (fun obj -> (sendself obj n) (sendself obj m))
+let send_const m x c =
+  ret (fun obj -> sendcache x m (Array.unsafe_get obj 0) c)
+let send_var m n c =
+  ret (fun obj ->
+    sendcache (Obj.magic (Array.unsafe_get obj n) : obj) m
+      (Array.unsafe_get obj 0) c)
+let send_env m e n c =
+  ret (fun obj ->
+    sendcache
+      (Obj.magic (Array.unsafe_get
+                    (Obj.magic (Array.unsafe_get obj e) : obj) n) : obj)
+      m (Array.unsafe_get obj 0) c)
+let send_meth m n c =
+  ret (fun obj ->
+    sendcache (sendself obj n) m (Array.unsafe_get obj 0) c)
+let new_cache table =
+  let n = new_method table in
+  let n =
+    if n mod 2 = 0 || n > 2 + magic table.methods.(1) * 16 / Sys.word_size
+    then n else new_method table
+  in
+  table.methods.(n) <- Obj.magic 0;
+  n
 
 type impl =
     GetConst
@@ -583,23 +490,27 @@ type impl =
   | MethAppVar
   | MethAppEnv
   | MethAppMeth
-  | Closure of Obj.t
+  | SendConst
+  | SendVar
+  | SendEnv
+  | SendMeth
+  | Closure of closure
 
-let method_impl i arr =
+let method_impl table i arr =
   let next () = incr i; magic arr.(!i) in
   match next() with
-    GetConst -> let x : t = next() in ret (fun obj -> x)
+    GetConst -> let x : t = next() in get_const x
   | GetVar   -> let n = next() in get_var n
   | GetEnv   -> let e = next() and n = next() in get_env e n
   | GetMeth  -> let n = next() in get_meth n
   | SetVar   -> let n = next() in set_var n
-  | AppConst -> let f = next() and x = next() in ret (fun obj -> f x)
+  | AppConst -> let f = next() and x = next() in app_const f x
   | AppVar   -> let f = next() and n = next () in app_var f n
   | AppEnv   ->
       let f = next() and e = next() and n = next() in app_env f e n
   | AppMeth  -> let f = next() and n = next () in app_meth f n
   | AppConstConst ->
-      let f = next() and x = next() and y = next() in ret (fun obj -> f x y)
+      let f = next() and x = next() and y = next() in app_const_const f x y
   | AppConstVar ->
       let f = next() and x = next() and n = next() in app_const_var f x n
   | AppConstEnv ->
@@ -622,12 +533,21 @@ let method_impl i arr =
       let n = next() and e = next() and m = next() in meth_app_env n e m
   | MethAppMeth ->
       let n = next() and m = next() in meth_app_meth n m
+  | SendConst ->
+      let m = next() and x = next() in send_const m x (new_cache table)
+  | SendVar ->
+      let m = next() and n = next () in send_var m n (new_cache table)
+  | SendEnv ->
+      let m = next() and e = next() and n = next() in
+      send_env m e n (new_cache table)
+  | SendMeth ->
+      let m = next() and n = next () in send_meth m n (new_cache table)
   | Closure _ as clo -> magic clo
 
 let set_methods table methods =
   let len = Array.length methods and i = ref 0 in
   while !i < len do
-    let label = methods.(!i) and clo = method_impl i methods in
+    let label = methods.(!i) and clo = method_impl table i methods in
     set_method table label clo;
     incr i
   done
@@ -635,35 +555,8 @@ let set_methods table methods =
 (**** Statistics ****)
 
 type stats =
-  { classes: int; labels: int; methods: int; inst_vars: int; buckets: int;
-    distrib : int array; small_bucket_count: int; small_bucket_max: int }
-
-let distrib () =
-  let d = Array.create 32 0 in
-  List.iter
-    (function b ->
-       let n = bucket_used b in
-       d.(n - 1) <- d.(n - 1) + 1)
-    !bucket_list;
-  d
+  { classes: int; methods: int; inst_vars: int; }
 
 let stats () =
-  { classes = !table_count; labels = !label_count;
-    methods = !method_count; inst_vars = !inst_var_count;
-    buckets = List.length !bucket_list; distrib = distrib ();
-    small_bucket_count = !small_bucket_count;
-    small_bucket_max = Array.length !small_buckets  }
-
-let sort_buck lst =
-  List.map snd
-    (Sort.list (fun (n, _) (n', _) -> n <= n')
-       (List.map (function b -> (bucket_used b, b)) lst))
-
-let show_buckets () =
-  List.iter
-    (function b ->
-       for i = 0 to bucket_size - 1 do
-         print_char (if b.(i) == dummy_item then '.' else '*')
-       done;
-       print_newline ())
-    (sort_buck !bucket_list)
+  { classes = !table_count;
+    methods = !method_count; inst_vars = !inst_var_count; }
diff --git a/stdlib/camlinternalOO.mli b/stdlib/camlinternalOO.mli
index 0195d465f5..8b6c980f6a 100644
--- a/stdlib/camlinternalOO.mli
+++ b/stdlib/camlinternalOO.mli
@@ -17,22 +17,23 @@
     All functions in this module are for system use only, not for the
     casual user. *)
 
-(** {6 Methods} *)
-
-type label
-val new_method : string -> label
-val public_method_label : string -> label
-
 (** {6 Classes} *)
 
+type tag
+type label
 type table
 type meth
 type t
 type obj
+type closure
+val public_method_label : string -> tag
+val new_method : table -> label
 val new_variable : table -> string -> int
 val new_variables : table -> string array -> int
 val get_variable : table -> string -> int
+val get_variables : table -> string array -> int array
 val get_method_label : table -> string -> label
+val get_method_labels : table -> string array -> label array
 val get_method : table -> label -> meth
 val set_method : table -> label -> meth -> unit
 val set_methods : table -> label array -> unit
@@ -60,17 +61,19 @@ val create_object_opt : obj -> table -> obj
 val run_initializers : obj -> table -> unit
 val run_initializers_opt : obj -> obj -> table -> obj
 val create_object_and_run_initializers : obj -> table -> obj
-external send : obj -> label -> t = "%send"
+external send : obj -> tag -> t = "%send"
+external sendcache : obj -> tag -> t -> int -> t = "%sendcache"
+external sendself : obj -> label -> t = "%sendself"
+external get_public_method : obj -> tag -> closure
+    = "caml_get_public_method" "noalloc"
 
 (** {6 Table cache} *)
 
 type tables
-val lookup_tables : tables -> table array -> tables
+val lookup_tables : tables -> closure array -> tables
 
 (** {6 Builtins to reduce code size} *)
 
-open Obj
-type closure
 val get_const : t -> closure
 val get_var : int -> closure
 val get_env : int -> int -> closure
@@ -91,6 +94,10 @@ val meth_app_const : label -> t -> closure
 val meth_app_var : label -> int -> closure
 val meth_app_env : label -> int -> int -> closure
 val meth_app_meth : label -> label -> closure
+val send_const : tag -> obj -> int -> closure
+val send_var : tag -> int -> int -> closure
+val send_env : tag -> int -> int -> int -> closure
+val send_meth : tag -> label -> int -> closure
 
 type impl =
     GetConst
@@ -113,10 +120,15 @@ type impl =
   | MethAppVar
   | MethAppEnv
   | MethAppMeth
-  | Closure of t
+  | SendConst
+  | SendVar
+  | SendEnv
+  | SendMeth
+  | Closure of closure
 
 (** {6 Parameters} *)
 
+(* currently disabled *)
 type params =
   { mutable compact_table : bool;
     mutable copy_parent : bool;
@@ -130,12 +142,6 @@ val params : params
 
 type stats =
   { classes : int; 
-    labels : int; 
     methods : int; 
-    inst_vars : int; 
-    buckets : int;
-    distrib : int array; 
-    small_bucket_count : int; 
-    small_bucket_max : int }
+    inst_vars : int }
 val stats : unit -> stats
-val show_buckets : unit -> unit
diff --git a/stdlib/filename.ml b/stdlib/filename.ml
index 82dce717bd..7d6887eaf4 100644
--- a/stdlib/filename.ml
+++ b/stdlib/filename.ml
@@ -28,11 +28,9 @@ let generic_quote quotequote s =
 module Unix = struct
   let current_dir_name = "."
   let parent_dir_name = ".."
-  let concat dirname filename =
-    let l = String.length dirname in
-    if l = 0 || dirname.[l-1] = '/'
-    then dirname ^ filename
-    else dirname ^ "/" ^ filename
+  let dir_sep = "/"
+  let is_dir_sep s i = s.[i] = '/'
+  let rindex_dir_sep s = String.rindex s '/'
   let is_relative n = String.length n < 1 || n.[0] <> '/';;
   let is_implicit n =
     is_relative n
@@ -42,19 +40,6 @@ module Unix = struct
     String.length name >= String.length suff &&
     String.sub name (String.length name - String.length suff)
                     (String.length suff) = suff
-  let basename name =
-    try
-      let p = String.rindex name '/' + 1 in
-      String.sub name p (String.length name - p)
-    with Not_found ->
-      name
-  let dirname name =
-    try
-      match String.rindex name '/' with
-        0 -> "/"
-      | n -> String.sub name 0 n
-    with Not_found ->
-      "."
   let temporary_directory =
     try Sys.getenv "TMPDIR" with Not_found -> "/tmp"
   let quote = generic_quote "'\\''"  
@@ -63,11 +48,14 @@ end
 module Win32 = struct
   let current_dir_name = "."
   let parent_dir_name = ".."
-  let concat dirname filename =
-    let l = String.length dirname in
-    if l = 0 || (let c = dirname.[l-1] in c = '/' || c = '\\' || c = ':')
-    then dirname ^ filename
-    else dirname ^ "\\" ^ filename
+  let dir_sep = "\\"
+  let is_dir_sep s i = let c = s.[i] in c = '/' || c = '\\' || c = ':'
+  let rindex_dir_sep s =
+    let rec pos i =
+      if i < 0 then raise Not_found
+      else if (let c = s.[i] in c = '/' || c = '\\' || c = ':') then i
+      else pos (i - 1)
+    in pos (String.length s - 1)
   let is_relative n =
     (String.length n < 1 || n.[0] <> '/')
     && (String.length n < 1 || n.[0] <> '\\')
@@ -83,29 +71,6 @@ module Win32 = struct
    (let s = String.sub name (String.length name - String.length suff)
                             (String.length suff) in
     String.lowercase s = String.lowercase suff)
-  let rindexsep s =
-    let rec pos i =
-      if i < 0 then raise Not_found
-      else if (let c = s.[i] in c = '/' || c = '\\' || c = ':') then i
-      else pos (i - 1)
-    in pos (String.length s - 1)
-  let basename name =
-    try
-      let p = rindexsep name + 1 in
-      String.sub name p (String.length name - p)
-    with Not_found ->
-      name
-  let dirname name =
-    try
-      match rindexsep name with
-        0 -> "\\"
-      | n ->
-          let n =
-            if name.[n] = ':' || (n > 0 && name.[n-1] = ':')
-            then n+1 else n in
-          String.sub name 0 n
-    with Not_found ->
-      "."
   let temporary_directory =
     try Sys.getenv "TEMP" with Not_found -> "."
   let quote s =
@@ -127,57 +92,67 @@ end
 module Cygwin = struct
   let current_dir_name = "."
   let parent_dir_name = ".."
-  let concat dirname filename =
-    let l = String.length dirname in
-    if l = 0 || (let c = dirname.[l-1] in c = '/' || c = '\\' || c = ':')
-    then dirname ^ filename
-    else dirname ^ "/" ^ filename
+  let dir_sep = "/"
+  let is_dir_sep = Win32.is_dir_sep
+  let rindex_dir_sep = Win32.rindex_dir_sep
   let is_relative = Win32.is_relative
   let is_implicit = Win32.is_implicit
   let check_suffix = Win32.check_suffix
-  let basename = Win32.basename
-  let dirname name =
-    try
-      match Win32.rindexsep name with
-        0 -> "/"
-      | n ->
-          let n =
-            if name.[n] = ':' || (n > 0 && name.[n-1] = ':')
-            then n+1 else n in
-          String.sub name 0 n
-    with Not_found ->
-      "."
   let temporary_directory = Unix.temporary_directory
   let quote = Unix.quote
 end
 
-let (current_dir_name, parent_dir_name, concat, is_relative, is_implicit,
-     check_suffix, basename, dirname, temporary_directory, quote) =
+let (current_dir_name, parent_dir_name, dir_sep, is_dir_sep, rindex_dir_sep,
+     is_relative, is_implicit, check_suffix, temporary_directory, quote) =
   match Sys.os_type with
     "Unix" ->
-      (Unix.current_dir_name, Unix.parent_dir_name, Unix.concat,
+      (Unix.current_dir_name, Unix.parent_dir_name, Unix.dir_sep, 
+       Unix.is_dir_sep, Unix.rindex_dir_sep,
        Unix.is_relative, Unix.is_implicit, Unix.check_suffix,
-       Unix.basename, Unix.dirname, Unix.temporary_directory, Unix.quote)
+       Unix.temporary_directory, Unix.quote)
   | "Win32" ->
-      (Win32.current_dir_name, Win32.parent_dir_name, Win32.concat,
+      (Win32.current_dir_name, Win32.parent_dir_name, Win32.dir_sep, 
+       Win32.is_dir_sep, Win32.rindex_dir_sep,
        Win32.is_relative, Win32.is_implicit, Win32.check_suffix,
-       Win32.basename, Win32.dirname, Win32.temporary_directory, Win32.quote)
+       Win32.temporary_directory, Win32.quote)
   | "Cygwin" ->
-      (Cygwin.current_dir_name, Cygwin.parent_dir_name, Cygwin.concat,
+      (Cygwin.current_dir_name, Cygwin.parent_dir_name, Cygwin.dir_sep, 
+       Cygwin.is_dir_sep, Cygwin.rindex_dir_sep,
        Cygwin.is_relative, Cygwin.is_implicit, Cygwin.check_suffix,
-       Cygwin.basename, Cygwin.dirname, 
        Cygwin.temporary_directory, Cygwin.quote)
   | _ -> assert false
 
+let concat dirname filename =
+  let l = String.length dirname in
+  if l = 0 || is_dir_sep dirname (l-1)
+  then dirname ^ filename
+  else dirname ^ dir_sep ^ filename
+
+let basename name =
+  try
+    let p = rindex_dir_sep name + 1 in
+    String.sub name p (String.length name - p)
+  with Not_found ->
+    name
+
+let dirname name =
+  try
+    match rindex_dir_sep name with
+      0 -> dir_sep
+    | n -> String.sub name 0 n
+  with Not_found ->
+    current_dir_name
+
 let chop_suffix name suff =
   let n = String.length name - String.length suff in
   if n < 0 then invalid_arg "Filename.chop_suffix" else String.sub name 0 n
 
 let chop_extension name =
-  try
-    String.sub name 0 (String.rindex name '.')
-  with Not_found ->
-    invalid_arg "Filename.chop_extension"
+  let rec search_dot i =
+    if i < 0 || is_dir_sep name i then invalid_arg "Filename.chop_extension"
+    else if name.[i] = '.' then String.sub name 0 i
+    else search_dot (i - 1) in
+  search_dot (String.length name - 1)
 
 external open_desc: string -> open_flag list -> int -> int = "caml_sys_open"
 external close_desc: int -> unit = "caml_sys_close"
diff --git a/stdlib/filename.mli b/stdlib/filename.mli
index 2d0d34396d..086775f5e9 100644
--- a/stdlib/filename.mli
+++ b/stdlib/filename.mli
@@ -48,10 +48,11 @@ val chop_suffix : string -> string -> string
 
 val chop_extension : string -> string
 (** Return the given file name without its extension. The extension
-   is the shortest suffix starting with a period, [.xyz] for instance.
+   is the shortest suffix starting with a period and not including
+   a directory separator, [.xyz] for instance.
 
    Raise [Invalid_argument] if the given name does not contain
-   a period. *)
+   an extension. *)
 
 val basename : string -> string
 (** Split a file name into directory name / base file name.
diff --git a/stdlib/format.mli b/stdlib/format.mli
index a8c83bd1b6..3526e2365b 100644
--- a/stdlib/format.mli
+++ b/stdlib/format.mli
@@ -20,6 +20,9 @@
    at specified break hints, and indents lines according to the box
    structure.
 
+   For a gentle introduction to the basics of prety-printing using
+   [Format], read the FAQ at [http://caml.inria.fr/FAQ/format-eng.html]. 
+
    Warning: the material output by the following functions is delayed
    in the pretty-printer queue in order to compute the proper line
    breaking. Hence, you should not mix calls to the printing functions
@@ -584,7 +587,9 @@ val fprintf : formatter -> ('a, formatter, unit) format -> 'a;;
      [nspaces] and [offset] parameters of the break may be
      optionally specified with the following syntax: 
      the [<] character, followed by an integer [nspaces] value,
-     then an integer offset, and a closing [>] character. 
+     then an integer offset, and a closing [>] character.
+     If no parameters are provided, the good break defaults to a
+     space.
    - [@?]: flush the pretty printer as with [print_flush ()].
      This is equivalent to the conversion [%!].
    - [@.]: flush the pretty printer and output a new line, as with
diff --git a/stdlib/gc.ml b/stdlib/gc.ml
index e4a15aea66..7299ff867c 100644
--- a/stdlib/gc.ml
+++ b/stdlib/gc.ml
@@ -78,6 +78,7 @@ let allocated_bytes () =
 ;;
 
 external finalise : ('a -> unit) -> 'a -> unit = "caml_final_register";;
+external finalise_release : unit -> unit = "caml_final_release";;
 
 
 type alarm = bool ref;;
diff --git a/stdlib/gc.mli b/stdlib/gc.mli
index 491faab393..bafa8ed9f7 100644
--- a/stdlib/gc.mli
+++ b/stdlib/gc.mli
@@ -188,14 +188,15 @@ val finalise : ('a -> unit) -> 'a -> unit
    be registered for the same value, or even several instances of the
    same function.  Each instance will be called once (or never,
    if the program terminates before [v] becomes unreachable).
-   
-  
-   A number of pitfalls are associated with finalised values:
-   finalisation functions are called asynchronously, sometimes
-   even during the execution of other finalisation functions.
-   In a multithreaded program, finalisation functions are called
-   from any thread, thus they must not acquire any mutex.
 
+   The GC will call the finalisation functions in the order of
+   deallocation.  When several values become unreachable at the
+   same time (i.e. during the same GC cycle), the finalisation
+   functions will be called in the reverse order of the corresponding
+   calls to [finalise].  If [finalise] is called in the same order
+   as the values are allocated, that means each value is finalised
+   before the values it depends upon.  Of course, this becomes
+   false if additional dependencies are introduced by assignments.
 
    Anything reachable from the closure of finalisation functions
    is considered reachable, so the following code will not work
@@ -232,10 +233,14 @@ val finalise : ('a -> unit) -> 'a -> unit
    
    The results of calling {!String.make}, {!String.create},
    {!Array.make}, and {!Pervasives.ref} are guaranteed to be
-   heap-allocated and non-constant
-   except when the length argument is [0].
+   heap-allocated and non-constant except when the length argument is [0].
 *)
 
+val finalise_release : unit -> unit;;
+(** A finalisation function may call [finalise_release] to tell the
+    GC that it can launch the next finalisation function without waiting
+    for the current one to return. *)
+
 type alarm
 (** An alarm is a piece of data that calls a user function at the end of
    each major GC cycle.  The following functions are provided to create
diff --git a/stdlib/hashtbl.ml b/stdlib/hashtbl.ml
index 0169f747ae..225aa6be78 100644
--- a/stdlib/hashtbl.ml
+++ b/stdlib/hashtbl.ml
@@ -44,6 +44,8 @@ let copy h =
   { size = h.size;
     data = Array.copy h.data }
 
+let length h = h.size
+
 let resize hashfun tbl =
   let odata = tbl.data in
   let osize = Array.length odata in
@@ -184,6 +186,7 @@ module type S =
     val mem : 'a t -> key -> bool
     val iter: (key -> 'a -> unit) -> 'a t -> unit
     val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+    val length: 'a t -> int
   end
 
 module Make(H: HashedType): (S with type key = H.t) =
@@ -272,4 +275,7 @@ module Make(H: HashedType): (S with type key = H.t) =
 
     let iter = iter
     let fold = fold
+    let length = length
   end
+
+(* eof $Id$ *)
diff --git a/stdlib/hashtbl.mli b/stdlib/hashtbl.mli
index fcb296a7ce..d6434ade79 100644
--- a/stdlib/hashtbl.mli
+++ b/stdlib/hashtbl.mli
@@ -35,6 +35,7 @@ val create : int -> ('a, 'b) t
 val clear : ('a, 'b) t -> unit
 (** Empty a hash table. *)
 
+
 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
@@ -91,6 +92,12 @@ val fold : ('a -> 'b -> 'c -> 'c) -> ('a, 'b) t -> 'c -> 'c
    the most recent binding is passed first. *)
 
 
+val length : ('a, 'b) t -> int
+(** [Hashtbl.length tbl] returns the number of bindings in [tbl]. 
+   Multiple bindings are counted multiply, so [Hashtbl.length] 
+   gives the number of times [Hashtbl.iter] calls it first argument. *)
+
+
 (** {6 Functorial interface} *)
 
 
@@ -130,6 +137,7 @@ module type S =
     val mem : 'a t -> key -> bool
     val iter : (key -> 'a -> unit) -> 'a t -> unit
     val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+    val length : 'a t -> int
   end
 (** The output signature of the functor {!Hashtbl.Make}. *)
 
diff --git a/stdlib/map.ml b/stdlib/map.ml
index 26c4d23c00..81b3396f33 100644
--- a/stdlib/map.ml
+++ b/stdlib/map.ml
@@ -24,6 +24,7 @@ module type S =
     type key
     type +'a t
     val empty: 'a t
+    val is_empty: 'a t -> bool
     val add: key -> 'a -> 'a t -> 'a t
     val find: key -> 'a t -> 'a
     val remove: key -> 'a t -> 'a t
@@ -32,6 +33,8 @@ module type S =
     val map: ('a -> 'b) -> 'a t -> 'b t
     val mapi: (key -> 'a -> 'b) -> 'a t -> 'b t
     val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+    val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int
+    val equal: ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
   end
 
 module Make(Ord: OrderedType) = struct
@@ -42,8 +45,6 @@ module Make(Ord: OrderedType) = struct
         Empty
       | Node of 'a t * key * 'a * 'a t * int
 
-    let empty = Empty
-
     let height = function
         Empty -> 0
       | Node(_,_,_,_,h) -> h
@@ -82,6 +83,10 @@ module Make(Ord: OrderedType) = struct
       end else
         Node(l, x, d, r, (if hl >= hr then hl + 1 else hr + 1))
 
+    let empty = Empty
+
+    let is_empty = function Empty -> true | _ -> false
+
     let rec add x data = function
         Empty ->
           Node(Empty, x, data, Empty, 1)
@@ -158,4 +163,36 @@ module Make(Ord: OrderedType) = struct
       | Node(l, v, d, r, _) ->
           fold f l (f v d (fold f r accu))
 
+    type 'a enumeration = End | More of key * 'a * 'a t * 'a enumeration
+
+    let rec cons_enum m e =
+      match m with
+        Empty -> e
+      | Node(l, v, d, r, _) -> cons_enum l (More(v, d, r, e))
+
+    let compare cmp m1 m2 =
+      let rec compare_aux e1 e2 =
+          match (e1, e2) with
+          (End, End) -> 0
+        | (End, _)  -> -1
+        | (_, End) -> 1
+        | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) ->
+            let c = Ord.compare v1 v2 in
+            if c <> 0 then c else
+            let c = cmp d1 d2 in
+            if c <> 0 then c else
+            compare_aux (cons_enum r1 e1) (cons_enum r2 e2)
+      in compare_aux (cons_enum m1 End) (cons_enum m2 End)
+
+    let equal cmp m1 m2 =
+      let rec equal_aux e1 e2 =
+          match (e1, e2) with
+          (End, End) -> true
+        | (End, _)  -> false
+        | (_, End) -> false
+        | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) ->
+            Ord.compare v1 v2 = 0 && cmp d1 d2 &&
+            equal_aux (cons_enum r1 e1) (cons_enum r2 e2)
+      in equal_aux (cons_enum m1 End) (cons_enum m2 End)
+
 end
diff --git a/stdlib/map.mli b/stdlib/map.mli
index ea8cc68f4f..71d6e269c1 100644
--- a/stdlib/map.mli
+++ b/stdlib/map.mli
@@ -49,6 +49,9 @@ module type S =
     val empty: 'a t
     (** The empty map. *)
 
+    val is_empty: 'a t -> bool
+    (** Test whether a map is empty or not. *)
+
     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
@@ -90,6 +93,16 @@ module type S =
        where [k1 ... kN] are the keys of all bindings in [m]
        (in increasing order), and [d1 ... dN] are the associated data. *)
 
+    val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int
+    (** Total ordering between maps.  The first argument is a total ordering
+        used to compare data associated with equal keys in the two maps. *)
+
+    val equal: ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
+    (** [equal cmp m1 m2] tests whether the maps [m1] and [m2] are
+       equal, that is, contain equal keys and associate them with
+       equal data.  [cmp] is the equality predicate used to compare
+       the data associated with the keys. *)
+
   end
 (** Output signature of the functor {!Map.Make}. *)
 
diff --git a/stdlib/moreLabels.mli b/stdlib/moreLabels.mli
index 6a690470cb..fbf848cba8 100644
--- a/stdlib/moreLabels.mli
+++ b/stdlib/moreLabels.mli
@@ -38,6 +38,7 @@ module Hashtbl : sig
   val fold :
       f:(key:'a -> data:'b -> 'c -> 'c) ->
         ('a, 'b) t -> init:'c -> 'c
+  val length : ('a, 'b) t -> int
   module type HashedType = Hashtbl.HashedType
   module type S =
     sig
@@ -56,6 +57,7 @@ module Hashtbl : sig
       val fold :
           f:(key:key -> data:'a -> 'b -> 'b) ->
           'a t -> init:'b -> 'b
+      val length : 'a t -> int
     end
   module Make : functor (H : HashedType) -> S with type key = H.t
   val hash : 'a -> int
@@ -70,6 +72,7 @@ module Map : sig
       type key
       and (+'a) t
       val empty : 'a t
+      val is_empty: 'a t -> bool
       val add : key:key -> data:'a -> 'a t -> 'a t
       val find : key -> 'a t -> 'a
       val remove : key -> 'a t -> 'a t
@@ -80,7 +83,9 @@ module Map : sig
       val fold :
           f:(key:key -> data:'a -> 'b -> 'b) ->
           'a t -> init:'b -> 'b
-    end
+      val compare: cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int
+      val equal: cmp:('a -> 'a -> bool) -> 'a t -> 'a t -> bool
+  end
   module Make : functor (Ord : OrderedType) -> S with type key = Ord.t
 end
 
@@ -113,6 +118,7 @@ module Set : sig
       val min_elt : t -> elt
       val max_elt : t -> elt
       val choose : t -> elt
+      val split: elt -> t -> t * bool * t
     end
   module Make : functor (Ord : OrderedType) -> S with type elt = Ord.t
 end
diff --git a/stdlib/oo.ml b/stdlib/oo.ml
index e8795d8573..c9ec64ae44 100644
--- a/stdlib/oo.ml
+++ b/stdlib/oo.ml
@@ -15,5 +15,5 @@
 
 let copy = CamlinternalOO.copy
 external id : < .. > -> int = "%field1"
-let new_method = CamlinternalOO.new_method
+let new_method = CamlinternalOO.public_method_label
 let public_method_label = CamlinternalOO.public_method_label
diff --git a/stdlib/oo.mli b/stdlib/oo.mli
index c18bfa51e4..b3111ce857 100644
--- a/stdlib/oo.mli
+++ b/stdlib/oo.mli
@@ -25,5 +25,5 @@ external id : < .. > -> int = "%field1"
 
 (**/**)
 (** For internal use (CamlIDL) *)
-val new_method : string -> CamlinternalOO.label
-val public_method_label : string -> CamlinternalOO.label
+val new_method : string -> CamlinternalOO.tag
+val public_method_label : string -> CamlinternalOO.tag
diff --git a/stdlib/parsing.mli b/stdlib/parsing.mli
index 6045c18d36..c6dc8e3212 100644
--- a/stdlib/parsing.mli
+++ b/stdlib/parsing.mli
@@ -30,7 +30,7 @@ val rhs_start : int -> int
 (** Same as {!Parsing.symbol_start} and {!Parsing.symbol_end}, but
    return the offset of the string matching the [n]th item on the
    right-hand side of the rule, where [n] is the integer parameter
-   to [lhs_start] and [lhs_end]. [n] is 1 for the leftmost item. *)
+   to [rhs_start] and [rhs_end]. [n] is 1 for the leftmost item. *)
 
 val rhs_end : int -> int
 (** See {!Parsing.rhs_start}. *)
diff --git a/stdlib/pervasives.mli b/stdlib/pervasives.mli
index 2561cc4cab..0b678ca28f 100644
--- a/stdlib/pervasives.mli
+++ b/stdlib/pervasives.mli
@@ -603,7 +603,9 @@ val output_byte : out_channel -> int -> unit
    256. *)
 
 val output_binary_int : out_channel -> int -> unit
-(** Write one integer in binary format on the given output channel.
+(** Write one integer in binary format (4 bytes, big-endian)
+   on the given output channel.
+   The given integer is taken modulo 2{^32}.
    The only reliable way to read it back is through the
    {!Pervasives.input_binary_int} function. The format is compatible across
    all machines for a given version of Objective Caml. *)
@@ -623,7 +625,9 @@ val seek_out : out_channel -> int -> unit
    the behavior is unspecified. *)
 
 val pos_out : out_channel -> int
-(** Return the current writing position for the given channel. *)
+(** Return the current writing position for the given channel.  Does
+    not work on channels opened with the [Open_append] flag (returns
+    unspecified results). *)
 
 val out_channel_length : out_channel -> int
 (** Return the total length (number of characters) of the
@@ -713,8 +717,8 @@ val input_byte : in_channel -> int
    Raise [End_of_file] if an end of file was reached. *)
 
 val input_binary_int : in_channel -> int
-(** Read an integer encoded in binary format from the given input
-   channel. See {!Pervasives.output_binary_int}.
+(** Read an integer encoded in binary format (4 bytes, big-endian)
+   from the given input channel. See {!Pervasives.output_binary_int}.
    Raise [End_of_file] if an end of file was reached while reading the
    integer. *)
 
diff --git a/stdlib/scanf.ml b/stdlib/scanf.ml
index 7413e21493..78adcc706a 100644
--- a/stdlib/scanf.ml
+++ b/stdlib/scanf.ml
@@ -115,8 +115,9 @@ type scanbuf = {
   file_name : file_name;
 };;
 
-(* Reads a new character from input buffer, sets the end of file
-   condition if necessary. *)
+(* Reads a new character from input buffer.  Next_char never fails,
+   even in case of end of input: it then simply sets the end of file
+   condition. *)
 let next_char ib =
   try
    let c = ib.get_next_char () in
@@ -264,8 +265,9 @@ let check_char_in range ib =
 (* Checking that [c] is indeed in the input, then skip it. *)
 let check_char ib c =
   let ci = Scanning.checked_peek_char ib in
-  if ci == c then Scanning.next_char ib else
-  bad_input (Printf.sprintf "looking for %C, found %C" c ci);;
+  if ci != c
+  then bad_input (Printf.sprintf "looking for %C, found %C" c ci)
+  else Scanning.next_char ib;;
 
 (* Extracting tokens from ouput token buffer. *)
 
@@ -315,11 +317,20 @@ let token_int64 conv ib = int64_of_string (token_int_literal conv ib);;
 
 (* Scanning numbers. *)
 
-(* The decimal case is optimized. *)
+(* Digits scanning functions suppose that one character has been
+   checked and is available, since they return at end of file with the
+   currently found token selected. The digits scanning functions scan
+   a possibly empty sequence of digits, (hence a successful scanning
+   from one of those functions does not imply that the token is a
+   well-formed number: to get a true number, it is mandatory to check
+   that at least one digit is available before calling a digit
+   scanning function). *)
+
+(* The decimal case is treated especially for optimization purposes. *)
 let scan_decimal_digits max ib =
   let rec loop inside max =
     if max = 0 || Scanning.eof ib then max else
-    match Scanning.checked_peek_char ib with
+    match Scanning.cautious_peek_char ib with
     | '0' .. '9' as c ->
         let max = Scanning.store_char ib c max in
         loop true max
@@ -329,11 +340,12 @@ let scan_decimal_digits max ib =
     | c -> max in
   loop false max;;
 
-(* Other cases uses a predicate argument to scan_digits. *)
+(* To scan numbers from other bases, we use a predicate argument to
+   scan_digits. *)
 let scan_digits digitp max ib =
   let rec loop inside max =
     if max = 0 || Scanning.eof ib then max else
-    match Scanning.checked_peek_char ib with
+    match Scanning.cautious_peek_char ib with
     | c when digitp c ->
        let max = Scanning.store_char ib c max in
        loop true max
@@ -343,28 +355,41 @@ let scan_digits digitp max ib =
     | _ -> max in
   loop false max;;
 
-let scan_binary_digits =
-  let is_binary_digit = function
+let scan_digits_plus digitp max ib =
+  let c = Scanning.checked_peek_char ib in
+  if digitp c then
+    let max = Scanning.store_char ib c max in
+    scan_digits digitp max ib
+  else bad_input_char c;;
+
+let is_binary_digit = function
   | '0' .. '1' -> true
-  | _ -> false in
-  scan_digits is_binary_digit;;
+  | _ -> false;;
 
-let scan_octal_digits =
-  let is_octal_digit = function
+let scan_binary_digits = scan_digits is_binary_digit;;
+let scan_binary_int = scan_digits_plus is_binary_digit;;
+
+let is_octal_digit = function
   | '0' .. '7' -> true
-  | _ -> false in
-  scan_digits is_octal_digit;;
+  | _ -> false;;
+
+let scan_octal_digits = scan_digits is_octal_digit;;
+let scan_octal_int = scan_digits_plus is_octal_digit;;
 
-let scan_hexadecimal_digits =
-  let is_hexa_digit = function
+let is_hexa_digit = function
   | '0' .. '9' | 'a' .. 'f' | 'A' .. 'F' -> true
-  | _ -> false in
-  scan_digits is_hexa_digit;;
+  | _ -> false;;
+
+let scan_hexadecimal_digits = scan_digits is_hexa_digit;;
+let scan_hexadecimal_int = scan_digits_plus is_hexa_digit;;
 
-(* Decimal integers. *)
+(* Scan a decimal integer. *)
 let scan_unsigned_decimal_int max ib =
-  if max = 0 || Scanning.eof ib then bad_input "decimal digit" else
-  scan_decimal_digits max ib;;
+  match Scanning.checked_peek_char ib with
+  | '0' .. '9' as c ->
+      let max = Scanning.store_char ib c max in
+      scan_decimal_digits max ib
+  | c -> bad_input_char c;;
 
 let scan_sign max ib =
   let c = Scanning.checked_peek_char ib in
@@ -392,28 +417,27 @@ let scan_unsigned_int max ib =
       | 'o' -> scan_octal_digits (Scanning.store_char ib c max) ib
       | 'b' -> scan_binary_digits (Scanning.store_char ib c max) ib
       | c -> scan_decimal_digits max ib end
-  | c -> scan_decimal_digits max ib;;
+  | c -> scan_unsigned_decimal_int max ib;;
 
 let scan_optionally_signed_int max ib =
   let max = scan_sign max ib in
-  if max = 0 || Scanning.eof ib then bad_input "bad int" else
   scan_unsigned_int max ib;;
 
-let scan_int conv max ib =
+let scan_int_conv conv max ib =
   match conv with
-  | 'b' -> scan_binary_digits max ib
+  | 'b' -> scan_binary_int max ib
   | 'd' -> scan_optionally_signed_decimal_int max ib
   | 'i' -> scan_optionally_signed_int max ib
-  | 'o' -> scan_octal_digits max ib
+  | 'o' -> scan_octal_int max ib
   | 'u' -> scan_unsigned_decimal_int max ib
-  | 'x' | 'X' -> scan_hexadecimal_digits max ib
+  | 'x' | 'X' -> scan_hexadecimal_int max ib
   | c -> assert false;;
 
 (* Scanning floating point numbers. *)
 (* Fractional part is optional and can be reduced to 0 digits. *)
 let scan_frac_part max ib =
   if max = 0 || Scanning.eof ib then max else
-  scan_unsigned_decimal_int max ib;;
+  scan_decimal_digits max ib;;
 
 (* Exp part is optional and can be reduced to 0 digits. *)
 let scan_exp_part max ib =
@@ -424,8 +448,17 @@ let scan_exp_part max ib =
      scan_optionally_signed_decimal_int (Scanning.store_char ib c max) ib
   | _ -> max;;
 
+(* An optional sign followed by a possibly empty sequence of decimal digits. *)
+let scan_optionally_signed_decimal_digits max ib =
+  let max = scan_sign max ib in
+  scan_decimal_digits max ib;;
+
+(* Scan the integer part of a floating point number, (not using the
+   Caml lexical convention since the integer part can be empty). *)
+let scan_int_part = scan_optionally_signed_decimal_digits;;
+
 let scan_float max ib =
-  let max = scan_optionally_signed_decimal_int max ib in
+  let max = scan_int_part max ib in
   if max = 0 || Scanning.eof ib then max else
   let c = Scanning.peek_char ib in
   match c with
@@ -448,7 +481,7 @@ let scan_Float max ib =
      scan_exp_part max ib
   | c -> bad_float ();;
 
-(* Scan a regular string: it stops with a space or one of the
+(* Scan a regular string: stops when encountering a space or one of the
    characters in stp. It also stops when the maximum number of
    characters has been read.*)
 let scan_string stp max ib =
@@ -630,7 +663,7 @@ let make_bv bit set =
     if i <= lim then
     match set.[i] with
     | '-' when rp ->
-       (* if i = 0 then rp is false (since the initial call is loop false 0)
+       (* if i = 0 then rp is false (since the initial call is loop bit false 0)
           hence i >= 1 and the following is safe. *)
        let c1 = set.[i - 1] in
        let i = i + 1 in
@@ -665,6 +698,7 @@ let make_setp stp char_set =
           (fun c -> if c == p1 || c == p2 then 1 else 0)
       | 3 ->
           let p1 = set.[0] and p2 = set.[1] and p3 = set.[2] in
+          if p2 = '-' then make_pred 1 set stp else
           (fun c -> if c == p1 || c == p2 || c == p3 then 1 else 0)
       | n -> make_pred 1 set stp
       end
@@ -679,6 +713,7 @@ let make_setp stp char_set =
           (fun c -> if c != p1 && c != p2 then 1 else 0)
       | 3 ->
           let p1 = set.[0] and p2 = set.[1] and p3 = set.[2] in
+          if p2 = '-' then make_pred 0 set stp else
           (fun c -> if c != p1 && c != p2 && c != p3 then 1 else 0)
       | n -> make_pred 0 set stp
       end;;
@@ -751,14 +786,14 @@ let scan_chars_in_char_set stp char_set max ib =
         | 0 -> loop (fun c -> 0) max
         | 1 -> loop_pos1 set.[0] max
         | 2 -> loop_pos2 set.[0] set.[1] max
-        | 3 -> loop_pos3 set.[0] set.[1] set.[2] max
+        | 3 when set.[1] != '-' -> loop_pos3 set.[0] set.[1] set.[2] max
         | n -> loop (find_setp stp char_set) max end
     | Neg_set set ->
         begin match String.length set with
         | 0 -> loop (fun c -> 1) max
         | 1 -> loop_neg1 set.[0] max
         | 2 -> loop_neg2 set.[0] set.[1] max
-        | 3 -> loop_neg3 set.[0] set.[1] set.[2] max
+        | 3 when set.[1] != '-' -> loop_neg3 set.[0] set.[1] set.[2] max
         | n -> loop (find_setp stp char_set) max end in
   if stp != [] then check_char_in stp ib;
   max;;
@@ -834,7 +869,7 @@ let kscanf ib ef fmt f =
           if conv = 'c' then scan_char max ib else scan_Char max ib in
         scan_fmt (stack f (token_char ib)) (i + 1)
     | 'd' | 'i' | 'o' | 'u' | 'x' | 'X' as conv ->
-        let x = scan_int conv max ib in
+        let x = scan_int_conv conv max ib in
         scan_fmt (stack f (token_int conv ib)) (i + 1)
     | 'f' | 'g' | 'G' | 'e' | 'E' ->
         let x = scan_float max ib in
@@ -862,7 +897,7 @@ let kscanf ib ef fmt f =
         if i > lim then scan_fmt (stack f (get_count t ib)) i else begin
         match fmt.[i] with
         | 'd' | 'i' | 'o' | 'u' | 'x' | 'X' as conv ->
-            let x = scan_int conv max ib in
+            let x = scan_int_conv conv max ib in
             begin match t with
             | 'l' -> scan_fmt (stack f (token_int32 conv ib)) (i + 1)
             | 'L' -> scan_fmt (stack f (token_int64 conv ib)) (i + 1)
diff --git a/stdlib/scanf.mli b/stdlib/scanf.mli
index 891bf1abf3..09753cdbc4 100644
--- a/stdlib/scanf.mli
+++ b/stdlib/scanf.mli
@@ -197,7 +197,6 @@ val bscanf :
 *)
 
 val fscanf : in_channel -> ('a, Scanning.scanbuf, 'b) format -> 'a -> 'b;;
-
 (** Same as {!Scanf.bscanf}, but inputs from the given channel.
 
     Warning: since all scanning functions operate from a scanning
@@ -221,7 +220,7 @@ val sscanf : string -> ('a, Scanning.scanbuf, 'b) format -> 'a -> 'b;;
 
 val scanf : ('a, Scanning.scanbuf, 'b) format -> 'a -> 'b;;
 (** Same as {!Scanf.bscanf}, but reads from the predefined scanning
-    buffer [Scanning.stdib] that is connected to [stdin]. *)
+    buffer {!Scanf.Scanning.stdib} that is connected to [stdin]. *)
 
 val kscanf :
   Scanning.scanbuf -> (Scanning.scanbuf -> exn -> 'a) ->
diff --git a/stdlib/set.ml b/stdlib/set.ml
index 2404c53854..e4ef7a0d94 100644
--- a/stdlib/set.ml
+++ b/stdlib/set.ml
@@ -48,6 +48,7 @@ module type S =
     val min_elt: t -> elt
     val max_elt: t -> elt
     val choose: t -> elt
+    val split: elt -> t -> t * bool * t
   end
 
 module Make(Ord: OrderedType) =
@@ -243,23 +244,26 @@ module Make(Ord: OrderedType) =
           | (l2, true, r2) ->
               concat (diff l1 l2) (diff r1 r2)
 
-    let rec compare_aux l1 l2 =
-        match (l1, l2) with
-        ([], []) -> 0
-      | ([], _)  -> -1
-      | (_, []) -> 1
-      | (Empty :: t1, Empty :: t2) ->
-          compare_aux t1 t2
-      | (Node(Empty, v1, r1, _) :: t1, Node(Empty, v2, r2, _) :: t2) ->
+    type enumeration = End | More of elt * t * enumeration
+
+    let rec cons_enum s e =
+      match s with
+        Empty -> e
+      | Node(l, v, r, _) -> cons_enum l (More(v, r, e))
+
+    let rec compare_aux e1 e2 =
+        match (e1, e2) with
+        (End, End) -> 0
+      | (End, _)  -> -1
+      | (_, End) -> 1
+      | (More(v1, r1, e1), More(v2, r2, e2)) ->
           let c = Ord.compare v1 v2 in
-          if c <> 0 then c else compare_aux (r1::t1) (r2::t2)
-      | (Node(l1, v1, r1, _) :: t1, t2) ->
-          compare_aux (l1 :: Node(Empty, v1, r1, 0) :: t1) t2
-      | (t1, Node(l2, v2, r2, _) :: t2) ->
-          compare_aux t1 (l2 :: Node(Empty, v2, r2, 0) :: t2)
+          if c <> 0
+          then c
+          else compare_aux (cons_enum r1 e1) (cons_enum r2 e2)
 
     let compare s1 s2 =
-      compare_aux [s1] [s2]
+      compare_aux (cons_enum s1 End) (cons_enum s2 End)
 
     let equal s1 s2 =
       compare s1 s2 = 0
diff --git a/stdlib/set.mli b/stdlib/set.mli
index fc4a1f4be6..69b0895f1e 100644
--- a/stdlib/set.mli
+++ b/stdlib/set.mli
@@ -136,6 +136,15 @@ module type S =
     (** Return one element of the given set, or raise [Not_found] if
        the set is empty. Which element is chosen is unspecified,
        but equal elements will be chosen for equal sets. *)
+
+    val split: elt -> t -> t * bool * t
+    (** [split x s] returns a triple [(l, present, r)], where
+          [l] is the set of elements of [s] that are
+          strictly less than [x];
+          [r] is the set of elements of [s] that are
+          strictly greater than [x];
+          [present] is [false] if [s] contains no element equal to [x],
+          or [true] if [s] contains an element equal to [x]. *)
   end
 (** Output signature of the functor {!Set.Make}. *)
 
diff --git a/stdlib/stdLabels.mli b/stdlib/stdLabels.mli
index 4750bbffbc..fbda4b7a49 100644
--- a/stdlib/stdLabels.mli
+++ b/stdlib/stdLabels.mli
@@ -50,6 +50,7 @@ module Array :
     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
+    val fast_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
@@ -97,6 +98,7 @@ module 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
+    val fast_sort : cmp:('a -> 'a -> int) -> 'a list -> 'a list
   end
 
 module String :
diff --git a/stdlib/sys.ml b/stdlib/sys.ml
index 99ecb18528..d1478525c6 100644
--- a/stdlib/sys.ml
+++ b/stdlib/sys.ml
@@ -78,4 +78,4 @@ let catch_break on =
 
 (* OCaml version string, must be in the format described in sys.mli. *)
 
-let ocaml_version = "3.07+14 (2004-02-03)";;
+let ocaml_version = "3.07+22 (2004-06-16)";;
diff --git a/stdlib/sys.mli b/stdlib/sys.mli
index 28cb6de0e3..9c829b1660 100644
--- a/stdlib/sys.mli
+++ b/stdlib/sys.mli
@@ -32,7 +32,9 @@ external remove : string -> unit = "caml_sys_remove"
 
 external rename : string -> string -> unit = "caml_sys_rename"
 (** Rename a file. The first argument is the old name and the
-   second is the new name. *)
+   second is the new name. If there is already another file
+   under the new name, [rename] may replace it, or raise an
+   exception, depending on your operating system. *)
 
 external getenv : string -> string = "caml_sys_getenv"
 (** Return the value associated to a variable in the process
@@ -98,9 +100,11 @@ type signal_behavior =
 
 external signal :
   int -> signal_behavior -> signal_behavior = "caml_install_signal_handler"
-(** Set the behavior of the system on receipt of a given signal.
-   The first argument is the signal number.  Return the behavior
-   previously associated with the signal. *)
+(** Set the behavior of the system on receipt of a given signal.  The
+   first argument is the signal number.  Return the behavior
+   previously associated with the signal. If the signal number is
+   invalid (or not available on your system), an [Invalid_argument]
+   exception is raised. *)
 
 val set_signal : int -> signal_behavior -> unit
 (** Same as {!Sys.signal} but return value is ignored. *)