From 24eac75c69b3d74388bbbc8ee2b6792e7590e4c6 Mon Sep 17 00:00:00 2001
From: polwex <polwex@sortug.com>
Date: Mon, 6 Oct 2025 04:03:14 +0700
Subject: did this madman really implement parallelism on urbit

---
 ocaml/lib/domain_pool.ml | 94 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 94 insertions(+)
 create mode 100644 ocaml/lib/domain_pool.ml

(limited to 'ocaml/lib/domain_pool.ml')

diff --git a/ocaml/lib/domain_pool.ml b/ocaml/lib/domain_pool.ml
new file mode 100644
index 0000000..06a5ce4
--- /dev/null
+++ b/ocaml/lib/domain_pool.ml
@@ -0,0 +1,94 @@
+(* Domain Pool - Manage worker domains for parallel Nock execution
+ *
+ * This module provides a pool of worker domains that can execute
+ * Nock computations in parallel across multiple CPU cores.
+ *
+ * Key innovation: Uses Domainslib.Task for work distribution
+ *)
+
+(* Domain pool configuration *)
+type config = {
+  num_domains: int;  (* Number of worker domains, default: num_cpus - 1 *)
+}
+
+(* Domain pool state *)
+type t = {
+  config: config;
+  pool: Domainslib.Task.pool;
+}
+
+(* Create domain pool *)
+let create ?(num_domains = Domain.recommended_domain_count () - 1) () =
+  let num_domains = max 1 num_domains in  (* At least 1 domain *)
+  Printf.printf "[DomainPool] Creating pool with %d domains\n%!" num_domains;
+
+  let config = { num_domains } in
+  let pool = Domainslib.Task.setup_pool ~num_domains () in
+
+  { config; pool }
+
+(* Shutdown domain pool *)
+let shutdown pool =
+  Printf.printf "[DomainPool] Shutting down pool\n%!";
+  Domainslib.Task.teardown_pool pool.pool
+
+(* Run a single task in the pool *)
+let run pool f =
+  Domainslib.Task.run pool.pool f
+
+(* Run multiple tasks in parallel *)
+let parallel_map pool f items =
+  let items_array = Array.of_list items in
+  let n = Array.length items_array in
+  let results = Array.make n None in
+
+  Domainslib.Task.run pool.pool (fun () ->
+    Domainslib.Task.parallel_for pool.pool
+      ~chunk_size:1
+      ~start:0
+      ~finish:(n - 1)
+      ~body:(fun i ->
+        let result = f items_array.(i) in
+        results.(i) <- Some result
+      )
+  );
+
+  (* Convert results to list *)
+  Array.to_list results |> List.filter_map (fun x -> x)
+
+(* Run tasks in parallel and collect results *)
+let parallel_for pool ~start ~finish ~body =
+  let results = Array.make (finish - start + 1) None in
+
+  Domainslib.Task.run pool.pool (fun () ->
+    Domainslib.Task.parallel_for pool.pool
+      ~chunk_size:1
+      ~start
+      ~finish:(finish + 1)
+      ~body:(fun i ->
+        let result = body i in
+        results.(i - start) <- Some result
+      )
+  );
+
+  (* Collect results *)
+  Array.to_list results |> List.filter_map (fun x -> x)
+
+(* Async await - execute task and return promise *)
+let async pool f =
+  Domainslib.Task.async pool.pool f
+
+(* Wait for async task to complete *)
+let await = Domainslib.Task.await
+
+(* Pool statistics type *)
+type stats = {
+  num_domains: int;
+  available_cores: int;
+}
+
+(* Get pool statistics *)
+let stats pool = {
+  num_domains = pool.config.num_domains;
+  available_cores = Domain.recommended_domain_count ();
+}
-- 
cgit v1.2.3