Sébastien Ferré avatar Sébastien Ferré committed 6ea40b6

A number of new commands.

Comments (0)

Files changed (1)

       | None -> mapfind f l
       | Some y -> y
 
+let rec mapfind_right : ('a -> 'b option) -> 'a list -> 'b =
+  fun f -> function
+    | [] -> raise Not_found
+    | x::l ->
+	try mapfind_right f l
+	with Not_found ->
+	  match f x with
+	  | None -> raise Not_found
+	  | Some y -> y
+
 let rec fold_while : ('a -> 'a option) -> 'a -> 'a =
   fun f e ->
     match f e with
 
 let utime () : float = (Unix.times ()).Unix.tms_utime (* in seconds *)
 
+let chrono (f : unit -> 'a) : float * 'a =
+  let t1 = utime () in
+  let res = f () in
+  let t2 = utime () in
+  t2 -. t1, res
+
+
 (* for profiling *)
 
 let tbl_prof : (string,(int * float * float)) Hashtbl.t = Hashtbl.create 100
 let prof : string -> (unit -> 'a) -> 'a =
   fun s f -> (* f () *)
 (* print_string ("<"^s^":"); flush stdout; *)
-    let t1 = (Unix.times ()).Unix.tms_utime in
     let m1 = Gc.allocated_bytes () (* float_of_int (Gc.stat ()).Gc.live_words *) in
-    let y = f () in
-    let t2 = (Unix.times ()).Unix.tms_utime in
+    let d, y = chrono f in
     let m2 = Gc.allocated_bytes () (* float_of_int (Gc.stat ()).Gc.live_words *) in
     let n, t, m = try Hashtbl.find tbl_prof s with Not_found -> 0, 0., 0. in
-    Hashtbl.replace tbl_prof s (n+1, t +. (t2 -. t1), m +. (m2 -. m1));
+    Hashtbl.replace tbl_prof s (n+1, t +. d, m +. (m2 -. m1));
 (* print_string (s^">\n"); flush stdout; *)
     y
 
 
 (* safe rewrite of a file *)
 let safe_file_update path f =
-  let path_new = path ^ ".new" in
-  f path_new;
+  let path_tmp = Filename.concat (Filename.dirname path) ("tmp_" ^ Filename.basename path) in
+  f path_tmp;
   (try Sys.remove path with _ -> ());
-  Sys.rename path_new path
+  Sys.rename path_tmp path
+
+(*
+let pipe_command (cmd : string) (f : in_channel -> 'a) : 'a =
+  let path = Filename.temp_file "cmd" ".txt" in
+  let code = Sys.command (cmd ^ " > " ^ path) in
+  if code <> 0
+  then raise (Sys_error ("error while executing: " ^ cmd))
+  else begin
+    let ch = open_in path in
+    let res = f ch in
+    close_in ch;
+    Sys.remove path;
+    res
+  end
+*)
+
+let pipe_command (cmd : string) (f : in_channel -> 'a) : 'a =
+  let ch = Unix.open_process_in cmd in
+  let res = f ch in
+  let status = Unix.close_process_in ch in
+  if status = Unix.WEXITED 0
+  then res
+  else raise (Sys_error ("Common.pipe_command: error while executing: " ^ cmd))
 
 (* probabilities *)
 
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.