mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-16 09:53:36 +00:00
307b1dc148
compiler/error_spec.m:
This new module contains the part of the old error_util.m that defines
the error_spec type, and some functions that can help construct pieces
of error_specs. Most modules of the compiler that deal with errors
will need to import only this part of the old error_util.m.
This change also renames the format_component type to format_piece,
which matches our long-standing naming convention for variables containing
(lists of) values of this type.
compiler/write_error_spec.m:
This new module contains the part of the old error_util.m that
writes out error specs, and converts them to strings.
This diff marks as obsolete the versions of predicates that
write out error specs to the current output stream, without
*explicitly* specifying the intended stream.
compiler/error_sort.m:
This new module contains the part of the old error_util.m that
sorts lists of error specs and error msgs.
compiler/error_type_util.m:
This new module contains the part of the old error_util.m that
convert types to format_pieces that generate readable output.
compiler/parse_tree.m:
compiler/notes/compiler_design.html:
Include and document the new modules.
compiler/error_util.m:
The code remaining in the original error_util.m consists of
general utility predicates and functions that don't fit into
any of the modules above.
Delete an unneeded pair of I/O states from the argument list
of a predicate.
compiler/file_util.m:
Move the unable_to_open_file predicate here from error_util.m,
since it belongs here. Mark another predicate that writes
to the current output stream as obsolete.
compiler/hlds_error_util.m:
Mark two predicates that wrote out error_spec to the current output
stream as obsolete, and add versions that take an explicit output stream.
compiler/Mercury.options:
Compile the modules that call the newly obsoleted predicates
with --no-warn-obsolete, for the time being.
compiler/*.m:
Conform to the changes above, mostly by updating import_module
declarations, and renaming format_component to format_piece.
545 lines
21 KiB
Mathematica
545 lines
21 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 1993-2006, 2008, 2010-2011 The University of Melbourne.
|
|
% This file may only be copied under the terms of the GNU General
|
|
% Public License - see the file COPYING in the Mercury distribution.
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% File: add_mode.m.
|
|
%
|
|
% This submodule of make_hlds handles the declarations of new insts and modes.
|
|
%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- module hlds.make_hlds.add_mode.
|
|
:- interface.
|
|
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module hlds.make_hlds.make_hlds_types.
|
|
:- import_module hlds.status.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.error_spec.
|
|
:- import_module parse_tree.prog_item.
|
|
|
|
:- import_module list.
|
|
|
|
%---------------------%
|
|
|
|
:- pred module_add_inst_defn(inst_status::in, item_inst_defn_info::in,
|
|
module_info::in, module_info::out,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
%---------------------%
|
|
|
|
:- pred module_add_mode_defn(mode_status::in, item_mode_defn_info::in,
|
|
module_info::in, module_info::out,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
%---------------------%
|
|
|
|
:- pred check_inst_defns(module_info::in, ims_list(item_inst_defn_info)::in,
|
|
found_invalid_inst_or_mode::in, found_invalid_inst_or_mode::out,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
%---------------------%
|
|
|
|
:- pred check_mode_defns(module_info::in, ims_list(item_mode_defn_info)::in,
|
|
found_invalid_inst_or_mode::in, found_invalid_inst_or_mode::out,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module hlds.hlds_inst_mode.
|
|
:- import_module hlds.make_hlds_error.
|
|
:- import_module libs.
|
|
:- import_module libs.options.
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.builtin_modules.
|
|
:- import_module mdbcomp.sym_name.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.prog_mode.
|
|
|
|
:- import_module assoc_list.
|
|
:- import_module bool.
|
|
:- import_module map.
|
|
:- import_module maybe.
|
|
:- import_module pair.
|
|
:- import_module require.
|
|
:- import_module set.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
module_add_inst_defn(InstStatus, ItemInstDefnInfo, !ModuleInfo, !Specs) :-
|
|
ItemInstDefnInfo = item_inst_defn_info(InstName, InstParams, MaybeForType,
|
|
MaybeAbstractInstDefn, VarSet, Context, _SeqNum),
|
|
(
|
|
MaybeAbstractInstDefn = abstract_inst_defn
|
|
% We use abstract inst definitions only for module qualification;
|
|
% we never add them to the HLDS.
|
|
;
|
|
MaybeAbstractInstDefn = nonabstract_inst_defn(InstDefn),
|
|
% Add the definition of this inst to the HLDS inst table.
|
|
module_info_get_inst_table(!.ModuleInfo, InstTable0),
|
|
inst_table_get_user_insts(InstTable0, UserInstTable0),
|
|
insts_add(VarSet, InstName, InstParams, MaybeForType, InstDefn,
|
|
Context, InstStatus, UserInstTable0, UserInstTable, !Specs),
|
|
inst_table_set_user_insts(UserInstTable, InstTable0, InstTable),
|
|
module_info_set_inst_table(InstTable, !ModuleInfo)
|
|
).
|
|
|
|
:- pred insts_add(inst_varset::in, sym_name::in, list(inst_var)::in,
|
|
maybe(type_ctor)::in, inst_defn::in, prog_context::in,
|
|
inst_status::in, user_inst_table::in, user_inst_table::out,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
insts_add(VarSet, InstSymName, InstParams, MaybeForType, eqv_inst(EqvInst),
|
|
Context, InstStatus, !UserInstTable, !Specs) :-
|
|
list.length(InstParams, InstArity),
|
|
InstCtor = inst_ctor(InstSymName, InstArity),
|
|
(
|
|
EqvInst = bound(_, _, _),
|
|
(
|
|
MaybeForType = no,
|
|
IFTC = iftc_applicable_not_known,
|
|
Here = inst_status_defined_in_this_module(InstStatus),
|
|
(
|
|
Here = yes,
|
|
ShortInstSymName = unqualified(unqualify_name(InstSymName)),
|
|
Pieces = [words("Warning: inst"),
|
|
qual_sym_name_arity(
|
|
sym_name_arity(ShortInstSymName, InstArity)),
|
|
words("includes references to function symbols,"),
|
|
words("but does not declare what type constructor"),
|
|
words("it is for."), nl],
|
|
Option = warn_insts_with_functors_without_type,
|
|
Spec = conditional_spec($pred, Option, yes,
|
|
severity_warning, phase_parse_tree_to_hlds,
|
|
[simplest_msg(Context, Pieces)]),
|
|
!:Specs = [Spec | !.Specs]
|
|
;
|
|
Here = no
|
|
)
|
|
;
|
|
MaybeForType = yes(ForType),
|
|
IFTC = iftc_applicable_declared(ForType)
|
|
)
|
|
;
|
|
( EqvInst = any(_, _)
|
|
; EqvInst = free
|
|
; EqvInst = free(_)
|
|
; EqvInst = ground(_, _)
|
|
; EqvInst = not_reached
|
|
; EqvInst = inst_var(_)
|
|
; EqvInst = constrained_inst_vars(_, _)
|
|
; EqvInst = defined_inst(_)
|
|
; EqvInst = abstract_inst(_, _)
|
|
),
|
|
IFTC = iftc_not_applicable,
|
|
( if
|
|
MaybeForType = yes(_ForType),
|
|
inst_status_defined_in_this_module(InstStatus) = yes
|
|
then
|
|
ShortInstSymName = unqualified(unqualify_name(InstSymName)),
|
|
Pieces = [words("Error: inst"),
|
|
qual_sym_name_arity(
|
|
sym_name_arity(ShortInstSymName, InstArity)),
|
|
words("is specified to be for a given type constructor,"),
|
|
words("but it is not defined to be equivalent to a"),
|
|
quote("bound"), words("inst."), nl],
|
|
Spec = simplest_spec($pred, severity_error,
|
|
phase_parse_tree_to_hlds, Context, Pieces),
|
|
!:Specs = [Spec | !.Specs]
|
|
else
|
|
true
|
|
)
|
|
),
|
|
InstDefn = hlds_inst_defn(VarSet, InstParams, eqv_inst(EqvInst), IFTC,
|
|
Context, InstStatus),
|
|
( if map.insert(InstCtor, InstDefn, !UserInstTable) then
|
|
true
|
|
else
|
|
% If abstract insts are implemented, this will need to change
|
|
% to update the hlds_inst_defn to the non-abstract inst.
|
|
|
|
InstStatus = inst_status(InstModeStatus),
|
|
ReportDup = should_report_duplicate_inst_or_mode(InstModeStatus),
|
|
(
|
|
ReportDup = no
|
|
;
|
|
ReportDup = yes,
|
|
map.lookup(!.UserInstTable, InstCtor, OrigInstDefn),
|
|
OrigContext = OrigInstDefn ^ inst_context,
|
|
report_multiply_defined("inst", InstSymName, user_arity(InstArity),
|
|
Context, OrigContext, [], !Specs)
|
|
)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
module_add_mode_defn(ModeStatus, ItemModeDefnInfo, !ModuleInfo, !Specs) :-
|
|
ItemModeDefnInfo = item_mode_defn_info(Name, Params, MaybeAbstractModeDefn,
|
|
VarSet, Context, _SeqNum),
|
|
(
|
|
MaybeAbstractModeDefn = abstract_mode_defn
|
|
% We use abstract mode definitions only for module qualification;
|
|
% we never add them to the HLDS.
|
|
;
|
|
MaybeAbstractModeDefn = nonabstract_mode_defn(ModeDefn),
|
|
module_info_get_mode_table(!.ModuleInfo, ModeTable0),
|
|
modes_add(VarSet, Name, Params, ModeDefn, Context, ModeStatus,
|
|
ModeTable0, ModeTable, !Specs),
|
|
module_info_set_mode_table(ModeTable, !ModuleInfo)
|
|
).
|
|
|
|
:- pred modes_add(inst_varset::in, sym_name::in, list(inst_var)::in,
|
|
mode_defn::in, prog_context::in, mode_status::in,
|
|
mode_table::in, mode_table::out,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
modes_add(VarSet, Name, Params, ModeBody, Context, ModeStatus,
|
|
!ModeTable, !Specs) :-
|
|
list.length(Params, Arity),
|
|
ModeCtor = mode_ctor(Name, Arity),
|
|
ModeBody = eqv_mode(EqvMode),
|
|
HldsModeBody = hlds_mode_body(EqvMode),
|
|
ModeDefn = hlds_mode_defn(VarSet, Params, HldsModeBody, Context,
|
|
ModeStatus),
|
|
( if mode_table_insert(ModeCtor, ModeDefn, !ModeTable) then
|
|
true
|
|
else
|
|
ModeStatus = mode_status(InstModeStatus),
|
|
ReportDup = should_report_duplicate_inst_or_mode(InstModeStatus),
|
|
(
|
|
ReportDup = no
|
|
;
|
|
ReportDup = yes,
|
|
mode_table_get_mode_defns(!.ModeTable, ModeDefns),
|
|
map.lookup(ModeDefns, ModeCtor, OrigModeDefn),
|
|
OrigModeDefn = hlds_mode_defn(_, _, _, OrigContext, _),
|
|
report_multiply_defined("mode", Name, user_arity(Arity),
|
|
Context, OrigContext, [], !Specs)
|
|
)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- func should_report_duplicate_inst_or_mode(new_instmode_status) = bool.
|
|
|
|
should_report_duplicate_inst_or_mode(InstModeStatus) = ReportDup :-
|
|
(
|
|
InstModeStatus = instmode_defined_in_this_module(_),
|
|
ReportDup = yes
|
|
;
|
|
InstModeStatus = instmode_defined_in_other_module(InstModeImport),
|
|
(
|
|
( InstModeImport = instmode_import_plain
|
|
; InstModeImport = instmode_import_abstract
|
|
),
|
|
ReportDup = yes
|
|
;
|
|
InstModeImport = instmode_import_opt,
|
|
ReportDup = no
|
|
)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
check_inst_defns(ModuleInfo, ImsSubLists, !FoundInvalidInstOrMode, !Specs) :-
|
|
find_eqv_cycles_in_insts(ModuleInfo, ImsSubLists, set.init, Cycles),
|
|
( if set.is_empty(Cycles) then
|
|
true
|
|
else
|
|
!:FoundInvalidInstOrMode = found_invalid_inst_or_mode,
|
|
list.map(cycle_to_error_spec(ModuleInfo, iom_inst),
|
|
set.to_sorted_list(Cycles), CycleSpecs),
|
|
!:Specs = CycleSpecs ++ !.Specs
|
|
).
|
|
|
|
check_mode_defns(ModuleInfo, ImsSubLists, !FoundInvalidInstOrMode, !Specs) :-
|
|
find_eqv_cycles_in_modes(ModuleInfo, ImsSubLists, set.init, Cycles),
|
|
( if set.is_empty(Cycles) then
|
|
true
|
|
else
|
|
!:FoundInvalidInstOrMode = found_invalid_inst_or_mode,
|
|
list.map(cycle_to_error_spec(ModuleInfo, iom_mode),
|
|
set.to_sorted_list(Cycles), CycleSpecs),
|
|
!:Specs = CycleSpecs ++ !.Specs
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pred find_eqv_cycles_in_insts(module_info::in,
|
|
ims_list(item_inst_defn_info)::in,
|
|
set(cycle)::in, set(cycle)::out) is det.
|
|
|
|
find_eqv_cycles_in_insts(_, [], !Cycles).
|
|
find_eqv_cycles_in_insts(ModuleInfo, [ImsSubList | ImsSubLists], !Cycles) :-
|
|
ImsSubList = ims_sub_list(_ItemMercuryStatus, InstDefns),
|
|
list.foldl(find_eqv_cycles_in_inst(ModuleInfo), InstDefns, !Cycles),
|
|
find_eqv_cycles_in_insts(ModuleInfo, ImsSubLists, !Cycles).
|
|
|
|
:- pred find_eqv_cycles_in_modes(module_info::in,
|
|
ims_list(item_mode_defn_info)::in,
|
|
set(cycle)::in, set(cycle)::out) is det.
|
|
|
|
find_eqv_cycles_in_modes(_, [], !Cycles).
|
|
find_eqv_cycles_in_modes(ModuleInfo, [ImsSubList | ImsSubLists], !Cycles) :-
|
|
ImsSubList = ims_sub_list(_ItemMercuryStatus, ModeDefns),
|
|
list.foldl(find_eqv_cycles_in_mode(ModuleInfo), ModeDefns, !Cycles),
|
|
find_eqv_cycles_in_modes(ModuleInfo, ImsSubLists, !Cycles).
|
|
|
|
%---------------------%
|
|
|
|
:- pred find_eqv_cycles_in_inst(module_info::in, item_inst_defn_info::in,
|
|
set(cycle)::in, set(cycle)::out) is det.
|
|
|
|
find_eqv_cycles_in_inst(ModuleInfo, ItemInstDefnInfo, !Cycles) :-
|
|
ItemInstDefnInfo = item_inst_defn_info(InstName, InstParams, _MaybeForType,
|
|
_MaybeAbstractInstDefn, _VarSet, _Context, _SeqNum),
|
|
module_info_get_inst_table(ModuleInfo, InstTable),
|
|
inst_table_get_user_insts(InstTable, UserInstTable),
|
|
list.length(InstParams, InstArity),
|
|
InstCtor = inst_ctor(InstName, InstArity),
|
|
TestArgs = list.duplicate(InstArity, not_reached),
|
|
map.init(Expansions0),
|
|
check_for_cyclic_inst(UserInstTable, InstCtor, InstCtor, TestArgs,
|
|
Expansions0, !Cycles).
|
|
|
|
:- pred find_eqv_cycles_in_mode(module_info::in, item_mode_defn_info::in,
|
|
set(cycle)::in, set(cycle)::out) is det.
|
|
|
|
find_eqv_cycles_in_mode(ModuleInfo, ItemModeDefnInfo, !Cycles) :-
|
|
ItemModeDefnInfo = item_mode_defn_info(ModeName, ModeParams,
|
|
_MaybeAbstractModeDefn, _VarSet, _Context, _SeqNum),
|
|
module_info_get_mode_table(ModuleInfo, ModeTable),
|
|
mode_table_get_mode_defns(ModeTable, ModeDefns),
|
|
list.length(ModeParams, ModeArity),
|
|
ModeCtor = mode_ctor(ModeName, ModeArity),
|
|
map.init(Expansions0),
|
|
check_for_cyclic_mode(ModeDefns, ModeCtor, ModeCtor,
|
|
Expansions0, !Cycles).
|
|
|
|
%---------------------%
|
|
|
|
:- pred check_for_cyclic_inst(user_inst_table::in,
|
|
inst_ctor::in, inst_ctor::in, list(mer_inst)::in,
|
|
expansions::in, set(cycle)::in, set(cycle)::out) is det.
|
|
|
|
check_for_cyclic_inst(UserInstTable, OrigInstCtor, InstCtor0, Args0,
|
|
Expansions0, !Cycles) :-
|
|
InstCtor0 = inst_ctor(SymName0, Arity0),
|
|
SNA0 = sym_name_arity(SymName0, Arity0),
|
|
( if map.search(Expansions0, SNA0, _OldContext) then
|
|
( if OrigInstCtor = InstCtor0 then
|
|
map.to_sorted_assoc_list(Expansions0, ExpansionsAL0),
|
|
set.insert(cycle(ExpansionsAL0), !Cycles)
|
|
else
|
|
% Both OrigInstCtor and InstCtor0 suffer from needing infinite
|
|
% expansion, but the circularity we have just detected does
|
|
% NOT involve OrigInstCtor.
|
|
true
|
|
)
|
|
else
|
|
( if
|
|
map.search(UserInstTable, InstCtor0, InstDefn),
|
|
InstDefn = hlds_inst_defn(_, Params, Body, _, Context, _),
|
|
Body = eqv_inst(EqvInst0),
|
|
inst_substitute_arg_list(Params, Args0, EqvInst0, EqvInst),
|
|
EqvInst = defined_inst(user_inst(SymName, Args))
|
|
then
|
|
list.length(Args, Arity),
|
|
InstCtor = inst_ctor(SymName, Arity),
|
|
map.det_insert(SNA0, Context, Expansions0, Expansions1),
|
|
check_for_cyclic_inst(UserInstTable, OrigInstCtor, InstCtor, Args,
|
|
Expansions1, !Cycles)
|
|
else
|
|
true
|
|
)
|
|
).
|
|
|
|
:- pred check_for_cyclic_mode(mode_defns::in, mode_ctor::in, mode_ctor::in,
|
|
expansions::in, set(cycle)::in, set(cycle)::out) is det.
|
|
|
|
check_for_cyclic_mode(ModeDefns, OrigModeCtor, ModeCtor0,
|
|
Expansions0, !Cycles) :-
|
|
ModeCtor0 = mode_ctor(SymName0, Arity0),
|
|
SNA0 = sym_name_arity(SymName0, Arity0),
|
|
( if map.search(Expansions0, SNA0, _OldContext) then
|
|
( if ModeCtor0 = OrigModeCtor then
|
|
map.to_sorted_assoc_list(Expansions0, ExpansionsAL0),
|
|
set.insert(cycle(ExpansionsAL0), !Cycles)
|
|
else
|
|
% Both OrigModeCtor and ModeCtor0 suffer from needing infinite
|
|
% expansion, but the circularity we have just detected does
|
|
% NOT involve OrigModeCtor.
|
|
true
|
|
)
|
|
else
|
|
( if
|
|
map.search(ModeDefns, ModeCtor0, ModeDefn),
|
|
ModeDefn = hlds_mode_defn(_, _, Body, Context, _),
|
|
Body = hlds_mode_body(EqvMode),
|
|
EqvMode = user_defined_mode(SymName, Args)
|
|
then
|
|
list.length(Args, Arity),
|
|
ModeCtor = mode_ctor(SymName, Arity),
|
|
map.det_insert(SNA0, Context, Expansions0, Expansions1),
|
|
check_for_cyclic_mode(ModeDefns, OrigModeCtor, ModeCtor,
|
|
Expansions1, !Cycles)
|
|
else
|
|
true
|
|
)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% The inst_ctors or mode_ctors we have seen so far, together
|
|
% with the contexts of their definitions.
|
|
:- type expansions == map(sym_name_arity, prog_context).
|
|
|
|
% A cycle is an expansion that starts and ends at the same inst_ctor
|
|
% or mode_ctor.
|
|
%
|
|
% We store it as an assoc_list, not a map, both because we need it
|
|
% in the form of a list when generating the error message, and because
|
|
% unlike maps, two assoc_lists are be semantically the same
|
|
% if and only if they are also syntactially the same.
|
|
:- type cycle
|
|
---> cycle(assoc_list(sym_name_arity, prog_context)).
|
|
|
|
:- type inst_or_mode
|
|
---> iom_inst
|
|
; iom_mode.
|
|
|
|
:- pred cycle_to_error_spec(module_info::in, inst_or_mode::in, cycle::in,
|
|
error_spec::out) is det.
|
|
|
|
cycle_to_error_spec(ModuleInfo, InstOrMode, Cycle, Spec) :-
|
|
(
|
|
InstOrMode = iom_inst,
|
|
InstOrModeWord = "inst",
|
|
AnInstOrModeWord = "an inst"
|
|
;
|
|
InstOrMode = iom_mode,
|
|
InstOrModeWord = "mode",
|
|
AnInstOrModeWord = "a mode"
|
|
),
|
|
Cycle = cycle(SNAsContexts),
|
|
module_info_get_name(ModuleInfo, ModuleName),
|
|
list.filter(sna_context_is_for_module(ModuleName), SNAsContexts,
|
|
LocalSNAsContexts, OtherSNAsContexts),
|
|
(
|
|
LocalSNAsContexts = [],
|
|
(
|
|
OtherSNAsContexts = [],
|
|
unexpected($pred, "cycle has no entries")
|
|
;
|
|
OtherSNAsContexts = [HeadOtherSNAContext | TailOtherSNAsContexts],
|
|
HeadOtherSNAContext = _HeadSNA - HeadContext,
|
|
other_sna_and_context_to_piece(HeadOtherSNAContext, HeadSNAPiece),
|
|
list.map(other_sna_and_context_to_piece,
|
|
TailOtherSNAsContexts, LaterSNAPieces),
|
|
ContextMsgs = []
|
|
)
|
|
;
|
|
LocalSNAsContexts = [HeadLocalSNAContext | TailLocalSNAsContexts],
|
|
HeadLocalSNAContext = _HeadSNA - HeadContext,
|
|
local_sna_and_context_to_piece_and_msg(ModuleInfo, InstOrMode,
|
|
HeadLocalSNAContext, HeadSNAPiece, _HeadMsg),
|
|
list.map2(
|
|
local_sna_and_context_to_piece_and_msg(ModuleInfo, InstOrMode),
|
|
TailLocalSNAsContexts, TailLocalSNAPieces, ContextMsgs),
|
|
list.map(other_sna_and_context_to_piece,
|
|
OtherSNAsContexts, OtherSNAPieces),
|
|
LaterSNAPieces = TailLocalSNAPieces ++ OtherSNAPieces
|
|
),
|
|
PreludePieces = [words("Error:"),
|
|
words(InstOrModeWord), words("name"), HeadSNAPiece,
|
|
words("expands to"), words(AnInstOrModeWord),
|
|
words("containing itself")],
|
|
ConsequencePieces = [words("which means that"),
|
|
words("processing any reference to it"),
|
|
words("would require an infinite sequence of expansions."), nl],
|
|
(
|
|
LaterSNAPieces = [],
|
|
HeadPieces = PreludePieces ++ [suffix(",")] ++ ConsequencePieces
|
|
;
|
|
LaterSNAPieces = [LaterSNAPiece],
|
|
HeadPieces = PreludePieces ++
|
|
[words("through"), LaterSNAPiece, suffix(",")]
|
|
++ ConsequencePieces
|
|
;
|
|
LaterSNAPieces = [_, _ | _],
|
|
LaterSNAPieceLists = list.map(make_singleton_list, LaterSNAPieces),
|
|
CyclePieces = component_list_to_line_pieces(LaterSNAPieceLists,
|
|
[suffix(","), nl]),
|
|
HeadPieces = PreludePieces ++ [words("through"), nl]
|
|
++ CyclePieces ++ ConsequencePieces
|
|
),
|
|
HeadMsg = simplest_msg(HeadContext, HeadPieces),
|
|
Spec = error_spec($pred, severity_error, phase_parse_tree_to_hlds,
|
|
[HeadMsg | ContextMsgs]).
|
|
|
|
:- pred sna_context_is_for_module(module_name::in,
|
|
pair(sym_name_arity, prog_context)::in) is semidet.
|
|
|
|
sna_context_is_for_module(ModuleName, SNA - _Context) :-
|
|
SNA = sym_name_arity(SymName, _Arity),
|
|
SymName = qualified(ModuleName, _).
|
|
|
|
:- pred local_sna_and_context_to_piece_and_msg(module_info::in,
|
|
inst_or_mode::in, pair(sym_name_arity, prog_context)::in,
|
|
format_piece::out, error_msg::out) is det.
|
|
|
|
local_sna_and_context_to_piece_and_msg(ModuleInfo, InstOrMode, SNA - Context,
|
|
SNAPiece, Msg) :-
|
|
% Module qualify the names of local insts or modes *only* if
|
|
% those names could be confused with insts or modes of the same name
|
|
% in the builtin module. (Error messages from the Mercury compiler
|
|
% normally module qualify every reference that is to an entity
|
|
% that is not either in the current module or the builtin module.)
|
|
SNA = sym_name_arity(SymName, Arity),
|
|
Name = unqualify_name(SymName),
|
|
BuiltinSymName = qualified(mercury_public_builtin_module, Name),
|
|
(
|
|
InstOrMode = iom_inst,
|
|
module_info_get_inst_table(ModuleInfo, InstTable),
|
|
inst_table_get_user_insts(InstTable, UserInstTable),
|
|
BuiltinInstCtor = inst_ctor(BuiltinSymName, Arity),
|
|
( if map.search(UserInstTable, BuiltinInstCtor, _) then
|
|
SNAPiece = qual_sym_name_arity(SNA)
|
|
else
|
|
SNAPiece = unqual_sym_name_arity(SNA)
|
|
)
|
|
;
|
|
InstOrMode = iom_mode,
|
|
module_info_get_mode_table(ModuleInfo, ModeTable),
|
|
mode_table_get_mode_defns(ModeTable, ModeDefns),
|
|
BuiltinModeCtor = mode_ctor(BuiltinSymName, Arity),
|
|
( if map.search(ModeDefns, BuiltinModeCtor, _ModeDefn) then
|
|
SNAPiece = qual_sym_name_arity(SNA)
|
|
else
|
|
SNAPiece = unqual_sym_name_arity(SNA)
|
|
)
|
|
),
|
|
MsgPieces = [words("The definition of"), SNAPiece, words("is here."), nl],
|
|
Msg = simplest_msg(Context, MsgPieces).
|
|
|
|
:- pred other_sna_and_context_to_piece(pair(sym_name_arity, prog_context)::in,
|
|
format_piece::out) is det.
|
|
|
|
other_sna_and_context_to_piece(SNA - _Context, SNAPiece) :-
|
|
SNAPiece = qual_sym_name_arity(SNA).
|
|
|
|
:- func make_singleton_list(T) = list(T).
|
|
|
|
make_singleton_list(X) = [X].
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module hlds.make_hlds.add_mode.
|
|
%---------------------------------------------------------------------------%
|