[m-rev.] for review: add transform_value predicate to map.

[Ian MacLarty]

For review by anyone.

Estimated hours taken: 2
Branches: main

Add transform_value predicate to map, tree234 and rbtree.  This applies
a higher order argument to a value in the map.  Often a value needs to be 
updated using its previous value, currently requiring two lookups of the
key.  With transform_value only one lookup is required.

NEWS
	Mention the new predicate.

library/map.m
library/rbtree.m
library/tree234.m
	Add transform_value.

library/require.m
	Add a version of report_lookup_error that doesn't take a value 
	argument, since the value argument is not available in transform_value.

tests/hard_coded/Mmakefile
tests/hard_coded/transform_value.exp
tests/hard_coded/transform_value.m
	Test transform_value.

Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.360
diff -u -r1.360 NEWS
--- NEWS	11 Jan 2005 06:06:14 -0000	1.360
+++ NEWS	12 Jan 2005 07:32:41 -0000
@@ -234,7 +234,7 @@
   variables.  We've also added a function version. 
 
 * We've added some new predicates, map__common_subset, map__foldl3,
-  and map__overlay_large_map, to map.m.
+  map__overlay_large_map and map__transform_value, to map.m.
 
 * We've added a predicate, map_fold, to set.m.
 
Index: library/map.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/map.m,v
retrieving revision 1.93
diff -u -r1.93 map.m
--- library/map.m	10 Jan 2005 05:23:46 -0000	1.93
+++ library/map.m	12 Jan 2005 02:25:33 -0000
@@ -124,6 +124,20 @@
 :- pred map__det_update(map(K, V)::in, K::in, V::in, map(K, V)::out) is det.
 :- func map__det_update(map(K, V), K, V) = map(K, V).
 
+	% Update the value at the given key by applying the supplied 
+	% transformation to it.  Fails if the key is not found.  This is faster
+	% that first searching for the value and then updating it.
+	%
+:- pred map__transform_value(pred(V, V)::in(pred(in, out) is det), K::in, 
+	map(K, V)::in, map(K, V)::out) is semidet.
+
+	% Same as transform_value/4, but aborts instead of failing if the
+	% key is not found.
+	%
+:- pred map__det_transform_value(pred(V, V)::in(pred(in, out) is det), K::in, 
+	map(K, V)::in, map(K, V)::out) is det.
+:- func map__det_transform_value(func(V) = V, K, map(K, V)) = map(K, V).
+
 	% Update value if the key is already present, otherwise
 	% insert new key and value.
 :- pred map__set(map(K, V), K, V, map(K, V)).
@@ -563,6 +577,23 @@
 	;
 		report_lookup_error("map__det_update: key not found", K, V)
 	).
+
+map__transform_value(P, K, !Map) :-
+	tree234__transform_value(P, K, !Map).
+
+map__det_transform_value(P, K, !Map) :-
+	(
+		map__transform_value(P, K, !.Map, NewMap)
+	->
+		!:Map = NewMap
+	;
+		report_lookup_error("map__det_transform_value: key not found",
+			K)
+	).
+
+map__det_transform_value(F, K, Map0) = Map :-
+	map__det_transform_value(pred(V0::in, V::out) is det :- V = F(V0), K, 
+		Map0, Map).
 
 map__set(Map0, K, V, Map) :-
 	tree234__set(Map0, K, V, Map).
Index: library/rbtree.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/rbtree.m,v
retrieving revision 1.17
diff -u -r1.17 rbtree.m
--- library/rbtree.m	11 Nov 2004 13:46:40 -0000	1.17
+++ library/rbtree.m	12 Jan 2005 02:44:45 -0000
@@ -15,6 +15,9 @@
 %	fails if key already in tree.
 % update:
 %	changes value of key already in tree.  fails if key doesn't exist.
+% transform_value:
+%	looks up an existing value in the tree, applies a transformation to the
+%	value and then updates the value.  fails if the key doesn't exist.
 % set:
 %	inserts or updates. Never fails.
 %
@@ -63,6 +66,13 @@
 :- pred rbtree__update(rbtree(K, V)::in, K::in, V::in, rbtree(K, V)::out)
 	is semidet.
 
+	% Update the value at the given key by applying the supplied 
+	% transformation to it.  Fails if the key is not found.  This is faster
+	% that first searching for the value and then updating it.
+	%
+:- pred rbtree__transform_value(pred(V, V)::in(pred(in, out) is det), K::in, 
+	rbtree(K, V)::in, rbtree(K, V)::out) is semidet.
+
 	% Sets a value regardless of whether key exists or not.
 	%
 :- func rbtree__set(rbtree(K, V), K, V) = rbtree(K, V).
@@ -390,6 +400,43 @@
 		Tree = black(K0, V0, NewL, R)
 	;
 		rbtree__update(R, K, V, NewR),
+		Tree = black(K0, V0, L, NewR)
+	).
+
+%-----------------------------------------------------------------------------%
+
+rbtree__transform_value(_P, _K, empty, _T) :-
+	fail.
+rbtree__transform_value(P, K, red(K0, V0, L, R), Tree) :-
+	compare(Result, K, K0),
+	(
+		Result = (=)
+	->
+		P(V0, NewV),
+		Tree = red(K, NewV, L, R)
+	;
+		Result = (<)
+	->
+		rbtree__transform_value(P, K, L, NewL),
+		Tree = red(K0, V0, NewL, R)
+	;
+		rbtree__transform_value(P, K, R, NewR),
+		Tree = red(K0, V0, L, NewR)
+	).
+rbtree__transform_value(P, K, black(K0, V0, L, R), Tree) :-
+	compare(Result, K, K0),
+	(
+		Result = (=)
+	->
+		P(V0, NewV),
+		Tree = black(K, NewV, L, R)
+	;
+		Result = (<)
+	->
+		rbtree__transform_value(P, K, L, NewL),
+		Tree = black(K0, V0, NewL, R)
+	;
+		rbtree__transform_value(P, K, R, NewR),
 		Tree = black(K0, V0, L, NewR)
 	).
 
Index: library/require.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/require.m,v
retrieving revision 1.31
diff -u -r1.31 require.m
--- library/require.m	13 Nov 2003 17:06:11 -0000	1.31
+++ library/require.m	11 Jan 2005 08:23:22 -0000
@@ -50,6 +50,15 @@
 %		Key and Value.  The error message will include Message
 %		and information about Key and Value.
 
+:- pred report_lookup_error(string, K).
+:- mode report_lookup_error(in, in) is erroneous.
+
+%	report_lookup_error(Message, Key)
+%		Call error/1 with an error message that is appropriate for
+%		the failure of a lookup operation involving the specified
+%		Key.  The error message will include Message
+%		and information about Key.
+
 %-----------------------------------------------------------------------------%
 
 :- implementation.
@@ -84,6 +93,25 @@
 		FunctorStr,
 		"\n\tValue Type: ",
 		ValueType
+		],
+		ErrorString),
+	error(ErrorString).
+
+report_lookup_error(Msg, K) :-
+	KeyType = type_name(type_of(K)),
+	functor(K, Functor, Arity),
+	( Arity = 0 ->
+		FunctorStr = Functor
+	;
+		string__int_to_string(Arity, ArityStr),
+		string__append_list([Functor, "/", ArityStr], FunctorStr)
+	),
+	string__append_list(
+		[Msg,
+		"\n\tKey Type: ",
+		KeyType,
+		"\n\tKey Functor: ",
+		FunctorStr
 		],
 		ErrorString),
 	error(ErrorString).
Index: library/tree234.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/tree234.m,v
retrieving revision 1.44
diff -u -r1.44 tree234.m
--- library/tree234.m	16 Dec 2004 03:17:28 -0000	1.44
+++ library/tree234.m	11 Jan 2005 08:08:11 -0000
@@ -115,6 +115,13 @@
 % :- mode tree234__update(di_tree234, in, in, uo_tree234) is det.
 % :- mode tree234__update(di, di, di, uo) is semidet.
 
+	% Update the value at the given key by applying the supplied 
+	% transformation to it.  This is faster that first searching for 
+	% the value and then updating it.
+	%
+:- pred tree234__transform_value(pred(V, V)::in(pred(in, out) is det), K::in, 
+	tree234(K, V)::in, tree234(K, V)::out) is semidet.
+
 	% count the number of elements in a tree
 :- pred tree234__count(tree234(K, V), int).
 :- mode tree234__count(in, out) is det.
@@ -774,6 +781,104 @@
 			;
 				Result2 = (>),
 				tree234__update(T3, K, V, NewT3),
+				Tout = four(K0, V0, K1, V1, K2, V2,
+					T0, T1, T2, NewT3)
+			)
+		)
+	).
+
+%------------------------------------------------------------------------------%
+
+tree234__transform_value(P, K, Tin, Tout) :-
+	(
+		Tin = empty,
+		fail
+	;
+		Tin = two(K0, V0, T0, T1),
+		compare(Result, K, K0),
+		(
+			Result = (<),
+			tree234__transform_value(P, K, T0, NewT0),
+			Tout = two(K0, V0, NewT0, T1)
+		;
+			Result = (=),
+			P(V0, VNew),
+			Tout = two(K0, VNew, T0, T1)
+		;
+			Result = (>),
+			tree234__transform_value(P, K, T1, NewT1),
+			Tout = two(K0, V0, T0, NewT1)
+		)
+	;
+		Tin = three(K0, V0, K1, V1, T0, T1, T2),
+		compare(Result0, K, K0),
+		(
+			Result0 = (<),
+			tree234__transform_value(P, K, T0, NewT0),
+			Tout = three(K0, V0, K1, V1, NewT0, T1, T2)
+		;
+			Result0 = (=),
+			P(V0, VNew),
+			Tout = three(K0, VNew, K1, V1, T0, T1, T2)
+		;
+			Result0 = (>),
+			compare(Result1, K, K1),
+			(
+				Result1 = (<),
+				tree234__transform_value(P, K, T1, NewT1),
+				Tout = three(K0, V0, K1, V1, T0, NewT1, T2)
+			;
+				Result1 = (=),
+				P(V1, VNew),
+				Tout = three(K0, V0, K1, VNew, T0, T1, T2)
+			;
+				Result1 = (>),
+				tree234__transform_value(P, K, T2, NewT2),
+				Tout = three(K0, V0, K1, V1, T0, T1, NewT2)
+			)
+		)
+	;
+		Tin = four(K0, V0, K1, V1, K2, V2, T0, T1, T2, T3),
+		compare(Result1, K, K1),
+		(
+			Result1 = (<),
+			compare(Result0, K, K0),
+			(
+				Result0 = (<),
+				tree234__transform_value(P, K, T0, NewT0),
+				Tout = four(K0, V0, K1, V1, K2, V2,
+					NewT0, T1, T2, T3)
+			;
+				Result0 = (=),
+				P(V0, VNew),
+				Tout = four(K0, VNew, K1, V1, K2, V2,
+					T0, T1, T2, T3)
+			;
+				Result0 = (>),
+				tree234__transform_value(P, K, T1, NewT1),
+				Tout = four(K0, V0, K1, V1, K2, V2,
+					T0, NewT1, T2, T3)
+			)
+		;
+			Result1 = (=),
+			P(V1, VNew),
+			Tout = four(K0, V0, K1, VNew, K2, V2, T0, T1, T2, T3)
+		;
+			Result1 = (>),
+			compare(Result2, K, K2),
+			(
+				Result2 = (<),
+				tree234__transform_value(P, K, T2, NewT2),
+				Tout = four(K0, V0, K1, V1, K2, V2,
+					T0, T1, NewT2, T3)
+			;
+				Result2 = (=),
+				P(V2, VNew),
+				Tout = four(K0, V0, K1, V1, K2, VNew,
+					T0, T1, T2, T3)
+			;
+				Result2 = (>),
+				tree234__transform_value(P, K, T3, NewT3),
 				Tout = four(K0, V0, K1, V1, K2, V2,
 					T0, T1, T2, NewT3)
 			)
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.246
diff -u -r1.246 Mmakefile
--- tests/hard_coded/Mmakefile	10 Jan 2005 01:47:30 -0000	1.246
+++ tests/hard_coded/Mmakefile	12 Jan 2005 02:33:26 -0000
@@ -170,6 +170,7 @@
 	time_test \
 	tim_qual1 \
 	trans_intermod_user_equality \
+	transform_value \
 	transitive_inst_type \
 	tuple_test \
 	tuple_test \
Index: tests/hard_coded/transform_value.exp
===================================================================
RCS file: tests/hard_coded/transform_value.exp
diff -N tests/hard_coded/transform_value.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/transform_value.exp	12 Jan 2005 02:55:00 -0000
@@ -0,0 +1,6 @@
+2
+key not found
+2
+2
+[1 - 2, 2 - 2, 3 - 2, 4 - 2, 5 - 2, 6 - 2, 7 - 2, 8 - 2]
+[1 - 2, 2 - 2]
Index: tests/hard_coded/transform_value.m
===================================================================
RCS file: tests/hard_coded/transform_value.m
diff -N tests/hard_coded/transform_value.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/transform_value.m	12 Jan 2005 02:54:48 -0000
@@ -0,0 +1,73 @@
+% Test the map.transform_value predicate.
+%
+
+:- module transform_value.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module map, int, svmap, list, assoc_list, rbtree.
+
+main(!IO) :-
+	some [!M] (
+		!:M = map.init,
+		svmap.set(1, 1, !M),
+		svmap.set(2, 1, !M),
+		svmap.set(3, 1, !M),
+		svmap.set(4, 1, !M),
+		svmap.set(5, 1, !M),
+		svmap.set(6, 1, !M),
+		svmap.set(7, 1, !M),
+		svmap.set(8, 1, !M),
+		M0 = !.M,
+		( map.transform_value(add1, 2, !.M, M1) ->
+			io.write_int(M1 ^ det_elem(2), !IO)
+		;
+			io.write_string("key not found", !IO)
+		),
+		io.nl(!IO),
+		( map.transform_value(add1, 9, !.M, M2) ->
+			io.write_int(M2 ^ det_elem(9), !IO)
+		;
+			io.write_string("key not found", !IO)
+		),
+		io.nl(!IO),
+		map.det_transform_value(add1, 3, !M),
+		io.write_int(!.M ^ det_elem(3), !IO),
+		io.nl(!IO),
+		M3 = map.det_transform_value(f, 7, !.M),
+		io.write_int(M3 ^ det_elem(7), !IO),
+		io.nl(!IO),
+		list.foldl(map.det_transform_value(add1), 
+			[1, 2, 3, 4, 5, 6, 7, 8], M0, M4),
+		A`with_type`assoc_list(int, int) = map.to_assoc_list(M4),
+		io.write(A, !IO),
+		io.nl(!IO),
+		RB0 = rbtree.init,
+		rbtree.set(RB0, 1, 1, RB1),
+		rbtree.set(RB1, 2, 1, RB2),
+		(
+			rbtree.transform_value(add1, 1, RB2, RB3),
+			rbtree.transform_value(add1, 2, RB3, RB4)
+		->
+			A2`with_type`assoc_list(int, int) = 
+				rbtree.rbtree_to_assoc_list(RB4),
+			io.write(A2, !IO)
+		;
+			io.write_string("key not found", !IO)
+		),
+		io.nl(!IO)
+	).
+		
+:- pred add1(int::in, int::out) is det.
+
+add1(X, X+1).
+
+:- func f(int) = int.
+
+f(X) = X+1.
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------