[m-dev.] diff: fix type specialization with inter-module optimization

[Simon Taylor]

Estimated hours taken: 1.5

When I changed intermod.m to append variable numbers
to type variables in predicate declarations in `.opt'
files, I didn't add them to `:- pragma type_spec'
declarations.

compiler/make_hlds.m:
	Make sure the type variable numbers in the predicate
	declaration match those in the `:- pragma type_spec'
	declaration stored in the module_info for use by intermod.m.
	 
compiler/mercury_to_mercury.m:
compiler/intermod.m:
	Append variable numbers to type variables in
	`:- pragma type_spec' declarations.

tests/valid/Mmakefile:
tests/valid/intermod_type_spec.m
tests/valid/intermod_type_spec_2.m
	Test case.


Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.84
diff -u -u -r1.84 intermod.m
--- compiler/intermod.m	2000/09/21 00:23:49	1.84
+++ compiler/intermod.m	2000/10/26 15:17:28
@@ -1534,10 +1534,16 @@
 	{ 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)
+		list__foldl(
+		    ( pred(Pragma::in, di, uo) is det -->
+			( { Pragma = type_spec(_, _, _, _, _, _, _) } ->
+				{ AppendVarnums = yes },
+				mercury_output_pragma_type_spec(Pragma,
+					AppendVarnums)
+			;
+				{ error("intermod__write_type_spec_pragmas") }
+			)
+		    ), TypeSpecPragmas)
 	;
 		[]
 	).
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.354
diff -u -u -r1.354 make_hlds.m
--- compiler/make_hlds.m	2000/10/26 06:05:33	1.354
+++ compiler/make_hlds.m	2000/10/27 05:57:34
@@ -452,11 +452,8 @@
 				ModeNum, 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)
+		{ Pragma = type_spec(_, _, _, _, _, _, _) },
+		add_pragma_type_spec(Pragma, Context, Module0, Module)
 	;
 		% Handle pragma fact_table decls later on (when we process
 		% clauses).
@@ -876,15 +873,12 @@
 
 %-----------------------------------------------------------------------------%
 
-:- 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.
+:- pred add_pragma_type_spec(pragma_type, term__context,
+		module_info, module_info, io__state, io__state).
+:- mode add_pragma_type_spec(in(type_spec), in, in, out, di, uo) is det.
 
-add_pragma_type_spec(Pragma, SymName, SpecName, Arity, MaybePredOrFunc,
-		MaybeModes, SpecSubst, VarSet, Context, Module0, Module) -->
+add_pragma_type_spec(Pragma, Context, Module0, Module) -->
+	{ Pragma = type_spec(SymName, _, Arity, MaybePredOrFunc, _, _, _) },
 	{ module_info_get_predicate_table(Module0, Preds) },
 	(
 		{ MaybePredOrFunc = yes(PredOrFunc) ->
@@ -897,8 +891,7 @@
 		},
 		{ PredIds \= [] }
 	->
-		list__foldl2(add_pragma_type_spec_2(Pragma, SymName, SpecName,
-			Arity, SpecSubst, MaybeModes, VarSet, Context),
+		list__foldl2(add_pragma_type_spec_2(Pragma, Context),
 			PredIds, Module0, Module)
 	;
 		undefined_pred_or_func_error(SymName, Arity, Context,
@@ -906,20 +899,18 @@
 		{ 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.
+:- pred add_pragma_type_spec_2(pragma_type, prog_context, pred_id,
+		module_info, module_info, io__state, io__state).
+:- mode add_pragma_type_spec_2(in(type_spec), in, in, in, out, di, uo) is det.
 
-add_pragma_type_spec_2(Pragma, SymName, SpecName, Arity,
-		Subst, MaybeModes, TVarSet0, Context, PredId,
-		ModuleInfo0, ModuleInfo) -->
+add_pragma_type_spec_2(Pragma0, Context, PredId, ModuleInfo0, ModuleInfo) -->
+	{ Pragma0 = type_spec(SymName, SpecName, Arity, _,
+			MaybeModes, Subst, TVarSet0) },
 	{ 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 } ->
+	( { SubstOk = yes(RenamedSubst) } ->
 	    { pred_info_procedures(PredInfo0, Procs0) },
 	    handle_pragma_type_spec_modes(SymName, Arity, Context,
 	    	MaybeModes, ProcIds, Procs0, Procs, ModesOk,
@@ -1011,6 +1002,9 @@
 			SpecMap = SpecMap0
 		),
 
+		Pragma = type_spec(SymName, SpecName, Arity,
+				yes(PredOrFunc), MaybeModes,
+				map__to_assoc_list(RenamedSubst), TVarSet), 
 		multi_map__set(PragmaMap0, PredId, Pragma, PragmaMap),
 		TypeSpecInfo = type_spec_info(ProcsToSpec,
 			ForceVersions, SpecMap, PragmaMap),
@@ -1033,7 +1027,7 @@
 	% of the current implementation, so it only results in a warning.
 :- 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,
+	class_constraints, maybe(tsubst), 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.
@@ -1117,7 +1111,7 @@
 				TypeSubst, Types),
 			apply_rec_subst_to_constraints(TypeSubst,
 				ClassContext0, ClassContext),
-			SubstOk = yes,
+			SubstOk = yes(TypeSubst),
 			ModuleInfo = ModuleInfo0
 			}
 		    ;
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.176
diff -u -u -r1.176 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m	2000/10/13 13:55:37	1.176
+++ compiler/mercury_to_mercury.m	2000/10/26 15:17:43
@@ -85,6 +85,14 @@
 		pragma_foreign_code_impl, io__state, io__state).
 :- mode mercury_output_pragma_c_code(in, in, in, in, in, in, di, uo) is det.
 
+:- inst type_spec == bound(type_spec(ground, ground, ground, ground,
+			ground, ground, ground)).
+
+	% mercury_output_pragma_type_spec(Pragma, AppendVarnums).
+:- pred mercury_output_pragma_type_spec((pragma_type), bool,
+		io__state, io__state).
+:- mode mercury_output_pragma_type_spec(in(type_spec), in, di, uo) is det.
+
 :- pred mercury_output_pragma_unused_args(pred_or_func, sym_name,
 		int, mode_num, list(int), io__state, io__state) is det.
 :- mode mercury_output_pragma_unused_args(in, in, in, in, in, di, uo) is det.
@@ -364,10 +372,9 @@
 		{ 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 = type_spec(_, _, _, _, _, _, _) },
+		{ AppendVarnums = no },
+		mercury_output_pragma_type_spec(Pragma, AppendVarnums)
 	;
 		{ Pragma = inline(Pred, Arity) },
 		mercury_output_pragma_decl(Pred, Arity, predicate, "inline")
@@ -2318,14 +2325,9 @@
 
 %-----------------------------------------------------------------------------%
 
-:- 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) -->
+mercury_output_pragma_type_spec(Pragma, AppendVarnums) -->
+	{ Pragma = type_spec(PredName, SpecName, Arity,
+		MaybePredOrFunc, MaybeModes, Subst, VarSet) },
 	io__write_string(":- pragma type_spec("),
 	( { MaybeModes = yes(Modes) } ->
 		{ MaybePredOrFunc = yes(PredOrFunc0) ->
@@ -2358,19 +2360,20 @@
 	),
 
 	io__write_string(", ("),
-	io__write_list(Subst, ", ", mercury_output_type_subst(VarSet)),
+	io__write_list(Subst, ", ",
+		mercury_output_type_subst(VarSet, AppendVarnums)),
 	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),	
+:- pred mercury_output_type_subst(tvarset, bool, pair(tvar, type),	
 		io__state, io__state).
-:- mode mercury_output_type_subst(in, in, di, uo) is det.
+:- mode mercury_output_type_subst(in, in, in, di, uo) is det.
 
-mercury_output_type_subst(VarSet, Var - Type) -->
-	mercury_output_var(Var, VarSet, no),
+mercury_output_type_subst(VarSet, AppendVarnums, Var - Type) -->
+	mercury_output_var(Var, VarSet, AppendVarnums),
 	io__write_string(" = "),
-	mercury_output_term(Type, VarSet, no).
+	mercury_output_term(Type, VarSet, AppendVarnums).
 
 %-----------------------------------------------------------------------------%
 
Index: tests/valid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/valid/Mmakefile,v
retrieving revision 1.76
diff -u -u -r1.76 Mmakefile
--- tests/valid/Mmakefile	2000/10/27 03:13:01	1.76
+++ tests/valid/Mmakefile	2000/10/27 06:05:46
@@ -84,6 +84,7 @@
 	intermod_quote.m \
 	intermod_test.m \
 	intermod_typeclass.m \
+	intermod_type_spec.m \
 	intermod_user_equality.m \
 	intermod_user_equality_nested.m \
 	lambda_inference.m\
@@ -241,6 +242,8 @@
 MCFLAGS-intermod_test2		= --intermodule-optimization
 MCFLAGS-intermod_typeclass	= --intermodule-optimization
 MCFLAGS-intermod_typeclass2	= --intermodule-optimization
+MCFLAGS-intermod_type_spec	= --intermodule-optimization
+MCFLAGS-intermod_type_spec2	= --intermodule-optimization
 MCFLAGS-intermod_user_equality	= --intermodule-optimization
 MCFLAGS-intermod_user_equality2	= --intermodule-optimization
 MCFLAGS-intermod_user_equality_nested	= --intermodule-optimization
Index: tests/valid/intermod_type_spec.m
===================================================================
RCS file: intermod_type_spec.m
diff -N intermod_type_spec.m
--- /dev/null	Fri Oct 27 17:05:01 2000
+++ intermod_type_spec.m	Fri Oct 27 16:38:46 2000
@@ -0,0 +1,14 @@
+:- module intermod_type_spec.
+
+:- interface.
+
+:- import_module list.
+
+:- pred call_p(list(int)::in, list(list(int))::in) is semidet.
+
+:- implementation.
+
+:- import_module intermod_type_spec_2.
+
+call_p(A, B) :- p(A, B).
+
Index: tests/valid/intermod_type_spec_2.m
===================================================================
RCS file: intermod_type_spec_2.m
diff -N intermod_type_spec_2.m
--- /dev/null	Fri Oct 27 17:05:01 2000
+++ intermod_type_spec_2.m	Fri Oct 27 16:38:27 2000
@@ -0,0 +1,27 @@
+:- module intermod_type_spec_2.
+
+:- interface.
+
+:- import_module list.
+
+:- pred p(T::in, list(T)::in) is semidet.
+:- pragma type_spec(p/2, T = list(U)).
+
+:- implementation.
+
+p(X, L) :-
+	p2(X, L).
+
+
+:- pred p2(T::in, list(T)::in) is semidet.
+:- pragma type_spec(p2/2, T = list(U)).
+:- pragma no_inline(p2/2).
+
+p2(X, [Y | Ys]) :-
+	(
+		X = Y
+	;
+		p2(X, Ys)
+	).
+
+
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------