[m-dev.] for review: type specialization (relative) [1]

Simon Taylor stayl at cs.mu.OZ.AU
Tue Apr 20 14:19:41 AEST 1999


--- log0	Tue Apr 20 13:59:48 1999
+++ /home/pgrad/stayl/mercury0/log	Tue Apr 20 14:00:55 1999
@@ -1,24 +1,17 @@
 
-Estimated hours taken: 35
+Estimated hours taken: 60
 
 User-guided type specialization.
 
 compiler/prog_data.m:
-compiler/prog_prog_io_pragma.m:
+compiler/prog_io_pragma.m:
 compiler/modules.m:
 compiler/module_qual.m:
 compiler/mercury_to_mercury.m:
-	Added `pragma type_spec(<predicate>, <type substitution>)'.
+	Handle `:- pragma type_spec'.
 
-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/prog_io_pragma.m:
+	Factor out some common code to parse predicate names with arguments.
 
 compiler/hlds_module.m:
 	Added a field to the module_sub_info to hold information about
@@ -26,7 +19,7 @@
 	and not used by anything after higher_order.m.
 
 compiler/make_hlds.m:
-	For each `pragma type_spec', introduce a new predicate
+	For each `:- pragma type_spec' declaration, 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.
@@ -35,14 +28,81 @@
 	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).
+		map__lookup(map(int, list(int)), int, list(int)) matches
+		map__lookup(map(int, V), int, V).
+	Perform specialization where a typeclass constraint matches a
+	known instance, but the construction of the typeclass_info is
+	done in the calling module.
+	Give slightly more informative progress messages. 
 
 compiler/dead_proc_elim.m:
 	Remove specializations for dead procedures.
 
+compiler/prog_util.m:
+	Change the definition of the `maybe1' and `maybe_functor' types
+	to avoid the need for copying to convert between `maybe1'
+	and `maybe1(generic)'.
+	Changed the interface of `make_pred_name_with_context' to allow
+	creation of predicate names for type specializations which describe
+	the type substitution.
+
+compiler/make_hlds.m:
+compiler/prog_io_pragma.m:
+	Make the specification of pragma declarations in error
+	messages consistent. (There are probably some more to
+	be fixed elsewhere for termination and tabling).
+
+compiler/intermod.m:
+	Write type specialization pragmas for predicates declared
+	in `.opt' files.
+
+compiler/mercury_to_mercury.m:
+	Export `mercury_output_item' for use by intermod.m. 
+
+compiler/options.m:
+	Add an option `--user-guided-type-specialization' enabled
+	with `-O3' or higher.
+
+compiler/handle_options.m:
+	`--type-specialization' implies `--user-guided-type-specialization'.
+
+compiler/hlds_goal.m:
+	Add predicates to construct constants. These are duplicated
+	in several other places, I'll fix that as a separate change.
+
+compiler/type_util.m:
+	Added functions `int_type/0', `string_type/0', `float_type/0'
+	and `char_type/0' which return the builtin types.
+	These are duplicated in several other places,
+	I'll fix that as a separate change.
+
+library/private_builtin.m:
+	Added `instance_constraint_from_typeclass_info/3' to extract
+	the typeclass_infos for a constraint on an instance declaration.
+	This is useful for specializing class method calls.
+	Added `thread_safe' to various `:- pragma c_code's.
+	Added `:- pragma inline' declarations for `builtin_compare_*', which
+	are important for user-guided type specialization. (`builtin_unify_*'
+	are simple enough to go in the `.opt' files automatically).
+
+compiler/polymorphism.m:
+	`instance_constraint_from_typeclass_info/3' does not need type_infos.
+	Add `instance_constraint_from_typeclass_info/3' to the
+	list of `typeclass_info_manipulator's which higher_order.m
+	can interpret.
+
 NEWS:
 doc/reference_manual.texi:
-doc/user_guide.texi:
-	Document the pragmas and new options.
+doc/user_guide.texi
+	Document the new pragma and option.
+
+tests/invalid/Mmakefile:
+tests/invalid/type_spec.m:
+tests/invalid/type_spec.err_exp:
+	Test error reporting for invalid type specializations.
+	
+tests/hard_coded/Mmakefile:
+tests/invalid/type_spec.m:
+tests/invalid/type_spec.exp:
+	Test type specialization.
 

diff --recursive -u ./NEWS /home/pgrad/stayl/mercury0/NEWS
--- ./NEWS	Tue Apr 20 12:01:18 1999
+++ /home/pgrad/stayl/mercury0/NEWS	Wed Apr  7 11:18:37 1999
@@ -90,11 +90,6 @@
   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.
-
 Changes to the Mercury implementation:
 **************************************
 
@@ -138,4 +133,9 @@
   Prolog support from Mercury 0.8, just by including the `bin'
   directories for both versions in their PATH, with the more recent one
   first, of course.
+
+* 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.
 
diff --recursive -u ./compiler/const_prop.m /home/pgrad/stayl/mercury0/compiler/const_prop.m
--- ./compiler/const_prop.m	Thu Apr  1 12:51:23 1999
+++ /home/pgrad/stayl/mercury0/compiler/const_prop.m	Thu Apr  8 12:22:39 1999
@@ -392,16 +392,13 @@
 
 %------------------------------------------------------------------------------%
 
+	% recompute_instmap_delta is run by simplify.m if anything changes,
+	% so the insts are not important here.
 :- pred make_construction(pair(prog_var, inst), cons_id, hlds_goal_expr).
 :- mode make_construction(in, in, out) is det.
 
-make_construction(Var - VarInst, ConsId, Goal) :-
-	RHS = functor(ConsId, []),
-	CInst = bound(unique, [functor(ConsId, [])]),
-	Mode =  (VarInst -> CInst) - (CInst -> CInst),
-	Unification = construct(Var, ConsId, [], []),
-	Context = unify_context(explicit, []),
-	Goal = unify(Var, RHS, Mode, Unification, Context).
+make_construction(Var - _, ConsId, Goal) :-
+	make_const_construction(Var, ConsId, Goal - _).
 
 %------------------------------------------------------------------------------%
diff --recursive -u ./compiler/higher_order.m /home/pgrad/stayl/mercury0/compiler/higher_order.m
--- ./compiler/higher_order.m	Tue Apr 20 12:02:41 1999
+++ /home/pgrad/stayl/mercury0/compiler/higher_order.m	Thu Apr 15 12:17:11 1999
@@ -39,7 +39,7 @@
 :- 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.
+:- import_module special_pred, passes_aux.
 
 :- import_module assoc_list, bool, char, int, list, map, require, set.
 :- import_module std_util, string, varset, term.
@@ -65,25 +65,32 @@
 	{ 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),
+	process_requests(Params, UserRequests, Requests1,
+		GoalSizes1, GoalSizes2, 1, NextHOid,
+		NewPreds0, NewPreds1, ModuleInfo1, ModuleInfo2),
+
+	%
+	% Process all other specialization until no more requests
+	% are generated.
+	%
 	{ get_specialization_requests(Params, PredIds, NewPreds1,
-		Requests0, Requests, GoalSizes2, GoalSizes,
+		Requests1, Requests, GoalSizes2, GoalSizes,
 		ModuleInfo2, ModuleInfo3) },
-	process_requests(Params, Requests, GoalSizes, _, NextHOid, _,
-		NewPreds1, _NewPreds, ModuleInfo3, ModuleInfo4),
+	recursively_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
@@ -91,47 +98,70 @@
 	{ list__foldl(module_info_remove_predicate,
 		UserSpecPredList, ModuleInfo4, ModuleInfo) }.
 
-:- pred process_requests(ho_params::in, set(request)::in, goal_sizes::in,
-	goal_sizes::out, int::in, int::out, new_preds::in, new_preds::out,
-	module_info::in, module_info::out,
+	% Process one lot of requests, returning requests for any
+	% new specializations made possible by the first lot.
+:- pred process_requests(ho_params::in, set(request)::in, set(request)::out,
+	goal_sizes::in, 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, GoalSizes, NextHOid0, NextHOid,
-			NewPreds0, NewPreds, ModuleInfo1, ModuleInfo) -->
-	{ filter_requests(Params, ModuleInfo1,
-		Requests0, GoalSizes0, Requests) },
+process_requests(Params, Requests0, NewRequests,
+		GoalSizes0, GoalSizes, NextHOid0, NextHOid,
+		NewPreds0, NewPreds, ModuleInfo1, ModuleInfo) -->
+	filter_requests(Params, ModuleInfo1, Requests0, GoalSizes0, Requests),
 	(
 		{ Requests = [] }
 	->
 		{ ModuleInfo = ModuleInfo1 },
 		{ NextHOid = NextHOid0 },
 		{ NewPreds = NewPreds0 },
-		{ GoalSizes = GoalSizes0 }
+		{ GoalSizes = GoalSizes0 },
+		{ set__init(NewRequests) }
 	;
 		{ set__init(PredProcsToFix0) },
 		create_new_preds(Params, Requests, NewPreds0, NewPreds1,
 			[], NewPredList, PredProcsToFix0, PredProcsToFix,
-			NextHOid0, NextHOid1, ModuleInfo1, ModuleInfo2),
+			NextHOid0, NextHOid, ModuleInfo1, ModuleInfo2),
 		{ set__to_sorted_list(PredProcsToFix, PredProcs) },
 		{ set__init(NewRequests0) },
 		{ create_specialized_versions(Params, NewPredList,
-			NewPreds1, NewPreds2, NewRequests0, NewRequests,
-			GoalSizes0, GoalSizes1, ModuleInfo2, ModuleInfo3) },
+			NewPreds1, NewPreds, NewRequests0, NewRequests,
+			GoalSizes0, GoalSizes, ModuleInfo2, ModuleInfo3) },
 
-		{ fixup_preds(Params, PredProcs, NewPreds2,
+		{ fixup_preds(Params, PredProcs, NewPreds,
 			ModuleInfo3, ModuleInfo4) },
 		{ NewPredList \= [] ->
 			% The dependencies have changed, so the
 			% dependency graph needs to rebuilt for
 			% inlining to work properly.
 			module_info_clobber_dependency_info(ModuleInfo4,
-				ModuleInfo5)
+				ModuleInfo)
 		;
-			ModuleInfo5 = ModuleInfo4
-		},
-		process_requests(Params, NewRequests, GoalSizes1, GoalSizes,
-			NextHOid1, NextHOid, NewPreds2, NewPreds,
-			ModuleInfo5, ModuleInfo)
+			ModuleInfo = ModuleInfo4
+		}
+	).
+
+	% Process requests until there are no new requests to process.
+:- pred recursively_process_requests(ho_params::in, set(request)::in,
+	goal_sizes::in, 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.
+
+recursively_process_requests(Params, Requests0,
+		GoalSizes0, GoalSizes, NextHOid0, NextHOid,
+		NewPreds0, NewPreds, ModuleInfo0, ModuleInfo) -->
+	( { set__empty(Requests0) } ->
+		{ GoalSizes = GoalSizes0 },
+		{ NextHOid = NextHOid0 },
+		{ NewPreds = NewPreds0 },
+		{ ModuleInfo = ModuleInfo0 }
+	;
+		process_requests(Params, Requests0, NewRequests,
+			GoalSizes0, GoalSizes1, NextHOid0, NextHOid1,
+			NewPreds0, NewPreds1, ModuleInfo0, ModuleInfo1),
+		recursively_process_requests(Params, NewRequests,
+			GoalSizes1, GoalSizes, NextHOid1, NextHOid,
+			NewPreds1, NewPreds, ModuleInfo1, ModuleInfo)
 	).
 
 %-------------------------------------------------------------------------------
@@ -197,8 +227,8 @@
 				% previous iterations
 				% not changed by traverse_goal
 		pred_proc_id,	% pred_proc_id of goal being traversed
-		pred_info,	% not changed by traverse_goal
-		proc_info,	% not changed by traverse_goal
+		pred_info,	% pred_info of goal being traversed
+		proc_info,	% proc_info of goal being traversed
 		module_info,	% not changed by traverse_goal
 		ho_params,
 		changed
@@ -246,8 +276,7 @@
 	;	request		% Need to check other procs
 	;	unchanged.	% Do nothing more for this predicate
 
-%-------------------------------------------------------------------------------
-
+%-----------------------------------------------------------------------------%
 :- 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.
@@ -275,14 +304,14 @@
 		Info0 = info(PredVars0, Requests0, NewPreds, PredProcId,
 			PredInfo0, ProcInfo0, ModuleInfo0, Params, unchanged),
 		traverse_goal_0(Goal0, Goal1, Info0,
-			info(_, Requests1,_,_,_,_,_,_, Changed)),
+		    info(_, Requests1,_,_,PredInfo1,ProcInfo1,_,_, Changed)),
 		goal_size(Goal1, GoalSize),
 		map__set(GoalSizes0, PredId, GoalSize, GoalSizes1),
-		proc_info_set_goal(ProcInfo0, Goal1, ProcInfo1),
+		proc_info_set_goal(ProcInfo1, Goal1, ProcInfo2),
 		(
 			Changed = changed
 		->
-			requantify_proc(ProcInfo1, ProcInfo),
+			requantify_proc(ProcInfo2, ProcInfo),
 			map__det_update(Procs0, ProcId, ProcInfo, Procs1)
 		;
 			Procs1 = Procs0
@@ -291,9 +320,9 @@
 			(Changed = request ; Changed = changed)
 		->
 			traverse_other_procs(Params, PredId, ProcIds,
-				ModuleInfo0, PredInfo0, NewPreds,
+				ModuleInfo0, PredInfo1, PredInfo2, NewPreds,
 				Requests1, Requests2, Procs1, Procs),
-			pred_info_set_procedures(PredInfo0, Procs, PredInfo),
+			pred_info_set_procedures(PredInfo2, Procs, PredInfo),
 			map__det_update(Preds0, PredId, PredInfo, Preds),
 			module_info_set_preds(ModuleInfo0, Preds, ModuleInfo1)
 		;
@@ -310,31 +339,34 @@
 		% 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, new_preds::in, set(request)::in,
+	module_info::in, pred_info::in, pred_info::out,
+	new_preds::in, set(request)::in,
 	set(request)::out, proc_table::in, proc_table::out) is det. 
 
-traverse_other_procs(_Params, _PredId, [], _Module, _PredInfo,
+traverse_other_procs(_Params, _PredId, [], _Module, PredInfo, PredInfo,
 		_, Requests, Requests, Procs, Procs).
 traverse_other_procs(Params, PredId, [ProcId | ProcIds], ModuleInfo,
-		PredInfo0, NewPreds, Requests0, Requests, Procs0, Procs) :-
+		PredInfo0, PredInfo, NewPreds,
+		Requests0, Requests, Procs0, Procs) :-
 	map__init(PredVars0),
 	map__lookup(Procs0, ProcId, ProcInfo0),
 	proc_info_goal(ProcInfo0, Goal0),
 	Info0 = info(PredVars0, Requests0, NewPreds, proc(PredId, ProcId),
 			PredInfo0, ProcInfo0, ModuleInfo, Params, unchanged),
 	traverse_goal_0(Goal0, Goal1, Info0,
-			info(_, Requests1, _,_,_,_,_,_,_)),
-	proc_info_headvars(ProcInfo0, HeadVars),
-	proc_info_varset(ProcInfo0, Varset0),
-	proc_info_vartypes(ProcInfo0, VarTypes0),
+			info(_, Requests1, _,_,PredInfo1,ProcInfo1,_,_,_)),
+	proc_info_headvars(ProcInfo1, HeadVars),
+	proc_info_varset(ProcInfo1, Varset0),
+	proc_info_vartypes(ProcInfo1, VarTypes0),
 	implicitly_quantify_clause_body(HeadVars, Goal1, Varset0, VarTypes0,
 						Goal, Varset, VarTypes, _),
-	proc_info_set_goal(ProcInfo0, Goal, ProcInfo1),
-	proc_info_set_varset(ProcInfo1, Varset, ProcInfo2),
-	proc_info_set_vartypes(ProcInfo2, VarTypes, ProcInfo),
+	proc_info_set_goal(ProcInfo1, Goal, ProcInfo2),
+	proc_info_set_varset(ProcInfo2, Varset, ProcInfo3),
+	proc_info_set_vartypes(ProcInfo3, VarTypes, ProcInfo),
 	map__det_update(Procs0, ProcId, ProcInfo, Procs1),
-	traverse_other_procs(Params, PredId, ProcIds, ModuleInfo, PredInfo0,
-		NewPreds, Requests1, Requests, Procs1, Procs).
+	traverse_other_procs(Params, PredId, ProcIds, ModuleInfo,
+		PredInfo1, PredInfo, NewPreds,
+		Requests1, Requests, Procs1, Procs).
 	
 %-------------------------------------------------------------------------------
 	% Goal traversal
@@ -383,15 +415,17 @@
 
 		% check whether this call could be specialized
 traverse_goal(Goal0, Goal) -->
-	{ Goal0 = higher_order_call(Var, Args, _,_,_,_) - _ }, 
-	maybe_specialize_higher_order_call(Var, no, Args, Goal0, Goal).
+	{ Goal0 = higher_order_call(Var, Args, _,_,_,_) - GoalInfo }, 
+	maybe_specialize_higher_order_call(Var, no, Args, Goal0, Goals),
+	{ conj_list_to_goal(Goals, GoalInfo, Goal) }.
 
 		% class_method_calls are treated similarly to
 		% higher_order_calls.
 traverse_goal(Goal0, Goal) -->
-	{ Goal0 = class_method_call(Var, Method, Args,_,_,_) - _ },
+	{ Goal0 = class_method_call(Var, Method, Args,_,_,_) - GoalInfo },
 	maybe_specialize_higher_order_call(Var, yes(Method), Args,
-		Goal0, Goal).
+		Goal0, Goals),
+	{ conj_list_to_goal(Goals, GoalInfo, Goal) }.
 
 		% check whether this call could be specialized
 traverse_goal(Goal0, Goal) -->
@@ -577,36 +611,33 @@
 
 :- 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, _, _, _),
+is_interesting_cons_id(ho_params(_, _, yes, _, _),
 		type_ctor_info_const(_, _, _)).
-is_interesting_cons_id(ho_params(_, yes, _, _, _),
+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.
 :- pred maybe_specialize_higher_order_call(prog_var::in, maybe(int)::in,
-	list(prog_var)::in, hlds_goal::in, hlds_goal::out, 
+	list(prog_var)::in, hlds_goal::in, list(hlds_goal)::out, 
 	higher_order_info::in, higher_order_info::out) is det.
 
 maybe_specialize_higher_order_call(PredVar, MaybeMethod, Args,
-		Goal0 - GoalInfo, Goal - GoalInfo, Info0, Info) :-
-	Info0 = info(PredVars, _Requests0, _NewPreds, _PredProcId,
-		_CallerPredInfo, _CallerProcInfo, ModuleInfo, _, _),
+		Goal0 - GoalInfo, Goals, Info0, Info) :-
+	Info0 = info(PredVars, Requests0, NewPreds, PredProcId,
+		CallerPredInfo0, CallerProcInfo0, ModuleInfo, Params, Changed),
 		
-	%proc_info_vartypes(CallerProcInfo, VarTypes),
-	%map__lookup(VarTypes, PredVar, PredVarType),
-
 	% We can specialize calls to call/N and class_method_call/N if
 	% the closure or typeclass_info has a known value.
 	(
@@ -645,27 +676,174 @@
 				hlds_class_proc(PredId, ProcId)),
 			list__append(InstanceConstraintArgs, Args, AllArgs)
 		;
-			fail	
+			fail
 		)
 	->
-		module_info_pred_info(ModuleInfo, PredId, PredInfo),
-		pred_info_module(PredInfo, ModuleName),
-		pred_info_name(PredInfo, PredName),
-		code_util__builtin_state(ModuleInfo, PredId, ProcId, Builtin),
-
-		MaybeContext = no,
-		Goal1 = call(PredId, ProcId, AllArgs,
-			Builtin, MaybeContext,
-			qualified(ModuleName, PredName)),
-		higher_order_info_update_changed_status(changed, Info0, Info1),
-		maybe_specialize_call(Goal1 - GoalInfo,
-			Goal - _, Info1, Info)
+		construct_specialized_higher_order_call(ModuleInfo,
+			PredId, ProcId, AllArgs, GoalInfo, Goal, Info0, Info),
+		Goals = [Goal]
+	;
+		% Handle a class method call where we know which instance
+		% is being used, but we haven't seen a construction for
+		% the typeclass_info. This can happen for user-guided
+		% typeclass specialization, because the type-specialized class
+		% constraint is still in the constraint list, so a
+		% typeclass_info is passed in by the caller rather than
+		% being constructed locally.
+		%
+		% The problem is that in importing modules we don't know
+		% which instance declarations are visible in the imported
+		% module, so we don't know which class constraints are
+		% redundant after type specialization.
+		MaybeMethod = yes(Method),
+
+		proc_info_vartypes(CallerProcInfo0, VarTypes),
+		map__lookup(VarTypes, PredVar, TypeClassInfoType),
+		polymorphism__typeclass_info_class_constraint(
+			TypeClassInfoType, ClassConstraint),
+		ClassConstraint = constraint(ClassName, ClassArgs),
+		list__length(ClassArgs, ClassArity),
+		module_info_instances(ModuleInfo, InstanceTable),
+        	map__lookup(InstanceTable, class_id(ClassName, ClassArity),
+			Instances),
+		pred_info_typevarset(CallerPredInfo0, TVarSet0),
+		find_matching_instance_method(Instances, Method,
+			ClassArgs, PredId, ProcId, InstanceConstraints,
+			TVarSet0, TVarSet)
+	->
+		pred_info_set_typevarset(CallerPredInfo0,
+			TVarSet, CallerPredInfo),
+		% Pull out the argument typeclass_infos. 
+		( InstanceConstraints = [] ->
+			ExtraGoals = [],
+			CallerProcInfo = CallerProcInfo0,
+			AllArgs = Args
+		;
+			mercury_private_builtin_module(PrivateBuiltin),
+			module_info_get_predicate_table(ModuleInfo, PredTable),
+			ExtractArgSymName = qualified(PrivateBuiltin,
+				"instance_constraint_from_typeclass_info"),
+			(
+				predicate_table_search_pred_sym_arity(
+					PredTable, ExtractArgSymName,
+					3, [ExtractArgPredId0])
+			->
+				ExtractArgPredId = ExtractArgPredId0
+			;
+				error(
+	"higher_order.m: can't find `instance-constraint_from_typeclass_info'")
+			),
+			hlds_pred__initial_proc_id(ExtractArgProcId),
+			get_arg_typeclass_infos(PredVar, ExtractArgPredId,
+				ExtractArgProcId, ExtractArgSymName,
+				InstanceConstraints, 1,
+				ExtraGoals, ArgTypeClassInfos,
+				CallerProcInfo0, CallerProcInfo),
+			list__append(ArgTypeClassInfos, Args, AllArgs)
+		),
+		Info1 = info(PredVars, Requests0, NewPreds, PredProcId,
+			CallerPredInfo, CallerProcInfo, ModuleInfo,
+			Params, Changed),
+		construct_specialized_higher_order_call(ModuleInfo,
+			PredId, ProcId, AllArgs, GoalInfo, Goal, Info1, Info),
+		list__append(ExtraGoals, [Goal], Goals)
 	;
 		% non-specializable call/N or class_method_call/N
-		Goal = Goal0,
+		Goals = [Goal0 - GoalInfo],
 		Info = Info0
 	).
 
+:- pred find_matching_instance_method(list(hlds_instance_defn)::in, int::in,
+	list(type)::in, pred_id::out, proc_id::out,
+	list(class_constraint)::out, tvarset::in, tvarset::out) is semidet.
+
+find_matching_instance_method([Instance | Instances], MethodNum,
+		ClassTypes, PredId, ProcId, Constraints, TVarSet0, TVarSet) :-
+        (
+		instance_matches(ClassTypes, Instance,
+			Constraints0, TVarSet0, TVarSet1)
+	->
+		TVarSet = TVarSet1,
+		Constraints = Constraints0,
+		Instance = hlds_instance_defn(_, _, _,
+			_, _, yes(ClassInterface), _, _),
+		list__index1_det(ClassInterface, MethodNum,
+			hlds_class_proc(PredId, ProcId))
+	;
+		find_matching_instance_method(Instances, MethodNum,
+			ClassTypes, PredId, ProcId, Constraints,
+			TVarSet0, TVarSet)
+	).
+
+:- pred instance_matches(list(type)::in, hlds_instance_defn::in,
+	list(class_constraint)::out, tvarset::in, tvarset::out) is semidet.
+	
+instance_matches(ClassTypes, Instance, Constraints, TVarSet0, TVarSet) :-
+	Instance = hlds_instance_defn(_, _, Constraints0,
+		InstanceTypes0, _, _, InstanceTVarSet, _),
+	varset__merge_subst(TVarSet0, InstanceTVarSet, TVarSet,
+		RenameSubst),
+	term__apply_substitution_to_list(InstanceTypes0,
+		RenameSubst, InstanceTypes),
+	type_list_subsumes(InstanceTypes, ClassTypes, Subst),
+	apply_subst_to_constraint_list(RenameSubst,
+		Constraints0, Constraints1),
+	apply_rec_subst_to_constraint_list(Subst,
+		Constraints1, Constraints).
+
+	% Build calls to
+	% `private_builtin:instance_constraint_from_typeclass_info/3'
+	% to extract the typeclass_infos for the constraints on an instance.
+	% This simulates the action of `do_call_*_class_method' in
+	% runtime/mercury_ho_call.c.
+:- pred get_arg_typeclass_infos(prog_var::in, pred_id::in, proc_id::in,
+		sym_name::in, list(class_constraint)::in, int::in,
+		list(hlds_goal)::out, list(prog_var)::out,
+		proc_info::in, proc_info::out) is det.
+
+get_arg_typeclass_infos(_, _, _, _, [], _, [], [], ProcInfo, ProcInfo).
+get_arg_typeclass_infos(TypeClassInfoVar, PredId, ProcId, SymName,
+		[InstanceConstraint | InstanceConstraints],
+		ConstraintNum, [ConstraintNumGoal, CallGoal | Goals],
+		[ArgTypeClassInfoVar | Vars], ProcInfo0, ProcInfo) :-
+	polymorphism__build_typeclass_info_type(InstanceConstraint,
+		ArgTypeClassInfoType),
+	proc_info_create_var_from_type(ProcInfo0, ArgTypeClassInfoType,
+		ArgTypeClassInfoVar, ProcInfo1),
+	MaybeContext = no,
+	make_int_const_construction(ConstraintNum, ConstraintNumGoal,
+		ConstraintNumVar, ProcInfo1, ProcInfo2),
+	Args = [TypeClassInfoVar, ConstraintNumVar, ArgTypeClassInfoVar],
+
+	set__list_to_set(Args, NonLocals),
+	instmap_delta_init_reachable(InstMapDelta0),
+	instmap_delta_insert(InstMapDelta0, ArgTypeClassInfoVar,
+		ground(shared, no), InstMapDelta),
+	goal_info_init(NonLocals, InstMapDelta, det, GoalInfo),
+	CallGoal = call(PredId, ProcId, Args, not_builtin,
+		MaybeContext, SymName) - GoalInfo,
+	get_arg_typeclass_infos(TypeClassInfoVar, PredId, ProcId, SymName,
+		InstanceConstraints, ConstraintNum + 1, Goals,
+		Vars, ProcInfo2, ProcInfo).
+
+:- pred construct_specialized_higher_order_call(module_info::in,
+	pred_id::in, proc_id::in, list(prog_var)::in, hlds_goal_info::in,
+	hlds_goal::out, higher_order_info::in, higher_order_info::out) is det.
+
+construct_specialized_higher_order_call(ModuleInfo, PredId, ProcId,
+		AllArgs, GoalInfo, Goal - GoalInfo, Info0, Info) :-
+	module_info_pred_info(ModuleInfo, PredId, PredInfo),
+	pred_info_module(PredInfo, ModuleName),
+	pred_info_name(PredInfo, PredName),
+	SymName = qualified(ModuleName, PredName),
+	code_util__builtin_state(ModuleInfo, PredId, ProcId, Builtin),
+
+	MaybeContext = no,
+	Goal1 = call(PredId, ProcId, AllArgs, Builtin, MaybeContext, SymName),
+	higher_order_info_update_changed_status(changed, Info0, Info1),
+	maybe_specialize_call(Goal1 - GoalInfo,
+		Goal - _, Info1, Info).
+
 		% Process a call to see if it could possibly be specialized.
 :- pred maybe_specialize_call(hlds_goal::in, hlds_goal::out,
 		higher_order_info::in, higher_order_info::out) is det.
@@ -719,13 +897,50 @@
 		find_higher_order_args(Module, CalleeStatus, Args0,
 			CalleeArgTypes, VarTypes, PredVars, 1, [],
 			HigherOrderArgs0),
-		( HigherOrderArgs0 = [] ->
-			Info = Info0,
-			Goal = Goal0
+
+		PredProcId = proc(CallerPredId, _),
+		module_info_type_spec_info(Module,
+			type_spec_info(_, ForceVersions, _, _)),
+		( set__member(CallerPredId, ForceVersions) ->
+			IsUserSpecProc = yes
 		;
+			IsUserSpecProc = no
+		),
+
+		( 
+			(
+				HigherOrderArgs0 = [_ | _]
+			;
+				% We should create these
+				% even if there is no specialization
+				% to avoid link errors.
+				IsUserSpecProc = yes
+			;
+				Params = ho_params(_, _, UserTypeSpec, _, _),
+				UserTypeSpec = yes,
+				map__apply_to_list(Args0, VarTypes, ArgTypes),
+
+				% Check whether any typeclass constraints
+				% now match an instance.
+				pred_info_get_class_context(CalleePredInfo,
+					CalleeClassContext),
+				CalleeClassContext =
+					constraints(CalleeUnivConstraints0, _),
+				pred_info_typevarset(CalleePredInfo,
+					CalleeTVarSet),
+				pred_info_get_exist_quant_tvars(CalleePredInfo,
+					CalleeExistQTVars),	
+				pred_info_typevarset(PredInfo, TVarSet),
+				type_subst_makes_instance_known(
+					Module, CalleeUnivConstraints0,
+					TVarSet, ArgTypes, CalleeTVarSet,
+					CalleeExistQTVars, CalleeArgTypes)
+			)
+		->
 			list__reverse(HigherOrderArgs0, HigherOrderArgs),
 			find_matching_version(Info0, CalledPred, CalledProc,
-				Args0, HigherOrderArgs, FindResult),
+				Args0, HigherOrderArgs, IsUserSpecProc,
+				FindResult),
 			(
 				FindResult = match(match(Match, _, Args)),
 				Match = new_pred(NewPredProcId, _, _,
@@ -754,7 +969,10 @@
 			),
 			Info = info(PredVars, Requests, NewPreds, PredProcId,
 				PredInfo, ProcInfo, Module, Params, Changed)
-		)
+		;
+			Info = Info0,
+			Goal = Goal0
+		)	
 	).
 
 	% Returns a list of the higher-order arguments in a call that have
@@ -817,6 +1035,47 @@
 	find_higher_order_args(ModuleInfo, CalleeStatus, Args, CalleeArgTypes,
 		VarTypes, PredVars, NextArg, HOArgs1, HOArgs).
 
+	% Succeeds if the type substitution for a call makes any of
+	% the class constraints match an instance which was not matched
+	% before.
+:- pred type_subst_makes_instance_known(module_info::in,
+		list(class_constraint)::in, tvarset::in, list(type)::in,
+		tvarset::in, existq_tvars::in, list(type)::in) is semidet.
+
+type_subst_makes_instance_known(ModuleInfo, CalleeUnivConstraints0, TVarSet0,
+		ArgTypes, CalleeTVarSet, CalleeExistQVars, CalleeArgTypes0) :-
+	CalleeUnivConstraints0 \= [],
+	varset__merge_subst(TVarSet0, CalleeTVarSet,
+		TVarSet, TypeRenaming),
+	term__apply_substitution_to_list(CalleeArgTypes0, TypeRenaming,
+		CalleeArgTypes1),
+
+	% Substitute the types in the callee's class constraints. 
+	% Typechecking has already succeeded, so none of the head type
+	% variables will be bound by the substitution.
+	HeadTypeParams = [],
+	inlining__get_type_substitution(CalleeArgTypes1, ArgTypes,
+		HeadTypeParams, CalleeExistQVars, TypeSubn),
+	apply_subst_to_constraint_list(TypeRenaming,
+		CalleeUnivConstraints0, CalleeUnivConstraints1),
+	apply_rec_subst_to_constraint_list(TypeSubn,
+		CalleeUnivConstraints1, CalleeUnivConstraints),
+	assoc_list__from_corresponding_lists(CalleeUnivConstraints0,
+		CalleeUnivConstraints, CalleeUnivConstraintAL),
+
+	% Go through each constraint in turn, checking whether any instances
+	% match which didn't before the substitution was applied.
+	list__member(CalleeUnivConstraint0 - CalleeUnivConstraint,
+		CalleeUnivConstraintAL),
+	CalleeUnivConstraint0 = constraint(ClassName, ConstraintArgs0),
+	list__length(ConstraintArgs0, ClassArity),
+	CalleeUnivConstraint = constraint(_, ConstraintArgs),
+	module_info_instances(ModuleInfo, InstanceTable),
+	map__search(InstanceTable, class_id(ClassName, ClassArity), Instances),
+	list__member(Instance, Instances), 	
+	instance_matches(ConstraintArgs, Instance, _, TVarSet, _),
+	\+ instance_matches(ConstraintArgs0, Instance, _, TVarSet, _).
+
 :- type find_result
 	--->	match(match)
 	; 	request(request)
@@ -834,13 +1093,13 @@
 
 :- pred find_matching_version(higher_order_info::in, 
 	pred_id::in, proc_id::in, list(prog_var)::in,
-	list(higher_order_arg)::in, find_result::out) is det.
+	list(higher_order_arg)::in, bool::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,
-		HigherOrderArgs, Result) :-
+		HigherOrderArgs, IsUserSpecProc, Result) :-
 	Info = info(_, _, NewPreds, Caller,
 		PredInfo, ProcInfo, ModuleInfo, Params, _),
 
@@ -851,16 +1110,6 @@
 	map__apply_to_list(Args0, VarTypes, CallArgTypes),
 	pred_info_typevarset(PredInfo, TVarSet),
 
-	module_info_type_spec_info(ModuleInfo,
-		type_spec_info(_, ForceVersions, _, _)),
-
-	Caller = proc(CallerPredId, _),
-	( set__member(CallerPredId, ForceVersions) ->
-		IsUserSpecProc = yes
-	;
-		IsUserSpecProc = no
-	),
-
 	Request = request(Caller, proc(CalledPred, CalledProc), Args0,
 		ExtraTypeInfos, HigherOrderArgs, CallArgTypes,
 		ExtraTypeInfoTypes, TVarSet, IsUserSpecProc), 
@@ -882,18 +1131,33 @@
 			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)
+			(
+				% This handles the introduced predicates
+				% which call class methods. Without this,
+				% user-specified specialized versions of
+				% class methods won't be called.
+				UserTypeSpec = yes,
+				(
+					pred_info_get_markers(CalledPredInfo,
+						Markers),
+					check_marker(Markers, class_method)
+				;
+					pred_info_name(CalledPredInfo,
+						CalledPredName),
+					string__prefix(CalledPredName,
+						"Introduced_")
+				)
+			;
+				HigherOrder = yes,
+				list__member(HOArg, HigherOrderArgs),
+				HOArg = higher_order_arg(pred_const(_, _),
+					_, _, _, _, _)
+			;
+				TypeSpec = yes
+			)
 		)
 	->
 		Result = request(Request)
@@ -901,6 +1165,10 @@
 		Result = no_request
 	).
 
+	% If `--typeinfo-liveness' is set, specializing type `T' to `list(U)'
+	% requires passing in the type-info for `U'. This predicate
+	% works out which extra variables to pass in given the argument
+	% list for the call.
 :- pred compute_extra_typeinfos(higher_order_info::in, list(prog_var)::in,
 		list(prog_var)::out, list(type)::out) is det.
 
@@ -1176,16 +1444,17 @@
 
 %-------------------------------------------------------------------------------
 
-	% Interpret a call to `type_info_from_typeclass_info' or
-	% `superclass_from_typeclass_info'. Currently they both have
-	% the same definition. This should be kept in sync with
-	% compiler/polymorphism.m, library/private_builtin.m and
-	% runtime/mercury_type_info.h.
+	% Interpret a call to `type_info_from_typeclass_info',
+	% `superclass_from_typeclass_info' or
+	% `instance_constraint_from_typeclass_info'.
+	% This should be kept in sync with compiler/polymorphism.m,
+	% library/private_builtin.m and runtime/mercury_type_info.h.
 :- pred interpret_typeclass_info_manipulator(typeclass_info_manipulator::in,
 	list(prog_var)::in, hlds_goal_expr::in, hlds_goal_expr::out,
 	higher_order_info::in, higher_order_info::out) is det.
 
-interpret_typeclass_info_manipulator(_, Args, Goal0, Goal, Info0, Info) :-
+interpret_typeclass_info_manipulator(Manipulator, Args,
+		Goal0, Goal, Info0, Info) :-
 	Info0 = info(PredVars0, _, _, _, _, _, ModuleInfo, _, _),
 	(
 		Args = [TypeClassInfoVar, IndexVar, TypeInfoVar],
@@ -1193,7 +1462,7 @@
 			constant(_TypeClassInfoConsId, TypeClassInfoArgs)),
 
 		map__search(PredVars0, IndexVar,
-			constant(int_const(Index), [])),
+			constant(int_const(Index0), [])),
 
 		% Extract the number of class constraints on the instance
 		% from the base_typeclass_info.
@@ -1207,9 +1476,21 @@
 		map__lookup(Instances, ClassId, InstanceDefns),
 		list__index1_det(InstanceDefns, InstanceNum, InstanceDefn),
 		InstanceDefn = hlds_instance_defn(_, _, Constraints, _,_,_,_,_),
-		list__length(Constraints, NumConstraints),	
-		TypeInfoIndex is Index + NumConstraints,	
-		list__index1_det(OtherVars, TypeInfoIndex, TypeInfoArg),
+		(
+			Manipulator = type_info_from_typeclass_info,
+			list__length(Constraints, NumConstraints),	
+			Index = Index0 + NumConstraints
+		;
+			Manipulator = superclass_from_typeclass_info,
+			list__length(Constraints, NumConstraints),	
+			% polymorphism.m adds the number of
+			% type_infos to the index.
+			Index = Index0 + NumConstraints
+		;
+			Manipulator = instance_constraint_from_typeclass_info,
+			Index = Index0
+		),
+		list__index1_det(OtherVars, Index, TypeInfoArg),
 		maybe_add_alias(TypeInfoVar, TypeInfoArg, Info0, Info),
 		Uni = assign(TypeInfoVar, TypeInfoArg),
 		in_mode(In),
@@ -1280,37 +1561,69 @@
 		% involving recursively building up lambda expressions
 		% this can create ridiculous numbers of versions.
 :- pred filter_requests(ho_params::in, module_info::in,
-	set(request)::in, goal_sizes::in, list(request)::out) is det.
+	set(request)::in, goal_sizes::in, list(request)::out,
+	io__state::di, io__state::uo) is det.
 
-filter_requests(Params, ModuleInfo, Requests0, GoalSizes, Requests) :-
-	set__to_sorted_list(Requests0, Requests1),
-	Params = ho_params(_, _, _, MaxSize, _),
-	list__filter(lambda([X::in] is semidet, (
-			X = request(_, CalledPredProcId, _, _, _,
-				_, _, _, IsUserTypeSpec),
-			CalledPredProcId = proc(CalledPredId, _),
-			module_info_pred_info(ModuleInfo,
-				CalledPredId, PredInfo),
-			(
-				% Ignore the size limit for user
-				% specified specializations.
-				IsUserTypeSpec = yes
-			;
-				map__search(GoalSizes, CalledPredId, GoalSize),
-				GoalSize =< MaxSize
-			),
-			pred_info_name(PredInfo, PredName),
-			\+ (
+filter_requests(Params, ModuleInfo, Requests0, GoalSizes, Requests) -->
+	{ set__to_sorted_list(Requests0, Requests1) },
+	filter_requests_2(Params, ModuleInfo, Requests1, GoalSizes,
+		[], Requests).
+
+:- pred filter_requests_2(ho_params::in, module_info::in, list(request)::in,
+	goal_sizes::in, list(request)::in, list(request)::out,
+	io__state::di, io__state::uo) is det.
+
+filter_requests_2(_, _, [], _, Requests, Requests) --> [].
+filter_requests_2(Params, ModuleInfo, [Request | Requests0],
+		GoalSizes, FilteredRequests0, FilteredRequests) -->
+	{ Params = ho_params(_, _, _, MaxSize, _) },
+	{ Request = request(_, CalledPredProcId, _, _, HOArgs,
+		_, _, _, IsUserTypeSpec) },
+	{ CalledPredProcId = proc(CalledPredId, _) },
+	{ module_info_pred_info(ModuleInfo, CalledPredId, PredInfo) },
+	globals__io_lookup_bool_option(very_verbose, VeryVerbose),
+	{ pred_info_module(PredInfo, PredModule) },
+	{ pred_info_name(PredInfo, PredName) },
+	{ pred_info_arity(PredInfo, Arity) },
+	{ pred_info_arg_types(PredInfo, Types) },
+	{ list__length(Types, ActualArity) },
+	maybe_write_request(VeryVerbose, ModuleInfo, "% Request for",
+		qualified(PredModule, PredName), Arity, ActualArity,
+		no, HOArgs),
+	(
+		{
+			% Ignore the size limit for user
+			% specified specializations.
+			IsUserTypeSpec = yes
+		;
+			map__search(GoalSizes, CalledPredId, GoalSize),
+			GoalSize =< MaxSize
+		}
+	->
+		(
+			\+ {
 				% There are probably cleaner ways to check 
 				% if this is a specialised version.
-				string__sub_string_search(PredName, 
+				string__sub_string_search(PredName,
 					"__ho", Index),
 				NumIndex is Index + 4,
 				string__index(PredName, NumIndex, Digit),
 				char__is_digit(Digit)
-			)
-		)),
-		Requests1, Requests).
+			}
+		->
+			{ FilteredRequests1 = [Request | FilteredRequests0] }
+		;
+			{ FilteredRequests1 = FilteredRequests0 },
+			maybe_write_string(VeryVerbose,
+			"% Not specializing (recursive specialization):\n")
+		)
+	;
+		{ FilteredRequests1 = FilteredRequests0 },
+		maybe_write_string(VeryVerbose,
+			"% Not specializing (goal too large):\n")
+	),
+	filter_requests_2(Params, ModuleInfo, Requests0, GoalSizes,
+		FilteredRequests1, FilteredRequests).
 
 :- pred create_new_preds(ho_params::in, list(request)::in, new_preds::in,
 		new_preds::out, list(new_pred)::in, list(new_pred)::out,
@@ -1394,7 +1707,6 @@
 	globals__io_lookup_bool_option(very_verbose, VeryVerbose,
 							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
@@ -1417,23 +1729,14 @@
 		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,
-			" into ", NewName, " with higher-order arguments:\n"],
-			IOState1, IOState2),
-		list__length(Types, ActualArity),
-		NumToDrop is ActualArity - Arity,
-		output_higher_order_args(ModuleInfo0, NumToDrop,
-					HOArgs, IOState2, IOState)
-	;
-       		IOState = IOState1
-       	),
+	unqualify_name(SymName, NewName),
+	list__length(Types, ActualArity),
+	maybe_write_request(VeryVerbose, ModuleInfo, "% Specializing",
+		qualified(PredModule, Name0), Arity, ActualArity,
+		yes(NewName), HOArgs, IOState1, IOState),
+
 	pred_info_typevarset(PredInfo0, TypeVarSet),
 	pred_info_context(PredInfo0, Context),
 	pred_info_get_markers(PredInfo0, MarkerList),
@@ -1459,7 +1762,28 @@
 	NewPred = new_pred(proc(NewPredId, NewProcId), CalledPredProc, Caller,
 		SymName, HOArgs, CallArgs, ExtraTypeInfoArgs, ArgTypes,
 		ExtraTypeInfoTypes, CallerTVarSet, IsUserTypeSpec).
-	
+
+:- pred maybe_write_request(bool::in, module_info::in, string::in,
+	sym_name::in, arity::in, arity::in, maybe(string)::in,
+	list(higher_order_arg)::in, io__state::di, io__state::uo) is det.
+
+maybe_write_request(no, _, _, _, _, _, _, _) --> [].
+maybe_write_request(yes, ModuleInfo, Msg, SymName,
+		Arity, ActualArity, MaybeNewName, HOArgs) -->
+	{ prog_out__sym_name_to_string(SymName, OldName) },
+	{ string__int_to_string(Arity, ArStr) },
+	io__write_strings([Msg, " `", OldName, "'/", ArStr]),
+
+	( { MaybeNewName = yes(NewName) } ->
+		io__write_string(" into "),
+		io__write_string(NewName)
+	;
+		[]
+	),
+	io__write_string(" with higher-order arguments:\n"),
+	{ NumToDrop is ActualArity - Arity },
+	output_higher_order_args(ModuleInfo, NumToDrop, HOArgs).
+
 :- pred output_higher_order_args(module_info::in, int::in,
 	list(higher_order_arg)::in, io__state::di, io__state::uo) is det.
 
@@ -1478,8 +1802,8 @@
 		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 `"),
+	; { ConsId = type_ctor_info_const(TypeModule, TypeName, TypeArity) } ->
+		io__write_string(" type_ctor_info for `"),
 		prog_out__write_sym_name(qualified(TypeModule, TypeName)),
 		io__write_string("'/"),
 		io__write_int(TypeArity)
@@ -1515,17 +1839,18 @@
 	set__init(Requests0),
 	Info0 = info(PredVars0, Requests0, NewPreds, PredProcId,
 			PredInfo0, ProcInfo0, ModuleInfo0, Params, unchanged),
-	traverse_goal_0(Goal0, Goal1, Info0, _),
-	proc_info_varset(ProcInfo0, Varset0),
-	proc_info_headvars(ProcInfo0, HeadVars),
-	proc_info_vartypes(ProcInfo0, VarTypes0),
+	traverse_goal_0(Goal0, Goal1, Info0, Info),
+	Info = info(_, _, _, _, PredInfo1, ProcInfo1, _, _, _),
+	proc_info_varset(ProcInfo1, Varset0),
+	proc_info_headvars(ProcInfo1, HeadVars),
+	proc_info_vartypes(ProcInfo1, VarTypes0),
 	implicitly_quantify_clause_body(HeadVars, Goal1, Varset0, VarTypes0,
 					Goal, Varset, VarTypes, _),
-	proc_info_set_goal(ProcInfo0, Goal, ProcInfo1),
 	proc_info_set_varset(ProcInfo1, Varset, ProcInfo2),
-	proc_info_set_vartypes(ProcInfo2, VarTypes, ProcInfo),
+	proc_info_set_vartypes(ProcInfo2, VarTypes, ProcInfo3),
+	proc_info_set_goal(ProcInfo3, Goal, ProcInfo),
 	map__det_update(Procs0, ProcId, ProcInfo, Procs),
-	pred_info_set_procedures(PredInfo0, Procs, PredInfo),
+	pred_info_set_procedures(PredInfo1, Procs, PredInfo),
 	map__det_update(Preds0, PredId, PredInfo, Preds),
 	module_info_set_preds(ModuleInfo0, Preds, ModuleInfo1),
 	fixup_preds(Params, PredProcIds, NewPreds, ModuleInfo1, ModuleInfo).
@@ -1691,28 +2016,28 @@
 	%
 	proc_info_goal(NewProcInfo7, Goal1),
 	HOInfo0 = info(PredVars, Requests0, NewPredMap1, NewPredProcId,
-		NewPredInfo2, NewProcInfo6, ModuleInfo0, Params, unchanged),
+		NewPredInfo3, NewProcInfo7, ModuleInfo0, Params, unchanged),
         traverse_goal_0(Goal1, Goal2, HOInfo0,
-		info(_, Requests1,_,_,_,_,_,_,_)),
+		info(_, Requests1,_,_,NewPredInfo4, NewProcInfo8,_,_,_)),
 	goal_size(Goal2, GoalSize),
 	map__set(GoalSizes0, NewPredId, GoalSize, GoalSizes1),
 
 	%
 	% Requantify and recompute instmap deltas.
 	%
-	proc_info_varset(NewProcInfo7, Varset7),
-	proc_info_vartypes(NewProcInfo7, VarTypes7),
-	implicitly_quantify_clause_body(HeadVars, Goal2, Varset7, VarTypes7,
+	proc_info_varset(NewProcInfo8, Varset8),
+	proc_info_vartypes(NewProcInfo8, VarTypes8),
+	implicitly_quantify_clause_body(HeadVars, Goal2, Varset8, VarTypes8,
 					Goal3, Varset, VarTypes, _),
-	proc_info_get_initial_instmap(NewProcInfo3, ModuleInfo0, InstMap0),
+	proc_info_get_initial_instmap(NewProcInfo8, ModuleInfo0, InstMap0),
 	recompute_instmap_delta(no, Goal3, Goal4, InstMap0,
 		ModuleInfo0, ModuleInfo1),
 
-	proc_info_set_goal(NewProcInfo7, Goal4, NewProcInfo8),
-	proc_info_set_varset(NewProcInfo8, Varset, NewProcInfo9),
-	proc_info_set_vartypes(NewProcInfo9, VarTypes, NewProcInfo),
+	proc_info_set_goal(NewProcInfo8, Goal4, NewProcInfo9),
+	proc_info_set_varset(NewProcInfo9, Varset, NewProcInfo10),
+	proc_info_set_vartypes(NewProcInfo10, VarTypes, NewProcInfo),
 	map__det_insert(NewProcs0, NewProcId, NewProcInfo, NewProcs),
-	pred_info_set_procedures(NewPredInfo3, NewProcs, NewPredInfo),
+	pred_info_set_procedures(NewPredInfo4, NewProcs, NewPredInfo),
 	map__det_update(Preds0, NewPredId, NewPredInfo, Preds),
 	predicate_table_set_preds(PredTable0, Preds, PredTable),
 	module_info_set_predicate_table(ModuleInfo1, PredTable, ModuleInfo2),
diff --recursive -u ./compiler/hlds_goal.m /home/pgrad/stayl/mercury0/compiler/hlds_goal.m
--- ./compiler/hlds_goal.m	Mon Mar 22 19:07:11 1999
+++ /home/pgrad/stayl/mercury0/compiler/hlds_goal.m	Thu Apr  8 12:40:40 1999
@@ -13,7 +13,7 @@
 :- interface.
 
 :- import_module hlds_data, hlds_pred, llds, prog_data, (inst), instmap.
-:- import_module list, set, map, std_util.
+:- import_module char, list, set, map, std_util.
 
 	% Here is how goals are represented
 
@@ -715,12 +715,76 @@
 :- pred goal_list_determinism(list(hlds_goal), determinism).
 :- mode goal_list_determinism(in, out) is det.
 
+	%
+	% Produce a goal to construct a given constant.
+	%
+
+:- pred make_int_const_construction(prog_var, int, hlds_goal).
+:- mode make_int_const_construction(in, in, out) is det.
+
+:- pred make_string_const_construction(prog_var, string, hlds_goal).
+:- mode make_string_const_construction(in, in, out) is det.
+
+:- pred make_float_const_construction(prog_var, float, hlds_goal).
+:- mode make_float_const_construction(in, in, out) is det.
+
+:- pred make_char_const_construction(prog_var, char, hlds_goal).
+:- mode make_char_const_construction(in, in, out) is det.
+
+:- pred make_const_construction(prog_var, cons_id, hlds_goal).
+:- mode make_const_construction(in, in, out) is det.
+
+:- pred make_int_const_construction(int, hlds_goal, prog_var,
+		map(prog_var, type), map(prog_var, type),
+		prog_varset, prog_varset).
+:- mode make_int_const_construction(in, out, out, in, out, in, out) is det.
+
+:- pred make_string_const_construction(string, hlds_goal, prog_var,
+		map(prog_var, type), map(prog_var, type),
+		prog_varset, prog_varset).
+:- mode make_string_const_construction(in, out, out, in, out, in, out) is det.
+
+:- pred make_float_const_construction(float, hlds_goal, prog_var,
+		map(prog_var, type), map(prog_var, type),
+		prog_varset, prog_varset).
+:- mode make_float_const_construction(in, out, out, in, out, in, out) is det.
+
+:- pred make_char_const_construction(char, hlds_goal, prog_var,
+		map(prog_var, type), map(prog_var, type),
+		prog_varset, prog_varset).
+:- mode make_char_const_construction(in, out, out, in, out, in, out) is det.
+
+:- pred make_const_construction(cons_id, (type), hlds_goal, prog_var,
+		map(prog_var, type), map(prog_var, type),
+		prog_varset, prog_varset).
+:- mode make_const_construction(in, in, out, out, in, out, in, out) is det.
+
+:- pred make_int_const_construction(int, hlds_goal, prog_var,
+		proc_info, proc_info).
+:- mode make_int_const_construction(in, out, out, in, out) is det.
+
+:- pred make_string_const_construction(string, hlds_goal, prog_var,
+		proc_info, proc_info).
+:- mode make_string_const_construction(in, out, out, in, out) is det.
+
+:- pred make_float_const_construction(float, hlds_goal, prog_var,
+		proc_info, proc_info).
+:- mode make_float_const_construction(in, out, out, in, out) is det.
+
+:- pred make_char_const_construction(char, hlds_goal, prog_var,
+		proc_info, proc_info).
+:- mode make_char_const_construction(in, out, out, in, out) is det.
+
+:- pred make_const_construction(cons_id, (type), hlds_goal, prog_var,
+		proc_info, proc_info).
+:- mode make_const_construction(in, in, out, out, in, out) is det.
+
 %-----------------------------------------------------------------------------%
 
 :- implementation.
 
-:- import_module det_analysis, term.
-:- import_module require.
+:- import_module det_analysis, type_util.
+:- import_module require, string, term, varset.
 
 goal_info_init(GoalInfo) :-
 	Detism = erroneous,
@@ -1031,6 +1095,83 @@
                        det_conjunction_detism(Det0, Det1, Det)
                )),
        list__foldl(ComputeDeterminism, Goals, det, Determinism).
+
+%-----------------------------------------------------------------------------%
+
+make_int_const_construction(Int, Goal, Var, ProcInfo0, ProcInfo) :-
+	proc_info_create_var_from_type(ProcInfo0, int_type, Var, ProcInfo),
+	make_int_const_construction(Var, Int, Goal).
+
+make_string_const_construction(String, Goal, Var, ProcInfo0, ProcInfo) :-
+	proc_info_create_var_from_type(ProcInfo0, string_type, Var, ProcInfo),
+	make_string_const_construction(Var, String, Goal).
+
+make_float_const_construction(Float, Goal, Var, ProcInfo0, ProcInfo) :-
+	proc_info_create_var_from_type(ProcInfo0, float_type, Var, ProcInfo),
+	make_float_const_construction(Var, Float, Goal).
+
+make_char_const_construction(Char, Goal, Var, ProcInfo0, ProcInfo) :-
+	proc_info_create_var_from_type(ProcInfo0, char_type, Var, ProcInfo),
+	make_char_const_construction(Var, Char, Goal).
+
+make_const_construction(ConsId, Type, Goal, Var, ProcInfo0, ProcInfo) :-
+	proc_info_create_var_from_type(ProcInfo0, Type, Var, ProcInfo),
+	make_const_construction(Var, ConsId, Goal).
+
+make_int_const_construction(Int, Goal, Var, VarTypes0, VarTypes,
+		VarSet0, VarSet) :-
+	varset__new_var(VarSet0, Var, VarSet),
+	map__det_insert(VarTypes0, Var, int_type, VarTypes),
+	make_int_const_construction(Var, Int, Goal).
+
+make_string_const_construction(String, Goal, Var, VarTypes0, VarTypes,
+		VarSet0, VarSet) :-
+	varset__new_var(VarSet0, Var, VarSet),
+	map__det_insert(VarTypes0, Var, string_type, VarTypes),
+	make_string_const_construction(Var, String, Goal).
+
+make_float_const_construction(Float, Goal, Var, VarTypes0, VarTypes,
+		VarSet0, VarSet) :-
+	varset__new_var(VarSet0, Var, VarSet),
+	map__det_insert(VarTypes0, Var, float_type, VarTypes),
+	make_float_const_construction(Var, Float, Goal).
+
+make_char_const_construction(Char, Goal, Var, VarTypes0, VarTypes,
+		VarSet0, VarSet) :-
+	varset__new_var(VarSet0, Var, VarSet),
+	map__det_insert(VarTypes0, Var, char_type, VarTypes),
+	make_char_const_construction(Var, Char, Goal).
+
+make_const_construction(ConsId, Type, Goal, Var, VarTypes0, VarTypes,
+		VarSet0, VarSet) :-
+	varset__new_var(VarSet0, Var, VarSet),
+	map__det_insert(VarTypes0, Var, Type, VarTypes),
+	make_const_construction(Var, ConsId, Goal).
+
+make_int_const_construction(Var, Int, Goal) :-
+	make_const_construction(Var, int_const(Int), Goal).
+
+make_string_const_construction(Var, String, Goal) :-
+	make_const_construction(Var, string_const(String), Goal).
+
+make_float_const_construction(Var, Float, Goal) :-
+	make_const_construction(Var, float_const(Float), Goal).
+
+make_char_const_construction(Var, Char, Goal) :-
+	string__char_to_string(Char, String),
+	make_const_construction(Var, cons(unqualified(String), 0), Goal).
+
+make_const_construction(Var, ConsId, Goal - GoalInfo) :-
+	RHS = functor(ConsId, []),
+	Inst = bound(unique, [functor(ConsId, [])]),
+	Mode = (free -> Inst) - (Inst -> Inst),
+	Unification = construct(Var, ConsId, [], []),
+	Context = unify_context(explicit, []),
+	Goal = unify(Var, RHS, Mode, Unification, Context),
+	set__singleton_set(NonLocals, Var),
+	instmap_delta_init_reachable(InstMapDelta0),
+	instmap_delta_insert(InstMapDelta0, Var, Inst, InstMapDelta),
+	goal_info_init(NonLocals, InstMapDelta, det, GoalInfo).
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
diff --recursive -u ./compiler/make_hlds.m /home/pgrad/stayl/mercury0/compiler/make_hlds.m
--- ./compiler/make_hlds.m	Tue Apr 20 12:01:19 1999
+++ /home/pgrad/stayl/mercury0/compiler/make_hlds.m	Tue Mar 30 17:00:44 1999
@@ -401,7 +401,6 @@
 		;
 			add_pragma_unused_args(PredOrFunc, SymName, Arity,
 				ProcId, UnusedArgs, Context, Module0, Module)
-			
 		)
 	;
 		{ Pragma = type_spec(Name, SpecName, Arity, PorF,
@@ -799,31 +798,16 @@
 		;
 			predicate_table_search_sym_arity(Preds,
 				SymName, Arity, PredIds)
-		}
+		},
+		{ 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")
-		)
+		list__foldl2(add_pragma_type_spec_2(Pragma, SymName, SpecName,
+			Arity, SpecSubst, MaybeModes, VarSet, Context),
+			PredIds, Module0, Module)
 	;
 		undefined_pred_or_func_error(SymName, Arity, Context,
-			"pragma type_spec declaration"),
-		{ Module = Module0 }
+			"`:- pragma type_spec' declaration"),
+		{ module_info_incr_errors(Module0, Module) }
 	).
 
 :- pred add_pragma_type_spec_2(pragma_type, sym_name, sym_name, arity,
@@ -931,6 +915,12 @@
 	    { ModuleInfo = ModuleInfo1 }
 	).
 
+	% Check that the type substitution for a `:- pragma type_spec'
+	% declaration is valid.
+	% A type substitution is invalid if:
+	%	- it substitutes unknown type variables
+	% 	- it substitutes existentially quantified type variables
+	% 	- the replacement types are not ground
 :- 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,
@@ -942,16 +932,10 @@
 		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 }
+	    { error("handle_pragma_type_spec_subst: empty substitution") }
 	;
 	    { pred_info_typevarset(PredInfo0, CalledTVarSet) },
-	    { varset__create_name_var_map(TVarSet0, NameVarIndex0) },
+	    { varset__create_name_var_map(CalledTVarSet, NameVarIndex0) },
 	    { assoc_list__keys(Subst, VarsToSub) },
 	    { list__filter(lambda([Var::in] is semidet, (
 		varset__lookup_name(TVarSet0, Var, VarName),
@@ -1010,6 +994,7 @@
 		    ;
 			report_subst_existq_tvars(PredInfo0, Context,
 					SubExistQVars),
+			io__set_exit_status(1),
 			{ module_info_incr_errors(ModuleInfo0, ModuleInfo) },
 			{ Types = [] },
 			{ ClassContext = constraints([], []) },
@@ -1017,7 +1002,13 @@
 		    )
 		;
 		    report_non_ground_subst(PredInfo0, Context),
-		    { module_info_incr_errors(ModuleInfo0, ModuleInfo) },
+		    globals__io_lookup_bool_option(halt_at_warn, Halt),
+		    ( { Halt = yes } ->
+		    	{ module_info_incr_errors(ModuleInfo0, ModuleInfo) },
+			io__set_exit_status(1)
+		    ;	
+		    	{ ModuleInfo = ModuleInfo0 }
+		    ),
 		    { ExistQVars = [] },
 		    { Types = [] },
 		    { ClassContext = constraints([], []) },
@@ -1028,6 +1019,7 @@
 		report_unknown_vars_to_subst(PredInfo0, Context,
 		    TVarSet0, UnknownVarsToSub),
 		{ module_info_incr_errors(ModuleInfo0, ModuleInfo) },
+		io__set_exit_status(1),
 		{ ExistQVars = [] },
 		{ Types = [] },
 		{ ClassContext = constraints([], []) },
@@ -1036,14 +1028,6 @@
 	    )
 	).
 
-:- 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.
@@ -1064,10 +1048,11 @@
 
 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").
+	io__write_string(
+		"  warning: the substitution does not make the substituted\n"),
+	prog_out__write_context(Context),
+	io__write_string("  types ground. The declaration will be ignored.\n").
 
 :- pred report_unknown_vars_to_subst(pred_info, prog_context, tvarset,
 		list(tvar), io__state, io__state).
@@ -1083,7 +1068,17 @@
 	;
 		io__write_string(" do not ")
 	),
-	io__write_string(" occur in the pred declaration.\n").
+	{ pred_info_get_is_pred_or_func(PredInfo0, PredOrFunc) },
+	(
+		{ PredOrFunc = predicate },
+		{ Decl = "`:- pred'" }
+	;
+		{ PredOrFunc = function },
+		{ Decl = "`:- func'" }
+	),
+	io__write_string("occur in the "),
+	io__write_string(Decl),
+	io__write_string(" declaration.\n").
 
 :- pred report_pragma_type_spec(pred_info, term__context,
 		io__state, io__state).
@@ -1095,7 +1090,7 @@
 	{ 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 "),
+	io__write_string("In `:- pragma type_spec' declaration for "),
 	hlds_out__write_call_id(PredOrFunc, qualified(Module, Name)/Arity),
 	io__write_string(":\n").
 
@@ -1111,6 +1106,8 @@
 	mercury_output_vars(SubExistQVars, VarSet, no),
 	io__write_string("'").
 
+	% Check that the mode list for a `:- pragma type_spec' declaration
+	% specifies a known procedure.
 :- 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,
@@ -1139,7 +1136,7 @@
 			{ Procs = Procs0 },
 			{ module_info_incr_errors(ModuleInfo0, ModuleInfo) }, 
 			undefined_mode_error(SymName, Arity, Context,
-				"`:- pragma type_spec(...)' declaration"),
+				"`:- pragma type_spec' declaration"),
 			{ ModesOk = no }
 		)
 	;
@@ -1324,7 +1321,7 @@
 	;
 		prog_out__write_context(Context),
 		io__write_string(
-			"In `:- pragma aditi_index(...)' declaration for `"),
+			"In `:- pragma aditi_index' declaration for `"),
 		hlds_out__write_pred_call_id(Name/Arity),
 		io__write_string("':\n"),
 		prog_out__write_context(Context),
@@ -1349,7 +1346,7 @@
 	;
 		prog_out__write_context(Context),
 		io__write_string(
-			"Error: `:- pragma aditi_index(...)' declaration"),
+			"Error: `:- pragma aditi_index' declaration"),
 		io__nl,
 		prog_out__write_context(Context),
 		io__write_string("  for "),
@@ -1357,7 +1354,7 @@
 		io__write_string(" without preceding\n"),
 		prog_out__write_context(Context),
 		io__write_string(
-			"  `:- pragma base_relation(...)' declaration.\n"),
+			"  `:- pragma base_relation' declaration.\n"),
 		io__set_exit_status(1)
 	),
 
@@ -1374,7 +1371,7 @@
 		% since they're removed by magic.m.
 		prog_out__write_context(Context),
 		io__write_string(
-			"In `:- pragma aditi_index(...)' declaration for "),
+			"In `:- pragma aditi_index' declaration for "),
 		hlds_out__write_call_id(PredOrFunc, Name/Arity),
 		io__write_string(":\n"),
 		prog_out__write_context(Context),
@@ -1419,8 +1416,9 @@
 			Module) }
 	;
 		{ PredIds = [] },
-		{ string__append_list(["`", PragmaName, "' pragma"],
-				      Description) },
+		{ string__append_list(
+			["`:- pragma ", PragmaName, "' declaration"],
+			Description) },
 		undefined_pred_or_func_error(Name, Arity, Context,
 			Description),
 		{ module_info_incr_errors(Module0, Module) }
@@ -1458,7 +1456,7 @@
 		{ module_mark_preds_as_external(PredIdList, Module0, Module) }
 	;
 		undefined_pred_or_func_error(PredName, Arity,
-			Context, "`external' declaration"),
+			Context, "`:- external' declaration"),
 		{ module_info_incr_errors(Module0, Module) }
 	).
 
@@ -3311,8 +3309,8 @@
 			{ ModuleInfo1 = ModuleInfo0 }	
 		;
 			{ module_info_name(ModuleInfo0, ModuleName) },
-			{ string__format("pragma (%s)", [s(EvalMethodS)], 
-				Message1) },
+			{ string__format("`:- pragma %s' declaration",
+				[s(EvalMethodS)], Message1) },
 			maybe_undefined_pred_error(PredName, Arity, 
 				PredOrFunc, Context, Message1),
 			{ preds_add_implicit(ModuleInfo0, PredicateTable0,
@@ -3331,8 +3329,8 @@
 			{ PredIds = PredIds0 }
 		;
 			{ module_info_name(ModuleInfo0, ModuleName) },
-			{ string__format("pragma (%s)", [s(EvalMethodS)], 
-				Message1) },
+			{ string__format("`:- pragma %s' declaration",
+				[s(EvalMethodS)], Message1) },
 			maybe_undefined_pred_error(PredName, Arity, 
 				predicate, Context, Message1),
 			{ preds_add_implicit(ModuleInfo0, PredicateTable0,
@@ -5546,7 +5544,7 @@
 	    )
 	;
 	    undefined_pred_or_func_error(Pred, Arity, Context, 
-	    	"pragma fact_table"),
+	    	"`:- pragma fact_table' declaration"),
 	    { Module = Module0 },
 	    { Info = Info0 }
 	).
diff --recursive -u ./compiler/mercury_to_mercury.m /home/pgrad/stayl/mercury0/compiler/mercury_to_mercury.m
--- ./compiler/mercury_to_mercury.m	Tue Apr 20 12:01:18 1999
+++ /home/pgrad/stayl/mercury0/compiler/mercury_to_mercury.m	Wed Mar 24 14:56:19 1999
@@ -2224,10 +2224,9 @@
 		io__write_int(Arity)
 	),
 
-	io__write_string(", ["),
-	list__foldl(mercury_output_type_subst(VarSet), Subst),
-
-	io__write_string("], "),
+	io__write_string(", ("),
+	io__write_list(Subst, ", ", mercury_output_type_subst(VarSet)),
+	io__write_string("), "),
 	mercury_output_bracketed_sym_name(SpecName, not_next_to_graphic_token),
 	io__write_string(").\n").
 	
@@ -2237,7 +2236,7 @@
 
 mercury_output_type_subst(VarSet, Var - Type) -->
 	mercury_output_var(Var, VarSet, no),
-	io__write_string(" - "),
+	io__write_string(" = "),
 	mercury_output_term(Type, VarSet, no).
 
 %-----------------------------------------------------------------------------%

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



More information about the developers mailing list