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..49e8ce2 --- /dev/null +++ b/examples/ocaml5.ml @@ -0,0 +1,37 @@ +(* 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 () = + 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 ] + 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 module T = Domainslib.Task in + 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