mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-15 17:33:38 +00:00
Code Issues Projects Releases Wiki Activity

Improve error messages about missing predicates.

Browse Source 
compiler/make_hlds_error.m:
    When printing an error message about a predicate or function with
    a given name and arity not being found, print the arities for which
    there *is* a predicate or function with that name.

compiler/hlds_error_util.m:
    Provide utility predicates to find the arities with which a name exists.

compiler/typecheck_errors.m:
    Delete the code that is now one of the utility predicates in
    hlds_error_util.m.

compiler/add_foreign_proc.m:
compiler/add_pragma.m:
compiler/add_pragma_type_spec.m:
    When reporting that a foreign_proc or pragma specifies a nonexistent
    predicate or function, tell make_hlds_error.m about the arities
    that the programmer may have meant to put next to the pred or func name.

    When generating error messages about something defined in the current
    module, don't module qualify its name, since the message is unambiguous
    without, and its presence is just clutter for readers.

    In add_pragma.m, when printing an error message about the pragma being
    added being incompatible with previous pragmas, specify their kinds.

compiler/hlds_pred.m:
    Export the fact that the pred_markers type is implemented as a set.
    In more than 20 years, we have never exploited the fact that this type
    was abstract, and I don't think we would in the next 20 :-) The export
    simplifies new code in add_pragma.m.

compiler/hlds_out_pred.m:
    Add a comment reminding future updaters of some code of a requirement
    placed on it by new code in add_pragma.m.

tests/invalid/bad_consider_used.err_exp:
tests/invalid/inline_conflict.err_exp:
tests/invalid/require_tailrec_invalid.err_exp:
tests/invalid/type_spec.err_exp:
tests/invalid_purity/purity_nonsense2.err_exp:
    Expect error messages with the changes listed above.
This commit is contained in:
Zoltan Somogyi
2017-09-22 05:04:34 +10:00
parent 69dbd420d9
commit 68f0bbf83a
13 changed files with 267 additions and 183 deletions
Download Patch File Download Diff File Expand all files Collapse all files

25
compiler/add_foreign_proc.m
View File

@@ -67,18 +67,24 @@ add_pragma_foreign_proc_export(MaybeAttrs, FPEInfo, Context,
!ModuleInfo, !Specs) :-
FPEInfo = pragma_info_foreign_proc_export(Lang, PrednameModesPF,
ExportedName),
PrednameModesPF = pred_name_modes_pf(Name, Modes, PredOrFunc),
PrednameModesPF = pred_name_modes_pf(PredSymName, Modes, PredOrFunc),
module_info_get_predicate_table(!.ModuleInfo, PredTable),
list.length(Modes, Arity),
predicate_table_lookup_pf_sym_arity(PredTable, may_be_partially_qualified,
PredOrFunc, Name, Arity, PredIds),
PredOrFunc, PredSymName, Arity, PredIds),
(
PredIds = [],
(
MaybeAttrs = item_origin_user,
report_undefined_pred_or_func_error(Name, Arity, Context,
[pragma_decl("foreign_export"), words("declaration")],
!Specs)
predicate_table_lookup_pf_sym(PredTable,
may_be_partially_qualified, PredOrFunc, PredSymName,
AllArityPredIds),
module_info_get_preds(!.ModuleInfo, Preds),
find_pred_arities_other_than(Preds, AllArityPredIds, Arity,
OtherArities),
DescPieces = [pragma_decl("foreign_export"), words("declaration")],
report_undefined_pred_or_func_error(PredSymName, Arity,
OtherArities, Context, DescPieces, !Specs)
;
MaybeAttrs = item_origin_compiler(CompilerAttrs),
% We do not warn about errors in export pragmas created by
@@ -94,7 +100,7 @@ add_pragma_foreign_proc_export(MaybeAttrs, FPEInfo, Context,
;
PredIds = [PredId],
add_pragma_foreign_proc_export_2(Arity, PredTable, MaybeAttrs,
Lang, Name, PredId, Modes, ExportedName, Context,
Lang, PredSymName, PredId, Modes, ExportedName, Context,
!ModuleInfo, !Specs)
;
PredIds = [_, _ | _],
@@ -122,8 +128,9 @@ add_pragma_foreign_proc_export(MaybeAttrs, FPEInfo, Context,
prog_context::in, module_info::in, module_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
add_pragma_foreign_proc_export_2(Arity, PredTable, MaybeAttrs, Lang, Name,
PredId, Modes, ExportedName, Context, !ModuleInfo, !Specs) :-
add_pragma_foreign_proc_export_2(Arity, PredTable, MaybeAttrs, Lang,
PredSymName, PredId, Modes, ExportedName, Context,
!ModuleInfo, !Specs) :-
predicate_table_get_preds(PredTable, Preds),
map.lookup(Preds, PredId, PredInfo),
pred_info_get_proc_table(PredInfo, Procs),
@@ -185,7 +192,7 @@ add_pragma_foreign_proc_export_2(Arity, PredTable, MaybeAttrs, Lang, Name,
else
(
MaybeAttrs = item_origin_user,
report_undefined_mode_error(Name, Arity, Context,
report_undefined_mode_error(PredSymName, Arity, Context,
[pragma_decl("foreign_export"), words("declaration")],
!Specs)
;

279
compiler/add_pragma.m
View File

@@ -106,6 +106,9 @@
:- include_module hlds.make_hlds.add_pragma.add_pragma_type_spec.
:- import_module hlds.hlds_code_util.
:- import_module hlds.hlds_error_util.
:- import_module hlds.hlds_out.
:- import_module hlds.hlds_out.hlds_out_pred.
:- import_module hlds.hlds_pred.
:- import_module hlds.make_hlds.add_foreign_proc.
:- import_module hlds.make_hlds.add_pragma.add_foreign_enum.
@@ -257,7 +260,7 @@ add_pass_2_pragma(SectionItem, !ModuleInfo, !Specs) :-
;
Pragma = pragma_external_proc(ExternalInfo),
% XXX STATUS Check ItemMercuryStatus
ExternalInfo = pragma_info_external_proc(PredName, Arity, PorF,
ExternalInfo = pragma_info_external_proc(PredSymName, Arity, PorF,
MaybeBackend),
module_info_get_globals(!.ModuleInfo, Globals),
CurrentBackend = lookup_current_backend(Globals),
@@ -275,12 +278,16 @@ add_pass_2_pragma(SectionItem, !ModuleInfo, !Specs) :-
(
PorF = pf_predicate,
predicate_table_lookup_pred_sym_arity(PredicateTable0,
is_fully_qualified, PredName, Arity, PredIds),
is_fully_qualified, PredSymName, Arity, PredIds),
predicate_table_lookup_pred_sym(PredicateTable0,
is_fully_qualified, PredSymName, AllArityPredIds),
MissingPieces = [decl("external_pred"), words("pragma")]
;
PorF = pf_function,
predicate_table_lookup_func_sym_arity(PredicateTable0,
is_fully_qualified, PredName, Arity, PredIds),
is_fully_qualified, PredSymName, Arity, PredIds),
predicate_table_lookup_func_sym(PredicateTable0,
is_fully_qualified, PredSymName, AllArityPredIds),
MissingPieces = [decl("external_func"), words("pragma")]
),
(
@@ -288,31 +295,34 @@ add_pass_2_pragma(SectionItem, !ModuleInfo, !Specs) :-
list.foldl(mark_pred_as_external, PredIds, !ModuleInfo)
;
PredIds = [],
report_undefined_pred_or_func_error(PredName, Arity, Context,
MissingPieces, !Specs)
module_info_get_preds(!.ModuleInfo, PredTable0),
find_pred_arities_other_than(PredTable0, AllArityPredIds,
Arity, OtherArities),
report_undefined_pred_or_func_error(PredSymName, Arity,
OtherArities, Context, MissingPieces, !Specs)
)
else
true
)
;
Pragma = pragma_inline(PredNameArity),
PredNameArity = pred_name_arity(Name, Arity),
Pragma = pragma_inline(PredSymNameArity),
item_mercury_status_to_pred_status(ItemMercuryStatus, PredStatus),
add_pred_marker("inline", Name, Arity, PredStatus, Context,
marker_user_marked_inline, [marker_user_marked_no_inline],
% Note that mode_check_inline conflicts with inline because
% it implies no_inline.
add_pred_marker("inline", PredSymNameArity, PredStatus, Context,
marker_user_marked_inline,
[marker_user_marked_no_inline, marker_mode_check_clauses],
!ModuleInfo, !Specs)
;
Pragma = pragma_no_inline(PredNameArity),
PredNameArity = pred_name_arity(Name, Arity),
Pragma = pragma_no_inline(PredSymNameArity),
item_mercury_status_to_pred_status(ItemMercuryStatus, PredStatus),
add_pred_marker("no_inline", Name, Arity, PredStatus, Context,
add_pred_marker("no_inline", PredSymNameArity, PredStatus, Context,
marker_user_marked_no_inline, [marker_user_marked_inline],
!ModuleInfo, !Specs)
;
Pragma = pragma_consider_used(PredNameArity),
PredNameArity = pred_name_arity(Name, Arity),
Pragma = pragma_consider_used(PredSymNameArity),
item_mercury_status_to_pred_status(ItemMercuryStatus, PredStatus),
add_pred_marker("consider_used", Name, Arity, PredStatus, Context,
add_pred_marker("consider_used", PredSymNameArity, PredStatus, Context,
marker_consider_used, [], !ModuleInfo, !Specs)
;
% Used for inter-module unused argument elimination.
@@ -377,15 +387,13 @@ add_pass_2_pragma(SectionItem, !ModuleInfo, !Specs) :-
)
;
Pragma = pragma_obsolete(PredNameArity),
PredNameArity = pred_name_arity(Name, Arity),
item_mercury_status_to_pred_status(ItemMercuryStatus, PredStatus),
add_pred_marker("obsolete", Name, Arity, PredStatus,
add_pred_marker("obsolete", PredNameArity, PredStatus,
Context, marker_obsolete, [], !ModuleInfo, !Specs)
;
Pragma = pragma_no_detism_warning(PredNameArity),
PredNameArity = pred_name_arity(Name, Arity),
item_mercury_status_to_pred_status(ItemMercuryStatus, PredStatus),
add_pred_marker("no_determinism_warning", Name, Arity, PredStatus,
add_pred_marker("no_determinism_warning", PredNameArity, PredStatus,
Context, marker_no_detism_warning, [], !ModuleInfo, !Specs)
;
Pragma = pragma_require_tail_recursion(TailrecWarningPragma),
@@ -393,51 +401,44 @@ add_pass_2_pragma(SectionItem, !ModuleInfo, !Specs) :-
!ModuleInfo, !Specs)
;
Pragma = pragma_promise_eqv_clauses(PredNameArity),
PredNameArity = pred_name_arity(Name, Arity),
item_mercury_status_to_pred_status(ItemMercuryStatus, PredStatus),
add_pred_marker("promise_equivalent_clauses", Name, Arity,
add_pred_marker("promise_equivalent_clauses", PredNameArity,
PredStatus, Context, marker_promised_equivalent_clauses, [],
!ModuleInfo, !Specs)
;
Pragma = pragma_promise_pure(PredNameArity),
PredNameArity = pred_name_arity(Name, Arity),
item_mercury_status_to_pred_status(ItemMercuryStatus, PredStatus),
add_pred_marker("promise_pure", Name, Arity, PredStatus,
add_pred_marker("promise_pure", PredNameArity, PredStatus,
Context, marker_promised_pure, [], !ModuleInfo, !Specs)
;
Pragma = pragma_promise_semipure(PredNameArity),
PredNameArity = pred_name_arity(Name, Arity),
item_mercury_status_to_pred_status(ItemMercuryStatus, PredStatus),
add_pred_marker("promise_semipure", Name, Arity, PredStatus,
add_pred_marker("promise_semipure", PredNameArity, PredStatus,
Context, marker_promised_semipure, [], !ModuleInfo, !Specs)
;
Pragma = pragma_terminates(PredNameArity),
PredNameArity = pred_name_arity(Name, Arity),
item_mercury_status_to_pred_status(ItemMercuryStatus, PredStatus),
add_pred_marker("terminates", Name, Arity, PredStatus, Context,
add_pred_marker("terminates", PredNameArity, PredStatus, Context,
marker_terminates,
[marker_check_termination, marker_does_not_terminate],
!ModuleInfo, !Specs)
;
Pragma = pragma_does_not_terminate(PredNameArity),
PredNameArity = pred_name_arity(Name, Arity),
item_mercury_status_to_pred_status(ItemMercuryStatus, PredStatus),
add_pred_marker("does_not_terminate", Name, Arity, PredStatus,
add_pred_marker("does_not_terminate", PredNameArity, PredStatus,
Context, marker_does_not_terminate,
[marker_check_termination, marker_terminates], !ModuleInfo, !Specs)
;
Pragma = pragma_check_termination(PredNameArity),
PredNameArity = pred_name_arity(Name, Arity),
item_mercury_status_to_pred_status(ItemMercuryStatus, PredStatus),
add_pred_marker("check_termination", Name, Arity, PredStatus,
add_pred_marker("check_termination", PredNameArity, PredStatus,
Context, marker_check_termination,
[marker_terminates, marker_does_not_terminate],
!ModuleInfo, !Specs)
;
Pragma = pragma_mode_check_clauses(PredNameArity),
PredNameArity = pred_name_arity(Name, Arity),
item_mercury_status_to_pred_status(ItemMercuryStatus, PredStatus),
add_pred_marker("mode_check_clauses", Name, Arity, PredStatus,
add_pred_marker("mode_check_clauses", PredNameArity, PredStatus,
Context, marker_mode_check_clauses, [], !ModuleInfo, !Specs),
% Allowing the predicate to be inlined could lead to code generator
@@ -445,7 +446,7 @@ add_pass_2_pragma(SectionItem, !ModuleInfo, !Specs) :-
% then push other code into the disjunction or switch's branches,
% which would invalidate the instmap_deltas that the mode_check_clauses
% marker prevents the recomputation of.
add_pred_marker("mode_check_clauses", Name, Arity, PredStatus,
add_pred_marker("mode_check_clauses", PredNameArity, PredStatus,
Context, marker_user_marked_no_inline, [marker_user_marked_inline],
!ModuleInfo, !Specs)
;
@@ -466,11 +467,11 @@ add_pass_2_pragma(SectionItem, !ModuleInfo, !Specs) :-
module_info::in, module_info::out) is det.
mark_pred_as_external(PredId, !ModuleInfo) :-
module_info_get_preds(!.ModuleInfo, Preds0),
map.lookup(Preds0, PredId, PredInfo0),
module_info_get_preds(!.ModuleInfo, PredTable0),
map.lookup(PredTable0, PredId, PredInfo0),
pred_info_mark_as_external(PredInfo0, PredInfo),
map.det_update(PredId, PredInfo, Preds0, Preds),
module_info_set_preds(Preds, !ModuleInfo).
map.det_update(PredId, PredInfo, PredTable0, PredTable),
module_info_set_preds(PredTable, !ModuleInfo).
%-----------------------------------------------------------------------------%
@@ -482,8 +483,8 @@ add_pragma_unused_args(UnusedArgsInfo, Context, !ModuleInfo, !Specs) :-
UnusedArgsInfo = pragma_info_unused_args(PredNameArityPFMn, UnusedArgs),
PredNameArityPFMn = pred_name_arity_pf_mn(SymName, Arity, PredOrFunc,
ModeNum),
module_info_get_predicate_table(!.ModuleInfo, Preds),
predicate_table_lookup_pf_sym_arity(Preds, is_fully_qualified,
module_info_get_predicate_table(!.ModuleInfo, PredTable),
predicate_table_lookup_pf_sym_arity(PredTable, is_fully_qualified,
PredOrFunc, SymName, Arity, PredIds),
(
PredIds = [],
@@ -521,8 +522,8 @@ add_pragma_exceptions(ExceptionsInfo, _Context, !ModuleInfo, !Specs) :-
ExceptionsInfo = pragma_info_exceptions(PredNameArityPFMn, ThrowStatus),
PredNameArityPFMn = pred_name_arity_pf_mn(SymName, Arity, PredOrFunc,
ModeNum),
module_info_get_predicate_table(!.ModuleInfo, Preds),
predicate_table_lookup_pf_sym_arity(Preds, is_fully_qualified,
module_info_get_predicate_table(!.ModuleInfo, PredTable),
predicate_table_lookup_pf_sym_arity(PredTable, is_fully_qualified,
PredOrFunc, SymName, Arity, PredIds),
(
PredIds = [PredId],
@@ -554,8 +555,8 @@ add_pragma_trailing_info(TrailingInfo, _Context, !ModuleInfo, !Specs) :-
TrailingStatus),
PredNameArityPFMn = pred_name_arity_pf_mn(SymName, Arity, PredOrFunc,
ModeNum),
module_info_get_predicate_table(!.ModuleInfo, Preds),
predicate_table_lookup_pf_sym_arity(Preds, is_fully_qualified,
module_info_get_predicate_table(!.ModuleInfo, PredTable),
predicate_table_lookup_pf_sym_arity(PredTable, is_fully_qualified,
PredOrFunc, SymName, Arity, PredIds),
(
PredIds = [PredId],
@@ -587,8 +588,8 @@ add_pragma_mm_tabling_info(MMTablingInfo, _Context, !ModuleInfo, !Specs) :-
TablingStatus),
PredNameArityPFMn = pred_name_arity_pf_mn(SymName, Arity, PredOrFunc,
ModeNum),
module_info_get_predicate_table(!.ModuleInfo, Preds),
predicate_table_lookup_pf_sym_arity(Preds, is_fully_qualified,
module_info_get_predicate_table(!.ModuleInfo, PredTable),
predicate_table_lookup_pf_sym_arity(PredTable, is_fully_qualified,
PredOrFunc, SymName, Arity, PredIds),
(
PredIds = [PredId],
@@ -618,16 +619,17 @@ add_pragma_mm_tabling_info(MMTablingInfo, _Context, !ModuleInfo, !Specs) :-
add_pragma_require_tail_recursion(Pragma, Context, !ModuleInfo, !Specs) :-
Pragma ^ rtr_proc_id =
pred_name_arity_mpf_mmode(Name, Arity, _MaybePF, MaybeMode),
get_matching_pred_ids(!.ModuleInfo, Name, Arity, PredIds),
pred_name_arity_mpf_mmode(PredSymName, Arity, _MaybePF, MaybeMode),
get_matching_pred_ids(!.ModuleInfo, PredSymName, Arity,
PredIds, OtherArities),
(
PredIds = [],
Pieces = [pragma_decl("require_tail_recursion"), words("pragma")],
report_undefined_pred_or_func_error(Name, Arity, Context, Pieces,
!Specs)
report_undefined_pred_or_func_error(PredSymName, Arity, OtherArities,
Context, Pieces, !Specs)
;
PredIds = [PredId],
NameAndArity = sym_name_arity(Name, Arity),
PredSymNameArity = sym_name_arity(PredSymName, Arity),
module_info_pred_info(!.ModuleInfo, PredId, PredInfo0),
pred_info_get_proc_table(PredInfo0, Procs0),
@@ -654,10 +656,10 @@ add_pragma_require_tail_recursion(Pragma, Context, !ModuleInfo, !Specs) :-
map.lookup(Procs0, ProcId, Proc),
add_pragma_require_tail_recursion_proc(
Pragma ^ rtr_require_tailrec, Context,
NameAndArity, ProcId - Proc, PredInfo0, PredInfo, !Specs)
PredSymNameArity, ProcId - Proc, PredInfo0, PredInfo, !Specs)
else
Pieces = [words("Error: no such mode for"),
qual_sym_name_and_arity(NameAndArity), words("in"),
qual_sym_name_and_arity(PredSymNameArity), words("in"),
pragma_decl("require_tail_recursion"),
words("pragma."), nl],
Msg = simple_msg(Context, [always(Pieces)]),
@@ -668,8 +670,9 @@ add_pragma_require_tail_recursion(Pragma, Context, !ModuleInfo, !Specs) :-
)
;
MaybeMode = no,
list.foldl2(add_pragma_require_tail_recursion_proc(
Pragma ^ rtr_require_tailrec, Context, NameAndArity),
list.foldl2(
add_pragma_require_tail_recursion_proc(
Pragma ^ rtr_require_tailrec, Context, PredSymNameArity),
Procs, PredInfo0, PredInfo, !Specs)
),
module_info_set_pred_info(PredId, PredInfo, !ModuleInfo)
@@ -715,34 +718,54 @@ add_pragma_require_tail_recursion_proc(RequireTailrec, Context,
%-----------------------------------------------------------------------------%
% add_pred_marker(PragmaName, Name, Arity, Status,
% Context, Marker, ConflictMarkers, !ModuleInfo, !Specs):
% add_pred_marker(PragmaName, PredNameArity, Status, Context,
% Marker, ConflictMarkers, !ModuleInfo, !Specs):
%
% Adds Marker to the marker list of the pred(s) with give Name and Arity,
% updating the ModuleInfo. If the named pred does not exist, or the pred
% already has a marker in ConflictMarkers, report an error.
% Adds Marker to the marker list of the pred(s) with the given
% PredNameArity, updating the ModuleInfo. If the named pred does not exist,
% or the pred(s) already has/have a marker in ConflictMarkers,
% report an error.
%
:- pred add_pred_marker(string::in, sym_name::in, arity::in, pred_status::in,
:- pred add_pred_marker(string::in, pred_name_arity::in, pred_status::in,
prog_context::in, pred_marker::in, list(pred_marker)::in,
module_info::in, module_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
add_pred_marker(PragmaName, Name, Arity, Status, Context, Marker,
ConflictMarkers, !ModuleInfo, !Specs) :-
add_pred_marker(PragmaName, PredSymNameArity, Status, Context,
Marker, ConflictMarkers, !ModuleInfo, !Specs) :-
( if marker_must_be_exported(Marker) then
MustBeExported = yes
else
MustBeExported = no
),
do_add_pred_marker(PragmaName, Name, Arity, Status, MustBeExported,
do_add_pred_marker(PragmaName, PredSymNameArity, Status, MustBeExported,
Context, add_marker_pred_info(Marker), !ModuleInfo, PredIds, !Specs),
module_info_get_preds(!.ModuleInfo, Preds),
pragma_check_markers(Preds, PredIds, ConflictMarkers, Conflict),
module_info_get_preds(!.ModuleInfo, PredTable),
list.map(get_pred_markers(PredTable), PredIds, PredMarkerSets),
PredMarkers = set.union_list(PredMarkerSets),
set.intersect(PredMarkers, set.list_to_set(ConflictMarkers),
ConflictingPredMarkerSet),
set.to_sorted_list(ConflictingPredMarkerSet, ConflictingPredMarkers0),
(
Conflict = yes,
pragma_conflict_error(Name, Arity, Context, PragmaName, !Specs)
ConflictingPredMarkers0 = [_ | _],
( if
list.member(marker_mode_check_clauses, ConflictingPredMarkers0),
list.member(marker_user_marked_no_inline, ConflictingPredMarkers0)
then
% The no_inline marker would have been added implicitly
% for the mode_check_clauses pragma. In the usual case where
% the programmer didn't also add an explicit no_inline pragma,
% mentioning the conflict with no_inline would be more confusing
% than helpful.
list.delete_all(ConflictingPredMarkers0,
marker_user_marked_no_inline, ConflictingPredMarkers)
else
ConflictingPredMarkers = ConflictingPredMarkers0
),
pragma_conflict_error(PredSymNameArity, Context, PragmaName,
ConflictingPredMarkers, !Specs)
;
Conflict = no
ConflictingPredMarkers0 = []
).
% Succeed if a marker for an exported procedure must also be exported.
@@ -755,15 +778,17 @@ marker_must_be_exported(_) :-
:- type add_marker_pred_info == pred(pred_info, pred_info).
:- inst add_marker_pred_info == (pred(in, out) is det).
:- pred do_add_pred_marker(string::in, sym_name::in, arity::in,
:- pred do_add_pred_marker(string::in, pred_name_arity::in,
pred_status::in, bool::in, term.context::in,
add_marker_pred_info::in(add_marker_pred_info),
module_info::in, module_info::out, list(pred_id)::out,
list(error_spec)::in, list(error_spec)::out) is det.
do_add_pred_marker(PragmaName, Name, Arity, Status, MustBeExported, Context,
UpdatePredInfo, !ModuleInfo, PredIds, !Specs) :-
get_matching_pred_ids(!.ModuleInfo, Name, Arity, PredIds),
do_add_pred_marker(PragmaName, PredSymNameArity, Status, MustBeExported,
Context, UpdatePredInfo, !ModuleInfo, PredIds, !Specs) :-
PredSymNameArity = pred_name_arity(PredSymName, Arity),
get_matching_pred_ids(!.ModuleInfo, PredSymName, Arity, PredIds,
OtherArities),
(
PredIds = [_ | _],
module_info_get_predicate_table(!.ModuleInfo, PredTable0),
@@ -773,7 +798,7 @@ do_add_pred_marker(PragmaName, Name, Arity, Status, MustBeExported, Context,
MustBeExported, Preds0, Preds, WrongStatus),
(
WrongStatus = yes,
pragma_status_error(Name, Arity, Context, PragmaName, !Specs)
pragma_status_error(PredSymNameArity, Context, PragmaName, !Specs)
;
WrongStatus = no
),
@@ -783,31 +808,20 @@ do_add_pred_marker(PragmaName, Name, Arity, Status, MustBeExported, Context,
;
PredIds = [],
DescPieces = [pragma_decl(PragmaName), words("declaration")],
report_undefined_pred_or_func_error(Name, Arity, Context, DescPieces,
!Specs)
report_undefined_pred_or_func_error(PredSymName, Arity, OtherArities,
Context, DescPieces, !Specs)
).
% For each pred_id in the list, check whether markers present in the list
% of conflicting markers are also present in the corresponding pred_info.
% The bool indicates whether there was a conflicting marker present.
% The output is a set of the names of the conflicting markers present.
%
:- pred pragma_check_markers(pred_table::in, list(pred_id)::in,
list(pred_marker)::in, bool::out) is det.
:- pred get_pred_markers(pred_table::in, pred_id::in,
set(pred_marker)::out) is det.
pragma_check_markers(_, [], _, no).
pragma_check_markers(PredTable, [PredId | PredIds], ConflictList, Conflict) :-
get_pred_markers(PredTable, PredId, Markers) :-
map.lookup(PredTable, PredId, PredInfo),
pred_info_get_markers(PredInfo, Markers),
( if
some [Marker] (
list.member(Marker, ConflictList),
check_marker(Markers, Marker)
)
then
Conflict = yes
else
pragma_check_markers(PredTable, PredIds, ConflictList, Conflict)
).
pred_info_get_markers(PredInfo, Markers).
% For each pred_id in the list, add the given markers to the
% list of markers in the corresponding pred_info.
@@ -843,40 +857,68 @@ add_marker_pred_info(Marker, !PredInfo) :-
add_marker(Marker, Markers0, Markers),
pred_info_set_markers(Markers, !PredInfo).
% Given a symname and arity, return (in PredIds) the predicates and
% functions with that name and arity. A reference to SymName/Arity
% could have meant any of the entries in PredIds. If PredIds is empty,
% then we will want to generate an error message. This message should
% mention that while given name does not exist with the given arity,
% it does exist with some other arity, so we also return (in OtherArities)
% the arities of all the predicates and functions with that name
% but with some *other* arity.
%
:- pred get_matching_pred_ids(module_info::in, sym_name::in, arity::in,
list(pred_id)::out) is det.
list(pred_id)::out, list(int)::out) is det.
get_matching_pred_ids(Module0, Name, Arity, PredIds) :-
module_info_get_predicate_table(Module0, PredTable0),
get_matching_pred_ids(ModuleInfo, SymName, Arity, PredIds, OtherArities) :-
module_info_get_predicate_table(ModuleInfo, PredTable0),
% Check that the pragma is module qualified.
(
Name = unqualified(_),
SymName = unqualified(_),
unexpected($pred, "unqualified name")
;
Name = qualified(_, _),
SymName = qualified(_, _),
predicate_table_lookup_sym_arity(PredTable0, is_fully_qualified,
Name, Arity, PredIds)
SymName, Arity, PredIds),
(
PredIds = [],
predicate_table_lookup_sym(PredTable0, is_fully_qualified,
SymName, SymOnlyPredIds),
module_info_get_preds(ModuleInfo, Preds0),
find_pred_arities_other_than(Preds0, SymOnlyPredIds,
Arity, OtherArities)
;
PredIds = [_ | _],
% There is no point in filling this in; our caller won't need it.
OtherArities = []
)
).
:- pred pragma_status_error(sym_name::in, int::in, prog_context::in,
:- pred pragma_status_error(pred_name_arity::in, prog_context::in,
string::in, list(error_spec)::in, list(error_spec)::out) is det.
pragma_status_error(Name, Arity, Context, PragmaName, !Specs) :-
pragma_status_error(PredSymNameArity, Context, PragmaName, !Specs) :-
PredSymNameArity = pred_name_arity(PredSymName, Arity),
Pieces = [words("Error:"), pragma_decl(PragmaName),
words("declaration for exported predicate or function"),
unqual_sym_name_and_arity(sym_name_arity(Name, Arity)),
unqual_sym_name_and_arity(sym_name_arity(PredSymName, Arity)),
words("must also be exported."), nl],
Msg = simple_msg(Context, [always(Pieces)]),
Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
!:Specs = [Spec | !.Specs].
:- pred pragma_conflict_error(sym_name::in, int::in, prog_context::in,
string::in, list(error_spec)::in, list(error_spec)::out) is det.
:- pred pragma_conflict_error(pred_name_arity::in, prog_context::in,
string::in, list(pred_marker)::in,
list(error_spec)::in, list(error_spec)::out) is det.
pragma_conflict_error(Name, Arity, Context, PragmaName, !Specs) :-
pragma_conflict_error(PredSymNameArity, Context, PragmaName, ConflictMarkers,
!Specs) :-
PredSymNameArity = pred_name_arity(PredSymName, Arity),
list.map(marker_name, ConflictMarkers, ConflictNames),
Pieces = [words("Error:"), pragma_decl(PragmaName),
words("declaration conflicts with previous pragma for"),
unqual_sym_name_and_arity(sym_name_arity(Name, Arity)),
words("declaration conflicts with previous")] ++
list_to_pieces(ConflictNames) ++
[words(choose_number(ConflictNames, "pragma for", "pragmas for")),
unqual_sym_name_and_arity(sym_name_arity(PredSymName, Arity)),
suffix("."), nl],
Msg = simple_msg(Context, [always(Pieces)]),
Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
@@ -1123,15 +1165,14 @@ add_pass_3_pragma(SectionItem, !ModuleInfo, !QualInfo, !Specs) :-
list(error_spec)::in, list(error_spec)::out) is det.
add_pragma_fact_table(FTInfo, PredStatus, Context, !ModuleInfo, !Specs) :-
FTInfo = pragma_info_fact_table(PredArity, FileName),
PredArity = pred_name_arity(Pred, Arity),
module_info_get_predicate_table(!.ModuleInfo, PredicateTable),
predicate_table_lookup_sym_arity(PredicateTable, is_fully_qualified,
Pred, Arity, PredIds),
FTInfo = pragma_info_fact_table(PredSymNameArity, FileName),
PredSymNameArity = pred_name_arity(PredSymName, Arity),
get_matching_pred_ids(!.ModuleInfo, PredSymName, Arity, PredIds,
OtherArities),
(
PredIds = [],
report_undefined_pred_or_func_error(Pred, Arity, Context,
[pragma_decl("fact_table"), words("declaration")], !Specs)
report_undefined_pred_or_func_error(PredSymName, Arity, OtherArities,
Context, [pragma_decl("fact_table"), words("declaration")], !Specs)
;
PredIds = [HeadPredId | TailPredIds],
(
@@ -1146,7 +1187,7 @@ add_pragma_fact_table(FTInfo, PredStatus, Context, !ModuleInfo, !Specs) :-
some [!IO] (
promise_pure (
semipure io.unsafe_get_io_state(!:IO),
fact_table_compile_facts(Pred, Arity, FileName,
fact_table_compile_facts(PredSymName, Arity, FileName,
PredInfo0, PredInfo, Context, !.ModuleInfo,
C_HeaderCode, PrimaryProcId, !IO),
impure io.unsafe_set_io_state(!.IO)
@@ -1169,12 +1210,12 @@ add_pragma_fact_table(FTInfo, PredStatus, Context, !ModuleInfo, !Specs) :-
% Create foreign_procs to access the table in each mode.
add_fact_table_procedures(ProcIds, PrimaryProcId,
ProcTable, Pred, PredOrFunc, NumArgs, ArgTypes, PredStatus,
Context, !ModuleInfo, !Specs)
ProcTable, PredSymName, PredOrFunc, NumArgs, ArgTypes,
PredStatus, Context, !ModuleInfo, !Specs)
;
TailPredIds = [_ | _], % >1 predicate found
Pieces = [words("In"), quote("pragma fact_table"), words("for"),
qual_sym_name_and_arity(sym_name_arity(Pred, Arity)),
qual_sym_name_and_arity(sym_name_arity(PredSymName, Arity)),
suffix(":"), nl,
words("error: ambiguous predicate/function name."), nl],
Msg = simple_msg(Context, [always(Pieces)]),
@@ -1255,8 +1296,8 @@ add_fact_table_proc(ProcId, PrimaryProcId, ProcTable, SymName,
% The C code for fact tables includes C labels. We cannot inline this code,
% because if we did, the result would be duplicate labels in the generated
% code. So we must disable inlining for fact_table procedures.
add_pred_marker("fact_table", SymName, Arity, PredStatus, Context,
marker_user_marked_no_inline, [], !ModuleInfo, !Specs).
add_pred_marker("fact_table", pred_name_arity(SymName, Arity), PredStatus,
Context, marker_user_marked_no_inline, [], !ModuleInfo, !Specs).
% Create a list(pragma_var) that looks like the ones that are created
% for foreign_procs in the parser.

6
compiler/add_pragma_type_spec.m
View File

@@ -67,8 +67,10 @@ add_pragma_type_spec(TSInfo, Context, !ModuleInfo, !QualInfo, !Specs) :-
),
(
PredIds = [],
report_undefined_pred_or_func_error(SymName, Arity, Context,
[pragma_decl("type_spec"), words("declaration")], !Specs)
% XXX We should compute a valid value for OtherArities.
OtherArities = [],
report_undefined_pred_or_func_error(SymName, Arity, OtherArities,
Context, [pragma_decl("type_spec"), words("declaration")], !Specs)
;
PredIds = [_ | _],
list.foldl3(add_pragma_type_spec_for_pred(TSInfo, Context), PredIds,

43
compiler/hlds_error_util.m
View File

@@ -9,9 +9,9 @@
% File: hlds_error_util.m.
% Main author: zs.
%
% This module contains code that can be helpful in the formatting of
% error messages. It builds upon parse_tree.error_util, and extends it
% with predicates that access HLDS data structures.
% This module contains code that can be helpful in the generation or
% formatting of error messages. It builds upon parse_tree.error_util,
% and extends it with predicates that access HLDS data structures.
%
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -21,6 +21,7 @@
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
:- import_module hlds.pred_table.
:- import_module libs.
:- import_module libs.globals.
:- import_module parse_tree.
@@ -69,6 +70,19 @@
:- func describe_several_call_sites(module_info, should_module_qualify,
assoc_list(pred_proc_id, prog_context)) = list(format_component).
%-----------------------------------------------------------------------------%
% Return the arities that the given pred_ids have.
%
:- pred find_pred_arities(pred_table::in, list(pred_id)::in,
list(arity)::out) is det.
% Return the set of arities that the given pred_ids have,
% other than the given arity.
%
:- pred find_pred_arities_other_than(pred_table::in, list(pred_id)::in,
arity::in, list(arity)::out) is det.
%-----------------------------------------------------------------------------%
%
% Every possible path of execution in mercury_compile.m should call
@@ -127,8 +141,10 @@
:- import_module parse_tree.prog_util.
:- import_module int.
:- import_module map.
:- import_module string.
:- import_module require.
:- import_module set.
:- import_module term.
%-----------------------------------------------------------------------------%
@@ -290,6 +306,27 @@ arg_modes_to_string(InstVarSet, ArgModes) = Str :-
%-----------------------------------------------------------------------------%
find_pred_arities(PredTable, PredIds, Arities) :-
find_pred_arities_set(PredTable, PredIds, AritiesSet),
set.to_sorted_list(AritiesSet, Arities).
find_pred_arities_other_than(PredTable, PredIds, Arity, OtherArities) :-
find_pred_arities_set(PredTable, PredIds, AritiesSet),
set.delete(Arity, AritiesSet, OtherAritiesSet),
set.to_sorted_list(OtherAritiesSet, OtherArities).
:- pred find_pred_arities_set(pred_table::in, list(pred_id)::in,
set(arity)::out) is det.
find_pred_arities_set(_, [], set.init).
find_pred_arities_set(PredTable, [PredId | PredIds], AritiesSet) :-
find_pred_arities_set(PredTable, PredIds, AritiesSet0),
map.lookup(PredTable, PredId, PredInfo),
Arity = pred_info_orig_arity(PredInfo),
set.insert(Arity, AritiesSet0, AritiesSet).
%-----------------------------------------------------------------------------%
definitely_write_out_errors(Globals, !HLDS, Specs, !IO) :-
write_error_specs(Specs, Globals,
0, _NumWarnings, 0, NumErrors, !IO),

2
compiler/hlds_out_pred.m
View File

@@ -1346,6 +1346,8 @@ write_marker(Marker, !IO) :-
marker_name(Marker, Name),
io.write_string(Name, !IO).
% For markers that we add to a predicate because of a pragma on that predicate,
% the marker name MUST correspond to the name of the pragma.
marker_name(marker_stub, "stub").
marker_name(marker_builtin_stub, "builtin_stub").
marker_name(marker_infer_type, "infer_type").

6
compiler/hlds_pred.m
View File

@@ -233,8 +233,8 @@
% Predicates can be marked with various boolean flags, called "markers".
% An abstract set of pred_markers.
:- type pred_markers.
% A set of pred_markers.
:- type pred_markers == set(pred_marker).
:- type pred_marker
---> marker_stub
@@ -1829,8 +1829,6 @@ pred_info_get_sym_name(PredInfo, SymName) :-
%-----------------------------------------------------------------------------%
:- type pred_markers == set(pred_marker).
init_markers(set.init).
check_marker(MarkerSet, Marker) :-

28
compiler/make_hlds_error.m
View File

@@ -31,8 +31,8 @@
prog_context::in, prog_context::in, list(format_component)::in,
list(error_spec)::in, list(error_spec)::out) is det.
:- pred report_undefined_pred_or_func_error(sym_name::in, int::in,
prog_context::in, list(format_component)::in,
:- pred report_undefined_pred_or_func_error(sym_name::in,
arity::in, list(arity)::in, prog_context::in, list(format_component)::in,
list(error_spec)::in, list(error_spec)::out) is det.
% Similar to report_undeclared_mode_error, but gives less information.
@@ -75,6 +75,7 @@
:- import_module bool.
:- import_module set.
:- import_module string.
:- import_module varset.
%-----------------------------------------------------------------------------%
@@ -101,13 +102,24 @@ report_multiple_def_error(Name, Arity, DefType, Context, OrigContext,
[Msg1, Msg2] ++ ExtraMsgs),
!:Specs = [Spec | !.Specs].
report_undefined_pred_or_func_error(Name, Arity, Context, DescPieces,
!Specs) :-
Pieces = [words("Error:") | DescPieces] ++ [words("for"),
qual_sym_name_and_arity(sym_name_arity(Name, Arity)),
report_undefined_pred_or_func_error(Name, Arity, OtherArities, Context,
DescPieces, !Specs) :-
MainPieces = [words("Error:") | DescPieces] ++ [words("for"),
unqual_sym_name_and_arity(sym_name_arity(Name, Arity)),
words("without corresponding"), decl("pred"), words("or"),
decl("func"), words("declaration.")],
Msg = simple_msg(Context, [always(Pieces)]),
decl("func"), words("declaration."), nl],
(
OtherArities = [],
OtherArityPieces = []
;
OtherArities = [_ | _],
list.map(string.int_to_string, OtherArities, OtherArityStrs),
OtherArityPieces = [unqual_sym_name(Name), words("does exist with"),
words(choose_number(OtherArityStrs, "arity", "arities"))] ++
list_to_pieces(OtherArityStrs) ++
[suffix("."), nl]
),
Msg = simple_msg(Context, [always(MainPieces ++ OtherArityPieces)]),
Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
!:Specs = [Spec | !.Specs].

17
compiler/typecheck_errors.m
View File

@@ -221,7 +221,7 @@ report_pred_call_error(ClauseContext, Context, PredCallId) = Spec :-
(
OtherIds = [_ | _],
predicate_table_get_preds(PredicateTable, Preds),
typecheck_find_arities(Preds, OtherIds, Arities),
find_pred_arities(Preds, OtherIds, Arities),
Spec = report_error_pred_num_args(ClauseContext, Context,
PredCallId, Arities)
;
@@ -244,23 +244,12 @@ report_pred_call_error(ClauseContext, Context, PredCallId) = Spec :-
Spec = error_spec(severity_error, phase_type_check, Msgs)
).
:- pred typecheck_find_arities(pred_table::in, list(pred_id)::in,
set(int)::out) is det.
typecheck_find_arities(_, [], set.init).
typecheck_find_arities(Preds, [PredId | PredIds], Arities) :-
typecheck_find_arities(Preds, PredIds, Arities0),
map.lookup(Preds, PredId, PredInfo),
Arity = pred_info_orig_arity(PredInfo),
set.insert(Arity, Arities0, Arities).
:- func report_error_pred_num_args(type_error_clause_context, prog_context,
simple_call_id, set(int)) = error_spec.
simple_call_id, list(int)) = error_spec.
report_error_pred_num_args(ClauseContext, Context, SimpleCallId, AritiesSet)
report_error_pred_num_args(ClauseContext, Context, SimpleCallId, Arities)
= Spec :-
SimpleCallId = simple_call_id(PredOrFunc, SymName, Arity),
set.to_sorted_list(AritiesSet, Arities),
Pieces = in_clause_for_pieces(ClauseContext) ++
[words("error:")] ++
error_num_args_to_pieces(yes(PredOrFunc), Arity, Arities) ++ [nl] ++

13
tests/invalid/bad_consider_used.err_exp
View File

@@ -1,6 +1,7 @@
bad_consider_used.m:032: Error: `:- pragma consider_used' declaration for
bad_consider_used.m:032: `bad_consider_used.q'/3 without corresponding
bad_consider_used.m:032: `:- pred' or `:- func' declaration.
bad_consider_used.m:033: Error: `:- pragma consider_used' declaration for
bad_consider_used.m:033: `bad_consider_used.g'/2 without corresponding
bad_consider_used.m:033: `:- pred' or `:- func' declaration.
bad_consider_used.m:032: Error: `:- pragma consider_used' declaration for `q'/3
bad_consider_used.m:032: without corresponding `:- pred' or `:- func'
bad_consider_used.m:032: declaration.
bad_consider_used.m:032: `q' does exist with arity 2.
bad_consider_used.m:033: Error: `:- pragma consider_used' declaration for `g'/2
bad_consider_used.m:033: without corresponding `:- pred' or `:- func'
bad_consider_used.m:033: declaration.

2
tests/invalid/inline_conflict.err_exp
View File

@@ -1,2 +1,2 @@
inline_conflict.m:019: Error: `:- pragma no_inline' declaration conflicts with
inline_conflict.m:019: previous pragma for `bar'/2.
inline_conflict.m:019: previous inline pragma for `bar'/2.

20
tests/invalid/require_tailrec_invalid.err_exp
View File

@@ -1,19 +1,16 @@
require_tailrec_invalid.m:014: Error: `:- pragma require_tail_recursion'
require_tailrec_invalid.m:014: declaration in module interface.
require_tailrec_invalid.m:021: Error: `:- pragma require_tail_recursion' pragma
require_tailrec_invalid.m:021: for
require_tailrec_invalid.m:021: `require_tailrec_invalid.non_existent_pred'/3
require_tailrec_invalid.m:021: without corresponding `:- pred' or `:- func'
require_tailrec_invalid.m:021: for `non_existent_pred'/3 without
require_tailrec_invalid.m:021: corresponding `:- pred' or `:- func'
require_tailrec_invalid.m:021: declaration.
require_tailrec_invalid.m:022: Error: `:- pragma require_tail_recursion' pragma
require_tailrec_invalid.m:022: for
require_tailrec_invalid.m:022: `require_tailrec_invalid.non_existent_proc'/2
require_tailrec_invalid.m:022: without corresponding `:- pred' or `:- func'
require_tailrec_invalid.m:022: for `non_existent_proc'/2 without
require_tailrec_invalid.m:022: corresponding `:- pred' or `:- func'
require_tailrec_invalid.m:022: declaration.
require_tailrec_invalid.m:023: Error: `:- pragma require_tail_recursion' pragma
require_tailrec_invalid.m:023: for
require_tailrec_invalid.m:023: `require_tailrec_invalid.non_existent_func_proc'/1
require_tailrec_invalid.m:023: without corresponding `:- pred' or `:- func'
require_tailrec_invalid.m:023: for `non_existent_func_proc'/1 without
require_tailrec_invalid.m:023: corresponding `:- pred' or `:- func'
require_tailrec_invalid.m:023: declaration.
require_tailrec_invalid.m:026: Error: no such mode for
require_tailrec_invalid.m:026: `require_tailrec_invalid.length'/2 in
@@ -46,9 +43,8 @@ require_tailrec_invalid.m:050: Error: unrecognised
require_tailrec_invalid.m:050: `:- pragma require_tail_recursion' attribute:
require_tailrec_invalid.m:050: `blahblahblah'.
require_tailrec_invalid.m:054: Error: `:- pragma require_tail_recursion' pragma
require_tailrec_invalid.m:054: for `require_tailrec_invalid.blahblahblah'/0
require_tailrec_invalid.m:054: without corresponding `:- pred' or `:- func'
require_tailrec_invalid.m:054: declaration.
require_tailrec_invalid.m:054: for `blahblahblah'/0 without corresponding
require_tailrec_invalid.m:054: `:- pred' or `:- func' declaration.
require_tailrec_invalid.m:056: Error: expected attribute list for
require_tailrec_invalid.m:056: `:- pragma require_tail_recursion'
require_tailrec_invalid.m:056: declaration, got `Woop'.

5
tests/invalid/type_spec.err_exp
View File

@@ -6,9 +6,8 @@ type_spec.m:014: error: variable `U' does not occur in the `:- pred'
type_spec.m:014: declaration.
type_spec.m:015: Error: `:- pragma type_spec' declaration for
type_spec.m:015: `type_spec.type_spec1'/1 specifies non-existent mode.
type_spec.m:017: Error: `:- pragma type_spec' declaration for
type_spec.m:017: `type_spec.type_spec1'/2 without corresponding `:- pred' or
type_spec.m:017: `:- func' declaration.
type_spec.m:017: Error: `:- pragma type_spec' declaration for `type_spec1'/2
type_spec.m:017: without corresponding `:- pred' or `:- func' declaration.
type_spec.m:026: Error: `:- pragma external_pred' declaration in module
type_spec.m:026: interface.
type_spec.m:028: In `:- pragma type_spec' declaration for predicate

4
tests/invalid_purity/purity_nonsense2.err_exp
View File

@@ -4,8 +4,8 @@ purity_nonsense2.m:010: Syntax error at token 'mode': unexpected token at start
purity_nonsense2.m:010: of (sub)term.
purity_nonsense2.m:012: Error: no clauses for predicate `undefined'/0.
purity_nonsense2.m:014: Error: `:- pragma promise_pure' declaration for
purity_nonsense2.m:014: `purity_nonsense2.undefined2'/0 without corresponding
purity_nonsense2.m:014: `:- pred' or `:- func' declaration.
purity_nonsense2.m:014: `undefined2'/0 without corresponding `:- pred' or
purity_nonsense2.m:014: `:- func' declaration.
purity_nonsense2.m:016: Error: clause for predicate `purity_nonsense2.e12'/0
purity_nonsense2.m:016: without corresponding `:- pred' declaration.
purity_nonsense2.m:017: In clause for predicate `e12'/0: