[m-dev.] for review: fix bug in record syntax

[Simon TAYLOR]

Estimated hours taken: 1

Fix a bug in record syntax reported by Tom Conway which caused a
compiler abort if there was a field and a constructor with the
same name.

compiler/post_typecheck.m:
	Check for a matching constructor before trying to
	expand out a field access function.

tests/valid/Mmakefile:
tests/valid/record_syntax_bug.m:
	Test case.



Index: compiler/post_typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/post_typecheck.m,v
retrieving revision 1.19
diff -u -u -r1.19 post_typecheck.m
--- compiler/post_typecheck.m	2000/04/14 08:38:19	1.19
+++ compiler/post_typecheck.m	2000/05/03 07:24:59
@@ -840,7 +840,18 @@
 		%
 		ConsId0 = cons(Name, Arity),
 		is_field_access_function_name(ModuleInfo0, Name, Arity,
-			AccessType, FieldName)
+			AccessType, FieldName),
+
+		%
+		% If there is a constructor for which the argument types
+		% match, this unification couldn't be a call to a field
+		% access function, otherwise there would have been an
+		% error reported for unresolved overloading. 
+		%
+		pred_info_typevarset(PredInfo0, TVarSet),
+		map__apply_to_list(ArgVars0, VarTypes0, ArgTypes0),
+		\+ find_matching_constructor(ModuleInfo0, TVarSet,
+			ConsId0, TypeOfX, ArgTypes0)
 	->
 		post_typecheck__finish_field_access_function(ModuleInfo0,
 			PredInfo0, PredInfo, AccessType, FieldName,
@@ -854,6 +865,34 @@
 		Goal = unify(X0, functor(ConsId0, ArgVars0), Mode0,
 				Unification0, UnifyContext) - GoalInfo0
 	).
+
+%-----------------------------------------------------------------------------%
+
+	% Succeed if there is a constructor which matches the given
+	% cons_id, type and argument types.
+:- pred find_matching_constructor(module_info, tvarset,
+		cons_id, type, list(type)).
+:- mode find_matching_constructor(in, in, in, in, in) is semidet.
+
+find_matching_constructor(ModuleInfo, TVarSet, ConsId, Type, ArgTypes) :-
+	type_to_type_id(Type, TypeId, _),
+	module_info_ctors(ModuleInfo, ConsTable),
+	map__search(ConsTable, ConsId, ConsDefns),
+	list__member(ConsDefn, ConsDefns),
+
+	% Overloading resolution ignores the class constraints.
+	ConsDefn = hlds_cons_defn(_, _, ConsArgTypes0, ConsTypeId, _),
+	ConsTypeId = TypeId,
+
+	module_info_types(ModuleInfo, Types),
+	map__search(Types, TypeId, TypeDefn),
+	hlds_data__get_type_defn_tvarset(TypeDefn, TypeTVarSet),
+
+	varset__merge_subst(TVarSet, TypeTVarSet, _, Renaming),
+	term__apply_substitution_to_list(ConsArgTypes0,
+		Renaming, ConsArgTypes),
+
+	type_list_subsumes(ConsArgTypes, ArgTypes, _).
 
 %-----------------------------------------------------------------------------%
 
Index: tests/valid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/valid/Mmakefile,v
retrieving revision 1.61
diff -u -u -r1.61 Mmakefile
--- tests/valid/Mmakefile	2000/04/14 08:39:24	1.61
+++ tests/valid/Mmakefile	2000/05/03 03:28:09
@@ -110,6 +110,7 @@
 	pred_with_no_modes.m \
 	qualified_cons_id.m \
 	quantifier_warning.m \
+	record_syntax_bug.m \
 	recursive_no_tag_type.m \
 	same_length_2.m \
 	semidet_disj.m \
Index: tests/valid/record_syntax_bug.m
===================================================================
RCS file: record_syntax_bug.m
diff -N record_syntax_bug.m
--- /dev/null	Wed May  3 17:05:01 2000
+++ record_syntax_bug.m	Wed May  3 16:20:56 2000
@@ -0,0 +1,15 @@
+% The compiler of 3/5/2000 aborted on this test case because it
+% didn't properly handle overloading of field access functions
+% and constructors.
+:- module record_syntax_bug.
+:- interface.
+
+:- type foo ---> debug(string).
+:- type bar ---> bar( debug :: int ).
+
+:- func dest(foo) = int.
+
+:- implementation.
+
+dest(debug(_)) = 42.
+
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------