mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-15 01:13:30 +00:00
Code Issues Projects Releases Wiki Activity
Files
cdf10e673cf66188e3facae0f458aea71f9ee438
mercury/compiler/split_parse_tree_src.m
Zoltan Somogyi 36e8833145 Add a new option, --warn-unused-types. 
When set, this option tells the compiler to generate warnings
about locally-defined types that are neither used in the module
nor exported to any other module.

compiler/options.m:
    Add the new option.

compiler/unused_types.m:
    New module to implement the new option.

compiler/mercury_compile_front_end.m:
    Invoke the new module, unless the presence of previous errors
    would make its warnings just a distraction.

compiler/check_hlds.m:
    Include the new module.

compiler/notes/compiler_design.html:
    Document the new module.

compiler/typecheck_error_wrong_type.m:
    Simplify some code.

browser/declarative_tree.m:
compiler/accumulator.m:
compiler/du_type_layout.m:
compiler/intermod.m:
compiler/mode_errors.m:
compiler/parse_inst_mode_defn.m:
compiler/polyhedron.m:
compiler/split_parse_tree_src.m:
compiler/tag_switch_util.m:
compiler/typecheck_error_unify.m:
compiler/unneeded_code.m:
deep_profiler/mdprof_test.m:
library/getopt.m:
library/getopt_io.m:
    Delete unused types reported by the new option.

library/rtti_implementation.m:
    Comment out unused type reported by the new option. This type was exported
    to both Java and C#, but this diff comments it out because neither language
    the Java or the C# runtime system seems to use the exported versions
    either. (Bootcheck in both java and csharp grades worked, with the
    same number of test case failures as before.) We do not delete it,
    because it may be useful in the future.

tests/warnings/help_text.err_exp:
    Expect the documentation of the new option.

tests/invalid_nodepend/Mmakefile:
    Specify --warn-unused-types for two test cases to test that the compiler
    does NOT generate warnings about unused types in the presence of previous
    errors.

tests/warnings/abstract_type_decl.err_exp:
tests/warnings/bug412.err_exp:
tests/warnings/warn_dead_procs.err_exp:
    Expect the new warnings for unused types.

tests/warnings/Mmakefile:
    Specify --warn-unused-types for the three test cases listed above.
2026-02-15 11:26:34 +11:00

1128 lines
49 KiB
Mathematica
Raw Blame History

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2015, 2017-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.
%---------------------------------------------------------------------------%
%
% File: split_parse_tree_src.m.
% Main author: zs.
%
%---------------------------------------------------------------------------%
:- module parse_tree.split_parse_tree_src.
:- interface.
:- import_module libs.
:- import_module libs.globals.
:- import_module parse_tree.error_spec.
:- import_module parse_tree.prog_parse_tree.
:- import_module list.
% Given the parse tree of a source module that may contain submodules,
% split it into a list of one or more parse_tree_module_srcs; one for the
% top level module, and one for each nested submodule. Return these
% parse_tree_module_srcs in top-down order of the submodule's inclusions.
%
% Also do some error checking:
%
% - report an error if the `implementation' section of a submodule
% is contained inside the `interface' section of its parent module;
%
% - check for modules declared as both nested and separate submodules;
%
% - check for non-abstract typeclass instance declarations in module
% interfaces.
%
:- pred split_into_component_modules_perform_checks(globals::in,
parse_tree_src::in, list(parse_tree_module_src)::out,
list(error_spec)::in, list(error_spec)::out) is det.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module libs.options.
:- import_module mdbcomp.
:- import_module mdbcomp.sym_name.
:- import_module parse_tree.convert_parse_tree.
:- import_module parse_tree.item_util.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_item.
:- import_module bool.
:- import_module cord.
:- import_module map.
:- import_module maybe.
:- import_module require.
:- import_module set.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
split_into_component_modules_perform_checks(Globals, ParseTreeSrc,
ParseTreeModuleSrcs, !Specs) :-
% This algorithm has two phases.
%
% The first phase, split_parse_tree_discover_submodules, builds up
% the split_module_map and the module_to_submodules_map, two data
% structures that together record what submodules (if any) are nested
% within the top module.
%
% The second phase, create_component_modules_depth_first,
% converts those data structures into the list of parse_tree_module_srcs
% that our caller expects us to return.
%
% We do the job in two phases because the two parts (interface and
% implementation) of a submodule may be in widely separated parts of
% of ParseTreeSrc, interspersed with parts of *other* submodules.
% Going from ParseTreeSrc to directly to ParseTreeModuleSrcs would
% therefore be possible only with excessively-complicated code.
split_parse_tree_discover_submodules(ParseTreeSrc, ma_no_parent,
map.init, SplitModuleMap, map.init, SubModulesMap, !Specs),
ParseTreeSrc = parse_tree_src(TopModuleName, _, _),
create_component_modules_depth_first(Globals, TopModuleName,
SplitModuleMap, LeftOverSplitModuleMap,
SubModulesMap, LeftOverSubModulesMap,
cord.init, ParseTreeModuleSrcCord, !Specs),
expect(map.is_empty(LeftOverSplitModuleMap), $pred,
"LeftOverSplitModuleMap is not empty"),
expect(map.is_empty(LeftOverSubModulesMap), $pred,
"LeftOverSubModulesMap is not empty"),
ParseTreeModuleSrcs = cord.list(ParseTreeModuleSrcCord).
%---------------------------------------------------------------------------%
% PHASE ONE
%
% The next section contains the data structures and the code of phase one,
% which discovers what submodules (if any) the top module has and what
% each submodule contains. It also looks for errors in the submodule
% structure, and generates a message for each error it finds.
%---------------------------------------------------------------------------%
% Maps each module to the list of its submodules seen so far.
% A submodule that is nested into its parent twice (because it has
% its interface and implementation sections inside separate `:- module'/
% `:- end_module' pairs) will appear twice in the cord.
%
:- type module_to_submodules_map == map(module_name, cord(module_name)).
%---------------------%
:- type submodule_include_info
---> submodule_include_info(
% Should this submodule be included in its parent's interface
% section, or in its implementation section? If it is included
% in both, we generate an item_include for it only in the
% interface section. This reflects the fact that the submodule
% is visible to clients of the parent module, but avoids
% a compiler error message about the submodule being included
% twice.
module_section,
% The context we should generate for that item_include.
prog_context
).
:- type submodule_include_info_map == map(module_name, submodule_include_info).
%---------------------%
% Modules contain sections, and those sections may contain (sub)modules.
%
% A module may be a top-level module in a parse_tree_src, in which case
% it has no parents in the parse tree, so its context is ma_no_parent.
% If a module is not the top-level module in its parse_tree_src, then
% it appears in a particular section, which in turn is contained in another
% module. You can find the identity of the containing section in ma_parent,
% and the identity of the module containing that in sa_parent.
:- type module_ancestors
---> ma_no_parent
; ma_parent(
% Which section of its parent module does this module
% appear in?
module_section,
% The context of the section.
prog_context,
% That section's ancestors.
section_ancestors
).
:- type section_ancestors
---> sa_parent(
module_name, % Which module does this section appear in?
module_ancestors
).
%---------------------%
:- type split_nested_info
---> split_nested_top_module(prog_context)
% This module is the top level module, and this is the context
% of its `:- module' declaration.
; split_nested_empty(prog_context)
% This module is not the top level module, and we have seen
% neither its interface section, nor its implementation section.
% We have seen only an empty module, and have generated a warning
% about this fact. The context is the context of the module
% declaration of the empty module.
; split_nested_only_int(prog_context)
% This module is not the top level module, we have seen
% only its interface section, and this is the context of the
% `:- module' declaration of this interface.
; split_nested_only_imp(prog_context)
% This module is not the top level module, we have seen
% only its implementation section, and this is the context of the
% `:- module' declaration of this implementation.
; split_nested_int_imp(prog_context, prog_context).
% This module is not the top level module, and we have seen
% both its interface and implementation section,
% with the two contexts giving the locations of the `:- module'
% declarations of the interface and implementation parts
% respectively. If there was a single `:- module' declaration
% which contained both interface and implementation sections,
% these two will be the same context.
:- type split_module_entry
---> split_included(
prog_context
% The module was included by an `:- include_module'
% declaration at this context.
)
; split_nested(
% The module is either the top level module or a directly
% or indirectly nested submodule. (NOT one referred to
% by `:- include_module' declaration.)
split_nested_info,
cord(raw_item_block),
% The contents of the module, at least as much as of it
% as we have seen so far (since nested modules may be included
% twice, once for their interface and once for their
% implementation), and except for the item_includes
% for any modules nested inside, which ....
submodule_include_info_map
% ... should be derived from this field, once we have seen
% all of this module's pieces.
).
:- type split_module_map == map(module_name, split_module_entry).
%---------------------------------------------------------------------------%
%
% The main code of phase one.
%
:- pred split_parse_tree_discover_submodules(parse_tree_src::in,
module_ancestors::in, split_module_map::in, split_module_map::out,
module_to_submodules_map::in, module_to_submodules_map::out,
list(error_spec)::in, list(error_spec)::out) is det.
split_parse_tree_discover_submodules(ParseTree, ModuleAncestors,
!SplitModuleMap, !SubModulesMap, !Specs) :-
ParseTree = parse_tree_src(ModuleName, Context, ModuleComponentsCord),
ModuleComponents = cord.list(ModuleComponentsCord),
% If this module is a submodule, record its relationship to its parent.
add_new_module_maybe_submodule_to_map(ModuleAncestors, ModuleName,
!SubModulesMap),
SubModuleSectionAncestors = sa_parent(ModuleName, ModuleAncestors),
split_components_discover_submodules(ModuleName, ModuleComponents,
SubModuleSectionAncestors, !SplitModuleMap, !SubModulesMap,
map.init, SubInclInfoMap0, cord.init, ItemBlockCord0, !Specs),
(
ModuleAncestors = ma_no_parent,
( if map.search(!.SplitModuleMap, ModuleName, OldEntry) then
(
OldEntry = split_included(OldContext),
Pieces = [words("Error: the top level module")] ++
color_as_subject([qual_sym_name(ModuleName)]) ++
color_as_incorrect([words("should not have an"),
decl("include_module"),
words("declaration for itself.")]) ++
[nl],
OldPieces = [words("This is the location of the"),
decl("include_module"), words("declaration."), nl]
;
OldEntry = split_nested(SplitNested, _, _),
OldContext = split_nested_info_get_context(SplitNested),
Pieces = [words("Error: the top level module")] ++
color_as_subject([qual_sym_name(ModuleName)]) ++
color_as_incorrect(
[words("should not have its name reused.")]) ++
[nl],
OldPieces = [words("This is the location of the reuse."), nl]
),
Msg = msg(Context, Pieces),
OldMsg = msg(OldContext, OldPieces),
Spec = error_spec($pred, severity_error, phase_pt2h,
[Msg, OldMsg]),
!:Specs = [Spec | !.Specs]
else
Entry = split_nested(split_nested_top_module(Context),
ItemBlockCord0, SubInclInfoMap0),
map.det_insert(ModuleName, Entry, !SplitModuleMap)
)
;
ModuleAncestors = ma_parent(_SectionKind, _SectionContext,
SectionAncestors),
SectionAncestors = sa_parent(ParentModuleName, _),
ItemBlocks = cord.list(ItemBlockCord0),
get_raw_item_block_section_kinds(ItemBlocks, no, SeenInt, no, SeenImp),
(
SeenInt = no,
SeenImp = no,
warn_empty_submodule(ModuleName, Context, ParentModuleName,
!Specs),
( if map.search(!.SplitModuleMap, ModuleName, OldEntry) then
report_duplicate_submodule(ModuleName, Context,
dup_empty, ParentModuleName, OldEntry, !Specs)
else
SplitNested = split_nested_empty(Context),
Entry = split_nested(SplitNested, ItemBlockCord0,
SubInclInfoMap0),
map.det_insert(ModuleName, Entry, !SplitModuleMap)
)
;
SeenInt = yes,
SeenImp = no,
( if map.search(!.SplitModuleMap, ModuleName, OldEntry) then
(
OldEntry = split_nested(OldSplitNested, OldItemBlockCord,
OldSubInclInfoMap),
(
OldSplitNested = split_nested_only_imp(ImpContext),
NewSplitNested =
split_nested_int_imp(Context, ImpContext),
NewItemBlockCord = ItemBlockCord0 ++ OldItemBlockCord,
map.union(combine_submodule_include_infos,
SubInclInfoMap0,
OldSubInclInfoMap, NewSubInclInfoMap),
NewEntry = split_nested(NewSplitNested,
NewItemBlockCord, NewSubInclInfoMap),
map.det_update(ModuleName, NewEntry, !SplitModuleMap)
;
OldSplitNested = split_nested_empty(EmptyContext),
warn_duplicate_of_empty_submodule(ModuleName,
ParentModuleName, Context, EmptyContext, !Specs),
NewSplitNested = split_nested_only_int(Context),
NewEntry = split_nested(NewSplitNested, ItemBlockCord0,
SubInclInfoMap0),
map.det_update(ModuleName, NewEntry, !SplitModuleMap)
;
( OldSplitNested = split_nested_top_module(_)
; OldSplitNested = split_nested_only_int(_)
; OldSplitNested = split_nested_int_imp(_, _)
),
report_duplicate_submodule(ModuleName, Context,
dup_int_only, ParentModuleName, OldEntry, !Specs)
)
;
OldEntry = split_included(_),
report_duplicate_submodule(ModuleName, Context,
dup_int_only, ParentModuleName, OldEntry, !Specs),
% Record the nested module, to prevent any complaints by
% warn_about_any_unread_modules_with_read_ancestors.
NewSplitNested = split_nested_only_int(Context),
NewEntry = split_nested(NewSplitNested, ItemBlockCord0,
SubInclInfoMap0),
map.det_update(ModuleName, NewEntry, !SplitModuleMap)
)
else
NewSplitNested = split_nested_only_int(Context),
NewEntry = split_nested(NewSplitNested, ItemBlockCord0,
SubInclInfoMap0),
map.det_insert(ModuleName, NewEntry, !SplitModuleMap)
)
;
SeenInt = no,
SeenImp = yes,
( if map.search(!.SplitModuleMap, ModuleName, OldEntry) then
(
OldEntry = split_nested(OldSplitNested, OldItemBlockCord,
OldSubInclInfoMap),
(
OldSplitNested = split_nested_only_int(IntContext),
NewSplitNested =
split_nested_int_imp(IntContext, Context),
NewItemBlockCord = OldItemBlockCord ++ ItemBlockCord0,
map.union(combine_submodule_include_infos,
SubInclInfoMap0,
OldSubInclInfoMap, NewSubInclInfoMap),
NewEntry = split_nested(NewSplitNested,
NewItemBlockCord, NewSubInclInfoMap),
map.det_update(ModuleName, NewEntry, !SplitModuleMap)
;
OldSplitNested = split_nested_empty(EmptyContext),
warn_duplicate_of_empty_submodule(ModuleName,
ParentModuleName, Context, EmptyContext, !Specs),
NewSplitNested = split_nested_only_imp(Context),
NewEntry = split_nested(NewSplitNested, ItemBlockCord0,
SubInclInfoMap0),
map.det_update(ModuleName, NewEntry, !SplitModuleMap)
;
( OldSplitNested = split_nested_top_module(_)
; OldSplitNested = split_nested_only_imp(_)
; OldSplitNested = split_nested_int_imp(_, _)
),
report_duplicate_submodule(ModuleName, Context,
dup_imp_only, ParentModuleName, OldEntry, !Specs)
)
;
OldEntry = split_included(_),
report_duplicate_submodule(ModuleName, Context,
dup_int_only, ParentModuleName, OldEntry, !Specs),
% Record the nested module, to prevent any complaints by
% warn_about_any_unread_modules_with_read_ancestors.
NewSplitNested = split_nested_only_imp(Context),
NewEntry = split_nested(NewSplitNested, ItemBlockCord0,
SubInclInfoMap0),
map.det_update(ModuleName, NewEntry, !SplitModuleMap)
)
else
NewSplitNested = split_nested_only_imp(Context),
NewEntry = split_nested(NewSplitNested, ItemBlockCord0,
SubInclInfoMap0),
map.det_insert(ModuleName, NewEntry, !SplitModuleMap)
)
;
SeenInt = yes,
SeenImp = yes,
( if map.search(!.SplitModuleMap, ModuleName, OldEntry) then
(
OldEntry = split_nested(OldSplitNested, _OldItemBlockCord,
_OldSubInclInfoMap),
(
OldSplitNested = split_nested_empty(EmptyContext),
warn_duplicate_of_empty_submodule(ModuleName,
ParentModuleName, Context, EmptyContext, !Specs),
NewSplitNested =
split_nested_int_imp(Context, Context),
NewEntry = split_nested(NewSplitNested, ItemBlockCord0,
SubInclInfoMap0),
map.det_update(ModuleName, NewEntry, !SplitModuleMap)
;
( OldSplitNested = split_nested_top_module(_)
; OldSplitNested = split_nested_only_int(_)
; OldSplitNested = split_nested_only_imp(_)
; OldSplitNested = split_nested_int_imp(_, _)
),
report_duplicate_submodule(ModuleName, Context,
dup_int_imp, ParentModuleName, OldEntry, !Specs)
)
;
OldEntry = split_included(_),
report_duplicate_submodule(ModuleName, Context,
dup_int_only, ParentModuleName, OldEntry, !Specs),
% Record the nested module, to prevent any complaints by
% warn_about_any_unread_modules_with_read_ancestors.
NewSplitNested = split_nested_int_imp(Context, Context),
NewEntry = split_nested(NewSplitNested, ItemBlockCord0,
SubInclInfoMap0),
map.det_update(ModuleName, NewEntry, !SplitModuleMap)
)
else
NewSplitNested = split_nested_int_imp(Context, Context),
NewEntry = split_nested(NewSplitNested, ItemBlockCord0,
SubInclInfoMap0),
map.det_insert(ModuleName, NewEntry, !SplitModuleMap)
)
)
).
:- pred get_raw_item_block_section_kinds(list(raw_item_block)::in,
bool::in, bool::out, bool::in, bool::out) is det.
get_raw_item_block_section_kinds([], !SeenInt, !SeenImp).
get_raw_item_block_section_kinds([ItemBlock | ItemBlocks],
!SeenInt, !SeenImp) :-
ItemBlock = item_block(_, SectionKind, _, _, _, _),
(
SectionKind = ms_interface,
!:SeenInt = yes
;
SectionKind = ms_implementation,
!:SeenImp = yes
),
get_raw_item_block_section_kinds(ItemBlocks, !SeenInt, !SeenImp).
%---------------------%
:- pred split_components_discover_submodules(module_name::in,
list(module_component)::in, section_ancestors::in,
split_module_map::in, split_module_map::out,
module_to_submodules_map::in, module_to_submodules_map::out,
submodule_include_info_map::in, submodule_include_info_map::out,
cord(raw_item_block)::in, cord(raw_item_block)::out,
list(error_spec)::in, list(error_spec)::out) is det.
split_components_discover_submodules(_, [],
_, !SplitModuleMap, !SubModulesMap,
!SubInclInfoMap, !RawItemBlockCord, !Specs).
split_components_discover_submodules(ModuleName, [Component | Components],
SectionAncestors, !SplitModuleMap, !SubModulesMap,
!SubInclInfoMap, !RawItemBlockCord, !Specs) :-
split_component_discover_submodules(ModuleName, Component,
SectionAncestors, !SplitModuleMap, !SubModulesMap,
!SubInclInfoMap, !RawItemBlockCord, !Specs),
split_components_discover_submodules(ModuleName, Components,
SectionAncestors, !SplitModuleMap, !SubModulesMap,
!SubInclInfoMap, !RawItemBlockCord, !Specs).
:- pred split_component_discover_submodules(module_name::in,
module_component::in, section_ancestors::in,
split_module_map::in, split_module_map::out,
module_to_submodules_map::in, module_to_submodules_map::out,
submodule_include_info_map::in, submodule_include_info_map::out,
cord(raw_item_block)::in, cord(raw_item_block)::out,
list(error_spec)::in, list(error_spec)::out) is det.
split_component_discover_submodules(ModuleName, Component, SectionAncestors,
!SplitModuleMap, !SubModulesMap, !SubInclInfoMap,
!RawItemBlockCord, !Specs) :-
(
Component = mc_section(ComponentModuleName, SectionKind,
SectionContext, IncludesCord, AvailsCord, FIMsCord, ItemsCord),
Includes = cord.list(IncludesCord),
Avails = cord.list(AvailsCord),
Items = cord.list(ItemsCord),
FIMs = cord.list(FIMsCord),
discover_included_submodules(Includes, SectionAncestors,
cord.init, OKIncludesCord,
!SplitModuleMap, !SubModulesMap, !Specs),
OKIncludes = cord.list(OKIncludesCord),
RawItemBlock = item_block(ComponentModuleName, SectionKind,
OKIncludes, Avails, FIMs, Items),
cord.snoc(RawItemBlock, !RawItemBlockCord),
(
SectionKind = ms_interface
;
SectionKind = ms_implementation,
section_has_some_ancestor_in_interface(SectionAncestors,
MaybeInterfaceAncestor),
(
MaybeInterfaceAncestor = no
;
MaybeInterfaceAncestor = yes(InterfaceAncestor),
SectionAncestors = sa_parent(CurModuleName, ModuleAncestors),
(
ModuleAncestors = ma_no_parent,
unexpected($pred,
"in interface section of nonexistent ancestor")
;
ModuleAncestors = ma_parent(_, _, ModuleSectionAncestor),
ModuleSectionAncestor = sa_parent(ModuleParent, _),
( if ModuleParent = InterfaceAncestor then
PorA = "parent"
else
PorA = "ancestor"
)
),
Pieces = [words("Error: this")] ++
color_as_subject([words("implementation section")]) ++
[words("for module"), qual_sym_name(CurModuleName)] ++
[words("occurs in the")] ++
color_as_incorrect([words("interface section")]) ++
[words("of"), words(PorA), words("module"),
qual_sym_name(InterfaceAncestor), suffix(".")] ++
[nl],
Spec = spec($pred, severity_error, phase_pt2h,
SectionContext, Pieces),
!:Specs = [Spec | !.Specs]
)
)
;
Component = mc_nested_submodule(ComponentModuleName, SectionKind,
SectionContext, NestedModuleParseTree),
NestedModuleParseTree = parse_tree_src(NestedModuleName,
NestedModuleContext, _NestedModuleComponents),
expect(unify(ModuleName, ComponentModuleName), $pred,
"ModuleName != ComponentModuleName"),
( if NestedModuleName = qualified(ComponentModuleName, _) then
true
else
unexpected($pred,
"ComponentModuleName is not NestedModuleName's parent")
),
NewEntry = submodule_include_info(SectionKind, NestedModuleContext),
( if map.search(!.SubInclInfoMap, NestedModuleName, OldEntry) then
combine_submodule_include_infos(OldEntry, NewEntry, Entry),
map.det_update(NestedModuleName, Entry, !SubInclInfoMap)
else
map.det_insert(NestedModuleName, NewEntry, !SubInclInfoMap)
),
% Discover any submodules nested inside NestedModuleParseTree.
NestedModuleAncestors = ma_parent(SectionKind, SectionContext,
SectionAncestors),
split_parse_tree_discover_submodules(NestedModuleParseTree,
NestedModuleAncestors, !SplitModuleMap, !SubModulesMap, !Specs)
).
%---------------------%
:- pred discover_included_submodules(list(item_include)::in,
section_ancestors::in, cord(item_include)::in, cord(item_include)::out,
split_module_map::in, split_module_map::out,
module_to_submodules_map::in, module_to_submodules_map::out,
list(error_spec)::in, list(error_spec)::out) is det.
discover_included_submodules([], _,
!OKIncludesCord, !SplitModuleMap, !SubModulesMap, !Specs).
discover_included_submodules([Include | Includes], SectionAncestors,
!OKIncludesCord, !SplitModuleMap, !SubModulesMap, !Specs) :-
Include = item_include(InclModuleName, Context, _SeqNum),
( if map.search(!.SplitModuleMap, InclModuleName, OldEntry) then
SectionAncestors = sa_parent(ParentModuleName, _),
Pieces1 = [words("In module"), qual_sym_name(ParentModuleName),
suffix(":"), nl, words("error:")] ++
color_as_subject([words("submodule"),
qual_sym_name(InclModuleName), suffix(",")]) ++
[words("included here as separate submodule,")],
(
OldEntry = split_nested(OldSplitNested, _, _),
OldContext = split_nested_info_get_context(OldSplitNested),
Pieces2 = color_as_incorrect([words("was previously declared"),
words("to be a nested submodule.")]) ++ [nl]
;
OldEntry = split_included(OldContext),
Pieces2 = color_as_incorrect([words("has already been declared"),
words("to be a separate submodule.")]) ++ [nl]
),
OldPieces = [words("This is the location"),
words("of that previous declaration."), nl],
Msg = msg(Context, Pieces1 ++ Pieces2),
OldMsg = msg(OldContext, OldPieces),
Spec = error_spec($pred, severity_error, phase_pt2h, [Msg, OldMsg]),
!:Specs = [Spec | !.Specs]
else
Entry = split_included(Context),
map.det_insert(InclModuleName, Entry, !SplitModuleMap),
add_new_submodule_to_map(SectionAncestors, InclModuleName,
!SubModulesMap),
cord.snoc(Include, !OKIncludesCord)
),
discover_included_submodules(Includes, SectionAncestors,
!OKIncludesCord, !SplitModuleMap, !SubModulesMap, !Specs).
%---------------------------------------------------------------------------%
%
% Operations on the data structures needed for phase one.
%
:- pred add_new_module_maybe_submodule_to_map(module_ancestors::in,
module_name::in,
module_to_submodules_map::in, module_to_submodules_map::out) is det.
add_new_module_maybe_submodule_to_map(ModuleAncestors, ModuleName,
!SubModulesMap) :-
(
ModuleAncestors = ma_no_parent
;
ModuleAncestors =
ma_parent(_SectionKind, _SectionContext, SectionAncestors),
add_new_submodule_to_map(SectionAncestors, ModuleName, !SubModulesMap)
).
:- pred add_new_submodule_to_map(section_ancestors::in, module_name::in,
module_to_submodules_map::in, module_to_submodules_map::out) is det.
add_new_submodule_to_map(SectionAncestors, ModuleName, !SubModulesMap) :-
SectionAncestors = sa_parent(ParentModuleName, _),
( if map.search(!.SubModulesMap, ParentModuleName, SiblingModules0) then
cord.snoc(ModuleName, SiblingModules0, SiblingModules),
map.det_update(ParentModuleName, SiblingModules, !SubModulesMap)
else
SiblingModules = cord.singleton(ModuleName),
map.det_insert(ParentModuleName, SiblingModules, !SubModulesMap)
).
%---------------------%
% If the two entries differ in section, return the entry for the interface.
% Otherwise, return the entry with the earlier context.
%
:- pred combine_submodule_include_infos(
submodule_include_info::in, submodule_include_info::in,
submodule_include_info::out) is det.
combine_submodule_include_infos(EntryA, EntryB, Entry) :-
EntryA = submodule_include_info(SectionA, ContextA),
EntryB = submodule_include_info(SectionB, ContextB),
(
SectionA = ms_interface,
SectionB = ms_implementation,
Entry = EntryA
;
SectionA = ms_implementation,
SectionB = ms_interface,
Entry = EntryB
;
(
SectionA = ms_interface,
SectionB = ms_interface
;
SectionA = ms_implementation,
SectionB = ms_implementation
),
compare(CmpResult, ContextA, ContextB),
(
CmpResult = (<),
Entry = EntryA
;
( CmpResult = (=)
; CmpResult = (>)
),
Entry = EntryB
)
).
%---------------------%
% Is this section in the interface section of some ancestor?
% If yes, return the name of the closest such ancestor.
%
:- pred section_has_some_ancestor_in_interface(section_ancestors::in,
maybe(module_name)::out) is det.
section_has_some_ancestor_in_interface(SectionAncestors,
MaybeInterfaceAncestor) :-
SectionAncestors = sa_parent(_ModuleName, ModuleAncestors),
(
ModuleAncestors = ma_no_parent,
MaybeInterfaceAncestor = no
;
ModuleAncestors = ma_parent(SectionKind, _SectionContext,
SectionParentAncestors),
(
SectionKind = ms_interface,
SectionParentAncestors = sa_parent(InterfaceAncestor, _),
MaybeInterfaceAncestor = yes(InterfaceAncestor)
;
SectionKind = ms_implementation,
section_has_some_ancestor_in_interface(SectionParentAncestors,
MaybeInterfaceAncestor)
)
).
%---------------------%
:- func split_nested_info_get_context(split_nested_info) = prog_context.
split_nested_info_get_context(SplitNested) = Context :-
( SplitNested = split_nested_top_module(Context)
; SplitNested = split_nested_empty(Context)
; SplitNested = split_nested_only_int(Context)
; SplitNested = split_nested_only_imp(Context)
; SplitNested = split_nested_int_imp(Context, _)
).
%---------------------------------------------------------------------------%
% PHASE TWO
%
% The next section contains the data structures and the code of phase two,
% which constructs the final list of parse_tree_module_srcs.
%---------------------------------------------------------------------------%
:- pred create_component_modules_depth_first(globals::in,
module_name::in, split_module_map::in, split_module_map::out,
module_to_submodules_map::in, module_to_submodules_map::out,
cord(parse_tree_module_src)::in, cord(parse_tree_module_src)::out,
list(error_spec)::in, list(error_spec)::out) is det.
create_component_modules_depth_first(Globals, ModuleName,
!SplitModuleMap, !SubModulesMap, !ParseTreeModuleSrcCord, !Specs) :-
map.det_remove(ModuleName, Entry, !SplitModuleMap),
(
Entry = split_included(_),
map.delete(ModuleName, !SubModulesMap)
;
Entry = split_nested(NestedInfo, RawItemBlockCord0, SubInclInfoMap),
add_includes_for_nested_submodules(ModuleName, SubInclInfoMap,
RawItemBlockCord0, RawItemBlockCord),
RawItemBlocks = cord.list(RawItemBlockCord),
(
( NestedInfo = split_nested_top_module(Context)
; NestedInfo = split_nested_only_int(Context)
; NestedInfo = split_nested_int_imp(Context, _)
; NestedInfo = split_nested_empty(Context)
)
;
NestedInfo = split_nested_only_imp(Context),
Pieces = [words("Error: submodule")] ++
color_as_subject([qual_sym_name(ModuleName)]) ++
[words("is")] ++
color_as_incorrect(
[words("missing its interface section.")]) ++
[nl],
Spec = spec($pred, severity_error, phase_pt2h, Context, Pieces),
!:Specs = [Spec | !.Specs]
),
% The reason why we do this even for split_nested_empty is that
% if we don't create and return ParseTreeModuleSrc (which will
% be empty in this case, except for whatever may have been added
% by the call to add_includes_for_nested_submodules above),
% then the rest of the compiler won't know that e.g. it needs to
% create interface files for the empty module. That would lead to
% the failure of the submodule/deeply_nested test case.
%
% The reason why we do this for split_nested_only_imp is to prevent
% any complaints by warn_about_any_unread_modules_with_read_ancestors.
RawCompUnit = raw_compilation_unit(ModuleName, Context,
RawItemBlocks),
check_convert_raw_comp_unit_to_module_src(Globals, RawCompUnit,
ParseTreeModuleSrc, !Specs),
cord.snoc(ParseTreeModuleSrc, !ParseTreeModuleSrcCord),
( if map.remove(ModuleName, SubModulesCord, !SubModulesMap) then
list.sort_and_remove_dups(cord.list(SubModulesCord), SubModules),
list.foldl4(
create_component_modules_depth_first(Globals),
SubModules, !SplitModuleMap, !SubModulesMap,
!ParseTreeModuleSrcCord, !Specs)
else
% ModuleName has no submodules for us to process.
true
)
).
%---------------------%
:- pred add_includes_for_nested_submodules(module_name::in,
submodule_include_info_map::in,
cord(raw_item_block)::in, cord(raw_item_block)::out) is det.
add_includes_for_nested_submodules(ModuleName, SubInclInfoMap,
!RawItemBlockCord) :-
% Do not add new include_module items for module names that
% already have them in the same section.
%
% Having both an explicit include_module item and a submodule declaration
% for the same (sub)module name is an error, but this should have been
% already discovered and reported by the time we get called.
list.foldl2(acc_included_module_names, cord.list(!.RawItemBlockCord),
set.init, IntMods, set.init, ImpMods),
map.foldl2(
submodule_include_info_map_to_item_includes_acc(IntMods, ImpMods),
SubInclInfoMap, [], RevIntIncludes, [], RevImpIncludes),
list.reverse(RevIntIncludes, IntIncludes),
list.reverse(RevImpIncludes, ImpIncludes),
(
IntIncludes = []
;
IntIncludes = [_ | _],
IntItemBlock = item_block(ModuleName, ms_interface, IntIncludes,
[], [], []),
cord.snoc(IntItemBlock, !RawItemBlockCord)
),
(
ImpIncludes = []
;
ImpIncludes = [_ | _],
ImpItemBlock = item_block(ModuleName, ms_implementation, ImpIncludes,
[], [], []),
cord.snoc(ImpItemBlock, !RawItemBlockCord)
).
:- pred acc_included_module_names(raw_item_block::in,
set(module_name)::in, set(module_name)::out,
set(module_name)::in, set(module_name)::out) is det.
acc_included_module_names(RawItemBlock, !IntMods, !ImpMods) :-
RawItemBlock = item_block(_, Section, Incls, _Avails, _FIMs, _Items),
Modules = list.map(item_include_module_name, Incls),
(
Section = ms_interface,
set.insert_list(Modules, !IntMods)
;
Section = ms_implementation,
set.insert_list(Modules, !ImpMods)
).
:- pred submodule_include_info_map_to_item_includes_acc(
set(module_name)::in, set(module_name)::in,
module_name::in, submodule_include_info::in,
list(item_include)::in, list(item_include)::out,
list(item_include)::in, list(item_include)::out) is det.
submodule_include_info_map_to_item_includes_acc(IntMods, ImpMods,
ModuleName, SubInclInfo, !RevIntIncludes, !RevImpIncludes) :-
SubInclInfo = submodule_include_info(SectionKind, Context),
Incl = item_include(ModuleName, Context, item_no_seq_num),
(
SectionKind = ms_interface,
( if set.contains(IntMods, ModuleName) then
true
else
!:RevIntIncludes = [Incl | !.RevIntIncludes]
)
;
SectionKind = ms_implementation,
( if set.contains(ImpMods, ModuleName) then
true
else
!:RevImpIncludes = [Incl | !.RevImpIncludes]
)
).
%---------------------------------------------------------------------------%
% ERROR REPORTING
%---------------------------------------------------------------------------%
:- pred warn_empty_submodule(module_name::in, prog_context::in,
module_name::in, list(error_spec)::in, list(error_spec)::out) is det.
warn_empty_submodule(ModuleName, Context, ParentModuleName, !Specs) :-
Pieces = [words("Warning:")] ++
color_as_subject([words("submodule"), qual_sym_name(ModuleName)]) ++
[words("of"), words("module"), qual_sym_name(ParentModuleName),
words("is")] ++
color_as_incorrect([words("empty.")]) ++
[nl],
Spec = spec($pred, severity_warning(warn_nothing_exported),
phase_pt2h, Context, Pieces),
!:Specs = [Spec | !.Specs].
%---------------------%
:- pred warn_duplicate_of_empty_submodule(module_name::in, module_name::in,
prog_context::in, prog_context::in,
list(error_spec)::in, list(error_spec)::out) is det.
warn_duplicate_of_empty_submodule(ModuleName, ParentModuleName,
Context, EmptyContext, !Specs) :-
Pieces1 = [words("Warning:")] ++
color_as_subject([words("submodule"), qual_sym_name(ModuleName)]) ++
[words("of"), words("module"), qual_sym_name(ParentModuleName)] ++
color_as_incorrect([words("duplicates")]) ++
[words("an empty submodule."), nl],
Msg1 = msg(Context, Pieces1),
Pieces2 = [words("This is the location of the empty submodule,"), nl],
Msg2 = msg(EmptyContext, Pieces2),
Spec = error_spec($pred, severity_warning(warn_nothing_exported),
phase_pt2h, [Msg1, Msg2]),
!:Specs = [Spec | !.Specs].
%---------------------%
:- type duplicated_section
---> dup_empty
; dup_int_only
; dup_imp_only
; dup_int_imp.
:- pred report_duplicate_submodule(module_name::in, prog_context::in,
duplicated_section::in, module_name::in, split_module_entry::in,
list(error_spec)::in, list(error_spec)::out) is det.
report_duplicate_submodule(ModuleName, Context, DupSection,
ParentModuleName, OldEntry, !Specs) :-
(
OldEntry = split_included(OldContext),
Pieces = [words("In module"), qual_sym_name(ParentModuleName),
suffix(":"), nl, words("error:")] ++
color_as_subject([words("submodule"), qual_sym_name(ModuleName),
suffix(",")]) ++
[words("declared here as a nested submodule,")] ++
color_as_incorrect([words("was previously declared to be"),
words("a separate submodule.")]) ++
[nl],
OldPieces = [words("This is the location"),
words("of that previous declaration."), nl],
Msg = msg(Context, Pieces),
OldMsg = msg(OldContext, OldPieces),
Spec = error_spec($pred, severity_error, phase_pt2h, [Msg, OldMsg])
;
OldEntry = split_nested(SplitNested, _, _),
(
DupSection = dup_empty,
OldContext = split_nested_info_get_context(SplitNested),
Pieces = [words("In module"), qual_sym_name(ParentModuleName),
suffix(":"), nl, words("error:"), words("the empty nested")] ++
color_as_subject([words("submodule"),
qual_sym_name(ModuleName)]) ++
[words("is a")] ++
color_as_incorrect([words("duplicate")]) ++
[words("of a previous declaration of that module."), nl],
OldPieces = [words("That previous declaration was here."), nl],
Msg = msg(Context, Pieces),
OldMsg = msg(OldContext, OldPieces),
Spec = error_spec($pred, severity_error, phase_pt2h, [Msg, OldMsg])
;
DupSection = dup_int_only,
report_duplicate_submodule_one_section(ModuleName, Context,
ms_interface, ParentModuleName, SplitNested, Spec)
;
DupSection = dup_imp_only,
report_duplicate_submodule_one_section(ModuleName, Context,
ms_implementation, ParentModuleName, SplitNested, Spec)
;
DupSection = dup_int_imp,
(
SplitNested = split_nested_top_module(_OldContext),
report_duplicate_submodule_vs_top(ModuleName, Context,
ParentModuleName, Spec)
;
SplitNested = split_nested_empty(_OldContext),
% An empty submodule should not duplicate either an interface
% or an implementation section.
unexpected($pred, "split_nested_empty duplicates a section")
;
SplitNested = split_nested_only_int(_OldContext),
report_duplicate_submodule_one_section(ModuleName, Context,
ms_interface, ParentModuleName, SplitNested, Spec)
;
SplitNested = split_nested_only_imp(_OldContext),
report_duplicate_submodule_one_section(ModuleName, Context,
ms_implementation, ParentModuleName, SplitNested, Spec)
;
SplitNested = split_nested_int_imp(IntContext, ImpContext),
report_duplicate_submodule_both_sections(ModuleName, Context,
ParentModuleName, IntContext, ImpContext, Spec)
)
)
),
!:Specs = [Spec | !.Specs].
:- pred report_duplicate_submodule_one_section(module_name::in,
prog_context::in, module_section::in, module_name::in,
split_nested_info::in, error_spec::out) is det.
report_duplicate_submodule_one_section(ModuleName, Context, Section,
ParentModuleName, SplitNested, Spec) :-
(
SplitNested = split_nested_top_module(_OldContext),
report_duplicate_submodule_vs_top(ModuleName, Context,
ParentModuleName, Spec)
;
SplitNested = split_nested_empty(_OldContext),
% An empty submodule should not duplicate either an interface
% or an implementation section.
unexpected($pred, "split_nested_empty duplicates a section")
;
(
SplitNested = split_nested_only_int(IntContext),
(
Section = ms_interface,
SectionWord = "interface",
OldContext = IntContext
;
Section = ms_implementation,
unexpected($pred, "duplicate int without duplication")
),
report_duplicate_submodule_one_section_2(ModuleName, Context,
SectionWord, ParentModuleName, OldContext, Spec)
;
SplitNested = split_nested_only_imp(ImpContext),
(
Section = ms_interface,
unexpected($pred, "duplicate imp without duplication")
;
Section = ms_implementation,
SectionWord = "implementation",
OldContext = ImpContext
),
report_duplicate_submodule_one_section_2(ModuleName, Context,
SectionWord, ParentModuleName, OldContext, Spec)
;
SplitNested = split_nested_int_imp(IntContext, ImpContext),
(
Section = ms_interface,
SectionWord = "interface",
OldContext = IntContext
;
Section = ms_implementation,
SectionWord = "implementation",
OldContext = ImpContext
),
report_duplicate_submodule_one_section_2(ModuleName, Context,
SectionWord, ParentModuleName, OldContext, Spec)
)
).
:- pred report_duplicate_submodule_one_section_2(module_name::in,
prog_context::in, string::in, module_name::in, prog_context::in,
error_spec::out) is det.
report_duplicate_submodule_one_section_2(ModuleName, Context,
SectionWord, ParentModuleName, OldContext, Spec) :-
Pieces = [words("In module"), qual_sym_name(ParentModuleName),
suffix(":"), nl, words("error: nested submodule")] ++
color_as_subject([qual_sym_name(ModuleName)]) ++
[words("has its"), fixed(SectionWord), words("declared")] ++
color_as_inconsistent([words("here.")]) ++
[nl],
OldPieces = [words("However, its"), fixed(SectionWord), words("was"),
words("also declared")] ++
color_as_inconsistent([words("here.")]) ++
[nl],
Msg = msg(Context, Pieces),
OldMsg = msg(OldContext, OldPieces),
Spec = error_spec($pred, severity_error, phase_pt2h, [Msg, OldMsg]).
:- pred report_duplicate_submodule_both_sections(module_name::in,
prog_context::in, module_name::in, prog_context::in, prog_context::in,
error_spec::out) is det.
report_duplicate_submodule_both_sections(ModuleName, Context,
ParentModuleName, OldIntContext, OldImpContext, Spec) :-
Pieces = [words("In module"), qual_sym_name(ParentModuleName),
suffix(":"), nl, words("error: nested submodule")] ++
color_as_subject([qual_sym_name(ModuleName)]) ++
[words("has both its interface and its implementation"),
words("declared")] ++
color_as_inconsistent([words("here.")]) ++
[nl],
( if OldIntContext = OldImpContext then
OldPieces = [words("However, its interface and implementation"),
words("were also declared")] ++
color_as_inconsistent([words("here.")]) ++
[nl],
Msg = msg(Context, Pieces),
OldMsg = msg(OldIntContext, OldPieces),
Spec = error_spec($pred, severity_error, phase_pt2h, [Msg, OldMsg])
else
OldIntPieces = [words("However, its interface"),
words("was also declared")] ++
color_as_inconsistent([words("here,")]) ++
[nl],
OldImpPieces = [words("and its implementation"),
words("was also declared")] ++
color_as_inconsistent([words("here.")]) ++
[nl],
Msg = msg(Context, Pieces),
OldIntMsg = msg(OldIntContext, OldIntPieces),
OldImpMsg = msg(OldImpContext, OldImpPieces),
Spec = error_spec($pred, severity_error, phase_pt2h,
[Msg, OldIntMsg, OldImpMsg])
).
:- pred report_duplicate_submodule_vs_top(module_name::in, prog_context::in,
module_name::in, error_spec::out) is det.
report_duplicate_submodule_vs_top(ModuleName, Context, ParentModuleName,
Spec) :-
Pieces = [words("In module"), qual_sym_name(ParentModuleName),
suffix(":"), nl, words("error: nested submodule")] ++
color_as_subject([qual_sym_name(ModuleName)]) ++
color_as_incorrect([words("has the same name")]) ++
[words("as its ancestor module."), nl],
Spec = spec($pred, severity_error, phase_pt2h, Context, Pieces).
%---------------------------------------------------------------------------%
:- end_module parse_tree.split_parse_tree_src.
%---------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink