diff for review: overload resolution for higher-order terms

[Fergus Henderson]

Hi,

Can someone please review this change?

Estimated Hours: 4

Fix a bug: use the types to resolve overloading for higher-order terms.
This avoids a software error in get_pred_and_proc_id when you try to
take the address of an overloaded predicate or function, e.g. `<',
without using an explicit module qualifier.

hlds_module.m:
	Change get_pred_and_proc_id to handle overload resolution.
	(Also, simplify the code by splitting out `get_proc_id'
	as a new subroutine.)

typecheck.m:
	Export new pred `typecheck__resolve_overloading'.  Previously the
	code for this was part of `typecheck__resolve_pred_overloading'.

intermod.m:
	Change call to get_pred_and_proc_id to match its new interface.
	Use `typecheck__resolve_overloading' rather than
	`typecheck__find_matching_pred_ids'.
	(Also, a few stylistic changes: add some documentation and
	rearrange the code a little.)

modecheck_unify.m:
	Change call to get_pred_and_proc_id to match its new interface.

cvs diff: Diffing .
Index: hlds_module.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_module.m,v
retrieving revision 1.17
diff -u -r1.17 hlds_module.m
--- hlds_module.m	1997/03/06 05:09:03	1.17
+++ hlds_module.m	1997/03/21 17:35:40
@@ -29,6 +29,7 @@
 
 :- import_module hlds_data, hlds_out, prog_data, prog_util, shapes.
 :- import_module require, int, string, list, map, set, std_util.
+:- import_module typecheck.
 
 %-----------------------------------------------------------------------------%
 
@@ -1012,7 +1013,7 @@
 	% Get the pred_id and proc_id matching a higher-order term with
 	% the given argument types, aborting with an error if none is
 	% found.
-:- pred get_pred_id_and_proc_id(sym_name, arity, pred_or_func, list(type),
+:- pred get_pred_id_and_proc_id(sym_name, pred_or_func, tvarset, list(type),
 				module_info, pred_id, proc_id).
 :- mode get_pred_id_and_proc_id(in, in, in, in, in, out, out) is det.
 
@@ -1421,74 +1422,66 @@
 				Func_N_Index, Func_NA_Index, Func_MNA_Index).
 
 
-get_pred_id_and_proc_id(SymName, Arity, PredOrFunc, PredArgTypes, ModuleInfo,
+get_pred_id_and_proc_id(SymName, PredOrFunc, TVarSet, ArgTypes, ModuleInfo,
 			PredId, ProcId) :-
-	unqualify_name(SymName, Name),
-	list__length(PredArgTypes, PredArity),
-	TotalArity is Arity + PredArity,
 	module_info_get_predicate_table(ModuleInfo, PredicateTable),
+	list__length(ArgTypes, Arity),
 	(
-	    predicate_table_search_pf_sym_arity(PredicateTable,
-		PredOrFunc, SymName, TotalArity, PredIds)
+		predicate_table_search_pf_sym_arity(PredicateTable,
+			PredOrFunc, SymName, Arity, PredIds),
+		typecheck__find_matching_pred_id(PredIds, ModuleInfo,
+			TVarSet, ArgTypes, PredId0, _PredName)
 	->
-	    (
-		PredIds = [PredId0]
-	    ->
 		PredId = PredId0,
-		predicate_table_get_preds(PredicateTable, Preds),
-		map__lookup(Preds, PredId, PredInfo),
-		pred_info_procedures(PredInfo, Procs),
-		map__keys(Procs, ProcIds),
-		( ProcIds = [ProcId0] ->
-		    ProcId = ProcId0
-		; ProcIds = [] ->
-		    hlds_out__pred_or_func_to_str(PredOrFunc, PredOrFuncStr),
-		    string__int_to_string(TotalArity, TotalArityString),
-		    string__append_list([
-			    "cannot take address of ", PredOrFuncStr,
-			    "\n`", Name, "/", TotalArityString,
-			    "' with no modes.\n",
-			    "(Sorry, confused by earlier errors ",
-			    	"-- bailing out.)"],
-			    Message),
-		    error(Message)
-		;
-		    hlds_out__pred_or_func_to_str(PredOrFunc, PredOrFuncStr),
-		    string__int_to_string(TotalArity, TotalArityString),
-		    string__append_list([
-			    "sorry, not implemented: ",
-			    "taking address of ", PredOrFuncStr,
-			    "\n`", Name, "/", TotalArityString,
-			    "' with multiple modes.\n",
-			    "(use an explicit lambda expression instead)"],
-			    Message),
-		    error(Message)
-		)
-	    ;
-	        % Ambiguous pred or func.
-		% cons_id ought to include the module prefix, so
-		% that we could use predicate_table__search_m_n_a to 
-		% prevent this from happening
-	        hlds_out__pred_or_func_to_str(PredOrFunc, PredOrFuncStr),
-	        string__int_to_string(TotalArity, TotalArityString),
+		get_proc_id(PredicateTable, PredId, ProcId)
+	;
+		% Undefined/invalid pred or func.
+		% the type-checker should ensure that this never happens
+		hlds_out__pred_or_func_to_str(PredOrFunc, PredOrFuncStr),
+		unqualify_name(SymName, Name),
+		string__int_to_string(Arity, ArityString),
 		string__append_list(
 			["get_pred_id_and_proc_id: ",
-			"ambiguous ", PredOrFuncStr,
-		        "\n`", Name, "/", TotalArityString, "'"],
+			"undefined/invalid ", PredOrFuncStr,
+			"\n`", Name, "/", ArityString, "'"],
 			Msg),
 		error(Msg)
-	    )
+	).
+
+:- pred get_proc_id(predicate_table, pred_id, proc_id).
+:- mode get_proc_id(in, in, out) is det.
+
+get_proc_id(PredicateTable, PredId, ProcId) :-
+	predicate_table_get_preds(PredicateTable, Preds),
+	map__lookup(Preds, PredId, PredInfo),
+	pred_info_procedures(PredInfo, Procs),
+	map__keys(Procs, ProcIds),
+	( ProcIds = [ProcId0] ->
+		ProcId = ProcId0
 	;
-	    % Undefined/invalid pred or func.
-	    % the type-checker should ensure that this never happens
-	    hlds_out__pred_or_func_to_str(PredOrFunc, PredOrFuncStr),
-	    string__int_to_string(TotalArity, TotalArityString),
-	    string__append_list(
-		["get_pred_id_and_proc_id: ",
-		"undefined/invalid ", PredOrFuncStr,
-		"\n`", Name, "/", TotalArityString, "'"],
-		Msg),
-	    error(Msg)
+		pred_info_name(PredInfo, Name),
+		pred_info_get_is_pred_or_func(PredInfo, PredOrFunc),
+		pred_info_arity(PredInfo, Arity),
+		hlds_out__pred_or_func_to_str(PredOrFunc, PredOrFuncStr),
+		string__int_to_string(Arity, ArityString),
+		( ProcIds = [] ->
+			string__append_list([
+				"cannot take address of ", PredOrFuncStr,
+				"\n`", Name, "/", ArityString,
+				"' with no modes.\n",
+				"(Sorry, confused by earlier errors -- ",
+				"bailing out.)"],
+				Message)
+		;
+			string__append_list([
+				"sorry, not implemented: ",
+				"taking address of ", PredOrFuncStr,
+				"\n`", Name, "/", ArityString,
+				"' with multiple modes.\n",
+				"(use an explicit lambda expression instead)"],
+				Message)
+		),
+		error(Message)
 	).
 
 %-----------------------------------------------------------------------------%
Index: intermod.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/intermod.m,v
retrieving revision 1.19
diff -u -r1.19 intermod.m
--- intermod.m	1997/03/06 05:09:12	1.19
+++ intermod.m	1997/03/21 18:18:19
@@ -481,10 +481,7 @@
 		{ DoWrite = yes }
 	).
 
-	% Resolve overloading and module qualify function calls and
-	% higher-order predicate constants in a unify_rhs.
-	% This has to wait until I implement module qualification of
-	% functions.
+	% Resolve overloading and module qualify everything in a unify_rhs.
 :- pred intermod__module_qualify_unify_rhs(var::in, unify_rhs::in,
 		unify_rhs::out, bool::out, intermod_info::in,
 		intermod_info::out) is det.
@@ -502,8 +499,10 @@
 	intermod__gather_proc_modes(ModuleInfo, ModeDefns,
 				UserInstDefns, Modes).
 
-	% Check if the functor is actually a function call or a higher-order
-	% pred constant. If so, module qualify.
+	% Check if the functor is a function call, a higher-order
+	% term, or an unqualified symbol. If so, module qualify.
+	% For function calls and higher-order terms, call intermod__add_proc
+	% so that the predicate or function will be exported if necessary.
 intermod__module_qualify_unify_rhs(LVar, functor(Functor0, Vars),
 				functor(Functor, Vars), DoWrite) -->
 	intermod_info_get_module_info(ModuleInfo),
@@ -511,40 +510,77 @@
 	intermod_info_get_tvarset(TVarSet),
 	intermod_info_get_var_types(VarTypes),
 	(
-		{ 
-			Functor0 = cons(QualifiedFuncName, Arity),
-			QualifiedFuncName = qualified(FuncModule, FuncName),
-			predicate_table_search_func_m_n_a(PredTable,
-				FuncModule, FuncName, Arity, [PredId])
+		%
+		% Is it a module-qualified function call?
+		%
+		{ Functor0 = cons(qualified(FuncModule, FuncName), Arity) },
+		{ predicate_table_search_func_m_n_a(PredTable,
+				FuncModule, FuncName, Arity, PredIds) }
+	->
+		%
+		% Yes, it is a module-qualified function call.
+		% Make sure that the called function will be exported.
+		%
+		( { PredIds = [PredId] } ->
+			intermod_info_add_proc(PredId, DoWrite)
 		;
-			Functor0 = cons(unqualified(FuncName), Arity),
-			predicate_table_search_func_name_arity(PredTable,
-					FuncName, Arity, PredIds),
-			list__append(Vars, [LVar], FuncArgs),
-			map__apply_to_list(FuncArgs, VarTypes, ArgTypes),
-			typecheck__find_matching_pred_id(PredIds, ModuleInfo,
-				TVarSet, ArgTypes, PredId, QualifiedFuncName)
-		}
+			% there should be at most one function
+			% with a given module, name, and arity
+			{ error("intermod.m: func_m_n_a not unique") }
+		),
+		{ Functor = Functor0 }
+	;
+		%
+		% Is it an unqualified function call?
+		%
+		{ Functor0 = cons(unqualified(FuncName), Arity) },
+		{ predicate_table_search_func_name_arity(PredTable,
+				FuncName, Arity, PredIds) }
 	->
-			% The unification is really a function call
+		%
+		% Yes, it is an unqualified function call.
+		% Module-qualify it.
+		% Make sure that the called function will be exported.
+		%
+		{ list__append(Vars, [LVar], FuncArgs) },
+		{ typecheck__resolve_overloading(ModuleInfo,
+			FuncArgs, VarTypes, TVarSet, PredIds,
+			QualifiedFuncName, PredId) },
 		{ Functor = cons(QualifiedFuncName, Arity) },
 		intermod_info_add_proc(PredId, DoWrite)
 	;
-		intermod_info_get_var_types(VarTypes),
+		%
+		% Is this a higher-order predicate or higher-order function
+		% term?
+		%
 		{ Functor0 = cons(PredName, Arity) },
+		intermod_info_get_var_types(VarTypes),
 		{ map__lookup(VarTypes, LVar, LVarType) },
 		{ type_is_higher_order(LVarType, PredOrFunc, PredArgTypes) }
 	->
-			% The unification creates a higher-order pred constant.
-		{ get_pred_id_and_proc_id(PredName, Arity, PredOrFunc,
-			PredArgTypes, ModuleInfo, PredId, _ProcId) },
-		{ module_info_pred_info(ModuleInfo, PredId, PredInfo) },
-		{ pred_info_module(PredInfo, Module) },
-		{ unqualify_name(PredName, UnqualPredName) },
-		{ QualifiedPredName = qualified(Module, UnqualPredName) },
-		{ Functor = cons(QualifiedPredName, Arity) },
-		intermod_info_add_proc(PredId, DoWrite)
+		%
+		% Yes, the unification creates a higher-order term.
+		% Make sure that the predicate/function is exported.
+		%
+		{ map__apply_to_list(Vars, VarTypes, Types) },
+		{ list__append(PredArgTypes, Types, ArgTypes) },
+		{ get_pred_id_and_proc_id(PredName, PredOrFunc,
+			TVarSet, ArgTypes, ModuleInfo, PredId, _ProcId) },
+		intermod_info_add_proc(PredId, DoWrite),
+		%
+		% Module-qualify it, if necessary.
+		%
+		{ PredName = unqualified(UnqualPredName) ->
+			predicate_module(ModuleInfo, PredId, Module),
+			QualifiedPredName = qualified(Module, UnqualPredName),
+			Functor = cons(QualifiedPredName, Arity)
+		;
+			Functor = Functor0
+		}
 	;
+		%
+		% Is it an unqualified functor symbol?
+		%
 		{ Functor0 = cons(unqualified(ConsName), ConsArity) },
 		{ map__lookup(VarTypes, LVar, VarType) },
 		{ type_to_type_id(VarType, TypeId, _) },
Index: modecheck_unify.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/modecheck_unify.m,v
retrieving revision 1.11
diff -u -r1.11 modecheck_unify.m
--- modecheck_unify.m	1997/03/06 05:09:37	1.11
+++ modecheck_unify.m	1997/03/21 18:05:42
@@ -222,7 +222,7 @@
 	% back into a higher-order pred constant again.
 	%
 
-		% check if variable has a higher-order pred type
+		% check if variable has a higher-order type
 		type_is_higher_order(TypeOfX, PredOrFunc, PredArgTypes),
 		ConsId = cons(PName, _),
 		% but in case we are redoing mode analysis, make sure
@@ -246,11 +246,15 @@
 		% the lambda goal
 		%
 
-		get_pred_id_and_proc_id(PName, Arity, PredOrFunc,
-			PredArgTypes, ModuleInfo0, PredId, ProcId),
+		module_info_pred_info(ModuleInfo0, ThisPredId, ThisPredInfo),
+		pred_info_typevarset(ThisPredInfo, TVarSet),
+		map__apply_to_list(Args, VarTypes, ArgTypes),
+		get_pred_id_and_proc_id(PName, PredOrFunc, TVarSet, ArgTypes,
+			ModuleInfo0, PredId, ProcId),
+		module_info_pred_proc_info(ModuleInfo0, PredId, ProcId,
+					PredInfo, ProcInfo),
 
 		% module-qualify the pred name (is this necessary?)
-		module_info_pred_info(ModuleInfo0, PredId, PredInfo),
 		pred_info_module(PredInfo, PredModule),
 		unqualify_name(PName, UnqualPName),
 		QualifiedPName = qualified(PredModule, UnqualPName),
@@ -277,8 +281,6 @@
 		% work out the modes of the introduced lambda variables
 		% and the determinism of the lambda goal
 		%
-		module_info_pred_proc_info(ModuleInfo0, PredId, ProcId,
-					_PredInfo, ProcInfo),
 		proc_info_argmodes(ProcInfo, ArgModes),
 		( list__drop(Arity, ArgModes, LambdaModes0) ->
 			LambdaModes = LambdaModes0
Index: typecheck.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/typecheck.m,v
retrieving revision 1.189
diff -u -r1.189 typecheck.m
--- typecheck.m	1997/02/26 09:47:55	1.189
+++ typecheck.m	1997/03/21 18:16:16
@@ -142,12 +142,28 @@
 
 
 	% Find a predicate which matches the given name and argument types.
+	% Abort if there is no matching pred.
+	% Abort if there are multiple matching preds.
 
 :- pred typecheck__resolve_pred_overloading(module_info, list(var),
 			map(var, type), tvarset, sym_name, sym_name, pred_id).
 :- mode typecheck__resolve_pred_overloading(in, in, in, in,
 			in, out, out) is det.
 
+	% Find a predicate or function from the list of pred_ids
+	% which matches the given name and argument types.
+	% Abort if there is no matching pred.
+	% Abort if there are multiple matching preds.
+
+:- pred typecheck__resolve_overloading(module_info, list(var), map(var, type),
+				tvarset, list(pred_id), sym_name, pred_id).
+:- mode typecheck__resolve_overloading(in, in, in, in, in, out, out) is det.
+
+	% Find a predicate or function from the list of pred_ids
+	% which matches the given name and argument types.
+	% Fail if there is no matching pred.
+	% Abort if there are multiple matching preds.
+
 :- pred typecheck__find_matching_pred_id(list(pred_id), module_info,
 			tvarset, list(type), pred_id, sym_name).
 :- mode typecheck__find_matching_pred_id(in, in, in, in, out, out) is semidet.
@@ -899,7 +915,11 @@
 	;
 		PredIds = []
 	),
+	typecheck__resolve_overloading(ModuleInfo, Args, VarTypes, TVarSet,
+			 PredIds, PredName, PredId).
 
+typecheck__resolve_overloading(ModuleInfo, Args, VarTypes, TVarSet, PredIds,
+		 PredName, PredId) :-
 	%
 	% Check if there any of the candidate pred_ids
 	% have argument/return types which subsume the actual
cvs diff: Diffing notes

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