[m-rev.] diff: add some library predicates

Julien Fischer jfischer at opturion.com
Wed Sep 20 20:36:07 AEST 2023


Add some library predicates.

library/list.m:
     Add map_corresponding4.

library/rbtree.m:
     Add foldr, foldr2 and foldr_values.

NEWS.md:
      Announce the above.

Julien.

diff --git a/NEWS.md b/NEWS.md
index 18fbdde..89e04f4 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -506,6 +506,8 @@ Changes to the Mercury standard library
      - pred `intersperse_list_last/4`
      - pred `is_singleton/2`
      - pred `last_gap_foldl/6`
+    - func `map_corresponding4/5`
+    - pred `map_corresponding4/6`
      - func `take_while_not/2`
      - pred `take_while_not/3`
      - pred `take_while_not/4`
@@ -657,6 +659,15 @@ Changes to the Mercury standard library
      - pred `permutation/4`
              (replacement: `random.shuffle_list/4` or `random.shuffle_list/5`)

+### Changes to the `rbtree` module
+
+* The following predicates and functions have been added:
+
+    - func `foldr/3`
+    - pred `foldr/4`
+    - pred `foldr2/6`
+    - pred `foldr_values/4`
+
  ### Changes to the `set` module

  * The following obsolete predicates and function have been removed:
diff --git a/library/list.m b/library/list.m
index 4917436..fc4fe57 100644
--- a/library/list.m
+++ b/library/list.m
@@ -2,7 +2,7 @@
  % vim: ft=mercury ts=4 sw=4 et
  %---------------------------------------------------------------------------%
  % Copyright (C) 1993-2012 The University of Melbourne.
-% Copyright (C) 2013-2022 The Mercury team.
+% Copyright (C) 2013-2023 The Mercury team.
  % This file is distributed under the terms specified in COPYING.LIB.
  %---------------------------------------------------------------------------%
  %
@@ -1127,6 +1127,20 @@
  :- mode map_corresponding3(in(pred(in, in, in, out) is semidet),
      in, in, in, out) is semidet.

+    % map_corresponding4(F, [A1, .. An], [B1, .. Bn], [C1, .. Cn],
+    %   [D1, .. Dn]) = [F(A1, B1, C1, D1), .., F(An, Bn, Cn, Dn)].
+    %
+    % Raises an exception if the list arguments differ in length.
+    %
+:- func map_corresponding4(func(A, B, C, D) = R, list(A), list(B), list(C),
+    list(D)) = list(R).
+:- pred map_corresponding4(pred(A, B, C, D, R), list(A), list(B), list(C),
+    list(D), list(R)).
+:- mode map_corresponding4(in(pred(in, in, in, in, out) is det),
+    in, in, in, in, out) is det.
+:- mode map_corresponding4(in(pred(in, in, in, in, out) is semidet),
+    in, in, in, in, out) is semidet.
+
  %---------------------%

      % filter_map_corresponding/3 does the same job as map_corresponding/3,
@@ -3595,6 +3609,46 @@ map_corresponding3(P, A, B, C, R) :-
          unexpected($pred, "mismatched list lengths")
      ).

+map_corresponding4(F, A, B, C, D) =
+    ( if
+        A = [AH | AT],
+        B = [BH | BT],
+        C = [CH | CT],
+        D = [DH | DT]
+    then
+        [F(AH, BH, CH, DH) | list.map_corresponding4(F, AT, BT, CT, DT)]
+    else if
+        A = [],
+        B = [],
+        C = [],
+        D = []
+    then
+        []
+    else
+        unexpected($pred, "mismatched list lengths")
+    ).
+
+map_corresponding4(P, A, B, C, D, R) :-
+    ( if
+        A = [AH | AT],
+        B = [BH | BT],
+        C = [CH | CT],
+        D = [DH | DT]
+    then
+        P(AH, BH, CH, DH, RH),
+        list.map_corresponding4(P, AT, BT, CT, DT, RT),
+        R = [RH | RT]
+    else if
+        A = [],
+        B = [],
+        C = [],
+        D = []
+    then
+        R = []
+    else
+        unexpected($pred, "mismatched list lengths")
+    ).
+
  %---------------------------------------------------------------------------%

  filter_map_corresponding(_, [], []) = [].
diff --git a/library/rbtree.m b/library/rbtree.m
index e06cc6a..c47d52e 100644
--- a/library/rbtree.m
+++ b/library/rbtree.m
@@ -2,7 +2,7 @@
  % vim: ft=mercury ts=4 sw=4 et
  %---------------------------------------------------------------------------%
  % Copyright (C) 1995-2000, 2003-2007, 2011 The University of Melbourne.
-% Copyright (C) 2014-2018 The Mercury team.
+% Copyright (C) 2014-2019, 2021, 2023 The Mercury team.
  % This file is distributed under the terms specified in COPYING.LIB.
  %---------------------------------------------------------------------------%
  %
@@ -245,6 +245,40 @@
  :- mode foldl2_values(in(pred(in, in, out, di, uo) is semidet), in, in, out,
      di, uo) is semidet.

+:- func foldr(func(K, V, A) = A, rbtree(K, V), A) = A.
+:- pred foldr(pred(K, V, A, A), rbtree(K, V), A, A).
+:- mode foldr(in(pred(in, in, in, out) is det), in, in, out) is det.
+:- mode foldr(in(pred(in, in, mdi, muo) is det), in, mdi, muo) is det.
+:- mode foldr(in(pred(in, in, di, uo) is det), in, di, uo) is det.
+:- mode foldr(in(pred(in, in, in, out) is semidet), in, in, out) is semidet.
+:- mode foldr(in(pred(in, in, mdi, muo) is semidet), in, mdi, muo) is semidet.
+:- mode foldr(in(pred(in, in, di, uo) is semidet), in, di, uo) is semidet.
+
+:- pred foldr2(pred(K, V, A, A, B, B), rbtree(K, V), A, A, B, B).
+:- mode foldr2(in(pred(in, in, in, out, in, out) is det),
+    in, in, out, in, out) is det.
+:- mode foldr2(in(pred(in, in, in, out, mdi, muo) is det),
+    in, in, out, mdi, muo) is det.
+:- mode foldr2(in(pred(in, in, in, out, di, uo) is det),
+    in, in, out, di, uo) is det.
+:- mode foldr2(in(pred(in, in, di, uo, di, uo) is det),
+    in, di, uo, di, uo) is det.
+:- mode foldr2(in(pred(in, in, in, out, in, out) is semidet),
+    in, in, out, in, out) is semidet.
+:- mode foldr2(in(pred(in, in, in, out, mdi, muo) is semidet),
+    in, in, out, mdi, muo) is semidet.
+:- mode foldr2(in(pred(in, in, in, out, di, uo) is semidet),
+    in, in, out, di, uo) is semidet.
+
+:- pred foldr_values(pred(V, A, A), rbtree(K, V), A, A).
+:- mode foldr_values(in(pred(in, in, out) is det), in, in, out) is det.
+:- mode foldr_values(in(pred(in, mdi, muo) is det), in, mdi, muo) is det.
+:- mode foldr_values(in(pred(in, di, uo) is det), in, di, uo) is det.
+:- mode foldr_values(in(pred(in, in, out) is semidet), in, in, out) is semidet.
+:- mode foldr_values(in(pred(in, mdi, muo) is semidet), in, mdi, muo)
+    is semidet.
+:- mode foldr_values(in(pred(in, di, uo) is semidet), in, di, uo) is semidet.
+
  :- func map_values(func(K, V) = W, rbtree(K, V)) = rbtree(K, W).
  :- pred map_values(pred(K, V, W), rbtree(K, V), rbtree(K, W)).
  :- mode map_values(in(pred(in, in, out) is det), in, out) is det.
@@ -1128,6 +1162,46 @@ foldl2_values(Pred, black(_K, V, Left, Right), !Acc1, !Acc2) :-

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

+foldr(F, T, A) = B :-
+    P = ( pred(W::in, X::in, Y::in, Z::out) is det :- Z = F(W, X, Y) ),
+    rbtree.foldr(P, T, A, B).
+
+foldr(_Pred, empty, !Acc).
+foldr(Pred, red(K, V, Left, Right), !Acc) :-
+    rbtree.foldr(Pred, Right, !Acc),
+    Pred(K, V, !Acc),
+    rbtree.foldr(Pred, Left, !Acc).
+foldr(Pred, black(K, V, Left, Right), !Acc) :-
+    rbtree.foldr(Pred, Right, !Acc),
+    Pred(K, V, !Acc),
+    rbtree.foldr(Pred, Left, !Acc).
+
+%---------------------------------------------------------------------------%
+
+foldr2(_, empty, !Acc1, !Acc2).
+foldr2(Pred, red(K, V, Left, Right), !Acc1, !Acc2) :-
+    rbtree.foldr2(Pred, Right, !Acc1, !Acc2),
+    Pred(K, V, !Acc1, !Acc2),
+    rbtree.foldr2(Pred, Left, !Acc1, !Acc2).
+foldr2(Pred, black(K, V, Left, Right), !Acc1, !Acc2) :-
+    rbtree.foldr2(Pred, Right, !Acc1, !Acc2),
+    Pred(K, V, !Acc1, !Acc2),
+    rbtree.foldr2(Pred, Left, !Acc1, !Acc2).
+
+%---------------------------------------------------------------------------%
+
+foldr_values(_Pred, empty, !Acc).
+foldr_values(Pred, red(_K, V, Left, Right), !Acc) :-
+    rbtree.foldr_values(Pred, Right, !Acc),
+    Pred(V, !Acc),
+    rbtree.foldr_values(Pred, Left, !Acc).
+foldr_values(Pred, black(_K, V, Left, Right), !Acc) :-
+    rbtree.foldr_values(Pred, Right, !Acc),
+    Pred(V, !Acc),
+    rbtree.foldr_values(Pred, Left, !Acc).
+
+%---------------------------------------------------------------------------%
+
  map_values(F, T1) = T2 :-
      P = ( pred(X::in, Y::in, Z::out) is det :- Z = F(X, Y) ),
      rbtree.map_values(P, T1, T2).




More information about the reviews mailing list