[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