%---------------------------------------------------------------------------% % 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 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), 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. %---------------------------------------------------------------------------%