for review: type specialization [2]

Simon Taylor stayl at cs.mu.OZ.AU
Thu Apr 15 15:38:14 AEST 1999


Index: compiler/intermod.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/intermod.m,v
retrieving revision 1.63
diff -u -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.292
diff -u -u -r1.292 make_hlds.m
--- make_hlds.m	1999/03/30 05:32:57	1.292
+++ make_hlds.m	1999/03/30 07:00:44
@@ -401,9 +401,14 @@
 		;
 			add_pragma_unused_args(PredOrFunc, SymName, Arity,
 				ProcId, UnusedArgs, Context, Module0, Module)
-			
 		)
 	;
+		{ 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(_, _, _) },
@@ -776,6 +781,373 @@
 
 %-----------------------------------------------------------------------------%
 
+:- 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 \= [] }
+	->
+		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_info_incr_errors(Module0, Module) }
+	).
+
+:- 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 }
+	).
+
+	% 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,
+	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 = [] } ->
+	    { error("handle_pragma_type_spec_subst: empty substitution") }
+	;
+	    { pred_info_typevarset(PredInfo0, CalledTVarSet) },
+	    { 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),
+		\+ 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),
+			io__set_exit_status(1),
+			{ module_info_incr_errors(ModuleInfo0, ModuleInfo) },
+			{ Types = [] },
+			{ ClassContext = constraints([], []) },
+			{ SubstOk = no }
+		    )
+		;
+		    report_non_ground_subst(PredInfo0, Context),
+		    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([], []) },
+		    { varset__init(TVarSet) },
+		    { SubstOk = no }
+		)
+	    ;	
+		report_unknown_vars_to_subst(PredInfo0, Context,
+		    TVarSet0, UnknownVarsToSub),
+		{ module_info_incr_errors(ModuleInfo0, ModuleInfo) },
+		io__set_exit_status(1),
+		{ ExistQVars = [] },
+		{ Types = [] },
+		{ ClassContext = constraints([], []) },
+		{ varset__init(TVarSet) },
+		{ SubstOk = no }
+	    )
+	).
+
+:- 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),
+	prog_out__write_context(Context),
+	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).
+:- 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 ")
+	),
+	{ 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).
+:- 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("'").
+
+	% 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,
+		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 }
+	).
+
+%-----------------------------------------------------------------------------%
+
 :- pred add_pragma_termination_info(pred_or_func, sym_name, list(mode),
 		maybe(arg_size_info), maybe(termination_info),
 		prog_context, module_info, module_info, io__state, io__state).
@@ -949,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),
@@ -974,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 "),
@@ -982,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)
 	),
 
@@ -999,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),
@@ -1044,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) }
@@ -1083,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) }
 	).
 
@@ -2936,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,
@@ -2956,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,
@@ -5171,7 +5544,7 @@
 	    )
 	;
 	    undefined_pred_or_func_error(Pred, Arity, Context, 
-	    	"pragma fact_table"),
+	    	"`:- pragma fact_table' declaration"),
 	    { Module = Module0 },
 	    { Info = Info0 }
 	).
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mercury_compile.m,v
retrieving revision 1.121
diff -u -u -r1.121 mercury_compile.m
--- mercury_compile.m	1999/03/28 07:30:40	1.121
+++ mercury_compile.m	1999/04/14 04:53:52
@@ -1635,14 +1635,15 @@
 
 mercury_compile__maybe_higher_order(HLDS0, Verbose, Stats, HLDS) -->
 	globals__io_lookup_bool_option(optimize_higher_order, HigherOrder),
-	globals__io_lookup_bool_option(type_specialization, Types),
+	% --type-specialization implies --user-guided-type-specialization.
+	globals__io_lookup_bool_option(user_guided_type_specialization, Types),
 
 	( { HigherOrder = yes ; Types = yes } ->
 		maybe_write_string(Verbose,
 		"% Specializing higher-order and polymorphic predicates...\n"),
 		maybe_flush_output(Verbose),
 		
-		specialize_higher_order(HigherOrder, Types, HLDS0, HLDS),
+		specialize_higher_order(HLDS0, HLDS),
 		maybe_write_string(Verbose, "% done.\n"),
 		maybe_report_stats(Stats)
 	;
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.155
diff -u -u -r1.155 mercury_to_mercury.m
--- mercury_to_mercury.m	1999/03/22 08:07:30	1.155
+++ mercury_to_mercury.m	1999/03/24 03:56:19
@@ -32,6 +32,9 @@
 				io__state, io__state).
 :- mode convert_to_mercury(in, in, in, di, uo) is det.
 
+:- pred mercury_output_item(item, prog_context, io__state, io__state).
+:- mode mercury_output_item(in, in, di, uo) is det.
+
 :- pred mercury_output_pred_type(tvarset, existq_tvars, sym_name, list(type),
 		maybe(determinism), purity, class_constraints,
 		prog_context, io__state, io__state).
@@ -205,11 +208,10 @@
 :- implementation.
 
 :- import_module prog_out, prog_util, hlds_pred, hlds_out, instmap.
-:- import_module globals, options, termination, term, varset.
-:- import_module term_io.
+:- import_module globals, options, termination.
 
-:- import_module int, string, set, lexer, require.
-:- import_module char.
+:- import_module assoc_list, char, int, string, set, lexer, require.
+:- import_module term, term_io, varset.
 
 %-----------------------------------------------------------------------------%
 
@@ -256,9 +258,6 @@
 
 %-----------------------------------------------------------------------------%
 
-:- pred mercury_output_item(item, prog_context, io__state, io__state).
-:- mode mercury_output_item(in, in, di, uo) is det.
-
 	% dispatch on the different types of items
 
 mercury_output_item(type_defn(VarSet, TypeDefn, _Cond), Context) -->
@@ -347,6 +346,11 @@
 		{ eval_method_to_string(Type, TypeS) },
 		mercury_output_pragma_decl(Pred, Arity, predicate, TypeS)
 	;
+		{ Pragma = type_spec(PredName, SymName, Arity,
+			MaybePredOrFunc, MaybeModes, Subst, VarSet) },
+		mercury_output_pragma_type_spec(PredName, SymName, Arity,
+			MaybePredOrFunc, MaybeModes, Subst, VarSet)
+	;
 		{ Pragma = inline(Pred, Arity) },
 		mercury_output_pragma_decl(Pred, Arity, predicate, "inline")
 	;
@@ -2178,6 +2182,62 @@
 		io__write_string(", ")
 	),
 	mercury_output_pragma_c_code_vars(Vars, VarSet).
+
+%-----------------------------------------------------------------------------%
+
+:- pred mercury_output_pragma_type_spec(sym_name, sym_name, arity,
+		maybe(pred_or_func), maybe(list(mode)), assoc_list(tvar, type),
+		tvarset, io__state, io__state).
+:- mode mercury_output_pragma_type_spec(in, in, in, in, in,
+		in, in, di, uo) is det.
+
+mercury_output_pragma_type_spec(PredName, SpecName, Arity,
+		MaybePredOrFunc, MaybeModes, Subst, VarSet) -->
+	io__write_string(":- pragma type_spec("),
+	( { MaybeModes = yes(Modes) } ->
+		{ MaybePredOrFunc = yes(PredOrFunc0) ->
+			PredOrFunc = PredOrFunc0
+		;
+			error("pragma type_spec: no pred_or_func")
+		},
+		(
+			{ PredOrFunc = function },
+			{ pred_args_to_func_args(Modes, FuncModes, RetMode) },
+			mercury_output_sym_name(PredName),
+			io__write_string("("),
+			{ varset__init(InstVarSet) },
+			mercury_output_mode_list(FuncModes, InstVarSet),
+			io__write_string(") = "),
+			mercury_output_mode(RetMode, InstVarSet)
+		;
+			{ PredOrFunc = predicate },
+			mercury_output_sym_name(PredName),
+			io__write_string("("),
+			{ varset__init(InstVarSet) },
+			mercury_output_mode_list(Modes, InstVarSet),
+			io__write_string(")")
+		)
+	;
+		mercury_output_bracketed_sym_name(PredName,
+			next_to_graphic_token),
+		io__write_string("/"),
+		io__write_int(Arity)
+	),
+
+	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").
+	
+:- pred mercury_output_type_subst(tvarset, pair(tvar, type),	
+		io__state, io__state).
+:- mode mercury_output_type_subst(in, in, di, uo) is det.
+
+mercury_output_type_subst(VarSet, Var - Type) -->
+	mercury_output_var(Var, VarSet, no),
+	io__write_string(" = "),
+	mercury_output_term(Type, VarSet, no).
 
 %-----------------------------------------------------------------------------%
 
Index: compiler/module_qual.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/module_qual.m,v
retrieving revision 1.43
diff -u -u -r1.43 module_qual.m
--- module_qual.m	1999/02/14 13:02:37	1.43
+++ module_qual.m	1999/03/19 04:03:45
@@ -65,8 +65,9 @@
 
 :- import_module hlds_data, hlds_module, hlds_pred, type_util, prog_out.
 :- import_module prog_util, mercury_to_mercury, modules, globals, options.
-:- import_module (inst), instmap, term, varset.
-:- import_module int, map, require, set, std_util, string.
+:- import_module (inst), instmap.
+:- import_module int, map, require, set, std_util, string, term, varset.
+:- import_module assoc_list.
 
 module_qual__module_qualify_items(Items0, Items, ModuleName, ReportErrors,
 			Info, NumErrors, UndefTypes, UndefModes) -->
@@ -685,6 +686,18 @@
 	qualify_mode_list(Modes0, Modes, Info0, Info).
 qualify_pragma(unused_args(A, B, C, D, E), unused_args(A, B, C, D, E),
 				Info, Info) --> [].
+qualify_pragma(type_spec(A, B, C, D, MaybeModes0, Subst0, G),
+		type_spec(A, B, C, D, MaybeModes, Subst, G), Info0, Info) -->
+	(
+		{ MaybeModes0 = yes(Modes0) }
+	->
+		qualify_mode_list(Modes0, Modes, Info0, Info1),
+		{ MaybeModes = yes(Modes) }
+	;
+		{ Info1 = Info0 },
+		{ MaybeModes = no }
+	),
+	qualify_type_spec_subst(Subst0, Subst, Info1, Info).
 qualify_pragma(fact_table(SymName, Arity, FileName),
 		fact_table(SymName, Arity, FileName), Info, Info) --> [].
 qualify_pragma(aditi(SymName, Arity), aditi(SymName, Arity),
@@ -726,6 +739,16 @@
 		[pragma_var(Var, Name, Mode) | PragmaVars], Info0, Info) -->
 	qualify_mode(Mode0, Mode, Info0, Info1),
 	qualify_pragma_vars(PragmaVars0, PragmaVars, Info1, Info).
+
+:- pred qualify_type_spec_subst(assoc_list(tvar, type)::in,
+		assoc_list(tvar, type)::out, mq_info::in, mq_info::out,
+		io__state::di, io__state::uo) is det.
+
+qualify_type_spec_subst([], [], Info, Info) --> [].
+qualify_type_spec_subst([Var - Type0 |  Subst0], [Var - Type | Subst],
+		Info0, Info) -->
+	qualify_type(Type0, Type, Info0, Info1),
+	qualify_type_spec_subst(Subst0, Subst, Info1, Info).
 
 :- pred qualify_class_constraints(class_constraints::in,
 	class_constraints::out, mq_info::in, mq_info::out, io__state::di,
Index: compiler/modules.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/modules.m,v
retrieving revision 1.96
diff -u -u -r1.96 modules.m
--- modules.m	1999/02/09 00:27:44	1.96
+++ modules.m	1999/02/10 05:48:09
@@ -864,6 +864,7 @@
 pragma_allowed_in_interface(tabled(_, _, _, _, _), no).
 pragma_allowed_in_interface(promise_pure(_, _), no).
 pragma_allowed_in_interface(unused_args(_, _, _, _, _), no).
+pragma_allowed_in_interface(type_spec(_, _, _, _, _, _, _), yes).
 pragma_allowed_in_interface(termination_info(_, _, _, _, _), yes).
 pragma_allowed_in_interface(terminates(_, _), yes).
 pragma_allowed_in_interface(does_not_terminate(_, _), yes).
Index: compiler/options.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/options.m,v
retrieving revision 1.255
diff -u -u -r1.255 options.m
--- options.m	1999/04/05 07:35:17	1.255
+++ options.m	1999/04/15 02:45:48
@@ -232,6 +232,7 @@
 		;	intermod_unused_args
 		;	optimize_higher_order
 		;	type_specialization
+		;	user_guided_type_specialization
 		;	higher_order_size_limit
 		;	optimize_constructor_last_call
 		;	optimize_duplicate_calls
@@ -574,6 +575,7 @@
 	intermod_unused_args	-	bool(no),
 	optimize_higher_order	-	bool(no),
 	type_specialization	-	bool(no),
+	user_guided_type_specialization	-	bool(no),
 	higher_order_size_limit	-	int(20),
 	optimize_constructor_last_call -	bool(no),
 	optimize_dead_procs	-	bool(no),
@@ -904,6 +906,10 @@
 long_option("optimise-higher-order",	optimize_higher_order).
 long_option("type-specialization",	type_specialization).
 long_option("type-specialisation",	type_specialization).
+long_option("user-guided-type-specialization",
+					user_guided_type_specialization).
+long_option("user-guided-type-specialisation",
+					user_guided_type_specialization).
 long_option("higher-order-size-limit",	higher_order_size_limit).
 long_option("optimise-constructor-last-call",	optimize_constructor_last_call).
 long_option("optimize-constructor-last-call",	optimize_constructor_last_call).
@@ -1228,6 +1234,8 @@
 	optimize_saved_vars	-	bool(yes),
 	optimize_unused_args	-	bool(yes),	
 	optimize_higher_order	-	bool(yes),
+	user_guided_type_specialization
+				-	bool(yes),
 	deforestation		-	bool(yes),
 	constant_propagation	-	bool(yes),
 	optimize_repeat		-	int(4)
@@ -1832,10 +1840,10 @@
 
 		"--fact-table-max-array-size <n>",
 		"\tSpecify the maximum number of elements in a single",
-		"\t`pragma fact_table' data array (default: 1024).",
+		"\t`:- pragma fact_table' data array (default: 1024).",
 		"--fact-table-hash-percent-full <percentage>",
-		"\tSpecify how full the `pragma fact_table' hash tables should be",
-		"\tallowed to get.  Given as an integer percentage",
+		"\tSpecify how full the `:- pragma fact_table' hash tables",
+		"\tshould be allowed to get.  Given as an integer percentage",
 		"\t(valid range: 1 to 100, default: 90)."
 	]).
 
@@ -1942,7 +1950,11 @@
 		"--optimize-higher-order",
 		"\tEnable specialization of higher-order predicates.",
 		"--type-specialization",
-		"\tEnable specialization of polymorphic predicates.",
+		"\tEnable specialization of polymorphic predicates where the",
+		"\tpolymorphic types are known.",
+		"--user-guided-type-specialization",
+		"\tEnable specialization of polymorphic predicates for which",
+		"\tthere are `:- pragma type_spec' declarations.",
 		"--higher-order-size-limit",
 		"\tSet the maximum goal size of specialized versions created by",
 		"\t`--optimize-higher-order' and `--type-specialization'.",
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/polymorphism.m,v
retrieving revision 1.162
diff -u -u -r1.162 polymorphism.m
--- polymorphism.m	1999/04/08 08:41:07	1.162
+++ polymorphism.m	1999/04/13 04:35:52
@@ -347,6 +347,11 @@
 :- pred polymorphism__no_type_info_builtin(module_name, string, int).
 :- mode polymorphism__no_type_info_builtin(in, in, out) is semidet.
 
+	% Build the type describing the typeclass_info for the
+	% given class_constraint.
+:- pred polymorphism__build_typeclass_info_type(class_constraint, (type)).
+:- mode polymorphism__build_typeclass_info_type(in, out) is det.
+
 	% From the type of a typeclass_info variable find the class_constraint
 	% about which the variable carries information, failing if the
 	% type is not a valid typeclass_info type.
@@ -370,6 +375,7 @@
 :- type typeclass_info_manipulator
 	--->	type_info_from_typeclass_info
 	;	superclass_from_typeclass_info
+	;	instance_constraint_from_typeclass_info
 	.
 
 	% Look up the pred_id and proc_id for a type specific
@@ -501,6 +507,9 @@
 		"superclass_from_typeclass_info", 3) :-
 	mercury_private_builtin_module(MercuryBuiltin).
 polymorphism__no_type_info_builtin(MercuryBuiltin,
+		"instance_constraint_from_typeclass_info", 3) :-
+	mercury_private_builtin_module(MercuryBuiltin).
+polymorphism__no_type_info_builtin(MercuryBuiltin,
 		"type_info_from_typeclass_info", 3) :-
 	mercury_private_builtin_module(MercuryBuiltin).
 
@@ -2826,9 +2835,6 @@
 	polymorphism__build_typeclass_info_type(Constraint, DictionaryType),
 	map__set(VarTypes0, Var, DictionaryType, VarTypes).
 
-:- pred polymorphism__build_typeclass_info_type(class_constraint, (type)).
-:- mode polymorphism__build_typeclass_info_type(in, out) is det.
-
 polymorphism__build_typeclass_info_type(Constraint, DictionaryType) :-
 	Constraint = constraint(SymName, ArgTypes),
 
@@ -2880,6 +2886,9 @@
 	;
 		PredName = "superclass_from_typeclass_info",
 		TypeClassManipulator = superclass_from_typeclass_info
+	;
+		PredName = "instance_constraint_from_typeclass_info",
+		TypeClassManipulator = instance_constraint_from_typeclass_info
 	).
 
 %---------------------------------------------------------------------------%
Index: compiler/prog_data.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/prog_data.m,v
retrieving revision 1.44
diff -u -u -r1.44 prog_data.m
--- prog_data.m	1999/02/12 03:46:58	1.44
+++ prog_data.m	1999/03/19 04:03:48
@@ -19,7 +19,7 @@
 :- interface.
 
 :- import_module hlds_data, hlds_pred, (inst), purity, rl, term_util.
-:- import_module list, map, varset, term, std_util.
+:- import_module assoc_list, list, map, varset, term, std_util.
 
 %-----------------------------------------------------------------------------%
 
@@ -110,6 +110,13 @@
 			%	whether or not the C code is thread-safe
 			% PredName, Predicate or Function, Vars/Mode, 
 			% VarNames, C Code Implementation Info
+	
+	;	type_spec(sym_name, sym_name, arity, maybe(pred_or_func),
+			maybe(list(mode)), type_subst, tvarset)
+			% PredName, SpecializedPredName, Arity,
+			% PredOrFunc, Modes if a specific procedure was
+			% specified, type substitution (using the variable
+			% names from the pred declaration), TVarSet
 
 	;	inline(sym_name, arity)
 			% Predname, Arity
@@ -214,6 +221,9 @@
 
 	;	check_termination(sym_name, arity).
 			% Predname, Arity
+
+	% The type substitution for a `pragma type_spec' declaration.
+:- type type_subst == assoc_list(tvar, type).
 
 	% This type holds information about the implementation details
 	% of procedures defined via `pragma c_code'.
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.18
diff -u -u -r1.18 prog_io_pragma.m
--- prog_io_pragma.m	1998/12/06 23:44:34	1.18
+++ prog_io_pragma.m	1999/04/15 01:20:16
@@ -22,7 +22,8 @@
 
 :- implementation.
 
-:- import_module prog_io, prog_io_goal, hlds_pred, term_util, term_errors, rl.
+:- import_module prog_io, prog_io_goal, prog_util, hlds_pred.
+:- import_module term_util, term_errors, rl.
 :- import_module int, map, string, std_util, bool, require.
 
 parse_pragma(ModuleName, VarSet, PragmaTerms, Result) :-
@@ -60,12 +61,12 @@
 		Result = ok(pragma(source_file(SourceFile)))
 	    ;
 		Result = error(
-		"string expected in `pragma source_file' declaration",
+		"string expected in `:- pragma source_file' declaration",
 				SourceFileTerm)
 	    )
 	;
 	    Result = error(
-		"wrong number of arguments in `pragma source_file' declaration",
+	"wrong number of arguments in `:- pragma source_file' declaration",
 			ErrorTerm)
 	).
 
@@ -83,7 +84,7 @@
 	    )
 	;
 	    Result = error(
-"wrong number of arguments in `pragma c_header_code(...) declaration", 
+"wrong number of arguments in `:- pragma c_header_code' declaration", 
 			    ErrorTerm)
         ).
 
@@ -210,136 +211,44 @@
 		    ErrorTerm)
 	).
 
-parse_pragma_type(ModuleName, "import", PragmaTerms, ErrorTerm,
-		_VarSet, Result) :-
-       (
-	    PragmaTerms = [PredAndModesTerm, FlagsTerm,
-			C_FunctionTerm]
-       ->
+parse_pragma_type(ModuleName, "import", PragmaTerms,
+			ErrorTerm, _VarSet, Result) :-
+	(
 	    (
-		PredAndModesTerm = term__functor(_, _, _),
-		C_FunctionTerm = term__functor(term__string(C_Function), [], _)
-	    ->
-		(
-		    PredAndModesTerm = term__functor(term__atom("="),
-				[FuncAndArgModesTerm, RetModeTerm], _)
-		->
-		    parse_implicitly_qualified_term(ModuleName,
-		    	FuncAndArgModesTerm, PredAndModesTerm,
-			"pragma import declaration", FuncAndArgModesResult),  
-		    (
-			FuncAndArgModesResult = ok(FuncName, ArgModeTerms),
-			(
-		    	    convert_mode_list(ArgModeTerms, ArgModes),
-			    convert_mode(RetModeTerm, RetMode)
-			->
-			    list__append(ArgModes, [RetMode], Modes),
-			    (
-				parse_pragma_c_code_attributes_term(FlagsTerm,
-					Flags)
-			    ->
-			        Result = ok(pragma(import(FuncName, function,
-				    Modes, Flags, C_Function)))
-			    ;
-				Result = error("invalid second argument in `:- pragma import/3' declaration -- expecting C code attribute or list of attributes'",
-					FlagsTerm)
-			    )
-			;
-	   		    Result = error(
-"expected pragma import(FuncName(ModeList) = Mode, Attributes, C_Function)",
-				PredAndModesTerm)
-			)
-		    ;
-			FuncAndArgModesResult = error(Msg, Term),
-			Result = error(Msg, Term)
-		    )
+		PragmaTerms = [PredAndModesTerm, FlagsTerm, C_FunctionTerm],
+		( parse_pragma_c_code_attributes_term(FlagsTerm, Flags) ->
+			FlagsResult = ok(Flags)
 		;
-		    parse_implicitly_qualified_term(ModuleName,
-		    	PredAndModesTerm, ErrorTerm,
-			"pragma import declaration", PredAndModesResult),  
-		    (
-			PredAndModesResult = ok(PredName, ModeTerms),
-			(
-		    	    convert_mode_list(ModeTerms, Modes)
-			->
-			    (
-				parse_pragma_c_code_attributes_term(FlagsTerm,
-					Flags)
-			    ->
-			        Result = ok(pragma(import(PredName, predicate,
-				    Modes, Flags, C_Function)))
-			    ;
-				Result = error("invalid second argument in `:- pragma import/3' declaration -- expecting C code attribute or list of attributes'",
+			FlagsResult = error("invalid second argument in `:- pragma import/3' declaration -- expecting C code attribute or list of attributes'",
 					FlagsTerm)
-			    )
-			;
-	   		    Result = error(
-"expected pragma import(PredName(ModeList), Attributes, C_Function)",
-				PredAndModesTerm)
-			)
-		    ;
-			PredAndModesResult = error(Msg, Term),
-			Result = error(Msg, Term)
-		    )
-		)
+	        )
 	    ;
-	    	Result = error(
-"expected pragma import(PredName(ModeList), Attributes, C_Function)",
-		     PredAndModesTerm)
-	    )
-	;
-	    PragmaTerms = [PredAndModesTerm, C_FunctionTerm]
-	->
-	    default_attributes(Attributes),
+		PragmaTerms = [PredAndModesTerm, C_FunctionTerm],
+		default_attributes(Flags),
+		FlagsResult = ok(Flags)
+	    )	
+ 	-> 
 	    (
-		PredAndModesTerm = term__functor(_, _, _),
 		C_FunctionTerm = term__functor(term__string(C_Function), [], _)
 	    ->
+		parse_pred_or_func_and_arg_modes(yes(ModuleName),
+			PredAndModesTerm, ErrorTerm,
+			"`:- pragma import' declaration",
+			PredAndArgModesResult),
 		(
-		    PredAndModesTerm = term__functor(term__atom("="),
-				[FuncAndArgModesTerm, RetModeTerm], _)
-		->
-		    parse_implicitly_qualified_term(ModuleName,
-		    	FuncAndArgModesTerm, PredAndModesTerm,
-			"pragma import declaration", FuncAndArgModesResult),  
+		    PredAndArgModesResult = ok(PredName - PredOrFunc,
+				ArgModes),
 		    (
-			FuncAndArgModesResult = ok(FuncName, ArgModeTerms),
-			(
-		    	    convert_mode_list(ArgModeTerms, ArgModes),
-			    convert_mode(RetModeTerm, RetMode)
-			->
-			    list__append(ArgModes, [RetMode], Modes),
-			    Result = ok(pragma(import(FuncName, function,
-				    Modes, Attributes, C_Function)))
-			;
-	   		    Result = error(
-"expected pragma import(FuncName(ModeList) = Mode, C_Function)",
-				PredAndModesTerm)
-			)
+			FlagsResult = ok(Attributes),
+			Result = ok(pragma(import(PredName, PredOrFunc,
+				ArgModes, Attributes, C_Function)))
 		    ;
-			FuncAndArgModesResult = error(Msg, Term),
+			FlagsResult = error(Msg, Term),
 			Result = error(Msg, Term)
 		    )
 		;
-		    parse_implicitly_qualified_term(ModuleName,
-		    	PredAndModesTerm, ErrorTerm,
-			"pragma import declaration", PredAndModesResult),  
-		    (
-			PredAndModesResult = ok(PredName, ModeTerms),
-			(
-		    	    convert_mode_list(ModeTerms, Modes)
-			->
-			    Result = ok(pragma(import(PredName, predicate,
-				    Modes, Attributes, C_Function)))
-			;
-	   		    Result = error(
-	"expected pragma import(PredName(ModeList), C_Function)",
-				PredAndModesTerm)
-			)
-		    ;
-			PredAndModesResult = error(Msg, Term),
+			PredAndArgModesResult = error(Msg, Term),
 			Result = error(Msg, Term)
-		    )
 		)
 	    ;
 	    	Result = error(
@@ -349,65 +258,28 @@
 	;
 	    Result = 
 	    	error(
-		"wrong number of arguments in `pragma import(...)' declaration",
+		"wrong number of arguments in `:- pragma import' declaration",
 		ErrorTerm)
-       ).
+	).
 
-parse_pragma_type(_ModuleName, "export", PragmaTerms, ErrorTerm,
-		_VarSet, Result) :-
+parse_pragma_type(_ModuleName, "export", PragmaTerms,
+		ErrorTerm, _VarSet, Result) :-
        (
 	    PragmaTerms = [PredAndModesTerm, C_FunctionTerm]
        ->
 	    (
-                PredAndModesTerm = term__functor(_, _, _),
 	        C_FunctionTerm = term__functor(term__string(C_Function), [], _)
 	    ->
+		parse_pred_or_func_and_arg_modes(no, PredAndModesTerm,
+			ErrorTerm, "`:- pragma export' declaration",
+			PredAndModesResult),
 		(
-		    PredAndModesTerm = term__functor(term__atom("="),
-				[FuncAndArgModesTerm, RetModeTerm], _)
-		->
-		    parse_qualified_term(FuncAndArgModesTerm,
-		    	PredAndModesTerm, "pragma export declaration",
-			FuncAndArgModesResult),  
-		    (
-		        FuncAndArgModesResult = ok(FuncName, ArgModeTerms),
-		        (
-		    	    convert_mode_list(ArgModeTerms, ArgModes),
-			    convert_mode(RetModeTerm, RetMode)
-		        ->
-			    list__append(ArgModes, [RetMode], Modes),
-			    Result =
-			    ok(pragma(export(FuncName, function,
-				Modes, C_Function)))
-		        ;
-	   		    Result = error(
-	"expected pragma export(FuncName(ModeList) = Mode, C_Function)",
-				PredAndModesTerm)
-		        )
-		    ;
-		        FuncAndArgModesResult = error(Msg, Term),
-		        Result = error(Msg, Term)
-		    )
-		;
-		    parse_qualified_term(PredAndModesTerm, ErrorTerm,
-			"pragma export declaration", PredAndModesResult),  
-		    (
-		        PredAndModesResult = ok(PredName, ModeTerms),
-		        (
-		    	    convert_mode_list(ModeTerms, Modes)
-		        ->
-			    Result = 
-			    ok(pragma(export(PredName, predicate, Modes,
-				C_Function)))
-		        ;
-	   		    Result = error(
-	"expected pragma export(PredName(ModeList), C_Function)",
-				PredAndModesTerm)
-		        )
-		    ;
-		        PredAndModesResult = error(Msg, Term),
-		        Result = error(Msg, Term)
-		    )
+			PredAndModesResult = ok(PredName - PredOrFunc, Modes),
+		    	Result = ok(pragma(export(PredName, PredOrFunc,
+					Modes, C_Function)))
+		;    
+			PredAndModesResult = error(Msg, Term),
+			Result = error(Msg, Term)
 		)
 	    ;
 	    	Result = error(
@@ -417,7 +289,7 @@
 	;
 	    Result = 
 	    	error(
-		"wrong number of arguments in `pragma export(...)' declaration",
+		"wrong number of arguments in `:- pragma export' declaration",
 		ErrorTerm)
        ).
 
@@ -457,8 +329,8 @@
 
 	% pragma unused_args should never appear in user programs,
 	% only in .opt files.
-parse_pragma_type(_ModuleName, "unused_args", PragmaTerms, ErrorTerm,
-		_VarSet, Result) :-
+parse_pragma_type(ModuleName, "unused_args", PragmaTerms,
+		ErrorTerm, _VarSet, Result) :-
 	(
 		PragmaTerms = [
 			PredOrFuncTerm,
@@ -477,8 +349,9 @@
 					term__atom("function"), [], _),
 			PredOrFunc = function 
 		),
-		parse_qualified_term(PredNameTerm, ErrorTerm,
-			"predicate name", PredNameResult),
+		parse_implicitly_qualified_term(ModuleName, PredNameTerm,
+			ErrorTerm, "`:- pragma unused_args' declaration",
+			PredNameResult),
 		PredNameResult = ok(PredName, []),
 		convert_int_list(UnusedArgsTerm, UnusedArgsResult),
 		UnusedArgsResult = ok(UnusedArgs)
@@ -486,7 +359,65 @@
 		Result = ok(pragma(unused_args(PredOrFunc, PredName,
 				Arity, ProcId, UnusedArgs)))
 	;
-		Result = error("error in pragma unused_args", ErrorTerm)
+		Result = error("error in `:- pragma unused_args'", ErrorTerm)
+	).
+
+parse_pragma_type(ModuleName, "type_spec", PragmaTerms, ErrorTerm, 
+		VarSet0, Result) :-
+	(
+	    (
+	        PragmaTerms = [PredAndModesTerm, TypeSubnTerm],
+		MaybeName = no
+	    ;
+		PragmaTerms = [PredAndModesTerm, TypeSubnTerm, SpecNameTerm],
+		SpecNameTerm = term__functor(_, _, SpecContext),
+
+		% This form of the pragma should not appear in source files.
+		term__context_file(SpecContext, FileName),
+		\+ string__remove_suffix(FileName, ".m", _),	
+
+		parse_implicitly_qualified_term(ModuleName,
+			SpecNameTerm, ErrorTerm, "", NameResult),
+		NameResult = ok(SpecName, []),
+		MaybeName = yes(SpecName)
+	    )
+	->
+	    parse_arity_or_modes(ModuleName, PredAndModesTerm, ErrorTerm,
+			"`:- pragma type_spec' declaration",
+			ArityOrModesResult),
+	    (
+		ArityOrModesResult = ok(arity_or_modes(PredName,
+			 Arity, MaybePredOrFunc, MaybeModes)),
+		conjunction_to_list(TypeSubnTerm, TypeSubnList),
+
+		% The varset is actually a tvarset.
+		varset__coerce(VarSet0, TVarSet),
+		( list__map(convert_type_spec_pair, TypeSubnList, TypeSubn) ->
+			( MaybeName = yes(SpecializedName0) ->
+				SpecializedName = SpecializedName0
+		    	;
+				unqualify_name(PredName, UnqualName),
+				make_pred_name(ModuleName, "TypeSpecOf",
+					MaybePredOrFunc, UnqualName,
+					type_subst(TVarSet, TypeSubn),
+					SpecializedName)
+		    	),
+		   	Result = ok(pragma(type_spec(PredName,
+				SpecializedName, Arity, MaybePredOrFunc,
+				MaybeModes, TypeSubn, TVarSet)))
+		    ;
+			Result = error(
+	"expected type substitution in `:- pragma type_spec' declaration",
+				TypeSubnTerm)
+		)
+	    ;
+		    ArityOrModesResult = error(Msg, Term),
+		    Result = error(Msg, Term)
+	    )
+	;
+	    Result = error(
+	"wrong number of arguments in `:- pragma type_spec' declaration", 
+		ErrorTerm)
 	).
 
 parse_pragma_type(ModuleName, "fact_table", PragmaTerms, ErrorTerm,
@@ -513,7 +444,7 @@
 	;
 	    Result = 
 		error(
-	"wrong number of arguments in pragma fact_table(..., ...) declaration",
+	"wrong number of arguments in `:- pragma fact_table' declaration",
 		ErrorTerm)
 	).
 
@@ -556,12 +487,12 @@
 		    ;
 			AttributeResult = error(_, AttrErrorTerm),
 			Result = error(
-	"expected attribute list for `:- pragma aditi_index(...)' declaration", 
+	"expected attribute list for `:- pragma aditi_index' declaration", 
 				AttrErrorTerm)	
 		    )
 	    	;
 		    Result = error(
-	"expected index type for `:- pragma aditi_index(...)' declaration",
+	"expected index type for `:- pragma aditi_index' declaration",
 	    			IndexTypeTerm)	
 	        )
 	    ;
@@ -570,7 +501,7 @@
 	    )
 	;
 	    Result = error(
-"wrong number of arguments in pragma aditi_index(..., ..., ...) declaration",
+	"wrong number of arguments in `:- pragma aditi_index' declaration",
 		ErrorTerm)
 	).
 
@@ -607,7 +538,7 @@
 			Pragma = supp_magic(Name, Arity)),
 		PragmaTerms, ErrorTerm, Result).
 
-parse_pragma_type(ModuleName, "context", 
+parse_pragma_type(ModuleName, "context",
 		PragmaTerms, ErrorTerm, _, Result) :-
 	parse_simple_pragma(ModuleName, "context",
 		lambda([Name::in, Arity::in, Pragma::out] is det,
@@ -623,13 +554,11 @@
 				Pragma = owner(Name, Arity, Owner)),
 			[SymNameAndArityTerm], ErrorTerm, Result)
 	    ;
-	        string__append_list(["expected owner name for
-			`pragma owner(...)' declaration"], ErrorMsg),
+	ErrorMsg = "expected owner name for `:- pragma owner' declaration",
 	        Result = error(ErrorMsg, OwnerTerm)
 	    )
 	;
-	    string__append_list(["wrong number of arguments in
-	    	`pragma owner(...)' declaration"], ErrorMsg),
+    ErrorMsg = "wrong number of arguments in `:- pragma owner' declaration",
 	    Result = error(ErrorMsg, ErrorTerm)
 	).
 
@@ -648,73 +577,45 @@
 	    ArgSizeTerm,
 	    TerminationTerm
 	],
-	( 
-	    PredAndModesTerm0 = term__functor(Const, Terms0, _) 
-	->
-	    ( 
-		Const = term__atom("="),
-		Terms0 = [FuncAndModesTerm, FuncResultTerm0]
-	    ->
-		% function
-		PredOrFunc = function,
-		PredAndModesTerm = FuncAndModesTerm,
-		FuncResultTerm = [FuncResultTerm0]
-	    ;
-		% predicate
-		PredOrFunc = predicate,
-		PredAndModesTerm = PredAndModesTerm0,
-		FuncResultTerm = []
-	    ),
-	    parse_implicitly_qualified_term(ModuleName,
-	    	PredAndModesTerm, ErrorTerm,
-		"`pragma termination_info' declaration", PredNameResult),
-	    PredNameResult = ok(PredName, ModeListTerm0),
-	    (
-		PredOrFunc = predicate,
-		ModeListTerm = ModeListTerm0
-	    ;
-		PredOrFunc = function,
-		list__append(ModeListTerm0, FuncResultTerm, ModeListTerm)
-	    ),
-	    convert_mode_list(ModeListTerm, ModeList),
-	    (			
+	parse_pred_or_func_and_arg_modes(yes(ModuleName), PredAndModesTerm0,
+		ErrorTerm, "`:- pragma termination_info' declaration",
+		NameAndModesResult),
+	NameAndModesResult = ok(PredName - PredOrFunc, ModeList),
+	(			
 		ArgSizeTerm = term__functor(term__atom("not_set"), [], _),
 		MaybeArgSizeInfo = no
-	    ;
+	;
 		ArgSizeTerm = term__functor(term__atom("infinite"), [],
 			ArgSizeContext),
 		MaybeArgSizeInfo = yes(infinite(
 			[ArgSizeContext - imported_pred]))
-	    ;
+	;
 		ArgSizeTerm = term__functor(term__atom("finite"),
 			[IntTerm, UsedArgsTerm], _),
 		IntTerm = term__functor(term__integer(Int), [], _),
 		convert_bool_list(UsedArgsTerm, UsedArgs),
 		MaybeArgSizeInfo = yes(finite(Int, UsedArgs))
-	    ),
-	    (
+	),
+	(
 		TerminationTerm = term__functor(term__atom("not_set"), [], _),
 		MaybeTerminationInfo = no
-	    ;
+	;
 		TerminationTerm = term__functor(term__atom("can_loop"),
 			[], TermContext),
 		MaybeTerminationInfo = yes(can_loop(
 			[TermContext - imported_pred]))
-	    ;
+	;
 		TerminationTerm = term__functor(term__atom("cannot_loop"),
 			[], _),
 		MaybeTerminationInfo = yes(cannot_loop)
-	    ),
-	    Result0 = ok(pragma(termination_info(PredOrFunc, PredName, 
-	    	ModeList, MaybeArgSizeInfo, MaybeTerminationInfo)))
-	;
-	    Result0 = error("unexpected variable in pragma termination_info",
-						ErrorTerm)
-	)
+	),
+	Result0 = ok(pragma(termination_info(PredOrFunc, PredName, 
+	ModeList, MaybeArgSizeInfo, MaybeTerminationInfo)))
     ->
 	Result = Result0
     ;
-	Result = error("syntax error in `pragma termination_info'", ErrorTerm)
+	Result = error("syntax error in `:- pragma termination_info'",
+		ErrorTerm)
     ).
 			
 parse_pragma_type(ModuleName, "terminates", PragmaTerms,
@@ -758,8 +659,8 @@
 	        Result = error(ErrorMsg, PredAndArityTerm)
 	    )
 	;
-	    string__append_list(["wrong number of arguments in `pragma ",
-		 PragmaType, "(...)' declaration"], ErrorMsg),
+	    string__append_list(["wrong number of arguments in `:- pragma ",
+		 PragmaType, "' declaration"], ErrorMsg),
 	    Result = error(ErrorMsg, ErrorTerm)
        ).
 
@@ -781,13 +682,13 @@
 	    Result = ok(PredName, Arity)
 	;
 	    string__append_list(
-		["expected predname/arity for `pragma ",
-		 PragmaType, "(...)' declaration"], ErrorMsg),
+		["expected predname/arity for `:- pragma ",
+		 PragmaType, "' declaration"], ErrorMsg),
 	    Result = error(ErrorMsg, PredAndArityTerm)
 	)
     ;
-	string__append_list(["expected predname/arity for `pragma ",
-		 PragmaType, "(...)' declaration"], ErrorMsg),
+	string__append_list(["expected predname/arity for `:- pragma ",
+		 PragmaType, "' declaration"], ErrorMsg),
 	Result = error(ErrorMsg, PredAndArityTerm)
     ).
 
@@ -896,55 +797,37 @@
 :- mode parse_pragma_c_code(in, in, in, in, in, out) is det.
 
 parse_pragma_c_code(ModuleName, Flags, PredAndVarsTerm0, PragmaImpl,
-	VarSet, Result) :-
+	VarSet0, Result) :-
+    parse_pred_or_func_and_args(yes(ModuleName), PredAndVarsTerm0,
+    	PredAndVarsTerm0, "`:- pragma c_code' declaration", PredAndArgsResult),
     (
-	PredAndVarsTerm0 = term__functor(Const, Terms0, _)
-    ->
+    	PredAndArgsResult = ok(PredName, VarList0 - MaybeRetTerm),
     	(
 	    % is this a function or a predicate?
-	    Const = term__atom("="),
-	    Terms0 = [FuncAndVarsTerm, FuncResultTerm0]
+	    MaybeRetTerm = yes(FuncResultTerm0)
 	->
 	    % function
 	    PredOrFunc = function,
-	    PredAndVarsTerm = FuncAndVarsTerm,
-	    FuncResultTerms = [FuncResultTerm0]
+	    list__append(VarList0, [FuncResultTerm0], VarList)
 	;
 	    % predicate
 	    PredOrFunc = predicate,
-	    PredAndVarsTerm = PredAndVarsTerm0,
-	    FuncResultTerms = []
+	    VarList = VarList0
 	),
-	parse_implicitly_qualified_term(ModuleName,
-	    PredAndVarsTerm, PredAndVarsTerm0,
-	    "pragma c_code declaration", PredNameResult),
+	parse_pragma_c_code_varlist(VarSet0, VarList, PragmaVars, Error),
 	(
-	    PredNameResult = ok(PredName, VarList0),
-	    (
-	    	PredOrFunc = predicate,
-	    	VarList = VarList0
-	    ;
-	    	PredOrFunc = function,
-	    	list__append(VarList0, FuncResultTerms, VarList)
-	    ),
-	    varset__coerce(VarSet, ProgVarSet),
-	    parse_pragma_c_code_varlist(VarSet, VarList, PragmaVars,
-	    	Error),
-	    (
-		Error = no,
-		Result = ok(pragma(c_code(Flags, PredName,
-		    PredOrFunc, PragmaVars, ProgVarSet, PragmaImpl)))
-	    ;
-		Error = yes(ErrorMessage),
-		Result = error(ErrorMessage, PredAndVarsTerm)
-	    )
-        ;
-	    PredNameResult = error(Msg, Term),
-	    Result = error(Msg, Term)
+	    Error = no,
+	    varset__coerce(VarSet0, VarSet),
+	    Result = ok(pragma(c_code(Flags, PredName,
+		    PredOrFunc, PragmaVars, VarSet, PragmaImpl)))
+	;
+	    Error = yes(ErrorMessage),
+	    Result = error(ErrorMessage, PredAndVarsTerm0)
+
 	)
     ;
-	Result = error("unexpected variable in `pragma c_code' declaration",
-		PredAndVarsTerm0)
+	PredAndArgsResult = error(Msg, Term),
+	Result = error(Msg, Term)
     ).
 
 	% parse the variable list in the pragma c code declaration.
@@ -996,7 +879,36 @@
     (
         PragmaTerms = [PredAndModesTerm0]
     ->
+	string__append_list(["`:- pragma ", PragmaName, "' declaration"],
+		ParseMsg),
+	parse_arity_or_modes(ModuleName, PredAndModesTerm0,
+		ErrorTerm, ParseMsg, ArityModesResult),
         (
+	    ArityModesResult = ok(arity_or_modes(PredName,
+	    	Arity, MaybePredOrFunc, MaybeModes)),
+            Result = ok(pragma(tabled(TablingType, PredName, Arity, 
+                MaybePredOrFunc, MaybeModes)))
+	;
+	    ArityModesResult = error(Msg, Term),
+	    Result = error(Msg, Term)
+	)
+    ;
+    	string__append_list(["wrong number of arguments in `:- pragma ", 
+            PragmaName, "' declaration"], ErrorMessage),
+        Result = error(ErrorMessage, ErrorTerm)
+    ).
+
+:- type arity_or_modes
+	--->	arity_or_modes(sym_name, arity,
+			maybe(pred_or_func), maybe(list(mode))).
+
+:- pred parse_arity_or_modes(module_name, term, term,
+		string, maybe1(arity_or_modes)).
+:- mode parse_arity_or_modes(in, in, in, in, out) is det.
+
+parse_arity_or_modes(ModuleName, PredAndModesTerm0,
+		ErrorTerm, ErrorMsg, Result) :-
+	(
                 % Is this a simple pred/arity pragma
             PredAndModesTerm0 = term__functor(term__atom("/"),
                 [PredNameTerm, ArityTerm], _)
@@ -1006,104 +918,101 @@
 			PredNameTerm, PredAndModesTerm0, "", ok(PredName, [])),
                 ArityTerm = term__functor(term__integer(Arity), [], _)
             ->
-                Result = ok(pragma(tabled(TablingType, PredName, Arity, 
-		    no, no)))    
+		Result = ok(arity_or_modes(PredName, Arity, no, no))
             ;
-                string__append_list(
-                    ["expected predname/arity for `pragma ",
-                    PragmaName, "(...)' declaration"], ErrorMsg),
-                Result = error(ErrorMsg, PredAndModesTerm0)
+                string__append("expected predname/arity for", ErrorMsg, Msg),
+                Result = error(Msg, ErrorTerm)
             )
         ;
-                % Is this a specific mode pragma
-            PredAndModesTerm0 = term__functor(Const, Terms0, _)
-        ->
-            (
-                % is this a function or a predicate?
-                Const = term__atom("="),
-                Terms0 = [FuncAndModesTerm, FuncResultTerm0]
-            ->
-                % function
-                PredOrFunc = function,
-                PredAndModesTerm = FuncAndModesTerm,
-                FuncResultTerms = [ FuncResultTerm0 ]
-            ;
-                % predicate
-                PredOrFunc = predicate,
-                PredAndModesTerm = PredAndModesTerm0,
-                FuncResultTerms = []
-            ),
-            string__append_list(["`pragma ", PragmaName, "(...)' declaration"],
-	    	ParseMsg), 
-	    parse_qualified_term(PredAndModesTerm, PredAndModesTerm0, 
-                ParseMsg, PredNameResult),
-            (
-                PredNameResult = ok(PredName, ModeList0),
-                (
-                    PredOrFunc = predicate,
-                    ModeList = ModeList0
+	    parse_pred_or_func_and_arg_modes(yes(ModuleName),
+	    	PredAndModesTerm0, PredAndModesTerm0, ErrorMsg,
+		PredAndModesResult),
+	    (
+	    	PredAndModesResult = ok(PredName - PredOrFunc, Modes),
+                list__length(Modes, Arity0),
+                ( PredOrFunc = function ->
+                    Arity is Arity0 - 1
                 ;
-                    PredOrFunc = function,
-                    list__append(ModeList0, FuncResultTerms, ModeList)
+                    Arity = Arity0
                 ),
-                (
-                    convert_mode_list(ModeList, Modes)
-                ->
-                    list__length(Modes, Arity0),
-                    (
-                        PredOrFunc = function
-                    ->
-                        Arity is Arity0 - 1
-                    ;
-                       Arity = Arity0
-                    ),
-                    Result = ok(pragma(tabled(TablingType, PredName, Arity, 
-                        yes(PredOrFunc), yes(Modes))))
-                ;
-                    string__append_list(["syntax error in pragma '", 
-		        PragmaName, "(...)' declaration"],ErrorMessage),
-                    Result = error(ErrorMessage, PredAndModesTerm)
-                )
+	    	Result = ok(arity_or_modes(PredName, Arity,
+			yes(PredOrFunc), yes(Modes)))
             ;
-                PredNameResult = error(Msg, Term),
+		PredAndModesResult = error(Msg, Term),
                 Result = error(Msg, Term)
             )
-        ;
-            string__append_list(["unexpected variable in `pragma ", PragmaName,
-                "'"], ErrorMessage),
-            Result = error(ErrorMessage, PredAndModesTerm0)
-        )
-    ;
-    	string__append_list(["wrong number of arguments in `pragma ", 
-            PragmaName, "(...)' declaration"], ErrorMessage),
-        Result = error(ErrorMessage, ErrorTerm)
-    ).
-
-:- pred convert_int_list(term::in, maybe1(list(int))::out) is det.
+	).
 
-convert_int_list(term__variable(V),
-			error("variable in int list", term__variable(V))).
-convert_int_list(term__functor(Functor, Args, Context), Result) :-
-	( 
-		Functor = term__atom("."),
-		Args = [term__functor(term__integer(Int), [], _), RestTerm]
-	->	
-		convert_int_list(RestTerm, RestResult),
+:- type maybe_pred_or_func_modes ==
+		maybe2(pair(sym_name, pred_or_func), list(mode)).
+:- type maybe_pred_or_func(T) == maybe2(sym_name, pair(list(T), maybe(T))).
+
+:- pred parse_pred_or_func_and_arg_modes(maybe(module_name), term, term,
+		string, maybe_pred_or_func_modes).
+:- mode parse_pred_or_func_and_arg_modes(in, in, in, in, out) is det.
+
+parse_pred_or_func_and_arg_modes(MaybeModuleName, PredAndModesTerm,
+		ErrorTerm, Msg, Result) :-
+	parse_pred_or_func_and_args(MaybeModuleName, PredAndModesTerm,
+		ErrorTerm, Msg, PredAndArgsResult),
+	(
+	    PredAndArgsResult =
+		ok(PredName, ArgModeTerms - MaybeRetModeTerm),
+	    ( convert_mode_list(ArgModeTerms, ArgModes0) ->
 		(
-			RestResult = ok(List0),
-			Result = ok([Int | List0])
+		    MaybeRetModeTerm = yes(RetModeTerm),
+		    ( convert_mode(RetModeTerm, RetMode) ->
+			list__append(ArgModes0, [RetMode], ArgModes),
+			Result = ok(PredName - function, ArgModes)
+		    ;
+			string__append("error in return mode in ",
+				Msg, ErrorMsg),
+		    	Result = error(ErrorMsg, ErrorTerm)
+		    )
 		;
-			RestResult = error(_, _),
-			Result = RestResult
+		    MaybeRetModeTerm = no,
+		    Result = ok(PredName - predicate, ArgModes0)
 		)
+	    ;
+		string__append("error in argument modes in ", Msg,
+			ErrorMsg),
+	    	Result = error(ErrorMsg, ErrorTerm)
+	    )
 	;
-		Functor = term__atom("[]"),
-		Args = []
+		PredAndArgsResult = error(ErrorMsg, Term),
+		Result = error(ErrorMsg, Term)
+	).
+
+:- pred parse_pred_or_func_and_args(maybe(sym_name), term, term, string,
+		maybe_pred_or_func(term)).
+:- mode parse_pred_or_func_and_args(in, in, in, in, out) is det.
+
+parse_pred_or_func_and_args(MaybeModuleName, PredAndArgsTerm, ErrorTerm,
+		Msg, PredAndArgsResult) :-
+	(
+		PredAndArgsTerm = term__functor(term__atom("="),
+			[FuncAndArgsTerm, FuncResultTerm], _)
 	->
-		Result = ok([])
+		FunctorTerm = FuncAndArgsTerm,
+		MaybeFuncResult = yes(FuncResultTerm)
 	;
-		Result = error("error in int list",
-				term__functor(Functor, Args, Context))
+		FunctorTerm = PredAndArgsTerm,
+		MaybeFuncResult = no
+	),
+	(
+		MaybeModuleName = yes(ModuleName),
+		parse_implicitly_qualified_term(ModuleName, FunctorTerm,
+			ErrorTerm, Msg, Result)
+	;
+		MaybeModuleName = no,
+		parse_qualified_term(FunctorTerm, ErrorTerm, Msg, Result)
+	),
+	(
+		Result = ok(SymName, Args),
+		PredAndArgsResult = ok(SymName, Args - MaybeFuncResult)
+	;
+		Result = error(ErrorMsg, Term),
+		PredAndArgsResult = error(ErrorMsg, Term)
 	).
 
 :- pred convert_bool_list(term::in, list(bool)::out) is semidet.
@@ -1126,3 +1035,56 @@
 		Args = [],
 		Bools = []
 	).
+
+:- pred convert_int_list(term::in, maybe1(list(int))::out) is det.
+
+convert_int_list(ListTerm, Result) :-
+	convert_list(ListTerm,
+		lambda([Term::in, Int::out] is semidet, (
+			Term = term__functor(term__integer(Int), [], _)
+		)), Result).
+
+	%
+	% convert_list(T, P, M) will convert a term T into a list of
+	% type X where P is a predicate that converts each element of
+	% the list into the correct type.  M will hold the list if the
+	% conversion succeded for each element of M, otherwise it will
+	% hold the error.
+	%
+:- pred convert_list(term, pred(term, T), maybe1(list(T))).
+:- mode convert_list(in, pred(in, out) is semidet, out) is det.
+
+convert_list(term__variable(V),_, error("variable in list", term__variable(V))).
+convert_list(term__functor(Functor, Args, Context), Pred, Result) :-
+	( 
+		Functor = term__atom("."),
+		Args = [Term, RestTerm],
+		call(Pred, Term, Element)
+	->	
+		convert_list(RestTerm, Pred, RestResult),
+		(
+			RestResult = ok(List0),
+			Result = ok([Element | List0])
+		;
+			RestResult = error(_, _),
+			Result = RestResult
+		)
+	;
+		Functor = term__atom("[]"),
+		Args = []
+	->
+		Result = ok([])
+	;
+		Result = error("error in list",
+				term__functor(Functor, Args, Context))
+	).
+
+:- pred convert_type_spec_pair(term::in, pair(tvar, type)::out) is semidet.
+
+convert_type_spec_pair(Term, TypeSpec) :-
+	Term = term__functor(term__atom("="), [TypeVarTerm, SpecTypeTerm0], _),
+	TypeVarTerm = term__variable(TypeVar0),
+	term__coerce_var(TypeVar0, TypeVar),
+	term__coerce(SpecTypeTerm0, SpecType),
+	TypeSpec = TypeVar - SpecType.
+
Index: compiler/prog_io_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/prog_io_util.m,v
retrieving revision 1.12
diff -u -u -r1.12 prog_io_util.m
--- prog_io_util.m	1998/11/20 04:09:02	1.12
+++ prog_io_util.m	1999/02/10 05:01:15
@@ -32,13 +32,11 @@
 :- type maybe2(T1, T2)	--->	error(string, term)
 			;	ok(T1, T2).
 
-:- type maybe1(T)	--->	error(string, term)
-			;	ok(T).
-
+:- type maybe1(T)	== 	maybe1(T, generic).
 :- type maybe1(T, U)	--->	error(string, term(U))
 			;	ok(T).
 
-:- type maybe_functor	== 	maybe2(sym_name, list(term)).
+:- type maybe_functor	== 	maybe_functor(generic).
 :- type maybe_functor(T) == 	maybe2(sym_name, list(term(T))).
 
 :- type maybe_item_and_context
Index: compiler/prog_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/prog_util.m,v
retrieving revision 1.43
diff -u -u -r1.43 prog_util.m
--- prog_util.m	1998/11/20 04:09:04	1.43
+++ prog_util.m	1999/04/15 01:23:14
@@ -78,10 +78,24 @@
 	%
 	% Create a predicate name with context, e.g. for introduced
 	% lambda or deforestation predicates.
+:- pred make_pred_name(module_name, string, maybe(pred_or_func),
+		string, new_pred_id, sym_name).
+:- mode make_pred_name(in, in, in, in, in, out) is det.
+
+	% make_pred_name_with_context(ModuleName, Prefix, PredOrFunc, PredName,
+	%	Line, Counter, SymName).
+	%
+	% Create a predicate name with context, e.g. for introduced
+	% lambda or deforestation predicates.
 :- pred make_pred_name_with_context(module_name, string, pred_or_func,
 		string, int, int, sym_name).
 :- mode make_pred_name_with_context(in, in, in, in, in, in, out) is det.
 
+:- type new_pred_id
+	--->	counter(int, int)		% Line number, Counter
+	;	type_subst(tvarset, type_subst)
+	.
+
 %-----------------------------------------------------------------------------%
 
 	% A pred declaration may contains just types, as in
@@ -113,8 +127,8 @@
 %-----------------------------------------------------------------------------%
 
 :- implementation.
-:- import_module (inst).
-:- import_module bool, string, int, map.
+:- import_module mercury_to_mercury, (inst).
+:- import_module bool, string, int, map, varset.
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
@@ -306,15 +320,62 @@
 
 make_pred_name_with_context(ModuleName, Prefix,
 		PredOrFunc, PredName, Line, Counter, SymName) :-
+	make_pred_name(ModuleName, Prefix, yes(PredOrFunc), PredName,
+		counter(Line, Counter), SymName).
+
+make_pred_name(ModuleName, Prefix, MaybePredOrFunc, PredName,
+		NewPredId, SymName) :-
+	(
+		MaybePredOrFunc = yes(PredOrFunc),
+		(
+			PredOrFunc = predicate,
+			PFS = "pred"
+		;
+			PredOrFunc = function,
+			PFS = "func"
+		)
+	;
+		MaybePredOrFunc = no,
+		PFS = "pred_or_func"
+	),
 	(
-		PredOrFunc = predicate,
-		PFS = "pred"
+		NewPredId = counter(Line, Counter),
+		string__format("%d__%d", [i(Line), i(Counter)], PredIdStr)
 	;
-		PredOrFunc = function,
-		PFS = "func"
+		NewPredId = type_subst(VarSet, TypeSubst),
+		SubstToString = lambda([SubstElem::in, SubstStr::out] is det, (
+			SubstElem = Var - Type,
+			varset__lookup_name(VarSet, Var, VarName),
+			mercury_type_to_string(VarSet, Type, TypeString),
+			string__append_list([VarName, " = ", TypeString],
+				SubstStr)
+		)),
+		list_to_string(SubstToString, TypeSubst, PredIdStr)
 	),
-	string__format("%s__%s__%s__%d__%d",
-		[s(Prefix), s(PFS), s(PredName), i(Line), i(Counter)], Name),
+
+	string__format("%s__%s__%s__%s",
+		[s(Prefix), s(PredIdStr), s(PFS), s(PredName)], Name),
 		SymName = qualified(ModuleName, Name).
+
+:- pred list_to_string(pred(T, string), list(T), string).
+:- mode list_to_string(pred(in, out) is det, in, out) is det.
+
+list_to_string(Pred, List, String) :-
+	list_to_string_2(Pred, List, Strings, ["]"]),
+	string__append_list(["[" | Strings], String).
+
+:- pred list_to_string_2(pred(T, string), list(T), list(string), list(string)).
+:- mode list_to_string_2(pred(in, out) is det, in, out, in) is det.
+
+list_to_string_2(_, []) --> [].
+list_to_string_2(Pred, [T | Ts]) -->
+	{ call(Pred, T, String) },
+	[String],
+	( { Ts = [] } ->
+		[]
+	;
+		[", "],
+		list_to_string_2(Pred, Ts)
+	).
 
 %-----------------------------------------------------------------------------%
Index: compiler/type_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/type_util.m,v
retrieving revision 1.64
diff -u -u -r1.64 type_util.m
--- type_util.m	1999/03/24 03:11:16	1.64
+++ type_util.m	1999/04/08 02:00:38
@@ -88,6 +88,12 @@
 :- pred construct_type(type_id, list(type), prog_context, (type)).
 :- mode construct_type(in, in, in, out) is det.
 
+	% Construct builtin types.
+:- func int_type = (type).
+:- func string_type = (type).
+:- func float_type = (type).
+:- func char_type = (type).
+
 	% Given a constant and an arity, return a type_id.
 	% Fails if the constant is not an atom.
 
@@ -385,6 +391,11 @@
 	),
 	TypeId = SymName - _,
 	construct_qualified_term(SymName, NewArgs, Context, Type).
+
+int_type = Type :- construct_type(unqualified("int") - 0, [], Type).
+string_type = Type :- construct_type(unqualified("string") - 0, [], Type).
+float_type = Type :- construct_type(unqualified("float") - 0, [], Type).
+char_type = Type :- construct_type(unqualified("character") - 0, [], Type).
 
 %-----------------------------------------------------------------------------%
 
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/staff/zs/imp/mercury/doc/reference_manual.texi,v
retrieving revision 1.136
diff -u -u -r1.136 reference_manual.texi
--- reference_manual.texi	1999/03/24 13:09:00	1.136
+++ reference_manual.texi	1999/03/30 01:31:11
@@ -3352,6 +3352,8 @@
 * Impurity::                    Users can write impure Mercury code
 * Inlining::                    Pragmas can be used to suggest or prevent
                                 procedure inlining.
+* Type specialization::		Pragmas can be used to produce specialized
+				versions of polymorphic procedures.
 * Obsolescence::                Library developers can declare old versions
                                 of predicates or functions to be obsolete.
 * Source file name::            The @samp{source_file} pragma and
@@ -4573,6 +4575,90 @@
 simply for performance concerns (inlining can cause unwanted code bloat
 in some cases) or to prevent possibly dangerous inlining when using
 low-level C code.
+
+ at node Type specialization
+ at section Type specialization
+
+The overhead of polymorphism can in some cases be significant, especially
+where polymorphic predicates make heavy use of class method calls or the
+built-in unification and comparison routines. To avoid this, the programmer
+can suggest to the compiler that a specialized version of a procedure should
+be created for a specific set of argument types.
+
+ at menu
+* Syntax and semantics of type specialization pragmas::
+* When to use type specialization::
+* Implementation specific details::
+ at end menu
+
+ at node Syntax and semantics of type specialization pragmas
+ at subsection Syntax and semantics of type specialization pragmas
+
+A declaration of the form
+
+ at example
+:- pragma type_spec(@var{Name}/@var{Arity}, @var{Subst}).
+:- pragma type_spec(@var{Name}(@var{Modes}), @var{Subst}).
+ at end example
+
+ at noindent
+suggests to the compiler that a specialized version of predicate(s)
+or function(s) with name @var{Name} and arity @var{Arity} should be
+created with the type substitution given by @var{Subst} applied to the
+argument types. The second form of the declaration only suggests
+specialization of the specified mode of the predicate or function.
+
+The substitution is written as a conjunction of bindings of the form
+ at w{@samp{@var{TypeVar} = @var{Type}}}, for example @w{@samp{K = int}} or
+ at w{@samp{(K = int, V = list(int))}}.
+
+The declarations
+
+ at example
+:- pred map__lookup(map(K, V), K, V).
+:- pragma type_spec(map__lookup/3, K = int).
+ at end example
+
+ at noindent
+give a hint to the compiler that a version of @samp{map__lookup/3} should
+be created for integer keys.
+
+Implementations are free to ignore @samp{pragma type_spec} declarations.
+Implementations are also free to perform type specialization
+even in the absense of any @samp{pragma type_spec} declarations.
+
+ at node When to use type specialization
+ at subsection When to use type specialization
+
+The set of types for which a predicate or function should be specialized is
+best determined by profiling your application. Overuse of type specialization
+will result in code bloat. 
+
+Type specialization of predicates or functions which
+unify or compare polymorphic variables is most effective when
+the specialized types are built-in types such as @samp{int}, @samp{float}
+and @samp{string}, or enumeration types, since their unification and
+comparison procedures are small and can be inlined.
+
+Predicates or functions which make use of type class method calls
+may also be candidates for specialization. Again, this is most effective
+when the called type class methods are small enough to be inlined.
+
+ at node Implementation specific details
+ at subsection Implementation specific details
+
+The University of Melbourne Mercury compiler performs user-requested type
+specializations when invoked with @samp{--user-guided-type-specialization},
+which is enabled at optimization level @samp{-O2} or higher.
+
+In the current implementation, the replacement types must be ground.
+Substitutions such as @w{@samp{T = list(U)}} are not supported.
+The compiler will warn about such substitutions, and will ignore
+the request for specialization. This restriction may be lifted in the future.
+ at c The main reason for this restriction is that it is tricky to ensure that
+ at c any extra typeclass_infos that may be needed are ordered the same way in
+ at c different modules. The efficiency gain from replacing a type variable with 
+ at c a non-ground type will usually be pretty small anyway.
 
 @node Obsolescence
 @section Obsolescence
Index: doc/user_guide.texi
===================================================================
RCS file: /home/staff/zs/imp/mercury/doc/user_guide.texi,v
retrieving revision 1.164
diff -u -u -r1.164 user_guide.texi
--- user_guide.texi	1999/04/14 22:50:54	1.164
+++ user_guide.texi	1999/04/15 02:43:10
@@ -3303,6 +3303,13 @@
 the polymorphic types are known.
 
 @sp 1
+ at item --user-guided-type-specialization
+Enable specialization of polymorphic predicates for which
+there are `:- pragma type_spec' declarations.
+See the ``Type specialization'' section in the ``Pragmas''
+chapter of the Mercury Language Reference Manual for more details.
+
+ at sp 1
 @item --higher-order-size-limit
 Set the maximum goal size of specialized versions created by
 @samp{--optimize-higher-order} and @samp{--type-specialization}.
Index: library/private_builtin.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/private_builtin.m,v
retrieving revision 1.18
diff -u -u -r1.18 private_builtin.m
--- private_builtin.m	1999/04/08 08:42:02	1.18
+++ private_builtin.m	1999/04/13 04:53:40
@@ -113,12 +113,21 @@
 :- mode type_info_from_typeclass_info(in, in, out) is det.
 
 	% superclass_from_typeclass_info(TypeClassInfo, Index, SuperClass)
-	% extracts SuperClass from TypeClassInfo where TypeInfo is the Indexth
-	% superclass of the class.
+	% extracts SuperClass from TypeClassInfo where SuperClass
+	% is the typeclass_info for the Indexth superclass of the class
+	% described by TypeClassInfo.
 :- pred superclass_from_typeclass_info(typeclass_info(_),
 		int, typeclass_info(_)).
 :- mode superclass_from_typeclass_info(in, in, out) is det.
 
+	% instance_constraint_from_typeclass_info(TypeClassInfo, Index,
+	%	InstanceConstraintTypeClassInfo)
+	% extracts the typeclass_info for the Indexth typeclass constraint
+	% of the instance described by TypeClassInfo.
+:- pred instance_constraint_from_typeclass_info(
+		typeclass_info(_), int, typeclass_info(_)).
+:- mode instance_constraint_from_typeclass_info(in, in, out) is det.
+
 	% the builtin < operator on ints, used in the code generated
 	% for compare/3 preds
 :- pred builtin_int_lt(int, int).
@@ -403,20 +412,32 @@
 % the compiler generates code for them inline.
 
 :- pragma c_code(type_info_from_typeclass_info(TypeClassInfo::in, Index::in,
-	TypeInfo::out), will_not_call_mercury,
+	TypeInfo::out), [will_not_call_mercury, thread_safe],
 " 
 	TypeInfo = MR_typeclass_info_type_info(TypeClassInfo, Index);
 ").
 
 :- pragma c_code(superclass_from_typeclass_info(TypeClassInfo0::in, Index::in,
-	TypeClassInfo::out), will_not_call_mercury,
+	TypeClassInfo::out), [will_not_call_mercury, thread_safe],
 " 
 	TypeClassInfo = 
 		MR_typeclass_info_superclass_info(TypeClassInfo0, Index);
 ").
 
+:- pragma c_code(instance_constraint_from_typeclass_info(TypeClassInfo0::in,
+	Index::in, TypeClassInfo::out), [will_not_call_mercury, thread_safe],
+" 
+	TypeClassInfo =
+		MR_typeclass_info_arg_typeclass_info(TypeClassInfo0, Index);
+").
+
 %-----------------------------------------------------------------------------%
 
+:- pragma inline(builtin_compare_int/3).
+:- pragma inline(builtin_compare_character/3).
+:- pragma inline(builtin_compare_string/3).
+:- pragma inline(builtin_compare_float/3).
+
 builtin_unify_int(X, X).
 
 builtin_index_int(X, X).
@@ -477,7 +498,7 @@
 :- mode builtin_strcmp(out, in, in) is det.
 
 :- pragma c_code(builtin_strcmp(Res::out, S1::in, S2::in),
-	will_not_call_mercury,
+	[will_not_call_mercury, thread_safe],
 	"Res = strcmp(S1, S2);").
 
 builtin_index_non_canonical_type(_, -1).
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/staff/zs/imp/tests/hard_coded/Mmakefile,v
retrieving revision 1.54
diff -u -u -r1.54 Mmakefile
--- Mmakefile	1999/03/26 04:34:14	1.54
+++ Mmakefile	1999/04/13 04:13:08
@@ -89,6 +89,7 @@
 	test_imported_no_tag \
 	term_io_test \
 	tim_qual1 \
+	type_spec \
 	write \
 	write_reg1
 
@@ -99,6 +100,7 @@
 
 # some tests need to be compiled with particular options
 
+MCFLAGS-bigtest		=	--intermodule-optimization -O3
 MCFLAGS-boyer		=	--infer-all
 MCFLAGS-func_test	=	--infer-all
 MCFLAGS-ho_order	=	--optimize-higher-order
@@ -106,7 +108,7 @@
 MCFLAGS-no_fully_strict	=	--no-fully-strict
 MCFLAGS-nondet_ctrl_vn	=	--optimize-value-number
 MCFLAGS-rnd		=	-O6
-MCFLAGS-bigtest		=	--intermodule-optimization -O3
+MCFLAGS-type_spec	=	--user-guided-type-specialization
 
 # In grade `none' with options `-O1 --opt-space' on kryten
 # (a sparc-sun-solaris2.5 system), mode_choice needs to be linked
Index: tests/hard_coded/type_spec.exp
===================================================================
RCS file: type_spec.exp
diff -N type_spec.exp
--- /dev/null	Thu Apr 15 15:17:20 1999
+++ type_spec.exp	Thu Apr 15 10:42:53 1999
@@ -0,0 +1,4 @@
+[3]
+[3]
+Succeeded
+Succeeded
Index: tests/hard_coded/type_spec.m
===================================================================
RCS file: type_spec.m
diff -N type_spec.m
--- /dev/null	Thu Apr 15 15:17:20 1999
+++ type_spec.m	Thu Apr 15 10:41:42 1999
@@ -0,0 +1,108 @@
+:- module type_spec.
+
+:- interface.
+
+:- import_module io.
+:- import_module int, list.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- typeclass comparable_t(T) where [
+		pred compare_t(comparison_result::out, T::in, T::in) is det
+].
+
+:- instance comparable_t(int) where [
+		pred(compare_t/3) is compare_int
+].
+:- pred compare_int(comparison_result::out, int::in, int::in) is det.
+
+:- pred type_spec(list(T)::in, list(T)::in, list(T)::out) is det.
+:- pragma type_spec(type_spec/3, T = int).
+
+:- pred typeclass_spec(list(T)::in, list(T)::in,
+		list(T)::out) is det <= comparable_t(T).
+:- pragma type_spec(typeclass_spec/3, T = int).
+
+:- typeclass all_zero(T) where [
+		pred all_zero(T::in) is semidet
+	].
+
+:- instance all_zero(list(T)) <= all_zero(T) where [
+		pred(all_zero/1) is list_all_zero
+	].
+
+:- instance all_zero(int) where [
+		pred(all_zero/1) is is_zero
+	].
+
+:- pred is_zero(int::in) is semidet.
+
+	% This tests the case where higher_order.m must extract
+	% the typeclass_infos for the constraints on an instance
+	% declaration when specializing a class method call.
+:- pred list_all_zero(list(T)::in) is semidet <= all_zero(T). 
+:- pragma type_spec(list_all_zero/1, T = int).
+
+:- implementation.
+
+main -->
+	{ type_spec([1,2,3], [3,4,5], Result1) },
+	io__write(Result1),
+	io__nl,
+	{ typeclass_spec([1,2,3], [3,4,5], Result2) },
+	io__write(Result2),
+	io__nl,
+	( { all_zero([0,1,2,3]) } ->
+		io__write_string("Failed\n")
+	;
+		io__write_string("Succeeded\n")
+	),
+	( { all_zero([0,0,0]) } ->
+		io__write_string("Succeeded\n")
+	;
+		io__write_string("Failed\n")
+	).
+
+type_spec([], [], []).
+type_spec([_ | _], [], []).
+type_spec([], [_ | _], []).
+type_spec([A | As], [B | Bs], Cs) :-
+	compare(Result, A, B),
+	( Result = (<) ->
+		type_spec(As, [B | Bs], Cs)
+	; Result = (=) ->
+		type_spec(As, Bs, Cs1),
+		Cs = [A | Cs1]
+	;
+		type_spec([A | As], Bs, Cs)
+	).
+
+typeclass_spec([], [], []).
+typeclass_spec([_ | _], [], []).
+typeclass_spec([], [_ | _], []).
+typeclass_spec([A | As], [B | Bs], Cs) :-
+	compare_t(Result, A, B),
+	( Result = (<) ->
+		typeclass_spec(As, [B | Bs], Cs)
+	; Result = (=) ->
+		typeclass_spec(As, Bs, Cs1),
+		Cs = [A | Cs1]
+	;
+		typeclass_spec([A | As], Bs, Cs)
+	).
+
+compare_int(Result, Int1, Int2) :-
+	( Int1 < Int2 ->
+		Result = (<)
+	; Int1 = Int2 ->
+		Result = (=)
+	;
+		Result = (>)
+	).
+
+list_all_zero([]).
+list_all_zero([H | T]) :-
+	all_zero(H),
+	list_all_zero(T).
+
+is_zero(0).
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/staff/zs/imp/tests/invalid/Mmakefile,v
retrieving revision 1.37
diff -u -u -r1.37 Mmakefile
--- Mmakefile	1999/02/12 04:19:30	1.37
+++ Mmakefile	1999/03/30 06:44:54
@@ -56,6 +56,7 @@
 	typeclass_test_7.m \
 	typeclass_test_9.m \
 	types.m	\
+	type_spec.m \
 	unbound_inst_var.m \
 	undef_lambda_mode.m \
 	undef_mode.m \
Index: tests/invalid/type_spec.err_exp
===================================================================
RCS file: type_spec.err_exp
diff -N type_spec.err_exp
--- /dev/null	Thu Apr 15 15:17:20 1999
+++ type_spec.err_exp	Tue Mar 30 17:05:20 1999
@@ -0,0 +1,13 @@
+type_spec.m:010: In `:- pragma type_spec' declaration for predicate `type_spec:type_spec1/1':
+type_spec.m:010:   error: variable `U' does not occur in the `:- pred' declaration.
+type_spec.m:011: Error: `:- pragma type_spec' declaration for
+type_spec.m:011:   `type_spec:type_spec1/1' specifies non-existent mode.
+type_spec.m:012: In `:- pragma type_spec' declaration for predicate `type_spec:type_spec1/1':
+type_spec.m:012:   warning: the substitution does not make the substituted
+type_spec.m:012:   types ground. The declaration will be ignored.
+type_spec.m:013: Error: `:- pragma type_spec' declaration for type_spec:type_spec1/2
+type_spec.m:013:   without corresponding `pred' or `func' declaration.
+type_spec.m:024: In `:- pragma type_spec' declaration for predicate `type_spec:type_spec2/1':
+type_spec.m:024:   error: the substitution includes the existentially
+type_spec.m:024:   quantified type variable `U'.
+For more information, try recompiling with `-E'.
Index: tests/invalid/type_spec.m
===================================================================
RCS file: type_spec.m
diff -N type_spec.m
--- /dev/null	Thu Apr 15 15:17:20 1999
+++ type_spec.m	Tue Mar 30 16:43:14 1999
@@ -0,0 +1,25 @@
+:- module type_spec.
+
+:- interface.
+
+:- import_module list.
+
+:- pred type_spec1(list(T)::in) is semidet.
+:- external(type_spec1/1).
+
+:- pragma type_spec(type_spec1/1, U = int).
+:- pragma type_spec(type_spec1(out), T = int).
+:- pragma type_spec(type_spec1/1, T = list(U)).
+:- pragma type_spec(type_spec1/2, T = int).
+
+:- typeclass fooable(T) where [
+                pred foo(T),
+                mode foo(in) is semidet
+	].
+
+:- type the_type(T, U).
+:- some [U] pred type_spec2(the_type(T, U)::in) is semidet => fooable(U).
+:- external(type_spec2/1).
+
+:- pragma type_spec(type_spec2/1, U = int).
+



More information about the developers mailing list