Diff: Error in .opt file output

[Andrew Bromage]

Estimated hours taken: 1

Fix a bug in the writing of .opt files.

The problem occurs when you have a pragma inline declaration for an
exported function.  The declaration:

:- func addone(int) = int.
:- pragma inline(addone/1).
addone(I) = I + 1.

gets written to the .opt file as:

:- pragma inline((foo:addone)/2).

That is, the arity of the _predicate_ version is written rather than
the arity of the _function_.

compiler/intermod.m:
compiler/mercury_to_mercury.m:
	Add a pred_or_func argument to mercury_output_pragma_decl,
	and use that to determine the declared arity.

tests/valid/intermod_test.m:
tests/valid/intermod_test2.m:
	Regression test.


Index: compiler/intermod.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/intermod.m,v
retrieving revision 1.34
diff -u -r1.34 intermod.m
--- intermod.m	1997/10/26 23:05:36	1.34
+++ intermod.m	1997/11/20 06:07:02
@@ -922,11 +922,11 @@
 	{ pred_info_name(PredInfo, Name) },
 	{ SymName = qualified(Module, Name) },
 	{ pred_info_get_marker_list(PredInfo, Markers) },
-	intermod__write_pragmas(SymName, Arity, Markers),
+	{ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc) },
+	intermod__write_pragmas(SymName, Arity, Markers, PredOrFunc),
 	{ pred_info_clauses_info(PredInfo, ClausesInfo) },
 	{ ClausesInfo = clauses_info(Varset, _, _VarTypes, HeadVars, Clauses) },
 		% handle pragma(c_code, ...) separately
-	{ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc) },
 	( { pred_info_get_goal_type(PredInfo, pragmas) } ->
 		{ pred_info_procedures(PredInfo, Procs) },
 		intermod__write_c_code(SymName, PredOrFunc, HeadVars, Varset,
@@ -940,10 +940,11 @@
 	intermod__write_preds(ModuleInfo, PredIds).
 
 :- pred intermod__write_pragmas(sym_name::in, int::in, list(marker_status)::in,
-				io__state::di, io__state::uo) is det.
+		pred_or_func::in, io__state::di, io__state::uo) is det.
 
-intermod__write_pragmas(_, _, []) --> [].
-intermod__write_pragmas(SymName, Arity, [MarkerStatus | Markers]) -->
+intermod__write_pragmas(_, _, [], _) --> [].
+intermod__write_pragmas(SymName, Arity, [MarkerStatus | Markers], PredOrFunc)
+		-->
 	(
 		{ MarkerStatus = request(Marker) }
 	;
@@ -958,11 +959,11 @@
 		)
 	->
 		{ hlds_out__marker_name(Marker, Name) },
-		mercury_output_pragma_decl(SymName, Arity, Name)
+		mercury_output_pragma_decl(SymName, Arity, PredOrFunc, Name)
 	;
 		[]
 	),
-	intermod__write_pragmas(SymName, Arity, Markers).
+	intermod__write_pragmas(SymName, Arity, Markers, PredOrFunc).
 
 	% Some pretty kludgy stuff to get c code written correctly.
 :- pred intermod__write_c_code(sym_name::in, pred_or_func::in, 
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.119
diff -u -r1.119 mercury_to_mercury.m
--- mercury_to_mercury.m	1997/10/09 09:38:54	1.119
+++ mercury_to_mercury.m	1997/11/20 05:47:24
@@ -46,8 +46,9 @@
 		maybe(determinism), term__context, io__state, io__state).
 :- mode mercury_output_func_mode_subdecl(in, in, in, in, in, in, di, uo) is det.
 
-:- pred mercury_output_pragma_decl(sym_name, int, string, io__state, io__state).
-:- mode mercury_output_pragma_decl(in, in, in, di, uo) is det.
+:- pred mercury_output_pragma_decl(sym_name, int, pred_or_func, string,
+		io__state, io__state).
+:- mode mercury_output_pragma_decl(in, in, in, in, di, uo) is det.
 
 :- pred mercury_output_pragma_c_code(may_call_mercury, sym_name, pred_or_func,
 		list(pragma_var), maybe(pair(list(string))),
@@ -285,16 +286,16 @@
 			C_Function)
 	;
 		{ Pragma = obsolete(Pred, Arity) },
-		mercury_output_pragma_decl(Pred, Arity, "obsolete")
+		mercury_output_pragma_decl(Pred, Arity, predicate, "obsolete")
 	;
 		{ Pragma = memo(Pred, Arity) },
-		mercury_output_pragma_decl(Pred, Arity, "memo")
+		mercury_output_pragma_decl(Pred, Arity, predicate, "memo")
 	;
 		{ Pragma = inline(Pred, Arity) },
-		mercury_output_pragma_decl(Pred, Arity, "inline")
+		mercury_output_pragma_decl(Pred, Arity, predicate, "inline")
 	;
 		{ Pragma = no_inline(Pred, Arity) },
-		mercury_output_pragma_decl(Pred, Arity, "no_inline")
+		mercury_output_pragma_decl(Pred, Arity, predicate, "no_inline")
 	;
 		{ Pragma = unused_args(PredOrFunc, PredName,
 			Arity, ProcId, UnusedArgs) },
@@ -310,13 +311,15 @@
 			PredName, ModeList, Termination, Context)
 	;
 		{ Pragma = terminates(Pred, Arity) },
-		mercury_output_pragma_decl(Pred, Arity, "terminates")
+		mercury_output_pragma_decl(Pred, Arity, predicate, "terminates")
 	;
 		{ Pragma = does_not_terminate(Pred, Arity) },
-		mercury_output_pragma_decl(Pred, Arity, "does_not_terminate")
+		mercury_output_pragma_decl(Pred, Arity, predicate,
+			"does_not_terminate")
 	;
 		{ Pragma = check_termination(Pred, Arity) },
-		mercury_output_pragma_decl(Pred, Arity, "check_termination")
+		mercury_output_pragma_decl(Pred, Arity, predicate,
+			"check_termination")
 	).
 
 mercury_output_item(nothing, _) --> [].
@@ -1620,13 +1623,18 @@
 
 %-----------------------------------------------------------------------------%
 
-mercury_output_pragma_decl(PredName, Arity, PragmaName) -->
+mercury_output_pragma_decl(PredName, Arity, PredOrFunc, PragmaName) -->
+	{ PredOrFunc = predicate,
+		DeclaredArity = Arity
+	; PredOrFunc = function,
+		DeclaredArity is Arity - 1
+	},
 	io__write_string(":- pragma "),
 	io__write_string(PragmaName),
 	io__write_string("(("),
 	mercury_output_bracketed_sym_name(PredName),
 	io__write_string(")/"),
-	io__write_int(Arity),
+	io__write_int(DeclaredArity),
 	io__write_string(").\n").
 
 %-----------------------------------------------------------------------------%
Index: tests/valid/intermod_test.m
===================================================================
RCS file: /home/staff/zs/imp/tests/valid/intermod_test.m,v
retrieving revision 1.1
diff -u -r1.1 intermod_test.m
--- intermod_test.m	1997/06/29 23:23:31	1.1
+++ intermod_test.m	1997/11/20 06:26:53
@@ -26,3 +26,9 @@
 :- mode local(pred(int_mode) is det, out) is det.
 
 local(Pred, Int) :- call(Pred, Int).
+
+:- pred local_2(pred(int), int).
+:- mode local_2(pred(int_mode) is det, out) is det.
+
+local_2(Pred, plusone(Int)) :- call(Pred, Int).
+
Index: tests/valid/intermod_test2.m
===================================================================
RCS file: /home/staff/zs/imp/tests/valid/intermod_test2.m,v
retrieving revision 1.1
diff -u -r1.1 intermod_test2.m
--- intermod_test2.m	1997/06/29 23:23:32	1.1
+++ intermod_test2.m	1997/11/20 06:29:11
@@ -5,6 +5,8 @@
 :- import_module int.
 :- pred baz(int::in) is semidet.
 
+:- func plusone(int :: in) = (int :: out) is det.
+
 :- implementation.
 
 :- type t
@@ -24,3 +26,11 @@
 :- mode local(pred(int_mode) is det, out) is det.
 
 local(Pred, Int) :- call(Pred, Int0), Int is Int0 + 1.
+
+% One version of the compiler incorrectly wrote this declaration to
+% the .opt file as `:- pragma inline((intermod_test2:plusone)/2).'
+% 		-- bromage  20 Nov 1997
+:- pragma inline(plusone/1).
+
+plusone(Int0) = Int :- Int is Int0 + 1.
+