(* Time-stamp: <modified the 20/05/2016 (at 08:47) by erwan> *)
(* Should rather be names misc or utils *)
(* [string_to_string_list str] returns the list of substrings of
[str] that are separated by blanks. *)
let (string_to_string_list : string -> string list) =
fun str ->
Str.split (Str.regexp "[ \t]+") str
(* Cloned from the OCaml stdlib Arg module: I want it on stdout! (scrogneugneu) *)
let usage_out speclist errmsg =
Printf.printf "%s" (Arg.usage_string speclist errmsg)
let (readfile: ?verbose:bool ->string -> string) =
fun ?(verbose=false) file ->
if verbose then (Printf.eprintf "Reading %s...\n" file; flush stderr);
try
let rec (readfile_ic : in_channel -> string) =
fun ic ->
let ic_l = in_channel_length ic in
let str_buf = String.make ic_l ' ' in
let _ = really_input ic str_buf 0 ic_l in
str_buf
in
let ic = (open_in file) in
let str = readfile_ic ic in
close_in ic;
str
with
e ->
print_string ((Printexc.to_string e) ^ ": ");
output_string stdout ("Error when reading " ^file^ ".\n");
flush stdout;
raise Not_found
let mygetenv x =
let x =
match Sys.os_type with
| "Win32" -> (x^"_DOS")
| _ -> x
in
try Unix.getenv x
with Not_found -> x^" env var not defined"
(****************************************************************************)
(* a few list utils *)
let rec (list_split7: ('a * 'b * 'c * 'd * 'e * 'f * 'g) list ->
'a list * 'b list * 'c list * 'd list * 'e list * 'f list * 'g list) =
function
| [] -> ([], [], [], [], [], [], [])
| (x,y,z,t,u,v,w)::l ->
let (rx, ry, rz, rt, ru, rv, rw) =
list_split7 l in (x::rx, y::ry, z::rz, t::rt, u::ru, v::rv, w::rw)
(* returns a \ b *)
let list_minus a b = List.filter (fun v -> not (List.mem v b)) a
(* returns a U b *)
let list_union a b = List.fold_left (fun acc x -> if (List.mem x acc) then acc else x::acc) a b
(** Removes duplicates from a list (conserving its order) *)
let (list_rm_dup : 'a list -> 'a list) =
fun list ->
let rec aux acc list =
match list with
| [] -> List.rev acc
| elt::tail ->
if List.mem elt acc then aux acc tail
else aux (elt::acc) tail
in
aux [] list
(****************************************************************************)
(** Map of strings *)
module StringMap = struct
include Map.Make(struct type t = string let compare = compare end)
end
(****************************************************************************)
(** I define my own version of print_float to turn around a bug of
sim2chro where it does not understand floats with no digit (e.g.,
4. instead of 4.0)
*)
(* format_float is not exported in Pervasives.mli.
nb: its name changed in ocaml version 3.08 (was "format_float") *)
external format_float: string -> float -> string = "caml_format_float"
let my_string_of_float f p = format_float ("%." ^ (string_of_int p) ^ "f") f
let my_print_float f p = output_string stdout (my_string_of_float f p)
let overflow_msg str =
Printf.eprintf "Fail to convert into an int the string '%s'.\n" str;
flush stderr
let int_of_num n =
try Num.int_of_num n
with _ ->
let str = Num.string_of_num n in
let msg = Printf.sprintf "Fail to convert into an int the num '%s'.\n" str in
overflow_msg msg;
exit 2
(* for language that does have one-line comments *)
let entete2 comment_open comment_close version sha =
let time = Unix.localtime (Unix.time ()) in
let date = (
(string_of_int time.Unix.tm_mday) ^ "/" ^
(string_of_int (time.Unix.tm_mon+1)) ^ "/" ^
(string_of_int (1900+time.Unix.tm_year))
)
and time_str = (
(string_of_int time.Unix.tm_hour) ^ ":" ^
(if time.Unix.tm_min < 10 then "0" else "") ^
(string_of_int time.Unix.tm_min) ^ ":" ^
(if time.Unix.tm_sec < 10 then "0" else "") ^
(string_of_int time.Unix.tm_sec)
)
and hostname = Unix.gethostname ()
in
(comment_open ^ " Automatically generated by "^
Sys.executable_name^" version \""^version^"\" (\"" ^sha^"\")"^comment_close^"\n" ^
comment_open ^ " on " ^ hostname ^
" the " ^ date ^ " at " ^ time_str ^comment_close^"\n" ^
comment_open^(String.concat " " (Array.to_list Sys.argv))^ comment_close^"\n\n")
(* for one-line comments *)
let entete comment version sha = entete2 comment "" version sha
(****************************************************************************)
(* use to perform system calls *)
type my_create_process_result =
OK
| KO
| PID of int (* if called with ~wait:false *)
let (my_create_process : ?std_in:(Unix.file_descr) -> ?std_out:(Unix.file_descr) ->
?std_err:(Unix.file_descr) ->
?wait:(bool) -> string -> string list -> my_create_process_result) =
fun ?(std_in = Unix.stdin) ?(std_out = Unix.stdout) ?(std_err = Unix.stderr)
?(wait = true) prog args ->
try
let pid =
List.iter (fun x -> output_string stderr (x ^ " ")) (prog::args);
output_string stderr "\n";
flush stderr;
Unix.create_process
prog
(Array.of_list (prog::args))
(std_in)
(std_out)
(std_err)
in
if not wait then PID pid else
let (_,status) = (Unix.waitpid [Unix.WUNTRACED] pid) in
( match status with
Unix.WEXITED i ->
if i = 0 || i = 1 then
(
output_string stderr (" ... " ^ prog ^ " exited normally.\n");
flush stderr;
OK
)
else
(
output_string stderr (
"*** Error: " ^ prog ^ " exited abnormally (return code=" ^
(string_of_int i)^").\n");
flush stderr;
KO
)
| Unix.WSIGNALED i->
output_string stderr (
"*** Error: " ^ prog ^
" process was killed by signal "^(string_of_int i)^"\n");
flush stderr;
KO
| Unix.WSTOPPED i ->
output_string stderr (
"*** Error: " ^ prog ^ " process was stopped by signal " ^
(string_of_int i)^"\n");
flush stderr;
KO
)
with
| Unix.Unix_error(error, name, arg) ->
let msg = ( "*** '" ^
(Unix.error_message error) ^
"'in the system call: '" ^ name ^ " " ^ arg ^ "'\n")
in
output_string stdout msg;
flush stdout;
output_string stderr msg;
flush stderr;
KO
| e ->
output_string stdout (Printexc.to_string e);
flush stdout;
output_string stderr (Printexc.to_string e);
flush stderr;
KO
(* run a cmd and collect the stdout lines into a list (requires sed) *)
let (run : string -> (string -> string option) -> string list) =
fun cmd filter ->
let proc = Unix.open_process_in ("(" ^ cmd ^ " | sed -e 's/^/stdout: /' ) 2>&1") in
let list = ref [] in
try
while true do
let line = input_line proc in
if String.length line >= 8 && String.sub line 0 8 = "stdout: " then
let str = String.sub line 8 (String.length line - 8) in
match filter str with
| None -> ()
| Some str -> list := str::!list
done;
[]
with End_of_file ->
ignore (Unix.close_process_in proc);
List.rev !list
let ls path ext = run ("ls "^path^"*."^ext) (fun s -> Some s)