[m-rev.] diff: fix bug in overloading resolution

Mark Brown mark at cs.mu.OZ.AU
Mon Nov 14 15:10:04 AEDT 2005


Hi,

This fixes the bug recently reported by Pete Ross.  Note that the bug also
occurs on the 0.12 release branch, and probably also in earlier releases.
I'm not planning to fix the release branch, though, since:

	- The fix for the release branch would be significantly more
	  complex: there is no constraint map to refer to, so the fix
	  would involve recording in each type_assign which unifications
	  were actually function calls, passing this information through
	  to post_typecheck, and then using it to resolve the overloading.

	- In most cases a simple workaround is to module qualify any data
	  constructors that would otherwise be ambiguous.

I'll commit this change once bootchecking is complete.

Cheers,
Mark.

Estimated hours taken: 5
Branches: main

Fix a bug in overloading resolution.

compiler/post_typecheck.m:
	Make the constraint map available when resolving unifications with
	overloaded functors.

compiler/hlds_module.m:
	Use the constraint map, if available, to rule out possible pred_ids
	when resolving overloading.

compiler/hlds_data.m:
	Provide a means to search the constraint map and fail rather than
	abort if the constraints aren't found.

compiler/intermod.m:
	Update for the changed interface in hlds_module.m.

tests/valid/Mmakefile:
tests/valid/overloading.m:
	New test case.

Index: compiler/hlds_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_data.m,v
retrieving revision 1.100
diff -u -r1.100 hlds_data.m
--- compiler/hlds_data.m	4 Nov 2005 03:40:45 -0000	1.100
+++ compiler/hlds_data.m	14 Nov 2005 02:00:19 -0000
@@ -30,6 +30,7 @@
 :- implementation.
 
 :- import_module check_hlds.type_util.
+:- import_module libs.compiler_util.
 :- import_module parse_tree.prog_type.
 :- import_module parse_tree.prog_type_subst.
 
@@ -1016,6 +1017,9 @@
 :- pred lookup_hlds_constraint_list(constraint_map::in, constraint_type::in,
     goal_path::in, int::in, list(prog_constraint)::out) is det.
 
+:- pred search_hlds_constraint_list(constraint_map::in, constraint_type::in,
+    goal_path::in, int::in, list(prog_constraint)::out) is semidet.
+
 %-----------------------------------------------------------------------------%
 
 :- implementation.
@@ -1164,22 +1168,33 @@
 
 lookup_hlds_constraint_list(ConstraintMap, ConstraintType, GoalPath, Count,
         Constraints) :-
-    lookup_hlds_constraint_list_2(ConstraintMap, ConstraintType, GoalPath,
+    (
+        search_hlds_constraint_list_2(ConstraintMap, ConstraintType, GoalPath,
+            Count, [], Constraints0)
+    ->
+        Constraints = Constraints0
+    ;
+        unexpected(this_file, "lookup_hlds_constraint_list: not found")
+    ).
+
+search_hlds_constraint_list(ConstraintMap, ConstraintType, GoalPath, Count,
+        Constraints) :-
+    search_hlds_constraint_list_2(ConstraintMap, ConstraintType, GoalPath,
         Count, [], Constraints).
 
-:- pred lookup_hlds_constraint_list_2(constraint_map::in, constraint_type::in,
+:- pred search_hlds_constraint_list_2(constraint_map::in, constraint_type::in,
     goal_path::in, int::in, list(prog_constraint)::in,
-    list(prog_constraint)::out) is det.
+    list(prog_constraint)::out) is semidet.
 
-lookup_hlds_constraint_list_2(ConstraintMap, ConstraintType, GoalPath, Count,
+search_hlds_constraint_list_2(ConstraintMap, ConstraintType, GoalPath, Count,
         !Constraints) :-
     ( Count = 0 ->
         true
     ;
         ConstraintId = constraint_id(ConstraintType, GoalPath, Count),
-        map.lookup(ConstraintMap, ConstraintId, Constraint),
+        map.search(ConstraintMap, ConstraintId, Constraint),
         !:Constraints = [Constraint | !.Constraints],
-        lookup_hlds_constraint_list_2(ConstraintMap, ConstraintType,
+        search_hlds_constraint_list_2(ConstraintMap, ConstraintType,
             GoalPath, Count - 1, !Constraints)
     ).
 
@@ -1330,3 +1345,13 @@
 
 exclusive_table_add(ExclusiveId, PredId, ExclusiveTable0, ExclusiveTable) :-
     multi_map__set(ExclusiveTable0, PredId, ExclusiveId, ExclusiveTable).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "hlds_data.m".
+
+%-----------------------------------------------------------------------------%
+:- end_module hlds.hlds_data.
+%-----------------------------------------------------------------------------%
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_module.m,v
retrieving revision 1.124
diff -u -r1.124 hlds_module.m
--- compiler/hlds_module.m	8 Nov 2005 08:14:51 -0000	1.124
+++ compiler/hlds_module.m	14 Nov 2005 02:40:46 -0000
@@ -1480,13 +1480,21 @@
     list(mer_type)::in, tvarset::in, sym_name::in, sym_name::out, pred_id::out)
     is det.
 
-    % Find a predicate or function from the list of pred_ids
-    % which matches the given name and argument types.
-    % Fail if there is no matching pred.
-    % Abort if there are multiple matching preds.
+    % Find a predicate or function from the list of pred_ids which matches the
+    % given name and argument types.  If the constraint_search argument is
+    % provided then also check that the class context is consistent with what
+    % is expected.  Fail if there is no matching pred.  Abort if there are
+    % multiple matching preds.
     %
 :- pred find_matching_pred_id(module_info::in, list(pred_id)::in, tvarset::in,
-    list(mer_type)::in, pred_id::out, sym_name::out) is semidet.
+    list(mer_type)::in, maybe(constraint_search)::in(maybe(constraint_search)),
+    pred_id::out, sym_name::out) is semidet.
+
+    % A means to check that the required constraints are available, without
+    % knowing in advance how many are required.
+    %
+:- type constraint_search == pred(int, list(prog_constraint)).
+:- inst constraint_search == (pred(in, out) is semidet).
 
     % Get the pred_id and proc_id matching a higher-order term with
     % the given argument types, aborting with an error if none is found.
@@ -2179,7 +2187,7 @@
     % which subsume the actual argument/return types of this function call.
     (
         find_matching_pred_id(ModuleInfo, PredIds, TVarSet, ArgTypes,
-            PredId1, PredName1)
+            no, PredId1, PredName1)
     ->
         PredId = PredId1,
         PredName = PredName1
@@ -2190,7 +2198,7 @@
     ).
 
 find_matching_pred_id(ModuleInfo, [PredId | PredIds], TVarSet, ArgTypes,
-        ThePredId, PredName) :-
+        MaybeConstraintSearch, ThePredId, PredName) :-
     (
         % Lookup the argument types of the candidate predicate
         % (or the argument types + return type of the candidate function).
@@ -2201,7 +2209,19 @@
         pred_info_tvar_kinds(PredInfo, PredKindMap),
 
         arg_type_list_subsumes(TVarSet, ArgTypes, PredTVarSet, PredKindMap,
-            PredExistQVars0, PredArgTypes0)
+            PredExistQVars0, PredArgTypes0),
+
+        (
+            MaybeConstraintSearch = no
+        ;
+            MaybeConstraintSearch = yes(ConstraintSearch),
+            % Lookup the universal constraints on the condidate predicate.
+            pred_info_get_class_context(PredInfo, ProgConstraints),
+            ProgConstraints = constraints(UnivConstraints, _),
+            list__length(UnivConstraints, NumConstraints),
+            ConstraintSearch(NumConstraints, ProvenConstraints),
+            univ_constraints_match(ProvenConstraints, UnivConstraints)
+        )
     ->
         % We've found a matching predicate.
         % Was there was more than one matching predicate/function?
@@ -2211,7 +2231,7 @@
         PredName = qualified(Module, PName),
         (
             find_matching_pred_id(ModuleInfo, PredIds, TVarSet, ArgTypes,
-                _OtherPredId, _)
+                MaybeConstraintSearch, _OtherPredId, _)
         ->
             % XXX this should report an error properly, not
             % via error/1
@@ -2224,9 +2244,30 @@
         )
     ;
         find_matching_pred_id(ModuleInfo, PredIds, TVarSet, ArgTypes,
-            ThePredId, PredName)
+            MaybeConstraintSearch, ThePredId, PredName)
     ).
 
+    % Check that the universal constraints proven in the caller match the
+    % constraints on the callee.
+    %
+    % XXX we should rename apart the callee constraints and check that the
+    % proven constraints are instances of them.  This would give us better
+    % overloading resolution.  For the moment, we just check that the names
+    % and arities match, which is sufficient to prevent any compiler aborts
+    % in later stages.
+    %
+:- pred univ_constraints_match(list(prog_constraint)::in,
+    list(prog_constraint)::in) is semidet.
+
+univ_constraints_match([], []).
+univ_constraints_match([ProvenConstraint | ProvenConstraints],
+        [CalleeConstraint | CalleeConstraints]) :-
+    ProvenConstraint = constraint(Name, ProvenArgs),
+    list__length(ProvenArgs, Arity),
+    CalleeConstraint = constraint(Name, CalleeArgs),
+    list__length(CalleeArgs, Arity),
+    univ_constraints_match(ProvenConstraints, CalleeConstraints).
+
 get_pred_id(IsFullyQualified, SymName, PredOrFunc, TVarSet,
         ArgTypes, ModuleInfo, PredId) :-
     module_info_get_predicate_table(ModuleInfo, PredicateTable),
@@ -2235,7 +2276,7 @@
         predicate_table_search_pf_sym_arity(PredicateTable, IsFullyQualified,
             PredOrFunc, SymName, Arity, PredIds),
         % Resolve overloading using the argument types.
-        find_matching_pred_id(ModuleInfo, PredIds, TVarSet, ArgTypes,
+        find_matching_pred_id(ModuleInfo, PredIds, TVarSet, ArgTypes, no,
             PredId0, _PredName)
     ->
         PredId = PredId0
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.185
diff -u -r1.185 intermod.m
--- compiler/intermod.m	8 Nov 2005 03:58:52 -0000	1.185
+++ compiler/intermod.m	14 Nov 2005 02:14:01 -0000
@@ -930,7 +930,7 @@
             may_be_partially_qualified, InstanceMethodName0,
             MethodArity, PredIds),
         find_matching_pred_id(ModuleInfo, PredIds, MethodCallTVarSet,
-            MethodCallArgTypes, PredId, InstanceMethodFuncName)
+            MethodCallArgTypes, no, PredId, InstanceMethodFuncName)
     ->
         TypeCtors = [],
         MaybePredId = yes(PredId),
Index: compiler/post_typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/post_typecheck.m,v
retrieving revision 1.88
diff -u -r1.88 post_typecheck.m
--- compiler/post_typecheck.m	4 Nov 2005 03:40:54 -0000	1.88
+++ compiler/post_typecheck.m	14 Nov 2005 02:12:28 -0000
@@ -1132,12 +1132,17 @@
             PredName, Arity, PredIds),
 
         % Check if any of the candidate functions have argument/return types
-        % which subsume the actual argument/return types of this function call.
+        % which subsume the actual argument/return types of this function call,
+        % and which have universal constraints consistent with what we expect.
         pred_info_typevarset(!.PredInfo, TVarSet),
         map__apply_to_list(ArgVars0, !.VarTypes, ArgTypes0),
         list__append(ArgTypes0, [TypeOfX], ArgTypes),
+        pred_info_get_constraint_map(!.PredInfo, ConstraintMap),
+        goal_info_get_goal_path(GoalInfo0, GoalPath),
+        ConstraintSearch = search_hlds_constraint_list(ConstraintMap, unproven,
+            GoalPath),
         find_matching_pred_id(ModuleInfo, PredIds, TVarSet, ArgTypes,
-            PredId, QualifiedFuncName)
+            yes(ConstraintSearch), PredId, QualifiedFuncName)
     ->
         % Convert function calls into predicate calls:
         % replace `X = f(A, B, C)' with `f(A, B, C, X)'.
Index: tests/valid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/valid/Mmakefile,v
retrieving revision 1.159
diff -u -r1.159 Mmakefile
--- tests/valid/Mmakefile	10 Oct 2005 02:23:48 -0000	1.159
+++ tests/valid/Mmakefile	14 Nov 2005 01:20:39 -0000
@@ -161,6 +161,7 @@
 	nested_mod_type_bug \
 	nested_module_bug \
 	nondet_live \
+	overloading \
 	parsing_bug_main \
 	pred_with_no_modes \
 	qualified_cons_id \
Index: tests/valid/overloading.m
===================================================================
RCS file: tests/valid/overloading.m
diff -N tests/valid/overloading.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/valid/overloading.m	14 Nov 2005 02:44:19 -0000
@@ -0,0 +1,19 @@
+:- module overloading.
+:- interface.
+
+:- type foo(T)
+	--->	f1(T, T)
+	;	f2.
+
+:- pred bar(foo(T)::in, T::in) is semidet.
+
+:- implementation.
+
+% The symbol f1/2 is overloaded here, but the overloading is resolved
+% because the baz/1 constraint cannot be reduced.
+bar(f1(X, _), X).
+
+:- typeclass baz(T) where [].
+:- func f1(T, T) = foo(T) <= baz(T).
+f1(_, _) = f2.
+
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------



More information about the reviews mailing list