(*
 * Builtin file operations.
 *
 * \begin{doc}
 * \section{IO functions}
 * \end{doc}
 *)

include Omake_pos.Make (struct let name = "Omake_builtin_io" end)

(*
 * Table of variables.
 *
 * \begin{doc}
 * \subsection{Standard channels}
 *
 * The following variables define the standard channels.
 *
 * \var{stdin}
 *
 * \begin{verbatim}
 * stdin : InChannel
 * \end{verbatim}
 *
 * The standard input channel, open for reading.
 *
 * \var{stdout}
 * \begin{verbatim}
 * stdout : OutChannel
 * \end{verbatim}
 *
 * The standard output channel, open for writing.
 *
 * \var{stderr}
 * \begin{verbatim}
 * stderr : OutChannel
 * \end{verbatim}
 *
 * The standard error channel, open for writing.
 * \end{doc}
 *)

(*
 * \begin{doc}
 * \fun{open-in-string}
 * The \verb+open-in-string+ treats a string as if it were a file
 * and returns a channel for reading.
 *
 * \begin{verbatim}
 *    $(open-in-string s) : Channel
 *        s : String
 * \end{verbatim}
 * \end{doc}
 *)
let open_in_string venv pos loc args =
   let pos = string_pos "open-in-string" pos in
      match args with
         [arg] ->
            let s = Omake_value.string_of_value venv pos arg in
            let fd = Lm_channel.of_string s in
            let chan = Omake_env.venv_add_channel venv fd in
               Omake_value_type.ValChannel (Lm_channel.InChannel, chan)
       | _ ->
            raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 1, List.length args)))

(*
 * \begin{doc}
 * \twofuns{open-out-string}{out-contents}
 * The \verb+open-out-string+ creates a channel that writes to a
 * string instead of a file.  The string may be retrieved with the
 * \verb+out-contents+ function.
 *
 * \begin{verbatim}
 *    $(open-out-string) : Channel
 *    $(out-contents chan) : String
 *        chan : OutChannel
 * \end{verbatim}
 * \end{doc}
 *)
let open_out_string venv pos loc args =
  let pos = string_pos "open-in-string" pos in
  match args with
  | [] ->
    let fd = Lm_channel.create_string () in
    let chan = Omake_env.venv_add_channel venv fd in
    Omake_value_type.ValChannel (Lm_channel.OutChannel, chan)
  | _ ->
    raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 0, List.length args)))

let out_contents venv pos loc args =
  let pos = string_pos "out-contents" pos in
  match args with
    [fd] ->
    let outp = Omake_value.prim_channel_of_value venv pos fd in
    let outx = Omake_env.venv_find_channel venv pos outp in
    let s = Lm_channel.to_string outx in
    Omake_value_type.ValString s
  | _ ->
    raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 1, List.length args)))

(*
 * Open a file.
 *
 * \begin{doc}
 * \fun{fopen}
 *
 * The \verb+fopen+ function opens a file for reading or writing.
 *
 * \begin{verbatim}
 *    $(fopen file, mode) : Channel
 *       file : File
 *       mode : String
 * \end{verbatim}
 *
 * The \verb+file+ is the name of the file to be opened.
 * The \verb+mode+ is a combination of the following characters.
 * \begin{description}
 * \item[r] Open the file for reading; it is an error if the file does not exist.
 * \item[w] Open the file for writing; the file is created if it does not exist.
 * \item[a] Open the file in append mode; the file is created if it does not exist.
 * \item[+] Open the file for both reading and writing.
 * \item[t] Open the file in text mode (default).
 * \item[b] Open the file in binary mode.
 * \item[n] Open the file in nonblocking mode.
 * \item[x] Fail if the file already exists.
 * \end{description}
 *
 * Binary mode is not significant on Unix systems, where
 * text and binary modes are equivalent.
 * \end{doc}
 *)
let read_mode     = 1
let write_mode    = 2
let create_mode   = 4
let append_mode   = 8
let binary_mode   = 16
let text_mode     = 32
let nonblock_mode = 64
let excl_mode     = 128

let fopen_mode pos loc s =
   let len = String.length s in
   let rec collect mode i =
      if i = len then
         mode
      else
         let bit =
         match s.[i] with
            ' '
          | '\t' ->
               mode
          | 'r' ->
               read_mode
          | 'w' ->
               write_mode lor create_mode
          | 'a' ->
               append_mode lor write_mode
          | '+' ->
               read_mode lor write_mode
          | 'b' ->
               binary_mode
          | 't' ->
               text_mode
          | 'n' ->
               nonblock_mode
          | 'x' ->
               excl_mode
          | _ ->
               raise (Omake_value_type.OmakeException (loc_pos loc pos, StringStringError ("illegal file mode", s)))
         in
         let mode = mode lor bit in
            collect mode (succ i)
   in
   let mode = collect 0 0 in
   let () =
      if (mode land text_mode) <> 0 && (mode land binary_mode) <> 0 then
         raise (Omake_value_type.OmakeException (loc_pos loc pos, StringStringError ("can't specify both text and binary modes", s)))
   in
   let opt =
      if (mode land append_mode) <> 0 then
         [Unix.O_APPEND; Unix.O_CREAT]
      else if (mode land create_mode) <> 0 then
         [Unix.O_CREAT; Unix.O_TRUNC]
      else
         []
   in
   let kind, opt =
      if (mode land read_mode) <> 0 && (mode land write_mode) <> 0 then
         Omake_value_type.InOutChannel, Unix.O_RDWR :: opt
      else if (mode land write_mode) <> 0 then
         OutChannel, Unix.O_WRONLY :: opt
      else
         InChannel, Unix.O_RDONLY :: opt
   in
   let opt =
      if (mode land excl_mode) <> 0 then
         Unix.O_EXCL :: opt
      else
         opt
   in
   let opt =
      if (mode land nonblock_mode) <> 0 then
         Unix.O_NONBLOCK :: opt
      else
         opt
   in
      kind, (mode land binary_mode) <> 0, opt

let fopen venv pos loc args =
  let pos = string_pos "fopen" pos in
  match args with
  |[node; flags] ->
    let name = Omake_value.filename_of_value venv pos node in
    let kind, binary, flags = fopen_mode pos loc (Omake_value.string_of_value venv pos flags) in
    let fd =
      try Lm_unix_util.openfile name flags 0o666 with
        Unix.Unix_error _ as exn ->
        raise (Omake_value_type.UncaughtException (loc_pos loc pos, exn))
    in
    let chan = Lm_channel.create name Lm_channel.FileChannel kind binary (Some fd) in
    Omake_value_type.ValChannel (kind, Omake_env.venv_add_channel venv chan)
  | _ ->
    raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 2, List.length args)))

(*
 * Closing file descriptors.
 *
 * \begin{doc}
 * \fun{close}
 *
 * \begin{verbatim}
 *     $(close channel...)
 *        channel : Channel
 * \end{verbatim}
 *
 * The \verb+close+ function closes a file that was previously opened
 * with \verb+fopen+.
 * \end{doc}
 *)
let close venv pos loc args =
  let pos = string_pos "close" pos in
  match args with
  |[arg] ->
    let args = Omake_value.values_of_value venv pos arg in
    List.iter (fun arg ->
      match Omake_value.eval_prim_value venv pos arg with
      |   ValChannel (_, channel) ->
        Omake_env.venv_close_channel venv pos channel
      | arg ->
        raise (Omake_value_type.OmakeException (loc_pos loc pos, StringValueError ("not a file descriptor", arg)))) args;
    Omake_value_type.ValNone
  | _ ->
    raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 1, List.length args)))

(*
 * \begin{doc}
 * \twofuns{read}{input-line}
 *
 * \begin{verbatim}
 *    $(read channel, amount) : String
 *    $(input-line channel) : String
 *       channel : InChannel
 *       amount  : Int
 *    raises RuntimeException
 * \end{verbatim}
 *
 * The \verb+read+ function reads up to \verb+amount+
 * bytes from an input channel, and returns
 * the data that was read. The \verb+input-line+ function reads a line from the file and returns the line read, without
 * the line terminator. If an end-of-file condition is reached, both functions raise a \verb+RuntimeException+
 * exception.
 * \end{doc}
 *)
let read venv pos loc args =
   let pos = string_pos "read" pos in
      match args with
         [fd; amount] ->
            let fd = Omake_value.channel_of_value venv pos fd in
            let amount = Omake_value.int_of_value venv pos amount in
            let s = Bytes.make amount '\000' in
            let count =
               try Lm_channel.read fd s 0 amount with
                  Sys_error _
                | Invalid_argument _ as exn ->
                     raise (Omake_value_type.UncaughtException (pos, exn))
            in
               if count = amount then
                  Omake_value_type.ValData (Bytes.to_string s)
               else if count = 0 then
                  raise (Omake_value_type.UncaughtException (pos, End_of_file))
               else
                  ValData (Bytes.sub_string s 0 count)
       | _ ->
            raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 2, List.length args)))

let input_line venv pos loc args =
  let pos = string_pos "input-line" pos in
  match args with
  |[fd] ->
    let fd = Omake_value.channel_of_value venv pos fd in
    let s =
      try Lm_channel.input_line fd with
        Sys_error _
      | End_of_file
      | Invalid_argument _ as exn ->
        raise (Omake_value_type.UncaughtException (pos, exn))
    in
    Omake_value_type.ValData s
  | _ ->
    raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 1, List.length args)))

(*
 * \begin{doc}
 * \fun{write}
 *
 * \begin{verbatim}
 *    $(write channel, buffer, offset, amount) : String
 *       channel : OutChannel
 *       buffer  : String
 *       offset  : Int
 *       amount  : Int
 *    $(write channel, buffer) : String
 *       channel : OutChannel
 *       buffer  : String
 *    raises RuntimeException
 * \end{verbatim}
 *
 * In the 4-argument form, the \verb+write+ function writes
 * bytes to the output channel \verb+channel+ from the \verb+buffer+,
 * starting at position \verb+offset+.  Up to \verb+amount+ bytes
 * are written.  The function returns the number of bytes that were
 * written.
 *
 * The 3-argument form is similar, but the \verb+offset+ is 0.
 *
 * In the 2-argument form, the \verb+offset+ is 0, and the \verb+amount+
 * if the length of the \verb+buffer+.
 *
 * If an end-of-file condition is reached,
 * the function raises a \verb+RuntimeException+ exception.
 * \end{doc}
 *)
let write venv pos loc args =
  let pos = string_pos "read" pos in
  let fd, buf, off, len =
    match args with
    | [fd; buf] ->
      fd, buf, None, None
    | [fd; buf; len] ->
      fd, buf, None, Some len
    | [fd; buf; off; len] ->
      fd, buf, Some off, Some len
    | _ ->
      raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityRange (2, 4), List.length args)))
  in
  let fd = Omake_value.channel_of_value venv pos fd in
  let buf = Omake_value.string_of_value venv pos buf in
  let off =
    match off with
      Some off ->
      Omake_value.int_of_value venv pos off
    | None ->
      0
  in
  let len =
    match len with
      Some len ->
      Omake_value.int_of_value venv pos len
    | None ->
      String.length buf
  in
  let count =
    try Lm_channel.write fd (Bytes.of_string buf) off len with
      Sys_error _
    | Invalid_argument _ as exn ->
      raise (Omake_value_type.UncaughtException (pos, exn))
  in
  Omake_value_type.ValInt count

(*
 * \begin{doc}
 * \fun{lseek}
 *
 * \begin{verbatim}
 *     $(lseek channel, offset, whence) : Int
 *        channel : Channel
 *        offset  : Int
 *        whence  : String
 *     raises RuntimeException
 * \end{verbatim}
 *
 * The \verb+lseek+ function repositions the offset of the
 * channel \verb+channel+ according to the \verb+whence+ directive, as
 * follows:
 *
 * \begin{description}
 * \item[SEEK\_SET] The offset is set to \verb+offset+.
 * \item[SEEK\_CUR] The offset is set to its current position plus \verb+offset+ bytes.
 * \item[SEEK\_END] The offset is set to the size of the file plus \verb+offset+ bytes.
 * \end{description}
 *
 * The \verb+lseek+ function returns the new position in the file.
 * \end{doc}
 *)
let lseek venv pos loc args =
  let pos = string_pos "lseek" pos in
  match args with
  | [fd; off; whence] ->
    let fd = Omake_value.channel_of_value venv pos fd in
    let off = Omake_value.int_of_value venv pos off in
    let whence =
      match String.uppercase_ascii (Omake_value.string_of_value venv pos whence) with
        "SET" | "SEEK_SET" ->
        Unix.SEEK_SET
      | "CUR" | "CURRENT" | "SEEK_CUR" ->
        Unix.SEEK_CUR
      | "END" | "SEEK_END" ->
        Unix.SEEK_END
      | whence ->
        raise (Omake_value_type.OmakeException (loc_pos loc pos, StringStringError ("illegal lseek parameter", whence)))
    in
    let off =
      try Lm_channel.seek fd off whence with
        Unix.Unix_error _ as exn ->
        raise (Omake_value_type.UncaughtException (pos, exn))
    in
    Omake_value_type.ValInt off
  | _ ->
    raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 3, List.length args)))

(*
 * \begin{doc}
 * \fun{rewind}
 *
 * \begin{verbatim}
 *    rewind(channel...)
 *       channel : Channel
 * \end{verbatim}
 *
 * The \verb+rewind+ function set the current file position to the
 * beginning of the file.
 * \end{doc}
 *)
let rewind venv pos loc args =
  let pos = string_pos "rewind" pos in
  match args with
  | [arg] ->
    let args = Omake_value.values_of_value venv pos arg in
    let () =
      try
        List.iter (fun arg ->
          let fd = Omake_value.channel_of_value venv pos arg in
          ignore (Lm_channel.seek fd 0 Unix.SEEK_SET)) args
      with
        Unix.Unix_error _ as exn ->
        raise (Omake_value_type.UncaughtException (pos, exn))
    in
    Omake_value_type.ValNone
  | _ ->
    raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 1, List.length args)))

(*
 * \begin{doc}
 * \fun{tell}
 *
 * \begin{verbatim}
 *     $(tell channel...) : Int...
 *        channel : Channel
 *     raises RuntimeException
 * \end{verbatim}
 *
 * The \verb+tell+ function returns the current position of the \verb+channel+.
 * \end{doc}
 *)
let tell venv pos loc args =
  let pos = string_pos "tell" pos in
  match args with
  | [arg] ->
    let args = Omake_value.values_of_value venv pos arg in
    let args =
      try
        List.map (fun arg ->
          let fd = Omake_value.channel_of_value venv pos arg in
          Omake_value_type.ValInt (Lm_channel.tell fd)) args
      with
        Unix.Unix_error _ as exn ->
        raise (Omake_value_type.UncaughtException (pos, exn))
    in
    Omake_value.concat_array args
  | _ ->
    raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 1, List.length args)))

(*
 * Flush an output channel.
 *
 * \begin{doc}
 * \fun{flush}
 *
 * \begin{verbatim}
 *    $(flush channel...)
 *       channel : OutChannel
 * \end{verbatim}
 *
 * The \verb+flush+ function can be used only on files that are open for writing.
 * It flushes all pending data to the file.
 * \end{doc}
 *)
let flush venv pos loc args =
  let pos = string_pos "flush" pos in
  match args with
  | [arg] ->
    let args = Omake_value.values_of_value venv pos arg in
    List.iter (fun s ->
      let fd = Omake_value.channel_of_value venv pos s in
      Lm_channel.flush fd) args;
    Omake_value_type.ValNone
  | _ ->
    raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 1, List.length args)))

(*
 * \begin{doc}
 * \fun{channel-name}
 *
 * \begin{verbatim}
 *    $(channel-name channel...) : String
 *       channel : Channel
 * \end{verbatim}
 *
 * The \verb+channel-name+ function returns the name that is associated with the channel.
 * \end{doc}
 *)
let channel_name venv pos loc args =
  let pos = string_pos "channel-name" pos in
  match args with
  | [arg] ->
    let fd = Omake_value.channel_of_value venv pos arg in
    Omake_value_type.ValData (Lm_channel.name fd)
  | _ ->
    raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 1, List.length args)))

(*
 * \begin{doc}
 * \fun{dup}
 *
 * \begin{verbatim}
 *     $(dup channel) : Channel
 *        channel : Channel
 *     raises RuntimeException
 * \end{verbatim}
 *
 * The \verb+dup+ function returns a new channel referencing the
 * same file as the argument.
 * \end{doc}
 *)
let dup venv pos loc args =
  let pos = string_pos "dup" pos in
  match args with
  | [arg] ->
    let channel = Omake_value.channel_of_value venv pos arg in
    let name = Lm_channel.name channel in
    let fd = Lm_channel.descr channel in
    let _, kind, mode, binary = Lm_channel.info channel in
    let fd =
      try Unix.dup fd with
        Unix.Unix_error _ as exn ->
        raise (Omake_value_type.UncaughtException (pos, exn))
    in
    let chan = Lm_channel.create name kind mode binary (Some fd) in
    let channel = Omake_env.venv_add_channel venv chan in
    Omake_value_type.ValChannel (mode, channel)
  | _ ->
    raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 1, List.length args)))

(*
 * \begin{doc}
 * \fun{dup2}
 *
 * \begin{verbatim}
 *    dup2(channel1, channel2)
 *       channel1 : Channel
 *       channel2 : Channel
 *    raises RuntimeException
 * \end{verbatim}
 *
 * The \verb+dup2+ function causes \verb+channel2+ to refer to the same
 * file as \verb+channel1+.
 * \end{doc}
 *)
let dup2 venv pos loc args =
  let pos = string_pos "dup2" pos in
  match args with
  | [arg1; arg2] ->
    let channel1 = Omake_value.channel_of_value venv pos arg1 in
    let channel2 = Omake_value.channel_of_value venv pos arg2 in
    let fd1 = Lm_channel.descr channel1 in
    let fd2 = Lm_channel.descr channel2 in
    let () =
      try Unix.dup2 fd1 fd2 with
        Unix.Unix_error _ as exn ->
        raise (Omake_value_type.UncaughtException (pos, exn))
    in
    Omake_value_type.ValNone
  | _ ->
    raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 2, List.length args)))

(*
 * \begin{doc}
 * \fun{set-nonblock}
 *
 * \begin{verbatim}
 *    set-nonblock-mode(mode, channel...)
 *       channel : Channel
 *       mode : String
 * \end{verbatim}
 *
 * The \verb+set-nonblock-mode+ function sets the nonblocking flag on the
 * given channel.  When IO is performed on the channel, and the operation
 * cannot be completed immediately, the operations raises a \verb+RuntimeException+.
 * \end{doc}
 *)
let set_nonblock_mode venv pos loc args =
  let pos = string_pos "set_nonblock_mode" pos in
  match args with
    [mode; channel] ->
    let set_mode =
      if Omake_value.bool_of_value venv pos mode then
        Unix.set_nonblock
      else
        Unix.clear_nonblock
    in
    let channels = Omake_value.values_of_value venv pos channel in
    let () =
      try
        List.iter (fun channel ->
          let channel = Omake_value.channel_of_value venv pos channel in
          let fd = Lm_channel.descr channel in
          set_mode fd) channels
      with
        Unix.Unix_error _ as exn ->
        raise (Omake_value_type.UncaughtException (pos, exn))
    in
    Omake_value_type.ValNone
  | _ ->
    raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 2, List.length args)))

(*
 * \begin{doc}
 * \fun{set-close-on-exec-mode}
 *
 * \begin{verbatim}
 *    set-close-on-exec-mode(mode, channel...)
 *       channel : Channel
 *       mode : String
 *    raises RuntimeException
 * \end{verbatim}
 *
 * The \verb+set-close-on-exec-mode+ function sets the close-on-exec
 * flags for the given channels.  If the close-on-exec flag is set, the channel
 * is not inherited by child processes.  Otherwise it is.
 * \end{doc}
 *)
let set_close_on_exec_mode venv pos loc args =
  let pos = string_pos "set-close-on-exec-mode" pos in
  match args with
  | [mode; channel] ->
    let set_mode =
      if Omake_value.bool_of_value venv pos mode then
        Unix.set_close_on_exec
      else
        Unix.clear_close_on_exec
    in
    let channels = Omake_value.values_of_value venv pos channel in
    let () =
      try
        List.iter (fun channel ->
          let channel = Omake_value.channel_of_value venv pos channel in
          let fd = Lm_channel.descr channel in
          set_mode fd) channels
      with
        Unix.Unix_error _ as exn ->
        raise (Omake_value_type.UncaughtException (pos, exn))
    in
    Omake_value_type.ValNone
  | _ ->
    raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 2, List.length args)))

(*
 * \begin{doc}
 * \fun{pipe}
 *
 * \begin{verbatim}
 *    $(pipe) : Pipe
 *    raises RuntimeException
 * \end{verbatim}
 *
 * The \verb+pipe+ function creates a \verb+Pipe+ object, which has two
 * fields.  The \verb+read+ field is a channel that is opened for
 * reading, and the \verb+write+ field is a channel that is opened
 * for writing.
 * \end{doc}
 *)
let pipe venv pos loc args =
  let pos = string_pos "pipe" pos in
  match args with
    [] ->
    let fd_read, fd_write =
      try Unix.pipe () with
        Unix.Unix_error _ as exn ->
        raise (Omake_value_type.UncaughtException (pos, exn))
    in
    let read = Lm_channel.create "<readpipe>" Lm_channel.PipeChannel InChannel false (Some fd_read) in
    let write = Lm_channel.create "<writepipe>" Lm_channel.PipeChannel OutChannel false (Some fd_write) in
    let fd_read = Omake_value_type.ValChannel (InChannel, Omake_env.venv_add_channel venv read) in
    let fd_write = Omake_value_type.ValChannel (OutChannel, Omake_env.venv_add_channel venv write) in
    let obj = Omake_env.venv_find_object_or_empty venv Omake_var.pipe_object_var in
    let obj = Omake_env.venv_add_field_internal obj Omake_symbol.read_sym fd_read in
    let obj = Omake_env.venv_add_field_internal obj Omake_symbol.write_sym fd_write in
    Omake_value_type.ValObject obj
  | _ ->
    raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 0, List.length args)))

(*
 * \begin{doc}
 * \fun{mkfifo}
 *
 * \begin{verbatim}
 *    mkfifo(mode, node...)
 *       mode : Int
 *       node : Node
 * \end{verbatim}
 *
 * The \verb+mkfifo+ function creates a named pipe.
 * \end{doc}
 *)
let mkfifo venv pos loc args =
  let pos = string_pos "mkfifo" pos in
  match args with
  | [mode; nodes] ->
    let mode = Omake_value.int_of_value venv pos mode in
    let nodes = Omake_value.values_of_value venv pos nodes in
    let () =
      try
        List.iter (fun node ->
          Unix.mkfifo (Omake_value.filename_of_value venv pos node) mode) nodes
      with
        Unix.Unix_error _ as exn ->
        raise (Omake_value_type.UncaughtException (pos, exn))
    in
    Omake_value_type.ValNone
  | _ ->
    raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 2, List.length args)))

(*
 * \begin{doc}
 * \fun{select}
 *
 * \begin{verbatim}
 *    $(select rfd..., wfd..., wfd..., timeout) : Select
 *       rfd : InChannel
 *       wfd : OutChannel
 *       efd : Channel
 *       timeout : float
 *    raises RuntimeException
 * \end{verbatim}
 *
 * The \verb+select+ function polls for possible IO on a set of channels.
 * The \verb+rfd+ are a sequence of channels for reading, \verb+wfd+ are a
 * sequence of channels for writing, and \verb+efd+ are a sequence of
 * channels to poll for error conditions.  The \verb+timeout+ specifies
 * the maximum amount of time to wait for events.
 *
 * On successful return, \verb+select+ returns a \verb+Select+ object,
 * which has the following fields:
 * \begin{description}
 * \item[read] An array of channels available for reading.
 * \item[write] An array of channels available for writing.
 * \item[error] An array of channels on which an error has occurred.
 * \end{description}
 * \end{doc}
 *)
let select venv pos loc args =
  let pos = string_pos "select" pos in
  match args with
  | [rfd; wfd; efd; timeout] ->
    let rfd = Omake_value.values_of_value venv pos rfd in
    let wfd = Omake_value.values_of_value venv pos wfd in
    let efd = Omake_value.values_of_value venv pos efd in
    let rfd = List.map (Omake_value.channel_of_value venv pos) rfd in
    let wfd = List.map (Omake_value.channel_of_value venv pos) wfd in
    let efd = List.map (Omake_value.channel_of_value venv pos) efd in
    let timeout = Omake_value.float_of_value venv pos timeout in
    let rfd, wfd, efd =
      try Lm_channel.select rfd wfd efd timeout with
        Unix.Unix_error _ as exn ->
        raise (Omake_value_type.UncaughtException (pos, exn))
    in
    let reintern_channel fdl =
      List.map (fun fd ->
        let fd = Omake_env.venv_find_channel_by_channel venv pos fd in
        let channel = Omake_env.venv_find_channel venv pos fd in
        let _, _, mode, _ = Lm_channel.info channel in
        Omake_value_type.ValChannel (mode, fd)) fdl
    in
    let rfd = reintern_channel rfd in
    let wfd = reintern_channel wfd in
    let efd = reintern_channel efd in
    let obj = Omake_env.venv_find_object_or_empty venv Omake_var.select_object_var in
    let obj = Omake_env.venv_add_field_internal obj Omake_symbol.read_sym  (ValArray rfd) in
    let obj = Omake_env.venv_add_field_internal obj Omake_symbol.write_sym (ValArray wfd) in
    let obj = Omake_env.venv_add_field_internal obj Omake_symbol.error_sym (ValArray efd) in
    Omake_value_type.ValObject obj
  | _ ->
    raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 4, List.length args)))

(*
 * \begin{doc}
 * \fun{lockf}
 *
 * \begin{verbatim}
 *     lockf(channel, command, len)
 *        channel : Channel
 *        command : String
 *        len : Int
 *     raises RuntimeException
 * \end{verbatim}
 *
 * The \verb+lockf+ function places a lock on a region of the channel.
 * The region starts at the current position and extends for \verb+len+
 * bytes.
 *
 * The possible values for \verb+command+ are the following.
 * \begin{description}
 * \item[F\_ULOCK] Unlock a region.
 * \item[F\_LOCK] Lock a region for writing; block if already locked.
 * \item[F\_TLOCK] Lock a region for writing; fail if already locked.
 * \item[F\_TEST] Test a region for other locks.
 * \item[F\_RLOCK] Lock a region for reading; block if already locked.
 * \item[F\_TRLOCK] Lock a region for reading; fail is already locked.
 * \end{description}
 * \end{doc}
 *)
let lockf venv pos loc args =
  let pos = string_pos "lockf" pos in
  match args with
    [channel; command; len] ->
    let channel = Omake_value.channel_of_value venv pos channel in
    let command = Omake_value.string_of_value venv pos command in
    let len = Omake_value.int_of_value venv pos len in
    let command =
      match command with
      | "F_ULOCK" -> Unix.F_ULOCK
      | "F_LOCK"  -> Unix.F_LOCK
      | "F_TLOCK" -> Unix.F_TLOCK
      | "F_TEST"  -> Unix.F_TEST
      | "F_RLOCK" -> Unix.F_RLOCK
      | "F_TRLOCK" -> Unix.F_TRLOCK
      | _ ->
        raise (Omake_value_type.OmakeException (loc_pos loc pos, StringStringError ("lockf: illegal command", command)))
    in
    let fd = Lm_channel.descr channel in
    let () =
      try Unix.lockf fd command len with
        Unix.Unix_error _ as exn ->
        raise (Omake_value_type.UncaughtException (pos, exn))
    in
    Omake_value_type.ValNone
  | _ ->
    raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 3, List.length args)))

(************************************************************************
 * Databases.
*)

let addr_of_value venv pos arg =
   let host = Omake_value.string_of_value venv pos arg in
      try Unix.inet_addr_of_string host with
         Failure _ ->
            let entry = Unix.gethostbyname host in
               entry.Unix.h_addr_list.(0)

let proto_of_value venv pos arg =
   let proto = Omake_value.string_of_value venv pos arg in
      try Unix.getprotobynumber (int_of_string proto) with
         Failure _ ->
            Unix.getprotobyname proto

(*
(*
 * \begin{doc}
 * \obj{InetAddr}
 *
 * The \verb+InetAddr+ object describes an Internet address.
 * It contains the following fields.
 *
 * \begin{description}
 * \item[addr] \verb+String+: the Internet address.
 * \item[port] \verb+Int+: the port number.
 * \end{description}
 *
 * \obj{Host}
 *
 * A \verb+Host+ object contains the following fields.
 *
 * \begin{description}
 * \item[name] \verb+String+: the name of the host.
 * \item[aliases] \verb+String Array+: other names by which the host is known.
 * \item[addrtype] \verb+String+: the preferred socket domain.
 * \item[addrs] \verb+InetAddr Array+: an array of Internet addresses belonging to the host.
 * \end{description}
 *
 * \fun{gethostbyname}
 *
 * \begin{verbatim}
 *    $(gethostbyname host...) : Host...
 *       host : String
 *    raises RuntimeException
 * \end{verbatim}
 *
 * The \verb+gethostbyname+ function returns a \verb+Host+ object
 * for the specified host.  The \verb+host+ may specify a domain name
 * or an Internet address.
 *
 * \end{doc}
 *)
let gethostbyname venv pos loc args =
   let pos = string_pos "gethostbyname" pos in
      match args with
         [arg] ->
            let args = Omake_value.values_of_value venv pos arg in
            let args =
               try
                  List.map (fun arg ->
                        let host = Omake_value.string_of_value venv pos arg in
                        let entry =
                           try
                              let addr = Unix.inet_addr_of_string host in
                                 Unix.gethostbyaddr addr
                           with
                              Failure _ ->
                                 Unix.gethostbyname host
                        in
                           make_host_entry venv pos entry) args
               with
                  Not_found
                | Unix.Unix_error _ as exn ->
                     raise (Omake_value_type.UncaughtException (pos, exn))
            in
               Omake_value.concat_array args
       | _ ->
            raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 1, List.length args)))

(*
 * \begin{doc}
 * \obj{Protocol}
 *
 * The \verb+Protocol+ object represents a protocol entry.
 * It has the following fields.
 *
 * \begin{description}
 * \item[name] \verb+String+: the canonical name of the protocol.
 * \item[aliases] \verb+String Array+: aliases for the protocol.
 * \item[proto] \verb+Int+: the protocol number.
 * \end{description}
 *
 * \fun{getprotobyname}
 *
 * \begin{verbatim}
 *    $(getprotobyname name...) : Protocol...
 *       name : Int or String
 *    raises RuntimeException
 * \end{verbatim}
 *
 * The \verb+getprotobyname+ function returns a \verb+Protocol+ object for the
 * specified protocol.  The \verb+name+ may be a protocol name, or a
 * protocol number.
 * \end{doc}
 *)
let getprotobyname venv pos loc args =
   let pos = string_pos "getprotobyname" pos in
      match args with
         [arg] ->
            let args = Omake_value.values_of_value venv pos arg in
            let args =
               try
                  List.map (fun arg ->
                        let proto = Omake_value.string_of_value venv pos arg in
                        let entry =
                           try Unix.getprotobynumber (int_of_string proto) with
                              Failure _ ->
                                 Unix.getprotobyname proto
                        in
                           make_proto_entry venv pos entry) args
               with
                  Not_found
                | Unix.Unix_error _ as exn ->
                     raise (Omake_value_type.UncaughtException (pos, exn))
            in
               Omake_value.concat_array args
       | _ ->
            raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 1, List.length args)))

(*
 * \begin{doc}
 * \obj{Service}
 *
 * The \verb+Service+ object represents a network service.
 * It has the following fields.
 *
 * \begin{description}
 * \item[name] \verb+String+: the name of the service.
 * \item[aliases] \verb+String Array+: aliases for the service.
 * \item[port] \verb+Int+: the port number of the service.
 * \item[proto] \verb+Protocol+: the protocol for the service.
 * \end{description}
 *
 * \fun{getservbyname}
 *
 * \begin{verbatim}
 *    $(getservbyname service...) : Service...
 *       service : String or Int
 *    raises RuntimeException
 * \end{verbatim}
 *
 * The \verb+getservbyname+ function gets the information for a network service.
 * The \verb+service+ may be specified as a service name or number.
 * \end{doc}
 *)
let getprotobyname venv pos loc args =
   let pos = string_pos "getprotobyname" pos in
      match args with
         [arg] ->
            let args = Omake_value.values_of_value venv pos arg in
            let args =
               try
                  List.map (fun arg ->
                        let proto = Omake_value.string_of_value venv pos arg in
                        let entry =
                           try Unix.getservbyprt (int_of_string proto) with
                              Failure _ ->
                                 Unix.getservbyname proto
                        in
                           make_serv_entry venv pos entry) args
               with
                  Not_found
                | Unix.Unix_error _ as exn ->
                     raise (Omake_value_type.UncaughtException (pos, exn))
            in
               Omake_value.concat_array args
       | _ ->
            raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 1, List.length args)))
*)

(*
 * \begin{doc}
 * \fun{socket}
 *
 * \begin{verbatim}
 *    $(socket domain, type, protocol) : Channel
 *       domain : String
 *       type : String
 *       protocol : String
 *    raises RuntimeException
 * \end{verbatim}
 *
 * The \verb+socket+ function creates an unbound socket.
 *
 * The possible values for the arguments are as follows.
 *
 * The \verb+domain+ may have the following values.
 * \begin{description}
 * \item[PF\_UNIX or unix] Unix domain, available only on Unix systems.
 * \item[PF\_INET or inet] Internet domain, IPv4.
 * \item[PF\_INET6 or inet6] Internet domain, IPv6.
 * \end{description}
 *
 * The \verb+type+ may have the following values.
 * \begin{description}
 * \item[SOCK\_STREAM or stream] Stream socket.
 * \item[SOCK\_DGRAM or dgram] Datagram socket.
 * \item[SOCK\_RAW or raw] Raw socket.
 * \item[SOCK\_SEQPACKET or seqpacket] Sequenced packets socket
 * \end{description}
 *
 * The \verb+protocol+ is an \verb+Int+ or \verb+String+ that specifies
 * a protocol in the protocols database.
 * \end{doc}
 *)
let socket venv pos loc args =
  let pos = string_pos "socket" pos in
  match args with
  | [domain; ty; proto] ->
    let domain =
      match String.uppercase_ascii (Omake_value.string_of_value venv pos domain) with
        "PF_UNIX"
      | "UNIX" ->
        Unix.PF_UNIX
      | "PF_INET"
      | "INET"
      | "IP" ->
        Unix.PF_INET

      (* If you are compiling with OCaml-3.07 or earlier, comment out these lines *)
      | "PF_INET6"
      | "INET6"
      | "IP6" ->
        Unix.PF_INET6
      | domain ->
        raise (Omake_value_type.OmakeException (loc_pos loc pos, StringStringError ("bad domain", domain)))
    in
    let ty =
      match String.uppercase_ascii (Omake_value.string_of_value venv pos ty) with
        "SOCK_STREAM"
      | "STREAM" ->
        Unix.SOCK_STREAM
      | "SOCK_DGRAM"
      | "DGRAM" ->
        Unix.SOCK_DGRAM
      | "SOCK_RAW"
      | "RAW" ->
        Unix.SOCK_RAW
      | "SOCK_SEQPACKET"
      | "SEQPACKET" ->
        Unix.SOCK_SEQPACKET
      | ty ->
        raise (Omake_value_type.OmakeException (loc_pos loc pos, StringStringError ("bad type", ty)))
    in
    let proto = proto_of_value venv pos proto in
    let socket =
      try Unix.socket domain ty proto.Unix.p_proto with
        Unix.Unix_error _ as exn ->
        raise (Omake_value_type.UncaughtException (pos, exn))
    in
    let channel = Lm_channel.create "<socket>" Lm_channel.SocketChannel Lm_channel.InOutChannel false (Some socket) in
    let channel = Omake_env.venv_add_channel venv channel in
    Omake_value_type.ValChannel (InOutChannel, channel)
  | _ ->
    raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 3, List.length args)))

(*
 * \begin{doc}
 * \fun{bind}
 *
 * \begin{verbatim}
 *    bind(socket, host, port)
 *       socket : InOutChannel
 *       host : String
 *       port : Int
 *    bind(socket, file)
 *       socket : InOutChannel
 *       file : File
 *    raise RuntimeException
 * \end{verbatim}
 *
 * The \verb+bind+ function binds a socket to an address.
 *
 * The 3-argument form specifies an Internet connection, the \verb+host+ specifies a host name
 * or IP address, and the \verb+port+ is a port number.
 *
 * The 2-argument form is for \verb+Unix+ sockets.  The \verb+file+ specifies the filename
 * for the address.
 * \end{doc}
 *)
let bind venv pos loc args =
  let pos = string_pos "bind" pos in
  let socket, addr =
    match args with
      [socket; host; port] ->
      let host = addr_of_value venv pos host in
      let port = Omake_value.int_of_value venv pos port in
      let addr = Unix.ADDR_INET (host, port) in
      socket, addr
    | [socket; name] ->
      let name = Omake_value.filename_of_value venv pos name in
      let addr = Unix.ADDR_UNIX name in
      socket, addr
    | _ ->
      raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityRange (2, 3), List.length args)))
  in
  let socket = Omake_value.channel_of_value venv pos socket in
  let socket = Lm_channel.descr socket in
  let () =
    try Unix.bind socket addr with
      Unix.Unix_error _ as exn ->
      raise (Omake_value_type.UncaughtException (pos, exn))
  in
  Omake_value_type.ValNone

(*
 * \begin{doc}
 * \fun{listen}
 *
 * \begin{verbatim}
 *    listen(socket, requests)
 *       socket : InOutChannel
 *       requests : Int
 *    raises RuntimeException
 * \end{verbatim}
 *
 * The \verb+listen+ function sets up the socket for receiving up to \verb+requests+ number
 * of pending connection requests.
 * \end{doc}
 *)
let listen venv pos loc args =
  let pos = string_pos "listen" pos in
  match args with
    [socket; requests] ->
    let socket = Omake_value.channel_of_value venv pos socket in
    let socket = Lm_channel.descr socket in
    let requests = Omake_value.int_of_value venv pos requests in
    let () =
      try Unix.listen socket requests with
        Unix.Unix_error _ as exn ->
        raise (Omake_value_type.UncaughtException (pos, exn))
    in
    Omake_value_type.ValNone
  | _ ->
    raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 2, List.length args)))

(*
 * \begin{doc}
 * \fun{accept}
 *
 * \begin{verbatim}
 *    $(accept socket) : InOutChannel
 *       socket : InOutChannel
 *    raises RuntimeException
 * \end{verbatim}
 *
 * The \verb+accept+ function accepts a connection on a socket.
 * \end{doc}
 *)
let accept venv pos loc args =
  let pos = string_pos "accept" pos in
  match args with
  | [socket] ->
    let socket = Omake_value.channel_of_value venv pos socket in
    let socket = Lm_channel.descr socket in
    let socket, _ =
      try Unix.accept socket with
        Unix.Unix_error _ as exn ->
        raise (Omake_value_type.UncaughtException (pos, exn))
    in
    let channel = Lm_channel.create "<socket>" Lm_channel.SocketChannel Lm_channel.InOutChannel false (Some socket) in
    let channel = Omake_env.venv_add_channel venv channel in
    Omake_value_type.ValChannel (InOutChannel, channel)
  | _ ->
    raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 1, List.length args)))

(*
 * \begin{doc}
 * \fun{connect}
 *
 * \begin{verbatim}
 *     connect(socket, addr, port)
 *        socket : InOutChannel
 *        addr : String
 *        port : int
 *     connect(socket, name)
 *        socket : InOutChannel
 *        name : File
 *     raise RuntimeException
 * \end{verbatim}
 *
 * The \verb+connect+ function connects a socket to a remote address.
 *
 * The 3-argument form specifies an Internet connection.
 * The \verb+addr+ argument is the Internet address of the remote host,
 * specified as a domain name or IP address.  The \verb+port+ argument
 * is the port number.
 *
 * The 2-argument form is for Unix sockets.  The \verb+name+ argument
 * is the filename of the socket.
 * \end{doc}
 *)
let connect venv pos loc args =
  let pos = string_pos "connect" pos in
  let socket, addr =
    match args with
      [socket; host; port] ->
      let host = addr_of_value venv pos host in
      let port = Omake_value.int_of_value venv pos port in
      let addr = Unix.ADDR_INET (host, port) in
      socket, addr
    | [socket; name] ->
      let name = Omake_value.filename_of_value venv pos name in
      let addr = Unix.ADDR_UNIX name in
      socket, addr
    | _ ->
      raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityRange (2, 3), List.length args)))
  in
  let socket = Omake_value.channel_of_value venv pos socket in
  let socket = Lm_channel.descr socket in
  let () =
    try Unix.connect socket addr with
      Unix.Unix_error _ as exn ->
      raise (Omake_value_type.UncaughtException (pos, exn))
  in
  Omake_value_type.ValNone

(************************************************************************
 * Buffered IO.
*)

(*
 * Get the next character.
 *
 * \begin{doc}
 * \fun{getchar}
 *
 * \begin{verbatim}
 *     $(getc) : String
 *     $(getc file) : String
 *        file : InChannel or File
 *     raises RuntimeException
 * \end{verbatim}
 *
 * The \verb+getc+ function returns the next character of a file.
 * If the argument is not specified, \verb+stdin+ is used as input.
 * If the end of file has been reached, the function returns \verb+false+.
 * \end{doc}
 *)
let getc venv pos loc args =
  let pos = string_pos "getc" pos in
  let arg =
    match args with
    |[] ->
      Omake_env.venv_find_var venv pos loc Omake_var.stdin_var
    | [arg] ->
      arg
    | _ ->
      raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityRange (0, 1), List.length args)))
  in
  let inp, close_flag = Omake_value.in_channel_of_any_value venv pos arg in
  let inx = Omake_env.venv_find_channel venv pos inp in
  let s =
    try String.make 1 (Lm_channel.input_char inx) with
      End_of_file ->
      "false"
  in
  if close_flag then
    Omake_env.venv_close_channel venv pos inp;
  Omake_value_type.ValData s


(*
 * Get the next line.
 *
 * \begin{doc}
 * \fun{gets}
 *
 * \begin{verbatim}
 *    $(gets) : String
 *    $(gets channel) : String
 *       channel : InChannel or File
 *    raises RuntimeException
 * \end{verbatim}
 *
 * The \verb+gets+ function returns the next line from a file.
 * The function returns the empty string if the end of file has been reached.
 * The line terminator is removed.
 * \end{doc}
 *)
let gets venv pos loc args =
  let pos = string_pos "gets" pos in
  let arg =
    match args with
    |[] ->
      Omake_env.venv_find_var venv pos loc Omake_var.stdin_var
    | [arg] ->
      arg
    | _ ->
      raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityRange (0, 1), List.length args)))
  in
  let inp, close_flag = Omake_value.in_channel_of_any_value venv pos arg in
  let inx = Omake_env.venv_find_channel venv pos inp in
  let s =
    try Lm_channel.input_line inx with
      End_of_file ->
      ""
  in
  if close_flag then
    Omake_env.venv_close_channel venv pos inp;
  Omake_value_type.ValString s

(*
 * Get the next line.
 *
 * \begin{doc}
 * \fun{fgets}
 *
 * \begin{verbatim}
 *    $(fgets) : String
 *    $(fgets channel) : String
 *       channel : InChannel or File
 *    raises RuntimeException
 * \end{verbatim}
 *
 * The \verb+fgets+ function returns the next line from a file that has been
 * opened for reading with \verb+fopen+.  The function returns the empty string
 * if the end of file has been reached.  The returned string is returned as
 * literal data.  The line terminator is not removed.
 * \end{doc}
 *)
let fgets venv pos loc args =
  let pos = string_pos "fgets" pos in
  let arg =
    match args with
      [] ->
      Omake_env.venv_find_var venv pos loc Omake_var.stdin_var
    | [arg] ->
      arg
    | _ ->
      raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityRange (0, 1), List.length args)))
  in
  let inp, close_flag = Omake_value.in_channel_of_any_value venv pos arg in
  let inx = Omake_env.venv_find_channel venv pos inp in
  let s =
    try Lm_channel.input_entire_line inx with
      End_of_file ->
      ""
  in
  if close_flag then
    Omake_env.venv_close_channel venv pos inp;
  Omake_value_type.ValData s

(*
 * \begin{doc}
 * \section{Printing functions}
 * \funref{fprint}
 * \funref{print}
 * \funref{eprint}
 * \funref{fprintln}
 * \funref{println}
 * \funref{eprintln}
 *
 * Output is printed with the \verb+print+ and \verb+println+ functions.
 * The \verb+println+ function adds a terminating newline to the value being
 * printed, the \verb+print+ function does not.
 *
 * \begin{verbatim}
 *     fprint(<file>, <string>)
 *     print(<string>)
 *     eprint(<string>)
 *     fprintln(<file>, <string>)
 *     println(<string>)
 *     eprintln(<string>)
 * \end{verbatim}
 *
 * The \verb+fprint+ functions print to a file that has been previously opened with
 * \verb+fopen+.  The \verb+print+ functions print to the standard output channel, and
 * the \verb+eprint+ functions print to the standard error channel.
 * \end{doc}
 *)
let print_aux venv pos loc nl args =
  match args with
  | [fd; s] ->
    let outp, close_flag = Omake_value.out_channel_of_any_value venv pos fd in
    let outx = Omake_env.venv_find_channel venv pos outp in
    let s = Omake_value.string_of_value venv pos s in
    Lm_channel.output_string outx s;
    Lm_channel.output_string outx nl;
    Lm_channel.flush outx;
    if close_flag then
      Omake_env.venv_close_channel venv pos outp;
    Omake_value_type.ValNone
  | _ ->
    raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 2, List.length args)))

let fprint venv pos loc args =
   let pos = string_pos "fprint" pos in
      print_aux venv pos loc "" args

let print venv pos loc args =
   let pos = string_pos "print" pos in
   let stdout_fd = Omake_env.venv_find_var venv pos loc Omake_var.stdout_var in
      fprint venv pos loc (stdout_fd :: args)

let eprint venv pos loc args =
   let pos = string_pos "eprint" pos in
   let stderr_fd = Omake_env.venv_find_var venv pos loc Omake_var.stderr_var in
      fprint venv pos loc (stderr_fd :: args)

let fprintln venv pos loc args =
   let pos = string_pos "fprintln" pos in
      print_aux venv pos loc "\n" args

let println venv pos loc args =
   let pos = string_pos "println" pos in
   let stdout_fd = Omake_env.venv_find_var venv pos loc Omake_var.stdout_var in
     fprintln venv pos loc (stdout_fd :: args)

let eprintln venv pos loc args =
   let pos = string_pos "eprintln" pos in
   let stderr_fd = Omake_env.venv_find_var venv pos loc Omake_var.stderr_var in
      fprintln venv pos loc (stderr_fd :: args)

(*
 * \begin{doc}
 * \section{Value printing functions}
 * \funref{fprintv}
 * \funref{printv}
 * \funref{eprintv}
 * \funref{fprintvln}
 * \funref{printvln}
 * \funref{eprintvln}
 *
 * Values can be printed with the \verb+printv+ and \verb+printvln+ functions.
 * The \verb+printvln+ function adds a terminating newline to the value being
 * printed, the \verb+printv+ function does not.
 *
 * \begin{verbatim}
 *     fprintv(<file>, <string>)
 *     printv(<string>)
 *     eprintv(<string>)
 *     fprintvln(<file>, <string>)
 *     printvln(<string>)
 *     eprintvln(<string>)
 * \end{verbatim}
 *
 * The \verb+fprintv+ functions print to a file that has been previously opened with
 * \verb+fopen+.  The \verb+printv+ functions print to the standard output channel, and
 * the \verb+eprintv+ functions print to the standard error channel.
 * \end{doc}
 *)
let printv_aux venv pos loc nl args =
  match args with
    [fd; s] ->
    let outp, close_flag = Omake_value.out_channel_of_any_value venv pos fd in
    let outx = Omake_env.venv_find_channel venv pos outp in
    let s =
      Omake_value_print.pp_print_value Format.str_formatter s;
      Format.flush_str_formatter ()
    in
    Lm_channel.output_string outx s;
    Lm_channel.output_string outx nl;
    Lm_channel.flush outx;
    if close_flag then
      Omake_env.venv_close_channel venv pos outp;
    Omake_value_type.ValNone
  | _ ->
    raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 2, List.length args)))

let fprintv venv pos loc args =
   let pos = string_pos "fprintv" pos in
      printv_aux venv pos loc "" args

let printv venv pos loc args =
   let pos = string_pos "printv" pos in
   let stdout_fd = Omake_env.venv_find_var venv pos loc Omake_var.stdout_var in
      fprintv venv pos loc (stdout_fd :: args)

let eprintv venv pos loc args =
   let pos = string_pos "eprintv" pos in
   let stderr_fd = Omake_env.venv_find_var venv pos loc Omake_var.stderr_var in
      fprintv venv pos loc (stderr_fd :: args)

let fprintvln venv pos loc args =
   let pos = string_pos "fprintvln" pos in
      printv_aux venv pos loc "\n" args

let printvln venv pos loc args =
   let pos = string_pos "printvln" pos in
   let stdout_fd = Omake_env.venv_find_var venv pos loc Omake_var.stdout_var in
     fprintvln venv pos loc (stdout_fd :: args)

let eprintvln venv pos loc args =
   let pos = string_pos "eprintvln" pos in
   let stderr_fd = Omake_env.venv_find_var venv pos loc Omake_var.stderr_var in
      fprintvln venv pos loc (stderr_fd :: args)

(************************************************************************
 * Printf.
 *)
module Args =
struct
  type t =
    { print_venv    : Omake_env.t;
      print_pos     : Omake_value_type.pos;
      print_loc     : Lm_location.t;
      print_fmt     : Format.formatter;
      print_fd      : Omake_value_type.prim_channel;
      print_channel : Lm_channel.t
    }

  type value = Omake_value_type.t

  (*
    * Create the buffers and channels.
    *)
  let create_channel venv pos loc channel =
    let fmt = Lm_printf.byte_formatter (Lm_channel.output_buffer channel) (fun () -> Lm_channel.flush channel) in
    let fd = Omake_env.venv_add_formatter_channel venv fmt in
    let channel = Omake_env.venv_find_channel venv pos fd in
    { print_venv    = venv;
      print_pos     = pos;
      print_loc     = loc;
      print_fmt     = fmt;
      print_fd      = fd;
      print_channel = channel
    }

  let create_buffer venv pos loc buf =
    let fmt = Format.formatter_of_buffer buf in
    let fd = Omake_env.venv_add_formatter_channel venv fmt in
    let channel = Omake_env.venv_find_channel venv pos fd in
    { print_venv    = venv;
      print_pos     = pos;
      print_loc     = loc;
      print_fmt     = fmt;
      print_fd      = fd;
      print_channel = channel
    }

  (*
    * When done, close the channels, and get the string.
    *)
  let close info =
    let { print_fd = fd;
          print_venv = venv;
          print_pos = pos;
          print_fmt = fmt;
          _
        } = info
    in
    Omake_env.venv_close_channel venv pos fd;
    Format.pp_print_flush fmt ()

  (*
    * The printers.
    *)
  let print_char info c =
    Lm_channel.output_char info.print_channel c

  let print_string info s =
    Lm_channel.output_string info.print_channel s

  (*
    * Formatter flushes the buffer.
    *)
  let flush info =
    Lm_channel.flush info.print_channel

  let open_box info i =
    flush info;
    Format.pp_open_box info.print_fmt i

  let open_hbox info =
    flush info;
    Format.pp_open_hbox info.print_fmt ()

  let open_vbox info i =
    flush info;
    Format.pp_open_vbox info.print_fmt i

  let open_hvbox info i =
    flush info;
    Format.pp_open_hvbox info.print_fmt i

  let open_hovbox info i =
    flush info;
    Format.pp_open_hovbox info.print_fmt i

  let close_box info =
    flush info;
    Format.pp_close_box info.print_fmt ()

  let print_cut info =
    flush info;
    Format.pp_close_box info.print_fmt ()

  let print_space info =
    flush info;
    Format.pp_print_space info.print_fmt ()

  let force_newline info =
    flush info;
    Format.pp_force_newline info.print_fmt ()

  let print_break info i j =
    flush info;
    Format.pp_print_break info.print_fmt i j

  let print_flush info =
    flush info;
    Format.pp_print_flush info.print_fmt ()

  let print_newline info =
    flush info;
    Format.pp_print_newline info.print_fmt ()

  (*
    * Converters.
    *)
  let bool_of_value info v =
    let { print_venv = venv;
          print_pos = pos;
          _
        } = info
    in
    Omake_value.bool_of_value venv pos v

  let char_of_value info v =
    let { print_venv = venv;
          print_pos = pos;
          _
        } = info
    in
    let s = Omake_value.string_of_value venv pos v in
    if String.length s <> 1 then
      raise (Omake_value_type.OmakeException (pos, StringStringError ("not a character", s)));
    s.[0]

  let int_of_value info v =
    let { print_venv = venv;
          print_pos = pos;
          _
        } = info
    in
    Omake_value.int_of_value venv pos v

  let float_of_value info v =
    let { print_venv = venv;
          print_pos = pos;
          _
        } = info
    in
    Omake_value.float_of_value venv pos v

  let string_of_value info v =
    let { print_venv = venv;
          print_pos = pos;
          _
        } = info
    in
    Omake_value.string_of_value venv pos v

  let print_value info v =
    flush info;
    Omake_value_print.pp_print_value info.print_fmt v

  (*
    * Applications.
    *)
  let apply1 info arg1 =
    let { print_venv = venv;
          print_pos = pos;
          print_loc = loc;
          print_fd = fd;
          _
        } = info
    in
    ignore (Omake_eval.eval_apply venv pos loc arg1 [ValChannel (OutChannel, fd)] [])

  let apply2 info arg1 arg2 =
    let { print_venv = venv;
          print_pos = pos;
          print_loc = loc;
          print_fd = fd;
          _
        } = info
    in
    ignore (Omake_eval.eval_apply venv pos loc arg1 [ValChannel (OutChannel, fd); arg2] [])

  (*
    * Catch too many arguments.
    *)
  let exit info args =
    match args with
      [] ->
      Omake_value_type.ValNone
    | arg :: _ ->
      let { 
        print_pos = pos;
        _
      } = info
      in
      raise (Omake_value_type.OmakeException (pos, StringValueError ("too many arguments to printf", arg)))
end

module Printf = Omake_printf.MakePrintf (Args);;

let fprintf_aux venv pos loc channel fmt args =
   let fmt = Omake_value.string_of_value venv pos fmt in
   let buf = Args.create_channel venv pos loc channel in
   let result =
      try Printf.fprintf buf fmt args with
         exn ->
            Args.close buf;
            raise exn
   in
      Args.close buf;
      result

let printf_fun venv pos loc args =
   let pos = string_pos "printf" pos in
      match args with
         fmt :: args ->
            let stdout = Omake_env.venv_find_var venv pos loc Omake_var.stdout_var in
            let stdout = Omake_value.channel_of_value venv pos stdout in
               fprintf_aux venv pos loc stdout fmt args
       | _ ->
            raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 1, List.length args)))

let eprintf_fun venv pos loc args =
   let pos = string_pos "eprintf" pos in
      match args with
         fmt :: args ->
            let stderr = Omake_env.venv_find_var venv pos loc Omake_var.stderr_var in
            let stderr = Omake_value.channel_of_value venv pos stderr in
               fprintf_aux venv pos loc stderr fmt args
       | _ ->
            raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 1, List.length args)))

let fprintf_fun venv pos loc args =
   let pos = string_pos "fprintf" pos in
      match args with
         fd :: fmt :: args ->
            let channel = Omake_value.channel_of_value venv pos fd in
               fprintf_aux venv pos loc channel fmt args
       | _ ->
            raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 2, List.length args)))

let sprintf_fun venv pos loc args =
  let pos = string_pos "sprintf" pos in
  match args with
  |fmt :: args ->
    let fmt = Omake_value.string_of_value venv pos fmt in
    let buf = Buffer.create 100 in
    let info = Args.create_buffer venv pos loc buf in
    let _ =
      try Printf.fprintf info fmt args with
        exn ->
        Args.close info;
        raise exn
    in
    Args.close info;
    Omake_value_type.ValData (Buffer.contents buf)
  | _ ->
    raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 1, List.length args)))

(*
 * \begin{doc}
 * \subsection{Miscellaneous functions}
 * \subsubsection{set-channel-line}
 *
 * \begin{verbatim}
 *     set-channel-line(channel, filename, line)
 *         channel : Channel
 *         filename : File
 *         line : int
 * \end{verbatim}
 *
 * Set the line number information for the channel.
 * \end{doc}
 *)
let set_channel_line_fun venv pos loc args =
  let pos = string_pos "set-channel-line" pos in
  let chan, file, line =
    match args with
      [chan; file; line] ->
      chan, file, line
    | _ ->
      raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 3, List.length args)))
  in
  let chan = Omake_value.channel_of_value venv pos chan in
  let file = Omake_value.string_of_value venv pos file in
  let line = Omake_value.int_of_value venv pos line in
  Lm_channel.set_line chan file line;
  Omake_value_type.ValNone

(************************************************************************
 * Tables.
*)

let () =
   let builtin_vars =
      ["nl",     (fun _ -> Omake_value_type.ValString "\n");
       "stdin",  (fun _ -> ValChannel (InChannel,  Omake_env.venv_stdin));
       "stdout", (fun _ -> ValChannel (OutChannel, Omake_env.venv_stdout));
       "stderr", (fun _ -> ValChannel (OutChannel, Omake_env.venv_stderr))]
   in
   let builtin_funs =
      [true, "open-in-string",        open_in_string,       Omake_ir.ArityExact 1;
       true, "open-out-string",       open_out_string,      ArityExact 0;
       true, "out-contents",          out_contents,         ArityExact 1;
       true, "fopen",                 fopen,                ArityExact 2;
       true, "close",                 close,                ArityExact 1;
       true, "read",                  read,                 ArityExact 2;
       true, "input-line",            input_line,           ArityExact 1;
       true, "write",                 write,                ArityRange (2, 4);
       true, "lseek",                 lseek,                ArityExact 3;
       true, "rewind",                rewind,               ArityExact 1;
       true, "tell",                  tell,                 ArityExact 1;
       true, "flush",                 flush,                ArityExact 1;
       true, "channel-name",          channel_name,         ArityExact 1;
       true, "dup",                   dup,                  ArityExact 1;
       true, "dup2",                  dup2,                 ArityExact 2;
       true, "set-nonblock-mode",     set_nonblock_mode,    ArityExact 2;
       true, "set-close-on-exec",     set_close_on_exec_mode, ArityExact 2;
       true, "pipe",                  pipe,                 ArityExact 0;
       true, "mkfifo",                mkfifo,               ArityExact 2;
       true, "select",                select,               ArityExact 4;
       true, "lockf",                 lockf,                ArityExact 3;
       true, "socket",                socket,               ArityExact 3;
       true, "bind",                  bind,                 ArityRange (2, 3);
       true, "listen",                listen,               ArityExact 2;
       true, "accept",                accept,               ArityExact 1;
       true, "connect",               connect,              ArityExact 1;
       true, "getc",                  getc,                 ArityRange (0, 1);
       true, "gets",                  gets,                 ArityRange (0, 1);
       true, "fgets",                 fgets,                ArityRange (0, 1);
       true, "print",                 print,                ArityExact 1;
       true, "eprint",                eprint,               ArityExact 1;
       true, "fprint",                fprint,               ArityExact 2;
       true, "println",               println,              ArityExact 1;
       true, "eprintln",              eprintln,             ArityExact 1;
       true, "fprintln",              fprintln,             ArityExact 2;
       true, "printv",                printv,               ArityExact 1;
       true, "eprintv",               eprintv,              ArityExact 1;
       true, "fprintv",               fprintv,              ArityExact 2;
       true, "printvln",              printvln,             ArityExact 1;
       true, "eprintvln",             eprintvln,            ArityExact 1;
       true, "fprintvln",             fprintvln,            ArityExact 2;
       true, "printf",                printf_fun,           ArityAny;
       true, "eprintf",               eprintf_fun,          ArityAny;
       true, "fprintf",               fprintf_fun,          ArityAny;
       true, "sprintf",               sprintf_fun,          ArityAny;
       true, "set-channel-line",      set_channel_line_fun, ArityExact 3]
   in
   let builtin_info =
      {Omake_builtin_type. builtin_empty with builtin_vars = builtin_vars;
                           builtin_funs = builtin_funs
      }
   in
      Omake_builtin.register_builtin builtin_info
