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
Using it:
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?