bug fixes for module qualified cons_ids

Simon TAYLOR stayl at students.cs.mu.oz.au
Wed Mar 19 20:49:16 AEDT 1997


Hi Fergus,

Could you please review these changes.

Thanks,
Simon


Estimated hours: 6

Bug fixes for module qualified cons_ids.

Improve the compilation time of modules with lots of user_defined insts.
(Compiling tree234.m is still way too slow. The main problem is that repeated
calls to inst_matches_initial expand the insts multiple times. With type
information in the insts to propagate, it is expensive to repeat the
expansion over and over again.)

compiler/mode_util.m
	In propagate_type_info_into_modes and the predicates it calls, avoid
	finding the constructors for a type and substituting the argument
	types.

compiler/hlds_pred.m
	Add a new field to the proc_info, maybe_declared_argmodes which
	holds the declared arg_modes for use in .opt files and error messages.

compiler/typecheck.m
	Call propagate_type_info_into_modes from here to avoid calling it
	many times throughout mode analysis. This does not cause a
	substantial performance improvement, but reduces confusion
	over where everything should be module qualified.
	This also fixes a bug with the no_tag optimisation reported by
	Mark Brown. A runtime abort occurred because a constructor in a bound
	inst was not being module qualified which confused mode_to_arg_mode
	into giving the argument an arg_mode of top_unused.

compiler/lambda.m
compiler/modecheck_unify.m
	Call propagate_type_info_mode_list for modes of lambda predicates.

compiler/modes.m
compiler/modecheck_call.m
compiler/unique_modes.m
	Don't call propagate_type_info_mode_list since that has
	already been done in typecheck.m.

compiler/intermod.m
	Write out the declared arg_modes, since these don't contain
	constructs such $typed_inst which the parser doesn't handle.

compiler/clause_to_proc.m
compiler/unify_proc.m
	Fill in the declared_argmodes field in proc_infos.

compiler/type_util.m
	Avoid creating the substitution multiple times in type_constructors.


Index: clause_to_proc.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/clause_to_proc.m,v
retrieving revision 1.13
diff -u -r1.13 clause_to_proc.m
--- clause_to_proc.m	1997/02/23 06:05:24	1.13
+++ clause_to_proc.m	1997/03/16 03:12:51
@@ -87,9 +87,9 @@
 		Determinism = det,
 		pred_info_context(PredInfo0, Context),
 		MaybePredArgLives = no,
-		add_new_proc(PredInfo0, PredArity, PredArgModes,
-			MaybePredArgLives, yes(Determinism), Context,
-			PredInfo, _ProcId)
+		add_new_proc(PredInfo0, PredArity, PredArgModes, 
+			yes(PredArgModes), MaybePredArgLives, yes(Determinism),
+			Context, PredInfo, _ProcId)
 	;
 		PredInfo = PredInfo0
 	).
Index: hlds_pred.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_pred.m,v
retrieving revision 1.27
diff -u -r1.27 hlds_pred.m
--- hlds_pred.m	1997/03/06 05:09:08	1.27
+++ hlds_pred.m	1997/03/16 03:19:13
@@ -562,9 +562,9 @@
 
 :- interface.
 
-:- pred proc_info_init(arity, list(mode), maybe(list(is_live)),
-		maybe(determinism), term__context, proc_info).
-:- mode proc_info_init(in, in, in, in, in, out) is det.
+:- pred proc_info_init(arity, list(mode), maybe(list(mode)),
+	maybe(list(is_live)), maybe(determinism), term__context, proc_info).
+:- mode proc_info_init(in, in, in, in, in, in, out) is det.
 
 :- pred proc_info_set(maybe(determinism), varset, map(var, type), list(var),
 	list(mode), maybe(list(is_live)), hlds_goal, term__context,
@@ -681,6 +681,9 @@
 :- pred proc_info_set_typeinfo_varmap(proc_info, map(tvar, var), proc_info).
 :- mode proc_info_set_typeinfo_varmap(in, in, out) is det.
 
+:- pred proc_info_maybe_declared_argmodes(proc_info, maybe(list(mode))).
+:- mode proc_info_maybe_declared_argmodes(in, out) is det.
+
 	% For a set of variables V, find all the type variables in the types 
 	% of the variables in V, and return set of typeinfo variables for 
 	% those type variables. (find all typeinfos for variables in V).
@@ -728,8 +731,10 @@
 					% should be passed.
 			liveness_info,	% the initial liveness,
 					% for code generation
-			map(tvar, var)	% typeinfo vars for
+			map(tvar, var),	% typeinfo vars for
 					% type parameters
+			maybe(list(mode))
+					% declared modes of args
 		).
 
 
@@ -740,7 +745,8 @@
 	% This is what `det_analysis.m' wants. det_analysis.m
 	% will later provide the correct inferred determinism for it.
 
-proc_info_init(Arity, Modes, MaybeArgLives, MaybeDet, MContext, NewProc) :-
+proc_info_init(Arity, Modes, DeclaredModes, MaybeArgLives,
+		MaybeDet, MContext, NewProc) :-
 	map__init(BodyTypes),
 	goal_info_init(GoalInfo),
 	varset__init(BodyVarSet0),
@@ -756,7 +762,7 @@
 	NewProc = procedure(
 		MaybeDet, BodyVarSet, BodyTypes, HeadVars, Modes, MaybeArgLives,
 		ClauseBody, MContext, StackSlots, InferredDet, CanProcess,
-		ArgInfo, InitialLiveness, TVarsMap
+		ArgInfo, InitialLiveness, TVarsMap, DeclaredModes
 	).
 
 proc_info_set(DeclaredDetism, BodyVarSet, BodyTypes, HeadVars, HeadModes,
@@ -766,7 +772,7 @@
 	ProcInfo = procedure(
 		DeclaredDetism, BodyVarSet, BodyTypes, HeadVars, HeadModes,
 		HeadLives, Goal, Context, StackSlots, InferredDetism,
-		CanProcess, ArgInfo, Liveness, TVarMap).
+		CanProcess, ArgInfo, Liveness, TVarMap, no).
 
 proc_info_create(VarSet, VarTypes, HeadVars, HeadModes, Detism, Goal,
 		Context, TVarMap, ProcInfo) :-
@@ -775,13 +781,13 @@
 	MaybeHeadLives = no,
 	ProcInfo = procedure(yes(Detism), VarSet, VarTypes, HeadVars, HeadModes,
 		MaybeHeadLives, Goal, Context, StackSlots, Detism, yes, [],
-		Liveness, TVarMap).
+		Liveness, TVarMap, no).
 
 proc_info_set_body(ProcInfo0, VarSet, VarTypes, HeadVars, Goal, ProcInfo) :-
 	ProcInfo0 = procedure(A, _, _, _, E, F, _,
-		H, I, J, K, L, M, N),
+		H, I, J, K, L, M, N, O),
 	ProcInfo = procedure(A, VarSet, VarTypes, HeadVars, E, F, Goal,
-		H, I, J, K, L, M, N).
+		H, I, J, K, L, M, N, O).
 
 proc_info_interface_determinism(ProcInfo, Determinism) :-
 	proc_info_declared_determinism(ProcInfo, MaybeDeterminism),
@@ -825,43 +831,51 @@
 proc_info_get_initial_instmap(ProcInfo, ModuleInfo, InstMap) :-
 	proc_info_headvars(ProcInfo, HeadVars),
 	proc_info_argmodes(ProcInfo, ArgModes),
-	mode_list_get_initial_insts(ArgModes, ModuleInfo, InitialInsts0),
-		% propagate type information into the modes
-	proc_info_vartypes(ProcInfo, VarTypes),
-	map__apply_to_list(HeadVars, VarTypes, ArgTypes),
-	propagate_type_info_inst_list(ArgTypes, ModuleInfo, InitialInsts0,
-					InitialInsts),
+	mode_list_get_initial_insts(ArgModes, ModuleInfo, InitialInsts),
 	assoc_list__from_corresponding_lists(HeadVars, InitialInsts, InstAL),
 	instmap__from_assoc_list(InstAL, InstMap).
 
 proc_info_declared_determinism(ProcInfo, Detism) :-
-	ProcInfo = procedure(Detism, _, _, _, _, _, _, _, _, _, _, _, _, _).
+	ProcInfo = procedure(Detism, _, _, _, _, _, _, _, _, _, _, _, _, _, _).
 proc_info_variables(ProcInfo, VarSet) :-
-	ProcInfo = procedure(_, VarSet, _, _, _, _, _, _, _, _, _, _, _, _).
+	ProcInfo = procedure(_, VarSet, _, _, _, _, _, _, _, _, _, _, _, _, _).
 proc_info_vartypes(ProcInfo, VarTypes) :-
-	ProcInfo = procedure(_, _, VarTypes, _, _, _, _, _, _, _, _, _, _, _).
+	ProcInfo = procedure(_, _, VarTypes, _, _, _, _, _, 
+		_, _, _, _, _, _, _).
 proc_info_headvars(ProcInfo, HeadVars) :-
-	ProcInfo = procedure(_, _, _, HeadVars, _, _, _, _, _, _, _, _, _, _).
+	ProcInfo = procedure(_, _, _, HeadVars, _, _, _, _, _,
+		_, _, _, _, _, _).
 proc_info_argmodes(ProcInfo, Modes) :-
-	ProcInfo = procedure(_, _, _, _, Modes, _, _, _, _, _, _, _, _, _).
+	ProcInfo = procedure(_, _, _, _, Modes, _, _, _, _, _, _, _, _, _, _).
 proc_info_maybe_arglives(ProcInfo, ArgLives) :-
-	ProcInfo = procedure(_, _, _, _, _, ArgLives, _, _, _, _, _, _, _, _).
+	ProcInfo = procedure(_, _, _, _, _, ArgLives, _, _, _,
+		_, _, _, _, _, _).
 proc_info_goal(ProcInfo, Goal) :-
-	ProcInfo = procedure(_, _, _, _, _, _, Goal, _, _, _, _, _, _, _).
+	ProcInfo = procedure(_, _, _, _, _, _, Goal, _, _, _, _, _, _, _, _).
 proc_info_context(ProcInfo, Context) :-
-	ProcInfo = procedure(_, _, _, _, _, _, _, Context, _, _, _, _, _, _).
+	ProcInfo = procedure(_, _, _, _, _, _, _, Context, 
+		_, _, _, _, _, _, _).
 proc_info_stack_slots(ProcInfo, StackSlots) :-
-	ProcInfo = procedure(_, _, _, _, _, _, _, _, StackSlots, _, _, _, _, _).
+	ProcInfo = procedure(_, _, _, _, _, _, _, _, StackSlots,
+		_, _, _, _, _, _).
 proc_info_inferred_determinism(ProcInfo, Detism) :-
-	ProcInfo = procedure(_, _, _, _, _, _, _, _, _, Detism, _, _, _, _).
+	ProcInfo = procedure(_, _, _, _, _, _, _, _, _, Detism, _, _, _, _, _).
 proc_info_can_process(ProcInfo, CanProcess) :-
- 	ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, CanProcess, _, _, _).
+ 	ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, CanProcess,
+		_, _, _, _).
 proc_info_arg_info(ProcInfo, ArgInfo) :-
-	ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, ArgInfo, _, _).
+	ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, ArgInfo,
+		_, _, _).
 proc_info_liveness_info(ProcInfo, Liveness) :-
-	ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, _, Liveness, _).
+	ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, _, Liveness,
+		_, _).
 proc_info_typeinfo_varmap(ProcInfo, TVarMap) :-
-	ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, _, _, TVarMap).
+	ProcInfo = procedure(_, _, _, _, _, _, _,
+		_, _, _, _, _, _, TVarMap, _).
+
+proc_info_maybe_declared_argmodes(ProcInfo, MaybeArgModes) :-
+	ProcInfo = procedure(_, _, _, _, _, _, _,
+		_, _, _, _, _, _, _, MaybeArgModes).
 
 % :- type proc_info	--->	procedure(
 % 				A	maybe(determinism),% _declared_ detism
@@ -884,59 +898,69 @@
 % 				M	liveness_info	% the initial liveness
 %				N	map(tvar, var)  % typeinfo vars to
 %							% vars.
+%				O	maybe(list(mode)) % declared modes
+%							% of args
 % 				).
 
 proc_info_set_varset(ProcInfo0, VarSet, ProcInfo) :-
-	ProcInfo0 = procedure(A, _, C, D, E, F, G, H, I, J, K, L, M, N),
-	ProcInfo = procedure(A, VarSet, C, D, E, F, G, H, I, J, K, L, M, N).
+	ProcInfo0 = procedure(A, _, C, D, E, F, G, H, I, J, K, L, M, N, O),
+	ProcInfo = procedure(A, VarSet, C, D, E, F, G, H, I, J, K, L, M, N, O).
 
 proc_info_set_variables(ProcInfo0, Vars, ProcInfo) :-
-	ProcInfo0 = procedure(A, _, C, D, E, F, G, H, I, J, K, L, M, N),
-	ProcInfo = procedure(A, Vars, C, D, E, F, G, H, I, J, K, L, M, N).
+	ProcInfo0 = procedure(A, _, C, D, E, F, G, H, I, J, K, L, M, N, O),
+	ProcInfo = procedure(A, Vars, C, D, E, F, G, H, I, J, K, L, M, N, O).
 
 proc_info_set_vartypes(ProcInfo0, Vars, ProcInfo) :-
-	ProcInfo0 = procedure(A, B, _, D, E, F, G, H, I, J, K, L, M, N),
-	ProcInfo = procedure(A, B, Vars, D, E, F, G, H, I, J, K, L, M, N).
+	ProcInfo0 = procedure(A, B, _, D, E, F, G, H, I, J, K, L, M, N, O),
+	ProcInfo = procedure(A, B, Vars, D, E, F, G, H, I, J, K, L, M, N, O).
 
 proc_info_set_headvars(ProcInfo0, HeadVars, ProcInfo) :-
-	ProcInfo0 = procedure(A, B, C, _, E, F, G, H, I, J, K, L, M, N),
-	ProcInfo = procedure(A, B, C, HeadVars, E, F, G, H, I, J, K, L, M, N).
+	ProcInfo0 = procedure(A, B, C, _, E, F, G, H, I, J, K, L, M, N, O),
+	ProcInfo = procedure(A, B, C, HeadVars, E, F, G, H,
+			I, J, K, L, M, N, O).
 
 proc_info_set_argmodes(ProcInfo0, ArgModes, ProcInfo) :-
-	ProcInfo0 = procedure(A, B, C, D, _, F, G, H, I, J, K, L, M, N),
-	ProcInfo = procedure(A, B, C, D, ArgModes, F, G, H, I, J, K, L, M, N).
+	ProcInfo0 = procedure(A, B, C, D, _, F, G, H, I, J, K, L, M, N, O),
+	ProcInfo = procedure(A, B, C, D, ArgModes, F, G, H, I,
+			J, K, L, M, N, O).
 
 proc_info_set_maybe_arglives(ProcInfo0, ArgLives, ProcInfo) :-
-	ProcInfo0 = procedure(A, B, C, D, E, _, G, H, I, J, K, L, M, N),
-	ProcInfo = procedure(A, B, C, D, E, ArgLives, G, H, I, J, K, L, M, N).
+	ProcInfo0 = procedure(A, B, C, D, E, _, G, H, I, J, K, L, M, N, O),
+	ProcInfo = procedure(A, B, C, D, E, ArgLives, G, H, I, J,
+			K, L, M, N, O).
 
 proc_info_set_inferred_determinism(ProcInfo0, Detism, ProcInfo) :-
-	ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, _, K, L, M, N),
-	ProcInfo = procedure(A, B, C, D, E, F, G, H, I, Detism, K, L, M, N).
+	ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, _, K, L, M, N, O),
+	ProcInfo = procedure(A, B, C, D, E, F, G, H, I, Detism, K, L, M, N, O).
 
 proc_info_set_can_process(ProcInfo0, CanProcess, ProcInfo) :-
- 	ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, _, L, M, N),
- 	ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, CanProcess, L, M, N).
+ 	ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, _, L, M, N, O),
+ 	ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, CanProcess, 
+			L, M, N, O).
 
 proc_info_set_goal(ProcInfo0, Goal, ProcInfo) :-
-	ProcInfo0 = procedure(A, B, C, D, E, F, _, H, I, J, K, L, M, N),
-	ProcInfo = procedure(A, B, C, D, E, F, Goal, H, I, J, K, L, M, N).
+	ProcInfo0 = procedure(A, B, C, D, E, F, _, H, I, J, K, L, M, N, O),
+	ProcInfo = procedure(A, B, C, D, E, F, Goal, H, I, J, K, L, M, N, O).
 
 proc_info_set_stack_slots(ProcInfo0, StackSlots, ProcInfo) :-
-	ProcInfo0 = procedure(A, B, C, D, E, F, G, H, _, J, K, L, M, N),
-	ProcInfo = procedure(A, B, C, D, E, F, G, H, StackSlots, J, K, L, M, N).
+	ProcInfo0 = procedure(A, B, C, D, E, F, G, H, _, J, K, L, M, N, O),
+	ProcInfo = procedure(A, B, C, D, E, F, G, H, StackSlots,
+			J, K, L, M, N, O).
 
 proc_info_set_arg_info(ProcInfo0, ArgInfo, ProcInfo) :-
-	ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, _, M, N),
-	ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, ArgInfo, M, N).
+	ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, _, M, N, O),
+	ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, ArgInfo,
+			M, N, O).
 
 proc_info_set_liveness_info(ProcInfo0, Liveness, ProcInfo) :-
-	ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, L, _, N),
-	ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, Liveness, N).
+	ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, L, _, N, O),
+	ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, Liveness,
+			N, O).
 
 proc_info_set_typeinfo_varmap(ProcInfo0, TVarMap, ProcInfo) :-
-	ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, _),
-	ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, TVarMap).
+	ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, _, O),
+	ProcInfo = procedure(A, B, C, D, E, F, G, H, I,
+			J, K, L, M, TVarMap, O).
 
 proc_info_get_used_typeinfos_setwise(ProcInfo, Vars, TypeInfoVars) :-
 	set__to_sorted_list(Vars, VarList),
Index: intermod.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/intermod.m,v
retrieving revision 1.19
diff -u -r1.19 intermod.m
--- intermod.m	1997/03/06 05:09:12	1.19
+++ intermod.m	1997/03/17 03:21:42
@@ -170,11 +170,15 @@
 		{ pred_info_procedures(PredInfo0, Procs) },
 		{ map__lookup(Procs, ProcId, ProcInfo) },
 		{ proc_info_goal(ProcInfo, Goal) },
+		{ pred_info_get_marker_list(PredInfo0, Markers) },
 		(
 			% Don't export builtins since they will be
 			% recreated in the importing module anyway.
 			{ \+ code_util__compiler_generated(PredInfo0) },
 			{ \+ code_util__predinfo_is_builtin(PredInfo0) },
+				% The compiler may have difficulty parsing
+				% inferred modes due to $typed_inst etc.
+			{ \+ list__member(request(infer_modes), Markers) },
 			(
 				{ inlining__is_simple_goal(Goal,
 						InlineThreshold) }
@@ -440,7 +444,8 @@
 	{ module_info_pred_info(ModuleInfo, PredId, PredInfo) },
 	{ pred_info_import_status(PredInfo, Status) },
 	{ pred_info_procids(PredInfo, ProcIds) },
-	( { ProcIds = [] } ->
+	{ pred_info_get_marker_list(PredInfo, Markers) },
+	( { list__member(request(infer_modes), Markers) } ->
 		% Don't write this pred if it calls preds without mode decls.
 		{ DoWrite = no }
 	; 
@@ -857,12 +862,13 @@
 intermod__write_pred_modes(_, _, _, []) --> [].
 intermod__write_pred_modes(Procs, SymName, PredOrFunc, [ProcId | ProcIds]) -->
 	{ map__lookup(Procs, ProcId, ProcInfo) },
-	{ proc_info_argmodes(ProcInfo, ArgModes) },
+	{ proc_info_maybe_declared_argmodes(ProcInfo, MaybeArgModes) },
 	{ proc_info_declared_determinism(ProcInfo, MaybeDetism) },
-	{ MaybeDetism = yes(Detism0) ->
+	{ MaybeArgModes = yes(ArgModes0), MaybeDetism = yes(Detism0) ->
+		ArgModes = ArgModes0,
 		Detism = Detism0
 	;
-		error("Attempt to write pred mode decl without det decl")
+		error("intermod__write_pred_modes: attempt to write undeclared mode")
 	},
 	{ proc_info_context(ProcInfo, Context) },
 	{ varset__init(Varset) },
@@ -980,13 +986,17 @@
 intermod__write_c_clauses(Procs, [ProcId | ProcIds], PredOrFunc,
 			CCode, MayCallMercury, Vars, Varset, SymName) -->
 	{ map__lookup(Procs, ProcId, ProcInfo) },
-	{ proc_info_argmodes(ProcInfo, ArgModes) },
-	{ get_pragma_c_code_vars(Vars, Varset, ArgModes, PragmaVars) },
-	% XXX will need modification for nondet pragma C code
-	mercury_output_pragma_c_code(MayCallMercury, SymName, PredOrFunc,
-		PragmaVars, no, Varset, CCode),
-	intermod__write_c_clauses(Procs, ProcIds, PredOrFunc, CCode,
-		MayCallMercury, Vars, Varset, SymName).
+	{ proc_info_maybe_declared_argmodes(ProcInfo, MaybeArgModes) },
+	( { MaybeArgModes = yes(ArgModes) } ->
+		{ get_pragma_c_code_vars(Vars, Varset, ArgModes, PragmaVars) },
+		% XXX will need modification for nondet pragma C code
+		mercury_output_pragma_c_code(MayCallMercury, SymName,
+			PredOrFunc, PragmaVars, no, Varset, CCode),
+		intermod__write_c_clauses(Procs, ProcIds, PredOrFunc, CCode,
+			MayCallMercury, Vars, Varset, SymName)
+	;
+		{ error("intermod__write_c_clauses: no mode declaration") }
+	).
 
 :- pred get_pragma_c_code_vars(list(var)::in, varset::in,
 		list(mode)::in, list(pragma_var)::out) is det.
Index: lambda.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/lambda.m,v
retrieving revision 1.24
diff -u -r1.24 lambda.m
--- lambda.m	1997/02/23 06:06:43	1.24
+++ lambda.m	1997/03/18 23:43:53
@@ -332,8 +332,10 @@
 		% come before all the outputs.
 		
 		permute_argvars(AllArgVars, AllArgModes, ModuleInfo1,
-			PermutedArgVars, PermutedArgModes),
+			PermutedArgVars, PermutedArgModes0),
 		map__apply_to_list(PermutedArgVars, VarTypes, ArgTypes),
+		propagate_type_info_mode_list(ArgTypes, ModuleInfo1,
+			PermutedArgModes0, PermutedArgModes),
 
 		% Now construct the proc_info and pred_info for the new
 		% single-mode predicate, using the information computed above
Index: make_hlds.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/make_hlds.m,v
retrieving revision 1.225
diff -u -r1.225 make_hlds.m
--- make_hlds.m	1997/03/06 05:09:22	1.225
+++ make_hlds.m	1997/03/16 03:23:52
@@ -40,9 +40,10 @@
 			unify_main_context, unify_sub_contexts, hlds_goal).
 :- mode create_atomic_unification(in, in, in, in, in, out) is det.
 
-:- pred add_new_proc(pred_info, arity, list(mode), maybe(list(is_live)),
-		maybe(determinism), term__context, pred_info, proc_id).
-:- mode add_new_proc(in, in, in, in, in, in, out, out) is det.
+:- pred add_new_proc(pred_info, arity, list(mode), maybe(list(mode)),
+		maybe(list(is_live)), maybe(determinism),
+		term__context, pred_info, proc_id).
+:- mode add_new_proc(in, in, in, in, in, in, in, out, out) is det.
 
 :- pred clauses_info_init(int::in, clauses_info::out) is det.
 
@@ -1207,8 +1208,8 @@
 	pred_info_init(ModuleName, PredName, Arity, TVarSet, ArgTypes, Cond,
 		Context, ClausesInfo0, Status, no, none, predicate, PredInfo0),
 	ArgLives = no,
-	add_new_proc(PredInfo0, Arity, ArgModes, ArgLives, yes(Det), Context,
-			PredInfo, _),
+	add_new_proc(PredInfo0, Arity, ArgModes, yes(ArgModes),
+		ArgLives, yes(Det), Context, PredInfo, _),
 
 	module_info_get_predicate_table(Module0, PredicateTable0),
 	predicate_table_insert(PredicateTable0, PredInfo, PredId,
@@ -1247,12 +1248,12 @@
 		Status = Status1
 	).
 
-add_new_proc(PredInfo0, Arity, ArgModes, MaybeArgLives, MaybeDet, Context,
-		PredInfo, ModeId) :-
+add_new_proc(PredInfo0, Arity, ArgModes, MaybeDeclaredArgModes,
+		MaybeArgLives, MaybeDet, Context, PredInfo, ModeId) :-
 	pred_info_procedures(PredInfo0, Procs0),
 	next_mode_id(Procs0, MaybeDet, ModeId),
-	proc_info_init(Arity, ArgModes, MaybeArgLives, MaybeDet, Context,
-			NewProc),
+	proc_info_init(Arity, ArgModes, MaybeDeclaredArgModes, MaybeArgLives,
+		MaybeDet, Context, NewProc),
 	map__set(Procs0, ModeId, NewProc, Procs),
 	pred_info_set_procedures(PredInfo0, Procs, PredInfo).
 
@@ -1326,8 +1327,8 @@
 		% XXX we should check that this mode declaration
 		% isn't the same as an existing one
 	{ ArgLives = no },
-	{ add_new_proc(PredInfo0, Arity, Modes, ArgLives, MaybeDet, MContext,
-			PredInfo, _) },
+	{ add_new_proc(PredInfo0, Arity, Modes, yes(Modes), ArgLives,
+			MaybeDet, MContext, PredInfo, _) },
 	{ map__set(Preds0, PredId, PredInfo, Preds) },
 	{ predicate_table_set_preds(PredicateTable1, Preds, PredicateTable) },
 	{ module_info_set_predicate_table(ModuleInfo0, PredicateTable,
Index: mode_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mode_util.m,v
retrieving revision 1.83
diff -u -r1.83 mode_util.m
--- mode_util.m	1997/02/28 05:30:31	1.83
+++ mode_util.m	1997/03/18 00:30:32
@@ -203,19 +203,13 @@
 				list(mode)).
 :- mode propagate_type_info_mode_list(in, in, in, out) is det.
 
-	% Given corresponding lists of types and insts, produce a new
-	% list of insts which includes the information provided by the
-	% corresponding types.
+	% Given corresponding lists of types and insts and a substitution
+	% for the type variables in the type, produce a new list of insts
+	% which includes the information provided by the corresponding types.
 	%
-:- pred propagate_type_info_inst_list(list(type), module_info, list(inst),
-				list(inst)).
-:- mode propagate_type_info_inst_list(in, in, in, out) is det.
-
-	% Given a type and an inst, produce a new inst which includes
-	% the information provided by the type.
-	%
-:- pred propagate_type_info_inst(type, module_info, inst, inst).
-:- mode propagate_type_info_inst(in, in, in, out) is det.
+:- pred propagate_type_info_inst_list(list(type), tsubst, module_info,
+		list(inst), list(inst)).
+:- mode propagate_type_info_inst_list(in, in, in, in, out) is det.
 
 	% Given the mode of a predicate,
 	% work out which arguments are live (might be used again
@@ -369,7 +363,7 @@
 		type_constructors(Type, ModuleInfo, Constructors),
 		type_is_no_tag_type(Constructors, FunctorName, ArgType)
 	->
-		% if so, the arg_mode will be determined by the mode and
+		% the arg_mode will be determined by the mode and
 		% type of the functor's argument,
 		% so we figure out the mode and type of the argument,
 		% and then recurse
@@ -1037,11 +1031,13 @@
 			Inst = abstract_inst(Name, Args)
 		)
 	; InstName = typed_ground(Uniq, Type),
-		propagate_type_info_inst(Type, ModuleInfo, ground(Uniq, no),
-			Inst)
+		map__init(Subst),
+		propagate_type_info_inst(Type, Subst, ModuleInfo,
+			ground(Uniq, no), Inst)
 	; InstName = typed_inst(Type, TypedInstName),
 		inst_lookup_2(TypedInstName, ModuleInfo, Inst0),
-		propagate_type_info_inst(Type, ModuleInfo, Inst0, Inst)
+		map__init(Subst),
+		propagate_type_info_inst(Type, Subst, ModuleInfo, Inst0, Inst)
 	),
 	!.
 
@@ -1051,8 +1047,6 @@
 	% list of modes which includes the information provided by the
 	% corresponding types.
 
-:- propagate_type_info_mode_list(A, B, _, _) when A and B.
-
 propagate_type_info_mode_list([], _, [], []).
 propagate_type_info_mode_list([Type | Types], ModuleInfo, [Mode0 | Modes0],
 		[Mode | Modes]) :-
@@ -1063,16 +1057,14 @@
 propagate_type_info_mode_list([_|_], _, [], []) :-
 	error("propagate_type_info_mode_list: length mismatch").
 
-:- propagate_type_info_inst_list(A, B, _, _) when A and B.
-
-propagate_type_info_inst_list([], _, [], []).
-propagate_type_info_inst_list([Type | Types], ModuleInfo, [Inst0 | Insts0],
-		[Inst | Insts]) :-
-	propagate_type_info_inst(Type, ModuleInfo, Inst0, Inst),
-	propagate_type_info_inst_list(Types, ModuleInfo, Insts0, Insts).
-propagate_type_info_inst_list([], _, [_|_], []) :-
+propagate_type_info_inst_list([], _, _, [], []).
+propagate_type_info_inst_list([Type | Types], Subst, ModuleInfo,
+		[Inst0 | Insts0], [Inst | Insts]) :-
+	propagate_type_info_inst(Type, Subst, ModuleInfo, Inst0, Inst),
+	propagate_type_info_inst_list(Types, Subst, ModuleInfo, Insts0, Insts).
+propagate_type_info_inst_list([], _, _, [_|_], []) :-
 	error("propagate_type_info_inst_list: length mismatch").
-propagate_type_info_inst_list([_|_], _, [], []) :-
+propagate_type_info_inst_list([_|_], _, _, [], []) :-
 	error("propagate_type_info_inst_list: length mismatch").
 
 	% Given a type and a mode, produce a new mode which includes
@@ -1083,45 +1075,31 @@
 
 propagate_type_info_mode(Type, ModuleInfo, Mode0, Mode) :-
 	mode_get_insts(ModuleInfo, Mode0, InitialInst0, FinalInst0),
-	ex_propagate_type_info_inst(Type, ModuleInfo, InitialInst0,
+	map__init(Subst),
+	ex_propagate_type_info_inst(Type, Subst, ModuleInfo, InitialInst0,
 		InitialInst),
-	ex_propagate_type_info_inst(Type, ModuleInfo, FinalInst0, FinalInst),
+	ex_propagate_type_info_inst(Type, Subst, ModuleInfo, FinalInst0, 
+		FinalInst),
 	Mode = (InitialInst -> FinalInst).
 
-	% Given a type and an inst, produce a new inst which includes
-	% the information provided by the type.
+	% Given a type, an inst and a substitution for the type variables in
+	% the type, produce a new inst which includes the information provided
+	% by the type.
+	%
+:- pred propagate_type_info_inst(type, tsubst, module_info, inst, inst).
+:- mode propagate_type_info_inst(in, in, in, in, out) is det.
 
-propagate_type_info_inst(Type, ModuleInfo, Inst0, Inst) :-
-	(
-		type_constructors(Type, ModuleInfo, Constructors)
-	->
-		% Many of the calls to this predicate from inst_match.m do
-		% not require expansion of ground insts to bound insts.
-		% At the moment the extra expansion only complicates the insts
-		% unnecessarily, so this is disabled.
-		% propagate_ctor_info(Inst0, Type, Constructors, ModuleInfo,
-		%	Inst) 
-		ex_propagate_ctor_info(Inst0, Type, Constructors, ModuleInfo,
-			Inst)
-	;
-		Inst = Inst0
-	).
+propagate_type_info_inst(Type, Subst, ModuleInfo, Inst0, Inst) :-
+	ex_propagate_ctor_info(Inst0, Type, Subst, ModuleInfo, Inst).
 
 	% Given a type and an inst, produce a new inst which includes
 	% the information provided by the type.
 
-:- pred ex_propagate_type_info_inst(type, module_info, inst, inst).
-:- mode ex_propagate_type_info_inst(in, in, in, out) is det.
+:- pred ex_propagate_type_info_inst(type, tsubst, module_info, inst, inst).
+:- mode ex_propagate_type_info_inst(in, in, in, in, out) is det.
 
-ex_propagate_type_info_inst(Type, ModuleInfo, Inst0, Inst) :-
-	(
-		type_constructors(Type, ModuleInfo, Constructors)
-	->
-		ex_propagate_ctor_info(Inst0, Type, Constructors, ModuleInfo,
-			Inst)
-	;
-		Inst = Inst0
-	).
+ex_propagate_type_info_inst(Type, Subst, ModuleInfo, Inst0, Inst) :-
+	ex_propagate_ctor_info(Inst0, Type, Subst, ModuleInfo, Inst).
 
 %-----------------------------------------------------------------------------%
 
@@ -1135,9 +1113,10 @@
 
 propagate_ctor_info(free(_), _, _, _, _) :-
 	error("propagate_ctor_info: type info already present").
-propagate_ctor_info(bound(Uniq, BoundInsts0), Type, Constructors, ModuleInfo,
+propagate_ctor_info(bound(Uniq, BoundInsts0), Type, _Constructors, ModuleInfo,
 		Inst) :-
-	propagate_ctor_info_2(BoundInsts0, Type, Constructors, ModuleInfo,
+	map__init(Subst),
+	propagate_ctor_info_2(BoundInsts0, Type, Subst, ModuleInfo,
 		BoundInsts),
 	( BoundInsts = [] ->
 		Inst = not_reached
@@ -1165,7 +1144,7 @@
 	inst_lookup(ModuleInfo, InstName, Inst0),
 	propagate_ctor_info(Inst0, Type, Ctors, ModuleInfo, Inst).
 
-:- pred ex_propagate_ctor_info(inst, type, list(constructor), module_info, inst).
+:- pred ex_propagate_ctor_info(inst, type, tsubst, module_info, inst).
 :- mode ex_propagate_ctor_info(in, in, in, in, out) is det.
 
 % ex_propagate_ctor_info(free, Type, _, _, free(Type)).	% temporarily disabled
@@ -1175,10 +1154,10 @@
 						% XXX loses type info!
 ex_propagate_ctor_info(free(_), _, _, _, _) :-
 	error("ex_propagate_ctor_info: type info already present").
-ex_propagate_ctor_info(bound(Uniq, BoundInsts0), Type, Constructors,
+ex_propagate_ctor_info(bound(Uniq, BoundInsts0), Type, Subst, 
 		ModuleInfo, Inst) :-
-	propagate_ctor_info_2(BoundInsts0, Type, Constructors, ModuleInfo,
-		BoundInsts),
+	propagate_ctor_info_2(BoundInsts0, Type, Subst,
+		ModuleInfo, BoundInsts),
 	( BoundInsts = [] ->
 		Inst = not_reached
 	;
@@ -1194,14 +1173,18 @@
 	% for higher-order pred modes, the information we need is already
 	% in the inst, so we leave it unchanged
 			ground(Uniq, yes(PredInstInfo))).
-ex_propagate_ctor_info(not_reached, _Type, _Constructors, _ModuleInfo,
-		not_reached).
+ex_propagate_ctor_info(not_reached, _Type, _, _ModuleInfo, not_reached).
 ex_propagate_ctor_info(inst_var(_), _, _, _, _) :-
 	error("propagate_ctor_info: unbound inst var").
 ex_propagate_ctor_info(abstract_inst(Name, Args), _, _, _,
 		abstract_inst(Name, Args)).	% XXX loses info
-ex_propagate_ctor_info(defined_inst(InstName), Type, _, _,
-		defined_inst(typed_inst(Type, InstName))).
+ex_propagate_ctor_info(defined_inst(InstName), Type0, Subst, _,
+		defined_inst(typed_inst(Type, InstName))) :-
+	( map__is_empty(Subst) ->
+		Type = Type0
+	;
+		term__apply_substitution(Type0, Subst, Type)
+	).
 
 :- pred constructors_to_bound_insts(list(constructor), uniqueness, module_info,
 				list(bound_inst)).
@@ -1228,18 +1211,29 @@
 	Inst = ground(Uniq, no),
 	ctor_arg_list_to_inst_list(Args, Uniq, Insts).
 
-:- pred propagate_ctor_info_2(list(bound_inst), (type), list(constructor),
+:- pred propagate_ctor_info_2(list(bound_inst), (type), tsubst,
 		module_info, list(bound_inst)).
 :- mode propagate_ctor_info_2(in, in, in, in, out) is det.
 
-propagate_ctor_info_2(BoundInsts0, Type, Constructors,
-		ModuleInfo, BoundInsts) :-
+propagate_ctor_info_2(BoundInsts0, Type0, Subst, ModuleInfo, BoundInsts) :-
+	( map__is_empty(Subst) ->
+		Type = Type0
+	;
+		term__apply_substitution(Type0, Subst, Type)
+	),
 	(
-		type_to_type_id(Type, TypeId, _),
-		TypeId = qualified(TypeModule, _) - _
+		type_to_type_id(Type, TypeId, TypeArgs),
+		TypeId = qualified(TypeModule, _) - _,
+		module_info_types(ModuleInfo, TypeTable),
+		map__search(TypeTable, TypeId, TypeDefn),
+		hlds_data__get_type_defn_tparams(TypeDefn, TypeParams0),
+		hlds_data__get_type_defn_body(TypeDefn, TypeBody),
+		TypeBody = du_type(Constructors, _, _)
 	->
-		propagate_ctor_info_3(BoundInsts0, TypeModule,
-			Constructors, ModuleInfo, BoundInsts1),
+		term__term_list_to_var_list(TypeParams0, TypeParams),
+		map__from_corresponding_lists(TypeParams, TypeArgs, ArgSubst),
+		propagate_ctor_info_3(BoundInsts0, TypeModule, Constructors,
+			ArgSubst, ModuleInfo, BoundInsts1),
 		list__sort(BoundInsts1, BoundInsts)
 	;
 		% Builtin types don't need processing.
@@ -1247,12 +1241,12 @@
 	).
 
 :- pred propagate_ctor_info_3(list(bound_inst), string, list(constructor),
-		module_info, list(bound_inst)).
-:- mode propagate_ctor_info_3(in, in, in, in, out) is det.
+		tsubst, module_info, list(bound_inst)).
+:- mode propagate_ctor_info_3(in, in, in, in, in, out) is det.
 
-propagate_ctor_info_3([], _, _, _, []).
+propagate_ctor_info_3([], _, _, _, _, []).
 propagate_ctor_info_3([BoundInst0 | BoundInsts0], TypeModule, Constructors,
-		ModuleInfo, [BoundInst | BoundInsts]) :-
+		Subst, ModuleInfo, [BoundInst | BoundInsts]) :-
 	BoundInst0 = functor(ConsId0, ArgInsts0),
 	( ConsId0 = cons(unqualified(Name), Ar) ->
 		ConsId = cons(qualified(TypeModule, Name), Ar)
@@ -1272,7 +1266,7 @@
 				CtorArg = _ArgName - ArgType
 			)),
 		list__map(GetArgTypes, Args, ArgTypes),
-		propagate_type_info_inst_list(ArgTypes,
+		propagate_type_info_inst_list(ArgTypes, Subst,
 			ModuleInfo, ArgInsts0, ArgInsts),
 		BoundInst = functor(ConsId, ArgInsts)
 	;
@@ -1283,7 +1277,7 @@
 		BoundInst = functor(ConsId, ArgInsts0)
 	),
 	propagate_ctor_info_3(BoundInsts0, TypeModule,
-		Constructors, ModuleInfo, BoundInsts).
+		Constructors, Subst, ModuleInfo, BoundInsts).
 
 %-----------------------------------------------------------------------------%
 
Index: modecheck_call.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/modecheck_call.m,v
retrieving revision 1.8
diff -u -r1.8 modecheck_call.m
--- modecheck_call.m	1997/03/06 05:09:34	1.8
+++ modecheck_call.m	1997/03/17 01:21:58
@@ -84,12 +84,13 @@
 		list__length(Modes0, Arity)
 	->
 		Det = Det0,
+		Modes = Modes0,
 
 		%
 		% Check that `Args0' have livenesses which match the
 		% expected livenesses.
 		%
-		get_arg_lives(Modes0, ModuleInfo0, ExpectedArgLives),
+		get_arg_lives(Modes, ModuleInfo0, ExpectedArgLives),
 		modecheck_var_list_is_live(Args0, ExpectedArgLives, 1,
 			ModeInfo0, ModeInfo1),
 
@@ -98,9 +99,6 @@
 		% initial insts, and set their new final insts (introducing
 		% extra unifications for implied modes, if necessary).
 		%
-		% propagate type info into modes
-		propagate_type_info_mode_list(Types, ModuleInfo0, Modes0,
-			Modes),
 		mode_list_get_initial_insts(Modes, ModuleInfo0, InitialInsts),
 		modecheck_var_has_inst_list(Args0, InitialInsts, 1,
 					ModeInfo1, ModeInfo2),
@@ -158,7 +156,7 @@
 	->
 		TheProcId = ProcId,
 		map__lookup(Procs, ProcId, ProcInfo),
-		proc_info_argmodes(ProcInfo, ProcArgModes0),
+		proc_info_argmodes(ProcInfo, ProcArgModes),
 		proc_info_arglives(ProcInfo, ModuleInfo, ProcArgLives0),
 
 		%
@@ -168,11 +166,6 @@
 		modecheck_var_list_is_live(ArgVars0, ProcArgLives0, 0,
 					ModeInfo0, ModeInfo1),
 
-		% propagate type info into modes
-		mode_info_get_types_of_vars(ModeInfo0, ArgVars0, ArgTypes),
-		propagate_type_info_mode_list(ArgTypes, ModuleInfo,
-			ProcArgModes0, ProcArgModes),
-
 		%
 		% Check that `ArgsVars0' have insts which match the expected
 		% initial insts, and set their new final insts (introducing
@@ -252,13 +245,9 @@
 		% find the initial insts and the final livenesses
 		% of the arguments for this mode of the called pred
 	map__lookup(Procs, ProcId, ProcInfo),
-	proc_info_argmodes(ProcInfo, ProcArgModes0),
+	proc_info_argmodes(ProcInfo, ProcArgModes),
 	mode_info_get_module_info(ModeInfo0, ModuleInfo),
 	proc_info_arglives(ProcInfo, ModuleInfo, ProcArgLives0),
-		% propagate the type information into the modes
-	mode_info_get_types_of_vars(ModeInfo0, ArgVars0, ArgTypes),
-	propagate_type_info_mode_list(ArgTypes, ModuleInfo,
-		ProcArgModes0, ProcArgModes),
 	mode_list_get_initial_insts(ProcArgModes, ModuleInfo, InitialInsts),
 
 		% check whether the livenesses of the args matches their
@@ -322,8 +311,8 @@
 	MaybeDeterminism = no,
 
 	% create the new mode
-	add_new_proc(PredInfo0, Arity, Modes, yes(ArgLives), MaybeDeterminism,
-		Context, PredInfo1, ProcId),
+	add_new_proc(PredInfo0, Arity, Modes, no, yes(ArgLives),
+		MaybeDeterminism, Context, PredInfo1, ProcId),
 
 	% copy the clauses for the predicate to this procedure,
 	% and then store the new proc_info and pred_info
Index: modecheck_unify.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/modecheck_unify.m,v
retrieving revision 1.11
diff -u -r1.11 modecheck_unify.m
--- modecheck_unify.m	1997/03/06 05:09:37	1.11
+++ modecheck_unify.m	1997/03/18 00:30:28
@@ -377,7 +377,11 @@
 	mode_info_get_module_info(ModeInfo0, ModuleInfo0),
  
 	% initialize the initial insts of the lambda variables
-	mode_list_get_initial_insts(Modes, ModuleInfo0, VarInitialInsts),
+	mode_list_get_initial_insts(Modes, ModuleInfo0, VarInitialInsts0),
+	mode_info_get_types_of_vars(ModeInfo0, Vars, VarTypes),
+	map__init(TSubst),
+	propagate_type_info_inst_list(VarTypes, TSubst,
+		ModuleInfo0, VarInitialInsts0, VarInitialInsts),
 	assoc_list__from_corresponding_lists(Vars, VarInitialInsts, VarInstAL),
 	instmap_delta_from_assoc_list(VarInstAL, VarInstMapDelta),
 	mode_info_get_instmap(ModeInfo0, InstMap0),
Index: modes.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/modes.m,v
retrieving revision 1.195
diff -u -r1.195 modes.m
--- modes.m	1997/02/23 06:07:29	1.195
+++ modes.m	1997/03/17 03:15:07
@@ -490,21 +490,16 @@
 	;
 		proc_info_context(ProcInfo0, Context)
 	),
-		% extract the predicate's type from the pred_info
-		% and propagate the type information into the modes
-	pred_info_arg_types(PredInfo, _TypeVars, ArgTypes),
-	propagate_type_info_mode_list(ArgTypes, ModuleInfo0, ArgModes0,
-			ArgModes1),
 
 		% modecheck the clause - first set the initial instantiation
 		% of the head arguments, mode-check the body, and
 		% then check that the final instantiation matches that in
 		% the mode declaration
-	mode_list_get_initial_insts(ArgModes1, ModuleInfo0, ArgInitialInsts),
+	mode_list_get_initial_insts(ArgModes0, ModuleInfo0, ArgInitialInsts),
 	assoc_list__from_corresponding_lists(HeadVars, ArgInitialInsts, InstAL),
 	instmap__from_assoc_list(InstAL, InstMap0),
 		% initially, only the non-clobbered head variables are live
-	mode_list_get_final_insts(ArgModes1, ModuleInfo0, ArgFinalInsts0),
+	mode_list_get_final_insts(ArgModes0, ModuleInfo0, ArgFinalInsts0),
 	get_live_vars(HeadVars, ArgLives0, LiveVarsList),
 	set__list_to_set(LiveVarsList, LiveVars),
 	mode_info_init(IOState0, ModuleInfo0, PredId, ProcId,
Index: type_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/type_util.m,v
retrieving revision 1.39
diff -u -r1.39 type_util.m
--- type_util.m	1997/02/23 06:08:21	1.39
+++ type_util.m	1997/03/13 11:35:25
@@ -364,29 +364,28 @@
 		Constructors = Constructors0
 	;
 		term__term_list_to_var_list(TypeParams0, TypeParams),
-		substitute_type_args_2(Constructors0, TypeParams, TypeArgs,
-			Constructors)
+		map__from_corresponding_lists(TypeParams, TypeArgs, Subst),
+		substitute_type_args_2(Constructors0, Subst, Constructors)
 	).
 
-:- pred substitute_type_args_2(list(constructor), list(var), list(type),
+:- pred substitute_type_args_2(list(constructor), substitution,
 				list(constructor)).
-:- mode substitute_type_args_2(in, in, in, out) is det.
+:- mode substitute_type_args_2(in, in, out) is det.
 
-substitute_type_args_2([], _TypeParams, _TypeArgs, []).
-substitute_type_args_2([Name - Args0 | Ctors0], TypeParams, TypeArgs,
+substitute_type_args_2([], _, []).
+substitute_type_args_2([Name - Args0 | Ctors0], Subst,
 		[Name - Args | Ctors]) :-
-	substitute_type_args_3(Args0, TypeParams, TypeArgs, Args),
-	substitute_type_args_2(Ctors0, TypeParams, TypeArgs, Ctors).
+	substitute_type_args_3(Args0, Subst, Args),
+	substitute_type_args_2(Ctors0, Subst, Ctors).
 
-:- pred substitute_type_args_3(list(constructor_arg), list(var), list(type),
+:- pred substitute_type_args_3(list(constructor_arg), substitution,
 				list(constructor_arg)).
-:- mode substitute_type_args_3(in, in, in, out) is det.
+:- mode substitute_type_args_3(in, in, out) is det.
 
-substitute_type_args_3([], _TypeParams, _TypeArgs, []).
-substitute_type_args_3([Name - Arg0 | Args0], TypeParams, TypeArgs,
-		[Name - Arg | Args]) :-
-	term__substitute_corresponding(TypeParams, TypeArgs, Arg0, Arg),
-	substitute_type_args_3(Args0, TypeParams, TypeArgs, Args).
+substitute_type_args_3([], _, []).
+substitute_type_args_3([Name - Arg0 | Args0], Subst, [Name - Arg | Args]) :-
+	term__apply_substitution(Arg0, Subst, Arg),
+	substitute_type_args_3(Args0, Subst, Args).
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
Index: typecheck.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/typecheck.m,v
retrieving revision 1.189
diff -u -r1.189 typecheck.m
--- typecheck.m	1997/02/26 09:47:55	1.189
+++ typecheck.m	1997/03/17 01:07:22
@@ -230,19 +230,43 @@
 		ModuleInfo0, ModuleInfo, Error0, Error, Changed0, Changed) -->
 	{ module_info_preds(ModuleInfo0, Preds0) },
 	{ map__lookup(Preds0, PredId, PredInfo0) },
+	{ pred_info_procids(PredInfo0, ProcIds) },
 	(
 		{ pred_info_is_imported(PredInfo0) }
 	->
 		{ Error1 = Error0 },
-		{ ModuleInfo1 = ModuleInfo0 },
-		{ Changed2 = Changed0 }
+
+		% 
+		% Ensure that all constructors occurring in predicate mode
+		% declarations are module qualified.
+		% 
+		{
+		pred_info_arg_types(PredInfo0, _, ArgTypes),
+		pred_info_procedures(PredInfo0, Procs0),
+		typecheck_propagate_type_info_into_proc_modes(
+		    ModuleInfo0, ProcIds, ArgTypes, Procs0, Procs),
+		pred_info_set_procedures(PredInfo0, Procs, PredInfo),
+		map__set(Preds0, PredId, PredInfo, Preds),
+		module_info_set_preds(ModuleInfo0, Preds, ModuleInfo1),
+		Changed2 = Changed0
+		}
 	;
 		typecheck_pred_type(PredId, PredInfo0, ModuleInfo0,
 			MaybePredInfo, Changed1),
 		{
 			MaybePredInfo = yes(PredInfo1),
 			Error1 = Error0,
-			map__set(Preds0, PredId, PredInfo1, Preds),
+
+			% 
+			% Ensure that all constructors occurring in predicate 
+			% mode declarations are module qualified.
+			% 
+			pred_info_arg_types(PredInfo1, _, ArgTypes),
+			pred_info_procedures(PredInfo1, Procs1),
+			typecheck_propagate_type_info_into_proc_modes(
+			    ModuleInfo0, ProcIds, ArgTypes, Procs1, Procs),
+			pred_info_set_procedures(PredInfo1, Procs, PredInfo),
+			map__set(Preds0, PredId, PredInfo, Preds),
 			module_info_set_preds(ModuleInfo0, Preds, ModuleInfo1)
 		;
 			MaybePredInfo = no,
@@ -254,6 +278,23 @@
 	),
 	typecheck_pred_types_2(PredIds, ModuleInfo1, ModuleInfo, Error1, Error,
 		Changed2, Changed).
+
+:- pred typecheck_propagate_type_info_into_proc_modes(module_info,
+		list(proc_id), list(type), proc_table, proc_table).
+:- mode typecheck_propagate_type_info_into_proc_modes(in,
+		in, in, in, out) is det.		
+
+typecheck_propagate_type_info_into_proc_modes(_, [], _, Procs, Procs).
+typecheck_propagate_type_info_into_proc_modes(ModuleInfo, [ProcId | ProcIds],
+		ArgTypes, Procs0, Procs) :-
+	map__lookup(Procs0, ProcId, ProcInfo0),
+	proc_info_argmodes(ProcInfo0, ArgModes0),
+	propagate_type_info_mode_list(ArgTypes, ModuleInfo,
+		ArgModes0, ArgModes),
+	proc_info_set_argmodes(ProcInfo0, ArgModes, ProcInfo),
+	map__det_update(Procs0, ProcId, ProcInfo, Procs1),
+	typecheck_propagate_type_info_into_proc_modes(ModuleInfo, ProcIds,
+		ArgTypes, Procs1, Procs).
 
 :- pred typecheck_pred_type(pred_id, pred_info, module_info,
 	maybe(pred_info), bool, io__state, io__state).
Index: unify_proc.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/unify_proc.m,v
retrieving revision 1.54
diff -u -r1.54 unify_proc.m
--- unify_proc.m	1997/03/06 05:09:52	1.54
+++ unify_proc.m	1997/03/16 03:13:08
@@ -221,8 +221,8 @@
 		MaybeDet = yes(Determinism),
 		term__context_init(Context),
 		ArgLives = no,  % XXX ArgLives should be part of the UnifyId
-		add_new_proc(PredInfo0, Arity, ArgModes, ArgLives, MaybeDet,
-				Context, PredInfo1, ProcId),
+		add_new_proc(PredInfo0, Arity, ArgModes, no, ArgLives,
+				MaybeDet, Context, PredInfo1, ProcId),
 
 		%
 		% copy the clauses for the procedure from the pred_info to the
Index: unique_modes.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/unique_modes.m,v
retrieving revision 1.33
diff -u -r1.33 unique_modes.m
--- unique_modes.m	1997/03/18 07:18:06	1.33
+++ unique_modes.m	1997/03/18 23:45:46
@@ -126,26 +126,17 @@
 	% Extract the useful fields in the proc_info.
 	%
 	proc_info_headvars(ProcInfo0, Args),
-	proc_info_argmodes(ProcInfo0, ArgModes0),
+	proc_info_argmodes(ProcInfo0, ArgModes),
 	proc_info_arglives(ProcInfo0, ModuleInfo0, ArgLives),
 	proc_info_goal(ProcInfo0, Goal0),
 
 	%
-	% extract the predicate's type from the pred_info
-	% and propagate the type information into the modes
-	%
-	module_info_preds(ModuleInfo0, Preds),
-	map__lookup(Preds, PredId, PredInfo),
-	pred_info_arg_types(PredInfo, _TypeVars, ArgTypes),
-	propagate_type_info_mode_list(ArgTypes, ModuleInfo0, ArgModes0,
-			ArgModes),
-
-	%
 	% Figure out the right context to use.
 	% We use the context of the first clause, unless
 	% there weren't any clauses at all, in which case
 	% we use the context of the mode declaration.
 	%
+	module_info_pred_info(ModuleInfo0, PredId, PredInfo),
 	pred_info_clauses_info(PredInfo, ClausesInfo),
 	ClausesInfo = clauses_info(_, _, _, _, ClauseList),
 	( ClauseList = [FirstClause | _] ->
@@ -594,13 +585,9 @@
 :- mode unique_modes__check_call_modes(in, in, in, in,
 			mode_info_di, mode_info_uo) is det.
 
-unique_modes__check_call_modes(ArgVars, ProcArgModes0, CodeModel, NeverSucceeds,
+unique_modes__check_call_modes(ArgVars, ProcArgModes, CodeModel, NeverSucceeds,
 			ModeInfo0, ModeInfo) :-
 	mode_info_get_module_info(ModeInfo0, ModuleInfo),
-	% propagate type info into modes
-	mode_info_get_types_of_vars(ModeInfo0, ArgVars, ArgTypes),
-	propagate_type_info_mode_list(ArgTypes, ModuleInfo,
-		ProcArgModes0, ProcArgModes),
 	mode_list_get_initial_insts(ProcArgModes, ModuleInfo,
 				InitialInsts),
 	modecheck_var_has_inst_list(ArgVars, InitialInsts, 0,



More information about the developers mailing list