[m-rev.] for review: Make cord foldl tail-recursive.

Peter Wang novalazy at gmail.com
Wed Jan 15 11:42:44 AEDT 2014


Make cord.foldl and cord.foldl_pred tail-recursive.  This may be
expected by users as cords are often used as a replacement for lists.

Also make the recursive calls in cord.foldr and cord.foldr_pred amenable
to last call optimisation.  However, they still use stack space
proportional to the size of the input due to calling list.foldr.

library/cord.m:
    As above.

tests/hard_coded/test_cord2.m:
tests/hard_coded/test_cord2.exp:
    Add tests for fold order.

NEWS:
    Announce the change.

diff --git a/NEWS b/NEWS
index 348805a..8db2c7d 100644
--- a/NEWS
+++ b/NEWS
@@ -12,6 +12,9 @@ Changes to the Mercury standard library:
 
 * We have added the function cord.condense/1.
 
+* The following functions in the standard library's cord module now use
+  constant stack space: foldl/3, foldl_pred/4.
+
 * We have added the following predicates to the array and version_array
   modules: is_empty/1, all_true/2 and all_false/2.
 
diff --git a/library/cord.m b/library/cord.m
index 06d7f25..ae7efd7 100644
--- a/library/cord.m
+++ b/library/cord.m
@@ -654,72 +654,120 @@ filter_node(P, Node, Trues, Falses) :-
 %-----------------------------------------------------------------------------%
 
 foldl(_, empty_cord, Acc) = Acc.
-foldl(F, nonempty_cord(N), Acc) = foldl_node(F, N, Acc).
+foldl(F, nonempty_cord(N), Acc0) = Acc :-
+    foldl_node(F, N, [], Acc0, Acc).
 
-:- func foldl_node(func(T, U) = U, cord_node(T), U) = U.
+:- pred foldl_node(func(T, U) = U, cord_node(T), list(cord_node(T)), U, U).
+:- mode foldl_node(in(func(in, in) = out is det), in, in, in, out) is det.
 
-foldl_node(F, unit_node(X), Acc) = F(X, Acc).
-foldl_node(F, list_node(H, T), Acc) = list.foldl(F, [H | T], Acc).
-foldl_node(F, branch_node(A, B), Acc) =
-    foldl_node(F, B, foldl_node(F, A, Acc)).
+foldl_node(F, C, Cs, !Acc) :-
+    (
+        C = unit_node(X),
+        F(X, !.Acc) = !:Acc
+    ;
+        C = list_node(H, T),
+        list.foldl(F, [H | T], !.Acc) = !:Acc
+    ),
+    (
+        Cs = []
+    ;
+        Cs = [Y | Ys],
+        foldl_node(F, Y, Ys, !Acc)
+    ).
+foldl_node(F, branch_node(A, B), Cs, !Acc) :-
+    foldl_node(F, A, [B | Cs], !Acc).
 
 foldl_pred(_P, empty_cord, !Acc).
 foldl_pred(P, nonempty_cord(N), !Acc) :-
-    foldl_node_pred(P, N, !Acc).
+    foldl_node_pred(P, N, [], !Acc).
 
-:- pred foldl_node_pred(pred(T, U, U), cord_node(T), U, U).
-:- mode foldl_node_pred(in(pred(in, in, out) is det), in, in, out) is det.
-:- mode foldl_node_pred(in(pred(in, mdi, muo) is det), in, mdi, muo) is det.
-:- mode foldl_node_pred(in(pred(in, di, uo) is det), in, di, uo) is det.
-:- mode foldl_node_pred(in(pred(in, in, out) is semidet), in, in, out)
+:- pred foldl_node_pred(pred(T, U, U), cord_node(T), list(cord_node(T)), U, U).
+:- mode foldl_node_pred(in(pred(in, in, out) is det), in, in, in, out) is det.
+:- mode foldl_node_pred(in(pred(in, mdi, muo) is det), in, in, mdi, muo)
+    is det.
+:- mode foldl_node_pred(in(pred(in, di, uo) is det), in, in, di, uo) is det.
+:- mode foldl_node_pred(in(pred(in, in, out) is semidet), in, in, in, out)
     is semidet.
-:- mode foldl_node_pred(in(pred(in, mdi, muo) is semidet), in, mdi, muo)
+:- mode foldl_node_pred(in(pred(in, mdi, muo) is semidet), in, in, mdi, muo)
     is semidet.
-:- mode foldl_node_pred(in(pred(in, di, uo) is semidet), in, di, uo)
+:- mode foldl_node_pred(in(pred(in, di, uo) is semidet), in, in, di, uo)
     is semidet.
 
-foldl_node_pred(P, unit_node(X), !Acc) :-
-    P(X, !Acc).
-foldl_node_pred(P, list_node(H, T), !Acc) :-
-    list.foldl(P, [H | T], !Acc).
-foldl_node_pred(P, branch_node(A, B), !Acc) :-
-    foldl_node_pred(P, A, !Acc),
-    foldl_node_pred(P, B, !Acc).
+foldl_node_pred(P, C, Cs, !Acc) :-
+    (
+        C = unit_node(X),
+        P(X, !Acc)
+    ;
+        C = list_node(H, T),
+        list.foldl(P, [H | T], !Acc)
+    ),
+    (
+        Cs = []
+    ;
+        Cs = [Y | Ys],
+        foldl_node_pred(P, Y, Ys, !Acc)
+    ).
+foldl_node_pred(P, branch_node(A, B), Cs, !Acc) :-
+    foldl_node_pred(P, A, [B | Cs], !Acc).
 
 %-----------------------------------------------------------------------------%
 
 foldr(_, empty_cord, Acc) = Acc.
-foldr(F, nonempty_cord(N), Acc) = foldr_node(F, N, Acc).
+foldr(F, nonempty_cord(N), Acc0) = Acc :-
+    foldr_node(F, N, [], Acc0, Acc).
 
-:- func foldr_node(func(T, U) = U, cord_node(T), U) = U.
+:- pred foldr_node(func(T, U) = U, cord_node(T), list(cord_node(T)), U, U).
+:- mode foldr_node(in(func(in, in) = out is det), in, in, in, out) is det.
 
-foldr_node(F, unit_node(X), Acc) = F(X, Acc).
-foldr_node(F, list_node(H, T), Acc) = list.foldr(F, [H | T], Acc).
-foldr_node(F, branch_node(A, B), Acc) =
-    foldr_node(F, A, foldr_node(F, B, Acc)).
+foldr_node(F, C, Cs, !Acc) :-
+    (
+        C = unit_node(X),
+        F(X, !.Acc) = !:Acc
+    ;
+        C = list_node(H, T),
+        list.foldr(F, [H | T], !.Acc) = !:Acc
+    ),
+    (
+        Cs = []
+    ;
+        Cs = [Y | Ys],
+        foldr_node(F, Y, Ys, !Acc)
+    ).
+foldr_node(F, branch_node(A, B), Cs, !Acc) :-
+    foldr_node(F, B, [A | Cs], !Acc).
 
 foldr_pred(_P, empty_cord, !Acc).
 foldr_pred(P, nonempty_cord(N), !Acc) :-
-    foldr_node_pred(P, N, !Acc).
+    foldr_node_pred(P, N, [], !Acc).
 
-:- pred foldr_node_pred(pred(T, U, U), cord_node(T), U, U).
-:- mode foldr_node_pred(in(pred(in, in, out) is det), in, in, out) is det.
-:- mode foldr_node_pred(in(pred(in, mdi, muo) is det), in, mdi, muo) is det.
-:- mode foldr_node_pred(in(pred(in, di, uo) is det), in, di, uo) is det.
-:- mode foldr_node_pred(in(pred(in, in, out) is semidet), in, in, out)
+:- pred foldr_node_pred(pred(T, U, U), cord_node(T), list(cord_node(T)), U, U).
+:- mode foldr_node_pred(in(pred(in, in, out) is det), in, in, in, out) is det.
+:- mode foldr_node_pred(in(pred(in, mdi, muo) is det), in, in, mdi, muo)
+    is det.
+:- mode foldr_node_pred(in(pred(in, di, uo) is det), in, in, di, uo) is det.
+:- mode foldr_node_pred(in(pred(in, in, out) is semidet), in, in, in, out)
     is semidet.
-:- mode foldr_node_pred(in(pred(in, mdi, muo) is semidet), in, mdi, muo)
+:- mode foldr_node_pred(in(pred(in, mdi, muo) is semidet), in, in, mdi, muo)
     is semidet.
-:- mode foldr_node_pred(in(pred(in, di, uo) is semidet), in, di, uo)
+:- mode foldr_node_pred(in(pred(in, di, uo) is semidet), in, in, di, uo)
     is semidet.
 
-foldr_node_pred(P, unit_node(X), !Acc) :-
-    P(X, !Acc).
-foldr_node_pred(P, list_node(H, T), !Acc) :-
-    list.foldr(P, [H | T], !Acc).
-foldr_node_pred(P, branch_node(A, B), !Acc) :-
-    foldr_node_pred(P, B, !Acc),
-    foldr_node_pred(P, A, !Acc).
+foldr_node_pred(P, C, Cs, !Acc) :-
+    (
+        C = unit_node(X),
+        P(X, !Acc)
+    ;
+        C = list_node(H, T),
+        list.foldr(P, [H | T], !Acc)
+    ),
+    (
+        Cs = []
+    ;
+        Cs = [Y | Ys],
+        foldr_node_pred(P, Y, Ys, !Acc)
+    ).
+foldr_node_pred(P, branch_node(A, B), Cs, !Acc) :-
+    foldr_node_pred(P, B, [A | Cs], !Acc).
 
 %-----------------------------------------------------------------------------%
 
diff --git a/tests/hard_coded/test_cord2.exp b/tests/hard_coded/test_cord2.exp
index e52ed51..4341d34 100644
--- a/tests/hard_coded/test_cord2.exp
+++ b/tests/hard_coded/test_cord2.exp
@@ -117,5 +117,8 @@ nonempty_cord(branch_node(branch_node(list_node(2, [3, 4]), list_node(2, [3, 4])
 [2, 3, 4, 2, 3, 4, 2, 3, 4, 2, 3, 4]
 [4, 3, 2, 4, 3, 2, 4, 3, 2, 4, 3, 2]
 
+Test folds
+done.
+
 Test cord_list_to_cord and cord_list_to_list
 done.
diff --git a/tests/hard_coded/test_cord2.m b/tests/hard_coded/test_cord2.m
index 0e3c1b8..f5cc800 100644
--- a/tests/hard_coded/test_cord2.m
+++ b/tests/hard_coded/test_cord2.m
@@ -23,6 +23,10 @@ main(!IO) :-
     solutions(gen_cord3, Cords),
     list.foldl(test_list_and_rev_list, Cords, !IO),
 
+    io.write_string("\nTest folds\n", !IO),
+    list.foldl(test_folds, Cords, !IO),
+    io.write_string("done.\n", !IO),
+
     io.write_string("\nTest cord_list_to_cord and cord_list_to_list\n", !IO),
     solutions(gen_cord_list, CordLists),
     list.foldl(test_cord_list_funcs, CordLists, !IO),
@@ -48,6 +52,22 @@ test_list_and_rev_list(Cord, !IO) :-
     expect(unify(List, reverse(RevList)),
         $module, $pred, "List != reverse(RevList)").
 
+:- pred test_folds((cord(int))::in, io::di, io::uo) is det.
+
+test_folds(Cord, !IO) :-
+    List = cord.list(Cord),
+    RevList = cord.rev_list(Cord),
+
+    cord.foldl(list.cons, Cord, []) = FoldlResultA,
+    cord.foldl_pred(list.cons, Cord, [], FoldlResultB),
+    expect(unify(FoldlResultA, RevList), $module, $pred, "foldl wrong"),
+    expect(unify(FoldlResultB, RevList), $module, $pred, "foldl_pred wrong"),
+
+    cord.foldr(list.cons, Cord, []) = FoldrResultA,
+    cord.foldr_pred(list.cons, Cord, [], FoldrResultB),
+    expect(unify(FoldrResultA, List), $module, $pred, "foldr wrong"),
+    expect(unify(FoldrResultB, List), $module, $pred, "foldr_pred wrong").
+
 :- pred test_cord_list_funcs(list(cord(int))::in, io::di, io::uo) is det.
 
 test_cord_list_funcs(Cords, !IO) :-




More information about the reviews mailing list