[m-rev.] for review: bt_array__map implementation; bsearch last argument type qn

[Peter Moulder]

It's nice to be able to switch back and forth between array and bt_array
relatively easily.  The minimum index thing is one obvious difference
(all bt_array creation methods take a Low argument; no array creation
methods do).  This isn't a huge issue, just adding to the number of
changes to be done (though beware the High/Size distinction).

A more serious difference is that bt_array currently doesn't have a
`map' predicate/function.  The below patch adds that.

There's also a question on bsearch's last argument and determinism,
whether they should be maybe(int)/det or int/semidet.  It looks as if
it was originally int/semidet in both array and bt_array, and then
array__bsearch was changed (1.32) but not bt_array__bsearch.  Both
modules have a stability comment of medium-low.  Should
bt_array__bsearch be changed to maybe(int)/det ?

Currently I have only a in/out is det mode for the map pred/func, which
is all array__map has.  list__map has several other modes.  Should I add
any of them?  Perhaps just a in/out is semidet mode?

pjm.


Estimated hours taken: 4

library/bt_array.m:
	New `bt_array__map/3' predicate and `bt_array__map/2' function.
	Documentation additions & changes.
tests/general/array.m:
tests/general/array.exp:
	Test array__map and bt_array__map predicates.

Index: library/bt_array.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/bt_array.m,v
retrieving revision 1.9
diff -d -u -r1.9 bt_array.m
--- library/bt_array.m	13 Dec 2000 00:00:39 -0000	1.9
+++ library/bt_array.m	15 Mar 2002 06:00:05 -0000
@@ -33,15 +33,15 @@
 
 %-----------------------------------------------------------------------------%
 
-	% bt_array__init(Low, Array) creates a bt_array of size zero
-	% starting at index Low.
+	% bt_array__make_empty_array(Low, Array) creates a bt_array of size
+	% zero starting at index Low.
 :- pred bt_array__make_empty_array(int, bt_array(T)).
 :- mode bt_array__make_empty_array(in, out) is det.
 
 :- func bt_array__make_empty_array(int) = bt_array(T).
 
-	% bt_array__init creates a bt_array with bounds from Low to High,
-	% with each element initialized to Init.
+	% bt_array__init(Low, High, Init, Array) creates a bt_array with bounds
+	% from Low to High, with each element initialized to Init.
 :- pred bt_array__init(int, int, T, bt_array(T)).
 :- mode bt_array__init(in, in, in, out) is det. % want a bt_array_skeleton?
 
@@ -170,9 +170,23 @@
 	% order.  Fails if the element is not present.  If the
 	% element to be found appears multiple times, the index of
 	% the first occurrence is returned.
+	% (Note: the last argument is an int rather than maybe(int) as in
+	% array__bsearch.  XXX: The discrepancy should probably be removed.
+	% Both modules have Stability: medium-low.  It appears that int/semidet
+	% was the original behavior, based on the `Fails if ...' comment still
+	% present in array__bsearch.  So should probably change this to
+	% maybe(int)/det.)
 :- pred bt_array__bsearch(bt_array(T), T, pred(T, T, comparison_result), int).
 :- mode bt_array__bsearch(in, in, pred(in, in, out) is det, out) is semidet.
 
+	% bt_array__map(Closure, OldArray, NewArray) applys `Closure' to
+	% each of the elements of `OldArray' to create `NewArray'.
+:- pred bt_array__map(pred(T1, T2), bt_array(T1), bt_array(T2)).
+:- mode bt_array__map(pred(in, out) is det, in, out) is det.
+
+:- func bt_array__map(func(T1) = T2, bt_array(T1)) = bt_array(T2).
+:- mode bt_array__map(func(in) = out is det, in) = out is det.
+
 	% Field selection for arrays.
 	% Array ^ elem(Index) = bt_array__lookup(Array, Index).
 :- func bt_array__elem(int, bt_array(T)) = T.
@@ -445,6 +459,15 @@
 	).
 
 %-----------------------------------------------------------------------------%
+
+bt_array__map(Pred, bt_array(Low, High, OldRaList), bt_array(Low, High, NewRaList)):-
+	ra_list_map(Pred, OldRaList, NewRaList).
+
+bt_array__map(Func, OldArray) = NewArray :-
+	Pred = ( pred(X::in, Y::out) is det :- Y = Func(X) ),
+	bt_array__map(Pred, OldArray, NewArray).
+
+%-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
 % This is a perfect application for submodules, but Mercury doesn't have
@@ -484,6 +507,12 @@
 
 %-----------------------------------------------------------------------------%
 
+	% Position (for both lookup and update) is specified as a non-negative
+	% integer where 0 indicates the head.
+	%
+	% lookup and update each fail if the specified position is negative or
+	% >= length.
+
 :- pred ra_list_lookup(int, ra_list(T), T).
 :- mode ra_list_lookup(in, in, out) is semidet.
 
@@ -492,6 +521,20 @@
 
 %-----------------------------------------------------------------------------%
 
+	% Discard the N head-most elements: ra_list_drop(N, Big, Small) is true
+	% iff Big contains at least N elements and Small is the same as Big
+	% except without the head-most N elements.  (Unless N<0, in which case
+	% the behavior in the current implementation is as for N=0.  Perhaps
+	% should instead call error for N<0.)
+	%
+	% Declaratively equivalent to:
+	%   ra_list_drop(N, Big, Small):-
+	%     (N =< 0 ->
+	%	Small = Big
+	%     ;
+	%	ra_list_tail(Big, Tail),
+	%	ra_list_drop(N - 1, Tail, Small)
+	%     ).
 :- pred ra_list_drop(int, ra_list(T), ra_list(T)).
 :- mode ra_list_drop(in, in, out) is semidet.
 
@@ -552,8 +595,13 @@
 :- pragma inline(ra_list_lookup/3).
 
 ra_list_lookup(I, List, X) :-
-	I >= 0,
-	ra_list_lookup_2(I, List, X).
+	% Must test before calling ra_list_lookup_2 to avoid infinite loop
+	% hence using `if' rather than simple conjunction, which has no
+	% order guarantee in the default, strict-commutative, semantics.
+	I >= 0 ->
+		ra_list_lookup_2(I, List, X)
+	;
+		fail.
 
 :- pred ra_list_lookup_2(int, ra_list(T), T).
 :- mode ra_list_lookup_2(in, in, out) is semidet.
@@ -628,13 +676,34 @@
 
 %-----------------------------------------------------------------------------%
 
+:- pred ra_list_map(pred(T1, T2), ra_list(T1), ra_list(T2)).
+:- mode ra_list_map(pred(in, out) is det, in, out) is det.
+
+ra_list_map(_Closure, nil, nil).
+ra_list_map(Closure, cons(Size, A_BT, A_Rest), cons(Size, B_BT, B_Rest)) :-
+	ra_list_bintree_map(Closure, A_BT, B_BT),
+	ra_list_map(Closure, A_Rest, B_Rest).
+
+:- pred ra_list_bintree_map(pred(T1, T2), ra_list_bintree(T1), ra_list_bintree(T2)).
+:- mode ra_list_bintree_map(pred(in, out) is det, in, out) is det.
+
+ra_list_bintree_map(Closure, leaf(A), leaf(B)):-
+	call(Closure, A, B).
+
+ra_list_bintree_map(Closure, node(A_X, A_T1, A_T2), node(B_X, B_T1, B_T2)):-
+	call(Closure, A_X, B_X),
+	ra_list_bintree_map(Closure, A_T1, B_T1),
+	ra_list_bintree_map(Closure, A_T2, B_T2).
+
+%-----------------------------------------------------------------------------%
+
 ra_list_drop(N, As, Bs) :-
 	(
 		N > 0
 	->
-		As = cons(Size, _, Cs),
-		( Size < N ->
-			N1 is N - Size,
+		As = cons(AHeadTreeSize, _AHeadTree, Cs),
+		( AHeadTreeSize =< N ->
+			N1 is N - AHeadTreeSize,
 			ra_list_drop(N1, Cs, Bs)
 		;
 			ra_list_slow_drop(N, As, Bs)
Index: tests/general/array_test.m
===================================================================
RCS file: /home/mercury1/repository/tests/general/array_test.m,v
retrieving revision 1.4
diff -d -u -r1.4 array_test.m
--- tests/general/array_test.m	24 Apr 2001 03:59:13 -0000	1.4
+++ tests/general/array_test.m	15 Mar 2002 06:00:05 -0000
@@ -50,6 +50,9 @@
 	{ A5 = array__sort(array(list__reverse(1 `..` 10))) },
 	{ array__to_list(A5, As5) },
 	write_message_int_list("A5: ", As5),
+	{ array__map((pred(X::in, X2::out) is det:- X2 is X * X), A5, A6) },
+	{ array__to_list(A6, As6) },
+	write_message_int_list("A6: ", As6),
 
 	{ bt_array__from_list(0, Xs, B0) },
 	{ bt_array__to_list(B0, Bs0) },
@@ -78,6 +81,9 @@
 	{ bt_array__shrink(B2, 0, 9, B3) },
 	{ bt_array__to_list(B3, Bs3) },
 	write_message_int_list("B3: ", Bs3),
+	{ bt_array__map((pred(X::in, X2::out) is det:- X2 is X * X), bt_array(1 `..` 10), B6) },
+	{ bt_array__to_list(B6, Bs6) },
+	write_message_int_list("B6: ", Bs6),
 
 	% Finally, just in case, compare the two implementations.
 	(
@@ -96,6 +102,7 @@
 			As1 = Bs1,
 			As2 = Bs2,
 			As3 = Bs3,
+			As6 = Bs6,
 			As1 = As3,	% Sanity check
 			Bs1 = Bs3	% Sanity check
 		}
Index: tests/general/array_test.exp
===================================================================
RCS file: /home/mercury1/repository/tests/general/array_test.exp,v
retrieving revision 1.2
diff -d -u -r1.2 array_test.exp
--- tests/general/array_test.exp	20 Feb 2001 10:42:17 -0000	1.2
+++ tests/general/array_test.exp	15 Mar 2002 06:00:05 -0000
@@ -10,6 +10,7 @@
 A3: [1, 2, 3, 4, 5, 6, 7, 8, 100, 10]
 A4: [1, 2, 3, 4, 5, 6, 7, 8, 9, 10]
 A5: [1, 2, 3, 4, 5, 6, 7, 8, 9, 10]
+A6: [1, 4, 9, 16, 25, 36, 49, 64, 81, 100]
 B0: [1, 2, 3, 4, 5, 6, 7, 8, 9, 10]
 BMax0: 9
 BMin0: 0
@@ -20,4 +21,5 @@
 B1: [1, 2, 3, 4, 5, 6, 7, 8, 100, 10]
 B2: [1, 2, 3, 4, 5, 6, 7, 8, 100, 10, 1000, 1000, 1000, 1000, 1000]
 B3: [1, 2, 3, 4, 5, 6, 7, 8, 100, 10]
+B6: [1, 4, 9, 16, 25, 36, 49, 64, 81, 100]
 Results all match
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------