diff --git a/compiler/add_pragma_impl.m b/compiler/add_pragma_impl.m index 79c72851e..803bac7ff 100644 --- a/compiler/add_pragma_impl.m +++ b/compiler/add_pragma_impl.m @@ -612,8 +612,8 @@ add_pragma_require_tail_rec_proc(RequireTailrec, Context, MaybePredOrFunc, color_as_subject([qual_sym_name_arity(SNA), suffix(".")]) ++ [nl], OrigPieces = [words("The earlier pragma is here."), nl], - ( RequireTailrecOrig = suppress_tailrec_warnings(ContextOrig) - ; RequireTailrecOrig = enable_tailrec_warnings(_, _, _, ContextOrig) + ( RequireTailrecOrig = disable_nontailrec_reports(ContextOrig) + ; RequireTailrecOrig = enable_nontailrec_reports(_, _, _, ContextOrig) ), Spec = error_spec($pred, severity_error, phase_pt2h, [msg(Context, MainPieces), diff --git a/compiler/mark_tail_calls.m b/compiler/mark_tail_calls.m index 06b84fd9b..7396969da 100644 --- a/compiler/mark_tail_calls.m +++ b/compiler/mark_tail_calls.m @@ -99,6 +99,13 @@ % as a tail call, it cannot actually implement that call as a tail call. % +:- type report_requested_by + ---> request_by_code + % Usually, the code doing the requesting + % is a require_tail_recursion pragma, but it can also be + % a disable_warnings scope. + ; request_by_option. + :- type maybe_warn_non_tail_self_rec ---> do_not_warn_non_tail_self_rec ; warn_non_tail_self_rec. @@ -109,6 +116,7 @@ :- type warn_non_tail_rec_params ---> warn_non_tail_rec_params( + report_requested_by, warning_or_error, report_in_which_grades, maybe_warn_non_tail_self_rec, @@ -174,7 +182,8 @@ % :- pred add_message_for_nontail_self_recursive_call(pf_sym_name_arity::in, proc_id::in, prog_context::in, nontail_rec_call_reason::in, - warning_or_error::in, list(error_spec)::in, list(error_spec)::out) is det. + report_requested_by::in, warning_or_error::in, + list(error_spec)::in, list(error_spec)::out) is det. % add_message_for_nontail_mutual_recursive_call(CallerCallId, CallerProcId, % CalleeCallId, WarnOrError, Context, !Specs): @@ -185,7 +194,7 @@ % :- pred add_message_for_nontail_mutual_recursive_call(pf_sym_name_arity::in, proc_id::in, pf_sym_name_arity::in, prog_context::in, - nontail_rec_call_reason::in, warning_or_error::in, + nontail_rec_call_reason::in, report_requested_by::in, warning_or_error::in, list(error_spec)::in, list(error_spec)::out) is det. % Have we found any recursive calls so far? @@ -199,7 +208,7 @@ ---> not_found_any_rec_calls ; found_any_rec_calls. - % maybe_report_no_tail_or_nontail_recursive_calls(PredInfo, ProcInfo + % maybe_report_no_tail_or_nontail_recursive_calls(PredInfo, ProcInfo, % FoundAnyRecCalls, Context, !Specs): % % If FoundAnyRecCalls = not_found_any_rec_calls but ProcInfo says @@ -212,6 +221,8 @@ proc_info::in, found_any_rec_calls::in, list(error_spec)::in, list(error_spec)::out) is det. +% ZZZ stop all unneeded exports + %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% @@ -277,9 +288,8 @@ mark_tail_rec_calls_in_scc_for_mlds(Params, SCC, [PredProcId | PredProcIds], pred_info_proc_info(PredInfo0, ProcId, ProcInfo0), maybe_override_params_for_proc(ProcInfo0, Params, ProcParams), do_mark_tail_rec_calls_in_proc(ProcParams, !.ModuleInfo, SCC, - PredId, ProcId, PredInfo0, ProcInfo0, ProcInfo, WasProcChanged, - [], ProcSpecs), - !:Specs = ProcSpecs ++ !.Specs, + PredId, ProcId, PredInfo0, ProcInfo0, ProcInfo, + WasProcChanged, !Specs), ( WasProcChanged = proc_was_not_changed ; @@ -345,12 +355,14 @@ mark_tail_rec_calls_in_proc_for_llds_code_gen(ModuleInfo, PredId, ProcId, %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% -:- func no_warnings_non_tail_rec_params = warn_non_tail_rec_params. +:- func no_warnings_non_tail_rec_params(report_requested_by) + = warn_non_tail_rec_params. -no_warnings_non_tail_rec_params = Params :- +no_warnings_non_tail_rec_params(RequestBy) = Params :- % Since neither SelfRec nor MutualRec is set, the values of % WarnOrError and Grades do not matter. - Params = warn_non_tail_rec_params(we_warning, in_tailrec_grades_only, + Params = warn_non_tail_rec_params(RequestBy, we_warning, + in_tailrec_grades_only, do_not_warn_non_tail_self_rec, do_not_warn_non_tail_mutual_rec). get_default_warn_parms(Globals, WarnNonTailRecParams) :- @@ -376,8 +388,8 @@ get_default_warn_parms(Globals, WarnNonTailRecParams) :- WarnNonTailMutualRecBool = no, WarnNonTailMutualRecOpt = do_not_warn_non_tail_mutual_rec ), - WarnNonTailRecParams = warn_non_tail_rec_params(we_warning, Grades, - WarnNonTailSelfRecOpt, WarnNonTailMutualRecOpt). + WarnNonTailRecParams = warn_non_tail_rec_params(request_by_option, + we_warning, Grades, WarnNonTailSelfRecOpt, WarnNonTailMutualRecOpt). maybe_override_warn_params_for_proc(ProcInfo, WarnParams, ProcWarnParams) :- proc_info_get_maybe_require_tailrec_info(ProcInfo, MaybeRequireTailRec), @@ -387,10 +399,10 @@ maybe_override_warn_params_for_proc(ProcInfo, WarnParams, ProcWarnParams) :- ; MaybeRequireTailRec = yes(Pragma), ( - Pragma = suppress_tailrec_warnings(_), - ProcWarnParams = no_warnings_non_tail_rec_params + Pragma = disable_nontailrec_reports(_), + ProcWarnParams = no_warnings_non_tail_rec_params(request_by_code) ; - Pragma = enable_tailrec_warnings(WarnOrError, RecType, Grades, + Pragma = enable_nontailrec_reports(WarnOrError, RecType, Grades, _Context), ( RecType = only_self_recursion_must_be_tail, @@ -401,8 +413,8 @@ maybe_override_warn_params_for_proc(ProcInfo, WarnParams, ProcWarnParams) :- SelfRec = warn_non_tail_self_rec, MutualRec = warn_non_tail_mutual_rec ), - ProcWarnParams = warn_non_tail_rec_params(WarnOrError, Grades, - SelfRec, MutualRec) + ProcWarnParams = warn_non_tail_rec_params(request_by_code, + WarnOrError, Grades, SelfRec, MutualRec) ) ). @@ -508,7 +520,7 @@ do_mark_tail_rec_calls_in_proc(Params, ModuleInfo, SCC, PredId, ProcId, MaybeSelfFeature = no, MaybeMutualFeature = no, MaybeRecordTailCalls = do_not_record_tail_recursion, - WarnNonTailRecParams = warn_non_tail_rec_params(_, _, + WarnNonTailRecParams = warn_non_tail_rec_params(_, _, _, do_not_warn_non_tail_self_rec, do_not_warn_non_tail_mutual_rec) then WasProcChanged = proc_was_not_changed @@ -660,6 +672,7 @@ find_output_args(ModuleInfo, Types, Modes, Vars, OutputVars) :- mark_tail_rec_calls_info::in, mark_tail_rec_calls_info::out) is det. mark_tail_rec_calls_in_goal(Goal0, Goal, AtTail0, AtTail, !Info) :- + % ZZZ break up Goal0 = hlds_goal(GoalExpr0, GoalInfo0), ( ( GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _) @@ -682,7 +695,7 @@ mark_tail_rec_calls_in_goal(Goal0, Goal, AtTail0, AtTail, !Info) :- then OldParams = !.Info ^ mtc_params, InnerParams = OldParams ^ warn_params := - no_warnings_non_tail_rec_params, + no_warnings_non_tail_rec_params(request_by_code), InnerInfo0 = !.Info ^ mtc_params := InnerParams, mark_tail_rec_calls_in_goal(SubGoal0, SubGoal, AtTail0, AtTail, InnerInfo0, InnerInfo), @@ -1046,7 +1059,7 @@ not_at_tail(Before, After) :- maybe_report_nontail_recursive_call(ModuleInfo, CallerPredProcId, CalleePredProcId, Context, Reason, Obviousness, WarnParams, !Specs) :- - WarnParams = warn_non_tail_rec_params(WarnOrError, Grades, + WarnParams = warn_non_tail_rec_params(RequestBy, WarnOrError, Grades, WarnNonTailSelfRec, WarnNonTailMutualRec), ( if ( if CallerPredProcId = CalleePredProcId then @@ -1070,8 +1083,8 @@ maybe_report_nontail_recursive_call(ModuleInfo, ) then report_nontail_recursive_call(ModuleInfo, - CallerPredProcId, CalleePredProcId, Context, Reason, WarnOrError, - !Specs) + CallerPredProcId, CalleePredProcId, Context, Reason, + RequestBy, WarnOrError, !Specs) else true ). @@ -1090,11 +1103,11 @@ grade_supports_tail_recursion(ModuleInfo) :- :- pred report_nontail_recursive_call(module_info::in, pred_proc_id::in, pred_proc_id::in, prog_context::in, - nontail_rec_call_reason::in, warning_or_error::in, + nontail_rec_call_reason::in, report_requested_by::in, warning_or_error::in, list(error_spec)::in, list(error_spec)::out) is det. report_nontail_recursive_call(ModuleInfo, CallerPredProcId, CalleePredProcId, - Context, Reason, WarnOrError, !Specs) :- + Context, Reason, RequestBy, WarnOrError, !Specs) :- CallerPredProcId = proc(CallerPredId, CallerProcId), module_info_pred_info(ModuleInfo, CallerPredId, CallerPredInfo), CallerPredOrFunc = pred_info_is_pred_or_func(CallerPredInfo), @@ -1104,7 +1117,7 @@ report_nontail_recursive_call(ModuleInfo, CallerPredProcId, CalleePredProcId, CallerPredFormArity), ( if CallerPredProcId = CalleePredProcId then add_message_for_nontail_self_recursive_call(CallerId, CallerProcId, - Context, Reason, WarnOrError, !Specs) + Context, Reason, RequestBy, WarnOrError, !Specs) else CalleePredProcId = proc(CalleePredId, _), module_info_pred_info(ModuleInfo, CalleePredId, CalleePredInfo), @@ -1115,17 +1128,20 @@ report_nontail_recursive_call(ModuleInfo, CallerPredProcId, CalleePredProcId, CalleeId = pf_sym_name_arity(CalleePredOrFunc, CalleeName, CalleePredFormArity), add_message_for_nontail_mutual_recursive_call(CallerId, - CallerProcId, CalleeId, Context, Reason, WarnOrError, !Specs) + CallerProcId, CalleeId, Context, Reason, + RequestBy, WarnOrError, !Specs) ). %---------------------------------------------------------------------------% add_message_for_nontail_self_recursive_call(PFSymNameArity, ProcId, Context, - Reason, WarnOrError, !Specs) :- + Reason, RequestBy, WarnOrError, !Specs) :- nontail_rec_call_reason_to_pieces(Reason, Context, ReasonPieces, VerboseMsgs), - woe_to_severity_and_string(warn_non_tail_recursion_self, WarnOrError, - Severity, WarnOrErrorWord), + ( RequestBy = request_by_code, Option = warn_requested_by_code + ; RequestBy = request_by_option, Option = warn_non_tail_recursion_self + ), + woe_to_severity_and_string(Option, WarnOrError, Severity, WarnOrErrorWord), proc_id_to_int(ProcId, ProcNumber0), ProcNumber = ProcNumber0 + 1, MainPieces = [words("In mode number"), int_fixed(ProcNumber), @@ -1138,11 +1154,13 @@ add_message_for_nontail_self_recursive_call(PFSymNameArity, ProcId, Context, !:Specs = [Spec | !.Specs]. add_message_for_nontail_mutual_recursive_call(CallerId, CallerProcId, - CalleeId, Context, Reason, WarnOrError, !Specs) :- + CalleeId, Context, Reason, RequestBy, WarnOrError, !Specs) :- nontail_rec_call_reason_to_pieces(Reason, Context, ReasonPieces, VerboseMsgs), - woe_to_severity_and_string(warn_non_tail_recursion_mutual, WarnOrError, - Severity, WarnOrErrorWord), + ( RequestBy = request_by_code, Option = warn_requested_by_code + ; RequestBy = request_by_option, Option = warn_non_tail_recursion_mutual + ), + woe_to_severity_and_string(Option, WarnOrError, Severity, WarnOrErrorWord), proc_id_to_int(CallerProcId, ProcNumber0), ProcNumber = ProcNumber0 + 1, MainPieces = [words("In mode number"), int_fixed(ProcNumber), words("of"), @@ -1223,8 +1241,15 @@ maybe_report_no_tail_or_nontail_recursive_calls(PredInfo, ProcInfo, MaybeRequireTailRec = no ; MaybeRequireTailRec = yes(RequireTailRecInfo), - ( RequireTailRecInfo = enable_tailrec_warnings(_, _, _, Context) - ; RequireTailRecInfo = suppress_tailrec_warnings(Context) + ( + RequireTailRecInfo = disable_nontailrec_reports(Context), + % In the absence of any recursive calls, + % the pragma that records disable_nontailrec_reports + % is totally useless. + WarnOrError = we_error + ; + RequireTailRecInfo = enable_nontailrec_reports(WarnOrError, + _, _, Context) ), pred_info_get_is_pred_or_func(PredInfo, PredOrFunc), pred_info_get_name(PredInfo, PredName), @@ -1232,23 +1257,25 @@ maybe_report_no_tail_or_nontail_recursive_calls(PredInfo, ProcInfo, PFSymNameArity = pf_sym_name_arity(PredOrFunc, unqualified(PredName), PredFormArity), report_no_tail_or_nontail_recursive_calls(PFSymNameArity, Context, - !Specs) + WarnOrError, warn_requested_by_code, !Specs) ) ). :- pred report_no_tail_or_nontail_recursive_calls(pf_sym_name_arity::in, - prog_context::in, list(error_spec)::in, list(error_spec)::out) is det. + prog_context::in, warning_or_error::in, option::in, + list(error_spec)::in, list(error_spec)::out) is det. -report_no_tail_or_nontail_recursive_calls(PFSymNameArity, Context, !Specs) :- +report_no_tail_or_nontail_recursive_calls(PFSymNameArity, Context, + WarnOrError, Option, !Specs) :- + woe_to_severity_and_string(Option, WarnOrError, Severity, WarnOrErrorWord), PFSymNameArity = pf_sym_name_arity(PredOrFunc, _, _), Pieces = [words("In"), pragma_decl("require_tail_recursion"), words("for"), unqual_pf_sym_name_pred_form_arity(PFSymNameArity), suffix(":"), nl, - words("warning: the code defining this"), p_or_f(PredOrFunc), - words("contains")] ++ + WarnOrErrorWord, words("the code defining this"), + p_or_f(PredOrFunc), words("contains")] ++ color_as_incorrect([words("no recursive calls at all,")]) ++ [words("tail-recursive or otherwise."), nl], - Spec = spec($pred, severity_warning(warn_no_recursion), phase_code_gen, - Context, Pieces), + Spec = spec($pred, Severity, phase_code_gen, Context, Pieces), !:Specs = [Spec | !.Specs]. %---------------------------------------------------------------------------% diff --git a/compiler/mercury_compile_llds_back_end.m b/compiler/mercury_compile_llds_back_end.m index 3bde938dc..c90db1050 100644 --- a/compiler/mercury_compile_llds_back_end.m +++ b/compiler/mercury_compile_llds_back_end.m @@ -207,8 +207,7 @@ llds_backend_pass_by_phases(ProgressStream, !HLDS, !:LLDS, !GlobalData, !Specs, compute_liveness(ProgressStream, Verbose, Stats, !HLDS, !IO), maybe_dump_hlds(ProgressStream, !.HLDS, 330, "liveness", !DumpInfo, !IO), - maybe_mark_tail_rec_calls(ProgressStream, Verbose, Stats, - !HLDS, !Specs, !IO), + mark_tail_rec_calls(ProgressStream, Verbose, Stats, !HLDS, !Specs, !IO), maybe_dump_hlds(ProgressStream, !.HLDS, 332, "mark_debug_tailrec_calls", !DumpInfo, !IO), @@ -580,12 +579,11 @@ compute_liveness(ProgressStream, Verbose, Stats, !HLDS, !IO) :- maybe_write_string(ProgressStream, Verbose, "% done.\n", !IO), maybe_report_stats(ProgressStream, Stats, !IO). -:- pred maybe_mark_tail_rec_calls(io.text_output_stream::in, - bool::in, bool::in, module_info::in, module_info::out, +:- pred mark_tail_rec_calls(io.text_output_stream::in, bool::in, bool::in, + module_info::in, module_info::out, list(error_spec)::in, list(error_spec)::out, io::di, io::uo) is det. -maybe_mark_tail_rec_calls(ProgressStream, Verbose, Stats, - !HLDS, !Specs, !IO) :- +mark_tail_rec_calls(ProgressStream, Verbose, Stats, !HLDS, !Specs, !IO) :- maybe_write_string(ProgressStream, Verbose, "% Marking directly tail recursive calls...", !IO), maybe_flush_output(ProgressStream, Verbose, !IO), diff --git a/compiler/mercury_compile_mlds_back_end.m b/compiler/mercury_compile_mlds_back_end.m index 3502185e0..176ad1b6a 100644 --- a/compiler/mercury_compile_mlds_back_end.m +++ b/compiler/mercury_compile_mlds_back_end.m @@ -112,7 +112,7 @@ hlds_to_mlds(ProgressStream, !.HLDS, !:MLDS, !Specs, !DumpInfo, !IO) :- maybe_dump_hlds(ProgressStream, !.HLDS, 425, "args_to_regs", !DumpInfo, !IO), - maybe_mark_tail_rec_calls_hlds(ProgressStream, Verbose, Stats, + mark_tail_rec_calls_hlds(ProgressStream, Verbose, Stats, !HLDS, !Specs, !IO), maybe_dump_hlds(ProgressStream, !.HLDS, 430, "mark_tail_calls", !DumpInfo, !IO), @@ -288,28 +288,20 @@ maybe_add_heap_ops(ProgressStream, Verbose, Stats, !HLDS, !IO) :- SemidetReclaim = no ). -:- pred maybe_mark_tail_rec_calls_hlds(io.text_output_stream::in, +:- pred mark_tail_rec_calls_hlds(io.text_output_stream::in, bool::in, bool::in, module_info::in, module_info::out, list(error_spec)::in, list(error_spec)::out, io::di, io::uo) is det. -maybe_mark_tail_rec_calls_hlds(ProgressStream, Verbose, Stats, +mark_tail_rec_calls_hlds(ProgressStream, Verbose, Stats, !HLDS, !Specs, !IO) :- - module_info_get_globals(!.HLDS, Globals), - globals.get_opt_tuple(Globals, OptTuple), - OptimizeTailCalls = OptTuple ^ ot_opt_mlds_tailcalls, - ( - OptimizeTailCalls = opt_mlds_tailcalls, maybe_write_string(ProgressStream, Verbose, "% Marking tail recursive calls...", !IO), maybe_flush_output(ProgressStream, Verbose, !IO), module_info_rebuild_dependency_info(!HLDS, DepInfo), - mark_self_and_mutual_tail_rec_calls_in_module_for_mlds_code_gen( - DepInfo, !HLDS, !Specs), + mark_self_and_mutual_tail_rec_calls_in_module_for_mlds_code_gen(DepInfo, + !HLDS, !Specs), maybe_write_string(ProgressStream, Verbose, " done.\n", !IO), - maybe_report_stats(ProgressStream, Stats, !IO) - ; - OptimizeTailCalls = do_not_opt_mlds_tailcalls - ). + maybe_report_stats(ProgressStream, Stats, !IO). :- pred mlds_gen_rtti_data(module_info::in, mlds_target_lang::in, mlds::in, mlds::out) is det. diff --git a/compiler/parse_pragma.m b/compiler/parse_pragma.m index 4c4af1dfd..2e0ee115f 100644 --- a/compiler/parse_pragma.m +++ b/compiler/parse_pragma.m @@ -211,6 +211,10 @@ parse_named_pragma(ModuleName, VarSet, ErrorTerm, PragmaName, PragmaTerms, PragmaName = "require_tail_recursion", parse_pragma_require_tail_recursion(ModuleName, PragmaName, PragmaTerms, ErrorTerm, VarSet, Context, SeqNum, MaybeIOM) + ; + PragmaName = "disable_non_tail_recursion_reports", + parse_pragma_disable_non_tail_recursion_reports(ModuleName, PragmaName, + PragmaTerms, ErrorTerm, VarSet, Context, SeqNum, MaybeIOM) ; PragmaName = "oisu", parse_oisu_pragma(ModuleName, VarSet, ErrorTerm, @@ -988,8 +992,7 @@ parse_pragma_require_tail_recursion(ModuleName, PragmaName, PragmaTerms, MaybeOptionsTerm = yes(OptionsTerm), ( if list_term_to_term_list(OptionsTerm, OptionsTerms) then parse_pragma_require_tail_recursion_options(VarSet, Context, - OptionsTerms, have_not_seen_none, no, no, no, - [], MaybeOptions) + OptionsTerms, no, no, no, [], MaybeRTR) else OptionsContext = get_term_context(OptionsTerm), OptionsTermStr = describe_error_term(VarSet, OptionsTerm), @@ -1003,27 +1006,28 @@ parse_pragma_require_tail_recursion(ModuleName, PragmaName, PragmaTerms, [nl], Spec = spec($pred, severity_error, phase_t2pt, OptionsContext, Pieces), - MaybeOptions = error1([Spec]) + MaybeRTR = error1([Spec]) ) ; MaybeOptionsTerm = no, Severity = we_warning, Kind = both_self_and_mutual_recursion_must_be_tail, Grades = in_tailrec_grades_only, - Enable = enable_tailrec_warnings(Severity, Kind, Grades, Context), - MaybeOptions = ok1(Enable) + Enable = enable_nontailrec_reports(Severity, Kind, Grades, + Context), + MaybeRTR = ok1(Enable) ), ( if MaybePredOrProcSpec = ok1(PredOrProcSpec), - MaybeOptions = ok1(Options) + MaybeRTR = ok1(RTR) then - TailRec = impl_pragma_req_tail_rec_info(PredOrProcSpec, Options, + TailRec = impl_pragma_req_tail_rec_info(PredOrProcSpec, RTR, Context, SeqNum), Item = item_impl_pragma(impl_pragma_req_tail_rec(TailRec)), MaybeIOM = ok1(iom_item(Item)) else Specs = get_any_errors1(MaybePredOrProcSpec) ++ - get_any_errors1(MaybeOptions), + get_any_errors1(MaybeRTR), MaybeIOM = error1(Specs) ) ; @@ -1035,63 +1039,20 @@ parse_pragma_require_tail_recursion(ModuleName, PragmaName, PragmaTerms, MaybeIOM = error1([Spec]) ). -:- type seen_none - ---> seen_none - ; have_not_seen_none. - :- pred parse_pragma_require_tail_recursion_options(varset::in, - prog_context::in, list(term)::in, seen_none::in, + prog_context::in, list(term)::in, maybe(warning_or_error)::in, maybe(require_tail_recursion_type)::in, maybe(report_in_which_grades)::in, list(error_spec)::in, maybe1(require_tail_recursion)::out) is det. parse_pragma_require_tail_recursion_options(_VarSet, PragmaContext, [], - !.SeenNone, !.MaybeWarnOrError, !.MaybeType, !.MaybeGrades, - !.Specs, MaybeRTR) :- + !.MaybeWarnOrError, !.MaybeType, !.MaybeGrades, Specs0, MaybeRTR) :- ( - !.SeenNone = seen_none, - % Check for conflicts with "none" option. - ( - !.MaybeWarnOrError = yes(WarnOrError0), - warning_or_error_string(WarnOrError0, WarnOrErrorString), - SpecA = conflicting_attributes_error("none", WarnOrErrorString, - PragmaContext), - !:Specs = [SpecA | !.Specs] + Specs0 = [_ | _], + MaybeRTR = error1(Specs0) ; - !.MaybeWarnOrError = no - ), - ( - !.MaybeType = yes(Type0), - require_tailrec_type_string(Type0, TypeString), - SpecB = conflicting_attributes_error("none", TypeString, - PragmaContext), - !:Specs = [SpecB | !.Specs] - ; - !.MaybeType = no - ), - ( - !.MaybeGrades = yes(Grades0), - require_tailrec_grades_string(Grades0, GradesString), - SpecC = conflicting_attributes_error("none", GradesString, - PragmaContext), - !:Specs = [SpecC | !.Specs] - ; - !.MaybeGrades = no - ) - ; - !.SeenNone = have_not_seen_none - ), - ( - !.Specs = [_ | _], - MaybeRTR = error1(!.Specs) - ; - !.Specs = [], - ( - !.SeenNone = seen_none, - MaybeRTR = ok1(suppress_tailrec_warnings(PragmaContext)) - ; - !.SeenNone = have_not_seen_none, - % If these values were not set, then use the defaults. + Specs0 = [], + % For any option whose value was not set, use the applicable default. ( !.MaybeWarnOrError = yes(WarnOrError) ; @@ -1110,14 +1071,13 @@ parse_pragma_require_tail_recursion_options(_VarSet, PragmaContext, [], !.MaybeGrades = no, Grades = in_tailrec_grades_only ), - RTR = enable_tailrec_warnings(WarnOrError, Type, Grades, + RTR = enable_nontailrec_reports(WarnOrError, Type, Grades, PragmaContext), MaybeRTR = ok1(RTR) - ) ). parse_pragma_require_tail_recursion_options(VarSet, PragmaContext, - [Term | Terms], !.SeenNone, !.MaybeWarnOrError, !.MaybeType, - !.MaybeGrades, !.Specs, MaybeRTR) :- + [Term | Terms], !.MaybeWarnOrError, !.MaybeType, !.MaybeGrades, + !.Specs, MaybeRTR) :- ( Term = functor(Functor, _Args, Context), ( if @@ -1162,10 +1122,6 @@ parse_pragma_require_tail_recursion_options(VarSet, PragmaContext, OldGradesString, Context), !:Specs = [Spec | !.Specs] ) - else if - Functor = atom("none") - then - !:SeenNone = seen_none else Spec = pragma_require_tailrec_unknown_term_error(VarSet, Term, Context), @@ -1178,8 +1134,7 @@ parse_pragma_require_tail_recursion_options(VarSet, PragmaContext, !:Specs = [Spec | !.Specs] ), parse_pragma_require_tail_recursion_options(VarSet, PragmaContext, Terms, - !.SeenNone, !.MaybeWarnOrError, !.MaybeType, !.MaybeGrades, - !.Specs, MaybeRTR). + !.MaybeWarnOrError, !.MaybeType, !.MaybeGrades, !.Specs, MaybeRTR). :- func conflicting_attributes_error(string, string, prog_context) = error_spec. @@ -1207,6 +1162,44 @@ pragma_require_tailrec_unknown_term_error(VarSet, Term, Context) = Spec :- [nl], Spec = spec($pred, severity_error, phase_t2pt, Context, Pieces). +%---------------------------------------------------------------------------% +% +% Parse disable_non_tail_recursion_reports pragmas. +% + +:- pred parse_pragma_disable_non_tail_recursion_reports(module_name::in, + string::in, list(term)::in, term::in, varset::in, prog_context::in, + item_seq_num::in, maybe1(item_or_marker)::out) is det. + +parse_pragma_disable_non_tail_recursion_reports(ModuleName, PragmaName, + PragmaTerms, ErrorTerm, VarSet, Context, SeqNum, MaybeIOM) :- + ( + PragmaTerms = [PredOrProcSpecTerm], + % Parse the procedure name. + ContextPieces = cord.from_list([words("In the first argument of"), + pragma_decl(PragmaName), words("declaration:"), nl]), + parse_pred_pfu_name_arity_maybe_modes(ModuleName, ContextPieces, + VarSet, PredOrProcSpecTerm, MaybePredOrProcSpec), + ( + MaybePredOrProcSpec = ok1(PredOrProcSpec), + RTR = disable_nontailrec_reports(Context), + TailRec = impl_pragma_req_tail_rec_info(PredOrProcSpec, RTR, + Context, SeqNum), + Item = item_impl_pragma(impl_pragma_req_tail_rec(TailRec)), + MaybeIOM = ok1(iom_item(Item)) + ; + MaybePredOrProcSpec = error1(Specs), + MaybeIOM = error1(Specs) + ) + ; + ( PragmaTerms = [] + ; PragmaTerms = [_, _ | _] + ), + Spec = report_pragma_arity_error(ErrorTerm, PragmaName, + "one argument"), + MaybeIOM = error1([Spec]) + ). + %---------------------------------------------------------------------------% % % Parse oisu (order-independent state update) pragmas. diff --git a/compiler/parse_tree_out_pragma.m b/compiler/parse_tree_out_pragma.m index 11f7a9b84..0d058a909 100644 --- a/compiler/parse_tree_out_pragma.m +++ b/compiler/parse_tree_out_pragma.m @@ -1264,15 +1264,16 @@ mercury_format_pragma_require_tail_rec(Lang, RequireTR, S, !U) :- RequireTR = impl_pragma_req_tail_rec_info(PredOrProcSpec, Warn, _, _), ProcSpecStr = pred_or_proc_pfumm_name_to_string(Lang, PredOrProcSpec), ( - Warn = suppress_tailrec_warnings(_), - string.format(":- pragma warn_tail_recursion(%s, [none]).\n", + Warn = disable_nontailrec_reports(_), + string.format( + ":- pragma disable_non_tail_recursion_reports(%s).\n", [s(ProcSpecStr)], DeclStr) ; - Warn = enable_tailrec_warnings(WarnOrError, Type, Grades, _), + Warn = enable_nontailrec_reports(WarnOrError, Type, Grades, _), warning_or_error_string(WarnOrError, WarnOrErrorStr), require_tailrec_type_string(Type, TypeStr), require_tailrec_grades_string(Grades, GradesStr), - string.format(":- pragma warn_tail_recursion(%s, [%s, %s, %s]).\n", + string.format(":- pragma require_tail_recursion(%s, [%s, %s, %s]).\n", [s(ProcSpecStr), s(WarnOrErrorStr), s(TypeStr), s(GradesStr)], DeclStr) ), diff --git a/compiler/prog_data_pragma.m b/compiler/prog_data_pragma.m index 6ec4c5371..7e63093f0 100644 --- a/compiler/prog_data_pragma.m +++ b/compiler/prog_data_pragma.m @@ -503,14 +503,14 @@ tabled_eval_method_to_table_type(EvalMethod) = TableTypeStr :- :- interface. :- type require_tail_recursion - ---> suppress_tailrec_warnings( - rtrs_context :: prog_context + ---> disable_nontailrec_reports( + dntrr_context :: prog_context ) - ; enable_tailrec_warnings( - rtre_warn_or_error :: warning_or_error, - rtre_recursion_type :: require_tail_recursion_type, - rtre_grades :: report_in_which_grades, - rtre_context :: prog_context + ; enable_nontailrec_reports( + entrr_warn_or_error :: warning_or_error, + entrr_recursion_type :: require_tail_recursion_type, + entrr_report_grades :: report_in_which_grades, + entrr_context :: prog_context ). % Should we report violations of the required level of tail recursion ... diff --git a/tests/invalid/Mercury.options b/tests/invalid/Mercury.options index cfaf1edb5..9048f11f2 100644 --- a/tests/invalid/Mercury.options +++ b/tests/invalid/Mercury.options @@ -113,12 +113,7 @@ MCFLAGS-range_restrict += --warn-too-private-instances MCFLAGS-record_syntax_errors += -E MCFLAGS-ref_to_implicit_pred += -E MCFLAGS-require_scopes += --warn-unsorted-import-blocks -MCFLAGS-require_tailrec_1 += -O0 --optimise-tailcalls -MCFLAGS-require_tailrec_1 += --no-warn-non-tail-recursion -MCFLAGS-require_tailrec_2 += -O0 --optimise-tailcalls -MCFLAGS-require_tailrec_2 += --warn-non-tail-recursion self -E -MCFLAGS-require_tailrec_3 += -O0 --optimise-tailcalls -MCFLAGS-require_tailrec_3 += --warn-non-tail-recursion self-and-mutual +MCFLAGS-require_tailrec_2 += --warn-non-tail-recursion self-and-mutual -E MCFLAGS-string_format_bad += --halt-at-warn MCFLAGS-string_format_bad += --warn-known-bad-format-calls MCFLAGS-string_format_bad += --warn-unknown-format-calls diff --git a/tests/invalid/Mmakefile b/tests/invalid/Mmakefile index 3ba6089f2..43a8f264d 100644 --- a/tests/invalid/Mmakefile +++ b/tests/invalid/Mmakefile @@ -33,8 +33,7 @@ ALWAYS_SPECIAL_RULE_SINGLEMODULE_PROGS = \ illtyped_compare \ make_opt_error \ require_tailrec_1 \ - require_tailrec_2 \ - require_tailrec_3 + require_tailrec_2 INTERMOD_SPECIAL_MULTIMODULE_PROGS = \ abstract_eqv \ @@ -583,9 +582,11 @@ illtyped_compare.err: illtyped_compare.m else true; \ fi -# For these tests the error is only caught when generating target code. +# The next line is needed for the foreign_include_file_missing test case. .PHONY: missing_file -require_tailrec_1.err require_tailrec_2.err require_tailrec_3.err foreign_include_file_missing.err: %.err : %.m + +# For these tests, the error is only caught when generating target code. +require_tailrec_1.err require_tailrec_2.err foreign_include_file_missing.err: %.err : %.m -$(MC) --make-interface $(ALL_GRADEFLAGS) $(ALL_MCFLAGS) \ $*.m > $*.int_err 2>&1; if $(MC) --target-code-only $(ALL_GRADEFLAGS) $(ALL_MCFLAGS) \ diff --git a/tests/invalid/require_tailrec_1.err_exp b/tests/invalid/require_tailrec_1.err_exp index 2ee389b2f..26493642b 100644 --- a/tests/invalid/require_tailrec_1.err_exp +++ b/tests/invalid/require_tailrec_1.err_exp @@ -1,6 +1,29 @@ -require_tailrec_1.m:117: In mode number 1 of predicate `qsortapp_4'/2: -require_tailrec_1.m:117: error: self-recursive call is not tail recursive. -require_tailrec_1.m:142: In `:- pragma require_tail_recursion' for function -require_tailrec_1.m:142: `cons'/2: -require_tailrec_1.m:142: warning: the code defining this function contains no -require_tailrec_1.m:142: recursive calls at all, tail-recursive or otherwise. +require_tailrec_1.m:067: In mode number 1 of predicate `map1'/3: +require_tailrec_1.m:067: warning: self-recursive call is not tail recursive. +require_tailrec_1.m:076: In mode number 1 of predicate `map2'/3: +require_tailrec_1.m:076: warning: self-recursive call is not tail recursive. +require_tailrec_1.m:092: In mode number 1 of function `even1'/1: +require_tailrec_1.m:092: warning: mutually recursive call to function +require_tailrec_1.m:092: `odd1'/1 is not tail recursive. +require_tailrec_1.m:119: In mode number 1 of function `even2'/1: +require_tailrec_1.m:119: error: mutually recursive call to function `odd2'/1 +require_tailrec_1.m:119: is not tail recursive. +require_tailrec_1.m:142: In mode number 1 of function `even3'/1: +require_tailrec_1.m:142: warning: mutually recursive call to function +require_tailrec_1.m:142: `odd3'/1 is not tail recursive. +require_tailrec_1.m:164: In mode number 1 of predicate `qsort_1'/2: +require_tailrec_1.m:164: warning: self-recursive call is not tail recursive. +require_tailrec_1.m:187: In mode number 1 of predicate `qsort_3'/2: +require_tailrec_1.m:187: warning: self-recursive call is not tail recursive. +require_tailrec_1.m:198: In mode number 1 of predicate `qsort_4'/2: +require_tailrec_1.m:198: error: self-recursive call is not tail recursive. +require_tailrec_1.m:209: In mode number 1 of predicate `qsort_5'/2: +require_tailrec_1.m:209: warning: self-recursive call is not tail recursive. +require_tailrec_1.m:220: In mode number 1 of predicate `qsort_6'/2: +require_tailrec_1.m:220: warning: self-recursive call is not tail recursive. +require_tailrec_1.m:232: In mode number 1 of predicate `qsort_7'/2: +require_tailrec_1.m:232: error: self-recursive call is not tail recursive. +require_tailrec_1.m:256: In `:- pragma require_tail_recursion' for function +require_tailrec_1.m:256: `cons'/2: +require_tailrec_1.m:256: error: the code defining this function contains no +require_tailrec_1.m:256: recursive calls at all, tail-recursive or otherwise. diff --git a/tests/invalid/require_tailrec_1.err_exp2 b/tests/invalid/require_tailrec_1.err_exp2 index d70fb0383..f39b88c16 100644 --- a/tests/invalid/require_tailrec_1.err_exp2 +++ b/tests/invalid/require_tailrec_1.err_exp2 @@ -1,27 +1,35 @@ -require_tailrec_1.m:050: In mode number 1 of predicate `map1'/3: -require_tailrec_1.m:050: warning: self-recursive call is not tail recursive. -require_tailrec_1.m:057: In mode number 1 of predicate `map2'/3: -require_tailrec_1.m:057: warning: self-recursive call is not tail recursive. -require_tailrec_1.m:065: In mode number 1 of function `even1'/1: -require_tailrec_1.m:065: warning: mutually recursive call to function -require_tailrec_1.m:065: `odd1'/1 is not tail recursive. -require_tailrec_1.m:074: In mode number 1 of function `odd1'/1: -require_tailrec_1.m:074: warning: mutually recursive call to function -require_tailrec_1.m:074: `even1'/1 is tail recursive, but tail recursion -require_tailrec_1.m:074: optimization cannot be applied to it, because the -require_tailrec_1.m:074: callee cannot reach the caller via tail calls only. -require_tailrec_1.m:090: In mode number 1 of predicate `qsortapp_1'/2: -require_tailrec_1.m:090: warning: self-recursive call is not tail recursive. -require_tailrec_1.m:108: In mode number 1 of predicate `qsortapp_3'/2: -require_tailrec_1.m:108: warning: self-recursive call is not tail recursive. -require_tailrec_1.m:117: In mode number 1 of predicate `qsortapp_4'/2: -require_tailrec_1.m:117: error: self-recursive call is not tail recursive. -require_tailrec_1.m:126: In mode number 1 of predicate `qsortapp_5'/2: -require_tailrec_1.m:126: warning: self-recursive call is not tail recursive. -require_tailrec_1.m:135: In mode number 1 of predicate `qsortapp_6'/2: -require_tailrec_1.m:135: warning: self-recursive call is not tail recursive. -require_tailrec_1.m:142: In `:- pragma require_tail_recursion' for function -require_tailrec_1.m:142: `cons'/2: -require_tailrec_1.m:142: warning: the code defining this function contains no -require_tailrec_1.m:142: recursive calls at all, tail-recursive or otherwise. +require_tailrec_1.m:067: In mode number 1 of predicate `map1'/3: +require_tailrec_1.m:067: warning: self-recursive call is not tail recursive. +require_tailrec_1.m:076: In mode number 1 of predicate `map2'/3: +require_tailrec_1.m:076: warning: self-recursive call is not tail recursive. +require_tailrec_1.m:092: In mode number 1 of function `even1'/1: +require_tailrec_1.m:092: warning: mutually recursive call to function +require_tailrec_1.m:092: `odd1'/1 is not tail recursive. +require_tailrec_1.m:105: In mode number 1 of function `odd1'/1: +require_tailrec_1.m:105: warning: mutually recursive call to function +require_tailrec_1.m:105: `even1'/1 is tail recursive, but tail recursion +require_tailrec_1.m:105: optimization cannot be applied to it, because the +require_tailrec_1.m:105: callee cannot reach the caller via tail calls only. +require_tailrec_1.m:119: In mode number 1 of function `even2'/1: +require_tailrec_1.m:119: error: mutually recursive call to function `odd2'/1 +require_tailrec_1.m:119: is not tail recursive. +require_tailrec_1.m:142: In mode number 1 of function `even3'/1: +require_tailrec_1.m:142: warning: mutually recursive call to function +require_tailrec_1.m:142: `odd3'/1 is not tail recursive. +require_tailrec_1.m:164: In mode number 1 of predicate `qsort_1'/2: +require_tailrec_1.m:164: warning: self-recursive call is not tail recursive. +require_tailrec_1.m:187: In mode number 1 of predicate `qsort_3'/2: +require_tailrec_1.m:187: warning: self-recursive call is not tail recursive. +require_tailrec_1.m:198: In mode number 1 of predicate `qsort_4'/2: +require_tailrec_1.m:198: error: self-recursive call is not tail recursive. +require_tailrec_1.m:209: In mode number 1 of predicate `qsort_5'/2: +require_tailrec_1.m:209: warning: self-recursive call is not tail recursive. +require_tailrec_1.m:220: In mode number 1 of predicate `qsort_6'/2: +require_tailrec_1.m:220: warning: self-recursive call is not tail recursive. +require_tailrec_1.m:232: In mode number 1 of predicate `qsort_7'/2: +require_tailrec_1.m:232: error: self-recursive call is not tail recursive. +require_tailrec_1.m:256: In `:- pragma require_tail_recursion' for function +require_tailrec_1.m:256: `cons'/2: +require_tailrec_1.m:256: error: the code defining this function contains no +require_tailrec_1.m:256: recursive calls at all, tail-recursive or otherwise. For more information, recompile with `-E'. diff --git a/tests/invalid/require_tailrec_1.err_exp3 b/tests/invalid/require_tailrec_1.err_exp3 index c5be6c9da..7dd8f3fad 100644 --- a/tests/invalid/require_tailrec_1.err_exp3 +++ b/tests/invalid/require_tailrec_1.err_exp3 @@ -1,24 +1,6 @@ -require_tailrec_1.m:050: In mode number 1 of predicate `map1'/3: -require_tailrec_1.m:050: warning: self-recursive call is not tail recursive. -require_tailrec_1.m:057: In mode number 1 of predicate `map2'/3: -require_tailrec_1.m:057: warning: self-recursive call is not tail recursive. -require_tailrec_1.m:065: In mode number 1 of function `even1'/1: -require_tailrec_1.m:065: warning: mutually recursive call to function -require_tailrec_1.m:065: `odd1'/1 is not tail recursive. -require_tailrec_1.m:074: In mode number 1 of function `odd1'/1: -require_tailrec_1.m:074: warning: mutually recursive call to function -require_tailrec_1.m:074: `even1'/1 is not tail recursive. -require_tailrec_1.m:090: In mode number 1 of predicate `qsortapp_1'/2: -require_tailrec_1.m:090: warning: self-recursive call is not tail recursive. -require_tailrec_1.m:108: In mode number 1 of predicate `qsortapp_3'/2: -require_tailrec_1.m:108: warning: self-recursive call is not tail recursive. -require_tailrec_1.m:117: In mode number 1 of predicate `qsortapp_4'/2: -require_tailrec_1.m:117: error: self-recursive call is not tail recursive. -require_tailrec_1.m:126: In mode number 1 of predicate `qsortapp_5'/2: -require_tailrec_1.m:126: warning: self-recursive call is not tail recursive. -require_tailrec_1.m:135: In mode number 1 of predicate `qsortapp_6'/2: -require_tailrec_1.m:135: warning: self-recursive call is not tail recursive. -require_tailrec_1.m:142: In `:- pragma require_tail_recursion' for function -require_tailrec_1.m:142: `cons'/2: -require_tailrec_1.m:142: warning: the code defining this function contains no -require_tailrec_1.m:142: recursive calls at all, tail-recursive or otherwise. +require_tailrec_1.m:232: In mode number 1 of predicate `qsort_7'/2: +require_tailrec_1.m:232: error: self-recursive call is not tail recursive. +require_tailrec_1.m:256: In `:- pragma require_tail_recursion' for function +require_tailrec_1.m:256: `cons'/2: +require_tailrec_1.m:256: error: the code defining this function contains no +require_tailrec_1.m:256: recursive calls at all, tail-recursive or otherwise. diff --git a/tests/invalid/require_tailrec_1.m b/tests/invalid/require_tailrec_1.m index fb07cc863..e4c57c3aa 100644 --- a/tests/invalid/require_tailrec_1.m +++ b/tests/invalid/require_tailrec_1.m @@ -1,12 +1,14 @@ %---------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et % -% Tests of `pragma require_tail_recursion' wit -% `--no-warn-non-tail-recursion'. +% The .exp file is for LLDS grades that allow tail recursion. +% The .exp2 file is for MLDS grades that allow tail recursion. +% The .exp3 file is for grades without tail recursion (.debug, .profdeep). % -% The .exp file is for non-deep-profiling LLDS grades. -% The .exp3 file is for deep profiling LLDS grades. -% The .exp2 file is for MLDS grades. +% We export the predicates and functions whose diagnostics we wish to test +% because the code in mark_tail_calls.m that generates those diagnostics +% process only the procedures in the dependency graph, and that graph +% contains only the procedures that are reachable from the module interface. % %---------------------------------------------------------------------------% @@ -18,46 +20,71 @@ :- import_module int. :- import_module list. +%---------------------------------------------------------------------------% + :- pred map1(pred(X, Y), list(X), list(Y)). :- mode map1(pred(in, out) is det, in, out) is det. :- pred map2(pred(X, Y), list(X), list(Y)). :- mode map2(pred(in, out) is det, in, out) is det. +%---------------------------------------------------------------------------% + :- func even1(int) = bool. :- func odd1(int) = bool. +:- func even2(int) = bool. +:- func odd2(int) = bool. + +:- func even3(int) = bool. +:- func odd3(int) = bool. + %---------------------------------------------------------------------------% -:- 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. +:- pred qsort_1(list(int)::in, list(int)::out) is det. +:- pred qsort_2(list(int)::in, list(int)::out) is det. +:- pred qsort_3(list(int)::in, list(int)::out) is det. +:- pred qsort_4(list(int)::in, list(int)::out) is det. +:- pred qsort_5(list(int)::in, list(int)::out) is det. +:- pred qsort_6(list(int)::in, list(int)::out) is det. +:- pred qsort_7(list(int)::in, list(int)::out) is det. + +%---------------------------------------------------------------------------% :- func cons(X, list(X)) = list(X). -%---------------------------------------------------------------------------% %---------------------------------------------------------------------------% :- implementation. +%---------------------------------------------------------------------------% + + % Self non-tail recursion with self_recursion_only pragma. + % +:- pragma require_tail_recursion(pred(map1/3), [self_recursion_only]). -% self non-tail recursion with self pragma -:- pragma require_tail_recursion(map1/3, [self_recursion_only]). map1(_, [], []). map1(P, [X | Xs], [Y | Ys]) :- P(X, Y), map1(P, Xs, Ys). -% self non-tail recursion with mutual pragma + % Self non-tail recursion with self_or_mutual_recursion pragma. + % :- pragma require_tail_recursion(map2/3, [self_or_mutual_recursion]). + map2(_, [], []). map2(P, [X | Xs], [Y | Ys]) :- P(X, Y), map2(P, Xs, Ys). -% mutual non-tail recursion with mutual pragma -:- pragma require_tail_recursion(even1/1, [self_or_mutual_recursion]). +%---------------------------------------------------------------------------% +% NOTE Without the noinline pragmas below, the compiler could generate +% somewhat different diagnostic messages at higher optimization levels. +%---------------------------------------------------------------------------% + + % Mutual non-tail recursion with self_or_mutual_recursion pragma. + % +:- pragma require_tail_recursion(func(even1/1), [self_or_mutual_recursion]). +:- pragma no_inline(even1/1). + even1(N) = ( if N = 0 then yes @@ -65,8 +92,12 @@ even1(N) = bool.not(odd1(N)) ). -% mutual tail recursion with mutual pragma, this does not raise an error. + % Mutual tail recursion with self_or_mutual_recursion pragma. + % This should get a diagnostic ONLY in MLDS grades. + % :- pragma require_tail_recursion(odd1/1, [self_or_mutual_recursion]). +:- pragma no_inline(odd1/1). + odd1(N) = ( if N = 0 then no @@ -74,76 +105,135 @@ odd1(N) = even1(N - 1) ). -% Suppress inlining of calls to even1 into odd1 and vice versa at higher -% optimisation levels, as that would affect the warning messages produced. -:- pragma no_inline(even1/1). -:- pragma no_inline(odd1/1). +%---------------------% + + % A repeat of even1/1, but asking for an error, not a warning. + % +:- pragma require_tail_recursion(even2/1, [error, self_or_mutual_recursion]). +:- pragma no_inline(even2/1). + +even2(N) = + ( if N = 0 then + yes + else + bool.not(odd2(N)) + ). + +:- pragma no_inline(odd2/1). + +odd2(N) = + ( if N = 0 then + no + else + even2(N - 1) + ). + +%---------------------% + + % A repeat of even1/1, but not specifying the severity. + % +:- pragma require_tail_recursion(func(even3/1)). +:- pragma no_inline(even3/1). + +even3(N) = + ( if N = 0 then + yes + else + bool.not(odd3(N)) + ). + +:- pragma no_inline(odd3/1). + +odd3(N) = + ( if N = 0 then + no + else + even3(N - 1) + ). %---------------------------------------------------------------------------% -:- pragma require_tail_recursion(qsortapp_1/2). + % Test the default operation of this pragma. + % +:- pragma require_tail_recursion(qsort_1/2). -qsortapp_1([], []). -qsortapp_1([Pivot | T], List) :- +qsort_1([], []). +qsort_1([Pivot | T], List) :- partition(Pivot, T, [], Left0, [], Right0), - qsortapp_1(Left0, Left), - qsortapp_1(Right0, Right), + qsort_1(Left0, Left), + qsort_1(Right0, Right), append(Left, [Pivot | Right], List). -:- pragma require_tail_recursion(qsortapp_2/2, []). + % Test the default operation of this pragma when the relevant call + % is in a scope when where the relevant warning is disabled. + % +:- pragma require_tail_recursion(qsort_2/2, []). -qsortapp_2([], []). -qsortapp_2([Pivot | T], List) :- +qsort_2([], []). +qsort_2([Pivot | T], List) :- partition(Pivot, T, [], Left0, [], Right0), - qsortapp_2(Left0, Left), - disable_warnings [non_tail_recursive_calls] qsortapp_2(Right0, Right), + qsort_2(Left0, Left), + disable_warnings [non_tail_recursive_calls] qsort_2(Right0, Right), append(Left, [Pivot | Right], List). -:- pragma require_tail_recursion(qsortapp_3/2, [warn]). + % Test the warn option. + % +:- pragma require_tail_recursion(qsort_3/2, [warn]). -qsortapp_3([], []). -qsortapp_3([Pivot | T], List) :- +qsort_3([], []). +qsort_3([Pivot | T], List) :- partition(Pivot, T, [], Left0, [], Right0), - qsortapp_3(Left0, Left), - qsortapp_3(Right0, Right), + qsort_3(Left0, Left), + qsort_3(Right0, Right), append(Left, [Pivot | Right], List). -:- pragma require_tail_recursion(qsortapp_4/2, [error]). + % Test the error option. + % +:- pragma require_tail_recursion(qsort_4/2, [error]). -qsortapp_4([], []). -qsortapp_4([Pivot | T], List) :- +qsort_4([], []). +qsort_4([Pivot | T], List) :- partition(Pivot, T, [], Left0, [], Right0), - qsortapp_4(Left0, Left), - qsortapp_4(Right0, Right), + qsort_4(Left0, Left), + qsort_4(Right0, Right), append(Left, [Pivot | Right], List). -:- pragma require_tail_recursion(qsortapp_5/2, [self_recursion_only]). + % Test (sort-of) the self_recursion_only option. + % +:- pragma require_tail_recursion(qsort_5/2, [self_recursion_only]). -qsortapp_5([], []). -qsortapp_5([Pivot | T], List) :- +qsort_5([], []). +qsort_5([Pivot | T], List) :- partition(Pivot, T, [], Left0, [], Right0), - qsortapp_5(Left0, Left), - qsortapp_5(Right0, Right), + qsort_5(Left0, Left), + qsort_5(Right0, Right), append(Left, [Pivot | Right], List). -:- pragma require_tail_recursion(qsortapp_6/2, [self_or_mutual_recursion]). + % Test (sort-of) the self_or_mutual_recursion option. + % +:- pragma require_tail_recursion(qsort_6/2, [self_or_mutual_recursion]). -qsortapp_6([], []). -qsortapp_6([Pivot | T], List) :- +qsort_6([], []). +qsort_6([Pivot | T], List) :- partition(Pivot, T, [], Left0, [], Right0), - qsortapp_6(Left0, Left), - qsortapp_6(Right0, Right), + qsort_6(Left0, Left), + qsort_6(Right0, Right), append(Left, [Pivot | Right], List). -%---------------------------------------------------------------------------% + % Test the in_all_grades option. + % +:- pragma require_tail_recursion(qsort_7/2, + [error, in_all_grades, self_or_mutual_recursion]). -% Adding a tail recursion pragma to something that is not recursive is an -% error. -:- pragma require_tail_recursion(cons/2). -cons(X, Xs) = [X | Xs]. - -%---------------------------------------------------------------------------% +qsort_7([], []). +qsort_7([Pivot | T], List) :- + partition(Pivot, T, [], Left0, [], Right0), + qsort_7(Left0, Left), + qsort_7(Right0, Right), + append(Left, [Pivot | Right], List). + % Auxiliary predicate for the qsort_N predicates above. + % :- pred partition(int::in, list(int)::in, list(int)::in, list(int)::out, list(int)::in, list(int)::out) is det. @@ -154,3 +244,17 @@ partition(Pivot, [H | T], Left0, Left, Right0, Right) :- else partition(Pivot, T, Left0, Left, [H | Right0], Right) ). + +%---------------------------------------------------------------------------% + +% Adding this pragma to a non-recursive function is an error. +% +% This test case is expected to fail, generating useful diagnostics +% in grades that DO support tail recursion, we need it to also fail +% in grades that do NOT support tail recursion. The "in_all_grades" option +% is here to ensure just that. +:- pragma require_tail_recursion(func(cons/2), [in_all_grades, error]). + +cons(X, Xs) = [X | Xs]. + +%---------------------------------------------------------------------------% diff --git a/tests/invalid/require_tailrec_2.err_exp b/tests/invalid/require_tailrec_2.err_exp index 46c927a71..58ac9b2e6 100644 --- a/tests/invalid/require_tailrec_2.err_exp +++ b/tests/invalid/require_tailrec_2.err_exp @@ -1,20 +1,25 @@ -require_tailrec_2.m:049: In mode number 1 of predicate `map1'/3: -require_tailrec_2.m:049: warning: self-recursive call is not tail recursive. -require_tailrec_2.m:056: In mode number 1 of predicate `map2'/3: -require_tailrec_2.m:056: warning: self-recursive call is not tail recursive. -require_tailrec_2.m:089: In mode number 1 of predicate `qsortapp_1'/2: -require_tailrec_2.m:089: warning: self-recursive call is not tail recursive. -require_tailrec_2.m:098: In mode number 1 of predicate `qsortapp_2'/2: -require_tailrec_2.m:098: warning: self-recursive call is not tail recursive. -require_tailrec_2.m:107: In mode number 1 of predicate `qsortapp_3'/2: -require_tailrec_2.m:107: warning: self-recursive call is not tail recursive. -require_tailrec_2.m:116: In mode number 1 of predicate `qsortapp_4'/2: -require_tailrec_2.m:116: error: self-recursive call is not tail recursive. -require_tailrec_2.m:125: In mode number 1 of predicate `qsortapp_5'/2: -require_tailrec_2.m:125: warning: self-recursive call is not tail recursive. -require_tailrec_2.m:134: In mode number 1 of predicate `qsortapp_6'/2: -require_tailrec_2.m:134: warning: self-recursive call is not tail recursive. -require_tailrec_2.m:141: In `:- pragma require_tail_recursion' for function -require_tailrec_2.m:141: `cons'/2: -require_tailrec_2.m:141: warning: the code defining this function contains no -require_tailrec_2.m:141: recursive calls at all, tail-recursive or otherwise. +require_tailrec_2.m:092: In mode number 1 of function `even1'/1: +require_tailrec_2.m:092: warning: mutually recursive call to function +require_tailrec_2.m:092: `odd1'/1 is not tail recursive. +require_tailrec_2.m:119: In mode number 1 of function `even2'/1: +require_tailrec_2.m:119: error: mutually recursive call to function `odd2'/1 +require_tailrec_2.m:119: is not tail recursive. +require_tailrec_2.m:142: In mode number 1 of function `even3'/1: +require_tailrec_2.m:142: warning: mutually recursive call to function +require_tailrec_2.m:142: `odd3'/1 is not tail recursive. +require_tailrec_2.m:164: In mode number 1 of predicate `qsort_1'/2: +require_tailrec_2.m:164: warning: self-recursive call is not tail recursive. +require_tailrec_2.m:187: In mode number 1 of predicate `qsort_3'/2: +require_tailrec_2.m:187: warning: self-recursive call is not tail recursive. +require_tailrec_2.m:198: In mode number 1 of predicate `qsort_4'/2: +require_tailrec_2.m:198: error: self-recursive call is not tail recursive. +require_tailrec_2.m:209: In mode number 1 of predicate `qsort_5'/2: +require_tailrec_2.m:209: warning: self-recursive call is not tail recursive. +require_tailrec_2.m:220: In mode number 1 of predicate `qsort_6'/2: +require_tailrec_2.m:220: warning: self-recursive call is not tail recursive. +require_tailrec_2.m:232: In mode number 1 of predicate `qsort_7'/2: +require_tailrec_2.m:232: error: self-recursive call is not tail recursive. +require_tailrec_2.m:256: In `:- pragma require_tail_recursion' for function +require_tailrec_2.m:256: `cons'/2: +require_tailrec_2.m:256: error: the code defining this function contains no +require_tailrec_2.m:256: recursive calls at all, tail-recursive or otherwise. diff --git a/tests/invalid/require_tailrec_2.err_exp2 b/tests/invalid/require_tailrec_2.err_exp2 index 90427ace9..6adf560c0 100644 --- a/tests/invalid/require_tailrec_2.err_exp2 +++ b/tests/invalid/require_tailrec_2.err_exp2 @@ -1,31 +1,43 @@ -require_tailrec_2.m:049: In mode number 1 of predicate `map1'/3: -require_tailrec_2.m:049: warning: self-recursive call is not tail recursive. -require_tailrec_2.m:056: In mode number 1 of predicate `map2'/3: -require_tailrec_2.m:056: warning: self-recursive call is not tail recursive. -require_tailrec_2.m:064: In mode number 1 of function `even1'/1: -require_tailrec_2.m:064: warning: mutually recursive call to function -require_tailrec_2.m:064: `odd1'/1 is not tail recursive. -require_tailrec_2.m:073: In mode number 1 of function `odd1'/1: -require_tailrec_2.m:073: warning: mutually recursive call to function -require_tailrec_2.m:073: `even1'/1 is tail recursive, but tail recursion -require_tailrec_2.m:073: optimization cannot be applied to it, because the -require_tailrec_2.m:073: callee cannot reach the caller via tail calls only. -require_tailrec_2.m:073: The MLDS backend can optimize only *mutual* tail -require_tailrec_2.m:073: recursion; it cannot optimize tail recursion if it -require_tailrec_2.m:073: goes only one way between two procedures. -require_tailrec_2.m:089: In mode number 1 of predicate `qsortapp_1'/2: -require_tailrec_2.m:089: warning: self-recursive call is not tail recursive. -require_tailrec_2.m:098: In mode number 1 of predicate `qsortapp_2'/2: -require_tailrec_2.m:098: warning: self-recursive call is not tail recursive. -require_tailrec_2.m:107: In mode number 1 of predicate `qsortapp_3'/2: -require_tailrec_2.m:107: warning: self-recursive call is not tail recursive. -require_tailrec_2.m:116: In mode number 1 of predicate `qsortapp_4'/2: -require_tailrec_2.m:116: error: self-recursive call is not tail recursive. -require_tailrec_2.m:125: In mode number 1 of predicate `qsortapp_5'/2: -require_tailrec_2.m:125: warning: self-recursive call is not tail recursive. -require_tailrec_2.m:134: In mode number 1 of predicate `qsortapp_6'/2: -require_tailrec_2.m:134: warning: self-recursive call is not tail recursive. -require_tailrec_2.m:141: In `:- pragma require_tail_recursion' for function -require_tailrec_2.m:141: `cons'/2: -require_tailrec_2.m:141: warning: the code defining this function contains no -require_tailrec_2.m:141: recursive calls at all, tail-recursive or otherwise. +require_tailrec_2.m:092: In mode number 1 of function `even1'/1: +require_tailrec_2.m:092: warning: mutually recursive call to function +require_tailrec_2.m:092: `odd1'/1 is not tail recursive. +require_tailrec_2.m:105: In mode number 1 of function `odd1'/1: +require_tailrec_2.m:105: warning: mutually recursive call to function +require_tailrec_2.m:105: `even1'/1 is tail recursive, but tail recursion +require_tailrec_2.m:105: optimization cannot be applied to it, because the +require_tailrec_2.m:105: callee cannot reach the caller via tail calls only. +require_tailrec_2.m:105: The MLDS backend can optimize only *mutual* tail +require_tailrec_2.m:105: recursion; it cannot optimize tail recursion if it +require_tailrec_2.m:105: goes only one way between two procedures. +require_tailrec_2.m:119: In mode number 1 of function `even2'/1: +require_tailrec_2.m:119: error: mutually recursive call to function `odd2'/1 +require_tailrec_2.m:119: is not tail recursive. +require_tailrec_2.m:128: In mode number 1 of function `odd2'/1: +require_tailrec_2.m:128: warning: mutually recursive call to function +require_tailrec_2.m:128: `even2'/1 is tail recursive, but tail recursion +require_tailrec_2.m:128: optimization cannot be applied to it, because the +require_tailrec_2.m:128: callee cannot reach the caller via tail calls only. +require_tailrec_2.m:142: In mode number 1 of function `even3'/1: +require_tailrec_2.m:142: warning: mutually recursive call to function +require_tailrec_2.m:142: `odd3'/1 is not tail recursive. +require_tailrec_2.m:151: In mode number 1 of function `odd3'/1: +require_tailrec_2.m:151: warning: mutually recursive call to function +require_tailrec_2.m:151: `even3'/1 is tail recursive, but tail recursion +require_tailrec_2.m:151: optimization cannot be applied to it, because the +require_tailrec_2.m:151: callee cannot reach the caller via tail calls only. +require_tailrec_2.m:164: In mode number 1 of predicate `qsort_1'/2: +require_tailrec_2.m:164: warning: self-recursive call is not tail recursive. +require_tailrec_2.m:187: In mode number 1 of predicate `qsort_3'/2: +require_tailrec_2.m:187: warning: self-recursive call is not tail recursive. +require_tailrec_2.m:198: In mode number 1 of predicate `qsort_4'/2: +require_tailrec_2.m:198: error: self-recursive call is not tail recursive. +require_tailrec_2.m:209: In mode number 1 of predicate `qsort_5'/2: +require_tailrec_2.m:209: warning: self-recursive call is not tail recursive. +require_tailrec_2.m:220: In mode number 1 of predicate `qsort_6'/2: +require_tailrec_2.m:220: warning: self-recursive call is not tail recursive. +require_tailrec_2.m:232: In mode number 1 of predicate `qsort_7'/2: +require_tailrec_2.m:232: error: self-recursive call is not tail recursive. +require_tailrec_2.m:256: In `:- pragma require_tail_recursion' for function +require_tailrec_2.m:256: `cons'/2: +require_tailrec_2.m:256: error: the code defining this function contains no +require_tailrec_2.m:256: recursive calls at all, tail-recursive or otherwise. diff --git a/tests/invalid/require_tailrec_2.err_exp3 b/tests/invalid/require_tailrec_2.err_exp3 index dbfc8f1bd..5f81a0591 100644 --- a/tests/invalid/require_tailrec_2.err_exp3 +++ b/tests/invalid/require_tailrec_2.err_exp3 @@ -1,24 +1,6 @@ -require_tailrec_2.m:049: In mode number 1 of predicate `map1'/3: -require_tailrec_2.m:049: warning: self-recursive call is not tail recursive. -require_tailrec_2.m:056: In mode number 1 of predicate `map2'/3: -require_tailrec_2.m:056: warning: self-recursive call is not tail recursive. -require_tailrec_2.m:089: In mode number 1 of predicate `qsortapp_1'/2: -require_tailrec_2.m:089: warning: self-recursive call is not tail recursive. -require_tailrec_2.m:098: In mode number 1 of predicate `qsortapp_2'/2: -require_tailrec_2.m:098: warning: self-recursive call is not tail recursive. -require_tailrec_2.m:107: In mode number 1 of predicate `qsortapp_3'/2: -require_tailrec_2.m:107: warning: self-recursive call is not tail recursive. -require_tailrec_2.m:116: In mode number 1 of predicate `qsortapp_4'/2: -require_tailrec_2.m:116: error: self-recursive call is not tail recursive. -require_tailrec_2.m:125: In mode number 1 of predicate `qsortapp_5'/2: -require_tailrec_2.m:125: warning: self-recursive call is not tail recursive. -require_tailrec_2.m:134: In mode number 1 of predicate `qsortapp_6'/2: -require_tailrec_2.m:134: warning: self-recursive call is not tail recursive. -require_tailrec_2.m:141: In `:- pragma require_tail_recursion' for function -require_tailrec_2.m:141: `cons'/2: -require_tailrec_2.m:141: warning: the code defining this function contains no -require_tailrec_2.m:141: recursive calls at all, tail-recursive or otherwise. -require_tailrec_2.m:152: In mode number 1 of predicate `partition'/6: -require_tailrec_2.m:152: warning: self-recursive call is not tail recursive. -require_tailrec_2.m:154: In mode number 1 of predicate `partition'/6: -require_tailrec_2.m:154: warning: self-recursive call is not tail recursive. +require_tailrec_2.m:232: In mode number 1 of predicate `qsort_7'/2: +require_tailrec_2.m:232: error: self-recursive call is not tail recursive. +require_tailrec_2.m:256: In `:- pragma require_tail_recursion' for function +require_tailrec_2.m:256: `cons'/2: +require_tailrec_2.m:256: error: the code defining this function contains no +require_tailrec_2.m:256: recursive calls at all, tail-recursive or otherwise. diff --git a/tests/invalid/require_tailrec_2.m b/tests/invalid/require_tailrec_2.m index c0d9e1be7..3e0b404ad 100644 --- a/tests/invalid/require_tailrec_2.m +++ b/tests/invalid/require_tailrec_2.m @@ -1,12 +1,14 @@ %---------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et % -% Tests of `pragma require_tail_recursion' with -% `--warn-non-tail-recursion self'. +% The .exp file is for LLDS grades that allow tail recursion. +% The .exp2 file is for MLDS grades that allow tail recursion. +% The .exp3 file is for grades without tail recursion (.debug, .profdeep). % -% The .exp file is for non-deep-profiling LLDS grades. -% The .exp3 file is for deep profiling LLDS grades. -% The .exp2 file is for MLDS grades. +% This is a copy of the require_tailrec_a test case. Whereas that test case +% contains pragmas that positively request warnings or errors, this test case +% is compiled with --warn-non-tail-recursion self-and-mutual, and uses pragmas +% either to disable warnings, or to turn them into errors. % %---------------------------------------------------------------------------% @@ -18,45 +20,71 @@ :- import_module int. :- import_module list. +%---------------------------------------------------------------------------% + :- pred map1(pred(X, Y), list(X), list(Y)). :- mode map1(pred(in, out) is det, in, out) is det. :- pred map2(pred(X, Y), list(X), list(Y)). :- mode map2(pred(in, out) is det, in, out) is det. +%---------------------------------------------------------------------------% + :- func even1(int) = bool. :- func odd1(int) = bool. +:- func even2(int) = bool. +:- func odd2(int) = bool. + +:- func even3(int) = bool. +:- func odd3(int) = bool. + %---------------------------------------------------------------------------% -:- 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. +:- pred qsort_1(list(int)::in, list(int)::out) is det. +:- pred qsort_2(list(int)::in, list(int)::out) is det. +:- pred qsort_3(list(int)::in, list(int)::out) is det. +:- pred qsort_4(list(int)::in, list(int)::out) is det. +:- pred qsort_5(list(int)::in, list(int)::out) is det. +:- pred qsort_6(list(int)::in, list(int)::out) is det. +:- pred qsort_7(list(int)::in, list(int)::out) is det. + +%---------------------------------------------------------------------------% :- func cons(X, list(X)) = list(X). %---------------------------------------------------------------------------% - :- implementation. +%---------------------------------------------------------------------------% + + % WAS: Self non-tail recursion with self_recursion_only pragma. + % +:- pragma disable_non_tail_recursion_reports(pred(map1/3)). -% self non-tail recursion with no pragma map1(_, [], []). map1(P, [X | Xs], [Y | Ys]) :- P(X, Y), map1(P, Xs, Ys). -% self non-tail recursion with self pragma -:- pragma require_tail_recursion(map2/3, [self_or_mutual_recursion]). + % WAS: Self non-tail recursion with self_or_mutual_recursion pragma. + % +:- pragma disable_non_tail_recursion_reports(map2/3). + map2(_, [], []). map2(P, [X | Xs], [Y | Ys]) :- P(X, Y), map2(P, Xs, Ys). -% mutual non-tail recursion with mutual pragma -:- pragma require_tail_recursion(even1/1, [self_or_mutual_recursion]). +%---------------------------------------------------------------------------% +% NOTE Without the noinline pragmas below, the compiler could generate +% somewhat different diagnostic messages at higher optimization levels. +%---------------------------------------------------------------------------% + + % Mutual non-tail recursion with self_or_mutual_recursion pragma. + % +% :- pragma require_tail_recursion(func(even1/1), [self_or_mutual_recursion]). +:- pragma no_inline(even1/1). + even1(N) = ( if N = 0 then yes @@ -64,8 +92,12 @@ even1(N) = bool.not(odd1(N)) ). -% mutual tail recursion with mutual pragma, this does not raise an error. -:- pragma require_tail_recursion(odd1/1, [self_or_mutual_recursion]). + % Mutual tail recursion with self_or_mutual_recursion pragma. + % This should get a diagnostic ONLY in MLDS grades. + % +% :- pragma require_tail_recursion(odd1/1, [self_or_mutual_recursion]). +:- pragma no_inline(odd1/1). + odd1(N) = ( if N = 0 then no @@ -73,76 +105,135 @@ odd1(N) = even1(N - 1) ). -% Suppress inlining of calls to even1 into odd1 and vice versa at higher -% optimisation levels, as that would affect the warning messages produced. -:- pragma no_inline(even1/1). -:- pragma no_inline(odd1/1). +%---------------------% + + % A repeat of even1/1, but asking for an error, not a warning. + % +:- pragma require_tail_recursion(even2/1, [error, self_or_mutual_recursion]). +:- pragma no_inline(even2/1). + +even2(N) = + ( if N = 0 then + yes + else + bool.not(odd2(N)) + ). + +:- pragma no_inline(odd2/1). + +odd2(N) = + ( if N = 0 then + no + else + even2(N - 1) + ). + +%---------------------% + + % A repeat of even1/1, but not specifying the severity. + % +% :- pragma require_tail_recursion(func(even3/1)). +:- pragma no_inline(even3/1). + +even3(N) = + ( if N = 0 then + yes + else + bool.not(odd3(N)) + ). + +:- pragma no_inline(odd3/1). + +odd3(N) = + ( if N = 0 then + no + else + even3(N - 1) + ). %---------------------------------------------------------------------------% -:- pragma require_tail_recursion(qsortapp_1/2). + % Test the default operation of this pragma. + % +% :- pragma require_tail_recursion(qsort_1/2). -qsortapp_1([], []). -qsortapp_1([Pivot | T], List) :- +qsort_1([], []). +qsort_1([Pivot | T], List) :- partition(Pivot, T, [], Left0, [], Right0), - qsortapp_1(Left0, Left), - qsortapp_1(Right0, Right), + qsort_1(Left0, Left), + qsort_1(Right0, Right), append(Left, [Pivot | Right], List). -:- pragma require_tail_recursion(qsortapp_2/2, []). + % Test the default operation of this pragma when the relevant call + % is in a scope when where the relevant warning is disabled. + % +% :- pragma require_tail_recursion(qsort_2/2, []). -qsortapp_2([], []). -qsortapp_2([Pivot | T], List) :- +qsort_2([], []). +qsort_2([Pivot | T], List) :- partition(Pivot, T, [], Left0, [], Right0), - qsortapp_2(Left0, Left), - qsortapp_2(Right0, Right), + qsort_2(Left0, Left), + disable_warnings [non_tail_recursive_calls] qsort_2(Right0, Right), append(Left, [Pivot | Right], List). -:- pragma require_tail_recursion(qsortapp_3/2, [warn]). + % Test the warn option. + % +% :- pragma require_tail_recursion(qsort_3/2, [warn]). -qsortapp_3([], []). -qsortapp_3([Pivot | T], List) :- +qsort_3([], []). +qsort_3([Pivot | T], List) :- partition(Pivot, T, [], Left0, [], Right0), - qsortapp_3(Left0, Left), - qsortapp_3(Right0, Right), + qsort_3(Left0, Left), + qsort_3(Right0, Right), append(Left, [Pivot | Right], List). -:- pragma require_tail_recursion(qsortapp_4/2, [error]). + % Test the error option. + % +:- pragma require_tail_recursion(qsort_4/2, [error]). -qsortapp_4([], []). -qsortapp_4([Pivot | T], List) :- +qsort_4([], []). +qsort_4([Pivot | T], List) :- partition(Pivot, T, [], Left0, [], Right0), - qsortapp_4(Left0, Left), - qsortapp_4(Right0, Right), + qsort_4(Left0, Left), + qsort_4(Right0, Right), append(Left, [Pivot | Right], List). -:- pragma require_tail_recursion(qsortapp_5/2, [self_recursion_only]). + % Test (sort-of) the self_recursion_only option. + % +% :- pragma require_tail_recursion(qsort_5/2, [self_recursion_only]). -qsortapp_5([], []). -qsortapp_5([Pivot | T], List) :- +qsort_5([], []). +qsort_5([Pivot | T], List) :- partition(Pivot, T, [], Left0, [], Right0), - qsortapp_5(Left0, Left), - qsortapp_5(Right0, Right), + qsort_5(Left0, Left), + qsort_5(Right0, Right), append(Left, [Pivot | Right], List). -:- pragma require_tail_recursion(qsortapp_6/2, [self_or_mutual_recursion]). + % Test (sort-of) the self_or_mutual_recursion option. + % +% :- pragma require_tail_recursion(qsort_6/2, [self_or_mutual_recursion]). -qsortapp_6([], []). -qsortapp_6([Pivot | T], List) :- +qsort_6([], []). +qsort_6([Pivot | T], List) :- partition(Pivot, T, [], Left0, [], Right0), - qsortapp_6(Left0, Left), - qsortapp_6(Right0, Right), + qsort_6(Left0, Left), + qsort_6(Right0, Right), append(Left, [Pivot | Right], List). -%---------------------------------------------------------------------------% + % Test the in_all_grades option. + % +:- pragma require_tail_recursion(qsort_7/2, + [error, in_all_grades, self_or_mutual_recursion]). -% Adding a tail recursion pragma to something that is not recursive is an -% error. -:- pragma require_tail_recursion(cons/2). -cons(X, Xs) = [X | Xs]. - -%---------------------------------------------------------------------------% +qsort_7([], []). +qsort_7([Pivot | T], List) :- + partition(Pivot, T, [], Left0, [], Right0), + qsort_7(Left0, Left), + qsort_7(Right0, Right), + append(Left, [Pivot | Right], List). + % Auxiliary predicate for the qsort_N predicates above. + % :- pred partition(int::in, list(int)::in, list(int)::in, list(int)::out, list(int)::in, list(int)::out) is det. @@ -153,3 +244,17 @@ partition(Pivot, [H | T], Left0, Left, Right0, Right) :- else partition(Pivot, T, Left0, Left, [H | Right0], Right) ). + +%---------------------------------------------------------------------------% + +% Adding this pragma to a non-recursive function is an error. +% +% This test case is expected to fail, generating useful diagnostics +% in grades that DO support tail recursion, we need it to also fail +% in grades that do NOT support tail recursion. The "in_all_grades" option +% is here to ensure just that. +:- pragma require_tail_recursion(func(cons/2), [in_all_grades, error]). + +cons(X, Xs) = [X | Xs]. + +%---------------------------------------------------------------------------% diff --git a/tests/invalid/require_tailrec_3.err_exp b/tests/invalid/require_tailrec_3.err_exp deleted file mode 100644 index b2a7a180e..000000000 --- a/tests/invalid/require_tailrec_3.err_exp +++ /dev/null @@ -1,9 +0,0 @@ -require_tailrec_3.m:038: In mode number 1 of function `even1'/1: -require_tailrec_3.m:038: warning: mutually recursive call to function -require_tailrec_3.m:038: `odd1'/1 is not tail recursive. -require_tailrec_3.m:053: In mode number 1 of function `even2'/1: -require_tailrec_3.m:053: error: mutually recursive call to function `odd2'/1 -require_tailrec_3.m:053: is not tail recursive. -require_tailrec_3.m:068: In mode number 1 of function `even3'/1: -require_tailrec_3.m:068: warning: mutually recursive call to function -require_tailrec_3.m:068: `odd3'/1 is not tail recursive. diff --git a/tests/invalid/require_tailrec_3.err_exp2 b/tests/invalid/require_tailrec_3.err_exp2 deleted file mode 100644 index b635c734a..000000000 --- a/tests/invalid/require_tailrec_3.err_exp2 +++ /dev/null @@ -1,25 +0,0 @@ -require_tailrec_3.m:038: In mode number 1 of function `even1'/1: -require_tailrec_3.m:038: warning: mutually recursive call to function -require_tailrec_3.m:038: `odd1'/1 is not tail recursive. -require_tailrec_3.m:044: In mode number 1 of function `odd1'/1: -require_tailrec_3.m:044: warning: mutually recursive call to function -require_tailrec_3.m:044: `even1'/1 is tail recursive, but tail recursion -require_tailrec_3.m:044: optimization cannot be applied to it, because the -require_tailrec_3.m:044: callee cannot reach the caller via tail calls only. -require_tailrec_3.m:053: In mode number 1 of function `even2'/1: -require_tailrec_3.m:053: error: mutually recursive call to function `odd2'/1 -require_tailrec_3.m:053: is not tail recursive. -require_tailrec_3.m:059: In mode number 1 of function `odd2'/1: -require_tailrec_3.m:059: warning: mutually recursive call to function -require_tailrec_3.m:059: `even2'/1 is tail recursive, but tail recursion -require_tailrec_3.m:059: optimization cannot be applied to it, because the -require_tailrec_3.m:059: callee cannot reach the caller via tail calls only. -require_tailrec_3.m:068: In mode number 1 of function `even3'/1: -require_tailrec_3.m:068: warning: mutually recursive call to function -require_tailrec_3.m:068: `odd3'/1 is not tail recursive. -require_tailrec_3.m:074: In mode number 1 of function `odd3'/1: -require_tailrec_3.m:074: warning: mutually recursive call to function -require_tailrec_3.m:074: `even3'/1 is tail recursive, but tail recursion -require_tailrec_3.m:074: optimization cannot be applied to it, because the -require_tailrec_3.m:074: callee cannot reach the caller via tail calls only. -For more information, recompile with `-E'. diff --git a/tests/invalid/require_tailrec_3.err_exp3 b/tests/invalid/require_tailrec_3.err_exp3 deleted file mode 100644 index 6f0b419c9..000000000 --- a/tests/invalid/require_tailrec_3.err_exp3 +++ /dev/null @@ -1,18 +0,0 @@ -require_tailrec_3.m:038: In mode number 1 of function `even1'/1: -require_tailrec_3.m:038: warning: mutually recursive call to function -require_tailrec_3.m:038: `odd1'/1 is not tail recursive. -require_tailrec_3.m:044: In mode number 1 of function `odd1'/1: -require_tailrec_3.m:044: warning: mutually recursive call to function -require_tailrec_3.m:044: `even1'/1 is not tail recursive. -require_tailrec_3.m:053: In mode number 1 of function `even2'/1: -require_tailrec_3.m:053: error: mutually recursive call to function `odd2'/1 -require_tailrec_3.m:053: is not tail recursive. -require_tailrec_3.m:059: In mode number 1 of function `odd2'/1: -require_tailrec_3.m:059: warning: mutually recursive call to function -require_tailrec_3.m:059: `even2'/1 is not tail recursive. -require_tailrec_3.m:068: In mode number 1 of function `even3'/1: -require_tailrec_3.m:068: warning: mutually recursive call to function -require_tailrec_3.m:068: `odd3'/1 is not tail recursive. -require_tailrec_3.m:074: In mode number 1 of function `odd3'/1: -require_tailrec_3.m:074: warning: mutually recursive call to function -require_tailrec_3.m:074: `even3'/1 is not tail recursive. diff --git a/tests/invalid/require_tailrec_3.m b/tests/invalid/require_tailrec_3.m deleted file mode 100644 index 02e7d8072..000000000 --- a/tests/invalid/require_tailrec_3.m +++ /dev/null @@ -1,86 +0,0 @@ -%---------------------------------------------------------------------------% -% vim: ft=mercury ts=4 sw=4 et -% -% Tests of `pragma require_tail_recursion' with -% `--warn-non-tail-recursion self-and-mutual'. -% -% The .exp file is for non-deep-profiling LLDS grades. -% The .exp3 file is for deep profiling LLDS grades. -% The .exp2 file is for MLDS grades. -% -%---------------------------------------------------------------------------% - -:- module require_tailrec_3. - -:- interface. - -:- import_module bool. -:- import_module int. - -:- func even1(int) = bool. -:- func odd1(int) = bool. - -:- func even2(int) = bool. -:- func odd2(int) = bool. - -:- func even3(int) = bool. -:- func odd3(int) = bool. - -%---------------------------------------------------------------------------% - -:- implementation. - -% mutual non-tail recursion with no pragma -even1(N) = - ( if N = 0 then - yes - else - bool.not(odd1(N)) - ). -odd1(N) = - ( if N = 0 then - no - else - even1(N - 1) - ). - -% mutual non-tail recursion with mutual pragma -:- pragma require_tail_recursion(even2/1, [error, self_or_mutual_recursion]). -even2(N) = - ( if N = 0 then - yes - else - bool.not(odd2(N)) - ). -odd2(N) = - ( if N = 0 then - no - else - even2(N - 1) - ). - -% mutual non-tail recursion with default pragma -:- pragma require_tail_recursion(even3/1). -even3(N) = - ( if N = 0 then - yes - else - bool.not(odd3(N)) - ). -odd3(N) = - ( if N = 0 then - no - else - even3(N - 1) - ). - -% Suppress inlining of calls to evenN into oddN and vice versa at higher -% optimisation levels, as that would affect the warning messages produced. -:- pragma no_inline(even1/1). -:- pragma no_inline(odd1/1). - -:- pragma no_inline(even2/1). -:- pragma no_inline(odd2/1). - -:- pragma no_inline(even3/1). -:- pragma no_inline(odd3/1). diff --git a/tests/invalid_nodepend/require_tailrec_invalid.err_exp b/tests/invalid_nodepend/require_tailrec_invalid.err_exp index f1f6bb90c..d8983dd95 100644 --- a/tests/invalid_nodepend/require_tailrec_invalid.err_exp +++ b/tests/invalid_nodepend/require_tailrec_invalid.err_exp @@ -20,26 +20,22 @@ require_tailrec_invalid.m:034: Error: conflicting require_tailrec_invalid.m:034: `:- pragma require_tail_recursion' attributes: require_tailrec_invalid.m:034: `error' conflicts with earlier attribute require_tailrec_invalid.m:034: `warn'. -require_tailrec_invalid.m:037: Error: conflicting -require_tailrec_invalid.m:037: `:- pragma require_tail_recursion' attributes: -require_tailrec_invalid.m:037: `none' conflicts with earlier attribute -require_tailrec_invalid.m:037: `warn'. -require_tailrec_invalid.m:040: Error: conflicting -require_tailrec_invalid.m:040: `:- pragma require_tail_recursion' attributes: -require_tailrec_invalid.m:040: `none' conflicts with earlier attribute -require_tailrec_invalid.m:040: `error'. +require_tailrec_invalid.m:037: Error: expected a +require_tailrec_invalid.m:037: `:- pragma require_tail_recursion' attribute, +require_tailrec_invalid.m:037: got `none'. +require_tailrec_invalid.m:040: Error: expected a +require_tailrec_invalid.m:040: `:- pragma require_tail_recursion' attribute, +require_tailrec_invalid.m:040: got `none'. require_tailrec_invalid.m:044: Error: conflicting require_tailrec_invalid.m:044: `:- pragma require_tail_recursion' attributes: require_tailrec_invalid.m:044: `self_recursion_only' conflicts with earlier require_tailrec_invalid.m:044: attribute `self_or_mutual_recursion'. -require_tailrec_invalid.m:047: Error: conflicting -require_tailrec_invalid.m:047: `:- pragma require_tail_recursion' attributes: -require_tailrec_invalid.m:047: `none' conflicts with earlier attribute -require_tailrec_invalid.m:047: `self_or_mutual_recursion'. -require_tailrec_invalid.m:051: Error: conflicting -require_tailrec_invalid.m:051: `:- pragma require_tail_recursion' attributes: -require_tailrec_invalid.m:051: `none' conflicts with earlier attribute -require_tailrec_invalid.m:051: `self_recursion_only'. +require_tailrec_invalid.m:048: Error: expected a +require_tailrec_invalid.m:048: `:- pragma require_tail_recursion' attribute, +require_tailrec_invalid.m:048: got `none'. +require_tailrec_invalid.m:051: Error: expected a +require_tailrec_invalid.m:051: `:- pragma require_tail_recursion' attribute, +require_tailrec_invalid.m:051: got `none'. require_tailrec_invalid.m:055: Error: expected a require_tailrec_invalid.m:055: `:- pragma require_tail_recursion' attribute, require_tailrec_invalid.m:055: got `blahblahblah'. @@ -55,14 +51,9 @@ require_tailrec_invalid.m:064: In the second argument of require_tailrec_invalid.m:064: `:- pragma require_tail_recursion' require_tailrec_invalid.m:064: declaration: require_tailrec_invalid.m:064: error: expected list of attributes, got `23'. -require_tailrec_invalid.m:071: Error: conflicting -require_tailrec_invalid.m:071: `:- pragma require_tail_recursion' attributes: -require_tailrec_invalid.m:071: `none' conflicts with earlier attribute -require_tailrec_invalid.m:071: `self_recursion_only'. -require_tailrec_invalid.m:071: Error: conflicting -require_tailrec_invalid.m:071: `:- pragma require_tail_recursion' attributes: -require_tailrec_invalid.m:071: `none' conflicts with earlier attribute -require_tailrec_invalid.m:071: `warn'. +require_tailrec_invalid.m:071: Error: expected a +require_tailrec_invalid.m:071: `:- pragma require_tail_recursion' attribute, +require_tailrec_invalid.m:071: got `none'. require_tailrec_invalid.m:072: Error: expected a require_tailrec_invalid.m:072: `:- pragma require_tail_recursion' attribute, require_tailrec_invalid.m:072: got `grasshopper'. diff --git a/tests/invalid_nodepend/require_tailrec_invalid.m b/tests/invalid_nodepend/require_tailrec_invalid.m index 543b564ae..72e82c615 100644 --- a/tests/invalid_nodepend/require_tailrec_invalid.m +++ b/tests/invalid_nodepend/require_tailrec_invalid.m @@ -64,9 +64,9 @@ :- 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) +% 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_impl.m, but this predicate is rejected earlier (parse_pragma.m) % due to the bad attribute list. :- pragma require_tail_recursion(length_nonexistent/3, [none, warn, self_recursion_only, grasshopper]). diff --git a/tests/valid/require_tailrec_1.m b/tests/valid/require_tailrec_1.m index e9082b540..808218d7d 100644 --- a/tests/valid/require_tailrec_1.m +++ b/tests/valid/require_tailrec_1.m @@ -42,8 +42,8 @@ foldl1(P, [X | Xs], !Acc) :- P(X, !Acc), foldl1(P, Xs, !Acc). -% self non-tail recursive code with none pragma. -:- pragma require_tail_recursion(pred(map1/3), [none]). +% self non-tail recursive code with reports disabled. +:- pragma disable_non_tail_recursion_reports(pred(map1/3)). map1(_, [], []). map1(P, [X | Xs], [Y | Ys]) :- P(X, Y), @@ -64,8 +64,8 @@ odd1(N) = bool.not(even1(N)) ). -% mutual non-tail recursion with none pragma. -:- pragma require_tail_recursion(func(odd2/1), [none]). +% mutual non-tail recursion with reports disabled. +:- pragma disable_non_tail_recursion_reports(func(odd2/1)). even2(N) = ( if N = 0 then yes @@ -97,7 +97,7 @@ odd3(N) = %---------------------------------------------------------------------------% -:- pragma require_tail_recursion(pred(qsortapp/2), [none]). +:- pragma disable_non_tail_recursion_reports(pred(qsortapp/2)). qsortapp([], []). qsortapp([Pivot | T], List) :- diff --git a/tests/valid/require_tailrec_2.m b/tests/valid/require_tailrec_2.m index 2c6b815a9..e4640dc47 100644 --- a/tests/valid/require_tailrec_2.m +++ b/tests/valid/require_tailrec_2.m @@ -64,8 +64,8 @@ foldl1(P, [X | Xs], !Acc) :- P(X, !Acc), foldl1(P, Xs, !Acc). -% self tail recursive code with none pragma. -:- pragma require_tail_recursion(foldl2/4, [none]). +% self tail recursive code with reports disabled. +:- pragma disable_non_tail_recursion_reports(foldl2/4). foldl2(_, [], !Acc). foldl2(P, [X | Xs], !Acc) :- P(X, !Acc), @@ -85,14 +85,14 @@ foldl4(P, [X | Xs], !Acc) :- P(X, !Acc), foldl4(P, Xs, !Acc). -% Self non-tail recursive code with no pragma +% Self non-tail recursive code with no pragma. map1(_, [], []). map1(P, [X | Xs], [Y | Ys]) :- P(X, Y), map1(P, Xs, Ys). -% Self non-tail recursive code with none pragma -:- pragma require_tail_recursion(map2/3, [none]). +% Self non-tail recursive code with reports disabled. +:- pragma disable_non_tail_recursion_reports(map2/3). map2(_, [], []). map2(P, [X | Xs], [Y | Ys]) :- P(X, Y), @@ -112,15 +112,15 @@ odd1(N) = even1(N - 1) ). -% Mutual tail recursion with none pragma. -:- pragma require_tail_recursion(even2/1, [none]). +% Mutual tail recursion with reports disabled. +:- pragma disable_non_tail_recursion_reports(even2/1). even2(N) = ( if N = 0 then yes else odd2(N - 1) ). -:- pragma require_tail_recursion(odd2/1, [none]). +:- pragma disable_non_tail_recursion_reports(odd2/1). odd2(N) = ( if N = 0 then no @@ -128,7 +128,7 @@ odd2(N) = even2(N - 1) ). -% Mutual tail recursion with none pragma. +% Mutual tail recursion. :- pragma require_tail_recursion(even3/1, [self_or_mutual_recursion]). even3(N) = ( if N = 0 then @@ -156,7 +156,7 @@ odd4(N) = bool.not(even4(N)) ). -:- pragma require_tail_recursion(even5/1, [none]). +:- pragma disable_non_tail_recursion_reports(even5/1). even5(N) = ( if N = 0 then yes @@ -187,7 +187,7 @@ odd6(N) = %---------------------------------------------------------------------------% -:- pragma require_tail_recursion(qsortapp/2, [none]). +:- pragma disable_non_tail_recursion_reports(qsortapp/2). qsortapp([], []). qsortapp([Pivot | T], List) :- diff --git a/tests/valid/require_tailrec_3.m b/tests/valid/require_tailrec_3.m index d674e7b1a..aa1a464d2 100644 --- a/tests/valid/require_tailrec_3.m +++ b/tests/valid/require_tailrec_3.m @@ -54,8 +54,8 @@ odd1(N) = even1(N) ). -% mutual tail recursion with none pragma. -:- pragma require_tail_recursion(even2/1, [none]). +% mutual tail recursion with reports disabled. +:- pragma disable_non_tail_recursion_reports(even2/1). even2(N) = ( if N = 0 then yes @@ -80,8 +80,8 @@ even3(N) = odd3(N - 1) ). -% mutual non-tail recursion with none pragma. -:- pragma require_tail_recursion(odd3/1, [none]). +% mutual non-tail recursion with reports disabled. +:- pragma disable_non_tail_recursion_reports(odd3/1). odd3(N) = ( if N = 0 then no