[m-rev.] for review: add foldl_corresponding/5 and foldl2_corresponding/7 for arrays

[Julien Fischer]

For review by anyone.

Note that test coverge for the many of the higher-order ops in the array
module doesn't appear to be very good; I intend to extend the test case
below to cover any operations that have previously been missed once this
is committed.

Julien.

----------------------------------------

Add foldl_corresponding/5 and foldl2_corrresponding/7 for arrays.

library/array.m:
     Add the above predicates.

NEWS:
     Announce the additions.

tests/hard_coded/Mmakefile:
tests/hard_coded/ho_array_ops.{m,exp}:
     Add tests of the new predicates.

diff --git a/NEWS b/NEWS
index 828da36..393d475 100644
--- a/NEWS
+++ b/NEWS
@@ -448,12 +448,14 @@ Changes to the Mercury standard library:
     - snoc/3
     - find_first_match/3

-* The following function has been added to the array module:
+* The following functions and predicates have been added to the array module:

     - det_least_index/1
     - semidet_least_index/1
     - det_greatest_index/1
     - semidet_greatest_index/1
+   - foldl_corresponding/5
+   - foldl2_corresponding/7

     The following functions in the array module have been deprecated:

diff --git a/library/array.m b/library/array.m
index 3350756..2602c60 100644
--- a/library/array.m
+++ b/library/array.m
@@ -595,6 +595,8 @@
      pred(in, in, out, in, out, in, out, in, out, di, uo) is semidet,
      in, in, out, in, out, in, out, in, out, di, uo) is semidet.

+%---------------------%
+
      % foldr(Fn, Array, X) is equivalent to
      %   list.foldr(Fn, to_list(Array), X)
      % but more efficient.
@@ -690,6 +692,47 @@
      pred(in, in, out, in, out, in, out, in, out, di, uo) is semidet,
      in, in, out, in, out, in, out, in, out, di, uo) is semidet.

+%---------------------%
+
+    % foldl_corresponding(P, A, B, !Acc):
+    %
+    % Does the same job as foldl, but works on two arrays in parallel.
+    % An exception is raised if the array arguments differ in size.
+    %
+:- pred foldl_corresponding(pred(T1, T2, T3, T3), array(T1), array(T2),
+    T3, T3).
+:- mode foldl_corresponding(in(pred(in, in, in, out) is det), in, in,
+    in, out) is det.
+:- mode foldl_corresponding(in(pred(in, in, mdi, muo) is det), in, in,
+    mdi, muo) is det.
+:- mode foldl_corresponding(in(pred(in, in, di, uo) is det), in, in,
+    di, uo) is det.
+:- mode foldl_corresponding(in(pred(in, in, in, out) is semidet), in, in,
+    in, out) is semidet.
+:- mode foldl_corresponding(in(pred(in, in, mdi, muo) is semidet), in, in,
+    mdi, muo) is semidet.
+:- mode foldl_corresponding(in(pred(in, in, di, uo) is semidet), in, in,
+    di, uo) is semidet.
+
+    % As above, but with two accumulators.
+    %
+:- pred foldl2_corresponding(pred(T1, T2, T3, T3, T4, T4),
+    array(T1), array(T2), T3, T3, T4, T4).
+:- mode foldl2_corresponding(in(pred(in, in, in, out, in, out) is det),
+    in, in, in, out, in, out) is det.
+:- mode foldl2_corresponding(in(pred(in, in, in, out, mdi, muo) is det),
+    in, in, in, out, mdi, muo) is det.
+:- mode foldl2_corresponding(in(pred(in, in, in, out, di, uo) is det),
+    in, in, in, out, di, uo) is det.
+:- mode foldl2_corresponding(in(pred(in, in, in, out, in, out) is semidet),
+    in, in, in, out, in, out) is semidet.
+:- mode foldl2_corresponding(in(pred(in, in, in, out, mdi, muo) is semidet),
+    in, in, in, out, mdi, muo) is semidet.
+:- mode foldl2_corresponding(in(pred(in, in,in, out,  di, uo) is semidet),
+    in, in, in, out, di, uo) is semidet.
+
+%---------------------%
+
      % map_foldl(P, A, B, !Acc):
      % Invoke P(Aelt, Belt, !Acc) on each element of the A array,
      % and construct array B from the resulting values of Belt.
@@ -704,6 +747,8 @@
  :- mode map_foldl(in(pred(in, out, in, out) is semidet),
      in, array_uo, in, out) is semidet.

+%---------------------%
+
      % map_corresponding_foldl(P, A, B, C, !Acc):
      %
      % Given two arrays A and B, invoke P(Aelt, Belt, Celt, !Acc) on
@@ -729,6 +774,8 @@
      in(pred(in, in, out, in, out) is semidet),
      in, in, array_uo, in, out) is semidet.

+%---------------------%
+
      % all_true(Pred, Array):
      % True iff Pred is true for every element of Array.
      %
@@ -2772,6 +2819,72 @@ do_foldr5(P, Min, I, A, !Acc1, !Acc2, !Acc3, !Acc4, !Acc5) :-

  %---------------------------------------------------------------------------%

+foldl_corresponding(P, A, B, !Acc) :-
+    MaxA = array.max(A),
+    MaxB = array.max(B),
+    ( if MaxA = MaxB then
+        do_foldl_corresponding(P, 0, MaxA, A, B, !Acc)
+    else
+        error("array.foldl_corresponding: array arguments differ in size")
+    ).
+
+:- pred do_foldl_corresponding(pred(T1, T2, T3, T3), int, int,
+    array(T1), array(T2), T3, T3).
+:- mode do_foldl_corresponding(in(pred(in, in, in, out) is det), in, in,
+    in, in, in, out) is det.
+:- mode do_foldl_corresponding(in(pred(in, in, mdi, muo) is det), in, in,
+    in, in, mdi, muo) is det.
+:- mode do_foldl_corresponding(in(pred(in, in, di, uo) is det), in, in,
+    in, in, di, uo) is det.
+:- mode do_foldl_corresponding(in(pred(in, in, in, out) is semidet), in, in,
+    in, in, in, out) is semidet.
+:- mode do_foldl_corresponding(in(pred(in, in, mdi, muo) is semidet), in, in,
+    in, in, mdi, muo) is semidet.
+:- mode do_foldl_corresponding(in(pred(in, in, di, uo) is semidet), in, in,
+    in, in, di, uo) is semidet.
+
+do_foldl_corresponding(P, I, Max, A, B, !Acc) :-
+    ( if Max < I then
+        true
+    else
+        P(A ^ unsafe_elem(I), B ^ unsafe_elem(I), !Acc),
+        do_foldl_corresponding(P, I + 1, Max, A, B, !Acc)
+    ).
+
+foldl2_corresponding(P, A, B, !Acc1, !Acc2) :-
+    MaxA = array.max(A),
+    MaxB = array.max(B),
+    ( if MaxA = MaxB then
+        do_foldl2_corresponding(P, 0, MaxA, A, B, !Acc1, !Acc2)
+    else
+        error("array.foldl2_corresponding: array arguments differ in size")
+    ).
+
+:- pred do_foldl2_corresponding(pred(T1, T2, T3, T3, T4, T4), int, int,
+    array(T1), array(T2), T3, T3, T4, T4).
+:- mode do_foldl2_corresponding(in(pred(in, in, in, out, in, out) is det),
+    in, in, in, in, in, out, in, out) is det.
+:- mode do_foldl2_corresponding(in(pred(in, in, in, out, mdi, muo) is det),
+    in, in, in, in, in, out, mdi, muo) is det.
+:- mode do_foldl2_corresponding(in(pred(in, in, in, out, di, uo) is det),
+    in, in, in, in, in, out, di, uo) is det.
+:- mode do_foldl2_corresponding(in(pred(in, in, in, out, in, out) is semidet),
+    in, in, in, in, in, out, in, out) is semidet.
+:- mode do_foldl2_corresponding(in(pred(in, in, in, out, mdi, muo) is semidet),
+    in, in, in, in, in, out, mdi, muo) is semidet.
+:- mode do_foldl2_corresponding(in(pred(in, in, in, out, di, uo) is semidet),
+    in, in, in, in, in, out, di, uo) is semidet.
+
+do_foldl2_corresponding(P, I, Max, A, B, !Acc1, !Acc2) :-
+    ( if Max < I then
+        true
+    else
+        P(A ^ unsafe_elem(I), B ^ unsafe_elem(I), !Acc1, !Acc2),
+        do_foldl2_corresponding(P, I + 1, Max, A, B, !Acc1, !Acc2)
+    ).
+
+%---------------------------------------------------------------------------%
+
  map_foldl(P, A, B, !Acc) :-
      N = array.size(A),
      ( if N =< 0 then
@@ -2804,6 +2917,8 @@ map_foldl_2(P, I, A, !B, !Acc) :-
          true
      ).

+%---------------------------------------------------------------------------%
+
  map_corresponding_foldl(P, A, B, C, !Acc) :-
      N = array.size(A),
      ( if N =< 0 then
diff --git a/tests/hard_coded/Mmakefile b/tests/hard_coded/Mmakefile
index b997253..a418d8c 100644
--- a/tests/hard_coded/Mmakefile
+++ b/tests/hard_coded/Mmakefile
@@ -693,6 +693,7 @@ ifeq "$(findstring profdeep,$(GRADE))" ""
  		cmp_uint8 \
  		dir_test \
  		final_excp \
+		ho_array_ops \
  		int8_static_data \
  		init_excp \
  		intermod_try_goal \
diff --git a/tests/hard_coded/ho_array_ops.exp b/tests/hard_coded/ho_array_ops.exp
index e69de29..15c59cc 100644
--- a/tests/hard_coded/ho_array_ops.exp
+++ b/tests/hard_coded/ho_array_ops.exp
@@ -0,0 +1,36 @@
+TESTING: foldl_corresponding (ok)
+1 - 2
+2 - 4
+3 - 6
+4 - 8
+5 - 10
+RESULT: OK
+FINISHED TESTING: foldl_corresponding (ok)
+
+TESTING: foldl_corresponding (empty)
+RESULT: OK
+FINISHED TESTING: foldl_corresponding (empty)
+
+TESTING: foldl_corresponding (mismatch)
+RESULT: EXCEPTION: software_error("array.foldl_corresponding: array arguments differ in size")
+FINISHED TESTING: foldl_corresponding (mismatch)
+
+TESTING: foldl2_corresponding (ok)
+1 - 2
+2 - 4
+3 - 6
+4 - 8
+5 - 10
+Sum is 45.
+RESULT: OK
+FINISHED TESTING: foldl2_corresponding (ok)
+
+TESTING: foldl2_corresponding (empty)
+Sum is 0.
+RESULT: OK
+FINISHED TESTING: foldl2_corresponding (empty)
+
+TESTING: foldl2_corresponding (mismatch)
+RESULT: EXCEPTION: software_error("array.foldl2_corresponding: array arguments differ in size")
+FINISHED TESTING: foldl2_corresponding (mismatch)
+
diff --git a/tests/hard_coded/ho_array_ops.m b/tests/hard_coded/ho_array_ops.m
index e69de29..edae85e 100644
--- a/tests/hard_coded/ho_array_ops.m
+++ b/tests/hard_coded/ho_array_ops.m
@@ -0,0 +1,127 @@
+%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%---------------------------------------------------------------------------%
+%
+% Tests of various higher-order array operations.
+% XXX this should extended cover other ho array operations.
+%
+%---------------------------------------------------------------------------%
+
+:- module ho_array_ops.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is cc_multi.
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module array.
+:- import_module int.
+:- import_module list.
+:- import_module string.
+
+%---------------------------------------------------------------------------%
+
+main(!IO) :-
+    do_test("foldl_corresponding (ok)", foldl_corresponding_ok, !IO),
+    do_test("foldl_corresponding (empty)", foldl_corresponding_empty, !IO),
+    do_test("foldl_corresponding (mismatch)", foldl_corresponding_mismatch,
+        !IO),
+
+    do_test("foldl2_corresponding (ok)", foldl2_corresponding_ok, !IO),
+    do_test("foldl2_corresponding (empty)", foldl2_corresponding_empty, !IO),
+    do_test("foldl2_corresponding (mismatch)", foldl2_corresponding_mismatch,
+        !IO).
+
+%---------------------------------------------------------------------------%
+
+:- pred do_test(string::in, pred(io, io)::in(pred(di, uo) is det),
+    io::di, io::uo) is cc_multi.
+
+do_test(Desc, Pred, !IO) :-
+    io.format("TESTING: %s\n", [s(Desc)], !IO),
+    ( try [io(!IO)] (
+        Pred(!IO)
+    )
+    then
+        io.write_string("RESULT: OK\n", !IO)
+    catch_any Excp ->
+        io.write_string("RESULT: EXCEPTION: ", !IO),
+        io.write_line(Excp, !IO)
+    ),
+    io.format("FINISHED TESTING: %s\n\n", [s(Desc)], !IO).
+
+%---------------------------------------------------------------------------%
+%
+% Tests for array.foldl_corresponding/5.
+%
+
+:- pred foldl_corresponding_ok(io::di, io::uo) is det.
+
+foldl_corresponding_ok(!IO) :-
+    A = array.from_list([1, 2, 3, 4, 5]),
+    B = array.from_list([2, 4, 6, 8, 10]),
+    array.foldl_corresponding(print_corresponding, A, B, !IO).
+
+:- pred foldl_corresponding_empty(io::di, io::uo) is det.
+
+foldl_corresponding_empty(!IO) :-
+    make_empty_array(A : array(int)),
+    make_empty_array(B : array(int)),
+    array.foldl_corresponding(print_corresponding, A, B, !IO).
+
+:- pred foldl_corresponding_mismatch(io::di, io::uo) is det.
+
+foldl_corresponding_mismatch(!IO) :-
+    make_empty_array(A : array(int)),
+    B = array.from_list([2, 4, 6, 8, 10]),
+    array.foldl_corresponding(print_corresponding, A, B, !IO).
+
+:- pred print_corresponding(int::in, int::in, io::di, io::uo) is det.
+
+print_corresponding(A, B, !IO) :-
+    io.format("%d - %d\n", [i(A), i(B)], !IO).
+
+%---------------------------------------------------------------------------%
+
+:- pred foldl2_corresponding_ok(io::di, io::uo) is det.
+
+foldl2_corresponding_ok(!IO) :-
+    A = array.from_list([1, 2, 3, 4, 5]),
+    B = array.from_list([2, 4, 6, 8, 10]),
+    array.foldl2_corresponding(print_and_sum_corresponding, A, B, 0, Sum,
+        !IO),
+    io.format("Sum is %d.\n", [i(Sum)], !IO).
+
+:- pred foldl2_corresponding_empty(io::di, io::uo) is det.
+
+foldl2_corresponding_empty(!IO) :-
+    make_empty_array(A : array(int)),
+    make_empty_array(B : array(int)),
+    array.foldl2_corresponding(print_and_sum_corresponding, A, B, 0, Sum,
+        !IO),
+    io.format("Sum is %d.\n", [i(Sum)], !IO).
+
+:- pred foldl2_corresponding_mismatch(io::di, io::uo) is det.
+
+foldl2_corresponding_mismatch(!IO) :-
+    make_empty_array(A : array(int)),
+    B = array.from_list([2, 4, 6, 8, 10]),
+    array.foldl2_corresponding(print_and_sum_corresponding, A, B, 0, Sum,
+        !IO),
+    io.format("Sum is %d.\n", [i(Sum)], !IO).
+
+:- pred print_and_sum_corresponding(int::in, int::in, int::in, int::out,
+    io::di, io::uo) is det.
+
+print_and_sum_corresponding(A, B, !Sum, !IO) :-
+    !:Sum = !.Sum + A + B,
+    io.format("%d - %d\n", [i(A), i(B)], !IO).
+
+%---------------------------------------------------------------------------%
+:- end_module ho_array_ops.
+%---------------------------------------------------------------------------%