[m-dev.] for review: destructive changes to string.m

[Michael Day]

Estimated hours taken: 2
 
Allows checking string length without losing uniqueness and adds
predicates to allow changing arbitrary characters in a string, handy for
implementation of string streams.
 
library/string.m:
	Added a new mode definition to string__length/2 using unique input
	so as not to destroy uniqueness when checking string length.

	Added three new predicates, string__set_char, set_char_det and 
	unsafe_set_char that allow changing arbitrary characters in a
	string. These function similarly to the corresponding index,
	index_det and unsafe_index predicates.

	Also changes index implementation to use MR_Unsigned not MR_Word.

Index: string.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/string.m,v
retrieving revision 1.134
diff -u -r1.134 string.m
--- string.m	2000/11/06 04:32:20	1.134
+++ string.m	2000/11/11 12:39:49
@@ -23,6 +23,7 @@
 
 :- pred string__length(string, int).
 :- mode string__length(in, uo) is det.
+:- mode string__length(ui, uo) is det.
 	% Determine the length of a string.
 	% An empty string has length zero.
 
@@ -215,6 +216,36 @@
 %	may be linear in the length of the string.
 %	Use with care!
 
+:- pred string__set_char(char, int, string, string).
+:- mode string__set_char(in, in, in, out) is semidet.
+:- mode string__set_char(in, in, di, uo) is semidet.
+%	string__set_char(Char, Index, String0, String):
+%	`String' is `String0' with the (`Index' + 1)-th character
+%	set to `Char'.
+%	Fails if `Index' is out of range (negative, or greater than or
+%	equal to the length of `String0').
+
+:- pred string__set_char_det(char, int, string, string).
+:- mode string__set_char_det(in, in, in, out) is det.
+:- mode string__set_char_det(in, in, di, uo) is det.
+%	string__set_char_det(Char, Index, String0, String):
+%	`String' is `String0' with the (`Index' + 1)-th character
+%	set to `Char'.
+%	Calls error/1 if `Index' is out of range (negative, or greater than or
+%	equal to the length of `String0').
+
+:- pred string__unsafe_set_char(char, int, string, string).
+:- mode string__unsafe_set_char(in, in, in, out) is det.
+:- mode string__unsafe_set_char(in, in, di, uo) is det.
+%	string__unsafe_set_char(Char, Index, String0, String):
+%	`String' is `String0' with the (`Index' + 1)-th character
+%	set to `Char'.
+%	WARNING: behavior is UNDEFINED if `Index' is out of range
+%	(negative, or greater than or equal to the length of `String0').
+%	This version is constant time, whereas string__set_char_det
+%	may be linear in the length of the string.
+%	Use with care!
+
 :- pred string__foldl(pred(char, T, T), string, T, T).
 :- mode string__foldl(pred(in, in, out) is det, in, in, out) is det.
 :- mode string__foldl(pred(in, di, uo) is det, in, di, uo) is det.
@@ -489,6 +520,13 @@
 		error("string__index_det: index out of range")
 	).
 
+string__set_char_det(Char, Int, String0, String) :-
+	( string__set_char(Char, Int, String0, String1) ->
+		String = String1
+	;
+		error("string__set_char_det: index out of range")
+	).
+
 string__foldl(Closure, String, Acc0, Acc) :-
 	string__length(String, Length),
 	string__foldl2(Closure, String, 0, Length, Acc0, Acc).
@@ -1427,7 +1465,7 @@
                 ** get an integer overflow error in this case).
                 */
 
-	if ((MR_Word) Index >= strlen(Str)) {
+	if ((MR_Unsigned) Index >= strlen(Str)) {
 		SUCCESS_INDICATOR = FALSE;
 	} else {
 		SUCCESS_INDICATOR = TRUE;
@@ -1445,14 +1483,81 @@
 /*-----------------------------------------------------------------------*/
 
 /*
+:- pred string__set_char(char, int, string, string).
+:- mode string__set_char(in, in, in, out) is semidet.
+*/
+:- pragma c_code(string__set_char(Ch::in, Index::in, Str0::in, Str::out),
+		[will_not_call_mercury, thread_safe], "
+	size_t len = strlen(Str0);
+	if ((MR_Unsigned) Index >= len) {
+		SUCCESS_INDICATOR = FALSE;
+	} else {
+		SUCCESS_INDICATOR = TRUE;
+		MR_allocate_aligned_string_msg(Str, len, MR_PROC_LABEL);
+		strcpy(Str, Str0);
+		Str[Index] = Ch;
+	}
+").
+
+/*
+:- pred string__set_char(char, int, string, string).
+:- mode string__set_char(in, in, di, uo) is semidet.
+*/
+:- pragma c_code(string__set_char(Ch::in, Index::in, Str0::di, Str::uo),
+		[will_not_call_mercury, thread_safe], "
+	if ((MR_Unsigned) Index >= strlen(Str0)) {
+		SUCCESS_INDICATOR = FALSE;
+	} else {
+		SUCCESS_INDICATOR = TRUE;
+		Str = Str0;
+		Str[Index] = Ch;
+	}
+").
+
+/*-----------------------------------------------------------------------*/
+
+/*
+:- pred string__unsafe_set_char(char, int, string, string).
+:- mode string__unsafe_set_char(in, in, in, out) is det.
+*/
+:- pragma c_code(string__unsafe_set_char(Ch::in, Index::in, Str0::in, Str::out),
+		[will_not_call_mercury, thread_safe], "
+	size_t len = strlen(Str0);
+	MR_allocate_aligned_string_msg(Str, len, MR_PROC_LABEL);
+	strcpy(Str, Str0);
+	Str[Index] = Ch;
+").
+
+/*
+:- pred string__unsafe_set_char(char, int, string, string).
+:- mode string__unsafe_set_char(in, in, di, uo) is det.
+*/
+:- pragma c_code(string__unsafe_set_char(Ch::in, Index::in, Str0::di, Str::uo),
+		[will_not_call_mercury, thread_safe], "
+	Str = Str0;
+	Str[Index] = Ch;
+").
+
+/*-----------------------------------------------------------------------*/
+
+/*
 :- pred string__length(string, int).
-:- mode string__length(in, out) is det.
+:- mode string__length(in, uo) is det.
 */
 :- pragma c_code(string__length(Str::in, Length::uo),
 		[will_not_call_mercury, thread_safe], "
 	Length = strlen(Str);
 ").
 
+/*
+:- pred string__length(string, int).
+:- mode string__length(ui, uo) is det.
+*/
+:- pragma c_code(string__length(Str::ui, Length::uo),
+		[will_not_call_mercury, thread_safe], "
+	Length = strlen(Str);
+").
+
 /*-----------------------------------------------------------------------*/
 
 /*
@@ -1718,6 +1823,7 @@
 :- interface.
 
 :- func string__length(string) = int.
+:- mode string__length(in) = uo is det.
 
 :- func string__append(string, string) = string.
 

--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------