Remove restrictions to stream concatenation, and use Lazy.t for the argument

of the Slazy data constructor.
Affected files: stdlib/{stream.ml,.depend,Makefile}


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

3 files changed, 54 insertions, 44 deletions

diff --git a/stdlib/.depend b/stdlib/.depend
index fe9f5ad1f..fc51ab117 100644
--- a/stdlib/.depend
+++ b/stdlib/.depend
@@ -94,7 +94,7 @@ stack.cmo: list.cmi stack.cmi
 stack.cmx: list.cmx stack.cmi 
 stdLabels.cmo: stringLabels.cmi listLabels.cmi arrayLabels.cmi stdLabels.cmi 
 stdLabels.cmx: stringLabels.cmx listLabels.cmx arrayLabels.cmx stdLabels.cmi 
-stream.cmo: string.cmi obj.cmi list.cmi stream.cmi 
+stream.cmo: string.cmi obj.cmi list.cmi lazy.cmi stream.cmi 
 stream.cmx: string.cmx obj.cmx list.cmx stream.cmi 
 string.cmo: pervasives.cmi list.cmi char.cmi string.cmi 
 string.cmx: pervasives.cmx list.cmx char.cmx string.cmi 
diff --git a/stdlib/Makefile b/stdlib/Makefile
index 2be2ae7c8..e1ecfe032 100644
--- a/stdlib/Makefile
+++ b/stdlib/Makefile
@@ -29,13 +29,13 @@ 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 \
+  set.cmo map.cmo stack.cmo queue.cmo lazy.cmo stream.cmo buffer.cmo \
   printf.cmo format.cmo scanf.cmo \
   arg.cmo printexc.cmo gc.cmo \
   digest.cmo random.cmo callback.cmo \
   camlinternalOO.cmo oo.cmo camlinternalMod.cmo \
   genlex.cmo weak.cmo \
-  lazy.cmo filename.cmo complex.cmo \
+  filename.cmo complex.cmo \
   arrayLabels.cmo listLabels.cmo stringLabels.cmo moreLabels.cmo stdLabels.cmo
 
 all: stdlib.cma std_exit.cmo camlheader camlheader_ur
diff --git a/stdlib/stream.ml b/stdlib/stream.ml
index c9975c4a0..aa6a2a2ab 100644
--- a/stdlib/stream.ml
+++ b/stdlib/stream.ml
@@ -22,7 +22,7 @@ and 'a data =
     Sempty
   | Scons of 'a * 'a data
   | Sapp of 'a data * 'a data
-  | Slazy of (unit -> 'a data)
+  | Slazy of 'a data Lazy.t
   | Sgen of 'a gen
   | Sbuffio of buffio
 and 'a gen = { mutable curr : 'a option option; func : int -> 'a option }
@@ -42,44 +42,54 @@ let fill_buff b =
   b.len <- input b.ic b.buff 0 (String.length b.buff); b.ind <- 0
 ;;
 
-let rec get_data =
-  function
-    Sempty -> None
-  | Scons (a, d) -> Some (a, d)
-  | Sapp (d1, d2) ->
-      begin match get_data d1 with
-        Some (a, d1) -> Some (a, Sapp (d1, d2))
-      | None -> get_data d2
-      end
-  | Slazy f ->
-      begin match f () with
-        Sgen _ | Sbuffio _ -> failwith "illegal stream concatenation"
-      | x -> get_data x
-      end
-  | Sgen _ | Sbuffio _ ->
-      failwith "illegal stream concatenation"
+let rec get_data count d = match d with
+ (* Returns either Sempty or Scons(a, _) even when d is a generator
+    or a buffer. In those cases, the item a is seen as extracted from
+ the generator/buffer.
+ The count parameter is used for calling `Sgen-functions'.  *)
+   Sempty | Scons (_, _) -> d
+ | Sapp (d1, d2) ->
+     begin match get_data count d1 with
+       Scons (a, d11) -> Scons (a, Sapp (d11, d2))
+     | Sempty -> get_data count d2
+     | _ -> assert false
+     end
+ | Sgen {curr = Some None; func = _ } -> Sempty
+ | Sgen ({curr = Some(Some a); func = f} as g) ->
+     g.curr <- None; Scons(a, d)
+ | Sgen g ->
+     begin match g.func count with
+       None -> g.curr <- Some(None); Sempty
+     | Some a -> Scons(a, d)
+         (* Warning: anyone using g thinks that an item has been read *)
+     end
+ | Sbuffio b ->
+     if b.ind >= b.len then fill_buff b;
+     if b.len == 0 then Sempty else
+       let r = Obj.magic (String.unsafe_get b.buff b.ind) in
+       (* Warning: anyone using g thinks that an item has been read *)
+       b.ind <- succ b.ind; Scons(r, d)
+ | Slazy f -> get_data count (Lazy.force f)
 ;;
 
 let rec peek s =
-  match s.data with
-    Sempty -> None
-  | Scons (a, _) -> Some a
-  | Sapp (_, _) ->
-      begin match get_data s.data with
-        Some (a, d) -> set_data s (Scons (a, d)); Some a
-      | None -> None
-      end
-  | Slazy f ->
-      begin match f () with
-        Sgen _ | Sbuffio _ -> failwith "illegal stream concatenation"
-      | d -> set_data s d; peek s
-      end
-  | 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
-      else Some (Obj.magic (String.unsafe_get b.buff b.ind))
+ (* 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
+     | Sempty -> None
+     | _ -> assert false
+     end
+ | Slazy f -> set_data s (Lazy.force f); peek 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
+     else Some (Obj.magic (String.unsafe_get b.buff b.ind))
 ;;
 
 let rec junk s =
@@ -152,13 +162,13 @@ let icons i s = {count = 0; data = Scons (i, s.data)};;
 let ising i = {count = 0; data = Scons (i, Sempty)};;
 
 let lapp f s =
-  {count = 0; data = Slazy (fun _ -> Sapp ((f ()).data, s.data))}
+  {count = 0; data = Slazy (lazy(Sapp ((f ()).data, s.data)))}
 ;;
-let lcons f s = {count = 0; data = Slazy (fun _ -> Scons (f (), s.data))};;
-let lsing f = {count = 0; data = Slazy (fun _ -> Scons (f (), Sempty))};;
+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 sempty = {count = 0; data = Sempty};;
-let slazy f = {count = 0; data = Slazy (fun _ -> (f ()).data)};;
+let slazy f = {count = 0; data = Slazy (lazy(f ()).data)};;
 
 (* For debugging use *)
 
@@ -184,7 +194,7 @@ and dump_data f =
       print_string ", ";
       dump_data f d2;
       print_string ")"
-  | Slazy f -> print_string "Slazy"
+  | Slazy _ -> print_string "Slazy"
   | Sgen _ -> print_string "Sgen"
   | Sbuffio b -> print_string "Sbuffio"
 ;;