diff: typeclasses

David Glen JEFFERY dgj at cs.mu.oz.au
Fri Nov 21 15:56:51 AEDT 1997


Hi all,

Well... here are the long-awaited changes to support typeclasses. I imagine
that there are a few bugs, but the compiler bootstraps, and all the tests
are passed (except valid/agc_*, which the installed compiler seems to fail
on too... Tyse?)

I am in the process of packaging up a nice test suite. It should follow in
the next few days. There is at least one failure on the tests I have, which I
will try to fix while this is being reviewed.

These changes have already been reviewed by Fergus once. I have addressed all
of his concerns except:
	- I'm not yet convinced that storing the hlds_instance_defn in a
	  multi_map is worth the effort.
	- There are still a few too many brackets required in the typeclass
	  decls. As you suggested, maybe pred and func should go to 800. I'll
	  wait for Peter to commit that change before I address this.
	- The error messages are still poor, although the ones in typecheck.m
	  aren't too bad. (check_typeclass.m sucks dogwater bigtime, though).

Could you have another look, Fergus? In particular, the checking of 
superclasses in check_typeclass.m is new, as is their handling in
polymorphism.m.

Tom, there is an XXX with your name on it in there.

Could Tyse also have a look, seeing that he seems to be Mr. Type-info. (Or is
that MR_Type_Info? Oh dear, I've been doing this for too long).

Comments from anyone are welcome. Particularly, I'd like to hear where people
find the documentation a bit thin.

Test cases and entries for the language reference manual to come RSN.



==============================================================================


Estimated hours taken: 500 or so

This change implements typeclasses. Included are the necessary changes to
the compiler, runtime and library.

compiler/typecheck.m:
	Typecheck the constraints on a pred by adding constraints for each
	call to a pred/func with constraints, and eliminating constraints
	by applying context reduction.

	While reducing the constraints, keep track of the proofs so that 
	polymorphism can produce the tyepclass_infos for eliminated 
	constraints.

compiler/polymorphism.m:
	Perform the source-to-source transformation which turns code with
	typeclass constraints into code without constraints, but with extra
	"typeclass_info", or "dictionary" parameters.

	Also, rather than always having a type_info directly for each type
	variable, sometimes the type_info is hidden inside a typeclass_info.

compiler/bytecode*.m:
	Insert some code to abort if bytecode generation is used when 
	typeclasses are used.
compiler/call_gen.m:
	Generate code for a class_method_call, which forms the body of a class
	method (by selecting the appropriate proc from the typeclass_info).
compiler/dead_proc_elim.m:
	Don't eliminate class methods if they are potentially used outside
	the module
compiler/hlds_data.m:
	Define data types to store:
		- the typeclass definitions
		- the instances of a class
		- "constraint_proof". ie. the proofs of redundancy of a
		  constraint. This info is used by polymorphism to construct the
		  typeclass_infos for a constraint.
		- the "base_tyepclass_info_constant", which is analagous the
		  the base_type_info_constant
compiler/hlds_data.m:
	Define the class_method_call goal. This goal is inserted into the
	body of class method procs, and is responsible for selecting the
	appropriate part of the typeclass_info to call.
compiler/hlds_data.m:
	Add the class table and instance table to the module_info.
compiler/hlds_out.m:
	Output info about base_typeclass_infos and class_method_calls
compiler/hlds_pred.m:
	Change the representation of the locations of type_infos from "var"
	to type_info_locn, which is either a var, or part of a typeclass_info,
	since now the typeclass_infos contain the type_infos for the type that
	they constrain.

	Add constraints to the pred_info.

	Add constraint_proofs to the pred_info (so that typeclass.m can 
	annotate the pred_info with the reasons that constraints were
	eliminated, so that polymorphism.m can in turn generate the
	typeclass_infos for the constraints).

	Add the "class_method" marker.

compiler/lambda.m:
	A feable attempt at adding class ontexts to lambda expressions, 
	untested and almost certainly not working.
compiler/llds_out.m:
	Output the code addresses for do_*det_class_method, and output 
	appropriately mangled symbol names for base_typeclass_infos.
compiler/make_hlds.m:
	Add constraints to the types on pred and func decls, and add
	class and instance declarations to the class_table and instance_table
	respectively.
compiler/mercury_compile.m:
	Add the check_typeclass pass.
compiler/mercury_to_mercury.m:
	Output constraints of pred and funcs, and output typeclass and instance
	declarations.
compiler/module_qual.m:
	Module qualify typeclass names in pred class contexts, and qualify the
	typeclass and instance decls themselves.
compiler/modules.m:
	Output typeclass declarations in the short interface too.
compiler/prog_data.m:
	Add the "typeclass" and "instance" items. Define the types to store
	information about the declarations, including class contexts on pred
	and func decls.
compiler/prog_io.m:
	Parse constraints on pred and func declarations.
compiler/prod_out.m:
	Output class contexts on pred and func decls.
compiler/type_util.m:
	Add preds to apply a substitution to a class_constraint, and to
	a list of class constraints. Add type_list_matches_exactly/2. Also
	add typeclass_info and base_typeclass_info as types which should not
	be optimised as no_tag types (seeing that we cheat a bit about their
	representation).
compiler/notes/compiler_design.html:
	Add notes on module qualification of class contexts. Needs expansion
	to include more stuff on typeclasses.
compiler/*.m:
	Various minor changes.

compiler/base_typeclass_info.m: (New File)
	Produce one base_typeclass_infos for each instance declaration.
compiler/prog_io_typeclass.m: (New File)
	Parse typeclass and instance declarations.
compiler/check_typeclass.m: (New File)
	Check the conformance of an instance declaration to the typeclass
	declaration, including building up a proof of how superclass
	constraints are satisfied so that polymorphism.m is able to construct
	the typeclass_info, including the superclass typeclass_infos.

library/mercury_builtin.m:
	Implement that base_typeclass_info and typeclass_info types, as
	well as the predicates type_info_from_typeclass_info/3 to extract
	a type_info from a typeclass_info, and superclass_from_typeclass_info/3
	for extracting superclasses.
library/ops.m:
	Add "typeclass" and "instance" as operators.
library/string.m:
	Add a (in, uo) mode for string__length/3. 

runtime/mercury_ho_call.c:
	Implement do_call_*det_class_method, which are the pieces of code
	responsible for extracting the correct code address from the
	typeclass_info, setting up the arguments correctly, then executing
	the code.
runtime/mercury_type_info.h:
	Macros for accessing the typeclass_info structure.



Index: compiler/base_type_info.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/base_type_info.m,v
retrieving revision 1.12
diff -u -r1.12 base_type_info.m
--- base_type_info.m	1997/08/05 04:37:30	1.12
+++ base_type_info.m	1997/08/28 06:13:00
@@ -35,7 +35,7 @@
 
 :- implementation.
 
-:- import_module prog_data, hlds_data, hlds_pred, hlds_out.
+:- import_module prog_data, hlds_data, hlds_pred, hlds_out, base_typeclass_info.
 :- import_module llds, code_util, globals, special_pred, options.
 :- import_module bool, string, list, map, std_util, require.
 
@@ -118,7 +118,10 @@
 base_type_info__generate_llds(ModuleInfo, CModules) :-
 	module_info_base_gen_infos(ModuleInfo, BaseGenInfos),
 	base_type_info__construct_base_type_infos(BaseGenInfos, ModuleInfo,
-		CModules).
+		CModules1),
+	base_typeclass_info__generate_llds(ModuleInfo, CModules2),
+		% XXX make this use an accumulator
+	list__append(CModules1, CModules2, CModules).
 
 :- pred base_type_info__construct_base_type_infos(list(base_gen_info),
 	module_info, list(c_module)).
Index: compiler/base_type_layout.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/base_type_layout.m,v
retrieving revision 1.23
diff -u -r1.23 base_type_layout.m
--- base_type_layout.m	1997/11/08 13:11:06	1.23
+++ base_type_layout.m	1997/11/17 02:38:33
@@ -1196,7 +1196,10 @@
 base_type_layout__tag_type_and_value(int_constant(_), -1, unused). 
 base_type_layout__tag_type_and_value(pred_closure_tag(_, _), -1, unused). 
 base_type_layout__tag_type_and_value(code_addr_constant(_, _), -1, unused).
-base_type_layout__tag_type_and_value(base_type_info_constant(_, _, _), -1,unused). 
+base_type_layout__tag_type_and_value(base_type_info_constant(_, _, _), -1,
+	unused). 
+base_type_layout__tag_type_and_value(base_typeclass_info_constant(_, _, _), -1,
+	unused). 
 
 	% Get the arguments of this constructor of the current type.
 	
Index: compiler/bytecode.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/bytecode.m,v
retrieving revision 1.29
diff -u -r1.29 bytecode.m
--- bytecode.m	1997/07/27 14:59:51	1.29
+++ bytecode.m	1997/08/26 05:06:56
@@ -82,6 +82,8 @@
 					arity, byte_proc_id)
 			;	base_type_info_const(byte_module_id, string,
 					int)
+			;	base_typeclass_info_const(byte_module_id,
+					class_id, string)
 			;	char_const(char)
 			.
 
@@ -727,6 +729,10 @@
 	{ char__to_int(Char, Byte) },
 	output_byte(Byte).
 
+	% XXX FIX THIS
+output_cons_id(base_typeclass_info_const(_, _, _)) -->
+	output_byte(8).
+
 :- pred debug_cons_id(byte_cons_id, io__state, io__state).
 :- mode debug_cons_id(in, di, uo) is det.
 
@@ -762,6 +768,15 @@
 	debug_module_id(ModuleId),
 	debug_string(TypeName),
 	debug_int(TypeArity).
+debug_cons_id(base_typeclass_info_const(ModuleId, 
+		class_id(ClassName, ClassArity), Instance)) -->
+	debug_string("base_typeclass_info_const"),
+	debug_module_id(ModuleId),
+	debug_string("class_id"),
+	debug_sym_name(ClassName),
+	debug_string("/"),
+	debug_int(ClassArity),
+	debug_string(Instance).
 debug_cons_id(char_const(Char)) -->
 	debug_string("char_const"),
 	{ string__from_char_list([Char], String) },
@@ -1265,6 +1280,18 @@
 
 debug_float(Val) -->
 	io__write_float(Val),
+	io__write_char(' ').
+
+:- pred debug_sym_name(sym_name, io__state, io__state).
+:- mode debug_sym_name(in, di, uo) is det.
+
+debug_sym_name(unqualified(Val)) -->
+	io__write_string(Val),
+	io__write_char(' ').
+debug_sym_name(qualified(Module, Val)) -->
+	io__write_string(Module),
+	io__write_char(':'),
+	io__write_string(Val),
 	io__write_char(' ').
 
 %---------------------------------------------------------------------------%
Index: compiler/bytecode_gen.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/bytecode_gen.m,v
retrieving revision 1.30
diff -u -r1.30 bytecode_gen.m
--- bytecode_gen.m	1997/09/01 14:00:22	1.30
+++ bytecode_gen.m	1997/09/08 04:11:51
@@ -161,6 +161,10 @@
 			ArgTypes, ArgModes, Detism, ByteInfo0, Code),
 		ByteInfo = ByteInfo0
 	;
+			% XXX
+		GoalExpr = class_method_call(_, _, _, _, _, _),
+		error("sorry: bytecode not implemented yet for typeclasses")
+	;
 		GoalExpr = call(PredId, ProcId, ArgVars, BuiltinState, _, _),
 		( BuiltinState = not_builtin ->
 			goal_info_get_determinism(GoalInfo, Detism),
@@ -618,6 +622,11 @@
 		ConsId = base_type_info_const(ModuleName, TypeName, TypeArity),
 		ByteConsId = base_type_info_const(ModuleName, TypeName,
 			TypeArity)
+	;
+		ConsId = base_typeclass_info_const(ModuleName, ClassId,
+			Instance),
+		ByteConsId = base_typeclass_info_const(ModuleName, ClassId,
+			Instance)
 	).
 
 :- pred bytecode_gen__map_cons_tag(cons_tag::in, byte_cons_tag::out) is det.
@@ -639,6 +648,8 @@
 	error("code_addr_constant cons tag for non-address_const cons id").
 bytecode_gen__map_cons_tag(base_type_info_constant(_, _, _), _) :-
 	error("base_type_info_constant cons tag for non-base_type_info_constant cons id").
+bytecode_gen__map_cons_tag(base_typeclass_info_constant(_, _, _), _) :-
+	error("base_typeclass_info_constant cons tag for non-base_typeclass_info_constant cons id").
 
 %---------------------------------------------------------------------------%
 
Index: compiler/call_gen.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/call_gen.m,v
retrieving revision 1.114
diff -u -r1.114 call_gen.m
--- call_gen.m	1997/10/03 04:55:25	1.114
+++ call_gen.m	1997/10/14 07:12:10
@@ -27,6 +27,12 @@
 :- mode call_gen__generate_higher_order_call(in, in, in, in, in, in, in, out,
 				in, out) is det.
 
+:- pred call_gen__generate_class_method_call(code_model, var, int, list(var),
+			list(type), list(mode), determinism, hlds_goal_info,
+			code_tree, code_info, code_info).
+:- mode call_gen__generate_class_method_call(in, in, in, in, in, in, in, in,
+				out, in, out) is det.
+
 :- pred call_gen__generate_call(code_model, pred_id, proc_id, list(var),
 			hlds_goal_info, code_tree, code_info, code_info).
 :- mode call_gen__generate_call(in, in, in, in, in, out, in, out) is det.
@@ -252,6 +258,139 @@
 		tree(TraceCode,
 		tree(CallCode,
 		     FailHandlingCode))))))))
+	}.
+
+%---------------------------------------------------------------------------%
+
+	%
+	% for a class method call,
+	% we split the arguments into inputs and outputs, put the inputs
+	% in the locations expected by do_call_<detism>_class_method in
+	% runtime/call.mod, generate the call to do_call_<detism>_class_method,
+	% and pick up the outputs from the locations that we know
+	% runtime/call.mod leaves them in.
+	%
+call_gen__generate_class_method_call(_OuterCodeModel, TCVar, Num, Args, Types,
+		Modes, Det, GoalInfo, Code) -->
+	{ determinism_to_code_model(Det, InnerCodeModel) },
+	code_info__get_globals(Globals),
+	code_info__get_module_info(ModuleInfo),
+	{ globals__get_args_method(Globals, ArgsMethod) },
+	{ make_arg_infos(ArgsMethod, Types, Modes, InnerCodeModel, ModuleInfo,
+		ArgInfo) },
+	{ assoc_list__from_corresponding_lists(Args, ArgInfo, ArgsAndArgInfo) },
+	{ call_gen__partition_args(ArgsAndArgInfo, InVars, OutVars) },
+	call_gen__generate_class_method_call2(InnerCodeModel, TCVar, Num,
+		InVars, OutVars, GoalInfo, Code).
+
+	% XXX This assumes compact args!!!
+	% XXX This assumes compact args!!!
+	% XXX This assumes compact args!!!
+:- pred call_gen__generate_class_method_call2(code_model, var, int, list(var),
+		list(var), hlds_goal_info, code_tree, code_info, code_info).
+:- mode call_gen__generate_class_method_call2(in, in, in, in, in, in, out, in,
+		out) is det.
+
+call_gen__generate_class_method_call2(CodeModel, TCVar, Index, InVars, OutVars,
+		GoalInfo, Code) -->
+	code_info__succip_is_used,
+	{ set__list_to_set(OutVars, OutArgs) },
+	call_gen__save_variables(OutArgs, SaveCode),
+	(
+		{ CodeModel = model_det },
+		{ CallModel = det },
+		{ RuntimeAddr = do_det_class_method },
+		{ FlushCode = empty }
+	;
+		{ CodeModel = model_semi },
+		{ CallModel = semidet },
+		{ RuntimeAddr = do_semidet_class_method },
+		{ FlushCode = empty }
+	;
+		{ CodeModel = model_non },
+		code_info__may_use_nondet_tailcall(TailCall),
+		{ CallModel = nondet(TailCall) },
+		{ RuntimeAddr = do_nondet_class_method },
+		code_info__unset_failure_cont(FlushCode)
+	),
+		% place the immediate input arguments in registers
+		% starting at r5.
+	call_gen__generate_immediate_args(InVars, 5, InLocs, ImmediateCode),
+	code_info__generate_stack_livevals(OutArgs, LiveVals0),
+	{ set__insert_list(LiveVals0,
+		[reg(r, 1), reg(r, 2), reg(r, 3), reg(r, 4) | InLocs], 
+			LiveVals) },
+	(
+		{ CodeModel = model_semi }
+	->
+		{ FirstArg = 2 }
+	;
+		{ FirstArg = 1 }
+	),
+	{ call_gen__outvars_to_outargs(OutVars, FirstArg, OutArguments) },
+	{ call_gen__output_arg_locs(OutArguments, OutLocs) },
+
+	code_info__get_instmap(InstMap),
+	{ goal_info_get_instmap_delta(GoalInfo, InstMapDelta) },
+	{ instmap__apply_instmap_delta(InstMap, InstMapDelta,
+		AfterCallInstMap) },
+
+	call_gen__generate_return_livevals(OutArgs, OutLocs, AfterCallInstMap, 
+		OutLiveVals),
+	code_info__produce_variable(TCVar, TCVarCode, TCVarRVal),
+	(
+		{ TCVarRVal = lval(reg(r, 1)) }
+	->
+		{ CopyCode = empty }
+	;
+		{ CopyCode = node([
+			assign(reg(r, 1), TCVarRVal) - "Copy typeclass info"
+		])}
+	),
+	{ list__length(InVars, NInVars) },
+	{ list__length(OutVars, NOutVars) },
+	{ SetupCode = tree(CopyCode, node([
+			assign(reg(r, 2), const(int_const(Index))) -
+				"Index of class method in typeclass info",
+			assign(reg(r, 3), const(int_const(NInVars))) -
+				"Assign number of immediate input arguments",
+			assign(reg(r, 4), const(int_const(NOutVars))) -
+				"Assign number of output arguments"
+		])
+	) },
+	code_info__get_next_label(ReturnLabel),
+	{ TryCallCode = node([
+		livevals(LiveVals) - "",
+		call(RuntimeAddr, label(ReturnLabel), OutLiveVals, CallModel)
+			- "setup and call class method",
+		label(ReturnLabel) - "Continuation label"
+	]) },
+	call_gen__rebuild_registers(OutArguments),
+	(
+		{ CodeModel = model_semi }
+	->
+		code_info__generate_failure(FailCode),
+		code_info__get_next_label(ContLab),
+		{ TestSuccessCode = node([
+			if_val(lval(reg(r, 1)), label(ContLab)) -
+				"Test for success"
+		]) },
+		{ ContLabelCode = node([label(ContLab) - ""]) },
+		{ CallCode =
+			tree(TryCallCode,
+			tree(TestSuccessCode,
+			tree(FailCode,
+			     ContLabelCode))) }
+	;
+		{ CallCode = TryCallCode }
+	),
+	{ Code =
+		tree(SaveCode,
+		tree(FlushCode,
+		tree(ImmediateCode,
+		tree(TCVarCode,
+		tree(SetupCode,
+		     CallCode)))))
 	}.
 
 %---------------------------------------------------------------------------%
Index: compiler/code_gen.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/code_gen.m,v
retrieving revision 1.39
diff -u -r1.39 code_gen.m
--- code_gen.m	1997/11/08 13:11:09	1.39
+++ code_gen.m	1997/11/17 02:38:35
@@ -694,6 +694,11 @@
 		GoalInfo, Instr) -->
 	call_gen__generate_higher_order_call(model_det, PredVar, Args,
 		Types, Modes, Det, GoalInfo, Instr).
+code_gen__generate_det_goal_2(class_method_call(TCVar, Num, Args, Types,
+		Modes, Det),
+		GoalInfo, Instr) -->
+	call_gen__generate_class_method_call(model_det, TCVar, Num, Args,
+		Types, Modes, Det, GoalInfo, Instr).
 code_gen__generate_det_goal_2(call(PredId, ProcId, Args, BuiltinState, _, _),
 		GoalInfo, Instr) -->
 	(
@@ -781,6 +786,10 @@
 		Det, _PredOrFunc), GoalInfo, Code) -->
 	call_gen__generate_higher_order_call(model_semi, PredVar, Args,
 		Types, Modes, Det, GoalInfo, Code).
+code_gen__generate_semi_goal_2(class_method_call(TCVar, Num, Args, Types, Modes,
+		Det), GoalInfo, Code) -->
+	call_gen__generate_class_method_call(model_semi, TCVar, Num, Args,
+		Types, Modes, Det, GoalInfo, Code).
 code_gen__generate_semi_goal_2(call(PredId, ProcId, Args, BuiltinState, _, _),
 							GoalInfo, Code) -->
 	(
@@ -981,6 +990,11 @@
 		Det, _PredOrFunc),
 		GoalInfo, Code) -->
 	call_gen__generate_higher_order_call(model_non, PredVar, Args, Types,
+		Modes, Det, GoalInfo, Code).
+code_gen__generate_non_goal_2(class_method_call(TCVar, Num, Args, Types, Modes,
+		Det),
+		GoalInfo, Code) -->
+	call_gen__generate_class_method_call(model_non, TCVar, Num, Args, Types,
 		Modes, Det, GoalInfo, Code).
 code_gen__generate_non_goal_2(call(PredId, ProcId, Args, BuiltinState, _, _),
 							GoalInfo, Code) -->
Index: compiler/code_info.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/code_info.m,v
retrieving revision 1.213
diff -u -r1.213 code_info.m
--- code_info.m	1997/10/03 04:55:31	1.213
+++ code_info.m	1997/11/20 07:16:32
@@ -651,7 +651,7 @@
 :- mode code_info__lookup_type_defn(in, out, in, out) is det.
 
 	% Given a list of type variables, find the lvals where the
-	% corresponding type_infos are being stored.
+	% corresponding type_infos and typeclass_infos are being stored.
 :- pred code_info__find_type_infos(list(var), assoc_list(var, lval), 
 	code_info, code_info).
 :- mode code_info__find_type_infos(in, out, in, out) is det.
@@ -836,13 +836,13 @@
 code_info__find_type_infos([TVar | TVars], [TVar - Lval | Lvals]) -->
 	code_info__get_proc_info(ProcInfo),
 	{ proc_info_typeinfo_varmap(ProcInfo, TypeInfoMap) },
-	(
-		{ map__search(TypeInfoMap, TVar, Var0) }
+	{
+		map__search(TypeInfoMap, TVar, Locn)
 	->
-		{ Var = Var0 }
+		type_info_locn_var(Locn, Var)
 	;
-		{ error("cannot find var for type variable") }
-	),
+		error("cannot find var for type variable")
+	},
 	{ proc_info_stack_slots(ProcInfo, StackSlots) },
 	(
 		{ map__search(StackSlots, Var, Lval0) }
Index: compiler/code_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/code_util.m,v
retrieving revision 1.89
diff -u -r1.89 code_util.m
--- code_util.m	1997/09/01 14:00:37	1.89
+++ code_util.m	1997/09/08 04:20:45
@@ -644,6 +644,8 @@
 code_util__cons_id_to_tag(pred_const(P,M), _, _, pred_closure_tag(P,M)).
 code_util__cons_id_to_tag(base_type_info_const(M,T,A), _, _,
 		base_type_info_constant(M,T,A)).
+code_util__cons_id_to_tag(base_typeclass_info_const(M,C,N), _, _,
+		base_typeclass_info_constant(M,C,N)).
 code_util__cons_id_to_tag(cons(Name, Arity), Type, ModuleInfo, Tag) :-
 	(
 			% handle the `character' type specially
@@ -771,6 +773,8 @@
 code_util__count_recursive_calls_2(unify(_, _, _, _, _), _, _, 0, 0).
 code_util__count_recursive_calls_2(higher_order_call(_, _,_, _, _, _), _, _,
 		0, 0).
+code_util__count_recursive_calls_2(class_method_call(_, _,_, _, _, _), _, _, 
+	0, 0).
 code_util__count_recursive_calls_2(pragma_c_code(_,_,_,_, _, _, _, _), _, _,
 		0, 0).
 code_util__count_recursive_calls_2(call(CallPredId, CallProcId, _, _, _, _),
Index: compiler/constraint.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/constraint.m,v
retrieving revision 1.35
diff -u -r1.35 constraint.m
--- constraint.m	1997/09/01 14:00:47	1.35
+++ constraint.m	1997/09/08 04:12:00
@@ -179,6 +179,12 @@
 	mode_checkpoint(exit, "higher-order call").
 
 constraint__propagate_goal_2(
+		class_method_call(A, B, C, D, E, F),
+		class_method_call(A, B, C, D, E, F)) -->
+	mode_checkpoint(enter, "class method call"),
+	mode_checkpoint(exit, "class method call").
+
+constraint__propagate_goal_2(
 		call(PredId, ProcId, ArgVars, Builtin, Sym, Context),
 		call(PredId, ProcId, ArgVars, Builtin, Sym, Context)) -->
 	mode_checkpoint(enter, "call"),
Index: compiler/cse_detection.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/cse_detection.m,v
retrieving revision 1.48
diff -u -r1.48 cse_detection.m
--- cse_detection.m	1997/09/01 14:00:51	1.48
+++ cse_detection.m	1997/09/08 04:22:09
@@ -206,6 +206,9 @@
 detect_cse_in_goal_2(higher_order_call(A,B,C,D,E,F), _, _, CseInfo, CseInfo,
 	no, higher_order_call(A,B,C,D,E,F)).
 
+detect_cse_in_goal_2(class_method_call(A,B,C,D,E,F), _, _, CseInfo, CseInfo, 
+	no, class_method_call(A,B,C,D,E,F)).
+
 detect_cse_in_goal_2(call(A,B,C,D,E,F), _, _, CseInfo, CseInfo, no,
 	call(A,B,C,D,E,F)).
 
Index: compiler/dead_proc_elim.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/dead_proc_elim.m,v
retrieving revision 1.32
diff -u -r1.32 dead_proc_elim.m
--- dead_proc_elim.m	1997/09/01 14:00:56	1.32
+++ dead_proc_elim.m	1997/11/03 05:43:31
@@ -110,7 +110,10 @@
 		Queue1, Queue2, Needed1, Needed2),
 	module_info_base_gen_infos(ModuleInfo, BaseGenInfos),
 	dead_proc_elim__initialize_base_gen_infos(BaseGenInfos,
-		Queue2, Queue, Needed2, Needed).
+		Queue2, Queue3, Needed2, Needed3),
+	module_info_instances(ModuleInfo, Instances),
+	dead_proc_elim__initialize_class_methods(Instances,
+		Queue3, Queue, Needed3, Needed).
 
 	% Add all normally exported procedures within the listed predicates
 	% to the queue and map.
@@ -198,6 +201,62 @@
 	dead_proc_elim__initialize_base_gen_infos(BaseGenInfos,
 		Queue1, Queue, Needed1, Needed).
 
+:- pred dead_proc_elim__initialize_class_methods(instance_table, 
+	entity_queue, entity_queue, needed_map, needed_map).
+:- mode dead_proc_elim__initialize_class_methods(in, in, out, in, out) is det.
+
+dead_proc_elim__initialize_class_methods(Instances, Queue0, Queue, 
+		Needed0, Needed) :-
+	map__values(Instances, InstanceDefns0),
+	list__condense(InstanceDefns0, InstanceDefns),
+	list__foldl2(get_instance_pred_procs, InstanceDefns, Queue0, Queue,
+		Needed0, Needed).
+
+:- pred get_instance_pred_procs(hlds_instance_defn, entity_queue, entity_queue,
+	needed_map, needed_map).
+:- 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(ImportStatus, _, _, _, PredProcIds, _, _),
+	(
+			% We only need the instance declarations which were
+			% made in this module.
+		( ImportStatus = exported
+		; ImportStatus = abstract_exported 
+		; ImportStatus = pseudo_exported
+		; ImportStatus = local
+		)
+	->
+		get_instance_pred_procs2(PredProcIds, Queue0, Queue, 
+			Needed0, Needed)
+	;
+		Queue = Queue0,
+		Needed = Needed0
+	).
+
+:- pred get_instance_pred_procs2(maybe(list(hlds_class_proc)), 
+	entity_queue, entity_queue, needed_map, needed_map).
+:- mode get_instance_pred_procs2(in, in, out, in, out) is det.
+
+get_instance_pred_procs2(PredProcIds, Queue0, Queue, Needed0, Needed) :-
+	(
+			% This should never happen
+		PredProcIds = no,
+		Queue = Queue0,
+		Needed = Needed0
+	;
+		PredProcIds = yes(Ids),
+		AddHldsClassProc = lambda(
+			[PredProc::in, Q0::in, Q::out, N0::in, N::out] is det,
+			(
+				PredProc = hlds_class_proc(PredId, ProcId),
+				queue__put(Q0, proc(PredId, ProcId), Q),
+				map__set(N0, proc(PredId, ProcId), no, N)
+			)),
+		list__foldl2(AddHldsClassProc, Ids, Queue0, Queue, 
+			Needed0, Needed)
+	).
+
 %-----------------------------------------------------------------------------%
 
 :- pred dead_proc_elim__examine(entity_queue, examined_set, module_info,
@@ -372,6 +431,8 @@
 		Needed2, Needed).
 dead_proc_elim__examine_expr(higher_order_call(_,_,_,_,_,_), _,
 		Queue, Queue, Needed, Needed).
+dead_proc_elim__examine_expr(class_method_call(_,_,_,_,_,_), _,
+		Queue, Queue, Needed, Needed).
 dead_proc_elim__examine_expr(call(PredId, ProcId, _,_,_,_),
 		CurrProc, Queue0, Queue, Needed0, Needed) :-
 	queue__put(Queue0, proc(PredId, ProcId), Queue),
@@ -693,6 +754,7 @@
 	)) },
 	list__foldl(ExamineCase, Cases).
 pre_modecheck_examine_goal(higher_order_call(_,_,_,_,_,_) - _) --> [].
+pre_modecheck_examine_goal(class_method_call(_,_,_,_,_,_) - _) --> [].
 pre_modecheck_examine_goal(not(Goal) - _) -->
 	pre_modecheck_examine_goal(Goal).
 pre_modecheck_examine_goal(some(_, Goal) - _) -->
Index: compiler/dependency_graph.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/dependency_graph.m,v
retrieving revision 1.30
diff -u -r1.30 dependency_graph.m
--- dependency_graph.m	1997/09/01 14:00:59	1.30
+++ dependency_graph.m	1997/09/08 04:26:58
@@ -218,6 +218,8 @@
 
 dependency_graph__add_arcs_in_goal_2(higher_order_call(_, _, _, _, _, _),
 		_Caller, DepGraph, DepGraph).
+dependency_graph__add_arcs_in_goal_2(class_method_call(_, _, _, _, _, _),
+		_Caller, DepGraph, DepGraph).
 
 dependency_graph__add_arcs_in_goal_2(call(PredId, ProcId, _, Builtin, _, _),
 			Caller, DepGraph0, DepGraph) :-
@@ -321,6 +323,8 @@
 		DepGraph = DepGraph0
 	).
 dependency_graph__add_arcs_in_cons(base_type_info_const(_, _, _), _Caller,
+				DepGraph, DepGraph).
+dependency_graph__add_arcs_in_cons(base_typeclass_info_const(_, _, _), _Caller,
 				DepGraph, DepGraph).
 
 %-----------------------------------------------------------------------------%
Index: compiler/det_analysis.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/det_analysis.m,v
retrieving revision 1.124
diff -u -r1.124 det_analysis.m
--- det_analysis.m	1997/11/17 05:47:30	1.124
+++ det_analysis.m	1997/11/21 00:18:40
@@ -454,7 +454,29 @@
 		NumSolns = at_most_many_cc,
 		SolnContext \= first_soln
 	->
-		Msgs = [higher_order_cc_pred_in_wrong_context(GoalInfo, Det)],
+		Msgs = [higher_order_cc_pred_in_wrong_context(GoalInfo, Det0)],
+		% Code elsewhere relies on the assumption that
+		% SolnContext \= first_soln => NumSolns \= at_most_many_cc,
+		% so we need to enforce that here.
+		determinism_components(Det, CanFail, at_most_many)
+	;
+		Msgs = [],
+		Det = Det0
+	).
+
+det_infer_goal_2(class_method_call(TCVar, Num, ArgVars, Types, Modes, Det0),
+		GoalInfo, _InstMap0, SolnContext,
+		_MiscInfo, _NonLocalVars, _DeltaInstMap,
+		class_method_call(TCVar, Num, ArgVars, Types, Modes, Det0),
+		Det, Msgs) :-
+	determinism_components(Det0, CanFail, NumSolns),
+	(
+		NumSolns = at_most_many_cc,
+		SolnContext \= first_soln
+	->
+			% XXX this will give a slightly misleading error
+			% XXX message
+		Msgs = [higher_order_cc_pred_in_wrong_context(GoalInfo, Det0)],
 		% Code elsewhere relies on the assumption that
 		% SolnContext \= first_soln => NumSolns \= at_most_many_cc,
 		% so we need to enforce that here.
@@ -972,7 +994,8 @@
 	segregate_procs(ModuleInfo, PredProcs, DeclaredProcs, UndeclaredProcs).
 
 	% get_all_pred_procs takes a module_info and returns a list
-	% of all the procedures ids for that module.
+	% of all the procedures ids for that module (except class methods,
+	% which do not need to be checked since we generate the code ourselves).
 
 :- pred get_all_pred_procs(module_info, pred_proc_list).
 :- mode get_all_pred_procs(in, out) is det.
@@ -989,8 +1012,16 @@
 get_all_pred_procs_2(_Preds, [], PredProcs, PredProcs).
 get_all_pred_procs_2(Preds, [PredId|PredIds], PredProcs0, PredProcs) :-
 	map__lookup(Preds, PredId, Pred),
-	pred_info_non_imported_procids(Pred, ProcIds),
-	fold_pred_modes(PredId, ProcIds, PredProcs0, PredProcs1),
+	pred_info_get_marker_list(Pred, Markers),
+	(
+			% ignore class members
+		list__member(request(class_method), Markers)
+	->
+		PredProcs1 = PredProcs0
+	;
+		pred_info_non_imported_procids(Pred, ProcIds),
+		fold_pred_modes(PredId, ProcIds, PredProcs0, PredProcs1)
+	),
 	get_all_pred_procs_2(Preds, PredIds, PredProcs1, PredProcs).
 
 :- pred fold_pred_modes(pred_id, list(proc_id), pred_proc_list, pred_proc_list).
Index: compiler/det_report.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/det_report.m,v
retrieving revision 1.43
diff -u -r1.43 det_report.m
--- det_report.m	1997/11/17 05:47:33	1.43
+++ det_report.m	1997/11/20 23:40:22
@@ -463,6 +463,17 @@
 	det_diagnose_atomic_goal(Desired, Actual,
 		report_higher_order_call_context(Context), Context).
 
+	% There's probably no point in this code being here: we only
+	% insert class_method_calls by hand, so they're gauranteed to be right,
+	% and in any case, we insert them after determinism analysis.
+	% Nonetheless, it's probably safer to include the code.
+det_diagnose_goal_2(class_method_call(_, _, _, _, _, _), GoalInfo,
+		Desired, Actual, _, _MiscInfo, yes) -->
+	{ goal_info_get_context(GoalInfo, Context) },
+	prog_out__write_context(Context),
+	det_diagnose_atomic_goal(Desired, Actual,
+		report_higher_order_call_context(Context), Context).
+
 det_diagnose_goal_2(unify(LT, RT, _, _, UnifyContext), GoalInfo,
 		Desired, Actual, _, DetInfo, yes) -->
 	{ goal_info_get_context(GoalInfo, Context) },
Index: compiler/dnf.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/dnf.m,v
retrieving revision 1.23
diff -u -r1.23 dnf.m
--- dnf.m	1997/10/31 00:14:22	1.23
+++ dnf.m	1997/11/17 06:32:40
@@ -220,6 +220,11 @@
 		NewPredIds = NewPredIds0,
 		Goal = Goal0
 	;
+		GoalExpr0 = class_method_call(_, _, _, _, _, _),
+		ModuleInfo = ModuleInfo0,
+		NewPredIds = NewPredIds0,
+		Goal = Goal0
+	;
 		GoalExpr0 = call(_, _, _, _, _, _),
 		ModuleInfo = ModuleInfo0,
 		NewPredIds = NewPredIds0,
@@ -377,8 +382,14 @@
 	Goal0 = _GoalExpr - GoalInfo,
 	goal_info_get_nonlocals(GoalInfo, NonLocals),
 	set__to_sorted_list(NonLocals, ArgVars),
+		% XXX
+		% XXX Does this new pred necessarily have an empty context?
+		% XXX I would think not. The pred context should probably be
+		% XXX added to the dnf_info.
+		% XXX
+	ClassContext = [],
 	hlds_pred__define_new_pred(Goal0, Goal, ArgVars, InstMap0, PredName,
-		TVarSet, VarTypes, VarSet, Markers, 
+		TVarSet, VarTypes, ClassContext, VarSet, Markers, 
 		ModuleInfo0, ModuleInfo, PredProcId),
 	PredProcId = proc(PredId, _).
 
@@ -422,6 +433,7 @@
 
 dnf__is_atomic_expr(conj(_), no).
 dnf__is_atomic_expr(higher_order_call(_, _, _, _, _, _), yes).
+dnf__is_atomic_expr(class_method_call(_, _, _, _, _, _), yes).
 dnf__is_atomic_expr(call(_, _, _, _, _, _), yes).
 dnf__is_atomic_expr(switch(_, _, _, _), no).
 dnf__is_atomic_expr(unify(_, _, _, _, _), yes).
Index: compiler/dupelim.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/dupelim.m,v
retrieving revision 1.24
diff -u -r1.24 dupelim.m
--- dupelim.m	1997/11/08 13:11:14	1.24
+++ dupelim.m	1997/11/17 02:38:42
@@ -285,6 +285,11 @@
 dupelim__replace_labels_code_addr(do_det_closure, _, do_det_closure).
 dupelim__replace_labels_code_addr(do_semidet_closure, _, do_semidet_closure).
 dupelim__replace_labels_code_addr(do_nondet_closure, _, do_nondet_closure).
+dupelim__replace_labels_code_addr(do_det_class_method, _, do_det_class_method).
+dupelim__replace_labels_code_addr(do_semidet_class_method, _,
+	do_semidet_class_method).
+dupelim__replace_labels_code_addr(do_nondet_class_method, _,
+	do_nondet_class_method).
 dupelim__replace_labels_code_addr(do_not_reached, _, do_not_reached).
 
 :- pred dupelim__replace_labels_label_list(list(label), map(label, label),
Index: compiler/equiv_type.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/equiv_type.m,v
retrieving revision 1.9
diff -u -r1.9 equiv_type.m
--- equiv_type.m	1997/08/22 13:54:55	1.9
+++ equiv_type.m	1997/09/08 04:12:11
@@ -112,18 +112,22 @@
 	equiv_type__replace_in_type_defn(TypeDefn0, VarSet0, EqvMap,
 				TypeDefn, VarSet, ContainsCirc).
 
-equiv_type__replace_in_item(pred(VarSet0, PredName, TypesAndModes0, Det, Cond),
-		EqvMap, pred(VarSet, PredName, TypesAndModes, Det, Cond), no) :-
+equiv_type__replace_in_item(
+		pred(VarSet0, PredName, TypesAndModes0,
+			Det, Cond, ClassContext),
+		EqvMap, 
+		pred(VarSet, PredName, TypesAndModes, Det, Cond, ClassContext),
+		no) :-
 	equiv_type__replace_in_tms(TypesAndModes0, VarSet0, EqvMap, 
 					TypesAndModes, VarSet).
 
 equiv_type__replace_in_item(
-			func(VarSet0, PredName, TypesAndModes0, 
-				RetTypeAndMode0, Det, Cond),
-			EqvMap,
-			func(VarSet, PredName, TypesAndModes, RetTypeAndMode,
-				Det, Cond),
-			no) :-
+		func(VarSet0, PredName, TypesAndModes0, 
+			RetTypeAndMode0, Det, Cond, ClassContext),
+		EqvMap,
+		func(VarSet, PredName, TypesAndModes, RetTypeAndMode,
+			Det, Cond, ClassContext),
+		no) :-
 	equiv_type__replace_in_tms(TypesAndModes0, VarSet0, EqvMap,
 				TypesAndModes, VarSet1),
 	equiv_type__replace_in_tm(RetTypeAndMode0, VarSet1, EqvMap,
Index: compiler/excess.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/excess.m,v
retrieving revision 1.24
diff -u -r1.24 excess.m
--- excess.m	1997/09/01 14:01:24	1.24
+++ excess.m	1997/09/08 04:47:04
@@ -120,6 +120,10 @@
 		Goal = GoalExpr0 - GoalInfo0,
 		ElimVars = ElimVars0
 	;
+		GoalExpr0 = class_method_call(_, _, _, _, _, _),
+		Goal = GoalExpr0 - GoalInfo0,
+		ElimVars = ElimVars0
+	;
 		GoalExpr0 = call(_, _, _, _, _, _),
 		Goal = GoalExpr0 - GoalInfo0,
 		ElimVars = ElimVars0
Index: compiler/exprn_aux.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/exprn_aux.m,v
retrieving revision 1.23
diff -u -r1.23 exprn_aux.m
--- exprn_aux.m	1997/11/08 13:11:19	1.23
+++ exprn_aux.m	1997/11/17 02:38:45
@@ -150,6 +150,9 @@
 exprn_aux__addr_is_constant(do_det_closure, _, no).
 exprn_aux__addr_is_constant(do_semidet_closure, _, no).
 exprn_aux__addr_is_constant(do_nondet_closure, _, no).
+exprn_aux__addr_is_constant(do_det_class_method, _, no).
+exprn_aux__addr_is_constant(do_semidet_class_method, _, no).
+exprn_aux__addr_is_constant(do_nondet_class_method, _, no).
 exprn_aux__addr_is_constant(do_not_reached, _, no).
 
 :- pred exprn_aux__label_is_constant(label, bool, bool, bool).
Index: compiler/follow_code.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/follow_code.m,v
retrieving revision 1.43
diff -u -r1.43 follow_code.m
--- follow_code.m	1997/09/01 14:01:28	1.43
+++ follow_code.m	1997/09/08 04:47:26
@@ -110,6 +110,9 @@
 move_follow_code_in_goal_2(higher_order_call(A,B,C,D,E,F),
 			higher_order_call(A,B,C,D,E,F), _, R, R).
 
+move_follow_code_in_goal_2(class_method_call(A,B,C,D,E,F),
+			class_method_call(A,B,C,D,E,F), _, R, R).
+
 move_follow_code_in_goal_2(call(A,B,C,D,E,F), call(A,B,C,D,E,F), _, R, R).
 
 move_follow_code_in_goal_2(unify(A,B,C,D,E), unify(A,B,C,D,E), _, R, R).
Index: compiler/follow_vars.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/follow_vars.m,v
retrieving revision 1.43
diff -u -r1.43 follow_vars.m
--- follow_vars.m	1997/09/01 14:01:32	1.43
+++ follow_vars.m	1997/10/13 03:40:54
@@ -155,12 +155,30 @@
 	find_follow_vars_in_goal(Goal0, ArgsMethod, ModuleInfo, FollowVars0,
 		Goal, FollowVars).
 
+	% XXX These follow-vars aren't correct since the desired positions for
+	% XXX the arguments are different from an ordinary call --- they are
+	% XXX as required by do_call_{det,semidet,nondet}_closure
 find_follow_vars_in_goal_2(
 		higher_order_call(PredVar, Args, Types, Modes, Det,
 			IsPredOrFunc),
 		ArgsMethod, ModuleInfo, _FollowVars0,
 		higher_order_call(PredVar, Args, Types, Modes, Det,
 			IsPredOrFunc),
+		FollowVars) :-
+	determinism_to_code_model(Det, CodeModel),
+	make_arg_infos(ArgsMethod, Types, Modes, CodeModel, ModuleInfo,
+		ArgInfo),
+	find_follow_vars_from_arginfo(ArgInfo, Args, FollowVars).
+
+	% XXX These follow-vars aren't correct since the desired positions for
+	% XXX the arguments are different from an ordinary call --- they are
+	% XXX as required by do_call_{det,semidet,nondet}_class_method
+find_follow_vars_in_goal_2(
+		class_method_call(TypeClassInfoVar, Num, Args, Types, Modes,
+			Det),
+		ArgsMethod, ModuleInfo, _FollowVars0,
+		class_method_call(TypeClassInfoVar, Num, Args, Types, Modes,
+			Det),
 		FollowVars) :-
 	determinism_to_code_model(Det, CodeModel),
 	make_arg_infos(ArgsMethod, Types, Modes, CodeModel, ModuleInfo,
Index: compiler/goal_path.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/goal_path.m,v
retrieving revision 1.1
diff -u -r1.1 goal_path.m
--- goal_path.m	1997/10/13 08:09:39	1.1
+++ goal_path.m	1997/10/17 05:10:07
@@ -56,6 +56,8 @@
 fill_expr_slots(call(A,B,C,D,E,F), _Path0, call(A,B,C,D,E,F)).
 fill_expr_slots(higher_order_call(A,B,C,D,E,F), _Path0,
 		higher_order_call(A,B,C,D,E,F)).
+fill_expr_slots(class_method_call(A,B,C,D,E,F), _Path0,
+		class_method_call(A,B,C,D,E,F)).
 fill_expr_slots(unify(A,B,C,D,E), _Path0, unify(A,B,C,D,E)).
 fill_expr_slots(pragma_c_code(A,B,C,D,E,F,G,H), _Path0,
 		pragma_c_code(A,B,C,D,E,F,G,H)).
Index: compiler/goal_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/goal_util.m,v
retrieving revision 1.38
diff -u -r1.38 goal_util.m
--- goal_util.m	1997/09/01 14:01:36	1.38
+++ goal_util.m	1997/09/08 04:50:08
@@ -226,6 +226,15 @@
 	goal_util__rename_var_list(Args0, Must, Subn, Args).
 
 goal_util__name_apart_2(
+		class_method_call(TypeClassInfoVar0, Num, Args0, Types, Modes,
+			Det),
+		Must, Subn,
+		class_method_call(TypeClassInfoVar, Num, Args, Types, Modes,
+			Det)) :-
+	goal_util__rename_var(TypeClassInfoVar0, Must, Subn, TypeClassInfoVar),
+	goal_util__rename_var_list(Args0, Must, Subn, Args).
+
+goal_util__name_apart_2(
 		call(PredId, ProcId, Args0, Builtin, Context, Sym),
 		Must, Subn,
 		call(PredId, ProcId, Args, Builtin, Context, Sym)) :-
@@ -418,6 +427,10 @@
 		Set0, Set) :-
 	set__insert_list(Set0, [PredVar | ArgVars], Set).
 
+goal_util__goal_vars_2(class_method_call(PredVar, _, ArgVars, _, _, _),
+		Set0, Set) :-
+	set__insert_list(Set0, [PredVar | ArgVars], Set).
+
 goal_util__goal_vars_2(call(_, _, ArgVars, _, _, _), Set0, Set) :-
 	set__insert_list(Set0, ArgVars, Set).
 
@@ -537,6 +550,7 @@
 	Size is Size1 + 1.
 goal_expr_size(call(_, _, _, _, _, _), 1).
 goal_expr_size(higher_order_call(_, _, _, _, _, _), 1).
+goal_expr_size(class_method_call(_, _, _, _, _, _), 1).
 goal_expr_size(unify(_, _, _, _, _), 1).
 goal_expr_size(pragma_c_code(_, _, _, _, _, _, _, _), 1).
 
Index: compiler/higher_order.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/higher_order.m,v
retrieving revision 1.33
diff -u -r1.33 higher_order.m
--- higher_order.m	1997/09/01 14:01:46	1.33
+++ higher_order.m	1997/10/13 03:47:44
@@ -295,6 +295,10 @@
 	{ Goal0 = higher_order_call(_,_,_,_,_,_) - _ }, 
 	maybe_specialize_higher_order_call(Goal0, Goal, PredProcId, Changed).
 
+		% For now, we do not specialize class method calls
+traverse_goal(Goal, Goal, _, unchanged, 1) -->
+	{ Goal = class_method_call(_,_,_,_,_,_) - _ }.
+
 		% check whether this call could be specialized
 traverse_goal(Goal0, Goal, PredProcId, Changed, 1) -->
 	{ Goal0 = call(_,_,_,_,_,_) - _ }, 
@@ -844,14 +848,19 @@
 	Name = qualified(PredModule, PredName),
 	varset__init(EmptyVarSet),
 	map__init(EmptyVarTypes),
+	map__init(EmptyProofs),
 	
 	% This isn't looked at after here, and just clutters up
 	% hlds dumps if it's filled in.
 	ClausesInfo = clauses_info(EmptyVarSet, EmptyVarTypes,
 		EmptyVarTypes, [], []),
+		% XXX
+		% XXX This is not, in general, correct.
+		% XXX
+	TypeConstraints = [],
 	pred_info_init(PredModule, Name, Arity, Tvars,
 		Types, true, Context, ClausesInfo, local, MarkerList, GoalType,
-		PredOrFunc, PredInfo1),
+		PredOrFunc, TypeConstraints, EmptyProofs, PredInfo1),
 	pred_info_set_typevarset(PredInfo1, TypeVars, PredInfo2),
 	pred_info_procedures(PredInfo2, Procs0),
 	next_mode_id(Procs0, no, NewProcId),
Index: compiler/hlds_data.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_data.m,v
retrieving revision 1.18
diff -u -r1.18 hlds_data.m
--- hlds_data.m	1997/09/14 09:24:23	1.18
+++ hlds_data.m	1997/11/03 05:51:16
@@ -34,8 +34,15 @@
 				% Used for constructing type_infos.
 				% Note that a pred_const is for a closure
 				% whereas a code_addr_const is just an address.
-			;	base_type_info_const(string, string, int).
+			;	base_type_info_const(string, string, int)
 				% module name, type name, type arity
+			;	base_typeclass_info_const(string, class_id,
+					string)
+				% name of module containing instance
+				% declaration, class name and arity, a string
+				% encoding the type names and arities of
+				% arguments to the instance declaration
+			.
 
 	% A cons_defn is the definition of a constructor (i.e. a constant
 	% or a functor) for a particular type.
@@ -112,6 +119,8 @@
 	error("cons_id_arity: can't get arity of code_addr_const").
 cons_id_arity(base_type_info_const(_, _, _), _) :-
 	error("cons_id_arity: can't get arity of base_type_info_const").
+cons_id_arity(base_typeclass_info_const(_, _, _), _) :-
+	error("cons_id_arity: can't get arity of base_typeclass_info_const").
 
 make_functor_cons_id(term__atom(Name), Arity, cons(unqualified(Name), Arity)).
 make_functor_cons_id(term__integer(Int), _, int_const(Int)).
@@ -241,6 +250,14 @@
 			% the name of the module the type is defined in
 			% and the name of the type, while the integer is
 			% the arity.
+	;	base_typeclass_info_constant(string, class_id, string)
+			% This is how we refer to base_typeclass_info structures
+			% represented as global data. The first argument is the
+			% name of the module containing the instance declration,
+			% the second is the class name and arity, while the
+			% third is the string which uniquely identifies the
+			% instance declaration (it is made from the type of
+			% the arguments to the instance decl).
 	;	simple_tag(tag_bits)
 			% This is for constants or functors which only
 			% require a simple tag.  (A "simple" tag is one
@@ -674,5 +691,64 @@
 determinism_to_code_model(cc_multidet, model_det).
 determinism_to_code_model(erroneous,   model_det).
 determinism_to_code_model(failure,     model_semi).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- interface.
+
+:- type class_table == map(class_id, hlds_class_defn).
+
+:- type class_id 	--->	class_id(sym_name, arity).
+
+	% Information about a single `typeclass' declaration
+:- type hlds_class_defn 
+	--->	hlds_class_defn(
+			list(class_constraint), % SuperClasses
+			list(var), 		% ClassVars 
+			hlds_class_interface, 	% Methods
+			varset 			% VarNames
+		).
+
+:- type hlds_class_interface	==	list(hlds_class_proc).	
+:- type hlds_class_proc
+	---> 	hlds_class_proc(
+			pred_id,
+			proc_id
+		).
+
+	% For each class, we keep track of a list of its instances, since there
+	% can be more than one instance of each class.
+:- type instance_table == map(class_id, list(hlds_instance_defn)).
+
+	% Information about a single `instance' declaration
+:- type hlds_instance_defn 
+	--->	hlds_instance_defn(
+			import_status,		% import status of the instance
+						% declaration
+			list(class_constraint), % Constraints
+			list(type), 		% ClassTypes 
+			instance_interface, 	% Methods
+			maybe(hlds_class_interface),
+						% After check_typeclass, we 
+						% will know the pred_ids and
+						% proc_ids of all the methods
+			varset,			% VarNames
+			map(class_constraint, constraint_proof)
+						% "Proofs" of how to build the
+						% typeclass_infos for the
+						% superclasses of this class,
+						% for this instance
+		).
+
+	% `Proof' of why a constraint is redundant
+:- type constraint_proof			
+			% Apply the following instance rule, the second 
+			% argument being the number of the instance decl.
+	--->	apply_instance(hlds_instance_defn, int)
+
+			% The constraint is redundant because of the following
+			% class's superclass declaration
+	;	superclass(class_constraint).
 
 %-----------------------------------------------------------------------------%
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_goal.m,v
retrieving revision 1.42
diff -u -r1.42 hlds_goal.m
--- hlds_goal.m	1997/10/13 08:09:41	1.42
+++ hlds_goal.m	1997/10/14 06:59:20
@@ -56,6 +56,16 @@
 			pred_or_func	% call/N (pred) or apply/N (func)
 		)
 
+	;	class_method_call(
+			var,		% the typeclass_info for the instance
+			int,		% the number of the method to call
+			list(var),	% the list of argument variables (other
+					% than this instance's typeclass_info)
+			list(type),	% the types of the argument variables
+			list(mode),	% the modes of the argument variables
+			determinism	% the determinism of the called pred
+		)
+
 		% Deterministic disjunctions are converted
 		% into switches by the switch detection pass.
 
@@ -905,6 +915,7 @@
 goal_is_atomic(conj([])).
 goal_is_atomic(disj([], _)).
 goal_is_atomic(higher_order_call(_,_,_,_,_,_)).
+goal_is_atomic(class_method_call(_,_,_,_,_,_)).
 goal_is_atomic(call(_,_,_,_,_,_)).
 goal_is_atomic(unify(_,_,_,_,_)).
 goal_is_atomic(pragma_c_code(_,_,_,_,_,_,_,_)).
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_module.m,v
retrieving revision 1.25
diff -u -r1.25 hlds_module.m
--- hlds_module.m	1997/09/01 04:17:55	1.25
+++ hlds_module.m	1997/09/08 04:12:21
@@ -7,7 +7,7 @@
 % This module defines the part of the High Level Data Structure or HLDS
 % that deals with issues that are wider than a single predicate.
 
-% The four main data structures defined here are the types
+% The three main data structures defined here are the types
 %
 %	module_info
 %	dependency_info
@@ -179,6 +179,12 @@
 :- pred module_info_ctors(module_info, cons_table).
 :- mode module_info_ctors(in, out) is det.
 
+:- pred module_info_classes(module_info, class_table).
+:- mode module_info_classes(in, out) is det.
+
+:- pred module_info_instances(module_info, instance_table).
+:- mode module_info_instances(in, out) is det.
+
 :- pred module_info_num_errors(module_info, int).
 :- mode module_info_num_errors(in, out) is det.
 
@@ -243,6 +249,12 @@
 :- pred module_info_set_ctors(module_info, cons_table, module_info).
 :- mode module_info_set_ctors(in, in, out) is det.
 
+:- pred module_info_set_classes(module_info, class_table, module_info).
+:- mode module_info_set_classes(in, in, out) is det.
+
+:- pred module_info_set_instances(module_info, instance_table, module_info).
+:- mode module_info_set_instances(in, in, out) is det.
+
 :- pred module_info_set_dependency_info(module_info, dependency_info,
 	module_info).
 :- mode module_info_set_dependency_info(in, in, out) is det.
@@ -344,6 +356,8 @@
 			inst_table,
 			mode_table,
 			cons_table,
+			class_table,
+			instance_table,
 			maybe(dependency_info),
 			int,		% number of errors
 			%%% num_warnings not used:
@@ -388,47 +402,49 @@
 	BaseTypeData = base_gen_data([], []),
 	set__init(StratPreds),
 	map__init(UnusedArgInfo),
+	map__init(ClassTable),
+	map__init(InstanceTable),
 	Module_Info = module(Name, C_Code_Info, PredicateTable, Requests, 
-		UnifyPredMap, ContinuationInfo, Types, Insts, Modes, 
-		Ctors, DepInfo, 0, 0, PragmaExports, BaseTypeData, Globals,
-		StratPreds, UnusedArgInfo, 0).
+		UnifyPredMap, ContinuationInfo, Types, Insts, Modes, Ctors,
+		ClassTable, InstanceTable, DepInfo, 0, 0, PragmaExports,
+		BaseTypeData, Globals, StratPreds, UnusedArgInfo, 0).
 
 	% Various access predicates which extract different pieces
 	% of info from the module_info data structure.
 
 module_info_name(ModuleInfo, Name) :-
-	ModuleInfo = module(Name, _, _, _, _, _, _, _, _, _, _, _, _, 
-		_, _, _, _, _, _).
+	ModuleInfo = module(Name, _, _, _, _, _, _, _, _, _, _, _, _, _, 
+		_, _, _, _, _, _, _).
 
 module_info_get_c_header(ModuleInfo, C_Header) :-
-	ModuleInfo = module(_, C_Code_Info, _, _, _, _, _, _, _, _, _, _,
-		_, _, _, _, _, _, _),
+	ModuleInfo = module(_, C_Code_Info, _, _, _, _, _, _, _, _, _, _, _,
+		_, _, _, _, _, _, _, _),
 	C_Code_Info = c_code_info(C_Header, _).
 
 module_info_set_c_header(ModuleInfo1, C_Header, ModuleInfo2) :-
 	ModuleInfo1 = module(A, C_Code_Info0, 
-		C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S),
+		C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U),
 	C_Code_Info0 = c_code_info(_C_Header0, C_Body),
 	C_Code_Info = c_code_info(C_Header, C_Body),
 	ModuleInfo2 = module(A, C_Code_Info, 
-		C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S).
+		C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U).
 
 module_info_get_c_body_code(ModuleInfo, C_Body) :-
-	ModuleInfo = module(_, C_Code_Info, _, _, _, _, _, _, _, _, _, _,
-		_, _, _, _, _, _, _),
+	ModuleInfo = module(_, C_Code_Info, _, _, _, _, _, _, _, _, _, _, _,
+		_, _, _, _, _, _, _, _),
 	C_Code_Info = c_code_info(_, C_Body).
 
 module_info_set_c_body_code(ModuleInfo1, C_Body, ModuleInfo2) :-
 	ModuleInfo1 = module(A, C_Code_Info0, 
-		C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S),
+		C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U),
 	C_Code_Info0 = c_code_info(C_Header, _C_Body0),
 	C_Code_Info = c_code_info(C_Header, C_Body),
 	ModuleInfo2 = module(A, C_Code_Info, 
-		C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S).
+		C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U).
 
 module_info_get_predicate_table(ModuleInfo, PredicateTable) :-
 	ModuleInfo = module(_, _, PredicateTable, 
-		_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _).
+		_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _).
 
 module_info_preds(ModuleInfo, Preds) :-
 	module_info_get_predicate_table(ModuleInfo, PredicateTable),
@@ -461,25 +477,25 @@
 		ModuleInfo).
 
 module_info_get_unify_requests(ModuleInfo, Requests) :-
-	ModuleInfo = module(_, _, _, Requests, _, _, _, _, _, _, _, _,
-		_, _, _, _, _, _, _).
+	ModuleInfo = module(_, _, _, Requests, _, _, _, _, _, _, _, _, _,
+		_, _, _, _, _, _, _, _).
 
 module_info_get_special_pred_map(ModuleInfo, SpecialPredMap) :-
 	ModuleInfo = module(_, _, _, _, SpecialPredMap, 
-		_, _, _, _, _, _, _, _, _, _, _, _, _, _).
+		_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _).
 
 module_info_types(ModuleInfo, Types) :-
-	ModuleInfo = module(_, _, _, _, _, _, Types, _, _, _, _, _, _, 
-		_, _, _, _, _, _).
+	ModuleInfo = module(_, _, _, _, _, _, Types, _, _, _, _, _, _, _,
+		_, _, _, _, _, _, _).
 
 module_info_typeids(ModuleInfo, TypeIDs) :-
-	ModuleInfo = module(_, _, _, _, _, _, Types, _, _, _, _, _, _, 
-		_, _, _, _, _, _),
+	ModuleInfo = module(_, _, _, _, _, _, Types, _, _, _, _, _, _, _,
+		_, _, _, _, _, _, _),
 	map__keys(Types, TypeIDs).
 
 module_info_insts(ModuleInfo, Insts) :-
-	ModuleInfo = module(_, _, _, _, _, _, _, Insts, _, _, _, _, _, 
-		_, _, _, _, _, _).
+	ModuleInfo = module(_, _, _, _, _, _, _, Insts, _, _, _, _, _, _,
+		_, _, _, _, _, _, _).
 
 module_info_instids(ModuleInfo, InstIDs) :-
 	module_info_insts(ModuleInfo, InstTable),
@@ -487,25 +503,33 @@
 	user_inst_table_get_inst_ids(UserInstTable, InstIDs).
 
 module_info_modes(ModuleInfo, Modes) :-
-	ModuleInfo = module(_, _, _, _, _, _, _, _, Modes, _, _, _, _, 
-		_, _, _, _, _, _).
+	ModuleInfo = module(_, _, _, _, _, _, _, _, Modes, _, _, _, _, _,
+		_, _, _, _, _, _, _).
 
 module_info_modeids(ModuleInfo, ModeIDs) :-
-	ModuleInfo = module(_, _, _, _, _, _, _, _, Modes, _, _, _, _, 
-		_, _, _, _, _, _),
+	ModuleInfo = module(_, _, _, _, _, _, _, _, Modes, _, _, _, _, _,
+		_, _, _, _, _, _, _),
 	mode_table_get_mode_ids(Modes, ModeIDs).
 
 module_info_ctors(ModuleInfo, Ctors) :-
-	ModuleInfo = module(_, _, _, _, _, _, _, _, _, Ctors, _, _, _, 
-		_, _, _, _, _, _).
+	ModuleInfo = module(_, _, _, _, _, _, _, _, _, Ctors, _, _, _, _,
+		_, _, _, _, _, _, _).
+
+module_info_classes(ModuleInfo, Classes) :-
+	ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, Classes, _, _, _,
+		_, _, _, _, _, _, _).
+
+module_info_instances(ModuleInfo, Instances) :-
+	ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, Instances, _, _,
+		_, _, _, _, _, _, _).
 
 module_info_consids(ModuleInfo, ConsIDs) :-
-	ModuleInfo = module(_, _, _, _, _, _, _, _, _, Ctors, _, _, _, 
-		_, _, _, _, _, _),
+	ModuleInfo = module(_, _, _, _, _, _, _, _, _, Ctors, _, _, _, _,
+		_, _, _, _, _, _, _),
 	map__keys(Ctors, ConsIDs).
 
 module_info_dependency_info(ModuleInfo, DepInfo) :-
-	ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, DepInfo0, _, _,
+	ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, _, DepInfo0, _, _,
 		_, _, _, _, _, _),
 	( DepInfo0 = yes(DepInfo1) ->
 		DepInfo = DepInfo1
@@ -514,35 +538,35 @@
 	).
 
 module_info_unused_arg_info(ModuleInfo, UnusedArgInfo) :-
-	ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, _, _,
+	ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
 		_, _, _, _, UnusedArgInfo, _).
 
 module_info_dependency_info_built(ModuleInfo) :-
-	ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, yes(_), _, _,
+	ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, _, yes(_), _, _,
 		_, _, _, _, _, _).
 
 module_info_num_errors(ModuleInfo, NumErrors) :-
-	ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, NumErrors,
+	ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, _, _, NumErrors,
 		_, _, _, _, _, _, _).
 
 module_info_base_gen_infos(ModuleInfo, BaseGenInfos) :-
-	ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, _, _, _,
+	ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
 		base_gen_data(BaseGenInfos, _), _, _, _, _).
 
 module_info_base_gen_layouts(ModuleInfo, BaseGenLayouts) :-
-	ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, _, _, _,
+	ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
 		base_gen_data(_, BaseGenLayouts), _, _, _, _).
 
 module_info_globals(ModuleInfo, Globals) :-
-	ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
+	ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
 		Globals, _, _, _).
 		
 module_info_stratified_preds(ModuleInfo, StratPreds) :-
-	ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
+	ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
 		_, StratPreds, _, _).
 
 module_info_get_cell_count(ModuleInfo, CellCount) :-
-	ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
+	ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
 		_, _, _, CellCount).
 
 % not used:
@@ -553,15 +577,15 @@
 
 module_info_set_name(ModuleInfo0, Name, ModuleInfo) :-
 	ModuleInfo0 = module(_, B, C, D, E, F, G, H, I, J, K, L, M, N, 
-		O, P, Q, R, S),
+		O, P, Q, R, S, T, U),
 	ModuleInfo = module(Name, B, C, D, E, F, G, H, I, J, K, L, M, N, 
-		O, P, Q, R, S).
+		O, P, Q, R, S, T, U).
 
 module_info_set_predicate_table(ModuleInfo0, PredicateTable, ModuleInfo) :-
 	ModuleInfo0 = module(A, B, _, D, E, F, G, H, I, J, K, L, M, N, 
-		O, P, Q, R, S),
+		O, P, Q, R, S, T, U),
 	ModuleInfo = module(A, B, PredicateTable, 
-		D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S).
+		D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U).
 
 module_info_set_preds(ModuleInfo0, Preds, ModuleInfo) :-
 	module_info_get_predicate_table(ModuleInfo0, PredicateTable0),
@@ -576,70 +600,82 @@
 
 module_info_set_unify_requests(ModuleInfo0, Requests, ModuleInfo) :-
 	ModuleInfo0 = module(A, B, C, _, E, F, G, H, I, J, K, L, M, N, 
-		O, P, Q, R, S), 
+		O, P, Q, R, S, T, U), 
 	ModuleInfo = module(A, B, C, Requests, E, F, G, H, I, J, K, L, 
-		M, N, O, P, Q, R, S).
+		M, N, O, P, Q, R, S, T, U).
 
 module_info_set_special_pred_map(ModuleInfo0, SpecialPredMap, ModuleInfo) :-
 	ModuleInfo0 = module(A, B, C, D, _, F, G, H, I, J, K, L, M, 
-		N, O, P, Q, R, S),
+		N, O, P, Q, R, S, T, U),
 	ModuleInfo = module(A, B, C, D, SpecialPredMap, 
-		F, G, H, I, J, K, L, M, N, O, P, Q, R, S).
+		F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U).
 
 module_info_set_continuation_info(ModuleInfo0, ContinuationInfo, ModuleInfo) :-
 	ModuleInfo0 = module(A, B, C, D, E, _, G, H, I, J, K, L, M, N, 
-		O, P, Q, R, S),
+		O, P, Q, R, S, T, U),
 	ModuleInfo = module(A, B, C, D, E, ContinuationInfo, G, H, I, J, K, L, 
-		M, N, O, P, Q, R, S).
+		M, N, O, P, Q, R, S, T, U).
 
 module_info_set_types(ModuleInfo0, Types, ModuleInfo) :-
 	ModuleInfo0 = module(A, B, C, D, E, F, _, H, I, J, K, L, M, N, 
-		O, P, Q, R, S),
+		O, P, Q, R, S, T, U),
 	ModuleInfo = module(A, B, C, D, E, F, Types, H, I, J, K, L, M, 
-		N, O, P, Q, R, S).
+		N, O, P, Q, R, S, T, U).
 
 module_info_set_insts(ModuleInfo0, Insts, ModuleInfo) :-
 	ModuleInfo0 = module(A, B, C, D, E, F, G, _, I, J, K, L, M, N, 
-		O, P, Q, R, S),
+		O, P, Q, R, S, T, U),
 	ModuleInfo = module(A, B, C, D, E, F, G, Insts, I, J, K, L, M, 
-		N, O, P, Q, R, S).
+		N, O, P, Q, R, S, T, U).
 
 module_info_set_modes(ModuleInfo0, Modes, ModuleInfo) :-
 	ModuleInfo0 = module(A, B, C, D, E, F, G, H, _, J, K, L, M, N, 
-		O, P, Q, R, S),
+		O, P, Q, R, S, T, U),
 	ModuleInfo = module(A, B, C, D, E, F, G, H, Modes, J, K, L, M, 
-		N, O, P, Q, R, S).
+		N, O, P, Q, R, S, T, U).
 
 module_info_set_ctors(ModuleInfo0, Ctors, ModuleInfo) :-
 	ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, _, K, L, M, N, 
-		O, P, Q, R, S),
+		O, P, Q, R, S, T, U),
 	ModuleInfo = module(A, B, C, D, E, F, G, H, I, Ctors, K, L, M, 
-		N, O, P, Q, R, S).
+		N, O, P, Q, R, S, T, U).
 
-module_info_set_dependency_info(ModuleInfo0, DepInfo, ModuleInfo) :-
+module_info_set_classes(ModuleInfo0, Classes, ModuleInfo) :-
 	ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, _, L, M, N, 
-		O, P, Q, R, S),
-	ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, yes(DepInfo), 
-		L, M, N, O, P, Q, R, S).
+		O, P, Q, R, S, T, U),
+	ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, Classes, L, M, 
+		N, O, P, Q, R, S, T, U).
+
+module_info_set_instances(ModuleInfo0, Instances, ModuleInfo) :-
+	ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, K, _, M, N, 
+		O, P, Q, R, S, T, U),
+	ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K, Instances, M, 
+		N, O, P, Q, R, S, T, U).
+
+module_info_set_dependency_info(ModuleInfo0, DepInfo, ModuleInfo) :-
+	ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, K, L, _, N, 
+		O, P, Q, R, S, T, U),
+	ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K, L, yes(DepInfo), 
+		N, O, P, Q, R, S, T, U).
 
 module_info_clobber_dependency_info(ModuleInfo0, ModuleInfo) :-
-	ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, _,
-		L, M, N, O, P, Q, R, S),
-	ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, no, 
-		L, M, N, O, P, Q, R, S).
+	ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, K,
+		L, _, N, O, P, Q, R, S, T, U),
+	ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K, L, no, 
+		N, O, P, Q, R, S, T, U).
 
 module_info_set_num_errors(ModuleInfo0, Errs, ModuleInfo) :-
-	ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, K, _, M, N, 
-		O, P, Q, R, S),
-	ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K, Errs, M, N, 
-		O, P, Q, R, S).
+	ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, K, L, M, _, 
+		O, P, Q, R, S, T, U),
+	ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K, L, M, Errs,
+		O, P, Q, R, S, T, U).
 
 module_info_incr_errors(ModuleInfo0, ModuleInfo) :-
-	ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, K, Errs0, M, 
-		N, O, P, Q, R, S),
+	ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, K, L, M, Errs0,
+		O, P, Q, R, S, T, U),
 	Errs is Errs0 + 1,
-	ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K, Errs, M, N, 
-		O, P, Q, R, S).
+	ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K, L, M, Errs,
+		O, P, Q, R, S, T, U).
 
 /* not used
 module_info_incr_warnings(ModuleInfo0, ModuleInfo) :-
@@ -648,55 +684,55 @@
 	ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K, L, Warns).
 */
 module_info_next_lambda_count(ModuleInfo0, Count, ModuleInfo) :-
-	ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, K, L, Count0, N, O,
-		P, Q, R, S),
+	ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, K, L, M, Count0, O, 
+		P, Q, R, S, T, U),
 	Count is Count0 + 1,
-	ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K, L, Count, 
-		N, O, P, Q, R, S).
+	ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K, L, M, Count, O,
+		P, Q, R, S, T, U).
 
 module_info_get_continuation_info(ModuleInfo, ContinuationInfo) :-
 	ModuleInfo = module(_, _, _, _, _, ContinuationInfo, _, _, _, _, _, _, 
-		_, _, _, _, _, _, _).
+		_, _, _, _, _, _, _, _, _).
 
 module_info_get_pragma_exported_procs(ModuleInfo, Procs) :-
-	ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, _, _, 
+	ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
 		Procs, _, _, _, _, _).
 
 module_info_set_pragma_exported_procs(ModuleInfo0, Procs, ModuleInfo) :-
-	ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, K, L, M, _, 
-		O, P, Q, R, S),
-	ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K, L, M, Procs, 
-		O, P, Q, R, S).
+	ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N, 
+		O, _, Q, R, S, T, U),
+	ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, Procs, 
+		Q, R, S, T, U).
 
 module_info_set_base_gen_infos(ModuleInfo0, BaseGenInfos, ModuleInfo) :-
-	ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N, 
-		base_gen_data(_, BaseGenLayouts), P, Q, R, S),
-	ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N,
-		base_gen_data(BaseGenInfos, BaseGenLayouts), P, Q, R, S).
+	ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P,
+		base_gen_data(_, BaseGenLayouts), R, S, T, U),
+	ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P,
+		base_gen_data(BaseGenInfos, BaseGenLayouts), R, S, T, U).
 
 module_info_set_base_gen_layouts(ModuleInfo0, BaseGenLayouts, ModuleInfo) :-
-	ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N, 
-		base_gen_data(BaseGenInfos, _), P, Q, R, S),
-	ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N,
-		base_gen_data(BaseGenInfos, BaseGenLayouts), P, Q, R, S).
+	ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P,
+		base_gen_data(BaseGenInfos, _), R, S, T, U),
+	ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P,
+		base_gen_data(BaseGenInfos, BaseGenLayouts), R, S, T, U).
 
 module_info_set_stratified_preds(ModuleInfo0, StratPreds, ModuleInfo) :-
 	ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, 
-		P, _, R, S),
+		P, Q, R, _, T, U),
 	ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N,
-		O, P, StratPreds, R, S).
+		O, P, Q, R, StratPreds, T, U).
 
 module_info_set_unused_arg_info(ModuleInfo0, UnusedArgInfo, ModuleInfo) :-
 	ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, K,
-		L, M, N, O, P, Q, _, S),
+		L, M, N, O, P, Q, R, S, _, U),
 	ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K,
-		L, M, N, O, P, Q, UnusedArgInfo, S).
+		L, M, N, O, P, Q, R, S, UnusedArgInfo, U).
 
 module_info_set_cell_count(ModuleInfo0, CellCount, ModuleInfo) :-
 	ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, 
-		P, Q, R, _),
+		P, Q, R, S, T, _),
 	ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N,
-		O, P, Q, R, CellCount).
+		O, P, Q, R, S, T, CellCount).
 
 module_info_remove_predid(ModuleInfo0, PredId, ModuleInfo) :-
 	module_info_get_predicate_table(ModuleInfo0, PredicateTable0),
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_out.m,v
retrieving revision 1.174
diff -u -r1.174 hlds_out.m
--- hlds_out.m	1997/10/13 08:09:43	1.174
+++ hlds_out.m	1997/10/14 07:14:20
@@ -205,6 +205,8 @@
 hlds_out__cons_id_to_string(pred_const(_, _), "<pred>").
 hlds_out__cons_id_to_string(code_addr_const(_, _), "<code_addr>").
 hlds_out__cons_id_to_string(base_type_info_const(_, _, _), "<base_type_info>").
+hlds_out__cons_id_to_string(base_typeclass_info_const(_, _, _), 
+	"<base_typeclass_info>").
 
 hlds_out__write_cons_id(cons(SymName, Arity)) -->
 	(
@@ -231,6 +233,8 @@
 	io__write_string("<code_addr>").
 hlds_out__write_cons_id(base_type_info_const(_, _, _)) -->
 	io__write_string("<base_type_info>").
+hlds_out__write_cons_id(base_typeclass_info_const(_, _, _)) -->
+	io__write_string("<base_typeclass_info>").
 
 hlds_out__write_pred_id(ModuleInfo, PredId) -->
 	{ module_info_pred_info(ModuleInfo, PredId, PredInfo) },
@@ -447,8 +451,9 @@
 	{ pred_info_import_status(PredInfo, ImportStatus) },
 	{ pred_info_get_marker_list(PredInfo, Markers) },
 	{ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc) },
+	{ pred_info_get_class_context(PredInfo, ClassContext) },
 	mercury_output_pred_type(TVarSet, qualified(Module, PredName), ArgTypes,
-		no, Context),
+		no, ClassContext, Context),
 	{ ClausesInfo = clauses_info(VarSet, _, VarTypes, HeadVars, Clauses) },
 	hlds_out__write_indent(Indent),
 	io__write_string("% pred id: "),
@@ -485,7 +490,12 @@
 
 	hlds_out__write_procs(Indent, AppendVarnums, ModuleInfo, PredId,
 		ImportStatus, ProcTable),
-	io__write_string("\n").
+	io__write_string("\n"),
+	
+	io__write_string("\n% Class Table:\n"),
+	{ module_info_classes(ModuleInfo, ClassTable) },
+		% XXX fix this up.
+	io__write(ClassTable).
 
 :- pred hlds_out__write_marker_list(list(marker_status), io__state, io__state).
 :- mode hlds_out__write_marker_list(in, di, uo) is det.
@@ -515,6 +525,7 @@
 hlds_out__marker_name(magic, "magic").
 hlds_out__marker_name(obsolete, "obsolete").
 hlds_out__marker_name(memo, "memo").
+hlds_out__marker_name(class_method, "class_method").
 hlds_out__marker_name(terminates, "terminates").
 hlds_out__marker_name(check_termination, "check_termination").
 hlds_out__marker_name(does_not_terminate, "does_not_terminate").
@@ -987,6 +998,22 @@
 	io__write_string(Follow),
 	io__write_string("\n").
 
+hlds_out__write_goal_2(class_method_call(TCInfoVar, _, ArgVars, _, _, _),
+		_ModuleInfo, VarSet, AppendVarnums, Indent, Follow, _) -->
+		% XXX we should print more info here too
+	globals__io_lookup_string_option(verbose_dump_hlds, Verbose),
+	hlds_out__write_indent(Indent),
+	( { string__contains_char(Verbose, 'l') } ->
+		io__write_string("% class method call"),
+		hlds_out__write_indent(Indent)
+	;
+		[]
+	),
+	hlds_out__write_functor(term__atom("class_method_call"),
+		[TCInfoVar|ArgVars], VarSet, AppendVarnums),
+	io__write_string(Follow),
+	io__write_string("\n").
+
 hlds_out__write_goal_2(call(PredId, ProcId, ArgVars, Builtin,
 			MaybeUnifyContext, PredName),
 		ModuleInfo, VarSet, AppendVarnums, Indent, Follow, TypeQual) -->
@@ -1358,6 +1385,19 @@
 		io__write_string(""", "),
 		io__write_int(Arity),
 		io__write_string(")")
+	;
+		{ ConsId = base_typeclass_info_const(Module,
+			class_id(Name, Arity), Instance) },
+		io__write_string("base_typeclass_info("""),
+		io__write_string(Module),
+		io__write_string(""", """),
+		io__write_string("class_id("),
+		prog_out__write_sym_name(Name),
+		io__write_string(", "),
+		io__write_int(Arity),
+		io__write_string("), "),
+		io__write_string(Instance),
+		io__write_string(")")
 	).
 
 hlds_out__write_var_modes([], [], _, _) --> [].
@@ -1571,8 +1611,8 @@
 	hlds_out__write_var_types_2(Vars, Indent, VarSet, AppendVarnums,
 		VarTypes, TypeVarSet).
 
-:- pred hlds_out__write_typeinfo_varmap(int, bool, map(tvar, var), varset, 
-	tvarset, io__state, io__state).
+:- pred hlds_out__write_typeinfo_varmap(int, bool, map(tvar, type_info_locn),
+	varset, tvarset, io__state, io__state).
 :- mode hlds_out__write_typeinfo_varmap(in, in, in, in, in, di, uo) is det.
 
 hlds_out__write_typeinfo_varmap(Indent, AppendVarnums, TypeInfoMap, VarSet,
@@ -1584,7 +1624,7 @@
 		TypeInfoMap, VarSet, TVarSet).
 
 :- pred hlds_out__write_typeinfo_varmap_2(list(tvar), int, bool, 
-	map(tvar, var), varset, tvarset, io__state, io__state).
+	map(tvar, type_info_locn), varset, tvarset, io__state, io__state).
 :- mode hlds_out__write_typeinfo_varmap_2(in, in, in, in, in, in, di, uo) 
 	is det.
 
@@ -1601,8 +1641,20 @@
 	io__write_string(")"),
 
 	io__write_string(" -> "),
-	{ map__lookup(TypeInfoMap, TVar, Var) },
-	mercury_output_var(Var, VarSet, AppendVarnums),
+	{ map__lookup(TypeInfoMap, TVar, Locn) },
+	(
+		{ Locn = type_info(Var) },
+		io__write_string("type_info("),
+		mercury_output_var(Var, VarSet, AppendVarnums),
+		io__write_string(") ")
+	;
+		{ Locn = typeclass_info(Var, Index) },
+		io__write_string("typeclass_info("),
+		mercury_output_var(Var, VarSet, AppendVarnums),
+		io__write_string(", "),
+		io__write_int(Index),
+		io__write_string(") ")
+	),
 	io__write_string(" (number "),
 	{ term__var_to_int(Var, VarNum) },
 	io__write_int(VarNum),
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_pred.m,v
retrieving revision 1.37
diff -u -r1.37 hlds_pred.m
--- hlds_pred.m	1997/10/31 00:14:25	1.37
+++ hlds_pred.m	1997/11/20 07:15:31
@@ -195,7 +195,7 @@
 	;	obsolete	% Requests warnings if this predicate is used.
 				% Used for pragma(obsolete).
 				% The `done' status is not meaningful.
-	;	inline		% Requests that this be predicate be inlined.
+	;	inline		% Requests that this predicate be inlined.
 				% Used for pragma(inline).
 				% Since the transformation affects *other*
 				% predicates, the `done' status is not
@@ -213,6 +213,8 @@
 	;	memo		% Requests that this predicate be evaluated
 				% using memoing.
 				% Used for pragma(memo).
+	;	class_method	% Requests that this predicate be transformed
+				% into the appropriate call to a class method
 
 				% The terminates and does_not_terminate
 				% pragmas are kept as markers to ensure
@@ -240,45 +242,56 @@
 				% but it is currently not used.
 	.
 	
-
 :- type marker_status
 	--->	request(marker)
 	;	done(marker).
 
+:- type type_info_locn	
+	--->	type_info(var)		% it is a normal type info 
+					% (ie. the type is not constrained)
+	;	typeclass_info(var, int).
+					% it is packed inside a typeclass_info,
+					% and is at the given offset
+
+:- pred type_info_locn_var(type_info_locn::in, var::out) is det.
 
 	% hlds_pred__define_new_pred(Goal, CallGoal, Args, InstMap, PredName,
-	% 	TVarSet, VarTypes, VarSet, Markers, ModuleInfo0, ModuleInfo,
-	% 	PredProcId)
+	% 	TVarSet, VarTypes, ClassContext, VarSet, Markers, ModuleInfo0,
+	% 	ModuleInfo, PredProcId)
 	%
 	% Create a new predicate for the given goal, returning a goal to 
 	% call the created predicate. This must only be called after 
 	% polymorphism.m.
 :- pred hlds_pred__define_new_pred(hlds_goal, hlds_goal, list(var),
-		instmap, string, tvarset, map(var, type), varset, 
+		instmap, string, tvarset, map(var, type),
+		list(class_constraint), varset, 
 		list(marker_status), module_info, module_info, pred_proc_id).
 :- mode hlds_pred__define_new_pred(in, out, in, in, in, 
-		in, in, in, in, in, out, out) is det.
+		in, in, in, in, in, in, out, out) is det.
 
 	% Various predicates for accessing the information stored in the
 	% pred_id and pred_info data structures.
 
 :- pred pred_info_init(module_name, sym_name, arity, tvarset, list(type),
 	condition, term__context, clauses_info, import_status,
-	list(marker_status), goal_type, pred_or_func, pred_info).
-:- mode pred_info_init(in, in, in, in, in, in, in, in, in, in, in, in, out)
-	is det.
+	list(marker_status), goal_type, pred_or_func, list(class_constraint), 
+	map(class_constraint, constraint_proof), pred_info).
+:- mode pred_info_init(in, in, in, in, in, in, in, in, in, in, in, in, in, in,
+	out) is det.
 
 :- pred pred_info_create(module_name, sym_name, tvarset, list(type),
 	condition, term__context, import_status, list(marker_status),
-	pred_or_func, proc_info, proc_id, pred_info).
-:- mode pred_info_create(in, in, in, in, in, in, in, in, in, in, out, out)
+	pred_or_func, list(class_constraint), proc_info, proc_id, pred_info).
+:- mode pred_info_create(in, in, in, in, in, in, in, in, in, in, in, out, out)
 	is det.
 
 :- pred pred_info_set(tvarset, list(type), condition, clauses_info, proc_table,
 	term__context, module_name, string, arity, import_status,
-	tvarset, goal_type, list(marker_status), pred_or_func, pred_info).
-:- mode pred_info_set(in, in, in, in, in, in, in, in, in, in, in, in, in, in,
-	out) is det.
+	tvarset, goal_type, list(marker_status), pred_or_func, 
+	list(class_constraint), map(class_constraint, constraint_proof),
+	pred_info).
+:- mode pred_info_set(in, in, in, in, in, in, in, in, in, in, in, in, in, in, 
+	in, in, out) is det.
 
 :- pred pred_info_module(pred_info, module_name).
 :- mode pred_info_module(in, out) is det.
@@ -380,6 +393,21 @@
 :- pred pred_info_get_is_pred_or_func(pred_info, pred_or_func).
 :- mode pred_info_get_is_pred_or_func(in, out) is det.
 
+:- pred pred_info_get_class_context(pred_info, list(class_constraint)).
+:- mode pred_info_get_class_context(in, out) is det.
+
+:- pred pred_info_set_class_context(pred_info, list(class_constraint), 
+	pred_info).
+:- mode pred_info_set_class_context(in, in, out) is det.
+
+:- pred pred_info_get_constraint_proofs(pred_info, 
+	map(class_constraint, constraint_proof)).
+:- mode pred_info_get_constraint_proofs(in, out) is det.
+
+:- pred pred_info_set_constraint_proofs(pred_info, 
+	map(class_constraint, constraint_proof), pred_info).
+:- mode pred_info_set_constraint_proofs(in, in, out) is det.
+
 %-----------------------------------------------------------------------------%
 
 :- implementation.
@@ -444,21 +472,31 @@
 			list(marker_status),
 					% records which transformations
 					% have been done or are to be done
-			pred_or_func	% whether this "predicate" was really
+			pred_or_func,	% whether this "predicate" was really
 					% a predicate or a function
+			list(class_constraint),
+					% the class constraints on the 
+					% predicate
+			map(class_constraint, constraint_proof)
+					% explanations of how redundant
+					% constraints were eliminated. These
+					% are needed by polymorphism.m to
+					% work out where to get the
+					% typeclass_infos from.
 		).
 
 pred_info_init(ModuleName, SymName, Arity, TypeVarSet, Types, Cond, Context,
-		ClausesInfo, Status, Markers, GoalType, PredOrFunc, PredInfo) :-
+		ClausesInfo, Status, Markers, GoalType, PredOrFunc, 
+		ClassContext, ClassProofs, PredInfo) :-
 	map__init(Procs),
 	unqualify_name(SymName, PredName),
 	sym_name_get_module_name(SymName, ModuleName, PredModuleName),
 	PredInfo = predicate(TypeVarSet, Types, Cond, ClausesInfo, Procs,
 		Context, PredModuleName, PredName, Arity, Status, TypeVarSet, 
-		GoalType, Markers, PredOrFunc).
+		GoalType, Markers, PredOrFunc, ClassContext, ClassProofs).
 
 pred_info_create(ModuleName, SymName, TypeVarSet, Types, Cond, Context,
-		Status, Markers, PredOrFunc, ProcInfo, ProcId,
+		Status, Markers, PredOrFunc, ClassContext, ProcInfo, ProcId,
 		PredInfo) :-
 	map__init(Procs0),
 	proc_info_declared_determinism(ProcInfo, MaybeDetism),
@@ -471,19 +509,22 @@
 	unqualify_name(SymName, PredName),
 	% The empty list of clauses is a little white lie.
 	ClausesInfo = clauses_info(VarSet, VarTypes, VarTypes, HeadVars, []),
+	map__init(ClassProofs),
 	PredInfo = predicate(TypeVarSet, Types, Cond, ClausesInfo, Procs,
 		Context, ModuleName, PredName, Arity, Status, TypeVarSet, 
-		clauses, Markers, PredOrFunc).
+		clauses, Markers, PredOrFunc, ClassContext, ClassProofs).
 
 pred_info_set(HeadTVarSet, Types, Cond, ClausesInfo, Procs, Context,
 		PredModuleName, PredName, Arity, Status, AllTVarSet,
-		GoalType, Markers, PredOrFunc, PredInfo) :-
+		GoalType, Markers, PredOrFunc, ClassContext, ClassProofs,
+		PredInfo) :-
 	PredInfo = predicate(HeadTVarSet, Types, Cond, ClausesInfo, Procs,
 		Context, PredModuleName, PredName, Arity, Status, AllTVarSet, 
-		GoalType, Markers, PredOrFunc).
+		GoalType, Markers, PredOrFunc, ClassContext, ClassProofs).
 
 pred_info_procids(PredInfo, ProcIds) :-
-	PredInfo = predicate(_, _, _, _, Procs, _, _, _, _, _, _, _, _, _),
+	PredInfo = predicate(_, _, _, _, Procs, _, _, _, _, _, _, _, 
+		_, _, _, _),
 	map__keys(Procs, ProcIds).
 
 pred_info_non_imported_procids(PredInfo, ProcIds) :-
@@ -509,43 +550,51 @@
 	).
 
 pred_info_clauses_info(PredInfo, Clauses) :-
-	PredInfo = predicate(_, _, _, Clauses, _, _, _, _, _, _, _, _, _, _).
+	PredInfo = predicate(_, _, _, Clauses, _, _, _, _, _, _, _, _,
+		_, _, _, _).
 
 pred_info_set_clauses_info(PredInfo0, Clauses, PredInfo) :-
-	PredInfo0 = predicate(A, B, C, _, E, F, G, H, I, J, K, L, M, N),
-	PredInfo = predicate(A, B, C, Clauses, E, F, G, H, I, J, K, L, M, N).
+	PredInfo0 = predicate(A, B, C, _, E, F, G, H, I, J, K, L, M, N, O, P),
+	PredInfo = predicate(A, B, C, Clauses, E, F, G, H, I, J, K, 
+		L, M, N, O, P).
 
 pred_info_arg_types(PredInfo, TypeVars, ArgTypes) :-
 	PredInfo = predicate(TypeVars, ArgTypes, 
-		_, _, _, _, _, _, _, _, _, _, _, _).
+		_, _, _, _, _, _, _, _, _, _, _, _, _, _).
 
 pred_info_set_arg_types(PredInfo0, TypeVarSet, ArgTypes, PredInfo) :-
-	PredInfo0 = predicate(_, _, C, D, E, F, G, H, I, J, K, L, M, N),
+	PredInfo0 = predicate(_, _, C, D, E, F, G, H, I, J, K, L, M, N, O, P),
 	PredInfo = predicate(TypeVarSet, ArgTypes, 
-			C, D, E, F, G, H, I, J, K, L, M, N).
+			C, D, E, F, G, H, I, J, K, L, M, N, O, P).
 
 pred_info_procedures(PredInfo, Procs) :-
-	PredInfo = predicate(_, _, _, _, Procs, _, _, _, _, _, _, _, _, _).
+	PredInfo = predicate(_, _, _, _, Procs, _, _, _, _, _, _, 
+		_, _, _, _, _).
 
 pred_info_set_procedures(PredInfo0, Procedures, PredInfo) :-
-	PredInfo0 = predicate(A, B, C, D, _, F, G, H, I, J, K, L, M, N),
-	PredInfo = predicate(A, B, C, D, Procedures, F, G, H, I, J, K, L, M, N).
+	PredInfo0 = predicate(A, B, C, D, _, F, G, H, I, J, K, L, M, N, O, P),
+	PredInfo = predicate(A, B, C, D, Procedures, F, G, H, I, J, K, L, M, 
+		N, O, P).
 
 pred_info_context(PredInfo, Context) :-
-	PredInfo = predicate(_, _, _, _, _, Context, _, _, _, _, _, _, _, _).
+	PredInfo = predicate(_, _, _, _, _, Context, _, _, _, 
+		_, _, _, _, _, _, _).
 
 pred_info_module(PredInfo, Module) :-
-	PredInfo = predicate(_, _, _, _, _, _, Module, _, _, _, _, _, _, _).
+	PredInfo = predicate(_, _, _, _, _, _, Module, _, _, _, _, 
+		_, _, _, _, _).
 
 pred_info_name(PredInfo, PredName) :-
-	PredInfo = predicate(_, _, _, _, _, _, _, PredName, _, _, _, _, _, _).
+	PredInfo = predicate(_, _, _, _, _, _, _, PredName, _, _, _, 
+		_, _, _, _, _).
 
 pred_info_arity(PredInfo, Arity) :-
-	PredInfo = predicate(_, _, _, _, _, _, _, _, Arity, _, _, _, _, _).
+	PredInfo = predicate(_, _, _, _, _, _, _, _, Arity, _, _, 
+		_, _, _, _, _).
 
 pred_info_import_status(PredInfo, ImportStatus) :-
 	PredInfo = predicate(_, _, _, _, _, _, _, _, _, ImportStatus, _, _, _,
-				_).
+				_, _, _).
 
 pred_info_is_imported(PredInfo) :-
 	pred_info_import_status(PredInfo, imported).
@@ -563,27 +612,32 @@
 	ImportStatus = pseudo_exported.
 
 pred_info_mark_as_external(PredInfo0, PredInfo) :-
-	PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, _, K, L, M, N),
-	PredInfo  = predicate(A, B, C, D, E, F, G, H, I, imported, K, L, M, N).
+	PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, _, K, L, M, N, O, P),
+	PredInfo  = predicate(A, B, C, D, E, F, G, H, I, imported, K, L, M, 
+		N, O, P).
 
 pred_info_set_import_status(PredInfo0, Status, PredInfo) :-
-	PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, _, K, L, M, N),
-	PredInfo  = predicate(A, B, C, D, E, F, G, H, I, Status, K, L, M, N).
+	PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, _, K, L, M, N, O, P),
+	PredInfo  = predicate(A, B, C, D, E, F, G, H, I, Status, K, 
+		L, M, N, O, P).
 
 pred_info_typevarset(PredInfo, TypeVarSet) :-
-	PredInfo = predicate(_, _, _, _, _, _, _, _, _, _, TypeVarSet, _, _, _).
+	PredInfo = predicate(_, _, _, _, _, _, _, _, _, _, TypeVarSet, _, _, 
+		_, _, _).
 
 pred_info_set_typevarset(PredInfo0, TypeVarSet, PredInfo) :-
-	PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, J, _, L, M, N),
+	PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, J, _, L, M, N, O, P),
 	PredInfo  = predicate(A, B, C, D, E, F, G, H, I, J, TypeVarSet, L, M,
-				N).
+				N, O, P).
 
 pred_info_get_goal_type(PredInfo, GoalType) :-
-	PredInfo = predicate(_, _, _, _, _, _, _, _, _, _, _, GoalType, _, _).
+	PredInfo = predicate(_, _, _, _, _, _, _, _, _, _, _, GoalType, _, 
+		_, _, _).
 
 pred_info_set_goal_type(PredInfo0, GoalType, PredInfo) :-
-	PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, J, K, _, M, N),
-	PredInfo  = predicate(A, B, C, D, E, F, G, H, I, J, K, GoalType, M, N).
+	PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, J, K, _, M, N, O, P),
+	PredInfo  = predicate(A, B, C, D, E, F, G, H, I, J, K, GoalType, M, 
+		N, O, P).
 
 pred_info_requested_inlining(PredInfo0) :-
 	pred_info_get_marker_list(PredInfo0, Markers),
@@ -594,20 +648,46 @@
 	list__member(request(no_inline), Markers).
 
 pred_info_get_marker_list(PredInfo, Markers) :-
-	PredInfo = predicate(_, _, _, _, _, _, _, _, _, _, _, _, Markers, _).
+	PredInfo = predicate(_, _, _, _, _, _, _, _, _, _, _, 
+		_, Markers, _, _, _).
 
 pred_info_set_marker_list(PredInfo0, Markers, PredInfo) :-
-	PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, J, K, L, _, N),
-	PredInfo  = predicate(A, B, C, D, E, F, G, H, I, J, K, L, Markers, N).
+	PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, J, K, L, _, N, O, P),
+	PredInfo  = predicate(A, B, C, D, E, F, G, H, I, J, K, L, Markers, 
+		N, O, P).
 
 pred_info_get_is_pred_or_func(PredInfo, IsPredOrFunc) :-
 	PredInfo = predicate(_, _, _, _, _, _, _, _, _, _, _, _, _,
-			IsPredOrFunc).
+			IsPredOrFunc, _, _).
+
+pred_info_set_class_context(PredInfo0, ClassContext, PredInfo) :-
+	PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, J, K, L, M, N, _, P),
+	PredInfo  = predicate(A, B, C, D, E, F, G, H, I, J, K, L, M, N, 
+		ClassContext, P).
+
+pred_info_get_class_context(PredInfo, ClassContext) :-
+	PredInfo = predicate(_, _, _, _, _, _, _, _, _, _, _, _, _, _, 
+		ClassContext, _).
+
+pred_info_set_constraint_proofs(PredInfo0, Proofs, PredInfo) :-
+	PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, _),
+	PredInfo  = predicate(A, B, C, D, E, F, G, H, I, J, K, L, M, N, 
+		O, Proofs).
+
+pred_info_get_constraint_proofs(PredInfo, ConstraintProofs) :-
+	PredInfo = predicate(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
+		ConstraintProofs).
 
 %-----------------------------------------------------------------------------%
 
+type_info_locn_var(type_info(Var), Var).
+type_info_locn_var(typeclass_info(Var, _), Var).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
 hlds_pred__define_new_pred(Goal0, Goal, ArgVars, InstMap0, PredName, TVarSet, 
-		VarTypes, VarSet, Markers, ModuleInfo0,
+		VarTypes, ClassContext, VarSet, Markers, ModuleInfo0,
 		ModuleInfo, PredProcId) :-
 	Goal0 = _GoalExpr - GoalInfo,
 	goal_info_get_instmap_delta(GoalInfo, InstMapDelta),
@@ -621,10 +701,12 @@
 	module_info_name(ModuleInfo0, ModuleName),
 	SymName = qualified(ModuleName, PredName),
 	map__init(TVarMap), % later, polymorphism.m will fill this in. 
+	map__init(TCVarMap), % later, polymorphism.m will fill this in. 
 	proc_info_create(VarSet, VarTypes, ArgVars, ArgModes, Detism,
-		Goal0, Context, TVarMap, ProcInfo),
+		Goal0, Context, TVarMap, TCVarMap, ProcInfo),
 	pred_info_create(ModuleName, SymName, TVarSet, ArgTypes, true,
-		Context, local, Markers, predicate, ProcInfo, ProcId, PredInfo),
+		Context, local, Markers, predicate, ClassContext, 
+		ProcInfo, ProcId, PredInfo),
 
 	module_info_get_predicate_table(ModuleInfo0, PredTable0),
 	predicate_table_insert(PredTable0, PredInfo, PredId,
@@ -663,13 +745,15 @@
 :- pred proc_info_set(maybe(determinism), varset, map(var, type), list(var),
 	list(mode), maybe(list(is_live)), hlds_goal, term__context,
 	stack_slots, determinism, bool, list(arg_info), liveness_info,
-	map(tvar, var), termination, proc_info).
+	map(tvar, type_info_locn), map(class_constraint, var), termination,
+	proc_info).
 :- mode proc_info_set(in, in, in, in, in, in, in, in, in, in, in, in, in, in,
-	in, out) is det.
+	in, in, out) is det.
 
 :- pred proc_info_create(varset, map(var, type), list(var), list(mode),
-	determinism, hlds_goal, term__context, map(tvar, var), proc_info).
-:- mode proc_info_create(in, in, in, in, in, in, in, in, out) is det.
+	determinism, hlds_goal, term__context, map(tvar, type_info_locn),
+	map(class_constraint, var), proc_info).
+:- mode proc_info_create(in, in, in, in, in, in, in, in, in, out) is det.
 
 :- pred proc_info_set_body(proc_info, varset, map(var, type), list(var),
 	hlds_goal, proc_info).
@@ -775,12 +859,20 @@
 :- pred proc_info_set_can_process(proc_info, bool, proc_info).
 :- mode proc_info_set_can_process(in, in, out) is det.
 
-:- pred proc_info_typeinfo_varmap(proc_info, map(tvar, var)).
+:- pred proc_info_typeinfo_varmap(proc_info, map(tvar, type_info_locn)).
 :- mode proc_info_typeinfo_varmap(in, out) is det.
 
-:- pred proc_info_set_typeinfo_varmap(proc_info, map(tvar, var), proc_info).
+:- pred proc_info_set_typeinfo_varmap(proc_info, map(tvar, type_info_locn),
+	proc_info).
 :- mode proc_info_set_typeinfo_varmap(in, in, out) is det.
 
+:- pred proc_info_typeclass_info_varmap(proc_info, map(class_constraint, var)).
+:- mode proc_info_typeclass_info_varmap(in, out) is det.
+
+:- pred proc_info_set_typeclass_info_varmap(proc_info, 
+	map(class_constraint, var), proc_info).
+:- mode proc_info_set_typeclass_info_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.
 
@@ -843,8 +935,12 @@
 					% should be passed.
 			liveness_info,	% the initial liveness,
 					% for code generation
-			map(tvar, var),	% typeinfo vars for
+			map(tvar, type_info_locn),	
+					% typeinfo vars for
 					% type parameters
+			map(class_constraint, var),
+					% typeclass_info vars for class
+					% constraints
 			termination,	% The termination properties of the
 					% procedure.  Initially 'not_set'.
 					% Final value inferred by termination.m
@@ -874,37 +970,40 @@
 	ClauseBody = conj([]) - GoalInfo,
 	CanProcess = yes,
 	map__init(TVarsMap),
+	map__init(TCVarsMap),
 	term_util__init(Termination),
 	NewProc = procedure(
 		MaybeDet, BodyVarSet, BodyTypes, HeadVars, Modes, MaybeArgLives,
 		ClauseBody, MContext, StackSlots, InferredDet, CanProcess,
-		ArgInfo, InitialLiveness, TVarsMap, Termination, DeclaredModes
+		ArgInfo, InitialLiveness, TVarsMap, TCVarsMap, Termination,
+		DeclaredModes
 	).
 
 proc_info_set(DeclaredDetism, BodyVarSet, BodyTypes, HeadVars, HeadModes,
 		HeadLives, Goal,
 		Context, StackSlots, InferredDetism, CanProcess,
-		ArgInfo, Liveness, TVarMap, Termination, ProcInfo) :-
+		ArgInfo, Liveness, TVarMap, TCVarsMap, Termination, ProcInfo) :-
 	ProcInfo = procedure(
 		DeclaredDetism, BodyVarSet, BodyTypes, HeadVars, HeadModes,
 		HeadLives, Goal, Context, StackSlots, InferredDetism,
-		CanProcess, ArgInfo, Liveness, TVarMap, Termination, no).
+		CanProcess, ArgInfo, Liveness, TVarMap, TCVarsMap, Termination,
+		no).
 
 proc_info_create(VarSet, VarTypes, HeadVars, HeadModes, Detism, Goal,
-		Context, TVarMap, ProcInfo) :-
+		Context, TVarMap, TCVarsMap, ProcInfo) :-
 	map__init(StackSlots),
 	set__init(Liveness),
 	term_util__init(Termination),
 	MaybeHeadLives = no,
 	ProcInfo = procedure(yes(Detism), VarSet, VarTypes, HeadVars, HeadModes,
 		MaybeHeadLives, Goal, Context, StackSlots, Detism, yes, [],
-		Liveness, TVarMap, Termination, no).
+		Liveness, TVarMap, TCVarsMap, Termination, no).
 
 proc_info_set_body(ProcInfo0, VarSet, VarTypes, HeadVars, Goal, ProcInfo) :-
 	ProcInfo0 = procedure(A, _, _, _, E, F, _,
-		H, I, J, K, L, M, N, O, P),
+		H, I, J, K, L, M, N, O, P, Q),
 	ProcInfo = procedure(A, VarSet, VarTypes, HeadVars, E, F, Goal,
-		H, I, J, K, L, M, N, O, P).
+		H, I, J, K, L, M, N, O, P, Q).
 
 proc_info_interface_determinism(ProcInfo, Determinism) :-
 	proc_info_declared_determinism(ProcInfo, MaybeDeterminism),
@@ -953,45 +1052,55 @@
 	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, 
-    		_, _, _, _, _).
-proc_info_arg_info(ProcInfo, ArgInfo) :- 
-    ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, ArgInfo, 
-    		_, _, _, _).
+ 	ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, CanProcess,
+		_, _, _, _, _, _).
+proc_info_arg_info(ProcInfo, 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_typeclass_info_varmap(ProcInfo, TCVarMap) :-
+	ProcInfo = procedure(_, _, _, _, _, _, _,
+		_, _, _, _, _, _, _, TCVarMap, _, _).
 proc_info_termination(ProcInfo, Termination) :-
-    ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, _, _, _, 
+    ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
     		Termination, _).
 proc_info_maybe_declared_argmodes(ProcInfo, MaybeArgModes) :-
-    ProcInfo = procedure(_, _, _, _, _, _, _,
+	ProcInfo = procedure(_, _, _, _, _, _, _, _,
 		_, _, _, _, _, _, _, _, MaybeArgModes).
 
 proc_info_declared_argmodes(ProcInfo, ArgModes) :-
@@ -1021,74 +1130,76 @@
 % 							% derived from the
 % 							% modes etc
 % 				M	liveness_info	% the initial liveness
-%				N	map(tvar, var)  % typeinfo vars to
+%				N	map(tvar, type_info_locn)  
+%							% typeinfo vars to
+%							% locations.
+%				O	map(class_constraint, var)  
+%							% constraints to
 %							% vars.
-%				O	termination	% Termination analys
-%				P	maybe(list(mode)) % declared modes
+%				P	termination	% Termination analys
+%				Q	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, O, P),
-    ProcInfo = procedure(A, VarSet, C, D, E, F, G, H, I, J, K, L, M, N, O, P).
+	ProcInfo0 = procedure(A,_,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q),
+	ProcInfo = procedure(A,VarSet,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q).
 
 proc_info_set_variables(ProcInfo0, Vars, ProcInfo) :-
-    ProcInfo0 = procedure(A, _, C, D, E, F, G, H, I, J, K, L, M, N, O, P),
-    ProcInfo = procedure(A, Vars, C, D, E, F, G, H, I, J, K, L, M, N, O, P).
+	ProcInfo0 = procedure(A,_,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q),
+	ProcInfo = procedure(A,Vars,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q).
 
 proc_info_set_vartypes(ProcInfo0, Vars, ProcInfo) :-
-    ProcInfo0 = procedure(A, B, _, D, E, F, G, H, I, J, K, L, M, N, O, P),
-    ProcInfo = procedure(A, B, Vars, D, E, F, G, H, I, J, K, L, M, N, O, P).
+	ProcInfo0 = procedure(A,B,_,D,E,F,G,H,I,J,K,L,M,N,O,P,Q),
+	ProcInfo = procedure(A,B,Vars,D,E,F,G,H,I,J,K,L,M,N,O,P,Q).
 
-proc_info_set_headvars(ProcInfo0, HdVars, ProcInfo) :-
-    ProcInfo0 = procedure(A, B, C, _, E, F, G, H, I, J, K, L, M, N, O, P),
-    ProcInfo = procedure(A, B, C, HdVars, E, F, G, H, I, J, K, L, M, N, O, P).
+proc_info_set_headvars(ProcInfo0, HeadVars, ProcInfo) :-
+	ProcInfo0 = procedure(A,B,C,_,E,F,G,H,I,J,K,L,M,N,O,P,Q),
+	ProcInfo = procedure(A,B,C,HeadVars,E,F,G,H,I,J,K,L,M,N,O,P,Q).
 
 proc_info_set_argmodes(ProcInfo0, ArgModes, ProcInfo) :-
-    ProcInfo0 = procedure(A, B, C, D, _, F, G, H, I, J, K, L, M, N, O, P),
-    ProcInfo = procedure(A, B, C, D, ArgModes, F, G, H, I, 
-    		J, K, L, M, N, O, P).
+	ProcInfo0 = procedure(A,B,C,D,_,F,G,H,I,J,K,L,M,N,O,P,Q),
+	ProcInfo = procedure(A,B,C,D,ArgModes,F,G,H,I,J,K,L,M,N,O,P,Q).
 
 proc_info_set_maybe_arglives(ProcInfo0, ArgLives, ProcInfo) :-
-    ProcInfo0 = procedure(A, B, C, D, E, _, G, H, I, J, K, L, M, N, O, P),
-    ProcInfo = procedure(A, B, C, D, E, ArgLives, G, H, I, 
-    		J, K, L, M, N, O, P).
+	ProcInfo0 = procedure(A,B,C,D,E,_,G,H,I,J,K,L,M,N,O,P,Q),
+	ProcInfo = procedure(A,B,C,D,E,ArgLives,G,H,I,J,K,L,M,N,O,P,Q).
 
 proc_info_set_inferred_determinism(ProcInfo0, Detism, ProcInfo) :-
-    ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, _, K, L, M, N, O, P),
-    ProcInfo = procedure(A, B, C, D, E, F, G, H, I, Detism, K, L, M, N, O, P).
+	ProcInfo0 = procedure(A,B,C,D,E,F,G,H,I,_,K,L,M,N,O,P,Q),
+	ProcInfo = procedure(A,B,C,D,E,F,G,H,I,Detism,K,L,M,N,O,P,Q).
 
 proc_info_set_can_process(ProcInfo0, CanProcess, ProcInfo) :-
-    ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, _, L, M, N, O, P),
-    ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, CanProcess, 
-    		L, M, N, O, P).
+ 	ProcInfo0 = procedure(A,B,C,D,E,F,G,H,I,J,_,L,M,N,O,P,Q),
+ 	ProcInfo = procedure(A,B,C,D,E,F,G,H,I,J,CanProcess,L,M,N,O,P,Q).
 
 proc_info_set_goal(ProcInfo0, Goal, ProcInfo) :-
-    ProcInfo0 = procedure(A, B, C, D, E, F, _, H, I, J, K, L, M, N, O, P),
-    ProcInfo = procedure(A, B, C, D, E, F, Goal, H, I, J, K, L, M, N, O, P).
+	ProcInfo0 = procedure(A,B,C,D,E,F,_,H,I,J,K,L,M,N,O,P,Q),
+	ProcInfo = procedure(A,B,C,D,E,F,Goal,H,I,J,K,L,M,N,O,P,Q).
 
 proc_info_set_stack_slots(ProcInfo0, StackSlots, ProcInfo) :-
-    ProcInfo0 = procedure(A, B, C, D, E, F, G, H, _, J, K, L, M, N, O, P),
-    ProcInfo = procedure(A, B, C, D, E, F, G, H, StackSlots, J, K, 
-    		L, M, N, O, P).
+	ProcInfo0 = procedure(A,B,C,D,E,F,G,H,_,J,K,L,M,N,O,P,Q),
+	ProcInfo = procedure(A,B,C,D,E,F,G,H,StackSlots,J,K,L,M,N,O,P,Q).
 
 proc_info_set_arg_info(ProcInfo0, ArgInfo, ProcInfo) :-
-    ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, _, M, N, O, P),
-    ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, ArgInfo, M, N, O, P).
+	ProcInfo0 = procedure(A,B,C,D,E,F,G,H,I,J,K,_,M,N,O,P,Q),
+	ProcInfo = procedure(A,B,C,D,E,F,G,H,I,J,K,ArgInfo,M,N,O,P,Q).
 
 proc_info_set_liveness_info(ProcInfo0, Liveness, ProcInfo) :-
-    ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, L, _, N, O, P),
-    ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, Liveness, 
-    		N, O, P).
+	ProcInfo0 = procedure(A,B,C,D,E,F,G,H,I,J,K,L,_,N,O,P,Q),
+	ProcInfo = procedure(A,B,C,D,E,F,G,H,I,J,K,L,Liveness,N,O,P,Q).
 
 proc_info_set_typeinfo_varmap(ProcInfo0, TVarMap, ProcInfo) :-
-    ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, _, O, P),
-    ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, TVarMap, O, P).
+	ProcInfo0 = procedure(A,B,C,D,E,F,G,H,I,J,K,L,M,_,O,P,Q),
+	ProcInfo = procedure(A,B,C,D,E,F,G,H,I,J,K,L,M,TVarMap,O,P,Q).
+
+proc_info_set_typeclass_info_varmap(ProcInfo0, TCVarMap, ProcInfo) :-
+	ProcInfo0 = procedure(A,B,C,D,E,F,G,H,I,J,K,L,M,N,_,P,Q),
+	ProcInfo = procedure(A,B,C,D,E,F,G,H,I,J,K,L,M,N,TCVarMap,P,Q).
 
 proc_info_set_termination(ProcInfo0, Terminat, ProcInfo) :-
-    ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, _, P),
-    ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, 
-    		M, N, Terminat, P).
+    ProcInfo0 = procedure(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,_,Q),
+    ProcInfo = procedure(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,Terminat,Q).
 
 proc_info_get_typeinfo_vars_setwise(ProcInfo, Vars, TypeInfoVars) :-
 	set__to_sorted_list(Vars, VarList),
@@ -1117,7 +1228,18 @@
 			% higher order pred types here -- if so, maybe
 			% treat them specially.
 			proc_info_typeinfo_varmap(ProcInfo, TVarMap),
-			map__apply_to_list(TypeVars, TVarMap, TypeInfoVars0),
+
+				% The type_info is either stored in a variable,
+				% or in a typeclass_info. Either get the
+				% type_info variable or the typeclass_info
+				% variable
+			LookupVar = lambda([TVar::in, TVarVar::out] is det,
+				(
+					map__lookup(TVarMap, TVar, Locn),
+					type_info_locn_var(Locn, TVarVar)
+				)),
+			list__map(LookupVar, TypeVars, TypeInfoVars0),
+
 			proc_info_get_typeinfo_vars_2(ProcInfo, Vars1,
 				TypeInfoVars1),
 			list__append(TypeInfoVars0, TypeInfoVars1, TypeInfoVars)
Index: compiler/inlining.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/inlining.m,v
retrieving revision 1.69
diff -u -r1.69 inlining.m
--- inlining.m	1997/09/01 14:02:31	1.69
+++ inlining.m	1997/09/08 04:51:26
@@ -312,7 +312,7 @@
 		varset,			% varset
 		map(var, type),		% variable types
 		tvarset,		% type variables
-		map(tvar, var),		% type_info varset, a mapping from 
+		map(tvar, type_info_locn),% type_info varset, a mapping from 
 					% type variables to variables
 					% where their type_info is
 					% stored.
@@ -520,6 +520,9 @@
 
 inlining__inlining_in_goal(higher_order_call(A, B, C, D, E, F) - GoalInfo,
 		higher_order_call(A, B, C, D, E, F) - GoalInfo) --> [].
+
+inlining__inlining_in_goal(class_method_call(A, B, C, D, E, F) - GoalInfo,
+		class_method_call(A, B, C, D, E, F) - GoalInfo) --> [].
 
 inlining__inlining_in_goal(unify(A, B, C, D, E) - GoalInfo,
 		unify(A, B, C, D, E) - GoalInfo) --> [].
Index: compiler/intermod.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/intermod.m,v
retrieving revision 1.34
diff -u -r1.34 intermod.m
--- intermod.m	1997/10/26 23:05:36	1.34
+++ intermod.m	1997/11/17 02:38:53
@@ -387,6 +387,9 @@
 intermod__traverse_goal(higher_order_call(A,B,C,D,E,F) - Info,
 			higher_order_call(A,B,C,D,E,F) - Info, yes) --> [].
 
+intermod__traverse_goal(class_method_call(A,B,C,D,E,F) - Info,
+			class_method_call(A,B,C,D,E,F) - Info, yes) --> [].
+
 intermod__traverse_goal(switch(A, B, Cases0, D) - Info,
 		switch(A, B, Cases, D) - Info, DoWrite) -->
 	intermod__traverse_cases(Cases0, Cases, DoWrite).
@@ -851,16 +854,17 @@
 	{ pred_info_arg_types(PredInfo, TVarSet, ArgTypes) },
 	{ pred_info_context(PredInfo, Context) },
 	{ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc) },
+	{ pred_info_get_class_context(PredInfo, ClassContext) },
 	(
 		{ PredOrFunc = predicate },
 		mercury_output_pred_type(TVarSet, qualified(Module, Name),
-					ArgTypes, no, Context)
+					ArgTypes, no, ClassContext, Context)
 	;
 		{ PredOrFunc = function },
 		{ pred_args_to_func_args(ArgTypes, FuncArgTypes, FuncRetType) },
 		mercury_output_func_type(TVarSet,
 			qualified(Module, Name), FuncArgTypes,
-			FuncRetType, no, Context)
+			FuncRetType, no, ClassContext, Context)
 	),
 	{ pred_info_procedures(PredInfo, Procs) },
 	{ pred_info_procids(PredInfo, ProcIds) },
Index: compiler/lambda.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/lambda.m,v
retrieving revision 1.32
diff -u -r1.32 lambda.m
--- lambda.m	1997/09/01 14:02:47	1.32
+++ lambda.m	1997/10/17 05:38:54
@@ -43,10 +43,11 @@
 
 :- pred lambda__transform_lambda(pred_or_func, string, list(var), list(mode), 
 		determinism, set(var), hlds_goal, unification,
-		varset, map(var, type), tvarset, map(tvar, var), module_info,
-		unify_rhs, unification, module_info).
+		varset, map(var, type), list(class_constraint), tvarset,
+		map(tvar, type_info_locn), map(class_constraint, var),
+		module_info, unify_rhs, unification, module_info).
 :- mode lambda__transform_lambda(in, in, in, in, in, in, in, in, in, in, in, in,
-		in, out, out, out) is det.
+		in, in, in, out, out, out) is det.
 
 	% Permute the list of variables so that inputs come before outputs.
 :- pred lambda__permute_argvars(list(var), list(mode), module_info,
@@ -67,8 +68,14 @@
 		lambda_info(
 			varset,			% from the proc_info
 			map(var, type),		% from the proc_info
+			list(class_constraint),	% from the pred_info
 			tvarset,		% from the proc_info
-			map(tvar, var),		% from the proc_info (typeinfos)
+			map(tvar, type_info_locn),	
+						% from the proc_info 
+						% (typeinfos)
+			map(class_constraint, var),
+						% from the proc_info
+						% (typeclass_infos)
 			pred_or_func,
 			string,			% pred/func name
 			module_info
@@ -120,26 +127,28 @@
 	pred_info_name(PredInfo0, PredName),
 	pred_info_get_is_pred_or_func(PredInfo0, PredOrFunc),
 	pred_info_typevarset(PredInfo0, TypeVarSet0),
+	pred_info_get_class_context(PredInfo0, Constraints0),
 	proc_info_variables(ProcInfo0, VarSet0),
 	proc_info_vartypes(ProcInfo0, VarTypes0),
 	proc_info_goal(ProcInfo0, Goal0),
 	proc_info_typeinfo_varmap(ProcInfo0, TVarMap0),
+	proc_info_typeclass_info_varmap(ProcInfo0, TCVarMap0),
 
 	% process the goal
-	Info0 = lambda_info(VarSet0, VarTypes0, TypeVarSet0, TVarMap0, 
-		PredOrFunc, PredName,
-		ModuleInfo0),
+	Info0 = lambda_info(VarSet0, VarTypes0, Constraints0, TypeVarSet0,
+		TVarMap0, TCVarMap0, PredOrFunc, PredName, ModuleInfo0),
 	lambda__process_goal(Goal0, Goal, Info0, Info),
-	Info = lambda_info(VarSet, VarTypes, TypeVarSet, TVarMap, 
-		_, _,
-		ModuleInfo),
+	Info = lambda_info(VarSet, VarTypes, Constraints, TypeVarSet, 
+		TVarMap, TCVarMap, _, _, ModuleInfo),
 
 	% set the new values of the fields in proc_info and pred_info
 	proc_info_set_goal(ProcInfo0, Goal, ProcInfo1),
 	proc_info_set_variables(ProcInfo1, VarSet, ProcInfo2),
 	proc_info_set_vartypes(ProcInfo2, VarTypes, ProcInfo3),
-	proc_info_set_typeinfo_varmap(ProcInfo3, TVarMap, ProcInfo),
-	pred_info_set_typevarset(PredInfo0, TypeVarSet, PredInfo).
+	proc_info_set_typeinfo_varmap(ProcInfo3, TVarMap, ProcInfo4),
+	proc_info_set_typeclass_info_varmap(ProcInfo4, TCVarMap, ProcInfo),
+	pred_info_set_typevarset(PredInfo0, TypeVarSet, PredInfo1),
+	pred_info_set_class_context(PredInfo1, Constraints, PredInfo).
 
 :- pred lambda__process_goal(hlds_goal, hlds_goal,
 					lambda_info, lambda_info).
@@ -190,6 +199,9 @@
 lambda__process_goal_2(higher_order_call(A,B,C,D,E,F), GoalInfo,
 			higher_order_call(A,B,C,D,E,F) - GoalInfo) -->
 	[].
+lambda__process_goal_2(class_method_call(A,B,C,D,E,F), GoalInfo,
+			class_method_call(A,B,C,D,E,F) - GoalInfo) -->
+	[].
 lambda__process_goal_2(call(A,B,C,D,E,F), GoalInfo,
 			call(A,B,C,D,E,F) - GoalInfo) -->
 	[].
@@ -224,18 +236,18 @@
 
 lambda__process_lambda(PredOrFunc, Vars, Modes, Det, OrigNonLocals0, LambdaGoal,
 		Unification0, Functor, Unification, LambdaInfo0, LambdaInfo) :-
-	LambdaInfo0 = lambda_info(VarSet, VarTypes, TVarSet, TVarMap, 
-			POF, PredName, ModuleInfo0),
+	LambdaInfo0 = lambda_info(VarSet, VarTypes, Constraints, TVarSet,
+			TVarMap, TCVarMap, POF, PredName, ModuleInfo0),
 	lambda__transform_lambda(PredOrFunc, PredName, Vars, Modes, Det,
 		OrigNonLocals0, LambdaGoal, Unification0, VarSet, VarTypes,
-		TVarSet, TVarMap, ModuleInfo0, Functor,
+		Constraints, TVarSet, TVarMap, TCVarMap, ModuleInfo0, Functor,
 		Unification, ModuleInfo),
-	LambdaInfo = lambda_info(VarSet, VarTypes, TVarSet, TVarMap, 
-			POF, PredName, ModuleInfo).
+	LambdaInfo = lambda_info(VarSet, VarTypes, Constraints, TVarSet,
+			TVarMap, TCVarMap, POF, PredName, ModuleInfo).
 
 lambda__transform_lambda(PredOrFunc, OrigPredName, Vars, Modes, Detism,
 		OrigNonLocals0, LambdaGoal, Unification0, VarSet, VarTypes,
-		TVarSet, TVarMap, ModuleInfo0, Functor,
+		Constraints, TVarSet, TVarMap, TCVarMap, ModuleInfo0, Functor,
 		Unification, ModuleInfo) :-
 	(
 		Unification0 = construct(Var0, _, _, UniModes0)
@@ -360,11 +372,11 @@
 
 		proc_info_create(VarSet, VarTypes, PermutedArgVars,
 			PermutedArgModes, Detism, LambdaGoal, LambdaContext,
-			TVarMap, ProcInfo),
+			TVarMap, TCVarMap, ProcInfo),
 
 		pred_info_create(ModuleName, PredName, TVarSet, ArgTypes,
-			true, LambdaContext, local, [], PredOrFunc, ProcInfo,
-			ProcId, PredInfo),
+			true, LambdaContext, local, [], PredOrFunc, 
+			Constraints, ProcInfo, ProcId, PredInfo),
 
 		% save the new predicate in the predicate table
 
Index: compiler/lco.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/lco.m,v
retrieving revision 1.7
diff -u -r1.7 lco.m
--- lco.m	1997/09/01 14:02:49	1.7
+++ lco.m	1997/09/08 04:54:11
@@ -83,6 +83,9 @@
 lco_in_goal_2(higher_order_call(A,B,C,D,E,F), _ModuleInfo,
 		higher_order_call(A,B,C,D,E,F)).
 
+lco_in_goal_2(class_method_call(A,B,C,D,E,F), _ModuleInfo,
+		class_method_call(A,B,C,D,E,F)).
+
 lco_in_goal_2(call(A,B,C,D,E,F), _ModuleInfo, call(A,B,C,D,E,F)).
 
 lco_in_goal_2(unify(A,B,C,D,E), _ModuleInfo, unify(A,B,C,D,E)).
Index: compiler/live_vars.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/live_vars.m,v
retrieving revision 1.67
diff -u -r1.67 live_vars.m
--- live_vars.m	1997/09/01 14:02:55	1.67
+++ live_vars.m	1997/09/08 04:55:25
@@ -254,6 +254,44 @@
 		ResumeVars = ResumeVars0
 	).
 
+	% Code duplication. Ulch.
+build_live_sets_in_goal_2(class_method_call(_, _, ArgVars, Types, Modes, Det),
+		Liveness, ResumeVars0, LiveSets0,
+		GoalInfo, ModuleInfo, ProcInfo,
+		Liveness, ResumeVars, LiveSets) :-
+	% The variables which need to be saved onto the stack
+	% before the call are all the variables that are live
+	% after the call, except for the output arguments produced
+	% by the call, plus all the variables that may be needed
+	% at an enclosing resumption point.
+
+	% To figure out which variables are output, we use the arg_info;
+	% but it shouldn't matter which arg convention we're using,
+	% so we can just pass convention `simple' to make_arg_infos.
+
+	determinism_to_code_model(Det, CallModel),
+	make_arg_infos(simple, Types, Modes, CallModel, ModuleInfo, ArgInfos),
+	find_output_vars_from_arg_info(ArgVars, ArgInfos, OutVars),
+	set__difference(Liveness, OutVars, InputLiveness),
+	set__union(InputLiveness, ResumeVars0, StackVars0),
+
+	% Might need to add more live variables with accurate GC.
+
+	maybe_add_accurate_gc_typeinfos(ModuleInfo, ProcInfo,
+		OutVars, StackVars0, StackVars),
+
+	set__insert(LiveSets0, StackVars, LiveSets),
+
+	% If this is a nondet call, then all the stack slots we need
+	% must be protected against reuse in following code.
+
+	goal_info_get_code_model(GoalInfo, CodeModel),
+	( CodeModel = model_non ->
+		ResumeVars = StackVars		% includes ResumeVars0
+	;
+		ResumeVars = ResumeVars0
+	).
+
 build_live_sets_in_goal_2(call(PredId, ProcId, ArgVars, BuiltinState, _, _),
 		Liveness, ResumeVars0, LiveSets0,
 		GoalInfo, ModuleInfo, ProcInfo,
Index: compiler/livemap.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/livemap.m,v
retrieving revision 1.27
diff -u -r1.27 livemap.m
--- livemap.m	1997/08/25 17:48:18	1.27
+++ livemap.m	1997/09/08 04:12:41
@@ -362,6 +362,9 @@
 livemap__special_code_addr(do_det_closure, no).
 livemap__special_code_addr(do_semidet_closure, no).
 livemap__special_code_addr(do_nondet_closure, no).
+livemap__special_code_addr(do_det_class_method, no).
+livemap__special_code_addr(do_semidet_class_method, no).
+livemap__special_code_addr(do_nondet_class_method, no).
 livemap__special_code_addr(do_not_reached, no).
 
 %-----------------------------------------------------------------------------%
Index: compiler/liveness.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/liveness.m,v
retrieving revision 1.84
diff -u -r1.84 liveness.m
--- liveness.m	1997/10/20 07:35:22	1.84
+++ liveness.m	1997/11/17 02:38:55
@@ -289,6 +289,9 @@
 detect_liveness_in_goal_2(higher_order_call(_,_,_,_,_,_), _, _, _, _, _) :-
 	error("higher-order-call in detect_liveness_in_goal_2").
 
+detect_liveness_in_goal_2(class_method_call(_,_,_,_,_,_), _, _, _, _, _) :-
+	error("class method call in detect_liveness_in_goal_2").
+
 detect_liveness_in_goal_2(call(_,_,_,_,_,_), _, _, _, _, _) :-
 	error("call in detect_liveness_in_goal_2").
 
@@ -465,6 +468,9 @@
 detect_deadness_in_goal_2(higher_order_call(_,_,_,_,_,_), _, _, _, _, _) :-
 	error("higher-order-call in detect_deadness_in_goal_2").
 
+detect_deadness_in_goal_2(class_method_call(_,_,_,_,_,_), _, _, _, _, _) :-
+	error("class-method-call in detect_deadness_in_goal_2").
+
 detect_deadness_in_goal_2(call(_,_,_,_,_,_), _, _, _, _, _) :-
 	error("call in detect_deadness_in_goal_2").
 
@@ -659,6 +665,9 @@
 
 detect_resume_points_in_goal_2(higher_order_call(A,B,C,D,E,F), _, Liveness,
 		_, _, higher_order_call(A,B,C,D,E,F), Liveness).
+
+detect_resume_points_in_goal_2(class_method_call(A,B,C,D,E,F), _, Liveness, _,
+		_, class_method_call(A,B,C,D,E,F), Liveness).
 
 detect_resume_points_in_goal_2(call(A,B,C,D,E,F), _, Liveness, _, _,
 		call(A,B,C,D,E,F), Liveness).
Index: compiler/llds.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/llds.m,v
retrieving revision 1.212
diff -u -r1.212 llds.m
--- llds.m	1997/11/08 13:11:26	1.212
+++ llds.m	1997/11/17 06:22:12
@@ -16,7 +16,7 @@
 
 :- interface.
 
-:- import_module hlds_pred, tree, prog_data, (inst).
+:- import_module hlds_pred, hlds_data, tree, prog_data, (inst).
 :- import_module assoc_list, bool, list, set, term, std_util.
 
 %-----------------------------------------------------------------------------%
@@ -438,6 +438,9 @@
 	--->	common(int)
 	;	base_type(base_data, string, arity)
 			% base_data, type name, type arity
+	;	base_typeclass_info(class_id, string)
+			% class name & class arity, names and arities of the
+			% types
 	;	stack_layout(label).	
 			% stack_layout for a given label
 
@@ -523,6 +526,9 @@
 	;	do_det_closure
 	;	do_semidet_closure
 	;	do_nondet_closure
+	;	do_det_class_method
+	;	do_semidet_class_method
+	;	do_nondet_class_method
 	;	do_not_reached.		% we should never jump to this address
 
 	% A proc_label is a label used for the entry point to a procedure.
Index: compiler/llds_out.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/llds_out.m,v
retrieving revision 1.62
diff -u -r1.62 llds_out.m
--- llds_out.m	1997/11/11 05:27:50	1.62
+++ llds_out.m	1997/11/18 03:33:09
@@ -17,7 +17,7 @@
 
 :- interface.
 
-:- import_module llds.
+:- import_module llds, hlds_data.
 :- import_module io.
 
 	% Given a 'c_file' structure, open the appropriate .c file
@@ -92,6 +92,11 @@
 :- pred llds_out__make_base_type_name(base_data, string, arity, string).
 :- mode llds_out__make_base_type_name(in, in, in, out) is det.
 
+	% Create a name for base_typeclass_info
+
+:- pred llds_out__make_base_typeclass_info_name(class_id, string, string).
+:- mode llds_out__make_base_typeclass_info_name(in, in, out) is det.
+
 %-----------------------------------------------------------------------------%
 
 :- implementation.
@@ -1820,6 +1825,9 @@
 need_code_addr_decls(do_det_closure, yes) --> [].
 need_code_addr_decls(do_semidet_closure, yes) --> [].
 need_code_addr_decls(do_nondet_closure, yes) --> [].
+need_code_addr_decls(do_det_class_method, yes) --> [].
+need_code_addr_decls(do_semidet_class_method, yes) --> [].
+need_code_addr_decls(do_nondet_class_method, yes) --> [].
 need_code_addr_decls(do_not_reached, yes) --> [].
 
 :- pred output_code_addr_decls(code_addr, io__state, io__state).
@@ -1859,6 +1867,12 @@
 	io__write_string("Declare_entry(do_call_semidet_closure);\n").
 output_code_addr_decls(do_nondet_closure) -->
 	io__write_string("Declare_entry(do_call_nondet_closure);\n").
+output_code_addr_decls(do_det_class_method) -->
+	io__write_string("Declare_entry(do_call_det_class_method);\n").
+output_code_addr_decls(do_semidet_class_method) -->
+	io__write_string("Declare_entry(do_call_semidet_class_method);\n").
+output_code_addr_decls(do_nondet_class_method) -->
+	io__write_string("Declare_entry(do_call_nondet_class_method);\n").
 output_code_addr_decls(do_not_reached) -->
 	io__write_string("Declare_entry(do_not_reached);\n").
 
@@ -2022,6 +2036,18 @@
 	io__write_string("tailcall(ENTRY(do_call_nondet_closure),\n\t\t"),
 	output_label_as_code_addr(CallerLabel),
 	io__write_string(");\n").
+output_goto(do_det_class_method, CallerLabel) -->
+	io__write_string("tailcall(ENTRY(do_call_det_class_method),\n\t\t"),
+	output_label_as_code_addr(CallerLabel),
+	io__write_string(");\n").
+output_goto(do_semidet_class_method, CallerLabel) -->
+	io__write_string("tailcall(ENTRY(do_call_semidet_class_method),\n\t\t"),
+	output_label_as_code_addr(CallerLabel),
+	io__write_string(");\n").
+output_goto(do_nondet_class_method, CallerLabel) -->
+	io__write_string("tailcall(ENTRY(do_call_nondet_class_method),\n\t\t"),
+	output_label_as_code_addr(CallerLabel),
+	io__write_string(");\n").
 output_goto(do_not_reached, CallerLabel) -->
 	io__write_string("tailcall(ENTRY(do_not_reached),\n\t\t"),
 	output_label_as_code_addr(CallerLabel),
@@ -2093,6 +2119,12 @@
 	io__write_string("ENTRY(do_call_semidet_closure)").
 output_code_addr(do_nondet_closure) -->
 	io__write_string("ENTRY(do_call_nondet_closure)").
+output_code_addr(do_det_class_method) -->
+	io__write_string("ENTRY(do_call_det_class_method)").
+output_code_addr(do_semidet_class_method) -->
+	io__write_string("ENTRY(do_call_semidet_class_method)").
+output_code_addr(do_nondet_class_method) -->
+	io__write_string("ENTRY(do_call_nondet_class_method)").
 output_code_addr(do_not_reached) -->
 	io__write_string("ENTRY(do_not_reached)").
 
@@ -2119,6 +2151,17 @@
 		io__write_string("__"),
 		io__write_string(Str)
 	;
+			% We don't want to include the module name as part
+			% of the name if it is a base_typeclass_info, since
+			% we _want_ to cause a link error for overlapping
+			% instance decls, even if they are in a different 
+			% module
+		{ VarName = base_typeclass_info(ClassId, TypeNames) },
+		{ llds_out__make_base_typeclass_info_name(ClassId, TypeNames, 
+			Str) },
+		io__write_string("__"),
+		io__write_string(Str)
+	;
 		{ VarName = stack_layout(Label) },
 		io__write_string("_stack_layout__"),
 		output_label(Label)
@@ -3032,6 +3075,22 @@
         string__append_list(["base_type_", BaseString, "_", TypeName, "_", 
 		A_str], Str).
 
+
+%-----------------------------------------------------------------------------%
+
+llds_out__make_base_typeclass_info_name(class_id(ClassSym, ClassArity),
+		TypeNames0, Str) :-
+	(
+		ClassSym = unqualified(_),
+		error("llds_out__make_base_typeclass_info_name: unqualified name")
+	;
+		ClassSym = qualified(ModuleName, ClassName),
+		string__append_list([ModuleName, "__", ClassName], ClassString)
+	),
+	string__int_to_string(ClassArity, A_str),
+	llds_out__name_mangle(TypeNames0, TypeNames),
+	string__append_list(["base_typeclass_info_", ClassString, "_", A_str,
+		"__", TypeNames], Str).
 
 %-----------------------------------------------------------------------------%
 
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/make_hlds.m,v
retrieving revision 1.243
diff -u -r1.243 make_hlds.m
--- make_hlds.m	1997/11/02 12:28:53	1.243
+++ make_hlds.m	1997/11/17 02:39:04
@@ -133,8 +133,8 @@
 	% for a predicate to syntactically precede the pred declaration.
 	%
 	% Adding default modes for functions needs to come after we have
-	% have processed all the mode declarations, since otherwise we
-	% can't be sure that there isn't a mode declaration for the function.
+	% processed all the mode declarations, since otherwise we can't be 
+	% sure that there isn't a mode declaration for the function.
 
 :- pred add_item_list_decls_pass_2(item_list, item_status,
 		module_info, module_info, io__state, io__state).
@@ -188,26 +188,29 @@
 	module_add_mode_defn(Module0, VarSet, ModeDefn, Cond, Context,
 			Status, Module).
 
-add_item_decl_pass_1(pred(VarSet, PredName, TypesAndModes, MaybeDet, Cond),
+add_item_decl_pass_1(pred(VarSet, PredName, TypesAndModes, 
+		MaybeDet, Cond, ClassContext),
 		Context, Status, Module0, Status, Module) -->
 	module_add_pred(Module0, VarSet, PredName, TypesAndModes, MaybeDet,
-		Cond, Context, Status, Module).
+		Cond, ClassContext, [], Context, Status, _, Module).
 
 add_item_decl_pass_1(func(VarSet, FuncName, TypesAndModes, RetTypeAndMode,
-		MaybeDet, Cond), Context, Status, Module0, Status, Module) -->
+		MaybeDet, Cond, ClassContext), Context, Status, Module0, 
+		Status, Module) -->
 	module_add_func(Module0, VarSet, FuncName, TypesAndModes,
-		RetTypeAndMode, MaybeDet, Cond, Context, Status, Module).
+		RetTypeAndMode, MaybeDet, Cond, ClassContext, [], Context, 
+		Status, _, Module).
 
 add_item_decl_pass_1(pred_mode(VarSet, PredName, Modes, MaybeDet, Cond),
 		Context, Status, Module0, Status, Module) -->
 	module_add_mode(Module0, VarSet, PredName, Modes, MaybeDet, Cond,
-		Context, predicate, Module).
+		Context, predicate, _, Module).
 
 add_item_decl_pass_1(func_mode(VarSet, FuncName, Modes, RetMode, MaybeDet,
 		Cond), Context, Status, Module0, Status, Module) -->
 	{ list__append(Modes, [RetMode], Modes1) },
 	module_add_mode(Module0, VarSet, FuncName, Modes1,
-		MaybeDet, Cond, Context, function, Module).
+		MaybeDet, Cond, Context, function, _, Module).
 
 add_item_decl_pass_1(pragma(_), _, Status, Module, Status, Module) --> [].
 
@@ -248,6 +251,16 @@
 
 add_item_decl_pass_1(nothing, _, Status, Module, Status, Module) --> [].
 
+add_item_decl_pass_1(typeclass(Constraints, Name, Vars, Interface, VarSet), 
+		Context, Status, Module0, Status, Module) -->
+	module_add_class_defn(Module0, Constraints, Name, Vars, Interface,
+		VarSet, Context, Status, Module).
+
+	% 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,
+	Module) --> [].
+
 %-----------------------------------------------------------------------------%
 
 	% dispatch on the different types of items
@@ -463,8 +476,8 @@
 	).
 
 add_item_decl_pass_2(func(_VarSet, FuncName, TypesAndModes, _RetTypeAndMode,
-		_MaybeDet, _Cond), _Context, Status, Module0, Status, Module)
-		-->
+		_MaybeDet, _Cond, _ClassContext), _Context, Status, Module0,
+		Status, Module) -->
 	%
 	% add default modes for function declarations, if necessary
 	%
@@ -490,13 +503,20 @@
 		--> [].
 add_item_decl_pass_2(mode_defn(_, _, _), _, Status, Module, Status, Module)
 		--> [].
-add_item_decl_pass_2(pred(_, _, _, _, _), _, Status, Module, Status, Module)
+add_item_decl_pass_2(pred(_, _, _, _, _, _), _, Status, Module, Status, Module)
 		--> [].
 add_item_decl_pass_2(pred_mode(_, _, _, _, _), _, Status, Module, Status,
 		Module) --> [].
 add_item_decl_pass_2(func_mode(_, _, _, _, _, _), _, Status, Module, Status,
 		Module) --> [].
 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, Interface, VarSet), 
+		Context, Status, Module0, Status, Module) -->
+	{ Status = item_status(ImportStatus, _) },
+	module_add_instance_defn(Module0, Constraints, Name, Types, Interface,
+		VarSet, ImportStatus, Context, Module).
 
 %------------------------------------------------------------------------------
 
@@ -539,9 +559,9 @@
 				Module, Module, Info, Info) --> [].
 add_item_clause(mode_defn(_, _, _), Status, Status, _,
 				Module, Module, Info, Info) --> [].
-add_item_clause(pred(_, _, _, _, _), Status, Status, _,
+add_item_clause(pred(_, _, _, _, _, _), Status, Status, _,
 				Module, Module, Info, Info) --> [].
-add_item_clause(func(_, _, _, _, _, _), Status, Status, _,
+add_item_clause(func(_, _, _, _, _, _, _), Status, Status, _,
 				Module, Module, Info, Info) --> [].
 add_item_clause(pred_mode(_, _, _, _, _), Status, Status, _,
 				Module, Module, Info, Info) --> [].
@@ -588,6 +608,10 @@
 		{ Info = Info0 }	
 	).
 add_item_clause(nothing, Status, Status, _, Module, Module, Info, Info) --> [].
+add_item_clause(typeclass(_, _, _, _, _)
+	, Status, Status, _, Module, Module, Info, Info) --> [].
+add_item_clause(instance(_, _, _, _, _)
+	, Status, Status, _, Module, Module, Info, Info) --> [].
 
 %-----------------------------------------------------------------------------%
 
@@ -1060,12 +1084,16 @@
 %---------------------------------------------------------------------------%
 
 :- pred module_add_pred(module_info, varset, sym_name, list(type_and_mode),
-		maybe(determinism), condition, term__context, 
-		item_status, module_info, io__state, io__state).
-:- mode module_add_pred(in, in, in, in, in, in, in, in, out, di, uo) is det.
+		maybe(determinism), condition, list(class_constraint), 
+		list(marker_status), term__context, item_status, 
+		maybe(pair(pred_id, proc_id)), module_info, 
+		io__state, io__state).
+:- mode module_add_pred(in, in, in, in, in, in, in, in, in, in, out, out,
+		di, uo) is det.
 
 module_add_pred(Module0, VarSet, PredName, TypesAndModes, MaybeDet, Cond,
-		Context, item_status(Status, NeedQual), Module) -->
+		ClassContext, Markers, Context, item_status(Status, NeedQual), 
+		MaybePredProcId, Module) -->
 	% Only preds with opt_imported clauses are tagged as opt_imported, so
 	% that the compiler doesn't look for clauses for other preds read in
 	% from optimization interfaces.
@@ -1075,25 +1103,30 @@
 		DeclStatus = Status
 	},
 	{ split_types_and_modes(TypesAndModes, Types, MaybeModes) },
-	add_new_pred(Module0, VarSet, PredName, Types, Cond, Context,
-		DeclStatus, NeedQual, predicate, Module1),
+	add_new_pred(Module0, VarSet, PredName, Types, Cond, ClassContext,
+		Markers, Context, DeclStatus, NeedQual, predicate, Module1),
 	(
 		{ MaybeModes = yes(Modes) }
 	->
 		module_add_mode(Module1, VarSet, PredName, Modes, MaybeDet,
-			Cond, Context, predicate, Module)
+			Cond, Context, predicate, PredProcId, Module),
+		{ MaybePredProcId = yes(PredProcId) }
 	;
-		{ Module = Module1 }
+		{ Module = Module1 },
+		{ MaybePredProcId = no }
 	).
 
 :- pred module_add_func(module_info, varset, sym_name, list(type_and_mode),
-		type_and_mode, maybe(determinism), condition, term__context,
-		item_status, module_info, io__state, io__state).
-:- mode module_add_func(in, in, in, in, in, in, in, in, in, out, di, uo) is det.
+		type_and_mode, maybe(determinism), condition,
+		list(class_constraint), list(marker_status), term__context,
+		item_status, maybe(pair(pred_id, proc_id)),
+		module_info, io__state, io__state).
+:- mode module_add_func(in, in, in, in, in, in, in, in, in, in, in, out, out,
+		di, uo) is det.
 
 module_add_func(Module0, VarSet, FuncName, TypesAndModes, RetTypeAndMode,
-		MaybeDet, Cond, Context,
-		item_status(Status, NeedQual), Module) -->
+		MaybeDet, Cond, ClassContext, Markers, Context,
+		item_status(Status, NeedQual), MaybePredProcId, Module) -->
 	% Only funcs with opt_imported clauses are tagged as opt_imported, so
 	% that the compiler doesn't look for clauses for other preds.
 	{ Status = opt_imported ->
@@ -1104,30 +1137,160 @@
 	{ split_types_and_modes(TypesAndModes, Types, MaybeModes) },
 	{ split_type_and_mode(RetTypeAndMode, RetType, MaybeRetMode) },
 	{ list__append(Types, [RetType], Types1) },
-	add_new_pred(Module0, VarSet, FuncName, Types1, Cond, Context,
-		DeclStatus, NeedQual, function, Module1),
+	add_new_pred(Module0, VarSet, FuncName, Types1, Cond, ClassContext,
+		Markers, Context, DeclStatus, NeedQual, function, Module1),
 	(
 		{ MaybeModes = yes(Modes) },
 		{ MaybeRetMode = yes(RetMode) }
 	->
 		{ list__append(Modes, [RetMode], Modes1) },
 		module_add_mode(Module1, VarSet, FuncName, Modes1,
-			MaybeDet, Cond, Context, function, Module)
+			MaybeDet, Cond, Context, function, PredProcId, Module),
+		{ MaybePredProcId = yes(PredProcId) }
+	;
+		{ Module = Module1 },
+		{ MaybePredProcId = no}
+	).
+
+:- pred module_add_class_defn(module_info, list(class_constraint), sym_name,
+	list(var), class_interface, varset, term__context, 
+	item_status, module_info, io__state, io__state).
+:- mode module_add_class_defn(in, in, in, in, in, in, in, in, out, 
+	di, uo) is det.
+
+module_add_class_defn(Module0, Constraints, Name, Vars, Interface, VarSet,
+		Context, Status, Module) -->
+	{ module_info_classes(Module0, Classes0) },
+	{ list__length(Vars, ClassArity) },
+	{ Key = class_id(Name, ClassArity) },
+	(
+		{ map__search(Classes0, Key, _) }
+	->
+			% XXX format the output properly (?)
+		prog_out__write_context(Context),
+		io__write_string("Error: typeclass "),
+		prog_out__write_sym_name(Name),
+		io__write_char('/'),
+		io__write_int(ClassArity),
+		io__write_string(" multiply defined.\n"),
+		io__set_exit_status(1),
+		{ Module = Module0 }
+	;
+		module_add_class_interface(Module0, Name, Vars, Interface,
+			Status, PredProcIds0, Module1),
+			% Get rid of the `no's from the list of maybes
+		{ IsYes = lambda([Maybe::in, PredProcId::out] is semidet,
+			(
+				Maybe = yes(Pred - Proc),
+				PredProcId = hlds_class_proc(Pred, Proc)
+			)) },
+		{ list__filter_map(IsYes, PredProcIds0, PredProcIds) },
+		{ Value = hlds_class_defn(Constraints, Vars, PredProcIds, 
+			VarSet) },
+		{ map__det_insert(Classes0, Key, Value, Classes) },
+		{ module_info_set_classes(Module1, Classes, Module2) },
+			% When we find the class declaration, make an
+			% entry for the instances.
+		{ module_info_instances(Module2, Instances0) },
+		{ map__det_insert(Instances0, Key, [], Instances) },
+		{ module_info_set_instances(Module2, Instances, Module) }
+	).
+
+:- pred module_add_class_interface(module_info, sym_name, list(var),
+	class_interface, item_status, list(maybe(pair(pred_id, proc_id))), 
+	module_info, io__state, io__state).
+:- mode module_add_class_interface(in, in, in, in, in, out, out, di, uo) is det.
+
+module_add_class_interface(Module, _, _, [], _, [], Module) --> [].
+module_add_class_interface(Module0, Name, Vars, [M|Ms], Status, [P|Ps], 
+		Module) -->
+	module_add_class_method(M, Name, Vars, Status, P, Module0, Module1),
+	module_add_class_interface(Module1, Name, Vars, Ms, Status, Ps, Module).
+
+:- pred module_add_class_method(class_method, sym_name, list(var), 
+	item_status, maybe(pair(pred_id, proc_id)), module_info, module_info,
+	io__state, io__state).
+:- mode module_add_class_method(in, in, in, in, out, in, out, di, uo) is det.
+	
+module_add_class_method(Method, Name, Vars, Status, MaybePredIdProcId, 
+		Module0, Module) -->
+	(
+		{ Method = pred(VarSet, PredName, TypesAndModes, 
+			MaybeDet, Cond, ClassContext, Context) },
+		{ term__var_list_to_term_list(Vars, VarTerms) },
+		{ NewClassContext = [constraint(Name, VarTerms)|ClassContext] },
+		{ Markers = [request(class_method)] },
+		module_add_pred(Module0, VarSet, PredName, TypesAndModes,
+			MaybeDet, Cond, NewClassContext, Markers,
+			Context, Status, MaybePredIdProcId, Module)
+	;
+		{ Method = func(VarSet, FuncName, TypesAndModes, RetTypeAndMode,
+			MaybeDet, Cond, ClassContext, Context) },
+		{ term__var_list_to_term_list(Vars, VarTerms) },
+		{ NewClassContext = [constraint(Name, VarTerms)|ClassContext] },
+		{ Markers = [request(class_method)] },
+		module_add_func(Module0, VarSet, FuncName, TypesAndModes,
+			RetTypeAndMode, MaybeDet, Cond, NewClassContext,
+			Markers, Context, Status, MaybePredIdProcId, Module)
+	;
+		{ Method = pred_mode(VarSet, PredName, Modes, MaybeDet, 
+			Cond, Context) },
+		module_add_mode(Module0, VarSet, PredName, Modes, MaybeDet, 
+			Cond, Context, predicate, PredIdProcId, Module),
+		{ MaybePredIdProcId = yes(PredIdProcId) }
+	;
+		{ Method = func_mode(VarSet, FuncName, Modes, RetMode, MaybeDet,
+			Cond, Context) },
+		{ list__append(Modes, [RetMode], Modes1) },
+		module_add_mode(Module0, VarSet, FuncName, Modes1,
+			MaybeDet, Cond, Context, function, PredIdProcId, 
+			Module),
+		{ MaybePredIdProcId = yes(PredIdProcId) }
+	).
+
+:- pred module_add_instance_defn(module_info, list(class_constraint), sym_name,
+	list(type), instance_interface, varset, import_status, term__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.
+
+module_add_instance_defn(Module0, Constraints, Name, Types, Interface, VarSet,
+		Status, _Context, Module) -->
+	{ module_info_classes(Module0, Classes) },
+	{ module_info_instances(Module0, Instances0) },
+	{ list__length(Types, ClassArity) },
+	{ Key = class_id(Name, ClassArity) },
+	(
+		{ map__search(Classes, Key, _) }
+	->
+		{ map__init(Empty) },
+		{ NewValue = hlds_instance_defn(Status, Constraints, Types,
+			Interface, no, VarSet, Empty) },
+		{ map__lookup(Instances0, Key, Values) },
+		{ map__det_update(Instances0, Key, [NewValue|Values], 
+			Instances) },
+		{ module_info_set_instances(Module0, Instances, Module) }
 	;
-		{ Module = Module1 }
+			% XXX give an error since the class has not been
+			% XXX defined
+		{ Module = Module0 }
 	).
 
+%-----------------------------------------------------------------------------%
+
 :- pred add_new_pred(module_info, tvarset, sym_name, list(type), condition, 
-		term__context, import_status, need_qualifier, pred_or_func,
+		list(class_constraint), list(marker_status), term__context,
+		import_status, need_qualifier, pred_or_func,
 		module_info, io__state, io__state).
-:- mode add_new_pred(in, in, in, in, in, in, in, in, in, out, di, uo) is det.
+:- mode add_new_pred(in, in, in, in, in, in, in, in, in, in, in, out, 
+		di, uo) is det.
 
 % NB.  Predicates are also added in polymorphism.m, which converts
 % lambda expressions into separate predicates, so any changes may need
 % to be reflected there too.
 
-add_new_pred(Module0, TVarSet, PredName, Types, Cond, Context, 
-		Status, NeedQual, PredOrFunc, Module) -->
+add_new_pred(Module0, TVarSet, PredName, Types, Cond, ClassContext, Markers,
+		Context, Status, NeedQual, PredOrFunc, Module) -->
 	{ module_info_name(Module0, ModuleName) },
 	{ list__length(Types, Arity) },
 	(
@@ -1141,9 +1304,11 @@
 		{ Module1 = Module0 },
 		{ module_info_get_predicate_table(Module1, PredicateTable0) },
 		{ clauses_info_init(Arity, ClausesInfo) },
+		{ map__init(Proofs) },
 		{ pred_info_init(ModuleName, PredName, Arity, TVarSet, Types,
-				Cond, Context, ClausesInfo, Status, [], none,	
-				PredOrFunc, PredInfo0) },
+				Cond, Context, ClausesInfo, Status, Markers,
+				none, PredOrFunc, ClassContext, Proofs,
+				PredInfo0) },
 		(
 			{ predicate_table_search_pf_m_n_a(PredicateTable0,
 				PredOrFunc, MNameOfPred, PName, Arity,
@@ -1321,8 +1486,12 @@
 	Cond = true,
 	clauses_info_init(Arity, ClausesInfo0),
 	adjust_special_pred_status(Status0, SpecialPredId, Status),
+	map__init(Proofs),
+		% XXX When we have "comparable" or "unifiable" typeclasses, 
+		% XXX this context might not be empty
 	pred_info_init(ModuleName, PredName, Arity, TVarSet, ArgTypes, Cond,
-		Context, ClausesInfo0, Status, [], none, predicate, PredInfo0),
+		Context, ClausesInfo0, Status, [], none, predicate, [], Proofs, 
+		PredInfo0),
 	ArgLives = no,
 	add_new_proc(PredInfo0, Arity, ArgModes, yes(ArgModes),
 		ArgLives, yes(Det), Context, PredInfo, _),
@@ -1379,14 +1548,16 @@
 
 :- pred module_add_mode(module_info, varset, sym_name, list(mode),
 		maybe(determinism), condition, term__context, pred_or_func,
-		module_info, io__state, io__state).
-:- mode module_add_mode(in, in, in, in, in, in, in, in, out, di, uo) is det.
+		pair(pred_id, proc_id), module_info, 
+		io__state, io__state).
+:- mode module_add_mode(in, in, in, in, in, in, in, in, out, out, 
+		di, uo) is det.
 
 	% We should store the mode varset and the mode condition
 	% in the hlds - at the moment we just ignore those two arguments.
 
 module_add_mode(ModuleInfo0, _VarSet, PredName, Modes, MaybeDet, _Cond,
-			MContext, PredOrFunc, ModuleInfo) -->
+			MContext, PredOrFunc, PredProcId, ModuleInfo) -->
 
 		% Lookup the pred or func declaration in the predicate table.
 		% If it's not there (or if it is ambiguous), optionally print a
@@ -1444,11 +1615,12 @@
 		% isn't the same as an existing one
 	{ ArgLives = no },
 	{ add_new_proc(PredInfo0, Arity, Modes, yes(Modes), ArgLives,
-			MaybeDet, MContext, PredInfo, _) },
+			MaybeDet, MContext, PredInfo, ProcId) },
 	{ map__det_update(Preds0, PredId, PredInfo, Preds) },
 	{ predicate_table_set_preds(PredicateTable1, Preds, PredicateTable) },
 	{ module_info_set_predicate_table(ModuleInfo0, PredicateTable,
-		ModuleInfo) }.
+		ModuleInfo) },
+	{ PredProcId = PredId - ProcId }.
 
 	% Whenever there is a clause or mode declaration for an undeclared
 	% predicate, we add an implicit declaration
@@ -1469,8 +1641,13 @@
 	term__var_list_to_term_list(TypeVars, Types),
 	Cond = true,
 	clauses_info_init(Arity, ClausesInfo),
+	map__init(Proofs),
+		% XXX
+		% XXX This is wrong --- the context isn't nec. empty
+		% XXX
 	pred_info_init(ModuleName, PredName, Arity, TVarSet, Types, Cond,
-		Context, ClausesInfo, local, [], none, PredOrFunc, PredInfo0),
+		Context, ClausesInfo, local, [], none, PredOrFunc, [], Proofs,
+		PredInfo0),
 	pred_info_set_marker_list(PredInfo0, [request(infer_type)], PredInfo),
 	(
 		\+ predicate_table_search_pf_sym_arity(PredicateTable0,
@@ -2095,6 +2272,14 @@
 		PredCallId).
 
 warn_singletons_in_goal_2(higher_order_call(_, Args, _, _, _, _),
+			GoalInfo, QuantVars, VarSet, PredCallId) -->
+	{ goal_info_get_nonlocals(GoalInfo, NonLocals) },
+	{ goal_info_get_context(GoalInfo, Context) },
+	warn_singletons(Args, NonLocals, QuantVars, VarSet, Context,
+		PredCallId).
+
+	% This code should never be called anyway.
+warn_singletons_in_goal_2(class_method_call(_, _, Args, _, _, _),
 			GoalInfo, QuantVars, VarSet, PredCallId) -->
 	{ goal_info_get_nonlocals(GoalInfo, NonLocals) },
 	{ goal_info_get_context(GoalInfo, Context) },
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mercury_compile.m,v
retrieving revision 1.60
diff -u -r1.60 mercury_compile.m
--- mercury_compile.m	1997/11/08 13:11:34	1.60
+++ mercury_compile.m	1997/11/17 02:39:06
@@ -32,7 +32,8 @@
 :- import_module handle_options, prog_io, modules, module_qual, equiv_type.
 :- import_module make_hlds, typecheck, modes.
 :- import_module switch_detection, cse_detection, det_analysis, unique_modes.
-:- import_module simplify, intermod, trans_opt, bytecode_gen, bytecode.
+:- import_module check_typeclass, simplify, intermod, trans_opt.
+:- import_module bytecode_gen, bytecode.
 :- import_module (lambda), polymorphism, termination, higher_order, inlining.
 :- import_module dnf, constraint, unused_args, dead_proc_elim, saved_vars.
 :- import_module lco, liveness, stratify.
@@ -560,7 +561,7 @@
 
 	( { UnsafeToContinue = yes } ->
 		{ FoundError = yes },
-		{ HLDS12 = HLDS5 }
+		{ HLDS13 = HLDS5 }
 	;
 		mercury_compile__detect_switches(HLDS5, Verbose, Stats, HLDS6),
 		!,
@@ -590,6 +591,11 @@
 			Verbose, Stats, HLDS11), !,
 		mercury_compile__maybe_dump_hlds(HLDS11, "11", "simplify"), !,
 
+		maybe_write_string(Verbose, 
+			"% Mode and type checking typeclass instances...\n"),
+		check_typeclass__check_instance_decls(HLDS11, HLDS12,
+			FoundTypeclassError),
+
 		%
 		% work out whether we encountered any errors
 		%
@@ -599,6 +605,7 @@
 			{ FoundDetError = no },
 			{ FoundUniqError = no },
 			{ FoundStratError = no },
+			{ FoundTypeclassError = no },
 			% Strictly speaking, we shouldn't need to check
 			% the exit status.  But the values returned for
 			% FoundModeError etc. aren't always correct.
@@ -610,18 +617,18 @@
 			globals__io_lookup_bool_option(
 				make_optimization_interface, MakeOptInt),
 			{ Intermod = yes, MakeOptInt = no ->
-				intermod__adjust_pred_import_status(HLDS11,
-					HLDS12), !
+				intermod__adjust_pred_import_status(HLDS12,
+					HLDS13), !
 			;
-				HLDS12 = HLDS11
+				HLDS13 = HLDS12
 			}
 		;
 			{ FoundError = yes },
-			{ HLDS12 = HLDS11 }
+			{ HLDS13 = HLDS12 }
 		)
 	),
 
-	{ HLDS20 = HLDS12 },
+	{ HLDS20 = HLDS13 },
 	mercury_compile__maybe_dump_hlds(HLDS20, "20", "front_end").
 
 :- pred mercury_compile__frontend_pass_2_by_preds(module_info, module_info,
Index: compiler/mercury_to_c.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mercury_to_c.m,v
retrieving revision 1.27
diff -u -r1.27 mercury_to_c.m
--- mercury_to_c.m	1997/09/01 14:03:37	1.27
+++ mercury_to_c.m	1997/09/08 04:56:47
@@ -165,13 +165,14 @@
 	{ pred_info_context(PredInfo, Context) },
 	{ pred_info_name(PredInfo, PredName) },
 	{ pred_info_non_imported_procids(PredInfo, ProcIds) },
+	{ pred_info_get_class_context(PredInfo, ClassContext) },
 	( { ProcIds = [] } ->
 		[]
 	;
 		c_gen_indent(Indent),
 		io__write_string("/****\n"),
 		mercury_output_pred_type(TVarSet, unqualified(PredName),
-			ArgTypes, no, Context),
+			ArgTypes, no, ClassContext, Context),
 
 		{ pred_info_clauses_info(PredInfo, ClausesInfo) },
 		{ ClausesInfo = clauses_info(VarSet, _VarTypes, _, HeadVars,
@@ -626,6 +627,8 @@
 	).
 
 c_gen_goal_2(higher_order_call(_, _, _, _, _, _), _, _, _) -->
+	{ error("mercury_to_c: higher_order_call not implemented") }.
+c_gen_goal_2(class_method_call(_, _, _, _, _, _), _, _, _) -->
 	{ error("mercury_to_c: higher_order_call not implemented") }.
 c_gen_goal_2(call(PredId, ProcId, ArgVars, _, _, _PredName),
 					Indent, CGenInfo0, CGenInfo) -->
Index: compiler/mercury_to_goedel.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mercury_to_goedel.m,v
retrieving revision 1.60
diff -u -r1.60 mercury_to_goedel.m
--- mercury_to_goedel.m	1997/08/22 13:55:25	1.60
+++ mercury_to_goedel.m	1997/09/08 04:12:52
@@ -140,14 +140,16 @@
 goedel_output_item(mode_defn(VarSet, ModeDefn, _Cond), Context) -->
 	goedel_output_mode_defn(VarSet, ModeDefn, Context).
 
-goedel_output_item(pred(VarSet, PredName, TypesAndModes, _Det, _Cond), Context)
-		-->
+	% XXX Should we ignore ClassContext, or give an error?
+goedel_output_item(pred(VarSet, PredName, TypesAndModes, _Det, _Cond,
+		_ClassContext), Context) -->
 	io__write_string("\n"),
 	maybe_write_line_number(Context),
 	goedel_output_pred(VarSet, PredName, TypesAndModes, Context).
 
+	% XXX Should we ignore ClassContext, or give an error?
 goedel_output_item(func(VarSet, PredName, TypesAndModes, RetTypeAndMode, _Det,
-		_Cond), Context) -->
+		_Cond, _ClassContext), Context) -->
 	io__write_string("\n"),
 	maybe_write_line_number(Context),
 	goedel_output_func(VarSet, PredName, TypesAndModes, RetTypeAndMode,
@@ -180,6 +182,15 @@
 			"warning: C header declarations not allowed. Ignoring\n").
 
 goedel_output_item(nothing, _) --> [].
+goedel_output_item(typeclass(_, _, _, _, _), _) -->
+	io__stderr_stream(Stderr),
+	io__write_string(Stderr, 
+			"warning: typeclass declarations not allowed. Ignoring\n").
+
+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/staff/zs/imp/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.119
diff -u -r1.119 mercury_to_mercury.m
--- mercury_to_mercury.m	1997/10/09 09:38:54	1.119
+++ mercury_to_mercury.m	1997/10/15 06:15:53
@@ -23,12 +23,14 @@
 :- mode convert_to_mercury(in, in, in, di, uo) is det.
 
 :- pred mercury_output_pred_type(varset, sym_name, list(type),
-		maybe(determinism), term__context, io__state, io__state).
-:- mode mercury_output_pred_type(in, in, in, in, in, di, uo) is det.
+		maybe(determinism), list(class_constraint),
+		term__context, io__state, io__state).
+:- mode mercury_output_pred_type(in, in, in, in, in, in, di, uo) is det.
 
 :- pred mercury_output_func_type(varset, sym_name, list(type), type,
-		maybe(determinism), term__context, io__state, io__state).
-:- mode mercury_output_func_type(in, in, in, in, in, in, di, uo) is det.
+		maybe(determinism), list(class_constraint),
+		term__context, io__state, io__state).
+:- mode mercury_output_func_type(in, in, in, in, in, in, in, di, uo) is det.
 
 :- pred mercury_output_pred_mode_decl(varset, sym_name, list(mode),
 		maybe(determinism), term__context, io__state, io__state).
@@ -150,6 +152,10 @@
 :- pred mercury_convert_var_name(string, string).
 :- mode mercury_convert_var_name(in, out) is det.
 
+:- pred mercury_output_constraint(varset, class_constraint, 
+		io__state, io__state).
+:- mode mercury_output_constraint(in, in, di, uo) is det.
+
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
@@ -221,16 +227,18 @@
 	maybe_output_line_number(Context),
 	mercury_output_mode_defn(VarSet, ModeDefn, Context).
 
-mercury_output_item(pred(VarSet, PredName, TypesAndModes, Det, _Cond), Context)
-		-->
+mercury_output_item(pred(VarSet, PredName, TypesAndModes, Det, _Cond,
+		ClassContext), Context) -->
 	maybe_output_line_number(Context),
-	mercury_output_pred_decl(VarSet, PredName, TypesAndModes, Det, Context).
+	mercury_output_pred_decl(VarSet, PredName, TypesAndModes, Det,
+		ClassContext, Context, ".\n", ".\n").
 
 mercury_output_item(func(VarSet, PredName, TypesAndModes, RetTypeAndMode, Det,
-		_Cond), Context) -->
+		_Cond, ClassContext), Context) -->
 	maybe_output_line_number(Context),
 	mercury_output_func_decl(VarSet, PredName, TypesAndModes,
-			RetTypeAndMode, Det, Context).
+			RetTypeAndMode, Det, ClassContext, Context, 
+			".\n", ".\n").
 
 mercury_output_item(pred_mode(VarSet, PredName, Modes, MaybeDet, _Cond),
 			Context) -->
@@ -320,6 +328,141 @@
 	).
 
 mercury_output_item(nothing, _) --> [].
+mercury_output_item(typeclass(Constraints, ClassName, Vars, Methods, 
+		VarSet), _) --> 
+	io__write_string(":- typeclass "),
+
+		% We put an extra set of brackets around the class name in
+		% case the name is an operator
+	io__write_char('('),
+	mercury_output_sym_name(ClassName),
+	io__write_char('('),
+	io__write_list(Vars, ", ", 
+			lambda([V::in, IO0::di, IO::uo] is det,
+				(
+				varset__lookup_name(VarSet, V, VarName),
+				io__write_string(VarName, IO0, IO)
+				)
+			)
+		),
+	io__write_char(')'),
+	io__write_char(')'),
+
+	(
+		{ Constraints = [] }
+	;
+		{ Constraints = [_|_] },
+		io__write_string(" <= ("),
+		output_class_constraints(Constraints, VarSet),
+		io__write_string(")")
+	),
+
+	io__write_string(" where [\n"),
+
+	output_class_methods(Methods),
+	
+	io__write_string("].\n").
+mercury_output_item(instance(Constraints, ClassName, Types, Methods, 
+		VarSet), _) --> 
+	io__write_string(":- instance "),
+
+		% We put an extra set of brackets around the class name in
+		% case the name is an operator
+	io__write_char('('),
+	mercury_output_sym_name(ClassName),
+	io__write_char('('),
+	io__write_list(Types, ", ", term_io__write_term(VarSet)),
+	io__write_char(')'),
+	io__write_char(')'),
+	
+	(
+		{ Constraints = [] }
+	;
+		{ Constraints = [_|_] },
+		io__write_string(" <= ("),
+		output_class_constraints(Constraints, VarSet),
+		io__write_string(")")
+	),
+
+	io__write_string(" where [\n"),
+
+	output_instance_methods(Methods),
+	
+	io__write_string("].\n").
+
+%-----------------------------------------------------------------------------%
+:- pred output_class_constraints(list(class_constraint), varset, 
+	io__state, io__state).
+:- mode output_class_constraints(in, in, di, uo) is det.
+
+output_class_constraints(Constraints, VarSet) -->
+	io__write_list(Constraints, ", ", output_class_constraint(VarSet)).
+	
+:- pred output_class_constraint(varset, class_constraint, io__state, io__state).
+:- mode output_class_constraint(in, in, di, uo) is det.
+
+output_class_constraint(VarSet, constraint(Name, Types)) -->
+	mercury_output_sym_name(Name),
+	io__write_char('('),
+	io__write_list(Types, ", ", term_io__write_term(VarSet)),
+	io__write_char(')').
+
+:- pred output_class_methods(list(class_method), io__state, io__state).
+:- mode output_class_methods(in, di, uo) is det.
+
+output_class_methods(Methods) -->
+	io__write_list(Methods, ",\n", output_class_method).
+
+:- pred output_class_method(class_method, io__state, io__state).
+:- mode output_class_method(in, di, uo) is det.
+
+output_class_method(Method) -->
+	io__write_string("\t("),
+	(
+		{ Method = pred(VarSet, Name, TypesAndModes, Detism, 
+			_Condition, ClassContext, Context) },
+		mercury_output_pred_decl(VarSet, Name, TypesAndModes, Detism,
+			ClassContext, Context, "),\n(", "\n")
+	;
+		{ Method = func(VarSet, Name, TypesAndModes, TypeAndMode, 
+			Detism, _Condition, ClassContext, Context) },
+		mercury_output_func_decl(VarSet, Name, TypesAndModes,
+			TypeAndMode, Detism, ClassContext, Context, 
+			"),\n(", "\n")
+	;
+		{ Method = pred_mode(VarSet, Name, Modes, Detism, 
+			_Condition, Context) },
+		mercury_output_pred_mode_decl2(VarSet, Name, Modes, Detism,
+			Context, "\n")
+	;
+		{ Method = func_mode(VarSet, Name, Modes, Mode, 
+			Detism, _Condition, Context) },
+		mercury_output_func_mode_decl2(VarSet, Name, Modes, 
+			Mode, Detism, Context, "\n")
+	),
+	io__write_char(')').
+
+:- pred output_instance_methods(instance_interface, io__state, io__state).
+:- mode output_instance_methods(in, di, uo) is det.
+
+output_instance_methods(Methods) -->
+	{ OutputMethod = lambda([Method::in, IO0::di, IO::uo] is det,
+		(
+			(
+				Method = func_instance(Name1, Name2, Arity),
+				io__write_string("func((", IO0, IO1)
+			;
+				Method = pred_instance(Name1, Name2, Arity),
+				io__write_string("pred((", IO0, IO1)
+			),
+			mercury_output_bracketed_sym_name(Name1, IO1, IO2),
+			io__write_string(")/", IO2, IO3),
+			io__write_int(Arity, IO3, IO4),
+			io__write_string(") is ", IO4, IO5),
+			mercury_output_bracketed_sym_name(Name2, IO5, IO)
+		)
+	) },
+	io__write_list(Methods, ",\n", OutputMethod).
 
 %-----------------------------------------------------------------------------%
 
@@ -878,6 +1021,12 @@
 	{ string__int_to_string(Arity, ArityString) },
 	io__write_strings(["<base_type_info for ", Module, ":", Type, "/",
 		ArityString, ">"]).
+mercury_output_cons_id(base_typeclass_info_const(Module, Class, InstanceString),
+		_) -->
+	io__write_string("<base_typeclass_info for "),
+	io__write(Class),
+	io__write_strings([" from module ", Module, ", instance number",
+		InstanceString]).
 
 mercury_output_mode_defn(VarSet, eqv_mode(Name, Args, Mode), Context) -->
 	io__write_string(":- mode ("),
@@ -1053,23 +1202,39 @@
 %-----------------------------------------------------------------------------%
 
 :- pred mercury_output_pred_decl(varset, sym_name, list(type_and_mode),
-		maybe(determinism), term__context, io__state, io__state).
-:- mode mercury_output_pred_decl(in, in, in, in, in, di, uo) is det.
+		maybe(determinism), list(class_constraint),
+		term__context, string, string, io__state, io__state).
+:- mode mercury_output_pred_decl(in, in, in, in, in, in, in, in, di, uo) is det.
 
-mercury_output_pred_decl(VarSet, PredName, TypesAndModes, MaybeDet, Context) -->
+mercury_output_pred_decl(VarSet, PredName, TypesAndModes, MaybeDet, 
+		ClassContext, Context, Separator, Terminator) -->
 	{ split_types_and_modes(TypesAndModes, Types, MaybeModes) },
-	mercury_output_pred_type(VarSet, PredName, Types, MaybeDet, Context),
 	(
 		{ MaybeModes = yes(Modes) },
 		{ Modes \= [] }
 	->
-		mercury_output_pred_mode_decl(VarSet, PredName, Modes,
-				MaybeDet, Context)
+		mercury_output_pred_type_2(VarSet, PredName, Types, MaybeDet, 
+			ClassContext, Context, Separator),
+		mercury_output_pred_mode_decl2(VarSet, PredName, Modes,
+				MaybeDet, Context, Terminator)
 	;
-		[]
+		mercury_output_pred_type_2(VarSet, PredName, Types, MaybeDet, 
+			ClassContext, Context, Terminator)
 	).
 
-mercury_output_pred_type(VarSet, PredName, Types, MaybeDet, _Context) -->
+mercury_output_pred_type(VarSet, PredName, Types, MaybeDet, ClassContext,
+		Context) -->
+	mercury_output_pred_type_2(VarSet, PredName, Types, MaybeDet,
+		ClassContext, Context, ".\n").
+
+
+:- pred mercury_output_pred_type_2(varset, sym_name, list(type),
+		maybe(determinism), list(class_constraint),
+		term__context, string, io__state, io__state).
+:- mode mercury_output_pred_type_2(in, in, in, in, in, in, in, di, uo) is det.
+
+mercury_output_pred_type_2(VarSet, PredName, Types, MaybeDet, ClassContext,
+		_Context, Separator) -->
 	io__write_string(":- pred "),
 	(
 		{ Types = [Type | Rest] }
@@ -1078,9 +1243,11 @@
 		io__write_string("("),
 		mercury_output_term(Type, VarSet, no),
 		mercury_output_remaining_terms(Rest, VarSet, no),
-		io__write_string(")")
+		io__write_string(")"),
+		mercury_output_class_context(ClassContext, VarSet)
 	;
 		mercury_output_bracketed_sym_name(PredName),
+		mercury_output_class_context(ClassContext, VarSet),
 		mercury_output_det_annotation(MaybeDet)
 	),
 
@@ -1105,34 +1272,47 @@
 	;
 		[]
 	),
-	io__write_string(".\n").
+	io__write_string(Separator).
 
 %-----------------------------------------------------------------------------%
 
 :- pred mercury_output_func_decl(varset, sym_name, list(type_and_mode),
-		type_and_mode, maybe(determinism), term__context,
+		type_and_mode, maybe(determinism), 
+		list(class_constraint), term__context, string, string,
 		io__state, io__state).
-:- mode mercury_output_func_decl(in, in, in, in, in, in, di, uo) is det.
+:- mode mercury_output_func_decl(in, in, in, in, in, in, in, in, in,
+	di, uo) is det.
 
 mercury_output_func_decl(VarSet, FuncName, TypesAndModes, RetTypeAndMode,
-		MaybeDet, Context) -->
+		MaybeDet, ClassContext, Context, Separator, Terminator) -->
 	{ split_types_and_modes(TypesAndModes, Types, MaybeModes) },
 	{ split_type_and_mode(RetTypeAndMode, RetType, MaybeRetMode) },
 	(
 		{ MaybeModes = yes(Modes) },
 		{ MaybeRetMode = yes(RetMode) }
 	->
-		mercury_output_func_type(VarSet, FuncName, Types, RetType,
-				no, Context),
-		mercury_output_func_mode_decl(VarSet, FuncName, Modes, RetMode,
-				MaybeDet, Context)
+		mercury_output_func_type2(VarSet, FuncName, Types, RetType,
+				no, ClassContext, Context, Separator),
+		mercury_output_func_mode_decl2(VarSet, FuncName, Modes, RetMode,
+				MaybeDet, Context, Terminator)
 	;
-		mercury_output_func_type(VarSet, FuncName, Types, RetType,
-				MaybeDet, Context)
+		mercury_output_func_type2(VarSet, FuncName, Types, RetType,
+				MaybeDet, ClassContext, Context, Terminator)
 	).
 
-mercury_output_func_type(VarSet, FuncName, Types, RetType, MaybeDet, _Context)
-		-->
+mercury_output_func_type(VarSet, FuncName, Types, RetType, MaybeDet, 
+		ClassContext, Context) -->
+	mercury_output_func_type2(VarSet, FuncName, Types, RetType, MaybeDet, 
+			ClassContext, Context, ".\n").
+
+:- pred mercury_output_func_type2(varset, sym_name, list(type), type,
+		maybe(determinism), list(class_constraint),
+		term__context, string, io__state, io__state).
+:- mode mercury_output_func_type2(in, in, in, in, in, in, in, in, 
+	di, uo) is det.
+
+mercury_output_func_type2(VarSet, FuncName, Types, RetType, MaybeDet, 
+		ClassContext, _Context, Separator) -->
 	io__write_string(":- func "),
 	(
 		{ Types = [Type | Rest] }
@@ -1147,18 +1327,58 @@
 	),
 	io__write_string(" = "),
 	mercury_output_term(RetType, VarSet, no),
+	mercury_output_class_context(ClassContext, VarSet),
 	mercury_output_det_annotation(MaybeDet),
-	io__write_string(".\n").
+	io__write_string(Separator).
+
+%-----------------------------------------------------------------------------%
+
+:- pred mercury_output_class_context(list(class_constraint), varset, 
+	io__state, io__state).
+:- mode mercury_output_class_context(in, in, di, uo) is det.
+
+mercury_output_class_context(ClassContext, VarSet) -->
+	(
+		{ ClassContext = [] }
+	;
+		{ ClassContext = [_|_] },
+		io__write_string(" <= ("),
+		io__write_list(ClassContext, ", ",
+			mercury_output_constraint(VarSet)),
+		io__write_char(')')
+	).
+
+mercury_output_constraint(VarSet, constraint(Name, Types)) -->
+	mercury_output_sym_name(Name),
+	io__write_char('('),
+	io__write_list(Types, ", ", output_type(VarSet)),
+	io__write_char(')').
+
+:- pred output_type(varset, term, io__state, io__state).
+:- mode output_type(in, in, di, uo) is det.
+
+output_type(VarSet, Type) -->
+	mercury_output_term(Type, VarSet, no).
 
 %-----------------------------------------------------------------------------%
 
 	% Output a mode declaration for a predicate.
 
 mercury_output_pred_mode_decl(VarSet, PredName, Modes, MaybeDet, Context) -->
+	mercury_output_pred_mode_decl2(VarSet, PredName, Modes, MaybeDet,
+		Context, ".\n").
+
+:- pred mercury_output_pred_mode_decl2(varset, sym_name, list(mode),
+		maybe(determinism), term__context, string, 
+		io__state, io__state).
+:- mode mercury_output_pred_mode_decl2(in, in, in, in, in, in, di, uo) is det.
+
+mercury_output_pred_mode_decl2(VarSet, PredName, Modes, MaybeDet, Context,
+		Separator) -->
 	io__write_string(":- mode "),
 	mercury_output_pred_mode_subdecl(VarSet, PredName, Modes, MaybeDet,
 		Context),
-	io__write_string(".\n").
+	io__write_string(Separator).
 
 mercury_output_pred_mode_subdecl(VarSet, PredName, Modes, MaybeDet,
 		_Context) -->
@@ -1178,10 +1398,21 @@
 
 mercury_output_func_mode_decl(VarSet, FuncName, Modes, RetMode, MaybeDet,
 		Context) -->
+	mercury_output_func_mode_decl2(VarSet, FuncName, Modes, RetMode,
+		MaybeDet, Context, ".\n").
+
+:- pred mercury_output_func_mode_decl2(varset, sym_name, list(mode), mode,
+		maybe(determinism), term__context, string, 
+		io__state, io__state).
+:- mode mercury_output_func_mode_decl2(in, in, in, in, in, in, in, 
+	di, uo) is det.
+
+mercury_output_func_mode_decl2(VarSet, FuncName, Modes, RetMode, MaybeDet,
+		Context, Separator) -->
 	io__write_string(":- mode "),
 	mercury_output_func_mode_subdecl(VarSet, FuncName, Modes, RetMode,
 		MaybeDet, Context),
-	io__write_string(".\n").
+	io__write_string(Separator).
 
 mercury_output_func_mode_subdecl(VarSet, FuncName, Modes, RetMode, MaybeDet,
 		_Context) -->
Index: compiler/mode_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mode_util.m,v
retrieving revision 1.101
diff -u -r1.101 mode_util.m
--- mode_util.m	1997/09/29 06:45:48	1.101
+++ mode_util.m	1997/10/14 06:59:42
@@ -1126,6 +1126,13 @@
 	{ instmap_delta_from_mode_list(Vars, Modes,
 		ModuleInfo, InstMapDelta) }.
 
+recompute_instmap_delta_2(_, class_method_call(A, B, Vars, C, Modes, D), _,
+		class_method_call(A, B, Vars, C, Modes, D),
+		_InstMap, InstMapDelta) -->
+	=(ModuleInfo),
+	{ instmap_delta_from_mode_list(Vars, Modes,
+		ModuleInfo, InstMapDelta) }.
+
 recompute_instmap_delta_2(_, call(PredId, ProcId, Args, D, E, F), _,
 		call(PredId, ProcId, Args, D, E, F), InstMap, InstMapDelta) -->
 	recompute_instmap_delta_call(PredId, ProcId,
Index: compiler/modes.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/modes.m,v
retrieving revision 1.206
diff -u -r1.206 modes.m
--- modes.m	1997/11/13 06:27:07	1.206
+++ modes.m	1997/11/20 05:21:32
@@ -795,6 +795,12 @@
 	modecheck_higher_order_pred_call(PredVar, Args0, PredOrFunc, GoalInfo0,
 		Goal).
 
+	% XXX This should be fixed one day, in case we decide to re-run
+	% modechecking or something like that.
+modecheck_goal_expr(class_method_call(_, _, _, _, _, _),
+		_GoalInfo0, _Goal) -->
+	{ error("modecheck_goal_expr: class method exists at modecheck time") }.
+
 modecheck_goal_expr(unify(A0, B0, _, UnifyInfo0, UnifyContext), GoalInfo0, Goal)
 		-->
 	mode_checkpoint(enter, "unify"),
Index: compiler/module_qual.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/module_qual.m,v
retrieving revision 1.24
diff -u -r1.24 module_qual.m
--- module_qual.m	1997/10/09 09:38:57	1.24
+++ module_qual.m	1997/10/15 06:27:37
@@ -97,12 +97,13 @@
 			type_id_set,	% Sets of all types, modes and
 			inst_id_set,	% insts visible in this module.
 			mode_id_set,
+			class_id_set,
 			set(module_name), % modules imported in the
 				% interface that are not definitely
 				% needed in the interface.
 			import_status, % import status of the current item.
 			int,	% number of errors found.
-			bool,	% are there any undefined types.
+			bool,	% are there any undefined types or typeclasses.
 			bool,	% are there any undefined insts or modes.
 			bool, 	% do we want to report errors.
 			error_context,	% context of the current item.
@@ -131,14 +132,18 @@
 	add_mode_defn(ModeDefn, Info0, Info).
 collect_mq_info_2(module_defn(_, ModuleDefn), Info0, Info) :-
 	process_module_defn(ModuleDefn, Info0, Info).
-collect_mq_info_2(pred(_,_,_,_,_), Info, Info).
-collect_mq_info_2(func(_,_,_,_,_,_), Info, Info).
+collect_mq_info_2(pred(_,_,_,_,_,_), Info, Info).
+collect_mq_info_2(func(_,_,_,_,_,_,_), Info, Info).
 collect_mq_info_2(pred_mode(_,_,_,_,_), Info, Info).
 collect_mq_info_2(func_mode(_,_,_,_,_,_), Info, Info).
 collect_mq_info_2(pragma(_), Info, Info).
 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).
 
-% Predicates to add the type, inst and mode ids visible
+
+% Predicates to add the type, inst, mode and typeclass ids visible
 % in this module to the mq_info.
 
 :- pred add_type_defn(type_defn::in, mq_info::in, mq_info::out) is det.
@@ -176,6 +181,16 @@
 	id_set_insert(NeedQualifier, SymName - Arity, Modes0, Modes),
 	mq_info_set_modes(Info0, Modes, Info).
 
+:- pred add_typeclass_defn(sym_name::in, list(var)::in, 
+	mq_info::in, mq_info::out) is det.
+
+add_typeclass_defn(SymName, Params, Info0, Info) :-
+	list__length(Params, Arity),
+	mq_info_get_classes(Info0, Classes0),
+	mq_info_get_need_qual_flag(Info0, NeedQualifier),
+	id_set_insert(NeedQualifier, SymName - Arity, Classes0, Classes),
+	mq_info_set_classes(Info0, Classes, Info).
+
 	% Update import status.
 	% Add imported modules if in the interface.
 :- pred process_module_defn(module_defn::in, mq_info::in, mq_info::out) is det.
@@ -258,22 +273,28 @@
 		module_defn(A, ModuleDefn) - Context, Info0, Info, Continue) -->
 	{ update_import_status(ModuleDefn, Info0, Info, Continue) }.
 
-module_qualify_item(pred(A, SymName, TypesAndModes0, D, E) - Context,
-		pred(A, SymName, TypesAndModes, D, E) - Context,
+module_qualify_item(
+		pred(A, SymName, TypesAndModes0, D, E, Constraints0) - Context,
+		pred(A, SymName, TypesAndModes, D, E, Constraints) - Context,
 		Info0, Info, yes) -->
 	{ list__length(TypesAndModes0, Arity) },
 	{ mq_info_set_error_context(Info0, pred(SymName - Arity) - Context,
 								Info1) },
-	qualify_types_and_modes(TypesAndModes0, TypesAndModes, Info1, Info).
+	qualify_types_and_modes(TypesAndModes0, TypesAndModes, Info1, Info2),
+	qualify_class_constraints(Constraints0, Constraints, Info2, Info).
 
-module_qualify_item(func(A,SymName, TypesAndModes0, TypeAndMode0,D,E) - Context,
-		func(A, SymName, TypesAndModes, TypeAndMode, D, E) - Context,
+module_qualify_item(
+		func(A,SymName, TypesAndModes0, TypeAndMode0,D,E,Constraints0) 
+			- Context,
+		func(A, SymName, TypesAndModes, TypeAndMode, D, E, Constraints) 
+			- Context,
 		Info0, Info, yes) -->
 	{ list__length(TypesAndModes0, Arity) },
 	{ mq_info_set_error_context(Info0, func(SymName - Arity) - Context,
 								Info1) },
 	qualify_types_and_modes(TypesAndModes0, TypesAndModes, Info1, Info2),
-	qualify_type_and_mode(TypeAndMode0, TypeAndMode, Info2, Info).
+	qualify_type_and_mode(TypeAndMode0, TypeAndMode, Info2, Info3),
+	qualify_class_constraints(Constraints0, Constraints, Info3, Info).
 
 module_qualify_item(pred_mode(A, SymName, Modes0, C, D) - Context,
 		 	pred_mode(A, SymName, Modes, C, D) - Context,
@@ -298,6 +319,31 @@
 	qualify_pragma(Pragma0, Pragma, Info1, Info).
 module_qualify_item(nothing - Context, nothing - Context,
 						Info, Info, yes) --> [].
+module_qualify_item(typeclass(Constraints0, Name, Vars, Interface0, VarSet) -
+			Context, 
+		typeclass(Constraints, Name, Vars, Interface, VarSet) -
+			Context, 
+		Info0, Info, yes) -->
+	{ list__length(Vars, Arity) },
+	{ Id = Name - Arity },
+	{ mq_info_set_error_context(Info0, class(Id) - Context, Info1) },
+	qualify_class_constraints(Constraints0, Constraints, Info1, Info2),
+	qualify_class_interface(Interface0, Interface, Info2, Info).
+
+module_qualify_item(instance(Constraints0, Name0, Types0, Interface0, VarSet) -
+			Context, 
+		instance(Constraints, Name, Types, Interface, VarSet) -
+			Context, 
+		Info0, Info, yes) -->
+	{ list__length(Types0, Arity) },
+	{ Id = Name0 - Arity },
+	{ mq_info_set_error_context(Info0, instance(Id) - Context, Info1) },
+		% We don't qualify the interface yet, since that requires
+		% us to resolve overloading.
+	qualify_class_constraints(Constraints0, Constraints, Info1, Info2),
+	qualify_classname(Id, Name - _, Info2, Info3),
+	qualify_type_list(Types0, Types, Info3, Info),
+	{ qualify_instance_interface(Name, Interface0, Interface) }.
 
 :- pred update_import_status(module_defn::in, mq_info::in, mq_info::out,
 							bool::out) is det.
@@ -627,11 +673,116 @@
 	qualify_mode(Mode0, Mode, Info0, Info1),
 	qualify_pragma_vars(PragmaVars0, PragmaVars, Info1, Info).
 
+:- pred qualify_class_constraints(list(class_constraint)::in,
+	list(class_constraint)::out, mq_info::in, mq_info::out, io__state::di,
+	io__state::uo) is det. 
+
+qualify_class_constraints([], [], MQInfo, MQInfo) --> [].
+qualify_class_constraints([C0|C0s], [C|Cs], MQInfo0, MQInfo) -->
+	qualify_class_constraint(C0, C, MQInfo0, MQInfo1),
+	qualify_class_constraints(C0s, Cs, MQInfo1, MQInfo).
+
+:- pred qualify_class_constraint(class_constraint::in, class_constraint::out,
+	mq_info::in, mq_info::out, io__state::di, io__state::uo) is det.
+
+qualify_class_constraint(constraint(ClassName0, Types0), 
+	constraint(ClassName, Types), MQInfo0, MQInfo) -->
+	{ list__length(Types0, Arity) },
+	qualify_classname(ClassName0 - Arity, ClassName - _, MQInfo0, MQInfo1),
+	qualify_type_list(Types0, Types, MQInfo1, MQInfo).
+
+:- pred qualify_classname(pair(classname, arity)::in, 
+	pair(classname, arity)::out, mq_info::in, mq_info::out, 
+	io__state::di, io__state::uo) is det.
+
+qualify_classname(Class0, Class, MQInfo0, MQInfo) -->
+	{ mq_info_get_classes(MQInfo0, ClassIdSet) },
+	find_unique_match(Class0, Class, ClassIdSet, class_id,
+		MQInfo0, MQInfo).
+
+:- pred qualify_class_interface(class_interface::in, class_interface::out,
+	mq_info::in, mq_info::out, io__state::di, io__state::uo) is det. 
+
+qualify_class_interface([], [], MQInfo, MQInfo) --> [].
+qualify_class_interface([M0|M0s], [M|Ms], MQInfo0, MQInfo) -->
+	qualify_class_method(M0, M, MQInfo0, MQInfo1),
+	qualify_class_interface(M0s, Ms, MQInfo1, MQInfo).
+
+:- pred qualify_class_method(class_method::in, class_method::out,
+	mq_info::in, mq_info::out, io__state::di, io__state::uo) is det. 
+
+	% There is no need to qualify the method name, since that is
+	% done when the item is parsed.
+qualify_class_method(
+		pred(Varset, Name, TypesAndModes0, MaybeDet, Cond,
+			ClassContext0, Context), 
+		pred(Varset, Name, TypesAndModes, MaybeDet, Cond, 
+			ClassContext, Context), 
+		MQInfo0, MQInfo
+		) -->
+	qualify_types_and_modes(TypesAndModes0, TypesAndModes, 
+		MQInfo0, MQInfo1),
+	qualify_class_constraints(ClassContext0, ClassContext, 
+		MQInfo1, MQInfo).
+qualify_class_method(
+		func(Varset, Name, TypesAndModes0, ReturnMode0, MaybeDet, Cond,
+			ClassContext0, Context), 
+		func(Varset, Name, TypesAndModes, ReturnMode, MaybeDet, Cond,
+			ClassContext, Context), 
+		MQInfo0, MQInfo
+		) -->
+	qualify_types_and_modes(TypesAndModes0, TypesAndModes, 
+		MQInfo0, MQInfo1),
+	qualify_type_and_mode(ReturnMode0, ReturnMode, MQInfo1, MQInfo2),
+	qualify_class_constraints(ClassContext0, ClassContext, 
+		MQInfo2, MQInfo).
+qualify_class_method(
+		pred_mode(Varset, Name, Modes0, MaybeDet, Cond, Context), 
+		pred_mode(Varset, Name, Modes, MaybeDet, Cond, Context), 
+		MQInfo0, MQInfo
+		) -->
+	qualify_mode_list(Modes0, Modes, MQInfo0, MQInfo).
+qualify_class_method(
+		func_mode(Varset, Name, Modes0, ReturnMode0, MaybeDet, Cond,
+			Context), 
+		func_mode(Varset, Name, Modes, ReturnMode, MaybeDet, Cond,
+			Context), 
+		MQInfo0, MQInfo
+		) -->
+	qualify_mode_list(Modes0, Modes, MQInfo0, MQInfo1),
+	qualify_mode(ReturnMode0, ReturnMode, MQInfo1, MQInfo).
+
+:- pred qualify_instance_interface(sym_name::in, instance_interface::in, 
+	instance_interface::out) is det. 
+
+qualify_instance_interface(ClassName, M0s, Ms) :-
+	(
+		ClassName = qualified(Module, _)
+	;
+		ClassName = unqualified( _),
+		Module = ""
+	),
+	Qualify = lambda([M0::in, M::out] is det,
+		(
+			M0 = pred_instance(unqualified(Method), A, B),
+			M = pred_instance(qualified(Module, Method), A, B)
+		;
+			M0 = pred_instance(qualified(_, _), _A, _B),
+			M = M0
+		;
+			M0 = func_instance(unqualified(Method), A, B),
+			M = func_instance(qualified(Module, Method), A, B)
+		;
+			M0 = func_instance(qualified(_, _), _A, _B),
+			M = M0
+		)),
+	list__map(Qualify, M0s, Ms).
+
 	% Find the unique match in the current name space for a given id
 	% from a list of ids. If none exists, either because no match was
 	% found or mulitiple matches were found, report an error.
-	% This predicate assumes that type_ids, inst_ids and mode_ids
-	% have the same representation.
+	% This predicate assumes that type_ids, inst_ids, mode_ids and
+	% class_ids have the same representation.
 :- pred find_unique_match(id::in, id::out, id_set::in, id_type::in,
 		mq_info::in, mq_info::out, io__state::di, io__state::uo) is det.
 
@@ -700,7 +851,8 @@
 :- type id_type --->
 		type_id
 	;	mode_id
-	;	inst_id.
+	;	inst_id
+	;	class_id.
 
 :- type error_context == pair(error_context2, term__context).
 
@@ -716,7 +868,9 @@
 	;	func_mode(id)
 	;	(pragma)
 	;	lambda_expr
-	;	type_qual.
+	;	type_qual
+	;	class(id)
+	;	instance(id).
 
 	% Report an undefined type, inst or mode.
 :- pred report_undefined(error_context, pair(sym_name, int),
@@ -800,12 +954,19 @@
 	io__write_string("pragma").
 write_error_context2(type_qual) -->
 	io__write_string("explicit type qualification").
+write_error_context2(class(Id)) -->
+	io__write_string("declaration of typeclass "),
+	write_id(Id).
+write_error_context2(instance(Id)) -->
+	io__write_string("declaration of instance of typeclass "),
+	write_id(Id).
 
 :- pred id_type_to_string(id_type::in, string::out) is det.
 
 id_type_to_string(type_id, "type").
 id_type_to_string(mode_id, "mode").
 id_type_to_string(inst_id, "inst").
+id_type_to_string(class_id, "typeclass").
 
 	% Write sym_name/arity.
 :- pred write_id(id::in, io__state::di, io__state::uo) is det.
@@ -917,12 +1078,13 @@
 	ErrorContext = type(unqualified("") - 0) - Context,
 	set__init(InterfaceModules0),
 	id_set_init(Empty),
-	Info0 = mq_info(Empty, Empty, Empty, InterfaceModules0, local, 0,
+	Info0 = mq_info(Empty, Empty, Empty, Empty, InterfaceModules0, local, 0,
 		no, no, ReportErrors, ErrorContext, may_be_unqualified).
 
 :- pred mq_info_get_types(mq_info::in, type_id_set::out) is det.
 :- pred mq_info_get_insts(mq_info::in, inst_id_set::out) is det.
 :- pred mq_info_get_modes(mq_info::in, mode_id_set::out) is det.
+:- pred mq_info_get_classes(mq_info::in, class_id_set::out) is det.
 :- pred mq_info_get_interface_modules(mq_info::in,
 					set(module_name)::out) is det.
 :- pred mq_info_get_import_status(mq_info::in, import_status::out) is det.
@@ -932,22 +1094,24 @@
 :- pred mq_info_get_report_error_flag(mq_info::in, bool::out) is det.
 :- pred mq_info_get_error_context(mq_info::in, error_context::out) is det.
 
-mq_info_get_types(mq_info(Types, _,_,_,_,_,_,_,_,_,_), Types).
-mq_info_get_insts(mq_info(_, Insts, _,_,_,_,_,_,_,_,_), Insts).
-mq_info_get_modes(mq_info(_,_, Modes, _,_,_,_,_,_,_,_), Modes).
-mq_info_get_interface_modules(mq_info(_,_,_, Modules, _,_,_,_,_,_,_), Modules).
-mq_info_get_import_status(mq_info(_,_,_,_, Status, _,_,_,_,_,_), Status).
-mq_info_get_num_errors(mq_info(_,_,_,_,_, NumErrors, _,_,_,_,_), NumErrors).
-mq_info_get_type_error_flag(mq_info(_,_,_,_,_,_, TypeErrs, _,_,_,_), TypeErrs).
-mq_info_get_mode_error_flag(mq_info(_,_,_,_,_,_,_, ModeError, _,_,_),
+mq_info_get_types(mq_info(Types, _, _,_,_,_,_,_,_,_,_,_), Types).
+mq_info_get_insts(mq_info(_, Insts, _,_,_,_,_,_,_,_,_,_), Insts).
+mq_info_get_modes(mq_info(_,_, Modes, _,_,_,_,_,_,_,_,_), Modes).
+mq_info_get_classes(mq_info(_,_,_, Classes, _,_,_,_,_,_,_,_), Classes).
+mq_info_get_interface_modules(mq_info(_,_,_,_, Modules,_,_,_,_,_,_,_), Modules).
+mq_info_get_import_status(mq_info(_,_,_,_,_, Status, _,_,_,_,_,_), Status).
+mq_info_get_num_errors(mq_info(_,_,_,_,_,_, NumErrors, _,_,_,_,_), NumErrors).
+mq_info_get_type_error_flag(mq_info(_,_,_,_,_,_,_, TypeErrs,_,_,_,_), TypeErrs).
+mq_info_get_mode_error_flag(mq_info(_,_,_,_,_,_,_,_, ModeError, _,_,_),
 						ModeError).
-mq_info_get_report_error_flag(mq_info(_,_,_,_,_,_,_,_, Report,_,_), Report).
-mq_info_get_error_context(mq_info(_,_,_,_,_,_,_,_,_, Context,_), Context).
-mq_info_get_need_qual_flag(mq_info(_,_,_,_,_,_,_,_,_,_,UseModule), UseModule).
+mq_info_get_report_error_flag(mq_info(_,_,_,_,_,_,_,_,_, Report,_,_), Report).
+mq_info_get_error_context(mq_info(_,_,_,_,_,_,_,_,_,_, Context,_), Context).
+mq_info_get_need_qual_flag(mq_info(_,_,_,_,_,_,_,_,_,_,_,UseModule), UseModule).
 
 :- pred mq_info_set_types(mq_info::in, type_id_set::in, mq_info::out) is det.
 :- pred mq_info_set_insts(mq_info::in, inst_id_set::in, mq_info::out) is det.
 :- pred mq_info_set_modes(mq_info::in, mode_id_set::in, mq_info::out) is det.
+:- pred mq_info_set_classes(mq_info::in, class_id_set::in, mq_info::out) is det.
 :- pred mq_info_set_interface_modules(mq_info::in, set(module_name)::in,
 						mq_info::out) is det.
 :- pred mq_info_set_import_status(mq_info::in, import_status::in,
@@ -957,29 +1121,31 @@
 :- pred mq_info_set_error_context(mq_info::in, error_context::in,
 						mq_info::out) is det.
 
-mq_info_set_types(mq_info(_, B,C,D,E,F,G,H,I,J,K), Types,
-		mq_info(Types, B,C,D,E,F,G,H,I,J,K)).
-mq_info_set_insts(mq_info(A,_,C,D,E,F,G,H,I,J,K), Insts,
-		mq_info(A, Insts, C,D,E,F,G,H,I,J,K)).
-mq_info_set_modes(mq_info(A,B,_,D,E,F,G,H,I,J,K), Modes,
-		mq_info(A,B, Modes, D,E,F,G,H,I,J,K)).
-mq_info_set_interface_modules(mq_info(A,B,C,_,E,F,G,H,I,J,K), Modules,
-		mq_info(A,B,C, Modules, E,F,G,H,I,J,K)).
-mq_info_set_import_status(mq_info(A,B,C,D,_,F,G,H,I,J,K), Status,
-		mq_info(A,B,C,D, Status, F,G,H,I,J,K)).
-mq_info_set_type_error_flag(mq_info(A,B,C,D,E,F, _, H,I,J,K),
-		mq_info(A,B,C,D,E,F, yes, H,I,J,K)).
-mq_info_set_mode_error_flag(mq_info(A,B,C,D,E,F,G,_,I,J,K),
-		mq_info(A,B,C,D,E,F,G, yes, I,J,K)).
-mq_info_set_error_context(mq_info(A,B,C,D,E,F,G,H,I,_,K), Context,
-		mq_info(A,B,C,D,E,F,G,H,I, Context,K)).
-mq_info_set_need_qual_flag(mq_info(A,B,C,D,E,F,G,H,I,J,_), Flag,
-		mq_info(A,B,C,D,E,F,G,H,I,J, Flag)).
+mq_info_set_types(mq_info(_, B,C,D,E,F,G,H,I,J,K,L), Types,
+		mq_info(Types, B,C,D,E,F,G,H,I,J,K,L)).
+mq_info_set_insts(mq_info(A,_,C,D,E,F,G,H,I,J,K,L), Insts,
+		mq_info(A, Insts, C,D,E,F,G,H,I,J,K,L)).
+mq_info_set_modes(mq_info(A,B,_,D,E,F,G,H,I,J,K,L), Modes,
+		mq_info(A,B, Modes, D,E,F,G,H,I,J,K,L)).
+mq_info_set_classes(mq_info(A,B,C,_,E,F,G,H,I,J,K,L), Classes,
+		mq_info(A,B, C, Classes,E,F,G,H,I,J,K,L)).
+mq_info_set_interface_modules(mq_info(A,B,C,D,_,F,G,H,I,J,K,L), Modules,
+		mq_info(A,B,C,D, Modules, F,G,H,I,J,K,L)).
+mq_info_set_import_status(mq_info(A,B,C,D,E,_,G,H,I,J,K,L), Status,
+		mq_info(A,B,C,D,E, Status, G,H,I,J,K,L)).
+mq_info_set_type_error_flag(mq_info(A,B,C,D,E,F,G, _, I,J,K,L),
+		mq_info(A,B,C,D,E,F,G, yes, I,J,K,L)).
+mq_info_set_mode_error_flag(mq_info(A,B,C,D,E,F,G,H,_,J,K,L),
+		mq_info(A,B,C,D,E,F,G,H, yes, J,K,L)).
+mq_info_set_error_context(mq_info(A,B,C,D,E,F,G,H,I,J,_,L), Context,
+		mq_info(A,B,C,D,E,F,G,H,I,J, Context,L)).
+mq_info_set_need_qual_flag(mq_info(A,B,C,D,E,F,G,H,I,J,K,_), Flag,
+		mq_info(A,B,C,D,E,F,G,H,I,J,K, Flag)).
 
 :- pred mq_info_incr_errors(mq_info::in, mq_info::out) is det.
 
-mq_info_incr_errors(mq_info(A,B,C,D,E, NumErrors0, G,H,I,J,K), 
-		mq_info(A,B,C,D,E, NumErrors, G,H,I,J,K)) :-
+mq_info_incr_errors(mq_info(A,B,C,D,E,F, NumErrors0, H,I,J,K,L), 
+		mq_info(A,B,C,D,E,F, NumErrors,H,I,J,K,L)) :-
 	NumErrors is NumErrors0 + 1.
 
 :- pred mq_info_set_error_flag(mq_info::in, id_type::in, mq_info::out) is det.
@@ -990,6 +1156,8 @@
 	mq_info_set_mode_error_flag(Info0, Info).
 mq_info_set_error_flag(Info0, inst_id, Info) :-
 	mq_info_set_mode_error_flag(Info0, Info).
+mq_info_set_error_flag(Info0, class_id, Info) :-
+	mq_info_set_type_error_flag(Info0, Info).
 
 	% If the current item is in the interface, remove its module 
 	% name from the list of modules not used in the interface.
@@ -1032,6 +1200,7 @@
 :- type type_id_set == id_set.
 :- type mode_id_set == id_set.
 :- type inst_id_set == id_set.
+:- type class_id_set == id_set.
 
 :- pred id_set_init(id_set::out) is det.
 
Index: compiler/modules.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/modules.m,v
retrieving revision 1.42
diff -u -r1.42 modules.m
--- modules.m	1997/10/16 04:59:11	1.42
+++ modules.m	1997/10/20 07:16:35
@@ -8,13 +8,13 @@
 % main author: fjh
 
 % This module contains all the code for handling module imports and exports,
-% for computing module dependencies, and for generate makefile fragments to
+% for computing module dependencies, and for generating makefile fragments to
 % record those dependencies.
 %
 %
 % The interface system works as follows:
 %
-% 1. a .int3 file is written, which contains all the types, insts
+% 1. a .int3 file is written, which contains all the types, typeclasses, insts
 % and modes defined in the interface. Equivalence types, insts and
 % modes are written in full, others are written in abstract form.
 % These are module qualified as far as possible given the information
@@ -1561,7 +1561,7 @@
 
 	% Given a module interface (well, a list of items), extract the
 	% short interface part of that module, i.e. the exported
-	% type/inst/mode declarations, but not the exported pred or
+	% type/typeclass/inst/mode declarations, but not the exported pred or
 	% constructor declarations.  If the module interface imports
 	% other modules, then the short interface only needs to include
 	% those import_module declarations only if the short interface
@@ -1625,6 +1625,7 @@
 include_in_short_interface(inst_defn(_, _, _)).
 include_in_short_interface(mode_defn(_, _, _)).
 include_in_short_interface(module_defn(_, _)).
+include_in_short_interface(typeclass(_, _, _, _, _)).
 
 :- pred make_abstract_type_defn(item, item).
 :- mode make_abstract_type_defn(in, out) is semidet.
Index: compiler/opt_debug.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/opt_debug.m,v
retrieving revision 1.74
diff -u -r1.74 opt_debug.m
--- opt_debug.m	1997/11/08 13:11:38	1.74
+++ opt_debug.m	1997/11/17 06:23:10
@@ -687,6 +687,8 @@
 	string__append("common", N_str, Str).
 opt_debug__dump_data_name(base_type(BaseData, TypeName, TypeArity), Str) :-
 	llds_out__make_base_type_name(BaseData, TypeName, TypeArity, Str).
+opt_debug__dump_data_name(base_typeclass_info(ClassId, InstanceNum), Str) :-
+	llds_out__make_base_typeclass_info_name(ClassId, InstanceNum, Str).
 opt_debug__dump_data_name(stack_layout(Label), Str) :-
 	opt_debug__dump_label(Label, LabelStr),
 	string__append_list(["stack_layout(", LabelStr, ")"], Str).
@@ -738,6 +740,9 @@
 opt_debug__dump_code_addr(do_det_closure, "do_det_closure").
 opt_debug__dump_code_addr(do_semidet_closure, "do_semidet_closure").
 opt_debug__dump_code_addr(do_nondet_closure, "do_nondet_closure").
+opt_debug__dump_code_addr(do_det_class_method, "do_det_class_method").
+opt_debug__dump_code_addr(do_semidet_class_method, "do_semidet_class_method").
+opt_debug__dump_code_addr(do_nondet_class_method, "do_nondet_class_method").
 opt_debug__dump_code_addr(do_not_reached, "do_not_reached").
 
 opt_debug__dump_code_addrs([], "").
Index: compiler/opt_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/opt_util.m,v
retrieving revision 1.84
diff -u -r1.84 opt_util.m
--- opt_util.m	1997/08/25 17:48:34	1.84
+++ opt_util.m	1997/09/08 04:13:07
@@ -1199,6 +1199,9 @@
 opt_util__livevals_addr(do_det_closure, yes).
 opt_util__livevals_addr(do_semidet_closure, yes).
 opt_util__livevals_addr(do_nondet_closure, yes).
+opt_util__livevals_addr(do_det_class_method, yes).
+opt_util__livevals_addr(do_semidet_class_method, yes).
+opt_util__livevals_addr(do_nondet_class_method, yes).
 opt_util__livevals_addr(do_not_reached, no).
 
 opt_util__count_temps_instr_list([], R, R, F, F).
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/polymorphism.m,v
retrieving revision 1.118
diff -u -r1.118 polymorphism.m
--- polymorphism.m	1997/10/14 09:27:53	1.118
+++ polymorphism.m	1997/11/20 04:49:20
@@ -8,9 +8,10 @@
 % main author: fjh
 
 % This module is a pass over the HLDS.
-% It does a syntactic transformation to implement polymorphism
-% using higher-order predicates, and also invokes `lambda__transform_lambda'
-% to handle lambda expressions by creating new predicates for them.
+% It does a syntactic transformation to implement polymorphism, including
+% typeclasses, using higher-order predicates, and also invokes
+% `lambda__transform_lambda' to handle lambda expressions by creating new
+% predicates for them.
 %
 %-----------------------------------------------------------------------------%
 %
@@ -40,7 +41,7 @@
 %	word 3		<compare/3 predicate for type>
 %	word 4		<base_type_layout for type>
 %	word 5		<base_type_functors for type>
-%	word 6		<string name of type>
+%	word 6		<string name of type constructor>
 %			e.g. "int" for `int', "list" for `list(T)',
 %			"map" for `map(K,V)'
 %	word 7		<string name of module>
@@ -150,6 +151,126 @@
 % single shared base_type_info.
 %
 %-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+%
+% Tranformation of code using typeclasses:
+%
+% Every predicate which has a typeclass constraint is given an extra
+% argument for every constraint in the predicate's type declaration.
+% The argument is the "dictionary", or "typeclass_info" for the typeclass.
+% The dictionary contains pointers to each of the class methods
+%
+%-----------------------------------------------------------------------------%
+%
+% Representation of a typeclass_info:
+%	The typeclass_info is represented in two parts (the typeclass_info
+%	itself, and a base_typeclass_info), in a similar fashion to the
+%	type_info being represented in two parts (the type_info and the
+%	base_type_info).
+%
+%		The base_type_info contains:
+%		  * arity of the instance declaration (ie. the number of
+%		    constraints on the decl).
+%		  * pointer to method #1
+%		    ...
+%		  * pointer to method #n
+%
+%		The type_info contains:
+%		  * a pointer to the base typeclass info
+%		  * typeclass info #1 for constraint on instance decl
+%		  * ...
+%		  * typeclass info #n for constraint on instance decl
+%		  * typeclass info for superclass #1
+%		    ...
+%		  * typeclass info for superclass #n
+%		  * type info #1 
+%		  * ...
+%		  * type info #n
+%
+% The base_type_info is produced statically, and there is one for each instance
+% declaration. For each constraint on the instance declaration, the
+% corresponding typeclass info is stored in the second part.
+%
+% eg. for the following program:
+%
+%	:- typeclass foo(T) where [...].
+%	:- instance  foo(int) where [...].
+%	:- instance  foo(list(T)) <= foo(T) where [...].
+%
+%	The typeclass_info for foo(int) is:
+%		The base_type_info:
+%		  * 0 (arity of the instance declaration) 
+%		  * pointer to method #1
+%		    ...
+%		  * pointer to method #n
+%
+%		The type_info:
+%		  * a pointer to the base typeclass info
+%		  * type info for int
+%
+%	The typeclass_info for foo(list(T)) is:
+%		The base_type_info:
+%		  * 1 (arity of the instance declaration)
+%		  * pointer to method #1
+%		    ...
+%		  * pointer to method #n
+%
+%		The type_info contains:
+%		  * a pointer to the base typeclass info
+%		  * typeclass info for foo(T)
+%		  * type info for list(T)
+%
+% Where the "T" for the list is known, the whole typeclass_info will be static
+% data. When we do not know until runtime, the typeclass_info is constructed
+% dynamically.
+%
+%-----------------------------------------------------------------------------%
+%
+% Example of transformation:
+%
+% Take the following code as an example (assuming the declarations above),
+% ignoring the requirement for super-homogeneous form for clarity:
+%
+%	:- pred p(T1) <= foo(T1).
+%	:- pred q(T2) <= foo(T2).
+%	:- pred r(T3, T4) <= foo(T3).
+%
+%	p(X) :- q([X]), r(0, X).
+%
+% We add an extra argument for each typeclass constraint, and one argument for
+% each unconstrained type variable.
+%
+%	:- pred p(typeclass_info(foo(T1)), T1).
+%	:- pred q(typeclass_info(foo(T2)), T2).
+%	:- pred r(typeclass_info(foo(T3)), type_info(T4), T3, T4).
+%
+% We transform the body of p to this:
+%
+%	p(TypeClassInfoT1, X) :-
+%		BaseTypeClassInfoT2 = base_typeclass_info(
+%			1,
+%			...
+%			... (The methods for the class from the list instance)
+%			...
+%			),
+%		TypeClassInfoT2 = typeclass_info(
+%			BaseTypeInfoT2,
+%			TypeClassInfoT1,
+%			<type_info for list(T1)>,
+%		q(TypeClassInfoT2, [X]),
+%		BaseTypeClassInfoT3 = baseclass_type_info(
+%			0,
+%			...
+%			... (The methods for the class from the int instance)
+%			...
+%			),
+%		TypeClassInfoT3 = typeclass_info(
+%			BaseTypeInfoT3,
+%			<type_info for int>),
+%		r(TypeClassInfoT1, TypeInfoT3, 0, X).
+%
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
 
 :- module polymorphism.
 :- interface.
@@ -166,10 +287,10 @@
 :- import_module hlds_pred, hlds_goal, hlds_data, llds, (lambda), globals.
 :- import_module prog_data, type_util, mode_util, quantification, instmap.
 :- import_module code_util, unify_proc, special_pred, prog_util, make_hlds.
-:- import_module (inst), hlds_out.
+:- import_module std_util, (inst), hlds_out, base_typeclass_info.
 
 :- import_module bool, int, string, list, set, map.
-:- import_module term, varset, std_util, require.
+:- import_module term, varset, std_util, require, assoc_list.
 
 %-----------------------------------------------------------------------------%
 
@@ -187,7 +308,8 @@
 	polymorphism__process_preds(PredIds0, ModuleInfo0, ModuleInfo1),
 	module_info_preds(ModuleInfo1, Preds1),
 	map__keys(Preds1, PredIds1),
-	polymorphism__fixup_preds(PredIds1, ModuleInfo1, ModuleInfo).
+	polymorphism__fixup_preds(PredIds1, ModuleInfo1, ModuleInfo2),
+	polymorphism__expand_class_method_bodies(ModuleInfo2, ModuleInfo).
 
 :- pred polymorphism__process_preds(list(pred_id), module_info, module_info).
 :- mode polymorphism__process_preds(in, in, out) is det.
@@ -284,9 +406,32 @@
 			varset,			% from the proc_info
 			map(var, type),		% from the proc_info
 			tvarset,		% from the proc_info
-			map(tvar, var),		% specifies the type_info var
+			map(tvar, type_info_locn),		
+						% specifies the location of
+						% the type_info var
 						% for each of the pred's type
 						% parameters
+
+			map(class_constraint, var),		
+						% specifies the location of
+						% the typeclass_info var
+						% for each of the pred's class
+						% constraints
+			map(class_constraint, constraint_proof),
+						% specifies why each constraint
+						% that was eliminated from the
+						% pred was able to be eliminated
+						% (this allows us to efficiently
+						% construct the dictionary)
+
+						% Note that the two maps above
+						% are separate since the second
+						% is the information calculated
+						% by typecheck.m, while the
+						% first is the information
+						% calculated here in
+						% polymorphism.m
+
 			string,			% pred name
 			module_info
 		).
@@ -300,34 +445,76 @@
 	% grab the appropriate fields from the pred_info and proc_info
 	pred_info_arg_types(PredInfo0, ArgTypeVarSet, ArgTypes),
 	pred_info_typevarset(PredInfo0, TypeVarSet0),
+	pred_info_get_class_context(PredInfo0, ClassContext),
+	pred_info_get_constraint_proofs(PredInfo0, Proofs),
 	pred_info_name(PredInfo0, PredName),
 	proc_info_headvars(ProcInfo0, HeadVars0),
 	proc_info_variables(ProcInfo0, VarSet0),
 	proc_info_vartypes(ProcInfo0, VarTypes0),
 	proc_info_goal(ProcInfo0, Goal0),
 	proc_info_argmodes(ProcInfo0, ArgModes0),
-	% insert extra head variables to hold the address of the
-	% equality predicate for each polymorphic type in the predicate's
-	% type declaration
+
+
+		% Insert extra head variables to hold the address of the
+		% type_infos and typeclass_infos.
+		% We insert one variable for each unconstrained type variable
+		% (for the type_info) and one variable for each constraint (for
+		% the typeclass_info).
 	term__vars_list(ArgTypes, HeadTypeVars0),
-	list__remove_dups(HeadTypeVars0, HeadTypeVars), % remove duplicates
-	polymorphism__make_head_vars(HeadTypeVars, ArgTypeVarSet,
-		VarSet0, VarTypes0, ExtraHeadVars, VarSet1, VarTypes1),
-	list__append(ExtraHeadVars, HeadVars0, HeadVars),
-	list__length(ExtraHeadVars, NumExtraVars),
+		% Make a fresh variable for each class constraint, returning
+		% a list of variables that appear in the constraints, along
+		% with the location of the type infos for them.
+	polymorphism__make_typeclass_info_head_vars(ClassContext, ModuleInfo0,
+		VarSet0, VarTypes0, ExtraHeadTypeclassInfoVars,
+		TypeClassInfoMap, ConstrainedTVars, 
+		VarSet1, VarTypes1),
+
+	list__delete_elems(HeadTypeVars0, ConstrainedTVars, 
+		UnconstrainedTVars0),
+	list__remove_dups(UnconstrainedTVars0, UnconstrainedTVars), 
+
+	polymorphism__make_head_vars(UnconstrainedTVars, ArgTypeVarSet,
+		VarSet1, VarTypes1, ExtraHeadTypeInfoVars, VarSet2, VarTypes2),
+
+		% First the type_infos, then the typeclass_infos, 
+		% but we have to do it in reverse because we're appending...
+	list__append(ExtraHeadTypeclassInfoVars, HeadVars0, HeadVars1),
+	list__append(ExtraHeadTypeInfoVars, HeadVars1, HeadVars),
+
+		% Work out the total number of new vars
+	list__length(ExtraHeadTypeInfoVars, NumExtraVars0),
+	list__length(ExtraHeadTypeclassInfoVars, NumExtraVars1),
+	NumExtraVars is NumExtraVars1 + NumExtraVars0,
+
 	list__duplicate(NumExtraVars, user_defined_mode(
 		qualified("mercury_builtin", "in"), []), ExtraModes),
 	list__append(ExtraModes, ArgModes0, ArgModes),
 
+		% Make a map of the locations of the unconstrained typeinfos
+	AddLocn = lambda([TVarAndVar::in, TIM0::in, TIM::out] is det,
+		(
+			TVarAndVar = TVar - TheVar,
+			map__det_insert(TIM0, TVar, type_info(TheVar), TIM)
+		)),
+	assoc_list__from_corresponding_lists(UnconstrainedTVars,
+		ExtraHeadTypeInfoVars, TVarsAndVars),
+	list__foldl(AddLocn, TVarsAndVars, TypeClassInfoMap, TypeInfoMap1),
+
+
+		% Make a map of the locations of the typeclass_infos
+	map__from_corresponding_lists(ClassContext, ExtraHeadTypeclassInfoVars,
+				TypeclassInfoLocations0),
+
+	Info0 = poly_info(VarSet2, VarTypes2, TypeVarSet0,
+				TypeInfoMap1, TypeclassInfoLocations0,
+				Proofs, PredName, ModuleInfo0),
+
 	% process any polymorphic calls inside the goal
-	map__from_corresponding_lists(HeadTypeVars, ExtraHeadVars,
-				TypeInfoMap0),
-	Info0 = poly_info(VarSet1, VarTypes1, TypeVarSet0,
-				TypeInfoMap0, PredName, ModuleInfo0),
 	polymorphism__process_goal(Goal0, Goal1, Info0, Info1),
 	polymorphism__fixup_quantification(Goal1, Goal, Info1, Info),
-	Info = poly_info(VarSet, VarTypes, TypeVarSet, TypeInfoMap, _PredName,
-		ModuleInfo),
+	Info = poly_info(VarSet, VarTypes, TypeVarSet,
+				TypeInfoMap, TypeclassInfoLocations,
+				_Proofs, _PredName, ModuleInfo),
 
 	% set the new values of the fields in proc_info and pred_info
 	proc_info_set_headvars(ProcInfo0, HeadVars, ProcInfo1),
@@ -335,7 +522,9 @@
 	proc_info_set_varset(ProcInfo2, VarSet, ProcInfo3),
 	proc_info_set_vartypes(ProcInfo3, VarTypes, ProcInfo4),
 	proc_info_set_argmodes(ProcInfo4, ArgModes, ProcInfo5),
-	proc_info_set_typeinfo_varmap(ProcInfo5, TypeInfoMap, ProcInfo),
+	proc_info_set_typeinfo_varmap(ProcInfo5, TypeInfoMap, ProcInfo6),
+	proc_info_set_typeclass_info_varmap(ProcInfo6, TypeclassInfoLocations,
+		ProcInfo),
 	pred_info_set_typevarset(PredInfo0, TypeVarSet, PredInfo).
 
 :- pred polymorphism__process_goal(hlds_goal, hlds_goal,
@@ -357,6 +546,11 @@
 		GoalInfo, higher_order_call(A, B, C, D, E, F) - GoalInfo)
 		--> [].
 
+	% The same goes for class method calls
+polymorphism__process_goal_expr(class_method_call(A, B, C, D, E, F),
+		GoalInfo, class_method_call(A, B, C, D, E, F) - GoalInfo)
+		--> [].
+
 polymorphism__process_goal_expr(call(PredId0, ProcId0, ArgVars0,
 		Builtin, Context, Name0), GoalInfo, Goal) -->
 	% Check for a call to a special predicate like compare/3
@@ -368,7 +562,7 @@
 		{ list__length(ArgVars0, Arity) },
 		{ special_pred_name_arity(SpecialPredId, PredName0,
 						MangledPredName, Arity) },
-		=(poly_info(_, VarTypes, _, _TypeInfoMap, _PN, ModuleInfo)),
+		=(poly_info(_, VarTypes, _, _, _, _, _, ModuleInfo)),
 		{ special_pred_get_type(MangledPredName, ArgVars0, MainVar) },
 		{ map__lookup(VarTypes, MainVar, Type) },
 		{ Type \= term__variable(_) },
@@ -404,7 +598,7 @@
 		{ Unification = complicated_unify(UniMode, CanFail) },
 		{ Y = var(YVar) }
 	->
-		=(poly_info(_, VarTypes, _, TypeInfoMap, _PName, ModuleInfo)),
+		=(poly_info(_, VarTypes, _, TypeInfoMap, _, _, _, ModuleInfo)),
 		{ map__lookup(VarTypes, XVar, Type) },
 		( { Type = term__variable(TypeVar) } ->
 			% Convert polymorphic unifications into calls to
@@ -428,14 +622,48 @@
 			%     polymorphically typed variables in partially
 			%     instantiated mode") if it isn't
 			{ hlds_pred__in_in_unification_proc_id(ProcId) },
-			{ map__lookup(TypeInfoMap, TypeVar, TypeInfoVar) },
+			{ map__lookup(TypeInfoMap, TypeVar, TypeInfoLocn) },
 			{ SymName = unqualified("unify") },
-			{ ArgVars = [TypeInfoVar, XVar, YVar] },
 			{ code_util__builtin_state(ModuleInfo, PredId, ProcId,
 				BuiltinState) },
 			{ CallContext = call_unify_context(XVar, Y, Context) },
-			{ Goal = call(PredId, ProcId, ArgVars, BuiltinState,
-				yes(CallContext), SymName) - GoalInfo }
+			(
+					% If the typeinfo is available in a
+					% variable, just use it
+				{ TypeInfoLocn = type_info(TypeInfoVar) },
+				{ ArgVars = [TypeInfoVar, XVar, YVar] },
+				{ Goal = call(PredId, ProcId, ArgVars,
+					BuiltinState, yes(CallContext), SymName)
+					- GoalInfo }
+			;
+					% If the typeinfo is in a
+					% typeclass_info, first extract it, 
+					% then use it
+				{ TypeInfoLocn =
+					typeclass_info(TypeClassInfoVar,
+					Index) },
+				extract_type_info(Type, TypeVar,
+					TypeClassInfoVar, Index,
+					Goals, TypeInfoVar),
+
+				{ ArgVars = [TypeInfoVar, XVar, YVar] },
+				{ Call = call(PredId, ProcId, ArgVars,
+					BuiltinState, yes(CallContext), SymName)
+					- GoalInfo },
+
+					% The TypeClassInfoVar is also nonlocal
+					% to this conj, since it is used to
+					% extract the type_info
+					%
+					% XXX Do I need to do this?
+				{ goal_info_get_nonlocals(GoalInfo, 
+					NonLocals0) },
+				{ set__insert(NonLocals0, TypeClassInfoVar,
+					NonLocals) },
+				{ goal_info_set_nonlocals(GoalInfo, NonLocals,
+					NewGoalInfo) },
+				{ Goal = conj([Call|Goals]) - NewGoalInfo }
+			)
 
 		; { type_is_higher_order(Type, _, _) } ->
 			{ SymName = unqualified("builtin_unify_pred") },
@@ -537,7 +765,7 @@
 	% so that the c_code can refer to the type_info variable
 	% for type T as `TypeInfo_for_T'.
 	%
-	=(poly_info(_, _, _, _, _, ModuleInfo)),
+	=(poly_info(_, _, _, _, _, _, _, ModuleInfo)),
 	{ module_info_pred_info(ModuleInfo, PredId, PredInfo) },
 	{ pred_info_arg_types(PredInfo, PredTypeVarSet, PredArgTypes) },
 	{ term__vars_list(PredArgTypes, PredTypeVars0) },
@@ -612,14 +840,17 @@
 
 polymorphism__process_call(PredId, _ProcId, ArgVars0, ArgVars,
 				ExtraVars, ExtraGoals, Info0, Info) :-
-	Info0 = poly_info(VarSet0, VarTypes0, TypeVarSet0,
-				TypeInfoMap0, PredName, ModuleInfo),
+
+	Info0 = poly_info(A, VarTypes, TypeVarSet0, D, E, F, G, ModuleInfo),
+
 	module_info_pred_info(ModuleInfo, PredId, PredInfo),
 	pred_info_arg_types(PredInfo, PredTypeVarSet, PredArgTypes0),
+	pred_info_get_class_context(PredInfo, PredClassContext0),
 		% rename apart
 		% (this merge might be a performance bottleneck?)
-	varset__merge(TypeVarSet0, PredTypeVarSet, PredArgTypes0,
-			TypeVarSet, PredArgTypes),
+	varset__merge_subst(TypeVarSet0, PredTypeVarSet, TypeVarSet, Subst),
+	term__apply_substitution_to_list(PredArgTypes0, Subst,
+		PredArgTypes),
 	term__vars_list(PredArgTypes, PredTypeVars0),
 	( PredTypeVars0 = [] ->
 		% optimize for common case of non-polymorphic call
@@ -628,24 +859,47 @@
 		ExtraVars = [],
 		Info = Info0
 	;
-		list__remove_dups(PredTypeVars0, PredTypeVars),
-		map__apply_to_list(ArgVars0, VarTypes0, ActualArgTypes),
+		list__remove_dups(PredTypeVars0, PredTypeVars1),
+		map__apply_to_list(ArgVars0, VarTypes, ActualArgTypes),
 		( type_list_subsumes(PredArgTypes, ActualArgTypes,
 				TypeSubst1) ->
 			TypeSubst = TypeSubst1
 		;
 		error("polymorphism__process_goal_expr: type unification failed")
 		),
+
+
+		apply_subst_to_constraints(Subst, PredClassContext0,
+			PredClassContext),
+
+		Info1 = poly_info(A, VarTypes, TypeVarSet, D, E, F, G,
+			ModuleInfo),
+
+			% Make the typeclass_infos for the call, and return
+			% a list of which variables were constrained by the
+			% context
+		polymorphism__make_typeclass_info_vars(PredClassContext,
+			Subst, TypeSubst, ExtraTypeClassVars, 
+			ExtraTypeClassGoals, ConstrainedVars, Info1, Info2),
+
+			% No need to make typeinfos for the constrained vars
+		list__delete_elems(PredTypeVars1, ConstrainedVars,
+			PredTypeVars),
+
 		term__var_list_to_term_list(PredTypeVars, PredTypes0),
 		term__apply_rec_substitution_to_list(PredTypes0, TypeSubst,
 			PredTypes),
-		polymorphism__make_vars(PredTypes, ModuleInfo, TypeInfoMap0,
-				VarSet0, VarTypes0,
-				ExtraVars, TypeInfoMap, ExtraGoals, VarSet, 
-				VarTypes),
-		list__append(ExtraVars, ArgVars0, ArgVars),
-		Info = poly_info(VarSet, VarTypes, TypeVarSet,
-				TypeInfoMap, PredName, ModuleInfo)
+
+		polymorphism__make_type_info_vars(PredTypes,
+			ExtraTypeInfoVars, ExtraTypeInfoGoals,
+			Info2, Info),
+		list__append(ExtraTypeClassVars, ArgVars0, ArgVars1),
+		list__append(ExtraTypeInfoVars, ArgVars1, ArgVars),
+		list__append(ExtraTypeClassGoals, ExtraTypeInfoGoals,
+			ExtraGoals),
+		list__append(ExtraTypeClassVars, ExtraTypeInfoVars,
+			ExtraVars)
+
 	).
 
 :- pred polymorphism__fixup_quantification(hlds_goal, hlds_goal,
@@ -661,31 +915,43 @@
 
 polymorphism__fixup_quantification(Goal0, Goal, Info0, Info) :-
 	Info0 = poly_info(VarSet0, VarTypes0, TypeVarSet, TypeVarMap,
-			PredName, ModuleInfo),
+			TypeClassVarMap, Proofs, PredName, ModuleInfo),
 	( map__is_empty(TypeVarMap) ->
 		Info = Info0,
 		Goal = Goal0
 	;
 		%
-		% A type-info variable may be non-local to a goal if any of
+		% A type-info variable may be non-local to a goal if any of 
 		% the ordinary non-local variables for that goal are
 		% polymorphically typed with a type that depends on that
 		% type-info variable.
 		%
+		% In addition, a typeclass-info is non-local to a goal if any 
+		% of the non-local variables for that goal are polymorphically
+		% typed and are constrained by the typeclass constraints for
+		% that typeclass-info variable
+		%
 		Goal0 = _ - GoalInfo0,
 		goal_info_get_nonlocals(GoalInfo0, NonLocals),
 		set__to_sorted_list(NonLocals, NonLocalsList),
 		map__apply_to_list(NonLocalsList, VarTypes0, NonLocalsTypes),
 		term__vars_list(NonLocalsTypes, NonLocalTypeVars),
-		solutions_set(lambda([TypeInfoVar::out] is nondet, (
-				list__member(Var, NonLocalTypeVars),
-				map__search(TypeVarMap, Var, TypeInfoVar)
+			% Find all the type-infos and typeclass-infos that are
+			% non-local
+		solutions_set(lambda([Var::out] is nondet, (
+				list__member(TheVar, NonLocalTypeVars),
+				map__search(TypeVarMap, TheVar, Location),
+				(
+					Location = type_info(Var)
+				;
+					Location = typeclass_info(Var, _)
+				)
 			)), NewOutsideVars),
 		set__union(NewOutsideVars, NonLocals, OutsideVars),
 		implicitly_quantify_goal(Goal0, VarSet0, VarTypes0,
 			OutsideVars, Goal, VarSet, VarTypes, _Warnings),
 		Info = poly_info(VarSet, VarTypes, TypeVarSet, TypeVarMap,
-				PredName, ModuleInfo)
+				TypeClassVarMap, Proofs, PredName, ModuleInfo)
 	).
 
 :- pred polymorphism__process_lambda(pred_or_func, list(var),
@@ -697,50 +963,469 @@
 polymorphism__process_lambda(PredOrFunc, Vars, Modes, Det, OrigNonLocals,
 		LambdaGoal, Unification0, Functor, Unification,
 		PolyInfo0, PolyInfo) :-
-	PolyInfo0 = poly_info(VarSet, VarTypes, TVarSet, TVarMap, PredName,
-			ModuleInfo0),
+	PolyInfo0 = poly_info(VarSet, VarTypes, TVarSet, TVarMap, 
+			TCVarMap, Proofs, PredName, ModuleInfo0),
+
+		% XXX This is wrong. What is the class context really?
+	Constraints = [],
+
 	lambda__transform_lambda(PredOrFunc, PredName, Vars, Modes, Det,
 		OrigNonLocals, LambdaGoal, Unification0, VarSet, VarTypes,
-		TVarSet, TVarMap, ModuleInfo0, Functor,
+		Constraints, TVarSet, TVarMap, TCVarMap, ModuleInfo0, Functor,
 		Unification, ModuleInfo),
-	PolyInfo = poly_info(VarSet, VarTypes, TVarSet, TVarMap, PredName,
-			ModuleInfo).
+	PolyInfo = poly_info(VarSet, VarTypes, TVarSet, TVarMap, 
+			TCVarMap, Proofs, PredName, ModuleInfo).
+
+%---------------------------------------------------------------------------%
+
+% Given a list of constraints, create a list of variables to hold the
+% typeclass_info for those constraints, and create a list of goals to 
+% initialize those typeclass_info variables to the appropriate 
+% typeclass_info structures for the constraints.
+
+:- pred polymorphism__make_typeclass_info_vars(list(class_constraint),
+	substitution, tsubst, list(var), list(hlds_goal), list(var),
+	poly_info, poly_info).
+:- mode polymorphism__make_typeclass_info_vars(in, in, in, out, out, out, 
+	in, out) is det.
+
+polymorphism__make_typeclass_info_vars(PredClassContext, Subst, TypeSubst, 
+		ExtraVars, ExtraGoals, ConstrainedVars, Info0, Info) :-
+
+		% initialise the accumulators
+	ExtraVars0 = [],
+	ExtraGoals0 = [],
+	ConstrainedVars0 = [],
+
+		% do the work
+	polymorphism__make_typeclass_info_vars_2(PredClassContext, 
+		Subst, TypeSubst, 
+		ExtraVars0, ExtraVars1, 
+		ExtraGoals0, ExtraGoals1,
+		ConstrainedVars0, ConstrainedVars, 
+		Info0, Info),
+	
+		% We build up the vars and goals in reverse order
+	list__reverse(ExtraVars1, ExtraVars),
+	list__reverse(ExtraGoals1, ExtraGoals).
+
+% Accumulator version of the above.
+:- pred polymorphism__make_typeclass_info_vars_2(list(class_constraint),
+	substitution, tsubst, 
+	list(var), list(var), 
+	list(hlds_goal), list(hlds_goal), 
+	list(var), list(var),
+	poly_info, poly_info).
+:- mode polymorphism__make_typeclass_info_vars_2(in, in, in, in, out, in, out,
+	in, out, in, out) is det.
+
+polymorphism__make_typeclass_info_vars_2([], _Subst, _TypeSubst,
+		ExtraVars, ExtraVars, 
+		ExtraGoals, ExtraGoals, 
+		ConstrainedVars, ConstrainedVars,
+		Info, Info).
+polymorphism__make_typeclass_info_vars_2([C|Cs], Subst, TypeSubst,
+		ExtraVars0, ExtraVars, 
+		ExtraGoals0, ExtraGoals, 
+		ConstrainedVars0, ConstrainedVars,
+		Info0, Info) :-
+	polymorphism__make_typeclass_info_var(C, Subst, TypeSubst,
+			ExtraGoals0, ExtraGoals1, 
+			ConstrainedVars0, ConstrainedVars1, Info0, Info1,
+			ExtraVar),
+	polymorphism__make_typeclass_info_vars_2(Cs, Subst, TypeSubst,
+			[ExtraVar|ExtraVars0], ExtraVars, 
+			ExtraGoals1, ExtraGoals, 
+			ConstrainedVars1, ConstrainedVars,
+			Info1, Info).
+
+:- pred polymorphism__make_typeclass_info_var(class_constraint,
+	substitution, tsubst,
+	list(hlds_goal), list(hlds_goal), 
+	list(var), list(var),
+	poly_info, poly_info,
+	var). 
+:- mode polymorphism__make_typeclass_info_var(in, in, in, in, out, in, out, 
+	in, out, out) is det.
+
+polymorphism__make_typeclass_info_var(Constraint, Subst, TypeSubst,
+		ExtraGoals0, ExtraGoals, 
+		ConstrainedVars0, ConstrainedVars, 
+		Info0, Info, Var) :-
+	Constraint = constraint(ClassName, NewConstrainedTypes),
+	list__length(NewConstrainedTypes, ClassArity),
+	ClassId = class_id(ClassName, ClassArity),
+	term__vars_list(NewConstrainedTypes, NewConstrainedVars),
+	list__append(NewConstrainedVars, ConstrainedVars0, ConstrainedVars),
+	term__apply_rec_substitution_to_list(NewConstrainedTypes, TypeSubst, 
+		ConstrainedTypes),
+	NewC = constraint(ClassName, ConstrainedTypes),
+
+	Info0 = poly_info(VarSet0, VarTypes0, TypeVarSet0, TypeInfoMap0, 
+		TypeClassInfoMap0, Proofs, PredName, ModuleInfo),
+
+	(
+		map__search(TypeClassInfoMap0, NewC, Location)
+	->
+			% We already have a typeclass_info for this constraint
+		ExtraGoals = ExtraGoals0,
+		Var = Location,
+		Info = Info0
+	;
+			% We don't have the typeclass_info as a parameter to
+			% the pred, so we must be able to create it from
+			% somewhere else
+
+			% Work out how to make it
+		map__lookup(Proofs, NewC, Proof),
+		(
+				% We have to construct the typeclass_info
+				% using an instance declaration
+			Proof = apply_instance(InstanceDefn, InstanceNum),
+
+				% The subst has already been applied to these
+				% constraints in typecheck.m
+			InstanceDefn = hlds_instance_defn(_,
+				InstanceConstraints, _, _, _, _, _),
+
+				% Make the type_infos for the types that are
+				% constrained by this. These are packaged in
+				% the typeclass_info
+			polymorphism__make_type_info_vars(ConstrainedTypes,
+				InstanceExtraTypeInfoVars, TypeInfoGoals, 
+				Info0, Info1),
+
+				% Make the typeclass_infos for the constraints
+				% from the context of the instance decl.
+			polymorphism__make_typeclass_info_vars_2(
+				InstanceConstraints,
+				Subst, TypeSubst, 
+				[], InstanceExtraTypeClassInfoVars, 
+				ExtraGoals0, ExtraGoals1, 
+				[], _, Info1, Info2),
+
+			polymorphism__construct_typeclass_info(
+				InstanceExtraTypeInfoVars, 
+				InstanceExtraTypeClassInfoVars, 
+				ClassId, InstanceNum, Var, NewGoals, 
+				Info2, Info),
+
+				% Oh, yuck. The type_info goals have already
+				% been reversed, so lets reverse them back.
+			list__reverse(TypeInfoGoals, RevTypeInfoGoals),
+
+			list__append(ExtraGoals1, RevTypeInfoGoals,
+				ExtraGoals2),
+			list__append(NewGoals, ExtraGoals2, ExtraGoals)
+		;
+				% We have to extract the typeclass_info from
+				% another one
+			Proof = superclass(SubClassConstraint0),
+
+				% First create a variable to hold the new
+				% typeclass_info 
+			unqualify_name(ClassName, ClassNameString),
+			polymorphism__new_typeclass_info_var(VarSet0, VarTypes0,
+				ClassNameString, Var, VarSet1, VarTypes1),
+
+				% Then work out where to extract it from
+			SubClassConstraint0 = 
+				constraint(SubClassName, SubClassTypes0),
+			term__apply_substitution_to_list(SubClassTypes0, Subst,
+				SubClassTypes),
+			SubClassConstraint = 
+				constraint(SubClassName, SubClassTypes),
+			list__length(SubClassTypes, SubClassArity),
+			SubClassId = class_id(SubClassName, SubClassArity),
+
+			Info1 = poly_info(VarSet1, VarTypes1, TypeVarSet0, 
+				TypeInfoMap0, TypeClassInfoMap0, Proofs, 
+				PredName, ModuleInfo),
+
+				% Make the typeclass_info for the subclass
+			polymorphism__make_typeclass_info_var(
+				SubClassConstraint,
+				Subst, TypeSubst, 
+				ExtraGoals0, ExtraGoals1, 
+				[], _,
+				Info1, Info2,
+				SubClassVar), 
+
+				% Look up the definition of the subclass
+			module_info_classes(ModuleInfo, ClassTable),
+			map__lookup(ClassTable, SubClassId, SubClassDefn), 
+			SubClassDefn = hlds_class_defn(SuperClasses0,
+				SubClassVars, _, _),
+
+				% Work out which superclass typeclass_info to
+				% take
+			ToTerm = lambda([TheVar::in, TheTerm::out] is det,
+				(
+					TheTerm = term__variable(TheVar)
+				)),
+			list__map(ToTerm, SubClassVars, SubClassVarTerms),
+			(
+				type_list_subsumes(SubClassVarTerms,
+					SubClassTypes, SubTypeSubst0)
+			->
+				SubTypeSubst0 = SubTypeSubst
+			;
+				error("polymorphism__make_typeclass_info_var")
+			),
+			apply_rec_subst_to_constraints(SubTypeSubst,
+				SuperClasses0, SuperClasses),
+			(
+				list__nth_member_search(SuperClasses,
+					Constraint, SuperClassIndex0)
+			->
+				SuperClassIndex0 = SuperClassIndex
+			;
+					% We shouldn't have got this far if
+					% the constraints were not satifsied
+				error("polymorphism.m: constraint not in constraint list")
+			),
+
+			Info2 = poly_info(VarSet2, VarTypes2, TypeVarSet2, 
+				TypeInfoMap2, TypeClassInfoMap2, Proofs2, 
+				PredName2, ModuleInfo2),
+
+			polymorphism__make_count_var(SuperClassIndex, VarSet2,
+				VarTypes2, IndexVar, IndexGoal, VarSet,
+				VarTypes),
+
+			Info = poly_info(VarSet, VarTypes, TypeVarSet2, 
+				TypeInfoMap2, TypeClassInfoMap2, Proofs2, 
+				PredName2, ModuleInfo2),
+
+				% We extract the superclass typeclass_info by
+				% inserting a call to
+				% superclass_from_typeclass_info in
+				% mercury_builtin.
+
+				% Make the goal for the call
+			varset__init(Empty),
+			term__context_init(EmptyContext),
+			ExtractSuperClass = 
+				qualified("mercury_builtin", 
+					  "superclass_from_typeclass_info"),
+			TypeClassInfoTerm = term__functor(
+					term__atom("typeclass_info"), [],
+					EmptyContext),
+			IntTerm = term__functor(
+					term__atom("int"), [],
+					EmptyContext),
+			get_pred_id_and_proc_id(ExtractSuperClass, predicate, 
+				Empty, 
+				[TypeClassInfoTerm, IntTerm, TypeClassInfoTerm],
+				ModuleInfo, PredId, ProcId),
+			Call = call(PredId, ProcId, 
+				[SubClassVar, IndexVar, Var],
+				not_builtin, no, 
+				ExtractSuperClass
+				),
+
+				% Make the goal info for the call
+			set__list_to_set([SubClassVar, IndexVar, Var],
+				NonLocals),
+			instmap_delta_from_assoc_list(
+				[Var - ground(shared, no)],
+				InstmapDelta),
+			goal_info_init(NonLocals, InstmapDelta, det, GoalInfo),
+
+				% Put them together
+			SuperClassGoal = Call - GoalInfo,
+
+				% Add it to the accumulator
+			ExtraGoals = [SuperClassGoal,IndexGoal|ExtraGoals1]
+		)
+	).
+
+:- pred polymorphism__construct_typeclass_info(list(var), list(var), class_id, 
+	int, var, list(hlds_goal), poly_info, poly_info).
+:- mode polymorphism__construct_typeclass_info(in, in, in, in, out, out, 
+	in, out) is det.
+
+polymorphism__construct_typeclass_info(ArgTypeInfoVars, ArgTypeClassInfoVars,
+		ClassId, InstanceNum, NewVar, NewGoals, Info0, Info) :-
+
+	Info0 = poly_info(_, _, _, _, _, _, _, ModuleInfo),
+
+	module_info_instances(ModuleInfo, InstanceTable),
+	map__lookup(InstanceTable, ClassId, InstanceList),
+	list__index1_det(InstanceList, InstanceNum, InstanceDefn),
+	InstanceDefn = hlds_instance_defn(_, _, InstanceTypes, _, _, _, 
+		SuperClassProofs),
+
+	module_info_classes(ModuleInfo, ClassTable),
+	map__lookup(ClassTable, ClassId, ClassDefn),
+
+	polymorphism__get_arg_superclass_vars(ClassDefn, InstanceTypes,
+		SuperClassProofs, ArgSuperClassVars, SuperClassGoals, 
+		Info0, Info1),
+
+	Info1 = poly_info(VarSet0, VarTypes0, TVarSet, TVarMap, TCVarMap, 
+			Proofs, PredName, _),
+
+		% lay out the argument variables as expected in the
+		% typeclass_info
+	list__append(ArgTypeClassInfoVars, ArgSuperClassVars, ArgVars0),
+	list__append(ArgVars0, ArgTypeInfoVars, ArgVars),
+
+	ClassId = class_id(ClassName, _Arity),
+
+	unqualify_name(ClassName, ClassNameString),
+	polymorphism__new_typeclass_info_var(VarSet0, VarTypes0,
+		ClassNameString, BaseVar, VarSet1, VarTypes1),
+
+	base_typeclass_info__make_instance_string(InstanceTypes,
+		InstanceString),
+
+		% XXX I don't think we actually need to carry this string
+		% around.
+	ModuleName = "some bogus string",
+	ConsId = base_typeclass_info_const(ModuleName, ClassId, InstanceString),
+	BaseTypeClassInfoTerm = functor(ConsId, []),
+
+		% create the construction unification to initialize the variable
+	BaseUnification = construct(BaseVar, ConsId, [], []),
+	BaseUnifyMode = (free -> ground(shared, no)) -
+			(ground(shared, no) -> ground(shared, no)),
+	BaseUnifyContext = unify_context(explicit, []),
+		% XXX the UnifyContext is wrong
+	BaseUnify = unify(BaseVar, BaseTypeClassInfoTerm, BaseUnifyMode,
+			BaseUnification, BaseUnifyContext),
+
+		% create a goal_info for the unification
+	set__list_to_set([BaseVar], NonLocals),
+	instmap_delta_from_assoc_list([BaseVar - ground(shared, no)],
+		InstmapDelta),
+	goal_info_init(NonLocals, InstmapDelta, det, BaseGoalInfo),
+
+	BaseGoal = BaseUnify - BaseGoalInfo,
+
+		% build a unification to add the argvars to the
+		% base_typeclass_info
+	NewConsId = cons(qualified("mercury_builtin", "typeclass_info"), 1),
+	NewArgVars = [BaseVar|ArgVars],
+	TypeClassInfoTerm = functor(NewConsId, NewArgVars),
+
+		% introduce a new variable
+	polymorphism__new_typeclass_info_var(VarSet1, VarTypes1,
+		ClassNameString, NewVar, VarSet, VarTypes),
+
+		% create the construction unification to initialize the
+		% variable
+	UniMode = (free - ground(shared, no) ->
+		   ground(shared, no) - ground(shared, no)),
+	list__length(NewArgVars, NumArgVars),
+	list__duplicate(NumArgVars, UniMode, UniModes),
+	Unification = construct(NewVar, NewConsId, NewArgVars,
+		UniModes),
+	UnifyMode = (free -> ground(shared, no)) -
+			(ground(shared, no) -> ground(shared, no)),
+	UnifyContext = unify_context(explicit, []),
+		% XXX the UnifyContext is wrong
+	Unify = unify(NewVar, TypeClassInfoTerm, UnifyMode,
+			Unification, UnifyContext),
+
+	% create a goal_info for the unification
+	goal_info_init(GoalInfo0),
+	set__list_to_set([NewVar | NewArgVars], TheNonLocals),
+	goal_info_set_nonlocals(GoalInfo0, TheNonLocals, GoalInfo1),
+	list__duplicate(NumArgVars, ground(shared, no), ArgInsts),
+		% note that we could perhaps be more accurate than
+		% `ground(shared)', but it shouldn't make any
+		% difference.
+	InstConsId = cons( qualified("mercury_builtin", "typeclass_info"), 
+		NumArgVars),
+	instmap_delta_from_assoc_list(
+		[NewVar - 
+			bound(unique, [functor(InstConsId, ArgInsts)])],
+		InstMapDelta),
+	goal_info_set_instmap_delta(GoalInfo1, InstMapDelta, GoalInfo2),
+	goal_info_set_determinism(GoalInfo2, det, GoalInfo),
+
+	TypeClassInfoGoal = Unify - GoalInfo,
+	NewGoals0 = [TypeClassInfoGoal, BaseGoal],
+	list__append(SuperClassGoals, NewGoals0, NewGoals),
+	Info = poly_info(VarSet, VarTypes, TVarSet, TVarMap, 
+			TCVarMap, Proofs, PredName, ModuleInfo).
+
+%---------------------------------------------------------------------------%
+
+:- pred polymorphism__get_arg_superclass_vars(hlds_class_defn, list(type),
+	map(class_constraint, constraint_proof), list(var), list(hlds_goal),
+	poly_info, poly_info).
+:- mode polymorphism__get_arg_superclass_vars(in, in, in, out, out, 
+	in, out) is det.
+
+polymorphism__get_arg_superclass_vars(ClassDefn, InstanceTypes, 
+		SuperClassProofs, NewVars, NewGoals, Info0, Info) :-
+
+	Info0 = poly_info(VarSet0, VarTypes0, TVarSet, TVarMap0, TCVarMap0, 
+			Proofs, PredName, ModuleInfo),
+
+	ClassDefn = hlds_class_defn(SuperClasses, ClassVars, _, ClassVarSet),
+
+	map__from_corresponding_lists(ClassVars, InstanceTypes, TypeSubst),
+	varset__merge_subst(VarSet0, ClassVarSet, VarSet1, Subst),
+
+		% XXX I think the SuperClassProofs need to have the 
+		% substitutions applied since the code that uses them 
+		% assumes that this has already been done. (?)
+
+	Info1 = poly_info(VarSet1, VarTypes0, TVarSet, TVarMap0, TCVarMap0, 
+			SuperClassProofs, PredName, ModuleInfo),
+
+	polymorphism__make_superclasses_from_proofs(SuperClasses, Subst,
+		TypeSubst, [], NewGoals, Info1, Info2, [], NewVars),
+
+	Info2 = poly_info(VarSet, VarTypes, _, TVarMap, TCVarMap, _, _, _),
+
+	Info = poly_info(VarSet, VarTypes, TVarSet, TVarMap, TCVarMap, 
+			Proofs, PredName, ModuleInfo) .  
+
+
+:- pred polymorphism__make_superclasses_from_proofs(list(class_constraint), 
+	substitution, tsubst, list(hlds_goal), list(hlds_goal), 
+	poly_info, poly_info, list(var), list(var)).
+:- mode polymorphism__make_superclasses_from_proofs(in, in, in, in, out, 
+	in, out, in, out) is det.
+
+polymorphism__make_superclasses_from_proofs([], _, _, 
+		Goals, Goals, Info, Info, Vars, Vars).
+polymorphism__make_superclasses_from_proofs([C|Cs], Subst, TypeSubst, 
+		Goals0, Goals, Info0, Info, Vars0, [Var|Vars]) :-
+	polymorphism__make_superclasses_from_proofs(Cs, Subst, TypeSubst,
+		Goals0, Goals1, Info0, Info1, Vars0, Vars),
+	polymorphism__make_typeclass_info_var(C, Subst, TypeSubst,
+		Goals1, Goals, [], _, Info1, Info, Var).
 
 %---------------------------------------------------------------------------%
 
 % Given a list of types, create a list of variables to hold the type_info
 % for those types, and create a list of goals to initialize those type_info
 % variables to the appropriate type_info structures for the types.
-% Update the varset and vartypes accordingly.
 
-:- pred polymorphism__make_vars(list(type), module_info, map(tvar, var),
-	varset, map(var, type), list(var), map(tvar, var), list(hlds_goal),
-	varset, map(var, type)).
-:- mode polymorphism__make_vars(in, in, in, in, in, out, out, out, out, 
-	out) is det.
-
-polymorphism__make_vars([], _, TypeInfoMap, VarSet, VarTypes, [], TypeInfoMap,
-		[], VarSet, VarTypes).
-polymorphism__make_vars([Type | Types], ModuleInfo, TypeInfoMap0,
-		VarSet0, VarTypes0, ExtraVars, TypeInfoMap, ExtraGoals, 
-		VarSet, VarTypes) :-
-	polymorphism__make_var(Type, ModuleInfo, TypeInfoMap0,
-		VarSet0, VarTypes0, Var, TypeInfoMap1, ExtraGoals1, VarSet1,
-		VarTypes1),
-	polymorphism__make_vars(Types, ModuleInfo, TypeInfoMap1,
-		VarSet1, VarTypes1, ExtraVars2, TypeInfoMap, ExtraGoals2, 
-		VarSet, VarTypes),
+:- pred polymorphism__make_type_info_vars(list(type),
+	list(var), list(hlds_goal), poly_info, poly_info).
+:- mode polymorphism__make_type_info_vars(in, out, out, in, out) is det.
+
+polymorphism__make_type_info_vars([], [], [], Info, Info).
+polymorphism__make_type_info_vars([Type | Types], 
+		ExtraVars, ExtraGoals, Info0, Info) :-
+	polymorphism__make_type_info_var(Type, 
+		Var, ExtraGoals1, Info0, Info1),
+	polymorphism__make_type_info_vars(Types, 
+		ExtraVars2, ExtraGoals2, Info1, Info),
 	ExtraVars = [Var | ExtraVars2],
 	list__append(ExtraGoals1, ExtraGoals2, ExtraGoals).
 
-:- pred polymorphism__make_var(type, module_info, map(tvar, var), 
-	varset, map(var, type), var, map(tvar, var), list(hlds_goal),
-	varset, map(var, type)).
-:- mode polymorphism__make_var(in, in, in, in, in, out, out, out, out, out) 
-	is det.
+:- pred polymorphism__make_type_info_var(type, var, list(hlds_goal), 
+	poly_info, poly_info).
+:- mode polymorphism__make_type_info_var(in, out, out, in, out) is det.
 
-polymorphism__make_var(Type, ModuleInfo, TypeInfoMap0, VarSet0, VarTypes0, 
-		Var, TypeInfoMap, ExtraGoals, VarSet, VarTypes) :-
+polymorphism__make_type_info_var(Type, Var, ExtraGoals, Info0, Info) :-
 	(
 		type_is_higher_order(Type, PredOrFunc, TypeArgs)
 	->
@@ -754,11 +1439,11 @@
 		% To allow univ_to_type to check the type_infos
 		% correctly, the actual arity of the pred is added to
 		% the type_info of higher-order types.
+		% XXX fix this when contexts are added to higher order types
 		hlds_out__pred_or_func_to_str(PredOrFunc, PredOrFuncStr),
 		TypeId = unqualified(PredOrFuncStr) - 0,
 		polymorphism__construct_type_info(Type, TypeId, TypeArgs,
-			yes, ModuleInfo, TypeInfoMap0, VarSet0, VarTypes0,
-			Var, TypeInfoMap, ExtraGoals, VarSet, VarTypes)
+			yes, Var, ExtraGoals, Info0, Info)
 	;
 		type_to_type_id(Type, TypeId, TypeArgs)
 	->
@@ -768,11 +1453,11 @@
 		% at the top of the module.
 
 		polymorphism__construct_type_info(Type, TypeId, TypeArgs,
-			no, ModuleInfo, TypeInfoMap0, VarSet0, VarTypes0,
-			Var, TypeInfoMap, ExtraGoals, VarSet, VarTypes)
+			no, Var, ExtraGoals, Info0, Info)
 	;
 		Type = term__variable(TypeVar1),
-		map__search(TypeInfoMap0, TypeVar1, TypeInfoVar)
+		Info0 = poly_info(_, _, _, TypeInfoMap0, _, _, _, _),
+		map__search(TypeInfoMap0, TypeVar1, TypeInfoLocn)
 	->
 		% This occurs for code where a predicate calls a polymorphic
 		% predicate with a bound but unknown value of the type variable.
@@ -790,11 +1475,20 @@
 		%
 		%	p(TypeInfo, X) :- q(TypeInfo, X).
 
-		Var = TypeInfoVar,
-		ExtraGoals = [],
-		VarSet = VarSet0,
-		VarTypes = VarTypes0,
-		TypeInfoMap = TypeInfoMap0
+		(
+				% If the typeinfo is available in a variable,
+				% just use it
+			TypeInfoLocn = type_info(TypeInfoVar),
+			Var = TypeInfoVar,
+			ExtraGoals = [],
+			Info = Info0
+		;
+				% If the typeinfo is in a typeclass_info, first
+				% extract it, then use it
+			TypeInfoLocn = typeclass_info(TypeClassInfoVar, Index),
+			extract_type_info(Type, TypeVar1, TypeClassInfoVar,
+				Index, ExtraGoals, Var, Info0, Info)
+		)
 	;
 		Type = term__variable(TypeVar1)
 	->
@@ -829,27 +1523,28 @@
 		% variable to zero
 		TypeId = unqualified("void") - 0,
 		polymorphism__construct_type_info(Type, TypeId, [],
-			no, ModuleInfo, TypeInfoMap0, VarSet0, VarTypes0,
-			Var, TypeInfoMap1, ExtraGoals, VarSet, VarTypes),
-		map__det_insert(TypeInfoMap1, TypeVar1, Var, TypeInfoMap)
+			no, Var, ExtraGoals, Info0, Info1),
+		Info1 = poly_info(A, B, C, TypeInfoMap1, E, F, G, H),
+		map__det_insert(TypeInfoMap1, TypeVar1, type_info(Var),
+			TypeInfoMap),
+		Info = poly_info(A, B, C, TypeInfoMap, E, F, G, H)
 	;
 		error("polymorphism__make_var: unknown type")
 	).
 
 :- pred polymorphism__construct_type_info(type, type_id, list(type),
-	bool, module_info, map(tvar, var), varset, map(var, type),
-	var, map(tvar, var), list(hlds_goal), varset, map(var, type)).
-:- mode polymorphism__construct_type_info(in, in, in, in, in, in, in, in,
-	out, out, out, out, out) is det.
+	bool, var, list(hlds_goal), poly_info, poly_info).
+:- mode polymorphism__construct_type_info(in, in, in, in, out, out, 
+	in, out) is det.
 
 polymorphism__construct_type_info(Type, TypeId, TypeArgs, IsHigherOrder, 
-		ModuleInfo, TypeInfoMap0, VarSet0, VarTypes0,
-		Var, TypeInfoMap, ExtraGoals, VarSet, VarTypes) :-
+		Var, ExtraGoals, Info0, Info) :-
 
 	% Create the typeinfo vars for the arguments
-	polymorphism__make_vars(TypeArgs, ModuleInfo, TypeInfoMap0,
-		VarSet0, VarTypes0, ArgTypeInfoVars, TypeInfoMap, 
-		ArgTypeInfoGoals, VarSet1, VarTypes1),
+	polymorphism__make_type_info_vars(TypeArgs, ArgTypeInfoVars, 
+		ArgTypeInfoGoals, Info0, Info1),
+
+	Info1 = poly_info(VarSet1, VarTypes1, C, D, E, F, G, ModuleInfo),
 
 	module_info_globals(ModuleInfo, Globals),
 	globals__get_type_info_method(Globals, TypeInfoMethod),
@@ -863,7 +1558,9 @@
 			ArgTypeInfoGoals, Type, IsHigherOrder,
 			BaseVar, VarSet2, VarTypes2, [BaseGoal],
 			Var, VarSet, VarTypes, ExtraGoals)
-	).
+	),
+
+	Info = poly_info(VarSet, VarTypes, C, D, E, F, G, ModuleInfo).
 
 		% Create a unification for the two-cell type_info
 		% variable for this type if the type arity is not zero:
@@ -1201,6 +1898,8 @@
 
 	BaseTypeInfoGoal = Unify - GoalInfo.
 
+%---------------------------------------------------------------------------%
+
 :- pred polymorphism__make_head_vars(list(tvar), tvarset,
 				varset, map(var, type),
 				list(var), varset, map(var, type)).
@@ -1240,18 +1939,336 @@
 					[Type], UnifyPredType),
 	map__set(VarTypes0, Var, UnifyPredType, VarTypes).
 
+%---------------------------------------------------------------------------%
+
+:- pred extract_type_info(type, tvar, var, int, list(hlds_goal),
+	var, poly_info, poly_info).
+:- mode extract_type_info(in, in, in, in, out, out, in, out) is det.
+
+extract_type_info(Type, TypeVar, TypeClassInfoVar, Index, Goals,
+		TypeInfoVar, PolyInfo0, PolyInfo) :-
+	PolyInfo0 = poly_info(VarSet0, VarTypes0, C, TypeInfoLocns0, 
+		E, F, G, ModuleInfo),
+	extract_type_info_2(Type, TypeVar, TypeClassInfoVar, Index, ModuleInfo,
+		Goals, TypeInfoVar, VarSet0, VarTypes0, TypeInfoLocns0,
+		VarSet, VarTypes, TypeInfoLocns),
+	PolyInfo = poly_info(VarSet, VarTypes, C, TypeInfoLocns, E, F, G, 
+			ModuleInfo).
+
+:- pred extract_type_info_2(type, tvar, var, int, module_info, list(hlds_goal),
+	var, varset, map(var, type), map(tvar, type_info_locn),
+	varset, map(var, type), map(tvar, type_info_locn)).
+:- mode extract_type_info_2(in, in, in, in, in, out, out, in, in, in, out, out,
+	out) is det.
+
+extract_type_info_2(Type, _TypeVar, TypeClassInfoVar, Index, ModuleInfo, Goals,
+		TypeInfoVar, VarSet0, VarTypes0, TypeInfoLocns0,
+		VarSet, VarTypes, TypeInfoLocns) :-
+
+		% We need a dummy tvarset to pass to get_pred_id_and_proc_id
+	varset__init(TVarSet0),
+	varset__new_var(TVarSet0, Dummy, TVarSet),
+
+	term__context_init(EmptyContext),
+	ExtractTypeInfo = qualified("mercury_builtin",
+				"type_info_from_typeclass_info"),
+	TypeClassInfoTerm = term__functor(term__atom("typeclass_info"), [],
+		EmptyContext),
+	IntTerm = term__functor(term__atom("int"), [], EmptyContext),
+	TypeInfoTerm = term__functor(term__atom("type_info"), 
+		[term__variable(Dummy)], EmptyContext),
+
+		% We have to put an extra type_info at the front, and pass it a
+		% bogus value because this pred has a type parameter... even
+		% though we are actually _extracting_ the type_info.
+		% Existential types would fix this.
+	get_pred_id_and_proc_id(ExtractTypeInfo, predicate, TVarSet, 
+		[TypeClassInfoTerm, IntTerm, TypeInfoTerm],
+		ModuleInfo, PredId, ProcId),
+	polymorphism__make_count_var(Index, VarSet0, VarTypes0, IndexVar,
+		IndexGoal, VarSet1, VarTypes1),
+
+	polymorphism__new_type_info_var(Type, "type_info", VarSet1, VarTypes1,
+		TypeInfoVar, VarSet2, VarTypes2),
+	polymorphism__new_type_info_var(Type, "type_info", VarSet2, VarTypes2,
+		DummyTypeInfoVar, VarSet, VarTypes),
+
+		% Now we put a dummy value in the dummy type-info variable.
+	polymorphism__init_with_int_constant(DummyTypeInfoVar, 0,
+		DummyTypeInfoGoal),
+
+		% Make the goal info for the call
+	set__list_to_set([DummyTypeInfoVar, TypeClassInfoVar, IndexVar,
+		TypeInfoVar], NonLocals),
+	instmap_delta_from_assoc_list([TypeInfoVar - ground(shared, no)],
+		InstmapDelta),
+	goal_info_init(NonLocals, InstmapDelta, det, GoalInfo),
+
+	Call = call(PredId, ProcId, 
+		[DummyTypeInfoVar, TypeClassInfoVar, IndexVar, TypeInfoVar],
+		not_builtin, no, ExtractTypeInfo) - GoalInfo,
+
+	Goals = [IndexGoal, DummyTypeInfoGoal, Call],
+
+	/* We should do this, except that makes us incorrectly compute the
+	 * non-locals for the goal, since it appears to fixup_quantification
+	 * that the type-info is non-local, but the typeclass-info is not.
+		% Update the location of the type_info so that we don't go to
+		% the bother of re-extracting it.
+	map__det_update(TypeInfoLocns0, TypeVar, type_info(TypeInfoVar),
+		TypeInfoLocns).
+	*/
+	TypeInfoLocns = TypeInfoLocns0.
+
+%---------------------------------------------------------------------------%
+
+	% Add a head var for each class constraint, and make an entry in the
+	% typeinfo locations map for each constrained type var.
+:- pred polymorphism__make_typeclass_info_head_vars(list(class_constraint),
+	module_info, varset, map(var, type), list(var), 
+	map(var, type_info_locn), list(var), varset, map(var, type)).
+:- mode polymorphism__make_typeclass_info_head_vars(in, in, in, in, 
+	out, out, out, out, out) is det.
+
+polymorphism__make_typeclass_info_head_vars(ClassContext, ModuleInfo, VarSet0, 
+		VarTypes0, ExtraHeadVars, TypeClassInfoMap, ConstrainedTVars,
+		VarSet, VarTypes) :-
+
+		% initialise the new accumulators
+	ExtraHeadVars0 = [],
+	map__init(TypeClassInfoMap0),
+
+		% do the work
+	polymorphism__make_typeclass_info_head_vars_2(ClassContext, ModuleInfo,
+		VarSet0, VarSet, 
+		VarTypes0, VarTypes, 
+		ExtraHeadVars0, ExtraHeadVars1,
+		TypeClassInfoMap0, TypeClassInfoMap),
+
+		% A type var has a location in a typeclass info iff it is
+		% constrained
+	map__keys(TypeClassInfoMap, ConstrainedTVars),
+
+		% The ExtraHeadVars are built up in reverse
+	list__reverse(ExtraHeadVars1, ExtraHeadVars).
+
+:- pred polymorphism__make_typeclass_info_head_vars_2(list(class_constraint),
+		module_info, varset, varset, 
+		map(var, type), map(var, type),
+		list(var), list(var),
+		map(var, type_info_locn), map(var, type_info_locn)).
+:- mode polymorphism__make_typeclass_info_head_vars_2(in, in, in, out, in, out, 
+		in, out, in, out) is det.
+
+polymorphism__make_typeclass_info_head_vars_2([], _,
+		VarSet, VarSet, 
+		VarTypes, VarTypes, 
+		ExtraHeadVars, ExtraHeadVars,
+		TypeInfoLocations, TypeInfoLocations).
+polymorphism__make_typeclass_info_head_vars_2([C|Cs], ModuleInfo,
+		VarSet0, VarSet, 
+		VarTypes0, VarTypes, 
+		ExtraHeadVars0, ExtraHeadVars,
+		TypeClassInfoMap0, TypeClassInfoMap) :-
+
+	C = constraint(ClassName0, ClassTypes),
+
+		% Work out how many superclass the class has
+	list__length(ClassTypes, ClassArity),
+	ClassId = class_id(ClassName0, ClassArity),
+	module_info_classes(ModuleInfo, ClassTable),
+	map__lookup(ClassTable, ClassId, ClassDefn),
+	ClassDefn = hlds_class_defn(SuperClasses, _, _, _),
+	list__length(SuperClasses, NumSuperClasses),
+
+	unqualify_name(ClassName0, ClassName),
+
+		% Make a new variable to contain the dictionary for this
+		% typeclass constraint
+	polymorphism__new_typeclass_info_var(VarSet0, VarTypes0, ClassName,
+		Var, VarSet1, VarTypes1),
+	ExtraHeadVars1 = [Var | ExtraHeadVars0],
+
+		% Find all the type variables in the constraint, and remember
+		% what index they appear in in the typeclass info.
+
+		% The first type_info will be just after the superclass infos
+	First is NumSuperClasses + 1,
+	term__vars_list(ClassTypes, ClassTypeVars0),
+	MakeIndex = lambda([Elem0::in, Elem::out, 
+				Index0::in, Index::out] is det,
+		(
+			Elem = Elem0 - Index0,
+			Index is Index0 + 1
+		)),
+	list__map_foldl(MakeIndex, ClassTypeVars0, ClassTypeVars, First, _),
+		
+
+		% Work out which ones haven't been seen before
+	IsNew = lambda([TypeVar0::in] is semidet,
+		(
+			TypeVar0 = TypeVar - _Index,
+			\+ map__search(TypeClassInfoMap0, TypeVar, _)
+		)),
+	list__filter(IsNew, ClassTypeVars, NewClassTypeVars),
+
+		% Make an entry in the TypeInfo locations map for each new
+		% type variable. The type variable can be found at the
+		% previously calculated offset with the new typeclass_info
+	MakeEntry = lambda([IndexedTypeVar::in, 
+				LocnMap0::in, LocnMap::out] is det,
+		(
+			IndexedTypeVar = TheTypeVar - Location,
+			map__det_insert(LocnMap0, TheTypeVar,
+				typeclass_info(Var, Location), LocnMap)
+		)),
+	list__foldl(MakeEntry, NewClassTypeVars, 
+		TypeClassInfoMap0, TypeClassInfoMap1),
+
+		% Handle the rest of the constraints
+	polymorphism__make_typeclass_info_head_vars_2(Cs, ModuleInfo,
+		VarSet1, VarSet,
+		VarTypes1, VarTypes,
+		ExtraHeadVars1, ExtraHeadVars,
+		TypeClassInfoMap1, TypeClassInfoMap).
+
+:- pred polymorphism__new_typeclass_info_var(varset, map(var, type), 
+		string, var, 
+		varset, map(var, type)).
+:- mode polymorphism__new_typeclass_info_var(in, in, in, out, out, out) is det.
+
+polymorphism__new_typeclass_info_var(VarSet0, VarTypes0, ClassName, 
+		Var, VarSet, VarTypes) :-
+	% introduce new variable
+	varset__new_var(VarSet0, Var, VarSet1),
+	string__append("TypeClassInfo_for_", ClassName, Name),
+	varset__name_var(VarSet1, Var, Name, VarSet),
+
+	construct_type(qualified("mercury_builtin", "typeclass_info") - 0,
+					[], DictionaryType),
+	map__set(VarTypes0, Var, DictionaryType, VarTypes).
+
+%---------------------------------------------------------------------------%
+
+:- pred polymorphism__expand_class_method_bodies(module_info, module_info).
+:- mode polymorphism__expand_class_method_bodies(in, out) is det.
+
+polymorphism__expand_class_method_bodies(ModuleInfo0, ModuleInfo) :-
+	module_info_classes(ModuleInfo0, Classes),
+	module_info_name(ModuleInfo0, Name),
+	map__keys(Classes, ClassIds0),
+
+		% Don't expand classes from other modules
+	FromThisModule = lambda([ClassId::in] is semidet,
+		(
+			ClassId = class_id(qualified(Name, _), _)
+		)),
+	list__filter(FromThisModule, ClassIds0, ClassIds),
+
+	map__apply_to_list(ClassIds, Classes, ClassDefns),
+	list__foldl(expand_bodies, ClassDefns, ModuleInfo0, ModuleInfo).
+
+:- pred expand_bodies(hlds_class_defn, module_info, module_info).
+:- mode expand_bodies(in, in, out) is det.
+
+expand_bodies(hlds_class_defn(_, _, Interface, _), ModuleInfo0, ModuleInfo) :-
+	list__foldl2(expand_one_body, Interface, 1, _, ModuleInfo0, ModuleInfo).
+
+:- pred expand_one_body(hlds_class_proc, int, int, module_info, module_info).
+:- mode expand_one_body(in, in, out, in, out) is det.
+
+expand_one_body(hlds_class_proc(PredId, ProcId), ProcNum0, ProcNum, 
+		ModuleInfo0, ModuleInfo) :-
+	module_info_preds(ModuleInfo0, PredTable0),
+	map__lookup(PredTable0, PredId, PredInfo0),
+	pred_info_procedures(PredInfo0, ProcTable0),
+	map__lookup(ProcTable0, ProcId, ProcInfo0),
+
+	pred_info_get_class_context(PredInfo0, ClassContext),
+	(
+		ClassContext = [Head|_]
+	->
+		InstanceDictContext = Head
+	;
+		error("expand_one_body: class method is not constrained")
+	),
+
+	proc_info_typeclass_info_varmap(ProcInfo0, VarMap),
+	map__lookup(VarMap, InstanceDictContext, TypeClassInfoVar),
+
+	%proc_info_variables(ProcInfo0, VarSet0),
+	%proc_info_vartypes(ProcInfo0, VarTypes0),
+
+	proc_info_headvars(ProcInfo0, HeadVars0),
+	proc_info_vartypes(ProcInfo0, Types0),
+	proc_info_argmodes(ProcInfo0, Modes0),
+	proc_info_declared_determinism(ProcInfo0, Detism0),
+	(
+		Detism0 = yes(Detism1)
+	->
+		Detism = Detism1
+	;
+		error("missing determinism decl. How did we get this far?")
+	),
+
+	(
+		list__nth_member_search(HeadVars0, TypeClassInfoVar, N),
+		delete_nth(HeadVars0, N, HeadVars1),
+		delete_nth(Modes0, N, Modes1)
+	->
+		HeadVars = HeadVars1,
+		map__apply_to_list(HeadVars1, Types0, Types),
+		Modes = Modes1
+	;
+		error("expand_one_body: typeclass_info var not found")
+	),
+
+	BodyGoalExpr = class_method_call(TypeClassInfoVar, ProcNum0,
+		HeadVars, Types, Modes, Detism),
+
+		% Make the goal info for the call. Maybe we should re modecheck
+		% the whole thing?
+	set__list_to_set(HeadVars0, NonLocals),
+	instmap_delta_from_mode_list(HeadVars0, Modes0, ModuleInfo0,
+			InstmapDelta),
+	goal_info_init(NonLocals, InstmapDelta, Detism, GoalInfo),
+	BodyGoal = BodyGoalExpr - GoalInfo,
+
+	proc_info_set_goal(ProcInfo0, BodyGoal, ProcInfo),
+	map__det_update(ProcTable0, ProcId, ProcInfo, ProcTable),
+	pred_info_set_procedures(PredInfo0, ProcTable, PredInfo),
+	map__det_update(PredTable0, PredId, PredInfo, PredTable),
+	module_info_set_preds(ModuleInfo0, PredTable, ModuleInfo),
+
+	ProcNum is ProcNum0 + 1.
+	
+:- pred delete_nth(list(T)::in, int::in, list(T)::out) is semidet.
+
+delete_nth([X|Xs], N0, Result) :-
+	(
+		N0 > 1
+	->
+		N is N0 - 1,
+		delete_nth(Xs, N, TheRest),
+		Result = [X|TheRest]
+	;
+		Result = Xs
+	).
+
+%---------------------------------------------------------------------------%
+
 :- pred polymorphism__get_module_info(module_info, poly_info, poly_info).
 :- mode polymorphism__get_module_info(out, in, out) is det.
 
 polymorphism__get_module_info(ModuleInfo, PolyInfo, PolyInfo) :-
-	PolyInfo = poly_info(_, _, _, _, _, ModuleInfo).
+	PolyInfo = poly_info(_, _, _, _, _, _, _, ModuleInfo).
 
 :- pred polymorphism__set_module_info(module_info, poly_info, poly_info).
 :- mode polymorphism__set_module_info(in, in, out) is det.
 
 polymorphism__set_module_info(ModuleInfo, PolyInfo0, PolyInfo) :-
-	PolyInfo0 = poly_info(A, B, C, D, E, _),
-	PolyInfo = poly_info(A, B, C, D, E, ModuleInfo).
+	PolyInfo0 = poly_info(A, B, C, D, E, F, G, _),
+	PolyInfo = poly_info(A, B, C, D, E, F, G, ModuleInfo).
 
 %---------------------------------------------------------------------------%
 %---------------------------------------------------------------------------%
Index: compiler/prog_data.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/prog_data.m,v
retrieving revision 1.26
diff -u -r1.26 prog_data.m
--- prog_data.m	1997/10/09 09:39:05	1.26
+++ prog_data.m	1997/10/17 05:27:20
@@ -52,11 +52,13 @@
 	; 	module_defn(varset, module_defn)
 
 	; 	pred(varset, sym_name, list(type_and_mode),
-			maybe(determinism), condition)
+			maybe(determinism), condition,
+			list(class_constraint))
 		%     VarNames, PredName, ArgTypes, Deterministicness, Cond
 
 	; 	func(varset, sym_name, list(type_and_mode), type_and_mode,
-			maybe(determinism), condition)
+			maybe(determinism), condition,
+			list(class_constraint))
 		%       VarNames, PredName, ArgTypes, ReturnType,
 		%       Deterministicness, Cond
 
@@ -72,6 +74,16 @@
 
 	;	pragma(pragma_type)
 
+	;	typeclass(list(class_constraint), classname, list(var),
+			class_interface, varset)
+		%	Constraints, ClassName, ClassParams, 
+		%	ClassMethods, VarNames
+
+	;	instance(list(class_constraint), classname, list(type),
+			instance_interface, varset)
+		%	DerivingClass, ClassName, Types, 
+		%	MethodInstances, VarNames
+
 	;	nothing.
 		% used for items that should be ignored (currently only
 		% NU-Prolog `when' declarations, which are silently ignored
@@ -151,6 +163,51 @@
 
 	;	check_termination(sym_name, arity).
 			% Predname, Arity
+
+:- type class_constraint	---> constraint(classname, list(type)).
+
+:- type classname == sym_name.
+
+:- type class_interface  == list(class_method).	
+
+:- type class_method	--->	pred(varset, sym_name, list(type_and_mode),
+					maybe(determinism), condition,
+					list(class_constraint), term__context)
+				%       VarNames, PredName, ArgTypes,
+				%	Determinism, Cond
+				%	ClassContext, Context
+
+			; 	func(varset, sym_name, list(type_and_mode),
+					type_and_mode,
+					maybe(determinism), condition,
+					list(class_constraint), term__context)
+				%       VarNames, PredName, ArgTypes,
+				%	ReturnType,
+				%	Determinism, Cond
+				%	ClassContext, Context
+
+			; 	pred_mode(varset, sym_name, list(mode),
+					maybe(determinism), condition,
+					term__context)
+				%       VarNames, PredName, ArgModes,
+				%	Determinism, Cond
+				%	Context
+
+			; 	func_mode(varset, sym_name, list(mode), mode,
+					maybe(determinism), condition,
+					term__context)
+				%       VarNames, PredName, ArgModes,
+				%	ReturnValueMode,
+				%	Determinism, Cond
+				%	Context
+			.
+
+:- type instance_method	--->	func_instance(sym_name, sym_name, arity)
+			;	pred_instance(sym_name, sym_name, arity)
+				% Method, Instance, Arity
+			.
+
+:- type instance_interface ==	list(instance_method).
 
 	% For pragma c_code, there are two different calling conventions,
 	% one for C code that may recursively call Mercury code, and another
Index: compiler/prog_io.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/prog_io.m,v
retrieving revision 1.165
diff -u -r1.165 prog_io.m
--- prog_io.m	1997/11/02 12:29:13	1.165
+++ prog_io.m	1997/11/17 07:06:58
@@ -56,7 +56,7 @@
 :- interface.
 
 :- import_module prog_data.
-:- import_module list, io.
+:- import_module list, io, prog_io_util.
 
 %-----------------------------------------------------------------------------%
 
@@ -93,12 +93,21 @@
 :- pred search_for_file(list(string), string, bool, io__state, io__state).
 :- mode search_for_file(in, in, out, di, uo) is det.
 
+	% parse_item(ModuleName, VarSet, Term, MaybeItem)
+	%
+	% parse Term. If successful, MaybeItem is bound to the parsed item,
+	% otherwise it is bound to an appropriate error message.
+	% Qualify appropriate parts to come from ModuleName
+:- pred parse_item(string, varset, term, maybe_item_and_context). 
+:- mode parse_item(in, in, in, out) is det.
+
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
 :- implementation.
 
 :- import_module prog_io_goal, prog_io_dcg, prog_io_pragma, prog_io_util.
+:- import_module prog_io_typeclass.
 :- import_module hlds_data, hlds_pred, prog_util, globals, options, (inst).
 :- import_module bool, int, string, std_util, parser, term_io, dir, require.
 :- import_module varset, term.
@@ -414,9 +423,6 @@
 convert_item(ok(Item, Context), ok(Item, Context)).
 convert_item(error(M, T), error(M, T)).
 
-:- pred parse_item(string, varset, term, maybe_item_and_context). 
-:- mode parse_item(in, in, in, out) is det.
-
 parse_item(ModuleName, VarSet, Term, Result) :-
  	( %%% some [Decl, DeclContext]
 		Term = term__functor(term__atom(":-"), [Decl], DeclContext)
@@ -661,6 +667,12 @@
 process_decl(ModuleName, VarSet, "pragma", Pragma, Result):-
 	parse_pragma(ModuleName, VarSet, Pragma, Result).
 
+process_decl(ModuleName, VarSet, "typeclass", Args, Result):-
+	parse_typeclass(ModuleName, VarSet, Args, Result).
+
+process_decl(ModuleName, VarSet, "instance", Args, Result):-
+	parse_instance(ModuleName, VarSet, Args, Result).
+
 :- pred parse_type_decl(string, varset, term, maybe1(item)).
 :- mode parse_type_decl(in, in, in, out) is det.
 parse_type_decl(ModuleName, VarSet, TypeDecl, Result) :-
@@ -1082,22 +1094,42 @@
 			maybe1(item)).
 :- mode process_pred(in, in, in, in, in, out) is det.
 
-process_pred(ModuleName, VarSet, PredType, Cond, MaybeDet, Result) :-
-	parse_qualified_term(ModuleName, PredType, PredType,
-		"`:- pred' declaration", R),
-	process_pred_2(R, PredType, VarSet, MaybeDet, Cond, Result).
+process_pred(ModuleName, VarSet, PredType0, Cond, MaybeDet, Result) :-
+	(
+		maybe_get_class_context(ModuleName, PredType0, PredType,
+			MaybeContext)
+	->
+		(
+			MaybeContext = ok(Constraints),
+			parse_qualified_term(ModuleName, PredType, PredType,
+				"`:- pred' declaration", R),
+			process_pred_2(R, PredType, VarSet, MaybeDet, Cond,
+				Constraints, Result)
+		;
+			MaybeContext = error(String, Term),
+			Result = error(String, Term)
+		)
+	;
+		parse_qualified_term(ModuleName, PredType0, PredType0,
+			"`:- pred' declaration", R),
+		process_pred_2(R, PredType0, VarSet, MaybeDet, Cond, [],
+			Result)
+	).
 
 :- pred process_pred_2(maybe_functor, term, varset, maybe(determinism),
-			condition, maybe1(item)).
-:- mode process_pred_2(in, in, in, in, in, out) is det.
-process_pred_2(ok(F, As0), PredType, VarSet, MaybeDet, Cond, Result) :-
+			condition, list(class_constraint), maybe1(item)).
+:- mode process_pred_2(in, in, in, in, in, in, out) is det.
+
+process_pred_2(ok(F, As0), PredType, VarSet, MaybeDet, Cond, ClassContext,
+		Result) :-
 	(
 		convert_type_and_mode_list(As0, As)
 	->
 		(
 			verify_type_and_mode_list(As)
 		->
-			Result = ok(pred(VarSet, F, As, MaybeDet, Cond))
+			Result = ok(pred(VarSet, F, As, MaybeDet, Cond,
+				ClassContext))
 		;
 			Result = error("some but not all arguments have modes", PredType)
 		)
@@ -1105,7 +1137,24 @@
 		Result = error("syntax error in `:- pred' declaration",
 				PredType)
 	).
-process_pred_2(error(M, T), _, _, _, _, error(M, T)).
+process_pred_2(error(M, T), _, _, _, _, _, error(M, T)).
+
+%-----------------------------------------------------------------------------%
+	% We could probably get rid of some code duplication between here and
+	% prog_io_typeclass.m
+	% The last argument is `no' if no context was given, and yes(Result) if
+	% there was. Result is either bound to the correctly parsed context, or
+	% an appropriate error message (if a syntactically invalid error 
+	% message was given.
+
+:- pred maybe_get_class_context(string, term, term,
+	maybe1(list(class_constraint))).
+:- mode maybe_get_class_context(in, in, out, out) is semidet.
+
+maybe_get_class_context(ModuleName, PredType0, PredType, MaybeContext) :-
+	PredType0 = term__functor(term__atom("<="), 
+		[PredType, Constraints], _),
+	parse_class_constraints(ModuleName, Constraints, MaybeContext).
 
 %-----------------------------------------------------------------------------%
 
@@ -1141,7 +1190,30 @@
 			maybe1(item)).
 :- mode process_func(in, in, in, in, in, out) is det.
 
-process_func(ModuleName, VarSet, Term, Cond, MaybeDet, Result) :-
+process_func(ModuleName, VarSet, Term0, Cond, MaybeDet, Result) :-
+	(
+		maybe_get_class_context(ModuleName, Term0, Term,
+			MaybeContext)
+	->
+		(
+			MaybeContext = ok(Constraints),
+			process_unconstrained_func(ModuleName, VarSet, Term,
+				Cond, MaybeDet, Constraints, Result) 
+		;
+			MaybeContext = error(String, ErrorTerm),
+			Result = error(String, ErrorTerm)
+		)
+	;
+		process_unconstrained_func(ModuleName, VarSet, Term0, 
+			Cond, MaybeDet, [], Result) 
+	).
+
+:- pred process_unconstrained_func(string, varset, term, condition,
+	maybe(determinism), list(class_constraint), maybe1(item)).
+:- mode process_unconstrained_func(in, in, in, in, in, in, out) is det.
+
+process_unconstrained_func(ModuleName, VarSet, Term, Cond, MaybeDet, 
+		Constraints, Result) :-
 	(
 		Term = term__functor(term__atom("="),
 				[FuncTerm, ReturnTypeTerm], _Context)
@@ -1149,16 +1221,18 @@
 		parse_qualified_term(ModuleName, FuncTerm, Term,
 			"`:- func' declaration", R),
 		process_func_2(R, FuncTerm, ReturnTypeTerm, VarSet, MaybeDet,
-				Cond, Result)
+				Cond, Constraints, Result)
 	;
 		Result = error("`=' expected in `:- func' declaration", Term)
 	).
 
+
 :- pred process_func_2(maybe_functor, term, term, varset, maybe(determinism),
-			condition, maybe1(item)).
-:- mode process_func_2(in, in, in, in, in, in, out) is det.
+			condition, list(class_constraint), maybe1(item)).
+:- mode process_func_2(in, in, in, in, in, in, in, out) is det.
+
 process_func_2(ok(F, As0), FuncTerm, ReturnTypeTerm, VarSet, MaybeDet, Cond,
-		Result) :-
+		ClassContext, Result) :-
 	( convert_type_and_mode_list(As0, As) ->
 		( \+ verify_type_and_mode_list(As) ->
 			Result = error("some but not all arguments have modes",
@@ -1187,7 +1261,7 @@
 					FuncTerm)
 			;
 				Result = ok(func(VarSet, F, As, ReturnType,
-					MaybeDet, Cond))
+					MaybeDet, Cond, ClassContext))
 			)
 		;
 			Result = error(
@@ -1199,7 +1273,7 @@
 			"syntax error in arguments of `:- func' declaration",
 					FuncTerm)
 	).
-process_func_2(error(M, T), _, _, _, _, _, error(M, T)).
+process_func_2(error(M, T), _, _, _, _, _, _, error(M, T)).
 
 %-----------------------------------------------------------------------------%
 
Index: compiler/prog_out.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/prog_out.m,v
retrieving revision 1.33
diff -u -r1.33 prog_out.m
--- prog_out.m	1997/07/27 15:16:38	1.33
+++ prog_out.m	1997/10/21 05:03:03
@@ -26,6 +26,10 @@
 :- pred prog_out__write_context(term__context, io__state, io__state).
 :- mode prog_out__write_context(in, di, uo) is det.
 
+:- pred prog_out__write_strings_with_context(term__context, list(string),
+	io__state, io__state).
+:- mode prog_out__write_strings_with_context(in, in, di, uo) is det.
+
 :- pred prog_out__write_sym_name(sym_name, io__state, io__state).
 :- mode prog_out__write_sym_name(in, di, uo) is det.
 
@@ -39,7 +43,7 @@
 %-----------------------------------------------------------------------------%
 
 :- implementation.
-:- import_module require, string, list, varset, std_util, term_io.
+:- import_module require, string, list, varset, std_util, term_io, int.
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
@@ -81,15 +85,62 @@
 	% error message.
 
 prog_out__write_context(Context) -->
+	prog_out__write_context_2(Context, _).
+
+:- pred prog_out__write_context_2(term__context, int, io__state, io__state).
+:- mode prog_out__write_context_2(in, out, di, uo) is det.
+
+prog_out__write_context_2(Context, Length) -->
 	{ term__context_file(Context, FileName) },
 	{ term__context_line(Context, LineNumber) },
 	( { FileName = "" } ->
-		[]
+		{ Length = 0 }
 	;
 		{ string__format("%s:%03d: ", [s(FileName), i(LineNumber)],
 			ContextMessage) }, 
-		io__write_string(ContextMessage)
+		io__write_string(ContextMessage),
+		{ string__length(ContextMessage, Length) }
 	).
+
+%-----------------------------------------------------------------------------%
+
+prog_out__write_strings_with_context(Context, Strings) -->
+	prog_out__write_strings_with_context_2(Context, Strings, 0).
+
+:- pred prog_out__write_strings_with_context_2(term__context, list(string), int,
+	io__state, io__state).
+:- mode prog_out__write_strings_with_context_2(in, in, in, di, uo) is det.
+
+prog_out__write_strings_with_context_2(_Context, [], _) --> [].
+prog_out__write_strings_with_context_2(Context, [S|Ss], N0) -->
+	{ string__length(S, MessageLength) },
+	(
+		{ N0 = 0 }
+	->
+		prog_out__write_context_2(Context, ContextLength),
+		io__write_string("  "),
+		io__write_string(S),
+		{ N is ContextLength + MessageLength },
+		{ Rest = Ss }
+	;
+		{ N1 is MessageLength + N0 },
+		{ num_columns(NumColumns) },
+		{ N1 < NumColumns }
+	->
+		io__write_string(S),
+		{ N = N1 },
+		{ Rest = Ss }
+	;
+		io__write_char('\n'),
+		{ N = 0 },
+		{ Rest = [S|Ss] }
+	),
+	prog_out__write_strings_with_context_2(Context, Rest, N).
+
+
+:- pred num_columns(int::out) is det.
+
+num_columns(80).
 
 %-----------------------------------------------------------------------------%
 
Index: compiler/quantification.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/quantification.m,v
retrieving revision 1.53
diff -u -r1.53 quantification.m
--- quantification.m	1997/09/01 14:04:33	1.53
+++ quantification.m	1997/09/08 05:19:36
@@ -297,6 +297,10 @@
 		higher_order_call(PredVar, ArgVars, C, D, E, F)) -->
 	implicitly_quantify_atomic_goal([PredVar|ArgVars]).
 
+implicitly_quantify_goal_2(class_method_call(TCVar, B, ArgVars, D, E, F), _,
+		class_method_call(TCVar, B, ArgVars, D, E, F)) -->
+	implicitly_quantify_atomic_goal([TCVar|ArgVars]).
+
 implicitly_quantify_goal_2(
 		unify(Var, UnifyRHS0, Mode, Unification0, UnifyContext),
 		Context,
@@ -589,6 +593,10 @@
 quantification__goal_vars_2(higher_order_call(PredVar, ArgVars, _, _, _, _),
 		Set0, LambdaSet, Set, LambdaSet) :-
 	set__insert_list(Set0, [PredVar | ArgVars], Set).
+
+quantification__goal_vars_2(class_method_call(TCVar, _, ArgVars, _, _, _),
+		Set0, LambdaSet, Set, LambdaSet) :-
+	set__insert_list(Set0, [TCVar | ArgVars], Set).
 
 quantification__goal_vars_2(call(_, _, ArgVars, _, _, _), Set0, LambdaSet,
 		Set, LambdaSet) :-
Index: compiler/saved_vars.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/saved_vars.m,v
retrieving revision 1.11
diff -u -r1.11 saved_vars.m
--- saved_vars.m	1997/09/01 14:04:35	1.11
+++ saved_vars.m	1997/10/21 05:03:55
@@ -110,6 +110,10 @@
 		Goal = GoalExpr0 - GoalInfo0,
 		SlotInfo = SlotInfo0
 	;
+		GoalExpr0 = class_method_call(_, _, _, _, _, _),
+		Goal = GoalExpr0 - GoalInfo0,
+		SlotInfo = SlotInfo0
+	;
 		GoalExpr0 = call(_, _, _, _, _, _),
 		Goal = GoalExpr0 - GoalInfo0,
 		SlotInfo = SlotInfo0
@@ -266,6 +270,15 @@
 			Goals = [NewConstruct, Goal1 | Goals1]
 		;
 			Goal0Expr = higher_order_call(_, _, _, _, _, _),
+			rename_var(SlotInfo0, Var, _NewVar, Subst, SlotInfo1),
+			goal_util__rename_vars_in_goal(Construct, Subst,
+				NewConstruct),
+			goal_util__rename_vars_in_goal(Goal0, Subst, Goal1),
+			saved_vars_delay_goal(Goals0, Construct, Var,
+				IsNonLocal, SlotInfo1, Goals1, SlotInfo),
+			Goals = [NewConstruct, Goal1 | Goals1]
+		;
+			Goal0Expr = class_method_call(_, _, _, _, _, _),
 			rename_var(SlotInfo0, Var, _NewVar, Subst, SlotInfo1),
 			goal_util__rename_vars_in_goal(Construct, Subst,
 				NewConstruct),
Index: compiler/simplify.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/simplify.m,v
retrieving revision 1.46
diff -u -r1.46 simplify.m
--- simplify.m	1997/09/01 14:04:39	1.46
+++ simplify.m	1997/10/21 05:59:38
@@ -420,6 +420,15 @@
 		Info = Info0
 	).
 
+	% XXX This is a little conservative, but will make no difference at
+	% this stage. We could eliminate duplicate class_method_calls, but
+	% since class_method_calls will only appear as the bodies of class
+	% methods, there will never be duplicates. If we start inlining the
+	% bodies of class methods (or other such optimisations), then adding
+	% the simplification code for class_method_calls may be worth it.
+simplify__goal_2(Goal, GoalInfo, Goal, GoalInfo, Info, Info) :-
+	Goal = class_method_call(_, _, _, _, _, _).
+
 simplify__goal_2(Goal0, GoalInfo0, Goal, GoalInfo, Info0, Info) :-
 	Goal0 = call(PredId, ProcId, Args, IsBuiltin, _, _),
 
Index: compiler/store_alloc.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/store_alloc.m,v
retrieving revision 1.55
diff -u -r1.55 store_alloc.m
--- store_alloc.m	1997/09/01 14:04:44	1.55
+++ store_alloc.m	1997/09/08 05:53:33
@@ -168,6 +168,9 @@
 store_alloc_in_goal_2(higher_order_call(A, B, C, D, E, F), Liveness, _, _,
 		higher_order_call(A, B, C, D, E, F), Liveness).
 
+store_alloc_in_goal_2(class_method_call(A, B, C, D, E, F), Liveness, _, _,
+		class_method_call(A, B, C, D, E, F), Liveness).
+
 store_alloc_in_goal_2(call(A, B, C, D, E, F), Liveness, _, _,
 		call(A, B, C, D, E, F), Liveness).
 
Index: compiler/stratify.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/stratify.m,v
retrieving revision 1.10
diff -u -r1.10 stratify.m
--- stratify.m	1997/09/01 14:04:49	1.10
+++ stratify.m	1997/10/21 06:00:32
@@ -235,6 +235,15 @@
 		"higher order call may introduce a non-stratified loop",
 		Error, Module0, Module).
 
+	% XXX This is very conservative.
+first_order_check_goal(class_method_call(_Var, _Num, _Vars, _Types, _Modes, 
+	_Det), GInfo, _Negated, _WholeScc, ThisPredProcId, Error,  
+	Module0, Module) --> 
+	{ goal_info_get_context(GInfo, Context) },
+	emit_message(ThisPredProcId, Context,
+		"class method call may introduce a non-stratified loop",
+		Error, Module0, Module).
+
 :- pred first_order_check_goal_list(list(hlds_goal), bool, 
 	list(pred_proc_id), pred_proc_id, bool, module_info, 
 	module_info, io__state, io__state).
@@ -406,6 +415,22 @@
 	;
 		{ Module = Module0 }
 	).
+
+	% XXX Is this right? Hmmmm. I need to talk to Tom.
+higher_order_check_goal(class_method_call(_Var, _Num, _Vars, _Types, _Modes,
+		_Det), GoalInfo, Negated, _WholeScc, ThisPredProcId,
+		HighOrderLoops, Error, Module0, Module) -->
+	(
+		{ Negated = yes },
+		{ HighOrderLoops = yes }
+	->
+		{ goal_info_get_context(GoalInfo, Context) },
+		emit_message(ThisPredProcId, Context, 
+			"higher order call may introduce a non-stratified loop", 
+			Error, Module0, Module)		
+	;
+		{ Module = Module0 }
+	).
 	
 :- pred higher_order_check_goal_list(list(hlds_goal), bool, set(pred_proc_id),
 	pred_proc_id, bool, bool, module_info, module_info, 
@@ -828,6 +853,11 @@
 check_goal1(higher_order_call(_Var, _Vars, _Types, _Modes, _Det, _PredOrFUnc),
 		Calls, Calls, HasAT, HasAT, _, yes).
 
+	% record that the higher order call was made. Well... a class method
+	% call is pretty similar to a higher order call...
+check_goal1(class_method_call(_Var, _Num, _Vars, _Types, _Modes, _Det), Calls,
+		Calls, HasAT, HasAT, _, yes).
+
 check_goal1(conj(Goals), Calls0, Calls, HasAT0, HasAT, CallsHO0, CallsHO) :-
 	check_goal_list(Goals, Calls0, Calls, HasAT0, HasAT, CallsHO0, CallsHO).
 check_goal1(disj(Goals, _Follow), Calls0, Calls, HasAT0, HasAT, CallsHO0, 
@@ -923,6 +953,9 @@
 
 get_called_procs(higher_order_call(_Var, _Vars, _Types, _Modes, _Det,
 		_PredOrFunc), Calls, Calls).
+
+get_called_procs(class_method_call(_Var, _Num,_Vars, _Types, _Modes, _Det),
+	Calls, Calls).
 
 
 get_called_procs(conj(Goals), Calls0, Calls) :-
Index: compiler/switch_detection.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/switch_detection.m,v
retrieving revision 1.76
diff -u -r1.76 switch_detection.m
--- switch_detection.m	1997/09/01 14:04:54	1.76
+++ switch_detection.m	1997/09/08 06:12:35
@@ -166,6 +166,9 @@
 detect_switches_in_goal_2(higher_order_call(A,B,C,D,E,F), _, _, _, _,
 		higher_order_call(A,B,C,D,E,F)).
 
+detect_switches_in_goal_2(class_method_call(A,B,C,D,E,F), _, _, _, _,
+		class_method_call(A,B,C,D,E,F)).
+
 detect_switches_in_goal_2(call(A,B,C,D,E,F), _, _, _, _,
 		call(A,B,C,D,E,F)).
 
Index: compiler/switch_gen.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/switch_gen.m,v
retrieving revision 1.61
diff -u -r1.61 switch_gen.m
--- switch_gen.m	1997/10/14 09:27:56	1.61
+++ switch_gen.m	1997/10/20 07:16:43
@@ -208,6 +208,7 @@
 switch_gen__priority(pred_closure_tag(_, _), 6).	% should never occur
 switch_gen__priority(code_addr_constant(_, _), 6).	% should never occur
 switch_gen__priority(base_type_info_constant(_, _, _), 6).% should never occur
+switch_gen__priority(base_typeclass_info_constant(_, _, _), 6).% shouldn't occur
 
 %---------------------------------------------------------------------------%
 %---------------------------------------------------------------------------%
Index: compiler/term_pass1.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/term_pass1.m,v
retrieving revision 1.3
diff -u -r1.3 term_pass1.m
--- term_pass1.m	1997/10/20 04:12:41	1.3
+++ term_pass1.m	1997/10/20 07:16:46
@@ -486,6 +486,11 @@
 		GoalInfo, _Module, _, _PPId, Error, Offs, Offs) :-
 	goal_info_get_context(GoalInfo, Context),
 	Error = error(Context - horder_call).
+	
+proc_inequalities_goal(class_method_call(_, _, _, _, _, _), 
+		GoalInfo, _Module, _, _PPId, Error, Offs, Offs) :-
+	goal_info_get_context(GoalInfo, Context),
+	Error = error(Context - horder_call).
 
 proc_inequalities_goal(switch(_SwitchVar, _CanFail, Cases, _StoreMap), GoalInfo,
 		Module, Info, PPId, Res, Offs0, Offs) :-
Index: compiler/term_pass2.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/term_pass2.m,v
retrieving revision 1.2
diff -u -r1.2 term_pass2.m
--- term_pass2.m	1997/10/09 09:39:18	1.2
+++ term_pass2.m	1997/10/17 05:33:30
@@ -607,6 +607,17 @@
 	Res = error(Context - horder_call),
 	Out = Out0.
 
+	% For now, we'll pretend that the class method call is a higher order
+	% call. In reality, we could probably analyse further than this, since
+	% we know that the method being called must come from one of the
+	% instance declarations, and we could potentially (globally) analyse
+	% these.
+termination_goal(class_method_call(_, _, _, _, _, _), 
+		GoalInfo, _Module, _UnifyInfo, _CallInfo, Res, Out0, Out) :-
+	goal_info_get_context(GoalInfo, Context),
+	Res = error(Context - horder_call),
+	Out = Out0.
+
 termination_goal(switch(_Var, _CanFail, Cases, _StoreMap),
 		_GoalInfo, Module, UnifyInfo, CallInfo, Res, Out0, Out) :-
 	termination_switch(Cases, Module, UnifyInfo, CallInfo, 
Index: compiler/type_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/type_util.m,v
retrieving revision 1.47
diff -u -r1.47 type_util.m
--- type_util.m	1997/10/14 09:27:58	1.47
+++ type_util.m	1997/11/20 07:18:58
@@ -135,6 +135,11 @@
 :- pred type_list_subsumes(list(type), list(type), tsubst).
 :- mode type_list_subsumes(in, in, out) is semidet.
 
+	% type_list_matches_exactly(TypesA, TypesB) succeeds iff TypesA and
+	% TypesB are exactly the same module variable renaming. 
+:- pred type_list_matches_exactly(list(type), list(type)).
+:- mode type_list_matches_exactly(in, in) is semidet.
+
 	% apply a type substitution (i.e. map from tvar -> type)
 	% to all the types in a variable typing (i.e. map from var -> type).
 
@@ -149,16 +154,32 @@
 						 map(var, type)).
 :- mode apply_rec_substitution_to_type_map(in, in, out) is det.
 
-	% Update a map from tvar to var, using the type substititon to
-	% rename tvars and a variable substition to rename vars.
+	% Update a map from tvar to type_info_locn, using the type substititon
+	% to rename tvars and a variable substition to rename vars.
 	%
 	% If tvar maps to a another type variable, we keep the new
 	% variable, if it maps to a type, we remove it from the map.
 
-:- pred apply_substitutions_to_var_map(map(tvar, var), tsubst, map(var, var), 
-		map(tvar, var)).
+:- pred apply_substitutions_to_var_map(map(tvar, type_info_locn), tsubst,
+	map(var, var), map(tvar, type_info_locn)).
 :- mode apply_substitutions_to_var_map(in, in, in, out) is det.
 
+:- pred apply_rec_subst_to_constraints(substitution, list(class_constraint),
+	list(class_constraint)).
+:- mode apply_rec_subst_to_constraints(in, in, out) is det.
+
+:- pred apply_rec_subst_to_constraint(substitution, class_constraint,
+	class_constraint).
+:- mode apply_rec_subst_to_constraint(in, in, out) is det.
+
+:- pred apply_subst_to_constraints(substitution, list(class_constraint),
+	list(class_constraint)).
+:- mode apply_subst_to_constraints(in, in, out) is det.
+
+:- pred apply_subst_to_constraint(substitution, class_constraint,
+	class_constraint).
+:- mode apply_subst_to_constraint(in, in, out) is det.
+
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
@@ -357,7 +378,11 @@
 	Ctor \= qualified("mercury_builtin", "type_info"),
 	Ctor \= qualified("mercury_builtin", "base_type_info"),
 	Ctor \= unqualified("type_info"),
-	Ctor \= unqualified("base_type_info").
+	Ctor \= unqualified("base_type_info"),
+	Ctor \= qualified("mercury_builtin", "typeclass_info"),
+	Ctor \= qualified("mercury_builtin", "base_typeclass_info"),
+	Ctor \= unqualified("typeclass_info"),
+	Ctor \= unqualified("base_typeclass_info").
 
 %-----------------------------------------------------------------------------%
 
@@ -414,6 +439,14 @@
 
 %-----------------------------------------------------------------------------%
 
+	% If this becomes a performance bottleneck, it can probably be coded
+	% more efficiently.
+type_list_matches_exactly(TypesA, TypesB) :-
+	type_list_subsumes(TypesA, TypesB, _),
+	type_list_subsumes(TypesB, TypesA, _).
+
+%-----------------------------------------------------------------------------%
+
 	% Types are represented as terms, but we can't just use term__unify
 	% because we need to avoid binding any of the "head type params"
 	% (the type variables that occur in the head of the clause),
@@ -639,14 +672,16 @@
 	).
 
 
-:- pred apply_substitutions_to_var_map_2(list(var)::in, map(tvar, var)::in,
-		tsubst::in, map(var, var)::in, map(tvar, var)::in, 
-		map(tvar, var)::out) is det.
+:- pred apply_substitutions_to_var_map_2(list(var)::in, map(tvar,
+		type_info_locn)::in, tsubst::in, map(var, var)::in, 
+		map(tvar, type_info_locn)::in, 
+		map(tvar, type_info_locn)::out) is det.
 
 apply_substitutions_to_var_map_2([], _VarMap0, _, _, NewVarMap, NewVarMap).
 apply_substitutions_to_var_map_2([TVar | TVars], VarMap0, TSubst, Subst, 
 		NewVarMap0, NewVarMap) :-
-	map__lookup(VarMap0, TVar, Var),
+	map__lookup(VarMap0, TVar, Locn),
+	type_info_locn_var(Locn, Var),
 
 		% find the new tvar, if there is one, otherwise just
 		% create the old var as a type variable.
@@ -662,16 +697,42 @@
 	;
 		NewVar = Var
 	),
+	(
+		Locn = type_info(_),
+		NewLocn = type_info(NewVar)
+	;
+		Locn = typeclass_info(_, Num),
+		NewLocn = typeclass_info(NewVar, Num)
+	),
 
 		% if the tvar is still a variable, insert it into the
 		% map with the new var.
 	( type_util__var(NewTerm, NewTVar) ->
-		map__det_insert(NewVarMap0, NewTVar, NewVar, NewVarMap1)
+		map__det_insert(NewVarMap0, NewTVar, NewLocn, NewVarMap1)
 	;
 		NewVarMap1 = NewVarMap0
 	),
 	apply_substitutions_to_var_map_2(TVars, VarMap0, TSubst, Subst, 
 		NewVarMap1, NewVarMap).
+
+%-----------------------------------------------------------------------------%
+
+apply_rec_subst_to_constraints(Subst, Constraints0, Constraints) :-
+	list__map(apply_rec_subst_to_constraint(Subst), Constraints0,
+		Constraints).
+
+apply_rec_subst_to_constraint(Subst, Constraint0, Constraint) :-
+	Constraint0 = constraint(ClassName, Types0),
+	term__apply_rec_substitution_to_list(Types0, Subst, Types),
+	Constraint  = constraint(ClassName, Types).
+
+apply_subst_to_constraints(Subst, Constraints0, Constraints) :-
+	list__map(apply_subst_to_constraint(Subst), Constraints0, Constraints).
+
+apply_subst_to_constraint(Subst, Constraint0, Constraint) :-
+	Constraint0 = constraint(ClassName, Types0),
+	term__apply_substitution_to_list(Types0, Subst, Types),
+	Constraint  = constraint(ClassName, Types).
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
Index: compiler/typecheck.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/typecheck.m,v
retrieving revision 1.218
diff -u -r1.218 typecheck.m
--- typecheck.m	1997/11/13 06:27:30	1.218
+++ typecheck.m	1997/11/20 06:24:31
@@ -155,6 +155,17 @@
 			tvarset, list(type), pred_id, sym_name).
 :- mode typecheck__find_matching_pred_id(in, in, in, in, out, out) is semidet.
 
+	% Apply context reduction to the list of class constraints by applying
+	% the instance rules or superclass rules, building up proofs for
+	% redundant constraints
+:- pred typecheck__reduce_context_by_rule_application(instance_table,
+	class_table, tsubst, tvarset, tvarset, 
+	map(class_constraint, constraint_proof), 
+	map(class_constraint, constraint_proof),
+	list(class_constraint), list(class_constraint)).
+:- mode typecheck__reduce_context_by_rule_application(in, in, in, in, out, 
+	in, out, in, out) is semidet.
+
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
@@ -416,17 +427,35 @@
 	    pred_info_typevarset(PredInfo0, TypeVarSet0),
 	    pred_info_clauses_info(PredInfo0, ClausesInfo0),
 	    pred_info_import_status(PredInfo0, Status),
+	    pred_info_get_marker_list(PredInfo0, Markers),
 	    ClausesInfo0 = clauses_info(VarSet, ExplicitVarTypes,
 				_OldInferredVarTypes, HeadVars, Clauses0),
 	    ( 
 		Clauses0 = [] 
 	    ->
-	        report_error_no_clauses(PredId, PredInfo0, ModuleInfo,
-		    IOState0, IOState),
-	        MaybePredInfo = no,
-		Changed = no
+			% There are no clauses for class methods.
+			% The clauses are generated later on,
+			% in polymorphism__expand_class_method_bodies
+		( list__member(request(class_method), Markers) ->
+			IOState = IOState0,
+				% For the moment, we just insert the types
+				% of the head vars into the clauses_info
+			pred_info_arg_types(PredInfo0, _, ArgTypes),
+			map__from_corresponding_lists(HeadVars, ArgTypes,
+				VarTypes),
+			ClausesInfo = clauses_info(VarSet, VarTypes,
+				VarTypes, HeadVars, Clauses0),
+			pred_info_set_clauses_info(PredInfo0, ClausesInfo,
+				PredInfo),
+			MaybePredInfo = yes(PredInfo),
+			Changed = no
+		;
+			report_error_no_clauses(PredId, PredInfo0, ModuleInfo,
+			    IOState0, IOState),
+			MaybePredInfo = no,
+			Changed = no
+		)
 	    ;
-		pred_info_get_marker_list(PredInfo0, Markers),
 		( list__member(request(infer_type), Markers) ->
 			% For a predicate whose type is inferred,
 			% the predicate is allowed to bind the type
@@ -436,37 +465,43 @@
 			% `pred foo(T1, T2, ..., TN)' by make_hlds.m.
 			Inferring = yes,
 			HeadTypeParams = [],
+			Constraints = [],
 			write_pred_progress_message("% Inferring type of ",
 				PredId, ModuleInfo, IOState0, IOState1)
 		;
 			Inferring = no,
 			term__vars_list(ArgTypes0, HeadTypeParams),
+			pred_info_get_class_context(PredInfo0, Constraints),
 			write_pred_progress_message("% Type-checking ",
 				PredId, ModuleInfo, IOState0, IOState1)
 		),
-		bool(Inferring), % dummy pred call to avoid type ambiguity
 
 		typecheck_info_init(IOState1, ModuleInfo, PredId,
 				TypeVarSet0, VarSet, ExplicitVarTypes,
-				HeadTypeParams, Status, TypeCheckInfo1),
+				HeadTypeParams, Constraints, Status,
+				TypeCheckInfo1),
 		typecheck_clause_list(Clauses0, HeadVars, ArgTypes0, Clauses,
 				TypeCheckInfo1, TypeCheckInfo2),
+		typecheck_constraints(Inferring, TypeCheckInfo2,
+				TypeCheckInfo3),
 		typecheck_check_for_ambiguity(whole_pred, HeadVars,
-				TypeCheckInfo2, TypeCheckInfo3),
-		typecheck_info_get_final_info(TypeCheckInfo3, TypeVarSet, 
+				TypeCheckInfo3, TypeCheckInfo4),
+		typecheck_info_get_final_info(TypeCheckInfo4, TypeVarSet, 
 				InferredVarTypes0),
 		map__optimize(InferredVarTypes0, InferredVarTypes),
 		ClausesInfo = clauses_info(VarSet, ExplicitVarTypes,
 				InferredVarTypes, HeadVars, Clauses),
 		pred_info_set_clauses_info(PredInfo0, ClausesInfo, PredInfo1),
 		pred_info_set_typevarset(PredInfo1, TypeVarSet, PredInfo2),
+		record_class_constraint_proofs(PredInfo2, TypeCheckInfo4,
+			PredInfo3),
 		( Inferring = no ->
-			PredInfo = PredInfo2,
+			PredInfo = PredInfo3,
 			Changed = no
 		;
 			map__apply_to_list(HeadVars, InferredVarTypes,
 				ArgTypes),
-			pred_info_set_arg_types(PredInfo2, TypeVarSet,
+			pred_info_set_arg_types(PredInfo3, TypeVarSet,
 				ArgTypes, PredInfo),
 			( identical_up_to_renaming(ArgTypes0, ArgTypes) ->
 				Changed = no
@@ -474,7 +509,7 @@
 				Changed = yes
 			)
 		),
-		typecheck_info_get_found_error(TypeCheckInfo3, Error),
+		typecheck_info_get_found_error(TypeCheckInfo4, Error),
 		(
 			Error = yes,
 			MaybePredInfo = no
@@ -482,14 +517,10 @@
 			Error = no,
 			MaybePredInfo = yes(PredInfo)
 		),
-		typecheck_info_get_io_state(TypeCheckInfo3, IOState)
+		typecheck_info_get_io_state(TypeCheckInfo4, IOState)
 	    )
 	).
 
-	% bool/1 is used to avoid a type ambiguity
-:- pred bool(bool::in) is det.
-bool(_).
-
 :- pred pred_is_user_defined_equality_pred(pred_info::in, module_info::in)
 	is semidet.
 
@@ -861,6 +892,9 @@
 		higher_order_call(PredVar, Args, C, D, E, F)) -->
 	checkpoint("higher-order call"),
 	typecheck_higher_order_call(PredVar, Args).
+typecheck_goal_2(class_method_call(A, B, C, D, E, F),
+		class_method_call(A, B, C, D, E, F)) -->
+	{ error("class_method_calls should be introduced after typechecking") }.
 typecheck_goal_2(unify(A, B0, Mode, Info, UnifyContext),
 		unify(A, B, Mode, Info, UnifyContext)) -->
 	checkpoint("unify"),
@@ -907,7 +941,7 @@
 			TypeVars, TypeVarSet) },
 		{ term__var_list_to_term_list(TypeVars, Types) },
 		typecheck_var_has_polymorphic_type_list(Vars,
-			TypeVarSet, Types)
+			TypeVarSet, Types, [])
 	).
 
 %-----------------------------------------------------------------------------%
@@ -923,8 +957,11 @@
 	{ Arity1 is Arity + 1 },
 	{ PredCallId = unqualified("call")/Arity1 },
 	typecheck_info_set_called_predid(PredCallId),
+% XXX DGJ
+% XXX This is wrong, and needs serious thought. It will do for now.
+% XXX We need to add constraints to higher order thingies.
 	typecheck_var_has_polymorphic_type_list([PredVar|Args], TypeVarSet,
-		[PredVarType|ArgTypes]).
+		[PredVarType|ArgTypes], []).
 
 :- pred higher_order_pred_type(int, tvarset, type, list(type)).
 :- mode higher_order_pred_type(in, out, out, out) is det.
@@ -992,9 +1029,11 @@
 			map__lookup(Preds, PredId, PredInfo),
 			pred_info_arg_types(PredInfo, PredTypeVarSet,
 						PredArgTypes),
+			pred_info_get_class_context(PredInfo,
+						PredClassContext),
 
 				% rename apart the type variables in 
-				% called predicate's arg types and then
+				% called predicate's arg types and then 
 				% unify the types of the call arguments
 				% with the called predicates' arg types
 				% (optimize for the common case of
@@ -1002,12 +1041,23 @@
 			( varset__is_empty(PredTypeVarSet) ->
 			    typecheck_var_has_type_list(Args,
 				PredArgTypes, 0, TypeCheckInfo1,
-				TypeCheckInfo)
+				TypeCheckInfo2),
+			    ( 
+					% sanity check
+			        PredClassContext \= []
+			    ->
+			        error("non-polymorphic pred has context")
+			    ;
+			    	true
+			    )
 			;
 			    typecheck_var_has_polymorphic_type_list(
 				Args, PredTypeVarSet, PredArgTypes,
-				TypeCheckInfo1, TypeCheckInfo)
-			)
+				PredClassContext,
+				TypeCheckInfo1, TypeCheckInfo2)
+			),
+			% Should we really do this now?
+			perform_context_reduction(TypeCheckInfo2, TypeCheckInfo)
 		;
 			typecheck_info_get_pred_import_status(TypeCheckInfo1,
 						CallingStatus),
@@ -1109,8 +1159,9 @@
 		TypeAssignSet0, ArgsTypeAssignSet0, ArgsTypeAssignSet) :-
 	map__lookup(Preds, PredId, PredInfo),
 	pred_info_arg_types(PredInfo, PredTypeVarSet, PredArgTypes),
+	pred_info_get_class_context(PredInfo, PredClassContext),
 	rename_apart(TypeAssignSet0, PredTypeVarSet, PredArgTypes,
-		ArgsTypeAssignSet0, ArgsTypeAssignSet1),
+		PredClassContext, ArgsTypeAssignSet0, ArgsTypeAssignSet1),
 	get_overloaded_pred_arg_types(PredIds, Preds, CallingPredStatus,
 		TypeAssignSet0, ArgsTypeAssignSet1, ArgsTypeAssignSet).
 
@@ -1203,42 +1254,49 @@
 	% assignment set", and then for each arg type assignment in the
 	% arg type assignment set, check that the argument variables have
 	% the expected types.
+	% A set of class constraints are also passed in, which must have the
+	% types contained within renamed apart. 
 
 :- pred typecheck_var_has_polymorphic_type_list(list(var), tvarset, list(type),
-		typecheck_info, typecheck_info).
-:- mode typecheck_var_has_polymorphic_type_list(in, in, in,
+		list(class_constraint), typecheck_info, typecheck_info).
+:- mode typecheck_var_has_polymorphic_type_list(in, in, in, in,
 		typecheck_info_di, typecheck_info_uo) is det.
 
 typecheck_var_has_polymorphic_type_list(Args, PredTypeVarSet, PredArgTypes,
-		TypeCheckInfo0, TypeCheckInfo) :-
+		PredClassConstraints, TypeCheckInfo0, TypeCheckInfo) :-
 	typecheck_info_get_type_assign_set(TypeCheckInfo0, TypeAssignSet0),
 	rename_apart(TypeAssignSet0, PredTypeVarSet, PredArgTypes,
-				[], ArgsTypeAssignSet),
+				PredClassConstraints, [], ArgsTypeAssignSet),
 	typecheck_var_has_arg_type_list(Args, 0, ArgsTypeAssignSet,
 				TypeCheckInfo0, TypeCheckInfo).
 
 :- pred rename_apart(type_assign_set, tvarset, list(type),
+			list(class_constraint),
                         args_type_assign_set, args_type_assign_set).
-:- mode rename_apart(in, in, in, in, out) is det.
+:- mode rename_apart(in, in, in, in, in, out) is det.
 
-rename_apart([], _, _, ArgTypeAssigns, ArgTypeAssigns).
+rename_apart([], _, _, _, ArgTypeAssigns, ArgTypeAssigns).
 rename_apart([TypeAssign0 | TypeAssigns0], PredTypeVarSet, PredArgTypes0,
-		ArgTypeAssigns0, ArgTypeAssigns) :-
+		PredClassConstraints0, ArgTypeAssigns0, ArgTypeAssigns) :-
         type_assign_rename_apart(TypeAssign0, PredTypeVarSet, PredArgTypes0,
-                        TypeAssign, PredArgTypes),
-        ArgTypeAssigns1 = [TypeAssign - PredArgTypes | ArgTypeAssigns0],
+                        TypeAssign, PredArgTypes, Subst),
+	apply_subst_to_constraints(Subst, PredClassConstraints0,
+		PredClassConstraints),
+	NewArgTypeAssign = args(TypeAssign, PredArgTypes, PredClassConstraints),
+        ArgTypeAssigns1 = [NewArgTypeAssign | ArgTypeAssigns0],
         rename_apart(TypeAssigns0, PredTypeVarSet, PredArgTypes0,
-			ArgTypeAssigns1, ArgTypeAssigns).
+			PredClassConstraints0, ArgTypeAssigns1, ArgTypeAssigns).
 
 :- pred type_assign_rename_apart(type_assign, tvarset, list(type),
-			type_assign, list(type)).
-:- mode type_assign_rename_apart(in, in, in, out, out) is det.
+			type_assign, list(type), substitution).
+:- mode type_assign_rename_apart(in, in, in, out, out, out) is det.
 
 type_assign_rename_apart(TypeAssign0, PredTypeVarSet, PredArgTypes0,
-		TypeAssign, PredArgTypes) :-
+		TypeAssign, PredArgTypes, Subst) :-
 	type_assign_get_typevarset(TypeAssign0, TypeVarSet0),
-	varset__merge(TypeVarSet0, PredTypeVarSet, PredArgTypes0,
-			  TypeVarSet, PredArgTypes),
+	varset__merge_subst(TypeVarSet0, PredTypeVarSet, TypeVarSet, Subst),
+	term__apply_substitution_to_list(PredArgTypes0, Subst,
+		PredArgTypes),
 	type_assign_set_typevarset(TypeAssign0, TypeVarSet, TypeAssign).
 
 %-----------------------------------------------------------------------------%
@@ -1267,10 +1325,19 @@
 :- mode convert_args_type_assign_set(in, out) is det.
 
 convert_args_type_assign_set([], []).
-convert_args_type_assign_set([TypeAssign - Args | ArgTypeAssigns],
-				[TypeAssign | TypeAssigns]) :-
+convert_args_type_assign_set(
+			[args(TypeAssign0, Args, Constraints0)|ArgTypeAssigns],
+			[TypeAssign | TypeAssigns]) :-
 	( Args = [] ->
-		true
+		type_assign_get_typeclass_constraints(TypeAssign0,
+			OldConstraints),
+		type_assign_get_type_bindings(TypeAssign0, Bindings),
+		apply_rec_subst_to_constraints(Bindings, Constraints0,
+			Constraints),
+
+		list__append(Constraints, OldConstraints, NewConstraints),
+		type_assign_set_typeclass_constraints(TypeAssign0,
+			NewConstraints, TypeAssign)
 	;
 		% this should never happen, since the arguments should
 		% all have been processed at this point
@@ -1310,8 +1377,8 @@
 :- mode skip_arg(in, out) is det.
 
 skip_arg([], []).
-skip_arg([TypeAssign - Args0 | ArgTypeAssigns0],
-				[TypeAssign - Args| ArgTypeAssigns]) :-
+skip_arg([args(TypeAssign, Args0, Constraints) | ArgTypeAssigns0],
+		[args(TypeAssign, Args, Constraints)| ArgTypeAssigns]) :-
 	( Args0 = [_ | Args1] ->
 		Args = Args1
 	;
@@ -1325,18 +1392,20 @@
 :- mode typecheck_var_has_arg_type_2(in, in, in, in, out) is det.
 
 typecheck_var_has_arg_type_2([], _, _) --> [].
-typecheck_var_has_arg_type_2([TypeAssign0 - ArgTypes0 | TypeAssignSet0],
-				HeadTypeParams, VarId) -->
+typecheck_var_has_arg_type_2(
+		[args(TypeAssign0, ArgTypes0, ClassContext) | TypeAssignSet0],
+		HeadTypeParams, VarId) -->
 	arg_type_assign_var_has_type(TypeAssign0, ArgTypes0,
-					HeadTypeParams, VarId),
+					HeadTypeParams, VarId, ClassContext),
 	typecheck_var_has_arg_type_2(TypeAssignSet0, HeadTypeParams, VarId).
 
 :- pred arg_type_assign_var_has_type(type_assign, list(type), headtypes, var,
+				list(class_constraint),
 				args_type_assign_set, args_type_assign_set).
-:- mode arg_type_assign_var_has_type(in, in, in, in, in, out) is det.
+:- mode arg_type_assign_var_has_type(in, in, in, in, in, in, out) is det.
 
 arg_type_assign_var_has_type(TypeAssign0, ArgTypes0, HeadTypeParams, VarId,
-		ArgTypeAssignSet0, ArgTypeAssignSet) :-
+		ClassContext, ArgTypeAssignSet0, ArgTypeAssignSet) :-
 	type_assign_get_var_types(TypeAssign0, VarTypes0),
 	( ArgTypes0 = [Type | ArgTypes] ->
 	    (
@@ -1346,15 +1415,17 @@
 		    type_assign_unify_type(TypeAssign0, HeadTypeParams,
 				VarType, Type, TypeAssign1)
 		->
-		    ArgTypeAssignSet = [TypeAssign1 - ArgTypes |
-					ArgTypeAssignSet0]
+		    ArgTypeAssignSet = 
+		    		[args(TypeAssign1, ArgTypes, ClassContext) |
+				ArgTypeAssignSet0]
 		;
 		    ArgTypeAssignSet = ArgTypeAssignSet0
 		)
 	    ;
 		map__det_insert(VarTypes0, VarId, Type, VarTypes),
 		type_assign_set_var_types(TypeAssign0, VarTypes, TypeAssign),
-		ArgTypeAssignSet = [TypeAssign - ArgTypes | ArgTypeAssignSet0]
+		ArgTypeAssignSet = [args(TypeAssign, ArgTypes, ClassContext)
+					| ArgTypeAssignSet0]
 	    )
 	;
 	    error("arg_type_assign_var_has_type")
@@ -1448,7 +1519,8 @@
 :- pred get_arg_type_stuff(args_type_assign_set, var, list(arg_type_stuff)).
 :- mode get_arg_type_stuff(in, in, out) is det.
 get_arg_type_stuff([], _VarId, []).
-get_arg_type_stuff([TypeAssign - ArgTypes | ArgTypeAssigns], VarId, L) :-
+get_arg_type_stuff([args(TypeAssign, ArgTypes, _) | ArgTypeAssigns], 
+			VarId, L) :-
 	get_arg_type_stuff(ArgTypeAssigns, VarId, L0),
 	type_assign_get_type_bindings(TypeAssign, TypeBindings),
 	type_assign_get_typevarset(TypeAssign, TVarSet),
@@ -1793,7 +1865,12 @@
 :- type cons_type ---> cons_type(type, list(type)).
 :- type cons_type_assign_set == list(pair(type_assign, cons_type)).
 
-:- type args_type_assign_set == list(pair(type_assign, list(type))).
+:- type args_type_assign_set == list(args_type_assign).
+
+:- type args_type_assign --->	args(type_assign, list(type),
+					list(class_constraint)).
+					% Type assignment, types of callee,
+					% constraints from callee
 
 :- pred typecheck_unify_var_functor_get_ctors(type_assign_set,
 				typecheck_info, list(cons_type_info),
@@ -1857,7 +1934,7 @@
 	is det.
 
 typecheck_functor_arg_types([], _, _) --> [].
-typecheck_functor_arg_types([TypeAssign - ArgTypes | ConsTypeAssigns],
+typecheck_functor_arg_types([args(TypeAssign, ArgTypes, _) | ConsTypeAssigns],
 			Args, TypeCheckInfo) -->
 	type_assign_var_has_type_list(Args, ArgTypes, TypeAssign,
 		TypeCheckInfo),
@@ -1969,15 +2046,22 @@
 			type_assign_unify_type(TypeAssign1, HeadTypeParams,
 					ConsType, TypeY, TypeAssign2)
 		->
-			TypeAssignSet = [TypeAssign2 - ArgTypes |
+				% The constraints are empty here because
+				% none are added by unification with a
+				% functor
+			TypeAssignSet = [args(TypeAssign2, ArgTypes, []) |
 					TypeAssignSet0]
 		;
 			TypeAssignSet = TypeAssignSet0
 		)
 	;
+			% The constraints are empty here because
+			% none are added by unification with a
+			% functor
 		map__det_insert(VarTypes0, Y, ConsType, VarTypes),
 		type_assign_set_var_types(TypeAssign1, VarTypes, TypeAssign3),
-		TypeAssignSet = [TypeAssign3 - ArgTypes | TypeAssignSet0]
+		TypeAssignSet = [args(TypeAssign3, ArgTypes, []) | 
+				TypeAssignSet0]
 	).
 
 %-----------------------------------------------------------------------------%
@@ -2007,7 +2091,7 @@
 	;
 		type_assign_rename_apart(TypeAssign0, ConsTypeVarSet,
 			[ConsType0 | ArgTypes0],
-			TypeAssign1, [ConsType1 | ArgTypes1])
+			TypeAssign1, [ConsType1 | ArgTypes1], _)
 	->
 		ConsType = ConsType1,
 		ArgTypes = ArgTypes1,
@@ -2295,6 +2379,9 @@
 
 			headtypes,	% Head type params
 
+			list(class_constraint),
+					% The declared typeclass constraints
+
 			bool,		% Have we already warned about
 					% highly ambiguous overloading?
 			import_status
@@ -2346,24 +2433,28 @@
 %-----------------------------------------------------------------------------%
 
 :- pred typecheck_info_init(io__state, module_info, pred_id, varset,
-	varset, map(var, type), headtypes, import_status, typecheck_info).
-:- mode typecheck_info_init(di, in, in, in, in, in, in, in, typecheck_info_uo)
+	varset, map(var, type), headtypes, list(class_constraint),
+	import_status, typecheck_info).
+:- mode typecheck_info_init(di, in, in, in, in, in, in, in, in,
+	typecheck_info_uo)
 	is det.
 
 typecheck_info_init(IOState0, ModuleInfo, PredId, TypeVarSet, VarSet,
-		VarTypes, HeadTypeParams, Status, TypeCheckInfo) :-
+		VarTypes, HeadTypeParams, Constraints, Status, TypeCheckInfo) :-
 	CallPredId = unqualified("") / 0,
 	term__context_init(Context),
 	map__init(TypeBindings),
+	map__init(Proofs),
 	FoundTypeError = no,
 	WarnedAboutOverloading = no,
 	unsafe_promise_unique(IOState0, IOState),	% XXX
 	TypeCheckInfo = typecheck_info(
 		IOState, ModuleInfo, CallPredId, 0, PredId, Context,
-		unify_context(explicit, []),
-		VarSet, [type_assign(VarTypes, TypeVarSet, TypeBindings)],
-		FoundTypeError, HeadTypeParams, WarnedAboutOverloading,
-		Status
+		unify_context(explicit, []), VarSet, 
+		[type_assign(VarTypes, TypeVarSet, TypeBindings, 
+			Constraints, Proofs)],
+		FoundTypeError, HeadTypeParams, Constraints,
+		WarnedAboutOverloading, Status
 	).
 
 %-----------------------------------------------------------------------------%
@@ -2371,7 +2462,7 @@
 :- pred typecheck_info_get_io_state(typecheck_info, io__state).
 :- mode typecheck_info_get_io_state(typecheck_info_get_io_state, uo) is det.
 
-typecheck_info_get_io_state(typecheck_info(IOState0,_,_,_,_,_,_,_,_,_,_,_,_), 
+typecheck_info_get_io_state(typecheck_info(IOState0,_,_,_,_,_,_,_,_,_,_,_,_,_), 
 		IOState) :-
 	unsafe_promise_unique(IOState0, IOState).	% XXX
 
@@ -2381,8 +2472,9 @@
 :- mode typecheck_info_set_io_state(typecheck_info_set_io_state, di, 
 				typecheck_info_uo) is det.
 
-typecheck_info_set_io_state(typecheck_info(_,B,C,D,E,F,G,H,I,J,K,L,M), IOState0,
-			typecheck_info(IOState,B,C,D,E,F,G,H,I,J,K,L,M)) :-
+typecheck_info_set_io_state(typecheck_info(_,B,C,D,E,F,G,H,I,J,K,L,M,N), 
+			IOState0,
+			typecheck_info(IOState,B,C,D,E,F,G,H,I,J,K,L,M,N)) :-
 	unsafe_promise_unique(IOState0, IOState).	% XXX
 
 %-----------------------------------------------------------------------------%
@@ -2391,7 +2483,7 @@
 :- mode typecheck_info_get_module_name(in, out) is det.
 
 typecheck_info_get_module_name(TypeCheckInfo, Name) :-
-	TypeCheckInfo = typecheck_info(_,ModuleInfo,_,_,_,_,_,_,_,_,_,_,_),
+	TypeCheckInfo = typecheck_info(_,ModuleInfo,_,_,_,_,_,_,_,_,_,_,_,_),
 	module_info_name(ModuleInfo, Name).
 
 %-----------------------------------------------------------------------------%
@@ -2400,7 +2492,7 @@
 :- mode typecheck_info_get_module_info(in, out) is det.
 
 typecheck_info_get_module_info(TypeCheckInfo, ModuleInfo) :-
-	TypeCheckInfo = typecheck_info(_,ModuleInfo,_,_,_,_,_,_,_,_,_,_,_).
+	TypeCheckInfo = typecheck_info(_,ModuleInfo,_,_,_,_,_,_,_,_,_,_,_,_).
 
 %-----------------------------------------------------------------------------%
 
@@ -2408,7 +2500,7 @@
 :- mode typecheck_info_get_preds(in, out) is det.
 
 typecheck_info_get_preds(TypeCheckInfo, Preds) :-
-	TypeCheckInfo = typecheck_info(_,ModuleInfo,_,_,_,_,_,_,_,_,_,_,_), 
+	TypeCheckInfo = typecheck_info(_,ModuleInfo,_,_,_,_,_,_,_,_,_,_,_,_), 
 	module_info_get_predicate_table(ModuleInfo, Preds).
 
 %-----------------------------------------------------------------------------%
@@ -2417,7 +2509,7 @@
 :- mode typecheck_info_get_types(in, out) is det.
 
 typecheck_info_get_types(TypeCheckInfo, Types) :-
-	TypeCheckInfo = typecheck_info(_,ModuleInfo,_,_,_,_,_,_,_,_,_,_,_),
+	TypeCheckInfo = typecheck_info(_,ModuleInfo,_,_,_,_,_,_,_,_,_,_,_,_),
 	module_info_types(ModuleInfo, Types).
 
 %-----------------------------------------------------------------------------%
@@ -2426,7 +2518,7 @@
 :- mode typecheck_info_get_ctors(in, out) is det.
 
 typecheck_info_get_ctors(TypeCheckInfo, Ctors) :-
-	TypeCheckInfo = typecheck_info(_,ModuleInfo,_,_,_,_,_,_,_,_,_,_,_),
+	TypeCheckInfo = typecheck_info(_,ModuleInfo,_,_,_,_,_,_,_,_,_,_,_,_),
 	module_info_ctors(ModuleInfo, Ctors).
 
 %-----------------------------------------------------------------------------%
@@ -2435,7 +2527,7 @@
 :- mode typecheck_info_get_called_predid(in, out) is det.
 
 typecheck_info_get_called_predid(TypeCheckInfo, PredId) :-
-	TypeCheckInfo = typecheck_info(_,_,PredId,_,_,_,_,_,_,_,_,_,_).
+	TypeCheckInfo = typecheck_info(_,_,PredId,_,_,_,_,_,_,_,_,_,_,_).
 
 %-----------------------------------------------------------------------------%
 
@@ -2445,8 +2537,8 @@
 			typecheck_info_uo) is det.
 
 typecheck_info_set_called_predid(PredCallId, TypeCheckInfo0, TypeCheckInfo) :-
-	TypeCheckInfo0 = typecheck_info(A,B,_,D,E,F,G,H,I,J,K,L,M),
-	TypeCheckInfo = typecheck_info(A,B,PredCallId,D,E,F,G,H,I,J,K,L,M).
+	TypeCheckInfo0 = typecheck_info(A,B,_,D,E,F,G,H,I,J,K,L,M,N),
+	TypeCheckInfo = typecheck_info(A,B,PredCallId,D,E,F,G,H,I,J,K,L,M,N).
 
 %-----------------------------------------------------------------------------%
 
@@ -2454,7 +2546,7 @@
 :- mode typecheck_info_get_arg_num(in, out) is det.
 
 typecheck_info_get_arg_num(TypeCheckInfo, ArgNum) :-
-	TypeCheckInfo = typecheck_info(_,_,_,ArgNum,_,_,_,_,_,_,_,_,_).
+	TypeCheckInfo = typecheck_info(_,_,_,ArgNum,_,_,_,_,_,_,_,_,_,_).
 
 %-----------------------------------------------------------------------------%
 
@@ -2463,8 +2555,8 @@
 		typecheck_info_uo) is det.
 
 typecheck_info_set_arg_num(ArgNum, TypeCheckInfo0, TypeCheckInfo) :-
-	TypeCheckInfo0 = typecheck_info(A,B,C,_,E,F,G,H,I,J,K,L,M),
-	TypeCheckInfo = typecheck_info(A,B,C,ArgNum,E,F,G,H,I,J,K,L,M).
+	TypeCheckInfo0 = typecheck_info(A,B,C,_,E,F,G,H,I,J,K,L,M,N),
+	TypeCheckInfo = typecheck_info(A,B,C,ArgNum,E,F,G,H,I,J,K,L,M,N).
 
 %-----------------------------------------------------------------------------%
 
@@ -2472,7 +2564,7 @@
 :- mode typecheck_info_get_predid(in, out) is det.
 
 typecheck_info_get_predid(TypeCheckInfo, PredId) :- 
-	TypeCheckInfo = typecheck_info(_,_,_,_,PredId,_,_,_,_,_,_,_,_).
+	TypeCheckInfo = typecheck_info(_,_,_,_,PredId,_,_,_,_,_,_,_,_,_).
 
 %-----------------------------------------------------------------------------%
 
@@ -2480,7 +2572,7 @@
 :- mode typecheck_info_get_context(in, out) is det.
 
 typecheck_info_get_context(TypeCheckInfo, Context) :-
-	TypeCheckInfo = typecheck_info(_,_,_,_,_,Context,_,_,_,_,_,_,_).
+	TypeCheckInfo = typecheck_info(_,_,_,_,_,Context,_,_,_,_,_,_,_,_).
 
 %-----------------------------------------------------------------------------%
 
@@ -2490,8 +2582,8 @@
 			typecheck_info_uo) is det.
 
 typecheck_info_set_context(Context, TypeCheckInfo0, TypeCheckInfo) :-
-	TypeCheckInfo0 = typecheck_info(A,B,C,D,E,_,G,H,I,J,K,L,M),
-	TypeCheckInfo = typecheck_info(A,B,C,D,E,Context,G,H,I,J,K,L,M).
+	TypeCheckInfo0 = typecheck_info(A,B,C,D,E,_,G,H,I,J,K,L,M,N),
+	TypeCheckInfo = typecheck_info(A,B,C,D,E,Context,G,H,I,J,K,L,M,N).
 
 %-----------------------------------------------------------------------------%
 
@@ -2499,7 +2591,7 @@
 :- mode typecheck_info_get_unify_context(in, out) is det.
 
 typecheck_info_get_unify_context(TypeCheckInfo, UnifyContext) :-
-	TypeCheckInfo = typecheck_info(_,_,_,_,_,_,UnifyContext,_,_,_,_,_,_).
+	TypeCheckInfo = typecheck_info(_,_,_,_,_,_,UnifyContext,_,_,_,_,_,_,_).
 
 %-----------------------------------------------------------------------------%
 
@@ -2509,8 +2601,8 @@
 			typecheck_info_uo) is det.
 
 typecheck_info_set_unify_context(UnifyContext, TypeCheckInfo0, TypeCheckInfo) :-
-	TypeCheckInfo0 = typecheck_info(A,B,C,D,E,F,_,H,I,J,K,L,M),
-	TypeCheckInfo = typecheck_info(A,B,C,D,E,F,UnifyContext,H,I,J,K,L,M).
+	TypeCheckInfo0 = typecheck_info(A,B,C,D,E,F,_,H,I,J,K,L,M,N),
+	TypeCheckInfo = typecheck_info(A,B,C,D,E,F,UnifyContext,H,I,J,K,L,M,N).
 
 %-----------------------------------------------------------------------------%
 
@@ -2518,7 +2610,7 @@
 :- mode typecheck_info_get_varset(in, out) is det.
 
 typecheck_info_get_varset(TypeCheckInfo, VarSet) :-
-	TypeCheckInfo = typecheck_info(_,_,_,_,_,_,_,VarSet,_,_,_,_,_).
+	TypeCheckInfo = typecheck_info(_,_,_,_,_,_,_,VarSet,_,_,_,_,_,_).
 
 %-----------------------------------------------------------------------------%
 
@@ -2526,7 +2618,7 @@
 :- mode typecheck_info_get_type_assign_set(in, out) is det.
 
 typecheck_info_get_type_assign_set(TypeCheckInfo, TypeAssignSet) :-
-	TypeCheckInfo = typecheck_info(_,_,_,_,_,_,_,_,TypeAssignSet,_,_,_,_).
+	TypeCheckInfo = typecheck_info(_,_,_,_,_,_,_,_,TypeAssignSet,_,_,_,_,_).
 
 %-----------------------------------------------------------------------------%
 
@@ -2632,8 +2724,8 @@
 
 typecheck_info_set_type_assign_set(TypeCheckInfo0, TypeAssignSet, 
 					TypeCheckInfo) :-
-	TypeCheckInfo0 = typecheck_info(A,B,C,D,E,F,G,H,_,J,K,L,M),
-	TypeCheckInfo = typecheck_info(A,B,C,D,E,F,G,H,TypeAssignSet,J,K,L,M).
+	TypeCheckInfo0 = typecheck_info(A,B,C,D,E,F,G,H,_,J,K,L,M,N),
+	TypeCheckInfo = typecheck_info(A,B,C,D,E,F,G,H,TypeAssignSet,J,K,L,M,N).
 
 %-----------------------------------------------------------------------------%
 
@@ -2641,7 +2733,7 @@
 :- mode typecheck_info_get_found_error(typecheck_info_ui, out) is det.
 
 typecheck_info_get_found_error(TypeCheckInfo, FoundError) :-
-	TypeCheckInfo = typecheck_info(_,_,_,_,_,_,_,_,_,FoundError,_,_,_).
+	TypeCheckInfo = typecheck_info(_,_,_,_,_,_,_,_,_,FoundError,_,_,_,_).
 
 %-----------------------------------------------------------------------------%
 
@@ -2650,8 +2742,8 @@
 			typecheck_info_uo) is det.
 
 typecheck_info_set_found_error(TypeCheckInfo0, FoundError, TypeCheckInfo) :-
-	TypeCheckInfo0 = typecheck_info(A,B,C,D,E,F,G,H,I,_,K,L,M),
-	TypeCheckInfo = typecheck_info(A,B,C,D,E,F,G,H,I,FoundError,K,L,M).
+	TypeCheckInfo0 = typecheck_info(A,B,C,D,E,F,G,H,I,_,K,L,M,N),
+	TypeCheckInfo = typecheck_info(A,B,C,D,E,F,G,H,I,FoundError,K,L,M,N).
 
 %-----------------------------------------------------------------------------%
 
@@ -2659,7 +2751,8 @@
 :- mode typecheck_info_get_head_type_params(typecheck_info_ui, out) is det.
 
 typecheck_info_get_head_type_params(TypeCheckInfo, HeadTypeParams) :-
-	TypeCheckInfo = typecheck_info(_,_,_,_,_,_,_,_,_,_,HeadTypeParams,_,_).
+	TypeCheckInfo =
+		typecheck_info(_,_,_,_,_,_,_,_,_,_,HeadTypeParams,_,_,_).
 
 %-----------------------------------------------------------------------------%
 
@@ -2670,8 +2763,31 @@
 
 typecheck_info_set_head_type_params(TypeCheckInfo0, HeadTypeParams,
 					TypeCheckInfo) :-
-	TypeCheckInfo0 = typecheck_info(A,B,C,D,E,F,G,H,I,J,_,L,M),
-	TypeCheckInfo = typecheck_info(A,B,C,D,E,F,G,H,I,J,HeadTypeParams,L,M).
+	TypeCheckInfo0 = typecheck_info(A,B,C,D,E,F,G,H,I,J,_,L,M,N),
+	TypeCheckInfo =
+		typecheck_info(A,B,C,D,E,F,G,H,I,J,HeadTypeParams,L,M,N).
+
+%-----------------------------------------------------------------------------%
+
+:- pred typecheck_info_get_constraints(typecheck_info, list(class_constraint)).
+:- mode typecheck_info_get_constraints(typecheck_info_ui, out) is det.
+
+typecheck_info_get_constraints(TypeCheckInfo, Constraints) :-
+	TypeCheckInfo =
+		typecheck_info(_,_,_,_,_,_,_,_,_,_,_,Constraints,_,_).
+
+%-----------------------------------------------------------------------------%
+
+:- pred typecheck_info_set_constraints(typecheck_info,
+	list(class_constraint), typecheck_info).
+:- mode typecheck_info_set_constraints(typecheck_info_di, in, 
+			typecheck_info_uo) is det.
+
+typecheck_info_set_constraints(TypeCheckInfo0, Constraints,
+					TypeCheckInfo) :-
+	TypeCheckInfo0 = typecheck_info(A,B,C,D,E,F,G,H,I,J,K,_,M,N),
+	TypeCheckInfo =
+		typecheck_info(A,B,C,D,E,F,G,H,I,J,K,Constraints,M,N).
 
 %-----------------------------------------------------------------------------%
 
@@ -2680,7 +2796,7 @@
 			is det.
 
 typecheck_info_get_warned_about_overloading(TypeCheckInfo, Warned) :-
-	TypeCheckInfo = typecheck_info(_,_,_,_,_,_,_,_,_,_,_,Warned,_).
+	TypeCheckInfo = typecheck_info(_,_,_,_,_,_,_,_,_,_,_,_,Warned,_).
 
 %-----------------------------------------------------------------------------%
 
@@ -2691,8 +2807,8 @@
 
 typecheck_info_set_warned_about_overloading(TypeCheckInfo0, Warned,
 				TypeCheckInfo) :-
-	TypeCheckInfo0 = typecheck_info(A,B,C,D,E,F,G,H,I,J,K,_,M),
-	TypeCheckInfo = typecheck_info(A,B,C,D,E,F,G,H,I,J,K,Warned,M).
+	TypeCheckInfo0 = typecheck_info(A,B,C,D,E,F,G,H,I,J,K,L,_,N),
+	TypeCheckInfo = typecheck_info(A,B,C,D,E,F,G,H,I,J,K,L,Warned,N).
 
 %-----------------------------------------------------------------------------%
 
@@ -2700,7 +2816,7 @@
 :- mode typecheck_info_get_pred_import_status(typecheck_info_ui, out) is det.
 
 typecheck_info_get_pred_import_status(TypeCheckInfo, Status) :-
-	TypeCheckInfo = typecheck_info(_,_,_,_,_,_,_,_,_,_,_,_,Status).
+	TypeCheckInfo = typecheck_info(_,_,_,_,_,_,_,_,_,_,_,_,_,Status).
 
 :- pred typecheck_info_set_pred_import_status(typecheck_info, import_status,
 			typecheck_info).
@@ -2708,8 +2824,8 @@
 			typecheck_info_uo) is det.
 
 typecheck_info_set_pred_import_status(TypeCheckInfo0, Status, TypeCheckInfo) :-
-	TypeCheckInfo0 = typecheck_info(A,B,C,D,E,F,G,H,I,J,K,L,_),
-	TypeCheckInfo = typecheck_info(A,B,C,D,E,F,G,H,I,J,K,L,Status).
+	TypeCheckInfo0 = typecheck_info(A,B,C,D,E,F,G,H,I,J,K,L,M,_),
+	TypeCheckInfo = typecheck_info(A,B,C,D,E,F,G,H,I,J,K,L,M,Status).
 
 %-----------------------------------------------------------------------------%
 
@@ -2774,6 +2890,387 @@
 		ConsInfoList = ConsInfoList1
 	).
 
+	% Add  a set of constraints to each type_assign in the typecheck info.
+:- pred typecheck_info_add_type_assign_constraints(list(class_constraint),
+	typecheck_info, typecheck_info).
+:- mode typecheck_info_add_type_assign_constraints(in, typecheck_info_di, 
+	typecheck_info_uo) is det.
+
+typecheck_info_add_type_assign_constraints(NewConstraints, TypecheckInfo0,
+		TypecheckInfo) :-
+	typecheck_info_get_type_assign_set(TypecheckInfo0, TypeAssignSet0),
+	AddConstraints = lambda([TypeAssign0::in, TypeAssign::out] is det,
+		(
+		type_assign_get_typeclass_constraints(TypeAssign0,
+			OldConstraints), 
+		list__append(NewConstraints, OldConstraints, Constraints),
+		type_assign_set_typeclass_constraints(TypeAssign0,
+			Constraints, TypeAssign)
+		)),
+	list__map(AddConstraints, TypeAssignSet0, TypeAssignSet),
+	typecheck_info_set_type_assign_set(TypecheckInfo0, TypeAssignSet,
+		TypecheckInfo).
+
+%-----------------------------------------------------------------------------%
+
+	% typecheck_constraints(Inferring, TypeCheckInfo0, TypeCheckInfo)
+	%
+	% Produces TypeCheckInfo from TypeCheckInfo0 by rejecting any
+	% type_assign in TypeCheckInfo0 whose calculated typeclass constraints
+	% do not match the declared constraints.
+	%
+	% An appropriate error message is given if all type_assigns are 
+	% rejected.
+:- pred typecheck_constraints(bool, typecheck_info, typecheck_info).
+:- mode typecheck_constraints(in, typecheck_info_di, typecheck_info_uo) is det.
+
+	% XXX if we're inferring, don't bother checking the constraints at this
+	% XXX stage. Fix this up.
+typecheck_constraints(yes, TypeCheckInfo, TypeCheckInfo).
+typecheck_constraints(no, TypeCheckInfo0, TypeCheckInfo) :-
+		%get the declared constraints
+	typecheck_info_get_constraints(TypeCheckInfo0, DeclaredConstraints),
+
+	typecheck_info_get_type_assign_set(TypeCheckInfo0, TypeAssignSet0),
+
+	ConstraintsMatch = lambda([TypeAssign::in] is semidet,
+		(
+			type_assign_get_typeclass_constraints(TypeAssign,
+				CalculatedConstraints0),
+			type_assign_get_type_bindings(TypeAssign, Bindings),
+			apply_rec_subst_to_constraints(Bindings,
+				CalculatedConstraints0, CalculatedConstraints1),
+			list__sort_and_remove_dups(CalculatedConstraints1, 
+				CalculatedConstraints),
+				% XXX. This needs thought. _When_ exactly
+				% do two constraint sets match? This is
+				% certainly too strict.
+			CalculatedConstraints = DeclaredConstraints
+		)),
+
+		% reject any type assignment whose constraints don't match the
+		% declared ones
+	list__filter(ConstraintsMatch, TypeAssignSet0, TypeAssignSet),
+	(
+			% Check that we haven't just eliminated
+			% all the type assignments. 
+		TypeAssignSet = [], 
+		TypeAssignSet0 \= []
+	->
+		report_unsatisfied_constraints(TypeAssignSet0,
+			TypeCheckInfo0, TypeCheckInfo)
+	;
+		typecheck_info_set_type_assign_set(TypeCheckInfo0,
+			TypeAssignSet, TypeCheckInfo)
+	).
+
+%-----------------------------------------------------------------------------%
+
+:- pred report_unsatisfied_constraints(type_assign_set,
+	typecheck_info, typecheck_info).
+:- mode report_unsatisfied_constraints(in,
+	typecheck_info_di, typecheck_info_uo) is det.
+
+report_unsatisfied_constraints(TypeAssignSet, TypeCheckInfo0, TypeCheckInfo) :-
+	typecheck_info_get_io_state(TypeCheckInfo0, IOState0),
+
+	typecheck_info_get_constraints(TypeCheckInfo0, DeclaredConstraints),
+
+	typecheck_info_get_context(TypeCheckInfo0, Context),
+	write_context_and_pred_id(TypeCheckInfo0, IOState0, IOState1),
+	prog_out__write_context(Context, IOState1, IOState2),
+	io__write_string("  unsatisfied typeclass constraint(s):\n",
+		IOState2, IOState3),
+
+	WriteConstraints = lambda([TheTypeAssign::in, IO0::di, IO::uo] is det,
+		(
+			type_assign_get_typeclass_constraints(
+				TheTypeAssign, TheConstraints0),
+			type_assign_get_typevarset(TheTypeAssign, TheVarSet),
+			type_assign_get_type_bindings(TheTypeAssign, Bindings),
+			apply_rec_subst_to_constraints(Bindings,
+				TheConstraints0, TheConstraints1),
+			list__sort_and_remove_dups(TheConstraints1,
+				TheConstraints),
+			list__delete_elems(TheConstraints, DeclaredConstraints,
+				Unsatisfied),
+			prog_out__write_context(Context, IO0, IO1),
+			io__write_list(Unsatisfied, ", ",
+				mercury_output_constraint(TheVarSet), IO1, IO2),
+			io__write_char('\n', IO2, IO)
+		)),
+
+		% XXX this won't be very pretty when there are
+		% XXX multiple type_assigns.
+	io__write_list(TypeAssignSet, "\n", WriteConstraints, 
+		IOState3, IOState),
+
+	typecheck_info_set_io_state(TypeCheckInfo0, IOState, TypeCheckInfo1),
+	typecheck_info_set_found_error(TypeCheckInfo1, yes, TypeCheckInfo).
+
+%-----------------------------------------------------------------------------%
+
+% perform_context_reduction(TypeCheckInfo0, TypeCheckInfo) is true iff
+% 	TypeCheckInfo is the typecheck_info that results from performing
+% 	context reduction on the type_assigns in TypeCheckInfo0.
+%
+% 	Context reduction is the process of eliminating redundant constraints
+% 	from the constraints in the type_assign and adding the proof of the
+% 	constraint's redundancy to the proofs in the same type_assign. There
+% 	are two ways in which a constraint may be redundant:
+% 		- if there is an instance declaration that may be applied, the
+% 		  constraint is replaced by the constraints from that instance
+% 		  declaration
+% 		- if a constraint is present in the set of constraints and all
+% 		  of the "superclass" constraints for the constraints are all
+% 		  present, then all the superclass constraints are eliminated
+%
+% 	In addition, context reduction removes repeated constraints.
+%
+% 	If context reduction fails on a type_assign, that type_assign is
+% 	removed from the type_assign_set. Context reduction fails if there is
+%	a constraint where the type of (at least) one of the arguments to
+%	the constraint has its top level functor bound, but there is no
+%	instance declaration for that type.
+%
+%	If all type_assigns from the typecheck_info are rejected, than an
+%	appropriate error message is given.
+
+:- pred perform_context_reduction(typecheck_info, typecheck_info).
+:- mode perform_context_reduction(typecheck_info_di, typecheck_info_uo) is det.
+
+perform_context_reduction(TypeCheckInfo0, TypeCheckInfo) :-
+	typecheck_info_get_module_info(TypeCheckInfo0, ModuleInfo),
+	module_info_classes(ModuleInfo, ClassTable),
+	module_info_instances(ModuleInfo, InstanceTable),
+	typecheck_info_get_type_assign_set(TypeCheckInfo0, TypeAssignSet0),
+	list__filter_map(reduce_type_assign_context(ClassTable, InstanceTable), 
+		TypeAssignSet0, TypeAssignSet),
+	(
+			% Check that this context reduction hasn't eliminated
+			% all the type assignments.
+		TypeAssignSet = [], 
+		TypeAssignSet0 \= []
+	->
+		report_unsatisfied_constraints(TypeAssignSet0,
+			TypeCheckInfo0, TypeCheckInfo)
+	;
+		typecheck_info_set_type_assign_set(TypeCheckInfo0,
+			TypeAssignSet, TypeCheckInfo)
+	).
+
+	% XXX do we need to do this to fixpoint?
+:- pred reduce_type_assign_context(class_table, instance_table, 
+	type_assign, type_assign).
+:- mode reduce_type_assign_context(in, in, in, out) is semidet.
+
+reduce_type_assign_context(ClassTable, InstanceTable, 
+		TypeAssign0, TypeAssign) :-
+	type_assign_get_typeclass_constraints(TypeAssign0, Constraints0),
+	type_assign_get_type_bindings(TypeAssign0, Bindings),
+	type_assign_get_typevarset(TypeAssign0, Tvarset0),
+	type_assign_get_constraint_proofs(TypeAssign0, Proofs0),
+
+	typecheck__reduce_context_by_rule_application(InstanceTable, 
+		ClassTable, Bindings, Tvarset0, Tvarset, Proofs0, Proofs,
+		Constraints0, Constraints),
+
+	type_assign_set_typeclass_constraints(TypeAssign0, Constraints,
+		TypeAssign1),
+	type_assign_set_typevarset(TypeAssign1, Tvarset, TypeAssign2),
+	type_assign_set_constraint_proofs(TypeAssign2, Proofs, TypeAssign).
+
+
+typecheck__reduce_context_by_rule_application(InstanceTable, ClassTable, 
+		Bindings, Tvarset0, Tvarset, Proofs0, Proofs, 
+		Constraints0, Constraints) :-
+	apply_instance_rules(Constraints0, InstanceTable, Bindings, 
+		Tvarset0, Tvarset, Proofs0, Proofs1, Constraints1),
+	apply_class_rules(Constraints1, ClassTable, Bindings, Tvarset,
+		Proofs1, Proofs, Constraints2),
+	list__sort_and_remove_dups(Constraints2, Constraints).
+
+:- pred apply_instance_rules(list(class_constraint), instance_table,
+	tsubst, tvarset, tvarset, map(class_constraint, constraint_proof),
+	map(class_constraint, constraint_proof), list(class_constraint)).
+:- mode apply_instance_rules(in, in, in, in, out, in, out, out) is semidet.
+
+apply_instance_rules([], _, _, Names, Names, Proofs, Proofs, []).
+apply_instance_rules([C|Cs], InstanceTable, Bindings, 
+		TypeNames, NewTypeNames, Proofs0, Proofs, Constraints) :-
+	C = constraint(ClassName, Types0),
+	list__length(Types0, Arity),
+	map__lookup(InstanceTable, class_id(ClassName, Arity), Instances),
+	term__apply_rec_substitution_to_list(Types0, Bindings, Types),
+	(
+		find_matching_instance_rule(Instances, ClassName, Types,
+			TypeNames, NewTypeNames0, Proofs0, Proofs1,
+			NewConstraints0)
+	->
+			% Put the new constraints at the front of the list
+		NewConstraints = NewConstraints0,
+		NewTypeNames1 = NewTypeNames0,
+		Proofs2 = Proofs1
+	;
+			% Put the old constraint at the front of the list
+		NewConstraints = [C],
+		NewTypeNames1 = TypeNames,
+		Proofs2 = Proofs0
+	),
+	apply_instance_rules(Cs, InstanceTable, Bindings, NewTypeNames1,
+		NewTypeNames, Proofs2, Proofs, TheRest),
+	list__append(NewConstraints, TheRest, Constraints).
+
+	% We take the first matching instance rule that we can find; any
+	% overlapping instance declarations will have been caught earlier.
+
+	% This pred also catches tautological constraints since the
+	% NewConstraints will be [].
+
+	% XXX Surely we shouldn't need to re-name the variables and return
+	% XXX a new varset: this substitution should have been worked out
+	% XXX before, as these varsets would already have been merged.
+:- pred find_matching_instance_rule(list(hlds_instance_defn), sym_name,
+	list(type), tvarset, tvarset, map(class_constraint, constraint_proof), 
+	map(class_constraint, constraint_proof), list(class_constraint)).
+:- mode find_matching_instance_rule(in, in, in, in, out, in, out, out) 
+	is semidet.
+
+find_matching_instance_rule(Instances, ClassName, Types, TypeNames,
+		NewTypeNames, Proofs0, Proofs, NewConstraints) :-
+		
+		% Start a counter so we remember which instance decl we have	
+		% used.
+	find_matching_instance_rule2(Instances, 1, ClassName, Types,
+		TypeNames, NewTypeNames, Proofs0, Proofs, NewConstraints).
+
+:- pred find_matching_instance_rule2(list(hlds_instance_defn), int,
+	sym_name, list(type), tvarset, tvarset,
+	map(class_constraint, constraint_proof), 
+	map(class_constraint, constraint_proof), list(class_constraint)).
+:- mode find_matching_instance_rule2(in, in, in, in, in, out, in, out, out) 
+	is semidet.
+
+find_matching_instance_rule2([I|Is], N0, ClassName, Types, TypeNames,
+		NewTypeNames, Proofs0, Proofs, NewConstraints) :-
+	I = hlds_instance_defn(ModuleName, NewConstraints0, InstanceTypes0,
+		Interface, PredProcIds, InstanceNames, SuperClassProofs),
+	(
+		varset__merge_subst(TypeNames, InstanceNames, NewTypeNames0,
+			RenameSubst),
+		term__apply_rec_substitution_to_list(InstanceTypes0,
+			RenameSubst, InstanceTypes),
+		type_list_subsumes(InstanceTypes, Types, Subst)
+	->
+		apply_rec_subst_to_constraints(RenameSubst, NewConstraints0,
+			NewConstraints1),
+		apply_rec_subst_to_constraints(Subst, NewConstraints1,
+			NewConstraints),
+		NewTypeNames = NewTypeNames0,
+		NewProof = apply_instance(hlds_instance_defn(ModuleName,
+			NewConstraints, InstanceTypes, Interface, PredProcIds,
+			InstanceNames, SuperClassProofs), N0),
+		Constraint = constraint(ClassName, Types),
+		map__set(Proofs0, Constraint, NewProof, Proofs)
+	;
+		N is N0 + 1,
+		find_matching_instance_rule2(Is, N, ClassName,
+			Types, TypeNames, NewTypeNames, Proofs0,
+			Proofs, NewConstraints)
+	).
+
+	% To reduce the context using class declarations, we scan the 
+	% context one constraint at a time. For each class in the constraint,
+	% we check to see if any of its superclasses is also a constraint, and 
+	% if so, delete the superclass from the constraint list as it is
+	% redundant.
+:- pred apply_class_rules(list(class_constraint), class_table,
+	tsubst, tvarset, map(class_constraint, constraint_proof),
+	map(class_constraint, constraint_proof), list(class_constraint)).
+:- mode apply_class_rules(in, in, in, in, in, out, out) is det.
+
+apply_class_rules(Constraints0, ClassTable, Bindings, TypeNames, 
+		Proofs0, Proofs, Constraints) :-
+	apply_class_rules2(Constraints0, Constraints0, ClassTable, Bindings,
+		TypeNames, Proofs0, Proofs, Constraints).
+
+:- pred apply_class_rules2(list(class_constraint), list(class_constraint),
+	class_table, tsubst, tvarset, map(class_constraint, constraint_proof),
+	map(class_constraint, constraint_proof), list(class_constraint)).
+:- mode apply_class_rules2(in, in, in, in, in, in, out, out) is det.
+
+	% The first argument is the list of constraints left to be checked.
+	% The second argument is the list of constraints that have not been
+	% rejected. If a redundant constraint is found, it is deleted from
+	% both (if it is still in the first list).
+apply_class_rules2([], Constraints, _, _, _, Proofs, Proofs, Constraints).
+apply_class_rules2([C|Cs], AllConstraints, ClassTable, Bindings, TypeNames,
+		Proofs0, Proofs, Constraints) :-
+	C = constraint(ClassName, Types0),
+	list__length(Types0, Arity),
+	ClassId = class_id(ClassName, Arity),
+	map__lookup(ClassTable, ClassId, ClassDefn),
+	term__apply_rec_substitution_to_list(Types0, Bindings, Types),
+	ClassDefn = hlds_class_defn(ParentClassConstraints0, ClassVars,
+		_ClassInterface, ClassVarset),
+	term__var_list_to_term_list(ClassVars, ClassTypes),
+		% XXX Can we really ignore _NewTypeNames?
+	varset__merge_subst(TypeNames, ClassVarset, _NewTypeNames, RenameSubst),
+	term__apply_rec_substitution_to_list(ClassTypes, RenameSubst,
+		NewClassTypes),
+	apply_rec_subst_to_constraints(RenameSubst, ParentClassConstraints0,
+		ParentClassConstraints),
+	IsRedundant = lambda(
+			[ThisConstraint::in, RenamedConstraint::out] is semidet,
+		(
+			type_list_subsumes(NewClassTypes, Types, Subst),
+			apply_rec_subst_to_constraint(Subst, ThisConstraint,
+				RenamedConstraint),
+			list__member(RenamedConstraint, AllConstraints)
+		)),
+	list__filter_map(IsRedundant, ParentClassConstraints,
+		RedundantConstraints),
+
+		% Delete the redundant constraints
+	list__delete_elems(AllConstraints, RedundantConstraints,
+		NewConstraints),
+	list__delete_elems(Cs, RedundantConstraints, NewCs),
+
+		% Remember why the constraints were redundant
+	RecordRedundancy = lambda([ConstraintName::in, TheProofs0::in,
+					TheProofs::out] is det,
+		(
+			map__set(TheProofs0, ConstraintName, superclass(C), 
+				TheProofs)
+		)),
+	list__foldl(RecordRedundancy, RedundantConstraints, Proofs0, Proofs1),
+
+	apply_class_rules2(NewCs, NewConstraints, ClassTable, Bindings,
+		TypeNames, Proofs1, Proofs, Constraints).
+
+%-----------------------------------------------------------------------------%
+
+:- pred record_class_constraint_proofs(pred_info, typecheck_info,
+	pred_info).
+:- mode record_class_constraint_proofs(in, typecheck_info_ui, out) is det.
+
+record_class_constraint_proofs(PredInfo0, TypeCheckInfo, PredInfo) :-
+	typecheck_info_get_type_assign_set(TypeCheckInfo, TypeAssignSet),
+	(
+		TypeAssignSet = [TypeAssign]
+	->
+		type_assign_get_constraint_proofs(TypeAssign, Proofs),
+		pred_info_set_constraint_proofs(PredInfo0, Proofs,
+			PredInfo)
+	;
+			% If there's not exactly one type_assign, don't
+			% bother recording the proofs since an error has
+			% occured, and will have been noted elsewhere
+		PredInfo = PredInfo0
+	).
+
+%-----------------------------------------------------------------------------%
+
 :- pred convert_cons_defn_list(typecheck_info, list(hlds_cons_defn),
 				list(cons_type_info)).
 :- mode convert_cons_defn_list(typecheck_info_ui, in, out) is det.
@@ -2805,7 +3302,14 @@
 :- type type_assign	--->	type_assign(
 					map(var, type),		% var types
 					tvarset,		% type names
-					tsubst			% type bindings
+					tsubst,			% type bindings
+					list(class_constraint),	% typeclass
+								% constraints
+					map(class_constraint,	% for each
+					    constraint_proof)	% constraint
+					    			% found to be
+								% redundant,
+								% why is it so?
 				).
 
 %-----------------------------------------------------------------------------%
@@ -2816,45 +3320,79 @@
 :- pred type_assign_get_var_types(type_assign, map(var, type)).
 :- mode type_assign_get_var_types(in, out) is det.
 
-type_assign_get_var_types(type_assign(VarTypes, _, _), VarTypes).
+type_assign_get_var_types(type_assign(VarTypes, _, _, _, _), VarTypes).
 
 %-----------------------------------------------------------------------------%
 
 :- pred type_assign_get_typevarset(type_assign, tvarset).
 :- mode type_assign_get_typevarset(in, out) is det.
 
-type_assign_get_typevarset(type_assign(_, TypeVarSet, _), TypeVarSet).
+type_assign_get_typevarset(type_assign(_, TypeVarSet, _, _, _), TypeVarSet).
 
 %-----------------------------------------------------------------------------%
 
 :- pred type_assign_get_type_bindings(type_assign, tsubst).
 :- mode type_assign_get_type_bindings(in, out) is det.
 
-type_assign_get_type_bindings(type_assign(_, _, TypeBindings), TypeBindings).
+type_assign_get_type_bindings(type_assign(_, _, TypeBindings, _, _),
+	TypeBindings).
+%-----------------------------------------------------------------------------%
+
+:- pred type_assign_get_typeclass_constraints(type_assign,
+	list(class_constraint)).
+:- mode type_assign_get_typeclass_constraints(in, out) is det.
 
+type_assign_get_typeclass_constraints(type_assign(_, _, _, Constraints, _),
+	Constraints).
+
+%-----------------------------------------------------------------------------%
+
+:- pred type_assign_get_constraint_proofs(type_assign,
+	map(class_constraint, constraint_proof)).
+:- mode type_assign_get_constraint_proofs(in, out) is det.
+
+type_assign_get_constraint_proofs(type_assign(_, _, _, _, Proofs), Proofs).  
 %-----------------------------------------------------------------------------%
 
 :- pred type_assign_set_var_types(type_assign, map(var, type), type_assign).
 :- mode type_assign_set_var_types(in, in, out) is det.
 
-type_assign_set_var_types(type_assign(_, B, C), VarTypes,
-			type_assign(VarTypes, B, C)).
+type_assign_set_var_types(type_assign(_, B, C, D, E), VarTypes,
+			type_assign(VarTypes, B, C, D, E)).
 
 %-----------------------------------------------------------------------------%
 
 :- pred type_assign_set_typevarset(type_assign, tvarset, type_assign).
 :- mode type_assign_set_typevarset(in, in, out) is det.
 
-type_assign_set_typevarset(type_assign(A, _, C), TypeVarSet,
-			type_assign(A, TypeVarSet, C)).
+type_assign_set_typevarset(type_assign(A, _, C, D, E), TypeVarSet,
+			type_assign(A, TypeVarSet, C, D, E)).
 
 %-----------------------------------------------------------------------------%
 
 :- pred type_assign_set_type_bindings(type_assign, tsubst, type_assign).
 :- mode type_assign_set_type_bindings(in, in, out) is det.
 
-type_assign_set_type_bindings(type_assign(A, B, _), TypeBindings,
-			type_assign(A, B, TypeBindings)).
+type_assign_set_type_bindings(type_assign(A, B, _, D, E), TypeBindings,
+			type_assign(A, B, TypeBindings, D, E)).
+
+%-----------------------------------------------------------------------------%
+
+:- pred type_assign_set_typeclass_constraints(type_assign,
+	list(class_constraint), type_assign).
+:- mode type_assign_set_typeclass_constraints(in, in, out) is det.
+
+type_assign_set_typeclass_constraints(type_assign(A, B, C, _, E), Constraints,
+			type_assign(A, B, C, Constraints, E)).
+
+%-----------------------------------------------------------------------------%
+
+:- pred type_assign_set_constraint_proofs(type_assign,
+	map(class_constraint, constraint_proof), type_assign).
+:- mode type_assign_set_constraint_proofs(in, in, out) is det.
+
+type_assign_set_constraint_proofs(type_assign(A, B, C, D, _),
+			Proofs, type_assign(A, B, C, D, Proofs)).
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
@@ -2899,16 +3437,17 @@
 	{ pred_info_arg_types(PredInfo, VarSet, Types0) },
 	{ strip_builtin_qualifiers_from_type_list(Types0, Types) },
 	{ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc) },
+	{ pred_info_get_class_context(PredInfo, ClassContext) },
 	{ MaybeDet = no },
 	prog_out__write_context(Context),
 	io__write_string("Inferred "),
 	(	{ PredOrFunc = predicate },
 		mercury_output_pred_type(VarSet, Name, Types, MaybeDet,
-			Context)
+			ClassContext, Context)
 	;	{ PredOrFunc = function },
 		{ pred_args_to_func_args(Types, ArgTypes, RetType) },
 		mercury_output_func_type(VarSet, Name, ArgTypes,
-			RetType, MaybeDet, Context)
+			RetType, MaybeDet, ClassContext, Context)
 	).
 
 %-----------------------------------------------------------------------------%
@@ -3417,7 +3956,8 @@
 :- mode write_args_type_assign_set(in, in, di, uo) is det.
 
 write_args_type_assign_set([], _) --> [].
-write_args_type_assign_set([TypeAssign - _ArgTypes| TypeAssigns], VarSet) -->
+write_args_type_assign_set([args(TypeAssign, _ArgTypes, _Cnstrs)| TypeAssigns], 
+		VarSet) -->
 	io__write_string("\t"),
 	write_type_assign(TypeAssign, VarSet),
 	io__write_string("\n"),
@@ -3873,7 +4413,7 @@
 					    cons(Constructor, N),
 					    _)),
 				ActualArities) },
-			{ ActualArities = [_|_] }
+			{ ActualArities \= [] }
 		->
 			report_wrong_arity_constructor(Constructor, Arity,
 				ActualArities, Context)
Index: compiler/unify_gen.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/unify_gen.m,v
retrieving revision 1.83
diff -u -r1.83 unify_gen.m
--- unify_gen.m	1997/09/01 14:05:29	1.83
+++ unify_gen.m	1997/09/08 04:13:25
@@ -202,6 +202,9 @@
 unify_gen__generate_tag_rval_2(base_type_info_constant(_, _, _), _, _) :-
 	% This should never happen
 	error("Attempted base_type_info unification").
+unify_gen__generate_tag_rval_2(base_typeclass_info_constant(_, _, _), _, _) :-
+	% This should never happen
+	error("Attempted base_typeclass_info unification").
 unify_gen__generate_tag_rval_2(no_tag, _Rval, TestRval) :-
 	TestRval = const(true).
 unify_gen__generate_tag_rval_2(simple_tag(SimpleTag), Rval, TestRval) :-
@@ -290,11 +293,21 @@
 	( { Args = [] } ->
 		[]
 	;
-		{ error("unify_gen: address constant has args") }
+		{ error("unify_gen: type-info constant has args") }
 	),
 	{ Code = empty },
 	code_info__cache_expression(Var, const(data_addr_const(data_addr(
 		ModuleName, base_type(info, TypeName, TypeArity))))).
+unify_gen__generate_construction_2(base_typeclass_info_constant(ModuleName,
+		ClassId, Instance), Var, Args, _Modes, Code) -->
+	( { Args = [] } ->
+		[]
+	;
+		{ error("unify_gen: typeclass-info constant has args") }
+	),
+	{ Code = empty },
+	code_info__cache_expression(Var, const(data_addr_const(data_addr(
+		ModuleName, base_typeclass_info(ClassId, Instance))))).
 unify_gen__generate_construction_2(code_addr_constant(PredId, ProcId),
 		Var, Args, _Modes, Code) -->
 	( { Args = [] } ->
@@ -546,6 +559,9 @@
 		{ Code = empty }
 	;
 		{ Tag = base_type_info_constant(_, _, _) },
+		{ Code = empty }
+	;
+		{ Tag = base_typeclass_info_constant(_, _, _) },
 		{ Code = empty }
 	;
 		{ Tag = no_tag },
Index: compiler/unique_modes.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/unique_modes.m,v
retrieving revision 1.40
diff -u -r1.40 unique_modes.m
--- unique_modes.m	1997/09/15 21:12:50	1.40
+++ unique_modes.m	1997/10/23 05:31:18
@@ -495,6 +495,26 @@
 	mode_info_unset_call_context,
 	mode_checkpoint(exit, "higher-order call").
 
+unique_modes__check_goal_2(class_method_call(TCVar, Num, Args, Types, Modes,
+		Det), _GoalInfo0, Goal) -->
+	mode_checkpoint(enter, "class method call"),
+		% This is a little white lie. However, since there can't
+		% really be a unique mode error in a class_method_call, this
+		% lie will never be used. There can't be an error because the
+		% class_method_call is introduced by the compiler as the body
+		% of a class method.
+	mode_info_set_call_context(higher_order_call(predicate)),
+	{ determinism_components(Det, _, at_most_zero) ->
+		NeverSucceeds = yes
+	;
+		NeverSucceeds = no
+	},
+	{ determinism_to_code_model(Det, CodeModel) },
+	unique_modes__check_call_modes(Args, Modes, CodeModel, NeverSucceeds),
+	{ Goal = class_method_call(TCVar, Num, Args, Types, Modes, Det) },
+	mode_info_unset_call_context,
+	mode_checkpoint(exit, "class method call").
+
 unique_modes__check_goal_2(call(PredId, ProcId, Args, Builtin, CallContext,
 		PredName), _GoalInfo0, Goal) -->
 	mode_checkpoint(enter, "call"),
Index: compiler/unused_args.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/unused_args.m,v
retrieving revision 1.35
diff -u -r1.35 unused_args.m
--- unused_args.m	1997/09/01 14:05:44	1.35
+++ unused_args.m	1997/10/23 00:54:37
@@ -394,6 +394,10 @@
 traverse_goal(_, higher_order_call(PredVar,Args,_,_,_,_), UseInf0, UseInf) :-
 	set_list_vars_used(UseInf0, [PredVar|Args], UseInf).
 
+% we assume that class method calls use all variables involved
+traverse_goal(_, class_method_call(PredVar,_,Args,_,_,_), UseInf0, UseInf) :-
+	set_list_vars_used(UseInf0, [PredVar|Args], UseInf).
+
 % handle pragma(c_code, ...) - pragma_c_code uses all its args
 traverse_goal(_, pragma_c_code(_, _, _, _, Args, _, _, _), UseInf0, UseInf) :-
 	set_list_vars_used(UseInf0, Args, UseInf).
@@ -885,11 +889,15 @@
 	pred_info_clauses_info(PredInfo0, ClausesInfo),
 	pred_info_get_marker_list(PredInfo0, MarkerList),
 	pred_info_get_goal_type(PredInfo0, GoalType),
+	map__init(EmptyProofs),
 		% *** This will need to be fixed when the condition
 		%	field of the pred_info becomes used.
+		% XXX
+		% XXX The class context shouldn't be empty!!!
+		% XXX
 	pred_info_init(PredModule, qualified(PredModule, Name), Arity, Tvars,
 		ArgTypes, true, Context, ClausesInfo, Status, MarkerList,
-		GoalType, PredOrFunc, PredInfo1),
+		GoalType, PredOrFunc, [], EmptyProofs, PredInfo1),
 	pred_info_set_typevarset(PredInfo1, TypeVars, PredInfo).
 
 
@@ -1188,6 +1196,10 @@
 fixup_goal_expr(_ModuleInfo, _UnusedVars, _ProcCallInfo, no,
 			GoalExpr - GoalInfo, GoalExpr - GoalInfo) :-
 	GoalExpr = higher_order_call(_, _, _, _, _, _).
+
+fixup_goal_expr(_ModuleInfo, _UnusedVars, _ProcCallInfo, no,
+			GoalExpr - GoalInfo, GoalExpr - GoalInfo) :-
+	GoalExpr = class_method_call(_, _, _, _, _, _).
 
 fixup_goal_expr(_ModuleInfo, _UnusedVars, _ProcCallInfo, no,
 			GoalExpr - GoalInfo, GoalExpr - GoalInfo) :-
Index: compiler/notes/compiler_design.html
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/notes/compiler_design.html,v
retrieving revision 1.8
diff -u -r1.8 compiler_design.html
--- compiler_design.html	1997/11/08 13:12:08	1.8
+++ compiler_design.html	1997/11/17 02:39:48
@@ -125,8 +125,9 @@
 	<br>
  	Notes on module qualification:
 	<ul>
- 	<li> all types, insts and modes occuring in pred, func, type and
- 	  mode declarations are module qualified by module_qual.m.
+	<li> all types, typeclasses, insts and modes occuring in pred, func,
+	  type, typeclass and mode declarations are module qualified by
+	  module_qual.m.
  	<li> all types, insts and modes occuring in lambda expressions and
  	  explicit type qualifications are module qualified in
  	  make_hlds.m.
@@ -134,6 +135,8 @@
  	  are module qualified during type checking.
  	<li> predicate and function calls and constructors within goals 
  	  are module qualified during mode analysis.
+ 	<li> predicate and function names in typeclass instance declarations
+	  are qualified in check_typeclass.m (after mode analysis).
 	</ul>
  
 
Index: library/mercury_builtin.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/mercury_builtin.m,v
retrieving revision 1.84
diff -u -r1.84 mercury_builtin.m
--- mercury_builtin.m	1997/10/14 09:27:19	1.84
+++ mercury_builtin.m	1997/11/20 07:51:34
@@ -229,10 +229,27 @@
 	% they depend on the number of type parameters of the type represented
 	% by the type_info, and how many predicates we associate with each
 	% type.
+	%
+	% Note that, since these types look to the compiler as though they
+	% are candidates to become no_tag types, special code is required in
+	% type_util:type_is_no_tag_type/3.
 
 :- type type_info(T) ---> type_info(base_type_info(T) /*, ... */).
 :- type base_type_info(T) ---> base_type_info(int /*, ... */).
 
+	% Note that, since these types look to the compiler as though they
+	% are candidates to become no_tag types, special code is required in
+	% type_util:type_is_no_tag_type/3.
+
+:- type typeclass_info ---> typeclass_info(base_typeclass_info /*, ... */). 
+:- type base_typeclass_info ---> typeclass_info(int /*, ... */). 
+
+:- pred type_info_from_typeclass_info(typeclass_info, int, type_info(T)).
+:- mode type_info_from_typeclass_info(in, in, out) is det.
+
+:- pred superclass_from_typeclass_info(typeclass_info, int, typeclass_info).
+:- mode superclass_from_typeclass_info(in, in, out) is det.
+
 	% the builtin < operator on ints, used in the code generated
 	% for compare/3 preds
 :- pred builtin_int_lt(int, int).
@@ -252,6 +269,21 @@
 
 % Many of the predicates defined in this module are builtin -
 % the compiler generates code for them inline.
+
+:- pragma c_code(will_not_call_mercury, 
+	type_info_from_typeclass_info(TypeClassInfo::in, Index::in,
+		TypeInfo::out),
+" 
+	TypeInfo = MR_typeclass_info_type_info(TypeClassInfo, Index);
+").
+
+:- pragma c_code(will_not_call_mercury, 
+	superclass_from_typeclass_info(TypeClassInfo0::in, Index::in,
+		TypeClassInfo::out),
+" 
+	TypeClassInfo = 
+		MR_typeclass_info_superclass_info(TypeClassInfo0, Index);
+").
 
 %-----------------------------------------------------------------------------%
 
Index: library/ops.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/ops.m,v
retrieving revision 1.18
diff -u -r1.18 ops.m
--- ops.m	1997/07/27 15:07:00	1.18
+++ ops.m	1997/09/17 04:20:51
@@ -187,6 +187,7 @@
 ops__op_table("import_sym", before, fx, 1199).	% Mercury extension (NYI)
 ops__op_table("import_type", before, fx, 1199).	% Mercury extension (NYI)
 ops__op_table("inst", before, fx, 1199).	% Mercury extension
+ops__op_table("instance", before, fx, 1199).	% Mercury extension
 ops__op_table("is", after, xfx, 701).		% ISO Prolog says prec 700
 ops__op_table("lambda", before, fxy, 950).	% Mercury extension
 ops__op_table("mod", after, xfx, 400).		% Standard ISO Prolog
@@ -201,6 +202,7 @@
 ops__op_table("some", before, fxy, 950).	% Mercury/NU-Prolog extension
 ops__op_table("then", after, xfx, 1150).	% Mercury/NU-Prolog extension
 ops__op_table("type", before, fx, 1180).	% Mercury extension
+ops__op_table("typeclass", before, fx, 1199).	% Mercury extension
 ops__op_table("use_adt", before, fx, 1199).	% Mercury extension (NYI)
 ops__op_table("use_cons", before, fx, 1199).	% Mercury extension (NYI)
 ops__op_table("use_module", before, fx, 1199).	% Mercury extension (NYI)
Index: library/string.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/string.m,v
retrieving revision 1.96
diff -u -r1.96 string.m
--- string.m	1997/10/11 16:11:25	1.96
+++ string.m	1997/10/14 07:01:20
@@ -20,7 +20,7 @@
 :- import_module list, char.
 
 :- pred string__length(string, int).
-:- mode string__length(in, out) is det.
+:- mode string__length(in, uo) is det.
 	% Determine the length of a string.
 	% An empty string has length zero.
 
@@ -1647,7 +1647,7 @@
 :- pred string__length(string, int).
 :- mode string__length(in, out) is det.
 */
-:- pragma(c_code, string__length(Str::in, Length::out), "
+:- pragma(c_code, string__length(Str::in, Length::uo), "
 	Length = strlen(Str);
 ").
 
Index: runtime/mercury_ho_call.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_ho_call.c,v
retrieving revision 1.1
diff -u -r1.1 mercury_ho_call.c
--- mercury_ho_call.c	1997/11/20 02:00:20	1.1
+++ mercury_ho_call.c	1997/11/21 00:02:42
@@ -96,6 +96,8 @@
 	call((Code *) field(0, closure, 1), LABEL(det_closure_return),
 		LABEL(do_call_det_closure));
 }
+	/* This is used as a return label both by do_call_det_closure and
+	* do_call_det_class_method */
 Define_label(det_closure_return);
 {
 	int	i, num_in_args, num_out_args;
@@ -168,6 +170,8 @@
 	call((Code *) field(0, closure, 1), LABEL(semidet_closure_return),
 		LABEL(do_call_semidet_closure));
 }
+	/* This is used as a return label both by do_call_semidet_closure and
+	* do_call_semidet_class_method */
 Define_label(semidet_closure_return);
 {
 	int	i, num_in_args, num_out_args;
@@ -225,6 +229,8 @@
 	call((Code *) field(0, closure, 1), LABEL(nondet_closure_return),
 		LABEL(do_call_nondet_closure));
 }
+	/* This is used as a return label both by do_call_nondet_closure and
+	* do_call_nondet_class_method */
 Define_label(nondet_closure_return);
 {
 	int	i, num_in_args, num_out_args;
@@ -244,6 +250,138 @@
 #endif
 
 	succeed();
+}
+
+
+
+
+
+	/*
+	 * r1: the typeclass_info
+	 * r2: index of class method
+	 * r3: number of immediate input arguments
+	 * r4: number of output arguments
+	 * r5+:input args
+	 */
+Define_entry(do_call_det_class_method);
+{
+	Code 	*destination;
+	int	i, num_in_args, num_arg_typeclass_infos;
+
+	destination = MR_typeclass_info_class_method(r1, r2);
+	num_arg_typeclass_infos = (int)MR_typeclass_info_instance_arity(r1);
+
+	num_in_args = r3; /* number of input args */
+
+	push(r4); /* The number of output args to unpack */
+	push(num_in_args); /* The number of input args */
+	push(succip);
+
+	save_registers();
+
+	if (num_arg_typeclass_infos < 4) {
+			/* copy to the left, from the left */
+		for (i = 1; i <= num_in_args; i++) {
+			virtual_reg(i+num_arg_typeclass_infos) =
+				virtual_reg(i+4);
+		}
+	} else if (num_arg_typeclass_infos > 4) {
+			/* copy to the right, from the right */
+		for (i = num_in_args; i > 0; i--) {
+			virtual_reg(i+num_arg_typeclass_infos) =
+				virtual_reg(i+4);
+		}
+	} /* else do nothing because num_arg_typeclass_infos == 4 */
+
+	for (i = num_arg_typeclass_infos; i > 0; i--) {
+		virtual_reg(i) = 
+			MR_typeclass_info_arg_typeclass_info(virtual_reg(1),i);
+	}
+
+	restore_registers();
+
+	call(destination, LABEL(det_closure_return),
+		LABEL(do_call_det_class_method));
+}
+
+Define_entry(do_call_semidet_class_method);
+{
+	Code 	*destination;
+	int	i, num_in_args, num_arg_typeclass_infos;
+
+	destination = MR_typeclass_info_class_method(r1, r2);
+	num_arg_typeclass_infos = (int)MR_typeclass_info_instance_arity(r1);
+
+	num_in_args = r3; /* number of input args */
+
+	push(r4); /* The number of output args to unpack */
+	push(num_in_args); /* The number of input args */
+	push(succip);
+
+	save_registers();
+
+	if (num_arg_typeclass_infos < 4) {
+			/* copy to the left, from the left */
+		for (i = 1; i <= num_in_args; i++) {
+			virtual_reg(i) = virtual_reg(i+4);
+		}
+	} else if (num_arg_typeclass_infos > 4) {
+			/* copy to the right, from the right */
+		for (i = num_in_args; i > 0; i--) {
+			virtual_reg(i+num_arg_typeclass_infos) =
+				virtual_reg(i+4);
+		}
+	} /* else do nothing because num_arg_typeclass_infos == 4 */
+
+	for (i = num_arg_typeclass_infos; i > 0; i--) {
+		virtual_reg(i) = 
+			MR_typeclass_info_arg_typeclass_info(virtual_reg(1),i);
+	}
+
+	restore_registers();
+
+	call(destination, LABEL(semidet_closure_return),
+		LABEL(do_call_semidet_class_method));
+}
+
+Define_entry(do_call_nondet_class_method);
+{
+	Code 	*destination;
+	int	i, num_in_args, num_arg_typeclass_infos;
+
+	destination = MR_typeclass_info_class_method(r1, r2);
+	num_arg_typeclass_infos = (int)MR_typeclass_info_instance_arity(r1);
+
+	num_in_args = r3; /* number of input args */
+
+	mkframe("do_call_nondet_class_method", 2, ENTRY(do_fail));
+	framevar(0) = r4;	   /* The number of output args to unpack */
+	framevar(1) = num_in_args; /* The number of input args */
+
+	save_registers();
+
+	if (num_arg_typeclass_infos < 4) {
+			/* copy to the left, from the left */
+		for (i = 1; i <= num_in_args; i++) {
+			virtual_reg(i) = virtual_reg(i+4);
+		}
+	} else if (num_arg_typeclass_infos > 4) {
+			/* copy to the right, from the right */
+		for (i = num_in_args; i > 0; i--) {
+			virtual_reg(i+num_arg_typeclass_infos) =
+				virtual_reg(i+4);
+		}
+	} /* else do nothing because num_arg_typeclass_infos == 4 */
+
+	for (i = num_arg_typeclass_infos; i > 0; i--) {
+		virtual_reg(i) = 
+			MR_typeclass_info_arg_typeclass_info(virtual_reg(1),i);
+	}
+
+	restore_registers();
+
+	call(destination, LABEL(nondet_closure_return),
+		LABEL(do_call_nondet_class_method));
 }
 
 /*
Index: runtime/mercury_type_info.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_type_info.h,v
retrieving revision 1.1
diff -u -r1.1 mercury_type_info.h
--- mercury_type_info.h	1997/11/20 02:01:22	1.1
+++ mercury_type_info.h	1997/11/20 23:46:48
@@ -774,6 +774,30 @@
 
 /*
 ** definitions for accessing the representation of the
+** Mercury typeclass_info
+*/
+
+#define	MR_typeclass_info_instance_arity(tci) \
+	(Integer)(*(Word **)(tci))[0]
+#define	MR_typeclass_info_class_method(tci, n) \
+	(Code *)(*(Word **)tci)[(n)]
+#define	MR_typeclass_info_arg_typeclass_info(tci, n) \
+	((Word *)(tci))[(n)]
+
+	/*
+	** The following have the same definitions. This is because 
+	** the call to MR_typeclass_info_type_info must already have the
+	** number of superclass_infos for the class added to it
+	*/
+#define	MR_typeclass_info_superclass_info(tci, n) \
+	((Word *)(tci))[MR_typeclass_info_instance_arity(tci) + (n)]
+#define	MR_typeclass_info_type_info(tci, n) \
+	((Word *)(tci))[MR_typeclass_info_instance_arity(tci) + (n)]
+
+/*---------------------------------------------------------------------------*/
+
+/*
+** definitions for accessing the representation of the
 ** Mercury `array' type
 */
 


love and cuddles,
dgj
-- 
David Jeffery (dgj at cs.mu.oz.au) |  Marge: Did you just call everyone "chicken"?
MEngSc student,                 |  Homer: Noooo.  I swear on this Bible!
Department of Computer Science  |  Marge: That's not a Bible; that's a book of
University of Melbourne         |         carpet samples!
Australia                       |  Homer: Ooooh... Fuzzy.



More information about the developers mailing list