15
\$\begingroup\$

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?

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.