mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-15 09:23:44 +00:00
Code Issues Projects Releases Wiki Activity
Files
a1849e6ca25384ff1ccf0f4552b71a880d97f2e7
mercury/compiler/split_parse_tree_src.m
Zoltan Somogyi f4acef12d0 Fix too-long lines.
2025-09-23 15:17:49 +10:00

1133 lines
49 KiB
Mathematica
Raw Blame History

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2015, 2017-2025 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 parent_module_context
---> no_parent_top_level
; in_parent_interface
; in_parent_implementation.
:- 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),
!:RawItemBlockCord = cord.snoc(!.RawItemBlockCord, RawItemBlock),
(
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),
!:OKIncludesCord = cord.snoc(!.OKIncludesCord, Include)
),
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
SiblingModules = cord.snoc(SiblingModules0, ModuleName),
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,
[], [], []),
!:RawItemBlockCord = cord.snoc(!.RawItemBlockCord, IntItemBlock)
),
(
ImpIncludes = []
;
ImpIncludes = [_ | _],
ImpItemBlock = item_block(ModuleName, ms_implementation, ImpIncludes,
[], [], []),
!:RawItemBlockCord = cord.snoc(!.RawItemBlockCord, ImpItemBlock)
).
:- 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