type error =
  | FORK   	(* fork failed due to lack of memory *)
  | READ   	(* read or select on pipes failed *)
  | CHDIR  	(* changing to working dir failed *)
  | ACCES  	(* execv() returned EACCES *)
  | PERM   	(* execv() returned EPERM *)
  | TOOBIG   	(* execv() returned E2BIG *)
  | NOEXEC 	(* execv() returned ENOEXEC *)
  | NAMETOOLONG (* ""  "" ENAMETOOLONG *)
  | NOENT       (* ""  "" ENOENT *)
  | NOMEM       (* ""  "" ENOMEM *)
  | NOTDIR      (* ""  "" ENOTDIR *)
  | LOOP        (* ""  "" ELOOP   *)
  | TXTBUSY     (* ""  "" ETXTBUSY *)
  | IO          (* ""  "" EIO *)
  | NFILE       (* ""  "" ENFILE *)
  | MFILE       (* ""  "" EMFLE *)
  | INVAL       (* ""  "" EINVAL *)
  | ISDIR       (* ""  "" EISDIR *)
  | LIBBAD      (* ""  "" ELIBBAD *)
  | FAILED      (* other fatal failure *)

exception Error of error * string
external _init : unit -> unit = "ml_g_spawn_init"
let init = 
  Callback.register_exception "g_spawn_error" (Error (FAILED, "")) ;
  _init ()

type real_spawn_flags =
  [ `LEAVE_DESCRIPTORS_OPEN
  | `DO_NOT_REAP_CHILD
  | `SEARCH_PATH
  | `STDOUT_TO_DEV_NULL
  | `STDERR_TO_DEV_NULL
  | `CHILD_INHERITS_STDIN
  | `FILE_AND_ARGV_ZERO ]
type spawn_flags =
  [ real_spawn_flags
  | `PIPE_STDIN
  | `PIPE_STDOUT
  | `PIPE_STDERR ]

type pid
type child = {
    pid             : pid option ;
    standard_input  : int option ;
    standard_output : int option ;
    standard_error  : int option
  }
external int_of_pid : pid -> int = "ml_int_of_pid"

external _async_with_pipes :
  ?working_directory:string ->
  ?environment:string list  ->
  ?child_setup:(unit -> unit) ->
  flags:spawn_flags list ->
  pipes:int ->
  string list -> child = "ml_g_spawn_async_with_pipes_bc" "ml_g_spawn_async_with_pipes"
let async_with_pipes ?working_directory ?environment ?child_setup ~flags args =
  let rec conv_flags acc pipes = function
    | `PIPE_STDIN  :: l -> conv_flags acc (pipes lor 0x1) l
    | `PIPE_STDOUT :: l -> conv_flags acc (pipes lor 0x2) l
    | `PIPE_STDERR :: l -> conv_flags acc (pipes lor 0x4) l
    | (#real_spawn_flags as f) :: l -> conv_flags (f :: acc) pipes l
    | [] -> acc, pipes in
  let flags, pipes = conv_flags [] 0 flags in
  _async_with_pipes ?working_directory ?environment ?child_setup ~flags ~pipes args

external close_pid : pid -> unit = "ml_g_spawn_close_pid"

type status =
  | EXITSTATUS of int
  | TERMSIG of int
  | STOPSIG of int

external sync :
  ?working_directory:string ->
  ?environment:string list  ->
  ?child_setup:(unit -> unit) ->
  flags:spawn_flags list ->
  string list -> status * string * string = "ml_g_spawn_sync"

external command_line_sync :
  string -> status * string * string = "ml_g_spawn_command_line_sync"
external command_line_async : string -> unit = "ml_g_spawn_command_line_async"

type source_id
external add_child_watch : ?prio:int -> pid -> (int -> unit) -> source_id = "ml_g_add_child_watch_full"
external remove_watch : source_id -> unit = "ml_g_source_remove"