From a266a42628d489e10af52b83a9f3266f32386c6d Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Mon, 19 Jun 2023 17:27:48 -0400
Subject: [PATCH] support for domain-local-await when installed

---
 dune-project      |  2 ++
 moonpool.opam     |  3 +++
 src/d_pool_.ml    |  1 +
 src/dla_.dummy.ml | 13 +++++++++++++
 src/dla_.real.ml  |  9 +++++++++
 src/dune          |  5 ++++-
 6 files changed, 32 insertions(+), 1 deletion(-)
 create mode 100644 src/dla_.dummy.ml
 create mode 100644 src/dla_.real.ml

diff --git a/dune-project b/dune-project
index ce0512d3..6b9e3c7e 100644
--- a/dune-project
+++ b/dune-project
@@ -26,6 +26,8 @@
    (and
     (>= 1.9.0)
     :with-test)))
+ (depopts
+   (domain-local-await (>= 0.2)))
  (tags
   (thread pool domain)))
 
diff --git a/moonpool.opam b/moonpool.opam
index d04f7837..eca13ce4 100644
--- a/moonpool.opam
+++ b/moonpool.opam
@@ -17,6 +17,9 @@ depends: [
   "odoc" {with-doc}
   "mdx" {>= "1.9.0" & with-test}
 ]
+depopts: [
+  "domain-local-await" {>= "0.2"}
+]
 build: [
   ["dune" "subst"] {dev}
   [
diff --git a/src/d_pool_.ml b/src/d_pool_.ml
index 250f3fd7..1a391687 100644
--- a/src/d_pool_.ml
+++ b/src/d_pool_.ml
@@ -1,6 +1,7 @@
 type domain = Domain_.t
 
 let work_ _i q : unit =
+  Dla_.setup_domain ();
   while true do
     let f = Bb_queue.pop q in
     try f () with _ -> ()
diff --git a/src/dla_.dummy.ml b/src/dla_.dummy.ml
new file mode 100644
index 00000000..3991ff1a
--- /dev/null
+++ b/src/dla_.dummy.ml
@@ -0,0 +1,13 @@
+(** Interface to Domain-local-await.
+
+    This is used to handle the presence or absence of DLA. *)
+
+type t = {
+  release: unit -> unit;
+  await: unit -> unit;
+}
+
+let using : prepare_for_await:(unit -> t) -> while_running:(unit -> 'a) -> 'a =
+ fun ~prepare_for_await:_ ~while_running -> while_running ()
+
+let setup_domain () = ()
diff --git a/src/dla_.real.ml b/src/dla_.real.ml
new file mode 100644
index 00000000..5f99d714
--- /dev/null
+++ b/src/dla_.real.ml
@@ -0,0 +1,9 @@
+type t = Domain_local_await.t = {
+  release: unit -> unit;
+  await: unit -> unit;
+}
+
+let using : prepare_for_await:(unit -> t) -> while_running:(unit -> 'a) -> 'a =
+  Domain_local_await.using
+
+let setup_domain () = Domain_local_await.per_thread (module Thread)
diff --git a/src/dune b/src/dune
index d9b0d84a..5cf7f22a 100644
--- a/src/dune
+++ b/src/dune
@@ -2,7 +2,10 @@
  (public_name moonpool)
  (name moonpool)
  (private_modules d_pool_)
- (libraries threads either))
+ (libraries threads either
+            (select dla_.ml from
+             (domain-local-await -> dla_.real.ml)
+             ( -> dla_.dummy.ml))))
 
 (rule
   (targets atomic_.ml)