Source file import.ml

module List = struct
  include ListLabels

  let concat_map l ~f = map l ~f |> concat
end

include (
  StdLabels :
    module type of struct
      include StdLabels
    end
    with module List := StdLabels.List)

include MoreLabels

module SMap = struct
  include Map.Make (String)

  let lookup t key =
    match find t key with
    | x -> Some x
    | exception Not_found -> None
  ;;
end

module SSet = Set.Make (String)
include Shexp_sexp.Std
include Shexp_bigstring_io.Std

external reraise : exn -> _ = "%reraise"

let protectx ~finally ~f x =
  match f x with
  | y ->
    finally x;
    y
  | exception e ->
    finally x;
    reraise e
;;

let sprintf = Printf.sprintf
let ( ^/ ) = Filename.concat

module W : sig
  type 'a t

  val unit : unit t
  val int : int t
  val string : string t
  val process_status : Unix.process_status t
  val fd : Unix.file_descr t
  val stats : Unix.LargeFile.stats t
  val dir_handle : Unix.dir_handle t
  val pair : 'a t -> 'b t -> ('a * 'b) t
end = struct
  type 'a t = unit

  let unit = ()
  let int = ()
  let string = ()
  let process_status = ()
  let fd = ()
  let stats = ()
  let dir_handle = ()
  let pair _ _ = ()
end

(* We require a witness to be sure we apply the function fully *)
let retry_eintr : 'a. 'a W.t -> (unit -> 'a) -> 'a =
  let[@inline always] rec loop f n =
    try f () with
    | Unix.Unix_error (EINTR, _, _) when n < 1000 -> loop f (n + 1)
  in
  fun _ f -> loop f 0
;;

let retry_eintr1 w f x = retry_eintr w (fun () -> f x)
let retry_eintr2 w f x y = retry_eintr w (fun () -> f x y)
let retry_eintr3 w f x y z = retry_eintr w (fun () -> f x y z)

module Unix = struct
  open Unix

  type nonrec file_descr = file_descr
  type nonrec stats = LargeFile.stats
  type nonrec access_permission = access_permission

  exception Unix_error = Unix_error

  let getpid = getpid
  let environment = environment
  let stdin = stdin
  let stdout = stdout
  let stderr = stderr
  let sleepf = sleepf
  let close x = retry_eintr1 W.unit close x
  let openfile x y z = retry_eintr3 W.fd openfile x y z
  let readlink x = retry_eintr1 W.string readlink x
  let mkdir x y = retry_eintr2 W.unit mkdir x y
  let chmod x y = retry_eintr2 W.unit chmod x y
  let chown x y z = retry_eintr3 W.unit chown x y z
  let unlink x = retry_eintr1 W.unit unlink x
  let rmdir x = retry_eintr1 W.unit rmdir x
  let mkfifo x y = retry_eintr2 W.unit mkfifo x y
  let link x y = retry_eintr2 W.unit link x y
  let symlink x y = retry_eintr2 W.unit symlink x y
  let rename x y = retry_eintr2 W.unit rename x y
  let stat x = retry_eintr1 W.stats LargeFile.stat x
  let lstat x = retry_eintr1 W.stats LargeFile.lstat x
  let access x y = retry_eintr2 W.unit access x y
  let readdir x = retry_eintr1 W.string readdir x
  let opendir x = retry_eintr1 W.dir_handle opendir x
  let closedir x = retry_eintr1 W.unit closedir x
  let lseek x y z = retry_eintr3 W.int lseek x y z
  let waitpid x y = retry_eintr2 W.(pair int process_status) waitpid x y
end

module Posixat = struct
  open Posixat
  module Fd = Fd
  module Open_flag = Open_flag
  module At_flag = At_flag
  module Access_permission = Access_permission
  module File_kind = File_kind
  module File_perm = File_perm
  module Stats = Stats

  let at_fdcwd = at_fdcwd
  let has_mkfifoat = has_mkfifoat

  let openat ~dir ~path ~flags ~perm =
    retry_eintr W.fd (fun () -> openat ~dir ~path ~flags ~perm)
  ;;

  let faccessat ~dir ~path ~mode ~flags =
    retry_eintr W.unit (fun () -> faccessat ~dir ~path ~mode ~flags)
  ;;

  let fchmodat ~dir ~path ~perm ~flags =
    retry_eintr W.unit (fun () -> fchmodat ~dir ~path ~perm ~flags)
  ;;

  let fchownat ~dir ~path ~uid ~gid ~flags =
    retry_eintr W.unit (fun () -> fchownat ~dir ~path ~uid ~gid ~flags)
  ;;

  let mkdirat ~dir ~path ~perm = retry_eintr W.unit (fun () -> mkdirat ~dir ~path ~perm)

  let unlinkat ~dir ~path ~flags =
    retry_eintr W.unit (fun () -> unlinkat ~dir ~path ~flags)
  ;;

  let mkfifoat ~dir ~path ~perm = retry_eintr W.unit (fun () -> mkfifoat ~dir ~path ~perm)

  let linkat ~olddir ~oldpath ~newdir ~newpath ~flags =
    retry_eintr W.unit (fun () -> linkat ~olddir ~oldpath ~newdir ~newpath ~flags)
  ;;

  let renameat ~olddir ~oldpath ~newdir ~newpath =
    retry_eintr W.unit (fun () -> renameat ~olddir ~oldpath ~newdir ~newpath)
  ;;

  let symlinkat ~oldpath ~newdir ~newpath =
    retry_eintr W.unit (fun () -> symlinkat ~oldpath ~newdir ~newpath)
  ;;

  let fstatat ~dir ~path ~flags =
    retry_eintr W.stats (fun () -> fstatat ~dir ~path ~flags)
  ;;

  let readlinkat ~dir ~path = retry_eintr W.string (fun () -> readlinkat ~dir ~path)
  let fdopendir fd = retry_eintr1 W.dir_handle fdopendir fd
end