Given a function f : t1 -> t2 , is there a way to write a function compute_f_in_a_hurry : t1 -> float -> t2 that uses f, such that compute_f_in_a_hurry x time_limit computes f x in time_limit units of time if possible, or raises an exception if the computation takes too long ?
I guess one needs the Unix module for that, especially Unix.time
1 Like
With Lwt it’s easy to do that:
let compute ~time ~f =
Lwt.pick [ f () >|= fun v -> `Done v
; Lwt_unix.sleep time >|= fun () -> `Timeout ]
This code will return Timeout if our computation was not yet done . Otherwise, it returns your result.
3 Likes
Thanks ! I don’t know much about the implementation of Lwt, and I wonder if all the heavy machinery of the Lwt library is needed here, or if one can get an equivalent functionality by rewriting a small part of it
As far as I know, there’s no way to bypass the blocking nature of OCaml functions (e.g. to register callbacks with the OCaml runtime). edit: TIL, not true! See below for a solution with SIGALRM
Lwt gets around the problem by having threads be cooperative. If the thread that you’re timing is insufficiently cooperative, even Lwt will not save you. e.g. following on from @dinosaure’s example:
let compute ~time ~f =
Lwt.pick [ f () >|= fun v -> `Done v
; Lwt_unix.sleep time >|= fun () -> `Timeout ]
|> Lwt_main.run
|> ignore
let () =
compute ~time:1. ~f:(fun () ->
let () = Unix.sleepf 3. in
Printf.printf "Foo%!";
Lwt.return_unit)
(* Still prints "Foo", since the thread being timed never yields *)
Using Lwt_unix.sleep, the `Timeout will occur properly since that function yields appropriately. So if you want to do something like getting “equivalent functionality by rewriting a small part of it”, you need to change your function type:
type ('a, 'b) cooperative_f = yield:(unit -> unit) -> 'a -> 'b
let compute_cooperative ~duration ~f =
let exception Timeout in
let initial_time = Unix.time () in
let yield () =
if (Unix.time () -. initial_time) >= duration then raise Timeout
in
f ~yield
If f calls yield every x seconds, the timeout will happen at t = duration + x at the latest. Naturally this doesn’t avoid the problem that f might not be cooperative at all 
See for instance: Today's trick : memory limits with Gc alarms (@zozozo’s comment)
2 Likes
Note that there is one downside with my solution which is that it doesn’t work on windows because timer are not implemented; similarly, other backends such as js_of_ocaml, do not implement the timers, so while it works quite well on unix systems, it’s not very portable sadly.
This uses asynchronous exceptions. There are caveats associated with them, essentially making sure that the state of the world does not end up corrupted. Presumably a similar issue exists with Lwt.pick.
If I got you correctly, suppose the initial code for my $f$ was : let f args = let blahblah1=... in let blahblah2=... in let blahblah3=... in ...
Then, the adhoc modification I should make to $f$ sould be let cooperative_f yield args = let blahblah1=... in let _=yield() in let blahblah2=... in let _=yield() in let blahblah3=... in ...
Now, the context where I needed that kind of stuff was the debugging of an incorrect recursion that produced an infinite loop without raising any exception. In this context, using your method I would need to rewrite the dozens of functions involved in a “cooperative” way, which wouldn’t be simpler than the sledgehammer method of following the computation step by step till the bad recursion is located (which is what I did)
I have this version that uses Unix signals.
exception Timeout
let delayed_fun f x timeout =
let _ =
Sys.set_signal Sys.sigalrm (Sys.Signal_handle (fun _ -> raise Timeout))
in
ignore (Unix.alarm timeout);
try
let r = f x in
ignore (Unix.alarm 0); r
with
| e -> ignore (Unix.alarm 0); raise e
4 Likes
I’m curious whether multiple threads can use this delayed_fun concurrently. Based on my limited understanding of signal handling, it happens at the process level, and usually the current executing thread will be used to execute the signal handler. reference
Do you mean OCaml system threads specifically?
Lwt is great and all, but it really deals with orchestrating and chaining many short computations. It won’t let you interrupt an arbitrary computation. Something like while true do () done will keep going till the end of times, while the elapsed timer and other lwt tasks kindly wait for their turn.
1 Like
That’s precisely the issue I ran into.
And to @gadmm: I don’t know enough about OCaml’s thread system but I’d like to be able to use the delayed_fun above concurrently (say in different client handler on a server). My hunch is that signal is at process level so this wouldn’t work out?
So with Lwt specifically?
I’m actually just using the Thread module.
My understanding is that if I use Lwt for all the timeout operations I’m trying to do (e.g., accept client socket, read from it, etc.), then it all works out. But using Lwt seems to require major refactoring of my existing codebase so I’d like to avoid that if possible.
It’s probably worth mentioning for the benefit of the inquirer that the kind of long cpu-intensive computations to which you refer can be made consistent with Lwt’s event loop model by using Lwt_preemptive.detach. That function executes the cpu-intensive computation in a separate system thread from the Lwt thread pool, upon the conclusion of which it will fulfil its associated promise and execute its continuation in the event loop thread in the normal Lwt way.
I have found it works OK: somewhat similar to OS X’s grand central dispatch, except of course for the problems of the global ocaml lock. Edit: I believe I read in a recent article here that when multicore becomes available, Lwt_preemptive.detach will be one way of accessing multiple cores.
1 Like
I just discovered that this method doesn’t seem to work for the following f if we compile to native code, i.e., it gets stuck.
let rec f () = f ();;
As far as system threads are concerned, the semantics of signals tries to mimic POSIX. The thread that receives the signal is chosen among the ones that do not mask the signal (see Thread.sigmask). Not terribly useful to cancel several threads on different timeouts.
A certain other language allows the cancellation of a chosen thread from any other thread by causing an an exception to arise at a distance. This would allow to implement timeouts for any number of threads from a controlling thread. Cancellation is not implemented with systhreads, although it does not seem to cause any more difficulty than the kind of asynchronous exceptions discussed in this topic.
Another option is if we had a way of executing a callback at regular intervals inside each thread and run a check there (and be able to raise an exception if we wished to interrupt the thread). This is essentially how memprof-limits works, which I wrote to show that with the new Memprof feature it is possible to implement allocation limits, a feature from a certain other language that addresses a use-case similar to yours (but which counts allocations as a measure of work done, rather than time elapsed). This is still experimental but I would like to publish a usable version soon.
In the absence of thread cancellation, this could be used to check for time elapsed or any other condition, but you need the additonal assumption that the threads allocate enough to trigger memprof callbacks (in contrast with the problem of memory limits which is similar to memory profiling).
1 Like
This is catch_break does not always catch break · Issue #3747 · ocaml/ocaml · GitHub. A workaround is to insert a dummy allocation to force a check for signals.
let rec f () =
let _ = Sys.opaque_identity (ref 0) in
f ()
1 Like
Just to check my understanding. So right now there is no general way to handle multiple system threads with different timeout?