[m-rev.] for review: fix expand equivalence type for special preds bug

[Peter Ross]

Hi,

For fjh to review, this change is bootchecking in the hlc.gc grade
now.  

This change supercedes the previous change.

The previous change that this change is based on bootchecked
sucessfully in the hlc.gc grade, but I think this approach is cleaner.


===================================================================


Estimated hours taken: 10
Branches: main

Fix a bug highlighted by the .NET backend where the comparison,
unification and index predicates for types defined as equivalence
types were being generated refering to the original types instead of
the expanded out equivalent type.

compiler/hlds_pred.m:
	Add pred_info_expanded_arg_types and
	proc_info_expanded_vartypes which both expand out all
	equivalence types before returning their answer.

compiler/rtti.m:
	Record the the actual argument types for a special predicate
	in the rtti_proc_label type.

compiler/ml_call_gen.m:
compiler/ml_closure_gen.m:
compiler/ml_code_gen.m:
compiler/ml_code_util.m:
	Use the types where all the equivalence types have been
	eliminated.

compiler/type_util.m:
	Add a utility predicate to expand out equivalence types.

compiler/typecheck.m:
	Ensure that the type_table map lookup can't fail by only
	searching for user_types in the type table.

compiler/code_util.m:
compiler/layout_out.m:
compiler/ml_code_util.m:
	Handle the rtti_proc_label structure correctly.


Index: compiler/code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_util.m,v
retrieving revision 1.139
diff -u -r1.139 code_util.m
--- compiler/code_util.m	1 Nov 2002 09:56:53 -0000	1.139
+++ compiler/code_util.m	8 Nov 2002 15:10:22 -0000
@@ -298,7 +298,7 @@
 		IsImported, _IsPseudoImported, _IsExported,
 		IsSpecialPredInstance),
 	(
-		IsSpecialPredInstance = yes
+		IsSpecialPredInstance = yes(_ActualArgTypes)
 	->
 		(
 			special_pred_get_type(PredName, ArgTypes, Type),
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.112
diff -u -r1.112 hlds_pred.m
--- compiler/hlds_pred.m	24 Oct 2002 04:36:43 -0000	1.112
+++ compiler/hlds_pred.m	8 Nov 2002 15:10:23 -0000
@@ -620,6 +620,11 @@
 :- pred pred_info_arg_types(pred_info, list(type)).
 :- mode pred_info_arg_types(in, out) is det.
 
+	% The arg_types where all the equivalence types have been expanded
+	% out.
+:- pred pred_info_expanded_arg_types(module_info, pred_info, list(type)).
+:- mode pred_info_expanded_arg_types(in, in, out) is det.
+
 :- pred pred_info_arg_types(pred_info, tvarset, existq_tvars, list(type)).
 :- mode pred_info_arg_types(in, out, out, out) is det.
 
@@ -1148,6 +1153,11 @@
 pred_info_arg_types(PredInfo, ArgTypes) :-
 	pred_info_arg_types(PredInfo, _TypeVars, _ExistQVars, ArgTypes).
 
+pred_info_expanded_arg_types(ModuleInfo, PredInfo, ArgTypes) :-
+	pred_info_arg_types(PredInfo, ArgTypes0),
+	module_info_types(ModuleInfo, TypeTable),
+	ArgTypes = list__map(expand_equivalence_type(TypeTable), ArgTypes0).
+
 pred_info_arg_types(PredInfo, PredInfo^decl_typevarset,
 		PredInfo^exist_quant_tvars, PredInfo^arg_types).
 
@@ -1647,6 +1657,10 @@
 :- pred proc_info_set_vartypes(proc_info, vartypes, proc_info).
 :- mode proc_info_set_vartypes(in, in, out) is det.
 
+	% The vartypes with all the equivalence types expanded out.
+:- pred proc_info_expanded_vartypes(module_info, proc_info, vartypes).
+:- mode proc_info_expanded_vartypes(in, in, out) is det.
+
 :- pred proc_info_headvars(proc_info, list(prog_var)).
 :- mode proc_info_headvars(in, out) is det.
 
@@ -2173,6 +2187,12 @@
 proc_info_declared_determinism(ProcInfo, ProcInfo^declared_detism).
 proc_info_varset(ProcInfo, ProcInfo^prog_varset).
 proc_info_vartypes(ProcInfo, ProcInfo^var_types).
+proc_info_expanded_vartypes(ModuleInfo, ProcInfo, VarTypes) :-
+	module_info_types(ModuleInfo, TypeTable),
+	Func = (func(Key, Value, Map)
+		= map__set(Map, Key, expand_equivalence_type(TypeTable, Value))
+	),
+	VarTypes = map__foldl(Func, ProcInfo ^ var_types, map__init).
 proc_info_headvars(ProcInfo, ProcInfo^head_vars).
 proc_info_argmodes(ProcInfo, ProcInfo^actual_head_modes).
 proc_info_inst_varset(ProcInfo, ProcInfo^inst_varset).
Index: compiler/layout_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/layout_out.m,v
retrieving revision 1.16
diff -u -r1.16 layout_out.m
--- compiler/layout_out.m	29 Sep 2002 10:30:41 -0000	1.16
+++ compiler/layout_out.m	8 Nov 2002 15:10:23 -0000
@@ -348,7 +348,7 @@
 		{ BeingDefined = yes }
 	),
 	(
-		{ RttiProcLabel ^ is_special_pred_instance = yes },
+		{ RttiProcLabel ^ is_special_pred_instance = yes(_) },
 		io__write_string("MR_Compiler_ProcStatic ")
 	;
 		{ RttiProcLabel ^ is_special_pred_instance = no },
Index: compiler/ml_call_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_call_gen.m,v
retrieving revision 1.35
diff -u -r1.35 ml_call_gen.m
--- compiler/ml_call_gen.m	4 Jun 2002 14:56:02 -0000	1.35
+++ compiler/ml_call_gen.m	8 Nov 2002 15:10:24 -0000
@@ -352,7 +352,7 @@
 	{ module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
 		PredInfo, ProcInfo) },
 	{ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc) },
-	{ pred_info_arg_types(PredInfo, PredArgTypes) },
+	{ pred_info_expanded_arg_types(ModuleInfo, PredInfo, PredArgTypes) },
 	{ proc_info_argmodes(ProcInfo, ArgModes) },
 
 	%
Index: compiler/ml_closure_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_closure_gen.m,v
retrieving revision 1.13
diff -u -r1.13 ml_closure_gen.m
--- compiler/ml_closure_gen.m	5 Sep 2002 21:26:37 -0000	1.13
+++ compiler/ml_closure_gen.m	8 Nov 2002 15:10:24 -0000
@@ -685,7 +685,7 @@
 	{ ml_gen_info_get_module_info(Info, ModuleInfo) },
 	{ module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
 		PredInfo, ProcInfo) },
-	{ pred_info_arg_types(PredInfo, ProcArgTypes) },
+	{ pred_info_expanded_arg_types(ModuleInfo, PredInfo, ProcArgTypes) },
 	{ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc) },
 	{ proc_info_headvars(ProcInfo, ProcHeadVars) },
 	{ proc_info_argmodes(ProcInfo, ProcArgModes) },
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.121
diff -u -r1.121 ml_code_gen.m
--- compiler/ml_code_gen.m	14 Jul 2002 04:08:26 -0000	1.121
+++ compiler/ml_code_gen.m	8 Nov 2002 15:10:25 -0000
@@ -1095,7 +1095,7 @@
 	module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
 			PredInfo, ProcInfo),
 	pred_info_import_status(PredInfo, ImportStatus),
-	pred_info_arg_types(PredInfo, ArgTypes),
+	pred_info_expanded_arg_types(ModuleInfo, PredInfo, ArgTypes),
 	proc_info_interface_code_model(ProcInfo, CodeModel),
 	proc_info_headvars(ProcInfo, HeadVars),
 	proc_info_goal(ProcInfo, Goal0),
Index: ml_code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.65
diff -u -r1.65 ml_code_util.m
--- ml_code_util.m	1 Nov 2002 09:56:54 -0000	1.65
+++ ml_code_util.m	8 Nov 2002 15:16:03 -0000
@@ -803,6 +803,7 @@
 
 :- import_module parse_tree__prog_data, parse_tree__prog_io.
 :- import_module hlds__hlds_goal, (parse_tree__inst), hlds__instmap.
+:- import_module hlds__special_pred.
 :- import_module check_hlds__polymorphism.
 :- import_module backend_libs__foreign.
 :- import_module parse_tree__prog_util, check_hlds__type_util.
@@ -1103,7 +1104,7 @@
 	proc_info_varset(ProcInfo, VarSet),
 	proc_info_headvars(ProcInfo, HeadVars),
 	pred_info_get_is_pred_or_func(PredInfo, PredOrFunc),
-	pred_info_arg_types(PredInfo, HeadTypes),
+	pred_info_expanded_arg_types(ModuleInfo, PredInfo, HeadTypes),
 	proc_info_argmodes(ProcInfo, HeadModes),
 	proc_info_interface_code_model(ProcInfo, CodeModel),
 	HeadVarNames = ml_gen_var_names(VarSet, HeadVars),
@@ -1117,7 +1118,7 @@
 	proc_info_varset(ProcInfo, VarSet),
 	proc_info_headvars(ProcInfo, HeadVars),
 	pred_info_get_is_pred_or_func(PredInfo, PredOrFunc),
-	pred_info_arg_types(PredInfo, HeadTypes),
+	pred_info_expanded_arg_types(ModuleInfo, PredInfo, HeadTypes),
 	proc_info_argmodes(ProcInfo, HeadModes),
 	proc_info_interface_code_model(ProcInfo, CodeModel),
 	HeadVarNames = ml_gen_var_names(VarSet, HeadVars),
@@ -1140,11 +1141,11 @@
 	% from the module_info, pred_id, and proc_id.
 	%
 ml_gen_proc_params_from_rtti(ModuleInfo, RttiProcId) = FuncParams :-
-	HeadVars = RttiProcId^proc_headvars,
-	ArgTypes = RttiProcId^arg_types,
-	ArgModes = RttiProcId^proc_arg_modes,
-	PredOrFunc = RttiProcId^pred_or_func,
-	CodeModel = RttiProcId^proc_interface_code_model,
+	HeadVars = RttiProcId ^ proc_headvars,
+	ArgTypes = RttiProcId ^ expanded_arg_types,
+	ArgModes = RttiProcId ^ proc_arg_modes,
+	PredOrFunc = RttiProcId ^ pred_or_func,
+	CodeModel = RttiProcId ^ proc_interface_code_model,
 	HeadVarNames = list__map((func(Var - Name) = Result :-
 			term__var_to_int(Var, N),
 			Result = mlds__var_name(Name, yes(N))
@@ -1356,7 +1357,7 @@
 	proc_info_interface_code_model(ProcInfo, model_det),
 
 	proc_info_argmodes(ProcInfo, Modes),
-	pred_info_arg_types(PredInfo, ArgTypes),
+	pred_info_expanded_arg_types(ModuleInfo, PredInfo, ArgTypes),
 	proc_info_headvars(ProcInfo, ArgVars),
 	modes_to_arg_modes(ModuleInfo, Modes, ArgTypes, ArgModes),
 	pred_args_to_func_args(ArgModes, _InputArgModes, RetArgMode),
@@ -1440,7 +1441,7 @@
 		IsImported, _IsPseudoImported, _IsExported,
 		IsSpecialPredInstance),
 	(
-		IsSpecialPredInstance = yes
+		IsSpecialPredInstance = yes(_)
 	->
 		(
 			special_pred_get_type(PredName, ArgTypes, Type),
@@ -2616,7 +2617,7 @@
 			_PredInfo, ProcInfo),
 	proc_info_headvars(ProcInfo, HeadVars),
 	proc_info_varset(ProcInfo, VarSet),
-	proc_info_vartypes(ProcInfo, VarTypes),
+	proc_info_expanded_vartypes(ModuleInfo, ProcInfo, VarTypes),
 	proc_info_argmodes(ProcInfo, HeadModes),
 	ByRefOutputVars = select_output_vars(ModuleInfo, HeadVars, HeadModes,
 		VarTypes),
Index: compiler/rtti.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti.m,v
retrieving revision 1.22
diff -u -r1.22 rtti.m
--- compiler/rtti.m	1 Nov 2002 09:56:54 -0000	1.22
+++ compiler/rtti.m	8 Nov 2002 15:10:27 -0000
@@ -435,11 +435,15 @@
 			% so that we can continue to use the above-mentioned
 			% abstract interfaces rather than hard-coding tests
 			% on the import_status.
+			% Note that for is_special_pred_instance we also
+			% record the arg_types where all the equivalence
+			% types in the args have been expanded out.
 			%
 			is_imported			::	bool,
 			is_pseudo_imported		::	bool,
 			is_exported			::	bool,
-			is_special_pred_instance	::	bool
+			is_special_pred_instance	::	maybe(
+								  list(type))
 		).
 
 %-----------------------------------------------------------------------------%
@@ -525,6 +529,10 @@
 	% Construct an rtti_proc_label for a given procedure.
 :- func rtti__make_proc_label(module_info, pred_id, proc_id) = rtti_proc_label.
 
+	% Return the arg_types where all the equivalence types have been
+	% expanded.
+:- func expanded_arg_types(rtti_proc_label) = list(type).
+
 	% Construct an rtti_proc_label for a given procedure.
 :- pred rtti__proc_label_pred_proc_id(rtti_proc_label::in,
 	pred_id::out, proc_id::out) is det.
@@ -716,6 +724,7 @@
 
 rtti__make_proc_label(ModuleInfo, PredId, ProcId) = ProcLabel :-
 	module_info_name(ModuleInfo, ThisModule),
+	module_info_types(ModuleInfo, TypeTable),
 	module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
 		PredInfo, ProcInfo),
 	pred_info_get_is_pred_or_func(PredInfo, PredOrFunc),
@@ -732,7 +741,12 @@
 	IsPseudoImp = (pred_info_is_pseudo_imported(PredInfo) -> yes ; no),
 	IsExported = (procedure_is_exported(PredInfo, ProcId) -> yes ; no),
 	IsSpecialPredInstance =
-		(code_util__compiler_generated(PredInfo) -> yes ; no),
+		( code_util__compiler_generated(PredInfo) ->
+			yes(list__map(
+				expand_equivalence_type(TypeTable), ArgTypes))
+		;
+			no
+		),
 	ProcHeadVarsWithNames = list__map((func(Var) = Var - Name :-
 			Name = varset__lookup_name(ProcVarSet, Var)
 		), ProcHeadVars),
@@ -740,6 +754,13 @@
 		PredName, Arity, ArgTypes, PredId, ProcId,
 		ProcHeadVarsWithNames, ProcArgModes, ProcCodeModel,
 		IsImported, IsPseudoImp, IsExported, IsSpecialPredInstance).
+
+expanded_arg_types(RttiProcLabel) =
+	( RttiProcLabel ^ is_special_pred_instance = yes(ArgTypes) ->
+		ArgTypes
+	;
+		RttiProcLabel ^ arg_types
+	).
 
 rtti__proc_label_pred_proc_id(ProcLabel, PredId, ProcId) :-
 	ProcLabel = rtti_proc_label(_, _, _, _, _, _, PredId, ProcId,
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.109
diff -u -r1.109 type_util.m
--- compiler/type_util.m	1 Nov 2002 07:06:59 -0000	1.109
+++ compiler/type_util.m	8 Nov 2002 15:10:27 -0000
@@ -468,6 +468,9 @@
 :- pred get_unconstrained_tvars(list(tvar), list(class_constraint), list(tvar)).
 :- mode get_unconstrained_tvars(in, in, out) is det.
 
+	% Expand an equivalence type into its base representation.
+:- func expand_equivalence_type(type_table, (type)) = (type).
+
 %-----------------------------------------------------------------------------%
 
 	% If possible, get the argument types for the cons_id.
@@ -1739,6 +1742,24 @@
 		MaybeTypes = list__map(func(T) = yes(T), Types)
 	;
 		list__duplicate(Arity, no, MaybeTypes)
+	).
+
+%-----------------------------------------------------------------------------%
+
+expand_equivalence_type(TypeTable, Type0) = Type :-
+	(
+		type_to_ctor_and_args(Type0, TypeCtor, _),
+		map__search(TypeTable, TypeCtor, TypeDefn)
+	->
+		hlds_data__get_type_defn_body(TypeDefn, TypeBody),
+		( TypeBody = eqv_type(EqvType) ->
+			Type = expand_equivalence_type(
+					TypeTable, EqvType)
+		;
+			Type = Type0
+		)
+	;
+		Type = Type0
 	).
 
 %-----------------------------------------------------------------------------%
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.325
diff -u -r1.325 typecheck.m
--- compiler/typecheck.m	25 Sep 2002 06:49:13 -0000	1.325
+++ compiler/typecheck.m	8 Nov 2002 15:10:32 -0000
@@ -791,6 +791,8 @@
 	pred_info_arg_types(PredInfo, ArgTypes),
 	special_pred_get_type(PredName, ArgTypes, Type),
 	type_to_ctor_and_args(Type, TypeCtor, _TypeArgs),
+	classify_type_ctor(ModuleInfo, TypeCtor, BuiltinType),
+	BuiltinType = user_type,
 	module_info_types(ModuleInfo, TypeTable),
 	map__lookup(TypeTable, TypeCtor, TypeDefn),
 	hlds_data__get_type_defn_body(TypeDefn, Body),

--------------------------------------------------------------------------
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
--------------------------------------------------------------------------