Set a timer for a function

Question

I have defined a list of values: data : int list and a function f: int -> unit, and a piece of code:

for i = 0 to (List.length data) - 1 do
  let d = List.nth data i in
  f d
done

Now, I would like to set a maximal running time for f. For instance, if f d exceeds a certain time maximal, the execution of f d stops, and we carry on with the next element of data.

Does anyone know how to do it?

Update1:

Following the comments, I would like to add that, the application of f to a good part of elements of data will end up by raising an exception. This is normal and accepted. So the code looks like:

List.iter
  (fun d ->
     try
       (f d)
     with
     | e ->
       printf "%s\n" (Printexc.to_string e))
data

Answer 1

Something like this might work for you:

exception Timeout

let run_with_timeout t f x =
    try
        Sys.set_signal Sys.sigalrm (Sys.Signal_handle (fun _ -> raise Timeout));
        ignore (Unix.alarm t);
        f x;
        ignore (Unix.alarm 0);
        Sys.set_signal Sys.sigalrm Sys.Signal_default
    with Timeout -> Sys.set_signal Sys.sigalrm Sys.Signal_default

Here's a session that shows how it works:

$ ocaml
        OCaml version 4.00.1

# #load "unix.cma";;
# #use "rwt.ml";;
exception Timeout
val run_with_timeout : int -> ('a -> 'b) -> 'a -> unit = <fun>
# run_with_timeout 2 Printf.printf "yes\n";;
yes
- : unit = ()
# run_with_timeout 2 (fun () -> while true do () done) ();;
- : unit = ()
#

Your code would be something like this:

List.iter (run_with_timeout 10 f) data

(This code hasn't been thorougly tested but it shows a way that might work.)

Update

As the comments have shown, this code isn't suitable if f x might throw an exception (or if you're using alarms for some other purpose). I encourage gsg to post his/her improved solution. The edit seems to have been rejected.

Answer 2

This is based on Jeffrey's answer, with some modifications to improve exception safety:

exception Timeout

let run_with_timeout timeout f x =
  let old_handler = Sys.signal Sys.sigalrm
    (Sys.Signal_handle (fun _ -> raise Timeout)) in
  let finish () =
    ignore (Unix.alarm 0);
    ignore (Sys.signal Sys.sigalrm old_handler) in
  try
    ignore (Unix.alarm timeout);
    ignore (f x);
    finish ()
  with Timeout -> finish ()
   | exn -> finish (); raise exn