Make Stream a less unsafe

(Pierre Chambart)

Stream used to modify blocks allocated as immutable. This Get rid of
most Obj module invocations in this module.

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

stdlib/stream.ml

@@ -15,7 +15,8 @@
    the empty stream. This is type safe because the empty stream is never
    patched. *)
 
-type 'a t = { count : int; data : 'a data }
+type 'a t = 'a data' option
+and 'a data' = { mutable count : int; mutable data : 'a data }
 and 'a data =
     Sempty
   | Scons of 'a * 'a data
@@ -30,11 +31,12 @@ and buffio =
 exception Failure;;
 exception Error of string;;
 
-external count : 'a t -> int = "%field0";;
-external set_count : 'a t -> int -> unit = "%setfield0";;
-let set_data (s : 'a t) (d : 'a data) =
-  Obj.set_field (Obj.repr s) 1 (Obj.repr d)
-;;
+let count = function
+  | None -> 0
+  | Some { count } -> count
+let data = function
+  | None -> Sempty
+  | Some { data } -> data
 
 let fill_buff b =
   b.len <- input b.ic b.buff 0 (Bytes.length b.buff); b.ind <- 0
@@ -70,51 +72,64 @@ let rec get_data count d = match d with
  | Slazy f -> get_data count (Lazy.force f)
 ;;
 
-let rec peek s =
+let rec peek_data s =
  (* consult the first item of s *)
  match s.data with
    Sempty -> None
  | Scons (a, _) -> Some a
  | Sapp (_, _) ->
      begin match get_data s.count s.data with
-       Scons(a, _) as d -> set_data s d; Some a
+       Scons(a, _) as d -> s.data <- d; Some a
      | Sempty -> None
      | _ -> assert false
      end
- | Slazy f -> set_data s (Lazy.force f); peek s
+ | Slazy f -> s.data <- (Lazy.force f); peek_data s
  | Sgen {curr = Some a} -> a
  | Sgen g -> let x = g.func s.count in g.curr <- Some x; x
  | Sbuffio b ->
      if b.ind >= b.len then fill_buff b;
-     if b.len == 0 then begin set_data s Sempty; None end
+     if b.len == 0 then begin s.data <- Sempty; None end
      else Some (Obj.magic (Bytes.unsafe_get b.buff b.ind))
 ;;
 
-let rec junk s =
-  match s.data with
-    Scons (_, d) -> set_count s (succ s.count); set_data s d
-  | Sgen ({curr = Some _} as g) -> set_count s (succ s.count); g.curr <- None
-  | Sbuffio b -> set_count s (succ s.count); b.ind <- succ b.ind
-  | _ ->
-      match peek s with
-        None -> ()
-      | Some _ -> junk s
+let peek = function
+  | None -> None
+  | Some s -> peek_data s
 ;;
 
-let rec nget n s =
+let rec junk_data s =
+  match s.data with
+    Scons (_, d) -> s.count <- (succ s.count); s.data <- d
+  | Sgen ({curr = Some _} as g) -> s.count <- (succ s.count); g.curr <- None
+  | Sbuffio b -> s.count <- (succ s.count); b.ind <- succ b.ind
+  | _ ->
+      match peek_data s with
+        None -> ()
+      | Some _ -> junk_data s
+;;
+
+let junk = function
+  | None -> ()
+  | Some data -> junk_data data
+
+let rec nget_data n s =
   if n <= 0 then [], s.data, 0
   else
-    match peek s with
+    match peek_data s with
       Some a ->
-        junk s;
-        let (al, d, k) = nget (pred n) s in a :: al, Scons (a, d), succ k
+        junk_data s;
+        let (al, d, k) = nget_data (pred n) s in a :: al, Scons (a, d), succ k
     | None -> [], s.data, 0
 ;;
 
-let npeek n s =
-  let (al, d, len) = nget n s in set_count s (s.count - len); set_data s d; al
+let npeek_data n s =
+  let (al, d, len) = nget_data n s in s.count <- (s.count - len); s.data <- d; al
 ;;
 
+let npeek n = function
+  | None -> []
+  | Some d -> npeek_data n d
+
 let next s =
   match peek s with
     Some a -> junk s; a
@@ -138,10 +153,10 @@ let iter f strm =
 
 (* Stream building functions *)
 
-let from f = {count = 0; data = Sgen {curr = None; func = f}};;
+let from f = Some {count = 0; data = Sgen {curr = None; func = f}};;
 
 let of_list l =
-  {count = 0; data = List.fold_right (fun x l -> Scons (x, l)) l Sempty}
+  Some {count = 0; data = List.fold_right (fun x l -> Scons (x, l)) l Sempty}
 ;;
 
 let of_string s =
@@ -169,32 +184,32 @@ let of_bytes s =
 ;;
 
 let of_channel ic =
-  {count = 0;
-   data = Sbuffio {ic = ic; buff = Bytes.create 4096; len = 0; ind = 0}}
+  Some {count = 0;
+        data = Sbuffio {ic = ic; buff = Bytes.create 4096; len = 0; ind = 0}}
 ;;
 
 (* Stream expressions builders *)
 
-let iapp i s = {count = 0; data = Sapp (i.data, s.data)};;
-let icons i s = {count = 0; data = Scons (i, s.data)};;
-let ising i = {count = 0; data = Scons (i, Sempty)};;
+let iapp i s = Some {count = 0; data = Sapp (data i, data s)};;
+let icons i s = Some {count = 0; data = Scons (i, data s)};;
+let ising i = Some {count = 0; data = Scons (i, Sempty)};;
 
 let lapp f s =
-  {count = 0; data = Slazy (lazy(Sapp ((f ()).data, s.data)))}
+  Some {count = 0; data = Slazy (lazy(Sapp (data (f ()), data s)))}
 ;;
-let lcons f s = {count = 0; data = Slazy (lazy(Scons (f (), s.data)))};;
-let lsing f = {count = 0; data = Slazy (lazy(Scons (f (), Sempty)))};;
+let lcons f s = Some {count = 0; data = Slazy (lazy(Scons (f (), data s)))};;
+let lsing f = Some {count = 0; data = Slazy (lazy(Scons (f (), Sempty)))};;
 
-let sempty = {count = 0; data = Sempty};;
-let slazy f = {count = 0; data = Slazy (lazy(f ()).data)};;
+let sempty = None;;
+let slazy f = Some {count = 0; data = Slazy (lazy(data (f ())))};;
 
 (* For debugging use *)
 
 let rec dump f s =
   print_string "{count = ";
-  print_int s.count;
+  print_int (count s);
   print_string "; data = ";
-  dump_data f s.data;
+  dump_data f (data s);
   print_string "}";
   print_newline ()
 and dump_data f =