[m-rev.] for review: avoiding the use of nondet foreign_procs
Zoltan Somogyi
zs at cs.mu.OZ.AU
Thu May 17 16:27:20 AEST 2001
For review by anyone.
This is an updated version of the diff I posted earlier, which uses
mode-specific clauses to avoid runtime overhead.
I intend to commit this only after Fergus's changes to add mode-specific code
have been installed on all our machines.
Zoltan.
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.
configure.in:
Check whether the installed compiler can handle mode-specific clauses,
since the new code in string.m uses such clauses.
cvs diff: Diffing .
Index: configure.in
===================================================================
RCS file: /home/mercury1/repository/mercury/configure.in,v
retrieving revision 1.253
diff -u -b -r1.253 configure.in
--- configure.in 2001/04/10 15:37:35 1.253
+++ configure.in 2001/05/17 04:08:31
@@ -87,30 +87,43 @@
:- implementation.
- % Check that we can declare foreign_proc for C and MC++.
- :- pred foo(int::out) is det.
- :- pragma foreign_proc("C", foo(X::out),
- [[will_not_call_mercury, thread_safe]],
- " X = 42; ").
- :- pragma foreign_proc("MC++", foo(X::out),
- [[will_not_call_mercury, thread_safe]],
- " X = 42; ").
+ :- import_module int.
- % Currently we test that mmc accepts the
- % --fixed-user-guided-type-specialization flag.
main -->
- ( { foo(42) } ->
- print("Hello, world\n")
- ;
- print("Nope.\n")
- ).
+ { p(10, Y) },
+ io__write_int(Y),
+ io__write_string(" "),
+ { p(X, 21) },
+ io__write_int(X).
+
+ % We check whether the compiler accepts mode-specific clauses.
+ :- pragma promise_pure(p/2).
+
+ :- pred p(int, int).
+ :- mode p(in, out) is det.
+ :- mode p(out, in) is det.
+
+ p(S1::in, S2::out) :-
+ p_io(S1, S2).
+ p(S1::out, S2::in) :-
+ p_oi(S1, S2).
+
+ :- pred p_io(int::in, int::out) is det.
+
+ p_io(X, Y) :-
+ Y = X * 2.
+
+ :- pred p_oi(int::out, int::in) is det.
+
+ p_oi(X, Y) :-
+ X = Y // 2.
EOF
if
echo $BOOTSTRAP_MC conftest >&AC_FD_CC 2>&1 &&
$BOOTSTRAP_MC --fixed-user-guided-type-specialization \
--halt-at-warn --link-flags "--static" conftest \
</dev/null >&AC_FD_CC 2>&1 &&
- test "`./conftest 2>&1 | tr -d '\015'`" = "Hello, world"
+ test "`./conftest 2>&1 | tr -d '\015'`" = "20 10"
then
rm -f conftest*
cat > conftest.m << EOF
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing java
cvs diff: Diffing library
Index: library/string.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/string.m,v
retrieving revision 1.144
diff -u -b -r1.144 string.m
--- library/string.m 2001/03/15 07:42:26 1.144
+++ library/string.m 2001/05/17 02:24:00
@@ -1828,19 +1828,21 @@
/*-----------------------------------------------------------------------*/
-/*
-:- pred string__append(string, string, string).
-:- mode string__append(in, in, in) is semidet. % implied
-:- mode string__append(in, out, in) is semidet.
-:- mode string__append(in, in, out) is det.
-:- 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::in, S2::in, S3::in) :-
+ string__append_iii(S1, S2, S3).
+string__append(S1::in, S2::out, S3::in) :-
+ string__append_ioi(S1, S2, S3).
+string__append(S1::in, S2::in, S3::out) :-
+ string__append_iio(S1, S2, S3).
+string__append(S1::out, S2::out, S3::in) :-
+ 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 +1850,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 +1879,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 +1898,54 @@
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),
+ string__append_ooi_2(0, S3Len, S1, S2, S3).
+
+:- pred string__append_ooi_2(int::in, int::in, string::out, string::out,
+ string::in) is multi.
+
+string__append_ooi_2(NextS1Len, S3Len, S1, S2, S3) :-
+ ( NextS1Len = S3Len ->
+ string__append_ooi_3(NextS1Len, S3Len, S1, S2, S3)
+ ;
+ (
+ string__append_ooi_3(NextS1Len, S3Len,
+ S1, S2, S3)
+ ;
+ string__append_ooi_2(NextS1Len + 1, S3Len,
+ S1, S2, S3)
+ )
+ ).
+
+:- 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: library/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
--- library/table_builtin.m 2001/03/15 07:42:27 1.8
+++ library/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"");
- ")
-).
+").
%-----------------------------------------------------------------------------%
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
--------------------------------------------------------------------------
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