X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FDEVEL%2Fpxp%2Fnetstring%2Fnetstream.ml;fp=helm%2FDEVEL%2Fpxp%2Fnetstring%2Fnetstream.ml;h=76c2e3a4c8abd8adfe7a2d6c4f442e8785684afc;hb=c03d2c1fdab8d228cb88aaba5ca0f556318bebc5;hp=0000000000000000000000000000000000000000;hpb=758057e85325f94cd88583feb1fdf6b038e35055;p=helm.git

diff --git a/helm/DEVEL/pxp/netstring/netstream.ml b/helm/DEVEL/pxp/netstring/netstream.ml
new file mode 100644
index 000000000..76c2e3a4c
--- /dev/null
+++ b/helm/DEVEL/pxp/netstring/netstream.ml
@@ -0,0 +1,162 @@
+(* $Id$
+ * ----------------------------------------------------------------------
+ *
+ *)
+
+
+type t =
+    { s_channel : in_channel;
+      s_maxlength : int option;
+      s_blocksize : int;
+      mutable s_current_length : int;
+      mutable s_at_eos : bool;
+      mutable s_win_pos : int;
+      mutable s_win_len : int;
+      s_netbuf : Netbuffer.t;
+      s_iobuf : string;
+    }
+;;
+
+
+let dump s text = 
+  print_string ("*** NETSTREAM DUMP " ^ text ^ "\n");
+  Printf.printf "current_length=%d  at_eos=%b  win_pos=%d  win_len=%d\n"
+                s.s_current_length s.s_at_eos s.s_win_pos s.s_win_len;
+  Printf.printf "netbuffer_length=%d  netbuffer_size=%d\n"
+                (Netbuffer.length s.s_netbuf)
+                (String.length(Netbuffer.unsafe_buffer s.s_netbuf));
+  Printf.printf "netbuffer=\"%s\"\n"
+                (String.escaped(Netbuffer.contents s.s_netbuf));
+  print_string "*** ---------------\n";
+  flush stdout
+;;
+
+
+let want_another_block s =
+  if not s.s_at_eos then begin
+    (* How much are we allowed to read? *)
+    let m =
+      match s.s_maxlength with
+	  None   -> s.s_blocksize
+	| Some k -> min (k - s.s_current_length) s.s_blocksize
+    in
+    (* Read this. *)
+    let rec read_block k =
+      if k < m then
+	let n = 
+	  input s.s_channel s.s_iobuf k (m - k) in
+	( if n > 0 then
+	    read_block (k+n)
+	  else (* EOF *)
+	    k
+	)
+      else
+	k
+    in
+    let n = read_block 0 in
+    (* If n < blocksize, EOS is reached. *)
+    Netbuffer.add_sub_string s.s_netbuf s.s_iobuf 0 n;
+    s.s_win_len        <- s.s_win_len + n;
+    s.s_current_length <- s.s_current_length + n;
+    s.s_at_eos         <- n < s.s_blocksize;
+
+    (* dump s "After appending block"; *)
+  end
+;;
+
+
+let want s n =
+  while not s.s_at_eos && s.s_win_len < n do
+    want_another_block s
+  done
+;;
+
+
+let want_minimum s =
+  want s (s.s_blocksize + s.s_blocksize)
+;;
+
+
+let move s n =
+  Netbuffer.delete s.s_netbuf 0 n;
+  s.s_win_pos <- s.s_win_pos + n;
+  s.s_win_len <- s.s_win_len - n;
+  want_minimum s;
+  (* dump s "After move"; *)
+;;
+
+
+let create_from_channel ch maxlength blocksize =
+  let s =
+    { s_channel = ch;
+      s_maxlength = maxlength;
+      s_blocksize = blocksize;
+      s_current_length = 0;
+      s_at_eos = false;
+      s_win_pos = 0;
+      s_win_len = 0;
+      s_netbuf = Netbuffer.create (2*blocksize);
+      s_iobuf = String.create blocksize;
+    }
+  in
+  want_minimum s;
+  s
+;;
+
+
+let create_from_string str =
+  let l = String.length str in
+  { s_channel = stdin;
+    s_maxlength = None;
+    s_blocksize = l;
+    s_current_length = l;
+    s_at_eos = true;
+    s_win_pos = 0;
+    s_win_len = l;
+    s_netbuf =
+      ( let nb = Netbuffer.create l in
+	Netbuffer.add_string nb str;
+	nb
+      );
+    s_iobuf = "";
+  }
+;;
+
+
+let block_size s = s.s_blocksize;;
+
+let current_length s = s.s_current_length;;
+
+let at_eos s = s.s_at_eos;;
+
+let window_position s = s.s_win_pos;;
+
+let window_length s = s.s_win_len;;
+
+let window s = s.s_netbuf;;
+
+let print_stream s =
+  Format.printf
+    "<NETSTREAM window:%d/%d total_length:%d eof=%b>"
+    s.s_win_pos
+    s.s_win_len
+    s.s_current_length
+    s.s_at_eos
+;;
+
+
+(* ======================================================================
+ * History:
+ * 
+ * $Log$
+ * Revision 1.1  2000/11/17 09:57:27  lpadovan
+ * Initial revision
+ *
+ * Revision 1.2  2000/06/24 20:20:33  gerd
+ * 	Added the toploop printer.
+ *
+ * Revision 1.1  2000/04/15 13:07:48  gerd
+ * 	Initial revision.
+ *
+ * 
+ *)