[m-rev.] for review: make sure that abstract instances have a corresponding concrete instance

[Julien Fischer]

For review by anyone.

Estimated hours taken: 3
Branches: main, release

Have the compiler emit an error if an abstract instance declaration
in the interface of a module does not have a corresponding concrete
instance declaration in the implementation of the module.  Currently
the compiler just ignores this situation which leads to C compilation
errors in the MLDS grades and link-time errors in the LLDS grades.

compiler/check_typeclass.m:
	Emit an error message if an abstract instance declaration
	in the interface of a module does not have a corresponding
	concrete instance in the implementation.

	Use unexpected/2 in place of error/2.

	Fix the positioning of a few comments.

	Add an end_module declaration.

compiler/hlds_data.m:
	Make the instance_table type a multi_map (which it
	already effectively was).

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

Julien.

Workspace:/home/swordfish/juliensf/ws75
Index: compiler/check_typeclass.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/check_typeclass.m,v
retrieving revision 1.67
diff -u -r1.67 check_typeclass.m
--- compiler/check_typeclass.m	12 Apr 2005 07:58:14 -0000	1.67
+++ compiler/check_typeclass.m	13 Apr 2005 04:44:04 -0000
@@ -87,10 +87,12 @@
 :- import_module int.
 :- import_module list.
 :- import_module map.
+:- import_module multi_map.
 :- import_module require.
 :- import_module set.
 :- import_module std_util.
 :- import_module string.
+:- import_module svmulti_map.
 :- import_module svset.
 :- import_module term.
 :- import_module varset.
@@ -100,6 +102,7 @@
 check_typeclass__check_typeclasses(!QualInfo, !ModuleInfo, FoundError, !IO) :-
 	check_typeclass__check_instance_decls(!QualInfo, !ModuleInfo,
 		FoundInstanceError, !IO),
+ 	check_for_missing_concrete_instances(!ModuleInfo, !IO),
 	module_info_classes(!.ModuleInfo, ClassTable),
 	check_for_cyclic_classes(ClassTable, FoundCycleError, !IO),
 	FoundError = bool.or(FoundInstanceError, FoundCycleError).
@@ -145,7 +148,8 @@
 			qual_info	:: qual_info
 		).

-	% check all the instances of one class.
+	% Check all the instances of one class.
+	%
 :- pred check_one_class(class_table::in,
 	pair(class_id, list(hlds_instance_defn))::in,
 	pair(class_id, list(hlds_instance_defn))::out,
@@ -187,7 +191,8 @@
 			!CheckTCInfo, !IO)
 	).

-	% check one instance of one class
+	% Check one instance of one class.
+	%
 :- pred check_class_instance(class_id::in, list(prog_constraint)::in,
 	list(tvar)::in, hlds_class_interface::in, class_interface::in,
 	tvarset::in, list(pred_id)::in,
@@ -434,7 +439,8 @@
 		UnivCs = OtherUnivCs,
 		ClassContext = constraints(UnivCs, ExistCs)
 	;
-		error("check_instance_pred: no constraint on class method")
+		unexpected(this_file,
+			"check_instance_pred: no constraint on class method")
 	),

 	MethodName0 = pred_info_name(PredInfo),
@@ -844,7 +850,7 @@
 	( term__var_list_to_term_list(ClassVars1, ClassVarTerms) ->
 		ClassVars = ClassVars1
 	;
-		error("ClassVarTerms are not vars")
+		unexpected(this_file, "ClassVarTerms are not vars.")
 	),

 		% Calculate the bindings
@@ -917,6 +923,143 @@
 	string__append_list([", `", String0, "'", String1], String).

 %---------------------------------------------------------------------------%
+%
+% Check that every abstract instance in the interface of a module
+% has a corresponding concrete instance in the implementation.
+%
+
+:- pred check_for_missing_concrete_instances(
+	module_info::in, module_info::out, io::di, io::uo) is det.
+
+check_for_missing_concrete_instances(!ModuleInfo, !IO) :-
+	module_info_instances(!.ModuleInfo, InstanceTable),
+	%
+	% Grab all the abstract instance declarations in the interface
+	% of this module and all the concrete instances defined in the
+	% implementation.
+	%
+	gather_abstract_and_concrete_instances(InstanceTable,
+		AbstractInstances, ConcreteInstances),
+	map.foldl(check_for_corresponding_instances(ConcreteInstances),
+		AbstractInstances, !IO).
+
+	% gather_abstract_and_concrete_instances(Table,
+	% 	AbstractInstances, ConcreteInstances).
+	%
+	% Search the instance_table and create a table of abstract
+	% instances that occur in the module interface and a table of
+	% concrete instances that occur in the module implementation.
+	% Imported instances are not included at all.
+	%
+:- pred gather_abstract_and_concrete_instances(instance_table::in,
+	instance_table::out, instance_table::out) is det.
+
+gather_abstract_and_concrete_instances(InstanceTable, Abstracts,
+		Concretes) :-
+	map.foldl2(partition_instances_for_class, InstanceTable,
+		multi_map.init, Abstracts, multi_map.init, Concretes).
+
+	% Partition all the non-imported instances for a particular
+	% class into two groups, those that are abstract and in the
+	% module interface and those that are concrete and in the module
+	% implementation.  Concrete instances cannot occur in the
+	% interface and we ignore abstract instances in the
+	% implementation.
+	%
+:- pred partition_instances_for_class(class_id::in, list(hlds_instance_defn)::in,
+	instance_table::in, instance_table::out, instance_table::in,
+	instance_table::out) is det.
+
+partition_instances_for_class(ClassId, Instances, !Abstracts, !Concretes) :-
+	list.foldl2(partition_instances_for_class_2(ClassId), Instances,
+		!Abstracts, !Concretes).
+
+:- pred partition_instances_for_class_2(class_id::in, hlds_instance_defn::in,
+	instance_table::in, instance_table::out,
+	instance_table::in, instance_table::out) is det.
+
+partition_instances_for_class_2(ClassId, InstanceDefn, !Abstracts,
+		!Concretes) :-
+	ImportStatus = InstanceDefn ^ instance_status,
+	status_is_imported(ImportStatus, IsImported),
+	(
+		IsImported = no,
+		Body = InstanceDefn ^ instance_body,
+		(
+			Body = abstract,
+			status_is_exported_to_non_submodules(ImportStatus,
+				IsExported),
+			(
+				IsExported = yes,
+				svmulti_map.add(ClassId, InstanceDefn,
+					!Abstracts)
+			;
+				IsExported = no
+			)
+		;
+			Body = concrete(_),
+			svmulti_map.add(ClassId, InstanceDefn,
+				!Concretes)
+		)
+	;
+		IsImported = yes
+	).
+
+:- pred check_for_corresponding_instances(instance_table::in,
+	class_id::in, list(hlds_instance_defn)::in, io::di, io::uo) is det.
+
+check_for_corresponding_instances(Concretes, ClassId, InstanceDefns, !IO) :-
+	list.foldl(check_for_corresponding_instances_2(Concretes, ClassId),
+		InstanceDefns, !IO).
+
+:- pred check_for_corresponding_instances_2(instance_table::in, class_id::in,
+	hlds_instance_defn::in, io::di, io::uo) is det.
+
+check_for_corresponding_instances_2(Concretes, ClassId, AbstractInstance,
+		!IO) :-
+	AbstractTypes = AbstractInstance ^ instance_types,
+	( multi_map.search(Concretes, ClassId, ConcreteInstances) ->
+		(
+			list.member(ConcreteInstance, ConcreteInstances),
+			ConcreteTypes = ConcreteInstance ^ instance_types,
+			ConcreteTypes = AbstractTypes
+		->
+			MissingConcreteError = no
+		;
+			% There were concrete instances for ClassId in the
+			% implementation but none of them matches the
+			% abstract instance we have.
+			MissingConcreteError = yes
+		)
+	;
+		% There were no concrete instances for ClassId in the
+		% implementation.
+		MissingConcreteError = yes
+	),
+	(
+		MissingConcreteError = yes,
+		ClassId = class_id(ClassName, _),
+		prim_data.sym_name_to_string(ClassName, ClassNameString),
+		AbstractTypesString = mercury_type_list_to_string(
+			AbstractInstance ^ instance_tvarset, AbstractTypes),
+		AbstractInstanceName = "`" ++ ClassNameString ++
+			"(" ++ AbstractTypesString ++ ")'",
+		% XXX Should we mention any constraints on the instance
+		%     declaration here?
+		ErrorPieces = [words("Error: abstract instance declaration"),
+			words("for"), fixed(AbstractInstanceName),
+			words("has no corresponding concrete"),
+			words("instance in the implementation.")
+		],
+		AbstractInstanceContext = AbstractInstance ^ instance_context,
+		write_error_pieces(AbstractInstanceContext, 0, ErrorPieces,
+			!IO),
+		io.set_exit_status(1, !IO)
+	;
+		MissingConcreteError = no
+	).
+
+%-----------------------------------------------------------------------------%

 :- pred check_for_cyclic_classes(class_table::in, bool::out, io::di, io::uo)
 	is det.
@@ -1002,7 +1145,8 @@
 report_cyclic_classes(ClassTable, ClassPath, !IO) :-
 	(
 		ClassPath = [],
-		error("report_cyclic_classes: empty cycle found")
+		unexpected(this_file,
+			"report_cyclic_classes: empty cycle found.")
 	;
 		ClassPath = [ClassId | Tail],
 		Context = map.lookup(ClassTable, ClassId) ^ class_context,
@@ -1021,6 +1165,13 @@

 add_path_element(class_id(Name, Arity), RevPieces0) =
 	[sym_name_and_arity(Name/Arity), words("<=") | RevPieces0].
+
+
+%---------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "check_typeclass.m".

 %---------------------------------------------------------------------------%
 :- end_module check_typeclass.
Index: compiler/hlds_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_data.m,v
retrieving revision 1.91
diff -u -r1.91 hlds_data.m
--- compiler/hlds_data.m	1 Apr 2005 14:28:56 -0000	1.91
+++ compiler/hlds_data.m	13 Apr 2005 00:53:55 -0000
@@ -820,7 +820,8 @@

 	% For each class, we keep track of a list of its instances, since there
 	% can be more than one instance of each class.
-:- type instance_table == map(class_id, list(hlds_instance_defn)).
+	%
+:- type instance_table == multi_map(class_id, hlds_instance_defn).

 	% Information about a single `instance' declaration
 :- type hlds_instance_defn --->
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.162
diff -u -r1.162 Mmakefile
--- tests/invalid/Mmakefile	12 Apr 2005 07:58:19 -0000	1.162
+++ tests/invalid/Mmakefile	13 Apr 2005 03:53:34 -0000
@@ -97,6 +97,7 @@
 	make_opt_error \
 	merge_ground_any \
 	method_impl \
+	missing_concrete_instance \
 	missing_det_decls \
 	missing_init_pred \
 	missing_interface_import \
Index: tests/invalid/missing_concrete_instance.err_exp
===================================================================
RCS file: tests/invalid/missing_concrete_instance.err_exp
diff -N tests/invalid/missing_concrete_instance.err_exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/invalid/missing_concrete_instance.err_exp	13 Apr 2005 04:12:31 -0000
@@ -0,0 +1,5 @@
+missing_concrete_instance.m:011: Error: abstract instance declaration for
+missing_concrete_instance.m:011:   `missing_concrete_instance.foo(int)' has no
+missing_concrete_instance.m:011:   corresponding concrete instance in the
+missing_concrete_instance.m:011:   implementation.
+For more information, try recompiling with `-E'.
Index: tests/invalid/missing_concrete_instance.m
===================================================================
RCS file: tests/invalid/missing_concrete_instance.m
diff -N tests/invalid/missing_concrete_instance.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/invalid/missing_concrete_instance.m	13 Apr 2005 03:56:34 -0000
@@ -0,0 +1,11 @@
+%
+% rotd-2005-05-12 and before did not emit
+% an error about the missing concrete instance.
+%
+:- module missing_concrete_instance.
+
+:- interface.
+
+:- typeclass foo(T) where [].
+
+:- instance foo(int).

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