Source file `capsule_blocking_sync.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
module Capsule = Capsule_prim

let yield = (Basement.Blocking_sync.yield [@alert "-deprecated"])

external unsafe_key : unit -> 'k Capsule.Key.t @ unique @@ portable = "%unbox_unit"

external unsafe_password
  :  unit
  -> 'k Capsule.Password.t @ local
  @@ portable
  = "%unbox_unit"

module Mutex = struct
  module M = Basement.Blocking_sync.Mutex [@alert "-deprecated"]

  type mutex = M.t
  type 'k t = M.t
  type packed = P : 'k t -> packed [@@unboxed]

  let[@inline] create _ = M.create ()

  exception Poisoned = M.Poisoned

  let[@inline] with_lock
    : type (a : value_or_null) k.
      (k t
       -> f:(k Capsule.Password.t @ local -> a @ once unique) @ local once
       -> a @ once unique) @ portable
    =
    fun t ~f ->
    M.with_lock t ~f:(fun () ->
      let pw : k Capsule.Password.t = unsafe_password () in
      f pw [@nontail])
    [@nontail]
  ;;

  let[@inline] with_key
    : type (a : value_or_null) k.
      (k t
       -> f:(k Capsule.Key.t @ unique -> #(a * k Capsule.Key.t) @ once unique)
          @ local once
       -> a @ once unique) @ portable
    =
    fun t ~f ->
    M.with_lock t ~f:(fun () ->
      let key : k Capsule.Key.t = unsafe_key () in
      let #(x, _key) = f key in
      x)
    [@nontail]
  ;;

  let[@inline] destroy t =
    M.destroy t;
    unsafe_key ()
  ;;
end

module Condition = struct
  module C = Basement.Blocking_sync.Condition [@alert "-deprecated"]

  type 'k t = C.t

  let[@inline] create () = C.create ()

  let[@inline] wait t ~mutex key =
    C.wait t ~mutex;
    key
  ;;

  let[@inline] signal t = C.signal t
  let[@inline] broadcast t = C.broadcast t
end
Source file capsule_blocking_sync.ml

Source file `capsule_blocking_sync.ml`
