l4/pkg/ocaml/contrib/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: stream.ml 8893 2008-06-18 15:35:02Z mauny $ *)
  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 'a data Lazy.t
  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 count d = match d with
  46  (* Returns either Sempty or Scons(a, _) even when d is a generator
  47     or a buffer. In those cases, the item a is seen as extracted from
  48  the generator/buffer.
  49  The count parameter is used for calling `Sgen-functions'.  *)
  50    Sempty | Scons (_, _) -> d
  51  | Sapp (d1, d2) ->
  52      begin match get_data count d1 with
  53        Scons (a, d11) -> Scons (a, Sapp (d11, d2))
  54      | Sempty -> get_data count d2
  55      | _ -> assert false
  56      end
  57  | Sgen {curr = Some None; func = _ } -> Sempty
  58  | Sgen ({curr = Some(Some a); func = f} as g) ->
  59      g.curr <- None; Scons(a, d)
  60  | Sgen g ->
  61      begin match g.func count with
  62        None -> g.curr <- Some(None); Sempty
  63      | Some a -> Scons(a, d)
  64          (* Warning: anyone using g thinks that an item has been read *)
  65      end
  66  | Sbuffio b ->
  67      if b.ind >= b.len then fill_buff b;
  68      if b.len == 0 then Sempty else
  69        let r = Obj.magic (String.unsafe_get b.buff b.ind) in
  70        (* Warning: anyone using g thinks that an item has been read *)
  71        b.ind <- succ b.ind; Scons(r, d)
  72  | Slazy f -> get_data count (Lazy.force f)
  73 ;;
  74
  75 let rec peek s =
  76  (* consult the first item of s *)
  77  match s.data with
  78    Sempty -> None
  79  | Scons (a, _) -> Some a
  80  | Sapp (_, _) ->
  81      begin match get_data s.count s.data with
  82        Scons(a, _) as d -> set_data s d; Some a
  83      | Sempty -> None
  84      | _ -> assert false
  85      end
  86  | Slazy f -> set_data s (Lazy.force f); peek s
  87  | Sgen {curr = Some a} -> a
  88  | Sgen g -> let x = g.func s.count in g.curr <- Some x; x
  89  | Sbuffio b ->
  90      if b.ind >= b.len then fill_buff b;
  91      if b.len == 0 then begin set_data s Sempty; None end
  92      else Some (Obj.magic (String.unsafe_get b.buff b.ind))
  93 ;;
  94
  95 let rec junk s =
  96   match s.data with
  97     Scons (_, d) -> set_count s (succ s.count); set_data s d
  98   | Sgen ({curr = Some _} as g) -> set_count s (succ s.count); g.curr <- None
  99   | Sbuffio b -> set_count s (succ s.count); b.ind <- succ b.ind
 100   | _ ->
 101       match peek s with
 102         None -> ()
 103       | Some _ -> junk s
 104 ;;
 105
 106 let rec nget n s =
 107   if n <= 0 then [], s.data, 0
 108   else
 109     match peek s with
 110       Some a ->
 111         junk s;
 112         let (al, d, k) = nget (pred n) s in a :: al, Scons (a, d), succ k
 113     | None -> [], s.data, 0
 114 ;;
 115
 116 let npeek n s =
 117   let (al, d, len) = nget n s in set_count s (s.count - len); set_data s d; al
 118 ;;
 119
 120 let next s =
 121   match peek s with
 122     Some a -> junk s; a
 123   | None -> raise Failure
 124 ;;
 125
 126 let empty s =
 127   match peek s with
 128     Some _ -> raise Failure
 129   | None -> ()
 130 ;;
 131
 132 let iter f strm =
 133   let rec do_rec () =
 134     match peek strm with
 135       Some a -> junk strm; ignore(f a); do_rec ()
 136     | None -> ()
 137   in
 138   do_rec ()
 139 ;;
 140
 141 (* Stream building functions *)
 142
 143 let from f = {count = 0; data = Sgen {curr = None; func = f}};;
 144
 145 let of_list l =
 146   {count = 0; data = List.fold_right (fun x l -> Scons (x, l)) l Sempty}
 147 ;;
 148
 149 let of_string s =
 150   from (fun c -> if c < String.length s then Some s.[c] else None)
 151 ;;
 152
 153 let of_channel ic =
 154   {count = 0;
 155    data = Sbuffio {ic = ic; buff = String.create 4096; len = 0; ind = 0}}
 156 ;;
 157
 158 (* Stream expressions builders *)
 159
 160 let iapp i s = {count = 0; data = Sapp (i.data, s.data)};;
 161 let icons i s = {count = 0; data = Scons (i, s.data)};;
 162 let ising i = {count = 0; data = Scons (i, Sempty)};;
 163
 164 let lapp f s =
 165   {count = 0; data = Slazy (lazy(Sapp ((f ()).data, s.data)))}
 166 ;;
 167 let lcons f s = {count = 0; data = Slazy (lazy(Scons (f (), s.data)))};;
 168 let lsing f = {count = 0; data = Slazy (lazy(Scons (f (), Sempty)))};;
 169
 170 let sempty = {count = 0; data = Sempty};;
 171 let slazy f = {count = 0; data = Slazy (lazy(f ()).data)};;
 172
 173 (* For debugging use *)
 174
 175 let rec dump f s =
 176   print_string "{count = ";
 177   print_int s.count;
 178   print_string "; data = ";
 179   dump_data f s.data;
 180   print_string "}";
 181   print_newline ()
 182 and dump_data f =
 183   function
 184     Sempty -> print_string "Sempty"
 185   | Scons (a, d) ->
 186       print_string "Scons (";
 187       f a;
 188       print_string ", ";
 189       dump_data f d;
 190       print_string ")"
 191   | Sapp (d1, d2) ->
 192       print_string "Sapp (";
 193       dump_data f d1;
 194       print_string ", ";
 195       dump_data f d2;
 196       print_string ")"
 197   | Slazy _ -> print_string "Slazy"
 198   | Sgen _ -> print_string "Sgen"
 199   | Sbuffio b -> print_string "Sbuffio"
 200 ;;