From b936c04a1bd51f8a7eb8df3ae825cb4ea889a8ad Mon Sep 17 00:00:00 2001
From: Kakadu <Kakadu@pm.me>
Date: Mon, 24 Jun 2024 22:42:38 +0300
Subject: [PATCH 1/2] Add buggy demo with OCaml5 [skip ci]

Signed-off-by: Kakadu <Kakadu@pm.me>
---
 examples/dune      | 21 ++++++++++++++++++---
 examples/ocaml5.ml | 27 +++++++++++++++++++++++++++
 2 files changed, 45 insertions(+), 3 deletions(-)
 create mode 100644 examples/ocaml5.ml

diff --git a/examples/dune b/examples/dune
index e99cc1c..d785442 100644
--- a/examples/dune
+++ b/examples/dune
@@ -1,11 +1,26 @@
 (library
  (name examples)
  (modules
-  (:standard \ main))
- (libraries progress unix logs logs.fmt logs.threaded fmt fmt.tty mtime
-   mtime.clock.os vector threads.posix))
+  (:standard \ main ocaml5))
+ (libraries
+  progress
+  unix
+  logs
+  logs.fmt
+  logs.threaded
+  fmt
+  fmt.tty
+  mtime
+  mtime.clock.os
+  vector
+  threads.posix))
 
 (executable
  (name main)
  (modules main)
  (libraries examples fmt))
+
+(executable
+ (name ocaml5)
+ (modules ocaml5)
+ (libraries progress domainslib))
diff --git a/examples/ocaml5.ml b/examples/ocaml5.ml
new file mode 100644
index 0000000..2068742
--- /dev/null
+++ b/examples/ocaml5.ml
@@ -0,0 +1,27 @@
+let domains_count = 2
+
+let () =
+  let xs = Array.init 100 (Fun.id) in
+  let len = Array.length xs in
+  let total = if len > 0 then len * (len - 1) / 2 else 0 in
+  let bar ~total =
+    let open Progress.Line in
+    list
+      [
+        spinner ();
+        bar total;
+        count_to total;
+      ]
+  in
+  let useful_stuff _i _j = () in
+  let module T = Domainslib.Task in
+  let pool = T.setup_pool ~num_domains:domains_count () in
+  Progress.with_reporter (bar ~total)
+    (fun report ->
+        T.run pool (fun () ->
+            T.parallel_for pool ~start:0 ~finish:(len - 1) ~body:(fun i ->
+                T.parallel_for pool ~start:(i + 1) ~finish:(len - 1)
+                  ~body:(fun j ->
+                    report 1;
+                    useful_stuff i j))));
+    T.teardown_pool pool
\ No newline at end of file

From 46100d7553946b1f3dc990c3b87d69e6b818ee61 Mon Sep 17 00:00:00 2001
From: Kakadu <Kakadu@pm.me>
Date: Tue, 25 Jun 2024 12:21:47 +0300
Subject: [PATCH 2/2] It works

Signed-off-by: Kakadu <Kakadu@pm.me>
---
 examples/ocaml5.ml | 52 +++++++++++++++++++++++++++-------------------
 1 file changed, 31 insertions(+), 21 deletions(-)

diff --git a/examples/ocaml5.ml b/examples/ocaml5.ml
index 2068742..49e8ce2 100644
--- a/examples/ocaml5.ml
+++ b/examples/ocaml5.ml
@@ -1,27 +1,37 @@
-let domains_count = 2
+(* Run as: time dune exec examples/ocaml5.exe -- -j 4 -l 1000  *)
+type cfg = { mutable num_domains : int; mutable length : int }
+
+let cfg = { num_domains = 4; length = 100 }
 
 let () =
-  let xs = Array.init 100 (Fun.id) in
-  let len = Array.length xs in
-  let total = if len > 0 then len * (len - 1) / 2 else 0 in
+  Arg.parse
+    [ ("-j", Arg.Int (fun n -> cfg.num_domains <- n), " number of domains")
+    ; ("-l", Arg.Int (fun n -> cfg.length <- n), " array length")
+    ]
+    (fun _ -> assert false)
+    ""
+
+let rec slow_fib n = if n <= 1 then n else slow_fib (n - 2) + slow_fib (n - 1)
+
+let () =
+  (* Quadratic number of iterations *)
+  let total = if cfg.length > 0 then cfg.length * (cfg.length - 1) / 2 else 0 in
   let bar ~total =
     let open Progress.Line in
-    list
-      [
-        spinner ();
-        bar total;
-        count_to total;
-      ]
+    list [ spinner (); bar total; count_to total ]
+  in
+  let m = Mutex.create () in
+  let useful_stuff report _i _j =
+    assert (0 <= abs (slow_fib 25));
+    Mutex.protect m (fun () -> report 1)
   in
-  let useful_stuff _i _j = () in
   let module T = Domainslib.Task in
-  let pool = T.setup_pool ~num_domains:domains_count () in
-  Progress.with_reporter (bar ~total)
-    (fun report ->
-        T.run pool (fun () ->
-            T.parallel_for pool ~start:0 ~finish:(len - 1) ~body:(fun i ->
-                T.parallel_for pool ~start:(i + 1) ~finish:(len - 1)
-                  ~body:(fun j ->
-                    report 1;
-                    useful_stuff i j))));
-    T.teardown_pool pool
\ No newline at end of file
+  let pool = T.setup_pool ~num_domains:cfg.num_domains () in
+  Progress.with_reporter
+    (* ~config:(Progress.Config.v ~ppf:(Format.formatter_of_out_channel stdout) ()) *)
+    (bar ~total) (fun report ->
+      T.run pool (fun () ->
+          T.parallel_for pool ~start:0 ~finish:(cfg.length - 1) ~body:(fun i ->
+              T.parallel_for pool ~start:(i + 1) ~finish:(cfg.length - 1)
+                ~body:(fun j -> useful_stuff report i j))));
+  T.teardown_pool pool