Newer
Older
(* Time-stamp: <modified the 20/05/2016 (at 08:47) by erwan> *)
(* Should rather be names misc or utils *)
Erwan Jahier
committed
(* [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);
Erwan Jahier
committed
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");
Erwan Jahier
committed
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
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 =
Erwan Jahier
committed
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")
Erwan Jahier
committed
(* for one-line comments *)
let entete comment version sha = entete2 comment "" version sha
Erwan Jahier
committed
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
(****************************************************************************)
(* 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)