[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