[m-rev.] for review: improve error message for model_non pragma imports

[Julien Fischer]

For review by anyone.

Estimated hours taken: 1.5
Branches: main, release

Improve the error message if an attempt is made to use `:- pragma
import' on a multi or nondet procedure.  Currently, we just emit #error
directives in the generated C code and let the C preprocessor handle the
error reporting.

compiler/foreign.m:
	Check that we are not trying to use pragma import for
	model_non code and emit an error message if we do.

compiler/make_hlds.m:
	Conform to the above change.

tests/invalid/Mmakefile:
tests/invalid/invalid_import_detism.m:
tests/invalid/invalid_import_detism.err_exp:
	Test case for the above.

Julien.

Workspace:/home/swordfish/juliensf/ws71
Index: compiler/foreign.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/foreign.m,v
retrieving revision 1.45
diff -u -r1.45 foreign.m
--- compiler/foreign.m	21 Mar 2005 04:45:45 -0000	1.45
+++ compiler/foreign.m	21 Mar 2005 23:26:08 -0000
@@ -25,7 +25,7 @@
 :- import_module mdbcomp__prim_data.
 :- import_module parse_tree__prog_data.

-:- import_module bool, list, std_util, string, term.
+:- import_module bool, io, list, std_util, string, term.

 :- type foreign_decl_info 		== list(foreign_decl_code).
 					% in reverse order
@@ -160,10 +160,12 @@
 	% which imports the foreign function, and return the varset,
 	% pragma_vars, argument types and other information about the
 	% generated predicate body.
+	%
 :- pred make_pragma_import(pred_info::in, proc_info::in, string::in,
-	prog_context::in, module_info::in, pragma_foreign_code_impl::out,
+	prog_context::in, pragma_foreign_code_impl::out,
 	prog_varset::out, list(pragma_var)::out, list(type)::out, arity::out,
-	pred_or_func::out) is det.
+	pred_or_func::out, module_info::in, module_info::out, io::di, io::uo)
+	is det.

 	% The name of the #define which can be used to guard declarations with
 	% to prevent entities being declared twice.
@@ -180,6 +182,7 @@
 :- import_module hlds__code_model.
 :- import_module hlds__hlds_data.
 :- import_module hlds__hlds_module.
+:- import_module hlds__hlds_out.
 :- import_module hlds__hlds_pred.
 :- import_module libs__globals.
 :- import_module parse_tree__error_util.
@@ -354,8 +357,8 @@
 make_pred_name_rest(java, _SymName) = "some_java_name".

 make_pragma_import(PredInfo, ProcInfo, C_Function, Context,
-		ModuleInfo, PragmaImpl, VarSet, PragmaVars, ArgTypes,
-		Arity, PredOrFunc) :-
+		PragmaImpl, VarSet, PragmaVars, ArgTypes,
+		Arity, PredOrFunc, !ModuleInfo, !IO) :-
 	%
 	% lookup some information we need from the pred_info and proc_info
 	%
@@ -386,11 +389,13 @@
 	% the type-infos yet.  polymorphism.m is responsible for adding
 	% the type-info arguments to the list of variables.
 	%
-	handle_return_value(CodeModel, PredOrFunc, PragmaVarsAndTypes,
-			ModuleInfo, ArgPragmaVarsAndTypes, Return),
+	proc_info_declared_determinism(ProcInfo, MaybeDeclaredDetism),
+	handle_return_value(Context, MaybeDeclaredDetism, CodeModel,
+		PredOrFunc, PragmaVarsAndTypes, ArgPragmaVarsAndTypes,
+		Return, !ModuleInfo, !IO),
 	assoc_list__keys(ArgPragmaVarsAndTypes, ArgPragmaVars),
-	create_pragma_import_c_code(ArgPragmaVars, ModuleInfo,
-			"", Variables),
+	create_pragma_import_c_code(ArgPragmaVars, !.ModuleInfo,
+		"", Variables),

 	%
 	% Make an import implementation
@@ -398,7 +403,9 @@
 	PragmaImpl = import(C_Function, Return, Variables, yes(Context)).

 %
-% handle_return_value(CodeModel, PredOrFunc, Args0, M, Args, C_Code0):
+% handle_return_value(Contxt, DeclaredDetism, CodeModel, PredOrFunc, Args0,
+% 		M, Args, C_Code0):
+%
 %	Figures out what to do with the C function's return value,
 %	based on Mercury procedure's code model, whether it is a predicate
 %	or a function, and (if it is a function) the type and mode of the
@@ -409,17 +416,24 @@
 %	Returns in Args all of Args0 that must be passed as arguments
 %	(i.e. all of them, or all of them except the return value).
 %
-:- pred handle_return_value(code_model::in, pred_or_func::in,
-	assoc_list(pragma_var, type)::in, module_info::in,
-	assoc_list(pragma_var, type)::out, string::out) is det.
+% 	Causes an error message to be emitted if the code_model is
+% 	not compatible with the use of pragma import (ie. it is
+% 	model_non).
+%
+:- pred handle_return_value(prog_context::in, maybe(determinism)::in,
+	code_model::in, pred_or_func::in,
+	assoc_list(pragma_var, type)::in, assoc_list(pragma_var, type)::out,
+	string::out, module_info::in, module_info::out, io::di, io::uo)
+	is det.

-handle_return_value(CodeModel, PredOrFunc, Args0, ModuleInfo, Args, C_Code0) :-
+handle_return_value(Context, MaybeDeclaredDetism, CodeModel, PredOrFunc,
+		Args0, Args, C_Code0, !ModuleInfo, !IO) :-
 	( CodeModel = model_det,
 		(
 			PredOrFunc = function,
 			pred_args_to_func_args(Args0, Args1, RetArg),
 			RetArg = pragma_var(_, RetArgName, RetMode) - RetType,
-			mode_to_arg_mode(ModuleInfo, RetMode, RetType,
+			mode_to_arg_mode(!.ModuleInfo, RetMode, RetType,
 				RetArgMode),
 			RetArgMode = top_out,
 			\+ type_util__is_dummy_argument_type(RetType)
@@ -438,12 +452,28 @@
 		C_Code0 = "SUCCESS_INDICATOR = ",
 		Args2 = Args0
 	; CodeModel = model_non,
-		% XXX we should report an error here, rather than generating
-		% C code with `#error'...
+		(
+			MaybeDeclaredDetism = yes(DeclaredDetism),
+			DetismStr = determinism_to_string(DeclaredDetism)
+		;
+			MaybeDeclaredDetism = no,
+			DetismStr = "multi or nondet"
+		),
+		ErrorPieces = [
+			words("Error: `pragma_import' declaration for"),
+			words("a procedure that has a determinism of"),
+			fixed(DetismStr), suffix(".")
+		],
+		write_error_pieces(Context, 0, ErrorPieces, !IO),
+		module_info_incr_errors(!ModuleInfo),
+		%
+		% The following are just dummy values - they will
+		% never actually be used.
+		%
 		C_Code0 = "\n#error ""cannot import nondet procedure""\n",
 		Args2 = Args0
 	),
-	list__filter(include_import_arg(ModuleInfo), Args2, Args).
+	list__filter(include_import_arg(!.ModuleInfo), Args2, Args).

 %
 % include_import_arg(M, Arg):
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.504
diff -u -r1.504 make_hlds.m
--- compiler/make_hlds.m	21 Mar 2005 04:45:45 -0000	1.504
+++ compiler/make_hlds.m	21 Mar 2005 22:18:22 -0000
@@ -5036,8 +5036,8 @@
     pred_info_procedures(!.PredInfo, Procs),
     map__lookup(Procs, ProcId, ProcInfo),
     foreign__make_pragma_import(!.PredInfo, ProcInfo, C_Function, Context,
-        !.ModuleInfo, PragmaImpl, VarSet, PragmaVars, ArgTypes,
-        Arity, PredOrFunc),
+        PragmaImpl, VarSet, PragmaVars, ArgTypes,
+        Arity, PredOrFunc, !ModuleInfo, !IO),

     %
     % lookup some information we need from the pred_info and proc_info
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.158
diff -u -r1.158 Mmakefile
--- tests/invalid/Mmakefile	9 Mar 2005 04:52:45 -0000	1.158
+++ tests/invalid/Mmakefile	21 Mar 2005 23:30:00 -0000
@@ -86,6 +86,7 @@
 	inline_conflict \
 	inst_list_dup \
 	invalid_export_detism \
+	invalid_import_detism \
 	invalid_main \
 	invalid_typeclass \
 	io_in_ite_cond \
Index: tests/invalid/invalid_import_detism.err_exp
===================================================================
RCS file: tests/invalid/invalid_import_detism.err_exp
diff -N tests/invalid/invalid_import_detism.err_exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/invalid/invalid_import_detism.err_exp	21 Mar 2005 23:29:28 -0000
@@ -0,0 +1,5 @@
+invalid_import_detism.m:010: Error: `pragma_import' declaration for a procedure
+invalid_import_detism.m:010:   that has a determinism of nondet.
+invalid_import_detism.m:011: Error: `pragma_import' declaration for a procedure
+invalid_import_detism.m:011:   that has a determinism of multi.
+For more information, try recompiling with `-E'.
Index: tests/invalid/invalid_import_detism.m
===================================================================
RCS file: tests/invalid/invalid_import_detism.m
diff -N tests/invalid/invalid_import_detism.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/invalid/invalid_import_detism.m	21 Mar 2005 23:28:46 -0000
@@ -0,0 +1,11 @@
+:- module invalid_import_detism.
+
+:- interface.
+
+:- pred foo(int::in, int::out) is nondet.
+:- pred bar(int::in, int::out) is multi.
+
+:- implementation.
+
+:- pragma import(foo(in, out), "IMPORTED_FOO").
+:- pragma import(bar(in, out), "IMPORTED_BAR").
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------