[Caml-list] semaphore puzzle

[Matej Kosik <5764c029b688c1c0d24a2e97cd764f@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 1000 bytes --]

Hi,

I am trying to find the most simple and, if possible, clean way to synchronize my threads.

In this particular case, semaphores would be ideal
(alternatively, unbounded channels)

  (* Create a new semaphore with a given initial value. *)
  val create : int -> t

  (* V *)
  val up : t -> unit

  (* P *)
  val down : t -> unit

  val try_down : t -> bool

The "down" or "try_down" are almost the solutions, but not quite.

"down" may block forever ---> there is no timeout at all
                              (I need some)

"try_down" --->  the timeout is zero
                 (I prefer a non-zero timeout)

Obviously, I could use "try_down" in a loop, checking the system time myself and then either give up or actually manage to decrement the semaphore.

Is there a better solution than this?

(There is a Unix module, there are signals, but I am not sure whether it is safe to use them in multithreaded program.
 At least, I did not have a luck.)

Thanks in advance for patience &| help.

[-- Attachment #2: semaphore.ml --]
[-- Type: text/plain, Size: 1075 bytes --]

exception Timeout

type t = {mutex : Mutex.t;
          condition_lock : Condition.t;
          mutable value : int}

let create initial_value =
  assert (0 <= initial_value);
  {mutex = Mutex.create ();
   condition_lock = Condition.create ();
   value = initial_value}

let up semaphore =
  Mutex.lock semaphore.mutex;
  semaphore.value <- succ semaphore.value;
  Mutex.unlock semaphore.mutex;
  Condition.signal semaphore.condition_lock

let down semaphore =
  Mutex.lock semaphore.mutex;
  assert (0 <= semaphore.value);
  while semaphore.value = 0 do
    Condition.wait semaphore.condition_lock semaphore.mutex
  done;
  semaphore.value <- pred semaphore.value;
  Mutex.unlock semaphore.mutex

(* If it is possible to decrement the semaphore, do it and return "true".
   Otherwise return "false". *)
let try_down semaphore =
  Mutex.lock semaphore.mutex;
  if 0 < semaphore.value then
    begin
      semaphore.value <- pred semaphore.value;
      Mutex.unlock semaphore.mutex;
      true
    end
  else
    begin
      Mutex.unlock semaphore.mutex;
      false
    end