139 lines
3.6 KiB
OCaml
139 lines
3.6 KiB
OCaml
type filename = string
|
|
type command = string
|
|
|
|
let has_suffix suffix name =
|
|
Filename.check_suffix name suffix
|
|
|
|
let fail format =
|
|
Printf.kprintf failwith format
|
|
|
|
let try_finally f h =
|
|
let result = try f() with e -> h(); raise e in
|
|
h(); result
|
|
|
|
let with_process_code_result command (f : in_channel -> 'a) : int * 'a =
|
|
let ic = Unix.open_process_in command in
|
|
set_binary_mode_in ic false;
|
|
match f ic with
|
|
| exception e ->
|
|
ignore (Unix.close_process_in ic); raise e
|
|
| result ->
|
|
match Unix.close_process_in ic with
|
|
| Unix.WEXITED code ->
|
|
code, result
|
|
| Unix.WSIGNALED _
|
|
| Unix.WSTOPPED _ ->
|
|
99 (* arbitrary *), result
|
|
|
|
let with_process_result command (f : in_channel -> 'a) : 'a =
|
|
let code, result = with_process_code_result command f in
|
|
if code = 0 then
|
|
result
|
|
else
|
|
fail "Command %S failed with exit code %d." command code
|
|
|
|
let with_open_in filename (f : in_channel -> 'a) : 'a =
|
|
let ic = open_in filename in
|
|
try_finally
|
|
(fun () -> f ic)
|
|
(fun () -> close_in_noerr ic)
|
|
|
|
let with_open_out filename (f : out_channel -> 'a) : 'a =
|
|
let oc = open_out filename in
|
|
try_finally
|
|
(fun () -> f oc)
|
|
(fun () -> close_out_noerr oc)
|
|
|
|
let chunk_size =
|
|
16384
|
|
|
|
let exhaust (ic : in_channel) : string =
|
|
let buffer = Buffer.create chunk_size in
|
|
let chunk = Bytes.create chunk_size in
|
|
let rec loop () =
|
|
let length = input ic chunk 0 chunk_size in
|
|
if length = 0 then
|
|
Buffer.contents buffer
|
|
else begin
|
|
Buffer.add_subbytes buffer chunk 0 length;
|
|
loop()
|
|
end
|
|
in
|
|
loop()
|
|
|
|
let read_whole_file filename =
|
|
with_open_in filename exhaust
|
|
|
|
let absolute_directory (path : string) : string =
|
|
try
|
|
let pwd = Sys.getcwd() in
|
|
Sys.chdir path;
|
|
let result = Sys.getcwd() in
|
|
Sys.chdir pwd;
|
|
result
|
|
with Sys_error _ ->
|
|
Printf.fprintf stderr "Error: the directory %s does not seem to exist.\n" path;
|
|
exit 1
|
|
|
|
let get_number_of_cores () =
|
|
try match Sys.os_type with
|
|
| "Win32" ->
|
|
int_of_string (Sys.getenv "NUMBER_OF_PROCESSORS")
|
|
| _ ->
|
|
with_process_result "getconf _NPROCESSORS_ONLN" (fun ic ->
|
|
let ib = Scanf.Scanning.from_channel ic in
|
|
Scanf.bscanf ib "%d" (fun n -> n)
|
|
)
|
|
with
|
|
| Not_found
|
|
| Sys_error _
|
|
| Failure _
|
|
| Scanf.Scan_failure _
|
|
| End_of_file
|
|
| Unix.Unix_error _ ->
|
|
1
|
|
|
|
let silent command : command =
|
|
command ^ " >/dev/null 2>/dev/null"
|
|
|
|
(* [groups eq xs] segments the list [xs] into a list of groups, where several
|
|
consecutive elements belong in the same group if they are equivalent in the
|
|
sense of the function [eq]. *)
|
|
|
|
(* The auxiliary function [groups1] deals with the case where we have an open
|
|
group [group] of which [x] is a member. The auxiliary function [group0]
|
|
deals with the case where we have no open group. [groups] is the list of
|
|
closed groups found so far, and [ys] is the list of elements that remain to
|
|
be examined. *)
|
|
|
|
let rec groups1 eq groups x group ys =
|
|
match ys with
|
|
| [] ->
|
|
group :: groups
|
|
| y :: ys ->
|
|
if eq x y then
|
|
groups1 eq groups x (y :: group) ys
|
|
else
|
|
groups0 eq (List.rev group :: groups) (y :: ys)
|
|
|
|
and groups0 eq groups ys =
|
|
match ys with
|
|
| [] ->
|
|
groups
|
|
| y :: ys ->
|
|
groups1 eq groups y [y] ys
|
|
|
|
let groups eq (xs : 'a list) : 'a list list =
|
|
List.rev (groups0 eq [] xs)
|
|
|
|
(* [sep ss] separates the nonempty strings in the list [ss] with a space,
|
|
and concatenates everything, producing a single string. *)
|
|
|
|
let sep (ss : string list) : string =
|
|
let ss = List.filter (fun s -> String.length s > 0) ss in
|
|
match ss with
|
|
| [] ->
|
|
""
|
|
| s :: ss ->
|
|
List.fold_left (fun s1 s2 -> s1 ^ " " ^ s2) s ss
|