[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