Defines a simple module for timeoutable computations, with the ability to return arbitrary intermediary results on timeout or the final value otherwise. It also allows default return values.
The implementation uses Unix.sigalrm to define timeout intervals with second resolution. There is a small overhead on starting the computation, because we have to set up signal handlers and only then call the Functor's 'call' method. Similarily, there is a small overhead on returning the computation result (partial or final), as we have to restore the original SIGALRM signal handler. Those should amortize if the actual computation takes some time (seconds) - and this is the context in which you would want to use the Timeout module anyway.
For using this, define your own module respecting the Timeoutable interface. Implement functionality in the call function. If you need to return intermediary results on timeout, catch the CallTimeout exception and return an appropiate value. If the code you write raises and does not catch an exception, the call function will return with the default value. The same thing happens if you don't catch the CallTimeout exception in your code and it timeouts.
exception CallTimeout;; type ('p,'f) result = [ `Timeout of 'p (* partial result *) | `Done of 'f (* final result *) | `Error of string ] module type Timeoutable = sig type ('p,'f) t type arg val default: ('p,'f) t val call: arg -> ('p,'f) t end module Timeout (U:Timeoutable) = struct let sigalrm_handler = Sys.Signal_handle (fun _ -> raise CallTimeout);; let tcall arg timeout = let old_behaviour = Sys.signal Sys.sigalrm sigalrm_handler in let reset_sigalrm () = Sys.set_signal Sys.sigalrm old_behaviour in ignore (Unix.alarm timeout); try let res = U.call arg in reset_sigalrm(); res; with exn -> reset_sigalrm(); U.default; end
module AddTwo = struct type ('p,'f) t = (int,int) Timeout.result type arg = int let default = `Error "could not complete AddTwo" let call a = try ignore(Unix.sleep 2); `Done (a+2) with | Timeout.CallTimeout-> `Timeout (a+1) end module Test = Timeout.Timeout(AddTwo);; let r = Test.tcall 7 10 in match r with | `Done x -> print_int x | `Timeout b -> print_string "Function timeout, partial result: "; print_int b | `Error s -> print_string s
Any ideas on how to improve this? What other features would you require for timeoutable computations?