[
Home
]
[ Index:
by date
|
by threads
]
[ Message by date: previous | next ] [ Message in thread: previous | next ] [ Thread: previous | next ]
[ Message by date: previous | next ] [ Message in thread: previous | next ] [ Thread: previous | next ]
| Date: | -- (:) |
| From: | Xavier Leroy <Xavier.Leroy@i...> |
| Subject: | Re: [Caml-list] Ask-if-continue wrapper? |
> 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