[m-rev.] for review: check for pred methods with no modes

Fergus Henderson fjh at cs.mu.OZ.AU
Wed Apr 25 03:12:58 AEST 2001


If there's no objections, I'll commit this sometime soon.

----------

Estimated hours taken: 4
Branches: main, release

Fix a bug where the compiler was silently accepting invalid code.

doc/reference_manual.texi:
	Document that type class methods must have their modes and
	determinism explicitly declared.

compiler/make_hlds.m:
	Report errors for predicate type class methods with no modes
	or with modes but no determinism.

tests/invalid/Mmakefile:
tests/invalid/typeclass_missing_mode.m:
tests/invalid/typeclass_missing_mode.err_exp:
tests/invalid/typeclass_missing_mode_2.m:
tests/invalid/typeclass_missing_mode_2.err_exp:
tests/invalid/typeclass_missing_det.m:
tests/invalid/typeclass_missing_det.err_exp:
tests/invalid/typeclass_missing_det_2.m:
tests/invalid/typeclass_missing_det_2.err_exp:
	Add some regression tests.

tests/invalid/tc_err1.err_exp:
	Update the expected output for this existing test.

Workspace: /home/mars/fjh/ws1/mercury
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.204
diff -u -d -r1.204 reference_manual.texi
--- doc/reference_manual.texi	2001/03/27 05:23:20	1.204
+++ doc/reference_manual.texi	2001/04/24 16:16:47
@@ -3614,10 +3614,19 @@
 declares the type class @code{point}, which
 represents points in two dimensional space. 
 
- at code{pred}, @code{func} and @code{mode} declarations are the only legal
-declarations inside a @code{typeclass} declaration.  The number of parameters 
-to the type class (e.g. @code{T}) is not limited.  For example, the following 
-is allowed:
+ at code{pred}, @code{func} and @code{mode} declarations are the only
+legal declarations inside a @code{typeclass} declaration.  The mode and
+determinism of type class methods must be explicitly declared or
+(for functions) defaulted, not inferred.  In other words, for each
+predicate declared in a type class, there must be at least one mode
+declaration, and each mode declaration in a type class must include
+an explicit determinism annotation.  Functions with no explicit mode
+declaration get the usual default mode (@pxref{Modes}): all arguments
+have mode @samp{in}, the result has mode @samp{out}, and the determinism
+is @samp{det}.
+
+The number of parameters to the type class (e.g. @code{T}) is not limited. 
+For example, the following is allowed:
 
 @example
 :- typeclass a(T1, T2) where [@dots{}].
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.368
diff -u -d -r1.368 make_hlds.m
--- compiler/make_hlds.m	2001/04/07 14:04:45	1.368
+++ compiler/make_hlds.m	2001/04/24 16:59:52
@@ -2379,8 +2379,8 @@
 		Module) -->
 	module_add_class_interface_2(Module0, Name, Vars, Methods, Status,
 		PredProcIds0, Module1),
-	{ add_default_class_method_func_modes(Methods, PredProcIds0,
-		PredProcIds, Module1, Module) }.
+	check_method_modes(Methods, PredProcIds0,
+		PredProcIds, Module1, Module).
 
 :- pred module_add_class_interface_2(module_info, sym_name, list(tvar),
 	class_interface, item_status, list(maybe(pair(pred_id, proc_id))), 
@@ -2451,59 +2451,80 @@
 		{ MaybePredIdProcId = yes(PredIdProcId) }
 	).
 
-	% Go through the list of class methods, looking for functions without
-	% mode declarations.
-:- pred add_default_class_method_func_modes(class_interface, 
+	% Go through the list of class methods, looking for
+	% - functions without mode declarations: add a default mode
+	% - predicates without mode declarations: report an error
+	% - mode declarations with no determinism: report an error
+:- pred check_method_modes(class_interface, 
 	list(maybe(pair(pred_id, proc_id))), 
-	list(maybe(pair(pred_id, proc_id))), module_info, module_info).
-:- mode add_default_class_method_func_modes(in, in, out, in, out) is det.
+	list(maybe(pair(pred_id, proc_id))), module_info, module_info,
+	io__state, io__state).
+:- mode check_method_modes(in, in, out, in, out, di, uo) is det.
 
-add_default_class_method_func_modes([], PredProcIds, PredProcIds,
-		Module, Module).
-add_default_class_method_func_modes([M|Ms], PredProcIds0, PredProcIds,
-		Module0, Module) :-
+check_method_modes([], PredProcIds, PredProcIds, Module, Module) --> [].
+check_method_modes([M|Ms], PredProcIds0, PredProcIds, Module0, Module) -->
 	(
-		M = func(_, _, _, FuncName, TypesAndModes, _, _, _, _, _, _)
+		{ M = func(_, _, _, QualName, TypesAndModes, _, _, _, _, _, _),
+		  PorF = function
+		; M = pred(_, _, _, QualName, TypesAndModes, _, _, _, _, _),
+		  PorF = predicate
+		}
 	->
-		( FuncName = qualified(ModuleName0, Func0) ->
+		{ QualName = qualified(ModuleName0, Name0) ->
 			ModuleName = ModuleName0,
-			Func = Func0
+			Name = Name0
 		;
 			% The class interface should be fully module qualified
 			% by prog_io.m at the time it is read in.
 			error(
 		       "add_default_class_method_func_modes: unqualified func")
-		),
+		},
 
-		list__length(TypesAndModes, FuncArity),
-		module_info_get_predicate_table(Module0, PredTable),
+		{ list__length(TypesAndModes, Arity) },
+		{ adjust_func_arity(PorF, Arity, PredArity) },
+
+		{ module_info_get_predicate_table(Module0, PredTable) },
 		(
-			predicate_table_search_func_m_n_a(PredTable,
-				ModuleName, Func, FuncArity, [PredId])
+			{ predicate_table_search_pf_m_n_a(PredTable, PorF,
+				ModuleName, Name, PredArity, [PredId]) }
 		->
-			module_info_pred_info(Module0, PredId, PredInfo0),
-			maybe_add_default_func_mode(PredInfo0,
-				PredInfo, MaybeProc),
+			{ module_info_pred_info(Module0, PredId, PredInfo0) },
 			(
-				MaybeProc = no,
-				PredProcIds1 = PredProcIds0,
-				Module1 = Module0
+				{ PorF = function },
+				{ maybe_add_default_func_mode(PredInfo0,
+					PredInfo, MaybeProc) },
+				{
+					MaybeProc = no,
+					PredProcIds1 = PredProcIds0,
+					Module1 = Module0
+				;
+					MaybeProc = yes(ProcId),
+					NewPredProc = yes(PredId - ProcId),
+					PredProcIds1 = [NewPredProc |
+						PredProcIds0],
+					module_info_set_pred_info(Module0,
+						PredId, PredInfo, Module1)
+				}
 			;
-				MaybeProc = yes(ProcId),
-				NewPredProc = yes(PredId - ProcId),
-				PredProcIds1 = [NewPredProc | PredProcIds0],
-				module_info_set_pred_info(Module0, PredId,
-					PredInfo, Module1)
+				{ PorF = predicate },
+				{ pred_info_procedures(PredInfo0, Procs) },
+				( { map__is_empty(Procs) } ->
+					pred_method_with_no_modes_error(
+						PredInfo0)
+				;
+					[]
+				),
+				{ Module1 = Module0 },
+				{ PredProcIds1 = PredProcIds0 }
 			)
 		;
-			error("add_default_class_method_func_modes")
+			{ error("handle_methods_with_no_modes") }
 		)
 	;
-		PredProcIds1 = PredProcIds0,
-		Module1 = Module0
+		{ PredProcIds1 = PredProcIds0 },
+		{ Module1 = Module0 }
 	),
-	add_default_class_method_func_modes(Ms, PredProcIds1, PredProcIds,
-		Module1, Module).
+	check_method_modes(Ms, PredProcIds1, PredProcIds, Module1, Module).
 
 :- pred module_add_instance_defn(module_info, module_name,
 		list(class_constraint), sym_name, list(type), instance_body,
@@ -3260,7 +3281,7 @@
 	{ map__lookup(Preds0, PredId, PredInfo0) },
 
 	module_do_add_mode(PredInfo0, InstVarSet, Arity, Modes, MaybeDet,
-		MContext, PredInfo, ProcId),
+		IsClassMethod, MContext, PredInfo, ProcId),
 	{ map__det_update(Preds0, PredId, PredInfo, Preds) },
 	{ predicate_table_set_preds(PredicateTable1, Preds, PredicateTable) },
 	{ module_info_set_predicate_table(ModuleInfo0, PredicateTable,
@@ -3268,12 +3289,13 @@
 	{ PredProcId = PredId - ProcId }.
 
 :- pred module_do_add_mode(pred_info, inst_varset, arity, list(mode),
-		maybe(determinism), prog_context, pred_info, proc_id,
+		maybe(determinism), bool, prog_context, pred_info, proc_id,
 		io__state, io__state).
-:- mode module_do_add_mode(in, in, in, in, in, in, out, out, di, uo) is det.
+:- mode module_do_add_mode(in, in, in, in, in, in, in, out, out, di, uo)
+		is det.
 
-module_do_add_mode(PredInfo0, InstVarSet, Arity, Modes, MaybeDet, MContext,
-		PredInfo, ProcId) -->
+module_do_add_mode(PredInfo0, InstVarSet, Arity, Modes, MaybeDet,
+		IsClassMethod, MContext, PredInfo, ProcId) -->
 		% check that the determinism was specified
 	(
 		{ MaybeDet = no }
@@ -3283,7 +3305,10 @@
 		{ pred_info_module(PredInfo0, PredModule) },
 		{ pred_info_name(PredInfo0, PredName) },
 		{ PredSymName = qualified(PredModule, PredName) },
-		( { status_is_exported(ImportStatus, yes) } ->
+		( { IsClassMethod = yes } ->
+			unspecified_det_for_method(PredSymName, Arity,
+				PredOrFunc, MContext)
+		; { status_is_exported(ImportStatus, yes) } ->
 			unspecified_det_for_exported(PredSymName, Arity,
 				PredOrFunc, MContext)
 		;
@@ -7455,6 +7480,22 @@
 	% Which is more correct?
 	io__write_string("  without corresponding `pred' or `func' declaration.\n").
 
+:- pred pred_method_with_no_modes_error(pred_info, io__state, io__state).
+:- mode pred_method_with_no_modes_error(in, di, uo) is det.
+
+pred_method_with_no_modes_error(PredInfo) -->
+	{ pred_info_context(PredInfo, Context) },
+	{ pred_info_module(PredInfo, Module) },
+	{ pred_info_name(PredInfo, Name) },
+	{ pred_info_arity(PredInfo, Arity) },
+	io__set_exit_status(1),
+	prog_out__write_context(Context),
+	io__write_string("Error: no mode declaration for type class method\n"),
+	prog_out__write_context(Context),
+	io__write_string("  predicate `"),
+	prog_out__write_sym_name_and_arity(qualified(Module,Name)/Arity),
+	io__write_string("'.\n").
+
 :- pred undefined_mode_error(sym_name, int, prog_context, string,
 				io__state, io__state).
 :- mode undefined_mode_error(in, in, in, in, di, uo) is det.
@@ -7561,6 +7602,20 @@
 	;
 		[]
 	).
+
+:- pred unspecified_det_for_method(sym_name, arity, pred_or_func,
+			prog_context, io__state, io__state).
+:- mode unspecified_det_for_method(in, in, in, in, di, uo) is det.
+
+unspecified_det_for_method(Name, Arity, PredOrFunc, Context) -->
+	io__set_exit_status(1),
+	prog_out__write_context(Context),
+	io__write_string(
+		"Error: no determinism declaration for type class method\n"),
+	prog_out__write_context(Context),
+	io__write_string("  "),
+	hlds_out__write_simple_call_id(PredOrFunc, Name/Arity),
+	io__write_string(".\n").
 
 :- pred unspecified_det_for_exported(sym_name, arity, pred_or_func,
 			prog_context, io__state, io__state).
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.81
diff -u -d -r1.81 Mmakefile
--- tests/invalid/Mmakefile	2001/03/05 02:50:52	1.81
+++ tests/invalid/Mmakefile	2001/04/24 17:06:51
@@ -83,6 +83,10 @@
 	type_vars.m \
 	typeclass_bogus_method.m \
 	typeclass_mode.m \
+	typeclass_missing_det.m \
+	typeclass_missing_det_2.m \
+	typeclass_missing_mode.m \
+	typeclass_missing_mode_2.m \
 	typeclass_test_1.m \
 	typeclass_test_2.m \
 	typeclass_test_3.m \
Index: tests/invalid/tc_err1.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/tc_err1.err_exp,v
retrieving revision 1.2
diff -u -d -r1.2 tc_err1.err_exp
--- tests/invalid/tc_err1.err_exp	2000/09/20 11:59:45	1.2
+++ tests/invalid/tc_err1.err_exp	2001/04/24 17:08:38
@@ -1,4 +1,4 @@
-tc_err1.m:025: Error: no determinism declaration for exported
+tc_err1.m:025: Error: no determinism declaration for type class method
 tc_err1.m:025:   predicate `tc_err1:handle_typedefs/3'.
 tc_err1.m:028: In instance declaration for `tc_err1:actions(tc_err1:pstate)':
 tc_err1.m:028:   no implementation for type class predicate method
Index: tests/invalid/typeclass_missing_det.err_exp
===================================================================
RCS file: typeclass_missing_det.err_exp
diff -N typeclass_missing_det.err_exp
--- /dev/null	Wed Apr 11 00:52:25 2001
+++ typeclass_missing_det.err_exp	Wed Apr 25 03:06:14 2001
@@ -0,0 +1,3 @@
+typeclass_missing_det.m:010: Error: no determinism declaration for type class method
+typeclass_missing_det.m:010:   predicate `typeclass_missing_det:p/1'.
+For more information, try recompiling with `-E'.
Index: tests/invalid/typeclass_missing_det.m
===================================================================
RCS file: typeclass_missing_det.m
diff -N typeclass_missing_det.m
--- /dev/null	Wed Apr 11 00:52:25 2001
+++ typeclass_missing_det.m	Wed Apr 25 02:55:33 2001
@@ -0,0 +1,11 @@
+% test the case of a type class pred-mode declaration without any determinism
+
+:- module typeclass_missing_det.
+:- interface.
+:- type dummy.
+
+:- implementation.
+
+:- typeclass c(T) where [
+	pred p(T::in)		% error -- missing det declaration for p/1
+].
Index: tests/invalid/typeclass_missing_det_2.err_exp
===================================================================
RCS file: typeclass_missing_det_2.err_exp
diff -N typeclass_missing_det_2.err_exp
--- /dev/null	Wed Apr 11 00:52:25 2001
+++ typeclass_missing_det_2.err_exp	Wed Apr 25 03:06:00 2001
@@ -0,0 +1,3 @@
+typeclass_missing_det_2.m:011: Error: no determinism declaration for type class method
+typeclass_missing_det_2.m:011:   predicate `typeclass_missing_det_2:p/1'.
+For more information, try recompiling with `-E'.
Index: tests/invalid/typeclass_missing_det_2.m
===================================================================
RCS file: typeclass_missing_det_2.m
diff -N typeclass_missing_det_2.m
--- /dev/null	Wed Apr 11 00:52:25 2001
+++ typeclass_missing_det_2.m	Wed Apr 25 03:02:04 2001
@@ -0,0 +1,12 @@
+% test the case of a type class mode declaration without any determinism
+
+:- module typeclass_missing_det_2.
+:- interface.
+:- type dummy.
+
+:- implementation.
+
+:- typeclass c(T) where [
+	pred p(T),
+	mode p(in)		% error -- missing det declaration for p/1
+].
Index: tests/invalid/typeclass_missing_mode.err_exp
===================================================================
RCS file: typeclass_missing_mode.err_exp
diff -N typeclass_missing_mode.err_exp
--- /dev/null	Wed Apr 11 00:52:25 2001
+++ typeclass_missing_mode.err_exp	Wed Apr 25 01:55:38 2001
@@ -0,0 +1,3 @@
+typeclass_missing_mode.m:007: Error: no mode declaration for type class method
+typeclass_missing_mode.m:007:   predicate `typeclass_missing_mode:p/1'.
+For more information, try recompiling with `-E'.
Index: tests/invalid/typeclass_missing_mode.m
===================================================================
RCS file: typeclass_missing_mode.m
diff -N typeclass_missing_mode.m
--- /dev/null	Wed Apr 11 00:52:25 2001
+++ typeclass_missing_mode.m	Wed Apr 25 01:54:01 2001
@@ -0,0 +1,8 @@
+% test the case of a type class containing a predicate method with no modes
+
+:- module typeclass_missing_mode.
+:- interface.
+
+:- typeclass c(T) where [
+	pred p(T)		% error -- missing mode declaration for p/1
+].
Index: tests/invalid/typeclass_missing_mode_2.err_exp
===================================================================
RCS file: typeclass_missing_mode_2.err_exp
diff -N typeclass_missing_mode_2.err_exp
--- /dev/null	Wed Apr 11 00:52:25 2001
+++ typeclass_missing_mode_2.err_exp	Wed Apr 25 01:55:53 2001
@@ -0,0 +1,7 @@
+typeclass_missing_mode_2.m:011: Error: no mode declaration for type class method
+typeclass_missing_mode_2.m:011:   predicate `typeclass_missing_mode_2:p/1'.
+typeclass_missing_mode_2.m:013: In instance declaration for
+typeclass_missing_mode_2.m:013:   `typeclass_missing_mode_2:c/1': incorrect
+typeclass_missing_mode_2.m:013:   method name(s): predicate
+typeclass_missing_mode_2.m:013:   `typeclass_missing_mode_2:p/1' .
+For more information, try recompiling with `-E'.
Index: tests/invalid/typeclass_missing_mode_2.m
===================================================================
RCS file: typeclass_missing_mode_2.m
diff -N typeclass_missing_mode_2.m
--- /dev/null	Wed Apr 11 00:52:25 2001
+++ typeclass_missing_mode_2.m	Wed Apr 25 01:55:29 2001
@@ -0,0 +1,15 @@
+% This test case is similar to typeclass_missing_mode,
+% except that it also includes an instance declaration.
+%
+% Currently mmc reports a spurious flow-on error for the
+% instance declaration.  (It would be nice to fix that someday.)
+
+:- module typeclass_missing_mode_2.
+:- interface.
+
+:- typeclass c(T) where [
+	pred p(T)		% error -- missing mode declaration for p/1
+].
+:- instance c(int) where [
+	p(_) :- true
+].

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
                                    |  of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh>  |     -- the last words of T. S. Garp.
--------------------------------------------------------------------------
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