[m-rev.] for post-commit review: Improve tail call warnings for the low level C grade.
Paul Bone
paul at bone.id.au
Wed Dec 16 22:51:06 AEDT 2015
For post-commit review by Zoltan.
The code in mark_tail_calls.m has changed so much that it will be easier to
review it by reading the file itself, not the diff.
---
Improve tail call warnings for the low level C grade.
This patch reduces spurious tail call warnings by warning only for the last
of a sequence of recursive calls along an execution path, for example it
no-longer emits a warning for the first of the two recursive calls in
quicksort. I have already made a change to this effect for the MLDS
backends.
This patch also implements the new the require_tail_recursion pragma. This
change has already been made for the MLDS backends.
The require_tail_recursion pragma does not yet handle mutual recursion or
raise an error if the code is not recursive at all. These will be my next
tasks.
compiler/mark_tail_calls.m:
Combine marking tail calls with warning about tail calls.
Handle scopes more accurately.
compiler/mercury_compile_llds_back_end.m:
Conform to changes in mark_tail_calls.m
No longer warn for tail calls, this is now done in the same pass that
marks tail calls. The decision to run this pass is now made on a
per-procedure basis and in mark_tail_calls.m
tests/invalid/require_tailrec_1.m:
tests/invalid/require_tailrec_2.m:
tests/invalid/Mmakefile:
tests/invalid/Mercury.options:
tests/valid/require_tailrec_1.m:
tests/valid/require_tailrec_2.m:
tests/valid/Mmakefile:
tests/valid/Mercury.options:
Add new tests.
tests/invalid/Mmakefile:
tests/invalid/Mercury.options:
tests/invalid/require_tail_recursion.{m,err_exp} ->
require_tailrec_invalid.{m,exp}:
Rename existing test.
---
compiler/mark_tail_calls.m | 583 ++++++++++++++++++--------
compiler/mercury_compile_llds_back_end.m | 84 +---
tests/invalid/Mercury.options | 4 +-
tests/invalid/Mmakefile | 9 +-
tests/invalid/require_tail_recursion.err_exp | 86 ----
tests/invalid/require_tail_recursion.m | 90 ----
tests/invalid/require_tailrec_1.err_exp | 12 +
tests/invalid/require_tailrec_1.m | 85 ++++
tests/invalid/require_tailrec_2.err_exp | 12 +
tests/invalid/require_tailrec_2.m | 85 ++++
tests/invalid/require_tailrec_invalid.err_exp | 88 ++++
tests/invalid/require_tailrec_invalid.m | 90 ++++
tests/valid/Mercury.options | 2 +
tests/valid/Mmakefile | 2 +
tests/valid/require_tailrec_1.m | 38 ++
tests/valid/require_tailrec_2.m | 47 +++
16 files changed, 898 insertions(+), 419 deletions(-)
delete mode 100644 tests/invalid/require_tail_recursion.err_exp
delete mode 100644 tests/invalid/require_tail_recursion.m
create mode 100644 tests/invalid/require_tailrec_1.err_exp
create mode 100644 tests/invalid/require_tailrec_1.m
create mode 100644 tests/invalid/require_tailrec_2.err_exp
create mode 100644 tests/invalid/require_tailrec_2.m
create mode 100644 tests/invalid/require_tailrec_invalid.err_exp
create mode 100644 tests/invalid/require_tailrec_invalid.m
create mode 100644 tests/valid/require_tailrec_1.m
create mode 100644 tests/valid/require_tailrec_2.m
diff --git a/compiler/mark_tail_calls.m b/compiler/mark_tail_calls.m
index e4618e8..059af31 100644
--- a/compiler/mark_tail_calls.m
+++ b/compiler/mark_tail_calls.m
@@ -24,7 +24,6 @@
:- module hlds.mark_tail_calls.
:- interface.
-:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
:- import_module parse_tree.
@@ -32,15 +31,23 @@
:- import_module list.
-:- pred mark_tail_calls(goal_feature::in, module_info::in, pred_proc_id::in,
- pred_info::in, proc_info::in, proc_info::out) is det.
-
-:- pred warn_non_tail_calls(module_info::in,
+:- pred mark_tail_calls_in_pred(pred_id::in,
+ module_info::in, module_info::out, pred_info::in, pred_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
-:- pred warn_non_tail_calls_in_proc(pred_id::in, proc_id::in,
- pred_info::in, proc_info::in,
- list(error_spec)::in, list(error_spec)::out) is det.
+ % This pass is only required when either: tail recursion warnings are
+ % enabled (via the command line option or the require_tail_recursion
+ % pragma) or a debug grade is used. In all other situations the HLDS
+ % traversal can be skipped and mark_tail_calls_in_proc will return
+ % not_changed to allow a caller to avoid updating the proc table.
+ %
+:- type maybe_changed
+ ---> not_changed
+ ; maybe_changed.
+
+:- pred mark_tail_calls_in_proc(module_info::in, pred_proc_id::in,
+ pred_info::in, list(error_spec)::out, maybe_changed::out,
+ proc_info::in, proc_info::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -50,13 +57,19 @@
:- import_module check_hlds.
:- import_module check_hlds.mode_util.
:- import_module check_hlds.type_util.
+:- import_module hlds.hlds_goal.
:- import_module hlds.goal_util.
:- import_module hlds.vartypes.
+:- import_module libs.
+:- import_module libs.compiler_util.
+:- import_module libs.globals.
+:- import_module libs.options.
:- import_module mdbcomp.
:- import_module mdbcomp.prim_data.
:- import_module mdbcomp.sym_name.
:- import_module parse_tree.prog_data.
+:- import_module bool.
:- import_module int.
:- import_module maybe.
:- import_module require.
@@ -66,21 +79,65 @@
:- type mark_tail_calls_info
---> mark_tail_calls_info(
- mtc_feature :: goal_feature,
- mtc_module :: module_info,
- mtc_pred_id :: pred_id,
- mtc_proc_id :: proc_id,
- mtc_vartypes :: vartypes
+ mtc_add_feature :: add_goal_feature,
+ mtc_module :: module_info,
+ mtc_pred_info :: pred_info,
+ mtc_pred_id :: pred_id,
+ mtc_proc_id :: proc_id,
+ mtc_vartypes :: vartypes,
+ mtc_warn_tail_calls :: warn_tail_calls,
+ mtc_maybe_require_tailrec :: maybe(require_tail_recursion)
).
+:- type add_goal_feature
+ ---> add_goal_feature
+ ; do_not_add_goal_feature.
+
+:- type warn_tail_calls
+ ---> warn_tail_calls
+ ; do_not_warn_tail_calls.
+
+ % Is the current position within the procedure a tail position, if so
+ % what are the output arguments.
+ %
+:- type at_tail
+ ---> at_tail(list(maybe(prog_var)))
+ ; not_at_tail_seen_reccall
+ ; not_at_tail_have_not_seen_reccall.
+
+ % Has any tail call been found so far. This is used to set the tailcall
+ % procedure feature if there is at least one tailcall in the procedure.
+ %
:- type found_tail_calls
---> found_tail_calls
; not_found_tail_calls.
-mark_tail_calls(Feature, ModuleInfo, proc(PredId, ProcId), PredInfo,
- !ProcInfo) :-
- pred_info_get_arg_types(PredInfo, Types),
- proc_info_get_goal(!.ProcInfo, Goal0),
+mark_tail_calls_in_pred(PredId, !ModuleInfo, !PredInfo, !Specs) :-
+ ProcIds = pred_info_non_imported_procids(!.PredInfo),
+ mark_tail_calls_in_procs(!.ModuleInfo, PredId, ProcIds, !PredInfo,
+ !Specs).
+
+:- pred mark_tail_calls_in_procs(module_info::in, pred_id::in,
+ list(proc_id)::in, pred_info::in, pred_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+mark_tail_calls_in_procs(_ModuleInfo, _PredId, [], !PredInfo, !Specs).
+mark_tail_calls_in_procs(ModuleInfo, PredId, [ProcId | ProcIds], !PredInfo,
+ !Specs) :-
+ pred_info_proc_info(!.PredInfo, ProcId, ProcInfo0),
+ mark_tail_calls_in_proc(ModuleInfo, proc(PredId, ProcId),
+ !.PredInfo, Specs, MaybeChanged, ProcInfo0, ProcInfo),
+ (
+ MaybeChanged = maybe_changed,
+ pred_info_set_proc_info(ProcId, ProcInfo, !PredInfo)
+ ;
+ MaybeChanged = not_changed
+ ),
+ !:Specs = Specs ++ !.Specs,
+ mark_tail_calls_in_procs(ModuleInfo, PredId, ProcIds, !PredInfo, !Specs).
+
+mark_tail_calls_in_proc(ModuleInfo, proc(PredId, ProcId), PredInfo,
+ Errors, MaybeChanged, !ProcInfo) :-
proc_info_interface_determinism(!.ProcInfo, Detism),
determinism_components(Detism, _CanFail, SolnCount),
(
@@ -90,30 +147,93 @@ mark_tail_calls(Feature, ModuleInfo, proc(PredId, ProcId), PredInfo,
% specially.
( SolnCount = at_most_many
; SolnCount = at_most_zero
- )
+ ),
+ Errors = [],
+ MaybeChanged = not_changed
;
( SolnCount = at_most_one
; SolnCount = at_most_many_cc
),
- proc_info_get_argmodes(!.ProcInfo, Modes),
- proc_info_get_headvars(!.ProcInfo, HeadVars),
- proc_info_get_vartypes(!.ProcInfo, VarTypes),
- find_maybe_output_args(ModuleInfo, Types, Modes, HeadVars, Outputs),
- Info = mark_tail_calls_info(Feature, ModuleInfo, PredId, ProcId,
- VarTypes),
- mark_tail_calls_in_goal(Info, Outputs, _, Goal0, Goal,
- not_found_tail_calls, FoundTailCalls),
- proc_info_set_goal(Goal, !ProcInfo),
+ proc_info_get_maybe_require_tailrec_info(!.ProcInfo,
+ MaybeRequireTailRecursion),
+
+ module_info_get_globals(ModuleInfo, Globals),
+ globals.lookup_bool_option(Globals, exec_trace_tail_rec,
+ ExecTraceTailRec),
(
- FoundTailCalls = found_tail_calls,
- TailCallEvents = has_tail_call_event
+ ExecTraceTailRec = yes,
+ AddGoalFeature = add_goal_feature
;
- FoundTailCalls = not_found_tail_calls,
- TailCallEvents = has_no_tail_call_event
+ ExecTraceTailRec = no,
+ AddGoalFeature = do_not_add_goal_feature
+ ),
+ globals.lookup_bool_option(Globals, warn_non_tail_recursion,
+ WarnNonTailRecursionBool),
+ (
+ WarnNonTailRecursionBool = yes,
+ WarnNonTailRecursion = warn_tail_calls
+ ;
+ WarnNonTailRecursionBool = no,
+ WarnNonTailRecursion = do_not_warn_tail_calls
),
- proc_info_set_has_tail_call_event(TailCallEvents, !ProcInfo)
+
+ % It is reasonably common that we don't need to check for tail calls
+ % at all.
+ ( if
+ AddGoalFeature = do_not_add_goal_feature,
+ (
+ WarnNonTailRecursion = do_not_warn_tail_calls,
+ (
+ MaybeRequireTailRecursion = no
+ ;
+ MaybeRequireTailRecursion =
+ yes(suppress_tailrec_warnings(_))
+ )
+ ;
+ WarnNonTailRecursion = warn_tail_calls,
+ MaybeRequireTailRecursion = yes(suppress_tailrec_warnings(_))
+ )
+ then
+ Errors = [],
+ MaybeChanged = not_changed
+ else
+ do_mark_tail_calls_in_proc(AddGoalFeature, WarnNonTailRecursion,
+ MaybeRequireTailRecursion, ModuleInfo, PredId, PredInfo,
+ ProcId, Errors, !ProcInfo),
+ MaybeChanged = maybe_changed
+ )
).
+:- pred do_mark_tail_calls_in_proc(add_goal_feature::in,
+ warn_tail_calls::in, maybe(require_tail_recursion)::in,
+ module_info::in, pred_id::in, pred_info::in, proc_id::in,
+ list(error_spec)::out, proc_info::in, proc_info::out) is det.
+
+do_mark_tail_calls_in_proc(AddGoalFeature, WarnNonTailRecursion,
+ MaybeRequireTailRecursion, ModuleInfo, PredId,
+ PredInfo, ProcId, Errors, !ProcInfo) :-
+ pred_info_get_arg_types(PredInfo, Types),
+ proc_info_get_goal(!.ProcInfo, Goal0),
+ proc_info_get_argmodes(!.ProcInfo, Modes),
+ proc_info_get_headvars(!.ProcInfo, HeadVars),
+ proc_info_get_vartypes(!.ProcInfo, VarTypes),
+ find_maybe_output_args(ModuleInfo, Types, Modes, HeadVars, Outputs),
+
+ Info = mark_tail_calls_info(AddGoalFeature, ModuleInfo, PredInfo,
+ PredId, ProcId, VarTypes, WarnNonTailRecursion,
+ MaybeRequireTailRecursion),
+ mark_tail_calls_in_goal(Info, FoundTailCalls, Errors, Goal0, Goal,
+ at_tail(Outputs), _),
+ proc_info_set_goal(Goal, !ProcInfo),
+ (
+ FoundTailCalls = found_tail_calls,
+ TailCallEvents = has_tail_call_event
+ ;
+ FoundTailCalls = not_found_tail_calls,
+ TailCallEvents = has_no_tail_call_event
+ ),
+ proc_info_set_has_tail_call_event(TailCallEvents, !ProcInfo).
+
:- pred find_maybe_output_args(module_info::in,
list(mer_type)::in, list(mer_mode)::in, list(prog_var)::in,
list(maybe(prog_var))::out) is det.
@@ -172,21 +292,48 @@ find_maybe_output_args_2(ModuleInfo, [Type | Types], [Mode | Modes],
% return 'no' for MaybeOutputs.
%
:- pred mark_tail_calls_in_goal(mark_tail_calls_info::in,
- list(maybe(prog_var))::in, maybe(list(maybe(prog_var)))::out,
- hlds_goal::in, hlds_goal::out, found_tail_calls::in, found_tail_calls::out)
- is det.
+ found_tail_calls::out, list(error_spec)::out,
+ hlds_goal::in, hlds_goal::out, at_tail::in, at_tail::out) is det.
-mark_tail_calls_in_goal(Info, Outputs0, MaybeOutputs, Goal0, Goal,
- !FoundTailCalls) :-
+mark_tail_calls_in_goal(Info, FoundTailCalls, Errors, Goal0, Goal,
+ AtTail0, AtTail) :-
Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
(
( GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
; GoalExpr0 = generic_call(_, _, _, _, _)
- ; GoalExpr0 = scope(_, _)
; GoalExpr0 = negation(_)
),
- MaybeOutputs = no,
- Goal = Goal0
+ Goal = Goal0,
+ not_at_tail(AtTail0, AtTail),
+ FoundTailCalls = not_found_tail_calls,
+ Errors = []
+ ;
+ GoalExpr0 = scope(Reason, SubGoal0),
+ (
+ ( Reason = exist_quant(_)
+ ; Reason = promise_solutions(_, _)
+ ; Reason = commit(_)
+ ),
+ not_at_tail(AtTail0, AtTail1),
+ mark_tail_calls_in_goal(Info, FoundTailCalls, Errors,
+ SubGoal0, SubGoal, AtTail1, AtTail)
+ ;
+ ( Reason = promise_purity(_)
+ ; Reason = barrier(_)
+ ; Reason = from_ground_term(_, _)
+ ; Reason = trace_goal(_, _, _, _, _)
+ ; Reason = loop_control(_, _, _)
+ ),
+ mark_tail_calls_in_goal(Info, FoundTailCalls, Errors,
+ SubGoal0, SubGoal, AtTail0, AtTail)
+ ;
+ ( Reason = require_detism(_)
+ ; Reason = require_complete_switch(_)
+ ; Reason = require_switch_arms_detism(_, _)
+ ),
+ unexpected($file, $pred, "unexpected scope kind")
+ ),
+ Goal = hlds_goal(scope(Reason, SubGoal), GoalInfo0)
;
GoalExpr0 = unify(LHS, _, _, Unify0, _),
Goal = Goal0,
@@ -195,7 +342,7 @@ mark_tail_calls_in_goal(Info, Outputs0, MaybeOutputs, Goal0, Goal,
( if var_is_of_dummy_type(ModuleInfo, VarTypes, LHS) then
% Unifications involving dummy type variables are no-ops,
% and do not inhibit a preceding tail call.
- MaybeOutputs = yes(Outputs0)
+ AtTail = AtTail0
else
(
( Unify0 = construct(_, _, _, _, _, _, _)
@@ -203,75 +350,121 @@ mark_tail_calls_in_goal(Info, Outputs0, MaybeOutputs, Goal0, Goal,
; Unify0 = simple_test(_, _)
; Unify0 = complicated_unify(_, _, _)
),
- MaybeOutputs = no
+ not_at_tail(AtTail0, AtTail)
;
Unify0 = assign(ToVar, FromVar),
( if
+ AtTail0 = at_tail(Outputs0),
is_output_arg_rename(ToVar, FromVar, Outputs0, Outputs)
then
- MaybeOutputs = yes(Outputs)
+ AtTail = at_tail(Outputs)
else
- MaybeOutputs = no
+ AtTail = not_at_tail_have_not_seen_reccall
)
)
- )
+ ),
+ FoundTailCalls = not_found_tail_calls,
+ Errors = []
;
GoalExpr0 = plain_call(CallPredId, CallProcId, Args, Builtin,
- _UnifyContext, _SymName),
- MaybeOutputs = no,
+ _UnifyContext, SymName),
PredId = Info ^ mtc_pred_id,
ProcId = Info ^ mtc_proc_id,
( if
CallPredId = PredId,
CallProcId = ProcId,
- match_output_args(Outputs0, Args),
Builtin = not_builtin
then
- Feature = Info ^ mtc_feature,
- goal_info_add_feature(Feature, GoalInfo0, GoalInfo),
- Goal = hlds_goal(GoalExpr0, GoalInfo),
- !:FoundTailCalls = found_tail_calls
+ ( if
+ AtTail0 = at_tail(Outputs0),
+ match_output_args(Outputs0, Args)
+ then
+ AddFeature = Info ^ mtc_add_feature,
+ (
+ AddFeature = add_goal_feature,
+ goal_info_add_feature(feature_debug_tail_rec_call,
+ GoalInfo0, GoalInfo),
+ Goal = hlds_goal(GoalExpr0, GoalInfo)
+ ;
+ AddFeature = do_not_add_goal_feature,
+ Goal = Goal0
+ ),
+ Errors = []
+ else
+ Goal = Goal0,
+ Arity = length(Args),
+ maybe_report_nontailcall(AtTail0, Info, SymName, Arity,
+ CallProcId, goal_info_get_context(GoalInfo0), Errors)
+ ),
+ AtTail = not_at_tail_seen_reccall,
+ FoundTailCalls = found_tail_calls
else
- Goal = Goal0
+ Goal = Goal0,
+ not_at_tail(AtTail0, AtTail),
+ FoundTailCalls = not_found_tail_calls,
+ Errors = []
)
;
GoalExpr0 = conj(ConjType, Goals0),
(
ConjType = plain_conj,
- list.reverse(Goals0, RevGoals0),
- mark_tail_calls_in_conj(Info, Outputs0, MaybeOutputs,
- RevGoals0, RevGoals, !FoundTailCalls),
- list.reverse(RevGoals, Goals),
- GoalExpr = conj(ConjType, Goals),
- Goal = hlds_goal(GoalExpr, GoalInfo0)
+ AtTail1 = AtTail0
;
ConjType = parallel_conj,
- MaybeOutputs = no,
- Goal = Goal0
- )
+ % Tail calls in parallel conjunctions are only supported when
+ % loop control is enabled. But loop control would have
+ % re-written the conjunction into a loop control scope and
+ % therefore all parallel conjunctions at this point do not
+ % support tail calls.
+ not_at_tail(AtTail0, AtTail1)
+ ),
+ list.reverse(Goals0, RevGoals0),
+ mark_tail_calls_in_conj(Info, RevGoals0, RevGoals,
+ AtTail1, AtTail, not_found_tail_calls, FoundTailCalls,
+ [], Errors),
+ list.reverse(RevGoals, Goals),
+ GoalExpr = conj(ConjType, Goals),
+ Goal = hlds_goal(GoalExpr, GoalInfo0)
;
- GoalExpr0 = disj(Goals0),
- mark_tail_calls_in_goals(Info, Outputs0, Goals0, Goals,
- !FoundTailCalls),
- MaybeOutputs = no,
- GoalExpr = disj(Goals),
+ GoalExpr0 = disj(Disjs0),
+ map4(mark_tail_calls_in_disj(Info, AtTail0), Disjs0, Disjs,
+ AtTails, FoundTailCallDisjs, DisjErrors),
+ AtTail = at_tail_branches(AtTails),
+ FoundTailCalls = found_tail_calls_condense(FoundTailCallDisjs),
+ Errors = condense(DisjErrors),
+ GoalExpr = disj(Disjs),
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
GoalExpr0 = switch(Var, CanFail, Cases0),
- mark_tail_calls_in_cases(Info, Outputs0, Cases0, Cases,
- !FoundTailCalls),
- MaybeOutputs = no,
+ map4(mark_tail_calls_in_case(Info, AtTail0), Cases0, Cases,
+ AtTails, FoundTailCallsCases, SwitchErrors),
+ AtTail = at_tail_branches(AtTails),
+ FoundTailCalls = found_tail_calls_condense(FoundTailCallsCases),
+ Errors = condense(SwitchErrors),
GoalExpr = switch(Var, CanFail, Cases),
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
- GoalExpr0 = if_then_else(Vars, Cond, Then0, Else0),
- mark_tail_calls_in_goal(Info, Outputs0, _, Then0, Then,
- !FoundTailCalls),
- mark_tail_calls_in_goal(Info, Outputs0, _, Else0, Else,
- !FoundTailCalls),
- MaybeOutputs = no,
+ GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
+ mark_tail_calls_in_goal(Info, FoundTailCallsThen, ErrorsThen,
+ Then0, Then, AtTail0, AtTailThen),
+ mark_tail_calls_in_goal(Info, FoundTailCallsElse, ErrorsElse,
+ Else0, Else, AtTail0, AtTailElse),
+ AtTailBranch0 = at_tail_branch(AtTailThen, AtTailElse),
+ not_at_tail(AtTailBranch0, AtTailBranch),
+ mark_tail_calls_in_goal(Info, _, ErrorsCond, Cond0, Cond,
+ AtTailBranch, AtTail),
+ ( if
+ ( FoundTailCallsThen = found_tail_calls
+ ; FoundTailCallsElse = found_tail_calls
+ )
+ then
+ FoundTailCalls = found_tail_calls
+ else
+ FoundTailCalls = not_found_tail_calls
+ ),
GoalExpr = if_then_else(Vars, Cond, Then, Else),
- Goal = hlds_goal(GoalExpr, GoalInfo0)
+ Goal = hlds_goal(GoalExpr, GoalInfo0),
+ Errors = ErrorsCond ++ ErrorsThen ++ ErrorsElse
;
GoalExpr0 = shorthand(_),
unexpected($module, $pred, "shorthand")
@@ -292,48 +485,44 @@ is_output_arg_rename(ToVar, FromVar,
is_output_arg_rename(ToVar, FromVar, MaybeVars0, MaybeVars)
).
-:- pred mark_tail_calls_in_goals(mark_tail_calls_info::in,
- list(maybe(prog_var))::in, list(hlds_goal)::in, list(hlds_goal)::out,
- found_tail_calls::in, found_tail_calls::out) is det.
+:- pred mark_tail_calls_in_disj(mark_tail_calls_info::in, at_tail::in,
+ hlds_goal::in, hlds_goal::out, at_tail::out, found_tail_calls::out,
+ list(error_spec)::out) is det.
-mark_tail_calls_in_goals(_Info, _Outputs0, [], [], !FoundTailCalls).
-mark_tail_calls_in_goals(Info, Outputs0, [Goal0 | Goals0], [Goal | Goals],
- !FoundTailCalls) :-
- mark_tail_calls_in_goal(Info, Outputs0, _, Goal0, Goal, !FoundTailCalls),
- mark_tail_calls_in_goals(Info, Outputs0, Goals0, Goals, !FoundTailCalls).
+mark_tail_calls_in_disj(Info, AtTail0, !Disj, AtTail, FoundAtTail, Errors) :-
+ mark_tail_calls_in_goal(Info, FoundAtTail, Errors, !Disj, AtTail0,
+ AtTail).
-:- pred mark_tail_calls_in_cases(mark_tail_calls_info::in,
- list(maybe(prog_var))::in, list(case)::in, list(case)::out,
- found_tail_calls::in, found_tail_calls::out) is det.
+:- pred mark_tail_calls_in_case(mark_tail_calls_info::in, at_tail::in,
+ case::in, case::out, at_tail::out, found_tail_calls::out,
+ list(error_spec)::out) is det.
-mark_tail_calls_in_cases(_Info, _Outputs0, [], [], !FoundTailCalls).
-mark_tail_calls_in_cases(Info, Outputs0, [Case0 | Cases0], [Case | Cases],
- !FoundTailCalls) :-
+mark_tail_calls_in_case(Info, AtTail0, Case0, Case, AtTail, FoundTailCalls,
+ Errors) :-
Case0 = case(MainConsId, OtherConsIds, Goal0),
- mark_tail_calls_in_goal(Info, Outputs0, _, Goal0, Goal, !FoundTailCalls),
- Case = case(MainConsId, OtherConsIds, Goal),
- mark_tail_calls_in_cases(Info, Outputs0, Cases0, Cases, !FoundTailCalls).
+ mark_tail_calls_in_goal(Info, FoundTailCalls, Errors, Goal0, Goal,
+ AtTail0, AtTail),
+ Case = case(MainConsId, OtherConsIds, Goal).
:- pred mark_tail_calls_in_conj(mark_tail_calls_info::in,
- list(maybe(prog_var))::in, maybe(list(maybe(prog_var)))::out,
- list(hlds_goal)::in, list(hlds_goal)::out,
- found_tail_calls::in, found_tail_calls::out) is det.
-
-mark_tail_calls_in_conj(_Info, Outputs0, yes(Outputs0),
- [], [], !FoundTailCalls).
-mark_tail_calls_in_conj(Info, Outputs0, MaybeOutputs,
- [RevGoal0 | RevGoals0], [RevGoal | RevGoals], !FoundTailCalls) :-
- mark_tail_calls_in_goal(Info, Outputs0, MaybeOutputs1, RevGoal0, RevGoal,
- !FoundTailCalls),
+ list(hlds_goal)::in, list(hlds_goal)::out, at_tail::in, at_tail::out,
+ found_tail_calls::in, found_tail_calls::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+mark_tail_calls_in_conj(_Info, [], [], !AtTail, !FoundTailCalls, !Errors).
+mark_tail_calls_in_conj(Info, [RevGoal0 | RevGoals0], [RevGoal | RevGoals],
+ !AtTail, !FoundTailCalls, !Errors) :-
+ mark_tail_calls_in_goal(Info, FoundTailCallsConj, Errors,
+ RevGoal0, RevGoal, !AtTail),
(
- MaybeOutputs1 = yes(Outputs1),
- mark_tail_calls_in_conj(Info, Outputs1, MaybeOutputs,
- RevGoals0, RevGoals, !FoundTailCalls)
+ FoundTailCallsConj = found_tail_calls,
+ !:FoundTailCalls = found_tail_calls
;
- MaybeOutputs1 = no,
- MaybeOutputs = no,
- RevGoals = RevGoals0
- ).
+ FoundTailCallsConj = not_found_tail_calls
+ ),
+ !:Errors = Errors ++ !.Errors,
+ mark_tail_calls_in_conj(Info, RevGoals0, RevGoals, !AtTail,
+ !FoundTailCalls, !Errors).
:- pred match_output_args(list(maybe(prog_var))::in, list(prog_var)::in)
is semidet.
@@ -351,72 +540,117 @@ match_output_args([MaybeOutputVar | MaybeOutputVars], [ArgVar | ArgVars]) :-
),
match_output_args(MaybeOutputVars, ArgVars).
-%-----------------------------------------------------------------------------%
+:- func found_tail_calls_condense(list(found_tail_calls)) =
+ found_tail_calls.
+
+found_tail_calls_condense(List) =
+ ( if member(found_tail_calls, List) then
+ found_tail_calls
+ else
+ not_found_tail_calls
+ ).
+
+:- pred not_at_tail(at_tail::in, at_tail::out) is det.
+
+not_at_tail(at_tail(_), not_at_tail_have_not_seen_reccall).
+not_at_tail(not_at_tail_seen_reccall, not_at_tail_seen_reccall).
+not_at_tail(not_at_tail_have_not_seen_reccall,
+ not_at_tail_have_not_seen_reccall).
+
+:- func at_tail_branches(list(at_tail)) = at_tail.
+
+at_tail_branches(List) =
+ foldl(at_tail_branch, List, not_at_tail_have_not_seen_reccall).
+
+:- func at_tail_branch(at_tail, at_tail) = at_tail.
+
+at_tail_branch(A, B) = R :-
+ (
+ A = at_tail(_),
+ (
+ B = at_tail(_),
+ % This shouldn't happen.
+ R = not_at_tail_have_not_seen_reccall
+ ;
+ ( B = not_at_tail_have_not_seen_reccall
+ ; B = not_at_tail_seen_reccall
+ ),
+ R = B
+ )
+ ;
+ A = not_at_tail_have_not_seen_reccall,
+ R = B
+ ;
+ A = not_at_tail_seen_reccall,
+ R = not_at_tail_seen_reccall
+ ).
+
%-----------------------------------------------------------------------------%
-warn_non_tail_calls(ModuleInfo, !Specs) :-
- solutions.solutions(nontailcall_in_hlds(ModuleInfo), Warnings),
- list.foldl(report_nontailcall_warning, Warnings, !Specs).
-
-warn_non_tail_calls_in_proc(PredId, ProcId, PredInfo, ProcInfo, !Specs) :-
- solutions.solutions(
- nontailcall_in_proc(PredId, ProcId, PredInfo, ProcInfo), Warnings),
- list.foldl(report_nontailcall_warning, Warnings, !Specs).
-
-:- type tailcall_warning
- ---> tailcall_warning(
- pred_or_func,
- sym_name,
- arity,
- proc_id,
- prog_context
- ).
+:- pred maybe_report_nontailcall(at_tail::in, mark_tail_calls_info::in,
+ sym_name::in, arity::in, proc_id::in, prog_context::in,
+ list(error_spec)::out) is det.
-:- pred nontailcall_in_hlds(module_info::in, tailcall_warning::out) is nondet.
-
-nontailcall_in_hlds(ModuleInfo, Warning) :-
- module_info_get_valid_pred_ids(ModuleInfo, PredIds),
- list.member(PredId, PredIds),
- nontailcall_in_pred(ModuleInfo, PredId, Warning).
-
-:- pred nontailcall_in_pred(module_info::in, pred_id::in,
- tailcall_warning::out) is nondet.
-
-nontailcall_in_pred(ModuleInfo, PredId, Warning) :-
- module_info_pred_info(ModuleInfo, PredId, PredInfo),
- ProcIds = pred_info_non_imported_procids(PredInfo),
- list.member(ProcId, ProcIds),
- pred_info_proc_info(PredInfo, ProcId, ProcInfo),
- nontailcall_in_proc(PredId, ProcId, PredInfo, ProcInfo, Warning).
-
-:- pred nontailcall_in_proc(pred_id::in, proc_id::in, pred_info::in,
- proc_info::in, tailcall_warning::out) is nondet.
-
-nontailcall_in_proc(PredId, ProcId, PredInfo, ProcInfo, Warning) :-
- proc_info_get_goal(ProcInfo, Goal),
- goal_contains_goal(Goal, SubGoal),
- SubGoal = hlds_goal(SubGoalExpr, SubGoalInfo),
- SubGoalExpr = plain_call(CallPredId, CallProcId, CallArgs, Builtin,
- _UnifyContext, SymName),
- % Check if this call is a directly recursive call.
- CallPredId = PredId,
- CallProcId = ProcId,
- Builtin = not_builtin,
- not goal_has_feature(SubGoal, feature_debug_tail_rec_call),
- % Don't warn about special predicates.
- not is_unify_or_compare_pred(PredInfo),
+maybe_report_nontailcall(AtTail, Info, SymName, Arity, ProcId,
+ Context, Specs) :-
+ (
+ ( AtTail = at_tail(_)
+ ; AtTail = not_at_tail_have_not_seen_reccall
+ ),
+ PredInfo = Info ^ mtc_pred_info,
+ WarnTailCalls = Info ^ mtc_warn_tail_calls,
+ MaybeRequireTailRecursion = Info ^ mtc_maybe_require_tailrec,
+ (
+ MaybeRequireTailRecursion = no,
+ (
+ WarnTailCalls = warn_tail_calls,
+ report_nontailcall(PredInfo, SymName, Arity, ProcId,
+ Context, we_warning, Specs)
+ ;
+ WarnTailCalls = do_not_warn_tail_calls,
+ Specs = []
+ )
+ ;
+ MaybeRequireTailRecursion = yes(RequireTailrecInfo),
+ (
+ RequireTailrecInfo = enable_tailrec_warnings(WarnOrError,
+ _Type, _),
+ % TODO: Check recursion type to implement support for
+ % mutual vs self recursion checking.
+ report_nontailcall(PredInfo, SymName, Arity, ProcId,
+ Context, WarnOrError, Specs)
+ ;
+ RequireTailrecInfo = suppress_tailrec_warnings(_),
+ Specs = []
+ )
+ )
+ ;
+ % Never report calls that are followed by recursive calls.
+ % NOTE: We could report these issues, doing so would help
+ % programmers ensure that they use constant stack space. This was
+ % not part of the initial design for the pragma but I'd like to add
+ % support for it with another option in the near future.
+ AtTail = not_at_tail_seen_reccall,
+ Specs = []
+ ).
- PredOrFunc = pred_info_is_pred_or_func(PredInfo),
- list.length(CallArgs, Arity),
- Context = goal_info_get_context(SubGoalInfo),
- Warning = tailcall_warning(PredOrFunc, SymName, Arity, CallProcId,
- Context).
+:- pred report_nontailcall(pred_info::in, sym_name::in, arity::in,
+ proc_id::in, prog_context::in, warning_or_error::in,
+ list(error_spec)::out) is det.
-:- pred report_nontailcall_warning(tailcall_warning::in,
- list(error_spec)::in, list(error_spec)::out) is det.
+report_nontailcall(PredInfo, SymName, Arity, ProcId, Context, WarnOrError,
+ Specs) :-
+ (
+ WarnOrError = we_warning,
+ Severity = severity_warning,
+ WarnOrErrorWord = words("warning:")
+ ;
+ WarnOrError = we_error,
+ Severity = severity_error,
+ WarnOrErrorWord = words("error:")
+ ),
-report_nontailcall_warning(Warning, !Specs) :-
- Warning = tailcall_warning(PredOrFunc, SymName, Arity, ProcId, Context),
+ PredOrFunc = pred_info_is_pred_or_func(PredInfo),
Name = unqualify_name(SymName),
SimpleCallId = simple_call_id(PredOrFunc, unqualified(Name), Arity),
proc_id_to_int(ProcId, ProcNumber0),
@@ -424,10 +658,11 @@ report_nontailcall_warning(Warning, !Specs) :-
Pieces =
[words("In mode number"), int_fixed(ProcNumber),
words("of"), simple_call(SimpleCallId), suffix(":"), nl,
- words("warning: recursive call is not tail recursive."), nl],
+ WarnOrErrorWord, words("recursive call is not tail recursive."),
+ nl],
Msg = simple_msg(Context, [always(Pieces)]),
- Spec = error_spec(severity_warning, phase_code_gen, [Msg]),
- !:Specs = [Spec | !.Specs].
+ Spec = error_spec(Severity, phase_code_gen, [Msg]),
+ Specs = [Spec].
%-----------------------------------------------------------------------------%
:- end_module hlds.mark_tail_calls.
diff --git a/compiler/mercury_compile_llds_back_end.m b/compiler/mercury_compile_llds_back_end.m
index 4998d96..037fc02 100644
--- a/compiler/mercury_compile_llds_back_end.m
+++ b/compiler/mercury_compile_llds_back_end.m
@@ -177,11 +177,9 @@ llds_backend_pass_by_phases(!HLDS, !:LLDS, !GlobalData, !Specs,
compute_liveness(Verbose, Stats, !HLDS, !IO),
maybe_dump_hlds(!.HLDS, 330, "liveness", !DumpInfo, !IO),
- maybe_mark_tail_rec_calls(Verbose, Stats, !HLDS, !IO),
+ maybe_mark_tail_rec_calls(Verbose, Stats, !HLDS, !Specs, !IO),
maybe_dump_hlds(!.HLDS, 332, "mark_debug_tailrec_calls", !DumpInfo, !IO),
- maybe_warn_non_tail_recursion(Verbose, Stats, !.HLDS, !Specs, !IO),
-
compute_stack_vars(Verbose, Stats, !HLDS, !IO),
maybe_dump_hlds(!.HLDS, 335, "stackvars", !DumpInfo, !IO),
@@ -399,29 +397,15 @@ llds_backend_pass_for_proc(!HLDS, ConstStructMap, PredId, PredInfo,
!.HLDS, !IO)
),
detect_liveness_proc(!.HLDS, PredProcId, !ProcInfo),
- globals.lookup_bool_option(Globals, exec_trace_tail_rec, ExecTraceTailRec),
- globals.lookup_bool_option(Globals, warn_non_tail_recursion,
- WarnTailCalls),
- MarkTailCalls = bool.or(ExecTraceTailRec, WarnTailCalls),
- (
- MarkTailCalls = yes,
- trace [io(!IO)] (
- write_proc_progress_message(
- "% Marking directly tail recursive calls in ", PredId, ProcId,
- !.HLDS, !IO)
- ),
- mark_tail_calls(feature_debug_tail_rec_call, !.HLDS, PredProcId,
- PredInfo, !ProcInfo)
- ;
- MarkTailCalls = no
- ),
- (
- WarnTailCalls = yes,
- warn_non_tail_calls_in_proc(PredId, ProcId, PredInfo, !.ProcInfo,
- !Specs)
- ;
- WarnTailCalls = no
+ trace [io(!IO)] (
+ write_proc_progress_message(
+ "% Marking directly tail recursive calls in ", PredId, ProcId,
+ !.HLDS, !IO)
),
+ mark_tail_calls_in_proc(!.HLDS, PredProcId, PredInfo, TCallSpecs,
+ _, !ProcInfo),
+ !:Specs = TCallSpecs ++ !.Specs,
+
trace [io(!IO)] (
write_proc_progress_message("% Allocating stack slots in ", PredId,
ProcId, !.HLDS, !IO)
@@ -543,46 +527,18 @@ compute_liveness(Verbose, Stats, !HLDS, !IO) :-
maybe_report_stats(Stats, !IO).
:- pred maybe_mark_tail_rec_calls(bool::in, bool::in,
- module_info::in, module_info::out, io::di, io::uo) is det.
-
-maybe_mark_tail_rec_calls(Verbose, Stats, !HLDS, !IO) :-
- module_info_get_globals(!.HLDS, Globals),
- globals.lookup_bool_option(Globals, exec_trace_tail_rec, ExecTraceTailRec),
- globals.lookup_bool_option(Globals, warn_non_tail_recursion,
- WarnTailCalls),
- MarkTailCalls = bool.or(ExecTraceTailRec, WarnTailCalls),
- (
- MarkTailCalls = yes,
- maybe_write_string(Verbose,
- "% Marking directly tail recursive calls...", !IO),
- maybe_flush_output(Verbose, !IO),
- process_all_nonimported_procs(
- update_proc_ids_pred(mark_tail_calls(feature_debug_tail_rec_call)),
- !HLDS),
- maybe_write_string(Verbose, " done.\n", !IO),
- maybe_report_stats(Stats, !IO)
- ;
- MarkTailCalls = no
- ).
+ module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out, io::di, io::uo) is det.
-:- pred maybe_warn_non_tail_recursion(bool::in, bool::in,
- module_info::in, list(error_spec)::in, list(error_spec)::out,
- io::di, io::uo) is det.
-
-maybe_warn_non_tail_recursion(Verbose, Stats, HLDS, !Specs, !IO) :-
- module_info_get_globals(HLDS, Globals),
- globals.lookup_bool_option(Globals, warn_non_tail_recursion,
- WarnTailCalls),
- (
- WarnTailCalls = yes,
- maybe_write_string(Verbose,
- "% Warning about non-tail recursive calls...\n", !IO),
- warn_non_tail_calls(HLDS, !Specs),
- maybe_write_string(Verbose, "% done.\n", !IO),
- maybe_report_stats(Stats, !IO)
- ;
- WarnTailCalls = no
- ).
+maybe_mark_tail_rec_calls(Verbose, Stats, !HLDS, !Specs, !IO) :-
+ maybe_write_string(Verbose,
+ "% Marking directly tail recursive calls...", !IO),
+ maybe_flush_output(Verbose, !IO),
+ process_all_nonimported_preds_errors(
+ update_pred_error(mark_tail_calls_in_pred),
+ !HLDS, !Specs, !IO),
+ maybe_write_string(Verbose, " done.\n", !IO),
+ maybe_report_stats(Stats, !IO).
:- pred compute_stack_vars(bool::in, bool::in,
module_info::in, module_info::out, io::di, io::uo) is det.
diff --git a/tests/invalid/Mercury.options b/tests/invalid/Mercury.options
index c6d0ded..ca153d4 100644
--- a/tests/invalid/Mercury.options
+++ b/tests/invalid/Mercury.options
@@ -117,7 +117,9 @@ MCFLAGS-polymorphic_unification = --verbose-error-messages
MCFLAGS-predmode = --verbose-error-messages
MCFLAGS-prog_io_erroneous = --verbose-error-messages
-MCFLAGS-require_tail_recursion = --allow-stubs --no-warn-stubs
+MCFLAGS-require_tailrec_1 = --no-warn-non-tail-recursion
+MCFLAGS-require_tailrec_2 = --warn-non-tail-recursion
+MCFLAGS-require_tailrec_invalid = --allow-stubs --no-warn-stubs
# We compile test_feature_set in hl.gc because that grade is incompatible
# with the features in the test require_feature_set pragma.
diff --git a/tests/invalid/Mmakefile b/tests/invalid/Mmakefile
index 03663fd..ee2573b 100644
--- a/tests/invalid/Mmakefile
+++ b/tests/invalid/Mmakefile
@@ -218,7 +218,9 @@ SINGLEMODULE= \
repeated_instance_vars_unsat \
require_det_in_lambda \
require_scopes \
- require_tail_recursion \
+ require_tailrec_1 \
+ require_tailrec_2 \
+ require_tailrec_invalid \
reserved \
some \
specified \
@@ -482,10 +484,9 @@ illtyped_compare.err: illtyped_compare.m
else true; \
fi
-# For foreign_include_file_missing, the error is only caught when generating
-# target code.
+# For these tests the error is only caught when generating target code.
.PHONY: missing_file
-foreign_include_file_missing.err: foreign_include_file_missing.m
+require_tailrec_1.err require_tailrec_2.err foreign_include_file_missing.err: %.err : %.m
if $(MC) --target-code-only $(ALL_GRADEFLAGS) $(ALL_MCFLAGS) \
$* > $*.err 2>&1; \
then false; \
diff --git a/tests/invalid/require_tail_recursion.err_exp b/tests/invalid/require_tail_recursion.err_exp
deleted file mode 100644
index 29607b8..0000000
--- a/tests/invalid/require_tail_recursion.err_exp
+++ /dev/null
@@ -1,86 +0,0 @@
-require_tail_recursion.m:014: Error: `:- pragma require_tail_recursion'
-require_tail_recursion.m:014: declaration in module interface.
-require_tail_recursion.m:021: Error: `:- pragma require_tail_recursion' pragma
-require_tail_recursion.m:021: for
-require_tail_recursion.m:021: `require_tail_recursion.non_existant_pred'/3
-require_tail_recursion.m:021: without corresponding `:- pred' or `:- func'
-require_tail_recursion.m:021: declaration.
-require_tail_recursion.m:022: Error: `:- pragma require_tail_recursion' pragma
-require_tail_recursion.m:022: for
-require_tail_recursion.m:022: `require_tail_recursion.non_existant_proc'/2
-require_tail_recursion.m:022: without corresponding `:- pred' or `:- func'
-require_tail_recursion.m:022: declaration.
-require_tail_recursion.m:023: Error: `:- pragma require_tail_recursion' pragma
-require_tail_recursion.m:023: for
-require_tail_recursion.m:023: `require_tail_recursion.non_existant_func_proc'/1
-require_tail_recursion.m:023: without corresponding `:- pred' or `:- func'
-require_tail_recursion.m:023: declaration.
-require_tail_recursion.m:026: Error: no such mode for
-require_tail_recursion.m:026: `require_tail_recursion.length'/2 in
-require_tail_recursion.m:026: `:- pragma require_tail_recursion' pragma.
-require_tail_recursion.m:029: Error: Conflicting
-require_tail_recursion.m:029: `:- pragma require_tail_recursion' attributes:
-require_tail_recursion.m:029: `error' conflicts with earlier attribute
-require_tail_recursion.m:029: `warn'.
-require_tail_recursion.m:032: Error: Conflicting
-require_tail_recursion.m:032: `:- pragma require_tail_recursion' attributes:
-require_tail_recursion.m:032: `none' conflicts with earlier attribute `warn'.
-require_tail_recursion.m:035: Error: Conflicting
-require_tail_recursion.m:035: `:- pragma require_tail_recursion' attributes:
-require_tail_recursion.m:035: `none' conflicts with earlier attribute
-require_tail_recursion.m:035: `error'.
-require_tail_recursion.m:039: Error: Conflicting
-require_tail_recursion.m:039: `:- pragma require_tail_recursion' attributes:
-require_tail_recursion.m:039: `self_recursion_only' conflicts with earlier
-require_tail_recursion.m:039: attribute `self_or_mutual_recursion'.
-require_tail_recursion.m:042: Error: Conflicting
-require_tail_recursion.m:042: `:- pragma require_tail_recursion' attributes:
-require_tail_recursion.m:042: `none' conflicts with earlier attribute
-require_tail_recursion.m:042: `self_or_mutual_recursion'.
-require_tail_recursion.m:046: Error: Conflicting
-require_tail_recursion.m:046: `:- pragma require_tail_recursion' attributes:
-require_tail_recursion.m:046: `none' conflicts with earlier attribute
-require_tail_recursion.m:046: `self_recursion_only'.
-require_tail_recursion.m:050: Error: unrecognised
-require_tail_recursion.m:050: `:- pragma require_tail_recursion' attribute:
-require_tail_recursion.m:050: `blahblahblah'.
-require_tail_recursion.m:054: Error: `:- pragma require_tail_recursion' pragma
-require_tail_recursion.m:054: for `require_tail_recursion.blahblahblah'/0
-require_tail_recursion.m:054: without corresponding `:- pred' or `:- func'
-require_tail_recursion.m:054: declaration.
-require_tail_recursion.m:056: Error: expected attribute list for
-require_tail_recursion.m:056: `:- pragma require_tail_recursion' declaration,
-require_tail_recursion.m:056: not `Woop'.
-require_tail_recursion.m:059: Error: expected attribute list for
-require_tail_recursion.m:059: `:- pragma require_tail_recursion' declaration,
-require_tail_recursion.m:059: not `23'.
-require_tail_recursion.m:066: Error: Conflicting
-require_tail_recursion.m:066: `:- pragma require_tail_recursion' attributes:
-require_tail_recursion.m:066: `none' conflicts with earlier attribute
-require_tail_recursion.m:066: `self_recursion_only'.
-require_tail_recursion.m:066: Error: Conflicting
-require_tail_recursion.m:066: `:- pragma require_tail_recursion' attributes:
-require_tail_recursion.m:066: `none' conflicts with earlier attribute `warn'.
-require_tail_recursion.m:067: Error: unrecognised
-require_tail_recursion.m:067: `:- pragma require_tail_recursion' attribute:
-require_tail_recursion.m:067: `grasshopper'.
-require_tail_recursion.m:072: Error: conflicting
-require_tail_recursion.m:072: `:- pragma require_tail_recursion' pragmas for
-require_tail_recursion.m:072: `require_tail_recursion.length10'/2 or one of
-require_tail_recursion.m:072: its modes.
-require_tail_recursion.m:070: Earlier pragma is here.
-require_tail_recursion.m:075: Error: conflicting
-require_tail_recursion.m:075: `:- pragma require_tail_recursion' pragmas for
-require_tail_recursion.m:075: `require_tail_recursion.length10'/2 or one of
-require_tail_recursion.m:075: its modes.
-require_tail_recursion.m:070: Earlier pragma is here.
-require_tail_recursion.m:089: Error: conflicting
-require_tail_recursion.m:089: `:- pragma require_tail_recursion' pragmas for
-require_tail_recursion.m:089: `require_tail_recursion.append'/3 or one of its
-require_tail_recursion.m:089: modes.
-require_tail_recursion.m:087: Earlier pragma is here.
-require_tail_recursion.m:089: Error: conflicting
-require_tail_recursion.m:089: `:- pragma require_tail_recursion' pragmas for
-require_tail_recursion.m:089: `require_tail_recursion.append'/3 or one of its
-require_tail_recursion.m:089: modes.
-require_tail_recursion.m:088: Earlier pragma is here.
diff --git a/tests/invalid/require_tail_recursion.m b/tests/invalid/require_tail_recursion.m
deleted file mode 100644
index 0e80d11..0000000
--- a/tests/invalid/require_tail_recursion.m
+++ /dev/null
@@ -1,90 +0,0 @@
-%
-% This test case tests for invalid uses of the require_tail_recursion
-% pragma. It does not test the use of this pragma on a non tail recursive
-% predicate or function, that will be tested separately.
-
-:- module require_tail_recursion.
-
-:- interface.
-
-:- import_module list.
-:- import_module int.
-
-% The pragma shouldn't be allowed in the interface
-:- pragma require_tail_recursion(length/2, [warn]).
-
-:- pred length(list(T)::in, int::out) is det.
-
-:- implementation.
-
-% The pragma used with an non-existant predicate or function.
-:- pragma require_tail_recursion(non_existant_pred/3, [warn]).
-:- pragma require_tail_recursion(non_existant_proc(in, out), [error]).
-:- pragma require_tail_recursion(non_existant_func_proc(in) = out, [error]).
-
-% or with a non existent mode of a predicate that does exist.
-:- pragma require_tail_recursion(length(out, in), [self_recursion_only]).
-
-% conflicting options.
-:- pragma require_tail_recursion(length1/2, [warn, error]).
-:- pred length1(list(T)::in, int::out) is det.
-
-:- pragma require_tail_recursion(length2/2, [warn, none]).
-:- pred length2(list(T)::in, int::out) is det.
-
-:- pragma require_tail_recursion(length3/2, [error, none]).
-:- pred length3(list(T)::in, int::out) is det.
-
-:- pragma require_tail_recursion(length4/2, [self_or_mutual_recursion,
- self_recursion_only]).
-:- pred length4(list(T)::in, int::out) is det.
-
-:- pragma require_tail_recursion(length5/2, [self_or_mutual_recursion,
- none]).
-:- pred length5(list(T)::in, int::out) is det.
-
-:- pragma require_tail_recursion(length6/2, [self_recursion_only, none]).
-:- pred length6(list(T)::in, int::out) is det.
-
-% malformed arguments / options.
-:- pragma require_tail_recursion(length7/2, [blahblahblah]).
-:- pred length7(list(T)::in, int::out) is det.
-
-% This gets read as a 0-arity predicate, that is then non-existent.
-:- pragma require_tail_recursion(blahblahblah).
-
-:- pragma require_tail_recursion(length8/2, Woop).
-:- pred length8(list(T)::in, int::out) is det.
-
-:- pragma require_tail_recursion(length9/2, 23).
-:- pred length9(list(T)::in, int::out) is det.
-
-% Multiple problems, this tests that each problem is reported, not just the
-% first. However the non-existent pred/proc is not checked until
-% add_pragma.m, but this predicate is rejected earlier (prog_io_pragma.m)
-% due to the bad attribute list.
-:- pragma require_tail_recursion(length_nonexistent/3, [none, warn,
- self_recursion_only, grasshopper]).
-
-% Multiple pragmas for the same predicate.
-:- pragma require_tail_recursion(length10/2, [warn,
- self_or_mutual_recursion]).
-:- pragma require_tail_recursion(length10/2, [error,
- self_recursion_only]).
-% Even the same options applied multiple times should cause an error.
-:- pragma require_tail_recursion(length10/2, [error,
- self_recursion_only]).
-
-:- pred length10(list(T)::in, int::out) is det.
-
-% Multiple definitions for the same mode of a predicate.
-
-:- pred append(list(T), list(T), list(T)).
-:- mode append(in, in, out) is det.
-:- mode append(out, out, in) is multi.
-:- mode append(in, in, in) is semidet.
-
-:- pragma require_tail_recursion(append(in, in, out), [warn]).
-:- pragma require_tail_recursion(append(in, in, in), [warn]).
-:- pragma require_tail_recursion(append/3, [warn]). % error should be here.
-
diff --git a/tests/invalid/require_tailrec_1.err_exp b/tests/invalid/require_tailrec_1.err_exp
new file mode 100644
index 0000000..434e4fd
--- /dev/null
+++ b/tests/invalid/require_tailrec_1.err_exp
@@ -0,0 +1,12 @@
+require_tailrec_1.m:025: In mode number 1 of predicate `qsortapp_1'/2:
+require_tailrec_1.m:025: warning: recursive call is not tail recursive.
+require_tailrec_1.m:034: In mode number 1 of predicate `qsortapp_2'/2:
+require_tailrec_1.m:034: warning: recursive call is not tail recursive.
+require_tailrec_1.m:043: In mode number 1 of predicate `qsortapp_3'/2:
+require_tailrec_1.m:043: warning: recursive call is not tail recursive.
+require_tailrec_1.m:052: In mode number 1 of predicate `qsortapp_4'/2:
+require_tailrec_1.m:052: error: recursive call is not tail recursive.
+require_tailrec_1.m:061: In mode number 1 of predicate `qsortapp_5'/2:
+require_tailrec_1.m:061: warning: recursive call is not tail recursive.
+require_tailrec_1.m:070: In mode number 1 of predicate `qsortapp_6'/2:
+require_tailrec_1.m:070: warning: recursive call is not tail recursive.
diff --git a/tests/invalid/require_tailrec_1.m b/tests/invalid/require_tailrec_1.m
new file mode 100644
index 0000000..59a1efa
--- /dev/null
+++ b/tests/invalid/require_tailrec_1.m
@@ -0,0 +1,85 @@
+%
+% Require tail recursion pragma tests with --no-warn-non-tail-recursive
+:- module require_tailrec_1.
+
+:- interface.
+
+:- import_module int.
+:- import_module list.
+
+:- pred qsortapp_1(list(int)::in, list(int)::out) is det.
+:- pred qsortapp_2(list(int)::in, list(int)::out) is det.
+:- pred qsortapp_3(list(int)::in, list(int)::out) is det.
+:- pred qsortapp_4(list(int)::in, list(int)::out) is det.
+:- pred qsortapp_5(list(int)::in, list(int)::out) is det.
+:- pred qsortapp_6(list(int)::in, list(int)::out) is det.
+
+:- implementation.
+
+:- pragma require_tail_recursion(qsortapp_1/2).
+
+qsortapp_1([], []).
+qsortapp_1([Pivot | T], List) :-
+ partition(Pivot, T, [], Left0, [], Right0),
+ qsortapp_1(Left0, Left),
+ qsortapp_1(Right0, Right),
+ append(Left, [Pivot | Right], List).
+
+:- pragma require_tail_recursion(qsortapp_2/2, []).
+
+qsortapp_2([], []).
+qsortapp_2([Pivot | T], List) :-
+ partition(Pivot, T, [], Left0, [], Right0),
+ qsortapp_2(Left0, Left),
+ qsortapp_2(Right0, Right),
+ append(Left, [Pivot | Right], List).
+
+:- pragma require_tail_recursion(qsortapp_3/2, [warn]).
+
+qsortapp_3([], []).
+qsortapp_3([Pivot | T], List) :-
+ partition(Pivot, T, [], Left0, [], Right0),
+ qsortapp_3(Left0, Left),
+ qsortapp_3(Right0, Right),
+ append(Left, [Pivot | Right], List).
+
+:- pragma require_tail_recursion(qsortapp_4/2, [error]).
+
+qsortapp_4([], []).
+qsortapp_4([Pivot | T], List) :-
+ partition(Pivot, T, [], Left0, [], Right0),
+ qsortapp_4(Left0, Left),
+ qsortapp_4(Right0, Right),
+ append(Left, [Pivot | Right], List).
+
+:- pragma require_tail_recursion(qsortapp_5/2, [self_recursion_only]).
+
+qsortapp_5([], []).
+qsortapp_5([Pivot | T], List) :-
+ partition(Pivot, T, [], Left0, [], Right0),
+ qsortapp_5(Left0, Left),
+ qsortapp_5(Right0, Right),
+ append(Left, [Pivot | Right], List).
+
+:- pragma require_tail_recursion(qsortapp_6/2, [self_or_mutual_recursion]).
+
+qsortapp_6([], []).
+qsortapp_6([Pivot | T], List) :-
+ partition(Pivot, T, [], Left0, [], Right0),
+ qsortapp_6(Left0, Left),
+ qsortapp_6(Right0, Right),
+ append(Left, [Pivot | Right], List).
+
+%-----------------------------------------------------------------------%
+
+:- pred partition(int::in, list(int)::in, list(int)::in, list(int)::out,
+ list(int)::in, list(int)::out) is det.
+
+partition(_Pivot, [], Left, Left, Right, Right).
+partition(Pivot, [H | T], Left0, Left, Right0, Right) :-
+ ( if H < Pivot then
+ partition(Pivot, T, [H | Left0], Left, Right0, Right)
+ else
+ partition(Pivot, T, Left0, Left, [H | Right0], Right)
+ ).
+
diff --git a/tests/invalid/require_tailrec_2.err_exp b/tests/invalid/require_tailrec_2.err_exp
new file mode 100644
index 0000000..a8cd2b8
--- /dev/null
+++ b/tests/invalid/require_tailrec_2.err_exp
@@ -0,0 +1,12 @@
+require_tailrec_2.m:025: In mode number 1 of predicate `qsortapp_1'/2:
+require_tailrec_2.m:025: warning: recursive call is not tail recursive.
+require_tailrec_2.m:034: In mode number 1 of predicate `qsortapp_2'/2:
+require_tailrec_2.m:034: warning: recursive call is not tail recursive.
+require_tailrec_2.m:043: In mode number 1 of predicate `qsortapp_3'/2:
+require_tailrec_2.m:043: warning: recursive call is not tail recursive.
+require_tailrec_2.m:052: In mode number 1 of predicate `qsortapp_4'/2:
+require_tailrec_2.m:052: error: recursive call is not tail recursive.
+require_tailrec_2.m:061: In mode number 1 of predicate `qsortapp_5'/2:
+require_tailrec_2.m:061: warning: recursive call is not tail recursive.
+require_tailrec_2.m:070: In mode number 1 of predicate `qsortapp_6'/2:
+require_tailrec_2.m:070: warning: recursive call is not tail recursive.
diff --git a/tests/invalid/require_tailrec_2.m b/tests/invalid/require_tailrec_2.m
new file mode 100644
index 0000000..f9c0a91
--- /dev/null
+++ b/tests/invalid/require_tailrec_2.m
@@ -0,0 +1,85 @@
+%
+% Require tail recursion pragma tests with --warn-non-tail-recursive
+:- module require_tailrec_2.
+
+:- interface.
+
+:- import_module int.
+:- import_module list.
+
+:- pred qsortapp_1(list(int)::in, list(int)::out) is det.
+:- pred qsortapp_2(list(int)::in, list(int)::out) is det.
+:- pred qsortapp_3(list(int)::in, list(int)::out) is det.
+:- pred qsortapp_4(list(int)::in, list(int)::out) is det.
+:- pred qsortapp_5(list(int)::in, list(int)::out) is det.
+:- pred qsortapp_6(list(int)::in, list(int)::out) is det.
+
+:- implementation.
+
+:- pragma require_tail_recursion(qsortapp_1/2).
+
+qsortapp_1([], []).
+qsortapp_1([Pivot | T], List) :-
+ partition(Pivot, T, [], Left0, [], Right0),
+ qsortapp_1(Left0, Left),
+ qsortapp_1(Right0, Right),
+ append(Left, [Pivot | Right], List).
+
+:- pragma require_tail_recursion(qsortapp_2/2, []).
+
+qsortapp_2([], []).
+qsortapp_2([Pivot | T], List) :-
+ partition(Pivot, T, [], Left0, [], Right0),
+ qsortapp_2(Left0, Left),
+ qsortapp_2(Right0, Right),
+ append(Left, [Pivot | Right], List).
+
+:- pragma require_tail_recursion(qsortapp_3/2, [warn]).
+
+qsortapp_3([], []).
+qsortapp_3([Pivot | T], List) :-
+ partition(Pivot, T, [], Left0, [], Right0),
+ qsortapp_3(Left0, Left),
+ qsortapp_3(Right0, Right),
+ append(Left, [Pivot | Right], List).
+
+:- pragma require_tail_recursion(qsortapp_4/2, [error]).
+
+qsortapp_4([], []).
+qsortapp_4([Pivot | T], List) :-
+ partition(Pivot, T, [], Left0, [], Right0),
+ qsortapp_4(Left0, Left),
+ qsortapp_4(Right0, Right),
+ append(Left, [Pivot | Right], List).
+
+:- pragma require_tail_recursion(qsortapp_5/2, [self_recursion_only]).
+
+qsortapp_5([], []).
+qsortapp_5([Pivot | T], List) :-
+ partition(Pivot, T, [], Left0, [], Right0),
+ qsortapp_5(Left0, Left),
+ qsortapp_5(Right0, Right),
+ append(Left, [Pivot | Right], List).
+
+:- pragma require_tail_recursion(qsortapp_6/2, [self_or_mutual_recursion]).
+
+qsortapp_6([], []).
+qsortapp_6([Pivot | T], List) :-
+ partition(Pivot, T, [], Left0, [], Right0),
+ qsortapp_6(Left0, Left),
+ qsortapp_6(Right0, Right),
+ append(Left, [Pivot | Right], List).
+
+%-----------------------------------------------------------------------%
+
+:- pred partition(int::in, list(int)::in, list(int)::in, list(int)::out,
+ list(int)::in, list(int)::out) is det.
+
+partition(_Pivot, [], Left, Left, Right, Right).
+partition(Pivot, [H | T], Left0, Left, Right0, Right) :-
+ ( if H < Pivot then
+ partition(Pivot, T, [H | Left0], Left, Right0, Right)
+ else
+ partition(Pivot, T, Left0, Left, [H | Right0], Right)
+ ).
+
diff --git a/tests/invalid/require_tailrec_invalid.err_exp b/tests/invalid/require_tailrec_invalid.err_exp
new file mode 100644
index 0000000..964614c
--- /dev/null
+++ b/tests/invalid/require_tailrec_invalid.err_exp
@@ -0,0 +1,88 @@
+require_tailrec_invalid.m:014: Error: `:- pragma require_tail_recursion'
+require_tailrec_invalid.m:014: declaration in module interface.
+require_tailrec_invalid.m:021: Error: `:- pragma require_tail_recursion' pragma
+require_tailrec_invalid.m:021: for
+require_tailrec_invalid.m:021: `require_tailrec_invalid.non_existent_pred'/3
+require_tailrec_invalid.m:021: without corresponding `:- pred' or `:- func'
+require_tailrec_invalid.m:021: declaration.
+require_tailrec_invalid.m:022: Error: `:- pragma require_tail_recursion' pragma
+require_tailrec_invalid.m:022: for
+require_tailrec_invalid.m:022: `require_tailrec_invalid.non_existent_proc'/2
+require_tailrec_invalid.m:022: without corresponding `:- pred' or `:- func'
+require_tailrec_invalid.m:022: declaration.
+require_tailrec_invalid.m:023: Error: `:- pragma require_tail_recursion' pragma
+require_tailrec_invalid.m:023: for
+require_tailrec_invalid.m:023: `require_tailrec_invalid.non_existent_func_proc'/1
+require_tailrec_invalid.m:023: without corresponding `:- pred' or `:- func'
+require_tailrec_invalid.m:023: declaration.
+require_tailrec_invalid.m:026: Error: no such mode for
+require_tailrec_invalid.m:026: `require_tailrec_invalid.length'/2 in
+require_tailrec_invalid.m:026: `:- pragma require_tail_recursion' pragma.
+require_tailrec_invalid.m:029: Error: Conflicting
+require_tailrec_invalid.m:029: `:- pragma require_tail_recursion' attributes:
+require_tailrec_invalid.m:029: `error' conflicts with earlier attribute
+require_tailrec_invalid.m:029: `warn'.
+require_tailrec_invalid.m:032: Error: Conflicting
+require_tailrec_invalid.m:032: `:- pragma require_tail_recursion' attributes:
+require_tailrec_invalid.m:032: `none' conflicts with earlier attribute
+require_tailrec_invalid.m:032: `warn'.
+require_tailrec_invalid.m:035: Error: Conflicting
+require_tailrec_invalid.m:035: `:- pragma require_tail_recursion' attributes:
+require_tailrec_invalid.m:035: `none' conflicts with earlier attribute
+require_tailrec_invalid.m:035: `error'.
+require_tailrec_invalid.m:039: Error: Conflicting
+require_tailrec_invalid.m:039: `:- pragma require_tail_recursion' attributes:
+require_tailrec_invalid.m:039: `self_recursion_only' conflicts with earlier
+require_tailrec_invalid.m:039: attribute `self_or_mutual_recursion'.
+require_tailrec_invalid.m:042: Error: Conflicting
+require_tailrec_invalid.m:042: `:- pragma require_tail_recursion' attributes:
+require_tailrec_invalid.m:042: `none' conflicts with earlier attribute
+require_tailrec_invalid.m:042: `self_or_mutual_recursion'.
+require_tailrec_invalid.m:046: Error: Conflicting
+require_tailrec_invalid.m:046: `:- pragma require_tail_recursion' attributes:
+require_tailrec_invalid.m:046: `none' conflicts with earlier attribute
+require_tailrec_invalid.m:046: `self_recursion_only'.
+require_tailrec_invalid.m:050: Error: unrecognised
+require_tailrec_invalid.m:050: `:- pragma require_tail_recursion' attribute:
+require_tailrec_invalid.m:050: `blahblahblah'.
+require_tailrec_invalid.m:054: Error: `:- pragma require_tail_recursion' pragma
+require_tailrec_invalid.m:054: for `require_tailrec_invalid.blahblahblah'/0
+require_tailrec_invalid.m:054: without corresponding `:- pred' or `:- func'
+require_tailrec_invalid.m:054: declaration.
+require_tailrec_invalid.m:056: Error: expected attribute list for
+require_tailrec_invalid.m:056: `:- pragma require_tail_recursion'
+require_tailrec_invalid.m:056: declaration, not `Woop'.
+require_tailrec_invalid.m:059: Error: expected attribute list for
+require_tailrec_invalid.m:059: `:- pragma require_tail_recursion'
+require_tailrec_invalid.m:059: declaration, not `23'.
+require_tailrec_invalid.m:066: Error: Conflicting
+require_tailrec_invalid.m:066: `:- pragma require_tail_recursion' attributes:
+require_tailrec_invalid.m:066: `none' conflicts with earlier attribute
+require_tailrec_invalid.m:066: `self_recursion_only'.
+require_tailrec_invalid.m:066: Error: Conflicting
+require_tailrec_invalid.m:066: `:- pragma require_tail_recursion' attributes:
+require_tailrec_invalid.m:066: `none' conflicts with earlier attribute
+require_tailrec_invalid.m:066: `warn'.
+require_tailrec_invalid.m:067: Error: unrecognised
+require_tailrec_invalid.m:067: `:- pragma require_tail_recursion' attribute:
+require_tailrec_invalid.m:067: `grasshopper'.
+require_tailrec_invalid.m:072: Error: conflicting
+require_tailrec_invalid.m:072: `:- pragma require_tail_recursion' pragmas for
+require_tailrec_invalid.m:072: `require_tailrec_invalid.length10'/2 or one of
+require_tailrec_invalid.m:072: its modes.
+require_tailrec_invalid.m:070: Earlier pragma is here.
+require_tailrec_invalid.m:075: Error: conflicting
+require_tailrec_invalid.m:075: `:- pragma require_tail_recursion' pragmas for
+require_tailrec_invalid.m:075: `require_tailrec_invalid.length10'/2 or one of
+require_tailrec_invalid.m:075: its modes.
+require_tailrec_invalid.m:070: Earlier pragma is here.
+require_tailrec_invalid.m:089: Error: conflicting
+require_tailrec_invalid.m:089: `:- pragma require_tail_recursion' pragmas for
+require_tailrec_invalid.m:089: `require_tailrec_invalid.append'/3 or one of
+require_tailrec_invalid.m:089: its modes.
+require_tailrec_invalid.m:087: Earlier pragma is here.
+require_tailrec_invalid.m:089: Error: conflicting
+require_tailrec_invalid.m:089: `:- pragma require_tail_recursion' pragmas for
+require_tailrec_invalid.m:089: `require_tailrec_invalid.append'/3 or one of
+require_tailrec_invalid.m:089: its modes.
+require_tailrec_invalid.m:088: Earlier pragma is here.
diff --git a/tests/invalid/require_tailrec_invalid.m b/tests/invalid/require_tailrec_invalid.m
new file mode 100644
index 0000000..05fec6c
--- /dev/null
+++ b/tests/invalid/require_tailrec_invalid.m
@@ -0,0 +1,90 @@
+%
+% This test case tests for invalid uses of the require_tail_recursion
+% pragma. It does not test the use of this pragma on a non tail recursive
+% predicate or function, that will be tested separately.
+
+:- module require_tailrec_invalid.
+
+:- interface.
+
+:- import_module list.
+:- import_module int.
+
+% The pragma shouldn't be allowed in the interface
+:- pragma require_tail_recursion(length/2, [warn]).
+
+:- pred length(list(T)::in, int::out) is det.
+
+:- implementation.
+
+% The pragma used with an non-existent predicate or function.
+:- pragma require_tail_recursion(non_existent_pred/3, [warn]).
+:- pragma require_tail_recursion(non_existent_proc(in, out), [error]).
+:- pragma require_tail_recursion(non_existent_func_proc(in) = out, [error]).
+
+% or with a non existent mode of a predicate that does exist.
+:- pragma require_tail_recursion(length(out, in), [self_recursion_only]).
+
+% conflicting options.
+:- pragma require_tail_recursion(length1/2, [warn, error]).
+:- pred length1(list(T)::in, int::out) is det.
+
+:- pragma require_tail_recursion(length2/2, [warn, none]).
+:- pred length2(list(T)::in, int::out) is det.
+
+:- pragma require_tail_recursion(length3/2, [error, none]).
+:- pred length3(list(T)::in, int::out) is det.
+
+:- pragma require_tail_recursion(length4/2, [self_or_mutual_recursion,
+ self_recursion_only]).
+:- pred length4(list(T)::in, int::out) is det.
+
+:- pragma require_tail_recursion(length5/2, [self_or_mutual_recursion,
+ none]).
+:- pred length5(list(T)::in, int::out) is det.
+
+:- pragma require_tail_recursion(length6/2, [self_recursion_only, none]).
+:- pred length6(list(T)::in, int::out) is det.
+
+% malformed arguments / options.
+:- pragma require_tail_recursion(length7/2, [blahblahblah]).
+:- pred length7(list(T)::in, int::out) is det.
+
+% This gets read as a 0-arity predicate, that is then non-existent.
+:- pragma require_tail_recursion(blahblahblah).
+
+:- pragma require_tail_recursion(length8/2, Woop).
+:- pred length8(list(T)::in, int::out) is det.
+
+:- pragma require_tail_recursion(length9/2, 23).
+:- pred length9(list(T)::in, int::out) is det.
+
+% Multiple problems, this tests that each problem is reported, not just the
+% first. However the non-existent pred/proc is not checked until
+% add_pragma.m, but this predicate is rejected earlier (prog_io_pragma.m)
+% due to the bad attribute list.
+:- pragma require_tail_recursion(length_nonexistent/3, [none, warn,
+ self_recursion_only, grasshopper]).
+
+% Multiple pragmas for the same predicate.
+:- pragma require_tail_recursion(length10/2, [warn,
+ self_or_mutual_recursion]).
+:- pragma require_tail_recursion(length10/2, [error,
+ self_recursion_only]).
+% Even the same options applied multiple times should cause an error.
+:- pragma require_tail_recursion(length10/2, [error,
+ self_recursion_only]).
+
+:- pred length10(list(T)::in, int::out) is det.
+
+% Multiple definitions for the same mode of a predicate.
+
+:- pred append(list(T), list(T), list(T)).
+:- mode append(in, in, out) is det.
+:- mode append(out, out, in) is multi.
+:- mode append(in, in, in) is semidet.
+
+:- pragma require_tail_recursion(append(in, in, out), [warn]).
+:- pragma require_tail_recursion(append(in, in, in), [warn]).
+:- pragma require_tail_recursion(append/3, [warn]). % error should be here.
+
diff --git a/tests/valid/Mercury.options b/tests/valid/Mercury.options
index f171e54..88d3bf2 100644
--- a/tests/valid/Mercury.options
+++ b/tests/valid/Mercury.options
@@ -82,6 +82,8 @@ MCFLAGS-par_dupelim = --optimize-dups
MCFLAGS-par_saved_const = -O3 --optimize-saved-vars-const
MCFLAGS-pred_with_no_modes = --infer-all
MCFLAGS-quantifier_warning = --halt-at-warn
+MCFLAGS-require_tailrec_1 = --warn-non-tail-recursion
+MCFLAGS-require_tailrec_2 = --no-warn-non-tail-recursion
MCFLAGS-reuse_static = --ctgc --deforestation
MCFLAGS-reuse_static2 = --structure-reuse --loop-invariants
MCFLAGS-sharing_exist = --ctgc --structure-sharing-widening 1
diff --git a/tests/valid/Mmakefile b/tests/valid/Mmakefile
index c4d99d6..3db66a3 100644
--- a/tests/valid/Mmakefile
+++ b/tests/valid/Mmakefile
@@ -200,6 +200,8 @@ OTHER_PROGS = \
recursive_no_tag_type \
reg_bug \
require_bug \
+ require_tailrec_1 \
+ require_tailrec_2 \
same_length_2 \
semidet_disj \
shape_type \
diff --git a/tests/valid/require_tailrec_1.m b/tests/valid/require_tailrec_1.m
new file mode 100644
index 0000000..c698001
--- /dev/null
+++ b/tests/valid/require_tailrec_1.m
@@ -0,0 +1,38 @@
+%
+% Test the require tail recursion pragma with the --warn-non-tail-recursion
+% option. These tests do not raise an error, the tests that do raise errors
+% are in invalid/
+%
+
+:- module require_tailrec_1.
+
+:- interface.
+
+:- import_module int.
+:- import_module list.
+
+:- pred qsortapp(list(int)::in, list(int)::out) is det.
+
+:- implementation.
+
+:- pragma require_tail_recursion(qsortapp/2, [none]).
+
+qsortapp([], []).
+qsortapp([Pivot | T], List) :-
+ partition(Pivot, T, [], Left0, [], Right0),
+ qsortapp(Left0, Left),
+ qsortapp(Right0, Right),
+ append(Left, [Pivot | Right], List).
+
+:- pred partition(int::in, list(int)::in, list(int)::in, list(int)::out,
+ list(int)::in, list(int)::out) is det.
+:- pragma require_tail_recursion(partition/6).
+
+partition(_Pivot, [], Left, Left, Right, Right).
+partition(Pivot, [H | T], Left0, Left, Right0, Right) :-
+ ( if H < Pivot then
+ partition(Pivot, T, [H | Left0], Left, Right0, Right)
+ else
+ partition(Pivot, T, Left0, Left, [H | Right0], Right)
+ ).
+
diff --git a/tests/valid/require_tailrec_2.m b/tests/valid/require_tailrec_2.m
new file mode 100644
index 0000000..31616af
--- /dev/null
+++ b/tests/valid/require_tailrec_2.m
@@ -0,0 +1,47 @@
+%
+% Test the require tail recursion pragma with the
+% --no-warn-non-tail-recursion option. These tests do not raise an error,
+% the tests that do raise errors are in invalid/
+%
+
+:- module require_tailrec_2.
+
+:- interface.
+
+:- import_module int.
+:- import_module list.
+
+:- pred qsortapp(list(int)::in, list(int)::out) is det.
+
+:- pred qsortapp_2(list(int)::in, list(int)::out) is det.
+
+:- implementation.
+
+:- pragma require_tail_recursion(qsortapp/2, [none]).
+
+qsortapp([], []).
+qsortapp([Pivot | T], List) :-
+ partition(Pivot, T, [], Left0, [], Right0),
+ qsortapp(Left0, Left),
+ qsortapp(Right0, Right),
+ append(Left, [Pivot | Right], List).
+
+qsortapp_2([], []).
+qsortapp_2([Pivot | T], List) :-
+ partition(Pivot, T, [], Left0, [], Right0),
+ qsortapp_2(Left0, Left),
+ qsortapp_2(Right0, Right),
+ append(Left, [Pivot | Right], List).
+
+:- pred partition(int::in, list(int)::in, list(int)::in, list(int)::out,
+ list(int)::in, list(int)::out) is det.
+:- pragma require_tail_recursion(partition/6).
+
+partition(_Pivot, [], Left, Left, Right, Right).
+partition(Pivot, [H | T], Left0, Left, Right0, Right) :-
+ ( if H < Pivot then
+ partition(Pivot, T, [H | Left0], Left, Right0, Right)
+ else
+ partition(Pivot, T, Left0, Left, [H | Right0], Right)
+ ).
+
--
2.6.2
More information about the reviews
mailing list