for review: fix for inlining of polymorphic procedures

[Simon Taylor]

Hi Fergus,

Could you please review this.

Simon.


Estimated hours taken: 2

Fix a bug in the optimization where polymorphism.m passes a
base_type_info in place of a type_info for non-polymorphic types.
The type of the variable was `base_type_info' not `type_info'.
This caused inlining.m to be unable to compute a type substitution,
and code_util__cons_id_to_tag aborted on an unsubstituted type
variable.

compiler/polymorphism.m
	Set the type of `base_type_info's passed where a `type_info'
	is expected to `type_info'.

compiler/common.m
	Don't do common structure elimination on structures
	which are of different types, since that could cause
	similar bugs.

tests/valid/inlining_bug.m
	Regression test.


Index: common.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/common.m,v
retrieving revision 1.47
diff -u -r1.47 common.m
--- common.m	1998/01/23 12:56:21	1.47
+++ common.m	1998/02/19 01:11:43
@@ -250,27 +250,45 @@
 
 %---------------------------------------------------------------------------%
 
+	% /*
 	% Two structures have compatible representations if the top
 	% level of their types are unifiable.  % For example, if we have
 	%
-	%	:- type maybe_err(T) --> ok(T) ; err(string).
+	%       :- type maybe_err(T) --> ok(T) ; err(string).
 	%
-	%	:- pred p(maybe_err(foo)::in, maybe_err(bar)::out) is semidet.
-	%	p(err(X), err(X)).
+	%       :- pred p(maybe_err(foo)::in, maybe_err(bar)::out) is semidet.
+	%       p(err(X), err(X)).
 	%
 	% then we want to reuse the `err(X)' in the first arg rather than
 	% constructing a new copy of it for the second arg.
 	% The two occurrences of `err(X)' have types `maybe_err(int)'
 	% and `maybe(float)', but we know that they have the same 
 	% representation.
+	% */
+	%
+	% We don't do this any more because it leaves the HLDS ill-typed.
+	% Specifically inlining can't compute type substitutions when the
+	% types of the arguments to a call don't match the types of the
+	% arguments. Now we only consider two types compatible if they are
+	% exactly the same. -stayl
 
 :- pred common__compatible_types(type, type).
 :- mode common__compatible_types(in, in) is semidet.
 
+common__compatible_types(term__variable(Var), term__variable(Var)).
 common__compatible_types(Type1, Type2) :-
-	type_to_type_id(Type1, TypeId1, _),
-	type_to_type_id(Type2, TypeId2, _),
-	TypeId1 = TypeId2.
+	type_to_type_id(Type1, TypeId1, Args1),
+	type_to_type_id(Type2, TypeId2, Args2),
+	TypeId1 = TypeId2,
+	common__compatible_type_lists(Args1, Args2).
+
+:- pred common__compatible_type_lists(list(type), list(type)).
+:- mode common__compatible_type_lists(in, in) is semidet.
+
+common__compatible_type_lists([], []).
+common__compatible_type_lists([Type1 | Types1], [Type2 | Types2]) :-
+	common__compatible_types(Type1, Type2),
+	common__compatible_type_lists(Types1, Types2).
 
 %---------------------------------------------------------------------------%
 
Index: polymorphism.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/polymorphism.m,v
retrieving revision 1.128
diff -u -r1.128 polymorphism.m
--- polymorphism.m	1998/02/15 06:48:35	1.128
+++ polymorphism.m	1998/02/19 00:29:33
@@ -1731,8 +1731,16 @@
 		IsHigherOrder = no
 	->
 		Var = BaseVar,
+
+		% Since this base_type_info is pretending to be
+		% a type_info, we need to adjust its type.
+		% Since base_type_info_const cons_ids are handled
+		% specially, this should not cause problems.
+		construct_type(qualified("mercury_builtin", "type_info") - 1,
+			[Type], NewBaseVarType),
+		map__det_update(VarTypes0, BaseVar, NewBaseVarType, VarTypes),
+
 		VarSet = VarSet0,
-		VarTypes = VarTypes0,
 		ExtraGoals = ExtraGoals0
 	;
 		% Unfortunately, if we have higher order terms, we


Index: tests/valid/Mmakefile
===================================================================
RCS file: /home/staff/zs/imp/tests/valid/Mmakefile,v
retrieving revision 1.10
diff -u -r1.10 Mmakefile
--- Mmakefile	1998/02/09 00:44:42	1.10
+++ Mmakefile	1998/02/19 00:43:23
@@ -40,6 +40,7 @@
 	higher_order_implied_mode.m \
 	ho_inst.m \
 	ho_func_call.m \
+	inlining_bug.m \
 	inhibit_warn_test.m \
 	implied_mode.m \
 	indexing.m \


%
% Regression test for an abort in code generation.
% When the actual type for a polymorphic argument is non-polymorphic,
% only the base_type_info is passed, avoiding the construction of
% a type_info. The problem was that the type of the type_info argument
% was being set to `mercury_builtin:base_type_info' rather than
% `type_info'. In the code to compute the type substitution in inlining,
% type_list_subsumes failed on the argument types, and no substitution
% was produced. code_util__cons_id_to_tag then aborted when asked to
% find the tag for a constructor of a variable type.
%
:- module inlining_bug.

:- interface.

:- pred calling_pred(int::in) is semidet.

:- implementation.

:- import_module int, list.

:- type my_pair(A) ---> pair(A, A).

calling_pred(_) :-
	Plus1 = lambda([Int0::in, IntPair::out] is det,
			IntPair = pair(Int0, Int0)),
	called_pred(Plus1, [1,2,3], [X | Ys]),
	X = pair(2, 2),
	Ys = [pair(3, 3), pair(4, 4)].

:- pred called_pred(pred(T, U), list(T), list(U)) is det.
:- mode called_pred(pred(in, out) is det, in, out) is semidet.
:- pragma inline(called_pred/3).

called_pred(P, [A | As], [B | Bs]) :-
	call(P, A, B),
	list__map(P, As, Bs).