From 7704fc7c05f943440970cd297b483b7934d97f04 Mon Sep 17 00:00:00 2001 From: Vesa Karvonen Date: Thu, 18 May 2023 14:17:30 +0300 Subject: [PATCH] WIP: Sleeping barbers --- README.md | 159 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 159 insertions(+) diff --git a/README.md b/README.md index 2ff3da14..b2c9d5dd 100644 --- a/README.md +++ b/README.md @@ -56,6 +56,7 @@ is distributed under the [ISC license](LICENSE.md). - [Programming with transactional data structures](#programming-with-transactional-data-structures) - [The dining philosophers problem](#the-dining-philosophers-problem) - [A transactional LRU cache](#a-transactional-lru-cache) + - [The sleeping barbers problem](#the-sleeping-barbers-problem) - [Programming with primitive operations](#programming-with-primitive-operations) - [Designing lock-free algorithms with k-CAS](#designing-lock-free-algorithms-with-k-cas) - [Minimize accesses](#minimize-accesses) @@ -940,6 +941,164 @@ val a_cache : (int, string) cache = As an exercise, implement an operation to `remove` associations from a cache and an operation to change the capacity of the cache. +#### The sleeping barbers problem + +The +[sleeping barber problem](https://en.wikipedia.org/wiki/Sleeping_barber_problem) +is another classic communication and synchronization problem. Let's write a +solution using **kcas**. + +```ocaml +module Barbershop : sig + type ('barber, 'customer) t + val create : int -> ('b, 'c) t + val get_barber_opt : xt:'x Xt.t -> ('b, 'c) t -> 'b option + val try_enqueue : xt:'x Xt.t -> ('b, 'c) t -> 'c -> bool + val get_customer_opt : xt:'x Xt.t -> ('b, 'c) t -> 'c option + val sleep : xt:'x Xt.t -> ('b, 'c) t -> 'b -> unit + val is_closed : xt:'x Xt.t -> ('b, 'c) t -> bool + val close : xt:'x Xt.t -> ('b, 'c) t -> unit +end = struct + type ('barber, 'customer) t = { + sleeping_barbers : 'barber Queue.t; + waiting_customers : 'customer Queue.t; + is_closed : bool Loc.t; + } + + let create capacity = + let sleeping_barbers = Queue.create () + and waiting_customers = Queue.create ~capacity () + and is_closed = Loc.make false in + { sleeping_barbers; waiting_customers; is_closed } + + let get_barber_opt ~xt bs = + Queue.Xt.take_opt ~xt bs.sleeping_barbers + + let try_enqueue ~xt bs customer = + not (Xt.get ~xt bs.is_closed) && + Queue.Xt.try_add ~xt customer bs.waiting_customers + + let get_customer_opt ~xt bs = + Queue.Xt.take_opt ~xt bs.waiting_customers + + let sleep ~xt bs barber = + if not (Xt.get ~xt bs.is_closed) + then Queue.Xt.add ~xt barber bs.sleeping_barbers + + let is_closed ~xt bs = Xt.get ~xt bs.is_closed + + let close ~xt bs = + Xt.set ~xt bs.is_closed true; + Queue.Xt.clear ~xt bs.sleeping_barbers; + Queue.Xt.clear ~xt bs.waiting_customers +end +``` + +```ocaml +type customer = { + cut_hair : 'x.xt:'x Xt.t -> unit; +} + +type barber = { + wake_up : 'x.xt:'x Xt.t -> customer -> unit; +} +``` + +```ocaml +# let customer shop cuts = + let clean = Mvar.create None in + let self = { cut_hair = Mvar.Xt.put clean true } in + while not (Xt.commit { tx = Barbershop.is_closed shop }) do + let try_get_barber ~xt = + match Barbershop.get_barber_opt ~xt shop with + | None -> + Barbershop.try_enqueue ~xt shop self + | Some barber -> + barber.wake_up ~xt self; + true + in + if Xt.commit { tx = try_get_barber } then + let try_get_haircut ~xt = + not (Barbershop.is_closed ~xt shop) && + Mvar.Xt.take ~xt clean + in + if Xt.commit { tx = try_get_haircut } then + Loc.incr cuts + done +val customer : (barber, customer) Barbershop.t -> int Loc.t -> unit = +``` + +```ocaml +# let barber shop cuts = + let customer = Mvar.create None in + let self = { wake_up = Mvar.Xt.put customer } in + while not (Xt.commit { tx = Barbershop.is_closed shop }) do + let cut customer = + Xt.commit { tx = customer.cut_hair }; + Loc.incr cuts + in + let try_get_customer ~xt = + match Barbershop.get_customer_opt ~xt shop with + | Some _ as some -> some + | None -> + Barbershop.sleep ~xt shop self; + None + in + match Xt.commit { tx = try_get_customer } with + | Some customer -> cut customer + | None -> + let sleeping ~xt = + if Barbershop.is_closed ~xt shop then None + else Some (Mvar.Xt.take ~xt customer) + in + match Xt.commit { tx = sleeping } with + | Some customer -> cut customer + | None -> () + done +val barber : (barber, customer) Barbershop.t -> int Loc.t -> unit = +``` + +```ocaml +# let sleeping_barbers ~barbers + ~queue_max + ~customers + ~cuts_per_agent = + assert (0 < barbers + && 0 <= queue_max + && 0 <= customers + && 0 <= cuts_per_agent); + let shop = Barbershop.create queue_max in + let barbers = Array.init barbers @@ fun _ -> + let cuts = Loc.make 0 in + (cuts, Domain.spawn (fun () -> barber shop cuts)) + and customers = Array.init customers @@ fun _ -> + let cuts = Loc.make 0 in + (cuts, Domain.spawn (fun () -> customer shop cuts)) + in + let agents = Array.append barbers customers in + while agents + |> Array.map fst + |> Array.exists @@ fun c -> + Loc.get c < cuts_per_agent do + Domain.cpu_relax () + done; + Xt.commit { tx = Barbershop.close shop }; + agents + |> Array.map snd + |> Array.iter Domain.join +val sleeping_barbers : + barbers:int -> queue_max:int -> customers:int -> cuts_per_agent:int -> unit = + +``` + +```ocaml +# sleeping_barbers ~barbers:2 + ~queue_max:1 + ~customers:4 + ~cuts_per_agent:10 +- : unit = () +``` + ### Programming with primitive operations In addition to the transactional interface, **kcas** also provides the