[m-rev.] diff: fix solver types bug

[Mark Brown]

Estimated hours taken: 3
Branches: main, release-0.13

Fix a bug with solver type initialisation.

compiler/modes.m:
	Use type information to resolve ambiguity when looking up the
	initialisation predicate of a solver type.

tests/valid/Mmakefile:
tests/valid/solver_type_bug_2.m:
	Regression test.

Index: compiler/modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.336
diff -u -r1.336 modes.m
--- compiler/modes.m	12 Jul 2006 02:51:05 -0000	1.336
+++ compiler/modes.m	19 Jul 2006 15:46:21 -0000
@@ -3116,7 +3116,7 @@
         NonLocals = set.make_singleton_set(Var),
         InstmapDeltaAL = [Var - Inst],
         instmap_delta_from_assoc_list(InstmapDeltaAL, InstmapDelta),
-        build_call(ModuleName, PredName, [Var], NonLocals,
+        build_call(ModuleName, PredName, [Var], [VarType], NonLocals,
             InstmapDelta, Context, MaybeCallUnifyContext,
             GoalExpr - GoalInfo, !ModeInfo)
     ->
@@ -3126,25 +3126,14 @@
     ).
 
 :- pred build_call(module_name::in, string::in, list(prog_var)::in,
-    set(prog_var)::in, instmap_delta::in, prog_context::in,
-    maybe(call_unify_context)::in, hlds_goal::out,
+    list(mer_type)::in, set(prog_var)::in, instmap_delta::in,
+    prog_context::in, maybe(call_unify_context)::in, hlds_goal::out,
     mode_info::in, mode_info::out) is semidet.
 
-build_call(CalleeModuleName, CalleePredName, ArgVars, NonLocals, InstmapDelta,
-        Context, CallUnifyContext, Goal, !ModeInfo) :-
+build_call(CalleeModuleName, CalleePredName, ArgVars, ArgTypes, NonLocals,
+        InstmapDelta, Context, CallUnifyContext, Goal, !ModeInfo) :-
     mode_info_get_module_info(!.ModeInfo, ModuleInfo0),
 
-        % Get the pred_info and proc_info for the procedure we are calling.
-        %
-    module_info_get_predicate_table(ModuleInfo0, PredicateTable),
-    list.length(ArgVars, Arity),
-    predicate_table_search_pred_m_n_a(PredicateTable, is_fully_qualified,
-        CalleeModuleName, CalleePredName, Arity, [CalleePredId]),
-    CalleeProcNo = 0, % first mode
-    hlds_pred.proc_id_to_int(CalleeProcId, CalleeProcNo),
-    module_info_pred_proc_info(ModuleInfo0, CalleePredId, CalleeProcId,
-        CalleePredInfo, CalleeProcInfo),
-
         % Get the relevant information for the procedure we are transforming
         % (i.e., the caller).
         %
@@ -3152,6 +3141,15 @@
     mode_info_get_procid(!.ModeInfo, ProcId),
     module_info_pred_proc_info(ModuleInfo0, PredId, ProcId, PredInfo0,
         ProcInfo0),
+    pred_info_get_typevarset(PredInfo0, TVarSet),
+
+        % Get the pred_info and proc_info for the procedure we are calling.
+        %
+    SymName = qualified(CalleeModuleName, CalleePredName),
+    get_pred_id_and_proc_id(is_fully_qualified, SymName, predicate, TVarSet,
+        ArgTypes, ModuleInfo0, CalleePredId, CalleeProcId),
+    module_info_pred_proc_info(ModuleInfo0, CalleePredId, CalleeProcId,
+        CalleePredInfo, CalleeProcInfo),
 
         % Create a poly_info for the caller.  We have to set the varset and
         % vartypes from the mode_info, not the proc_info, because new vars may
Index: tests/valid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/valid/Mmakefile,v
retrieving revision 1.175
diff -u -r1.175 Mmakefile
--- tests/valid/Mmakefile	7 May 2006 23:08:15 -0000	1.175
+++ tests/valid/Mmakefile	19 Jul 2006 14:23:26 -0000
@@ -182,6 +182,7 @@
 	soln_context \
 	solv \
 	solver_type_bug \
+	solver_type_bug_2 \
 	solver_type_mutable_bug \
 	some_switch \
 	spurious_purity_warning \
Index: tests/valid/solver_type_bug_2.m
===================================================================
RCS file: tests/valid/solver_type_bug_2.m
diff -N tests/valid/solver_type_bug_2.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/valid/solver_type_bug_2.m	19 Jul 2006 14:21:08 -0000
@@ -0,0 +1,27 @@
+:- module solver_type_bug_2.
+:- interface.
+
+:- solver type foo where
+	representation is int,
+	initialisation is foo_init.
+
+:- pred foo_init(foo::oa) is det.
+
+:- solver type bar where
+	representation is int,
+	initialisation is bar_init.
+
+:- pred bar_init(bar::oa) is det.
+
+:- pred p(foo::oa) is det.
+
+:- implementation.
+
+foo_init(F) :-
+	promise_pure impure F = 'representation to any foo/0'(1).
+
+bar_init(F) :-
+	promise_pure impure F = 'representation to any bar/0'(2).
+
+p(_).
+
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at csse.unimelb.edu.au
administrative address: owner-mercury-reviews at csse.unimelb.edu.au
unsubscribe: Address: mercury-reviews-request at csse.unimelb.edu.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at csse.unimelb.edu.au Message: subscribe
--------------------------------------------------------------------------