[m-rev.] for review: fix bug #230
Peter Wang
novalazy at gmail.com
Tue Nov 22 14:19:13 AEDT 2011
Julien, I assume this fix would be too intrusive for 11.07, so you
should go ahead with disabling the direct arg functor optimisation there.
Branches: main
Fix bug #230. When compiling a sub-module we could incorrectly use the
direct argument functor representation for a d.u. functor when:
1. the outer type is defined and exported from an ancestor module, and
2. the functor argument type is defined in the same ancestor module,
but NOT exported.
e.g.
:- module ancestor.
:- interface.
:- type outer ---> f(inner) ; ... .
:- implementation.
:- type inner ---> inner( ... ).
To solve the problem, the sub-module must be able to distinguish between type
definitions which are available from the ancestor module's public interface,
and type definitions which the ancestor only exported to sub-modules.
The distinction was not apparent in the `.int0' private interface files --
all items were contained into a single interface section, no matter
where they came from in the original source file.
This change separates `.int0' files into two sections: the interface section
for items in the public interface, and the implementation section for items in
the private interface.
compiler/modules.m:
Change `.int0' files to have two sections as described.
Sort the contents of the individual sections.
compiler/add_type.m:
Do not let other statuses override
`status_imported(import_locn_ancestor_private_interface_proper)'.
compiler/make_tags.m:
Fix the main bug described.
Fix a bug where a type with `status_abstract_exported' was not
considered exported-to-submodules, which it is.
compiler/prog_data.m:
Rename and clarify that `import_locn_ancestor_private_interface_proper'
really, really means that it came from the actual, true, and proper
private interface of a module and nowhere else.
compiler/prog_item.m:
Rename `md_private_interface' to what it really means.
compiler/equiv_type.m:
compiler/hlds_out_pred.m:
compiler/hlds_pred.m:
compiler/make_hlds_passes.m:
compiler/mercury_to_mercury.m:
compiler/module_qual.m:
Conform to changes.
tests/hard_coded/Mmakefile:
tests/hard_coded/daf_bug.exp:
tests/hard_coded/daf_bug.m:
tests/hard_coded/daf_bug_parent.m:
tests/hard_coded/daf_bug_sub.m:
Add test case.
tests/invalid/ii_parent.ii_child.err_exp:
Update expected output.
diff --git a/compiler/add_type.m b/compiler/add_type.m
index c46083f..215fdf3 100644
--- a/compiler/add_type.m
+++ b/compiler/add_type.m
@@ -550,8 +550,19 @@ combine_status(StatusA, StatusB, Status) :-
:- pred combine_status_2(import_status::in, import_status::in,
import_status::out) is semidet.
-combine_status_2(status_imported(_), Status2, Status) :-
- combine_status_imported(Status2, Status).
+combine_status_2(status_imported(ImportLocn), Status2, Status) :-
+ require_complete_switch [ImportLocn]
+ (
+ ( ImportLocn = import_locn_implementation
+ ; ImportLocn = import_locn_interface
+ ; ImportLocn = import_locn_ancestor
+ ),
+ combine_status_imported_non_private(Status2, Status)
+ ;
+ ImportLocn = import_locn_ancestor_private_interface_proper,
+ % If it's private, it's private.
+ Status = status_imported(import_locn_ancestor_private_interface_proper)
+ ).
combine_status_2(status_local, Status2, Status) :-
combine_status_local(Status2, Status).
combine_status_2(status_exported, _Status2, status_exported).
@@ -568,17 +579,29 @@ combine_status_2(status_abstract_imported, Status2, Status) :-
combine_status_2(status_abstract_exported, Status2, Status) :-
combine_status_abstract_exported(Status2, Status).
-:- pred combine_status_imported(import_status::in, import_status::out)
- is semidet.
+:- pred combine_status_imported_non_private(import_status::in,
+ import_status::out) is semidet.
-combine_status_imported(status_imported(Section), status_imported(Section)).
-combine_status_imported(status_local,
- status_imported(import_locn_implementation)).
-combine_status_imported(status_exported, status_exported).
-combine_status_imported(status_opt_imported, status_opt_imported).
-combine_status_imported(status_abstract_imported,
- status_imported(import_locn_interface)).
-combine_status_imported(status_abstract_exported, status_abstract_exported).
+combine_status_imported_non_private(Status2, Status) :-
+ (
+ Status2 = status_imported(Section),
+ Status = status_imported(Section)
+ ;
+ Status2 = status_local,
+ Status = status_imported(import_locn_implementation)
+ ;
+ Status2 = status_exported,
+ Status = status_exported
+ ;
+ Status2 = status_opt_imported,
+ Status = status_opt_imported
+ ;
+ Status2 = status_abstract_imported,
+ Status = status_imported(import_locn_interface)
+ ;
+ Status2 = status_abstract_exported,
+ Status = status_abstract_exported
+ ).
:- pred combine_status_local(import_status::in, import_status::out) is semidet.
diff --git a/compiler/equiv_type.m b/compiler/equiv_type.m
index 8fac69c..49db920 100644
--- a/compiler/equiv_type.m
+++ b/compiler/equiv_type.m
@@ -245,7 +245,7 @@ skip_abstract_imported_items([Item0 | Items0], Items) :-
is_section_defn(md_interface) = yes.
is_section_defn(md_implementation) = yes.
-is_section_defn(md_private_interface) = yes.
+is_section_defn(md_implementation_but_exported_to_submodules) = yes.
is_section_defn(md_imported(_)) = yes.
is_section_defn(md_used(_)) = yes.
is_section_defn(md_abstract_imported) = yes.
@@ -282,7 +282,7 @@ replace_in_item_list(ModuleName, Location0, [Item0 | Items0],
Location = eqv_type_in_interface
;
( ModuleDefn = md_implementation
- ; ModuleDefn = md_private_interface
+ ; ModuleDefn = md_implementation_but_exported_to_submodules
),
Location = eqv_type_in_implementation
;
diff --git a/compiler/hlds_out_pred.m b/compiler/hlds_out_pred.m
index 75c3f04..288ca69 100644
--- a/compiler/hlds_out_pred.m
+++ b/compiler/hlds_out_pred.m
@@ -498,7 +498,7 @@ import_status_to_string(status_imported(import_locn_interface)) =
import_status_to_string(status_imported(import_locn_implementation)) =
"imported in the implementation".
import_status_to_string(status_imported(
- import_locn_ancestor_private_interface)) =
+ import_locn_ancestor_private_interface_proper)) =
"imported from an ancestor's private interface".
import_status_to_string(status_imported(import_locn_ancestor)) =
"imported by an ancestor".
diff --git a/compiler/hlds_pred.m b/compiler/hlds_pred.m
index 1d533fc..ffec4fc 100644
--- a/compiler/hlds_pred.m
+++ b/compiler/hlds_pred.m
@@ -250,7 +250,8 @@
% due to its presence in the .opt files
% (intermod.adjust_pred_import_status).
; status_abstract_exported
- % Describes a type with only an abstract declaration exported.
+ % Describes a type with only an abstract declaration exported
+ % to non-sub-modules. It *is* exported to sub-modules.
; status_pseudo_exported
% The converse of pseudo_imported; this means that only the
% (in, in) mode of a unification is exported.
@@ -965,8 +966,8 @@ status_defined_in_impl_section(status_imported(ImportLocn)) =
import_locn_defined_in_impl_section(import_locn_implementation) = yes.
import_locn_defined_in_impl_section(import_locn_interface) = yes.
import_locn_defined_in_impl_section(import_locn_ancestor) = yes.
-import_locn_defined_in_impl_section(import_locn_ancestor_private_interface)
- = yes.
+import_locn_defined_in_impl_section(
+ import_locn_ancestor_private_interface_proper) = yes.
calls_are_fully_qualified(Markers) =
( check_marker(Markers, marker_calls_are_fully_qualified) ->
diff --git a/compiler/make_hlds_passes.m b/compiler/make_hlds_passes.m
index f724793..8da5abe 100644
--- a/compiler/make_hlds_passes.m
+++ b/compiler/make_hlds_passes.m
@@ -729,7 +729,7 @@ add_pass_1_module_defn(ItemModuleDefn, !Status, !ModuleInfo, !Specs) :-
;
( ModuleDefn = md_interface
; ModuleDefn = md_implementation
- ; ModuleDefn = md_private_interface
+ ; ModuleDefn = md_implementation_but_exported_to_submodules
; ModuleDefn = md_imported(_)
; ModuleDefn = md_used(_)
; ModuleDefn = md_opt_imported
@@ -915,7 +915,7 @@ add_solver_type_mutable_items_pass_1([Item | Items], !Status,
add_module_specifiers(Specifiers, IStat, !ModuleInfo) :-
( status_defined_in_this_module(IStat) = yes ->
module_add_imported_module_specifiers(IStat, Specifiers, !ModuleInfo)
- ; IStat = status_imported(import_locn_ancestor_private_interface) ->
+ ; IStat = status_imported(import_locn_ancestor_private_interface_proper) ->
module_add_imported_module_specifiers(IStat, Specifiers, !ModuleInfo),
% Any import_module which comes from a private interface
@@ -3150,7 +3150,7 @@ module_defn_update_import_status(ModuleDefn, Status) :-
ModuleDefn = md_implementation,
Status = item_status(status_local, may_be_unqualified)
;
- ModuleDefn = md_private_interface,
+ ModuleDefn = md_implementation_but_exported_to_submodules,
Status = item_status(status_exported_to_submodules, may_be_unqualified)
;
ModuleDefn = md_imported(Section),
diff --git a/compiler/make_tags.m b/compiler/make_tags.m
index ef66d01..9e13589 100644
--- a/compiler/make_tags.m
+++ b/compiler/make_tags.m
@@ -668,6 +668,7 @@ is_direct_arg_ctor(TypeTable, TypeCtorModule, TypeStatus,
is semidet.
check_direct_arg_cond(TypeStatus, ArgCond) :-
+ require_complete_switch [TypeStatus]
(
% If the outer type _definition_ is not exported from this module then
% the direct arg representation may be used. In the absence of
@@ -694,9 +695,13 @@ check_direct_arg_cond(TypeStatus, ArgCond) :-
( ArgCond = direct_arg_builtin_type
; ArgCond = direct_arg_asserted
; ArgCond = direct_arg_same_module(status_exported)
- ; ArgCond = direct_arg_same_module(TypeStatus)
- % If the outer type is exported to sub-modules only, the argument
- % type only needs to be exported to sub-modules as well.
+ )
+ ;
+ % If the outer type is exported to sub-modules only, the argument
+ % type only needs to be exported to sub-modules as well.
+ TypeStatus = status_exported_to_submodules,
+ ( ArgCond = direct_arg_same_module(status_exported_to_submodules)
+ ; ArgCond = direct_arg_same_module(status_abstract_exported)
)
;
% The direct arg representation is required if the outer type is
@@ -704,10 +709,22 @@ check_direct_arg_cond(TypeStatus, ArgCond) :-
% - if the argument type is an acceptable builtin type
% - a `where direct_arg' attribute says so
% - if the argument type is imported from the same module
- TypeStatus = status_imported(_),
- ( ArgCond = direct_arg_builtin_type
- ; ArgCond = direct_arg_asserted
- ; ArgCond = direct_arg_same_module(status_imported(_))
+ TypeStatus = status_imported(TypeImportLocn),
+ (
+ ArgCond = direct_arg_builtin_type
+ ;
+ ArgCond = direct_arg_asserted
+ ;
+ ArgCond = direct_arg_same_module(status_imported(ArgImportLocn)),
+ % If the argument type is only exported by an ancestor to its
+ % sub-modules (of which we are one), the outer type must also only
+ % be exported to sub-modules. Otherwise sub-modules and
+ % non-sub-modules would infer different things.
+ (
+ ArgImportLocn = import_locn_ancestor_private_interface_proper
+ =>
+ TypeImportLocn = import_locn_ancestor_private_interface_proper
+ )
)
;
% If the outer type is opt-imported, there will always be a
@@ -717,6 +734,12 @@ check_direct_arg_cond(TypeStatus, ArgCond) :-
; TypeStatus = status_abstract_imported
),
ArgCond = direct_arg_asserted
+ ;
+ ( TypeStatus = status_external(_)
+ ; TypeStatus = status_pseudo_exported
+ ; TypeStatus = status_pseudo_imported
+ ),
+ unexpected($module, $pred, "inappropriate status for type")
).
:- pred assign_direct_arg_tags(type_ctor::in, list(constructor)::in,
diff --git a/compiler/mercury_to_mercury.m b/compiler/mercury_to_mercury.m
index 92731eb..14b6596 100644
--- a/compiler/mercury_to_mercury.m
+++ b/compiler/mercury_to_mercury.m
@@ -1166,9 +1166,9 @@ mercury_output_module_defn(ModuleDefn, _Context, !IO) :-
( ModuleDefn = md_abstract_imported
; ModuleDefn = md_export(_)
; ModuleDefn = md_external(_, _)
+ ; ModuleDefn = md_implementation_but_exported_to_submodules
; ModuleDefn = md_imported(_)
; ModuleDefn = md_opt_imported
- ; ModuleDefn = md_private_interface
; ModuleDefn = md_transitively_imported
; ModuleDefn = md_used(_)
),
diff --git a/compiler/module_qual.m b/compiler/module_qual.m
index d7cdab2..4606f31 100644
--- a/compiler/module_qual.m
+++ b/compiler/module_qual.m
@@ -456,7 +456,7 @@ process_module_defn(md_include_module(ModuleNameList), !Info) :-
list.foldl(add_module_defn, ModuleNameList, !Info).
process_module_defn(md_interface, !Info) :-
mq_info_set_import_status(mq_status_exported, !Info).
-process_module_defn(md_private_interface, !Info) :-
+process_module_defn(md_implementation_but_exported_to_submodules, !Info) :-
mq_info_set_import_status(mq_status_local, !Info).
process_module_defn(md_implementation, !Info) :-
mq_info_set_import_status(mq_status_local, !Info).
@@ -498,13 +498,14 @@ add_module_defn(ModuleName, !Info) :-
add_imports(Imports, !Info) :-
mq_info_get_import_status(!.Info, Status),
- % Modules imported from the the private interface of ancestors of
+ % Modules imported from the the proper private interface of ancestors of
% the current module are treated as if they were directly imported
% by the current module.
(
( Status = mq_status_local
; Status = mq_status_exported
- ; Status = mq_status_imported(import_locn_ancestor_private_interface)
+ ; Status = mq_status_imported(
+ import_locn_ancestor_private_interface_proper)
)
->
mq_info_get_imported_modules(!.Info, Modules0),
@@ -530,7 +531,8 @@ add_imports(Imports, !Info) :-
% interface of ancestor modules may be used in the interface.
(
( Status = mq_status_exported
- ; Status = mq_status_imported(import_locn_ancestor_private_interface)
+ ; Status = mq_status_imported(
+ import_locn_ancestor_private_interface_proper)
)
->
mq_info_get_interface_visible_modules(!.Info, IntModules0),
@@ -977,7 +979,8 @@ update_import_status(md_interface, !Info, yes) :-
mq_info_set_import_status(mq_status_exported, !Info).
update_import_status(md_implementation, !Info, yes) :-
mq_info_set_import_status(mq_status_local, !Info).
-update_import_status(md_private_interface, !Info, yes) :-
+update_import_status(md_implementation_but_exported_to_submodules, !Info, yes)
+ :-
mq_info_set_import_status(mq_status_local, !Info).
update_import_status(md_imported(_), !Info, no).
update_import_status(md_used(_), !Info, no).
diff --git a/compiler/modules.m b/compiler/modules.m
index 679ba68..fc62b30 100644
--- a/compiler/modules.m
+++ b/compiler/modules.m
@@ -445,20 +445,31 @@ make_private_interface(Globals, SourceFileName, SourceFileModuleName,
%
% XXX The following sequence of operations relies on the fact that
% any reversals done while processing it are undone by subsequent
- % operations. Also, we should sort the contents of the .int0 file
- % as we do for the other types of interface file. We don't do that
- % at the moment because the code for doing that cannot handle
- % the structure of lists of items that represent private
- % interfaces.
+ % operations.
strip_imported_items(Items2, Items3),
- strip_clauses_from_interface(Items3, Items4),
- handle_mutables_in_private_interface(ModuleName, Items4, Items5),
- list.map(make_any_instances_abstract, Items5, Items6),
- list.reverse(Items6, Items),
+ some [!IntItems, !ImplItems] (
+ list.foldl3(strip_clauses_private_interface, Items3,
+ section_interface, _Section,
+ [], !:IntItems, [], !:ImplItems),
+ handle_mutables_in_private_interface(ModuleName, !IntItems),
+ handle_mutables_in_private_interface(ModuleName, !ImplItems),
+ list.map(make_any_instances_abstract, !IntItems),
+ list.map(make_any_instances_abstract, !ImplItems),
+ order_items(!IntItems),
+ order_items(!ImplItems),
+ Items4 = [make_pseudo_decl(md_interface) | !.IntItems],
+ (
+ !.ImplItems = [],
+ Items = Items4
+ ;
+ !.ImplItems = [_ | _],
+ Items = Items4 ++
+ [make_pseudo_decl(md_implementation) | !.ImplItems]
+ )
+ ),
write_interface_file(Globals, SourceFileName, ModuleName,
- ".int0", MaybeTimestamp,
- [make_pseudo_decl(md_interface) | Items], !IO),
+ ".int0", MaybeTimestamp, Items, !IO),
touch_interface_datestamp(Globals, ModuleName, ".date0", !IO)
)
).
@@ -480,7 +491,7 @@ make_any_instances_abstract(Item0, Item) :-
:- pred handle_mutables_in_private_interface(module_name::in,
list(item)::in, list(item)::out) is det.
- handle_mutables_in_private_interface(ModuleName, !Items) :-
+handle_mutables_in_private_interface(ModuleName, !Items) :-
list.foldl(handle_mutable_in_private_interface(ModuleName), !.Items,
[], !:Items).
@@ -655,7 +666,7 @@ strip_imported_items_2([Item | Items], !RevItems) :-
% XXX Some of these should probably cause an error message.
( ModuleDefn = md_interface
; ModuleDefn = md_implementation
- ; ModuleDefn = md_private_interface
+ ; ModuleDefn = md_implementation_but_exported_to_submodules
; ModuleDefn = md_opt_imported
; ModuleDefn = md_transitively_imported
; ModuleDefn = md_external(_, _)
@@ -876,7 +887,7 @@ do_standardize_impl_items([Item | Items], !Unexpected,
; ModuleDefn = md_export(_)
; ModuleDefn = md_interface
; ModuleDefn = md_implementation
- ; ModuleDefn = md_private_interface
+ ; ModuleDefn = md_implementation_but_exported_to_submodules
; ModuleDefn = md_version_numbers(_, _)
),
!:Unexpected = yes
@@ -1540,22 +1551,78 @@ clause_in_interface_warning(ClauseOrPragma, Context) = Spec :-
Spec = error_spec(severity_warning, phase_term_to_parse_tree,
[simple_msg(Context, [always(Pieces)])]).
- % strip_clauses_from_interface is the same as
- % check_for_clauses_in_interface except that it doesn't issue any
- % warnings, and that it also strips out the `:- interface' and `:-
- % implementation' declarations.
+ % strip_clauses_private_interface is used when creating the private
+ % interface (`.int0') files for packages with sub-modules. It removes
+ % unnecessary items and separates interface and implementation items.
+ %
+ % The `.int0' file contains items which is available to any module in the
+ % interface section, and items which are only available to sub-modules in
+ % the implementation section. The term "private interface" is ambiguous:
+ % sometimes it refers to the `.int0' file which, as just explained,
+ % contains the public interface as well. The term "private interface
+ % proper" may be used to refer to the information in the implementation
+ % section of the `.int0' file.
%
- % This is used when creating the private interface (`.int0') files for
- % packages with sub-modules.
+ % (Historically, the `.int0' file did not distinguish between the public
+ % and private interfaces.)
%
% We treat initialise and finalise declarations as special kinds of
% clause, since they should always be grouped together with the clauses
% and should not appear in private interfaces.
%
-:- pred strip_clauses_from_interface(list(item)::in, list(item)::out) is det.
+:- pred strip_clauses_private_interface(item::in, section::in, section::out,
+ list(item)::in, list(item)::out, list(item)::in, list(item)::out) is det.
-strip_clauses_from_interface(Items0, Items) :-
- split_clauses_and_decls(Items0, _Clauses, Items).
+strip_clauses_private_interface(Item, !Section, !InterfaceItems, !ImplItems) :-
+ (
+ Item = item_module_defn(ItemModuleDefn),
+ ItemModuleDefn = item_module_defn_info(ModuleDefn, _, _),
+ (
+ ModuleDefn = md_interface,
+ !:Section = section_interface
+ ;
+ ModuleDefn = md_implementation,
+ !:Section = section_implementation
+ ;
+ ModuleDefn = md_import(_),
+ % Only imports listed in the implementation section will be
+ % directly imported by sub-modules. Import declarations in the
+ % interface section must be duplicated into the implementation
+ % section of the `.int0' file.
+ (
+ !.Section = section_interface,
+ list.cons(Item, !InterfaceItems),
+ list.cons(Item, !ImplItems)
+ ;
+ !.Section = section_implementation,
+ list.cons(Item, !ImplItems)
+ )
+ )
+ ->
+ true
+ ;
+ (
+ Item = item_clause(_)
+ ;
+ Item = item_pragma(ItemPragma),
+ ItemPragma = item_pragma_info(_, Pragma, _, _),
+ pragma_allowed_in_interface(Pragma) = no
+ ;
+ Item = item_initialise(_)
+ ;
+ Item = item_finalise(_)
+ )
+ ->
+ true
+ ;
+ (
+ !.Section = section_interface,
+ list.cons(Item, !InterfaceItems)
+ ;
+ !.Section = section_implementation,
+ list.cons(Item, !ImplItems)
+ )
+ ).
:- pred split_clauses_and_decls(list(item)::in,
list(item)::out, list(item)::out) is det.
@@ -1832,7 +1899,7 @@ grab_imported_modules(Globals, SourceFileName, SourceFileModuleName,
% we need to make everything in the implementation of this module
% exported_to_submodules. We do that by splitting out the
% implementation declarations and putting them in a special
- % `:- private_interface' section.
+ % `implementation_but_exported_to_submodules' section.
get_children(Items0, Children),
(
@@ -1843,7 +1910,8 @@ grab_imported_modules(Globals, SourceFileName, SourceFileModuleName,
split_clauses_and_decls(ImplItems, Clauses, ImplDecls),
Items1 =
[make_pseudo_decl(md_interface) | InterfaceItems] ++
- [make_pseudo_decl(md_private_interface) | ImplDecls] ++
+ [make_pseudo_decl(md_implementation_but_exported_to_submodules)
+ | ImplDecls] ++
[make_pseudo_decl(md_implementation) | Clauses],
!Module ^ mai_items_cord := cord.from_list(Items1)
),
@@ -1860,9 +1928,9 @@ grab_imported_modules(Globals, SourceFileName, SourceFileModuleName,
% to be visible in the current module.
process_module_private_interfaces(Globals, HaveReadModuleMap,
AncestorModules,
- make_pseudo_decl(
- md_imported(import_locn_ancestor_private_interface)),
- make_pseudo_decl(md_abstract_imported),
+ make_pseudo_decl(md_imported(import_locn_interface)),
+ make_pseudo_decl(md_imported(
+ import_locn_ancestor_private_interface_proper)),
IntImportedModules2, IntImportedModules,
IntUsedModules2, IntUsedModules, !Module, !IO),
@@ -1966,8 +2034,9 @@ grab_unqual_imported_modules(Globals, SourceFileName, SourceFileModuleName,
% First the .int0s for parent modules.
process_module_private_interfaces(Globals, HaveReadModuleMap, ParentDeps,
- make_pseudo_decl(md_imported(import_locn_ancestor_private_interface)),
- make_pseudo_decl(md_abstract_imported),
+ make_pseudo_decl(md_imported(import_locn_interface)),
+ make_pseudo_decl(md_imported(
+ import_locn_ancestor_private_interface_proper)),
[], ParentImportDeps, [], ParentUseDeps, !Module, !IO),
% Then the .int3s for `:- import'-ed modules.
@@ -3214,7 +3283,7 @@ get_accessible_children_2(!.Visible, [Item | Items], !IncludeDeps) :-
; ModuleDefn = md_used(_)
; ModuleDefn = md_interface
; ModuleDefn = md_implementation
- ; ModuleDefn = md_private_interface
+ ; ModuleDefn = md_implementation_but_exported_to_submodules
),
!:Visible = yes
;
@@ -3868,7 +3937,7 @@ include_in_int_file_implementation(Item) = Include :-
% XXX Some of these should yield an exception.
( ModuleDefn = md_interface
; ModuleDefn = md_implementation
- ; ModuleDefn = md_private_interface
+ ; ModuleDefn = md_implementation_but_exported_to_submodules
; ModuleDefn = md_imported(_)
; ModuleDefn = md_used(_)
; ModuleDefn = md_abstract_imported
@@ -4308,8 +4377,8 @@ reorderable_module_defn(ModuleDefn) = Reorderable :-
; ModuleDefn = md_imported(_)
; ModuleDefn = md_include_module(_)
; ModuleDefn = md_interface
+ ; ModuleDefn = md_implementation_but_exported_to_submodules
; ModuleDefn = md_opt_imported
- ; ModuleDefn = md_private_interface
; ModuleDefn = md_transitively_imported
; ModuleDefn = md_used(_)
; ModuleDefn = md_version_numbers(_, _)
@@ -4423,8 +4492,8 @@ chunkable_module_defn(ModuleDefn) = Reorderable :-
; ModuleDefn = md_imported(_)
; ModuleDefn = md_include_module(_)
; ModuleDefn = md_interface
+ ; ModuleDefn = md_implementation_but_exported_to_submodules
; ModuleDefn = md_opt_imported
- ; ModuleDefn = md_private_interface
; ModuleDefn = md_transitively_imported
; ModuleDefn = md_used(_)
; ModuleDefn = md_version_numbers(_, _)
diff --git a/compiler/prog_data.m b/compiler/prog_data.m
index d8033cf..b9793db 100644
--- a/compiler/prog_data.m
+++ b/compiler/prog_data.m
@@ -2194,8 +2194,9 @@ get_type_kind(kinded_type(_, Kind)) = Kind.
; import_locn_ancestor
% The item is from a module imported by an ancestor.
- ; import_locn_ancestor_private_interface.
- % The item is from the private interface of an ancestor module.
+ ; import_locn_ancestor_private_interface_proper.
+ % The item is from the _actual_ private interface of an ancestor
+ % module, i.e. the implementation section of a `.int0' file.
:- type sym_name_specifier
---> name(sym_name)
diff --git a/compiler/prog_item.m b/compiler/prog_item.m
index c1a3211..9c6fe3f 100644
--- a/compiler/prog_item.m
+++ b/compiler/prog_item.m
@@ -878,7 +878,7 @@
---> md_interface
; md_implementation
- ; md_private_interface
+ ; md_implementation_but_exported_to_submodules
% This is used internally by the compiler, to identify items
% which originally came from an implementation section for a
% module that contains sub-modules; such items need to be exported
diff --git a/tests/hard_coded/Mmakefile b/tests/hard_coded/Mmakefile
index 9a785a6..6bb15b9 100644
--- a/tests/hard_coded/Mmakefile
+++ b/tests/hard_coded/Mmakefile
@@ -50,6 +50,7 @@ ORDINARY_PROGS= \
cut_test \
cycles \
cycles2 \
+ daf_bug \
deconstruct_arg \
deep_copy \
deep_copy_bug \
diff --git a/tests/hard_coded/daf_bug.exp b/tests/hard_coded/daf_bug.exp
new file mode 100644
index 0000000..26cdb89
--- /dev/null
+++ b/tests/hard_coded/daf_bug.exp
@@ -0,0 +1,4 @@
+Parent Value = [outer_public1(inner_public(geq, 561, 42)), outer_public2(inner_private(geq, 561, 42))]
+Child Value = [outer_public1(inner_public(geq, 561, 42)), outer_public2(inner_private(geq, 561, 42))]
+Parent Value2 = univ_cons([outer_private1(inner_public(geq, 561, 42)), outer_private2(inner_private(geq, 561, 42))])
+Child Value2 = univ_cons([outer_private1(inner_public(geq, 561, 42)), outer_private2(inner_private(geq, 561, 42))])
diff --git a/tests/hard_coded/daf_bug.m b/tests/hard_coded/daf_bug.m
new file mode 100644
index 0000000..8624b3a
--- /dev/null
+++ b/tests/hard_coded/daf_bug.m
@@ -0,0 +1,31 @@
+% Rotd-2011-11-21 (and a bit before) apply the direct arg functor optimisation
+% to the outer_public/0 type in the daf_bug_sub submodule but not in its
+% parent, daf_bug_parent, module.
+% "Parent Value" and "Child Value" below should be identical.
+%
+:- module daf_bug.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module daf_bug_parent.
+:- import_module daf_bug_parent.daf_bug_sub.
+
+main(!IO) :-
+ io.write_string("Parent Value = ", !IO),
+ io.write(parent_value, !IO),
+ io.nl(!IO),
+ io.write_string("Child Value = ", !IO),
+ io.write(child_value, !IO),
+ io.nl(!IO),
+
+ io.write_string("Parent Value2 = ", !IO),
+ io.write(parent_value2, !IO),
+ io.nl(!IO),
+ io.write_string("Child Value2 = ", !IO),
+ io.write(child_value2, !IO),
+ io.nl(!IO).
diff --git a/tests/hard_coded/daf_bug_parent.m b/tests/hard_coded/daf_bug_parent.m
new file mode 100644
index 0000000..a3c0b11
--- /dev/null
+++ b/tests/hard_coded/daf_bug_parent.m
@@ -0,0 +1,42 @@
+:- module daf_bug_parent.
+:- interface.
+
+:- include_module daf_bug_sub.
+:- import_module daf_bug_parent.daf_bug_sub.
+
+:- import_module list.
+:- import_module univ.
+
+:- type outer_public
+ ---> outer_public0(list(int))
+ ; outer_public1(inner_public)
+ ; outer_public2(inner_private).
+
+:- type inner_public
+ ---> inner_public(bool_kind, int, int).
+
+:- type inner_private.
+
+:- func parent_value = list(outer_public).
+
+:- func parent_value2 = univ.
+
+:- implementation.
+
+:- type outer_private
+ ---> outer_private0(list(int))
+ ; outer_private1(inner_public)
+ ; outer_private2(inner_private).
+
+:- type inner_private
+ ---> inner_private(bool_kind, int, int).
+
+parent_value = [
+ outer_public1(inner_public(geq, 561, 42)),
+ outer_public2(inner_private(geq, 561, 42))
+].
+
+parent_value2 = univ([
+ outer_private1(inner_public(geq, 561, 42)),
+ outer_private2(inner_private(geq, 561, 42))
+]).
diff --git a/tests/hard_coded/daf_bug_sub.m b/tests/hard_coded/daf_bug_sub.m
new file mode 100644
index 0000000..56a58fa
--- /dev/null
+++ b/tests/hard_coded/daf_bug_sub.m
@@ -0,0 +1,20 @@
+:- module daf_bug_parent.daf_bug_sub.
+:- interface.
+
+:- type bool_kind ---> geq ; lt ; eq ; neq.
+
+:- func child_value = list(outer_public).
+
+:- func child_value2 = univ.
+
+:- implementation.
+
+child_value = [
+ outer_public1(inner_public(geq, 561, 42)),
+ outer_public2(inner_private(geq, 561, 42))
+].
+
+child_value2 = univ([
+ outer_private1(inner_public(geq, 561, 42)),
+ outer_private2(inner_private(geq, 561, 42))
+]).
diff --git a/tests/invalid/ii_parent.ii_child.err_exp b/tests/invalid/ii_parent.ii_child.err_exp
index 6e2cff7..8e00bac 100644
--- a/tests/invalid/ii_parent.ii_child.err_exp
+++ b/tests/invalid/ii_parent.ii_child.err_exp
@@ -1,6 +1,6 @@
ii_parent.int0:006: Inconsistent instance declaration for typeclass
ii_parent.int0:006: `ii_parent.foo'/2 with functional dependency `(A -> B)'.
ii_parent.ii_child.m:008: Here is the conflicting instance.
-ii_parent.int0:008: Inconsistent instance declaration for typeclass
-ii_parent.int0:008: `ii_parent.foo'/2 with functional dependency `(A -> B)'.
+ii_parent.int0:009: Inconsistent instance declaration for typeclass
+ii_parent.int0:009: `ii_parent.foo'/2 with functional dependency `(A -> B)'.
ii_parent.ii_child.m:008: Here is the conflicting instance.
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list