diff: typeclasses (round 2) [2/4]

David Glen JEFFERY dgj at cs.mu.oz.au
Thu Dec 18 19:01:11 AEDT 1997


Here's the changes to the compiler:

-------------------------------------------------------------------------------
diff -u -r compiler/bytecode.m /home/pgrad/dgj/mer/work/mercury/compiler/bytecode.m
--- compiler/bytecode.m	Wed Dec 17 13:25:43 1997
+++ /home/pgrad/dgj/mer/work/mercury/compiler/bytecode.m	Tue Nov 25 12:28:21 1997
@@ -729,8 +729,9 @@
 	{ char__to_int(Char, Byte) },
 	output_byte(Byte).
 
-	% XXX FIX THIS
+	% XXX
 output_cons_id(base_typeclass_info_const(_, _, _)) -->
+	{ error("Sorry, bytecode for typeclass not yet implemented") },
 	output_byte(8).
 
 :- pred debug_cons_id(byte_cons_id, io__state, io__state).
diff -u -r compiler/call_gen.m /home/pgrad/dgj/mer/work/mercury/compiler/call_gen.m
--- compiler/call_gen.m	Wed Dec 17 13:25:43 1997
+++ /home/pgrad/dgj/mer/work/mercury/compiler/call_gen.m	Tue Nov 25 19:22:12 1997
@@ -270,8 +270,8 @@
 	% 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) -->
+call_gen__generate_class_method_call(_OuterCodeModel, TCVar, MethodNum, Args,
+		Types, Modes, Det, GoalInfo, Code) -->
 	{ determinism_to_code_model(Det, InnerCodeModel) },
 	code_info__get_globals(Globals),
 	code_info__get_module_info(ModuleInfo),
@@ -280,19 +280,26 @@
 		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).
+	call_gen__generate_class_method_call_2(InnerCodeModel, TCVar, 
+		MethodNum, 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),
+	% XXX This assumes compact args
+:- pred call_gen__generate_class_method_call_2(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,
+:- mode call_gen__generate_class_method_call_2(in, in, in, in, in, in, out, in,
 		out) is det.
 
-call_gen__generate_class_method_call2(CodeModel, TCVar, Index, InVars, OutVars,
+call_gen__generate_class_method_call_2(CodeModel, TCVar, Index, InVars, OutVars,
 		GoalInfo, Code) -->
+	code_info__get_globals(Globals),
+	{ globals__get_args_method(Globals, ArgsMethod) },
+	(
+		{ ArgsMethod = compact }
+	->
+		[]
+	;
+		{ error("Sorry, typeclasses with simple args_method not yet implemented") }
+	),
 	code_info__succip_is_used,
 	{ set__list_to_set(OutVars, OutArgs) },
 	call_gen__save_variables(OutArgs, SaveCode),
diff -u -r compiler/det_analysis.m /home/pgrad/dgj/mer/work/mercury/compiler/det_analysis.m
--- compiler/det_analysis.m	Wed Dec 17 13:25:43 1997
+++ /home/pgrad/dgj/mer/work/mercury/compiler/det_analysis.m	Tue Dec  2 18:16:44 1997
@@ -474,8 +474,10 @@
 		NumSolns = at_most_many_cc,
 		SolnContext \= first_soln
 	->
-			% XXX this will give a slightly misleading error
-			% XXX message
+			% If called, this would give a slightly misleading
+			% error message. class_method_calls are introduced
+			% after det_analysis, though, so it doesn't really
+			% matter.
 		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,
@@ -1012,10 +1014,14 @@
 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_get_marker_list(Pred, Markers),
+	pred_info_get_markers(Pred, Markers),
 	(
-			% ignore class members
-		list__member(request(class_method), Markers)
+			% ignore class members, since their bodies are filled
+			% in after this pass, and the body is gauranteed to
+			% be determinism-correct. Determinism correctness of
+			% the methods in an instance declaration are check
+			% separately in check_typeclass.m
+		check_marker(Markers, class_method)
 	->
 		PredProcs1 = PredProcs0
 	;
diff -u -r compiler/det_report.m /home/pgrad/dgj/mer/work/mercury/compiler/det_report.m
--- compiler/det_report.m	Thu Dec 18 15:31:49 1997
+++ /home/pgrad/dgj/mer/work/mercury/compiler/det_report.m	Thu Dec 18 18:41:53 1997
@@ -459,7 +459,6 @@
 det_diagnose_goal_2(higher_order_call(_, _, _, _, _, _), GoalInfo,
 		Desired, Actual, _, _DetInfo, 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).
 
@@ -470,7 +469,6 @@
 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).
 
diff -u -r compiler/dnf.m /home/pgrad/dgj/mer/work/mercury/compiler/dnf.m
--- compiler/dnf.m	Thu Dec 18 14:55:02 1997
+++ /home/pgrad/dgj/mer/work/mercury/compiler/dnf.m	Tue Dec  9 16:29:24 1997
@@ -137,10 +137,11 @@
 	pred_info_name(PredInfo0, PredName),
 	pred_info_typevarset(PredInfo0, TVarSet),
 	pred_info_get_markers(PredInfo0, Markers),
+	pred_info_get_class_context(PredInfo0, ClassContext),
 	proc_info_goal(ProcInfo0, Goal0),
 	proc_info_variables(ProcInfo0, VarSet),
 	proc_info_vartypes(ProcInfo0, VarTypes),
-	DnfInfo = dnf_info(TVarSet, VarTypes, VarSet, Markers),
+	DnfInfo = dnf_info(TVarSet, VarTypes, ClassContext, VarSet, Markers),
 
 	proc_info_get_initial_instmap(ProcInfo0, ModuleInfo0, InstMap),
 	dnf__transform_goal(Goal0, InstMap, MaybeNonAtomic,
@@ -153,6 +154,7 @@
 :- type dnf_info --->	dnf_info(
 				tvarset,
 				map(var, type),
+				list(class_constraint),
 				varset,
 				pred_markers
 			).
@@ -366,16 +368,13 @@
 
 dnf__define_new_pred(Goal0, Goal, InstMap0, PredName, DnfInfo,
 		ModuleInfo0, ModuleInfo, PredId) :-
-	DnfInfo = dnf_info(TVarSet, VarTypes, VarSet, Markers),
+	DnfInfo = dnf_info(TVarSet, VarTypes, ClassContext, VarSet, Markers),
 	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 = [],
+		% This ClassContext is a conservative approximation.
+		% We could get rid of some constraints on variables
+		% that are not part of the goal.
 	hlds_pred__define_new_pred(Goal0, Goal, ArgVars, InstMap0, PredName,
 		TVarSet, VarTypes, ClassContext, VarSet, Markers, 
 		ModuleInfo0, ModuleInfo, PredProcId),
diff -u -r compiler/equiv_type.m /home/pgrad/dgj/mer/work/mercury/compiler/equiv_type.m
--- compiler/equiv_type.m	Thu Dec 18 15:37:50 1997
+++ /home/pgrad/dgj/mer/work/mercury/compiler/equiv_type.m	Tue Dec  9 18:39:57 1997
@@ -113,9 +113,9 @@
 				TypeDefn, VarSet, ContainsCirc).
 
 equiv_type__replace_in_item(
-		pred(VarSet0, PredName, TypesAndModes0,
+		pred(VarSet0, PredName, TypesAndModes0, 
 			Det, Cond, Purity, ClassContext),
-		EqvMap, 
+		EqvMap,
 		pred(VarSet, PredName, TypesAndModes, 
 			Det, Cond, Purity, ClassContext),
 		no) :-
@@ -123,12 +123,14 @@
 					TypesAndModes, VarSet).
 
 equiv_type__replace_in_item(
-		func(VarSet0, PredName, TypesAndModes0, RetTypeAndMode0, 
-			Det, Cond, Purity, ClassContext),
-		EqvMap,
-		func(VarSet, PredName, TypesAndModes, RetTypeAndMode,
-			Det, Cond, Purity, ClassContext),
-		no) :-
+			func(VarSet0, PredName, TypesAndModes0, 
+				RetTypeAndMode0, Det, Cond, Purity,
+				ClassContext),
+			EqvMap,
+			func(VarSet, PredName, TypesAndModes
+				, RetTypeAndMode, Det, Cond, Purity,
+				ClassContext),
+			no) :-
 	equiv_type__replace_in_tms(TypesAndModes0, VarSet0, EqvMap,
 				TypesAndModes, VarSet1),
 	equiv_type__replace_in_tm(RetTypeAndMode0, VarSet1, EqvMap,
diff -u -r compiler/higher_order.m /home/pgrad/dgj/mer/work/mercury/compiler/higher_order.m
--- compiler/higher_order.m	Thu Dec 18 14:55:05 1997
+++ /home/pgrad/dgj/mer/work/mercury/compiler/higher_order.m	Wed Dec 10 17:04:25 1997
@@ -295,7 +295,7 @@
 	{ Goal0 = higher_order_call(_,_,_,_,_,_) - _ }, 
 	maybe_specialize_higher_order_call(Goal0, Goal, PredProcId, Changed).
 
-		% For now, we do not specialize class method calls
+		% XXX For now, we do not specialize class method calls
 traverse_goal(Goal, Goal, _, unchanged, 1) -->
 	{ Goal = class_method_call(_,_,_,_,_,_) - _ }.
 
@@ -845,6 +845,10 @@
 	pred_info_context(PredInfo0, Context),
 	pred_info_get_markers(PredInfo0, MarkerList),
 	pred_info_get_goal_type(PredInfo0, GoalType),
+		% When we start specialising class method calls, this
+		% context will need to be updated. 
+		% cf.  remove_listof_higher_order_args.
+	pred_info_get_class_context(PredInfo0, ClassContext),
 	Name = qualified(PredModule, PredName),
 	varset__init(EmptyVarSet),
 	map__init(EmptyVarTypes),
@@ -854,13 +858,9 @@
 	% 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, TypeConstraints, EmptyProofs, PredInfo1),
+		PredOrFunc, ClassContext, EmptyProofs, PredInfo1),
 	pred_info_set_typevarset(PredInfo1, TypeVars, PredInfo2),
 	pred_info_procedures(PredInfo2, Procs0),
 	next_mode_id(Procs0, no, NewProcId),
diff -u -r compiler/hlds_data.m /home/pgrad/dgj/mer/work/mercury/compiler/hlds_data.m
--- compiler/hlds_data.m	Wed Dec 17 13:25:44 1997
+++ /home/pgrad/dgj/mer/work/mercury/compiler/hlds_data.m	Fri Nov 28 16:16:24 1997
@@ -707,7 +707,8 @@
 			list(class_constraint), % SuperClasses
 			list(var), 		% ClassVars 
 			hlds_class_interface, 	% Methods
-			varset 			% VarNames
+			varset,			% VarNames
+			term__context		% Location of declaration
 		).
 
 :- type hlds_class_interface	==	list(hlds_class_proc).	
diff -u -r compiler/hlds_out.m /home/pgrad/dgj/mer/work/mercury/compiler/hlds_out.m
--- compiler/hlds_out.m	Thu Dec 18 15:39:55 1997
+++ /home/pgrad/dgj/mer/work/mercury/compiler/hlds_out.m	Thu Dec 18 18:37:29 1997
@@ -457,8 +457,8 @@
 	{ pred_info_get_markers(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, pure, ClassContext, Context),
+	mercury_output_pred_type(TVarSet, qualified(Module, PredName), 
+				ArgTypes, no, pure, ClassContext, Context),
 	{ ClausesInfo = clauses_info(VarSet, _, VarTypes, HeadVars, Clauses) },
 	hlds_out__write_indent(Indent),
 	io__write_string("% pred id: "),
@@ -501,7 +501,7 @@
 	io__write_string("\n% Class Table:\n"),
 	{ module_info_classes(ModuleInfo, ClassTable) },
 		% XXX fix this up.
-	io__write(ClassTable).
+	io__print(ClassTable).
 
 :- pred hlds_out__write_marker_list(list(marker), io__state, io__state).
 :- mode hlds_out__write_marker_list(in, di, uo) is det.
@@ -510,7 +510,6 @@
 hlds_out__write_marker_list([Marker | Markers]) -->
 	hlds_out__write_marker(Marker),
 	hlds_out__write_marker_list(Markers).
-
 
 hlds_out__marker_name(infer_type, "infer_type").
 hlds_out__marker_name(infer_modes, "infer_modes").
diff -u -r compiler/hlds_pred.m /home/pgrad/dgj/mer/work/mercury/compiler/hlds_pred.m
--- compiler/hlds_pred.m	Thu Dec 18 15:48:51 1997
+++ /home/pgrad/dgj/mer/work/mercury/compiler/hlds_pred.m	Mon Dec 15 17:42:33 1997
@@ -252,6 +252,9 @@
 
 :- pred type_info_locn_var(type_info_locn::in, var::out) is det.
 
+:- pred type_info_locn_set_var(type_info_locn::in, var::in, 
+		type_info_locn::out) is det.
+
 	% hlds_pred__define_new_pred(Goal, CallGoal, Args, InstMap, PredName,
 	% 	TVarSet, VarTypes, ClassContext, VarSet, Markers, ModuleInfo0,
 	% 	ModuleInfo, PredProcId)
@@ -381,15 +384,6 @@
 :- pred pred_info_requested_no_inlining(pred_info).
 :- mode pred_info_requested_no_inlining(in) is semidet.
 
-:- pred pred_info_get_purity(pred_info, purity).
-:- mode pred_info_get_purity(in, out) is det.
-
-:- pred pred_info_get_promised_pure(pred_info, bool).
-:- mode pred_info_get_promised_pure(in, out) is det.
-
-:- pred purity_to_markers(purity, pred_markers).
-:- mode purity_to_markers(in, out) is det.
-
 :- 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.
 
@@ -408,6 +402,15 @@
 	map(class_constraint, constraint_proof), pred_info).
 :- mode pred_info_set_constraint_proofs(in, in, out) is det.
 
+:- pred pred_info_get_purity(pred_info, purity).
+:- mode pred_info_get_purity(in, out) is det.
+
+:- pred pred_info_get_promised_pure(pred_info, bool).
+:- mode pred_info_get_promised_pure(in, out) is det.
+
+:- pred purity_to_markers(purity, pred_markers).
+:- mode purity_to_markers(in, out) is det.
+
 :- type pred_markers.
 
 :- pred pred_info_get_markers(pred_info, pred_markers).
@@ -697,8 +700,7 @@
 		_, _, _).
 
 pred_info_set_markers(PredInfo0, Markers, PredInfo) :-
-	PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, J, K, L, _, 
-		N, O, P),
+	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).
 
@@ -728,6 +730,9 @@
 
 type_info_locn_var(type_info(Var), Var).
 type_info_locn_var(typeclass_info(Var, _), Var).
+
+type_info_locn_set_var(type_info(_), Var, type_info(Var)).
+type_info_locn_set_var(typeclass_info(_, Num), Var, typeclass_info(Var, Num)).
 
 %-----------------------------------------------------------------------------%
 :- type pred_markers == list(marker).
diff -u -r compiler/lambda.m /home/pgrad/dgj/mer/work/mercury/compiler/lambda.m
--- compiler/lambda.m	Thu Dec 18 15:53:45 1997
+++ /home/pgrad/dgj/mer/work/mercury/compiler/lambda.m	Tue Dec  2 16:43:17 1997
@@ -28,6 +28,11 @@
 %
 %	:- pred '__LambdaGoal__1'(int::in, int::out) is nondet.
 %	'__LambdaGoal__1'(X, Y) :- q(Y, X).
+%
+%
+%
+%	Note: Support for lambda expressions which involve class constraints
+%	      is not yet complete.
 
 %-----------------------------------------------------------------------------%
 
diff -u -r compiler/llds_out.m /home/pgrad/dgj/mer/work/mercury/compiler/llds_out.m
--- compiler/llds_out.m	Thu Dec 18 14:55:11 1997
+++ /home/pgrad/dgj/mer/work/mercury/compiler/llds_out.m	Thu Dec 18 18:37:35 1997
@@ -3090,7 +3090,9 @@
 		ClassSym = unqualified(_),
 		error("llds_out__make_base_typeclass_info_name: unqualified name")
 	;
-		ClassSym = qualified(ModuleName, ClassName),
+		ClassSym = qualified(ModuleName, ClassName0),
+			% Mangle the class name in case it is an operator
+		llds_out__name_mangle(ClassName0, ClassName),
 		string__append_list([ModuleName, "__", ClassName], ClassString)
 	),
 	string__int_to_string(ClassArity, A_str),
diff -u -r compiler/make_hlds.m /home/pgrad/dgj/mer/work/mercury/compiler/make_hlds.m
--- compiler/make_hlds.m	Thu Dec 18 17:49:10 1997
+++ /home/pgrad/dgj/mer/work/mercury/compiler/make_hlds.m	Thu Dec 18 17:47:16 1997
@@ -201,7 +201,7 @@
 		Context, Status, Module0, Status, Module) -->
 	{ init_markers(Markers) },
 	module_add_func(Module0, VarSet, FuncName, TypesAndModes,
-		RetTypeAndMode, MaybeDet, Cond, Purity, ClassContext, Markers
+		RetTypeAndMode, MaybeDet, Cond, Purity, ClassContext, Markers,
 		Context, Status, _, Module).
 
 add_item_decl_pass_1(pred_mode(VarSet, PredName, Modes, MaybeDet, Cond),
@@ -508,8 +508,8 @@
 		--> [].
 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,
@@ -564,9 +564,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) --> [].
@@ -1107,7 +1107,7 @@
 		DeclStatus = Status
 	},
 	{ split_types_and_modes(TypesAndModes, Types, MaybeModes) },
-	add_new_pred(Module0, VarSet, PredName, Types, Cond, Purity,
+	add_new_pred(Module0, VarSet, PredName, Types, Cond, Purity, 
 		ClassContext, Markers, Context, DeclStatus, NeedQual, 
 		predicate, Module1),
 	(
@@ -1123,11 +1123,10 @@
 
 :- pred module_add_func(module_info, varset, sym_name, list(type_and_mode),
 		type_and_mode, maybe(determinism), condition, purity,
-		list(class_constraint), list(marker_status), term__context,
+		list(class_constraint), pred_markers, 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, in, 
-		out, out, di, uo) is det.
+:- mode module_add_func(in, 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, Purity, ClassContext, Markers, Context,
@@ -1170,15 +1169,11 @@
 	{ list__length(Vars, ClassArity) },
 	{ Key = class_id(Name, ClassArity) },
 	(
-		{ map__search(Classes0, Key, _) }
+		{ map__search(Classes0, Key, OldValue) }
 	->
-			% 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"),
+		{ OldValue = hlds_class_defn(_, _, _, _, OldContext) },
+		multiple_def_error(Name, ClassArity, "typeclass", 
+			Context, OldContext),
 		io__set_exit_status(1),
 		{ Module = Module0 }
 	;
@@ -1192,7 +1187,7 @@
 			)) },
 		{ list__filter_map(IsYes, PredProcIds0, PredProcIds) },
 		{ Value = hlds_class_defn(Constraints, Vars, PredProcIds, 
-			VarSet) },
+			VarSet, Context) },
 		{ map__det_insert(Classes0, Key, Value, Classes) },
 		{ module_info_set_classes(Module1, Classes, Module2) },
 			% When we find the class declaration, make an
@@ -1225,18 +1220,20 @@
 			MaybeDet, Cond, ClassContext, Context) },
 		{ term__var_list_to_term_list(Vars, VarTerms) },
 		{ NewClassContext = [constraint(Name, VarTerms)|ClassContext] },
-		{ Markers = [request(class_method)] },
+		{ init_markers(Markers0) },
+		{ add_marker(Markers0, class_method, Markers) },
 		module_add_pred(Module0, VarSet, PredName, TypesAndModes,
-			MaybeDet, Cond, NewClassContext, Markers,
+			MaybeDet, Cond, pure, 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)] },
+		{ init_markers(Markers0) },
+		{ add_marker(Markers0, class_method, Markers) },
 		module_add_func(Module0, VarSet, FuncName, TypesAndModes,
-			RetTypeAndMode, MaybeDet, Cond, NewClassContext,
+			RetTypeAndMode, MaybeDet, Cond, pure, NewClassContext,
 			Markers, Context, Status, MaybePredIdProcId, Module)
 	;
 		{ Method = pred_mode(VarSet, PredName, Modes, MaybeDet, 
@@ -1288,15 +1285,15 @@
 		purity, list(class_constraint), pred_markers, 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, in, in, in, out, 
+:- mode add_new_pred(in, 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
+% NB.  Predicates are also added in lambda.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, Purity, ClassContext, 
-		Markers, Context, Status, NeedQual, PredOrFunc, Module) -->
+add_new_pred(Module0, TVarSet, PredName, Types, Cond, Purity, ClassContext,
+		Markers0, Context, Status, NeedQual, PredOrFunc, Module) -->
 	{ module_info_name(Module0, ModuleName) },
 	{ list__length(Types, Arity) },
 	(
@@ -1311,10 +1308,14 @@
 		{ module_info_get_predicate_table(Module1, PredicateTable0) },
 		{ clauses_info_init(Arity, ClausesInfo) },
 		{ map__init(Proofs) },
-		{ purity_to_markers(Purity, Markers) },
-			% I haven't resolved this conflict properly so that
-			% you can see how I'm handling markers in the updated
-			% version.
+		{ purity_to_markers(Purity, PurityMarkers) },
+		{ markers_to_marker_list(PurityMarkers, MarkersList) },
+		{ AddMarker = lambda(
+			[M::in, TheMarkers0::in, TheMarkers::out] is det,
+			(
+				add_marker(TheMarkers0, M, TheMarkers)
+			)) },
+		{ list__foldl(AddMarker, MarkersList, Markers0, Markers) },
 		{ pred_info_init(ModuleName, PredName, Arity, TVarSet, Types,
 				Cond, Context, ClausesInfo, Status, Markers,
 				none, PredOrFunc, ClassContext, Proofs,
@@ -1498,11 +1499,11 @@
 	adjust_special_pred_status(Status0, SpecialPredId, Status),
 	map__init(Proofs),
 	init_markers(Markers),
-		% XXX When we have "comparable" or "unifiable" typeclasses, 
+		% XXX If/when we have "comparable" or "unifiable" typeclasses, 
 		% XXX this context might not be empty
-	ClassContext=[],
+	ClassContext  = [],
 	pred_info_init(ModuleName, PredName, Arity, TVarSet, ArgTypes, Cond,
-		Context, ClausesInfo0, Status, Markers, none, predicate,
+		Context, ClausesInfo0, Status, Markers, none, predicate, 
 		ClassContext, Proofs, PredInfo0),
 	ArgLives = no,
 	add_new_proc(PredInfo0, Arity, ArgModes, yes(ArgModes),
@@ -1653,10 +1654,13 @@
 	Cond = true,
 	clauses_info_init(Arity, ClausesInfo),
 	map__init(Proofs),
+		% The class context is empty since this is an implicit
+		% definition. Inference will fill it in.
+	ClassContext = [],
 	init_markers(Markers0),
 	pred_info_init(ModuleName, PredName, Arity, TVarSet, Types, Cond,
-		Context, ClausesInfo, local, Markers0, none, PredOrFunc, [],
-		Proofs, PredInfo0),
+		Context, ClausesInfo, local, Markers0, none, PredOrFunc, 
+		ClassContext, Proofs, PredInfo0),
 	add_marker(Markers0, infer_type, Markers),
 	pred_info_set_markers(PredInfo0, Markers, PredInfo),
 	(
diff -u -r compiler/mercury_to_c.m /home/pgrad/dgj/mer/work/mercury/compiler/mercury_to_c.m
--- compiler/mercury_to_c.m	Thu Dec 18 17:49:21 1997
+++ /home/pgrad/dgj/mer/work/mercury/compiler/mercury_to_c.m	Tue Dec  9 19:10:50 1997
@@ -630,7 +630,7 @@
 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") }.
+	{ error("mercury_to_c: class_method_call not implemented") }.
 c_gen_goal_2(call(PredId, ProcId, ArgVars, _, _, _PredName),
 					Indent, CGenInfo0, CGenInfo) -->
 	{ c_gen_info_get_module_info(CGenInfo0, ModuleInfo) },
diff -u -r compiler/mercury_to_mercury.m /home/pgrad/dgj/mer/work/mercury/compiler/mercury_to_mercury.m
--- compiler/mercury_to_mercury.m	Thu Dec 18 17:58:19 1997
+++ /home/pgrad/dgj/mer/work/mercury/compiler/mercury_to_mercury.m	Wed Dec 17 18:22:31 1997
@@ -30,7 +30,8 @@
 :- pred mercury_output_func_type(varset, sym_name, list(type), type,
 		maybe(determinism), purity, list(class_constraint),
 		term__context, io__state, io__state).
-:- mode mercury_output_func_type(in, in, in, in, in, in, in, in, di, uo) is det.
+:- mode mercury_output_func_type(in, 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).
@@ -346,7 +347,6 @@
 
 		% 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, ", ", 
@@ -358,7 +358,6 @@
 			)
 		),
 	io__write_char(')'),
-	io__write_char(')'),
 
 	(
 		{ Constraints = [] }
@@ -434,22 +433,22 @@
 		{ Method = pred(VarSet, Name, TypesAndModes, Detism, 
 			_Condition, ClassContext, Context) },
 		mercury_output_pred_decl(VarSet, Name, TypesAndModes, Detism,
-			ClassContext, Context, "),\n(", "\n")
+			pure, 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, 
+			TypeAndMode, Detism, pure, ClassContext, Context, 
 			"),\n(", "\n")
 	;
 		{ Method = pred_mode(VarSet, Name, Modes, Detism, 
 			_Condition, Context) },
-		mercury_output_pred_mode_decl2(VarSet, Name, Modes, Detism,
+		mercury_output_pred_mode_decl_2(VarSet, Name, Modes, Detism,
 			Context, "\n")
 	;
 		{ Method = func_mode(VarSet, Name, Modes, Mode, 
 			Detism, _Condition, Context) },
-		mercury_output_func_mode_decl2(VarSet, Name, Modes, 
+		mercury_output_func_mode_decl_2(VarSet, Name, Modes, 
 			Mode, Detism, Context, "\n")
 	),
 	io__write_char(')').
@@ -1228,7 +1227,7 @@
 	->
 		mercury_output_pred_type_2(VarSet, PredName, Types, MaybeDet, 
 			Purity, ClassContext, Context, Separator),
-		mercury_output_pred_mode_decl2(VarSet, PredName, Modes,
+		mercury_output_pred_mode_decl_2(VarSet, PredName, Modes,
 				MaybeDet, Context, Terminator)
 	;
 		mercury_output_pred_type_2(VarSet, PredName, Types, MaybeDet, 
@@ -1291,7 +1290,6 @@
 	io__write_string(Separator).
 
 
-
 % this works under the assumptions that all purity names but `pure' are prefix
 % operators, and that we never need `pure' indicators/declarations.
 
@@ -1314,7 +1312,7 @@
 		purity, list(class_constraint), term__context, string, string,
 		io__state, io__state).
 :- mode mercury_output_func_decl(in, in, in, in, in, in, in, in, in, in,
-	di, uo) is det.
+		di, uo) is det.
 
 mercury_output_func_decl(VarSet, FuncName, TypesAndModes, RetTypeAndMode,
 		MaybeDet, Purity, ClassContext, Context, 
@@ -1325,28 +1323,28 @@
 		{ MaybeModes = yes(Modes) },
 		{ MaybeRetMode = yes(RetMode) }
 	->
-		mercury_output_func_type2(VarSet, FuncName, Types, RetType,
+		mercury_output_func_type_2(VarSet, FuncName, Types, RetType,
 				no, Purity, ClassContext, Context, Separator),
-		mercury_output_func_mode_decl2(VarSet, FuncName, Modes, RetMode,
-				MaybeDet, Context, Terminator)
+		mercury_output_func_mode_decl_2(VarSet, FuncName, Modes,
+				RetMode, MaybeDet, Context, Terminator)
 	;
-		mercury_output_func_type2(VarSet, FuncName, Types, RetType,
+		mercury_output_func_type_2(VarSet, FuncName, Types, RetType,
 				MaybeDet, Purity, ClassContext, Context,
 				Terminator)
 	).
 
 mercury_output_func_type(VarSet, FuncName, Types, RetType, MaybeDet, 
 		Purity, ClassContext, Context) -->
-	mercury_output_func_type2(VarSet, FuncName, Types, RetType, MaybeDet, 
+	mercury_output_func_type_2(VarSet, FuncName, Types, RetType, MaybeDet, 
 			Purity, ClassContext, Context, ".\n").
 
-:- pred mercury_output_func_type2(varset, sym_name, list(type), type,
+:- pred mercury_output_func_type_2(varset, sym_name, list(type), type,
 		maybe(determinism), purity, list(class_constraint),
 		term__context, string, io__state, io__state).
-:- mode mercury_output_func_type2(in, in, in, in, in, in, in, in, in, 
-	di, uo) is det.
+:- mode mercury_output_func_type_2(in, in, in, in, in, in, in, in, in, 
+		di, uo) is det.
 
-mercury_output_func_type2(VarSet, FuncName, Types, RetType, MaybeDet, 
+mercury_output_func_type_2(VarSet, FuncName, Types, RetType, MaybeDet, 
 		Purity, ClassContext, _Context, Separator) -->
 	io__write_string(":- "),
 	write_purity_prefix(Purity),
@@ -1415,15 +1413,15 @@
 	% 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,
+	mercury_output_pred_mode_decl_2(VarSet, PredName, Modes, MaybeDet,
 		Context, ".\n").
 
-:- pred mercury_output_pred_mode_decl2(varset, sym_name, list(mode),
+:- pred mercury_output_pred_mode_decl_2(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.
+:- mode mercury_output_pred_mode_decl_2(in, in, in, in, in, in, di, uo) is det.
 
-mercury_output_pred_mode_decl2(VarSet, PredName, Modes, MaybeDet, Context,
+mercury_output_pred_mode_decl_2(VarSet, PredName, Modes, MaybeDet, Context,
 		Separator) -->
 	io__write_string(":- mode "),
 	mercury_output_pred_mode_subdecl(VarSet, PredName, Modes, MaybeDet,
@@ -1448,16 +1446,16 @@
 
 mercury_output_func_mode_decl(VarSet, FuncName, Modes, RetMode, MaybeDet,
 		Context) -->
-	mercury_output_func_mode_decl2(VarSet, FuncName, Modes, RetMode,
+	mercury_output_func_mode_decl_2(VarSet, FuncName, Modes, RetMode,
 		MaybeDet, Context, ".\n").
 
-:- pred mercury_output_func_mode_decl2(varset, sym_name, list(mode), mode,
+:- pred mercury_output_func_mode_decl_2(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, 
+:- mode mercury_output_func_mode_decl_2(in, in, in, in, in, in, in, 
 	di, uo) is det.
 
-mercury_output_func_mode_decl2(VarSet, FuncName, Modes, RetMode, MaybeDet,
+mercury_output_func_mode_decl_2(VarSet, FuncName, Modes, RetMode, MaybeDet,
 		Context, Separator) -->
 	io__write_string(":- mode "),
 	mercury_output_func_mode_subdecl(VarSet, FuncName, Modes, RetMode,
diff -u -r compiler/module_qual.m /home/pgrad/dgj/mer/work/mercury/compiler/module_qual.m
--- compiler/module_qual.m	Thu Dec 18 17:59:50 1997
+++ /home/pgrad/dgj/mer/work/mercury/compiler/module_qual.m	Mon Dec 15 17:19:44 1997
@@ -132,8 +132,8 @@
 	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).
@@ -274,10 +274,8 @@
 	{ update_import_status(ModuleDefn, Info0, Info, Continue) }.
 
 module_qualify_item(
-		pred(A, SymName, TypesAndModes0, D, E, F, Constraints0) -
-			Context,
-		pred(A, SymName, TypesAndModes, D, E, F, Constraints) - 
-			Context,
+		pred(A, SymName, TypesAndModes0, D,E,F, Constraints0) - Context,
+		pred(A, SymName, TypesAndModes, D,E,F, Constraints) - Context,
 		Info0, Info, yes) -->
 	{ list__length(TypesAndModes0, Arity) },
 	{ mq_info_set_error_context(Info0, pred(SymName - Arity) - Context,
@@ -286,8 +284,8 @@
 	qualify_class_constraints(Constraints0, Constraints, Info2, Info).
 
 module_qualify_item(
-		func(A,SymName, TypesAndModes0, TypeAndMode0, D, E, F,
-			Constraints0) - Context,
+		func(A,SymName, TypesAndModes0, TypeAndMode0, D, E, F
+			,Constraints0) - Context,
 		func(A, SymName, TypesAndModes, TypeAndMode, D, E, F,
 			Constraints) - Context,
 		Info0, Info, yes) -->
@@ -343,7 +341,7 @@
 		% 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_class_name(Id, Name - _, Info2, Info3),
 	qualify_type_list(Types0, Types, Info3, Info),
 	{ qualify_instance_interface(Name, Interface0, Interface) }.
 
@@ -692,14 +690,14 @@
 qualify_class_constraint(constraint(ClassName0, Types0), 
 	constraint(ClassName, Types), MQInfo0, MQInfo) -->
 	{ list__length(Types0, Arity) },
-	qualify_classname(ClassName0 - Arity, ClassName - _, MQInfo0, MQInfo1),
+	qualify_class_name(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, 
+:- pred qualify_class_name(pair(class_name, arity)::in, 
+	pair(class_name, arity)::out, mq_info::in, mq_info::out, 
 	io__state::di, io__state::uo) is det.
 
-qualify_classname(Class0, Class, MQInfo0, MQInfo) -->
+qualify_class_name(Class0, Class, MQInfo0, MQInfo) -->
 	{ mq_info_get_classes(MQInfo0, ClassIdSet) },
 	find_unique_match(Class0, Class, ClassIdSet, class_id,
 		MQInfo0, MQInfo).
diff -u -r compiler/notes/.#compiler_design.html.1.8 /home/pgrad/dgj/mer/work/mercury/compiler/notes/.#compiler_design.html.1.8
--- compiler/notes/.#compiler_design.html.1.8	Wed Dec 17 13:25:47 1997
+++ /home/pgrad/dgj/mer/work/mercury/compiler/notes/.#compiler_design.html.1.8	Mon Nov 24 16:23:55 1997
@@ -97,9 +97,10 @@
 	definition is in prog_data.m, while the code to create it is in
 	prog_io.m and its submodules prog_io_dcg.m (which handles clauses
 	using Definite Clause Grammar notation), prog_io_goal.m (which handles
-	goals), prog_io_pragma.m (which handles pragma declarations) and
-	prog_io_util.m (which defines predicates and types needed by the other
-	prog_io*.m modules.  The data structure for insts is stored in
+	goals), prog_io_pragma.m (which handles pragma declarations),
+	prog_io_typeclass.m (which handles typeclass and instance declarations)
+	and prog_io_util.m (which defines predicates and types needed by the
+	other prog_io*.m modules.  The data structure for insts is stored in 
 	its own module, inst.m.
 	
 	<p>
@@ -206,10 +207,12 @@
 	  pred_info.  However, typecheck.m doesn't figure out the pred_id
 	  for function calls or calls to overloaded predicates; that can't
 	  be done in a single pass of typechecking, and so it is done
-	  later on in modes.m.  When it has finished, typecheck.m calls
-	  clause_to_proc.m to make duplicate copies of the clauses for
-	  each different mode of a predicate; all later stages work on
-	  procedures, not predicates.
+	  later on in modes.m.  Typeclass constraints are checked here, and
+	  any redundant constraints that are eliminated are recorded (as
+	  constraint_proofs) in the pred_info for future reference. When it has
+	  finished, typecheck.m calls clause_to_proc.m to make duplicate copies
+	  of the clauses for each different mode of a predicate; all later
+	  stages work on procedures, not predicates.
 	<li> type_util.m contains utility predicates dealing with types
 	  that are used in a variety of different places within the compiler
 	</ul>
@@ -298,6 +301,18 @@
 	what modes.m does, and unique_modes calls lots of predicates
 	defined in modes.m to do it.
 
+<dt> checking typeclass instances (check_typeclass.m)
+	<dd>
+	check_typeclass.m checks that, each instance declaration, that the
+	types, modes and determinism of each predicate/function that is a
+	method of the class is correct (ie. that it matches the typeclass
+	declaration). In this pass, pred_ids and proc_ids are assigned to
+	the methods for each instance. In addition, while checking that the
+	superclasses of a class are satisfied by the instance declaration, a
+	set of constraint_proofs are built up for the superclass constraints.
+	These are used by polymorphism.m when generating the 
+	base_typeclass_info for the instance.
+
 <dt> simplification (simplify.m)
 
 	<dd>
@@ -323,8 +338,9 @@
 The first two passes of this stage are code simplifications.
 
 <ul>
-<li> introduction of type_info arguments for polymorphic predicates and
-  transformation of complicated unifications into predicate calls
+<li> introduction of type_info arguments for polymorphic predicates, 
+  introduction of typeclass_info arguments for typeclass-constrained predicates
+  and transformation of complicated unifications into predicate calls
   (polymorphism.m)
 
 <li> removal of lambda expressions (lambda.m) <br>
@@ -620,6 +636,10 @@
   creates base_type_functors structures that give information on 
   the functors of a given type. The base_type_layout and base_type_functors
   structures of each declared type constructor are added to the LLDS.
+<ul>
+<li> base_typeclass_info.m generates the base_typeclass_info structures that 
+  list the methods of a class for each instance declaration. These are added to
+  the LLDS.
 
 <li> stack_layout.m generates the stack_layout structures for
   accurate garbage collection. Tables are created from the data
diff -u -r compiler/notes/compiler_design.html /home/pgrad/dgj/mer/work/mercury/compiler/notes/compiler_design.html
--- compiler/notes/compiler_design.html	Thu Dec 18 14:55:29 1997
+++ /home/pgrad/dgj/mer/work/mercury/compiler/notes/compiler_design.html	Tue Dec  9 17:38:07 1997
@@ -97,9 +97,10 @@
 	definition is in prog_data.m, while the code to create it is in
 	prog_io.m and its submodules prog_io_dcg.m (which handles clauses
 	using Definite Clause Grammar notation), prog_io_goal.m (which handles
-	goals), prog_io_pragma.m (which handles pragma declarations) and
-	prog_io_util.m (which defines predicates and types needed by the other
-	prog_io*.m modules.  The data structure for insts is stored in
+	goals), prog_io_pragma.m (which handles pragma declarations),
+	prog_io_typeclass.m (which handles typeclass and instance declarations)
+	and prog_io_util.m (which defines predicates and types needed by the
+	other prog_io*.m modules.  The data structure for insts is stored in 
 	its own module, inst.m.
 	
 	<p>
@@ -206,10 +207,12 @@
 	  pred_info.  However, typecheck.m doesn't figure out the pred_id
 	  for function calls or calls to overloaded predicates; that can't
 	  be done in a single pass of typechecking, and so it is done
-	  later on in modes.m.  When it has finished, typecheck.m calls
-	  clause_to_proc.m to make duplicate copies of the clauses for
-	  each different mode of a predicate; all later stages work on
-	  procedures, not predicates.
+	  later on in modes.m.  Typeclass constraints are checked here, and
+	  any redundant constraints that are eliminated are recorded (as
+	  constraint_proofs) in the pred_info for future reference. When it has
+	  finished, typecheck.m calls clause_to_proc.m to make duplicate copies
+	  of the clauses for each different mode of a predicate; all later
+	  stages work on procedures, not predicates.
 	<li> type_util.m contains utility predicates dealing with types
 	  that are used in a variety of different places within the compiler
 	</ul>
@@ -304,6 +307,18 @@
 	what modes.m does, and unique_modes calls lots of predicates
 	defined in modes.m to do it.
 
+<dt> checking typeclass instances (check_typeclass.m)
+	<dd>
+	check_typeclass.m checks that, each instance declaration, that the
+	types, modes and determinism of each predicate/function that is a
+	method of the class is correct (ie. that it matches the typeclass
+	declaration). In this pass, pred_ids and proc_ids are assigned to
+	the methods for each instance. In addition, while checking that the
+	superclasses of a class are satisfied by the instance declaration, a
+	set of constraint_proofs are built up for the superclass constraints.
+	These are used by polymorphism.m when generating the 
+	base_typeclass_info for the instance.
+
 <dt> simplification (simplify.m)
 
 	<dd>
@@ -329,8 +344,9 @@
 The first two passes of this stage are code simplifications.
 
 <ul>
-<li> introduction of type_info arguments for polymorphic predicates and
-  transformation of complicated unifications into predicate calls
+<li> introduction of type_info arguments for polymorphic predicates, 
+  introduction of typeclass_info arguments for typeclass-constrained predicates
+  and transformation of complicated unifications into predicate calls
   (polymorphism.m)
 
 <li> removal of lambda expressions (lambda.m) <br>
@@ -626,6 +642,10 @@
   creates base_type_functors structures that give information on 
   the functors of a given type. The base_type_layout and base_type_functors
   structures of each declared type constructor are added to the LLDS.
+<ul>
+<li> base_typeclass_info.m generates the base_typeclass_info structures that 
+  list the methods of a class for each instance declaration. These are added to
+  the LLDS.
 
 <li> stack_layout.m generates the stack_layout structures for
   accurate garbage collection. Tables are created from the data
diff -u -r compiler/notes/glossary.html /home/pgrad/dgj/mer/work/mercury/compiler/notes/glossary.html
--- compiler/notes/glossary.html	Thu Apr  3 15:17:38 1997
+++ /home/pgrad/dgj/mer/work/mercury/compiler/notes/glossary.html	Wed Nov 26 15:55:57 1997
@@ -15,6 +15,10 @@
 
 <dl>
 
+<dt> class context 
+	<dd>
+	The typeclass constraints on a predicate or function.
+
 <dt> HLDS 
 	<dd>
 	The "High Level Data Structure".  See hlds.m.
diff -u -r compiler/polymorphism.m /home/pgrad/dgj/mer/work/mercury/compiler/polymorphism.m
--- compiler/polymorphism.m	Wed Dec 17 13:25:46 1997
+++ /home/pgrad/dgj/mer/work/mercury/compiler/polymorphism.m	Mon Dec 15 17:15:47 1997
@@ -158,7 +158,7 @@
 % 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
+% The dictionary contains pointers to each of the class methods.
 %
 %-----------------------------------------------------------------------------%
 %
@@ -168,14 +168,13 @@
 %	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).
+%		The base_typeclass_info contains:
+%		  * the number of constraints on the instance decl.
 %		  * pointer to method #1
 %		    ...
 %		  * pointer to method #n
 %
-%		The type_info contains:
+%		The typeclass_info contains:
 %		  * a pointer to the base typeclass info
 %		  * typeclass info #1 for constraint on instance decl
 %		  * ...
@@ -220,7 +219,7 @@
 %		  * 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
+% If 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.
 %
@@ -232,17 +231,17 @@
 % 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).
+%	:- pred q(T2, T3) <= foo(T2), bar(T3).
+%	:- pred r(T4, T5) <= foo(T4).
 %
-%	p(X) :- q([X]), r(0, X).
+%	p(X) :- q([X], 0), 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).
+%	:- pred q(typeclass_info(foo(T2)), typeclass_info(bar(T3)), T2, T3).
+%	:- pred r(typeclass_info(foo(T4)), type_info(T5), T4, T5).
 %
 % We transform the body of p to this:
 %
@@ -250,24 +249,36 @@
 %		BaseTypeClassInfoT2 = base_typeclass_info(
 %			1,
 %			...
-%			... (The methods for the class from the list instance)
+%			... (The methods for the foo class from the list
+%			...  instance)
 %			...
 %			),
 %		TypeClassInfoT2 = typeclass_info(
-%			BaseTypeInfoT2,
+%			BaseClassTypeInfoT2,
 %			TypeClassInfoT1,
-%			<type_info for list(T1)>,
-%		q(TypeClassInfoT2, [X]),
-%		BaseTypeClassInfoT3 = baseclass_type_info(
+%			<type_info for list(T1)>),
+%		BaseTypeClassInfoT3 = base_typeclass_info(
 %			0,
 %			...
-%			... (The methods for the class from the int instance)
+%			... (The methods for the bar class from the int
+%			...  instance)
 %			...
 %			),
 %		TypeClassInfoT3 = typeclass_info(
-%			BaseTypeInfoT3,
+%			BaseClassTypeInfoT3,
 %			<type_info for int>),
-%		r(TypeClassInfoT1, TypeInfoT3, 0, X).
+%		q(TypeClassInfoT2, TypeClassInfoT3, [X], 0),
+%		BaseTypeClassInfoT4 = baseclass_type_info(
+%			0,
+%			...
+%			... (The methods for the foo class from the int
+%			...  instance)
+%			...
+%			),
+%		TypeClassInfoT4 = typeclass_info(
+%			BaseTypeClassInfoT4,
+%			<type_info for int>),
+%		r(TypeClassInfoT1, <type_info for int>, 0, X).
 %
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
@@ -287,7 +298,7 @@
 :- 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 std_util, (inst), hlds_out, base_typeclass_info.
+:- import_module (inst), hlds_out, base_typeclass_info.
 
 :- import_module bool, int, string, list, set, map.
 :- import_module term, varset, std_util, require, assoc_list.
@@ -651,18 +662,8 @@
 					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 }
+				{ list__append(Goals, [Call], TheGoals) },
+				{ Goal = conj(TheGoals) - GoalInfo }
 			)
 
 		; { type_is_higher_order(Type, _, _) } ->
@@ -926,10 +927,10 @@
 		% 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
+		% In addition, a typeclass-info may be 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),
@@ -941,11 +942,7 @@
 		solutions_set(lambda([Var::out] is nondet, (
 				list__member(TheVar, NonLocalTypeVars),
 				map__search(TypeVarMap, TheVar, Location),
-				(
-					Location = type_info(Var)
-				;
-					Location = typeclass_info(Var, _)
-				)
+				type_info_locn_var(Location, Var)
 			)), NewOutsideVars),
 		set__union(NewOutsideVars, NonLocals, OutsideVars),
 		implicitly_quantify_goal(Goal0, VarSet0, VarTypes0,
@@ -966,8 +963,14 @@
 	PolyInfo0 = poly_info(VarSet, VarTypes, TVarSet, TVarMap, 
 			TCVarMap, Proofs, PredName, ModuleInfo0),
 
-		% XXX This is wrong. What is the class context really?
-	Constraints = [],
+		% Calculate the constraints which apply to this lambda
+		% expression.
+	map__keys(TCVarMap, AllConstraints),
+	map__apply_to_list(Vars, VarTypes, LambdaVarTypes),
+	list__map(type_util__vars, LambdaVarTypes, LambdaTypeVarsList),
+	list__condense(LambdaTypeVarsList, LambdaTypeVars),
+	list__filter(polymorphism__constraint_contains_vars(LambdaTypeVars), 
+		AllConstraints, Constraints),
 
 	lambda__transform_lambda(PredOrFunc, PredName, Vars, Modes, Det,
 		OrigNonLocals, LambdaGoal, Unification0, VarSet, VarTypes,
@@ -976,6 +979,19 @@
 	PolyInfo = poly_info(VarSet, VarTypes, TVarSet, TVarMap, 
 			TCVarMap, Proofs, PredName, ModuleInfo).
 
+:- pred polymorphism__constraint_contains_vars(list(var), class_constraint).
+:- mode polymorphism__constraint_contains_vars(in, in) is semidet.
+
+polymorphism__constraint_contains_vars(LambdaVars, ClassConstraint) :-
+	ClassConstraint = constraint(_, ConstraintTypes),
+	list__map(type_util__vars, ConstraintTypes, ConstraintVarsList),
+	list__condense(ConstraintVarsList, ConstraintVars),
+		% Probably not the most efficient way of doing it, but I
+		% wouldn't think that it matters.
+	set__list_to_set(LambdaVars, LambdaVarsSet),
+	set__list_to_set(ConstraintVars, ConstraintVarsSet),
+	set__subset(ConstraintVarsSet, LambdaVarsSet).
+
 %---------------------------------------------------------------------------%
 
 % Given a list of constraints, create a list of variables to hold the
@@ -1155,7 +1171,7 @@
 			module_info_classes(ModuleInfo, ClassTable),
 			map__lookup(ClassTable, SubClassId, SubClassDefn), 
 			SubClassDefn = hlds_class_defn(SuperClasses0,
-				SubClassVars, _, _),
+				SubClassVars, _, _, _),
 
 				% Work out which superclass typeclass_info to
 				% take
@@ -1365,15 +1381,11 @@
 	Info0 = poly_info(VarSet0, VarTypes0, TVarSet, TVarMap0, TCVarMap0, 
 			Proofs, PredName, ModuleInfo),
 
-	ClassDefn = hlds_class_defn(SuperClasses, ClassVars, _, ClassVarSet),
+	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),
 
@@ -1439,7 +1451,6 @@
 		% 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,
@@ -1965,9 +1976,9 @@
 		TypeInfoVar, VarSet0, VarTypes0, TypeInfoLocns0,
 		VarSet, VarTypes, TypeInfoLocns) :-
 
-		% We need a dummy tvarset to pass to get_pred_id_and_proc_id
+		% We need a tvarset to pass to get_pred_id_and_proc_id
 	varset__init(TVarSet0),
-	varset__new_var(TVarSet0, Dummy, TVarSet),
+	varset__new_var(TVarSet0, TVar, TVarSet),
 
 	term__context_init(EmptyContext),
 	ExtractTypeInfo = qualified("mercury_builtin",
@@ -1976,12 +1987,8 @@
 		EmptyContext),
 	IntTerm = term__functor(term__atom("int"), [], EmptyContext),
 	TypeInfoTerm = term__functor(term__atom("type_info"), 
-		[term__variable(Dummy)], EmptyContext),
+		[term__variable(TVar)], 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),
@@ -1990,6 +1997,12 @@
 
 	polymorphism__new_type_info_var(Type, "type_info", VarSet1, VarTypes1,
 		TypeInfoVar, VarSet2, VarTypes2),
+
+		% We have to put an extra type_info at the front of the call to
+		% type_info_from_typeclass_info, and pass it a bogus value
+		% because the pred has a type parameter... even though we are
+		% actually _extracting_ the type_info.  Existential typing of
+		% type_info_from_typeclass_info would fix this.
 	polymorphism__new_type_info_var(Type, "type_info", VarSet2, VarTypes2,
 		DummyTypeInfoVar, VarSet, VarTypes),
 
@@ -2078,7 +2091,7 @@
 	ClassId = class_id(ClassName0, ClassArity),
 	module_info_classes(ModuleInfo, ClassTable),
 	map__lookup(ClassTable, ClassId, ClassDefn),
-	ClassDefn = hlds_class_defn(SuperClasses, _, _, _),
+	ClassDefn = hlds_class_defn(SuperClasses, _, _, _, _),
 	list__length(SuperClasses, NumSuperClasses),
 
 	unqualify_name(ClassName0, ClassName),
@@ -2150,18 +2163,22 @@
 
 %---------------------------------------------------------------------------%
 
+	% Expand the bodies of all class methods for typeclasses which
+	% were defined in this module. The expansion involves inserting a
+	% class_method_call with the appropriate arguments, which is 
+	% responsible for extracting the appropriate part of the dictionary.
 :- 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),
+	module_info_name(ModuleInfo0, ModuleName),
 	map__keys(Classes, ClassIds0),
 
 		% Don't expand classes from other modules
 	FromThisModule = lambda([ClassId::in] is semidet,
 		(
-			ClassId = class_id(qualified(Name, _), _)
+			ClassId = class_id(qualified(ModuleName, _), _)
 		)),
 	list__filter(FromThisModule, ClassIds0, ClassIds),
 
@@ -2171,7 +2188,8 @@
 :- 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) :-
+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).
@@ -2184,20 +2202,19 @@
 	pred_info_procedures(PredInfo0, ProcTable0),
 	map__lookup(ProcTable0, ProcId, ProcInfo0),
 
+		% Find which of the constraints on the pred is the one
+		% introduced because it is a class method.
 	pred_info_get_class_context(PredInfo0, ClassContext),
 	(
 		ClassContext = [Head|_]
 	->
-		InstanceDictContext = Head
+		InstanceConstraint = 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),
+	map__lookup(VarMap, InstanceConstraint, TypeClassInfoVar),
 
 	proc_info_headvars(ProcInfo0, HeadVars0),
 	proc_info_vartypes(ProcInfo0, Types0),
@@ -2211,6 +2228,11 @@
 		error("missing determinism decl. How did we get this far?")
 	),
 
+		% Work out which argument corresponds to the constraint which
+		% is introduced because this is a class method, then delete it
+		% from the list of args to the class_method_call. That variable
+		% becomes the "dictionary" variable for the class_method_call.
+		% (cf. the closure for a higher order call).
 	(
 		list__nth_member_search(HeadVars0, TypeClassInfoVar, N),
 		delete_nth(HeadVars0, N, HeadVars1),
@@ -2226,8 +2248,7 @@
 	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?
+		% Make the goal info for the call. 
 	set__list_to_set(HeadVars0, NonLocals),
 	instmap_delta_from_mode_list(HeadVars0, Modes0, ModuleInfo0,
 			InstmapDelta),
diff -u -r compiler/prog_data.m /home/pgrad/dgj/mer/work/mercury/compiler/prog_data.m
--- compiler/prog_data.m	Thu Dec 18 18:00:18 1997
+++ /home/pgrad/dgj/mer/work/mercury/compiler/prog_data.m	Mon Dec 15 17:21:23 1997
@@ -18,8 +18,8 @@
 
 :- interface.
 
-:- import_module hlds_data, hlds_pred, (inst), purity.
-:- import_module term_util, list, map, varset, term, std_util.
+:- import_module hlds_data, hlds_pred, (inst), purity, term_util.
+:- import_module list, map, varset, term, std_util.
 
 %-----------------------------------------------------------------------------%
 
@@ -52,13 +52,13 @@
 	; 	module_defn(varset, module_defn)
 
 	; 	pred(varset, sym_name, list(type_and_mode),
-			maybe(determinism), condition,
-			purity, list(class_constraint))
+			maybe(determinism), condition, purity,
+			list(class_constraint))
 		%     VarNames, PredName, ArgTypes, Deterministicness, Cond
 
 	; 	func(varset, sym_name, list(type_and_mode), type_and_mode,
-			maybe(determinism), condition,
-			purity, list(class_constraint))
+			maybe(determinism), condition, purity,
+			list(class_constraint))
 		%       VarNames, PredName, ArgTypes, ReturnType,
 		%       Deterministicness, Cond
 
@@ -74,12 +74,12 @@
 
 	;	pragma(pragma_type)
 
-	;	typeclass(list(class_constraint), classname, list(var),
+	;	typeclass(list(class_constraint), class_name, list(var),
 			class_interface, varset)
 		%	Constraints, ClassName, ClassParams, 
 		%	ClassMethods, VarNames
 
-	;	instance(list(class_constraint), classname, list(type),
+	;	instance(list(class_constraint), class_name, list(type),
 			instance_interface, varset)
 		%	DerivingClass, ClassName, Types, 
 		%	MethodInstances, VarNames
@@ -167,9 +167,9 @@
 	;	check_termination(sym_name, arity).
 			% Predname, Arity
 
-:- type class_constraint	---> constraint(classname, list(type)).
+:- type class_constraint	---> constraint(class_name, list(type)).
 
-:- type classname == sym_name.
+:- type class_name == sym_name.
 
 :- type class_interface  == list(class_method).	
 
diff -u -r compiler/prog_io.m /home/pgrad/dgj/mer/work/mercury/compiler/prog_io.m
--- compiler/prog_io.m	Thu Dec 18 18:08:13 1997
+++ /home/pgrad/dgj/mer/work/mercury/compiler/prog_io.m	Mon Dec 15 17:23:32 1997
@@ -55,8 +55,8 @@
 
 :- interface.
 
-:- import_module prog_data.
-:- import_module list, io, prog_io_util.
+:- import_module prog_data, prog_io_util.
+:- import_module list, io. 
 
 %-----------------------------------------------------------------------------%
 
@@ -97,7 +97,8 @@
 	%
 	% 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
+	% Qualify appropriate parts of the item, with ModuleName as the
+	% module name.
 :- pred parse_item(string, varset, term, maybe_item_and_context). 
 :- mode parse_item(in, in, in, out) is det.
 
@@ -528,6 +529,29 @@
 process_decl(ModuleName, VarSet, "func", [FuncDecl], Result) :-
 	parse_type_decl_func(ModuleName, VarSet, FuncDecl, pure, Result).
 
+	% Because "<=" has a higher precedence than "pred" or "func", we
+	% we need to handle preds and funcs with class contexts specially.
+process_decl(ModuleName, VarSet, "<=", [Decl, ClassContext], Result) :-
+	(
+		Decl = term__functor(term__atom("pred"), [PredDecl], Context)
+	->
+		NewTerm = term__functor(term__atom("<="), 
+			[PredDecl, ClassContext], Context),
+		parse_type_decl_pred(ModuleName, VarSet, NewTerm, pure,
+			Result)
+	;
+		Decl = term__functor(term__atom("func"), [FuncDecl], Context)
+	->
+		NewTerm = term__functor(term__atom("<="), 
+			[FuncDecl, ClassContext], Context),
+		parse_type_decl_func(ModuleName, VarSet, NewTerm, pure,
+			Result)
+	;
+		Result = error(
+		"Class contexts only allowed on pred or func declarations", 
+		    Decl)
+	).
+
 process_decl(ModuleName, VarSet, "mode", [ModeDecl], Result) :-
 	parse_mode_decl(ModuleName, VarSet, ModeDecl, Result).
 
@@ -1150,7 +1174,7 @@
 	).
 
 :- pred process_pred_2(maybe_functor, term, varset, maybe(determinism),
-			condition, purity, list(class_constraint),
+			condition, purity, list(class_constraint), 
 			maybe1(item)).
 :- mode process_pred_2(in, in, in, in, in, in, in, out) is det.
 
@@ -1171,15 +1195,15 @@
 		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.
+	% an appropriate error message (if a syntactically invalid class 
+	% context was given).
 
 :- pred maybe_get_class_context(string, term, term,
 	maybe1(list(class_constraint))).
@@ -1232,22 +1256,22 @@
 		(
 			MaybeContext = ok(Constraints),
 			process_unconstrained_func(ModuleName, VarSet, Term,
-				Cond, Purity, MaybeDet, Constraints, Result) 
+				Cond, MaybeDet, Purity, Constraints, Result) 
 		;
 			MaybeContext = error(String, ErrorTerm),
 			Result = error(String, ErrorTerm)
 		)
 	;
 		process_unconstrained_func(ModuleName, VarSet, Term0, 
-			Cond, Purity, MaybeDet, [], Result) 
+			Cond, MaybeDet, Purity, [], Result) 
 	).
 
 :- pred process_unconstrained_func(string, varset, term, condition,
-	purity, maybe(determinism), list(class_constraint), maybe1(item)).
+	maybe(determinism), purity, list(class_constraint), maybe1(item)).
 :- mode process_unconstrained_func(in, in, in, in, in, in, in, out) is det.
 
-process_unconstrained_func(ModuleName, VarSet, Term, Cond, Purity, MaybeDet, 
-		Constraints, Result) :-
+process_unconstrained_func(ModuleName, VarSet, Term, Cond, MaybeDet, 
+		Purity, Constraints, Result) :-
 	(
 		Term = term__functor(term__atom("="),
 				[FuncTerm, ReturnTypeTerm], _Context)
@@ -1308,7 +1332,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)).
 
 %-----------------------------------------------------------------------------%
 
diff -u -r compiler/prog_out.m /home/pgrad/dgj/mer/work/mercury/compiler/prog_out.m
--- compiler/prog_out.m	Wed Dec 17 13:25:46 1997
+++ /home/pgrad/dgj/mer/work/mercury/compiler/prog_out.m	Thu Dec 18 11:31:02 1997
@@ -26,6 +26,9 @@
 :- pred prog_out__write_context(term__context, io__state, io__state).
 :- mode prog_out__write_context(in, di, uo) is det.
 
+	% XXX This pred should be deleted, and all uses replaced with
+	% XXX error_util:write_error_pieces, once zs has committed that
+	% XXX error_util.m.
 :- 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.
diff -u -r compiler/purity.m /home/pgrad/dgj/mer/work/mercury/compiler/purity.m
--- compiler/purity.m	Thu Dec 11 21:31:08 1997
+++ /home/pgrad/dgj/mer/work/mercury/compiler/purity.m	Thu Dec 18 18:37:45 1997
@@ -366,6 +366,11 @@
 	{ HOCall = higher_order_call(_,_,_,_,_,_) },
 	error_if_body_purity_indicated(GoalInfo, NumErrors0, NumErrors,
 				       InClosure, "higher order goal").
+compute_expr_purity(CMCall, CMCall, GoalInfo, _, _, InClosure, pure,
+		NumErrors0, NumErrors) -->
+	{ CMCall = class_method_call(_,_,_,_,_,_) },
+	error_if_body_purity_indicated(GoalInfo, NumErrors0, NumErrors,
+				       InClosure, "class method goal").
 compute_expr_purity(switch(Var,Canfail,Cases0,Storemap),
 		switch(Var,Canfail,Cases,Storemap), GoalInfo, PredInfo,
 		ModuleInfo, InClosure, Purity, NumErrors0, NumErrors) -->
diff -u -r compiler/simplify.m /home/pgrad/dgj/mer/work/mercury/compiler/simplify.m
--- compiler/simplify.m	Thu Dec 18 14:55:21 1997
+++ /home/pgrad/dgj/mer/work/mercury/compiler/simplify.m	Wed Dec 10 18:20:54 1997
@@ -424,12 +424,8 @@
 		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.
+	% XXX We ought to do duplicate call elimination for class 
+	% XXX method calls here.
 simplify__goal_2(Goal, GoalInfo, Goal, GoalInfo, Info, Info) :-
 	Goal = class_method_call(_, _, _, _, _, _).
 
diff -u -r compiler/stratify.m /home/pgrad/dgj/mer/work/mercury/compiler/stratify.m
--- compiler/stratify.m	Thu Dec 18 14:55:22 1997
+++ /home/pgrad/dgj/mer/work/mercury/compiler/stratify.m	Wed Dec 10 18:22:00 1997
@@ -409,13 +409,12 @@
 	->
 		{ goal_info_get_context(GoalInfo, Context) },
 		emit_message(ThisPredProcId, Context, 
-			"higher order call may introduce a non-stratified loop", 
+			"higher order call may introduce a non-stratified loop",
 			Error, Module0, Module)		
 	;
 		{ 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) -->
@@ -425,7 +424,7 @@
 	->
 		{ goal_info_get_context(GoalInfo, Context) },
 		emit_message(ThisPredProcId, Context, 
-			"higher order call may introduce a non-stratified loop", 
+			"class method call may introduce a non-stratified loop",
 			Error, Module0, Module)		
 	;
 		{ Module = Module0 }
diff -u -r compiler/term_pass1.m /home/pgrad/dgj/mer/work/mercury/compiler/term_pass1.m
--- compiler/term_pass1.m	Wed Dec 17 13:25:46 1997
+++ /home/pgrad/dgj/mer/work/mercury/compiler/term_pass1.m	Mon Dec 15 17:32:47 1997
@@ -490,6 +490,8 @@
 proc_inequalities_goal(class_method_call(_, _, _, _, _, _), 
 		GoalInfo, _Module, _, _PPId, Error, Offs, Offs) :-
 	goal_info_get_context(GoalInfo, Context),
+		% It would be better to use a new alternative
+		% `class_method_call' rather than than `horder_call' here.
 	Error = error(Context - horder_call).
 
 proc_inequalities_goal(switch(_SwitchVar, _CanFail, Cases, _StoreMap), GoalInfo,
diff -u -r compiler/type_util.m /home/pgrad/dgj/mer/work/mercury/compiler/type_util.m
--- compiler/type_util.m	Wed Dec 17 13:25:46 1997
+++ /home/pgrad/dgj/mer/work/mercury/compiler/type_util.m	Mon Dec 15 17:42:57 1997
@@ -136,7 +136,7 @@
 :- 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. 
+	% TypesB are exactly the same modulo variable renaming. 
 :- pred type_list_matches_exactly(list(type), list(type)).
 :- mode type_list_matches_exactly(in, in) is semidet.
 
@@ -697,13 +697,7 @@
 	;
 		NewVar = Var
 	),
-	(
-		Locn = type_info(_),
-		NewLocn = type_info(NewVar)
-	;
-		Locn = typeclass_info(_, Num),
-		NewLocn = typeclass_info(NewVar, Num)
-	),
+	type_info_locn_set_var(Locn, NewVar, NewLocn),
 
 		% if the tvar is still a variable, insert it into the
 		% map with the new var.
diff -u -r compiler/typecheck.m /home/pgrad/dgj/mer/work/mercury/compiler/typecheck.m
--- compiler/typecheck.m	Thu Dec 18 18:08:57 1997
+++ /home/pgrad/dgj/mer/work/mercury/compiler/typecheck.m	Wed Dec 17 13:06:22 1997
@@ -427,7 +427,7 @@
 	    pred_info_typevarset(PredInfo0, TypeVarSet0),
 	    pred_info_clauses_info(PredInfo0, ClausesInfo0),
 	    pred_info_import_status(PredInfo0, Status),
-	    pred_info_get_marker_list(PredInfo0, Markers),
+	    pred_info_get_markers(PredInfo0, Markers),
 	    ClausesInfo0 = clauses_info(VarSet, ExplicitVarTypes,
 				_OldInferredVarTypes, HeadVars, Clauses0),
 	    ( 
@@ -436,7 +436,7 @@
 			% 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) ->
+		( check_marker(Markers, class_method) ->
 			IOState = IOState0,
 				% For the moment, we just insert the types
 				% of the head vars into the clauses_info
@@ -456,7 +456,6 @@
 			Changed = no
 		)
 	    ;
-		pred_info_get_markers(PredInfo0, Markers),
 		( check_marker(Markers, infer_type) ->
 			% For a predicate whose type is inferred,
 			% the predicate is allowed to bind the type
@@ -958,11 +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.
+		% The class context is empty because higher-order predicates
+		% are always monomorphic.
+	{ ClassContext = [] },
 	typecheck_var_has_polymorphic_type_list([PredVar|Args], TypeVarSet,
-		[PredVarType|ArgTypes], []).
+		[PredVarType|ArgTypes], ClassContext).
 
 :- pred higher_order_pred_type(int, tvarset, type, list(type)).
 :- mode higher_order_pred_type(in, out, out, out) is det.
@@ -1047,7 +1046,7 @@
 					% sanity check
 			        PredClassContext \= []
 			    ->
-			        error("non-polymorphic pred has context")
+			        error("non-polymorphic pred has class context")
 			    ;
 			    	true
 			    )
@@ -1057,7 +1056,11 @@
 				PredClassContext,
 				TypeCheckInfo1, TypeCheckInfo2)
 			),
-			% Should we really do this now?
+				% Arguably, we could do context reduction at
+				% a different point. See the paper:
+				% "Type class: an exploration of the design
+				% space", S.P. Jones, M. Jones 1997.
+				% for a discussion of some of the issues.
 			perform_context_reduction(TypeCheckInfo2, TypeCheckInfo)
 		;
 			typecheck_info_get_pred_import_status(TypeCheckInfo1,
@@ -1194,7 +1197,7 @@
 	;
 		% if there is no matching predicate for this call,
 		% then this predicate must have a type error which
-		% should have been caught by in typechecking.
+		% should have been caught by typechecking.
 		error("type error in pred call: no matching pred")
 	).
 
@@ -1346,14 +1349,6 @@
 	),
 	convert_args_type_assign_set(ArgTypeAssigns, TypeAssigns).
 
-:- pred conv_args_type_assign_set(args_type_assign_set, type_assign_set).
-:- mode conv_args_type_assign_set(in, out) is det.
-
-conv_args_type_assign_set([], []).
-conv_args_type_assign_set([X|Xs], [Y|Ys]) :-
-	conv_args_type_assign(X, Y),
-	conv_args_type_assign_set(Xs, Ys).
-
 :- pred conv_args_type_assign(pair(type_assign, list(type)), type_assign).
 :- mode conv_args_type_assign(in, out) is det.
 
@@ -1744,7 +1739,8 @@
 typecheck_unification(X, var(Y), var(Y)) -->
 	typecheck_unify_var_var(X, Y).
 typecheck_unification(X, functor(F, As), functor(F, As)) -->
-	typecheck_unify_var_functor(X, F, As).
+	typecheck_unify_var_functor(X, F, As),
+	perform_context_reduction.
 typecheck_unification(X, lambda_goal(PredOrFunc, Vars, Modes, Det, Goal0),
 			 lambda_goal(PredOrFunc, Vars, Modes, Det, Goal)) -->
  	typecheck_lambda_var_has_type(PredOrFunc, X, Vars),
@@ -1880,10 +1876,12 @@
 
 :- 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
+:- type args_type_assign 
+	--->	args(
+			type_assign, 	% Type assignment, 
+			list(type), 	% types of callee,
+			list(class_constraint) % constraints from callee
+		).
 
 :- pred typecheck_unify_var_functor_get_ctors(type_assign_set,
 				typecheck_info, list(cons_type_info),
@@ -2091,7 +2089,8 @@
 get_cons_stuff(ConsDefn, TypeAssign0, _TypeCheckInfo, ConsType, ArgTypes,
 			TypeAssign) :-
 
-	ConsDefn = cons_type_info(ConsTypeVarSet, ConsType0, ArgTypes0),
+	ConsDefn = cons_type_info(ConsTypeVarSet, ConsType0, ArgTypes0,
+			ClassConstraints0),
 
 	% Rename apart the type vars in the type of the constructor
 	% and the types of its arguments.
@@ -2104,11 +2103,18 @@
 	;
 		type_assign_rename_apart(TypeAssign0, ConsTypeVarSet,
 			[ConsType0 | ArgTypes0],
-			TypeAssign1, [ConsType1 | ArgTypes1], _)
+			TypeAssign1, [ConsType1 | ArgTypes1], Subst)
 	->
+		apply_subst_to_constraints(Subst, ClassConstraints0,
+			ClassConstraints2),
+		type_assign_get_typeclass_constraints(TypeAssign1,
+			OldConstraints),
+		list__append(OldConstraints, ClassConstraints2,
+			ClassConstraints),
+		type_assign_set_typeclass_constraints(TypeAssign1,
+			ClassConstraints, TypeAssign),
 		ConsType = ConsType1,
-		ArgTypes = ArgTypes1,
-		TypeAssign = TypeAssign1
+		ArgTypes = ArgTypes1
 	;
 		error("get_cons_stuff: type_assign_rename_apart failed")
 	).
@@ -2270,7 +2276,13 @@
 	make_pred_cons_info_list(TypeCheckInfo, PredIds, PredTable, Arity,
 				ModuleInfo, L1, L).
 
-:- type cons_type_info ---> cons_type_info(tvarset, type, list(type)).
+:- type cons_type_info 
+	---> cons_type_info(
+			tvarset, 
+			type, 
+			list(type), 
+			list(class_constraint)
+		).
 
 :- pred make_pred_cons_info(typecheck_info, pred_id, pred_table, int,
 		module_info, list(cons_type_info), list(cons_type_info)).
@@ -2281,6 +2293,7 @@
 	map__lookup(PredTable, PredId, PredInfo),
 	pred_info_arity(PredInfo, PredArity),
 	pred_info_get_is_pred_or_func(PredInfo, IsPredOrFunc),
+	pred_info_get_class_context(PredInfo, ClassContext),
 	(
 		IsPredOrFunc = predicate,
 		PredArity >= FuncArity
@@ -2295,7 +2308,7 @@
 			PredType = term__functor(term__atom("pred"),
 					PredTypeParams, Context),
 			ConsInfo = cons_type_info(PredTypeVarSet,
-					PredType, ArgTypes),
+					PredType, ArgTypes, ClassContext),
 			L = [ConsInfo | L0]
 		;
 			error("make_pred_cons_info: split_list failed")
@@ -2328,7 +2341,7 @@
 					], Context)
 			),
 			ConsInfo = cons_type_info(PredTypeVarSet,
-					FuncType, FuncArgTypes),
+					FuncType, FuncArgTypes, ClassContext),
 			L = [ConsInfo | L0]
 		;
 			error("make_pred_cons_info: split_list or remove_suffix failed")
@@ -2353,7 +2366,7 @@
 	Arity1 is Arity - 1,
 	higher_order_func_type(Arity1, TypeVarSet, FuncType, ArgTypes, RetType),
 	ConsTypeInfos = [cons_type_info(TypeVarSet, RetType,
-					[FuncType | ArgTypes])].
+					[FuncType | ArgTypes], [])].
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
@@ -2886,7 +2899,7 @@
 		ConsType = term__functor(term__atom(BuiltInTypeName), [],
 				Context),
 		varset__init(ConsTypeVarSet),
-		ConsInfo = cons_type_info(ConsTypeVarSet, ConsType, []),
+		ConsInfo = cons_type_info(ConsTypeVarSet, ConsType, [], []),
 		ConsInfoList1 = [ConsInfo | ConsInfoList0]
 	;
 		ConsInfoList1 = ConsInfoList0
@@ -2938,7 +2951,9 @@
 :- 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.
+	% XXX stage. Fix this up. Handling inference isn't actually that
+	% XXX difficult: you just collect the constraint set, perform context
+	% XXX reduction, and that is the class context of the pred.
 typecheck_constraints(yes, TypeCheckInfo, TypeCheckInfo).
 typecheck_constraints(no, TypeCheckInfo0, TypeCheckInfo) :-
 		%get the declared constraints
@@ -3072,7 +3087,6 @@
 			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.
@@ -3098,40 +3112,55 @@
 		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).
+		Tvarset0, Tvarset1, Proofs0, Proofs1, Constraints1, Changed1),
+	apply_class_rules(Constraints1, ClassTable, Bindings, Tvarset1,
+		Proofs1, Proofs2, Constraints2, Changed2),
+	(
+		Changed1 = no, Changed2 = no
+	->
+			% We have reached fixpoint
+		list__sort_and_remove_dups(Constraints2, Constraints),
+		Tvarset = Tvarset1,
+		Proofs = Proofs2
+	;
+		typecheck__reduce_context_by_rule_application(InstanceTable,
+			ClassTable, Bindings, Tvarset1, Tvarset, Proofs2,
+			Proofs, 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.
+	map(class_constraint, constraint_proof), list(class_constraint), bool).
+:- mode apply_instance_rules(in, in, in, in, out, in, out, out, out) is semidet.
 
-apply_instance_rules([], _, _, Names, Names, Proofs, Proofs, []).
+apply_instance_rules([], _, _, Names, Names, Proofs, Proofs, [], no).
 apply_instance_rules([C|Cs], InstanceTable, Bindings, 
-		TypeNames, NewTypeNames, Proofs0, Proofs, Constraints) :-
+		TVarSet, NewTVarSet, Proofs0, Proofs, 
+		Constraints, Changed) :-
 	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,
+			TVarSet, NewTVarSet0, Proofs0, Proofs1,
 			NewConstraints0)
 	->
 			% Put the new constraints at the front of the list
 		NewConstraints = NewConstraints0,
-		NewTypeNames1 = NewTypeNames0,
-		Proofs2 = Proofs1
+		NewTVarSet1 = NewTVarSet0,
+		Proofs2 = Proofs1,
+		Changed1 = yes
 	;
 			% 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),
+		NewTVarSet1 = TVarSet,
+		Proofs2 = Proofs0,
+		Changed1 = no
+	),
+	apply_instance_rules(Cs, InstanceTable, Bindings, NewTVarSet1,
+		NewTVarSet, Proofs2, Proofs, TheRest, Changed2),
+	bool__or(Changed1, Changed2, Changed),
 	list__append(NewConstraints, TheRest, Constraints).
 
 	% We take the first matching instance rule that we can find; any
@@ -3149,27 +3178,27 @@
 :- 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) :-
+find_matching_instance_rule(Instances, ClassName, Types, TVarSet,
+		NewTVarSet, 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).
+	find_matching_instance_rule_2(Instances, 1, ClassName, Types,
+		TVarSet, NewTVarSet, Proofs0, Proofs, NewConstraints).
 
-:- pred find_matching_instance_rule2(list(hlds_instance_defn), int,
+:- pred find_matching_instance_rule_2(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) 
+:- mode find_matching_instance_rule_2(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) :-
+find_matching_instance_rule_2([I|Is], N0, ClassName, Types, TVarSet,
+		NewTVarSet, Proofs0, Proofs, NewConstraints) :-
 	I = hlds_instance_defn(ModuleName, NewConstraints0, InstanceTypes0,
 		Interface, PredProcIds, InstanceNames, SuperClassProofs),
 	(
-		varset__merge_subst(TypeNames, InstanceNames, NewTypeNames0,
+		varset__merge_subst(TVarSet, InstanceNames, NewTVarSet0,
 			RenameSubst),
 		term__apply_rec_substitution_to_list(InstanceTypes0,
 			RenameSubst, InstanceTypes),
@@ -3179,7 +3208,7 @@
 			NewConstraints1),
 		apply_rec_subst_to_constraints(Subst, NewConstraints1,
 			NewConstraints),
-		NewTypeNames = NewTypeNames0,
+		NewTVarSet = NewTVarSet0,
 		NewProof = apply_instance(hlds_instance_defn(ModuleName,
 			NewConstraints, InstanceTypes, Interface, PredProcIds,
 			InstanceNames, SuperClassProofs), N0),
@@ -3187,8 +3216,8 @@
 		map__set(Proofs0, Constraint, NewProof, Proofs)
 	;
 		N is N0 + 1,
-		find_matching_instance_rule2(Is, N, ClassName,
-			Types, TypeNames, NewTypeNames, Proofs0,
+		find_matching_instance_rule_2(Is, N, ClassName,
+			Types, TVarSet, NewTVarSet, Proofs0,
 			Proofs, NewConstraints)
 	).
 
@@ -3199,36 +3228,36 @@
 	% 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.
+	map(class_constraint, constraint_proof), list(class_constraint), bool).
+:- mode apply_class_rules(in, in, in, in, in, out, 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.
+apply_class_rules(Constraints0, ClassTable, Bindings, TVarSet, 
+		Proofs0, Proofs, Constraints, Changed) :-
+	apply_rec_subst_to_constraints(Bindings, Constraints0, Constraints1),
+	apply_class_rules_2(Constraints1, Constraints1, ClassTable,
+		TVarSet, Proofs0, Proofs, Constraints, Changed).
+
+:- pred apply_class_rules_2(list(class_constraint), list(class_constraint),
+	class_table, tvarset, map(class_constraint, constraint_proof),
+	map(class_constraint, constraint_proof), list(class_constraint), bool).
+:- mode apply_class_rules_2(in, in, in, in, in, out, 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),
+apply_class_rules_2([], Constraints, _, _, Proofs, Proofs, Constraints, no).
+apply_class_rules_2([C|Cs], AllConstraints, ClassTable, TVarSet,
+		Proofs0, Proofs, Constraints, Changed) :-
+	C = constraint(ClassName, Types),
+	list__length(Types, 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),
+		_ClassInterface, ClassVarset, _TermContext),
 	term__var_list_to_term_list(ClassVars, ClassTypes),
-		% XXX Can we really ignore _NewTypeNames?
-	varset__merge_subst(TypeNames, ClassVarset, _NewTypeNames, RenameSubst),
+		% XXX Can we really ignore _NewTVarSet?
+	varset__merge_subst(TVarSet, ClassVarset, NewTVarSet, RenameSubst),
 	term__apply_rec_substitution_to_list(ClassTypes, RenameSubst,
 		NewClassTypes),
 	apply_rec_subst_to_constraints(RenameSubst, ParentClassConstraints0,
@@ -3237,7 +3266,7 @@
 			[ThisConstraint::in, RenamedConstraint::out] is semidet,
 		(
 			type_list_subsumes(NewClassTypes, Types, Subst),
-			apply_rec_subst_to_constraint(Subst, ThisConstraint,
+			apply_rec_subst_to_constraint(Subst, ThisConstraint, 
 				RenamedConstraint),
 			list__member(RenamedConstraint, AllConstraints)
 		)),
@@ -3257,9 +3286,17 @@
 				TheProofs)
 		)),
 	list__foldl(RecordRedundancy, RedundantConstraints, Proofs0, Proofs1),
+	(
+		RedundantConstraints = [],
+		Changed1 = no
+	;
+		RedundantConstraints = [_|_],
+		Changed1 = yes
+	),
 
-	apply_class_rules2(NewCs, NewConstraints, ClassTable, Bindings,
-		TypeNames, Proofs1, Proofs, Constraints).
+	apply_class_rules_2(NewCs, NewConstraints, ClassTable,
+		NewTVarSet, Proofs1, Proofs, Constraints, Changed2),
+	bool__or(Changed1, Changed2, Changed).
 
 %-----------------------------------------------------------------------------%
 
@@ -3303,7 +3340,7 @@
 	hlds_data__get_type_defn_tvarset(TypeDefn, ConsTypeVarSet),
 	hlds_data__get_type_defn_tparams(TypeDefn, ConsTypeParams),
 	construct_type(TypeId, ConsTypeParams, Context, ConsType),
-	ConsTypeInfo = cons_type_info(ConsTypeVarSet, ConsType, ArgTypes).
+	ConsTypeInfo = cons_type_info(ConsTypeVarSet, ConsType, ArgTypes, []).
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
@@ -3312,18 +3349,16 @@
 
 :- type type_assign_set	==	list(type_assign).
 
-:- type type_assign	--->	type_assign(
-					map(var, type),		% var types
-					tvarset,		% type names
-					tsubst,			% type bindings
-					list(class_constraint),	% typeclass
-								% constraints
-					map(class_constraint,	% for each
-					    constraint_proof)	% constraint
-					    			% found to be
-								% redundant,
-								% why is it so?
-				).
+:- type type_assign	
+	--->	type_assign(
+			map(var, type),		% var types
+			tvarset,		% type names
+			tsubst,			% type bindings
+			list(class_constraint),	% typeclass constraints
+			map(class_constraint,	% for each constraint
+			    constraint_proof)	% constraint found to be 
+						% redundant, why is it so?
+		).
 
 %-----------------------------------------------------------------------------%
 
@@ -3696,7 +3731,7 @@
 	% arguments only for the arguments in which the two types differ.
 	(
 		{ ArgsTypeAssignSet = [SingleArgsTypeAssign] },
-		{ SingleArgsTypeAssign = TypeAssign - ConsArgTypes },
+		{ SingleArgsTypeAssign = args(TypeAssign, ConsArgTypes, _) },
 		{ assoc_list__from_corresponding_lists(Args, ConsArgTypes,
 			ArgExpTypes) },
 		{ find_mismatched_args(ArgExpTypes, [TypeAssign], 1,
@@ -3706,7 +3741,7 @@
 		report_mismatched_args(Mismatches, yes, VarSet, Context)
 	;
 
-		{ conv_args_type_assign_set(ArgsTypeAssignSet,
+		{ convert_args_type_assign_set(ArgsTypeAssignSet,
 			TypeAssignSet) },
 
 		%
@@ -3717,7 +3752,7 @@
 		(
 			% could the type of the functor be polymorphic?
 			{ list__member(ConsDefn, ConsDefnList) },
-			{ ConsDefn = cons_type_info(_, _, ConsArgTypes) },
+			{ ConsDefn = cons_type_info(_, _, ConsArgTypes, _) },
 			{ ConsArgTypes \= [] }
 		->
 			% if so, print out the type of `Var'
@@ -3906,7 +3941,9 @@
 			io__state, io__state).
 :- mode write_cons_type(in, in, in, di, uo) is det.
 
-write_cons_type(cons_type_info(TVarSet, ConsType0, ArgTypes0), Functor, _) -->
+	% XXX Should we mention the context here?
+write_cons_type(cons_type_info(TVarSet, ConsType0, ArgTypes0, _), 
+		Functor, _) -->
 	{ strip_builtin_qualifier_from_cons_id(Functor, Functor1) },
 	{ strip_builtin_qualifiers_from_type_list(ArgTypes0, ArgTypes) },
 	( { ArgTypes \= [] } ->
diff -u -r compiler/unique_modes.m /home/pgrad/dgj/mer/work/mercury/compiler/unique_modes.m
--- compiler/unique_modes.m	Thu Dec 18 18:13:23 1997
+++ /home/pgrad/dgj/mer/work/mercury/compiler/unique_modes.m	Wed Dec 17 13:10:29 1997
@@ -370,11 +370,11 @@
 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.
+		% Setting the context to `higher_order_call(...)' 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
diff -u -r compiler/unused_args.m /home/pgrad/dgj/mer/work/mercury/compiler/unused_args.m
--- compiler/unused_args.m	Thu Dec 18 18:11:56 1997
+++ /home/pgrad/dgj/mer/work/mercury/compiler/unused_args.m	Thu Dec 18 18:37:49 1997
@@ -929,15 +929,13 @@
 	pred_info_clauses_info(PredInfo0, ClausesInfo),
 	pred_info_get_markers(PredInfo0, Markers),
 	pred_info_get_goal_type(PredInfo0, GoalType),
+	pred_info_get_class_context(PredInfo0, ClassContext),
 	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, Markers,
-		GoalType, PredOrFunc, [], EmptyProofs, PredInfo1),
+		GoalType, PredOrFunc, ClassContext, EmptyProofs, PredInfo1),
 	pred_info_set_typevarset(PredInfo1, TypeVars, PredInfo).
 
 


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