package mvar

  1. Overview
  2. Docs
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file mvar.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
module Mutex = struct
  include Mutex
  (** execute the function f with the mutex hold *)
  let execute lock f =
    Mutex.lock lock;
    let r = begin try f () with exn -> Mutex.unlock lock; raise exn end; in
    Mutex.unlock lock;
    r
end

type 'a t = {
  data: 'a option ref;
  m: Mutex.t;
  c: Condition.t;
}

let create_empty () =
  {
    data = ref None;
    m = Mutex.create ();
    c = Condition.create ();
  }

let create x =
  {
    data = ref (Some x);
    m = Mutex.create ();
    c = Condition.create ();
  }

let take mvar =
  let rec check () =
    match !(mvar.data) with
    | None ->
      Condition.wait mvar.c mvar.m;
      check ()
    | Some x ->
      mvar.data := None;
      Condition.signal mvar.c;
      x
    in
  Mutex.execute mvar.m (fun () -> check ())

let try_take mvar =
  Mutex.execute mvar.m (fun () ->
    match !(mvar.data) with
    | None -> None
    | Some x ->
      mvar.data := None;
      Condition.signal mvar.c;
      Some x)

let put mvar x =
  let rec check () =
    match !(mvar.data) with
    | None ->
      mvar.data := (Some x);
      Condition.signal mvar.c
    | Some _ ->
      Condition.wait mvar.c mvar.m;
      check ()
  in
  Mutex.execute mvar.m (fun () -> check ())

let try_put mvar x =
  Mutex.execute mvar.m (fun () ->
    match !(mvar.data) with
    | Some _ ->
      false
    | None ->
      mvar.data := (Some x);
      Condition.signal mvar.c;
      true)

let is_empty mvar =
  Mutex.execute mvar.m (fun () ->
    match !(mvar.data) with
    | Some _ -> false
    | None -> true)

let swap mvar x =
  let rec check () =
    match !(mvar.data) with
    | None ->
      Condition.wait mvar.c mvar.m;
      check ()
    | Some y ->
      mvar.data := (Some x);
      Condition.signal mvar.c;
      y
  in
  Mutex.execute mvar.m (fun () -> check ())

let modify mvar f =
  let rec check () =
    match !(mvar.data) with
    | None ->
      Condition.wait mvar.c mvar.m;
      check ()
    | Some x ->
      mvar.data := (Some (f x));
      Condition.signal mvar.c
  in
  Mutex.execute mvar.m (fun () -> check ())