Char, String: ajout fonctions uppercase, lowercase, capitalize, uncapitalize.

Filename: mort aux ;;, utiliser String.lowercase
Hashtbl: corrige la fuite de Hashtbl.remove, ajout interface fonctorielle.


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

9 files changed, 282 insertions, 104 deletions

diff --git a/stdlib/.depend b/stdlib/.depend
index d3cb9523e..4ab0a28ca 100644
--- a/stdlib/.depend
+++ b/stdlib/.depend
@@ -4,14 +4,14 @@ 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: list.cmi array.cmi 
 array.cmx: list.cmx array.cmi 
-char.cmo: string.cmi char.cmi 
-char.cmx: string.cmx char.cmi 
+char.cmo: char.cmi 
+char.cmx: char.cmi 
 digest.cmo: string.cmi digest.cmi 
 digest.cmx: string.cmx digest.cmi 
 filename.cmo: string.cmi sys.cmi filename.cmi 
 filename.cmx: string.cmx sys.cmx filename.cmi 
-format.cmo: queue.cmi string.cmi format.cmi 
-format.cmx: queue.cmx string.cmx format.cmi 
+format.cmo: string.cmi format.cmi 
+format.cmx: string.cmx format.cmi 
 gc.cmo: printf.cmi gc.cmi 
 gc.cmx: printf.cmx gc.cmi 
 genlex.cmo: char.cmi hashtbl.cmi list.cmi stream.cmi string.cmi genlex.cmi 
@@ -26,8 +26,10 @@ map.cmo: map.cmi
 map.cmx: map.cmi 
 obj.cmo: obj.cmi 
 obj.cmx: obj.cmi 
-oo.cmo: array.cmi hashtbl.cmi list.cmi obj.cmi random.cmi sort.cmi oo.cmi 
-oo.cmx: array.cmx hashtbl.cmx list.cmx obj.cmx random.cmx sort.cmx oo.cmi 
+oo.cmo: array.cmi hashtbl.cmi list.cmi map.cmi obj.cmi random.cmi sort.cmi \
+    sys.cmi oo.cmi 
+oo.cmx: array.cmx hashtbl.cmx list.cmx map.cmx obj.cmx random.cmx sort.cmx \
+    sys.cmx oo.cmi 
 parsing.cmo: array.cmi lexing.cmi obj.cmi parsing.cmi 
 parsing.cmx: array.cmx lexing.cmx obj.cmx parsing.cmi 
 pervasives.cmo: pervasives.cmi 
@@ -48,7 +50,7 @@ stack.cmo: list.cmi stack.cmi
 stack.cmx: list.cmx stack.cmi 
 stream.cmo: list.cmi obj.cmi string.cmi stream.cmi 
 stream.cmx: list.cmx obj.cmx string.cmx stream.cmi 
-string.cmo: list.cmi string.cmi 
-string.cmx: list.cmx string.cmi 
+string.cmo: char.cmi list.cmi string.cmi 
+string.cmx: char.cmx list.cmx string.cmi 
 sys.cmo: sys.cmi 
 sys.cmx: sys.cmi 
diff --git a/stdlib/Makefile b/stdlib/Makefile
index 0ec5282f6..535286133 100644
--- a/stdlib/Makefile
+++ b/stdlib/Makefile
@@ -8,7 +8,7 @@ CAMLOPT=$(RUNTIME) $(OPTCOMPILER)
 CAMLDEP=../boot/ocamlrun ../tools/ocamldep
 CPPFLAGS=-DUNIX
 
-OBJS=pervasives.cmo list.cmo string.cmo char.cmo array.cmo sys.cmo \
+OBJS=pervasives.cmo list.cmo char.cmo string.cmo array.cmo sys.cmo \
   hashtbl.cmo sort.cmo filename.cmo obj.cmo lexing.cmo parsing.cmo \
   set.cmo map.cmo stack.cmo queue.cmo stream.cmo \
   printf.cmo format.cmo arg.cmo printexc.cmo gc.cmo \
@@ -73,5 +73,5 @@ clean::
 
 include .depend
 
-depend: beforedepend
+depend:
 	$(CAMLDEP) *.mli *.ml > .depend
diff --git a/stdlib/char.ml b/stdlib/char.ml
index 077719d8c..37062dcb4 100644
--- a/stdlib/char.ml
+++ b/stdlib/char.ml
@@ -21,19 +21,40 @@ let chr n =
 
 external is_printable: char -> bool = "is_printable"
 
+external string_create: int -> string = "create_string"
+external string_unsafe_get : string -> int -> char = "%string_unsafe_get"
+external string_unsafe_set : string -> int -> char -> unit
+                           = "%string_unsafe_set"
+
 let escaped = function
     '\'' -> "\\'"
   | '\\' -> "\\\\"
   | '\n' -> "\\n"
   | '\t' -> "\\t"
-  | c ->  if is_printable c then
-            String.make 1 c
-          else begin
+  | c ->  if is_printable c then begin
+            let s = string_create 1 in
+            string_unsafe_set s 1 c;
+            s
+          end else begin
             let n = code c in
-            let s = String.create 4 in
-            String.unsafe_set s 0 '\\';
-            String.unsafe_set s 1 (unsafe_chr (48 + n / 100));
-            String.unsafe_set s 2 (unsafe_chr (48 + (n / 10) mod 10));
-            String.unsafe_set s 3 (unsafe_chr (48 + n mod 10));
+            let s = string_create 4 in
+            string_unsafe_set s 0 '\\';
+            string_unsafe_set s 1 (unsafe_chr (48 + n / 100));
+            string_unsafe_set s 2 (unsafe_chr (48 + (n / 10) mod 10));
+            string_unsafe_set s 3 (unsafe_chr (48 + n mod 10));
             s
           end
+
+let lowercase c =
+  if (c >= 'A' && c <= 'Z')
+  || (c >= '\192' && c <= '\214')
+  || (c >= '\217' && c <= '\222')
+  then unsafe_chr(code c + 32)
+  else c
+
+let uppercase c =
+  if (c >= 'a' && c <= 'z')
+  || (c >= '\224' && c <= '\246')
+  || (c >= '\249' && c <= '\254')
+  then unsafe_chr(code c - 32)
+  else c
diff --git a/stdlib/char.mli b/stdlib/char.mli
index bccfc15d5..fe82e0e52 100644
--- a/stdlib/char.mli
+++ b/stdlib/char.mli
@@ -23,7 +23,10 @@ val escaped : char -> string
         (* Return a string representing the given character,
            with special characters escaped following the lexical conventions
            of Caml Light. *)
-
+val lowercase: char -> char
+val uppercase: char -> char
+        (* Convert the given character to its equivalent lowercase or
+           uppercase character, respectively. *)
 (*--*)
 
 external unsafe_chr: int -> char = "%identity"
diff --git a/stdlib/filename.ml b/stdlib/filename.ml
index c962f7915..378263cbd 100644
--- a/stdlib/filename.ml
+++ b/stdlib/filename.ml
@@ -2,7 +2,7 @@
 (*                                                                     *)
 (*                           Objective Caml                            *)
 (*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*          Xavier Leroy and Damien Doligez, INRIA Rocquencourt        *)
 (*                                                                     *)
 (*  Copyright 1996 Institut National de Recherche en Informatique et   *)
 (*  Automatique.  Distributed only by permission.                      *)
@@ -11,7 +11,7 @@
 
 (* $Id$ *)
 
-let systype = (Sys.get_config()).Sys.os_type;;
+let systype = (Sys.get_config()).Sys.os_type
 
 let current_dir_name =
   match systype with
@@ -19,26 +19,24 @@ let current_dir_name =
   | "Win32" -> "."
   | "MacOS" -> ":"
   | _ -> failwith "Filename.current_dir_name: unknown system"
-;;
 
 let unix_concat dirname filename =
   let l = String.length dirname in
   if l = 0 or dirname.[l-1] = '/'
   then dirname ^ filename
   else dirname ^ "/" ^ filename
-;;
+
 let wnt_concat dirname filename =
   let l = String.length dirname in
   if l = 0 or (let c = dirname.[l-1] in c = '/' or c = '\\' or c = ':')
   then dirname ^ filename
   else dirname ^ "\\" ^ filename
-;;
+
 let mac_concat dirname filename =
   let l = String.length dirname in
   if l = 0 or dirname.[l-1] = ':'
   then dirname ^ filename
   else dirname ^ ":" ^ filename
-;;
 
 let concat =
   match systype with
@@ -46,22 +44,21 @@ let concat =
   | "Win32" -> wnt_concat
   | "MacOS" -> mac_concat
   | _ -> failwith "Filename.concat: unknown system"
-;;
 
 let unix_is_absolute n =
-     (String.length n >= 1 & String.sub n 0 1 = "/")
-  or (String.length n >= 2 & String.sub n 0 2 = "./")
-  or (String.length n >= 3 & String.sub n 0 3 = "../")
-;;
+     (String.length n >= 1 && String.sub n 0 1 = "/")
+  || (String.length n >= 2 && String.sub n 0 2 = "./")
+  || (String.length n >= 3 && String.sub n 0 3 = "../")
+
 let wnt_is_absolute n =
-     (String.length n >= 1 &
-       (let s = String.sub n 0 1 in s = "/" or s = "\\"))
-  or (String.length n >= 2 &
-       (let s = String.sub n 0 2 in s = "./" or s = ".\\"))
-  or (String.length n >= 3 &
-       (let s = String.sub n 0 3 in s = "../" or s = "..\\"))
-  or (String.length n >= 2 & String.get n 1 = ':')
-;;
+     (String.length n >= 1 &&
+       (let s = String.sub n 0 1 in s = "/" || s = "\\"))
+  || (String.length n >= 2 &&
+       (let s = String.sub n 0 2 in s = "./" || s = ".\\"))
+  || (String.length n >= 3 &&
+       (let s = String.sub n 0 3 in s = "../" || s = "..\\"))
+  || (String.length n >= 2 && String.get n 1 = ':')
+
 let mac_is_absolute n =
   try
     for i = 0 to String.length n - 1 do
@@ -69,7 +66,6 @@ let mac_is_absolute n =
     done;
     false
   with Exit -> true
-;;
 
 let is_absolute =
   match systype with
@@ -77,30 +73,19 @@ let is_absolute =
   | "Win32" -> wnt_is_absolute
   | "MacOS" -> mac_is_absolute
   | _ -> failwith "Filename.is_absolute: unknown system"
-;;
-
-let lowercase s =
-  let l = String.length s in
-  let n = String.create l in
-  for i = 0 to l - 1 do
-    let c = s.[i] in
-    n.[i] <- (if c >= 'A' & c <= 'Z' then Char.chr(Char.code c + 32) else c)
-  done;
-  n
-;;
 
 let unix_check_suffix name suff =
- String.length name >= String.length suff &
+ String.length name >= String.length suff &&
  String.sub name (String.length name - String.length suff) (String.length suff)
     = suff
-;;
+
 let wnt_check_suffix name suff =
- String.length name >= String.length suff &
+ String.length name >= String.length suff &&
  (let s = String.sub name (String.length name - String.length suff)
                           (String.length suff) in
-  lowercase s = lowercase suff)
-;;
-let mac_check_suffix = unix_check_suffix;;
+  String.lowercase s = String.lowercase suff)
+
+let mac_check_suffix = unix_check_suffix
 
 let check_suffix =
   match systype with
@@ -108,12 +93,10 @@ let check_suffix =
   | "Win32" -> wnt_check_suffix
   | "MacOS" -> mac_check_suffix
   | _ -> failwith "Filename.check_suffix: unknown system"
-;;
 
 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 rindex s c =
   let rec pos i =
@@ -121,21 +104,19 @@ let rindex s c =
     else if s.[i] = c then i
     else pos (i - 1)
   in pos (String.length s - 1)
-;;
-let rindexsep s =
+
+let wnt_rindexsep s =
   let rec pos i =
     if i < 0 then raise Not_found
-    else if (let c = s.[i] in c = '/' or c = '\\' or c = ':') then i
+    else if (let c = s.[i] in c = '/' || c = '\\' || c = ':') then i
     else pos (i - 1)
   in pos (String.length s - 1)
-;;
 
 let chop_extension name =
   try
     String.sub name 0 (rindex name '.')
   with Not_found ->
     invalid_arg "Filename.chop_extension"
-;;
 
 let unix_basename name =
   try
@@ -143,7 +124,7 @@ let unix_basename name =
     String.sub name p (String.length name - p)
   with Not_found ->
     name
-;;
+
 let unix_dirname name =
   try
     match rindex name '/' with
@@ -151,34 +132,33 @@ let unix_dirname name =
     | n -> String.sub name 0 n
   with Not_found ->
     "."
-;;
+
 let wnt_basename name =
   try
-    let p = rindexsep name + 1 in
+    let p = wnt_rindexsep name + 1 in
     String.sub name p (String.length name - p)
   with Not_found ->
     name
-;;
+
 let wnt_dirname name =
   try
-    match rindexsep name with
+    match wnt_rindexsep name with
       0 -> "\\"
     | n -> String.sub name 0 n
   with Not_found ->
     "."
-;;
+
 let mac_basename name =
   try
     let p = rindex name ':' + 1 in
     String.sub name p (String.length name - p)
   with Not_found -> name
-;;
+
 let mac_dirname name =
   try match rindex name ':' with
       | 0 -> ":"
       | n -> String.sub name 0 n
   with Not_found -> ":"
-;;
 
 let basename =
   match systype with
@@ -186,14 +166,13 @@ let basename =
   | "Win32" -> wnt_basename
   | "MacOS" -> mac_basename
   | _ -> failwith "Filename.basename: unknown system"
-;;
+
 let dirname =
   match systype with
   | "Unix" -> unix_dirname
   | "Win32" -> wnt_dirname
   | "MacOS" -> mac_dirname
   | _ -> failwith "Filename.dirname: unknown system"
-;;
 
 let temporary_directory =
   match systype with
@@ -201,12 +180,18 @@ let temporary_directory =
   | "Win32" -> (try Sys.getenv "TEMP" with Not_found -> "C:\\temp")
   | "MacOS" -> (try Sys.getenv "TempFolder" with Not_found -> ":")
   | _ -> failwith "Filename.temporary_directory: unknown system"
-;;
+
+external open_desc: string -> open_flag list -> int -> int = "sys_open"
+external close_desc: int -> unit = "sys_close"
 
 let temp_file prefix suffix =
   let rec try_name counter =
     let name =
       concat temporary_directory (prefix ^ string_of_int counter ^ suffix) in
-    if Sys.file_exists name then try_name (counter + 1) else name
+    try
+      close_desc(open_desc name [Open_wronly; Open_creat; Open_excl] 0o666);
+      name
+    with Sys_error _ ->
+      try_name (counter + 1)
   in try_name 0
-;;
+
diff --git a/stdlib/hashtbl.ml b/stdlib/hashtbl.ml
index 52a62784a..ba5995b3e 100644
--- a/stdlib/hashtbl.ml
+++ b/stdlib/hashtbl.ml
@@ -13,11 +13,15 @@
 
 (* Hash tables *)
 
-(* We do dynamic hashing, and we double the size of the table when
-   buckets become too long, but without re-hashing the elements. *)
+external hash_param : int -> int -> 'a -> int = "hash_univ_param" "noalloc"
+
+let hash x = hash_param 10 100 x
+
+(* We do dynamic hashing, and resize the table and rehash the elements
+   when buckets become too long. *)
 
 type ('a, 'b) t =
-  { mutable max_len: int;                    (* max length of a bucket *)
+  { mutable max_len: int;                     (* max length of a bucket *)
     mutable data: ('a, 'b) bucketlist array } (* the buckets *)
 
 and ('a, 'b) bucketlist =
@@ -25,34 +29,41 @@ and ('a, 'b) bucketlist =
   | Cons of 'a * 'b * ('a, 'b) bucketlist
 
 let create initial_size =
-  { max_len = 2; data = Array.create initial_size Empty }
+  { max_len = 3; data = Array.create initial_size Empty }
 
 let clear h =
   for i = 0 to Array.length h.data - 1 do
     h.data.(i) <- Empty
   done
 
-let resize h =
-  let n = Array.length h.data in
-  let newdata = Array.create (n+n) Empty in
-    Array.blit h.data 0 newdata 0 n;
-    Array.blit h.data 0 newdata n n;
-    h.data <- newdata;
-    h.max_len <- 2 * h.max_len
-
+let resize hashfun tbl =
+  let odata = tbl.data in
+  let osize = Array.length odata in
+  let nsize = 2 * osize + 1 in
+  let ndata = Array.create nsize Empty in
+  let rec insert_bucket idx = function
+      Empty -> ()
+    | Cons(key, data, rest) ->
+        insert_bucket idx rest; (* preserve original order of elements *)
+        let nidx = (hashfun key) mod nsize in
+        ndata.(nidx) <- Cons(key, data, ndata.(nidx)) in
+  for i = 0 to osize - 1 do
+    insert_bucket i odata.(i)
+  done;
+  tbl.data <- ndata;
+  tbl.max_len <- 2 * tbl.max_len
+          
 let rec bucket_too_long n bucket =
   if n < 0 then true else
     match bucket with
       Empty -> false
-    | Cons(_,_,rest) -> bucket_too_long (pred n) rest
-
-external hash_param : int -> int -> 'a -> int = "hash_univ_param" "noalloc"
+    | Cons(_,_,rest) -> bucket_too_long (n - 1) rest
 
 let add h key info =
   let i = (hash_param 10 100 key) mod (Array.length h.data) in
   let bucket = Cons(key, info, h.data.(i)) in
-    h.data.(i) <- bucket;
-    if bucket_too_long h.max_len bucket then resize h
+  h.data.(i) <- bucket;
+  if bucket_too_long h.max_len bucket then resize hash h
 
 let remove h key =
   let rec remove_bucket = function
@@ -61,7 +72,7 @@ let remove h key =
     | Cons(k, i, next) ->
         if k = key then next else Cons(k, i, remove_bucket next) in
   let i = (hash_param 10 100 key) mod (Array.length h.data) in
-    h.data.(i) <- remove_bucket h.data.(i)
+  h.data.(i) <- remove_bucket h.data.(i)
 
 let find h key =
   match h.data.((hash_param 10 100 key) mod (Array.length h.data)) with
@@ -93,17 +104,93 @@ let find_all h key =
   find_in_bucket h.data.((hash_param 10 100 key) mod (Array.length h.data))
 
 let iter f h =
+  let rec do_bucket = function
+      Empty ->
+        ()
+    | Cons(k, d, rest) ->
+        f k d; do_bucket rest in
   let d = h.data in
-  let len = Array.length d in
-  for i = 0 to len - 1 do
-    let rec do_bucket = function
-        Empty ->
-          ()
-      | Cons(k, d, rest) ->
-          if (hash_param 10 100 k) mod len = i
-          then begin f k d; do_bucket rest end
-          else do_bucket rest in
+  for i = 0 to Array.length d - 1 do
     do_bucket d.(i)
   done
 
-let hash x = hash_param 50 500 x
+(* Functorial interface *)
+
+module type HashedType =
+  sig
+    type t
+    val equal: t -> t -> bool
+    val hash: t -> int
+  end
+
+module type S =
+  sig
+    type key
+    type 'a t
+    val create: int -> 'a t
+    val clear: 'a t -> 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 iter: (key -> 'a -> 'b) -> 'a t -> unit
+  end
+
+module Make(H: HashedType): (S with type key = H.t) =
+  struct
+    type key = H.t
+    type 'a hashtbl = (key, 'a) t
+    type 'a t = 'a hashtbl
+    let create = create
+    let clear = clear
+    
+    let add h key info =
+      let i = (H.hash key) mod (Array.length h.data) in
+      let bucket = Cons(key, info, h.data.(i)) in
+      h.data.(i) <- bucket;
+      if bucket_too_long h.max_len bucket then resize H.hash h
+
+    let remove h key =
+      let rec remove_bucket = function
+          Empty ->
+            Empty
+        | Cons(k, i, next) ->
+            if H.equal k key
+            then next
+            else Cons(k, i, remove_bucket next) in
+      let i = (H.hash key) mod (Array.length h.data) in
+      h.data.(i) <- remove_bucket h.data.(i)
+
+    let find h key =
+      match h.data.((H.hash key) mod (Array.length h.data)) with
+        Empty -> raise Not_found
+      | Cons(k1, d1, rest1) ->
+          if H.equal key k1 then d1 else
+          match rest1 with
+            Empty -> raise Not_found
+          | Cons(k2, d2, rest2) ->
+              if H.equal key k2 then d2 else
+              match rest2 with
+                Empty -> raise Not_found
+              | Cons(k3, d3, rest3) ->
+                  if H.equal key k3 then d3 else begin
+                    let rec find = function
+                        Empty ->
+                          raise Not_found
+                      | Cons(k, d, rest) ->
+                          if H.equal key k then d else find rest
+                    in find rest3
+                  end
+
+    let find_all h key =
+      let rec find_in_bucket = function
+        Empty ->
+          []
+      | Cons(k, d, rest) ->
+          if H.equal k key
+          then d :: find_in_bucket rest
+          else find_in_bucket rest in
+      find_in_bucket h.data.((H.hash key) mod (Array.length h.data))
+
+    let iter = iter
+  end
diff --git a/stdlib/hashtbl.mli b/stdlib/hashtbl.mli
index e31448b79..c3bf841ca 100644
--- a/stdlib/hashtbl.mli
+++ b/stdlib/hashtbl.mli
@@ -15,6 +15,8 @@
 
 (* Hash tables are hashed association tables, with in-place modification. *)
 
+(*** Generic interface *)
+
 type ('a, 'b) t
         (* The type of hash tables from type ['a] to type ['b]. *)
 
@@ -57,6 +59,50 @@ val iter : ('a -> 'b -> 'c) -> ('a, 'b) t -> unit
            [f] is unspecified. Each binding is presented exactly once
            to [f]. *)
 
+(*** Functorial interface *)
+
+module type HashedType =
+  sig
+    type t
+    val equal: t -> t -> bool
+    val hash: t -> int
+  end
+        (* The input signature of the functor [Hashtbl.Make].
+           [t] is the type of keys.
+           [equal] is the equality predicate used to compare keys.
+           [hash] is a hashing function on keys, returning a non-negative
+           integer. It must be such that if two keys are equal according
+           to [equal], then they must have identical hash values as computed
+           by [hash].
+           Examples: suitable ([equal], [hash]) pairs for arbitrary key
+           types include
+           ([(=)], [Hashtbl.hash]) for comparing objects by structure,
+           ([(==)], [Hashtbl.hash]) for comparing objects by addresses
+           (e.g. for mutable or cyclic keys). *)
+
+module type S =
+  sig
+    type key
+    type 'a t
+    val create: int -> 'a t
+    val clear: 'a t -> 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 iter: (key -> 'a -> 'b) -> 'a t -> unit
+  end
+
+module Make(H: HashedType): (S with type key = H.t)
+
+        (* The functor [Hashtbl.Make] returns a structure containing
+           a type [key] of keys and a type ['a t] of hash tables
+           associating data of type ['a] to keys of type [key].
+           The operations perform similarly to those of the generic
+           interface, but use the hashing and equality functions
+           specified in the functor argument [H] instead of generic
+           equality and hashing. *)
+
 (*** The polymorphic hash primitive *)
 
 val hash : 'a -> int
diff --git a/stdlib/string.ml b/stdlib/string.ml
index ad7f6524b..243751581 100644
--- a/stdlib/string.ml
+++ b/stdlib/string.ml
@@ -115,3 +115,24 @@ let escaped s =
         done;
         s'
       end
+
+let map f s =
+  let l = length s in
+  if l = 0 then s else begin
+    let r = create l in
+    for i = 0 to l - 1 do unsafe_set r i (f(unsafe_get s i)) done;
+    r
+  end
+
+let uppercase s = map Char.uppercase s
+let lowercase s = map Char.uppercase s
+
+let apply1 f s =
+  if length s = 0 then s else begin
+    let r = copy s in
+    unsafe_set r 0 (f(unsafe_get s 0));
+    r
+  end
+
+let capitalize s = apply1 Char.uppercase s
+let uncapitalize s = apply1 Char.lowercase s
diff --git a/stdlib/string.mli b/stdlib/string.mli
index 3ae892940..b1b4a66b3 100644
--- a/stdlib/string.mli
+++ b/stdlib/string.mli
@@ -70,6 +70,19 @@ val escaped: string -> string
            by escape sequences, following the lexical conventions of
            Caml Light. *)
 
+val uppercase: string -> string
+        (* Return a copy of the argument, with all lowercase letters
+           translated to uppercase. *)
+val lowercase: string -> string
+        (* Return a copy of the argument, with all uppercase letters
+           translated to lowercase. *)
+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"