summaryrefslogtreecommitdiff
path: root/ocaml/lib/domain_pool.ml
diff options
context:
space:
mode:
Diffstat (limited to 'ocaml/lib/domain_pool.ml')
-rw-r--r--ocaml/lib/domain_pool.ml94
1 files changed, 94 insertions, 0 deletions
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 ();
+}