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

Simon Taylor stayl at cs.mu.OZ.AU
Mon May 8 17:21:01 AEST 2000


> On 04-May-2000, Simon Taylor <stayl at cs.mu.OZ.AU> wrote:
> > 
> > > 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.
> > 
 
> For record_syntax_bug_2.m, the problem is that
> code that you added to fix the bug that Tom reported is trying
> to second-guess typechecking and is getting it wrong.  This
> causes it to wrongly think that an occurrence of `debug'
> refers to a constructor rather than a field name, leading
> to an obscure sequence of error messages:


Estimated hours taken: 1

My previous bug fix for overloading resolution of field access functions
and constructors didn't work for existentially typed constructors.

compiler/post_typecheck.m:
	When checking whether a constructor matches a cons_id
	and argument types, make sure the actual argument types
	don't bind any of the existentially quantified type
	variables of the constructor.

compiler/typecheck.m:
compiler/type_util.m:
	Factor out the code to check whether the argument types
	of a call subsume the actual argument types into
	a new predicate, `type_util__arg_type_list_subsumes'.

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

Index: compiler/post_typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/post_typecheck.m,v
retrieving revision 1.22
diff -u -u -r1.22 post_typecheck.m
--- compiler/post_typecheck.m	2000/05/05 06:07:49	1.22
+++ compiler/post_typecheck.m	2000/05/08 00:44:34
@@ -941,6 +941,12 @@
 			AccessType, FieldName),
 
 		%
+		% We don't do this for compiler-generated predicates --
+		% they will never contain calls to field access functions.
+		%
+		\+ code_util__compiler_generated(PredInfo0),
+
+		%
 		% 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
@@ -979,18 +985,16 @@
 	list__member(ConsDefn, ConsDefns),
 
 	% Overloading resolution ignores the class constraints.
-	ConsDefn = hlds_cons_defn(_, _, ConsArgTypes0, ConsTypeId, _),
+	ConsDefn = hlds_cons_defn(ConsExistQVars, _,
+			ConsArgTypes, 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, _).
+	arg_type_list_subsumes(TVarSet, ArgTypes,
+		TypeTVarSet, ConsExistQVars, ConsArgTypes).
 
 %-----------------------------------------------------------------------------%
 
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.81
diff -u -u -r1.81 type_util.m
--- compiler/type_util.m	2000/04/10 07:19:16	1.81
+++ compiler/type_util.m	2000/05/08 00:54:12
@@ -238,6 +238,18 @@
 :- pred type_list_subsumes(list(type), list(type), tsubst).
 :- mode type_list_subsumes(in, in, out) is semidet.
 
+	% arg_type_list_subsumes(TVarSet, ArgTypes,
+	%       CalleeTVarSet, CalleeExistQVars, CalleeArgTypes).
+	%
+	% Check that the argument types of the called predicate,
+	% function or constructor subsume the types of the
+	% arguments of the call. This checks that none
+	% of the existentially quantified type variables of
+	% the callee are bound.
+:- pred arg_type_list_subsumes(tvarset, list(type),
+		tvarset, existq_tvars, list(type)).
+:- mode arg_type_list_subsumes(in, in, in, in, in) is semidet.
+
 	% apply a type substitution (i.e. map from tvar -> type)
 	% to all the types in a variable typing (i.e. map from var -> type).
 
@@ -359,7 +371,7 @@
 %-----------------------------------------------------------------------------%
 
 :- implementation.
-:- import_module bool, int, require, std_util, string.
+:- import_module bool, int, require, std_util, string, varset.
 :- import_module prog_io, prog_io_goal, prog_util.
 
 type_util__type_id_module(_ModuleInfo, TypeName - _Arity, ModuleName) :-
@@ -834,6 +846,51 @@
 	term__vars_list(TypesB, TypesBVars),
 	map__init(TypeSubst0),
 	type_unify_list(TypesA, TypesB, TypesBVars, TypeSubst0, TypeSubst).
+
+
+arg_type_list_subsumes(TVarSet, ArgTypes, CalleeTVarSet,
+		CalleeExistQVars0, CalleeArgTypes0) :-
+
+	%
+	% rename the type variables in the callee's argument types.
+	%
+	varset__merge_subst(TVarSet, CalleeTVarSet, _TVarSet1, Subst),
+	term__apply_substitution_to_list(CalleeArgTypes0, Subst,
+				CalleeArgTypes),
+	map__apply_to_list(CalleeExistQVars0, Subst, CalleeExistQTypes0),
+
+	%
+	% check that the types of the candidate predicate/function
+	% subsume the actual argument types
+	% [This is the right thing to do even for calls to
+	% existentially typed preds, because we're using the
+	% type variables from the callee's pred decl (obtained
+	% from the pred_info via pred_info_arg_types) not the types
+	% inferred from the callee's clauses (and stored in the
+	% clauses_info and proc_info) -- the latter
+	% might not subsume the actual argument types.]
+	%
+	type_list_subsumes(CalleeArgTypes, ArgTypes, TypeSubst),
+
+	%
+	% check that the type substitution did not bind any
+	% existentially typed variables to non-ground types
+	%
+	( CalleeExistQTypes0 = [] ->
+		% optimize common case
+		true
+	;
+		term__apply_rec_substitution_to_list(CalleeExistQTypes0,
+			TypeSubst, CalleeExistQTypes),
+		all [T] (list__member(T, CalleeExistQTypes) =>
+				type_util__var(T, _))	
+
+		% it might make sense to also check that
+		% the type substitution did not bind any
+		% existentially typed variables to universally 
+		% quantified type variables in the caller's
+		% argument types
+	).
 
 %-----------------------------------------------------------------------------%
 
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.275
diff -u -u -r1.275 typecheck.m
--- compiler/typecheck.m	2000/04/19 07:26:25	1.275
+++ compiler/typecheck.m	2000/05/08 00:43:58
@@ -1522,52 +1522,8 @@
 		pred_info_arg_types(PredInfo, PredTVarSet, PredExistQVars0,
 			PredArgTypes0),
 
-		%
-		% rename them apart from the actual argument types
-		%
-		varset__merge_subst(TVarSet, PredTVarSet, _TVarSet1,
-			Subst),
-		term__apply_substitution_to_list(PredArgTypes0, Subst,
-					PredArgTypes),
-		map__apply_to_list(PredExistQVars0, Subst, PredExistQTypes0),
-
-		%
-		% check that the types of the candidate predicate/function
-		% subsume the actual argument types
-		% [This is the right thing to do even for calls to
-		% existentially typed preds, because we're using the
-		% type variables from the callee's pred decl (obtained
-		% from the pred_info via pred_info_arg_types) not the types
-		% inferred from the callee's clauses (and stored in the
-		% clauses_info and proc_info) -- the latter
-		% might not subsume the actual argument types.]
-		%
-		type_list_subsumes(PredArgTypes, ArgTypes, TypeSubst),
-
-		%
-		% check that the type substitution did not bind any
-		% existentially typed variables to non-ground types
-		%
-		( PredExistQTypes0 = [] ->
-			% optimize common case
-			true
-		;
-			term__apply_rec_substitution_to_list(
-				PredExistQTypes0, TypeSubst, PredExistQTypes),
-			% SICStus doesn't allow the following syntax
-			% all [T] (list__member(T, PredExistQTypes) => 
-			% 		type_util__var(T, _))
-			\+ (
-				list__member(T, PredExistQTypes),
-				\+ type_util__var(T, _)
-			)
-
-			% it might make sense to also check that
-			% the type substitution did not bind any
-			% existentially typed variables to universally 
-			% quantified type variables in the caller's
-			% argument types
-		)
+		arg_type_list_subsumes(TVarSet, ArgTypes,
+			PredTVarSet, PredExistQVars0, PredArgTypes0)
 	->
 		%
 		% we've found a matching predicate
Index: tests/valid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/valid/Mmakefile,v
retrieving revision 1.62
diff -u -u -r1.62 Mmakefile
--- tests/valid/Mmakefile	2000/05/04 04:33:24	1.62
+++ tests/valid/Mmakefile	2000/05/06 04:58:17
@@ -111,6 +111,7 @@
 	qualified_cons_id.m \
 	quantifier_warning.m \
 	record_syntax_bug.m \
+	record_syntax_bug_2.m \
 	recursive_no_tag_type.m \
 	same_length_2.m \
 	semidet_disj.m \
Index: tests/valid/record_syntax_bug_2.m
===================================================================
RCS file: record_syntax_bug_2.m
diff -N record_syntax_bug_2.m
--- /dev/null	Mon May  8 17:17:13 2000
+++ record_syntax_bug_2.m	Mon May  8 17:19:06 2000
@@ -0,0 +1,23 @@
+% The compiler of 8/5/2000 aborted on this test case because it
+% didn't properly handle overloading of field access functions
+% and constructors.
+:- module record_syntax_bug_2.
+:- interface.
+
+:- type foo ---> some [T] debug(T) where equality is all_equal.
+
+:- type bar ---> bar( debug :: foo ).
+
+:- pred baz(foo, bar).
+:- mode baz(in, out) is cc_multi.
+
+:- pred all_equal(foo, foo).
+:- mode all_equal(in, in) is semidet.
+
+:- implementation.
+:- import_module std_util.
+
+all_equal(_, _) :- semidet_succeed.
+
+baz(debug(X), X).
+
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------



More information about the developers mailing list