[m-rev.] for review: warn about exported insts for abstract types
Peter Wang
novalazy at gmail.com
Fri Aug 8 14:14:22 AEST 2008
Branches: main
Extend `--warn-insts-without-matching-type' to warn about insts defined in the
interface which refer to constructors of types defined in the implementation.
This is usually done because Mercury doesn't (yet) support abstract insts so
the inst is exported while keeping the type abstract. However, it is not
really safe. Other modules, can see the function symbols from the inst but
cannot match them up to constructors from the type definition. Hence those
constructors never get module qualified.
This is related to Mantis bug #26.
compiler/inst_check.m:
Check that exported inst definitions have a matching type that is
visible (we can see its constructors) in the interface.
Fix some spelling.
compiler/mode_robdd.tfeirn.m:
library/array2d.m:
library/hash_table.m:
library/tree234.m:
Export previously abstract types in "secret" interface sections,
where necessary to avoid the warning.
tests/warnings/inst_with_no_type.exp:
Update expected output.
tests/warnings/inst_with_no_type.m:
Fix a comment.
diff --git a/compiler/inst_check.m b/compiler/inst_check.m
index 9ffa8ec..1d745e7 100644
--- a/compiler/inst_check.m
+++ b/compiler/inst_check.m
@@ -10,7 +10,7 @@
% Main author: maclarty.
%
% This module exports a predicate that checks that each user defined inst is
-% consistant with at least one type in scope.
+% consistent with at least one type in scope.
%
% TODO:
% If we find an inst that is not consistent with any of the types in scope,
@@ -27,13 +27,14 @@
:- import_module hlds.
:- import_module hlds.hlds_module.
- % This predicate issues a warning for each user defined bound insts
- % that is not consistant with at least one type in scope.
+ % This predicate issues a warning for each user defined bound inst
+ % that is not consistent with at least one type in scope.
%
:- pred check_insts_have_matching_types(module_info::in,
io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
:- implementation.
@@ -57,38 +58,58 @@
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_type.
+%-----------------------------------------------------------------------------%
+
check_insts_have_matching_types(Module, !IO) :-
module_info_get_inst_table(Module, InstTable),
inst_table_get_user_insts(InstTable, UserInstTable),
user_inst_table_get_inst_defns(UserInstTable, InstDefs),
module_info_get_type_table(Module, TypeTable),
AllTypeDefs = map.values(TypeTable),
- list.filter(type_is_user_visible, AllTypeDefs, UserVisibleTypeDefs),
+ list.filter(type_is_user_visible(section_implementation), AllTypeDefs,
+ UserVisibleTypeDefs),
InstIdDefPairs = map.to_assoc_list(InstDefs),
list.filter(inst_is_defined_in_current_module, InstIdDefPairs,
InstIdDefPairsForCurrentModule),
FunctorsToTypeDefs = index_types_by_unqualified_functors(
UserVisibleTypeDefs),
- list.foldl_corresponding(check_inst(FunctorsToTypeDefs),
- assoc_list.keys(InstIdDefPairsForCurrentModule),
- assoc_list.values(InstIdDefPairsForCurrentModule), !IO).
+ list.foldl(check_inst(FunctorsToTypeDefs), InstIdDefPairsForCurrentModule,
+ !IO).
% Returns yes if a type definition with the given import status
- % is user visible in the current module.
+ % is user visible in a section of the current module.
%
-:- func status_implies_type_defn_is_user_visible(import_status) = bool.
-
-status_implies_type_defn_is_user_visible(status_imported(_)) = yes.
-status_implies_type_defn_is_user_visible(status_external(_)) = no.
-status_implies_type_defn_is_user_visible(status_abstract_imported) = no.
-status_implies_type_defn_is_user_visible(status_pseudo_imported) = no.
-status_implies_type_defn_is_user_visible(status_opt_imported) = no.
-status_implies_type_defn_is_user_visible(status_exported) = yes.
-status_implies_type_defn_is_user_visible(status_opt_exported) = yes.
-status_implies_type_defn_is_user_visible(status_abstract_exported) = yes.
-status_implies_type_defn_is_user_visible(status_pseudo_exported) = yes.
-status_implies_type_defn_is_user_visible(status_exported_to_submodules) = yes.
-status_implies_type_defn_is_user_visible(status_local) = yes.
+:- func status_implies_type_defn_is_user_visible(section, import_status)
+ = bool.
+
+status_implies_type_defn_is_user_visible(Section, Status) = Visible :-
+ (
+ ( Status = status_imported(_)
+ ; Status = status_exported
+ ),
+ Visible = yes
+ ;
+ ( Status = status_external(_)
+ ; Status = status_abstract_imported
+ ; Status = status_pseudo_imported
+ ; Status = status_opt_imported
+ ),
+ Visible = no
+ ;
+ ( Status = status_opt_exported
+ ; Status = status_abstract_exported
+ ; Status = status_pseudo_exported
+ ; Status = status_exported_to_submodules
+ ; Status = status_local
+ ),
+ (
+ Section = section_interface,
+ Visible = no
+ ;
+ Section = section_implementation,
+ Visible = yes
+ )
+ ).
:- pred inst_is_defined_in_current_module(pair(inst_id, hlds_inst_defn)::in)
is semidet.
@@ -97,11 +118,11 @@ inst_is_defined_in_current_module(_ - InstDef) :-
ImportStatus = InstDef ^ inst_status,
status_defined_in_this_module(ImportStatus) = yes.
-:- pred type_is_user_visible(hlds_type_defn::in) is semidet.
+:- pred type_is_user_visible(section::in, hlds_type_defn::in) is semidet.
-type_is_user_visible(TypeDef) :-
+type_is_user_visible(Section, TypeDef) :-
get_type_defn_status(TypeDef, ImportStatus),
- status_implies_type_defn_is_user_visible(ImportStatus) = yes.
+ status_implies_type_defn_is_user_visible(Section, ImportStatus) = yes.
:- type functors_to_types == multi_map(sym_name_and_arity, hlds_type_defn).
@@ -116,10 +137,10 @@ type_is_user_visible(TypeDef) :-
; type_builtin(builtin_type)
; type_tuple(arity).
-:- pred check_inst(functors_to_types::in, inst_id::in, hlds_inst_defn::in,
+:- pred check_inst(functors_to_types::in, pair(inst_id, hlds_inst_defn)::in,
io::di, io::uo) is det.
-check_inst(FunctorsToTypes, InstId, InstDef, !IO) :-
+check_inst(FunctorsToTypes, InstId - InstDef, !IO) :-
InstBody = InstDef ^ inst_body,
(
InstBody = eqv_inst(Inst),
@@ -154,19 +175,33 @@ check_inst(FunctorsToTypes, InstId, InstDef, !IO) :-
:- pred maybe_issue_inst_check_warning(inst_id::in, hlds_inst_defn::in,
list(list(type_defn_or_builtin))::in, io::di, io::uo) is det.
-maybe_issue_inst_check_warning(InstId, InstDef, MatchingTypeLists,
- !IO) :-
- ( if
+maybe_issue_inst_check_warning(InstId, InstDef, MatchingTypeLists, !IO) :-
+ InstImportStatus = InstDef ^ inst_status,
+ InstIsExported = status_is_exported_to_non_submodules(InstImportStatus),
+ (
MatchingTypeLists = [MatchingTypeList | _],
not (some [Type] (
+ % Check at least one type matched all the functors of the inst.
list.member(Type, MatchingTypeList),
- all [TypeList] (
- list.member(TypeList, MatchingTypeLists)
- =>
- list.member(Type, TypeList)
+ type_matched_all_functors(Type, MatchingTypeLists),
+
+ % If the inst is exported then that type must be concrete outside
+ % of this module.
+ (
+ InstIsExported = yes,
+ (
+ Type = type_def(TypeDefn),
+ type_is_user_visible(section_interface, TypeDefn)
+ ;
+ Type = type_builtin(_)
+ ;
+ Type = type_tuple(_)
+ )
+ ;
+ InstIsExported = no
)
))
- then
+ ->
Context = InstDef ^ inst_context,
InstId = inst_id(InstName, InstArity),
Warning = [
@@ -175,10 +210,20 @@ maybe_issue_inst_check_warning(InstId, InstDef, MatchingTypeLists,
words("does not match any of the types in scope.")
],
report_warning(Context, 0, Warning, !IO)
- else
+ ;
true
).
+:- pred type_matched_all_functors(type_defn_or_builtin::in,
+ list(list(type_defn_or_builtin))::in) is semidet.
+
+type_matched_all_functors(Type, MatchingTypeLists) :-
+ all [TypeList] (
+ list.member(TypeList, MatchingTypeLists)
+ =>
+ list.member(Type, TypeList)
+ ).
+
:- pred find_types_for_functor(functors_to_types::in, bound_inst_functor::in,
list(type_defn_or_builtin)::out) is det.
@@ -315,4 +360,6 @@ constructor_to_sym_name_and_arity(ctor(_, _, Name, Args, _)) =
multi_map_set(Value, Key, Map) = multi_map.set(Map, Key, Value).
+%-----------------------------------------------------------------------------%
:- end_module check_hlds.inst_check.
+%-----------------------------------------------------------------------------%
diff --git a/compiler/mode_robdd.tfeirn.m b/compiler/mode_robdd.tfeirn.m
index 1348a8c..676d418 100644
--- a/compiler/mode_robdd.tfeirn.m
+++ b/compiler/mode_robdd.tfeirn.m
@@ -11,15 +11,17 @@
%-----------------------------------------------------------------------------%
:- module mode_robdd__tfeirn.
-
:- interface.
:- import_module check_hlds.
:- import_module check_hlds.mode_constraint_robdd.
+:- import_module bool.
:- import_module robdd.
:- import_module term.
+%-----------------------------------------------------------------------------%
+
:- type tfeirn(T).
:- type tfeirn == tfeirn(generic).
@@ -186,13 +188,13 @@
:- func robdd_to_mode_robdd(robdd(T)) = tfeirn(T).
%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
:- implementation.
:- import_module mode_robdd.equiv_vars.
:- import_module mode_robdd.implications.
-:- import_module bool.
:- import_module int.
:- import_module list.
:- import_module map.
@@ -209,6 +211,10 @@
% tfeirn
% TFENIR
+:- interface.
+
+ % This should be abstract, but needs to be exported for insts.
+ %
:- type tfeirn(T)
---> mode_robdd(
true_vars :: vars(T),
@@ -219,6 +225,10 @@
normalised :: bool
).
+:- implementation.
+
+%-----------------------------------------------------------------------------%
+
one = mode_robdd(init, init, init_equiv_vars, init_imp_vars, one, yes).
zero = mode_robdd(init, init, init_equiv_vars, init_imp_vars, zero, yes).
diff --git a/library/array2d.m b/library/array2d.m
index 5870e71..b048ebd 100644
--- a/library/array2d.m
+++ b/library/array2d.m
@@ -125,13 +125,21 @@
:- implementation.
-:- import_module array.
:- import_module require.
:- import_module int.
- % array2d(Rows, Cols, Array)
+:- interface.
+
+ % This should be abstract, but needs to be exported for insts.
%
-:- type array2d(T) ---> array2d(int, int, array(T)).
+:- type array2d(T)
+ ---> array2d(
+ int, % rows
+ int, % cols
+ array(T) % array
+ ).
+
+:- implementation.
%-----------------------------------------------------------------------------%
diff --git a/library/hash_table.m b/library/hash_table.m
index 9be19e0..7ecfa90 100644
--- a/library/hash_table.m
+++ b/library/hash_table.m
@@ -215,6 +215,10 @@
%-----------------------------------------------------------------------------%
+:- interface.
+
+ % This should be abstract, but needs to be exported for insts.
+ %
:- type hash_table(K, V)
---> ht(
num_buckets :: int,
@@ -226,6 +230,8 @@
values :: array(V)
).
+:- implementation.
+
%-----------------------------------------------------------------------------%
% THE HASHING SCHEME
diff --git a/library/tree234.m b/library/tree234.m
index bb2befb..f6b2ba9 100644
--- a/library/tree234.m
+++ b/library/tree234.m
@@ -298,6 +298,10 @@
:- import_module pair.
:- import_module require.
+:- interface.
+
+ % This should be abstract, but needs to be exported for insts.
+ %
:- type tree234(K, V)
---> empty
; two(K, V, tree234(K, V), tree234(K, V))
@@ -305,8 +309,6 @@
; four(K, V, K, V, K, V, tree234(K, V), tree234(K, V),
tree234(K, V), tree234(K, V)).
-:- interface.
-
:- inst uniq_tree234(K, V) ==
unique((
empty
diff --git a/tests/warnings/inst_with_no_type.exp b/tests/warnings/inst_with_no_type.exp
index b1e3c00..fa5700b 100644
--- a/tests/warnings/inst_with_no_type.exp
+++ b/tests/warnings/inst_with_no_type.exp
@@ -1,3 +1,5 @@
+inst_with_no_type.m:079: Warning: inst `inst_with_no_type.citrus'/0 does not
+inst_with_no_type.m:079: match any of the types in scope.
inst_with_no_type.m:014: Warning: inst `inst_with_no_type.i1_no_match'/0 does
inst_with_no_type.m:014: not match any of the types in scope.
inst_with_no_type.m:035: Warning: inst `inst_with_no_type.i2_no_match'/1 does
@@ -6,10 +8,14 @@ inst_with_no_type.m:046: Warning: inst `inst_with_no_type.i4_no_match'/0 does
inst_with_no_type.m:046: not match any of the types in scope.
inst_with_no_type.m:059: Warning: inst `inst_with_no_type.i7_no_match'/0 does
inst_with_no_type.m:059: not match any of the types in scope.
+inst_with_no_type.m:070: Warning: inst `inst_with_no_type.mostly_unique_inst'/0
+inst_with_no_type.m:070: does not match any of the types in scope.
inst_with_no_type.m:072: Warning: inst
inst_with_no_type.m:072: `inst_with_no_type.mostly_unique_no_match'/0 does
inst_with_no_type.m:072: not match any of the types in scope.
inst_with_no_type.m:092: Warning: inst `inst_with_no_type.t_no_match'/0 does
inst_with_no_type.m:092: not match any of the types in scope.
+inst_with_no_type.m:074: Warning: inst `inst_with_no_type.unique_inst'/0 does
+inst_with_no_type.m:074: not match any of the types in scope.
inst_with_no_type.m:076: Warning: inst `inst_with_no_type.unique_no_match'/0
inst_with_no_type.m:076: does not match any of the types in scope.
diff --git a/tests/warnings/inst_with_no_type.m b/tests/warnings/inst_with_no_type.m
index a4c55dd..0db7291 100644
--- a/tests/warnings/inst_with_no_type.m
+++ b/tests/warnings/inst_with_no_type.m
@@ -86,7 +86,7 @@
% Even though t is defined in the implementation of
% inst_with_no_type_2 we should get a warning for the following
- % insts, since the function symbol t is not user visible from
+ % insts, since the function symbol ft is not user visible from
% this scope.
%
:- inst t_no_match ---> ft.
--------------------------------------------------------------------------
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