[m-rev.] diff: fix polymorphism bug

Mark Brown mark at cs.mu.OZ.AU
Fri Sep 9 16:41:14 AEST 2005


I came across this bug while making the change of type (type).  I'll commit
the fix to the main branch after it passes bootcheck.  The corresponding fix
to the release branch won't make it into the 0.12.0 release because the
repository has already been tagged, but this probably isn't a major problem
since the bug has probably been around for the last seven years without any
complaints.  It will have to go in the 0.12.1 release -- I'll commit the
change to the release branch some time next week, after Julien has finished
fixing the configure script and retagging the repository.

Cheers,
Mark.

Estimated hours taken: 2
Branches: main, release

Fix a bug in the polymorphism transformation.

compiler/polymorphism.m:
	Make sure extra arguments are added in the proper order when
	processing calls to polymorphic procedures.

	Clarify the comments at the top of the file regarding the order
	of extra arguments.

	Rename some variables to make them more consistent.

tests/hard_coded/Mmakefile:
tests/hard_coded/type_info_order.exp:
tests/hard_coded/type_info_order.m:
	A test case which exposes the bug.

Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.271
diff -u -r1.271 polymorphism.m
--- compiler/polymorphism.m	5 Sep 2005 07:09:50 -0000	1.271
+++ compiler/polymorphism.m	9 Sep 2005 05:43:36 -0000
@@ -139,20 +139,36 @@
 % The argument passing convention is that the new parameters
 % introduced by this pass are placed in the following order:
 %
-%	First the UnivTypeInfos (for universally quantified type variables)
-% 	then the ExistTypeInfos (for existentially quantified type variables)
-%	then the UnivTypeClassInfos (for universally quantified constraints)
-%	then the ExistTypeClassInfos (for existentially quantified constraints)
+%	First the UnivTypeInfos for universally quantified type variables,
+%	in the order that the type variables first appear in the argument
+%	types;
+%
+% 	then the ExistTypeInfos for existentially quantified type variables,
+% 	in the order that the type variables first appear in the argument
+% 	types;
+%
+%	then the UnivTypeClassInfos for universally quantified constraints,
+%	in the order that the constraints appear in the class context;
+%
+%	then the ExistTypeClassInfos for existentially quantified constraints,
+%	in the order that the constraints appear in the class context;
+%
 %	and finally the original arguments of the predicate.
 %
+% Bear in mind that for the purposes of this (and most other) calucaltions,
+% the return parameter of a function counts as the _last_ argument.
+%
 % The convention for class method implementations is slightly different
 % to match the order that the type_infos and typeclass_infos are passed
 % in by do_call_class_method (in runtime/mercury_ho_call.c):
 %
-%	First the type_infos for the unconstrained type variables in
-% 		the instance declaration
-%	then the typeclass_infos for the class constraints on the
-%		instance declaration
+%	First the type_infos for the unconstrained type variables in the
+%	instance declaration, in the order that they first appear in the
+%	instance arguments;
+%
+%	then the typeclass_infos for the class constraints on the instance
+%	declaration, in the order that they appear in the declaration;
+%
 % 	then the remainder of the type_infos and typeclass_infos as above.
 %
 %-----------------------------------------------------------------------------%
@@ -793,16 +809,18 @@
 		HeadVars, ExtraArgModes, HeadTypeVars, AllUnconstrainedTVars,
 		AllExtraHeadTypeInfoVars, ExistHeadTypeClassInfoVars, !Info) :-
 	%
-	% grab the appropriate fields from the pred_info
+	% Grab the appropriate fields from the pred_info.
 	%
 	pred_info_arg_types(PredInfo, ArgTypeVarSet, ExistQVars, ArgTypes),
 
 	%
-	% Insert extra head variables to hold the address of the
-	% type_infos and typeclass_infos.
-	% We insert one variable for each unconstrained type variable
-	% (for the type_info) and one variable for each constraint (for
-	% the typeclass_info).
+	% Insert extra head variables to hold the address of the type_infos
+	% and typeclass_infos.  We insert one variable for each unconstrained
+	% type variable (for the type_info) and one variable for each
+	% constraint (for the typeclass_info).
+	%
+	% The order of these variables is important, and must match the order
+	% specified at the top of this file.
 	%
 
 		% Make a fresh variable for each class constraint, returning
@@ -1773,6 +1791,11 @@
 	poly_info_get_typevarset(!.Info, TypeVarSet0),
 	poly_info_get_module_info(!.Info, ModuleInfo),
 
+	%
+	% The order of the added variables is important, and must match the
+	% order specified at the top of this file.
+	%
+
 	module_info_pred_info(ModuleInfo, PredId, PredInfo),
 	pred_info_arg_types(PredInfo, PredTypeVarSet, PredExistQVars,
 		PredArgTypes),
@@ -1794,7 +1817,7 @@
 		map__init(PredToParentTypeSubst),
 		TypeVarSet = TypeVarSet0,
 		ParentArgTypes = PredArgTypes,
-		ParentTypeVars = [],
+		ParentTVars = [],
 		ParentExistQVarTerms = []
 	;
 		% (this merge might be a performance bottleneck?)
@@ -1802,7 +1825,7 @@
 			PredToParentTypeSubst),
 		term__apply_substitution_to_list(PredArgTypes,
 			PredToParentTypeSubst, ParentArgTypes),
-		term__vars_list(ParentArgTypes, ParentTypeVars),
+		term__vars_list(ParentArgTypes, ParentTVars),
 		term__var_list_to_term_list(PredExistQVars,
 			PredExistQVarTerms),
 		term__apply_substitution_to_list(PredExistQVarTerms,
@@ -1816,7 +1839,7 @@
 		(
 			% Optimize for the common case of non-polymorphic call
 			% with no constraints.
-			ParentTypeVars = [],
+			ParentTVars = [],
 			PredClassContext = constraints([], [])
 		;
 			% Some builtins don't need or want the type_info.
@@ -1847,16 +1870,27 @@
 			ParentExistConstrainedTVars),
 
 			% Calculate the set of unconstrained type vars.
-		list__remove_dups(ParentTypeVars,
-			ParentUnconstrainedTypeVars0),
-		list__delete_elems(ParentUnconstrainedTypeVars0,
+			% Split these into existential and universal type
+			% vars.
+		list__remove_dups(ParentTVars,
+			ParentUnconstrainedTVars0),
+		list__delete_elems(ParentUnconstrainedTVars0,
 			ParentUnivConstrainedTVars,
-			ParentUnconstrainedTypeVars1),
-		list__delete_elems(ParentUnconstrainedTypeVars1,
+			ParentUnconstrainedTVars1),
+		list__delete_elems(ParentUnconstrainedTVars1,
 			ParentExistConstrainedTVars,
-			ParentUnconstrainedTypeVars),
-		term__var_list_to_term_list(ParentUnconstrainedTypeVars,
-			ParentUnconstrainedTypes),
+			ParentUnconstrainedTVars),
+		term__term_list_to_var_list(ParentExistQVarTerms,
+			ParentExistQVars),
+		list__delete_elems(ParentUnconstrainedTVars, ParentExistQVars,
+			ParentUnconstrainedUnivTVars),
+		list__delete_elems(ParentUnconstrainedTVars,
+			ParentUnconstrainedUnivTVars,
+			ParentUnconstrainedExistTVars),
+		term__var_list_to_term_list(ParentUnconstrainedUnivTVars,
+			ParentUnconstrainedUnivTypes),
+		term__var_list_to_term_list(ParentUnconstrainedExistTVars,
+			ParentUnconstrainedExistTypes),
 
 			% Calculate the "parent to actual" binding.
 		map__apply_to_list(ArgVars0, VarTypes, ActualArgTypes),
@@ -1889,18 +1923,30 @@
 			ActualExistConstraints, ExtraExistClassVars,
 			ExtraExistClassGoals, !Info),
 
-			% Make variables to hold typeinfos for any remaining
-			% (that is, unconstrained) type vars.
-		term__apply_rec_substitution_to_list(ParentUnconstrainedTypes,
-			ParentToActualTypeSubst, ActualUnconstrainedTypes),
-		polymorphism__make_type_info_vars(ActualUnconstrainedTypes,
-			Context, ExtraTypeInfoVars, ExtraTypeInfoGoals, !Info),
+			% Make variables to hold typeinfos for unconstrained
+			% universal type vars.
+		term__apply_rec_substitution_to_list(
+			ParentUnconstrainedUnivTypes, ParentToActualTypeSubst,
+			ActualUnconstrainedUnivTypes),
+		polymorphism__make_type_info_vars(ActualUnconstrainedUnivTypes,
+			Context, ExtraUnivTypeInfoVars, ExtraUnivTypeInfoGoals,
+			!Info),
+
+			% Make variables to hold typeinfos for unconstrained
+			% existential type vars.
+		term__apply_rec_substitution_to_list(
+			ParentUnconstrainedExistTypes, ParentToActualTypeSubst,
+			ActualUnconstrainedExistTypes),
+		polymorphism__make_type_info_vars(
+			ActualUnconstrainedExistTypes, Context,
+			ExtraExistTypeInfoVars, ExtraExistTypeInfoGoals,
+			!Info),
 
 			% Add up the extra vars and goals.
 		ExtraGoals = ExtraUnivClassGoals ++ ExtraExistClassGoals
-			++ ExtraTypeInfoGoals,
-		ExtraVars = ExtraTypeInfoVars ++ ExtraUnivClassVars
-			++ ExtraExistClassVars,
+			++ ExtraUnivTypeInfoGoals ++ ExtraExistTypeInfoGoals,
+		ExtraVars = ExtraUnivTypeInfoVars ++ ExtraExistTypeInfoVars
+			++ ExtraUnivClassVars ++ ExtraExistClassVars,
 
 		%
 		% update the non-locals
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.266
diff -u -r1.266 Mmakefile
--- tests/hard_coded/Mmakefile	7 Sep 2005 08:30:01 -0000	1.266
+++ tests/hard_coded/Mmakefile	9 Sep 2005 03:13:56 -0000
@@ -189,6 +189,7 @@
 	tuple_test \
 	type_ctor_desc \
 	type_ctor_desc_manip \
+	type_info_order \
 	type_qual \
 	type_spec_ho_term \
 	type_spec_modes \
Index: tests/hard_coded/type_info_order.exp
===================================================================
RCS file: tests/hard_coded/type_info_order.exp
diff -N tests/hard_coded/type_info_order.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/type_info_order.exp	9 Sep 2005 03:19:51 -0000
@@ -0,0 +1 @@
+yes
Index: tests/hard_coded/type_info_order.m
===================================================================
RCS file: tests/hard_coded/type_info_order.m
diff -N tests/hard_coded/type_info_order.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/type_info_order.m	9 Sep 2005 03:19:12 -0000
@@ -0,0 +1,32 @@
+% This program triggers (as of 8/9/2005) a mode error because the type_info
+% arguments in the call to g are in the wrong order.
+
+:- module type_info_order.
+:- interface.
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+main(!IO) :-
+	( p(1) ->
+		io.write_string("yes\n", !IO)
+	;
+		io.write_string("no\n", !IO)
+	).
+
+:- some [T] pred g(T::out, U::in) is det.
+
+g(X, X).
+
+:- pred p(T::in) is semidet.
+
+p(A) :-
+	g(B, A),
+	q(B, B).
+
+:- pred q(T::in, T::in) is semidet.
+
+q(Z, Z).
+
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------



More information about the reviews mailing list