[m-dev.] for review: track module name for instance declarations

Fergus Henderson fjh at cs.mu.OZ.AU
Tue Oct 31 19:13:16 AEDT 2000


For review by Tyson.

Estimated hours taken: 6

Record the module that each instance declaration came from.
This is needed for the IL back-end, which includes that
module name in the symbol name that it generates for each
instance declaration.

compiler/prog_data.m:
	Add a module_name field to the `instance' item.

compiler/prog_io_typeclass.m:
	When parsing `instance' declarations, store the
	module name that they came from in the module_name field
	of the `instance' item.

compiler/hlds_data.m:
	Add a module_name field to the `hlds_instance_defn' structure.

compiler/make_hlds.m:
	Copy the module_name field from the `instance' item to the
	`hlds_instance_defn' structure.

compiler/polymorphism.m:
	Fix an old XXX: when constructing `base_typeclass_info_const's,
	use the module name from the `hlds_instance_defn', rather than
	hard-coding the invalid value "some bogus module name".

compiler/rtti.m:
	Add a module_name field to the `base_typeclass_info' rtti_name
	and rtti_data.

compiler/base_typeclass_info.m:
	Copy the module_name field in the `hlds_instance_defn' to the
	module_name field in the `base_typeclass_info' rtti_data
	and rtti_name.

compiler/rtti_to_mlds.m:
	When constructing mlds `data_addr's, use the module_name from
	the `base_typeclass_info' rtti_name, rather than assuming that
	such references always refer to instance declarations in the
	current module.  (That assumption would be a safe one currently,
	but doing it this way is probably a bit more robust against
	future changes.)

compiler/*.m:
	Trivial changes to reflect the above data structure changes.

Workspace: /home/pgrad/fjh/fs/roy/traveller/mercury2
Index: compiler/base_typeclass_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/base_typeclass_info.m,v
retrieving revision 1.19
diff -u -d -r1.19 base_typeclass_info.m
--- compiler/base_typeclass_info.m	2000/05/10 18:06:23	1.19
+++ compiler/base_typeclass_info.m	2000/10/30 08:03:26
@@ -75,9 +75,9 @@
 		ModuleName, ModuleInfo, RttiDataList) :-
 	base_typeclass_info__gen_infos_for_instance_list(ClassId - Is,
 		ModuleName, ModuleInfo, RttiDataList1),
-	InstanceDefn = hlds_instance_defn(ImportStatus, _TermContext,
-				InstanceConstraints, InstanceTypes, Body,
-				PredProcIds, _Varset, _SuperClassProofs),
+	InstanceDefn = hlds_instance_defn(InstanceModule, ImportStatus,
+			_TermContext, InstanceConstraints, InstanceTypes, Body,
+			PredProcIds, _Varset, _SuperClassProofs),
 	(
 		Body = concrete(_),
 			% Only make the base_typeclass_info if the instance
@@ -89,8 +89,8 @@
 		base_typeclass_info__gen_body(PredProcIds,
 			InstanceTypes, InstanceConstraints, ModuleInfo, 
 			ClassId, BaseTypeClassInfo),
-		RttiData = base_typeclass_info(ClassId, InstanceString,
-			BaseTypeClassInfo),
+		RttiData = base_typeclass_info(InstanceModule,
+			ClassId, InstanceString, BaseTypeClassInfo),
 		RttiDataList = [RttiData | RttiDataList1]
 	;
 			% The instance decl is from another module,
Index: compiler/check_typeclass.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/check_typeclass.m,v
retrieving revision 1.35
diff -u -d -r1.35 check_typeclass.m
--- compiler/check_typeclass.m	2000/10/31 01:35:26	1.35
+++ compiler/check_typeclass.m	2000/10/31 06:13:29
@@ -166,7 +166,8 @@
 		IO0, IO):-
 		
 		% check conformance of the instance body
-	InstanceDefn0 = hlds_instance_defn(_, _, _, _, InstanceBody, _, _, _),
+	InstanceDefn0 = hlds_instance_defn(_, _, _, _, _, InstanceBody,
+		_, _, _),
 	(
 		InstanceBody = abstract,
 		InstanceDefn2 = InstanceDefn0,
@@ -192,8 +193,8 @@
 		% handled by check_instance_pred, but we also need to handle
 		% it below, in case the class has no methods.
 		%
-		InstanceDefn1 = hlds_instance_defn(A, B, C, D, _, 
-				MaybePredProcs1, G, H),
+		InstanceDefn1 = hlds_instance_defn(A, B, C, D, E, _, 
+				MaybePredProcs1, H, I),
 		(
 			MaybePredProcs1 = yes(_),
 			MaybePredProcs = MaybePredProcs1
@@ -208,16 +209,16 @@
 		% relies on this
 		OrderedInstanceMethods = list__reverse(RevInstanceMethods),
 
-		InstanceDefn2 = hlds_instance_defn(A, B, C, D,
+		InstanceDefn2 = hlds_instance_defn(A, B, C, D, E,
 				concrete(OrderedInstanceMethods),
-				MaybePredProcs, G, H),
+				MaybePredProcs, H, I),
 
 		%
 		% Check if there are any instance methods left over,
 		% which did not match any of the methods from the
 		% class interface.
 		%
-		InstanceDefn2 = hlds_instance_defn(_, Context,
+		InstanceDefn2 = hlds_instance_defn(_, _, Context,
 			_, _, _, _, _, _),
 		check_for_bogus_methods(InstanceMethods, ClassId, PredIds,
 			Context, ModuleInfo1, Errors1, Errors2)
@@ -403,7 +404,7 @@
 		ProcIds, 
 		ArgModes),
 	
-	InstanceDefn0 = hlds_instance_defn(Status, _, _, InstanceTypes, 
+	InstanceDefn0 = hlds_instance_defn(_, Status, _, _, InstanceTypes, 
 		_, _, _, _),
 
 		% Work out the name of the predicate that we will generate
@@ -440,10 +441,10 @@
 check_instance_pred_procs(ClassId, ClassVars, MethodName, Markers,
 		InstanceDefn0, InstanceDefn, OrderedInstanceMethods0,
 		OrderedInstanceMethods, Info0, Info, IO0, IO) :-
-	InstanceDefn0 = hlds_instance_defn(A, InstanceContext, 
+	InstanceDefn0 = hlds_instance_defn(A, B, InstanceContext, 
 				InstanceConstraints, InstanceTypes,
 				InstanceBody, MaybeInstancePredProcs,
-				InstanceVarSet, H),
+				InstanceVarSet, I),
 	Info0 = instance_method_info(ModuleInfo, QualInfo, PredName, Arity,
 		ExistQVars, ArgTypes, ClassContext, ArgModes, Errors0,
 		ArgTypeVars, Status, PredOrFunc),
@@ -478,9 +479,9 @@
 			MaybeInstancePredProcs = no,
 			InstancePredProcs = InstancePredProcs1
 		),
-		InstanceDefn = hlds_instance_defn(A, Context, 
+		InstanceDefn = hlds_instance_defn(A, B, Context, 
 			InstanceConstraints, InstanceTypes, InstanceBody,
-			yes(InstancePredProcs), InstanceVarSet, H)
+			yes(InstancePredProcs), InstanceVarSet, I)
 	;
 		MatchingInstanceMethods = [I1, I2 | Is]
 	->
@@ -767,8 +768,8 @@
 		InstanceDefn0, InstanceDefn, 
 		Errors0 - ModuleInfo, Errors - ModuleInfo) :-
 
-	InstanceDefn0 = hlds_instance_defn(A, Context, InstanceConstraints,
-		InstanceTypes, E, F, InstanceVarSet0, Proofs0),
+	InstanceDefn0 = hlds_instance_defn(A, B, Context, InstanceConstraints,
+		InstanceTypes, F, G, InstanceVarSet0, Proofs0),
 	varset__merge_subst(InstanceVarSet0, ClassVarSet, InstanceVarSet1,
 		Subst),
 
@@ -805,8 +806,8 @@
 		UnprovenConstraints = []
 	->
 		Errors = Errors0,
-		InstanceDefn = hlds_instance_defn(A, Context, 
-			InstanceConstraints, InstanceTypes, E, F, 
+		InstanceDefn = hlds_instance_defn(A, B, Context, 
+			InstanceConstraints, InstanceTypes, F, G,
 			InstanceVarSet2, Proofs1)
 	;
 		ClassId = class_id(ClassName, _ClassArity),
Index: compiler/dead_proc_elim.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dead_proc_elim.m,v
retrieving revision 1.61
diff -u -d -r1.61 dead_proc_elim.m
--- compiler/dead_proc_elim.m	2000/09/21 00:21:42	1.61
+++ compiler/dead_proc_elim.m	2000/10/30 08:03:27
@@ -228,7 +228,7 @@
 :- mode get_instance_pred_procs(in, in, out, in, out) is det.
 
 get_instance_pred_procs(Instance, Queue0, Queue, Needed0, Needed) :-
-	Instance = hlds_instance_defn(_, _, _, _, _, PredProcIds, _, _),
+	Instance = hlds_instance_defn(_, _, _, _, _, _, PredProcIds, _, _),
 
 	%
 	% We need to keep the instance methods for all instances
Index: compiler/equiv_type.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/equiv_type.m,v
retrieving revision 1.22
diff -u -d -r1.22 equiv_type.m
--- compiler/equiv_type.m	2000/03/27 05:07:34	1.22
+++ compiler/equiv_type.m	2000/10/30 08:03:27
@@ -157,10 +157,10 @@
 
 equiv_type__replace_in_item(
 			instance(Constraints0, ClassName, Ts0, 
-				InstanceBody, VarSet0),
+				InstanceBody, VarSet0, ModName),
 			EqvMap,
 			instance(Constraints, ClassName, Ts, 
-				InstanceBody, VarSet),
+				InstanceBody, VarSet, ModName),
 			no) :-
 	equiv_type__replace_in_class_constraint_list(Constraints0, VarSet0, 
 				EqvMap, Constraints, VarSet1),
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.80
diff -u -d -r1.80 higher_order.m
--- compiler/higher_order.m	2000/10/31 02:01:10	1.80
+++ compiler/higher_order.m	2000/10/31 06:13:39
@@ -760,7 +760,7 @@
 			module_info_instances(ModuleInfo, Instances),
 			map__lookup(Instances, ClassId, InstanceList),
 			list__index1_det(InstanceList, Instance, InstanceDefn),
-			InstanceDefn = hlds_instance_defn(_, _,
+			InstanceDefn = hlds_instance_defn(_, _, _,
 				InstanceConstraints, InstanceTypes0, _,
 				yes(ClassInterface), _, _),
 			term__vars_list(InstanceTypes0, InstanceTvars),
@@ -862,7 +862,7 @@
 		TVarSet = TVarSet1,
 		Constraints = Constraints0,
 		UnconstrainedTVarTypes = UnconstrainedTVarTypes0,
-		Instance = hlds_instance_defn(_, _, _,
+		Instance = hlds_instance_defn(_, _, _, _,
 			_, _, yes(ClassInterface), _, _),
 		list__index1_det(ClassInterface, MethodNum,
 			hlds_class_proc(PredId, ProcId))
@@ -878,7 +878,7 @@
 
 instance_matches(ClassTypes, Instance, Constraints, UnconstrainedTVarTypes,
 		TVarSet0, TVarSet) :-
-	Instance = hlds_instance_defn(_, _, Constraints0,
+	Instance = hlds_instance_defn(_, _, _, Constraints0,
 		InstanceTypes0, _, _, InstanceTVarSet, _),
 	varset__merge_subst(TVarSet0, InstanceTVarSet, TVarSet,
 		RenameSubst),
@@ -1679,7 +1679,7 @@
 		module_info_instances(ModuleInfo, Instances),
 		map__lookup(Instances, ClassId, InstanceDefns),
 		list__index1_det(InstanceDefns, InstanceNum, InstanceDefn),
-		InstanceDefn = hlds_instance_defn(_, _, Constraints, _,_,_,_,_),
+		InstanceDefn = hlds_instance_defn(_,_,_,Constraints,_,_,_,_,_),
 		(
 			Manipulator = type_info_from_typeclass_info,
 			list__length(Constraints, NumConstraints),
Index: compiler/hlds_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_data.m,v
retrieving revision 1.49
diff -u -d -r1.49 hlds_data.m
--- compiler/hlds_data.m	2000/10/26 06:05:32	1.49
+++ compiler/hlds_data.m	2000/10/31 06:13:39
@@ -827,6 +827,7 @@
 	% Information about a single `instance' declaration
 :- type hlds_instance_defn 
 	--->	hlds_instance_defn(
+			module_name,		% module of the instance decl
 			import_status,		% import status of the instance
 						% declaration
 			prog_context,		% context of declaration
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.247
diff -u -d -r1.247 hlds_out.m
--- compiler/hlds_out.m	2000/10/13 04:04:35	1.247
+++ compiler/hlds_out.m	2000/10/30 08:03:28
@@ -2702,8 +2702,8 @@
 
 hlds_out__write_instance_defn(Indent, InstanceDefn) -->
 
-	{ InstanceDefn = hlds_instance_defn(_, Context,
-		Constraints, Types, Body,
+	{ InstanceDefn = hlds_instance_defn(_InstanceModule, _Status,
+		Context, Constraints, Types, Body,
 		MaybePredProcIds, VarSet, Proofs) },
 
 	{ term__context_file(Context, FileName) },
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.85
diff -u -d -r1.85 intermod.m
--- compiler/intermod.m	2000/10/27 06:16:01	1.85
+++ compiler/intermod.m	2000/10/31 06:13:44
@@ -818,8 +818,8 @@
 	hlds_instance_defn::in, intermod_info::in, intermod_info::out) is det.
 		
 intermod__gather_instances_3(ModuleInfo, ClassId, InstanceDefn) -->
-	{ InstanceDefn = hlds_instance_defn(Status, B, C, D, Interface0,
-				MaybePredProcIds, F, G) },
+	{ InstanceDefn = hlds_instance_defn(A, Status, C, D, E, Interface0,
+				MaybePredProcIds, H, I) },
 	(
 		%
 		% The bodies are always stripped from instance declarations
@@ -894,9 +894,9 @@
 				status_is_exported(Status, no)
 			}
 		->
-			{ InstanceDefnToWrite = hlds_instance_defn(Status,
-					B, C, D, Interface, MaybePredProcIds,
-					F, G) },
+			{ InstanceDefnToWrite = hlds_instance_defn(A, Status,
+					C, D, E, Interface, MaybePredProcIds,
+					H, I) },
 			intermod_info_get_instances(Instances0),
 			intermod_info_set_instances(
 				[ClassId - InstanceDefnToWrite | Instances0])
@@ -1269,10 +1269,11 @@
 		io__state::di, io__state::uo) is det.
 
 intermod__write_instance(ClassId - InstanceDefn) -->
-	{ InstanceDefn = hlds_instance_defn(_, Context, Constraints,
-				Types, Body, _, TVarSet, _) },
+	{ InstanceDefn = hlds_instance_defn(ModuleName, _, Context,
+			Constraints, Types, Body, _, TVarSet, _) },
 	{ ClassId = class_id(ClassName, _) },
-	{ Item = instance(Constraints, ClassName, Types, Body, TVarSet) },
+	{ Item = instance(Constraints, ClassName, Types, Body, TVarSet,
+		ModuleName) },
 	mercury_output_item(Item, Context).
 
 	% We need to write all the declarations for local predicates so
@@ -1913,16 +1914,17 @@
 	hlds_instance_defn::out, module_info::in, module_info::out) is det.
 
 adjust_instance_status_3(Instance0, Instance, ModuleInfo0, ModuleInfo) :-
-	Instance0 = hlds_instance_defn(Status0, Context, Constraints, Types,
-			Body, HLDSClassInterface, TVarSet, ConstraintProofs),
+	Instance0 = hlds_instance_defn(InstanceModule, Status0, Context,
+			Constraints, Types, Body, HLDSClassInterface,
+			TVarSet, ConstraintProofs),
 	(
 		( Status0 = local
 		; Status0 = abstract_exported
 		)
 	->
-		Instance = hlds_instance_defn(exported, Context, Constraints,
-				Types, Body, HLDSClassInterface, TVarSet,
-				ConstraintProofs),
+		Instance = hlds_instance_defn(InstanceModule, exported,
+			Context, Constraints, Types, Body, HLDSClassInterface,
+			TVarSet, ConstraintProofs),
 		( HLDSClassInterface = yes(ClassInterface) ->
 			class_procs_to_pred_ids(ClassInterface, PredIds),
 			set_list_of_preds_exported(PredIds,
Index: compiler/llds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.161
diff -u -d -r1.161 llds_out.m
--- compiler/llds_out.m	2000/10/31 02:15:44	1.161
+++ compiler/llds_out.m	2000/10/31 06:13:48
@@ -3004,7 +3004,7 @@
 		LaterIndent) -->
 	( { DataVarName = base_typeclass_info(ClassId, Instance) } ->
 		output_base_typeclass_info_storage_type_name(
-			ClassId, Instance, no)
+			ModuleName, ClassId, Instance, no)
 	;
 		{ data_name_linkage(DataVarName, Linkage) },
 		globals__io_get_globals(Globals),
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.356
diff -u -d -r1.356 make_hlds.m
--- compiler/make_hlds.m	2000/10/27 06:42:52	1.356
+++ compiler/make_hlds.m	2000/10/31 06:13:50
@@ -352,7 +352,7 @@
 
 	% We add instance declarations on the second pass so that we don't add
 	% an instance declaration before its class declaration.
-add_item_decl_pass_1(instance(_, _, _, _, _), _, Status, Module, Status,
+add_item_decl_pass_1(instance(_, _, _, _, _, _), _, Status, Module, Status,
 	Module) --> [].
 
 %-----------------------------------------------------------------------------%
@@ -577,16 +577,17 @@
 add_item_decl_pass_2(nothing, _, Status, Module, Status, Module) --> [].
 add_item_decl_pass_2(typeclass(_, _, _, _, _)
 	, _, Status, Module, Status, Module) --> [].
-add_item_decl_pass_2(instance(Constraints, Name, Types, Body, VarSet), 
-		Context, Status, Module0, Status, Module) -->
+add_item_decl_pass_2(instance(Constraints, Name, Types, Body, VarSet,
+		InstanceModuleName), Context,
+		Status, Module0, Status, Module) -->
 	{ Status = item_status(ImportStatus, _) },
 	{ Body = abstract ->
 		make_status_abstract(ImportStatus, BodyStatus)
 	;
 		BodyStatus = ImportStatus
 	},
-	module_add_instance_defn(Module0, Constraints, Name, Types, Body,
-		VarSet, BodyStatus, Context, Module).
+	module_add_instance_defn(Module0, InstanceModuleName, Constraints,
+		Name, Types, Body, VarSet, BodyStatus, Context, Module).
 
 %------------------------------------------------------------------------------
 
@@ -779,7 +780,7 @@
 add_item_clause(nothing, Status, Status, _, Module, Module, Info, Info) --> [].
 add_item_clause(typeclass(_, _, _, _, _),
 	Status, Status, _, Module, Module, Info, Info) --> [].
-add_item_clause(instance(_, _, _, _, _),
+add_item_clause(instance(_, _, _, _, _, _),
 	Status, Status, _, Module, Module, Info, Info) --> [].
 
 %-----------------------------------------------------------------------------%
@@ -2504,14 +2505,15 @@
 	add_default_class_method_func_modes(Ms, PredProcIds1, PredProcIds,
 		Module1, Module).
 
-:- pred module_add_instance_defn(module_info, list(class_constraint), sym_name,
-	list(type), instance_body, tvarset, import_status, prog_context, 
-	module_info, io__state, io__state).
-:- mode module_add_instance_defn(in, in, in, in, in, in, in, in, out, 
-	di, uo) is det.
+:- pred module_add_instance_defn(module_info, module_name,
+		list(class_constraint), sym_name, list(type), instance_body,
+		tvarset, import_status, prog_context, module_info,
+		io__state, io__state).
+:- mode module_add_instance_defn(in, in, in, in, in, in, in, in, in, out, 
+		di, uo) is det.
 
-module_add_instance_defn(Module0, Constraints, ClassName, Types, Body, VarSet,
-		Status, Context, Module) -->
+module_add_instance_defn(Module0, InstanceModuleName, Constraints, ClassName,
+		Types, Body, VarSet, Status, Context, Module) -->
 	{ module_info_classes(Module0, Classes) },
 	{ module_info_instances(Module0, Instances0) },
 	{ list__length(Types, ClassArity) },
@@ -2520,8 +2522,9 @@
 		{ map__search(Classes, ClassId, _) }
 	->
 		{ map__init(Empty) },
-		{ NewInstanceDefn = hlds_instance_defn(Status, Context,
-			Constraints, Types, Body, no, VarSet, Empty) },
+		{ NewInstanceDefn = hlds_instance_defn(InstanceModuleName,
+			Status, Context, Constraints, Types, Body, no,
+			VarSet, Empty) },
 		{ map__lookup(Instances0, ClassId, InstanceDefns) },
 		check_for_overlapping_instances(NewInstanceDefn, InstanceDefns,
 			ClassId),
@@ -2540,11 +2543,11 @@
 
 check_for_overlapping_instances(NewInstanceDefn, InstanceDefns, ClassId) -->
 	{ IsOverlapping = lambda([(Context - OtherContext)::out] is nondet, (
-		NewInstanceDefn = hlds_instance_defn(_Status, Context,
+		NewInstanceDefn = hlds_instance_defn(_, _Status, Context,
 				_, Types, Body, _, VarSet, _),
 		Body \= abstract, % XXX
 		list__member(OtherInstanceDefn, InstanceDefns),
-		OtherInstanceDefn = hlds_instance_defn(_OtherStatus,
+		OtherInstanceDefn = hlds_instance_defn(_, _OtherStatus,
 				OtherContext, _, OtherTypes, OtherBody,
 				_, OtherVarSet, _),
 		OtherBody \= abstract, % XXX
Index: compiler/mercury_to_goedel.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_goedel.m,v
retrieving revision 1.70
diff -u -d -r1.70 mercury_to_goedel.m
--- compiler/mercury_to_goedel.m	2000/04/22 07:11:51	1.70
+++ compiler/mercury_to_goedel.m	2000/10/30 08:03:32
@@ -213,7 +213,7 @@
 	io__write_string(Stderr, 
 			"warning: typeclass declarations not allowed. Ignoring\n").
 
-goedel_output_item(instance(_, _, _, _, _), _) -->
+goedel_output_item(instance(_, _, _, _, _, _), _) -->
 	io__stderr_stream(Stderr),
 	io__write_string(Stderr, 
 			"warning: instance declarations not allowed. Ignoring\n").
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.178
diff -u -d -r1.178 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m	2000/10/31 02:18:57	1.178
+++ compiler/mercury_to_mercury.m	2000/10/31 06:41:16
@@ -488,7 +488,7 @@
 	
 	io__write_string("\n].\n").
 mercury_output_item(instance(Constraints, ClassName, Types, Body, 
-		VarSet), _) --> 
+		VarSet, _InstanceModuleName), _) --> 
 	io__write_string(":- instance "),
 
 		% We put an extra set of brackets around the class name in
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.37
diff -u -d -r1.37 mlds.m
--- compiler/mlds.m	2000/10/30 07:09:02	1.37
+++ compiler/mlds.m	2000/10/31 06:13:56
@@ -1126,9 +1126,13 @@
 	% Stuff for handling polymorphism/RTTI and type classes.
 	%
 	;	rtti(rtti_type_id, rtti_name)
-	;	base_typeclass_info(hlds_data__class_id, string)
-			% class name & class arity, names and arities of the
-			% types
+	;	base_typeclass_info(
+			hlds_data__class_id,	% class name & class arity,
+			string			% a mangled string that encodes
+						% the names and arities of the
+						% types in the instance
+						% declaration
+		)
 	%
 	% Stuff for handling debugging and accurate garbage collection.
 	% (Those features are not yet implemented for the MLDS back-end,
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.60
diff -u -d -r1.60 module_qual.m
--- compiler/module_qual.m	2000/10/13 13:55:46	1.60
+++ compiler/module_qual.m	2000/10/30 08:03:33
@@ -228,7 +228,7 @@
 collect_mq_info_2(nothing, Info, Info).
 collect_mq_info_2(typeclass(_, Name, Vars, _, _), Info0, Info) :-
 	add_typeclass_defn(Name, Vars, Info0, Info).
-collect_mq_info_2(instance(_,_,_,_,_), Info, Info).
+collect_mq_info_2(instance(_,_,_,_,_,_), Info, Info).
 
 
 % Predicates to add the type, inst, mode and typeclass ids visible
@@ -571,9 +571,9 @@
 	qualify_class_constraint_list(Constraints0, Constraints, Info1, Info2),
 	qualify_class_interface(Interface0, Interface, Info2, Info).
 
-module_qualify_item(instance(Constraints0, Name0, Types0, Body0, VarSet) -
-			Context, 
-		instance(Constraints, Name, Types, Body, VarSet) -
+module_qualify_item(instance(Constraints0, Name0, Types0, Body0, VarSet,
+		ModName) - Context, 
+		instance(Constraints, Name, Types, Body, VarSet, ModName) -
 			Context, 
 		Info0, Info, yes) -->
 	{ list__length(Types0, Arity) },
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.135
diff -u -d -r1.135 modules.m
--- compiler/modules.m	2000/10/30 00:37:21	1.135
+++ compiler/modules.m	2000/10/31 06:14:02
@@ -4334,10 +4334,12 @@
 :- pred make_abstract_instance(item, item).
 :- mode make_abstract_instance(in, out) is semidet.
 
-make_abstract_instance(Item, Item1) :-
-	Item = instance(Constraints, Class, ClassTypes, Body0, TVarSet),
+make_abstract_instance(Item0, Item) :-
+	Item0 = instance(Constraints, Class, ClassTypes, Body0, TVarSet,
+		ModName),
 	Body0 = concrete(_),
 	Body = abstract,
-	Item1 = instance(Constraints, Class, ClassTypes, Body, TVarSet).
+	Item = instance(Constraints, Class, ClassTypes, Body, TVarSet,
+		ModName).
 
 %-----------------------------------------------------------------------------%
Index: compiler/opt_debug.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/opt_debug.m,v
retrieving revision 1.108
diff -u -d -r1.108 opt_debug.m
--- compiler/opt_debug.m	2000/10/31 02:15:45	1.108
+++ compiler/opt_debug.m	2000/10/31 06:14:03
@@ -791,7 +791,8 @@
 	Str = "du_ptag_ordered_table".
 opt_debug__dump_rtti_name(type_ctor_info, Str) :-
 	Str = "type_ctor_info".
-opt_debug__dump_rtti_name(base_typeclass_info(ClassId, InstanceStr), Str) :-
+opt_debug__dump_rtti_name(base_typeclass_info(_ModuleName, ClassId,
+		InstanceStr), Str) :-
 	llds_out__make_base_typeclass_info_name(ClassId, InstanceStr, Str).
 opt_debug__dump_rtti_name(pseudo_type_info(_Pseudo), Str) :-
 	% XXX should give more info than this
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.201
diff -u -d -r1.201 polymorphism.m
--- compiler/polymorphism.m	2000/10/13 13:55:48	1.201
+++ compiler/polymorphism.m	2000/10/30 08:03:34
@@ -2012,7 +2012,7 @@
 			list__index1_det(InstanceList, InstanceNum,
 				ProofInstanceDefn),
 
-			ProofInstanceDefn = hlds_instance_defn(_, _,
+			ProofInstanceDefn = hlds_instance_defn(_, _, _,
 				InstanceConstraints0, InstanceTypes0, _, _, 
 				InstanceTVarset, SuperClassProofs0),
 
@@ -2257,12 +2257,14 @@
 	polymorphism__new_typeclass_info_var(VarSet0, VarTypes0,
 		Constraint, ClassNameString, BaseVar, VarSet1, VarTypes1),
 
-		% XXX I don't think we actually need to carry the module name
-		% around.
-	ModuleName = unqualified("some bogus module name"),
+	module_info_instances(ModuleInfo, InstanceTable),
+	map__lookup(InstanceTable, ClassId, InstanceList),
+	list__index1_det(InstanceList, InstanceNum, InstanceDefn),
+	InstanceDefn = hlds_instance_defn(InstanceModuleName,
+		_, _, _, _, _, _, _, _),
 	base_typeclass_info__make_instance_string(InstanceTypes,
 		InstanceString),
-	ConsId = base_typeclass_info_const(ModuleName, ClassId,
+	ConsId = base_typeclass_info_const(InstanceModuleName, ClassId,
 		InstanceNum, InstanceString),
 	BaseTypeClassInfoTerm = functor(ConsId, []),
 
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.60
diff -u -d -r1.60 prog_data.m
--- compiler/prog_data.m	2000/10/27 03:12:31	1.60
+++ compiler/prog_data.m	2000/10/31 06:14:07
@@ -91,9 +91,9 @@
 		%	ClassMethods, VarNames
 
 	;	instance(list(class_constraint), class_name, list(type),
-			instance_body, tvarset)
+			instance_body, tvarset, module_name)
 		%	DerivingClass, ClassName, Types, 
-		%	MethodInstances, VarNames
+		%	MethodInstances, VarNames, ModuleContainingInstance
 
 	;	nothing.
 		% used for items that should be ignored (currently only
Index: compiler/prog_io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io.m,v
retrieving revision 1.193
diff -u -d -r1.193 prog_io.m
--- compiler/prog_io.m	2000/10/13 13:55:53	1.193
+++ compiler/prog_io.m	2000/10/30 08:03:35
@@ -148,7 +148,7 @@
 
 	% parse_qualified_term/4 takes a term (and also the containing
 	% term, and a string describing the context from which it
-	% was called [e.g. "clause head"] and the containing term)
+	% was called [e.g. "clause head"])
 	% and returns a sym_name and a list of argument terms.
 	% Returns an error on ill-formed input.
 	% See also parse_implicitly_qualified_term/5 (below).
Index: compiler/prog_io_typeclass.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_typeclass.m,v
retrieving revision 1.17
diff -u -d -r1.17 prog_io_typeclass.m
--- compiler/prog_io_typeclass.m	2000/10/18 18:22:48	1.17
+++ compiler/prog_io_typeclass.m	2000/10/30 08:03:35
@@ -389,10 +389,11 @@
 		->
 			Result = Result0
 		;
-			Result0 = ok(instance(_, Name, Types, Body, VarSet0))
+			Result0 = ok(instance(_, Name, Types, Body, VarSet,
+				ModName))
 		->
 			Result = ok(instance(ConstraintList, Name, Types, Body,
-					VarSet0))
+					VarSet, ModName))
 		;
 				% if the item we get back isn't an instance, 
 				% something has gone wrong...
@@ -417,7 +418,7 @@
 :- pred parse_underived_instance(module_name, term, tvarset, maybe1(item)).
 :- mode parse_underived_instance(in, in, in, out) is det.
 
-parse_underived_instance(_ModuleName, Name, TVarSet, Result) :-
+parse_underived_instance(ModuleName, Name, TVarSet, Result) :-
 		% We don't give a default module name here since the instance
 		% declaration could well be for a typeclass defined in another
 		% module
@@ -459,7 +460,7 @@
 		(
 			ErroneousTypes = [],
 			Result = ok(instance([], ClassName,
-				TermTypes, abstract, TVarSet))
+				TermTypes, abstract, TVarSet, ModuleName))
 		;
 				% XXX We should report an error for _each_
 				% XXX erroneous type
@@ -488,10 +489,10 @@
 			Result = error(String, Term)
 		;
 			ParsedNameAndTypes = ok(instance(Constraints,
-				NameString, Types, _, _))
+				NameString, Types, _, _, ModName))
 		->
 			Result0 = ok(instance(Constraints, NameString, Types,
-				concrete(MethodList), TVarSet)),
+				concrete(MethodList), TVarSet, ModName)),
 			check_tvars_in_instance_constraint(Result0, Name,
 				Result)
 		;
@@ -509,7 +510,10 @@
 
 check_tvars_in_instance_constraint(error(M,E), _, error(M, E)).
 check_tvars_in_instance_constraint(ok(Item), InstanceTerm, Result) :-
-	( Item = instance(Constraints, _Name, Types, _Methods, _TVarSet) ->
+	(
+		Item = instance(Constraints, _Name, Types, _Methods, _TVarSet,
+			_ModName)
+	->
 		%
 		% check that all of the type variables in the constraints
 		% on the instance declaration also occur in the type class
Index: compiler/rtti.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti.m,v
retrieving revision 1.8
diff -u -d -r1.8 rtti.m
--- compiler/rtti.m	2000/05/10 18:07:04	1.8
+++ compiler/rtti.m	2000/10/30 08:03:37
@@ -300,6 +300,7 @@
 		)
 	;	pseudo_type_info(pseudo_type_info)
 	;	base_typeclass_info(
+			module_name,	% module containing instance decl.
 			class_id,	% specifies class name & class arity
 			string,		% encodes the names and arities of the
 					% types in the instance declaration
@@ -324,6 +325,7 @@
 	;	type_ctor_info
 	;	pseudo_type_info(pseudo_type_info)
 	;	base_typeclass_info(
+			module_name,	% module containing instance decl.
 			class_id,	% specifies class name & class arity
 			string		% encodes the names and arities of the
 					% types in the instance declaration
@@ -461,7 +463,7 @@
 	RttiTypeId, du_ptag_ordered_table).
 rtti_data_to_name(type_ctor_info(RttiTypeId, _,_,_,_,_,_,_,_,_,_,_,_),
 	RttiTypeId, type_ctor_info).
-rtti_data_to_name(base_typeclass_info(_, _, _), _, _) :-
+rtti_data_to_name(base_typeclass_info(_, _, _, _), _, _) :-
 	% there's no rtti_type_id associated with a base_typeclass_info
 	error("rtti_data_to_name: base_typeclass_info").
 rtti_data_to_name(pseudo_type_info(PseudoTypeInfo), RttiTypeId,
@@ -490,7 +492,7 @@
 rtti_name_has_array_type(du_ptag_ordered_table)		= yes.
 rtti_name_has_array_type(type_ctor_info)		= no.
 rtti_name_has_array_type(pseudo_type_info(_))		= no.
-rtti_name_has_array_type(base_typeclass_info(_, _))	= yes.
+rtti_name_has_array_type(base_typeclass_info(_, _, _))	= yes.
 rtti_name_has_array_type(type_hashcons_pointer)		= no.
 
 rtti_name_is_exported(exist_locns(_))		= no.
@@ -508,7 +510,7 @@
 rtti_name_is_exported(type_ctor_info)           = yes.
 rtti_name_is_exported(pseudo_type_info(Pseudo)) =
 	pseudo_type_info_is_exported(Pseudo).
-rtti_name_is_exported(base_typeclass_info(_, _)) = yes.
+rtti_name_is_exported(base_typeclass_info(_, _, _)) = yes.
 rtti_name_is_exported(type_hashcons_pointer)    = no.
 
 :- func pseudo_type_info_is_exported(pseudo_type_info) = bool.
@@ -606,7 +608,8 @@
 		RttiName = pseudo_type_info(PseudoTypeInfo),
 		rtti__pseudo_type_info_to_string(PseudoTypeInfo, Str)
 	;
-		RttiName = base_typeclass_info(ClassId, InstanceStr),
+		RttiName = base_typeclass_info(_ModuleName, ClassId,
+			InstanceStr),
 		ClassId = class_id(ClassSym, ClassArity),
 		llds_out__sym_name_mangle(ClassSym, MangledClassString),
 		string__int_to_string(ClassArity, ArityString),
Index: compiler/rtti_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti_out.m,v
retrieving revision 1.16
diff -u -d -r1.16 rtti_out.m
--- compiler/rtti_out.m	2000/10/26 03:28:00	1.16
+++ compiler/rtti_out.m	2000/10/31 06:14:14
@@ -23,7 +23,7 @@
 
 :- interface.
 
-:- import_module hlds_data.
+:- import_module prog_data, hlds_data.
 :- import_module rtti, llds_out.
 :- import_module bool, io.
 
@@ -67,8 +67,9 @@
 
 	% The same as output_rtti_addr_storage_type_name,
 	% but for a base_typeclass_info.
-:- pred output_base_typeclass_info_storage_type_name(class_id::in, string::in,
-		bool::in, io__state::di, io__state::uo) is det.
+:- pred output_base_typeclass_info_storage_type_name(module_name::in,
+		class_id::in, string::in, bool::in,
+		io__state::di, io__state::uo) is det.
 
         % Return true iff the given type of RTTI data structure includes
 	% code addresses.
@@ -379,25 +380,25 @@
 %	io__write_string(",\n\t"),
 %	output_maybe_static_code_addr(Prettyprinter),
 	io__write_string("\n};\n").
-output_rtti_data_defn(base_typeclass_info(ClassId, InstanceString,
-		BaseTypeClassInfo), DeclSet0, DeclSet) -->
-	output_base_typeclass_info_defn(ClassId, InstanceString,
-		BaseTypeClassInfo, DeclSet0, DeclSet).
+output_rtti_data_defn(base_typeclass_info(InstanceModuleName, ClassId,
+		InstanceString, BaseTypeClassInfo), DeclSet0, DeclSet) -->
+	output_base_typeclass_info_defn(InstanceModuleName, ClassId,
+		InstanceString, BaseTypeClassInfo, DeclSet0, DeclSet).
 output_rtti_data_defn(pseudo_type_info(Pseudo), DeclSet0, DeclSet) -->
 	output_pseudo_type_info_defn(Pseudo, DeclSet0, DeclSet).
 
-:- pred output_base_typeclass_info_defn(class_id, string, base_typeclass_info,
-		decl_set, decl_set, io__state, io__state).
-:- mode output_base_typeclass_info_defn(in, in, in, in, out, di, uo) is det.
+:- pred output_base_typeclass_info_defn(module_name, class_id, string,
+		base_typeclass_info, decl_set, decl_set, io__state, io__state).
+:- mode output_base_typeclass_info_defn(in, in, in, in, in, out, di, uo) is det.
 
-output_base_typeclass_info_defn(ClassId, InstanceString,
+output_base_typeclass_info_defn(InstanceModuleName, ClassId, InstanceString,
 		base_typeclass_info(N1, N2, N3, N4, N5, Methods),
 		DeclSet0, DeclSet) -->
 	{ CodeAddrs = list__map(make_code_addr, Methods) },
 	output_code_addrs_decls(CodeAddrs, "", "", 0, _, DeclSet0, DeclSet1),
 	io__write_string("\n"),
-	output_base_typeclass_info_storage_type_name(ClassId, InstanceString,
-		yes),
+	output_base_typeclass_info_storage_type_name(InstanceModuleName,
+		ClassId, InstanceString, yes),
 	% XXX It would be nice to avoid generating redundant declarations
 	% of base_typeclass_infos, but currently we don't.
 	{ DeclSet1 = DeclSet },
@@ -528,9 +529,12 @@
 		% so we don't need to declare them.
 		% Also rtti_data_to_name/3 does not handle this case.
 		{ DeclSet = DeclSet0 }
-	; { RttiData = base_typeclass_info(ClassId, InstanceStr, _) } ->
+	;
+		{ RttiData = base_typeclass_info(InstanceModuleName, ClassId,
+			InstanceStr, _) }
+	->
 		% rtti_data_to_name/3 does not handle this case
-		output_base_typeclass_info_decl(ClassId,
+		output_base_typeclass_info_decl(InstanceModuleName, ClassId,
 			InstanceStr, no, DeclSet0, DeclSet)
 	;
 		{ rtti_data_to_name(RttiData, RttiTypeId, RttiName) },
@@ -538,24 +542,25 @@
 			DeclSet0, DeclSet)
 	).
 
-:- pred output_base_typeclass_info_decl(class_id::in, string::in,
-		bool::in, decl_set::in, decl_set::out,
+:- pred output_base_typeclass_info_decl(module_name::in, class_id::in,
+		string::in, bool::in, decl_set::in, decl_set::out,
 		io__state::di, io__state::uo) is det.
 
-output_base_typeclass_info_decl(ClassId, InstanceStr,
+output_base_typeclass_info_decl(InstanceModuleName, ClassId, InstanceStr,
 		BeingDefined, DeclSet0, DeclSet) -->
-	output_base_typeclass_info_storage_type_name(ClassId, InstanceStr,
-			BeingDefined),
+	output_base_typeclass_info_storage_type_name(InstanceModuleName,
+			ClassId, InstanceStr, BeingDefined),
 	io__write_string(";\n"),
 	% XXX It would be nice to avoid generating redundant declarations
 	% of base_typeclass_infos, but currently we don't.
 	{ DeclSet = DeclSet0 }.
 
-output_base_typeclass_info_storage_type_name(ClassId, InstanceStr,
-		BeingDefined) -->
+output_base_typeclass_info_storage_type_name(InstanceModuleName, ClassId,
+		InstanceStr, BeingDefined) -->
 	output_rtti_name_storage_type_name(
 		output_base_typeclass_info_name(ClassId, InstanceStr),
-		base_typeclass_info(ClassId, InstanceStr), BeingDefined).
+		base_typeclass_info(InstanceModuleName, ClassId, InstanceStr),
+			BeingDefined).
 
 %-----------------------------------------------------------------------------%
 
@@ -667,7 +672,7 @@
 		io__write_int(Arity),
 		io__write_string("_0);\n")
 	;
-		{ Data = base_typeclass_info(ClassName, ClassArity,
+		{ Data = base_typeclass_info(_ModName, ClassName, ClassArity,
 			base_typeclass_info(_N1, _N2, _N3, _N4, _N5,
 				Methods)) }
 	->
@@ -706,8 +711,8 @@
 			io__write_string(");\n")
 		)
 	;
-		{ Data = base_typeclass_info(_ClassId, _InstanceString,
-			_BaseTypeClassInfo) }
+		{ Data = base_typeclass_info(_InstanceModuleName, _ClassId,
+			_InstanceString, _BaseTypeClassInfo) }
 	->
 		% XXX Registering base_typeclass_infos by themselves is not
 		% enough. A base_typeclass_info doesn't say which types it
@@ -716,8 +721,8 @@
 		% to describe such membership information.
 		%
 		% io__write_string("\tMR_register_base_typeclass_info(\n\t\t&"),
-		% output_base_typeclass_info_storage_type_name(ClassId,
-		% 	InstanceString, no),
+		% output_base_typeclass_info_storage_type_name(
+		%	InstanceModuleName, ClassId, InstanceString, no),
 		% io__write_string(");\n")
 		[]
 	;
@@ -795,11 +800,14 @@
 		% Also rtti_data_to_name/3 does not handle this case.
 		{ DeclSet = DeclSet0 },
 		{ N = N0 }
-	; { RttiData = base_typeclass_info(ClassId, InstanceStr, _) } ->
+	;
+		{ RttiData = base_typeclass_info(InstanceModuleName, ClassId,
+			InstanceStr, _) }
+	->
 		% rtti_data_to_name/3 does not handle this case,
 		% so we need to handle it here
-		output_base_typeclass_info_decl(ClassId, InstanceStr, no,
-			DeclSet0, DeclSet),
+		output_base_typeclass_info_decl(InstanceModuleName, ClassId,
+			InstanceStr, no, DeclSet0, DeclSet),
 		{ N = N0 }
 	;
 		{ rtti_data_to_name(RttiData, RttiTypeId, RttiName) },
@@ -864,9 +872,13 @@
 		% rtti_data_to_name/3 does not handle this case
 		io__write_string("(MR_PseudoTypeInfo) "),
 		io__write_int(VarNum)
-	; { RttiData = base_typeclass_info(ClassId, InstanceStr, _) } ->
+	;
+		{ RttiData = base_typeclass_info(_InstanceModuleName, ClassId,
+			InstanceStr, _) }
+	->
 		% rtti_data_to_name/3 does not handle this case
-		output_base_typeclass_info_name(ClassId, InstanceStr)
+		output_base_typeclass_info_name(ClassId,
+			InstanceStr)
 	;
 		{ rtti_data_to_name(RttiData, RttiTypeId, RttiName) },
 		output_addr_of_rtti_addr(RttiTypeId, RttiName)
@@ -990,7 +1002,7 @@
 rtti_name_would_include_code_addr(du_stag_ordered_table(_),  no).
 rtti_name_would_include_code_addr(du_ptag_ordered_table,     no).
 rtti_name_would_include_code_addr(type_ctor_info,            yes).
-rtti_name_would_include_code_addr(base_typeclass_info(_, _), yes).
+rtti_name_would_include_code_addr(base_typeclass_info(_, _, _), yes).
 rtti_name_would_include_code_addr(pseudo_type_info(Pseudo),
 		pseudo_type_info_would_incl_code_addr(Pseudo)).
 rtti_name_would_include_code_addr(type_hashcons_pointer,     no).
@@ -1031,7 +1043,7 @@
 rtti_name_c_type(du_ptag_ordered_table,    "MR_DuPtagLayout", "[]").
 rtti_name_c_type(type_ctor_info,           "struct MR_TypeCtorInfo_Struct",
 						"").
-rtti_name_c_type(base_typeclass_info(_, _), "MR_Code *", "[]").
+rtti_name_c_type(base_typeclass_info(_, _, _), "MR_Code *", "[]").
 rtti_name_c_type(pseudo_type_info(Pseudo), TypePrefix, TypeSuffix) :-
 	pseudo_type_info_name_c_type(Pseudo, TypePrefix, TypeSuffix).
 rtti_name_c_type(type_hashcons_pointer,    "union MR_TableNode_Union **", "").
Index: compiler/rtti_to_mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti_to_mlds.m,v
retrieving revision 1.6
diff -u -d -r1.6 rtti_to_mlds.m
--- compiler/rtti_to_mlds.m	2000/09/06 05:11:21	1.6
+++ compiler/rtti_to_mlds.m	2000/10/30 08:03:37
@@ -48,8 +48,12 @@
 		%
 		% Generate the name
 		%
-		( RttiData = base_typeclass_info(ClassId, InstanceStr, _) ->
-			RttiName = base_typeclass_info(ClassId, InstanceStr),
+		(
+			RttiData = base_typeclass_info(InstanceModule,
+				ClassId, InstanceStr, _)
+		->
+			RttiName = base_typeclass_info(InstanceModule,
+				ClassId, InstanceStr),
 			Name = data(base_typeclass_info(ClassId, InstanceStr))
 		;
 			rtti_data_to_name(RttiData, RttiTypeId, RttiName),
@@ -220,8 +224,8 @@
 		%	MaybeHashCons),
 		% gen_init_maybe_proc_id(ModuleInfo, PrettyprinterProc)
 	]).
-gen_init_rtti_data_defn(base_typeclass_info(_ClassId, _InstanceStr,
-		BaseTypeClassInfo), _ModuleName, ModuleInfo,
+gen_init_rtti_data_defn(base_typeclass_info(_InstanceModule, _ClassId,
+		_InstanceStr, BaseTypeClassInfo), _ModuleName, ModuleInfo,
 		Init, ExtraDefns) :-
 	BaseTypeClassInfo = base_typeclass_info(N1, N2, N3, N4, N5,
 		Methods),
@@ -338,20 +342,27 @@
 
 	% Generate the MLDS initializer comprising the rtti_name
 	% for a given rtti_data, converted to mlds__generic_type.
+	% XXX we don't need to pass the module_name down to here
 :- func gen_init_cast_rtti_data(mlds__type, module_name, rtti_data) =
 	mlds__initializer.
 
 gen_init_cast_rtti_data(DestType, ModuleName, RttiData) = Initializer :-
-	( RttiData = pseudo_type_info(type_var(VarNum)) ->
+	(
+		RttiData = pseudo_type_info(type_var(VarNum))
+	->
 		% rtti_data_to_name/3 does not handle this case
 		SrcType = mlds__native_int_type,
 		Initializer = init_obj(unop(gen_cast(SrcType, DestType),
 			const(int_const(VarNum))))
-	; RttiData = base_typeclass_info(ClassId, InstanceString, _) ->
+	;
+		RttiData = base_typeclass_info(InstanceModuleName, ClassId,
+			InstanceString, _)
+	->
 		% rtti_data_to_name/3 does not handle this case
-		SrcType = rtti_type(base_typeclass_info(ClassId,
-			InstanceString)),
-		MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
+		SrcType = rtti_type(base_typeclass_info(InstanceModuleName,
+			ClassId, InstanceString)),
+		MLDS_ModuleName = mercury_module_name_to_mlds(
+			InstanceModuleName),
 		MLDS_DataName = base_typeclass_info(ClassId, InstanceString),
 		DataAddr = data_addr(MLDS_ModuleName, MLDS_DataName),
 		Rval = const(data_addr_const(DataAddr)),
@@ -598,7 +609,7 @@
 mlds_rtti_type_name(du_stag_ordered_table(_)) =	"DuFunctorDescPtrArray".
 mlds_rtti_type_name(du_ptag_ordered_table) =	"DuPtagLayoutArray".
 mlds_rtti_type_name(type_ctor_info) =		"TypeCtorInfo_Struct".
-mlds_rtti_type_name(base_typeclass_info(_, _)) = "BaseTypeclassInfo".
+mlds_rtti_type_name(base_typeclass_info(_, _, _)) = "BaseTypeclassInfo".
 mlds_rtti_type_name(pseudo_type_info(Pseudo)) =
 	mlds_pseudo_type_info_type_name(Pseudo).
 mlds_rtti_type_name(type_hashcons_pointer) =	"TableNodePtrPtr".
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.289
diff -u -d -r1.289 typecheck.m
--- compiler/typecheck.m	2000/10/31 01:35:32	1.289
+++ compiler/typecheck.m	2000/10/31 06:14:20
@@ -4071,9 +4071,9 @@
 
 find_matching_instance_rule_2([I|Is], N0, ClassName, Types, TVarSet,
 		NewTVarSet, Proofs0, Proofs, NewConstraints) :-
-	I = hlds_instance_defn(_Status, _Context, NewConstraints0, 
-		InstanceTypes0, _Interface, _PredProcIds, InstanceNames,
-		_SuperClassProofs),
+	I = hlds_instance_defn(_InstanceModule, _Status, _Context,
+		NewConstraints0, InstanceTypes0, _Interface, _PredProcIds,
+		InstanceNames, _SuperClassProofs),
 	(
 		varset__merge_subst(TVarSet, InstanceNames, NewTVarSet0,
 			RenameSubst),

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
                                    |  of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh>  |     -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------



More information about the developers mailing list