[m-dev.] For review: updates to library/rbtree.m
Warwick Harvey
wh at icparc.ic.ac.uk
Sat May 13 08:00:33 AEST 2000
Hi folks,
I know you all thought you'd gotten rid of me when I moved to London,
but I just can't help myself... :-) Looks like I'll always find an
excuse to do *something* with the best programming language in the
world. (Oops, am I allowed to say that? ;-)
As per some private mail exchanged with Fergus, I've been looking at the
rbtree module, as an alternative to tree234 as the underlying
implementation of map. It was missing a few things that tree234 has,
and as such was not plug-in compatible. These changes fix that by
bringing rbtree "up to speed", so to speak.
These changes come in two parts. The first part just adds the missing
functionality to the interface, and is all I need. The second part adds
limited support for unique modes, so that the module truly is a drop-in
replacement for implementing map. I added this mainly so I can test the
module by bootchecking the compiler using it (in progress), but partly
also just to see if I could get the modes to work. I'll adjust the log
message if necessary, depending on which version you folks want me to
commit.
I've included full diffs for the two different versions, as well as a
relative diff between the two.
Cheers,
Warwick
(P.S. Please Cc: replies to me, since I'm no longer on the developer's
mailing list. Thanks.)
-------------- next part --------------
Estimated hours taken: 3
This change updates the `rbtree' module, so that its interface is compatible
with that of `tree234', and thus it can be used as an alternative underlying
implementation for `map'.
library/rbtree.m:
Added the predicates `is_empty/1', `member/3', `remove_smallest/4',
`foldl/4' and `map_values/3', with the same meaning as
the corresponding predicates from `tree234'. Also added was
`remove_largest/4', since it was readily available and complements
`remove_smallest/4'. `remove/3' has had an extra argument added
to it to make it compatible with `remove/4' from `tree234'.
The old interface has been kept, but should be considered obsolete.
Internally, `get_tree_min/4' and `get_tree_max/4' were
renamed and made `semidet' to provide `remove_smallest/4' and
`remove_largest/4', with their meaning altered so that they
failed if the tree was empty, rather than aborting with an error.
Also added was limited support for unique modes (to the same level
as `tree234'), in order to support the `map' module's unique modes.
Unfortunately this seems to require some code duplication, since
`delete/3' doesn't mode check when implemented by calling
`remove/4'. (The `tree234' module seems to have the same kind of
duplication.) A few other minor hacks were necessary.
-------------- next part --------------
Index: rbtree.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/rbtree.m,v
retrieving revision 1.12
diff -u -r1.12 rbtree.m
--- rbtree.m 2000/05/12 17:28:44 1.12
+++ rbtree.m 2000/05/12 21:13:03
@@ -46,6 +46,10 @@
:- pred rbtree__init(rbtree(K, V)).
:- mode rbtree__init(out) is det.
+ % Check whether a tree is empty.
+:- pred rbtree__is_empty(rbtree(K, V)).
+:- mode rbtree__is_empty(in) is semidet.
+
% Inserts a new key-value pair into the tree. Fails if key
% already in the tree.
:- pred rbtree__insert(rbtree(K, V), K, V, rbtree(K, V)).
@@ -65,6 +69,9 @@
:- pred rbtree__insert_duplicate(rbtree(K, V), K, V, rbtree(K, V)).
:- mode rbtree__insert_duplicate(in, in, in, out) is det.
+:- pred rbtree__member(rbtree(K, V), K, V).
+:- mode rbtree__member(in, out, out) is nondet.
+
% Search for a key-value pair using the key. Fails if key doesn't
% exist.
:- pred rbtree__search(rbtree(K, V), K, V).
@@ -106,9 +113,25 @@
% Remove the key value pair associated with a key. Fails
% if the key doesn't exist.
+:- pred rbtree__remove(rbtree(K, V), K, V, rbtree(K, V)).
+:- mode rbtree__remove(in, in, out, out) is semidet.
+
+ % Same as above, except this version does not return the value
+ % corresponding to the key. Its use is deprecated, but it is
+ % kept for compatibility with older versions of this library.
:- pred rbtree__remove(rbtree(K, V), K, rbtree(K, V)).
:- mode rbtree__remove(in, in, out) is semidet.
+ % Deletes the node with the minimum K from the tree, and returns
+ % the key and value fields.
+:- pred rbtree__remove_smallest(rbtree(K, V), K, V, rbtree(K, V)).
+:- mode rbtree__remove_smallest(in, out, out, out) is semidet.
+
+ % Deletes the node with the maximum K from the tree, and returns
+ % the key and value fields.
+:- pred rbtree__remove_largest(rbtree(K, V), K, V, rbtree(K, V)).
+:- mode rbtree__remove_largest(in, out, out, out) is semidet.
+
% Returns an in-order list of all the keys in the rbtree.
:- pred rbtree__keys(rbtree(K, V), list(K)).
:- mode rbtree__keys(in, out) is det.
@@ -128,6 +151,15 @@
:- pred rbtree__rbtree_to_assoc_list(rbtree(K, V), assoc_list(K, V)).
:- mode rbtree__rbtree_to_assoc_list(in, out) is det.
+:- pred rbtree__foldl(pred(K, V, T, T), rbtree(K, V), T, T).
+:- mode rbtree__foldl(pred(in, in, in, out) is det, in, in, out) is det.
+:- mode rbtree__foldl(pred(in, in, in, out) is semidet, in, in, out)
+ is semidet.
+
+:- pred rbtree__map_values(pred(K, V, W), rbtree(K, V), rbtree(K, W)).
+:- mode rbtree__map_values(pred(in, in, out) is det, in, out) is det.
+:- mode rbtree__map_values(pred(in, in, out) is semidet, in, out) is semidet.
+
%-----------------------------------------------------------------------------%
:- implementation.
@@ -143,6 +175,9 @@
rbtree__init(empty).
+rbtree__is_empty(Tree) :-
+ Tree = empty.
+
%-----------------------------------------------------------------------------%
% Special conditions that must be satisfied by Red-Black trees.
@@ -584,6 +619,28 @@
%-----------------------------------------------------------------------------%
+rbtree__member(empty, _K, _V) :- fail.
+rbtree__member(red(K0, V0, Left, Right), K, V) :-
+ (
+ K = K0,
+ V = V0
+ ;
+ rbtree__member(Left, K, V)
+ ;
+ rbtree__member(Right, K, V)
+ ).
+rbtree__member(black(K0, V0, Left, Right), K, V) :-
+ (
+ K = K0,
+ V = V0
+ ;
+ rbtree__member(Left, K, V)
+ ;
+ rbtree__member(Right, K, V)
+ ).
+
+%-----------------------------------------------------------------------------%
+
rbtree__search(Tree, K, V) :-
( Tree = red(K0, V0, Left, Right)
; Tree = black(K0, V0, Left, Right)
@@ -682,7 +739,7 @@
rbtree__delete(Tree0, K, Tree) :-
(
- rbtree__remove(Tree0, K, Tree1)
+ rbtree__remove(Tree0, K, _, Tree1)
->
Tree = Tree1
;
@@ -705,79 +762,81 @@
%
% Algorithm O(log N).
-rbtree__remove(empty, _K, _Tree) :-
+rbtree__remove(empty, _K, _V, _Tree) :-
fail.
-rbtree__remove(red(K0, V0, L, R), K, Tree) :-
+rbtree__remove(red(K0, V0, L, R), K, V, Tree) :-
compare(Result, K, K0),
(
Result = (=)
->
(
- L = empty
- ->
+ rbtree__remove_largest(L, NewK, NewV, NewL)
+ ->
+ Tree = red(NewK, NewV, NewL, R)
+ ;
+ % L must be empty
(
- R = empty
+ rbtree__remove_smallest(R, NewK, NewV, NewR)
->
- Tree = empty
- ;
- rbtree__get_tree_min(R, NewK, NewV, NewR),
Tree = red(NewK, NewV, L, NewR)
+ ;
+ % R must be empty
+ Tree = empty
)
- ;
- rbtree__get_tree_max(L, NewK, NewV, NewL),
- Tree = red(NewK, NewV, NewL, R)
- )
+ ),
+ V = V0
;
Result = (<)
->
- rbtree__remove(L, K, NewL),
+ rbtree__remove(L, K, V, NewL),
Tree = red(K0, V0, NewL, R)
;
- rbtree__remove(R, K, NewR),
+ rbtree__remove(R, K, V, NewR),
Tree = red(K0, V0, L, NewR)
).
-rbtree__remove(black(K0, V0, L, R), K, Tree) :-
+rbtree__remove(black(K0, V0, L, R), K, V, Tree) :-
compare(Result, K, K0),
(
Result = (=)
->
(
- L = empty
- ->
+ rbtree__remove_largest(L, NewK, NewV, NewL)
+ ->
+ Tree = black(NewK, NewV, NewL, R)
+ ;
+ % L must be empty
(
- R = empty
+ rbtree__remove_smallest(R, NewK, NewV, NewR)
->
- Tree = empty
- ;
- rbtree__get_tree_min(R, NewK, NewV, NewR),
Tree = black(NewK, NewV, L, NewR)
+ ;
+ % R must be empty
+ Tree = empty
)
- ;
- rbtree__get_tree_max(L, NewK, NewV, NewL),
- Tree = black(NewK, NewV, NewL, R)
- )
+ ),
+ V = V0
;
Result = (<)
->
- rbtree__remove(L, K, NewL),
+ rbtree__remove(L, K, V, NewL),
Tree = black(K0, V0, NewL, R)
;
- rbtree__remove(R, K, NewR),
+ rbtree__remove(R, K, V, NewR),
Tree = black(K0, V0, L, NewR)
).
+
+rbtree__remove(Tree0, K, Tree) :-
+ rbtree__remove(Tree0, K, _, Tree).
-% rbtree__get_tree_max:
+% rbtree__remove_largest:
% Deletes the node with the maximum K from the tree, and returns the
% key and value fields.
-:- pred rbtree__get_tree_max(rbtree(K, V), K, V, rbtree(K, V)).
-:- mode rbtree__get_tree_max(in, out, out, out) is det.
-
-rbtree__get_tree_max(empty, _K, _V, _Tree) :-
- error("rbtree__get_tree_max: attempted to get K+V from empty tree").
-rbtree__get_tree_max(red(K0, V0, L, R), NewK, NewV, Tree) :-
+rbtree__remove_largest(empty, _K, _V, _Tree) :-
+ fail.
+rbtree__remove_largest(red(K0, V0, L, R), NewK, NewV, Tree) :-
(
R = empty
->
@@ -785,10 +844,10 @@
NewV = V0,
Tree = L
;
- rbtree__get_tree_max(R, NewK, NewV, NewR),
+ rbtree__remove_largest(R, NewK, NewV, NewR),
Tree = red(K0, V0, L, NewR)
).
-rbtree__get_tree_max(black(K0, V0, L, R), NewK, NewV, Tree) :-
+rbtree__remove_largest(black(K0, V0, L, R), NewK, NewV, Tree) :-
(
R = empty
->
@@ -796,20 +855,17 @@
NewV = V0,
Tree = L
;
- rbtree__get_tree_max(R, NewK, NewV, NewR),
+ rbtree__remove_largest(R, NewK, NewV, NewR),
Tree = black(K0, V0, L, NewR)
).
-% rbtree__get_tree_min:
+% rbtree__remove_smallest:
% Deletes the node with the minimum K from the tree, and returns the
% key and value fields.
-:- pred rbtree__get_tree_min(rbtree(K, V), K, V, rbtree(K, V)).
-:- mode rbtree__get_tree_min(in, out, out, out) is det.
-
-rbtree__get_tree_min(empty, _K, _V, _Tree) :-
- error("rbtree__get_tree_min: attempted to get K+V from empty tree").
-rbtree__get_tree_min(red(K0, V0, L, R), NewK, NewV, Tree) :-
+rbtree__remove_smallest(empty, _K, _V, _Tree) :-
+ fail.
+rbtree__remove_smallest(red(K0, V0, L, R), NewK, NewV, Tree) :-
(
L = empty
->
@@ -817,10 +873,10 @@
NewV = V0,
Tree = R
;
- rbtree__get_tree_min(L, NewK, NewV, NewL),
+ rbtree__remove_smallest(L, NewK, NewV, NewL),
Tree = red(K0, V0, NewL, R)
).
-rbtree__get_tree_min(black(K0, V0, L, R), NewK, NewV, Tree) :-
+rbtree__remove_smallest(black(K0, V0, L, R), NewK, NewV, Tree) :-
(
L = empty
->
@@ -828,7 +884,7 @@
NewV = V0,
Tree = R
;
- rbtree__get_tree_min(L, NewK, NewV, NewL),
+ rbtree__remove_smallest(L, NewK, NewV, NewL),
Tree = black(K0, V0, NewL, R)
).
@@ -890,7 +946,35 @@
list__append(L0, [K0 - V0|L1], L).
%-----------------------------------------------------------------------------%
+
+rbtree__foldl(_Pred, empty, Acc, Acc).
+rbtree__foldl(Pred, red(K, V, Left, Right), Acc0, Acc) :-
+ rbtree__foldl(Pred, Left, Acc0, Acc1),
+ call(Pred, K, V, Acc1, Acc2),
+ rbtree__foldl(Pred, Right, Acc2, Acc).
+rbtree__foldl(Pred, black(K, V, Left, Right), Acc0, Acc) :-
+ rbtree__foldl(Pred, Left, Acc0, Acc1),
+ call(Pred, K, V, Acc1, Acc2),
+ rbtree__foldl(Pred, Right, Acc2, Acc).
+
+%-----------------------------------------------------------------------------%
+
+rbtree__map_values(_Pred, empty, empty).
+rbtree__map_values(Pred, Tree0, Tree) :-
+ Tree0 = red(K0, V0, Left0, Right0),
+ Tree = red(K0, W0, Left, Right),
+ call(Pred, K0, V0, W0),
+ rbtree__map_values(Pred, Left0, Left),
+ rbtree__map_values(Pred, Right0, Right).
+rbtree__map_values(Pred, Tree0, Tree) :-
+ Tree0 = black(K0, V0, Left0, Right0),
+ Tree = black(K0, W0, Left, Right),
+ call(Pred, K0, V0, W0),
+ rbtree__map_values(Pred, Left0, Left),
+ rbtree__map_values(Pred, Right0, Right).
+
%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
% Ralph Becket <rwab1 at cl.cam.ac.uk> 29/04/99
% Function forms added.
@@ -916,6 +1000,10 @@
:- func rbtree__rbtree_to_assoc_list(rbtree(K, V)) = assoc_list(K, V).
+:- func rbtree__foldl(func(K, V, T) = T, rbtree(K, V), T) = T.
+
+:- func rbtree__map_values(func(K, V) = W, rbtree(K, V)) = rbtree(K, W).
+
% ---------------------------------------------------------------------------- %
% ---------------------------------------------------------------------------- %
@@ -951,4 +1039,11 @@
rbtree__rbtree_to_assoc_list(RBT) = AL :-
rbtree__rbtree_to_assoc_list(RBT, AL).
+rbtree__foldl(F, T, A) = B :-
+ P = ( pred(W::in, X::in, Y::in, Z::out) is det :- Z = F(W, X, Y) ),
+ rbtree__foldl(P, T, A, B).
+
+rbtree__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).
-------------- next part --------------
Index: rbtree.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/rbtree.m,v
retrieving revision 1.12
diff -u -r1.12 rbtree.m
--- rbtree.m 2000/05/12 17:28:44 1.12
+++ rbtree.m 2000/05/12 21:38:36
@@ -44,8 +44,12 @@
% Initialise the data structure.
:- pred rbtree__init(rbtree(K, V)).
-:- mode rbtree__init(out) is det.
+:- mode rbtree__init(uo) is det.
+ % Check whether a tree is empty.
+:- pred rbtree__is_empty(rbtree(K, V)).
+:- mode rbtree__is_empty(in) is semidet.
+
% Inserts a new key-value pair into the tree. Fails if key
% already in the tree.
:- pred rbtree__insert(rbtree(K, V), K, V, rbtree(K, V)).
@@ -59,12 +63,16 @@
% Sets a value irregardless of whether key exists or not. Never
% fails.
:- pred rbtree__set(rbtree(K, V), K, V, rbtree(K, V)).
+:- mode rbtree__set(di, di, di, uo) is det.
:- mode rbtree__set(in, in, in, out) is det.
% Insert a duplicate key into the tree. Never fails.
:- pred rbtree__insert_duplicate(rbtree(K, V), K, V, rbtree(K, V)).
:- mode rbtree__insert_duplicate(in, in, in, out) is det.
+:- pred rbtree__member(rbtree(K, V), K, V).
+:- mode rbtree__member(in, out, out) is nondet.
+
% Search for a key-value pair using the key. Fails if key doesn't
% exist.
:- pred rbtree__search(rbtree(K, V), K, V).
@@ -102,13 +110,33 @@
% Delete the key value pair associated with a key. Does nothing
% if the key doesn't exist.
:- pred rbtree__delete(rbtree(K, V), K, rbtree(K, V)).
+:- mode rbtree__delete(di, in, uo) is det.
:- mode rbtree__delete(in, in, out) is det.
% Remove the key value pair associated with a key. Fails
% if the key doesn't exist.
+:- pred rbtree__remove(rbtree(K, V), K, V, rbtree(K, V)).
+:- mode rbtree__remove(di, in, uo, uo) is semidet.
+:- mode rbtree__remove(in, in, out, out) is semidet.
+
+ % Same as above, except this version does not return the value
+ % corresponding to the key. Its use is deprecated, but it is
+ % kept for compatibility with older versions of this library.
:- pred rbtree__remove(rbtree(K, V), K, rbtree(K, V)).
:- mode rbtree__remove(in, in, out) is semidet.
+ % Deletes the node with the minimum K from the tree, and returns
+ % the key and value fields.
+:- pred rbtree__remove_smallest(rbtree(K, V), K, V, rbtree(K, V)).
+:- mode rbtree__remove_smallest(di, uo, uo, uo) is semidet.
+:- mode rbtree__remove_smallest(in, out, out, out) is semidet.
+
+ % Deletes the node with the maximum K from the tree, and returns
+ % the key and value fields.
+:- pred rbtree__remove_largest(rbtree(K, V), K, V, rbtree(K, V)).
+:- mode rbtree__remove_largest(di, uo, uo, uo) is semidet.
+:- mode rbtree__remove_largest(in, out, out, out) is semidet.
+
% Returns an in-order list of all the keys in the rbtree.
:- pred rbtree__keys(rbtree(K, V), list(K)).
:- mode rbtree__keys(in, out) is det.
@@ -128,6 +156,16 @@
:- pred rbtree__rbtree_to_assoc_list(rbtree(K, V), assoc_list(K, V)).
:- mode rbtree__rbtree_to_assoc_list(in, out) is det.
+:- pred rbtree__foldl(pred(K, V, T, T), rbtree(K, V), T, T).
+:- mode rbtree__foldl(pred(in, in, in, out) is det, in, in, out) is det.
+:- mode rbtree__foldl(pred(in, in, in, out) is semidet, in, in, out)
+ is semidet.
+:- mode rbtree__foldl(pred(in, in, di, uo) is det, in, di, uo) is det.
+
+:- pred rbtree__map_values(pred(K, V, W), rbtree(K, V), rbtree(K, W)).
+:- mode rbtree__map_values(pred(in, in, out) is det, in, out) is det.
+:- mode rbtree__map_values(pred(in, in, out) is semidet, in, out) is semidet.
+
%-----------------------------------------------------------------------------%
:- implementation.
@@ -143,6 +181,9 @@
rbtree__init(empty).
+rbtree__is_empty(Tree) :-
+ Tree = empty.
+
%-----------------------------------------------------------------------------%
% Special conditions that must be satisfied by Red-Black trees.
@@ -328,6 +369,7 @@
:- pred rbtree__set_2(rbtree(K, V), K, V, rbtree(K, V)).
+:- mode rbtree__set_2(di, di, di, uo) is det.
:- mode rbtree__set_2(in, in, in, out) is det.
% rbtree__set_2:
@@ -395,7 +437,10 @@
TreeR = red(K0, V0, LRR, R0),
Tree = black(LRK, LRV, TreeL, TreeR)
;
- Tree = black(K0, V0, NewL, R0)
+ % NewL2 == NewL, but this hack
+ % needed for unique modes to work.
+ NewL2 = red(LK, LV, LL, LR),
+ Tree = black(K0, V0, NewL2, R0)
)
;
Tree = black(K0, V0, NewL, R0)
@@ -422,7 +467,10 @@
TreeL = red(K0, V0, L0, RL),
Tree = black(RK, RV, TreeL, RR)
;
- Tree = black(K0, V0, L0, NewR)
+ % NewR2 == NewR, but this hack
+ % needed for unique modes to work.
+ NewR2 = red(RK, RV, RL, RR),
+ Tree = black(K0, V0, L0, NewR2)
)
;
Tree = black(K0, V0, L0, NewR)
@@ -584,6 +632,28 @@
%-----------------------------------------------------------------------------%
+rbtree__member(empty, _K, _V) :- fail.
+rbtree__member(red(K0, V0, Left, Right), K, V) :-
+ (
+ K = K0,
+ V = V0
+ ;
+ rbtree__member(Left, K, V)
+ ;
+ rbtree__member(Right, K, V)
+ ).
+rbtree__member(black(K0, V0, Left, Right), K, V) :-
+ (
+ K = K0,
+ V = V0
+ ;
+ rbtree__member(Left, K, V)
+ ;
+ rbtree__member(Right, K, V)
+ ).
+
+%-----------------------------------------------------------------------------%
+
rbtree__search(Tree, K, V) :-
( Tree = red(K0, V0, Left, Right)
; Tree = black(K0, V0, Left, Right)
@@ -680,15 +750,68 @@
%-----------------------------------------------------------------------------%
-rbtree__delete(Tree0, K, Tree) :-
- (
- rbtree__remove(Tree0, K, Tree1)
+rbtree__delete(empty, _K, empty).
+rbtree__delete(red(K0, V0, L, R), K, Tree) :-
+ compare(Result, K, K0),
+ (
+ Result = (=)
->
- Tree = Tree1
+ (
+ rbtree__remove_largest(L, NewK, NewV, NewL)
+ ->
+ Tree = red(NewK, NewV, NewL, R)
+ ;
+ % L must be empty
+ (
+ rbtree__remove_smallest(R, NewK, NewV, NewR)
+ ->
+ Tree = red(NewK, NewV, empty, NewR)
+ ;
+ % R must be empty
+ Tree = empty
+ )
+ )
;
- Tree = Tree0
+
+ Result = (<)
+ ->
+ rbtree__delete(L, K, NewL),
+ Tree = red(K0, V0, NewL, R)
+ ;
+ rbtree__delete(R, K, NewR),
+ Tree = red(K0, V0, L, NewR)
).
-
+rbtree__delete(black(K0, V0, L, R), K, Tree) :-
+ compare(Result, K, K0),
+ (
+ Result = (=)
+ ->
+ (
+ rbtree__remove_largest(L, NewK, NewV, NewL)
+ ->
+ Tree = black(NewK, NewV, NewL, R)
+ ;
+ % L must be empty
+ (
+ rbtree__remove_smallest(R, NewK, NewV, NewR)
+ ->
+ Tree = black(NewK, NewV, empty, NewR)
+ ;
+ % R must be empty
+ Tree = empty
+ )
+ )
+ ;
+
+ Result = (<)
+ ->
+ rbtree__delete(L, K, NewL),
+ Tree = black(K0, V0, NewL, R)
+ ;
+ rbtree__delete(R, K, NewR),
+ Tree = black(K0, V0, L, NewR)
+ ).
+
%-----------------------------------------------------------------------------%
% rbtree_remove:
@@ -705,79 +828,81 @@
%
% Algorithm O(log N).
-rbtree__remove(empty, _K, _Tree) :-
+rbtree__remove(empty, _K, _V, _Tree) :-
fail.
-rbtree__remove(red(K0, V0, L, R), K, Tree) :-
+rbtree__remove(red(K0, V0, L, R), K, V, Tree) :-
compare(Result, K, K0),
(
Result = (=)
->
(
- L = empty
- ->
+ rbtree__remove_largest(L, NewK, NewV, NewL)
+ ->
+ Tree = red(NewK, NewV, NewL, R)
+ ;
+ % L must be empty
(
- R = empty
+ rbtree__remove_smallest(R, NewK, NewV, NewR)
->
- Tree = empty
+ Tree = red(NewK, NewV, empty, NewR)
;
- rbtree__get_tree_min(R, NewK, NewV, NewR),
- Tree = red(NewK, NewV, L, NewR)
+ % R must be empty
+ Tree = empty
)
- ;
- rbtree__get_tree_max(L, NewK, NewV, NewL),
- Tree = red(NewK, NewV, NewL, R)
- )
+ ),
+ V = V0
;
Result = (<)
->
- rbtree__remove(L, K, NewL),
+ rbtree__remove(L, K, V, NewL),
Tree = red(K0, V0, NewL, R)
;
- rbtree__remove(R, K, NewR),
+ rbtree__remove(R, K, V, NewR),
Tree = red(K0, V0, L, NewR)
).
-rbtree__remove(black(K0, V0, L, R), K, Tree) :-
+rbtree__remove(black(K0, V0, L, R), K, V, Tree) :-
compare(Result, K, K0),
(
Result = (=)
->
(
- L = empty
- ->
+ rbtree__remove_largest(L, NewK, NewV, NewL)
+ ->
+ Tree = black(NewK, NewV, NewL, R)
+ ;
+ % L must be empty
(
- R = empty
+ rbtree__remove_smallest(R, NewK, NewV, NewR)
->
- Tree = empty
+ Tree = black(NewK, NewV, empty, NewR)
;
- rbtree__get_tree_min(R, NewK, NewV, NewR),
- Tree = black(NewK, NewV, L, NewR)
+ % R must be empty
+ Tree = empty
)
- ;
- rbtree__get_tree_max(L, NewK, NewV, NewL),
- Tree = black(NewK, NewV, NewL, R)
- )
+ ),
+ V = V0
;
Result = (<)
->
- rbtree__remove(L, K, NewL),
+ rbtree__remove(L, K, V, NewL),
Tree = black(K0, V0, NewL, R)
;
- rbtree__remove(R, K, NewR),
+ rbtree__remove(R, K, V, NewR),
Tree = black(K0, V0, L, NewR)
).
+
+rbtree__remove(Tree0, K, Tree) :-
+ rbtree__remove(Tree0, K, _, Tree).
-% rbtree__get_tree_max:
+% rbtree__remove_largest:
% Deletes the node with the maximum K from the tree, and returns the
% key and value fields.
-:- pred rbtree__get_tree_max(rbtree(K, V), K, V, rbtree(K, V)).
-:- mode rbtree__get_tree_max(in, out, out, out) is det.
-
-rbtree__get_tree_max(empty, _K, _V, _Tree) :-
- error("rbtree__get_tree_max: attempted to get K+V from empty tree").
-rbtree__get_tree_max(red(K0, V0, L, R), NewK, NewV, Tree) :-
+rbtree__remove_largest(empty, _K, _V, _Tree) :-
+ fail.
+rbtree__remove_largest(red(K0, V0, L, R), NewK, NewV, Tree) :-
(
R = empty
->
@@ -785,10 +910,10 @@
NewV = V0,
Tree = L
;
- rbtree__get_tree_max(R, NewK, NewV, NewR),
+ rbtree__remove_largest(R, NewK, NewV, NewR),
Tree = red(K0, V0, L, NewR)
).
-rbtree__get_tree_max(black(K0, V0, L, R), NewK, NewV, Tree) :-
+rbtree__remove_largest(black(K0, V0, L, R), NewK, NewV, Tree) :-
(
R = empty
->
@@ -796,20 +921,17 @@
NewV = V0,
Tree = L
;
- rbtree__get_tree_max(R, NewK, NewV, NewR),
+ rbtree__remove_largest(R, NewK, NewV, NewR),
Tree = black(K0, V0, L, NewR)
).
-% rbtree__get_tree_min:
+% rbtree__remove_smallest:
% Deletes the node with the minimum K from the tree, and returns the
% key and value fields.
-
-:- pred rbtree__get_tree_min(rbtree(K, V), K, V, rbtree(K, V)).
-:- mode rbtree__get_tree_min(in, out, out, out) is det.
-rbtree__get_tree_min(empty, _K, _V, _Tree) :-
- error("rbtree__get_tree_min: attempted to get K+V from empty tree").
-rbtree__get_tree_min(red(K0, V0, L, R), NewK, NewV, Tree) :-
+rbtree__remove_smallest(empty, _K, _V, _Tree) :-
+ fail.
+rbtree__remove_smallest(red(K0, V0, L, R), NewK, NewV, Tree) :-
(
L = empty
->
@@ -817,10 +939,10 @@
NewV = V0,
Tree = R
;
- rbtree__get_tree_min(L, NewK, NewV, NewL),
+ rbtree__remove_smallest(L, NewK, NewV, NewL),
Tree = red(K0, V0, NewL, R)
).
-rbtree__get_tree_min(black(K0, V0, L, R), NewK, NewV, Tree) :-
+rbtree__remove_smallest(black(K0, V0, L, R), NewK, NewV, Tree) :-
(
L = empty
->
@@ -828,7 +950,7 @@
NewV = V0,
Tree = R
;
- rbtree__get_tree_min(L, NewK, NewV, NewL),
+ rbtree__remove_smallest(L, NewK, NewV, NewL),
Tree = black(K0, V0, NewL, R)
).
@@ -890,6 +1012,34 @@
list__append(L0, [K0 - V0|L1], L).
%-----------------------------------------------------------------------------%
+
+rbtree__foldl(_Pred, empty, Acc, Acc).
+rbtree__foldl(Pred, red(K, V, Left, Right), Acc0, Acc) :-
+ rbtree__foldl(Pred, Left, Acc0, Acc1),
+ call(Pred, K, V, Acc1, Acc2),
+ rbtree__foldl(Pred, Right, Acc2, Acc).
+rbtree__foldl(Pred, black(K, V, Left, Right), Acc0, Acc) :-
+ rbtree__foldl(Pred, Left, Acc0, Acc1),
+ call(Pred, K, V, Acc1, Acc2),
+ rbtree__foldl(Pred, Right, Acc2, Acc).
+
+%-----------------------------------------------------------------------------%
+
+rbtree__map_values(_Pred, empty, empty).
+rbtree__map_values(Pred, Tree0, Tree) :-
+ Tree0 = red(K0, V0, Left0, Right0),
+ Tree = red(K0, W0, Left, Right),
+ call(Pred, K0, V0, W0),
+ rbtree__map_values(Pred, Left0, Left),
+ rbtree__map_values(Pred, Right0, Right).
+rbtree__map_values(Pred, Tree0, Tree) :-
+ Tree0 = black(K0, V0, Left0, Right0),
+ Tree = black(K0, W0, Left, Right),
+ call(Pred, K0, V0, W0),
+ rbtree__map_values(Pred, Left0, Left),
+ rbtree__map_values(Pred, Right0, Right).
+
+%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
% Ralph Becket <rwab1 at cl.cam.ac.uk> 29/04/99
% Function forms added.
@@ -916,6 +1066,10 @@
:- func rbtree__rbtree_to_assoc_list(rbtree(K, V)) = assoc_list(K, V).
+:- func rbtree__foldl(func(K, V, T) = T, rbtree(K, V), T) = T.
+
+:- func rbtree__map_values(func(K, V) = W, rbtree(K, V)) = rbtree(K, W).
+
% ---------------------------------------------------------------------------- %
% ---------------------------------------------------------------------------- %
@@ -951,4 +1105,11 @@
rbtree__rbtree_to_assoc_list(RBT) = AL :-
rbtree__rbtree_to_assoc_list(RBT, AL).
+rbtree__foldl(F, T, A) = B :-
+ P = ( pred(W::in, X::in, Y::in, Z::out) is det :- Z = F(W, X, Y) ),
+ rbtree__foldl(P, T, A, B).
+
+rbtree__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).
-------------- next part --------------
--- rbtree.m.non-unique Fri May 12 21:14:15 2000
+++ rbtree.m Fri May 12 22:38:05 2000
@@ -44,7 +44,7 @@
% Initialise the data structure.
:- pred rbtree__init(rbtree(K, V)).
-:- mode rbtree__init(out) is det.
+:- mode rbtree__init(uo) is det.
% Check whether a tree is empty.
:- pred rbtree__is_empty(rbtree(K, V)).
@@ -63,6 +63,7 @@
% Sets a value irregardless of whether key exists or not. Never
% fails.
:- pred rbtree__set(rbtree(K, V), K, V, rbtree(K, V)).
+:- mode rbtree__set(di, di, di, uo) is det.
:- mode rbtree__set(in, in, in, out) is det.
% Insert a duplicate key into the tree. Never fails.
@@ -109,11 +110,13 @@
% Delete the key value pair associated with a key. Does nothing
% if the key doesn't exist.
:- pred rbtree__delete(rbtree(K, V), K, rbtree(K, V)).
+:- mode rbtree__delete(di, in, uo) is det.
:- mode rbtree__delete(in, in, out) is det.
% Remove the key value pair associated with a key. Fails
% if the key doesn't exist.
:- pred rbtree__remove(rbtree(K, V), K, V, rbtree(K, V)).
+:- mode rbtree__remove(di, in, uo, uo) is semidet.
:- mode rbtree__remove(in, in, out, out) is semidet.
% Same as above, except this version does not return the value
@@ -125,11 +128,13 @@
% Deletes the node with the minimum K from the tree, and returns
% the key and value fields.
:- pred rbtree__remove_smallest(rbtree(K, V), K, V, rbtree(K, V)).
+:- mode rbtree__remove_smallest(di, uo, uo, uo) is semidet.
:- mode rbtree__remove_smallest(in, out, out, out) is semidet.
% Deletes the node with the maximum K from the tree, and returns
% the key and value fields.
:- pred rbtree__remove_largest(rbtree(K, V), K, V, rbtree(K, V)).
+:- mode rbtree__remove_largest(di, uo, uo, uo) is semidet.
:- mode rbtree__remove_largest(in, out, out, out) is semidet.
% Returns an in-order list of all the keys in the rbtree.
@@ -155,6 +160,7 @@
:- mode rbtree__foldl(pred(in, in, in, out) is det, in, in, out) is det.
:- mode rbtree__foldl(pred(in, in, in, out) is semidet, in, in, out)
is semidet.
+:- mode rbtree__foldl(pred(in, in, di, uo) is det, in, di, uo) is det.
:- pred rbtree__map_values(pred(K, V, W), rbtree(K, V), rbtree(K, W)).
:- mode rbtree__map_values(pred(in, in, out) is det, in, out) is det.
@@ -363,6 +369,7 @@
:- pred rbtree__set_2(rbtree(K, V), K, V, rbtree(K, V)).
+:- mode rbtree__set_2(di, di, di, uo) is det.
:- mode rbtree__set_2(in, in, in, out) is det.
% rbtree__set_2:
@@ -430,7 +437,10 @@
TreeR = red(K0, V0, LRR, R0),
Tree = black(LRK, LRV, TreeL, TreeR)
;
- Tree = black(K0, V0, NewL, R0)
+ % NewL2 == NewL, but this hack
+ % needed for unique modes to work.
+ NewL2 = red(LK, LV, LL, LR),
+ Tree = black(K0, V0, NewL2, R0)
)
;
Tree = black(K0, V0, NewL, R0)
@@ -457,7 +467,10 @@
TreeL = red(K0, V0, L0, RL),
Tree = black(RK, RV, TreeL, RR)
;
- Tree = black(K0, V0, L0, NewR)
+ % NewR2 == NewR, but this hack
+ % needed for unique modes to work.
+ NewR2 = red(RK, RV, RL, RR),
+ Tree = black(K0, V0, L0, NewR2)
)
;
Tree = black(K0, V0, L0, NewR)
@@ -737,15 +750,68 @@
%-----------------------------------------------------------------------------%
-rbtree__delete(Tree0, K, Tree) :-
- (
- rbtree__remove(Tree0, K, _, Tree1)
+rbtree__delete(empty, _K, empty).
+rbtree__delete(red(K0, V0, L, R), K, Tree) :-
+ compare(Result, K, K0),
+ (
+ Result = (=)
->
- Tree = Tree1
+ (
+ rbtree__remove_largest(L, NewK, NewV, NewL)
+ ->
+ Tree = red(NewK, NewV, NewL, R)
+ ;
+ % L must be empty
+ (
+ rbtree__remove_smallest(R, NewK, NewV, NewR)
+ ->
+ Tree = red(NewK, NewV, empty, NewR)
+ ;
+ % R must be empty
+ Tree = empty
+ )
+ )
;
- Tree = Tree0
+
+ Result = (<)
+ ->
+ rbtree__delete(L, K, NewL),
+ Tree = red(K0, V0, NewL, R)
+ ;
+ rbtree__delete(R, K, NewR),
+ Tree = red(K0, V0, L, NewR)
).
-
+rbtree__delete(black(K0, V0, L, R), K, Tree) :-
+ compare(Result, K, K0),
+ (
+ Result = (=)
+ ->
+ (
+ rbtree__remove_largest(L, NewK, NewV, NewL)
+ ->
+ Tree = black(NewK, NewV, NewL, R)
+ ;
+ % L must be empty
+ (
+ rbtree__remove_smallest(R, NewK, NewV, NewR)
+ ->
+ Tree = black(NewK, NewV, empty, NewR)
+ ;
+ % R must be empty
+ Tree = empty
+ )
+ )
+ ;
+
+ Result = (<)
+ ->
+ rbtree__delete(L, K, NewL),
+ Tree = black(K0, V0, NewL, R)
+ ;
+ rbtree__delete(R, K, NewR),
+ Tree = black(K0, V0, L, NewR)
+ ).
+
%-----------------------------------------------------------------------------%
% rbtree_remove:
@@ -778,7 +844,7 @@
(
rbtree__remove_smallest(R, NewK, NewV, NewR)
->
- Tree = red(NewK, NewV, L, NewR)
+ Tree = red(NewK, NewV, empty, NewR)
;
% R must be empty
Tree = empty
@@ -809,7 +875,7 @@
(
rbtree__remove_smallest(R, NewK, NewV, NewR)
->
- Tree = black(NewK, NewV, L, NewR)
+ Tree = black(NewK, NewV, empty, NewR)
;
% R must be empty
Tree = empty
More information about the developers
mailing list