[m-rev.] for review: mercury implementation of string.m

Peter Ross pro at missioncriticalit.com
Thu Jun 13 20:10:53 AEST 2002


Hi,


===================================================================


Estimated hours taken: 4
Branches: main

library/string.m:
	Provide a mercury implementation of every foreign_proc,
	calling private_builtin__sorry for those which are difficult
	to implement in mercury.
	Remove the unused reverse mode of string__to_int_list.



Index: string.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/string.m,v
retrieving revision 1.170
diff -u -r1.170 string.m
--- string.m	12 Jun 2002 06:46:44 -0000	1.170
+++ string.m	13 Jun 2002 10:06:37 -0000
@@ -89,10 +89,10 @@
 
 :- pred string__first_char(string, char, string).
 :- mode string__first_char(in, in, in) is semidet.	% implied
-:- mode string__first_char(in, out, in) is semidet.	% implied
-:- mode string__first_char(in, in, out) is semidet.	% implied
-:- mode string__first_char(in, out, out) is semidet.
-:- mode string__first_char(out, in, in) is det.
+:- mode string__first_char(in, uo, in) is semidet.	% implied
+:- mode string__first_char(in, in, uo) is semidet.	% implied
+:- mode string__first_char(in, uo, uo) is semidet.
+:- mode string__first_char(uo, in, in) is det.
 %	string__first_char(String, Char, Rest) is true iff
 %		Char is the first character of String, and Rest is the
 %		remainder.
@@ -142,8 +142,8 @@
 
 :- func string__to_char_list(string) = list(char).
 :- pred string__to_char_list(string, list(char)).
-:- mode string__to_char_list(in, out) is det.
-:- mode string__to_char_list(out, in) is det.
+:- mode string__to_char_list(in, uo) is det.
+:- mode string__to_char_list(uo, in) is det.
 
 :- func string__from_char_list(list(char)) = string.
 :- pred string__from_char_list(list(char), string).
@@ -461,7 +461,6 @@
 :- import_module bool, std_util, int, float, require.
 
 :- pred string__to_int_list(string, list(int)).
-:- mode string__to_int_list(out, in) is det.
 :- mode string__to_int_list(in, out) is det.
 
 string__replace(String, SubString0, SubString1, StringOut) :-
@@ -623,17 +622,16 @@
 	string__split(String, LeftCount, _LeftString, RightString).
 
 string__remove_suffix(A, B, C) :-
-	string__to_int_list(A, LA),
-	string__to_int_list(B, LB),
-	string__to_int_list(C, LC),
+	string__to_char_list(A, LA),
+	string__to_char_list(B, LB),
+	string__to_char_list(C, LC),
 	list__remove_suffix(LA, LB, LC).
 
 string__prefix(String, Prefix) :-
 	string__append(Prefix, _, String).
 
 string__char_to_string(Char, String) :-
-	string__to_int_list(String, [Code]),
-	char__to_int(Char, Code).
+	string__to_char_list(String, [Char]).
 
 string__int_to_string(N, Str) :-
 	string__int_to_base_string(N, 10, Str).
@@ -692,11 +690,12 @@
 
 /*
 :- pred string__to_char_list(string, list(char)).
-:- mode string__to_char_list(in, out) is det.
-:- mode string__to_char_list(out, in) is det.
+:- mode string__to_char_list(in, uo) is det.
+:- mode string__to_char_list(uo, in) is det.
 */
 
-:- pragma foreign_proc("C", string__to_char_list(Str::in, CharList::out),
+:- pragma promise_pure(string__to_char_list/2).
+:- pragma foreign_proc("C", string__to_char_list(Str::in, CharList::uo),
 		[will_not_call_mercury, promise_pure, thread_safe], "{
 	MR_ConstString p = Str + strlen(Str);
 	CharList = MR_list_empty_msg(MR_PROC_LABEL);
@@ -707,9 +706,9 @@
 	}
 }").
 
-:- pragma foreign_proc("C", string__to_char_list(Str::out, CharList::in),
+:- pragma foreign_proc("C", string__to_char_list(Str::uo, CharList::in),
 		[will_not_call_mercury, promise_pure, thread_safe], "{
-		/* mode (out, in) is det */
+		/* mode (uo, in) is det */
 	MR_Word char_list_ptr;
 	size_t size;
 /*
@@ -743,6 +742,56 @@
 	Str[size] = '\\0';
 }").
 
+:- pragma foreign_proc("MC++", string__to_char_list(Str::in, CharList::uo),
+		[will_not_call_mercury, promise_pure, thread_safe], "{
+        MR_Integer length, i; 
+        MR_Word tmp;
+        MR_Word prev;
+
+        length = Str->get_Length();
+      
+        MR_list_nil(prev);
+
+        for (i = length - 1; i >= 0; i--) {
+		MR_list_cons(tmp, __box(Str->get_Chars(i)), prev);
+		prev = tmp;
+        }
+        CharList = tmp;
+}").
+
+:- pragma foreign_proc("MC++", string__to_char_list(Str::uo, CharList::in),
+		[will_not_call_mercury, promise_pure, thread_safe], "{
+        System::Text::StringBuilder *tmp;
+	MR_Char c;
+       
+        tmp = new System::Text::StringBuilder();
+        while (1) {
+            if (MR_list_is_cons(CharList)) {
+		c = System::Convert::ToChar(MR_list_head(CharList));
+                tmp->Append(c);
+                CharList = MR_list_tail(CharList);
+            } else {
+                break;
+            }
+        }
+        Str = tmp->ToString();
+}").
+
+string__to_char_list(Str::in, CharList::uo) :-
+	( string__first_char(Str, First, Rest) ->
+		string__to_char_list(Rest, CharList0),
+		CharList = [First | CharList0]
+	;
+		CharList = []
+	).
+string__to_char_list(Str::uo, CharList::in) :-
+	( CharList = [],
+		Str = ""
+	; CharList = [C | Cs],
+		string__to_char_list(Str0, Cs),
+		Str = string__char_to_string(C) ++ Str0
+	).
+
 /*-----------------------------------------------------------------------*/
 
 %
@@ -1116,6 +1165,20 @@
 	Index = WholeString->IndexOf(SubString);
 }").
 
+string__sub_string_search(String, SubString, Index) :-
+	string__sub_string_search_2(String, SubString, 0, Index).
+
+:- pred sub_string_search_2(string::in, string::in,
+		int::in, int::out) is semidet.
+
+sub_string_search_2(String, SubString, CurrentIndex, Index) :-
+	( string__prefix(String, SubString) ->
+		Index = CurrentIndex
+	;
+		string__first_char(String, _, Rest),
+		sub_string_search_2(Rest, SubString, CurrentIndex + 1, Index)
+	).
+
 %-----------------------------------------------------------------------------%
 
 	% This predicate has been optimised to produce the least memory
@@ -1486,6 +1549,9 @@
 	[will_not_call_mercury, promise_pure, thread_safe], "
 	SUCCESS_INDICATOR = MR_FALSE;
 ").
+using_sprintf :-
+	% This version is only for if there is not a foreign_proc version.
+	private_builtin__sorry("string__using_sprintf").
 		
 
 	% Construct a format string suitable to passing to sprintf.
@@ -1560,6 +1626,9 @@
 		[will_not_call_mercury, promise_pure, thread_safe], "{
 	LengthModifier = """";
 }").
+int_length_modifer = _ :-
+	% This version is only for if there is not a foreign_proc version.
+	private_builtin__sorry("int_length_modifer").
 
 
 	% Create a string from a float using the format string.
@@ -1578,6 +1647,9 @@
 		[will_not_call_mercury, promise_pure, thread_safe], "{
 	Str = System.String.Format(FormatStr, Val);
 }").
+format_float(_, _) = _ :-
+	% This version is only for if there is not a foreign_proc version.
+	private_builtin__sorry("format_float").
 
 	% Create a string from a int using the format string.
 	% Note it is the responsibility of the caller to ensure that the
@@ -1595,6 +1667,9 @@
 		[will_not_call_mercury, promise_pure, thread_safe], "{
 	Str = System.String.Format(FormatStr, Val);
 }").
+format_int(_, _) = _ :-
+	% This version is only for if there is not a foreign_proc version.
+	private_builtin__sorry("format_int").
 
 	% Create a string from a string using the format string.
 	% Note it is the responsibility of the caller to ensure that the
@@ -1610,6 +1685,9 @@
 		[will_not_call_mercury, promise_pure, thread_safe], "{
 	Str = System.String.Format(FormatStr, Val);
 }").
+format_string(_, _) = _ :-
+	% This version is only for if there is not a foreign_proc version.
+	private_builtin__sorry("format_string").
 
 	% Create a string from a char using the format string.
 	% Note it is the responsibility of the caller to ensure that the
@@ -1627,7 +1705,9 @@
 		[will_not_call_mercury, promise_pure, thread_safe], "{
 	Str = System.String.Format(FormatStr, Val);
 }").
-
+format_char(_, _) = _ :-
+	% This version is only for if there is not a foreign_proc version.
+	private_builtin__sorry("format_char").
 
 %-----------------------------------------------------------------------------%
 
@@ -1659,6 +1739,11 @@
 	FloatString = System::Convert::ToString(FloatVal);
 }").
 
+string__float_to_string(_, _) :-
+	% This version is only for if there is not a foreign_proc version.
+	private_builtin__sorry("string__float_to_string").
+
+
 	% Beware that the implementation of string__format depends
 	% on the details of what string__float_to_f_string/2 outputs.
 
@@ -1673,6 +1758,16 @@
 	strcpy(FloatString, buf);
 }").
 
+:- pragma foreign_proc("MC++",
+	string__float_to_f_string(FloatVal::in, FloatString::out),
+		[will_not_call_mercury, promise_pure, thread_safe], "{
+	FloatString = System::Convert::ToString(FloatVal);
+}").
+
+string__float_to_f_string(_, _) :-
+	% This version is only for if there is not a foreign_proc version.
+	private_builtin__sorry("string__float_to_f_string").
+
 :- pragma foreign_proc("C",
 	string__to_float(FloatString::in, FloatVal::out),
 		[will_not_call_mercury, promise_pure, thread_safe], "{
@@ -1708,14 +1803,16 @@
 	}
 }").
 
+string__to_float(_, _) :-
+	% This version is only for if there is not a foreign_proc version.
+	private_builtin__sorry("string__to_float").
+
 /*-----------------------------------------------------------------------*/
 
 /*
 :- pred string__to_int_list(string, list(int)).
 :- mode string__to_int_list(in, out) is det.
-:- mode string__to_int_list(out, in) is det.
 */
-
 :- pragma foreign_proc("C",
 	string__to_int_list(Str::in, IntList::out),
 		[will_not_call_mercury, promise_pure, thread_safe], "{
@@ -1727,45 +1824,6 @@
 			MR_PROC_LABEL);
 	}
 }").
-
-:- pragma foreign_proc("C",
-	string__to_int_list(Str::out, IntList::in),
-		[will_not_call_mercury, promise_pure, thread_safe], "{
-		/* mode (out, in) is det */
-	MR_Word int_list_ptr;
-	size_t size;
-	MR_Word str_ptr;
-/*
-** loop to calculate list length + sizeof(MR_Word) in `size' using list in
-** `int_list_ptr'
-*/
-	size = sizeof(MR_Word);
-	int_list_ptr = IntList;
-	while (! MR_list_is_empty(int_list_ptr)) {
-		size++;
-		int_list_ptr = MR_list_tail(int_list_ptr);
-	}
-/*
-** allocate (length + 1) bytes of heap space for string
-** i.e. (length + 1 + sizeof(MR_Word) - 1) / sizeof(MR_Word) words
-*/
-	MR_allocate_aligned_string_msg(Str, size, MR_PROC_LABEL);
-
-/*
-** loop to copy the characters from the int_list to the string
-*/
-	size = 0;
-	int_list_ptr = IntList;
-	while (! MR_list_is_empty(int_list_ptr)) {
-		Str[size++] = MR_list_head(int_list_ptr);
-		int_list_ptr = MR_list_tail(int_list_ptr);
-	}
-/*
-** null terminate the string
-*/
-	Str[size] = '\\0';
-}").
-
 :- pragma foreign_proc("MC++",
 	string__to_int_list(Str::in, IntList::out),
 		[will_not_call_mercury, promise_pure, thread_safe], "{
@@ -1783,25 +1841,9 @@
         }
         IntList = tmp;
 }").
-
-:- pragma foreign_proc("MC++",
-	string__to_int_list(Str::out, IntList::in),
-		[will_not_call_mercury, promise_pure, thread_safe], "{
-        System::Text::StringBuilder *tmp;
-       
-        tmp = new System::Text::StringBuilder();
-        while (1) {
-            if (System::Convert::ToInt32(IntList->GetValue(0))) {
-                tmp->Append(System::Convert::ToChar(
-			IntList->GetValue(1)));
-                IntList = dynamic_cast<MR_Word>(IntList->GetValue(2));
-            } else {
-                break;
-            }
-        }
-        Str = tmp->ToString();
-}").
-
+string__to_int_list(String, IntList) :-
+	string__to_char_list(String, CharList),
+	IntList = list__map(char__to_int, CharList).
 
 /*-----------------------------------------------------------------------*/
 
@@ -1817,6 +1859,13 @@
 		[will_not_call_mercury, promise_pure, thread_safe], "
 	SUCCESS_INDICATOR = (Str->IndexOf(Ch) != -1);
 ").
+string__contains_char(String, Char) :-
+	string__first_char(String, FirstChar, RestOfString),
+	( FirstChar = Char ->
+		true
+	;
+		string__contains_char(RestOfString, Char)
+	).
 
 /*-----------------------------------------------------------------------*/
 
@@ -1853,6 +1902,13 @@
 		Ch = Str->get_Chars(Index);
 	}
 ").
+string__index(Str, Index, Char) :-
+	string__first_char(Str, First, Rest),
+	( Index = 0 ->
+		Char = First
+	;
+		string__index(Rest, Index - 1, Char)
+	).
 
 /*-----------------------------------------------------------------------*/
 
@@ -1866,6 +1922,9 @@
 		[will_not_call_mercury, promise_pure, thread_safe], "
 	Ch = Str->get_Chars(Index);
 ").
+string__unsafe_index(_, _, _) :-
+	% This version is only for if there is not a foreign_proc version.
+	private_builtin__sorry("string__unsafe_index").
 
 /*-----------------------------------------------------------------------*/
 
@@ -1915,6 +1974,10 @@
 		SUCCESS_INDICATOR = MR_TRUE;
 	}
 ").
+string__set_char(Ch, Index, Str0, Str) :-
+	string__to_char_list(Str0, List0),
+	list__replace_nth(List0, Index + 1, Ch, List),
+	string__to_char_list(Str, List).
 
 /*
 :- pred string__set_char(char, int, string, string).
@@ -1968,6 +2031,9 @@
 		System::Convert::ToString(Ch), 
 		Str0->Substring(Index + 1));
 ").
+string__unsafe_set_char(_, _, _, _) :-
+	% This version is only for if there is not a foreign_proc version.
+	private_builtin__sorry("string__unsafe_set_char").
 
 /*
 :- pred string__unsafe_set_char(char, int, string, string).
@@ -2021,6 +2087,22 @@
 	Length = Str->get_Length();
 ").
 
+:- pragma promise_pure(string__length/2).
+string__length(Str::in, Len::uo) :-
+	string__length_2(Str, Len).
+string__length(Str0::ui, Len::uo) :-
+	copy(Str0, Str),
+	string__length_2(Str, Len).
+
+:- pred string__length_2(string::in, int::uo) is det.
+string__length_2(Str, Length) :-
+	( string__first_char(Str, _First, Rest) ->
+		string__length(Rest, Length0),
+		Length = Length0 + 1
+	;
+		Length = 0
+	).
+
 /*-----------------------------------------------------------------------*/
 
 :- pragma promise_pure(string__append/3).
@@ -2052,6 +2134,9 @@
 	SUCCESS_INDICATOR = S3->Equals(System::String::Concat(S1, S2));
 }").
 
+string__append_iii(X, Y, Z) :-
+	string__mercury_append(X, Y, Z).
+
 :- pred string__append_ioi(string::in, string::out, string::in) is semidet.
 
 :- pragma foreign_proc("C",
@@ -2086,6 +2171,9 @@
 	}
 }").
 
+string__append_ioi(X, Y, Z) :-
+	string__mercury_append(X, Y, Z).
+
 :- pred string__append_iio(string::in, string::in, string::uo) is det.
 
 :- pragma foreign_proc("C",
@@ -2105,6 +2193,9 @@
 	S3 = System::String::Concat(S1, S2);
 }").
 
+string__append_iio(X, Y, Z) :-
+	string__mercury_append(X, Y, Z).
+
 :- pred string__append_ooi(string::out, string::out, string::in) is multi.
 
 string__append_ooi(S1, S2, S3) :-
@@ -2148,6 +2239,21 @@
 	S2 = S3->Substring(S1Len);
 ").
 
+string__append_ooi_3(S1Len, _S3Len, S1, S2, S3) :-
+	string__split(S3, S1Len, S1, S2).
+
+:- pred string__mercury_append(string, string, string).
+:- mode string__mercury_append(in, in, in) is semidet.	% implied
+:- mode string__mercury_append(in, uo, in) is semidet.
+:- mode string__mercury_append(in, in, uo) is det.
+:- mode string__mercury_append(uo, uo, in) is multi.
+
+string__mercury_append(X, Y, Z) :-
+	string__to_char_list(X, XList),
+	string__to_char_list(Y, YList),
+	string__to_char_list(Z, ZList),
+	list__append(XList, YList, ZList).
+
 /*-----------------------------------------------------------------------*/
 
 /*
@@ -2214,7 +2320,9 @@
 	SubString = Str->Substring(Start, Count);
 }").
 
-
+string__unsafe_substring(_, _, _, _) :-
+	% This version is only for if there is not a foreign_proc version.
+	private_builtin__sorry("string__unsafe_substring").
 
 /*
 :- pred string__split(string, int, string, string).
@@ -2269,16 +2377,36 @@
 	}
 }").
 
+string__split(Str, Count, Left, Right) :-
+	( Count =< 0 ->
+		Left = "",
+		Right = Str
+	;
+		string__to_char_list(Str, List),
+		Len = list__length(List),
+		( Count > Len ->
+			Num = Len
+		;
+			Num = Count
+		),
+		( list__split_list(Num, List, LeftList, RightList) ->
+			string__to_char_list(Left, LeftList),
+			string__to_char_list(Right, RightList)
+		;
+			error("string__split")
+		)
+	).
+
 
 /*-----------------------------------------------------------------------*/
 
 /*
 :- pred string__first_char(string, char, string).
 :- mode string__first_char(in, in, in) is semidet.	% implied
-:- mode string__first_char(in, out, in) is semidet.	% implied
-:- mode string__first_char(in, in, out) is semidet.	% implied
-:- mode string__first_char(in, out, out) is semidet.
-:- mode string__first_char(out, in, in) is det.
+:- mode string__first_char(in, uo, in) is semidet.	% implied
+:- mode string__first_char(in, in, uo) is semidet.	% implied
+:- mode string__first_char(in, uo, uo) is semidet.
+:- mode string__first_char(uo, in, in) is det.
 %	string__first_char(String, Char, Rest) is true iff
 %		Char is the first character of String, and Rest is the
 %		remainder.
@@ -2308,16 +2436,16 @@
 ").
 
 /*
-:- mode string__first_char(in, out, in) is semidet.	% implied
+:- mode string__first_char(in, uo, in) is semidet.	% implied
 */
 :- pragma foreign_proc("C",
-	string__first_char(Str::in, First::out, Rest::in),
+	string__first_char(Str::in, First::uo, Rest::in),
 		[will_not_call_mercury, promise_pure, thread_safe], "
 	First = Str[0];
 	SUCCESS_INDICATOR = (First != '\\0' && strcmp(Str + 1, Rest) == 0);
 ").
 :- pragma foreign_proc("MC++",
-	string__first_char(Str::in, First::out, Rest::in),
+	string__first_char(Str::in, First::uo, Rest::in),
 		[will_not_call_mercury, promise_pure, thread_safe], "
 	MR_Integer len = Str->get_Length();
 	if (len > 0) {
@@ -2330,10 +2458,10 @@
 ").
 
 /*
-:- mode string__first_char(in, in, out) is semidet.	% implied
+:- mode string__first_char(in, in, uo) is semidet.	% implied
 */
 :- pragma foreign_proc("C",
-	string__first_char(Str::in, First::in, Rest::out),
+	string__first_char(Str::in, First::in, Rest::uo),
 		[will_not_call_mercury, promise_pure, thread_safe], "{
 	if (Str[0] != First || First == '\\0') {
 		SUCCESS_INDICATOR = MR_FALSE;
@@ -2350,7 +2478,7 @@
 	}
 }").
 :- pragma foreign_proc("MC++",
-	string__first_char(Str::in, First::in, Rest::out),
+	string__first_char(Str::in, First::in, Rest::uo),
 		[will_not_call_mercury, promise_pure, thread_safe], "{
 	MR_Integer len = Str->get_Length();
 	if (len > 0) {
@@ -2362,10 +2490,10 @@
 }").
 
 /*
-:- mode string__first_char(in, out, out) is semidet.
+:- mode string__first_char(in, uo, uo) is semidet.
 */
 :- pragma foreign_proc("C", 
-	string__first_char(Str::in, First::out, Rest::out),
+	string__first_char(Str::in, First::uo, Rest::uo),
 		[will_not_call_mercury, promise_pure, thread_safe], "{
 	First = Str[0];
 	if (First == '\\0') {
@@ -2383,7 +2511,7 @@
 	}
 }").
 :- pragma foreign_proc("MC++", 
-	string__first_char(Str::in, First::out, Rest::out),
+	string__first_char(Str::in, First::uo, Rest::uo),
 		[will_not_call_mercury, promise_pure, thread_safe], "{
 	if (Str->get_Length() == 0) {
 		SUCCESS_INDICATOR = MR_FALSE;
@@ -2396,10 +2524,10 @@
 
 
 /*
-:- mode string__first_char(out, in, in) is det.
+:- mode string__first_char(uo, in, in) is det.
 */
 :- pragma foreign_proc("C",
-	string__first_char(Str::out, First::in, Rest::in),
+	string__first_char(Str::uo, First::in, Rest::in),
 		[will_not_call_mercury, promise_pure, thread_safe], "{
 	size_t len = strlen(Rest) + 1;
 	MR_allocate_aligned_string_msg(Str, len, MR_PROC_LABEL);
@@ -2407,13 +2535,18 @@
 	strcpy(Str + 1, Rest);
 }").
 :- pragma foreign_proc("MC++",
-	string__first_char(Str::out, First::in, Rest::in),
+	string__first_char(Str::uo, First::in, Rest::in),
 		[will_not_call_mercury, promise_pure, thread_safe], "{
 	MR_String FirstStr;
 	FirstStr = new System::String(First, 1);
 	Str = System::String::Concat(FirstStr, Rest);
 }").
 
+
+:- pragma promise_pure(string__first_char/3).
+string__first_char(_, _, _) :-
+	% This version is only for if there is not a foreign_proc version.
+	private_builtin__sorry("string__first_char").
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%

--------------------------------------------------------------------------
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
--------------------------------------------------------------------------



More information about the reviews mailing list