[m-rev.] for review: warn about insts without matching types
Ian MacLarty
maclarty at cs.mu.OZ.AU
Tue Jul 4 10:21:47 AEST 2006
For review by anyone.
Estimated hours taken: 3
Branches: main
Issue a warning message if a user defined bound inst is not consistent with
any types in scope.
The warning needs to be disabled by default until all the Mercury machines
have been updated. This is because we will need to disable the warning for
the array module, since the following inst triggers the warning:
:- inst array(I) == bound(array(I)).
The problem is that there is no type with a function symbol array/1. I think
if we allow insts to be annotated with a type (as Zoltan suggested), then this
problem would go away, since we needn't check insts that are for foreign types.
NEWS:
Mention the new warning.
compiler/check_hlds.m:
Include the new module check_hlds.inst_check.
compiler/inst_check.m:
Implement a predicate that checks that all user defined insts
are consistent with at least one type in scope. The predicate
issues a warning if no consistent types are found for an inst.
compiler/mercury_compile.m:
Check insts at stage 12, before type and mode checking.
compiler/options.m:
Add an option to turn the new warning on or off.
tests/warnings/Mmakefile:
tests/warnings/Mercury.options:
tests/warnings/inst_with_no_type.m:
tests/warnings/inst_with_no_type.exp:
Test the new warning.
Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.414
diff -u -r1.414 NEWS
--- NEWS 13 Jun 2006 09:48:58 -0000 1.414
+++ NEWS 4 Jul 2006 00:10:33 -0000
@@ -57,6 +57,8 @@
with many clauses.
* We have deleted the old --split-c-files option, as it conflicted with the
implementation of module initialisation and finalisation.
+* The compiler now issues a warning when an inst declaration isn't
+ consistent with any types in scope.
Portability Improvements:
* We've ported Mercury to the x86_64 (AMD64 / Intel EMT64) architecure.
@@ -320,6 +322,12 @@
will also generate error messages for calls to string.format and io.format
in which the format string or the structure of the list of values to be
printed are not statically available.
+
+* The compiler now issues a warning when an inst declaration isn't
+ consistent with any types in scope.
+
+ This makes it easier to diagnose mode errors caused by insts that are not
+ consistent with the type they are intended to be consistent with.
Changes to the Mercury debugger:
Index: compiler/check_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/check_hlds.m,v
retrieving revision 1.14
diff -u -r1.14 check_hlds.m
--- compiler/check_hlds.m 5 Jun 2006 05:23:26 -0000 1.14
+++ compiler/check_hlds.m 4 Jul 2006 00:10:33 -0000
@@ -80,6 +80,9 @@
:- include_module format_call.
:- include_module simplify.
+% Warnings about insts with no matching types
+:- include_module inst_check.
+
:- include_module goal_path.
%-----------------------------------------------------------------------------%
Index: compiler/inst_check.m
===================================================================
RCS file: compiler/inst_check.m
diff -N compiler/inst_check.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ compiler/inst_check.m 4 Jul 2006 00:10:33 -0000
@@ -0,0 +1,291 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2006 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% File: inst_check.m
+% Main author: maclarty.
+%
+% This module exports a predicate that checks that each user defined inst is
+% consistant with at least one type in scope.
+%
+% TODO:
+% If we find an inst that is not consistent with any types in scope,
+% except for one function symbol with a different arity, then we
+% should communicate this in the warning message.
+%
+%-----------------------------------------------------------------------------%
+
+:- module check_hlds.inst_check.
+
+:- interface.
+
+:- import_module io.
+
+:- 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.
+ %
+:- pred check_insts_have_matching_types(module_info::in,
+ io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module assoc_list.
+:- import_module bool.
+:- import_module list.
+:- import_module map.
+:- import_module maybe.
+:- import_module multi_map.
+:- import_module pair.
+:- import_module string.
+
+:- import_module hlds.
+:- import_module hlds.hlds_data.
+:- import_module hlds.hlds_module.
+:- import_module hlds.hlds_pred.
+:- import_module libs.
+:- import_module mdbcomp.
+:- import_module mdbcomp.prim_data.
+:- import_module parse_tree.
+:- import_module parse_tree.error_util.
+:- 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),
+ TypeDefs = map.values(TypeTable),
+ InstIdDefPairs = map.to_assoc_list(InstDefs),
+ list.filter(inst_is_defined_in_current_module, InstIdDefPairs,
+ InstIdDefPairsForCurrentModule),
+ FunctorsToTypeDefs = index_types_by_unqualified_functors(TypeDefs),
+ list.foldl_corresponding(check_inst(FunctorsToTypeDefs),
+ assoc_list.keys(InstIdDefPairsForCurrentModule),
+ assoc_list.values(InstIdDefPairsForCurrentModule), !IO).
+
+:- pred inst_is_defined_in_current_module(pair(inst_id, hlds_inst_defn)::in)
+ is semidet.
+
+inst_is_defined_in_current_module(_ - InstDef) :-
+ ImportStatus = InstDef ^ inst_status,
+ status_defined_in_this_module(ImportStatus, yes).
+
+:- type functors_to_types == multi_map(sym_name_and_arity, hlds_type_defn).
+
+:- type bound_inst_functor
+ ---> name_and_arity(sym_name, int)
+ ; string_constant
+ ; int_constant
+ ; float_constant.
+
+:- type type_defn_or_builtin
+ ---> type_def(hlds_type_defn)
+ ; builtin_type(builtin_type)
+ ; tuple(arity).
+
+:- pred check_inst(functors_to_types::in, inst_id::in, hlds_inst_defn::in,
+ io::di, io::uo) is det.
+
+check_inst(FunctorsToTypes, InstId, InstDef, !IO) :-
+ InstBody = InstDef ^ inst_body,
+ (
+ InstBody = eqv_inst(Inst),
+ (
+ Inst = bound(_, BoundInsts),
+ (
+ list.map(bound_inst_to_functor, BoundInsts, Functors)
+ ->
+ list.map(find_types_for_functor(FunctorsToTypes),
+ Functors, MatchingTypeLists),
+ maybe_issue_inst_check_warning(InstId, InstDef,
+ MatchingTypeLists, !IO)
+ ;
+ true
+ )
+ ;
+ ( Inst = any(_)
+ ; Inst = free
+ ; Inst = free(_)
+ ; Inst = ground(_, _)
+ ; Inst = not_reached
+ ; Inst = inst_var(_)
+ ; Inst = constrained_inst_vars(_, _)
+ ; Inst = defined_inst(_)
+ ; Inst = abstract_inst(_, _)
+ )
+ )
+ ;
+ InstBody = abstract_inst
+ ).
+
+:- 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
+ MatchingTypeLists = [MatchingTypeList | _],
+ not (some [Type] (
+ list.member(Type, MatchingTypeList),
+ all [TypeList] (
+ list.member(TypeList, MatchingTypeLists)
+ =>
+ list.member(Type, TypeList)
+ )
+ ))
+ then
+ Context = InstDef ^ inst_context,
+ InstId = inst_id(InstName, InstArity),
+ InstSymNameAndArity = InstName / InstArity,
+ report_warning(Context, 0, [words("warning: inst "),
+ sym_name_and_arity(InstSymNameAndArity),
+ words(" has no matching type in scope.")], !IO)
+ else
+ true
+ ).
+
+:- pred find_types_for_functor(functors_to_types::in, bound_inst_functor::in,
+ list(type_defn_or_builtin)::out) is det.
+
+find_types_for_functor(FunctorsToTypes, Functor, Types) :-
+ (
+ Functor = name_and_arity(Name, Arity),
+ ( multi_map.search(FunctorsToTypes, strip_qualifiers(Name) / Arity,
+ TypeDefs) ->
+ TypesExceptChar = list.map(func(TypeDef) = type_def(TypeDef),
+ TypeDefs)
+ ;
+ TypesExceptChar = []
+ ),
+ (
+ %
+ % Zero arity functors with length 1 could match the
+ % character builtin type.
+ %
+ Name = unqualified(NameStr),
+ string.length(NameStr) = 1
+ ->
+ TypesExceptTuple = [builtin_type(character) | TypesExceptChar]
+ ;
+ TypesExceptTuple = TypesExceptChar
+ ),
+ (
+ %
+ % The inst could match a tuple type, which won't be explicitly
+ % declared.
+ %
+ type_ctor_is_tuple(type_ctor(Name, Arity))
+ ->
+ Types = [tuple(Arity) | TypesExceptTuple]
+ ;
+ Types = TypesExceptTuple
+ )
+ ;
+ Functor = int_constant,
+ Types = [builtin_type(int)]
+ ;
+ Functor = float_constant,
+ Types = [builtin_type(float)]
+ ;
+ Functor = string_constant,
+ Types = [builtin_type(string)]
+ ).
+
+:- pred bound_inst_to_functor(bound_inst::in, bound_inst_functor::out)
+ is semidet.
+
+bound_inst_to_functor(functor(ConsId, _), Functor) :-
+ get_functor_if_must_check_for_type(ConsId, yes(Functor)).
+
+ % Return the functor for the given cons_id if we should look for
+ % matching types for the cons_id.
+ % We don't bother checking for types for certain cons_ids such as
+ % predicate signatures and cons_ids that are only used internally.
+ %
+:- pred get_functor_if_must_check_for_type(cons_id::in,
+ maybe(bound_inst_functor)::out) is det.
+
+get_functor_if_must_check_for_type(ConsId, MaybeFunctor) :-
+ (
+ ConsId = cons(Name, Arity),
+ MaybeFunctor = yes(name_and_arity(Name, Arity))
+ ;
+ ConsId = int_const(_),
+ MaybeFunctor = yes(int_constant)
+ ;
+ ConsId = string_const(_),
+ MaybeFunctor = yes(string_constant)
+ ;
+ ConsId = float_const(_),
+ MaybeFunctor = yes(float_constant)
+ ;
+ ( ConsId = pred_const(_, __)
+ ; ConsId = type_ctor_info_const(_, _, _)
+ ; ConsId = base_typeclass_info_const(_, _, _, _)
+ ; ConsId = type_info_cell_constructor(_)
+ ; ConsId = typeclass_info_cell_constructor
+ ; ConsId = tabling_info_const(_)
+ ; ConsId = deep_profiling_proc_layout(_)
+ ; ConsId = table_io_decl(_)
+ ),
+ MaybeFunctor = no
+ ).
+
+:- func index_types_by_unqualified_functors(list(hlds_type_defn)) =
+ functors_to_types.
+
+index_types_by_unqualified_functors([]) = multi_map.init.
+index_types_by_unqualified_functors([TypeDef | TypeDefs]) =
+ FunctorsToTypeDefs :-
+ FunctorsToTypeDefs0 = index_types_by_unqualified_functors(TypeDefs),
+ Functors = get_du_functors_for_type_def(TypeDef),
+ UnqualifiedFunctors = list.map(
+ ( func(Name / Arity) = strip_qualifiers(Name) / Arity ), Functors),
+ FunctorsToTypeDefs = list.foldl(multi_map_set(TypeDef),
+ UnqualifiedFunctors, FunctorsToTypeDefs0).
+
+:- func strip_qualifiers(sym_name) = sym_name.
+
+strip_qualifiers(unqualified(Name)) = unqualified(Name).
+strip_qualifiers(qualified(_, Name)) = unqualified(Name).
+
+:- func get_du_functors_for_type_def(hlds_type_defn) =
+ list(sym_name_and_arity).
+
+get_du_functors_for_type_def(TypeDef) = Functors :-
+ get_type_defn_body(TypeDef, TypeDefBody),
+ (
+ TypeDefBody = du_type(Constructors, _, _, _, _, _),
+ Functors = list.map(constructor_to_sym_name_and_arity, Constructors)
+ ;
+ ( TypeDefBody = eqv_type(_)
+ ; TypeDefBody = foreign_type(_)
+ ; TypeDefBody = solver_type(_, _)
+ ; TypeDefBody = abstract_type(_)
+ ),
+ Functors = []
+ ).
+
+:- func constructor_to_sym_name_and_arity(constructor) = sym_name_and_arity.
+
+constructor_to_sym_name_and_arity(ctor(_, _, Name, Args)) =
+ Name / list.length(Args).
+
+ % multi_map_set is the same as multi_map.set, except that the
+ % arguments are in an order convenient for use in
+ % index_types_by_unqualified_functors.
+ %
+:- func multi_map_set(V, K, multi_map(K, V)) = multi_map(K, V).
+
+multi_map_set(Value, Key, Map) = multi_map.set(Map, Key, Value).
+
+:- end_module check_hlds.inst_check.
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.391
diff -u -r1.391 mercury_compile.m
--- compiler/mercury_compile.m 14 Jun 2006 08:14:49 -0000 1.391
+++ compiler/mercury_compile.m 4 Jul 2006 00:10:33 -0000
@@ -136,6 +136,7 @@
% miscellaneous compiler modules
:- import_module check_hlds.goal_path.
+:- import_module check_hlds.inst_check.
:- import_module hlds.arg_info.
:- import_module hlds.hlds_data.
:- import_module hlds.hlds_module.
@@ -859,7 +860,7 @@
:- type file_or_module
---> file(file_name)
- ; module(module_name).
+ ; module(module_name).
:- func string_to_file_or_module(string) = file_or_module.
@@ -1947,6 +1948,20 @@
maybe_dump_hlds(!.HLDS, 10, "dead_pred_elim", !DumpInfo, !IO)
;
true
+ ),
+
+ globals.lookup_bool_option(Globals, warn_insts_without_matching_type,
+ WarnInstsWithNoMatchingType),
+ (
+ WarnInstsWithNoMatchingType = yes,
+ maybe_write_string(Verbose,
+ "% Checking that insts have matching types... ", !IO),
+ check_hlds.inst_check.check_insts_have_matching_types(!.HLDS, !IO),
+ maybe_write_string(Verbose, "done.\n", !IO),
+ maybe_dump_hlds(!.HLDS, 12, "warn_insts_without_matching_type",
+ !DumpInfo, !IO)
+ ;
+ WarnInstsWithNoMatchingType = no
),
%
Index: compiler/options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.517
diff -u -r1.517 options.m
--- compiler/options.m 8 Jun 2006 08:19:26 -0000 1.517
+++ compiler/options.m 4 Jul 2006 00:10:33 -0000
@@ -113,6 +113,7 @@
; warn_known_bad_format_calls
; warn_unknown_format_calls
; warn_obsolete
+ ; warn_insts_without_matching_type
% Verbosity options
; verbose
@@ -862,7 +863,8 @@
warn_non_term_special_preds - bool(yes),
warn_known_bad_format_calls - bool(yes),
warn_unknown_format_calls - bool(no),
- warn_obsolete - bool(yes)
+ warn_obsolete - bool(yes),
+ warn_insts_without_matching_type - bool(no)
]).
option_defaults_2(verbosity_option, [
% Verbosity Options
@@ -1562,6 +1564,8 @@
long_option("warn-known-bad-format-calls", warn_known_bad_format_calls).
long_option("warn-unknown-format-calls", warn_unknown_format_calls).
long_option("warn-obsolete", warn_obsolete).
+long_option("warn-insts-without-matching-type",
+ warn_insts_without_matching_type).
% verbosity options
long_option("verbose", verbose).
@@ -2766,6 +2770,9 @@
"--no-warn-inferred-erroneous",
"\tDon't warn about procedures whose determinism is inferred",
"\terroneous but whose determinism declarations are laxer.",
+ "--no-warn-insts-without-matching-type",
+ "\tDon't warn about insts that are not consistent with any",
+ "\ttypes in scope.",
"--no-warn-nothing-exported",
"\tDon't warn about modules which export nothing.",
"--warn-unused-args",
Index: tests/warnings/Mercury.options
===================================================================
RCS file: /home/mercury1/repository/tests/warnings/Mercury.options,v
retrieving revision 1.12
diff -u -r1.12 Mercury.options
--- tests/warnings/Mercury.options 27 Feb 2006 06:57:06 -0000 1.12
+++ tests/warnings/Mercury.options 4 Jul 2006 00:10:33 -0000
@@ -45,3 +45,5 @@
MCFLAGS-warn_dead_procs = --warn-dead-procs --infer-all
MCFLAGS-non_stratification = --warn-non-stratification --verbose-error-messages
+
+MCFLAGS-inst_with_no_type = --warn-insts-without-matching-type
Index: tests/warnings/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/warnings/Mmakefile,v
retrieving revision 1.43
diff -u -r1.43 Mmakefile
--- tests/warnings/Mmakefile 27 Mar 2006 06:56:22 -0000 1.43
+++ tests/warnings/Mmakefile 4 Jul 2006 00:10:33 -0000
@@ -21,6 +21,7 @@
inference_test \
infinite_recursion \
inf_recursion_lambda \
+ inst_with_no_type \
missing_if \
non_stratification \
pragma_source_file \
Index: tests/warnings/inst_with_no_type.exp
===================================================================
RCS file: tests/warnings/inst_with_no_type.exp
diff -N tests/warnings/inst_with_no_type.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/warnings/inst_with_no_type.exp 4 Jul 2006 00:10:33 -0000
@@ -0,0 +1,8 @@
+inst_with_no_type.m:014: warning: inst `inst_with_no_type.i1_no_match'/0 has no
+inst_with_no_type.m:014: matching type in scope.
+inst_with_no_type.m:035: warning: inst `inst_with_no_type.i2_no_match'/1 has no
+inst_with_no_type.m:035: matching type in scope.
+inst_with_no_type.m:046: warning: inst `inst_with_no_type.i4_no_match'/0 has no
+inst_with_no_type.m:046: matching type in scope.
+inst_with_no_type.m:059: warning: inst `inst_with_no_type.i7_no_match'/0 has no
+inst_with_no_type.m:059: matching type in scope.
Index: tests/warnings/inst_with_no_type.m
===================================================================
RCS file: tests/warnings/inst_with_no_type.m
diff -N tests/warnings/inst_with_no_type.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/warnings/inst_with_no_type.m 4 Jul 2006 00:10:33 -0000
@@ -0,0 +1,64 @@
+:- module inst_with_no_type.
+
+:- interface.
+
+:- inst chars
+ ---> a
+ ; b
+ ; c.
+
+:- inst i1
+ ---> t1_f1(ground, ground)
+ ; t1_f2(ground).
+
+:- inst i1_no_match
+ ---> t1_f1(ground)
+ ; t1_f2(ground).
+
+:- type t1
+ ---> t1_f1(int, int)
+ ; t1_f2(string).
+
+:- inst i2(I)
+ ---> i2_f1(ground, I)
+ ; i2_f2(ground, ground, ground)
+ ; i2_f3(ground)
+ ; i2_f4.
+
+:- type t2(T)
+ ---> i2_f1(character, T)
+ ; i2_f2(T, T, int)
+ ; i2_f3(float)
+ ; i2_f4
+ ; i2_f5.
+
+:- inst i2_no_match(I)
+ ---> i2_f1(ground, I)
+ ; i2_f2(ground, ground, ground, ground)
+ ; i2_f3(ground)
+ ; i2_f4.
+
+:- inst i3
+ ---> "a"
+ ; "b"
+ ; "c".
+
+:- inst i4_no_match
+ ---> 1
+ ; 2
+ ; "3".
+
+:- inst i5
+ ---> 1
+ ; 2.
+
+:- inst i6
+ ---> 1.1
+ ; 1.2.
+
+:- inst i7_no_match
+ ---> 1.0
+ ; 1.
+
+:- inst tuple
+ ---> {ground, ground}.
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list