Re: [Caml-list] Re: Common IO structure

[Benjamin Geer <ben@socialtools.net>]

[-- Attachment #1: Type: text/plain, Size: 957 bytes --]

Vladimir N. Silyaev wrote:
> If you felt interested, please look into the attached file io.ml.

This looks like a good start to me; what do others think?

I have two questions about it:

First, I think that rather than having to hard-code the use of the UTF8 
module in an application in order to handle UTF-8 characters, it would 
be more useful to be able to specify encodings using string arguments; 
the choice of encoding is often determined by reading a configuration 
file.  Would there be a way to support this?

Second, I'm wondering if this design can be adapted to accommodate 
non-blocking I/O.  The 'get' function has to return a character, but on 
a non-blocking socket, there might not be any character to return.  I've 
attached a sketch of an approach that might be more suitable for 
non-blocking I/O; I'd like to add it to your design, but I'm having 
trouble figuring out how.  I would be very interested in your thoughts 
on this.

Ben

[-- Attachment #2: buf.ml --]
[-- Type: text/plain, Size: 3216 bytes --]

exception Buffer_underflow
exception Buffer_overflow

module type Async =
sig
  type t
  val create : unit -> t
  val get : t -> char
  val put : t -> char -> unit
  val read : t -> string -> int -> int -> int
  val write : t -> string -> int -> int -> unit
  val from_fd : t -> Unix.file_descr -> unit
  val to_fd : t -> Unix.file_descr -> unit
  val clear : t -> unit
  val flip : t -> unit
  val compact : t -> unit
  val rewind : t -> unit
  val limit : t -> int
  val position : t -> int
  val remaining : t -> int
  val contents : t -> string
end

module AsyncBuffer : Async =
struct
  type t = {
    buf : string;
    mutable pos : int;
    mutable limit: int;
  }
  
  let create () =
    let capacity = 1024 in
      {
        buf = String.create capacity;
        pos = 0;   
        limit = capacity;
      }
  
  let limit b =
    b.limit

  let position b =
    b.pos

  let remaining b =
    b.limit - b.pos

  let contents b =
    String.sub b.buf b.pos (remaining b)

  let get b =
    let c = b.buf.[b.pos] in
      if b.pos < b.limit then
        (b.pos <- b.pos + 1; c)
      else
        raise Buffer_underflow

  let put b c =
    if b.pos < b.limit then
      (b.buf.[b.pos] <- c;
       b.pos <- b.pos + 1)
    else
      raise Buffer_overflow

  let read b dst offset len =
    let real_len =
      if len > remaining b then
        remaining b
      else
        len in
      String.blit b.buf b.pos dst offset real_len;
      b.pos <- b.pos + real_len;
      real_len

  let write b src offset len =
    if len <= remaining b then
      let result =
        String.blit src offset b.buf b.pos len in
        b.pos <- b.pos + len;
        result
    else
      raise Buffer_overflow

  let from_fd b fd =
    try
      let len = Unix.read fd b.buf b.pos (remaining b) in
        b.pos <- b.pos + len;
        if len = 0 then
          raise End_of_file
    with Unix.Unix_error (err, _, _) as e ->
      match err with
          Unix.EAGAIN | Unix.EWOULDBLOCK -> ()
        | _ -> raise e
          
  let to_fd b fd =
    try
      let len = Unix.write fd b.buf b.pos (remaining b) in
        b.pos <- b.pos + len
    with Unix.Unix_error (err, _, _) as e ->
      match err with
          Unix.EAGAIN | Unix.EWOULDBLOCK -> ()
        | _ -> raise e
      
  let clear b =
    b.pos <- 0;
    b.limit <- String.length b.buf
  
  let flip b =
    b.limit <- b.pos;
    b.pos <- 0

  let compact b =
    String.blit b.buf b.pos b.buf 0 (remaining b)
  
  let rewind b =
    b.pos <- 0
end

let copy_fd in_fd out_fd =
  let b = AsyncBuffer.create () in
    try
      while (true) do
        AsyncBuffer.from_fd b in_fd;
        AsyncBuffer.flip b;
        AsyncBuffer.to_fd b out_fd;
        AsyncBuffer.compact b
      done
    with End_of_file -> ()

let copy_file input_filename output_filename =
  let in_fd = Unix.openfile input_filename
                [ Unix.O_RDONLY; Unix.O_NONBLOCK ] 0o644 in
  let out_fd = Unix.openfile output_filename
                 [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC; Unix.O_NONBLOCK ] 0o644 in
  let output_data = String.create 10 in
    copy_fd in_fd out_fd;
    Unix.close in_fd;
    Unix.close out_fd

let _ =
  copy_file "input.txt" "output.txt"