Skip to content

Commit abaa4a3

Browse files
authored
Merge pull request #118 from aytao/main
Make parallel_scan work on noncommutative functions
2 parents 3c807b9 + 2fa73a7 commit abaa4a3

File tree

3 files changed

+41
-1
lines changed

3 files changed

+41
-1
lines changed

lib/task.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -267,7 +267,7 @@ let parallel_scan pool op elements =
267267
let x = ref prefix_s.(n/p - 1) in
268268
for i = 2 to p do
269269
let ind = i * n / p - 1 in
270-
x := op prefix_s.(ind) !x;
270+
x := op !x prefix_s.(ind);
271271
prefix_s.(ind) <- !x
272272
done;
273273

test/dune

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -79,6 +79,11 @@
7979
(libraries domainslib)
8080
(modules test_parallel_find))
8181

82+
(test
83+
(name test_parallel_scan)
84+
(libraries domainslib)
85+
(modules test_parallel_scan))
86+
8287
(test
8388
(name test_deadlock)
8489
(libraries domainslib)

test/test_parallel_scan.ml

Lines changed: 35 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,35 @@
1+
let len = 1_000_000
2+
3+
let singleton_interval i = (i, i + 1)
4+
5+
let combine_intervals interval1 interval2 =
6+
let b1, e1 = interval1
7+
and b2, e2 = interval2 in
8+
if e1 <> b2 then begin
9+
Printf.eprintf "Invalid intervals: (%d, %d), (%d, %d)\n" b1 e1 b2 e2;
10+
assert false
11+
end
12+
else (b1, e2)
13+
14+
open Domainslib
15+
16+
let test_scan_ordering pool =
17+
let check_interval i interval =
18+
let (b, e) = interval in
19+
assert (b = 0 && e = i + 1)
20+
in
21+
Array.init len singleton_interval
22+
|> Task.parallel_scan pool combine_intervals
23+
|> Array.iteri check_interval
24+
25+
let () =
26+
(* [num_domains] is the number of *new* domains spawned by the pool
27+
performing computations in addition to the current domain. *)
28+
let num_domains = Domain.recommended_domain_count () - 1 in
29+
Printf.eprintf "test_parallel_scan on %d domains.\n" (num_domains + 1);
30+
let pool = Task.setup_pool ~num_domains ~name:"pool" () in
31+
Task.run pool begin fun () ->
32+
test_scan_ordering pool
33+
end;
34+
Task.teardown_pool pool;
35+
prerr_endline "Success.";

0 commit comments

Comments
 (0)