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

[Fergus Henderson]

Does this fix work for the following test case?

	:- module test2.
	:- interface.

	:- type foo ---> some [T] debug(T).
	:- type bar ---> bar( debug :: int ).

	:- pred baz(int, bar).
	:- mode baz(in, in) is semidet.

	:- implementation.

	baz(debug(X), X).

On 03-May-2000, Simon TAYLOR <stayl at cs.mu.OZ.AU> wrote:
> 
> 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
> --------------------------------------------------------------------------

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