for review: type class error messages

David Glen JEFFERY dgj at cs.mu.OZ.AU
Tue Sep 22 15:34:58 AEST 1998


Hi,

Someone want to review this?

Test case to follow soon.

----------------------------------------------------------------------------

Estimated hours taken: 10

Improve the error messages generated by check_typeclass.m.

check_typeclass.m:
	Write decent error messages, including term__contexts for the
	appropriate lines, for the errors detected by this module. These errors
	are missing or multiple definitions of instance methods and unsatisfied
	superclass constraints on instance decls.
mercury_to_mercury.m:
	Add predicates which convert class_constraints and types into strings.
	This is needed so that an error message can be created as a string,
	then formatted to fit the line, rather than writing out the error
	message as you go.
hlds_data.m:
	Add a term__context to the hlds_instance_defn.
base_typeclass_info.m:
dead_proc_elim.m:
higher_order.m:
hlds_out.m:
polymorphism.m:
typecheck.m:
	Ignore the term__context field of the hlds_instance_defn.
make_hlds.m:
	Insert the term__context field into the hlds_instance_defn when it
	is created.

cvs diff: Diffing .
Index: base_typeclass_info.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/base_typeclass_info.m,v
retrieving revision 1.5
diff -u -t -r1.5 base_typeclass_info.m
--- base_typeclass_info.m	1998/09/03 11:13:25	1.5
+++ base_typeclass_info.m	1998/09/18 06:23:16
@@ -72,7 +72,7 @@
                 ModuleName, ModuleInfo, CModules) :-
         base_typeclass_info__gen_infos_for_instance_list(ClassId - Is,
                 ModuleName, ModuleInfo, CModules1),
-        InstanceDefn = hlds_instance_defn(ImportStatus,
+        InstanceDefn = hlds_instance_defn(ImportStatus, _TermContext,
                                 InstanceConstraints, InstanceTypes, _Interface,
                                 PredProcIds, _Varset, _SuperClassProofs),
         (
Index: check_typeclass.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/check_typeclass.m,v
retrieving revision 1.15
diff -u -t -r1.15 check_typeclass.m
--- check_typeclass.m	1998/08/05 08:45:52	1.15
+++ check_typeclass.m	1998/09/22 05:20:14
@@ -59,8 +59,12 @@
 
 :- import_module map, list, std_util, hlds_pred, hlds_data, prog_data, require.
 :- import_module type_util, assoc_list, mode_util, inst_match, hlds_module.
-:- import_module term, varset, typecheck, int, globals, make_hlds. 
+:- import_module term, varset, typecheck, int, globals, make_hlds, error_util. 
 :- import_module base_typeclass_info, string, hlds_goal, set, prog_out.
+:- import_module mercury_to_mercury.
+
+:- type error_message == pair(term__context, list(format_component)).
+:- type error_messages == list(error_message).
 
 check_typeclass__check_instance_decls(ModuleInfo0, ModuleInfo, FoundError, 
                 IO0, IO) :-
@@ -80,9 +84,14 @@
         ;
                 ModuleInfo = ModuleInfo1,
                 list__reverse(Errors, ErrorList),
-                io__write_list(ErrorList, "\n", io__write_string, IO0, IO1),
-                io__write_string("\n", IO1, IO2),
-                io__set_exit_status(1, IO2, IO),
+                WriteError = lambda([E::in, TheIO0::di, TheIO::uo] is det,
+                        (
+                                E = ErrorContext - ErrorPieces,
+                                write_error_pieces(ErrorContext, 0, 
+                                        ErrorPieces, TheIO0, TheIO)
+                        )),
+                list__foldl(WriteError, ErrorList, IO0, IO1),
+                io__set_exit_status(1, IO1, IO),
                 FoundError = yes
         ).  
                 
@@ -90,8 +99,8 @@
 :- pred check_one_class(class_table,
         pair(class_id, list(hlds_instance_defn)), 
         pair(class_id, list(hlds_instance_defn)), 
-        pair(list(string), module_info), 
-        pair(list(string), module_info)).
+        pair(error_messages, module_info), 
+        pair(error_messages, module_info)).
 :- mode check_one_class(in, in, out, in, out) is det.
 
 check_one_class(ClassTable, ClassId - InstanceDefns0, 
@@ -118,8 +127,8 @@
 :- pred check_class_instance(class_id, list(class_constraint), list(var),
         hlds_class_interface, varset, list(pred_id), 
         hlds_instance_defn, hlds_instance_defn, 
-        pair(list(string), module_info), 
-        pair(list(string), module_info)).
+        pair(error_messages, module_info), 
+        pair(error_messages, module_info)).
 :- mode check_class_instance(in, in, in, in, in, in, in, out, in, out) is det.
 
 check_class_instance(ClassId, SuperClasses, Vars, ClassInterface, ClassVarSet,
@@ -136,17 +145,17 @@
                         ModuleInfo0, ModuleInfo1)
         ;
                 % there are no methods for this class
-                InstanceDefn0 = hlds_instance_defn(A, B, C, D, 
-                                _MaybeInstancePredProcs, F, G),
-                InstanceDefn1 = hlds_instance_defn(A, B, C, D, 
-                                yes([]), F, G),
+                InstanceDefn0 = hlds_instance_defn(A, B, C, D, E,
+                                _MaybeInstancePredProcs, G, H),
+                InstanceDefn1 = hlds_instance_defn(A, B, C, D, E,
+                                yes([]), G, H),
                 ModuleInfo1 = ModuleInfo0
         ),
 
 
                 % check that the superclass constraints are satisfied for the
                 % types in this instance declaration
-        check_superclass_conformance(SuperClasses, Vars, ClassVarSet,
+        check_superclass_conformance(ClassId, SuperClasses, Vars, ClassVarSet,
                 InstanceDefn1, InstanceDefn, ModuleInfo1, ModuleInfo).
 
 %----------------------------------------------------------------------------%
@@ -168,7 +177,7 @@
                 list(pair(list(mode), determinism)),    % Modes and 
                                                         % determinisms of the
                                                         % required procs.
-                list(string),                           % Error messages
+                error_messages,                         % Error messages
                                                         % that have been
                                                         % generated.
                 tvarset,                
@@ -183,7 +192,7 @@
         % check one pred in one instance of one class
 :- pred check_instance_pred(class_id, list(var), hlds_class_interface, 
         pred_id, hlds_instance_defn, hlds_instance_defn,
-        pair(list(string), module_info), pair(list(string), module_info)).
+        pair(error_messages, module_info), pair(error_messages, module_info)).
 :- mode check_instance_pred(in,in, in, in, in, out, in, out) is det.
 
 check_instance_pred(ClassId, ClassVars, ClassInterface, PredId,
@@ -231,7 +240,7 @@
                 ProcIds, 
                 ArgModes),
         
-        InstanceDefn0 = hlds_instance_defn(Status, _, InstanceTypes, 
+        InstanceDefn0 = hlds_instance_defn(Status, _, _, InstanceTypes, 
                 _, _, _, _),
 
                 % Work out the name of the predicate that we will generate
@@ -243,23 +252,24 @@
                 ExistQVars, ArgTypes, ClassContext, ArgModes, Errors0,
                 ArgTypeVars, Status, PredOrFunc),
 
-        check_instance_pred_procs(ClassVars, MethodName,
+        check_instance_pred_procs(ClassId, ClassVars, MethodName,
                 InstanceDefn0, InstanceDefn, Info0, Info),
 
         Info = instance_method_info(ModuleInfo, _PredName, _PredArity, 
                 _ExistQVars, _ArgTypes, _ClassContext, _ArgModes, Errors,
                 _ArgTypeVars, _Status, _PredOrFunc).
 
-:- pred check_instance_pred_procs(list(var), sym_name,
+:- pred check_instance_pred_procs(class_id, list(var), sym_name,
         hlds_instance_defn, hlds_instance_defn, 
         instance_method_info, instance_method_info).
-:- mode check_instance_pred_procs(in, in, in, out, in, out) is det.
+:- mode check_instance_pred_procs(in, in, in, in, out, in, out) is det.
 
-check_instance_pred_procs(ClassVars, MethodName, InstanceDefn0, InstanceDefn, 
-                Info0, Info) :-
-        InstanceDefn0 = hlds_instance_defn(A, InstanceConstraints,
-                                InstanceTypes, InstanceInterface,
-                                MaybeInstancePredProcs, InstanceVarSet, F),
+check_instance_pred_procs(ClassId, ClassVars, MethodName, InstanceDefn0,
+                InstanceDefn, Info0, Info) :-
+        InstanceDefn0 = hlds_instance_defn(A, InstanceContext, 
+                                InstanceConstraints, InstanceTypes,
+                                InstanceInterface, MaybeInstancePredProcs,
+                                InstanceVarSet, H),
         Info0 = instance_method_info(ModuleInfo, PredName, PredArity, 
                 ExistQVars, ArgTypes, ClassContext, ArgModes, Errors0,
                 ArgTypeVars, Status, PredOrFunc),
@@ -289,40 +299,69 @@
                         MaybeInstancePredProcs = no,
                         InstancePredProcs = InstancePredProcs1
                 ),
-                InstanceDefn = hlds_instance_defn(A, InstanceConstraints,
-                        InstanceTypes, InstanceInterface,
-                        yes(InstancePredProcs), InstanceVarSet, F)
+                InstanceDefn = hlds_instance_defn(A, Context, 
+                        InstanceConstraints, InstanceTypes, InstanceInterface,
+                        yes(InstancePredProcs), InstanceVarSet, H)
         ;
-                InstanceNames = [_,_|_]
+                InstanceNames = [_-I1,I2|Is]
         ->
                         % one kind of error
-                        % XXX still room for improvement in the error message
                 InstanceDefn = InstanceDefn0,
+                ClassId = class_id(ClassName, _ClassArity),
                 prog_out__sym_name_to_string(MethodName, MethodNameString),
+                prog_out__sym_name_to_string(ClassName, ClassNameString),
                 string__int_to_string(PredArity, PredArityString),
+                mercury_type_list_to_string(InstanceVarSet, InstanceTypes,
+                        InstanceTypesString),
                 string__append_list([
-                        "Multiple implementations of type class method ",
+                        "In instance declaration for ",
+                        ClassNameString,
+                        "(",
+                        InstanceTypesString,
+                        "), ",
+                        "multiple implementations of type class method ",
                         MethodNameString,
                         "/",
-                        PredArityString],
-                        NewError),
-                Errors = [NewError|Errors0],
+                        PredArityString,
+                        "."],
+                        ErrorHeader),
+                Heading = [I1-[words("First definition appears here.")],
+                        InstanceContext-[words(ErrorHeader)]],
+                list__map(lambda([Definition::in, ContextAndError::out] is det,
+                (
+                        Definition = _ - TheContext,
+                        Error = [words("Subsequent definition appears here.")],
+                        ContextAndError = TheContext - Error
+                )), [I2|Is], SubsequentErrors),
+                        
+                        % errors are built up in reverse.
+                list__append(SubsequentErrors, Heading, NewErrors),
+                list__append(NewErrors, Errors0, Errors),
                 Info = instance_method_info(ModuleInfo, PredName, PredArity,
                         ExistQVars, ArgTypes, ClassContext, ArgModes, Errors,
                         ArgTypeVars, Status, PredOrFunc)
         ;
-                         % another kind of error
-                         % XXX still room for improvement in the error message
+                        % another kind of error
                 InstanceDefn = InstanceDefn0,
+                ClassId = class_id(ClassName, _ClassArity),
                 prog_out__sym_name_to_string(MethodName, MethodNameString),
+                prog_out__sym_name_to_string(ClassName, ClassNameString),
                 string__int_to_string(PredArity, PredArityString),
+                mercury_type_list_to_string(InstanceVarSet, InstanceTypes,
+                        InstanceTypesString),
                 string__append_list([
-                        "No implementation for type class method ",
+                        "In instance declaration for ",
+                        ClassNameString,
+                        "(",
+                        InstanceTypesString,
+                        "), ",
+                        "no implementation for type class method ",
                         MethodNameString,
                         "/",
-                        PredArityString],
+                        PredArityString,
+                        "."],
                         NewError),
-                Errors = [NewError|Errors0],
+                Errors = [InstanceContext-[words(NewError)]|Errors0],
                 Info = instance_method_info(ModuleInfo, PredName, PredArity,
                         ExistQVars, ArgTypes, ClassContext, ArgModes, Errors,
                         ArgTypeVars, Status, PredOrFunc)
@@ -535,17 +574,17 @@
 % check that the superclass constraints are satisfied for the
 % types in this instance declaration
 
-:- pred check_superclass_conformance(list(class_constraint), list(var),
-        varset, hlds_instance_defn, hlds_instance_defn, 
-        pair(list(string), module_info), pair(list(string), module_info)).
-:- mode check_superclass_conformance(in, in, in, in, out, in, out) is det.
+:- pred check_superclass_conformance(class_id, list(class_constraint), 
+        list(var), varset, hlds_instance_defn, hlds_instance_defn, 
+        pair(error_messages, module_info), pair(error_messages, module_info)).
+:- mode check_superclass_conformance(in, in, in, in, in, out, in, out) is det.
 
-check_superclass_conformance(SuperClasses0, ClassVars0, ClassVarSet, 
+check_superclass_conformance(ClassId, SuperClasses0, ClassVars0, ClassVarSet, 
                 InstanceDefn0, InstanceDefn, 
                 Errors0 - ModuleInfo, Errors - ModuleInfo) :-
 
-        InstanceDefn0 = hlds_instance_defn(A, InstanceConstraints,
-                InstanceTypes, D, E, InstanceVarSet0, Proofs0),
+        InstanceDefn0 = hlds_instance_defn(A, Context, InstanceConstraints,
+                InstanceTypes, E, F, InstanceVarSet0, Proofs0),
         varset__merge_subst(InstanceVarSet0, ClassVarSet, InstanceVarSet1,
                 Subst),
 
@@ -568,24 +607,58 @@
         module_info_instances(ModuleInfo, InstanceTable),
         module_info_superclasses(ModuleInfo, SuperClassTable),
 
+                % Try to reduce the superclass constraints,
+                % using the declared instance constraints
+                % and the usual context reduction rules.
+        typecheck__reduce_context_by_rule_application(InstanceTable, 
+                SuperClassTable, InstanceConstraints, TypeSubst,
+                InstanceVarSet1, InstanceVarSet2, Proofs0, Proofs1,
+                SuperClasses, UnprovenConstraints),
+
         (
-                        % Try to reduce the superclass constraints,
-                        % using the declared instance constraints
-                        % and the usual context reduction rules.
-                typecheck__reduce_context_by_rule_application(InstanceTable, 
-                        SuperClassTable, InstanceConstraints, TypeSubst,
-                        InstanceVarSet1, InstanceVarSet2,
-                        Proofs0, Proofs1, SuperClasses, 
-                        [])
+                UnprovenConstraints = []
         ->
                 Errors = Errors0,
-                InstanceDefn = hlds_instance_defn(A, InstanceConstraints,
-                        InstanceTypes, D, E, InstanceVarSet2, Proofs1)
+                InstanceDefn = hlds_instance_defn(A, Context, 
+                        InstanceConstraints, InstanceTypes, E, F, 
+                        InstanceVarSet2, Proofs1)
         ;
-                        % XXX improve the error message
-                NewError = "superclass constraint unsatisfied",
-                Errors = [NewError|Errors0],
+                ClassId = class_id(ClassName, _ClassArity),
+                prog_out__sym_name_to_string(ClassName, ClassNameString),
+                mercury_type_list_to_string(InstanceVarSet2, InstanceTypes,
+                        InstanceTypesString),
+                constraint_list_to_string(ClassVarSet, UnprovenConstraints, 
+                        ConstraintsString),
+                string__append_list([
+                        "In instance declaration for ",
+                        ClassNameString,
+                        "(",
+                        InstanceTypesString,
+                        "), ",
+                        "superclass constraint(s) not satisfied: ",
+                        ConstraintsString,
+                        "."],
+                        NewError),
+                Errors = [Context-[words(NewError)]|Errors0],
                 InstanceDefn = InstanceDefn0
         ).
+
+:- pred constraint_list_to_string(varset, list(class_constraint), string).
+:- mode constraint_list_to_string(in, in, out) is det.
+
+constraint_list_to_string(_, [], "").
+constraint_list_to_string(VarSet, [C|Cs], String) :-
+        mercury_constraint_to_string(VarSet, C, String0),
+        constraint_list_to_string_2(VarSet, Cs, String1),
+        string__append(String0, String1, String).
+
+:- pred constraint_list_to_string_2(varset, list(class_constraint), string).
+:- mode constraint_list_to_string_2(in, in, out) is det.
+
+constraint_list_to_string_2(_VarSet, [], "").
+constraint_list_to_string_2(VarSet, [C|Cs], String) :-
+        mercury_constraint_to_string(VarSet, C, String0),
+        constraint_list_to_string_2(VarSet, Cs, String1),
+        string__append_list([", ", String0, String1], String).
 
 %---------------------------------------------------------------------------%
Index: dead_proc_elim.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/dead_proc_elim.m,v
retrieving revision 1.41
diff -u -t -r1.41 dead_proc_elim.m
--- dead_proc_elim.m	1998/06/09 02:12:17	1.41
+++ dead_proc_elim.m	1998/09/18 06:23:35
@@ -223,7 +223,8 @@
 :- 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, _, _),
+        Instance = hlds_instance_defn(ImportStatus, _, _, _, _, 
+                        PredProcIds, _, _),
         (
                         % We only need the instance declarations which were
                         % made in this module.
Index: higher_order.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/higher_order.m,v
retrieving revision 1.46
diff -u -t -r1.46 higher_order.m
--- higher_order.m	1998/09/10 06:51:09	1.46
+++ higher_order.m	1998/09/18 06:23:51
@@ -608,7 +608,7 @@
                         module_info_instances(ModuleInfo, Instances),
                         map__lookup(Instances, ClassId, InstanceList),
                         list__index1_det(InstanceList, Instance, InstanceDefn),
-                        InstanceDefn = hlds_instance_defn(_,
+                        InstanceDefn = hlds_instance_defn(_, _,
                                 InstanceConstraints, _, _,
                                 yes(ClassInterface), _, _),
                         list__length(InstanceConstraints, InstanceArity),
@@ -1018,7 +1018,7 @@
                 module_info_instances(ModuleInfo, Instances),
                 map__lookup(Instances, ClassId, InstanceDefns),
                 list__index1_det(InstanceDefns, InstanceNum, InstanceDefn),
-                InstanceDefn = hlds_instance_defn(_, Constraints, _,_,_,_,_),
+                InstanceDefn = hlds_instance_defn(_, _, Constraints, _,_,_,_,_),
                 list__length(Constraints, NumConstraints),      
                 TypeInfoIndex is Index + NumConstraints,        
                 list__index1_det(OtherVars, TypeInfoIndex, TypeInfoArg),
Index: hlds_data.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_data.m,v
retrieving revision 1.27
diff -u -t -r1.27 hlds_data.m
--- hlds_data.m	1998/09/18 02:19:56	1.27
+++ hlds_data.m	1998/09/18 06:21:05
@@ -737,6 +737,7 @@
         --->    hlds_instance_defn(
                         import_status,          % import status of the instance
                                                 % declaration
+                        term__context,          % context of declaration
                         list(class_constraint), % Constraints
                         list(type),             % ClassTypes 
                         instance_interface,     % Methods
Index: hlds_out.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_out.m,v
retrieving revision 1.202
diff -u -t -r1.202 hlds_out.m
--- hlds_out.m	1998/09/18 02:20:04	1.202
+++ hlds_out.m	1998/09/18 06:24:48
@@ -2179,10 +2179,10 @@
 
 hlds_out__write_instance_defn(Indent, InstanceDefn) -->
 
-        { InstanceDefn = hlds_instance_defn(_, Constraints, Types, Interface,
+        { InstanceDefn = hlds_instance_defn(_, Context,
+                Constraints, Types, Interface,
                 _MaybeClassInterface, VarSet, Proofs) },
 
-        /*
         { term__context_file(Context, FileName) },
         { term__context_line(Context, LineNumber) },
         ( { FileName \= "" } ->
@@ -2195,7 +2195,6 @@
         ;
                 []
         ),
-        */
 
                 % curry the varset for term_io__write_variable/4
         { PrintTerm = lambda([TypeName::in, IO0::di, IO::uo] is det,
Index: make_hlds.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/make_hlds.m,v
retrieving revision 1.272
diff -u -t -r1.272 make_hlds.m
--- make_hlds.m	1998/09/15 07:30:50	1.272
+++ make_hlds.m	1998/09/18 06:25:21
@@ -1493,8 +1493,8 @@
                 { map__search(Classes, Key, _) }
         ->
                 { map__init(Empty) },
-                { NewValue = hlds_instance_defn(Status, Constraints, Types,
-                        Interface, no, VarSet, Empty) },
+                { NewValue = hlds_instance_defn(Status, Context, Constraints, 
+                        Types, Interface, no, VarSet, Empty) },
                 { map__lookup(Instances0, Key, Values) },
                 { map__det_update(Instances0, Key, [NewValue|Values], 
                         Instances) },
Index: mercury_to_mercury.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.146
diff -u -t -r1.146 mercury_to_mercury.m
--- mercury_to_mercury.m	1998/09/17 06:42:40	1.146
+++ mercury_to_mercury.m	1998/09/22 04:58:04
@@ -157,6 +157,12 @@
 :- pred mercury_output_term(term, varset, bool, io__state, io__state).
 :- mode mercury_output_term(in, in, in, di, uo) is det.
 
+:- pred mercury_type_to_string(varset, term, string).
+:- mode mercury_type_to_string(in, in, out) is det.
+
+:- pred mercury_type_list_to_string(varset, list(term), string).
+:- mode mercury_type_list_to_string(in, in, out) is det.
+
 :- pred mercury_output_newline(int, io__state, io__state).
 :- mode mercury_output_newline(in, di, uo) is det.
 
@@ -170,6 +176,10 @@
                 io__state, io__state).
 :- mode mercury_output_constraint(in, in, di, uo) is det.
 
+:- pred mercury_constraint_to_string(varset, class_constraint, 
+                string).
+:- mode mercury_constraint_to_string(in, in, out) is det.
+
         % output an existential quantifier
 :- pred mercury_output_quantifier(tvarset, existq_tvars, io__state, io__state).
 :- mode mercury_output_quantifier(in, in, di, uo) is det.
@@ -1452,11 +1462,63 @@
                 io__write_char(')')
         ).
 
+        % This code could be written in terms of mercury_constraint_to_string
+        % and io__write_string , but for efficiency's sake it's probably not
+        % worth doing as it would mean building an intermediate string every
+        % time you print a constraint. (eg. when generating interface files).
 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(')').
+
+mercury_constraint_to_string(VarSet, constraint(Name, Types), String) :-
+        prog_out__sym_name_to_string(Name, NameString),
+        mercury_type_list_to_string(VarSet, Types, TypeString),
+        string__append_list([NameString, "(", TypeString, ")"], String).
+
+mercury_type_list_to_string(_, [], "").
+mercury_type_list_to_string(VarSet, [T|Ts], String) :-
+        mercury_type_to_string(VarSet, T, String0),
+        type_list_to_string_2(VarSet, Ts, String1),
+        string__append(String0, String1, String).
+
+:- pred type_list_to_string_2(varset, list(term), string).
+:- mode type_list_to_string_2(in, in, out) is det.
+
+type_list_to_string_2(_, [], "").
+type_list_to_string_2(VarSet, [T|Ts], String) :-
+        mercury_type_to_string(VarSet, T, String0),
+        type_list_to_string_2(VarSet, Ts, String1),
+        string__append_list([String0, ", ", String1], String).
+
+        % XXX this should probably be a little cleverer, like
+        % mercury_output_term. 
+mercury_type_to_string(VarSet, term__variable(Var), String) :-
+        varset__lookup_name(VarSet, Var, String).
+mercury_type_to_string(VarSet, term__functor(Functor, Args, _), String) :-
+        (
+                Functor = term__atom(":"),
+                Args = [Arg1, Arg2]
+        ->
+                mercury_type_to_string(VarSet, Arg1, String1),
+                mercury_type_to_string(VarSet, Arg2, String2),
+                string__append_list([String1, ":", String2], String)
+        ;
+                Functor = term__atom(Atom)
+        ->
+                (
+                        Args = []
+                ->
+                        String = Atom
+                ;
+                        mercury_type_list_to_string(VarSet, Args, ArgsString),
+                        string__append_list([Atom, "(", ArgsString, ")"],
+                                String)
+                )
+        ;
+                error("mercury_type_to_string: atom expected for type")
+        ).
 
 :- pred output_type(varset, term, io__state, io__state).
 :- mode output_type(in, in, di, uo) is det.
Index: polymorphism.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/polymorphism.m,v
retrieving revision 1.149
diff -u -t -r1.149 polymorphism.m
--- polymorphism.m	1998/09/18 02:20:20	1.149
+++ polymorphism.m	1998/09/18 06:25:46
@@ -1697,7 +1697,7 @@
                         list__index1_det(InstanceList, InstanceNum,
                                 ProofInstanceDefn),
 
-                        ProofInstanceDefn = hlds_instance_defn(_,
+                        ProofInstanceDefn = hlds_instance_defn(_, _,
                                 InstanceConstraints0, InstanceTypes0, _, _, 
                                 InstanceTVarset, SuperClassProofs0),
 
Index: typecheck.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/typecheck.m,v
retrieving revision 1.246
diff -u -t -r1.246 typecheck.m
--- typecheck.m	1998/09/18 02:20:43	1.246
+++ typecheck.m	1998/09/18 06:26:27
@@ -3394,8 +3394,9 @@
 
 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),
+        I = hlds_instance_defn(_Status, _Context, NewConstraints0, 
+                InstanceTypes0, _Interface, _PredProcIds, InstanceNames,
+                _SuperClassProofs),
         (
                 varset__merge_subst(TVarSet, InstanceNames, NewTVarSet0,
                         RenameSubst),

----------------------------------------------------------------------------

dgj
-- 
David Jeffery (dgj at cs.mu.oz.au) |  Marge: Did you just call everyone "chicken"?
PhD 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