convert Benoît's first patch to bytes/string

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

3 files changed, 79 insertions, 72 deletions

diff --git a/stdlib/camlinternalFormat.ml b/stdlib/camlinternalFormat.ml
index 5c704fb8a..c915e0329 100644
--- a/stdlib/camlinternalFormat.ml
+++ b/stdlib/camlinternalFormat.ml
@@ -107,41 +107,39 @@ external format_int64: string -> int64 -> string
 (* Type of extensible character buffers. *)
 type buffer = {
   mutable ind : int;
-  mutable str : string;
+  mutable bytes : bytes;
 }
 
 (* Create a fresh buffer. *)
-let buffer_create init_size = { ind = 0; str = String.create init_size }
+let buffer_create init_size = { ind = 0; bytes = Bytes.create init_size }
 
 (* Check size of the buffer and grow it if needed. *)
 let buffer_check_size buf overhead =
-  let len = String.length buf.str in
+  let len = Bytes.length buf.bytes in
   let min_len = buf.ind + overhead in
   if min_len > len then (
     let new_len = max (len * 2) min_len in
-    let new_str = String.create new_len in
-    String.blit buf.str 0 new_str 0 len;
-    buf.str <- new_str;
+    let new_str = Bytes.create new_len in
+    Bytes.blit buf.bytes 0 new_str 0 len;
+    buf.bytes <- new_str;
   )
 
 (* Add the character `c' to the buffer `buf'. *)
 let buffer_add_char buf c =
   buffer_check_size buf 1;
-  buf.str.[buf.ind] <- c;
+  Bytes.set buf.bytes buf.ind c;
   buf.ind <- buf.ind + 1
 
 (* Add the string `s' to the buffer `buf'. *)
 let buffer_add_string buf s =
   let str_len = String.length s in
   buffer_check_size buf str_len;
-  String.blit s 0 buf.str buf.ind str_len;
+  String.blit s 0 buf.bytes buf.ind str_len;
   buf.ind <- buf.ind + str_len
 
 (* Get the content of the buffer. *)
 let buffer_contents buf =
-  let str = String.create buf.ind in
-  String.blit buf.str 0 str 0 buf.ind;
-  str
+  Bytes.sub_string buf.bytes 0 buf.ind
 
 (***)
 
@@ -327,10 +325,7 @@ let string_of_formatting formatting = match formatting with
   | Magic_size (str, _)  -> str
   | Escaped_at           -> "@@"
   | Escaped_percent      -> "@%"
-  | Scan_indic c ->
-    let str = String.create 2 in
-    str.[0] <- '@'; str.[1] <- c;
-    str
+  | Scan_indic c -> "@" ^ (String.make 1 c)
 
 (***)
 
@@ -814,47 +809,43 @@ fun sub_fmtty fmt fmtty -> match sub_fmtty, fmtty with
 let fix_padding padty width str =
   let len = String.length str in
   if width <= len then str else
-    let res = String.make width (if padty = Zeros then '0' else ' ') in
+    let res = Bytes.make width (if padty = Zeros then '0' else ' ') in
     begin match padty with
     | Left  -> String.blit str 0 res 0 len
     | Right -> String.blit str 0 res (width - len) len
     | Zeros when len > 0 && (str.[0] = '+' || str.[0] = '-') ->
-      res.[0] <- str.[0];
+      Bytes.set res 0 str.[0];
       String.blit str 1 res (width - len + 1) (len - 1)
     | Zeros when len > 1 && str.[0] = '0' && (str.[1] = 'x' || str.[1] = 'X') ->
-      res.[1] <- str.[1];
+      Bytes.set res 1 str.[1];
       String.blit str 2 res (width - len + 2) (len - 2)
     | Zeros ->
       String.blit str 0 res (width - len) len
     end;
-    res
+    Bytes.unsafe_to_string res
 
 (* Add '0' padding to int, int32, nativeint or int64 string representation. *)
 let fix_int_precision prec str =
   let len = String.length str in
   if prec <= len then str else
-    let res = String.make prec '0' in
+    let res = Bytes.make prec '0' in
     begin match str.[0] with
     | ('+' | '-' | ' ') as c ->
-      res.[0] <- c;
+      Bytes.set res 0 c;
       String.blit str 1 res (prec - len + 1) (len - 1);
     | '0' when len > 1 && (str.[1] = 'x' || str.[1] = 'X') ->
-      res.[1] <- str.[1];
+      Bytes.set res 1 str.[1];
       String.blit str 2 res (prec - len + 2) (len - 2);
     | '0' .. '9' ->
       String.blit str 0 res (prec - len) len;
     | _ ->
       assert false
     end;
-    res
+    Bytes.unsafe_to_string res
 
 (* Escape a string according to the OCaml lexing convention. *)
 let string_to_caml_string str =
-  let esc = String.escaped str in
-  let len = String.length esc in
-  let res = String.create (len + 2) in
-  res.[0] <- '"'; String.blit esc 0 res 1 len; res.[len + 1] <- '"';
-  res
+  String.concat (String.escaped str) ["\""; "\""]
 
 (* Generate the format_int first argument from an int_conv. *)
 let format_of_iconv iconv = match iconv with
@@ -865,17 +856,17 @@ let format_of_iconv iconv = match iconv with
   | Int_o -> "%o" | Int_Co -> "%#o"
   | Int_u -> "%u"
 
-(* Generate the format_int32, format_nativeint and format_int64 first argument
-   from an int_conv. *)
+(* Generate the format_int32, format_nativeint and format_int64 first
+   argument from an int_conv. *)
 let format_of_aconv iconv c =
-  let fix i fmt = fmt.[i] <- c; fmt in
-  match iconv with
-  | Int_d -> fix 1 "% d" | Int_pd -> fix 2 "%+ d" | Int_sd -> fix 2 "%  d"
-  | Int_i -> fix 1 "% i" | Int_pi -> fix 2 "%+ i" | Int_si -> fix 2 "%  i"
-  | Int_x -> fix 1 "% x" | Int_Cx -> fix 2 "%# x"
-  | Int_X -> fix 1 "% X" | Int_CX -> fix 2 "%# X"
-  | Int_o -> fix 1 "% o" | Int_Co -> fix 2 "%# o"
-  | Int_u -> fix 1 "% u"
+  let seps = match iconv with
+  | Int_d -> ["%";"d"] | Int_pd -> ["%+";"d"] | Int_sd -> ["% ";"d"]
+  | Int_i -> ["%";"i"] | Int_pi -> ["%+";"i"] | Int_si -> ["% ";"i"]
+  | Int_x -> ["%";"x"] | Int_Cx -> ["%#";"x"]
+  | Int_X -> ["%";"X"] | Int_CX -> ["%#";"X"]
+  | Int_o -> ["%";"o"] | Int_Co -> ["%#";"o"]
+  | Int_u -> ["%";"u"]
+  in String.concat (String.make 1 c) seps
 
 (* Generate the format_float first argument form a float_conv. *)
 let format_of_fconv fconv prec =
@@ -912,11 +903,7 @@ let convert_float fconv prec x =
 
 (* Convert a char to a string according to the OCaml lexical convention. *)
 let format_caml_char c =
-  let esc = Char.escaped c in
-  let len = String.length esc in
-  let res = String.create (len + 2) in
-  res.[0] <- '\''; String.blit esc 0 res 1 len; res.[len+1] <- '\'';
-  res
+  String.concat (Char.escaped c) ["'"; "'"]
 
 (* Convert a format type to string *)
 let string_of_fmtty fmtty =
@@ -1807,12 +1794,14 @@ let fmt_ebb_of_string str =
   (* Parse and construct a char set. *)
   and parse_char_set str_ind end_ind =
     if str_ind = end_ind then unexpected_end_of_format end_ind;
-    let char_set = create_char_set () in
-    match str.[str_ind] with
-    | '^' ->
-      let next_ind = parse_char_set_start (str_ind + 1) end_ind char_set in
-      next_ind, rev_char_set char_set
-    | _ -> parse_char_set_start str_ind end_ind char_set, char_set
+    let mut_char_set = create_char_set () in
+    let str_ind, reverse =
+      match str.[str_ind] with
+        | '^' -> str_ind + 1, true
+        | _ -> str_ind, false in
+    let next_ind = parse_char_set_start str_ind end_ind mut_char_set in
+    let char_set = freeze_char_set mut_char_set in
+    next_ind, (if reverse then rev_char_set char_set else char_set)
 
   (* Parse the first character of a char set. *)
   and parse_char_set_start str_ind end_ind char_set =
diff --git a/stdlib/pervasives.ml b/stdlib/pervasives.ml
index e56688f0d..6f7e27792 100644
--- a/stdlib/pervasives.ml
+++ b/stdlib/pervasives.ml
@@ -169,11 +169,22 @@ external bytes_length : bytes -> int = "%string_length"
 external bytes_create : int -> bytes = "caml_create_string"
 external string_blit : string -> int -> bytes -> int -> int -> unit
                      = "caml_blit_string" "noalloc"
+external bytes_get : bytes -> int -> char = "%string_safe_get"
+external bytes_set : bytes -> int -> char -> unit = "%string_safe_set"
 external bytes_blit : bytes -> int -> bytes -> int -> int -> unit
                         = "caml_blit_string" "noalloc"
 external bytes_unsafe_to_string : bytes -> string = "%identity"
 external bytes_unsafe_of_string : string -> bytes = "%identity"
 
+let copy_bytes byt =
+  let len = bytes_length byt in
+  let res = bytes_create len in
+  bytes_blit byt 0 res 0 len;
+  res
+
+let bytes_to_string byt =
+  bytes_unsafe_to_string (copy_bytes byt)
+
 let ( ^ ) s1 s2 =
   let l1 = string_length s1 and l2 = string_length s2 in
   let s = bytes_create (l1 + l2) in
@@ -222,10 +233,7 @@ let string_of_int n =
   format_int "%d" n
 
 external int_of_string : string -> int = "caml_int_of_string"
-module String = struct
-  external get : string -> int -> char = "%string_safe_get"
-  external set : string -> int -> char -> unit = "%string_safe_set"
-end
+external string_get : string -> int -> char = "%string_safe_get"
 
 let valid_float_lexem s =
   let l = string_length s in
@@ -849,32 +857,39 @@ fun fmt1 fmt2 -> match fmt1 with
 (******************************************************************************)
            (* Tools to manipulate scanning set of chars (see %[...]) *)
 
-(* Create a fresh empty char set. *)
-let create_char_set () =
-  let str = string_create 32 in
-  for i = 0 to 31 do str.[i] <- '\000' done;
-  str
+type mutable_char_set = bytes
 
-(* Return true if a `c' is in `char_set'. *)
-let is_in_char_set char_set c =
-  let ind = int_of_char c in
-  let str_ind = ind lsr 3 and mask = 1 lsl (ind land 0b111) in
-  (int_of_char char_set.[str_ind] land mask) <> 0
+(* Create a fresh, empty, mutable char set. *)
+let create_char_set () =
+  (* Bytes.make isn't defined yet, so we'll fill manually *)
+  let cs = bytes_create 32 in
+  for i = 0 to 31 do bytes_set cs i '\000' done;
+  cs
 
-(* Add a char in a char set. *)
+(* Add a char in a mutable char set. *)
 let add_in_char_set char_set c =
   let ind = int_of_char c in
   let str_ind = ind lsr 3 and mask = 1 lsl (ind land 0b111) in
-  char_set.[str_ind] <- char_of_int (int_of_char char_set.[str_ind] lor mask)
+  bytes_set char_set str_ind
+    (char_of_int (int_of_char (bytes_get char_set str_ind) lor mask))
+
+let freeze_char_set char_set =
+  bytes_to_string char_set
 
 (* Compute the complement of a char set. *)
-(* Return a fresh string, do not modify its argument. *)
 let rev_char_set char_set =
   let char_set' = create_char_set () in
   for i = 0 to 31 do
-    char_set'.[i] <- char_of_int (int_of_char char_set.[i] lxor 0xFF);
+    bytes_set char_set' i
+      (char_of_int (int_of_char (string_get char_set i) lxor 0xFF));
   done;
-  char_set'
+  bytes_unsafe_to_string char_set'
+
+(* Return true if a `c' is in `char_set'. *)
+let is_in_char_set char_set c =
+  let ind = int_of_char c in
+  let str_ind = ind lsr 3 and mask = 1 lsl (ind land 0b111) in
+  (int_of_char (string_get char_set str_ind) land mask) <> 0
 
 (******************************************************************************)
                              (* Reader count *)
diff --git a/stdlib/pervasives.mli b/stdlib/pervasives.mli
index fb927b9be..7755af816 100644
--- a/stdlib/pervasives.mli
+++ b/stdlib/pervasives.mli
@@ -1187,10 +1187,13 @@ module CamlinternalFormatBasics : sig
       ('f, 'b, 'c, 'e, 'g, 'h) fmt ->
       ('a, 'b, 'c, 'd, 'g, 'h) fmt
 
-  val create_char_set : unit -> string
-  val is_in_char_set : string -> char -> bool
-  val add_in_char_set : string -> char -> unit
-  val rev_char_set : string -> string
+  val is_in_char_set : char_set -> char -> bool
+  val rev_char_set : char_set -> char_set
+
+  type mutable_char_set = bytes
+  val create_char_set : unit -> mutable_char_set
+  val add_in_char_set : mutable_char_set -> char -> unit
+  val freeze_char_set : mutable_char_set -> char_set
 
   val reader_nb_unifier_of_fmtty :
      ('a, 'b, 'c, 'd, 'e, 'f) fmtty -> ('d, 'e, 'd, 'e) reader_nb_unifier