mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-17 10:23:46 +00:00
e2a8a8cbfa
compiler/mercury_to_mercury.m:
Delete this module, and replace it with ...
compiler/parse_tree_out_cons_id.m:
compiler/parse_tree_out_sym_name.m:
compiler/parse_tree_out_type.m:
compiler/parse_tree_out_misc.m:
... these four modules. The first three write out the entities
in their names: cons_ids, sym_names, and types. The fourth contains
the rest of the old mercury_to_mercury.m, plus a few predicates
moved there from prog_out.m that deal with indentation.
compiler/parse_tree.m:
Include the four new modules, and stop including the deleted module.
compiler/notes/compiler_design.html:
Document the new modules.
compiler/prog_out.m:
Delete the code moved to parse_tree_out_misc.m.
compiler/*.m:
Adjust the imports as needed. Most modules need only one, maybe two
of mercury_to_mercury's four successor modules.
363 lines
14 KiB
Mathematica
363 lines
14 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 1993-2012 The University of Melbourne.
|
|
% Copyright (C) 2014-2021 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.
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- module check_hlds.typecheck_msgs.
|
|
:- interface.
|
|
|
|
:- import_module hlds.
|
|
:- import_module hlds.hlds_clauses.
|
|
:- 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_tree234.
|
|
|
|
:- func typecheck_report_max_iterations_exceeded(int) = error_spec.
|
|
|
|
% Construct the inferred `pred' or `func' declarations for a list of
|
|
% predicates. Don't construct declarations for the inferred types
|
|
% of predicates that represent assertions.
|
|
%
|
|
:- pred construct_type_inference_messages(module_info::in,
|
|
set_tree234(pred_id)::in, list(pred_id)::in,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
:- pred maybe_check_for_and_report_any_non_contiguous_clauses(module_info::in,
|
|
pred_id::in, pred_info::in, clause_item_numbers::in, list(error_spec)::out)
|
|
is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module hlds.hlds_error_util.
|
|
:- import_module hlds.pred_table.
|
|
:- import_module libs.
|
|
:- import_module libs.globals.
|
|
:- import_module libs.options.
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.prim_data.
|
|
:- import_module mdbcomp.sym_name.
|
|
:- import_module parse_tree.parse_tree_out_pred_decl.
|
|
:- import_module parse_tree.parse_tree_out_type.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.prog_type.
|
|
:- import_module parse_tree.prog_util.
|
|
|
|
:- import_module bool.
|
|
:- import_module edit_seq.
|
|
:- import_module int.
|
|
:- import_module maybe.
|
|
:- import_module string.
|
|
:- import_module varset.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
typecheck_report_max_iterations_exceeded(MaxIterations) = Spec :-
|
|
Pieces = [words("Type inference iteration limit exceeded."),
|
|
words("This probably indicates that your program has a type error."),
|
|
words("You should declare the types explicitly."),
|
|
words("(The current limit is"), int_fixed(MaxIterations),
|
|
words("iterations."),
|
|
words("You can use the"), quote("--type-inference-iteration-limit"),
|
|
words("option to increase the limit)."), nl],
|
|
Spec = simplest_no_context_spec($pred, severity_error, phase_type_check,
|
|
Pieces).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
construct_type_inference_messages(_, _, [], !Specs).
|
|
construct_type_inference_messages(ModuleInfo, ValidPredIdSet,
|
|
[PredId | PredIds], !Specs) :-
|
|
module_info_pred_info(ModuleInfo, PredId, PredInfo),
|
|
pred_info_get_markers(PredInfo, Markers),
|
|
( if
|
|
check_marker(Markers, marker_infer_type),
|
|
set_tree234.contains(ValidPredIdSet, PredId),
|
|
not pred_info_is_promise(PredInfo, _)
|
|
then
|
|
Spec = construct_type_inference_message(ModuleInfo, PredId, PredInfo),
|
|
!:Specs = [Spec | !.Specs]
|
|
else
|
|
true
|
|
),
|
|
construct_type_inference_messages(ModuleInfo, ValidPredIdSet,
|
|
PredIds, !Specs).
|
|
|
|
% Construct a message containing the inferred `pred' or `func' declaration
|
|
% for a single predicate.
|
|
%
|
|
:- func construct_type_inference_message(module_info, pred_id, pred_info)
|
|
= error_spec.
|
|
|
|
construct_type_inference_message(ModuleInfo, PredId, PredInfo) = Spec :-
|
|
PredName = pred_info_name(PredInfo),
|
|
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
|
|
UnqualPredSymName = unqualified(PredName),
|
|
pred_info_get_context(PredInfo, Context),
|
|
pred_info_get_arg_types(PredInfo, VarSet, ExistQVars, Types0),
|
|
strip_module_names_from_type_list(strip_builtin_module_name,
|
|
Types0, Types),
|
|
pred_info_get_class_context(PredInfo, ClassContext),
|
|
pred_info_get_purity(PredInfo, Purity),
|
|
MaybeDet = no,
|
|
VarNamePrint = print_name_only,
|
|
(
|
|
PredOrFunc = pf_predicate,
|
|
ArgTypes = Types,
|
|
MaybeReturnType = no,
|
|
TypeStr = mercury_pred_type_to_string(VarSet, VarNamePrint, ExistQVars,
|
|
UnqualPredSymName, Types, MaybeDet, Purity, ClassContext)
|
|
;
|
|
PredOrFunc = pf_function,
|
|
pred_args_to_func_args(Types, ArgTypes, ReturnType),
|
|
MaybeReturnType = yes(ReturnType),
|
|
TypeStr = mercury_func_type_to_string(VarSet, VarNamePrint, ExistQVars,
|
|
UnqualPredSymName, ArgTypes, ReturnType, MaybeDet, Purity,
|
|
ClassContext)
|
|
),
|
|
InferredPieces = [invis_order_default_start(2),
|
|
words("Inferred"), words(TypeStr), nl],
|
|
|
|
module_info_get_predicate_table(ModuleInfo, PredicateTable),
|
|
ModuleName = pred_info_module(PredInfo),
|
|
QualPredSymName = qualified(ModuleName, PredName),
|
|
predicate_table_lookup_pf_sym(PredicateTable, is_fully_qualified,
|
|
PredOrFunc, QualPredSymName, AllPredIds),
|
|
list.delete_all(AllPredIds, PredId, AllOtherPredIds),
|
|
PredIsDeclared =
|
|
( pred(OtherPredId::in) is semidet :-
|
|
module_info_pred_info(ModuleInfo, OtherPredId, OtherPredInfo),
|
|
pred_info_get_markers(OtherPredInfo, OtherPredMarkers),
|
|
not check_marker(OtherPredMarkers, marker_infer_type)
|
|
),
|
|
list.filter(PredIsDeclared, AllOtherPredIds, AllOtherDeclaredPredIds),
|
|
(
|
|
AllOtherDeclaredPredIds = [],
|
|
Spec = conditional_spec($pred, inform_inferred_types, yes,
|
|
severity_informational, phase_type_check,
|
|
[simplest_msg(Context, InferredPieces)])
|
|
;
|
|
AllOtherDeclaredPredIds = [_ | _],
|
|
list.map(
|
|
construct_pred_decl_diff(ModuleInfo, ArgTypes, MaybeReturnType),
|
|
AllOtherDeclaredPredIds, DiffPieceLists),
|
|
Pieces = [invis_order_default_start(2)] ++ InferredPieces ++
|
|
list.condense(DiffPieceLists),
|
|
Spec = simplest_spec($pred, severity_informational, phase_type_check,
|
|
Context, Pieces)
|
|
).
|
|
|
|
:- pred construct_pred_decl_diff(module_info::in,
|
|
list(mer_type)::in, maybe(mer_type)::in, pred_id::in,
|
|
list(format_piece)::out) is det.
|
|
|
|
construct_pred_decl_diff(ModuleInfo, ActualArgTypes, MaybeActualReturnType,
|
|
OtherPredId, Pieces) :-
|
|
module_info_pred_info(ModuleInfo, OtherPredId, OtherPredInfo),
|
|
pred_info_get_arg_types(OtherPredInfo, OtherTypes),
|
|
% It would be nice if we could print the names of type variables,
|
|
% but there are two problems. The lesser problem is that the names
|
|
% may be different in the varsets of the two predicates, which may be
|
|
% confusing. The more deadly problem is that a type variable that
|
|
% exists in one of the varsets may not exist in the other.
|
|
% Therefore printing variable numbers is the best thing we can do,
|
|
% as a general case. (We *could* do better in the special case
|
|
% where neither problem arises.)
|
|
varset.init(TVarSet),
|
|
(
|
|
MaybeActualReturnType = no,
|
|
list.length(OtherTypes, OtherArity),
|
|
pred_decl_lines(TVarSet, ActualArgTypes, ActualLines),
|
|
pred_decl_lines(TVarSet, OtherTypes, OtherLines)
|
|
;
|
|
MaybeActualReturnType = yes(ActualReturnType),
|
|
pred_args_to_func_args(OtherTypes, OtherArgTypes, OtherReturnType),
|
|
list.length(OtherArgTypes, OtherArity),
|
|
func_decl_lines(TVarSet, ActualArgTypes, ActualReturnType,
|
|
ActualLines),
|
|
func_decl_lines(TVarSet, OtherArgTypes, OtherReturnType,
|
|
OtherLines)
|
|
),
|
|
EditParams = edit_params(1, 1, 2), % cost(replace) = cost(delete + insert).
|
|
find_shortest_edit_seq(EditParams, OtherLines, ActualLines, EditSeq),
|
|
find_diff_seq(OtherLines, EditSeq, DiffSeq),
|
|
DiffPieceLists = list.map(diff_to_pieces, DiffSeq),
|
|
list.condense(DiffPieceLists, DiffPieces),
|
|
Pieces = [words("The argument list difference from the arity"),
|
|
int_fixed(OtherArity), words("version is"), nl] ++ DiffPieces.
|
|
|
|
:- func diff_to_pieces(diff(string)) = list(format_piece).
|
|
|
|
diff_to_pieces(Diff) = Pieces :-
|
|
(
|
|
Diff = unchanged(Line),
|
|
Char = " "
|
|
;
|
|
Diff = deleted(Line),
|
|
Char = "-"
|
|
;
|
|
Diff = inserted(Line),
|
|
Char = "+"
|
|
),
|
|
Pieces = [fixed(Char ++ " " ++ Line), nl].
|
|
|
|
:- pred pred_decl_lines(tvarset::in, list(mer_type)::in,
|
|
list(string)::out) is det.
|
|
|
|
pred_decl_lines(TVarSet, ArgTypes, Lines) :-
|
|
( if list.split_last(ArgTypes, NonLastArgTypes, LastArgType) then
|
|
arg_decl_lines("pred", TVarSet, NonLastArgTypes, LastArgType, "",
|
|
Lines)
|
|
else
|
|
Lines = ["pred"]
|
|
).
|
|
|
|
:- pred func_decl_lines(tvarset::in, list(mer_type)::in, mer_type::in,
|
|
list(string)::out) is det.
|
|
|
|
func_decl_lines(TVarSet, ArgTypes, ReturnType, Lines) :-
|
|
ReturnTypeStr =
|
|
mercury_type_to_string(TVarSet, print_num_only, ReturnType),
|
|
ReturnTypeSuffix = " = " ++ ReturnTypeStr,
|
|
( if list.split_last(ArgTypes, NonLastArgTypes, LastArgType) then
|
|
arg_decl_lines("func", TVarSet, NonLastArgTypes, LastArgType,
|
|
ReturnTypeSuffix, Lines)
|
|
else
|
|
Lines = ["func" ++ ReturnTypeSuffix]
|
|
).
|
|
|
|
:- pred arg_decl_lines(string::in, tvarset::in,
|
|
list(mer_type)::in, mer_type::in, string::in, list(string)::out) is det.
|
|
|
|
arg_decl_lines(PredOrFuncStr, TVarSet, NonLastArgTypes, LastArgType, Suffix,
|
|
Lines) :-
|
|
NonLastArgTypeStrs = list.map(
|
|
mercury_type_to_string(TVarSet, print_num_only), NonLastArgTypes),
|
|
AddComma =
|
|
(func(NonLastArgTypeStr) = one_indent ++ NonLastArgTypeStr ++ ","),
|
|
NonLastArgTypeLines = list.map(AddComma, NonLastArgTypeStrs),
|
|
LastArgTypeStr =
|
|
mercury_type_to_string(TVarSet, print_num_only, LastArgType),
|
|
Lines = [PredOrFuncStr ++ "("] ++
|
|
NonLastArgTypeLines ++
|
|
[one_indent ++ LastArgTypeStr,
|
|
")" ++ Suffix].
|
|
|
|
:- func one_indent = string.
|
|
|
|
one_indent = " ".
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
maybe_check_for_and_report_any_non_contiguous_clauses(ModuleInfo,
|
|
PredId, PredInfo, ItemNumbers, Specs) :-
|
|
module_info_get_globals(ModuleInfo, Globals),
|
|
globals.lookup_bool_option(Globals, warn_non_contiguous_foreign_procs,
|
|
WarnNonContiguousForeignProcs),
|
|
(
|
|
WarnNonContiguousForeignProcs = yes,
|
|
Specs = report_any_non_contiguous_clauses(ModuleInfo,
|
|
PredId, PredInfo, ItemNumbers, clauses_and_foreign_procs)
|
|
;
|
|
WarnNonContiguousForeignProcs = no,
|
|
globals.lookup_bool_option(Globals, warn_non_contiguous_clauses,
|
|
WarnNonContiguousClauses),
|
|
(
|
|
WarnNonContiguousClauses = yes,
|
|
Specs = report_any_non_contiguous_clauses(ModuleInfo,
|
|
PredId, PredInfo, ItemNumbers, only_clauses)
|
|
;
|
|
WarnNonContiguousClauses = no,
|
|
Specs = []
|
|
)
|
|
).
|
|
|
|
:- func report_any_non_contiguous_clauses(module_info, pred_id, pred_info,
|
|
clause_item_numbers, clause_item_number_types) = list(error_spec).
|
|
|
|
report_any_non_contiguous_clauses(ModuleInfo, PredId, PredInfo, ItemNumbers,
|
|
NumberTypes) = Specs :-
|
|
( if
|
|
clauses_are_non_contiguous(ItemNumbers, NumberTypes,
|
|
FirstRegion, SecondRegion, LaterRegions)
|
|
then
|
|
Spec = report_non_contiguous_clauses(ModuleInfo, PredId,
|
|
PredInfo, FirstRegion, SecondRegion, LaterRegions),
|
|
Specs = [Spec]
|
|
else
|
|
Specs = []
|
|
).
|
|
|
|
:- func report_non_contiguous_clauses(module_info, pred_id, pred_info,
|
|
clause_item_number_region, clause_item_number_region,
|
|
list(clause_item_number_region)) = error_spec.
|
|
|
|
report_non_contiguous_clauses(ModuleInfo, PredId, PredInfo,
|
|
FirstRegion, SecondRegion, LaterRegions) = Spec :-
|
|
PredPieces = describe_one_pred_name(ModuleInfo, should_not_module_qualify,
|
|
PredId),
|
|
FrontPieces = [words("Warning: non-contiguous clauses for ") | PredPieces]
|
|
++ [suffix("."), nl],
|
|
pred_info_get_context(PredInfo, Context),
|
|
FrontMsg = simplest_msg(Context, FrontPieces),
|
|
report_non_contiguous_clause_contexts(PredPieces, 1,
|
|
FirstRegion, SecondRegion, LaterRegions, ContextMsgs),
|
|
Msgs = [FrontMsg | ContextMsgs],
|
|
Spec = error_spec($pred, severity_warning, phase_type_check, Msgs).
|
|
|
|
:- pred report_non_contiguous_clause_contexts(list(format_piece)::in,
|
|
int::in, clause_item_number_region::in, clause_item_number_region::in,
|
|
list(clause_item_number_region)::in, list(error_msg)::out) is det.
|
|
|
|
report_non_contiguous_clause_contexts(PredPieces, GapNumber,
|
|
FirstRegion, SecondRegion, LaterRegions, Msgs) :-
|
|
FirstRegion =
|
|
clause_item_number_region(_FirstLowerNumber, _FirstUpperNumber,
|
|
_FirstLowerContext, FirstUpperContext),
|
|
SecondRegion =
|
|
clause_item_number_region(_SecondLowerNumber, _SecondUpperNumber,
|
|
SecondLowerContext, _SecondUpperContext),
|
|
( if
|
|
GapNumber = 1,
|
|
LaterRegions = []
|
|
then
|
|
% There is only one gap, so don't number it.
|
|
GapPieces = []
|
|
else
|
|
GapPieces = [int_fixed(GapNumber)]
|
|
),
|
|
% The wording here is chosen be non-confusing even if a clause has a gap
|
|
% both before and after it, so that gaps both end and start at the context
|
|
% of that clause. We could do better if we had separate contexts for the
|
|
% start and the end of the clause, but we don't.
|
|
FirstPieces = [words("Gap") | GapPieces] ++
|
|
[words("in clauses of") | PredPieces] ++
|
|
[words("starts after this clause."), nl],
|
|
SecondPieces = [words("Gap") | GapPieces] ++
|
|
[words("in clauses of") | PredPieces] ++
|
|
[words("ends with this clause."), nl],
|
|
FirstMsg = simplest_msg(FirstUpperContext, FirstPieces),
|
|
SecondMsg = simplest_msg(SecondLowerContext, SecondPieces),
|
|
(
|
|
LaterRegions = [],
|
|
Msgs = [FirstMsg, SecondMsg]
|
|
;
|
|
LaterRegions = [FirstLaterRegion | LaterLaterRegions],
|
|
report_non_contiguous_clause_contexts(PredPieces, GapNumber + 1,
|
|
SecondRegion, FirstLaterRegion, LaterLaterRegions, LaterMsgs),
|
|
Msgs = [FirstMsg, SecondMsg | LaterMsgs]
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module check_hlds.typecheck_msgs.
|
|
%---------------------------------------------------------------------------%
|