[m-rev.] for review: improve $pred for methods

Peter Wang novalazy at gmail.com
Mon Apr 7 10:41:27 AEST 2008


Estimated hours taken: 1.5
Branches: main

Make `pred_id_to_string' a meaningful string for instance methods defined
using clause syntax.  Previously it returned "type class method
implementation" which is unhelpful as a substitution for the
implementation-defined literal `$pred'.

compiler/hlds_pred.m:
	Remember the method name in the `origin_instance_method' option of
	`pred_origin'.

compiler/check_typeclass.m:
	Add the method name to the constructions of `origin_instance_method'.

compiler/hlds_out.m:
	Make `pred_id_to_string' produce better output, as above. 

compiler/layout_out.m:
compiler/mode_errors.m:
compiler/polymorphism.m:
compiler/typecheck.m:
	Conform to changes above.

tests/hard_coded/impl_def_literal.exp:
tests/hard_coded/impl_def_literal.m:
	Test `$pred' in method implementations.

Index: compiler/check_typeclass.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/check_typeclass.m,v
retrieving revision 1.119
diff -u -p -r1.119 check_typeclass.m
--- compiler/check_typeclass.m	30 Dec 2007 11:09:08 -0000	1.119
+++ compiler/check_typeclass.m	4 Apr 2008 06:43:57 -0000
@@ -539,7 +539,7 @@ check_instance_pred_procs(ClassId, Class
         MatchingInstanceMethods = [InstanceMethod],
         OrderedInstanceMethods = [InstanceMethod | OrderedInstanceMethods0],
         InstanceMethod = instance_method(_, _, InstancePredDefn, _, Context),
-        produce_auxiliary_procs(ClassId, ClassVars, Markers,
+        produce_auxiliary_procs(ClassId, ClassVars, MethodName, Markers,
             InstanceTypes, InstanceConstraints,
             InstanceVarSet, InstanceModuleName,
             InstancePredDefn, Context,
@@ -619,14 +619,14 @@ get_matching_instance_defns(instance_bod
         ResultList = MatchingMethods
     ).
 
-:- pred produce_auxiliary_procs(class_id::in, list(tvar)::in, pred_markers::in,
-    list(mer_type)::in, list(prog_constraint)::in, tvarset::in,
-    module_name::in, instance_proc_def::in, prog_context::in,
+:- pred produce_auxiliary_procs(class_id::in, list(tvar)::in, sym_name::in,
+    pred_markers::in, list(mer_type)::in, list(prog_constraint)::in,
+    tvarset::in, module_name::in, instance_proc_def::in, prog_context::in,
     pred_id::out, list(proc_id)::out,
     instance_method_info::in, instance_method_info::out,
     list(error_spec)::in, list(error_spec)::out) is det.
 
-produce_auxiliary_procs(ClassId, ClassVars, Markers0,
+produce_auxiliary_procs(ClassId, ClassVars, MethodName, Markers0,
         InstanceTypes0, InstanceConstraints0, InstanceVarSet,
         InstanceModuleName, InstancePredDefn, Context, PredId,
         InstanceProcIds, Info0, Info, !Specs) :-
@@ -714,9 +714,10 @@ produce_auxiliary_procs(ClassId, ClassVa
     % order.
     MethodConstraints = instance_method_constraints(ClassId,
         InstanceTypes, InstanceConstraints, ClassMethodClassContext),
+    PredOrigin = origin_instance_method(MethodName, MethodConstraints),
     map.init(VarNameRemap),
     pred_info_init(InstanceModuleName, PredName, PredArity, PredOrFunc,
-        Context, origin_instance_method(MethodConstraints), Status,
+        Context, PredOrigin, Status,
         goal_type_none, Markers, ArgTypes, TVarSet, ExistQVars, ClassContext,
         Proofs, ConstraintMap, ClausesInfo, VarNameRemap, PredInfo0),
     pred_info_set_clauses_info(ClausesInfo, PredInfo0, PredInfo1),
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.447
diff -u -p -r1.447 hlds_out.m
--- compiler/hlds_out.m	3 Apr 2008 05:26:43 -0000	1.447
+++ compiler/hlds_out.m	4 Apr 2008 06:43:57 -0000
@@ -397,10 +397,20 @@ pred_id_to_string(ModuleInfo, PredId) = 
             ),
             Str = Descr ++ ForStr ++ type_name_to_string(TypeCtor)
         ;
-            pred_info_get_markers(PredInfo, Markers),
-            check_marker(Markers, marker_class_instance_method)
+            pred_info_get_origin(PredInfo, Origin),
+            Origin = origin_instance_method(MethodName, MethodConstraints)
         ->
-            Str = "type class method implementation"
+            MethodConstraints = instance_method_constraints(ClassId,
+                InstanceTypes, _, _),
+            MethodStr = simple_call_id_to_string(PredOrFunc, MethodName,
+                Arity),
+            ClassId = class_id(ClassName, _),
+            ClassStr = sym_name_to_string(ClassName),
+            TypeStrs = mercury_type_list_to_string(varset.init, InstanceTypes),
+            Str = string.append_list([
+                "instance method ", MethodStr,
+                " for `", ClassStr, "(", TypeStrs, ")'"
+            ])
         ;
             pred_info_get_goal_type(PredInfo, goal_type_promise(PromiseType))
         ->
@@ -942,7 +952,7 @@ write_pred(Indent, ModuleInfo, PredId, P
 
         pred_info_get_origin(PredInfo, Origin),
         (
-            Origin = origin_instance_method(MethodConstraints),
+            Origin = origin_instance_method(_, MethodConstraints),
             MethodConstraints = instance_method_constraints(ClassId,
                 InstanceTypes, InstanceConstraints, ClassMethodConstraints),
             io.write_string("% instance method constraints:\n", !IO),
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.240
diff -u -p -r1.240 hlds_pred.m
--- compiler/hlds_pred.m	27 Mar 2008 02:29:41 -0000	1.240
+++ compiler/hlds_pred.m	4 Apr 2008 06:43:57 -0000
@@ -485,11 +485,11 @@
     --->    origin_special_pred(special_pred)
                 % If the predicate is a unify, compare, index or initialisation
                 % predicate, specify which one, and for which type constructor.
-    ;       origin_instance_method(instance_method_constraints)
-                % If this predicate is a class method implementation, record
-                % extra information about the class context to allow
-                % polymorphism.m to correctly set up the extra type_info
-                % and typeclass_info arguments.
+    ;       origin_instance_method(sym_name, instance_method_constraints)
+                % The predicate is a class method implementation. Record
+                % the method name and extra information about the class
+                % context to allow polymorphism.m to correctly set up the
+                % extra type_info and typeclass_info arguments.
     ;       origin_transformed(pred_transformation, pred_origin, pred_id)
                 % The predicate is a transformed version of another predicate,
                 % whose origin and identity are given by the second and third
Index: compiler/layout_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/layout_out.m,v
retrieving revision 1.95
diff -u -p -r1.95 layout_out.m
--- compiler/layout_out.m	27 Feb 2008 07:23:08 -0000	1.95
+++ compiler/layout_out.m	4 Apr 2008 06:43:57 -0000
@@ -1426,7 +1426,7 @@ origin_name(Origin, Name0) = Name :-
             Name = OldName ++ "_" ++ pred_transform_name(Transform)
         )
     ;
-        ( Origin = origin_instance_method(_)
+        ( Origin = origin_instance_method(_, _)
         ; Origin = origin_created(_)
         ; Origin = origin_assertion(_, _)
         ; Origin = origin_user(_)
Index: compiler/mode_errors.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_errors.m,v
retrieving revision 1.124
diff -u -p -r1.124 mode_errors.m
--- compiler/mode_errors.m	27 Feb 2008 07:23:10 -0000	1.124
+++ compiler/mode_errors.m	4 Apr 2008 06:43:57 -0000
@@ -1164,7 +1164,7 @@ purity_error_lambda_should_be_any_to_spe
 %-----------------------------------------------------------------------------%
 
 should_report_mode_warning_for_pred_origin(origin_special_pred(_), no).
-should_report_mode_warning_for_pred_origin(origin_instance_method(_), no).
+should_report_mode_warning_for_pred_origin(origin_instance_method(_, _), no).
 should_report_mode_warning_for_pred_origin(origin_transformed(_, _, _), no).
 should_report_mode_warning_for_pred_origin(origin_created(_), no).
 should_report_mode_warning_for_pred_origin(origin_assertion(_, _), no).
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.331
diff -u -p -r1.331 polymorphism.m
--- compiler/polymorphism.m	5 Mar 2008 06:59:53 -0000	1.331
+++ compiler/polymorphism.m	4 Apr 2008 06:43:57 -0000
@@ -683,7 +683,7 @@ setup_headvars(PredInfo, !HeadVars, Extr
     pred_info_get_origin(PredInfo, Origin),
     ExtraArgModes0 = poly_arg_vector_init : poly_arg_vector(mer_mode),
     (
-        Origin = origin_instance_method(InstanceMethodConstraints),
+        Origin = origin_instance_method(_, InstanceMethodConstraints),
         setup_headvars_instance_method(PredInfo,
             InstanceMethodConstraints, !HeadVars,
             UnconstrainedTVars, ExtraHeadTypeInfoVars,
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.430
diff -u -p -r1.430 typecheck.m
--- compiler/typecheck.m	3 Apr 2008 05:26:45 -0000	1.430
+++ compiler/typecheck.m	4 Apr 2008 06:43:57 -0000
@@ -694,7 +694,7 @@ generate_stub_clause(PredName, !PredInfo
     pred_origin::in, pred_origin::out) is det.
 
 rename_instance_method_constraints(Renaming, Origin0, Origin) :-
-    ( Origin0 = origin_instance_method(Constraints0) ->
+    ( Origin0 = origin_instance_method(MethodName, Constraints0) ->
         Constraints0 = instance_method_constraints(ClassId, InstanceTypes0,
             InstanceConstraints0, ClassMethodClassContext0),
         apply_variable_renaming_to_type_list(Renaming, InstanceTypes0,
@@ -705,7 +705,7 @@ rename_instance_method_constraints(Renam
             ClassMethodClassContext0, ClassMethodClassContext),
         Constraints = instance_method_constraints(ClassId,
             InstanceTypes, InstanceConstraints, ClassMethodClassContext),
-        Origin = origin_instance_method(Constraints)
+        Origin = origin_instance_method(MethodName, Constraints)
     ;
         Origin = Origin0
     ).
Index: tests/hard_coded/impl_def_literal.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/impl_def_literal.exp,v
retrieving revision 1.1
diff -u -p -r1.1 impl_def_literal.exp
--- tests/hard_coded/impl_def_literal.exp	3 Apr 2008 05:26:48 -0000	1.1
+++ tests/hard_coded/impl_def_literal.exp	4 Apr 2008 06:43:57 -0000
@@ -10,3 +10,7 @@ impl_def_literal.sub
 predicate `impl_def_literal.sub.in_submodule'/2
 impl_def_literal.m
 10101
+instance method predicate `impl_def_literal.tc_p'/5 for `impl_def_literal.tc(int, character, ((impl_def_literal.sub).tt(V_1)))'
+instance method function `impl_def_literal.tc_f'/3 for `impl_def_literal.tc(int, character, ((impl_def_literal.sub).tt(V_1)))'
+predicate `impl_def_literal.sub.string_p'/5
+function `impl_def_literal.sub.string_f'/3
Index: tests/hard_coded/impl_def_literal.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/impl_def_literal.m,v
retrieving revision 1.1
diff -u -p -r1.1 impl_def_literal.m
--- tests/hard_coded/impl_def_literal.m	3 Apr 2008 05:26:48 -0000	1.1
+++ tests/hard_coded/impl_def_literal.m	4 Apr 2008 06:43:57 -0000
@@ -38,7 +38,20 @@ main(!IO) :-
         io.write_string("have $grade\n", !IO)
     ),
 
-    in_submodule(!IO).
+    in_submodule(!IO),
+
+    % Test literals in instance methods.
+    tc_p(1, 'a', tt(0), !IO),
+
+    tc_f(tt(0), 'b', 2) = F1,
+    io.write_string(F1, !IO),
+    io.nl(!IO),
+
+    tc_p("a", "b", "c", !IO),
+
+    tc_f("a", "b", "c") = F2,
+    io.write_string(F2, !IO),
+    io.nl(!IO).
 
 :- func a_function = string.
 
@@ -69,6 +82,11 @@ fun_with_lines_2(!IO) :-
         io.write_string("fun_with_lines_2: unequal\n", !IO)
     ).
 
+:- typeclass tc(A, B, C) where [
+    pred tc_p(A::in, B::in, C::in, io::di, io::uo) is det,
+    func tc_f(C, B, A) = string
+].
+
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
@@ -77,6 +95,11 @@ fun_with_lines_2(!IO) :-
 
 :- pred in_submodule(io::di, io::uo) is det.
 
+:- type tt(T) ---> tt(T).
+
+:- instance tc(int, character, tt(T)).
+:- instance tc(string, string, string).
+
 :- implementation.
 
 in_submodule(!IO) :-
@@ -90,6 +113,29 @@ in_submodule(!IO) :-
     io.write_int($line, !IO),
     io.nl(!IO).
 
+:- instance tc(int, character, tt(T)) where [
+    ( tc_p(_, _, _, !IO) :-
+        io.write_string($pred, !IO),
+        io.nl(!IO)
+    ),
+    ( tc_f(_, _, _) = $pred )
+].
+
+:- instance tc(string, string, string) where [
+    pred(tc_p/5) is string_p,
+    func(tc_f/3) is string_f
+].
+
+:- pred string_p(string::in, string::in, string::in, io::di, io::uo) is det.
+
+string_p(_, _, _, !IO) :-
+    io.write_string($pred, !IO),
+    io.nl(!IO).
+
+:- func string_f(string, string, string) = string.
+
+string_f(_, _, _) = $pred.
+
 :- end_module sub.
 
 %-----------------------------------------------------------------------------%


--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------



More information about the reviews mailing list