[m-dev.] diff: existential types: address stayl's review comments

[Fergus Henderson]

This is all on a separate branch still, although it is almost
ready to be merged onto the main branch.

----------

Estimated hours taken: 2

Make some changes suggested by Simon Taylor's review comments.

compiler/modes.m:
compiler/unique_modes.m:
	Delete some commented-out code, because it was just confusing.

compiler/type_util.m:
compiler/mode_util.m:
	Move the definition of is_introduced_typeinfo_type/1
	from mode_util.m to type_util.m, since it's related to types
	rather than being directly related to modes.

compiler/modecheck_unify.m:
compiler/polymorphism.m:
	Extract out some duplicate code into a new subroutine
	convert_pred_to_lambda_goal/17.

Workspace: /home/mercury0/fjh/mercury-other
Index: compiler/mode_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mode_util.m,v
retrieving revision 1.114.2.1
diff -u -r1.114.2.1 mode_util.m
--- mode_util.m	1999/06/12 00:50:34	1.114.2.1
+++ mode_util.m	1999/06/23 05:57:45
@@ -1559,19 +1559,6 @@
 		NormalisedInst = Inst
 	).
 
-:- pred is_introduced_type_info_type(type).
-:- mode is_introduced_type_info_type(in) is semidet.
-
-is_introduced_type_info_type(Type) :-
-	sym_name_and_args(Type, TypeName, _),
-	TypeName = qualified(PrivateBuiltin, Name),
-	( Name = "type_info"
-	; Name = "type_ctor_info"
-	; Name = "typeclass_info"
-	; Name = "base_typeclass_info"
-	),
-	mercury_private_builtin_module(PrivateBuiltin).
-
 %-----------------------------------------------------------------------------%
 
 fixup_switch_var(Var, InstMap0, InstMap, Goal0, Goal) :-
Index: compiler/modecheck_unify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modecheck_unify.m,v
retrieving revision 1.37.2.4
diff -u -r1.37.2.4 modecheck_unify.m
--- modecheck_unify.m	1999/06/23 05:14:57	1.37.2.4
+++ modecheck_unify.m	1999/06/24 17:04:22
@@ -133,91 +133,23 @@
 		Unification0 \= deconstruct(_, code_addr_const(_, _), _, _, _)
 	->
 		%
-		% Create the new lambda-quantified variables
+		% convert the pred term to a lambda expression
 		%
 		mode_info_get_varset(ModeInfo0, VarSet0),
-		make_fresh_vars(PredArgTypes, VarSet0, VarTypes0,
-				LambdaVars, VarSet, VarTypes),
-		list__append(ArgVars0, LambdaVars, Args),
-		mode_info_set_varset(VarSet, ModeInfo0, ModeInfo1),
-		mode_info_set_var_types(VarTypes, ModeInfo1, ModeInfo2),
-
-		%
-		% Build up the hlds_goal_expr for the call that will form
-		% the lambda goal
-		%
-
+		mode_info_get_context(ModeInfo0, Context),
 		mode_info_get_predid(ModeInfo0, ThisPredId),
 		module_info_pred_info(ModuleInfo0, ThisPredId, ThisPredInfo),
 		pred_info_typevarset(ThisPredInfo, TVarSet),
-		map__apply_to_list(Args, VarTypes, ArgTypes),
-		(
-			% If we are redoing mode analysis, use the
-			% pred_id and proc_id found before, to avoid aborting
-			% in get_pred_id_and_proc_id if there are multiple
-			% matching procedures.
-			Unification0 = construct(_, 
-				pred_const(PredId0, ProcId0), _, _)
-		->
-			PredId = PredId0,
-			ProcId = ProcId0
-		;
-			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?)
-		pred_info_module(PredInfo, PredModule),
-		unqualify_name(PName, UnqualPName),
-		QualifiedPName = qualified(PredModule, UnqualPName),
-
-		CallUnifyContext = call_unify_context(X0,
-				functor(ConsId0, ArgVars0), UnifyContext),
-		LambdaGoalExpr = call(PredId, ProcId, Args, not_builtin,
-				yes(CallUnifyContext), QualifiedPName),
-
-		%
-		% construct a goal_info for the lambda goal, making sure
-		% to set up the nonlocals field in the goal_info correctly
-		%
-		goal_info_get_nonlocals(GoalInfo0, NonLocals),
-		set__insert_list(NonLocals, LambdaVars, OutsideVars),
-		set__list_to_set(Args, InsideVars),
-		set__intersect(OutsideVars, InsideVars, LambdaNonLocals),
-		goal_info_init(LambdaGoalInfo0),
-		mode_info_get_context(ModeInfo2, Context),
-		goal_info_set_context(LambdaGoalInfo0, Context,
-				LambdaGoalInfo1),
-		goal_info_set_nonlocals(LambdaGoalInfo1, LambdaNonLocals,
-				LambdaGoalInfo),
-		LambdaGoal = LambdaGoalExpr - LambdaGoalInfo,
-
-		%
-		% work out the modes of the introduced lambda variables
-		% and the determinism of the lambda goal
-		%
-		proc_info_argmodes(ProcInfo, ArgModes),
-		list__length(ArgVars0, Arity),
-		( list__drop(Arity, ArgModes, LambdaModes0) ->
-			LambdaModes = LambdaModes0
-		;
-			error("modecheck_unification: list__drop failed")
-		),
-		proc_info_declared_determinism(ProcInfo, MaybeDet),
-		( MaybeDet = yes(Det) ->
-			LambdaDet = Det
-		;
-			error("Sorry, not implemented: determinism inference for higher-order predicate terms")
-		),
-
+		convert_pred_to_lambda_goal(PredOrFunc, X0, ConsId0, PName,
+			ArgVars0, PredArgTypes, TVarSet,
+			Unification0, UnifyContext, GoalInfo0, Context,
+			ModuleInfo0, VarSet0, VarTypes0,
+			Functor0, VarSet, VarTypes),
+		mode_info_set_varset(VarSet, ModeInfo0, ModeInfo1),
+		mode_info_set_var_types(VarTypes, ModeInfo1, ModeInfo2),
 		%
-		% construct the lambda expression, and then go ahead
-		% and modecheck this unification in its new form
+		% modecheck this unification in its new form
 		%
-		Functor0 = lambda_goal(PredOrFunc, ArgVars0, LambdaVars, 
-				LambdaModes, LambdaDet, LambdaGoal),
 		modecheck_unification( X0, Functor0, Unification0, UnifyContext,
 				GoalInfo0, Goal, ModeInfo2, ModeInfo)
 	;
@@ -1256,19 +1188,6 @@
 mode_set_args([Inst | Insts], FinalInst, [Mode | Modes]) :-
 	Mode = (Inst -> FinalInst),
 	mode_set_args(Insts, FinalInst, Modes).
-
-%-----------------------------------------------------------------------------%
-
-:- pred make_fresh_vars(list(type), prog_varset, map(prog_var, type),
-			list(prog_var), prog_varset, map(prog_var, type)).
-:- mode make_fresh_vars(in, in, in, out, out, out) is det.
-
-make_fresh_vars([], VarSet, VarTypes, [], VarSet, VarTypes).
-make_fresh_vars([Type|Types], VarSet0, VarTypes0,
-		[Var|Vars], VarSet, VarTypes) :-
-	varset__new_var(VarSet0, Var, VarSet1),
-	map__det_insert(VarTypes0, Var, Type, VarTypes1),
-	make_fresh_vars(Types, VarSet1, VarTypes1, Vars, VarSet, VarTypes).
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.230.2.4
diff -u -r1.230.2.4 modes.m
--- modes.m	1999/06/15 15:54:29	1.230.2.4
+++ modes.m	1999/06/23 05:56:07
@@ -1073,7 +1073,6 @@
 
 modecheck_goal_expr(call(PredId, ProcId0, Args0, _, Context, PredName),
 		GoalInfo0, Goal) -->
-	/*** CallString = "call" ***/
 	{ prog_out__sym_name_to_string(PredName, PredNameString) },
 	{ string__append("call ", PredNameString, CallString) },
 	mode_checkpoint(enter, CallString),
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.163.2.5
diff -u -r1.163.2.5 polymorphism.m
--- polymorphism.m	1999/06/23 05:14:59	1.163.2.5
+++ polymorphism.m	1999/06/24 17:17:56
@@ -307,7 +307,9 @@
 :- module polymorphism.
 :- interface.
 
-:- import_module hlds_goal, hlds_module, hlds_pred, prog_data, special_pred.
+:- import_module hlds_goal, hlds_module, hlds_pred, hlds_data.
+:- import_module prog_data, special_pred.
+
 :- import_module io, list, term, map.
 
 % Run the polymorphism pass over the whole HLDS.
@@ -413,12 +415,21 @@
 		module_info, sym_name, pred_id, proc_id).
 :- mode polymorphism__get_special_proc(in, in, in, out, out, out) is det.
 
+	% convert a higher-order pred term to a lambda goal
+:- pred convert_pred_to_lambda_goal(pred_or_func, prog_var, cons_id, sym_name,
+		list(prog_var), list(type), tvarset,
+		unification, unify_context, hlds_goal_info, context,
+		module_info, prog_varset, map(prog_var, type),
+		unify_rhs, prog_varset, map(prog_var, type)).
+:- mode convert_pred_to_lambda_goal(in, in, in, in, in, in, in, 
+		in, in, in, in, in, in, in, out, out, out) is det.
+
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
 :- implementation.
 
-:- import_module typecheck, hlds_data, llds, prog_io.
+:- import_module typecheck, llds, prog_io.
 :- import_module type_util, mode_util, quantification, instmap, prog_out.
 :- import_module code_util, unify_proc, prog_util, make_hlds.
 :- import_module (inst), hlds_out, base_typeclass_info, goal_util, passes_aux.
@@ -1318,79 +1329,21 @@
 		ConsId0 = cons(PName, _)
 	->
 		%
-		% Create the new lambda-quantified variables
+		% convert the higher-order pred term to a lambda goal
 		%
 		poly_info_get_varset(PolyInfo0, VarSet0),
-		make_fresh_vars(PredArgTypes, VarSet0, VarTypes0,
-				LambdaVars, VarSet, VarTypes),
-		list__append(ArgVars0, LambdaVars, Args),
+		poly_info_get_typevarset(PolyInfo0, TVarSet),
+		goal_info_get_context(GoalInfo0, Context),
+		convert_pred_to_lambda_goal(PredOrFunc, X0, ConsId0, PName,
+			ArgVars0, PredArgTypes, TVarSet,
+			Unification0, UnifyContext, GoalInfo0, Context,
+			ModuleInfo0, VarSet0, VarTypes0,
+			Functor0, VarSet, VarTypes),
 		poly_info_set_varset_and_types(VarSet, VarTypes,
 			PolyInfo0, PolyInfo1),
-
 		%
-		% Build up the hlds_goal_expr for the call that will form
-		% the lambda goal
+		% process the unification in its new form
 		%
-
-		poly_info_get_typevarset(PolyInfo1, 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?)
-		pred_info_module(PredInfo, PredModule),
-		unqualify_name(PName, UnqualPName),
-		QualifiedPName = qualified(PredModule, UnqualPName),
-
-		CallUnifyContext = call_unify_context(X0,
-				functor(ConsId0, ArgVars0), UnifyContext),
-		LambdaGoalExpr = call(PredId, ProcId, Args, not_builtin,
-				yes(CallUnifyContext), QualifiedPName),
-
-		%
-		% construct a goal_info for the lambda goal, making sure
-		% to set up the nonlocals field in the goal_info correctly
-		%
-		goal_info_get_nonlocals(GoalInfo0, NonLocals),
-		set__insert_list(NonLocals, LambdaVars, OutsideVars),
-		set__list_to_set(Args, InsideVars),
-		set__intersect(OutsideVars, InsideVars, LambdaNonLocals),
-		goal_info_init(LambdaGoalInfo0),
-		goal_info_get_context(GoalInfo0, Context),
-		goal_info_set_context(LambdaGoalInfo0, Context,
-				LambdaGoalInfo1),
-		goal_info_set_nonlocals(LambdaGoalInfo1, LambdaNonLocals,
-				LambdaGoalInfo),
-		LambdaGoal = LambdaGoalExpr - LambdaGoalInfo,
-
-		%
-		% work out the modes of the introduced lambda variables
-		% and the determinism of the lambda goal
-		%
-		pred_info_arity(PredInfo, PredArity),
-		proc_info_argmodes(ProcInfo, ArgModes),
-		list__length(ArgModes, ProcArity),
-		NumTypeInfos = ProcArity - PredArity,
-		( list__drop(NumTypeInfos + Arity, ArgModes, LambdaModes0) ->
-			LambdaModes = LambdaModes0
-		;
-			error("modecheck_unification: list__drop failed")
-		),
-		proc_info_declared_determinism(ProcInfo, MaybeDet),
-		( MaybeDet = yes(Det) ->
-			LambdaDet = Det
-		;
-			error("Sorry, not implemented: determinism inference for higher-order predicate terms")
-		),
-
-		%
-		% construct the lambda expression, and then go ahead
-		% and process this unification in its new form
-		%
-		Functor0 = lambda_goal(PredOrFunc, ArgVars0, LambdaVars, 
-				LambdaModes, LambdaDet, LambdaGoal),
 		polymorphism__process_unify(X0, Functor0, Mode0,
 				Unification0, UnifyContext, GoalInfo0, Goal,
 				PolyInfo1, PolyInfo)
@@ -1403,8 +1356,90 @@
 				Unification0, UnifyContext) - GoalInfo0,
 		PolyInfo = PolyInfo0
 	).
+
+convert_pred_to_lambda_goal(PredOrFunc, X0, ConsId0, PName,
+		ArgVars0, PredArgTypes, TVarSet,
+		Unification0, UnifyContext, GoalInfo0, Context,
+		ModuleInfo0, VarSet0, VarTypes0,
+		Functor, VarSet, VarTypes) :-
+	%
+	% Create the new lambda-quantified variables
+	%
+	make_fresh_vars(PredArgTypes, VarSet0, VarTypes0,
+			LambdaVars, VarSet, VarTypes),
+	list__append(ArgVars0, LambdaVars, Args),
+
+	%
+	% Build up the hlds_goal_expr for the call that will form
+	% the lambda goal
+	%
+	map__apply_to_list(Args, VarTypes, ArgTypes),
+	(
+		% If we are redoing mode analysis, use the
+		% pred_id and proc_id found before, to avoid aborting
+		% in get_pred_id_and_proc_id if there are multiple
+		% matching procedures.
+		Unification0 = construct(_, 
+			pred_const(PredId0, ProcId0), _, _)
+	->
+		PredId = PredId0,
+		ProcId = ProcId0
+	;
+		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?)
+	pred_info_module(PredInfo, PredModule),
+	unqualify_name(PName, UnqualPName),
+	QualifiedPName = qualified(PredModule, UnqualPName),
+
+	CallUnifyContext = call_unify_context(X0,
+			functor(ConsId0, ArgVars0), UnifyContext),
+	LambdaGoalExpr = call(PredId, ProcId, Args, not_builtin,
+			yes(CallUnifyContext), QualifiedPName),
+
+	%
+	% construct a goal_info for the lambda goal, making sure
+	% to set up the nonlocals field in the goal_info correctly
+	%
+	goal_info_get_nonlocals(GoalInfo0, NonLocals),
+	set__insert_list(NonLocals, LambdaVars, OutsideVars),
+	set__list_to_set(Args, InsideVars),
+	set__intersect(OutsideVars, InsideVars, LambdaNonLocals),
+	goal_info_init(LambdaGoalInfo0),
+	goal_info_set_context(LambdaGoalInfo0, Context,
+			LambdaGoalInfo1),
+	goal_info_set_nonlocals(LambdaGoalInfo1, LambdaNonLocals,
+			LambdaGoalInfo),
+	LambdaGoal = LambdaGoalExpr - LambdaGoalInfo,
+
+	%
+	% work out the modes of the introduced lambda variables
+	% and the determinism of the lambda goal
+	%
+	proc_info_argmodes(ProcInfo, ArgModes),
+	list__length(ArgVars0, Arity),
+	( list__drop(Arity, ArgModes, LambdaModes0) ->
+		LambdaModes = LambdaModes0
+	;
+		error("modecheck_unification: list__drop failed")
+	),
+	proc_info_declared_determinism(ProcInfo, MaybeDet),
+	( MaybeDet = yes(Det) ->
+		LambdaDet = Det
+	;
+		error("Sorry, not implemented: determinism inference for higher-order predicate terms")
+	),
+
+	%
+	% construct the lambda expression
+	%
+	Functor = lambda_goal(PredOrFunc, ArgVars0, LambdaVars, 
+			LambdaModes, LambdaDet, LambdaGoal).
 
-% this is duplicated in modecheck_unify.m
 :- pred make_fresh_vars(list(type), prog_varset, map(prog_var, type),
 			list(prog_var), prog_varset, map(prog_var, type)).
 :- mode make_fresh_vars(in, in, in, out, out, out) is det.
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.66
diff -u -r1.66 type_util.m
--- type_util.m	1999/05/31 09:22:50	1.66
+++ type_util.m	1999/06/23 06:00:41
@@ -54,6 +54,14 @@
 :- pred type_id_is_hand_defined(type_id).
 :- mode type_id_is_hand_defined(in) is semidet.
 
+	% A test for type_info-related types that are introduced by
+	% polymorphism.m.  Mode inference never infers unique modes
+	% for these types, since it would not be useful, and since we
+	% want to minimize the number of different modes that we infer.
+
+:- pred is_introduced_type_info_type(type).
+:- mode is_introduced_type_info_type(in) is semidet.
+
 	% Given a type, determine what sort of type it is.
 
 :- pred classify_type(type, module_info, builtin_type).
@@ -279,6 +287,16 @@
 type_id_is_hand_defined(qualified(PrivateBuiltin, "typeclass_info") - 1) :-
 	mercury_private_builtin_module(PrivateBuiltin).
 type_id_is_hand_defined(qualified(PrivateBuiltin, "base_typeclass_info") - 1) :-
+	mercury_private_builtin_module(PrivateBuiltin).
+
+is_introduced_type_info_type(Type) :-
+	sym_name_and_args(Type, TypeName, _),
+	TypeName = qualified(PrivateBuiltin, Name),
+	( Name = "type_info"
+	; Name = "type_ctor_info"
+	; Name = "typeclass_info"
+	; Name = "base_typeclass_info"
+	),
 	mercury_private_builtin_module(PrivateBuiltin).
 
 %-----------------------------------------------------------------------------%
Index: compiler/unique_modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unique_modes.m,v
retrieving revision 1.52.2.2
diff -u -r1.52.2.2 unique_modes.m
--- unique_modes.m	1999/06/13 08:57:24	1.52.2.2
+++ unique_modes.m	1999/06/23 05:56:18
@@ -425,7 +425,6 @@
 
 unique_modes__check_goal_2(call(PredId, ProcId0, Args, Builtin, CallContext,
 		PredName), _GoalInfo0, Goal) -->
-	/*** CallString = "call" ***/
 	{ prog_out__sym_name_to_string(PredName, PredNameString) },
 	{ string__append("call ", PredNameString, CallString) },
 	mode_checkpoint(enter, CallString),
-- 
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.
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------