stdlib/stream.ml

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                             Ocaml                                   *)
   4 (*                                                                     *)
   5 (*        Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt     *)
   6 (*                                                                     *)
   7 (*  Copyright 1997 Institut National de Recherche en Informatique et   *)
   8 (*  en Automatique.  All rights reserved.  This file is distributed    *)
   9 (*  under the terms of the GNU Library General Public License, with    *)
  10 (*  the special exception on linking described in file ../LICENSE.     *)
  11 (*                                                                     *)
  12 (***********************************************************************)
  13
  14 (* $Id$ *)
  15
  16 (* The fields of type t are not mutable to preserve polymorphism of
  17    the empty stream. This is type safe because the empty stream is never
  18    patched. *)
  19
  20 type 'a t = { count : int; data : 'a data }
  21 and 'a data =
  22     Sempty
  23   | Scons of 'a * 'a data
  24   | Sapp of 'a data * 'a data
  25   | Slazy of (unit -> 'a data)
  26   | Sgen of 'a gen
  27   | Sbuffio of buffio
  28 and 'a gen = { mutable curr : 'a option option; func : int -> 'a option }
  29 and buffio =
  30   { ic : in_channel; buff : string; mutable len : int; mutable ind : int }
  31 ;;
  32 exception Failure;;
  33 exception Error of string;;
  34
  35 external count : 'a t -> int = "%field0";;
  36 external set_count : 'a t -> int -> unit = "%setfield0";;
  37 let set_data (s : 'a t) (d : 'a data) =
  38   Obj.set_field (Obj.repr s) 1 (Obj.repr d)
  39 ;;
  40
  41 let fill_buff b =
  42   b.len <- input b.ic b.buff 0 (String.length b.buff); b.ind <- 0
  43 ;;
  44
  45 let rec get_data =
  46   function
  47     Sempty -> None
  48   | Scons (a, d) -> Some (a, d)
  49   | Sapp (d1, d2) ->
  50       begin match get_data d1 with
  51         Some (a, d1) -> Some (a, Sapp (d1, d2))
  52       | None -> get_data d2
  53       end
  54   | Slazy f ->
  55       begin match f () with
  56         Sgen _ | Sbuffio _ -> failwith "illegal stream concatenation"
  57       | x -> get_data x
  58       end
  59   | Sgen _ | Sbuffio _ ->
  60       failwith "illegal stream concatenation"
  61 ;;
  62
  63 let rec peek s =
  64   match s.data with
  65     Sempty -> None
  66   | Scons (a, _) -> Some a
  67   | Sapp (_, _) ->
  68       begin match get_data s.data with
  69         Some (a, d) -> set_data s (Scons (a, d)); Some a
  70       | None -> None
  71       end
  72   | Slazy f ->
  73       begin match f () with
  74         Sgen _ | Sbuffio _ -> failwith "illegal stream concatenation"
  75       | d -> set_data s d; peek s
  76       end
  77   | Sgen {curr = Some a} -> a
  78   | Sgen g -> let x = g.func s.count in g.curr <- Some x; x
  79   | Sbuffio b ->
  80       if b.ind >= b.len then fill_buff b;
  81       if b.len == 0 then begin set_data s Sempty; None end
  82       else Some (Obj.magic (String.unsafe_get b.buff b.ind))
  83 ;;
  84
  85 let rec junk s =
  86   match s.data with
  87     Scons (_, d) -> set_count s (succ s.count); set_data s d
  88   | Sgen ({curr = Some _} as g) -> set_count s (succ s.count); g.curr <- None
  89   | Sbuffio b -> set_count s (succ s.count); b.ind <- succ b.ind
  90   | _ ->
  91       match peek s with
  92         None -> ()
  93       | Some _ -> junk s
  94 ;;
  95
  96 let rec nget n s =
  97   if n <= 0 then [], s.data, 0
  98   else
  99     match peek s with
 100       Some a ->
 101         junk s;
 102         let (al, d, k) = nget (pred n) s in a :: al, Scons (a, d), succ k
 103     | None -> [], s.data, 0
 104 ;;
 105
 106 let npeek n s =
 107   let (al, d, len) = nget n s in set_count s (s.count - len); set_data s d; al
 108 ;;
 109
 110 let next s =
 111   match peek s with
 112     Some a -> junk s; a
 113   | None -> raise Failure
 114 ;;
 115
 116 let empty s =
 117   match peek s with
 118     Some _ -> raise Failure
 119   | None -> ()
 120 ;;
 121
 122 let iter f strm =
 123   let rec do_rec () =
 124     match peek strm with
 125       Some a -> junk strm; ignore(f a); do_rec ()
 126     | None -> ()
 127   in
 128   do_rec ()
 129 ;;
 130
 131 (* Stream building functions *)
 132
 133 let from f = {count = 0; data = Sgen {curr = None; func = f}};;
 134
 135 let of_list l =
 136   {count = 0; data = List.fold_right (fun x l -> Scons (x, l)) l Sempty}
 137 ;;
 138
 139 let of_string s =
 140   from (fun c -> if c < String.length s then Some s.[c] else None)
 141 ;;
 142
 143 let of_channel ic =
 144   {count = 0;
 145    data = Sbuffio {ic = ic; buff = String.create 4096; len = 0; ind = 0}}
 146 ;;
 147
 148 (* Stream expressions builders *)
 149
 150 let iapp i s = {count = 0; data = Sapp (i.data, s.data)};;
 151 let icons i s = {count = 0; data = Scons (i, s.data)};;
 152 let ising i = {count = 0; data = Scons (i, Sempty)};;
 153
 154 let lapp f s =
 155   {count = 0; data = Slazy (fun _ -> Sapp ((f ()).data, s.data))}
 156 ;;
 157 let lcons f s = {count = 0; data = Slazy (fun _ -> Scons (f (), s.data))};;
 158 let lsing f = {count = 0; data = Slazy (fun _ -> Scons (f (), Sempty))};;
 159
 160 let sempty = {count = 0; data = Sempty};;
 161 let slazy f = {count = 0; data = Slazy (fun _ -> (f ()).data)};;
 162
 163 (* For debugging use *)
 164
 165 let rec dump f s =
 166   print_string "{count = ";
 167   print_int s.count;
 168   print_string "; data = ";
 169   dump_data f s.data;
 170   print_string "}";
 171   print_newline ()
 172 and dump_data f =
 173   function
 174     Sempty -> print_string "Sempty"
 175   | Scons (a, d) ->
 176       print_string "Scons (";
 177       f a;
 178       print_string ", ";
 179       dump_data f d;
 180       print_string ")"
 181   | Sapp (d1, d2) ->
 182       print_string "Sapp (";
 183       dump_data f d1;
 184       print_string ", ";
 185       dump_data f d2;
 186       print_string ")"
 187   | Slazy f -> print_string "Slazy"
 188   | Sgen _ -> print_string "Sgen"
 189   | Sbuffio b -> print_string "Sbuffio"
 190 ;;