[m-rev.] For review: fix a mode analysis bug

[Ralph Becket]

Estimated hours taken: 13
Branches: main

Mode analysis was aborting in a program where it was inserting a new
variable for an implied mode unification, but the new variable id
already had a (non-free) mapping in the instmap, which led to a
compiler abort (it thought it was about to enter an infinite loop).

This problem was introduced when Mark changed modes.build_call with
his recent fixes for polymorphism.  modes.build_call extracts the
module_info from the mode_info, then the proc_info for the current
proc from the module_info.  However, at this point the proc_info has
out-of-date varset and vartypes fields, because mode analysis can
introduce temporary variables for implied mode unifications.

compiler/modes.m:
	Ensure that modes.build_call first takes the current varset and
	vartypes fields from the mode_info and used them to update the
	current proc_info before using it to construct an initialisation
	call.

tests/hard_coded/Mmakefile:
tests/hard_coded/solver_build_call.m:
tests/hard_coded/solver_build_call.exp:
	Added a test case.

Index: compiler/modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.318
diff -u -r1.318 modes.m
--- compiler/modes.m	25 Oct 2005 06:32:59 -0000	1.318
+++ compiler/modes.m	26 Oct 2005 02:26:39 -0000
@@ -3193,9 +3193,16 @@
     module_info_pred_proc_info(ModuleInfo0, PredId, ProcId, PredInfo0,
         ProcInfo0),
 
-        % Create a poly_info for the caller.
+        % 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
+        % have been introduced during mode analysis (e.g., when adding
+        % unifications to handle implied modes).
         %
-    polymorphism__create_poly_info(ModuleInfo0, PredInfo0, ProcInfo0,
+    mode_info_get_varset(!.ModeInfo, VarSet0),
+    mode_info_get_var_types(!.ModeInfo, VarTypes0),
+    proc_info_set_varset(VarSet0, ProcInfo0, ProcInfo1),
+    proc_info_set_vartypes(VarTypes0, ProcInfo1, ProcInfo2),
+    polymorphism__create_poly_info(ModuleInfo0, PredInfo0, ProcInfo2,
         PolyInfo0),
 
         % Create a goal_info for the call.
@@ -3215,7 +3222,7 @@
         % Update the information in the predicate table.
         %
     polymorphism__poly_info_extract(PolyInfo, PredInfo0, PredInfo,
-        ProcInfo0, ProcInfo, ModuleInfo1),
+        ProcInfo2, ProcInfo, ModuleInfo1),
     module_info_set_pred_proc_info(PredId, ProcId, PredInfo, ProcInfo,
         ModuleInfo1, ModuleInfo),
 
Index: tests/debugger/mdb_command_test.inp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/mdb_command_test.inp,v
retrieving revision 1.47
diff -u -r1.47 mdb_command_test.inp
--- tests/debugger/mdb_command_test.inp	25 Oct 2005 04:00:53 -0000	1.47
+++ tests/debugger/mdb_command_test.inp	26 Oct 2005 01:56:34 -0000
@@ -95,4 +95,3 @@
 class_decl           xyzzy xyzzy xyzzy xyzzy xyzzy
 all_class_decls      xyzzy xyzzy xyzzy xyzzy xyzzy
 all_procedures       xyzzy xyzzy xyzzy xyzzy xyzzy
-ambiguity            xyzzy xyzzy xyzzy xyzzy xyzzy
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.272
diff -u -r1.272 Mmakefile
--- tests/hard_coded/Mmakefile	20 Oct 2005 00:35:56 -0000	1.272
+++ tests/hard_coded/Mmakefile	26 Oct 2005 02:26:12 -0000
@@ -163,6 +163,7 @@
 	setjmp_test \
 	shift_test \
 	solve_quadratic \
+	solver_build_call \
 	solver_construction_init_test \
 	solver_disj_inits \
 	solver_ite_inits \
Index: tests/hard_coded/solver_build_call.exp
===================================================================
RCS file: tests/hard_coded/solver_build_call.exp
diff -N tests/hard_coded/solver_build_call.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/solver_build_call.exp	26 Oct 2005 02:25:50 -0000
@@ -0,0 +1 @@
+solution found: 42
Index: tests/hard_coded/solver_build_call.m
===================================================================
RCS file: tests/hard_coded/solver_build_call.m
diff -N tests/hard_coded/solver_build_call.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/solver_build_call.m	26 Oct 2005 02:25:21 -0000
@@ -0,0 +1,82 @@
+%-----------------------------------------------------------------------------%
+% solver_build_call.m
+% Ralph Becket <rafe at cs.mu.oz.au>
+% Tue Oct 18 15:30:39 EST 2005
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%
+% This detects a bug where modes.build_call was using out-of-date versions
+% of the varset and vartypes and then overwriting these fields in the
+% mode_info, leading to a compiler abort:
+%
+%   Uncaught Mercury exception:
+%   Software Error: mode analysis: rechecking extra goals adds more extra goals
+%
+%-----------------------------------------------------------------------------%
+
+:- module solver_build_call.
+
+:- interface.
+
+:- import_module io.
+
+
+
+:- pred main(io :: di, io :: uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module list.
+:- import_module std_util.
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+    ( if
+        post_constraint(  B \/ -C),
+        post_constraint( -B \/  C),
+        solve([B, C], Solution)
+      then
+        io.print("solution found: ", !IO),
+        io.print(Solution, !IO),
+        io.nl(!IO)
+      else
+        io.print("no solution found\n", !IO)
+    ).
+
+:- solver type st
+    where   representation is int,
+            initialisation is init.
+
+
+:- pred init(st::oa) is det.
+
+init(A) :-
+    promise_pure(impure A = 'representation to any st/0'(123)).
+
+
+:- func -(st::ia) = (st::oa) is det.
+
+-(A) = A.
+
+
+:- func (st::ia) \/ (st::ia) = (st::oa) is det.
+
+A \/ _ = A.
+
+
+:- pred post_constraint(st::ia) is semidet.
+
+post_constraint(_) :-
+    semidet_succeed.
+
+
+:- pred solve(list(st)::ia, int::out) is semidet.
+
+solve(_, 42) :-
+    semidet_succeed.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------