[m-rev.] for review: fix MLDS tail recursion bug

[Fergus Henderson]

Estimated hours taken: 2

Fix a bug where we weren't getting proper tail recursion optimization in
the MLDS->C back-end for procedures with output arguments and determinism
`erroneous'.

compiler/ml_call_gen.m:
	Mark calls with determinism `erroneous' or `failure' as tail calls.

compiler/ml_code_gen.m:
	Pass the determinism (instead of the code_model) to ml_call_gen.m.

compiler/ml_tailcall.m:
	Add a comment.

tests/hard_coded/exceptions/Mmakefile:
tests/hard_coded/exceptions/looptest.m:
tests/hard_coded/exceptions/looptest.exp:
	Add a regression test.

Workspace: /home/earth/fjh/ws-earth4/mercury
Index: compiler/ml_call_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_call_gen.m,v
retrieving revision 1.28
diff -u -d -r1.28 ml_call_gen.m
--- compiler/ml_call_gen.m	30 Jan 2002 12:46:58 -0000	1.28
+++ compiler/ml_call_gen.m	31 Jan 2002 11:44:51 -0000
@@ -26,7 +26,7 @@
 	% Generate MLDS code for an HLDS generic_call goal.
 	% This includes boxing/unboxing the arguments if necessary.
 :- pred ml_gen_generic_call(generic_call, list(prog_var), list(mode),
-		code_model, prog_context, mlds__defns, mlds__statements,
+		determinism, prog_context, mlds__defns, mlds__statements,
 		ml_gen_info, ml_gen_info).
 :- mode ml_gen_generic_call(in, in, in, in, in, out, out, in, out) is det.
 
@@ -97,7 +97,7 @@
 
 :- implementation.
 
-:- import_module hlds_module.
+:- import_module hlds_module, hlds_data.
 :- import_module builtin_ops.
 :- import_module type_util, mode_util, error_util.
 :- import_module options, globals.
@@ -116,7 +116,7 @@
 	% XXX For typeclass method calls, we do some unnecessary
 	% boxing/unboxing of the arguments.
 	%
-ml_gen_generic_call(GenericCall, ArgVars, ArgModes, CodeModel, Context,
+ml_gen_generic_call(GenericCall, ArgVars, ArgModes, Determinism, Context,
 		MLDS_Decls, MLDS_Statements) -->
 	%
 	% allocate some fresh type variables to use as the Mercury types
@@ -136,6 +136,7 @@
 	{ ml_gen_info_get_varset(MLDSGenInfo, VarSet) },
 	{ ArgNames = ml_gen_var_names(VarSet, ArgVars) },
 	{ PredOrFunc = generic_call_pred_or_func(GenericCall) },
+	{ determinism_to_code_model(Determinism, CodeModel) },
 	{ Params0 = ml_gen_params(ModuleInfo, ArgNames,
 		BoxedArgTypes, ArgModes, PredOrFunc, CodeModel) },
 
@@ -243,7 +244,7 @@
 	{ ObjectRval = no },
 	{ DoGenCall = ml_gen_mlds_call(Signature, ObjectRval, FuncVarRval,
 		[ClosureRval | InputRvals], OutputLvals, OutputTypes,
-		CodeModel, Context) },
+		Determinism, Context) },
 
 	( { ConvArgDecls = [], ConvOutputStatements = [] } ->
 		DoGenCall(MLDS_Decls0, MLDS_Statements0)
@@ -352,8 +353,9 @@
 	% to generate it.)
 	%
 	{ ObjectRval = no },
+	{ proc_info_interface_determinism(ProcInfo, Detism) },
 	{ DoGenCall = ml_gen_mlds_call(Signature, ObjectRval, FuncRval,
-		InputRvals, OutputLvals, OutputTypes, CodeModel, Context) },
+		InputRvals, OutputLvals, OutputTypes, Detism, Context) },
 
 	( { ConvArgDecls = [], ConvOutputStatements = [] } ->
 		DoGenCall(MLDS_Decls, MLDS_Statements)
@@ -392,16 +394,17 @@
 	%
 :- pred ml_gen_mlds_call(mlds__func_signature, maybe(mlds__rval), mlds__rval,
 		list(mlds__rval), list(mlds__lval), list(mlds__type),
-		code_model, prog_context, mlds__defns, mlds__statements,
+		determinism, prog_context, mlds__defns, mlds__statements,
 		ml_gen_info, ml_gen_info).
 :- mode ml_gen_mlds_call(in, in, in, in, in, in, in, in, out, out, in, out)
 		is det.
 
 ml_gen_mlds_call(Signature, ObjectRval, FuncRval, ArgRvals0, RetLvals0,
-		RetTypes0, CodeModel, Context, MLDS_Decls, MLDS_Statements) -->
+		RetTypes0, Detism, Context, MLDS_Decls, MLDS_Statements) -->
 	%
 	% append the extra arguments or return val for this code_model
 	%
+	{ determinism_to_code_model(Detism, CodeModel) },
 	(
 		{ CodeModel = model_non },
 		% create a new success continuation, if necessary
@@ -444,7 +447,14 @@
 	%
 	% build the MLDS call statement
 	%
-	{ CallOrTailcall = call },
+	% if the called procedure has determinism `erroneous' or `failure',
+	% then it's always safe to make this call a tail call.
+	{ determinism_components(Detism, _, NumSolns) },
+	{ NumSolns = at_most_zero ->
+		CallOrTailcall = tail_call
+	;
+		CallOrTailcall = call
+	},
 	{ MLDS_Stmt = call(Signature, FuncRval, ObjectRval, ArgRvals, RetLvals,
 			CallOrTailcall) },
 	{ MLDS_Statement = mlds__statement(MLDS_Stmt,
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.107
diff -u -d -r1.107 ml_code_gen.m
--- compiler/ml_code_gen.m	16 Jan 2002 01:13:30 -0000	1.107
+++ compiler/ml_code_gen.m	31 Jan 2002 08:38:50 -0000
@@ -2012,7 +2012,7 @@
 	{ determinism_to_code_model(Detism, CallCodeModel) },
 	{ require(unify(CodeModel, CallCodeModel),
 		"ml_gen_generic_call: code model mismatch") },
-	ml_gen_generic_call(GenericCall, Vars, Modes, CodeModel, Context,
+	ml_gen_generic_call(GenericCall, Vars, Modes, Detism, Context,
 		MLDS_Decls, MLDS_Statements).
 
 ml_gen_goal_expr(call(PredId, ProcId, ArgVars, BuiltinState, _, PredName),
Index: compiler/ml_tailcall.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_tailcall.m,v
retrieving revision 1.12
diff -u -d -r1.12 ml_tailcall.m
--- compiler/ml_tailcall.m	11 Jan 2002 07:41:25 -0000	1.12
+++ compiler/ml_tailcall.m	31 Jan 2002 08:46:54 -0000
@@ -43,6 +43,9 @@
 % optimization (turn self-tailcalls into loops) is done in ml_optimize.
 % Individual backends may wish to treat tailcalls separately if there is
 % any backend support for them.
+%
+% Note that ml_call_gen.m will also mark calls to procedures with determinism
+% `erroneous' or `failure' as tail calls when it generates them.
 
 %-----------------------------------------------------------------------------%
 
Index: tests/hard_coded/exceptions/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/exceptions/Mmakefile,v
retrieving revision 1.8
diff -u -d -r1.8 Mmakefile
--- tests/hard_coded/exceptions/Mmakefile	31 May 2001 06:00:23 -0000	1.8
+++ tests/hard_coded/exceptions/Mmakefile	31 Jan 2002 12:10:27 -0000
@@ -21,8 +21,12 @@
 
 #
 # XXX the following tests are not enabled because we do not pass them yet:
+#	looptest.m
+#		(fails in debugging grades, because debugging breaks
+#		tail recursion optimization)
 #	test_memo.m test_loop_check.m
-#       (those two tests test the combination of tabling and exceptions).
+#       	(those two tests test the combination of
+#		tabling and exceptions).
 #
 # Also currently the compiler has a bug where it generates
 # static ground terms even for things with `di' modes;
@@ -44,6 +48,8 @@
 check: $(PROGS:.m=.res)
 
 #-----------------------------------------------------------------------------#
+
+MCFLAGS-looptest = --infer-all
 
 # test_uncaught_exception is *supposed* to return an error exit status.
 # We also need to pipe the output through sed to avoid hard-coding
Index: tests/hard_coded/exceptions/looptest.exp
===================================================================
RCS file: tests/hard_coded/exceptions/looptest.exp
diff -N tests/hard_coded/exceptions/looptest.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/exceptions/looptest.exp	31 Jan 2002 11:52:33 -0000
@@ -0,0 +1 @@
+exception(univ_cons("finished"))
Index: tests/hard_coded/exceptions/looptest.m
===================================================================
RCS file: tests/hard_coded/exceptions/looptest.m
diff -N tests/hard_coded/exceptions/looptest.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/exceptions/looptest.m	31 Jan 2002 12:01:50 -0000
@@ -0,0 +1,33 @@
+% This module is a regression test;
+% it tests that we do correct tail recursion optimization
+% for procedures with output arguments and determinism
+% of `erroneous' or `failure', such as loop//1 below.
+
+% This test is designed so that if the compiler doesn't
+% do tail recursion optimization, then the program will
+% overflow the limit on stack size.
+
+:- module looptest.
+:- interface.
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is cc_multi.
+
+:- implementation.
+:- import_module int, string, exception.
+
+main --> 
+	{ try(do_loop, R) },
+	io__print(R), nl.
+
+:- mode do_loop(out) is det.
+do_loop(X) :-
+	loop(100000000, 42, X).
+	
+loop(N) -->
+	( { N = 0 } ->
+		{ throw("finished") }
+	;
+		loop(N - 1)
+	).
+
-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
The University of Melbourne         |  of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh>  |     -- the last words of T. S. Garp.
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------