Re: [Caml-list] Ask-if-continue wrapper?

[Xavier Leroy <Xavier.Leroy@inria.fr>]

> I'd like an OCaml function, which I'll call continueq, with the property
> that for any function f with argument(s) fargs,
>
> continueq f fargs tsecs defaultval
>
> starts evaluating f on fargs and lets this evaluation proceed for up to
> tsecs seconds. If the computation of (f fargs) completes in this time,
> then it returns the result of that computation. Otherwise, it asks the
> user how many seconds to let the computation of (f fargs) proceed. If
> the user inputs a value less than or equal to 0, then it returns
> defaultval. If the user inputs a value tsecs' greater than 0, then it
> evaluates
>
> continueq f' fargs' tsecs' defaultval
>
> where (f' fargs') denotes the computation state of (f fargs) at the time
> it was interrupted.

The latter ("the computation state of ...") is not something you can
manipulate programmatically in OCaml.  However, there is no need to:
Unix timer signals are sufficient to do what you want.  (If you're on
Windows, there's nothing I can do for you, in this particular instance
and in general.)  See below for the code.

A word of caution: if your function f performs I/O operations, be
prepared for them to fail with a EINTR Unix error.  That's the Unix
(SVR4 / POSIX) way of being unhelpful...

- Xavier Leroy

----------------------------------------------------------------------

let set_timer tsecs =
  ignore (Unix.setitimer Unix.ITIMER_REAL
                         { Unix.it_interval = 0.0; Unix.it_value = tsecs })

exception Timeout

let handle_sigalrm signo =
  print_string "Continue for how long? "; flush stdout;
  let f = read_float() in
  if f <= 0.0
  then raise Timeout
  else set_timer f

let continueq f arg tsecs defaultval =
  let oldsig = Sys.signal Sys.sigalrm (Sys.Signal_handle handle_sigalrm) in
  try
    set_timer tsecs;
    let res = f arg in
    set_timer 0.0;
    Sys.set_signal Sys.sigalrm oldsig;
    res
  with Timeout ->
    Sys.set_signal Sys.sigalrm oldsig;
    defaultval