Files
mercury/compiler/check_pragma_format_call.m
Zoltan Somogyi b560f66ab9 Move four modules from check_hlds.m to hlds.m.
After this, I think all modules in the check_hlds package belong there.

compiler/inst_match.m:
compiler/mode_test.m:
    Move these modules from the check_hlds package to the hlds package
    because most of their uses are outside the semantic analysis passes
    that the check_hlds package is intended to contain.

compiler/inst_merge.m:
    Move this module from the check_hlds package to the hlds package
    because it is imported by only two modules, instmap.m and inst_match.m,
    and after this diff, both are in the hlds package.

compiler/implementation_defined_literals.m:
    Move this module from the check_hlds package to the hlds package
    because it does a straightforward program transformation that
    does not have anything to do with semantic analysis (though its
    invocation does happen between semantic analysis passes).

compiler/notes/compiler_design.html:
    Update the documentation of the goal_path.m module. (I checked the
    documentation of the moved modules, which did not need updates,
    and found the need for this instead.)

compiler/*.m:
    Conform to the changes above. (For many modules, this deletes
    their import of the check_hlds package itself.)
2026-02-27 15:16:44 +11:00

366 lines
16 KiB
Mathematica

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2022-2026 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%---------------------------------------------------------------------------%
%
% This module checks the validity of format_call pragmas for predicates
% in the module being compiled.
%
% Each format_call pragma specifies one or more pairs of argument positions,
% with each pair specifying the position of a format string argument
% and a values list argument. We check whether the arguments in the
% nominated positions
%
% - actually exist,
% - have the expected types, string and list(poly_type) respectively,
% - and are inputs.
%
% In the presence of type and/or mode inference, the second and third checks
% can be done only after type and mode analysis. And the checks must be done
% before the simplification pass at the end of semantic analysis, because
% that is when format_call.m checks calls to predicates with these pragmas,
% using code that relies on them being correct. The code of this module
% is therefore invoked in the interval in between (provided that there are
% any pragmas to check, which usually there won't be).
%
% If any argument fails the checks above, then, besides generating an error
% message for each failure, we delete the argument pair it is a part of.
% In the usual case of a pragma that consists of one argument pair, this
% effectively deletes the pragma. The point is that any argument pairs
% in any pragmas left after this pass will have passed the above checks.
%
%---------------------------------------------------------------------------%
:- module check_hlds.check_pragma_format_call.
:- interface.
:- import_module hlds.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
:- import_module parse_tree.
:- import_module parse_tree.error_spec.
:- import_module list.
:- import_module set.
%---------------------------------------------------------------------------%
:- pred check_pragma_format_call_preds(set(pred_id)::in,
module_info::in, module_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module hlds.hlds_error_util.
:- import_module hlds.mode_test.
:- import_module hlds.status.
:- import_module mdbcomp.
:- import_module mdbcomp.builtin_modules.
:- import_module mdbcomp.prim_data.
:- import_module mdbcomp.sym_name.
:- import_module parse_tree.builtin_lib_types.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_data_pragma.
:- import_module bool.
:- import_module int.
:- import_module map.
:- import_module maybe.
:- import_module one_or_more.
:- import_module pair.
:- import_module require.
%---------------------------------------------------------------------------%
check_pragma_format_call_preds(FormatCallPredIds, !ModuleInfo, !Specs) :-
list.foldl2(check_pragma_format_call_pred,
set.to_sorted_list(FormatCallPredIds), !ModuleInfo, !Specs).
:- pred check_pragma_format_call_pred(pred_id::in,
module_info::in, module_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
check_pragma_format_call_pred(PredId, !ModuleInfo, !Specs) :-
module_info_get_pred_id_table(!.ModuleInfo, PredIdTable0),
( if map.search(PredIdTable0, PredId, PredInfo0) then
pred_info_get_format_call_info(PredInfo0, MaybeFormatCall0),
(
MaybeFormatCall0 = no,
% add_pragma.m should add a pred_id to the set of predicates
% that have a format_call pragma if and only if it also sets
% this field to yes(...).
unexpected($pred, "MaybeFormatCall0 = no")
;
MaybeFormatCall0 = yes(FormatCall0)
),
FormatCall0 = format_call_info(Context, OoMFormatArgs0),
FormatArgs0 = one_or_more_to_list(OoMFormatArgs0),
list.length(FormatArgs0, NumFormatArgs0),
pred_info_get_proc_table(PredInfo0, ProcTable0),
map.to_sorted_assoc_list(ProcTable0, ProcIdsInfos0),
list.length(ProcIdsInfos0, NumProcs),
% Setting the maximum argument number that a format_call pragma
% may refer to be from the *user* arity means that format_call
% pragmas cannot refer to the return values of functions.
% The reason for this is that a function's return value
% is supposed to be output, while the format string and
% values list arguments are supposed to be inputs.
user_arity(MaxArgNum) = pred_info_user_arity(PredInfo0),
pred_info_get_arg_types(PredInfo0, ArgTypes),
check_format_args(!.ModuleInfo, PredInfo0, Context, MaxArgNum,
ArgTypes, NumProcs, ProcIdsInfos0, NumFormatArgs0,
1, FormatArgs0, FormatArgs, !Specs),
(
FormatArgs = [HeadFormatArgs | TailFormatArgs],
OoMFormatArgs = one_or_more(HeadFormatArgs, TailFormatArgs),
FormatCall = format_call_info(Context, OoMFormatArgs),
MaybeFormatCall = yes(FormatCall)
;
FormatArgs = [],
MaybeFormatCall = no
),
pred_info_set_format_call_info(MaybeFormatCall, PredInfo0, PredInfo),
module_info_set_pred_info(PredId, PredInfo, !ModuleInfo)
else
true
).
:- pred check_format_args(module_info::in, pred_info::in, prog_context::in,
int::in, list(mer_type)::in, int::in, list(pair(proc_id, proc_info))::in,
int::in, int::in,
list(format_string_values)::in, list(format_string_values)::out,
list(error_spec)::in, list(error_spec)::out) is det.
check_format_args(_, _, _, _, _, _, _, _, _, [], [], !Specs).
check_format_args(ModuleInfo, PredInfo, Context, MaxArgNum, ArgTypes,
NumProcs, ProcIdsInfos, NumFormatArgs, FormatArgNum,
[HeadFmtStrVals | TailFmtStrVals], OKFmtStrVals, !Specs) :-
check_format_args(ModuleInfo, PredInfo, Context, MaxArgNum, ArgTypes,
NumProcs, ProcIdsInfos, NumFormatArgs, FormatArgNum + 1,
TailFmtStrVals, TailOKFmtStrVals, !Specs),
HeadFmtStrVals = format_string_values(OrigArgNumFS, OrigArgNumVL,
CurArgNumFS, CurArgNumVL),
some [!CurSpecs] (
!:CurSpecs = [],
( if OrigArgNumFS > MaxArgNum then
SpecTooLargeFS = format_call_error_too_large_arg_num(PredInfo,
Context, NumFormatArgs, FormatArgNum, MaxArgNum,
OrigArgNumFS, "first"),
!:CurSpecs = [SpecTooLargeFS | !.CurSpecs]
else if OrigArgNumFS < 1 then
SpecTooSmallFS = format_call_error_too_small_arg_num(PredInfo,
Context, NumFormatArgs, FormatArgNum, OrigArgNumFS, "first"),
!:CurSpecs = [SpecTooSmallFS | !.CurSpecs]
else
list.det_index1(ArgTypes, CurArgNumFS, ArgTypeFS),
( if ArgTypeFS = string_type then
true
else
SpecWrongTypeFS = format_call_error_wrong_type(PredInfo,
Context, NumFormatArgs, FormatArgNum, OrigArgNumFS,
"first", "a format string", "string"),
!:CurSpecs = [SpecWrongTypeFS | !.CurSpecs]
),
list.foldl2(
check_for_non_input_arg_nums_in_proc(ModuleInfo, CurArgNumFS),
ProcIdsInfos, 1, _, [], BadModeNumsFS),
(
BadModeNumsFS = []
;
BadModeNumsFS = [_ | _],
SpecWrongModeFS = format_call_error_wrong_mode(PredInfo,
Context, NumFormatArgs, FormatArgNum, OrigArgNumFS,
"first", "a format string", NumProcs, BadModeNumsFS),
!:CurSpecs = [SpecWrongModeFS | !.CurSpecs]
)
),
( if OrigArgNumVL > MaxArgNum then
SpecTooLargeVL = format_call_error_too_large_arg_num(PredInfo,
Context, NumFormatArgs, FormatArgNum, MaxArgNum,
OrigArgNumVL, "second"),
!:CurSpecs = [SpecTooLargeVL | !.CurSpecs]
else if OrigArgNumVL < 1 then
SpecTooSmallVL = format_call_error_too_small_arg_num(PredInfo,
Context, NumFormatArgs, FormatArgNum, OrigArgNumVL, "second"),
!:CurSpecs = [SpecTooSmallVL | !.CurSpecs]
else
list.det_index1(ArgTypes, CurArgNumVL, ArgTypeVL),
( if
ArgTypeVL = defined_type(ListTypeCtorSymName,
[ListElementType], kind_star),
ListTypeCtorSymName =
qualified(ListTypeCtorModuleName, ListTypeCtorName),
is_std_lib_module_name(ListTypeCtorModuleName, "list"),
ListTypeCtorName = "list",
ListElementType = defined_type(PolyTypeCtorSymName,
[], kind_star),
PolyTypeCtorSymName =
qualified(PolyTypeCtorModuleName, PolyTypeCtorName),
is_std_lib_module_name(PolyTypeCtorModuleName, "string"),
PolyTypeCtorName = "poly_type"
then
true
else
SpecWrongTypeVL = format_call_error_wrong_type(PredInfo,
Context, NumFormatArgs, FormatArgNum, OrigArgNumVL,
"second", "a values list", "list(poly_type)"),
!:CurSpecs = [SpecWrongTypeVL | !.CurSpecs]
),
list.foldl2(
check_for_non_input_arg_nums_in_proc(ModuleInfo, CurArgNumVL),
ProcIdsInfos, 1, _, [], BadModeNumsVL),
(
BadModeNumsVL = []
;
BadModeNumsVL = [_ | _],
SpecWrongModeVL = format_call_error_wrong_mode(PredInfo,
Context, NumFormatArgs, FormatArgNum, OrigArgNumVL,
"second", "a values list", NumProcs, BadModeNumsVL),
!:CurSpecs = [SpecWrongModeVL | !.CurSpecs]
)
),
(
!.CurSpecs = [],
OKFmtStrVals = [HeadFmtStrVals | TailOKFmtStrVals]
;
!.CurSpecs = [_ | _],
pred_info_get_status(PredInfo, PredStatus),
PredIsLocal = pred_status_defined_in_this_module(PredStatus),
(
PredIsLocal = yes,
!:Specs = !.CurSpecs ++ !.Specs
;
PredIsLocal = no
% We *could* report !.CurSpecs, but probably it would add
% only "noise" for the programmer. The problem *will* be
% reported when the module that we imported PredInfo from
% is compiled, and until that module is fixed, the only thing
% the programmer is missing out on is an error message about
% a module that he/she may not be actively working on
% at that moment.
),
OKFmtStrVals = TailOKFmtStrVals
)
).
:- pred check_for_non_input_arg_nums_in_proc(module_info::in,
int::in, pair(proc_id, proc_info)::in, int::in, int::out,
list(int)::in, list(int)::out) is det.
check_for_non_input_arg_nums_in_proc(ModuleInfo, ArgNum, _ProcId - ProcInfo,
!CurModeNum, !BadModeNums) :-
proc_info_get_argmodes(ProcInfo, ArgModes),
list.det_index1(ArgModes, ArgNum, ArgMode),
( if mode_is_input(ModuleInfo, ArgMode) then
true
else
!:BadModeNums = [!.CurModeNum | !.BadModeNums]
),
!:CurModeNum = !.CurModeNum + 1.
%---------------------%
:- func format_call_error_too_large_arg_num(pred_info, prog_context,
int, int, int, int, string) = error_spec.
format_call_error_too_large_arg_num(PredInfo, Context, NumFormatArgs,
FormatArgNum, MaxArgNum, ArgNum, FirstOrSecond) = Spec :-
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
Pieces =
format_call_error_prelude(PredInfo, NumFormatArgs, FormatArgNum) ++
color_as_subject([words("the"), words(FirstOrSecond),
words("argument of"), quote("format_string_values")]) ++
[words("specifies argument number"), int_fixed(ArgNum), suffix(","),
words("but")] ++
color_as_incorrect([words("the"), p_or_f(PredOrFunc),
words("has only"), int_fixed(MaxArgNum), words("arguments.")]) ++
[nl],
Spec = spec($pred, severity_error, phase_pt2h, Context, Pieces).
:- func format_call_error_too_small_arg_num(pred_info, prog_context,
int, int, int, string) = error_spec.
format_call_error_too_small_arg_num(PredInfo, Context, NumFormatArgs,
FormatArgNum, ArgNum, FirstOrSecond) = Spec :-
Pieces =
format_call_error_prelude(PredInfo, NumFormatArgs, FormatArgNum) ++
color_as_subject([words("the"), words(FirstOrSecond),
words("argument of"), quote("format_string_values")]) ++
[words("specifies argument number"), int_fixed(ArgNum), suffix(","),
words("but")] ++
color_as_incorrect([words("argument numbers start at 1.")]) ++
[nl],
Spec = spec($pred, severity_error, phase_pt2h, Context, Pieces).
:- func format_call_error_wrong_type(pred_info, prog_context,
int, int, int, string, string, string) = error_spec.
format_call_error_wrong_type(PredInfo, Context, NumFormatArgs, FormatArgNum,
ArgNum, FirstOrSecond, Role, ExpectedType) = Spec :-
Pieces =
format_call_error_prelude(PredInfo, NumFormatArgs, FormatArgNum) ++
color_as_subject([words("the"), words(FirstOrSecond),
words("argument of"), quote("format_string_values")]) ++
[words("specifies argument number"), int_fixed(ArgNum),
words("as holding"), words(Role), suffix(","), words("but")] ++
color_as_incorrect([words("the type of that argument is not"),
quote(ExpectedType), suffix(".")]) ++
[nl],
Spec = spec($pred, severity_error, phase_pt2h, Context, Pieces).
:- func format_call_error_wrong_mode(pred_info, prog_context,
int, int, int, string, string, int, list(int)) = error_spec.
format_call_error_wrong_mode(PredInfo, Context, NumFormatArgs, FormatArgNum,
ArgNum, FirstOrSecond, Role, NumProcs, BadModeNums) = Spec :-
Pieces0 =
format_call_error_prelude(PredInfo, NumFormatArgs, FormatArgNum) ++
color_as_subject([words("the"), words(FirstOrSecond),
words("argument"), words("of"), quote("format_string_values")]) ++
[words("specifies argument number"), int_fixed(ArgNum),
words("as holding"), words(Role), suffix(",")],
( if NumProcs = 1, BadModeNums = [_] then
Pieces = Pieces0 ++
color_as_incorrect([words("but that argument is not input.")]) ++
[nl]
else
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
list.sort(BadModeNums, SortedBadModeNums),
BadModeNumPieceLists =
list.map((func(N) = [nth_fixed(N)]), SortedBadModeNums),
BadModeNumPieces = pieces_list_to_pieces("and", BadModeNumPieceLists),
Pieces = Pieces0 ++
color_as_incorrect([words("but that argument is not input")]) ++
[words("in the")] ++ BadModeNumPieces ++
[words("modes of the"), p_or_f(PredOrFunc), suffix("."), nl]
),
Spec = spec($pred, severity_error, phase_pt2h, Context, Pieces).
%---------------------%
:- func format_call_error_prelude(pred_info, int, int) = list(format_piece).
format_call_error_prelude(PredInfo, NumFormatArgs, FormatArgNum) = Pieces :-
Pieces0 = [words("Error: in the second argument of"),
pragma_decl("format_call"), words("declaration for")] ++
describe_one_pred_info_name(yes(color_subject),
should_not_module_qualify, [suffix(":")], PredInfo) ++
[nl],
( if FormatArgNum = 1, NumFormatArgs = 1 then
Pieces = Pieces0
else
Pieces = Pieces0 ++ [words("in the"), nth_fixed(FormatArgNum),
words("element of the list:"), nl]
).
%---------------------------------------------------------------------------%
:- end_module check_hlds.check_pragma_format_call.
%---------------------------------------------------------------------------%