I want to make a function which can make a pause less then 1 sec.
So I have made this function :
let pause(n:float)=
Unix.select [] [] [] n
;;
And I use it like this :
ignore(pause(0.1));
And the top level return me this error :
Exception: Unix.Unix_error (Unix.EINTR, "select", "").
What should I do ?
P.S. I have also tried with Thread.delay but I have same error.
This means a signal was sent to your program during the call to select.
Assuming you are using OCaml 4.03 or higher, you can use the Unix.sleepf function which does exactly what you expect:
# Unix.sleepf;;
- : float -> unit = <fun>
On older versions of OCaml, you can use the setitimer function, which will require some signal handling:
exception Alarm
let () = Sys.set_signal Sys.sigalrm ( Sys.Signal_handle (fun _ -> raise Alarm) )
let pause f =
let _ = Unix.setitimer Unix.ITIMER_REAL
{ Unix.it_interval = 0.; Unix.it_value = f; } in
try Unix.sleep (int_of_float (ceil f)) with
| Alarm -> ()
Note that this is not really thread safe and would conflict with other uses of SIGALRM. I strongly suggest you switch to the most recent version of OCaml.
Related
I am attempting to implement a basic 'stress testing' program in MLton and its Concurrent ML implementation, specifically the Monte Carlo Pi test described here. While I think I have most of what I need figured out, I have a problem in that my program always terminates before the CML threads have finished their work. I know that they are doing something, since I sometimes see them print text to the console that I have directed should be printed, but there seems to be a race condition between them getting started and running, and the program as a whole exiting.
The code where I start CML is:
local
val iterations : int = 10
val num_threads : int = 1
val still_going : bool ref = ref true
in
val _ = (RunCML.doit ((experiment iterations num_threads still_going), NONE);
(* while !still_going do (); (* Spin-wait for the CML stuff to finish. This doesn't work... *) *)
print "All done!\n")
end
the contents of the experiment function are:
fun experiment (iterations : int) (num_threads : int) (still_going : bool ref) () : unit = let
val iters_per_thread : int = iterations div num_threads
val return_ivars = Vector.tabulate (num_threads, (fn _ => SyncVar.iVar()))
val _ = Vector.map (fn return_ivar => CML.spawn (montecarlopi iters_per_thread return_ivar)) return_ivars
val return_val = Vector.foldl (fn (elem, acc) => acc + (SyncVar.iGet elem)) 0.0 return_ivars
in
(TextIO.print ("Result is: " ^ (Real.toString return_val) ^ "\n");
still_going := false)
end
and finally, the montecarlopi function is:
fun montecarlopi (iterations : int) (return_ivar : real SyncVar.ivar) () = let
val _ = MLton.Random.srand (valOf (MLton.Random.useed ()))
fun helper accumulator 0 = accumulator
| helper accumulator iteration = let
val x : real = wordToBoundedReal (MLton.Random.rand ())
val y : real = wordToBoundedReal (MLton.Random.rand ())
val in_target = (x * x) + (y * y)
val next_iter = iteration - 1
val _ = TextIO.print ("next_iter is: " ^ (Int.toString next_iter) ^ ", in_target is: " ^ (Real.toString in_target) ^ ",x is: " ^ (Real.toString x) ^ ",y is: " ^ (Real.toString y) ^ "\n")
in
if in_target < 1.0 then
helper (accumulator + 1) next_iter
else
helper accumulator next_iter
end
in
SyncVar.iPut (return_ivar, (4.0 * ((real (helper 0 iterations)) / (real iterations))))
end
(The full (small) program and accompanying .mlb file can be viewed here). I'm reasonably sure that the bits inside the RunCML.doit function call do what they're supposed to, which leads me to think that the issue is probably to do with the outermost part of the program.
As you can see, I tried to spin wait, using a ref cell on a boolean to determine when to stop, but that doesn't seem to work. Nor does trying to spin wait using RunCML.isRunning - although both of those sound like terrible ideas to begin with, really, anyway. Of course, I can't use something like a CML channel or syncvar, since those need to be inside the RunCML.doit segment to be used. Changing the number of threads doesn't make any difference to this problem. Nor was I able to find any other functions that would make the main part go into a non-blocking wait.
How do I get the outer part of my program to wait until the bulk of it, inside the RunCML.doit function call, completes? Or, am I doing something wrong inside that part, which is causing the problem?
If we look at the the function RunCML.doit, It has type OS.Process.status which can either be success or failure, from which your call to doit is returning failure. There is a CML function shutdown: OS.Process.status -> 'a.
Which could be an explaination for why it's failing, except you don't call shutdown, and parts of your output results never print.
Here is a small example exercising various mechanisms for CML's shutdown, where CML seems to be doing something such as 'graceful' internally. Catching exceptions raised and turning those into failure.
structure Main = struct
open CML
structure RunCML = RunCML;
exception ohno
fun raises() = raise ohno
fun succeed() = RunCML.shutdown(OS.Process.success)
fun fail() = RunCML.shutdown(OS.Process.failure)
fun graceful f () =
let val () = f() handle _ => RunCML.shutdown(OS.Process.failure);
in RunCML.shutdown(OS.Process.success)
end
fun print_status status =
if OS.Process.isSuccess status
then TextIO.print("success\n")
else TextIO.print("failure\n")
fun main() = let
val _ = TextIO.print(banner ^ "\n");
val _ = print_status(RunCML.doit(succeed, NONE))
val _ = print_status(RunCML.doit(fail, NONE))
val _ = print_status(RunCML.doit(raises, NONE))
val _ = print_status(RunCML.doit(graceful(raises), NONE))
val _ = print_status(RunCML.doit(graceful(succeed), NONE))
in OS.Process.success end
end
So, if CML is exiting strangely, and you aren't calling shutdown yourself, its a good chance there is an exception being raised somewhere, which turned out to be the case.
One way to avoid this silent handling of exceptions might in the future might be adding something like:
fun noisy f () =
let val () = f()
handle e =>
let val () = TextIO.print ("Exception: " ^ (exnName e)
^ " Message: " ^ (exnMessage e) ^ "\n")
in RunCML.shutdown(OS.Process.failure) end
in RunCML.shutdown(OS.Process.success)
end
then calling RunCML.doit(noisy(f), NONE)
P.S. Thank you for including a link to your code, it would have been much harder to understand the problem otherwise.
I have the following code block which I modified from the mirageOS github repo:
open Lwt.Infix
module Main (KV: Mirage_kv.RO) = struct
let start kv =
let read_from_file kv =
KV.get kv (Mirage_kv.Key.v "secret") >|= function
| Error e ->
Logs.warn (fun f -> f "Could not compare the secret against a known constant: %a"
KV.pp_error e)
| Ok stored_secret ->
Logs.info (fun f -> f "Data -> %a" Format.pp_print_string stored_secret);
in
read_from_file kv
end
This code reads data from a file called "secret" and outputs it once. I want to read the file and output from it constantly with sleep in between.
The usage case is this: While this program is running I will update the secret file with other processes, so I want to see the change in the output.
What I tried ?
I tried to put the last statement in while loop with
in
while true do
read_from_file kv
done
But It gives the error This expression has type unit Lwt.t but an expression was expected of type unit because it is in the body of a while loop.
I just know that lwt is a threading library but I'm not a ocaml developer and don't try to be one, (I'm interested in MirageOS) , so I can't find the functional syntax to write it.
You need to write the loop as a function. e.g.
let rec loop () =
read_from_file kv >>= fun () ->
(* wait here? *)
loop ()
in
loop ()
I'm writing code to monitor the content of a file. When the program reaches the end of the the file I want it to terminate cleanly.
let log () : input_channel Lwt.t =
openfile "log" [O_RDONLY] 0 >>= fun fd ->
Lwt.return (of_fd input fd);;
let rec loop (ic: input_channel) = Lwt_io.read_line ic >>= fun text ->
Lwt_io.printl text >>= fun _ -> loop ic;;
let monitor () : unit Lwt.t = log () >>= loop;;
let handler : exn -> unit Lwt.t = fun e -> match e with
| End_of_file -> let (p: unit Lwt.t), r = Lwt.wait() in p
| x -> Lwt.fail x;;
let main () : unit Lwt.t = Lwt.catch monitor handler;;
let _ = Lwt_main.run (main ());;
However, when reading a file and reaching the end, the program does not terminate, it just hangs and I have to escape with Ctrl+c. I am not sure what is going on under the hood with bind but I figured whatever it's doing, eventually Lwt_io.readline ic should eventually hit the end of the file and return an End_of_file exception, which presumably would get passed over to the handler, etc.
If I had to guess at a resolution, I would think maybe in the last bind of the definition of >>= I would include some if check. But I'd be checking, I think, whether Lwt_io.read_line returned End_of_file, which I though should be handled by the handler.
The Lwt.wait function creates a promise which could only be resolved using the second element of the returned pair, basically, this function will never terminate:
let never_ready () =
let (p,_) = Lwt.wait in
p
and this is exactly what you've written.
Concerning a graceful termination, ideally, you should do this in the loop function so that you can close the channel and prevent leaking of the valuable resources, e.g.,
let rec loop (ic: input_channel) =
Lwt_io.read_line ic >>= function
| exception End_of_file ->
Lwt.close ic
| text->
Lwt_io.printl text >>= fun () ->
loop ic
The minimum change to your code would be, however, to use Lwt.return () instead of Lwt.wait in the body of your handler.
I'd like to interrupt a call if it takes too long to compute, like this
try
do_something ()
with Too_long -> something_else ()
Is it possible to do something like that in OCaml? The function do_something may not be modified.
In general the only way to interrupt a function is to use a signal, as Basile suggested. Unfortunately the control flow will be transferred to a signal handler, so that you will be unable to return a value that you like. To get a more fine-grained control, you can run you do_something in separate thread. A first approximation would be the following function:
exception Timeout
let with_timeout timeout f =
let result = ref None in
let finished = Condition.create () in
let guard = Mutex.create () in
let set x =
Mutex.lock guard;
result := Some x;
Mutex.unlock guard in
Mutex.lock guard;
let work () =
let x = f () in
set x;
Condition.signal finished in
let delay () =
Thread.delay timeout;
Condition.signal finished in
let task = Thread.create work () in
let wait = Thread.create delay () in
Condition.wait finished guard;
match !result with
| None ->
Thread.kill task;
raise Timeout
| Some x ->
Thread.kill wait;
x
The solution with threads as well as with signal function has some drawbacks. For example, threads are switched in OCaml in specific iterruption points, in general this is any allocations. So if your code doesn't perform any allocations or external calls, then it may never yield to other thread and will run forever. A good example of such function is let rec f () = f (). In this is your case, then you should run your function in another process instead of thread. There're many libraries for multiprocessing in OCaml, to name a few:
parmap
forkwork
async-parallel
lwt-parallel
There is no built-in facility to perform this precise operation in the standard library, but it is rather straightforward to implement. Using the Thread module, run one thread to perform your main program and a monitoring thread that will kill the program if it lasts too long. Here is a starting implementation:
type 'a state =
| Running
| Finished of 'a
| Failed of exn
| Cancelled of 'a
let bounded_run d f g x =
let state = ref Running in
let p = ref None in
let m = ref None in
let cancel t' = match !t' with
| Some(t) -> Thread.kill t
| None -> ()
in
let program () =
(try state := Finished(f x)
with exn -> state := Failed (exn));
cancel m;
in
let monitor () =
Thread.delay d;
match !state with
| Running -> cancel p; state := Cancelled(g x)
| _ -> ()
in
p := Some(Thread.create program ());
m := Some(Thread.create monitor p);
(match !m with
| None -> ()
| Some(t) -> Thread.join t);
!state
The call bounded_run d f g x runs f x for at most d seconds and returns Finished(f x) if the computation runs in the given time. It might return Failed(exn) if the computation throws an exception. When the computation lasts too long, the returned value is Cancelled(g x).
This implementation has many defaults, for instance, the state and the returned values should have different types (the value Running should not be possible in the returned type), it does not use mutexes to prevent concurrent accesses to the p and m variables holding references to the threads we use. While it is rough at the edges, this should get you started, but for more advanced usage, you should also learn Event or 3rd party libraries such as Lwt or Async – the former will require you to change your function.
(I guess that you are on Linux)
Read more about signal(7)-s. You could use Ocaml's Sys.signal for Sys.sigalarm and Unix module (notably Unix.setitimer)
I needed a simple timing profiler to estimate the runtime of some parts of my program (written in OCaml, but I believe this could apply to other functional languages), and I couldn't find a very simple solution, similar to what one would code in an imperative language, using functions such as timer.start/timer.stop. So I tried one using lazy evaluation, and it works quite well for what I need, however I didn't find any references to this method, so I wonder it the approach is flawed or if there is a simpler solution.
So, the question is: do you know about similar implementations for functional languages (especially OCaml)? If so, please indicate them to me, I'd like to borrow some of their ideas to improve my "poorer man's profiler" (I've seen this question but it didn't help me much). From what I've seen, GHC already has a way to collect timing information, so it's probably not an issue for Haskell.
By the way, I tried doing timing profiling as indicated in the OCaml manual (17.4), but it was too "low-level" for what I needed: it gives lots of information at the C function level, which make it harder to evaluate precisely which part of the OCaml code is the culprit.
Below follows my implementation in OCaml (note that I need to add the "lazy" expression everytime I want to measure the time, but at the same time I can finely control how much information I need).
open Unix (* for the timers *)
(** 'timers' associates keys (strings) to time counters,
to allow for multiple simultaneous measurements. *)
let timers : (string, (float * float)) Hashtbl.t = Hashtbl.create 1
(** starts the timer associated with key <name> *)
let timer_start (name : string) : unit =
let now = Unix.times () in
Hashtbl.replace timers name (now.tms_utime, now.tms_stime)
(** Returns time elapsed between the corresponding call to
timer_start and this call *)
let timer_stop (name : string) : float =
try
let now = Unix.times () in
let t = Hashtbl.find timers name in
(now.tms_utime -. fst t) +. (now.tms_stime -. snd t)
with
Not_found -> 0.0
(** Wrapper for the timer function using lazy evaluation *)
let time (s : string) (e : 'a Lazy.t) : 'a =
timer_start s;
let a = Lazy.force e in
let t2 = timer_stop s in
(* outputs timing information *)
Printf.printf "TIMER,%s,%f\n" s t2; a
(** Example *)
let rec fibo n =
match n with
| 0 -> 1
| 1 -> 1
| n' -> fibo (n - 1) + fibo (n - 2)
let main =
let f = time "fibo" (lazy (fibo 42)) in
Printf.printf "f = %d\n" f
Unix.times measures CPU time, not wall-clock time. So this is suitable only for computational code that spends all of its time in CPU. And BTW hashtbl is not needed, even for multiple simultaneous measurements, just return the start time in timer_start and substract it in timer_stop.
Merging the ideas from #Jeffrey_Scofield and #ygrek, the "poorest man's timing profiler" is indeed so simple it would barely require mention at all, which would explain why I hadn't found it. So I've merged their answers and produced a much simpler version:
open Unix (* for the timers *)
(* Wrapper for the timer function using a "unit -> 'a" thunk *)
let time (s : string) (e : unit -> 'a) : 'a =
let tstart = Unix.times () in
let a = e () in
let tend = Unix.times () in
let delta = (tend.tms_utime -. tstart.tms_utime) +.
(tend.tms_stime -. tstart.tms_stime) in
(* outputs timing information *)
Printf.printf "TIMER,%s,%f\n" s delta; a
(* Example *)
let rec fibo n =
match n with
| 0 -> 1
| 1 -> 1
| n' -> fibo (n - 1) + fibo (n - 2)
let main =
let f = time "fibo" (fun () -> fibo 42) in
Printf.printf "f = %d\n" f