[m-rev.] diff: fix bug in error messages

[Mark Brown]

Hi,

This fixes a bug that was reported by Rob Moss a while ago.

Cheers,
Mark.

Estimated hours taken: 0.5
Branches: main, release

compiler/module_qual.m:
	Check for variables used as constructors when module qualifying types
	and insts.  In both cases this is currently illegal, so we report a
	more sensible error message than we would otherwise get.

compiler/prog_type.m:
	Export a test to check if a type uses a variable as a constructor.

tests/invalid/Mmakefile:
tests/invalid/kind.err_exp:
tests/invalid/kind.m:
	Test case.

Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.104
diff -u -r1.104 module_qual.m
--- compiler/module_qual.m	20 Apr 2005 12:57:13 -0000	1.104
+++ compiler/module_qual.m	7 May 2005 10:11:24 -0000
@@ -870,10 +870,21 @@
 qualify_inst_name(user_inst(SymName0, Insts0), user_inst(SymName, Insts),
 		!Info, !IO) :-
 	qualify_inst_list(Insts0, Insts, !Info, !IO),
-	mq_info_get_insts(!.Info, InstIds),
-	list.length(Insts0, Arity),
-	find_unique_match(SymName0 - Arity, SymName - _,
-		InstIds, inst_id, !Info, !IO).
+	(
+		% Check for a variable inst constructor.
+		SymName0 = unqualified("")
+	->
+		mq_info_get_error_context(!.Info, ErrorContext),
+		report_invalid_user_inst(SymName0, Insts, ErrorContext, !IO),
+		mq_info_set_error_flag(inst_id, !Info),
+		mq_info_incr_errors(!Info),
+		SymName = SymName0
+	;
+		list.length(Insts0, Arity),
+		mq_info_get_insts(!.Info, InstIds),
+		find_unique_match(SymName0 - Arity, SymName - _,
+			InstIds, inst_id, !Info, !IO)
+	).
 qualify_inst_name(merge_inst(_, _), _, !Info, !IO) :-
 	error("compiler generated inst unexpected").
 qualify_inst_name(unify_inst(_, _, _, _), _, !Info, !IO) :-
@@ -941,6 +952,14 @@
 			TypeCtor = TypeCtor0
 		; type_ctor_is_tuple(TypeCtor0) ->
 			TypeCtor = TypeCtor0
+		; type_ctor_is_variable(TypeCtor0) ->
+			TypeCtor = TypeCtor0,
+			% This is an error until we support higher-kinded
+			% types.
+			mq_info_get_error_context(!.Info, ErrorContext),
+			report_invalid_type(Type0, ErrorContext, !IO),
+			mq_info_set_error_flag(type_id, !Info),
+			mq_info_incr_errors(!Info)
 		;
 			mq_info_get_types(!.Info, Types),
 			find_unique_match(TypeCtor0, TypeCtor, Types,
@@ -951,6 +970,8 @@
 	;
 		mq_info_get_error_context(!.Info, ErrorContext),
 		report_invalid_type(Type0, ErrorContext, !IO),
+		mq_info_set_error_flag(type_id, !Info),
+		mq_info_incr_errors(!Info),
 		Type = Type0
 	),
 	%
@@ -1465,16 +1486,29 @@
 is_or_are([_, _ | _], "are").
 
 	% Output an error message about an ill-formed type.
+	%
 :- pred report_invalid_type((type)::in, error_context::in,
 	io::di, io::uo) is det.
 
 report_invalid_type(Type, ErrorContext - Context, !IO) :-
 	ContextPieces = mq_error_context_to_pieces(ErrorContext),
 	varset.init(VarSet),
-	Pieces = [words("In definition of")] ++ ContextPieces ++
+	Pieces = [words("In")] ++ ContextPieces ++
 		[suffix(":"), nl, words("error: ill-formed type"),
 		fixed("`" ++ mercury_term_to_string(Type, VarSet, no) ++
 			"'.")],
+	write_error_pieces(Context, 0, Pieces, !IO),
+	io.set_exit_status(1, !IO).
+
+	% Output an error message about an ill-formed user_inst.
+	%
+:- pred report_invalid_user_inst(sym_name::in, list(inst)::in,
+	error_context::in, io::di, io::uo) is det.
+
+report_invalid_user_inst(_SymName, _Insts, ErrorContext - Context, !IO) :-
+	ContextPieces = mq_error_context_to_pieces(ErrorContext),
+	Pieces = [words("In")] ++ ContextPieces ++ [suffix(":"), nl,
+		words("error: variable used as inst constructor.")],
 	write_error_pieces(Context, 0, Pieces, !IO),
 	io.set_exit_status(1, !IO).
 
Index: compiler/prog_type.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_type.m,v
retrieving revision 1.5
diff -u -r1.5 prog_type.m
--- compiler/prog_type.m	23 Apr 2005 06:29:47 -0000	1.5
+++ compiler/prog_type.m	7 May 2005 08:34:47 -0000
@@ -59,6 +59,10 @@
 	% type_ctor_is_tuple(TypeCtor) succeeds iff TypeCtor is a tuple type.
 	%
 :- pred type_ctor_is_tuple(type_ctor::in) is semidet.
+
+	% type_ctor_is_variable(TypeCtor) succeeds iff TypeCtor is a variable.
+	%
+:- pred type_ctor_is_variable(type_ctor::in) is semidet.
 	
 	% Given a variable type, return its type variable.
 	%
@@ -320,6 +324,8 @@
 	type_ctor_is_tuple(TypeCtor).
 
 type_ctor_is_tuple(unqualified("{}") - _).
+
+type_ctor_is_variable(unqualified("") - _).
 
 prog_type.var(term.variable(Var), Var).
 
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.167
diff -u -r1.167 Mmakefile
--- tests/invalid/Mmakefile	28 Apr 2005 07:25:01 -0000	1.167
+++ tests/invalid/Mmakefile	7 May 2005 10:06:01 -0000
@@ -97,6 +97,7 @@
 	invalid_new \
 	invalid_typeclass \
 	io_in_ite_cond \
+	kind \
 	lambda_syntax_error \
 	loopcheck \
 	magicbox \
Index: tests/invalid/kind.err_exp
===================================================================
RCS file: tests/invalid/kind.err_exp
diff -N tests/invalid/kind.err_exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/invalid/kind.err_exp	7 May 2005 10:14:51 -0000
@@ -0,0 +1,9 @@
+kind.m:004: In definition of type `kind.t'/1:
+kind.m:004:   error: ill-formed type `V_1(int)'.
+kind.m:006: In declaration of typeclass `kind.tc'/1:
+kind.m:006:   error: ill-formed type `V_1(string)'.
+kind.m:011: In definition of inst `kind.i'/1:
+kind.m:011:   error: variable used as inst constructor.
+kind.m:012: In definition of mode `kind.m'/1:
+kind.m:012:   error: variable used as inst constructor.
+For more information, try recompiling with `-E'.
Index: tests/invalid/kind.m
===================================================================
RCS file: tests/invalid/kind.m
diff -N tests/invalid/kind.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/invalid/kind.m	7 May 2005 10:05:38 -0000
@@ -0,0 +1,13 @@
+:- module kind.
+:- interface.
+
+:- type t(K1) ---> t(K1(int)).
+
+:- typeclass tc(K2) where [
+	func f(K2(string)) = string,
+	func g(t(K2)) = int
+].
+
+:- inst i(K3) ---> t(K3(ground)).
+:- mode m(K4) == free >> bound(t(K4(ground))).
+
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------