[m-rev.] for review: --warn-non-tail-recursion

[Fergus Henderson]

Estimated hours taken: 2
Branches: main

Implement a new option `--warn-non-tail-recursion'.

compiler/ml_tailcall.m:
	Add a pass to warn about directly recursive calls that are not
	tail calls.

compiler/options.m:
doc/user_guide.texi:
	Add a new option to enable the new pass.

compiler/mercury_compile.m:
	Add code to invoke the new pass.

compiler/handle_options.m:
	If --warn-non-tail-recursion is set, then report an error
	if either --high-level-code or --optimize-tailcalls is not,
	or if --error-check-only is set.

Workspace: /home/ceres/fjh/mercury
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.128
diff -u -d -r1.128 handle_options.m
--- compiler/handle_options.m	11 Feb 2002 11:29:20 -0000	1.128
+++ compiler/handle_options.m	11 Feb 2002 13:41:14 -0000
@@ -809,6 +809,15 @@
 	% we are expecting some to be missing.
 	option_implies(use_opt_files, warn_missing_opt_files, bool(no)),
 
+	% --warn-non-tail-recursion requires both --high-level-code
+	% and --optimize-tailcalls.  It also doesn't work if you use
+	% --errorcheck-only.
+	option_requires(warn_non_tail_recursion, highlevel_code, bool(yes),
+		"--warn-non-tail-recursion requires --high-level-code"),
+	option_requires(warn_non_tail_recursion, optimize_tailcalls, bool(yes),
+		"--warn-non-tail-recursion requires --optimize-tailcalls"),
+	option_requires(warn_non_tail_recursion, errorcheck_only, bool(no),
+		"--warn-non-tail-recursion is incompatible with --errorcheck-only"),
 
 	% The backend foreign languages depend on the target.
 	( 	
@@ -913,6 +922,23 @@
 	globals__io_lookup_bool_option(SourceOption, SourceOptionValue),
 	( { SourceOptionValue = no } ->
 		globals__io_set_option(ImpliedOption, ImpliedOptionValue)
+	;
+		[]
+	).
+
+% option_requires(SourceBoolOption, RequiredOption, RequiredOptionValue,
+%	ErrorMsg):
+% If the SourceBoolOption is set to yes, and RequiredOption is not set
+% to RequiredOptionValue, then report a usage error.
+:- pred option_requires(option::in, option::in, option_data::in,
+		string::in, io__state::di, io__state::uo) is det.
+
+option_requires(SourceOption, RequiredOption, RequiredOptionValue,
+		ErrorMessage) -->
+	globals__io_lookup_bool_option(SourceOption, SourceOptionValue),
+	globals__io_lookup_option(RequiredOption, OptionValue),
+	( { SourceOptionValue = yes, OptionValue \= RequiredOptionValue } ->
+		usage_error(ErrorMessage)
 	;
 		[]
 	).
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.231
diff -u -d -r1.231 mercury_compile.m
--- compiler/mercury_compile.m	11 Feb 2002 09:00:18 -0000	1.231
+++ compiler/mercury_compile.m	11 Feb 2002 13:33:38 -0000
@@ -61,7 +61,8 @@
 :- import_module mark_static_terms.		% HLDS -> HLDS
 :- import_module mlds.				% MLDS data structure
 :- import_module ml_code_gen, rtti_to_mlds.	% HLDS/RTTI -> MLDS
-:- import_module ml_elim_nested, ml_tailcall.	% MLDS -> MLDS
+:- import_module ml_elim_nested.		% MLDS -> MLDS
+:- import_module ml_tailcall.			% MLDS -> MLDS
 :- import_module ml_optimize.			% MLDS -> MLDS
 :- import_module mlds_to_c.			% MLDS -> C
 :- import_module mlds_to_java.			% MLDS -> Java
@@ -3262,6 +3263,19 @@
 	),
 	maybe_report_stats(Stats),
 	mercury_compile__maybe_dump_mlds(MLDS20, "20", "tailcalls"),
+
+	% Warning about non-tail calls needs to come after detection
+	% of tail calls
+	globals__io_lookup_bool_option(warn_non_tail_recursion, WarnTailCalls),
+	( { OptimizeTailCalls = yes, WarnTailCalls = yes } ->
+		maybe_write_string(Verbose, 
+			"% Warning about non-tail recursive calls...\n"),
+		ml_warn_tailcalls(MLDS20),
+		maybe_write_string(Verbose, "% done.\n")
+	;
+		[]
+	),
+	maybe_report_stats(Stats),
 
 	% run the ml_optimize pass before ml_elim_nested,
 	% so that we eliminate as many local variables as possible
Index: compiler/ml_tailcall.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_tailcall.m,v
retrieving revision 1.14
diff -u -d -r1.14 ml_tailcall.m
--- compiler/ml_tailcall.m	6 Feb 2002 18:44:19 -0000	1.14
+++ compiler/ml_tailcall.m	11 Feb 2002 13:30:16 -0000
@@ -11,6 +11,10 @@
 % that marks function calls as tail calls whenever
 % it is safe to do so, based on the assumptions described below.
 
+% This module also contains a pass over the MLDS that detects functions
+% which are directly recursive, but not tail-recursive,
+% and warns about them.
+
 % A function call can safely be marked as a tail call if
 %	(1) it occurs in a position which would fall through into the
 %	    end of the function body or to a `return' statement,
@@ -60,10 +64,17 @@
 :- pred ml_mark_tailcalls(mlds, mlds, io__state, io__state).
 :- mode ml_mark_tailcalls(in, out, di, uo) is det.
 
+	% Traverse the MLDS, warning about all directly recursive calls
+	% that are not marked as tail calls.
+	%
+:- pred ml_warn_tailcalls(mlds, io__state, io__state).
+:- mode ml_warn_tailcalls(in, di, uo) is det.
+
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
 :- implementation.
+:- import_module prog_data, hlds_out, error_util, ml_util.
 :- import_module list, std_util.
 
 ml_mark_tailcalls(MLDS0, MLDS) -->
@@ -543,6 +554,86 @@
 		Locals = params(Params),
 		list__member(Param, Params),
 		Param = mlds__argument(Name, _, _)
+	).
+
+%-----------------------------------------------------------------------------%
+
+ml_warn_tailcalls(MLDS) -->
+	{ solutions(nontailcall_in_mlds(MLDS), Warnings) },
+	list__foldl(report_nontailcall_warning, Warnings).
+
+:- type tailcall_warning ---> tailcall_warning(
+		mlds__pred_label,
+		% XXX perhaps we should also include the proc_id here
+		mlds__context
+	).
+
+:- pred nontailcall_in_mlds(mlds::in, tailcall_warning::out) is nondet.
+nontailcall_in_mlds(MLDS, Warning) :-
+	MLDS = mlds(ModuleName, _ForeignCode, _Imports, Defns),
+	MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
+	nontailcall_in_defns(MLDS_ModuleName, Defns, Warning).
+
+:- pred nontailcall_in_defns(mlds_module_name::in, mlds__defns::in,
+		tailcall_warning::out) is nondet.
+nontailcall_in_defns(ModuleName, Defns, Warning) :-
+	list__member(Defn, Defns),
+	nontailcall_in_defn(ModuleName, Defn, Warning).
+
+:- pred nontailcall_in_defn(mlds_module_name::in, mlds__defn::in,
+		tailcall_warning::out) is nondet.
+nontailcall_in_defn(ModuleName, Defn, Warning) :-
+	Defn = mlds__defn(Name, _Context, _Flags, DefnBody),
+	(
+		DefnBody = mlds__function(_PredProcId, _Params, FuncBody,
+			_Attributes),
+		FuncBody = defined_here(Body),
+		nontailcall_in_statement(ModuleName, Name, Body, Warning)
+	;
+		DefnBody = mlds__class(ClassDefn),
+		ClassDefn = class_defn(_Kind, _Imports, _BaseClasses,
+			_Implements, CtorDefns, MemberDefns),
+		( nontailcall_in_defns(ModuleName, CtorDefns, Warning)
+		; nontailcall_in_defns(ModuleName, MemberDefns, Warning)
+		)
+	).
+
+:- pred nontailcall_in_statement(mlds_module_name::in, mlds__entity_name::in,
+		mlds__statement::in, tailcall_warning::out) is nondet.
+
+nontailcall_in_statement(CallerModule, CallerFuncName, Statement, Warning) :-
+	% nondeterministically find a non-tail call
+	statement_contains_statement(Statement, SubStatement),
+	SubStatement = mlds__statement(SubStmt, Context),
+	SubStmt = call(_CallSig, Func, _This, _Args, _RetVals, IsTailCall),
+	IsTailCall = call,
+	% check if this call is a directly recursive call
+	Func = const(code_addr_const(CodeAddr)),
+	( CodeAddr = proc(QualProcLabel, _Sig), MaybeSeqNum = no
+	; CodeAddr = internal(QualProcLabel, SeqNum, _Sig),
+	  MaybeSeqNum = yes(SeqNum)
+	),
+	QualProcLabel = qual(CallerModule, PredLabel - ProcId),
+	CallerFuncName = function(PredLabel, ProcId, MaybeSeqNum, _PredId),
+	% if so, construct an appropriate warning
+	Warning = tailcall_warning(PredLabel, Context). % XXX include ProcId?
+
+:- pred report_nontailcall_warning(tailcall_warning::in,
+		io__state::di, io__state::uo) is det.
+
+report_nontailcall_warning(tailcall_warning(PredLabel, Context)) -->
+	(
+		{ PredLabel = pred(PredOrFunc, _MaybeModule, Name, Arity,
+			_CodeModel, _NonOutputFunc) },
+		{ hlds_out__simple_call_id_to_string(PredOrFunc -
+			unqualified(Name) / Arity, CallId) },
+		report_warning(mlds__get_prog_context(Context), 0, [
+		    words("In "), fixed(CallId), nl,
+		    words("  warning: recursive call is not tail recursive.")
+		])
+	;
+		{ PredLabel = special_pred(_, _, _, _) }
+		% don't warn about these
 	).
 
 %-----------------------------------------------------------------------------%
Index: compiler/options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.354
diff -u -d -r1.354 options.m
--- compiler/options.m	11 Feb 2002 10:14:59 -0000	1.354
+++ compiler/options.m	11 Feb 2002 13:12:44 -0000
@@ -71,6 +71,7 @@
 		;	warn_missing_module_name
 		;	warn_wrong_module_name
 		;	warn_smart_recompilation
+		;	warn_non_tail_recursion
 	% Verbosity options
 		;	verbose
 		;	very_verbose
@@ -566,7 +567,8 @@
 	warn_duplicate_calls	-	bool(no),
 	warn_missing_module_name -	bool(yes),
 	warn_wrong_module_name -	bool(yes),
-	warn_smart_recompilation -	bool(yes)
+	warn_smart_recompilation -	bool(yes),
+	warn_non_tail_recursion -	bool(no)
 ]).
 option_defaults_2(verbosity_option, [
 		% Verbosity Options
@@ -1036,6 +1038,7 @@
 long_option("warn-missing-module-name",	warn_missing_module_name).
 long_option("warn-wrong-module-name",	warn_wrong_module_name).
 long_option("warn-smart-recompilation",	warn_smart_recompilation).
+long_option("warn-non-tail-recursion",	warn_non_tail_recursion).
 
 % verbosity options
 long_option("verbose",			verbose).
@@ -1929,7 +1932,10 @@
 		"\tDisable warnings for modules whose `:- module'",
 		"\tdeclaration does not match the module's file name.",
 		"--no-warn-smart-recompilation",
-		"\tDisable warnings from the smart recompilation system."
+		"\tDisable warnings from the smart recompilation system.",
+		"--warn-non-tail-recursion",
+		"\tWarn about any directly recursive calls that are not tail calls.",
+		"\tThis requires --high-level-code."
 	]).
 
 :- pred options_help_verbosity(io__state::di, io__state::uo) is det.
Index: doc/user_guide.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/user_guide.texi,v
retrieving revision 1.291
diff -u -d -r1.291 user_guide.texi
--- doc/user_guide.texi	11 Feb 2002 10:15:00 -0000	1.291
+++ doc/user_guide.texi	11 Feb 2002 13:50:45 -0000
@@ -3549,9 +3549,15 @@
 
 @sp 1
 @item --no-warn-smart-recompilation
+ at findex --warn-smart-recompilation
 @findex --no-warn-smart-recompilation
 Disable warnings from the smart recompilation system.
 
+ at sp 1
+ at item --warn-non-tail-recursion
+ at findex --warn-non-tail-recursion
+Warn about any directly recursive calls that are not tail recursive.
+This option also requires @samp{--high-level-code}.
 @end table
 
 @node Verbosity options

-- 
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
--------------------------------------------------------------------------