[m-rev.] for review: avoiding model_non foreign_procs
Zoltan Somogyi
zs at cs.mu.OZ.AU
Mon Apr 30 17:09:56 AEST 2001
For review by anyone.
library/string.m:
library/table_builtin.m:
Avoid the use of model_non foreign_procs, since deep profiling won't
be able to handle them.
Zoltan.
cvs diff: Diffing .
Index: string.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/string.m,v
retrieving revision 1.144
diff -u -b -r1.144 string.m
--- string.m 2001/03/15 07:42:26 1.144
+++ string.m 2001/04/30 07:08:33
@@ -1836,11 +1836,35 @@
:- mode string__append(out, out, in) is multi.
*/
-/*
-:- mode string__append(in, in, in) is semidet.
-*/
+:- pragma promise_pure(string__append/3).
+
+string__append(S1, S2, S3) :-
+ (
+ impure private_builtin__nonvar(S1),
+ impure private_builtin__nonvar(S2),
+ impure private_builtin__nonvar(S3),
+ string__append_iii(S1, S2, S3)
+ ;
+ impure private_builtin__nonvar(S1),
+ impure private_builtin__var(S2),
+ impure private_builtin__nonvar(S3),
+ string__append_ioi(S1, S2, S3)
+ ;
+ impure private_builtin__nonvar(S1),
+ impure private_builtin__nonvar(S2),
+ impure private_builtin__var(S3),
+ string__append_iio(S1, S2, S3)
+ ;
+ impure private_builtin__var(S1),
+ impure private_builtin__var(S2),
+ impure private_builtin__nonvar(S3),
+ string__append_ooi(S1, S2, S3)
+ ).
+
+:- pred string__append_iii(string::in, string::in, string::in) is semidet.
+
:- pragma foreign_proc("C",
- string__append(S1::in, S2::in, S3::in),
+ string__append_iii(S1::in, S2::in, S3::in),
[will_not_call_mercury, thread_safe], "{
size_t len_1 = strlen(S1);
SUCCESS_INDICATOR = (
@@ -1848,17 +1872,17 @@
strcmp(S2, S3 + len_1) == 0
);
}").
+
:- pragma foreign_proc("MC++",
- string__append(_S1::in, _S2::in, _S3::in),
+ string__append_iii(_S1::in, _S2::in, _S3::in),
[will_not_call_mercury, thread_safe], "{
mercury::runtime::Errors::SORRY(""c code for this function"");
}").
-/*
-:- mode string__append(in, out, in) is semidet.
-*/
+:- pred string__append_ioi(string::in, string::out, string::in) is semidet.
+
:- pragma foreign_proc("C",
- string__append(S1::in, S2::out,S3::in),
+ string__append_ioi(S1::in, S2::out,S3::in),
[will_not_call_mercury, thread_safe], "{
size_t len_1, len_2, len_3;
@@ -1877,17 +1901,17 @@
SUCCESS_INDICATOR = TRUE;
}
}").
+
:- pragma foreign_proc("MC++",
- string__append(_S1::in, _S2::out, _S3::in),
+ string__append_ioi(_S1::in, _S2::out, _S3::in),
[will_not_call_mercury, thread_safe], "{
mercury::runtime::Errors::SORRY(""c code for this function"");
}").
-/*
-:- mode string__append(in, in, out) is det.
-*/
+:- pred string__append_iio(string::in, string::in, string::out) is det.
+
:- pragma foreign_proc("C",
- string__append(S1::in, S2::in, S3::out),
+ string__append_iio(S1::in, S2::in, S3::out),
[will_not_call_mercury, thread_safe], "{
size_t len_1, len_2;
len_1 = strlen(S1);
@@ -1896,58 +1920,65 @@
strcpy(S3, S1);
strcpy(S3 + len_1, S2);
}").
+
:- pragma foreign_proc("MC++",
- string__append(S1::in, S2::in, S3::out),
+ string__append_iio(S1::in, S2::in, S3::out),
[will_not_call_mercury, thread_safe], "{
S3 = System::String::Concat(S1, S2);
}").
+:- pred string__append_ooi(string::out, string::out, string::in) is multi.
+
+string__append_ooi(S1, S2, S3) :-
+ S3Len = string__length(S3),
+ % The if-then-else below is equivalent to the call
+ % string__append_ooi_3(0, S3Len, S1, S2, S3)
+ % except the compiler recognizes that it has at least one solution.
+ ( S3Len = 0 ->
+ string__append_ooi_3(0, S3Len, S1, S2, S3)
+ ;
+ (
+ string__append_ooi_3(0, S3Len, S1, S2, S3)
+ ;
+ string__append_ooi_2(1, S3Len, S1, S2, S3)
+ )
+ ).
+
+:- pred string__append_ooi_2(int::in, int::in, string::out, string::out,
+ string::in) is nondet.
+
+string__append_ooi_2(NextS1Len, S3Len, S1, S2, S3) :-
+ ( NextS1Len = S3Len ->
+ string__append_ooi_3(NextS1Len, S3Len, S1, S2, S3)
+ ; NextS1Len < S3Len ->
+ (
+ string__append_ooi_3(NextS1Len, S3Len, S1, S2, S3)
+ ;
+ string__append_ooi_2(NextS1Len + 1, S3Len, S1, S2, S3)
+ )
+ ;
+ fail
+ ).
+
+:- pred string__append_ooi_3(int::in, int::in, string::out,
+ string::out, string::in) is det.
+
:- pragma foreign_proc("C",
- string__append(S1::out, S2::out, S3::in),
- [will_not_call_mercury, thread_safe],
- local_vars("
- MR_String s;
- size_t len;
- size_t count;
- "),
- first_code("
- LOCALS->s = S3;
- LOCALS->len = strlen(S3);
- LOCALS->count = 0;
- "),
- retry_code("
- LOCALS->count++;
- "),
- common_code("
- MR_allocate_aligned_string_msg(S1, LOCALS->count,
- MR_PROC_LABEL);
- memcpy(S1, LOCALS->s, LOCALS->count);
- S1[LOCALS->count] = '\\0';
- MR_allocate_aligned_string_msg(S2, LOCALS->len - LOCALS->count,
- MR_PROC_LABEL);
- strcpy(S2, LOCALS->s + LOCALS->count);
+ string__append_ooi_3(S1Len::in, S3Len::in, S1::out, S2::out, S3::in),
+ [will_not_call_mercury, thread_safe], "{
+ MR_allocate_aligned_string_msg(S1, S1Len, MR_PROC_LABEL);
+ memcpy(S1, S3, S1Len);
+ S1[S1Len] = '\\0';
+ MR_allocate_aligned_string_msg(S2, S3Len - S1Len, MR_PROC_LABEL);
+ strcpy(S2, S3 + S1Len);
+}").
- if (LOCALS->count < LOCALS->len) {
- SUCCEED;
- } else {
- SUCCEED_LAST;
- }
- ")
-).
:- pragma foreign_proc("MC++",
- string__append(_S1::out, _S2::out, _S3::in),
- [will_not_call_mercury, thread_safe],
- local_vars("
- "),
- first_code("
- "),
- retry_code("
- "),
- common_code("
+ string__append_ooi_3(_S1Len::in, _S3Len::in,
+ _S1::out, _S2::out, _S3::in),
+ [will_not_call_mercury, thread_safe], "
mercury::runtime::Errors::SORRY(""c code for this function"");
- ")
-).
-
+").
/*-----------------------------------------------------------------------*/
Index: table_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/table_builtin.m,v
retrieving revision 1.8
diff -u -b -r1.8 table_builtin.m
--- table_builtin.m 2001/03/15 07:42:27 1.8
+++ table_builtin.m 2001/04/30 07:08:28
@@ -811,28 +811,44 @@
#endif
").
-/*
-** Note that the code for this is identical to the code for
-** table_multi_return_all_ans/2 (below).
-** Any changes to this code should also be made there.
-*/
-:- pragma foreign_proc("C",
- table_nondet_return_all_ans(T::in, A::out),
- will_not_call_mercury,
- local_vars("
-#ifdef MR_USE_MINIMAL_MODEL
- MR_AnswerList cur_node;
-#else
- /* ensure local var struct is non-empty */
- char bogus;
-#endif
- "),
- first_code("
+table_nondet_return_all_ans(TrieNode, Answer) :-
+ semipure pickup_answer_list(TrieNode, CurNode0),
+ semipure table_nondet_return_all_ans_2(CurNode0, Answer).
+
+table_multi_return_all_ans(TrieNode, Answer) :-
+ semipure pickup_answer_list(TrieNode, CurNode0),
+ ( semipure return_next_answer(CurNode0, FirstAnswer, CurNode1) ->
+ (
+ Answer = FirstAnswer
+ ;
+ semipure table_nondet_return_all_ans_2(CurNode1,
+ Answer)
+ )
+ ;
+ error("table_multi_return_all_ans: no first answer")
+ ).
+
+:- semipure pred table_nondet_return_all_ans_2(c_pointer::in,
+ ml_answer_block::out) is nondet.
+
+table_nondet_return_all_ans_2(CurNode0, Answer) :-
+ semipure return_next_answer(CurNode0, FirstAnswer, CurNode1),
+ (
+ Answer = FirstAnswer
+ ;
+ semipure table_nondet_return_all_ans_2(CurNode1, Answer)
+ ).
+
+:- semipure pred pickup_answer_list(ml_subgoal_table_node::in, c_pointer::out)
+ is det.
+
+:- pragma foreign_proc("C", pickup_answer_list(T::in, CurNode::out),
+ [will_not_call_mercury], "
#ifdef MR_USE_MINIMAL_MODEL
MR_TrieNode table;
table = (MR_TrieNode) T;
- LOCALS->cur_node = table->MR_subgoal->answer_list;
+ CurNode = (MR_Word) table->MR_subgoal->answer_list;
#ifdef MR_TABLE_DEBUG
if (MR_tabledebug) {
@@ -840,73 +856,30 @@
table, table->MR_subgoal);
}
#endif
-#endif
- "),
- retry_code("
- "),
- shared_code("
-#ifdef MR_USE_MINIMAL_MODEL
- if (LOCALS->cur_node == NULL) {
- FAIL;
- } else {
- A = (MR_Word) &LOCALS->cur_node->answer_data;
- LOCALS->cur_node = LOCALS->cur_node->next_answer;
- SUCCEED;
- }
-#else
- MR_fatal_error(""minimal model code entered when not enabled"");
#endif
- ")
-).
+").
+
+:- semipure pred return_next_answer(c_pointer::in, ml_answer_block::out,
+ c_pointer::out) is semidet.
-/*
-** Note that the code for this is identical to the code for
-** table_nondet_return_all_ans/2 (above).
-** Any changes to this code should also be made there.
-*/
:- pragma foreign_proc("C",
- table_multi_return_all_ans(T::in, A::out),
- will_not_call_mercury,
- local_vars("
+ return_next_answer(CurNode0::in, AnswerBlock::out, CurNode::out),
+ [will_not_call_mercury], "
#ifdef MR_USE_MINIMAL_MODEL
- MR_AnswerList cur_node;
-#else
- /* ensure local var struct is non-empty */
- char bogus;
-#endif
- "),
- first_code("
-#ifdef MR_USE_MINIMAL_MODEL
- MR_TrieNode table;
+ MR_AnswerList cur_node0;
- table = (MR_TrieNode) T;
- LOCALS->cur_node = table->MR_subgoal->answer_list;
-
- #ifdef MR_TABLE_DEBUG
- if (MR_tabledebug) {
- printf(""restoring all answers in %p -> %p\\n"",
- table, table->MR_subgoal);
- }
- #endif
-#endif
- "),
- retry_code("
- "),
- shared_code("
-#ifdef MR_USE_MINIMAL_MODEL
- if (LOCALS->cur_node == NULL) {
- FAIL;
+ cur_node0 = (MR_AnswerList *) CurNode0;
+ if (cur_node0 == NULL) {
+ SUCCESS_INDICATOR = FALSE;
} else {
- A = (MR_Word) &LOCALS->cur_node->answer_data;
- LOCALS->cur_node = LOCALS->cur_node->next_answer;
- SUCCEED;
+ AnswerBlock = (MR_Word) &cur_node0->answer_data;
+ CurNode = (MR_Word) cur_node0->next_answer;
+ SUCCESS_INDICATOR = TRUE;
}
#else
MR_fatal_error(""minimal model code entered when not enabled"");
#endif
- ")
-).
-
+").
:- pragma foreign_proc("MC++",
table_nondet_is_complete(_T::in), [will_not_call_mercury], "
@@ -941,38 +914,17 @@
mercury::runtime::Errors::SORRY(""foreign code for this function"");
").
+:- pragma foreign_proc("MC++",
+ pickup_answer_list(_T::in, _CurNode::out),
+ [will_not_call_mercury], "
+ mercury::runtime::Errors::SORRY(""foreign code for this function"");
+").
+
:- pragma foreign_proc("MC++",
- table_nondet_return_all_ans(_T::in, _A::out),
- will_not_call_mercury,
- local_vars("
- "),
- first_code("
- "),
- retry_code("
- "),
- shared_code("
- mercury::runtime::Errors::SORRY(""foreign code for this function"");
- ")
-).
-
-/*
-** Note that the code for this is identical to the code for
-** table_nondet_return_all_ans/2 (above).
-** Any changes to this code should also be made there.
-*/
-:- pragma foreign_proc("MC++",
- table_multi_return_all_ans(_T::in, _A::out),
- will_not_call_mercury,
- local_vars("
- "),
- first_code("
- "),
- retry_code("
- "),
- shared_code("
+ return_next_answer(_CurNode0::in, _AnswerBlock::out, _CurNode::out),
+ [will_not_call_mercury], "
mercury::runtime::Errors::SORRY(""foreign code for this function"");
- ")
-).
+").
%-----------------------------------------------------------------------------%
--------------------------------------------------------------------------
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