[m-rev.] for review: improve error message for pragma export and model_non code

Julien Fischer juliensf at cs.mu.OZ.AU
Wed Jan 5 14:25:15 AEDT 2005


For review by anyone.

Estimated hours taken: 3
Branches: main

Catch errors concerning pragma export and model_non code
earlier than we do at the moment.  Currently, we just generate
#error directives in the C code and let the C preprocessor
report the error.

compiler/make_hlds.m:
	Emit an error message if pragma export is used on a
	procedure that has a declared determinism of multi
	or nondet.

compiler/det_analysis.m:
compiler/det_report.m:
	As above, but handle the case where the determinism
	has to be inferred.

compiler/export.m:
	Abort rather than trying to generate code for model_non
	pragma exports.

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

Julien.

Workspace:/home/earth/juliensf/ws52
Index: compiler/det_analysis.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/det_analysis.m,v
retrieving revision 1.172
diff -u -r1.172 det_analysis.m
--- compiler/det_analysis.m	10 Dec 2004 07:03:43 -0000	1.172
+++ compiler/det_analysis.m	22 Dec 2004 03:50:51 -0000
@@ -314,6 +314,26 @@
 	proc_info_set_goal(Goal, Proc0, Proc1),
 	proc_info_set_inferred_determinism(Detism, Proc1, Proc),

+	% Check to make sure that if this procedure is exported to
+	% C via a pragma export declaration then the determinism
+	% is not multi or nondet - pragma exported procs that have
+	% been declared to have these determinisms should have been
+	% picked up in make_hlds, so this is just to catch those whose
+	% determinisms need to be inferred.
+
+	module_info_get_pragma_exported_procs(!.ModuleInfo,
+		ExportedProcs),
+	(
+		list.member(pragma_exported_proc(PredId, ProcId, _, _),
+			ExportedProcs),
+		( Detism = multidet ; Detism = nondet)
+	->
+		list.cons(export_model_non_proc(PredId, ProcId, Detism),
+			!Msgs)
+	;
+		true
+	),
+
 		%  Put back the new proc_info structure.
 	map__det_update(Procs0, ProcId, Proc, Procs),
 	pred_info_set_procedures(Procs, Pred0, Pred),
Index: compiler/det_report.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/det_report.m,v
retrieving revision 1.92
diff -u -r1.92 det_report.m
--- compiler/det_report.m	27 Dec 2004 03:55:37 -0000	1.92
+++ compiler/det_report.m	4 Jan 2005 06:43:33 -0000
@@ -61,7 +61,10 @@
 				hlds_goal_info, list(hlds_goal))
 		; 	pragma_c_code_without_det_decl(pred_id, proc_id)
 		;	has_io_state_but_not_det(pred_id, proc_id)
-		;	will_not_throw_with_erroneous(pred_id, proc_id).
+		;	will_not_throw_with_erroneous(pred_id, proc_id)
+		;	export_model_non_proc(pred_id, proc_id, determinism).
+				% Procedure with multi or nondet detism
+				% exported via :- pragma export ...

 :- type seen_call_id
 	--->	seen_call(pred_id, proc_id)
@@ -1059,6 +1062,7 @@
 det_msg_get_type(pragma_c_code_without_det_decl(_, _), error).
 det_msg_get_type(has_io_state_but_not_det(_, _), error).
 det_msg_get_type(will_not_throw_with_erroneous(_, _), error).
+det_msg_get_type(export_model_non_proc(_, _, _), error).

 det_msg_is_any_mode_msg(multidet_disj(_, _), all_modes).
 det_msg_is_any_mode_msg(det_disj(_, _), all_modes).
@@ -1083,6 +1087,7 @@
 det_msg_is_any_mode_msg(pragma_c_code_without_det_decl(_, _), any_mode).
 det_msg_is_any_mode_msg(has_io_state_but_not_det(_, _), any_mode).
 det_msg_is_any_mode_msg(will_not_throw_with_erroneous(_, _), any_mode).
+det_msg_is_any_mode_msg(export_model_non_proc(_, _, _), any_mode).

 :- pred det_report_msg(det_msg::in, module_info::in, io::di, io::uo) is det.

@@ -1392,7 +1397,36 @@
 		  words("to erroneous procedures.")
 		],
 	write_error_pieces(Context, 0, Pieces, !IO).
+det_report_msg(export_model_non_proc(PredId, ProcId, Detism), ModuleInfo,
+		!IO) :-
+	module_info_get_pragma_exported_procs(ModuleInfo, ExportedProcs),
+	(
+		get_exported_proc_context(ExportedProcs, PredId, ProcId,
+			Context)
+	->
+		Pieces = [words("Error: "),
+			  fixed(":- pragam export' declaration"),
+			  words("for a procedure that has"),
+			  words("a determinism of"),
+			  fixed(hlds_out.determinism_to_string(Detism)
+				++ ",")
+			],
+		error_util.write_error_pieces(Context, 0, Pieces, !IO)
+	;
+		unexpected(this_file, "Cannot find proc in table of "
+			++ "pragma exported procs")
+	).
+
+
+:- pred get_exported_proc_context(list(pragma_exported_proc)::in,
+	pred_id::in, proc_id::in, prog_context::out) is semidet.

+get_exported_proc_context([ Proc | Procs], PredId, ProcId, Context) :-
+	( Proc = pragma_exported_proc(PredId, ProcId, _, Context0) ->
+		Context = Context0
+	;
+		get_exported_proc_context(Procs, PredId, ProcId, Context)
+	).
 %-----------------------------------------------------------------------------%

 :- func det_report_seen_call_id(module_info, seen_call_id)
@@ -1450,5 +1484,11 @@
 	list__foldl((pred((Option - Value)::in, di, uo) is det -->
 		globals__io_set_option(Option, Value)
 	), OptionsToRestore, !IO).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "det_report.m".

 %-----------------------------------------------------------------------------%
Index: compiler/export.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/export.m,v
retrieving revision 1.80
diff -u -r1.80 export.m
--- compiler/export.m	17 Jun 2004 04:17:51 -0000	1.80
+++ compiler/export.m	5 Jan 2005 03:09:58 -0000
@@ -398,13 +398,7 @@
 		MaybeSucceed = "\treturn MR_TRUE;\n",
 		ArgInfoTypes2 = ArgInfoTypes0
 	; CodeModel = model_non,
-		% we should probably check this earlier, e.g. in make_hlds.m,
-		% but better we catch this error late than never...
-		C_RetType = "\n#error ""cannot export nondet procedure""\n",
-		MaybeDeclareRetval = "",
-		MaybeFail = "",
-		MaybeSucceed = "",
-		ArgInfoTypes2 = ArgInfoTypes0
+		unexpected(this_file, "Attempt to export model_non procedure.")
 	),
 	list__filter(export__include_arg, ArgInfoTypes2, ArgInfoTypes).

Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.489
diff -u -r1.489 make_hlds.m
--- compiler/make_hlds.m	5 Jan 2005 03:12:26 -0000	1.489
+++ compiler/make_hlds.m	5 Jan 2005 03:12:36 -0000
@@ -1353,14 +1353,35 @@
 			get_procedure_matching_declmodes(ExistingProcs, Modes,
 				!.Module, ProcId)
 		->
-			module_info_get_pragma_exported_procs(!.Module,
-				PragmaExportedProcs0),
-			NewExportedProc = pragma_exported_proc(PredId,
-				ProcId, C_Function, Context),
-			PragmaExportedProcs =
-				[NewExportedProc | PragmaExportedProcs0],
-			module_info_set_pragma_exported_procs(
-				PragmaExportedProcs, !Module)
+			map__lookup(Procs, ProcId, ProcInfo),
+			proc_info_declared_determinism(ProcInfo, MaybeDet),
+			% We cannot catch those multi or nondet procedures that
+			% don't have a determinism declaration until after
+			% determinism analysis.
+			(
+				MaybeDet = yes(Det),
+				( Det = nondet ; Det = multidet )
+			->
+				Pieces = [words("Error: "),
+				    fixed("`:- pragma export' declaration"),
+				    words("for a procedure that has"),
+				    words("a declared determinism of"),
+				    fixed(hlds_out.determinism_to_string(Det)
+					++ ".")
+				],
+				error_util.write_error_pieces(Context, 0,
+					Pieces, !IO),
+				module_info_incr_errors(!Module)
+			;
+				module_info_get_pragma_exported_procs(!.Module,
+					PragmaExportedProcs0),
+				NewExportedProc = pragma_exported_proc(PredId,
+					ProcId, C_Function, Context),
+				PragmaExportedProcs =
+					[NewExportedProc | PragmaExportedProcs0],
+				module_info_set_pragma_exported_procs(
+					PragmaExportedProcs, !Module)
+			)
 		;
 			undefined_mode_error(Name, Arity, Context,
 				"`:- pragma export' declaration", !IO),
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.155
diff -u -r1.155 Mmakefile
--- tests/invalid/Mmakefile	10 Dec 2004 07:03:45 -0000	1.155
+++ tests/invalid/Mmakefile	20 Dec 2004 06:55:46 -0000
@@ -82,6 +82,7 @@
 	impure_method_impl \
 	inline_conflict \
 	inst_list_dup \
+	invalid_export_detism \
 	invalid_main \
 	invalid_typeclass \
 	io_in_ite_cond \
Index: tests/invalid/invalid_export_detism.err_exp
===================================================================
RCS file: tests/invalid/invalid_export_detism.err_exp
diff -N tests/invalid/invalid_export_detism.err_exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/invalid/invalid_export_detism.err_exp	20 Dec 2004 06:55:09 -0000
@@ -0,0 +1,4 @@
+invalid_export_detism.m:009: Error: `:- pragma export' declaration for a
+invalid_export_detism.m:009:   procedure that has a declared determinism of
+invalid_export_detism.m:009:   nondet.
+For more information, try recompiling with `-E'.
Index: tests/invalid/invalid_export_detism.m
===================================================================
RCS file: tests/invalid/invalid_export_detism.m
diff -N tests/invalid/invalid_export_detism.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/invalid/invalid_export_detism.m	20 Dec 2004 06:54:42 -0000
@@ -0,0 +1,16 @@
+:- module invalid_export_detism.
+
+:- interface.
+
+:- pred foo(int::in, int::out) is nondet.
+
+:- implementation.
+
+:- pragma export(foo(in, out), "EXPORTED_FOO").
+
+foo(1, 2).
+foo(2, 3).
+foo(3, 4).
+foo(3, 5).
+foo(3, 6).
+

--------------------------------------------------------------------------
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