From 2c4b259f6093bb7340b13d49a05bc14a87714a4d Mon Sep 17 00:00:00 2001
From: Gabriel Scherer <gabriel.scherer@gmail.com>
Date: Wed, 6 Aug 2014 16:31:52 +0000
Subject: remove the Obj.magic from the string.ml implementation

It is important not to assume that String.t and Bytes.t will always
share the same representation. Using Obj.magic to convert between
functions would give a very bad example to users considering
a migration, which are very quick to imitate any moral turpitude found
in the standard library.

An unfortunate consequence of the change is the duplication of
String.concat code; other designs would be possible to share more
implementation details between Bytes and String (eg. defined
factorized operations on both in a shared internal module), but if we
consider that String representation may evolve in the future this
coincidence of implementation is really a temporary coindence rather
than an definitive duplication.

I checked that all the small functions introduced are marked as
inlinable. In the case of coercions like this, we could even have the
compiler recognize eta-expansions of the identity function and turn
them into simple rebindings.

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@15060 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
---
 stdlib/string.ml | 92 ++++++++++++++++++++++++++++++++++++++++----------------
 1 file changed, 66 insertions(+), 26 deletions(-)

(limited to 'stdlib/string.ml')

diff --git a/stdlib/string.ml b/stdlib/string.ml
index 44e9c48989..00ff8be9e7 100644
--- a/stdlib/string.ml
+++ b/stdlib/string.ml
@@ -26,18 +26,48 @@ external unsafe_fill : bytes -> int -> int -> char -> unit
 
 module B = Bytes
 
-let make = (Obj.magic B.make : int -> char -> string)
-let init = (Obj.magic B.init : int -> (int -> char) -> string)
-let copy = (Obj.magic B.copy : string -> string)
-let sub = (Obj.magic B.sub : string -> int -> int -> string)
-let fill = B.fill
-let blit =
-  (Obj.magic B.blit : string -> int -> bytes -> int -> int -> unit)
-let concat = (Obj.magic B.concat : string -> string list -> string)
-let iter = (Obj.magic B.iter : (char -> unit) -> string -> unit)
-let iteri = (Obj.magic B.iteri : (int -> char -> unit) -> string -> unit)
-let map = (Obj.magic B.map : (char -> char) -> string -> string)
-let mapi = (Obj.magic B.mapi : (int -> char -> char) -> string -> string)
+let bts = B.unsafe_to_string
+let bos = B.unsafe_of_string
+
+let make n c =
+  B.make n c |> bts
+let init n f =
+  B.init n f |> bts
+let copy s =
+  B.copy (bos s) |> bts
+let sub s ofs len =
+  B.sub (bos s) ofs len |> bts
+let fill =
+  B.fill
+let blit s1 ofs1 s2 ofs2 len =
+  B.blit (bos s1) ofs1 s2 ofs2 len
+
+let concat sep l =
+  match l with
+  | [] -> ""
+  | hd :: tl ->
+      let num = ref 0 and len = ref 0 in
+      List.iter (fun s -> incr num; len := !len + length s) l;
+      let r = B.create (!len + length sep * (!num - 1)) in
+      unsafe_blit hd 0 r 0 (length hd);
+      let pos = ref(length hd) in
+      List.iter
+        (fun s ->
+          unsafe_blit sep 0 r !pos (length sep);
+          pos := !pos + length sep;
+          unsafe_blit s 0 r !pos (length s);
+          pos := !pos + length s)
+        tl;
+      Bytes.unsafe_to_string r
+
+let iter f s =
+  B.iter f (bos s)
+let iteri f s =
+  B.iteri f (bos s)
+let map f s =
+  B.map f (bos s) |> bts
+let mapi f s =
+  B.mapi f (bos s) |> bts
 
 (* Beware: we cannot use B.trim or B.escape because they always make a
    copy, but String.mli spells out some cases where we are not allowed
@@ -52,7 +82,7 @@ let is_space = function
 let trim s =
   if s = "" then s
   else if is_space (unsafe_get s 0) || is_space (unsafe_get s (length s - 1))
-    then B.unsafe_to_string (B.trim (B.unsafe_of_string s))
+    then bts (B.trim (bos s))
   else s
 
 let escaped s =
@@ -64,22 +94,32 @@ let escaped s =
       | _ -> true
   in
   if needs_escape 0 then
-    B.unsafe_to_string (B.escaped (B.unsafe_of_string s))
+    bts (B.escaped (bos s))
   else
     s
 
-let index = (Obj.magic B.index : string -> char -> int)
-let rindex = (Obj.magic B.rindex : string -> char -> int)
-let index_from = (Obj.magic B.index_from : string -> int -> char -> int)
-let rindex_from = (Obj.magic B.rindex_from : string -> int -> char -> int)
-let contains = (Obj.magic B.contains : string -> char -> bool)
-let contains_from = (Obj.magic B.contains_from : string -> int -> char -> bool)
-let rcontains_from =
-  (Obj.magic B.rcontains_from : string -> int -> char -> bool)
-let uppercase = (Obj.magic B.uppercase : string -> string)
-let lowercase = (Obj.magic B.lowercase : string -> string)
-let capitalize = (Obj.magic B.capitalize : string -> string)
-let uncapitalize = (Obj.magic B.uncapitalize : string -> string)
+let index s c =
+  B.index (bos s) c
+let rindex s c =
+  B.rindex (bos s) c
+let index_from s i c=
+  B.index_from (bos s) i c
+let rindex_from s i c =
+  B.rindex_from (bos s) i c
+let contains s c =
+  B.contains (bos s) c
+let contains_from s i c =
+  B.contains_from (bos s) i c
+let rcontains_from s i c =
+  B.rcontains_from (bos s) i c
+let uppercase s =
+  B.uppercase (bos s) |> bts
+let lowercase s =
+  B.lowercase (bos s) |> bts
+let capitalize s =
+  B.capitalize (bos s) |> bts
+let uncapitalize s =
+  B.uncapitalize (bos s) |> bts
 
 type t = string
 
-- 
cgit v1.2.1