for review: type specialization [1]

Simon Taylor stayl at cs.mu.OZ.AU
Wed Feb 17 12:24:56 AEDT 1999


Hi,

Could someone (Fergus?) please review this?

I'll fix the demangler as a separate change.

There's another diff coming later with type specialization declarations
for the library - that has to wait until this diff is installed. An entry
for the news section of the web page can wait until then.

Thanks,
Simon.


Estimated hours taken: 35

User-guided type specialization.

compiler/prog_data.m:
compiler/prog_prog_io_pragma.m:
compiler/modules.m:
compiler/module_qual.m:
compiler/mercury_to_mercury.m:
	Added `pragma type_spec(<predicate>, <type substitution>)'.

compiler/prog_prog_io_pragma.m:
	Thread a counter through the pragma parsing so that unique
	specialised predicate names can be allocated and placed in
	the `.int' files. This avoids having to create and read in
	`.opt' files to use the `pragma type_spec' declarations for
	imported modules.
	
	Factor out some common code to parse predicate names with arguments
	that was useful for `pragma type_spec'.

compiler/hlds_module.m:
	Added a field to the module_sub_info to hold information about
	user-requested type specializations, filled in by make_hlds.m
	and not used by anything after higher_order.m.

compiler/make_hlds.m:
	For each `pragma type_spec', introduce a new predicate
	which just calls the predicate to be specialized with the
	specified argument types. This forces higher_order.m to produce
	the specialized versions.

compiler/higher_order.m:
	Process the user-requested type specializations first to ensure
	that they get the correct names.
	Allow partial matches against user-specified versions, e.g.
	map__lookup(map(int, list(int)), int, list(int)) matches
	map__lookup(map(int, V), int, V).

compiler/dead_proc_elim.m:
	Remove specializations for dead procedures.

NEWS:
doc/reference_manual.texi:
doc/user_guide.texi:
	Document the pragmas and new options.


Index: NEWS
===================================================================
RCS file: /home/staff/zs/imp/mercury/NEWS,v
retrieving revision 1.132
diff -u -r1.132 NEWS
--- NEWS	1998/12/06 06:23:38	1.132
+++ NEWS	1999/02/17 00:48:57
@@ -10,3 +10,8 @@
   which are supported by most modern Unix systems.
   See the files in extras/dynamic_linking for details.
 
+* We've added support for user-guided type specialization.
+
+  See the "Type specialization" section of the "Pragmas" chapter of the
+  Mercury Language Reference Manual for details.
+
Index: compiler/dead_proc_elim.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/dead_proc_elim.m,v
retrieving revision 1.43
diff -u -r1.43 dead_proc_elim.m
--- dead_proc_elim.m	1998/11/02 09:48:58	1.43
+++ dead_proc_elim.m	1999/02/10 05:01:04
@@ -686,12 +686,37 @@
 	list__foldl(dead_pred_elim_initialize, PredIds, 
 		DeadInfo0, DeadInfo1),
 	dead_pred_elim_analyze(DeadInfo1, DeadInfo),
-	DeadInfo = dead_pred_info(ModuleInfo1, _, _, NeededPreds, _),
+	DeadInfo = dead_pred_info(ModuleInfo1, _, _, NeededPreds2, _),
+
+	%
+	% If a predicate is not needed, predicates which were added in
+	% make_hlds.m to force type specialization are also not needed.
+	% Here we add in those which are needed.
+	%
+	module_info_type_spec_info(ModuleInfo1,
+		type_spec_info(TypeSpecProcs0, TypeSpecForcePreds0,
+			SpecMap0, PragmaMap0)),
+	set__to_sorted_list(NeededPreds2, NeededPredList2),
+	list__foldl(
+	    lambda([NeededPred::in, AllPreds0::in, AllPreds::out] is det, (
+		( map__search(SpecMap0, NeededPred, NewNeededPreds) ->
+			set__insert_list(AllPreds0, NewNeededPreds, AllPreds)
+		;
+			AllPreds = AllPreds0
+		)
+	)), NeededPredList2, NeededPreds2, NeededPreds),
+	set__intersect(TypeSpecForcePreds0, NeededPreds, TypeSpecForcePreds),
+
+	module_info_set_type_spec_info(ModuleInfo1,
+		type_spec_info(TypeSpecProcs0, TypeSpecForcePreds, 
+			SpecMap0, PragmaMap0),
+		ModuleInfo2),
+
 	set__list_to_set(PredIds, PredIdSet),
 	set__difference(PredIdSet, NeededPreds, DeadPreds),
 	set__to_sorted_list(DeadPreds, DeadPredList),
 	list__foldl(module_info_remove_predicate, DeadPredList,
-		ModuleInfo1, ModuleInfo).
+		ModuleInfo2, ModuleInfo).
 
 :- pred dead_pred_elim_add_entity(entity::in, queue(pred_id)::in,
 	queue(pred_id)::out, set(pred_id)::in, set(pred_id)::out) is det.
Index: compiler/equiv_type.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/equiv_type.m,v
retrieving revision 1.17
diff -u -r1.17 equiv_type.m
--- equiv_type.m	1998/11/20 04:07:32	1.17
+++ equiv_type.m	1999/02/10 05:01:05
@@ -36,9 +36,8 @@
 %-----------------------------------------------------------------------------%
 
 :- implementation.
-:- import_module bool, require, std_util, map.
+:- import_module assoc_list, bool, require, std_util, map, term, varset.
 :- import_module hlds_data, type_util, prog_data, prog_util, prog_out.
-:- import_module term, varset.
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
@@ -164,6 +163,12 @@
 				EqvMap, Constraints, VarSet1),
 	equiv_type__replace_in_type_list(Ts0, VarSet1, EqvMap, Ts, VarSet, _).
 
+equiv_type__replace_in_item(
+			pragma(type_spec(A, B, C, D, E, Subst0, VarSet0)),
+			EqvMap,
+			pragma(type_spec(A, B, C, D, E, Subst, VarSet)), no) :-
+	equiv_type__replace_in_subst(Subst0, VarSet0, EqvMap, Subst, VarSet).
+	
 :- pred equiv_type__replace_in_type_defn(type_defn, tvarset, eqv_map,
 					type_defn, tvarset, bool).
 :- mode equiv_type__replace_in_type_defn(in, in, in, out, out, out) is semidet.
@@ -272,6 +277,18 @@
 equiv_type__replace_in_class_method(_, 
 			func_mode(A,B,C,D,E,F,G),
 			func_mode(A,B,C,D,E,F,G)).
+
+%-----------------------------------------------------------------------------%
+
+:- pred equiv_type__replace_in_subst(assoc_list(tvar, type), tvarset,
+		eqv_map, assoc_list(tvar, type), tvarset).
+:- mode equiv_type__replace_in_subst(in, in, in, out, out) is det.
+
+equiv_type__replace_in_subst([], VarSet, _EqvMap, [], VarSet).
+equiv_type__replace_in_subst([Var - Type0 | Subst0], VarSet0,
+		EqvMap, [Var - Type | Subst], VarSet) :-
+	equiv_type__replace_in_type(Type0, VarSet0, EqvMap, Type, VarSet1),
+	equiv_type__replace_in_subst(Subst0, VarSet1, EqvMap, Subst, VarSet).
 
 %-----------------------------------------------------------------------------%
 
Index: compiler/handle_options.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/handle_options.m,v
retrieving revision 1.70
diff -u -r1.70 handle_options.m
--- handle_options.m	1998/12/09 03:26:21	1.70
+++ handle_options.m	1999/02/10 05:01:07
@@ -407,6 +407,11 @@
 		[]
 	),
 
+	% If we are doing type-specialization, we may as well take
+	% advantage of the declarations supplied by the programmer.
+	option_implies(type_specialization, user_guided_type_specialization,
+		bool(yes)),
+
 	% --intermod-unused-args implies --intermodule-optimization and
 	% --optimize-unused-args.
 	option_implies(intermod_unused_args, intermodule_optimization,
Index: compiler/higher_order.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/higher_order.m,v
retrieving revision 1.49
diff -u -r1.49 higher_order.m
--- higher_order.m	1998/12/06 23:43:15	1.49
+++ higher_order.m	1999/02/10 05:01:07
@@ -26,13 +26,9 @@
 :- interface.
 
 :- import_module hlds_module.
-:- import_module bool, io.
+:- import_module io.
 
-	% specialize_higher_order(DoHigherOrder, DoTypeInfos, Module0, Module).
-	% DoHigherOrder is the value of `--optimize-higher-order'.
-	% DoTypeInfos is the value of `--type-specialization'
-:- pred specialize_higher_order(bool::in, bool::in,
-		module_info::in, module_info::out,
+:- pred specialize_higher_order(module_info::in, module_info::out,
 		io__state::di, io__state::uo) is det.
 
 %-------------------------------------------------------------------------------
@@ -43,30 +39,64 @@
 :- import_module code_util, globals, make_hlds, mode_util, goal_util.
 :- import_module type_util, options, prog_data, prog_out, quantification.
 :- import_module mercury_to_mercury, inlining, polymorphism, prog_util.
-:- import_module special_pred, term, varset.
+:- import_module special_pred.
 
-:- import_module assoc_list, char, int, list, map, require, set.
-:- import_module std_util, string.
+:- import_module assoc_list, bool, char, int, list, map, require, set.
+:- import_module std_util, string, varset, term.
 
 	% Iterate collecting requests and processing them until there
 	% are no more requests remaining.
-specialize_higher_order(DoHigherOrder, DoTypeInfos,
-		ModuleInfo0, ModuleInfo) -->
+specialize_higher_order(ModuleInfo0, ModuleInfo) -->
+	globals__io_lookup_bool_option(optimize_higher_order, HigherOrder),
+	globals__io_lookup_bool_option(type_specialization, TypeSpec),
+	globals__io_lookup_bool_option(user_guided_type_specialization,
+		UserTypeSpec),
 	globals__io_lookup_int_option(higher_order_size_limit, SizeLimit),
-	{ Params = ho_params(DoHigherOrder, DoTypeInfos, SizeLimit) },
-	{ get_specialization_requests(Params, Requests, GoalSizes,
-		ModuleInfo0, ModuleInfo1) },
+	globals__io_lookup_bool_option(typeinfo_liveness,
+		TypeInfoLiveness),
+	{ Params = ho_params(HigherOrder, TypeSpec,
+		UserTypeSpec, SizeLimit, TypeInfoLiveness) },
 	{ map__init(NewPredMap) },
 	{ map__init(PredVarMap) },
 	{ NewPreds0 = new_preds(NewPredMap, PredVarMap) },
-	process_requests(Params, Requests, GoalSizes, 1, _NextHOid,
-		NewPreds0, _NewPreds, ModuleInfo1, ModuleInfo).
+	{ map__init(GoalSizes0) },
+
+	{ module_info_predids(ModuleInfo0, PredIds0) },
+	{ module_info_type_spec_info(ModuleInfo0,
+		type_spec_info(_, UserSpecPreds, _, _)) },
+
+	% Make sure the user requested specializations are processed first,
+	% since we don't want to create more versions if one of these
+	% matches.
+	{ set__list_to_set(PredIds0, PredIdSet0) },
+	{ set__difference(PredIdSet0, UserSpecPreds, PredIdSet) },
+	{ set__to_sorted_list(PredIdSet, PredIds) },
+
+	{ set__init(Requests0) },
+	{ set__to_sorted_list(UserSpecPreds, UserSpecPredList) },
+	{ get_specialization_requests(Params, UserSpecPredList, NewPreds0,
+		Requests0, UserRequests, GoalSizes0, GoalSizes1,
+		ModuleInfo0, ModuleInfo1) },
+	process_requests(Params, UserRequests, GoalSizes1, GoalSizes2,
+		1, NextHOid, NewPreds0, NewPreds1, ModuleInfo1, ModuleInfo2),
+	{ get_specialization_requests(Params, PredIds, NewPreds1,
+		Requests0, Requests, GoalSizes2, GoalSizes,
+		ModuleInfo2, ModuleInfo3) },
+	process_requests(Params, Requests, GoalSizes, _, NextHOid, _,
+		NewPreds1, _NewPreds, ModuleInfo3, ModuleInfo4),
+
+	% Remove the predicates which were used to force the production of
+	% user-requested type specializations, since they are not called
+	% from anywhere and are no longer needed.
+	{ list__foldl(module_info_remove_predicate,
+		UserSpecPredList, ModuleInfo4, ModuleInfo) }.
 
 :- pred process_requests(ho_params::in, set(request)::in, goal_sizes::in,
-	int::in, int::out, new_preds::in, new_preds::out, module_info::in,
-	module_info::out, io__state::di, io__state::uo) is det.
+	goal_sizes::out, int::in, int::out, new_preds::in, new_preds::out,
+	module_info::in, module_info::out,
+	io__state::di, io__state::uo) is det.
 
-process_requests(Params, Requests0, GoalSizes0, NextHOid0, NextHOid,
+process_requests(Params, Requests0, GoalSizes0, GoalSizes, NextHOid0, NextHOid,
 			NewPreds0, NewPreds, ModuleInfo1, ModuleInfo) -->
 	{ filter_requests(Params, ModuleInfo1,
 		Requests0, GoalSizes0, Requests) },
@@ -75,17 +105,18 @@
 	->
 		{ ModuleInfo = ModuleInfo1 },
 		{ NextHOid = NextHOid0 },
-		{ NewPreds = NewPreds0 }
+		{ NewPreds = NewPreds0 },
+		{ GoalSizes = GoalSizes0 }
 	;
 		{ set__init(PredProcsToFix0) },
-		create_new_preds(Requests, NewPreds0, NewPreds1,
+		create_new_preds(Params, Requests, NewPreds0, NewPreds1,
 			[], NewPredList, PredProcsToFix0, PredProcsToFix,
 			NextHOid0, NextHOid1, ModuleInfo1, ModuleInfo2),
 		{ set__to_sorted_list(PredProcsToFix, PredProcs) },
 		{ set__init(NewRequests0) },
 		{ create_specialized_versions(Params, NewPredList,
 			NewPreds1, NewPreds2, NewRequests0, NewRequests,
-			GoalSizes0, GoalSizes, ModuleInfo2, ModuleInfo3) },
+			GoalSizes0, GoalSizes1, ModuleInfo2, ModuleInfo3) },
 
 		{ fixup_preds(Params, PredProcs, NewPreds2,
 			ModuleInfo3, ModuleInfo4) },
@@ -98,8 +129,9 @@
 		;
 			ModuleInfo5 = ModuleInfo4
 		},
-		process_requests(Params, NewRequests, GoalSizes, NextHOid1,
-			NextHOid, NewPreds2, NewPreds, ModuleInfo5, ModuleInfo)
+		process_requests(Params, NewRequests, GoalSizes1, GoalSizes,
+			NextHOid1, NextHOid, NewPreds2, NewPreds,
+			ModuleInfo5, ModuleInfo)
 	).
 
 %-------------------------------------------------------------------------------
@@ -115,7 +147,9 @@
 		list(type),			% Extra typeinfo argument
 						% types required by
 						% --typeinfo-liveness.
-		tvarset				% caller's typevarset.
+		tvarset,			% caller's typevarset.
+		bool				% is this a user-requested
+						% specialization
 	).
 
 		% Stores cons_id, index in argument vector, number of 
@@ -174,7 +208,9 @@
 	---> ho_params(
 		bool,		% propagate higher-order constants.
 		bool,		% propagate type-info constants.
-		int		% size limit on requested version.
+		bool,		% user-guided type specialization.
+		int,		% size limit on requested version.
+		bool		% --typeinfo-liveness
 	).
 
 :- type new_preds
@@ -199,7 +235,9 @@
 					% in requesting caller
 		list(type),		% extra typeinfo argument
 					% types in requesting caller
-		tvarset			% caller's typevarset
+		tvarset,		% caller's typevarset
+		bool			% is this a user-specified type
+					% specialization
 	).
 
 	% Returned by traverse_goal. 
@@ -209,25 +247,15 @@
 	;	unchanged.	% Do nothing more for this predicate
 
 %-------------------------------------------------------------------------------
-:- pred get_specialization_requests(ho_params::in, set(request)::out,
-	goal_sizes::out, module_info::in, module_info::out) is det.
 
-get_specialization_requests(Params, Requests, GoalSizes,
-		ModuleInfo0, ModuleInfo) :-
-	module_info_predids(ModuleInfo0, PredIds),
-	map__init(GoalSizes0),
-	set__init(Requests0),
-	get_specialization_requests_2(Params, PredIds, Requests0, Requests,
-			GoalSizes0, GoalSizes, ModuleInfo0, ModuleInfo).
+:- pred get_specialization_requests(ho_params::in, list(pred_id)::in,
+	new_preds::in, set(request)::in, set(request)::out, goal_sizes::in,
+	goal_sizes::out, module_info::in, module_info::out) is det.
 
-:- pred get_specialization_requests_2(ho_params::in, list(pred_id)::in,
-	set(request)::in, set(request)::out, goal_sizes::in, goal_sizes::out, 
-	module_info::in, module_info::out) is det.
-
-get_specialization_requests_2(_Params, [], Requests, Requests, Sizes, Sizes, 
-					ModuleInfo, ModuleInfo).
-get_specialization_requests_2(Params, [PredId | PredIds], Requests0, Requests,
-			GoalSizes0, GoalSizes, ModuleInfo0, ModuleInfo) :-
+get_specialization_requests(_Params, [], _NewPreds, Requests, Requests,
+		Sizes, Sizes, ModuleInfo, ModuleInfo).
+get_specialization_requests(Params, [PredId | PredIds], NewPreds, Requests0,
+		Requests, GoalSizes0, GoalSizes, ModuleInfo0, ModuleInfo) :-
 	module_info_preds(ModuleInfo0, Preds0), 
 	map__lookup(Preds0, PredId, PredInfo0),
 	pred_info_non_imported_procids(PredInfo0, NonImportedProcs),
@@ -243,11 +271,8 @@
 		proc_info_goal(ProcInfo0, Goal0),
 		map__init(PredVars0),
 			% first time through we can only specialize call/N
-		map__init(NewPredMap),
-		map__init(PredVarMap),
-		NewPreds0 = new_preds(NewPredMap, PredVarMap),
 		PredProcId = proc(PredId, ProcId),
-		Info0 = info(PredVars0, Requests0, NewPreds0, PredProcId,
+		Info0 = info(PredVars0, Requests0, NewPreds, PredProcId,
 			PredInfo0, ProcInfo0, ModuleInfo0, Params, unchanged),
 		traverse_goal_0(Goal0, Goal1, Info0,
 			info(_, Requests1,_,_,_,_,_,_, Changed)),
@@ -266,8 +291,8 @@
 			(Changed = request ; Changed = changed)
 		->
 			traverse_other_procs(Params, PredId, ProcIds,
-				ModuleInfo0, PredInfo0, Requests1, Requests2,
-				Procs1, Procs),
+				ModuleInfo0, PredInfo0, NewPreds,
+				Requests1, Requests2, Procs1, Procs),
 			pred_info_set_procedures(PredInfo0, Procs, PredInfo),
 			map__det_update(Preds0, PredId, PredInfo, Preds),
 			module_info_set_preds(ModuleInfo0, Preds, ModuleInfo1)
@@ -276,28 +301,26 @@
 			Requests2 = Requests1
 		)
 	),
-	get_specialization_requests_2(Params, PredIds, Requests2, Requests,
-			GoalSizes1, GoalSizes, ModuleInfo1, ModuleInfo).
+	get_specialization_requests(Params, PredIds, NewPreds,
+		Requests2, Requests, GoalSizes1, GoalSizes,
+		ModuleInfo1, ModuleInfo).
 
 		% This is called when the first procedure of a pred was 
 		% changed. It fixes up all the other procs, ignoring the
 		% goal_size and requests that come out, since that information
 		% has already been collected. 
 :- pred traverse_other_procs(ho_params::in, pred_id::in, list(proc_id)::in,
-		module_info::in, pred_info::in, set(request)::in,
-		set(request)::out, proc_table::in, proc_table::out) is det. 
+	module_info::in, pred_info::in, new_preds::in, set(request)::in,
+	set(request)::out, proc_table::in, proc_table::out) is det. 
 
 traverse_other_procs(_Params, _PredId, [], _Module, _PredInfo,
-		Requests, Requests, Procs, Procs).
+		_, Requests, Requests, Procs, Procs).
 traverse_other_procs(Params, PredId, [ProcId | ProcIds], ModuleInfo,
-		PredInfo0, Requests0, Requests, Procs0, Procs) :-
+		PredInfo0, NewPreds, Requests0, Requests, Procs0, Procs) :-
 	map__init(PredVars0),
-	map__init(NewPredMap),
-	map__init(PredVarMap),
-	NewPreds0 = new_preds(NewPredMap, PredVarMap),
 	map__lookup(Procs0, ProcId, ProcInfo0),
 	proc_info_goal(ProcInfo0, Goal0),
-	Info0 = info(PredVars0, Requests0, NewPreds0, proc(PredId, ProcId),
+	Info0 = info(PredVars0, Requests0, NewPreds, proc(PredId, ProcId),
 			PredInfo0, ProcInfo0, ModuleInfo, Params, unchanged),
 	traverse_goal_0(Goal0, Goal1, Info0,
 			info(_, Requests1, _,_,_,_,_,_,_)),
@@ -311,7 +334,7 @@
 	proc_info_set_vartypes(ProcInfo2, VarTypes, ProcInfo),
 	map__det_update(Procs0, ProcId, ProcInfo, Procs1),
 	traverse_other_procs(Params, PredId, ProcIds, ModuleInfo, PredInfo0,
-		Requests1, Requests, Procs1, Procs).
+		NewPreds, Requests1, Requests, Procs1, Procs).
 	
 %-------------------------------------------------------------------------------
 	% Goal traversal
@@ -322,6 +345,7 @@
 traverse_goal_0(Goal0, Goal, Info0, Info) :-
 	Info0 = info(_, B, NewPreds0, PredProcId, E, F, G, H, I),
 	NewPreds0 = new_preds(_, PredVarMap),
+
 	% Lookup the initial known bindings of the variables if this
 	% procedure is a specialised version.
 	( map__search(PredVarMap, PredProcId, PredVars) ->
@@ -553,20 +577,21 @@
 
 :- pred is_interesting_cons_id(ho_params::in, cons_id::in) is semidet.
 
-is_interesting_cons_id(ho_params(_, yes, _),
+is_interesting_cons_id(ho_params(_, _, yes, _, _),
 		cons(qualified(Module, Name), _)) :-
 	mercury_private_builtin_module(Module),
 	( Name = "type_info"
 	; Name = "typeclass_info"
 	).
-is_interesting_cons_id(ho_params(yes, _, _), pred_const(_, _)).
-is_interesting_cons_id(ho_params(_, yes, _), base_type_info_const(_, _, _)).
-is_interesting_cons_id(ho_params(_, yes, _),
+is_interesting_cons_id(ho_params(yes, _, _, _, _), pred_const(_, _)).
+is_interesting_cons_id(ho_params(_, _, yes, _, _),
+		base_type_info_const(_, _, _)).
+is_interesting_cons_id(ho_params(_, _, yes, _, _),
 		base_typeclass_info_const(_, _, _, _)).
 	% We need to keep track of int_consts so we can interpret
 	% superclass_info_from_typeclass_info and typeinfo_from_typeclass_info.
 	% We don't specialize based on them.
-is_interesting_cons_id(ho_params(_, yes, _), int_const(_)).
+is_interesting_cons_id(ho_params(_, _, yes, _, _), int_const(_)).
 
 	% Process a higher-order call or class_method_call to see if it
 	% could possibly be specialized.
@@ -672,30 +697,39 @@
 		interpret_typeclass_info_manipulator(Manipulator, Args0,
 			Goal0, Goal, Info0, Info)
 	;
-		( pred_info_is_imported(CalleePredInfo)
-		; pred_info_get_goal_type(CalleePredInfo, pragmas)
+		(
+			pred_info_is_imported(CalleePredInfo),
+			module_info_type_spec_info(Module,
+				type_spec_info(TypeSpecProcs, _, _, _)),
+			\+ set__member(proc(CalledPred, CalledProc),
+				TypeSpecProcs)
+		;
+			pred_info_is_pseudo_imported(CalleePredInfo),
+			hlds_pred__in_in_unification_proc_id(CalledProc)
+		;
+			pred_info_get_goal_type(CalleePredInfo, pragmas)
 		)
 	->
 		Info = Info0,
 		Goal = Goal0
 	;
 		pred_info_arg_types(CalleePredInfo, CalleeArgTypes),
+		pred_info_import_status(CalleePredInfo, CalleeStatus),
 		proc_info_vartypes(ProcInfo, VarTypes),
-		find_higher_order_args(Module, Args0, CalleeArgTypes,
-			VarTypes, PredVars, 1, [], HigherOrderArgs0,
-			Args0, Args1),
+		find_higher_order_args(Module, CalleeStatus, Args0,
+			CalleeArgTypes, VarTypes, PredVars, 1, [],
+			HigherOrderArgs0),
 		( HigherOrderArgs0 = [] ->
 			Info = Info0,
 			Goal = Goal0
 		;
 			list__reverse(HigherOrderArgs0, HigherOrderArgs),
 			find_matching_version(Info0, CalledPred, CalledProc,
-				Args0, Args1, HigherOrderArgs, FindResult),
+				Args0, HigherOrderArgs, FindResult),
 			(
-				FindResult = match(Match, ExtraTypeInfos),
+				FindResult = match(match(Match, _, Args)),
 				Match = new_pred(NewPredProcId, _, _,
-					NewName, _HOArgs, _, _, _, _, _),
-				list__append(ExtraTypeInfos, Args1, Args),
+					NewName, _HOArgs, _, _, _, _, _, _),
 				NewPredProcId = proc(NewCalledPred,
 					NewCalledProc),
 				Goal = call(NewCalledPred, NewCalledProc,
@@ -707,11 +741,16 @@
 				% There is a known higher order variable in
 				% the call, so we put in a request for a
 				% specialized version of the pred.
-				Goal = Goal0,
 				FindResult = request(Request),
+				Goal = Goal0,
 				set__insert(Requests0, Request, Requests),
 				update_changed_status(Changed0,
 					request, Changed)
+			;
+				FindResult = no_request,
+				Goal = Goal0,
+				Requests = Requests0,
+				Changed = Changed0
 			),
 			Info = info(PredVars, Requests, NewPreds, PredProcId,
 				PredInfo, ProcInfo, Module, Params, Changed)
@@ -719,22 +758,18 @@
 	).
 
 	% Returns a list of the higher-order arguments in a call that have
-	% a known value. Also update the argument list to now include
-	% curried arguments that need to be explicitly passed.
-	% The order of the argument list must match that generated
-	% by construct_higher_order_terms.
-:- pred find_higher_order_args(module_info::in, list(prog_var)::in,
-		list(type)::in, map(prog_var, type)::in, pred_vars::in, int::in,
-		list(higher_order_arg)::in, list(higher_order_arg)::out,
-		list(prog_var)::in, list(prog_var)::out) is det.
+	% a known value.
+:- pred find_higher_order_args(module_info::in, import_status::in,
+	list(prog_var)::in, list(type)::in, map(prog_var, type)::in,
+	pred_vars::in, int::in, list(higher_order_arg)::in,
+	list(higher_order_arg)::out) is det.
 
-find_higher_order_args(_, [], _, _, _, _,
-		HOArgs, HOArgs, NewArgs, NewArgs).
-find_higher_order_args(_, [_|_], [], _, _, _, _, _, _, _) :-
+find_higher_order_args(_, _, [], _, _, _, _, HOArgs, HOArgs).
+find_higher_order_args(_, _, [_|_], [], _, _, _, _, _) :-
 	error("find_higher_order_args: length mismatch").
-find_higher_order_args(ModuleInfo, [Arg | Args],
-		[CalleeArgType | CalleeArgTypes], VarTypes, PredVars, ArgNo,
-		HOArgs0, HOArgs, NewArgs0, NewArgs) :-
+find_higher_order_args(ModuleInfo, CalleeStatus, [Arg | Args],
+		[CalleeArgType | CalleeArgTypes], VarTypes,
+		PredVars, ArgNo, HOArgs0, HOArgs) :-
 	NextArg is ArgNo + 1,
 	(
 		% We don't specialize arguments whose declared type is
@@ -750,6 +785,10 @@
 		ConsId \= int_const(_),
 
 		( ConsId = pred_const(_, _) ->
+			% If we don't have clauses for the callee, we can't
+			% specialize any higher-order arguments. We may be
+			% able to do user guided type specialization.
+			CalleeStatus \= imported,
 			type_is_higher_order(CalleeArgType, _, _)
 		;
 			true
@@ -764,150 +803,255 @@
 		;
 			CurriedCalleeArgTypes = CurriedArgTypes
 		),
-		find_higher_order_args(ModuleInfo, CurriedArgs,
+		find_higher_order_args(ModuleInfo, CalleeStatus, CurriedArgs,
 			CurriedCalleeArgTypes, VarTypes,
-			PredVars, 1, [], HOCurriedArgs0,
-			CurriedArgs, NewExtraArgs),
+			PredVars, 1, [], HOCurriedArgs0),
 		list__reverse(HOCurriedArgs0, HOCurriedArgs),
 		list__length(CurriedArgs, NumArgs),
 		HOArg = higher_order_arg(ConsId, ArgNo, NumArgs,
 			CurriedArgs, CurriedArgTypes, HOCurriedArgs),
-		HOArgs1 = [HOArg | HOArgs0],
-		list__append(NewArgs0, NewExtraArgs, NewArgs1)
+		HOArgs1 = [HOArg | HOArgs0]
 	;
-		HOArgs1 = HOArgs0,
-		NewArgs1 = NewArgs0
+		HOArgs1 = HOArgs0
 	),
-	find_higher_order_args(ModuleInfo, Args, CalleeArgTypes,
-		VarTypes, PredVars, NextArg, HOArgs1, HOArgs,
-		NewArgs1, NewArgs).
+	find_higher_order_args(ModuleInfo, CalleeStatus, Args, CalleeArgTypes,
+		VarTypes, PredVars, NextArg, HOArgs1, HOArgs).
 
 :- type find_result
-	--->	match(
-			new_pred,	% Specialised version to use.
-			list(prog_var)	% Ordered list of extra type-info
-					% variables to add to the front of
-					% the argument list, empty if
-					% --typeinfo-liveness is not set.
-		)
-	;	request(request)
+	--->	match(match)
+	; 	request(request)
+	;	no_request
 	.
 
+:- type match
+	---> match(
+		new_pred,
+		maybe(int),	% was the match partial, if so,
+				% how many higher_order arguments
+				% matched.
+		list(prog_var)	% the arguments to the specialised call
+	).
+
 :- pred find_matching_version(higher_order_info::in, 
-	pred_id::in, proc_id::in, list(prog_var)::in, list(prog_var)::in,
+	pred_id::in, proc_id::in, list(prog_var)::in,
 	list(higher_order_arg)::in, find_result::out) is det.
 
 	% Args0 is the original list of arguments.
 	% Args1 is the original list of arguments with the curried arguments
 	% of known higher-order arguments added.
-find_matching_version(Info, CalledPred, CalledProc, Args0, Args1,
+find_matching_version(Info, CalledPred, CalledProc, Args0,
 		HigherOrderArgs, Result) :-
 	Info = info(_, _, NewPreds, Caller,
-		PredInfo, ProcInfo, ModuleInfo, _, _),
+		PredInfo, ProcInfo, ModuleInfo, Params, _),
+
+	compute_extra_typeinfos(Info, Args0, ExtraTypeInfos,
+		ExtraTypeInfoTypes),
+
 	proc_info_vartypes(ProcInfo, VarTypes),
-	pred_info_arg_types(PredInfo, _, ExistQVars, _),
+	map__apply_to_list(Args0, VarTypes, CallArgTypes),
 	pred_info_typevarset(PredInfo, TVarSet),
 
-	module_info_globals(ModuleInfo, Globals),
-	globals__lookup_bool_option(Globals,
-		typeinfo_liveness, TypeInfoLiveness),
-	( TypeInfoLiveness = yes ->
-		set__list_to_set(Args1, NonLocals0),
-		proc_info_typeinfo_varmap(ProcInfo, TVarMap),
-		proc_info_typeclass_info_varmap(ProcInfo, TCVarMap),
-		goal_util__extra_nonlocal_typeinfos(TVarMap, TCVarMap,
-			VarTypes, ExistQVars, NonLocals0, TypeInfos0),
-		set__delete_list(TypeInfos0, Args1, ExtraTypeInfos0),
-		set__to_sorted_list(ExtraTypeInfos0, ExtraTypeInfos),
-		map__apply_to_list(ExtraTypeInfos,
-			VarTypes, ExtraTypeInfoTypes)
+	module_info_type_spec_info(ModuleInfo,
+		type_spec_info(_, ForceVersions, _, _)),
+
+	Caller = proc(CallerPredId, _),
+	( set__member(CallerPredId, ForceVersions) ->
+		IsUserSpecProc = yes
 	;
-		ExtraTypeInfos = [],
-		ExtraTypeInfoTypes = []
+		IsUserSpecProc = no
 	),
 
-	map__apply_to_list(Args0, VarTypes, CallArgTypes),
 	Request = request(Caller, proc(CalledPred, CalledProc), Args0,
 		ExtraTypeInfos, HigherOrderArgs, CallArgTypes,
-		ExtraTypeInfoTypes, TVarSet), 
+		ExtraTypeInfoTypes, TVarSet, IsUserSpecProc), 
 
 	% Check to see if any of the specialized
 	% versions of the called pred apply here.
 	( 
 		NewPreds = new_preds(NewPredMap, _),
 		map__search(NewPredMap, proc(CalledPred, CalledProc),
-			NewPredSet),
-		set__to_sorted_list(NewPredSet, NewPredList),
-		search_for_version(TypeInfoLiveness, ModuleInfo, Request,
-			ExtraTypeInfos, NewPredList,
-			Match, OrderedExtraTypeInfos)
+			Versions0),
+		set__to_sorted_list(Versions0, Versions),
+		search_for_version(Info, Params, ModuleInfo, Request, Args0,
+			Versions, no, Match)
 	->
-		Result = match(Match, OrderedExtraTypeInfos)
+		Result = match(Match)
 	;
+		Params = ho_params(HigherOrder, TypeSpec, UserTypeSpec, _, _),
+		(
+			UserTypeSpec = yes,
+			IsUserSpecProc = yes
+		;
+			HigherOrder = yes,
+			module_info_pred_info(ModuleInfo,
+				CalledPred, CalledPredInfo),
+			\+ pred_info_is_imported(CalledPredInfo),
+			list__member(HOArg, HigherOrderArgs),
+			HOArg = higher_order_arg(pred_const(_, _),
+				_, _, _, _, _)
+		;
+			TypeSpec = yes,
+			module_info_pred_info(ModuleInfo,
+				CalledPred, CalledPredInfo),
+			\+ pred_info_is_imported(CalledPredInfo)
+		)
+	->
 		Result = request(Request)
+	;
+		Result = no_request
 	).
 
-:- pred search_for_version(bool::in, module_info::in, request::in, 
-		list(prog_var)::in, list(new_pred)::in, new_pred::out,
-		list(prog_var)::out) is semidet.
+:- pred compute_extra_typeinfos(higher_order_info::in, list(prog_var)::in,
+		list(prog_var)::out, list(type)::out) is det.
+
+compute_extra_typeinfos(Info, Args1, ExtraTypeInfos, ExtraTypeInfoTypes) :-
+	Info = info(_, _, _, _, PredInfo, ProcInfo, _, Params, _),
+
+	proc_info_vartypes(ProcInfo, VarTypes),
+	pred_info_arg_types(PredInfo, _, ExistQVars, _),
 
-search_for_version(TypeInfoLiveness, ModuleInfo, Request, ExtraTypeInfos,
-		[Version | Versions], Match, OrderedExtraTypeInfos) :-
+	Params = ho_params(_, _, _, _, TypeInfoLiveness),
+	( TypeInfoLiveness = yes ->
+		set__list_to_set(Args1, NonLocals0),
+		proc_info_typeinfo_varmap(ProcInfo, TVarMap),
+		proc_info_typeclass_info_varmap(ProcInfo, TCVarMap),
+		goal_util__extra_nonlocal_typeinfos(TVarMap, TCVarMap,
+			VarTypes, ExistQVars, NonLocals0, TypeInfos0),
+		set__delete_list(TypeInfos0, Args1, ExtraTypeInfos0),
+		set__to_sorted_list(ExtraTypeInfos0, ExtraTypeInfos),
+		map__apply_to_list(ExtraTypeInfos,
+			VarTypes, ExtraTypeInfoTypes)
+	;
+		ExtraTypeInfos = [],
+		ExtraTypeInfoTypes = []
+	).
+
+:- pred search_for_version(higher_order_info::in, ho_params::in,
+		module_info::in, request::in, list(prog_var)::in,
+		list(new_pred)::in, maybe(match)::in, match::out) is semidet.
+
+search_for_version(_Info, _Params, _ModuleInfo, _Request, _Args0,
+		[], yes(Match), Match).
+search_for_version(Info, Params, ModuleInfo, Request, Args0,
+		[Version | Versions], Match0, Match) :-
 	(
-		version_matches(TypeInfoLiveness, ModuleInfo, Request,
-			Version, yes(ExtraTypeInfos), OrderedExtraTypeInfos0)
+		version_matches(Params, ModuleInfo, Request, yes(Args0 - Info),
+			Version, Match1)
 	->
-		Match = Version,
-		OrderedExtraTypeInfos = OrderedExtraTypeInfos0
+		(
+			Match1 = match(_, no, _)
+		->
+			Match = Match1
+		;
+			(
+				Match0 = no
+			->
+				Match2 = yes(Match1)
+			;
+				% pick the best match
+				Match0 = yes(match(_, yes(NumMatches0), _)),
+				Match1 = match(_, yes(NumMatches1), _)
+			->
+				( NumMatches0 > NumMatches1 ->
+					Match2 = Match0
+				;
+					Match2 = yes(Match1)
+				)
+			;
+				error("higher_order: search_for_version")
+			),
+			search_for_version(Info, Params, ModuleInfo, Request,
+				Args0, Versions, Match2, Match)
+		)
 	;
-		search_for_version(TypeInfoLiveness, ModuleInfo, Request,
-			ExtraTypeInfos, Versions, Match, OrderedExtraTypeInfos)
+		search_for_version(Info, Params, ModuleInfo, Request,
+			Args0, Versions, Match0, Match)
 	).
 
 	% Check whether the request has already been implemented by 
 	% the new_pred, maybe ordering the list of extra type_infos
 	% in the caller predicate to match up with those in the caller.
-:- pred version_matches(bool::in, module_info::in, request::in, 
-		new_pred::in, maybe(list(prog_var))::in, list(prog_var)::out)
-		is semidet.
+:- pred version_matches(ho_params::in, module_info::in, request::in,
+		maybe(pair(list(prog_var), higher_order_info))::in,
+		new_pred::in, match::out) is semidet.
 
-version_matches(TypeInfoLiveness, _ModuleInfo, Request, Version,
-		MaybeExtraTypeInfos, OrderedExtraTypeInfos) :-
+version_matches(Params, ModuleInfo, Request, MaybeArgs0, Version,
+		match(Version, PartialMatch, Args)) :-
 
-	Request = request(_, _, _, _, RequestHigherOrderArgs, CallArgTypes,
-		ExtraTypeInfoTypes, RequestTVarSet), 
+	Request = request(_, Callee, _, _, RequestHigherOrderArgs,
+		CallArgTypes, _, RequestTVarSet, _), 
 	Version = new_pred(_, _, _, _, VersionHigherOrderArgs, _, _,
-		VersionArgTypes0, VersionExtraTypeInfoTypes0, VersionTVarSet),
+		VersionArgTypes0, VersionExtraTypeInfoTypes,
+		VersionTVarSet, VersionIsUserSpec),
 
 	higher_order_args_match(RequestHigherOrderArgs,
-		VersionHigherOrderArgs),
+		VersionHigherOrderArgs, HigherOrderArgs, MatchIsPartial),
+
+	( MatchIsPartial = yes ->
+		list__length(HigherOrderArgs, NumHOArgs),
+		PartialMatch = yes(NumHOArgs)
+	;
+		PartialMatch = no
+	),
+
+	Params = ho_params(_, TypeSpec, _, _, TypeInfoLiveness),
+
+	Callee = proc(CalleePredId, _),
+	module_info_pred_info(ModuleInfo, CalleePredId, CalleePredInfo),
+	(
+		% Don't accept partial matches unless the predicate is
+		% imported or we are only doing user-guided type
+		% specialization.
+		MatchIsPartial = no
+	;
+		TypeSpec = no	
+	;	
+		pred_info_is_imported(CalleePredInfo)
+	),
 
 	% Rename apart type variables.
 	varset__merge_subst(RequestTVarSet, VersionTVarSet, _, TVarSubn),
 	term__apply_substitution_to_list(VersionArgTypes0, TVarSubn,
 		VersionArgTypes),
-	term__apply_substitution_to_list(VersionExtraTypeInfoTypes0,
-		TVarSubn, VersionExtraTypeInfoTypes),
 	type_list_subsumes(VersionArgTypes, CallArgTypes, Subn),
-	( TypeInfoLiveness = yes ->
-		% If typeinfo_liveness is set, the subsumption
-		% must go in both directions, since otherwise
-		% the set of type_infos which need to be passed
-		% might not be the same.
+
+	% If typeinfo_liveness is set, the subsumption must go both ways,
+	% since otherwise a different set of typeinfos may need to be passed.
+	% For user-specified type specializations, it is guaranteed that
+	% no extra typeinfos are required because the substitution supplied
+	% by the user is not allowed to partially instantiate type variables.
+	( TypeInfoLiveness = yes, VersionIsUserSpec = no ->
 		type_list_subsumes(CallArgTypes, VersionArgTypes, _)
 	;
 		true
 	),
-	( TypeInfoLiveness = yes, MaybeExtraTypeInfos = yes(ExtraTypeInfos) ->
-		term__apply_rec_substitution_to_list(
-			VersionExtraTypeInfoTypes,
-			Subn, RenamedVersionTypeInfos),
-		assoc_list__from_corresponding_lists(ExtraTypeInfos,
-			ExtraTypeInfoTypes, ExtraTypeInfoAL),
-		order_typeinfos(Subn, ExtraTypeInfoAL, RenamedVersionTypeInfos,
-			[], OrderedExtraTypeInfos)
+
+	( MaybeArgs0 = yes(Args0 - Info) ->
+		get_extra_arguments(HigherOrderArgs, Args0, Args1),
+
+		% For user-specified type specializations, it is guaranteed
+		% that no extra typeinfos are required because the
+		% substitution supplied by the user is not allowed to
+		% partially instantiate type variables.
+		( VersionIsUserSpec = yes ->
+			Args = Args1
+		;
+			compute_extra_typeinfos(Info, Args1, ExtraTypeInfos,
+				ExtraTypeInfoTypes),
+			term__apply_rec_substitution_to_list(
+				VersionExtraTypeInfoTypes,
+				Subn, RenamedVersionTypeInfos),
+			assoc_list__from_corresponding_lists(ExtraTypeInfos,
+				ExtraTypeInfoTypes, ExtraTypeInfoAL),
+			order_typeinfos(Subn, ExtraTypeInfoAL,
+				RenamedVersionTypeInfos,
+				[], OrderedExtraTypeInfos),
+			list__append(OrderedExtraTypeInfos, Args1, Args)
+		)
 	;
-		OrderedExtraTypeInfos = []
+		% This happens when called from create_new_preds -- it doesn't
+		% care about the arguments.
+		Args = []
 	).
 
 	% Put the extra typeinfos for --typeinfo-liveness in the correct
@@ -944,16 +1088,56 @@
 	).
 
 :- pred higher_order_args_match(list(higher_order_arg)::in,
-		list(higher_order_arg)::in) is semidet.
+		list(higher_order_arg)::in, list(higher_order_arg)::out,
+		bool::out) is semidet.
 
-higher_order_args_match([], []).
-higher_order_args_match([Arg1 | Args1], [Arg2 | Args2]) :-
-	Arg1 = higher_order_arg(ConsId, ArgNo, NumArgs,
-			_, _, HOCurriedArgs1),
-	Arg2 = higher_order_arg(ConsId, ArgNo, NumArgs,
+higher_order_args_match([], [], [], no).
+higher_order_args_match([_ | _], [], [], yes).
+higher_order_args_match([RequestArg | Args1], [VersionArg | Args2],
+		Args, PartialMatch) :-
+	RequestArg = higher_order_arg(ConsId1, ArgNo1, _, _, _, _),
+	VersionArg = higher_order_arg(ConsId2, ArgNo2, _, _, _, _),
+
+	( ArgNo1 = ArgNo2 ->
+		ConsId1 = ConsId2,
+		RequestArg = higher_order_arg(_, _, NumArgs,
+			CurriedArgs, CurriedArgTypes, HOCurriedArgs1),
+		VersionArg = higher_order_arg(_, _, NumArgs,
 			_, _, HOCurriedArgs2),
-	higher_order_args_match(HOCurriedArgs1, HOCurriedArgs2),
-	higher_order_args_match(Args1, Args2).
+		higher_order_args_match(HOCurriedArgs1, HOCurriedArgs2,
+			NewHOCurriedArgs, PartialMatch),
+		higher_order_args_match(Args1, Args2, Args3, _),
+		NewRequestArg = higher_order_arg(ConsId1, ArgNo1, NumArgs,
+			CurriedArgs, CurriedArgTypes, NewHOCurriedArgs),
+		Args = [NewRequestArg | Args3]
+	;
+		% type-info arguments present in the request may be missing
+		% from the version if we are doing user-guided type
+		% specialization. 
+		% All of the arguments in the version must be
+		% present in the request for a match. 
+		ArgNo1 < ArgNo2,
+
+		% All the higher-order arguments must be present in the
+		% version otherwise we should create a new one.
+		ConsId1 \= pred_const(_, _),
+		PartialMatch = yes,
+		higher_order_args_match(Args1, [VersionArg | Args2], Args, _)
+	).
+
+	% Add the curried arguments of the higher-order terms to the
+	% argument list. The order here must match that generated by
+	% construct_higher_order_terms.
+:- pred get_extra_arguments(list(higher_order_arg)::in,
+		list(prog_var)::in, list(prog_var)::out) is det.
+
+get_extra_arguments([], Args, Args).
+get_extra_arguments([HOArg | HOArgs], Args0, Args) :-
+	HOArg = higher_order_arg(_, _, _,
+		CurriedArgs0, _, HOCurriedArgs),
+	get_extra_arguments(HOCurriedArgs, CurriedArgs0, CurriedArgs),
+	list__append(Args0, CurriedArgs, Args1),
+	get_extra_arguments(HOArgs, Args1, Args).
 
 		% if the right argument of an assignment is a higher order
 		% term with a known value, we need to add an entry for
@@ -1099,22 +1283,22 @@
 	set(request)::in, goal_sizes::in, list(request)::out) is det.
 
 filter_requests(Params, ModuleInfo, Requests0, GoalSizes, Requests) :-
-	Params = ho_params(_, _, MaxSize),
 	set__to_sorted_list(Requests0, Requests1),
+	Params = ho_params(_, _, _, MaxSize, _),
 	list__filter(lambda([X::in] is semidet, (
-			X = request(_, CalledPredProcId, _, _, _, _, _, _),
-			CalledPredProcId = proc(CalledPredId,
-				CalledProcId),
+			X = request(_, CalledPredProcId, _, _, _,
+				_, _, _, IsUserTypeSpec),
+			CalledPredProcId = proc(CalledPredId, _),
 			module_info_pred_info(ModuleInfo,
 				CalledPredId, PredInfo),
-			\+ pred_info_is_imported(PredInfo),
-			\+ (
-				pred_info_is_pseudo_imported(PredInfo),
-				hlds_pred__in_in_unification_proc_id(
-					CalledProcId)
+			(
+				% Ignore the size limit for user
+				% specified specializations.
+				IsUserTypeSpec = yes
+			;
+				map__search(GoalSizes, CalledPredId, GoalSize),
+				GoalSize =< MaxSize
 			),
-			map__search(GoalSizes, CalledPredId, GoalSize),
-			GoalSize =< MaxSize,
 			pred_info_name(PredInfo, PredName),
 			\+ (
 				% There are probably cleaner ways to check 
@@ -1128,38 +1312,36 @@
 		)),
 		Requests1, Requests).
 
-:- pred create_new_preds(list(request)::in, new_preds::in, new_preds::out,
-		list(new_pred)::in, list(new_pred)::out,
+:- pred create_new_preds(ho_params::in, list(request)::in, new_preds::in,
+		new_preds::out, list(new_pred)::in, list(new_pred)::out,
 		set(pred_proc_id)::in, set(pred_proc_id)::out, int::in,
 		int::out, module_info::in, module_info::out,
 		io__state::di, io__state::uo) is det.
 
-create_new_preds([], NewPreds, NewPreds, NewPredList, NewPredList,
+create_new_preds(_, [], NewPreds, NewPreds, NewPredList, NewPredList,
 		ToFix, ToFix, NextId, NextId, Mod, Mod, IO, IO). 
-create_new_preds([Request | Requests], NewPreds0, NewPreds,
+create_new_preds(Params, [Request | Requests], NewPreds0, NewPreds,
 		NewPredList0, NewPredList, PredsToFix0, PredsToFix,
 		NextHOid0, NextHOid, Module0, Module, IO0, IO)  :-
 	Request = request(CallingPredProcId, CalledPredProcId, _HOArgs,
-			_CallArgs, _, _CallerArgTypes, _ExtraTypeInfoTypes, _),
+		_CallArgs, _, _CallerArgTypes, _ExtraTypeInfoTypes, _, _),
 	set__insert(PredsToFix0, CallingPredProcId, PredsToFix1),
 	(
 		NewPreds0 = new_preds(NewPredMap0, _),
 		map__search(NewPredMap0, CalledPredProcId, SpecVersions0)
 	->
-		globals__io_lookup_bool_option(typeinfo_liveness,
-			TypeInfoLiveness, IO0, IO1),
 		(
 			% check that we aren't redoing the same pred
 			% SpecVersions are pred_proc_ids of the specialized
 			% versions of the current pred.
 			\+ (
 				set__member(Version, SpecVersions0),
-				version_matches(TypeInfoLiveness, Module0,
-					Request, Version, no, _)
+				version_matches(Params, Module0,
+					Request, no, Version, _)
 			)
 		->
 			create_new_pred(Request, NewPred, NextHOid0,
-				NextHOid1, Module0, Module1, IO1, IO2), 
+				NextHOid1, Module0, Module1, IO0, IO2), 
 			add_new_pred(CalledPredProcId, NewPred,
 				NewPreds0, NewPreds1),
 			NewPredList1 = [NewPred | NewPredList0]
@@ -1167,7 +1349,7 @@
 			Module1 = Module0,
 			NewPredList1 = NewPredList0,
 			NewPreds1 = NewPreds0,
-			IO2 = IO1,
+			IO2 = IO0,
 			NextHOid1 = NextHOid0
 		)
 	;
@@ -1176,7 +1358,7 @@
 		add_new_pred(CalledPredProcId, NewPred, NewPreds0, NewPreds1),
 		NewPredList1 = [NewPred | NewPredList0]
 	),
-	create_new_preds(Requests, NewPreds1, NewPreds, NewPredList1,
+	create_new_preds(Params, Requests, NewPreds1, NewPreds, NewPredList1,
 		NewPredList, PredsToFix1, PredsToFix, NextHOid1, NextHOid,
 		Module1, Module, IO2, IO).
 
@@ -1199,7 +1381,8 @@
 create_new_pred(Request, NewPred, NextHOid0, NextHOid,
 		ModuleInfo0, ModuleInfo, IOState0, IOState) :- 
 	Request = request(Caller, CalledPredProc, CallArgs, ExtraTypeInfoArgs,
-			HOArgs, ArgTypes, ExtraTypeInfoTypes, CallerTVarSet),
+			HOArgs, ArgTypes, ExtraTypeInfoTypes,
+			CallerTVarSet, IsUserTypeSpec),
 	CalledPredProc = proc(CalledPred, _),
 	module_info_get_predicate_table(ModuleInfo0, PredTable0),
 	predicate_table_get_preds(PredTable0, Preds0),
@@ -1212,13 +1395,37 @@
 							IOState0, IOState1),
         pred_info_arg_types(PredInfo0, ArgTVarSet, ExistQVars, Types),
 	string__int_to_string(Arity, ArStr),
+
+	( IsUserTypeSpec = yes ->
+		% If this is a user-guided type specialisation, the
+		% new name comes from the name of the requesting predicate.
+		Caller = proc(CallerPredId, CallerProcId),
+		predicate_name(ModuleInfo0, CallerPredId, CallerName),
+		proc_id_to_int(CallerProcId, CallerProcInt),
+		string__int_to_string(CallerProcInt, CallerProcStr),
+		string__append_list([CallerName, "__ho", CallerProcStr],
+			PredName),
+		NextHOid = NextHOid0,
+		% For exported predicates the type specialization must
+		% be exported.
+		% For opt_imported predicates we only want to keep this
+		% version if we do some other useful specialization on it.
+		pred_info_import_status(PredInfo0, Status)
+	;
+		string__int_to_string(NextHOid0, IdStr),
+		NextHOid is NextHOid0 + 1,
+		string__append_list([Name0, "__ho", IdStr], PredName),
+		Status = local
+	),
+	SymName = qualified(PredModule, PredName),
 	(
  		VeryVerbose = yes
 	->
 		prog_out__sym_name_to_string(PredModule, PredModuleString),
+		unqualify_name(SymName, NewName),
 		io__write_strings(["% Specializing calls to `",
 			PredModuleString, ":", Name0, "'/", ArStr,
-			" with higher-order arguments:\n"],
+			" into ", NewName, " with higher-order arguments:\n"],
 			IOState1, IOState2),
 		list__length(Types, ActualArity),
 		NumToDrop is ActualArity - Arity,
@@ -1227,16 +1434,12 @@
 	;
        		IOState = IOState1
        	),
-	string__int_to_string(NextHOid0, IdStr),
-	NextHOid is NextHOid0 + 1,
-	string__append_list([Name0, "__ho", IdStr], PredName),
 	pred_info_typevarset(PredInfo0, TypeVarSet),
 	pred_info_context(PredInfo0, Context),
 	pred_info_get_markers(PredInfo0, MarkerList),
 	pred_info_get_goal_type(PredInfo0, GoalType),
 	pred_info_get_class_context(PredInfo0, ClassContext),
 	pred_info_get_aditi_owner(PredInfo0, Owner),
-	Name = qualified(PredModule, PredName),
 	varset__init(EmptyVarSet),
 	map__init(EmptyVarTypes),
 	map__init(EmptyProofs),
@@ -1245,8 +1448,8 @@
 	% hlds dumps if it's filled in.
 	ClausesInfo = clauses_info(EmptyVarSet, EmptyVarTypes,
 		EmptyVarTypes, [], []),
-	pred_info_init(PredModule, Name, Arity, ArgTVarSet, ExistQVars,
-		Types, true, Context, ClausesInfo, local, MarkerList, GoalType,
+	pred_info_init(PredModule, SymName, Arity, ArgTVarSet, ExistQVars,
+		Types, true, Context, ClausesInfo, Status, MarkerList, GoalType,
 		PredOrFunc, ClassContext, EmptyProofs, Owner, PredInfo1),
 	pred_info_set_typevarset(PredInfo1, TypeVarSet, PredInfo2),
 	pred_info_procedures(PredInfo2, Procs0),
@@ -1254,8 +1457,8 @@
 	predicate_table_insert(PredTable0, PredInfo2, NewPredId, PredTable),
 	module_info_set_predicate_table(ModuleInfo0, PredTable, ModuleInfo),
 	NewPred = new_pred(proc(NewPredId, NewProcId), CalledPredProc, Caller,
-		Name, HOArgs, CallArgs, ExtraTypeInfoArgs, ArgTypes,
-		ExtraTypeInfoTypes, CallerTVarSet).
+		SymName, HOArgs, CallArgs, ExtraTypeInfoArgs, ArgTypes,
+		ExtraTypeInfoTypes, CallerTVarSet, IsUserTypeSpec).
 	
 :- pred output_higher_order_args(module_info::in, int::in,
 	list(higher_order_arg)::in, io__state::di, io__state::uo) is det.
@@ -1275,9 +1478,20 @@
 		io__write_string(Name),
 		io__write_string("'/"),
 		io__write_int(Arity)
+	; { ConsId = base_type_info_const(TypeModule, TypeName, TypeArity) } ->
+		io__write_string(" base_type_info for `"),
+		prog_out__write_sym_name(qualified(TypeModule, TypeName)),
+		io__write_string("'/"),
+		io__write_int(TypeArity)
+	; { ConsId = base_typeclass_info_const(_, ClassId, _, _) } ->
+		io__write_string(" base_typeclass_info for `"),
+		{ ClassId = class_id(ClassName, ClassArity) },
+		prog_out__write_sym_name(ClassName),
+		io__write_string("'/"),
+		io__write_int(ClassArity)
 	;
 		% XXX output the type.
-		io__write_string(" type_info ")
+		io__write_string(" type_info/typeclass_info ")
 	),
 	io__write_string(" with "),
 	io__write_int(NumArgs),
@@ -1329,7 +1543,7 @@
 		ModuleInfo0, ModuleInfo) :-
 	NewPred = new_pred(NewPredProcId, OldPredProcId, Caller, _Name,
 		HOArgs0, CallArgs, ExtraTypeInfoArgs, CallerArgTypes0,
-		ExtraTypeInfoTypes0, _),
+		ExtraTypeInfoTypes0, _, _),
 
 	OldPredProcId = proc(OldPredId, OldProcId),
 	module_info_pred_proc_info(ModuleInfo0, OldPredId, OldProcId,
@@ -1581,8 +1795,8 @@
 	list__append(ArgModes0, CurriedArgModes, ArgModes1),
 	list__append(HeadVars0, NewHeadVars, HeadVars1),
 
-	construct_higher_order_terms(ModuleInfo, HeadVars1, HeadVars, ArgModes1,
-		ArgModes, HOArgs, ProcInfo2, ProcInfo,
+	construct_higher_order_terms(ModuleInfo, HeadVars1, HeadVars,
+		ArgModes1, ArgModes, HOArgs, ProcInfo2, ProcInfo,
 		Renaming2, Renaming, PredVars2, PredVars).
 
 %-----------------------------------------------------------------------------%
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_module.m,v
retrieving revision 1.39
diff -u -r1.39 hlds_module.m
--- hlds_module.m	1998/12/06 23:43:17	1.39
+++ hlds_module.m	1999/02/10 05:01:07
@@ -24,13 +24,13 @@
 
 :- import_module hlds_pred, hlds_data, prog_data, unify_proc, special_pred.
 :- import_module globals, llds, continuation_info.
-:- import_module relation, map, std_util, list, set.
+:- import_module relation, map, std_util, list, set, multi_map.
 
 :- implementation.
 
-:- import_module hlds_out, prog_out, prog_data, prog_util.
+:- import_module hlds_out, prog_out, prog_util.
 :- import_module typecheck, modules.
-:- import_module bool, require, int, string, set, multi_map.
+:- import_module bool, require, int, string.
 
 %-----------------------------------------------------------------------------%
 
@@ -82,10 +82,36 @@
 			hlds_type_defn	% defn of type
 		).
 
-	% Various predicates for manipulating the module_info data structure
 	% map from proc to a list of unused argument numbers.
 :- type unused_arg_info == map(pred_proc_id, list(int)).
 
+	% List of procedures for which there are user-requested type
+	% specializations, and a list of predicates which should be
+	% processed by higher_order.m to ensure the production of those
+	% versions.
+:- type type_spec_info
+	---> type_spec_info(
+		set(pred_proc_id),	% Procedures for which there are
+					% user-requested type specializations.
+		set(pred_id),		% Set of procedures which need to be
+					% processed by higher_order.m to
+					% produce those specialized versions.
+		multi_map(pred_id, pred_id),
+					% Map from predicates for which the
+					% user requested a type specialization
+					% to the list of predicates which must
+					% be processed by higher_order.m to
+					% force the production of those
+					% versions. This is used by
+					% dead_proc_elim.m to avoid creating
+					% versions unnecessarily for versions
+					% in imported modules.
+		multi_map(pred_id, pragma_type)
+					% Type spec pragmas to be placed in
+					% the `.opt' file if a predicate
+					% becomes exported.
+	).
+
         % This field should be set to `do_aditi_compilation' if there
 	% are local Aditi predicates.
 :- type do_aditi_compilation
@@ -94,6 +120,8 @@
 
 %-----------------------------------------------------------------------------%
 
+	% Various predicates for manipulating the module_info data structure
+
 	% Create an empty module_info for a given module name (and the
 	% global options).
 
@@ -265,6 +293,13 @@
 :- pred module_info_set_do_aditi_compilation(module_info, module_info).
 :- mode module_info_set_do_aditi_compilation(in, out) is det.
 
+:- pred module_info_type_spec_info(module_info, type_spec_info).
+:- mode module_info_type_spec_info(in, out) is det.
+
+:- pred module_info_set_type_spec_info(module_info,
+		type_spec_info, module_info).
+:- mode module_info_set_type_spec_info(in, in, out) is det.
+
 %-----------------------------------------------------------------------------%
 
 :- pred module_info_preds(module_info, pred_table).
@@ -449,6 +484,9 @@
 		do_aditi_compilation).
 :- mode module_sub_get_do_aditi_compilation(in, out) is det.
 
+:- pred module_sub_get_type_spec_info(module_sub_info, type_spec_info).
+:- mode module_sub_get_type_spec_info(in, out) is det.
+
 :- pred module_sub_set_c_header_info(module_sub_info, c_header_info,
 	module_sub_info).
 :- mode module_sub_set_c_header_info(in, in, out) is det.
@@ -498,6 +536,10 @@
 :- pred module_sub_set_do_aditi_compilation(module_sub_info, module_sub_info).
 :- mode module_sub_set_do_aditi_compilation(in, out) is det.
 
+:- pred module_sub_set_type_spec_info(module_sub_info,
+		type_spec_info, module_sub_info).
+:- mode module_sub_set_type_spec_info(in, in, out) is det.
+
 :- type module_info
 	--->	module(
 			module_sub_info,
@@ -546,9 +588,12 @@
 			set(module_specifier),
 					% All the imported module specifiers
 					% (used during type checking).
-			do_aditi_compilation
+			do_aditi_compilation,
 					% are there any local Aditi predicates
 					% for which Aditi-RL must be produced.
+			type_spec_info
+					% data used for user-guided type
+					% specialization.
 		).
 
 	% A predicate which creates an empty module
@@ -564,13 +609,21 @@
 	map__init(Ctors),
 	set__init(StratPreds),
 	map__init(UnusedArgInfo),
+
+	set__init(TypeSpecPreds),
+	set__init(TypeSpecForcePreds),
+	map__init(SpecMap),
+	map__init(PragmaMap),
+	TypeSpecInfo = type_spec_info(TypeSpecPreds,
+		TypeSpecForcePreds, SpecMap, PragmaMap),
+
 	map__init(ClassTable),
 	map__init(InstanceTable),
 	map__init(SuperClassTable),
 	set__init(ModuleNames),
 	ModuleSubInfo = module_sub(Name, Globals, [], [], no, 0, 0, [], 
 		[], [], StratPreds, UnusedArgInfo, 0, ModuleNames,
-		no_aditi_compilation),
+		no_aditi_compilation, TypeSpecInfo),
 	ModuleInfo = module(ModuleSubInfo, PredicateTable, Requests,
 		UnifyPredMap, GlobalData, Types, Insts, Modes, Ctors,
 		ClassTable, SuperClassTable, InstanceTable, 0).
@@ -608,6 +661,7 @@
 % O			do_aditi_compilation
 %					% are there any local Aditi predicates
 %					% for which Aditi-RL must be produced.
+% P			type_spec_info
 %		).
 
 %-----------------------------------------------------------------------------%
@@ -615,110 +669,117 @@
 	% Various predicates which access the module_sub_info data structure.
 
 module_sub_get_name(MI0, A) :-
-	MI0 = module_sub(A, _, _, _, _, _, _, _, _, _, _, _, _, _, _).
+	MI0 = module_sub(A, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _).
 
 module_sub_get_globals(MI0, B) :-
-	MI0 = module_sub(_, B, _, _, _, _, _, _, _, _, _, _, _, _, _).
+	MI0 = module_sub(_, B, _, _, _, _, _, _, _, _, _, _, _, _, _, _).
 
 module_sub_get_c_header_info(MI0, C) :-
-	MI0 = module_sub(_, _, C, _, _, _, _, _, _, _, _, _, _, _, _).
+	MI0 = module_sub(_, _, C, _, _, _, _, _, _, _, _, _, _, _, _, _).
 
 module_sub_get_c_body_info(MI0, D) :-
-	MI0 = module_sub(_, _, _, D, _, _, _, _, _, _, _, _, _, _, _).
+	MI0 = module_sub(_, _, _, D, _, _, _, _, _, _, _, _, _, _, _, _).
 
 module_sub_get_maybe_dependency_info(MI0, E) :-
-	MI0 = module_sub(_, _, _, _, E, _, _, _, _, _, _, _, _, _, _).
+	MI0 = module_sub(_, _, _, _, E, _, _, _, _, _, _, _, _, _, _, _).
 
 module_sub_get_num_errors(MI0, F) :-
-	MI0 = module_sub(_, _, _, _, _, F, _, _, _, _, _, _, _, _, _).
+	MI0 = module_sub(_, _, _, _, _, F, _, _, _, _, _, _, _, _, _, _).
 
 module_sub_get_lambda_count(MI0, G) :-
-	MI0 = module_sub(_, _, _, _, _, _, G, _, _, _, _, _, _, _, _).
+	MI0 = module_sub(_, _, _, _, _, _, G, _, _, _, _, _, _, _, _, _).
 
 module_sub_get_pragma_exported_procs(MI0, H) :-
-	MI0 = module_sub(_, _, _, _, _, _, _, H, _, _, _, _, _, _, _).
+	MI0 = module_sub(_, _, _, _, _, _, _, H, _, _, _, _, _, _, _, _).
 
 module_sub_get_base_gen_infos(MI0, I) :-
-	MI0 = module_sub(_, _, _, _, _, _, _, _, I, _, _, _, _, _, _).
+	MI0 = module_sub(_, _, _, _, _, _, _, _, I, _, _, _, _, _, _, _).
 
 module_sub_get_base_gen_layouts(MI0, J) :-
-	MI0 = module_sub(_, _, _, _, _, _, _, _, _, J, _, _, _, _, _).
+	MI0 = module_sub(_, _, _, _, _, _, _, _, _, J, _, _, _, _, _, _).
 
 module_sub_get_stratified_preds(MI0, K) :-
-	MI0 = module_sub(_, _, _, _, _, _, _, _, _, _, K, _, _, _, _).
+	MI0 = module_sub(_, _, _, _, _, _, _, _, _, _, K, _, _, _, _, _).
 
 module_sub_get_unused_arg_info(MI0, L) :-
-	MI0 = module_sub(_, _, _, _, _, _, _, _, _, _, _, L, _, _, _).
+	MI0 = module_sub(_, _, _, _, _, _, _, _, _, _, _, L, _, _, _, _).
 
 module_sub_get_model_non_pragma_count(MI0, M) :-
-	MI0 = module_sub(_, _, _, _, _, _, _, _, _, _, _, _, M, _, _).
+	MI0 = module_sub(_, _, _, _, _, _, _, _, _, _, _, _, M, _, _, _).
 
 module_sub_get_imported_module_specifiers(MI0, N) :-
-	MI0 = module_sub(_, _, _, _, _, _, _, _, _, _, _, _, _, N, _).
+	MI0 = module_sub(_, _, _, _, _, _, _, _, _, _, _, _, _, N, _, _).
 
 module_sub_get_do_aditi_compilation(MI0, O) :-
-	MI0 = module_sub(_, _, _, _, _, _, _, _, _, _, _, _, _, _, O).
+	MI0 = module_sub(_, _, _, _, _, _, _, _, _, _, _, _, _, _, O, _).
+
+module_sub_get_type_spec_info(MI0, P) :-
+	MI0 = module_sub(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, P).
 
 %-----------------------------------------------------------------------------%
 
 	% Various predicates which modify the module_sub_info data structure.
 
 module_sub_set_globals(MI0, B, MI) :-
-	MI0 = module_sub(A, _, C, D, E, F, G, H, I, J, K, L, M, N, O),
-	MI  = module_sub(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O).
+	MI0 = module_sub(A, _, C, D, E, F, G, H, I, J, K, L, M, N, O, P),
+	MI  = module_sub(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P).
 
 module_sub_set_c_header_info(MI0, C, MI) :-
-	MI0 = module_sub(A, B, _, D, E, F, G, H, I, J, K, L, M, N, O),
-	MI  = module_sub(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O).
+	MI0 = module_sub(A, B, _, D, E, F, G, H, I, J, K, L, M, N, O, P),
+	MI  = module_sub(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P).
 
 module_sub_set_c_body_info(MI0, D, MI) :-
-	MI0 = module_sub(A, B, C, _, E, F, G, H, I, J, K, L, M, N, O),
-	MI  = module_sub(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O).
+	MI0 = module_sub(A, B, C, _, E, F, G, H, I, J, K, L, M, N, O, P),
+	MI  = module_sub(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P).
 
 module_sub_set_maybe_dependency_info(MI0, E, MI) :-
-	MI0 = module_sub(A, B, C, D, _, F, G, H, I, J, K, L, M, N, O),
-	MI  = module_sub(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O).
+	MI0 = module_sub(A, B, C, D, _, F, G, H, I, J, K, L, M, N, O, P),
+	MI  = module_sub(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P).
 
 module_sub_set_num_errors(MI0, F, MI) :-
-	MI0 = module_sub(A, B, C, D, E, _, G, H, I, J, K, L, M, N, O),
-	MI  = module_sub(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O).
+	MI0 = module_sub(A, B, C, D, E, _, G, H, I, J, K, L, M, N, O, P),
+	MI  = module_sub(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P).
 
 module_sub_set_lambda_count(MI0, G, MI) :-
-	MI0 = module_sub(A, B, C, D, E, F, _, H, I, J, K, L, M, N, O),
-	MI  = module_sub(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O).
+	MI0 = module_sub(A, B, C, D, E, F, _, H, I, J, K, L, M, N, O, P),
+	MI  = module_sub(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P).
 
 module_sub_set_pragma_exported_procs(MI0, H, MI) :-
-	MI0 = module_sub(A, B, C, D, E, F, G, _, I, J, K, L, M, N, O),
-	MI  = module_sub(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O).
+	MI0 = module_sub(A, B, C, D, E, F, G, _, I, J, K, L, M, N, O, P),
+	MI  = module_sub(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P).
 
 module_sub_set_base_gen_infos(MI0, I, MI) :-
-	MI0 = module_sub(A, B, C, D, E, F, G, H, _, J, K, L, M, N, O),
-	MI  = module_sub(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O).
+	MI0 = module_sub(A, B, C, D, E, F, G, H, _, J, K, L, M, N, O, P),
+	MI  = module_sub(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P).
 
 module_sub_set_base_gen_layouts(MI0, J, MI) :-
-	MI0 = module_sub(A, B, C, D, E, F, G, H, I, _, K, L, M, N, O),
-	MI  = module_sub(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O).
+	MI0 = module_sub(A, B, C, D, E, F, G, H, I, _, K, L, M, N, O, P),
+	MI  = module_sub(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P).
 
 module_sub_set_stratified_preds(MI0, K, MI) :-
-	MI0 = module_sub(A, B, C, D, E, F, G, H, I, J, _, L, M, N, O),
-	MI  = module_sub(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O).
+	MI0 = module_sub(A, B, C, D, E, F, G, H, I, J, _, L, M, N, O, P),
+	MI  = module_sub(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P).
 
 module_sub_set_unused_arg_info(MI0, L, MI) :-
-	MI0 = module_sub(A, B, C, D, E, F, G, H, I, J, K, _, M, N, O),
-	MI  = module_sub(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O).
+	MI0 = module_sub(A, B, C, D, E, F, G, H, I, J, K, _, M, N, O, P),
+	MI  = module_sub(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P).
 
 module_sub_set_model_non_pragma_count(MI0, M, MI) :-
-	MI0 = module_sub(A, B, C, D, E, F, G, H, I, J, K, L, _, N, O),
-	MI  = module_sub(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O).
+	MI0 = module_sub(A, B, C, D, E, F, G, H, I, J, K, L, _, N, O, P),
+	MI  = module_sub(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P).
 
 module_sub_set_imported_module_specifiers(MI0, N, MI) :-
-	MI0 = module_sub(A, B, C, D, E, F, G, H, I, J, K, L, M, _, O),
-	MI  = module_sub(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O).
+	MI0 = module_sub(A, B, C, D, E, F, G, H, I, J, K, L, M, _, O, P),
+	MI  = module_sub(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P).
 
 module_sub_set_do_aditi_compilation(MI0, MI) :-
-	MI0 = module_sub(A, B, C, D, E, F, G, H, I, J, K, L, M, N, _),
+	MI0 = module_sub(A, B, C, D, E, F, G, H, I, J, K, L, M, N, _, P),
 	MI  = module_sub(A, B, C, D, E, F, G, H, I, J, K, L, M, N,
-		do_aditi_compilation).
+		do_aditi_compilation, P).
+
+module_sub_set_type_spec_info(MI0, P, MI) :-
+	MI0 = module_sub(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, _),
+	MI  = module_sub(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P).
 
 %-----------------------------------------------------------------------------%
 
@@ -902,6 +963,10 @@
 	module_info_get_sub_info(MI0, MS0),
 	module_sub_get_imported_module_specifiers(MS0, N).
 
+module_info_type_spec_info(MI0, P) :-
+	module_info_get_sub_info(MI0, MS0),
+	module_sub_get_type_spec_info(MS0, P).
+
 module_info_get_do_aditi_compilation(MI0, O) :-
 	module_info_get_sub_info(MI0, MS0),
 	module_sub_get_do_aditi_compilation(MS0, O).
@@ -981,6 +1046,11 @@
 module_info_set_do_aditi_compilation(MI0, MI) :-
 	module_info_get_sub_info(MI0, MS0),
 	module_sub_set_do_aditi_compilation(MS0, MS),
+	module_info_set_sub_info(MI0, MS, MI).
+
+module_info_set_type_spec_info(MI0, P, MI) :-
+	module_info_get_sub_info(MI0, MS0),
+	module_sub_set_type_spec_info(MS0, P, MS),
 	module_info_set_sub_info(MI0, MS, MI).
 
 %-----------------------------------------------------------------------------%
Index: compiler/intermod.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/intermod.m,v
retrieving revision 1.63
diff -u -r1.63 intermod.m
--- intermod.m	1998/12/06 23:43:25	1.63
+++ intermod.m	1999/02/10 05:01:08
@@ -60,8 +60,8 @@
 
 :- implementation.
 
-:- import_module assoc_list, dir, getopt, int, list, map, require, set.
-:- import_module std_util, string.
+:- import_module assoc_list, dir, getopt, int, list, map, multi_map, require.
+:- import_module set, std_util, string, term, varset.
 
 :- import_module code_util, globals, goal_util, term, varset.
 :- import_module hlds_data, hlds_goal, hlds_pred, hlds_out, inlining, llds.
@@ -167,6 +167,8 @@
 	intermod_info_get_module_info(ModuleInfo0),
 	{ module_info_preds(ModuleInfo0, PredTable0) },
 	{ map__lookup(PredTable0, PredId, PredInfo0) },
+	{ module_info_type_spec_info(ModuleInfo0, TypeSpecInfo) },
+	{ TypeSpecInfo = type_spec_info(_, TypeSpecForcePreds, _, _) },
 	(
 		%
 		% note: we can't include exported_to_submodules predicates
@@ -183,6 +185,9 @@
 			% recreated in the importing module anyway.
 			{ \+ code_util__compiler_generated(PredInfo0) },
 			{ \+ code_util__predinfo_is_builtin(PredInfo0) },
+
+			% These will be recreated in the importing module.
+			{ \+ set__member(PredId, TypeSpecForcePreds) },
 			(
 				{ inlining__is_simple_goal(Goal,
 						InlineThreshold) },
@@ -1010,6 +1015,8 @@
 	{ list__sort(CompareProcId, ProcIds, SortedProcIds) },
 	intermod__write_pred_modes(Procs, qualified(Module, Name),
 					PredOrFunc, SortedProcIds),
+	intermod__write_pragmas(PredInfo),
+	intermod__write_type_spec_pragmas(ModuleInfo, PredId),
 	intermod__write_pred_decls(ModuleInfo, PredIds).
 
 :- pred intermod__write_pred_modes(map(proc_id, proc_info)::in, 
@@ -1048,15 +1055,14 @@
 intermod__write_preds(_, []) --> [].
 intermod__write_preds(ModuleInfo, [PredId | PredIds]) -->
 	{ module_info_pred_info(ModuleInfo, PredId, PredInfo) },
-	{ pred_info_arg_types(PredInfo, ArgTypes) },
-	{ list__length(ArgTypes, Arity) },
 	{ pred_info_module(PredInfo, Module) },
 	{ pred_info_name(PredInfo, Name) },
 	{ SymName = qualified(Module, Name) },
-	{ pred_info_get_markers(PredInfo, Markers) },
-	{ markers_to_marker_list(Markers, MarkerList) },
 	{ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc) },
-	intermod__write_pragmas(SymName, Arity, MarkerList, PredOrFunc),
+	intermod__write_pragmas(PredInfo),
+	% The type specialization pragmas for exported preds should
+	% already be in the interface file.
+
 	{ pred_info_clauses_info(PredInfo, ClausesInfo) },
 	{ ClausesInfo = clauses_info(Varset, _, _VarTypes, HeadVars, Clauses) },
 		% handle pragma c_code(...) separately
@@ -1072,6 +1078,20 @@
 	),
 	intermod__write_preds(ModuleInfo, PredIds).
 
+
+:- pred intermod__write_pragmas(pred_info::in,
+		io__state::di, io__state::uo) is det.
+
+intermod__write_pragmas(PredInfo) -->
+	{ pred_info_module(PredInfo, Module) },
+	{ pred_info_name(PredInfo, Name) },
+	{ pred_info_arity(PredInfo, Arity) },
+	{ SymName = qualified(Module, Name) },
+	{ pred_info_get_markers(PredInfo, Markers) },
+	{ markers_to_marker_list(Markers, MarkerList) },
+	{ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc) },
+	intermod__write_pragmas(SymName, Arity, MarkerList, PredOrFunc).
+
 :- pred intermod__write_pragmas(sym_name::in, int::in, list(marker)::in,
 		pred_or_func::in, io__state::di, io__state::uo) is det.
 
@@ -1085,6 +1105,21 @@
 		[]
 	),
 	intermod__write_pragmas(SymName, Arity, Markers, PredOrFunc).
+
+:- pred intermod__write_type_spec_pragmas(module_info::in, pred_id::in,
+		io__state::di, io__state::uo) is det.
+
+intermod__write_type_spec_pragmas(ModuleInfo, PredId) -->
+	{ module_info_type_spec_info(ModuleInfo,
+		type_spec_info(_, _, _, PragmaMap)) },
+	( { multi_map__search(PragmaMap, PredId, TypeSpecPragmas) } ->
+		{ term__context_init(Context) },
+		list__foldl(lambda([Pragma::in, IO0::di, IO::uo] is det, (
+			mercury_output_item(pragma(Pragma), Context, IO0, IO)
+		)), TypeSpecPragmas)
+	;
+		[]
+	).
 
 	% Is a pragma declaration required in the `.opt' file for
 	% a predicate with the given marker.
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/make_hlds.m,v
retrieving revision 1.281
diff -u -r1.281 make_hlds.m
--- make_hlds.m	1999/02/08 22:42:45	1.281
+++ make_hlds.m	1999/02/10 05:48:06
@@ -387,6 +387,12 @@
 			
 		)
 	;
+		{ Pragma = type_spec(Name, SpecName, Arity, PorF,
+			MaybeModes, TypeSubst, VarSet) },
+		add_pragma_type_spec(Pragma, Name, SpecName, Arity, PorF,
+			MaybeModes, TypeSubst, VarSet,
+			Context, Module0, Module)
+	;
 		% Handle pragma fact_table decls later on (when we process
 		% clauses).
 		{ Pragma = fact_table(_, _, _) },
@@ -750,6 +756,375 @@
 		io__write_string(
 "Internal compiler error: unknown predicate in `pragma unused_args'.\n"),
 		{ module_info_incr_errors(Module0, Module) }
+	).
+
+%-----------------------------------------------------------------------------%
+
+:- pred add_pragma_type_spec(pragma_type, sym_name, sym_name, arity,
+		maybe(pred_or_func), maybe(list(mode)), assoc_list(tvar, type),
+		tvarset, term__context, module_info, module_info,
+		io__state, io__state).
+:- mode add_pragma_type_spec(in, in, in, in, in, in, in,
+		in, in, in, out, di, uo) is det.
+
+add_pragma_type_spec(Pragma, SymName, SpecName, Arity, MaybePredOrFunc,
+		MaybeModes, SpecSubst, VarSet, Context, Module0, Module) -->
+	{ module_info_get_predicate_table(Module0, Preds) },
+	(
+		{ MaybePredOrFunc = yes(PredOrFunc) ->
+			predicate_table_search_pf_sym_arity(Preds,
+				PredOrFunc, SymName, Arity, PredIds)
+		;
+			predicate_table_search_sym_arity(Preds,
+				SymName, Arity, PredIds)
+		}
+	->
+		( { PredIds = [PredId] } ->
+			add_pragma_type_spec_2(Pragma, SymName, SpecName,
+				Arity, SpecSubst, MaybeModes, VarSet, Context,
+				PredId, Module0, Module)
+		;
+			% XXX we should allow the programmer to specify
+			% predicate or function to avoid this problem.
+			% It's difficult to just specialize all matching names
+			% because we've only included a single specialized
+			% name in the interface file.
+			{ Module  = Module0 },
+			io__set_exit_status(1),
+			prog_out__write_context(Context),
+			io__write_string(
+			    "Error: `pragma type_spec' declaration matches\n"),
+			prog_out__write_context(Context),
+			io__write_string(
+			    "  multiple predicates or functions.\n")
+		)
+	;
+		undefined_pred_or_func_error(SymName, Arity, Context,
+			"pragma type_spec declaration"),
+		{ Module = Module0 }
+	).
+
+:- pred add_pragma_type_spec_2(pragma_type, sym_name, sym_name, arity,
+	assoc_list(tvar, type), maybe(list(mode)), tvarset,
+	prog_context, pred_id, module_info, module_info, io__state, io__state).
+:- mode add_pragma_type_spec_2(in, in, in, in, in, in, in, in,
+	in, in, out, di, uo) is det.
+
+add_pragma_type_spec_2(Pragma, SymName, SpecName, Arity,
+		Subst, MaybeModes, TVarSet0, Context, PredId,
+		ModuleInfo0, ModuleInfo) -->
+	{ module_info_pred_info(ModuleInfo0, PredId, PredInfo0) },
+	handle_pragma_type_spec_subst(Context, Subst, TVarSet0, PredInfo0,
+		TVarSet, Types, ExistQVars, ClassContext, SubstOk,
+		ModuleInfo0, ModuleInfo1),
+	( { SubstOk = yes } ->
+	    { pred_info_procedures(PredInfo0, Procs0) },
+	    handle_pragma_type_spec_modes(SymName, Arity, Context,
+	    	MaybeModes, ProcIds, Procs0, Procs, ModesOk,
+		ModuleInfo1, ModuleInfo2),
+	    globals__io_lookup_bool_option(user_guided_type_specialization,
+	    	DoTypeSpec),
+	    {
+		ModesOk = yes,
+		% Even if we aren't doing type specialization, we need
+		% to create the interface procedures for local predicates
+		% to check the type-class correctness of the requested
+		% specializations.
+		( DoTypeSpec = yes
+	    	; \+ pred_info_is_imported(PredInfo0)
+	    	)
+	    ->
+		%
+		% Build a clause to call the old predicate with the
+		% specified types to force the specialization. For imported
+		% predicates this forces the creation of the proper interface. 
+		%
+		varset__init(ArgVarSet0),
+		varset__new_vars(ArgVarSet0, Arity, Args, ArgVarSet),
+		map__from_corresponding_lists(Args, Types, VarTypes0),
+		goal_info_init(GoalInfo0),
+		set__list_to_set(Args, NonLocals),
+		goal_info_set_nonlocals(GoalInfo0, NonLocals, GoalInfo1),
+		goal_info_set_context(GoalInfo1, Context, GoalInfo),
+		invalid_proc_id(DummyProcId),
+		Goal = call(PredId, DummyProcId, Args,
+			not_builtin, no, SymName) - GoalInfo,
+		Clause = clause(ProcIds, Goal, Context),
+		Clauses = clauses_info(ArgVarSet, VarTypes0,
+			VarTypes0, Args, [Clause]),
+		pred_info_get_markers(PredInfo0, Markers),
+		map__init(Proofs),
+		( pred_info_is_imported(PredInfo0) ->
+			Status = opt_imported
+		;
+			pred_info_import_status(PredInfo0, Status)
+		),
+
+		pred_info_module(PredInfo0, ModuleName),
+		pred_info_get_aditi_owner(PredInfo0, Owner),
+		pred_info_get_is_pred_or_func(PredInfo0, PredOrFunc),
+		pred_info_init(ModuleName, SpecName, Arity, TVarSet,
+			ExistQVars, Types, true, Context, Clauses,
+			Status, Markers, none, PredOrFunc,
+			ClassContext, Proofs, Owner, NewPredInfo0),
+		pred_info_set_procedures(NewPredInfo0,
+			Procs, NewPredInfo),
+		module_info_get_predicate_table(ModuleInfo2, PredTable0),
+		predicate_table_insert(PredTable0, NewPredInfo,
+			must_be_qualified, NewPredId, PredTable),
+		module_info_set_predicate_table(ModuleInfo2,
+			PredTable, ModuleInfo3),
+
+		%
+		% Record the type specialisation in the module_info.
+		%
+		module_info_type_spec_info(ModuleInfo3, TypeSpecInfo0),
+		TypeSpecInfo0 = type_spec_info(ProcsToSpec0,
+			ForceVersions0, SpecMap0, PragmaMap0),
+		list__map(lambda([ProcId::in, PredProcId::out] is det, (
+				PredProcId = proc(PredId, ProcId)
+			)), ProcIds, PredProcIds),
+		set__insert_list(ProcsToSpec0, PredProcIds, ProcsToSpec),
+		set__insert(ForceVersions0, NewPredId, ForceVersions),
+
+		( Status = opt_imported ->
+			% For imported predicates dead_proc_elim.m needs
+			% to know that if the original predicate is used,
+			% the predicate to force the production of the
+			% specialised interface is also used.
+			multi_map__set(SpecMap0, PredId, NewPredId, SpecMap)
+		;
+			SpecMap = SpecMap0
+		),
+
+		multi_map__set(PragmaMap0, PredId, Pragma, PragmaMap),
+		TypeSpecInfo = type_spec_info(ProcsToSpec,
+			ForceVersions, SpecMap, PragmaMap),
+		module_info_set_type_spec_info(ModuleInfo3,
+			TypeSpecInfo, ModuleInfo)
+	    ;
+	   	ModuleInfo = ModuleInfo2
+	    }
+	;
+	    { ModuleInfo = ModuleInfo1 }
+	).
+
+:- pred handle_pragma_type_spec_subst(prog_context, assoc_list(tvar, type),
+	tvarset, pred_info, tvarset, list(type), existq_tvars,
+	class_constraints, bool, module_info, module_info,
+	io__state, io__state).
+:- mode handle_pragma_type_spec_subst(in, in, in, in, out, out, out, out, out,
+		in, out, di, uo) is det.
+
+handle_pragma_type_spec_subst(Context, Subst, TVarSet0, PredInfo0,
+		TVarSet, Types, ExistQVars, ClassContext, SubstOk,
+		ModuleInfo0, ModuleInfo) -->
+	( { Subst = [] } ->
+	    report_empty_subst(PredInfo0, Context),
+	    { module_info_incr_errors(ModuleInfo0, ModuleInfo) },
+	    { ExistQVars = [] },
+	    { Types = [] },
+	    { ClassContext = constraints([], []) },
+	    { varset__init(TVarSet) },
+	    { SubstOk = no }
+	;
+	    { pred_info_typevarset(PredInfo0, CalledTVarSet) },
+	    { varset__create_name_var_map(TVarSet0, NameVarIndex0) },
+	    { assoc_list__keys(Subst, VarsToSub) },
+	    { list__filter(lambda([Var::in] is semidet, (
+		varset__lookup_name(TVarSet0, Var, VarName),
+		\+ map__contains(NameVarIndex0, VarName)
+	    )), VarsToSub, UnknownVarsToSub) },
+	    ( { UnknownVarsToSub = [] } ->
+		% Check that the substitution makes all types involved
+		% ground. This is not strictly necessary, but handling
+		% this case with --typeinfo-liveness is tricky (to get the
+		% order of any extra typeclass_infos right), and it probably
+		% isn't very useful. If this restriction is removed later,
+		% remember to report an error for recursive substitutions.
+		{ map__init(TVarRenaming0) },
+		{ assoc_list__values(Subst, SubstTypes) },
+		{ list__filter(lambda([SubstType::in] is semidet, (
+			\+ term__is_ground(SubstType)
+		)), SubstTypes, NonGroundTypes) },
+
+		( { NonGroundTypes = [] } ->
+		    { get_new_tvars(VarsToSub, TVarSet0, CalledTVarSet,
+			TVarSet, NameVarIndex0, _,
+			TVarRenaming0, TVarRenaming) },
+
+		    % Check that none of the existentially quantified
+		    % variables were substituted.
+		    { map__apply_to_list(VarsToSub, TVarRenaming,
+				RenamedVars) },
+		    { pred_info_get_exist_quant_tvars(PredInfo0, ExistQVars) },
+		    { list__filter(lambda([RenamedVar::in] is semidet, (
+				list__member(RenamedVar, ExistQVars)
+			)), RenamedVars, SubExistQVars) },
+		    ( { SubExistQVars = [] } ->
+			{
+			map__apply_to_list(VarsToSub, TVarRenaming, 
+				RenamedVarsToSub),
+			map__init(TypeSubst0),
+			assoc_list__from_corresponding_lists(RenamedVarsToSub,
+				SubstTypes, SubAL),
+			list__foldl(
+			    lambda([(TVar - Type)::in, TSubst0::in,
+			    		TSubst::out] is det, (
+				map__set(TSubst0, TVar, Type, TSubst)
+			)), SubAL, TypeSubst0, TypeSubst),
+
+			% Apply the substitution.
+			pred_info_arg_types(PredInfo0, Types0),
+			pred_info_get_class_context(PredInfo0,
+				ClassContext0),
+			term__apply_rec_substitution_to_list(Types0,
+				TypeSubst, Types),
+			apply_rec_subst_to_constraints(TypeSubst,
+				ClassContext0, ClassContext),
+			SubstOk = yes,
+			ModuleInfo = ModuleInfo0
+			}
+		    ;
+			report_subst_existq_tvars(PredInfo0, Context,
+					SubExistQVars),
+			{ module_info_incr_errors(ModuleInfo0, ModuleInfo) },
+			{ Types = [] },
+			{ ClassContext = constraints([], []) },
+			{ SubstOk = no }
+		    )
+		;
+		    report_non_ground_subst(PredInfo0, Context),
+		    { module_info_incr_errors(ModuleInfo0, ModuleInfo) },
+		    { ExistQVars = [] },
+		    { Types = [] },
+		    { ClassContext = constraints([], []) },
+		    { varset__init(TVarSet) },
+		    { SubstOk = no }
+		)
+	    ;	
+		report_unknown_vars_to_subst(PredInfo0, Context,
+		    TVarSet0, UnknownVarsToSub),
+		{ module_info_incr_errors(ModuleInfo0, ModuleInfo) },
+		{ ExistQVars = [] },
+		{ Types = [] },
+		{ ClassContext = constraints([], []) },
+		{ varset__init(TVarSet) },
+		{ SubstOk = no }
+	    )
+	).
+
+:- pred report_empty_subst(pred_info, prog_context,
+		io__state, io__state).
+:- mode report_empty_subst(in, in, di, uo) is det.
+
+report_empty_subst(PredInfo0, Context) -->
+	report_pragma_type_spec(PredInfo0, Context),
+	io__write_string("  error: empty substitution.\n").
+
+:- pred report_subst_existq_tvars(pred_info, prog_context,
+		list(tvar), io__state, io__state).
+:- mode report_subst_existq_tvars(in, in, in, di, uo) is det.
+
+report_subst_existq_tvars(PredInfo0, Context, SubExistQVars) -->
+	report_pragma_type_spec(PredInfo0, Context),
+	prog_out__write_context(Context),
+	io__write_string("  error: the substitution includes the existentially\n"),
+	prog_out__write_context(Context),
+	io__write_string("  quantified type "),
+	{ pred_info_typevarset(PredInfo0, TVarSet) },
+	report_variables(SubExistQVars, TVarSet),
+	io__write_string(".\n").
+
+:- pred report_non_ground_subst(pred_info, prog_context,
+		io__state, io__state).
+:- mode report_non_ground_subst(in, in, di, uo) is det.
+
+report_non_ground_subst(PredInfo0, Context) -->
+	report_pragma_type_spec(PredInfo0, Context),
+	io__write_string("  error: the substitution does not make the\n"),
+	io__nl,
+	prog_out__write_context(Context),
+	io__write_string("  substituted types ground.\n").
+
+:- pred report_unknown_vars_to_subst(pred_info, prog_context, tvarset,
+		list(tvar), io__state, io__state).
+:- mode report_unknown_vars_to_subst(in, in, in, in, di, uo) is det.
+
+report_unknown_vars_to_subst(PredInfo0, Context, TVarSet, RecursiveVars) -->
+	report_pragma_type_spec(PredInfo0, Context),
+	prog_out__write_context(Context),
+	io__write_string("  error: "),
+	report_variables(RecursiveVars, TVarSet),
+	( { RecursiveVars = [_] } ->
+		io__write_string(" does not ")
+	;
+		io__write_string(" do not ")
+	),
+	io__write_string(" occur in the pred declaration.\n").
+
+:- pred report_pragma_type_spec(pred_info, term__context,
+		io__state, io__state).
+:- mode report_pragma_type_spec(in, in, di, uo) is det.
+
+report_pragma_type_spec(PredInfo0, Context) -->
+	{ pred_info_module(PredInfo0, Module) },
+	{ pred_info_name(PredInfo0, Name) },
+	{ pred_info_arity(PredInfo0, Arity) },
+	{ pred_info_get_is_pred_or_func(PredInfo0, PredOrFunc) },
+	prog_out__write_context(Context),
+	io__write_string("In `pragma type_spec(...)' declaration for "),
+	hlds_out__write_call_id(PredOrFunc, qualified(Module, Name)/Arity),
+	io__write_string(":\n").
+
+:- pred report_variables(list(tvar), tvarset, io__state, io__state).
+:- mode report_variables(in, in, di, uo) is det.
+
+report_variables(SubExistQVars, VarSet) -->
+	( { SubExistQVars = [_] } ->
+		io__write_string("variable `")
+	;
+		io__write_string("variables `")
+	),
+	mercury_output_vars(SubExistQVars, VarSet, no),
+	io__write_string("'").
+
+:- pred handle_pragma_type_spec_modes(sym_name, arity,
+		prog_context, maybe(list(mode)), list(proc_id),
+		proc_table, proc_table, bool, module_info, module_info,
+		io__state, io__state).
+:- mode handle_pragma_type_spec_modes(in, in, in, in, out, in, out,
+		out, in, out, di, uo) is det.
+
+handle_pragma_type_spec_modes(SymName, Arity, Context, MaybeModes, ProcIds,
+		Procs0, Procs, ModesOk, ModuleInfo0, ModuleInfo) -->
+	( { MaybeModes = yes(Modes) } ->
+		{ map__to_assoc_list(Procs0, ExistingProcs) },
+		(
+			{ get_procedure_matching_argmodes(ExistingProcs,
+				Modes, ModuleInfo0, ProcId) }
+		->
+			{ map__lookup(Procs0, ProcId, ProcInfo) },
+			{ map__init(Procs1) },
+			{ hlds_pred__initial_proc_id(NewProcId) },
+			{ map__det_insert(Procs1, NewProcId,
+				ProcInfo, Procs) },
+			{ ProcIds = [ProcId] },
+			{ ModesOk = yes },
+			{ ModuleInfo = ModuleInfo0 }
+		;
+			{ ProcIds = [] },
+			{ Procs = Procs0 },
+			{ module_info_incr_errors(ModuleInfo0, ModuleInfo) }, 
+			undefined_mode_error(SymName, Arity, Context,
+				"`:- pragma type_spec(...)' declaration"),
+			{ ModesOk = no }
+		)
+	;
+		{ Procs = Procs0 },
+		{ map__keys(Procs, ProcIds) },
+		{ ModesOk = yes },
+		{ ModuleInfo = ModuleInfo0 }
 	).
 
 %-----------------------------------------------------------------------------%




More information about the developers mailing list