[m-rev.] for review: Warn about redundant type conversions.
Peter Wang
novalazy at gmail.com
Thu Jun 27 17:03:21 AEST 2024
Warn about type conversion expressions, i.e. coerce(),
where the type of the argument and the type of the expression
are the same.
compiler/options.m:
Add a new option --warn-redundant-coerce, enabled by default.
compiler/type_assign.m:
Add a coerce_constraint_status value to indicate that a coercion
is known to be type-correct but redundant.
compiler/typecheck.m:
Generate warnings for redundant coercions, once typechecking has
narrowed down to a single type assignment.
compiler/typecheck_clauses.m:
Check for and record redundant coercions the type assignment.
Note down a bug in the way we process coerce constraints.
This can cause the compiler to arbitrarily pick a valid
assignment of types to type variables, when other equally valid
possibilities exist.
compiler/typecheck_errors.m:
Delete incorrect error messages that said you cannot coerce from a
given type to itself.
Add predicate to generate a warning for a redundant coercion.
compiler/mlds_to_cs_type.m:
compiler/mlds_to_java_type.m:
Delete redundant type conversions.
tests/invalid/coerce_clobbered.err_exp:
tests/invalid/coerce_int.err_exp:
tests/invalid/coerce_mode_error.err_exp:
tests/invalid/coerce_non_du.err_exp:
tests/invalid/coerce_uniq.err_exp:
tests/invalid/coerce_void.err_exp:
Update expected outputs.
tests/invalid/coerce_ambig.err_exp:
tests/invalid/coerce_ambig.m:
Extend test case.
tests/warnings/Mmakefile:
tests/warnings/redundant_coerce.err_exp:
tests/warnings/redundant_coerce.m:
Add test case.
doc/user_guide.texi:
NEWS.md:
Document the new option.
---
NEWS.md | 4 +
compiler/mlds_to_cs_type.m | 4 +-
compiler/mlds_to_java_type.m | 4 +-
compiler/options.m | 10 +-
compiler/type_assign.m | 5 +-
compiler/typecheck.m | 37 +++----
compiler/typecheck_clauses.m | 129 ++++++++++++++++--------
compiler/typecheck_errors.m | 37 ++++---
doc/user_guide.texi | 7 ++
tests/invalid/coerce_ambig.err_exp | 8 ++
tests/invalid/coerce_ambig.m | 9 ++
tests/invalid/coerce_clobbered.err_exp | 4 +
tests/invalid/coerce_int.err_exp | 9 ++
tests/invalid/coerce_mode_error.err_exp | 4 +
tests/invalid/coerce_non_du.err_exp | 5 -
tests/invalid/coerce_uniq.err_exp | 9 ++
tests/invalid/coerce_void.err_exp | 3 +
tests/warnings/Mmakefile | 1 +
tests/warnings/redundant_coerce.err_exp | 11 ++
tests/warnings/redundant_coerce.m | 49 +++++++++
20 files changed, 264 insertions(+), 85 deletions(-)
create mode 100644 tests/warnings/redundant_coerce.err_exp
create mode 100644 tests/warnings/redundant_coerce.m
diff --git a/NEWS.md b/NEWS.md
index e5dd19b4d..af466fb02 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1250,6 +1250,10 @@ Changes to the Mercury compiler
with that name and arity, and the pragma does not specify which one
it is for.
+* We have added a new option `--warn-redundant-coerce`,
+ that tells the compiler to generate warnings for type conversions
+ from one type to the same type. This option is enabled by default.
+
* We have added a new option `--reverse-error-order` that tells the compiler
to output error messages for higher line numbers before error messages
for lower line numbers.
diff --git a/compiler/mlds_to_cs_type.m b/compiler/mlds_to_cs_type.m
index 64fa0baf1..14e4643cd 100644
--- a/compiler/mlds_to_cs_type.m
+++ b/compiler/mlds_to_cs_type.m
@@ -2,7 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2010-2012 The University of Melbourne.
-% Copyright (C) 2013-2018 The Mercury team.
+% Copyright (C) 2013-2018, 2020, 2022-2024 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.
%---------------------------------------------------------------------------%
@@ -476,7 +476,7 @@ mercury_user_type_to_string_and_dims_for_csharp(Info, Type,
mercury_user_enum_type_to_string_and_dims_for_csharp(Info, Type,
TypeNameWithGenerics) :-
- type_to_ctor_and_args_det(coerce(Type), TypeCtor, ArgsTypes),
+ type_to_ctor_and_args_det(Type, TypeCtor, ArgsTypes),
ml_gen_type_name(TypeCtor, EnumModule, EnumName, EnumArity),
EnumId = mlds_enum_class_id(EnumModule, EnumName, EnumArity),
MLDS_Type = mlds_enum_class_type(EnumId),
diff --git a/compiler/mlds_to_java_type.m b/compiler/mlds_to_java_type.m
index bf5055175..7f8e9ee84 100644
--- a/compiler/mlds_to_java_type.m
+++ b/compiler/mlds_to_java_type.m
@@ -2,7 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2000-2012 The University of Melbourne.
-% Copyright (C) 2013-2018 The Mercury team.
+% Copyright (C) 2013-2020, 2022-2024 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.
%---------------------------------------------------------------------------%
@@ -140,7 +140,7 @@ type_to_string_and_dims_for_java(Info, MLDS_Type, String, ArrayDims) :-
% We need to handle type_info (etc.) types specially --
% they get mapped to types in the runtime rather than
% in private_builtin.
- hand_defined_type_for_java(Type, coerce(CtorCat),
+ hand_defined_type_for_java(Type, CtorCat,
StringPrime, ArrayDimsPrime)
then
String = StringPrime,
diff --git a/compiler/options.m b/compiler/options.m
index 6eaeb124b..6a5d22832 100644
--- a/compiler/options.m
+++ b/compiler/options.m
@@ -253,6 +253,7 @@
; print_error_spec_id
; inform_ignored_pragma_errors
; inform_generated_type_spec_pragmas
+ ; warn_redundant_coerce
% Verbosity options
; verbose
@@ -1373,6 +1374,7 @@ optdef(oc_warn, inform_suboptimal_packing, bool(no)).
optdef(oc_warn, print_error_spec_id, bool(no)).
optdef(oc_warn, inform_ignored_pragma_errors, bool(no)).
optdef(oc_warn, inform_generated_type_spec_pragmas, bool(no)).
+optdef(oc_warn, warn_redundant_coerce, bool(yes)).
% Verbosity options.
@@ -2353,6 +2355,7 @@ long_table("inform-ignored-pragma-errors",
inform_ignored_pragma_errors).
long_table("inform-generated-type-spec-pragmas",
inform_generated_type_spec_pragmas).
+long_table("warn-redundant-coerce", warn_redundant_coerce).
% verbosity options
long_table("verbose", verbose).
@@ -4269,7 +4272,8 @@ style_warning_options = [
warn_suspicious_foreign_procs,
warn_state_var_shadowing,
warn_unneeded_mode_specific_clause,
- inform_suboptimal_packing
+ inform_suboptimal_packing,
+ warn_redundant_coerce
].
non_style_warning_options = [
@@ -4646,7 +4650,7 @@ options_help_warning(Stream, !IO) :-
"\tDo not generate messages about inferred modes.",
"--inform-suboptimal-packing",
"\tGenerate messages if the arguments of a data constructor",
- "\tcould be packed more tightly if they were reordered."
+ "\tcould be packed more tightly if they were reordered.",
% "--print-error-spec-id",
% "\tAfter each error message is printed, print its id, which",
% "\tby convention is the $pred of the code that constructs it."
@@ -4658,6 +4662,8 @@ options_help_warning(Stream, !IO) :-
% "\tPrint an informational message for each type_spec pragma that"
% "\tthe compiler generates to implement a type_spec_constrained_pred"
% "\tpragma.",
+ "--no-warn-redundant-coerce",
+ "\tDo not warn about redundant type conversions."
], !IO).
:- pred options_help_verbosity(io.text_output_stream::in,
diff --git a/compiler/type_assign.m b/compiler/type_assign.m
index 7ceb00f52..84b0ac43b 100644
--- a/compiler/type_assign.m
+++ b/compiler/type_assign.m
@@ -1,7 +1,7 @@
%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
-% Copyright (C) 2014-2015, 2018, 2020-2021 The Mercury team.
+% Copyright (C) 2014-2015, 2018, 2020-2021, 2024 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.
%---------------------------------------------------------------------------%
@@ -67,7 +67,8 @@
:- type coerce_constraint_status
---> need_to_check
- ; unsatisfiable.
+ ; unsatisfiable
+ ; satisfied_but_redundant.
:- pred type_assign_get_var_types(type_assign::in,
vartypes::out) is det.
diff --git a/compiler/typecheck.m b/compiler/typecheck.m
index df78c7a07..74ed33ad8 100644
--- a/compiler/typecheck.m
+++ b/compiler/typecheck.m
@@ -2,7 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 1993-2012 The University of Melbourne.
-% Copyright (C) 2014-2021 The Mercury team.
+% Copyright (C) 2014-2024 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.
%---------------------------------------------------------------------------%
@@ -591,7 +591,7 @@ do_typecheck_pred(ProgressStream, ModuleInfo, PredId, !PredInfo,
perform_context_reduction(Context, !TypeAssignSet, !Info),
typecheck_check_for_ambiguity(Context, whole_pred, HeadVars,
!.TypeAssignSet, !Info),
- typecheck_check_for_unsatisfied_coercions(!.TypeAssignSet, !Info),
+ typecheck_check_remaining_coercion_constraints(!.TypeAssignSet, !Info),
type_assign_set_get_final_info(!.TypeAssignSet,
!.ExternalTypeParams, ExistQVars0, ExplicitVarTypes0, TypeVarSet,
!:ExternalTypeParams, InferredVarTypes, InferredTypeConstraints0,
@@ -1030,24 +1030,17 @@ special_pred_needs_typecheck(ModuleInfo, PredInfo) :-
%---------------------------------------------------------------------------%
-:- pred typecheck_check_for_unsatisfied_coercions(type_assign_set::in,
+:- pred typecheck_check_remaining_coercion_constraints(type_assign_set::in,
typecheck_info::in, typecheck_info::out) is det.
-typecheck_check_for_unsatisfied_coercions(TypeAssignSet, !Info) :-
+typecheck_check_remaining_coercion_constraints(TypeAssignSet, !Info) :-
(
TypeAssignSet = [],
unexpected($pred, "no type-assignment")
;
TypeAssignSet = [TypeAssign],
type_assign_get_coerce_constraints(TypeAssign, Coercions),
- (
- Coercions = []
- ;
- Coercions = [_ | _],
- % All valid coercion constraints have been removed from the
- % type assignment already.
- list.foldl(report_invalid_coercion(TypeAssign), Coercions, !Info)
- )
+ list.foldl(report_coercion(TypeAssign), Coercions, !Info)
;
TypeAssignSet = [_, _ | _]
% If there are multiple type assignments then there is a type ambiguity
@@ -1055,21 +1048,31 @@ typecheck_check_for_unsatisfied_coercions(TypeAssignSet, !Info) :-
% assignments would be confusing.
).
-:- pred report_invalid_coercion(type_assign::in, coerce_constraint::in,
+:- pred report_coercion(type_assign::in, coerce_constraint::in,
typecheck_info::in, typecheck_info::out) is det.
-report_invalid_coercion(TypeAssign, Coercion, !Info) :-
+report_coercion(TypeAssign, Coercion, !Info) :-
% XXX When inferring types for a predicate/function with no declared type,
% we should not report coercions as invalid until the argument types have
% been inferred.
- Coercion = coerce_constraint(FromType0, ToType0, Context, _Status),
+ Coercion = coerce_constraint(FromType0, ToType0, Context, Status),
type_assign_get_typevarset(TypeAssign, TVarSet),
type_assign_get_type_bindings(TypeAssign, TypeBindings),
apply_rec_subst_to_type(TypeBindings, FromType0, FromType),
apply_rec_subst_to_type(TypeBindings, ToType0, ToType),
typecheck_info_get_error_clause_context(!.Info, ClauseContext),
- Spec = report_invalid_coerce_from_to(ClauseContext, Context, TVarSet,
- FromType, ToType),
+ (
+ Status = need_to_check,
+ unexpected($pred, "need to check")
+ ;
+ Status = unsatisfiable,
+ Spec = report_invalid_coerce_from_to(ClauseContext, Context, TVarSet,
+ FromType, ToType)
+ ;
+ Status = satisfied_but_redundant,
+ Spec = report_redundant_coerce(ClauseContext, Context, TVarSet,
+ FromType)
+ ),
typecheck_info_add_error(Spec, !Info).
%---------------------------------------------------------------------------%
diff --git a/compiler/typecheck_clauses.m b/compiler/typecheck_clauses.m
index 8352d7f23..e1f3625cb 100644
--- a/compiler/typecheck_clauses.m
+++ b/compiler/typecheck_clauses.m
@@ -95,6 +95,7 @@
:- import_module parse_tree.vartypes.
:- import_module assoc_list.
+:- import_module bool.
:- import_module int.
:- import_module io.
:- import_module map.
@@ -1788,14 +1789,18 @@ typecheck_coerce_2(Context, FromVar, ToVar, TypeAssign0,
typecheck_coerce_between_types(TypeTable, TVarSet,
FromType, ToType, TypeAssign0, TypeAssign1)
then
- TypeAssign = TypeAssign1
+ type_assign_get_type_bindings(TypeAssign1, TypeBindings1),
+ ( if is_same_type_after_subst(TypeBindings1, FromType, ToType) then
+ Coercion = coerce_constraint(FromType, ToType, Context,
+ satisfied_but_redundant),
+ add_coerce_constraint(Coercion, TypeAssign1, TypeAssign)
+ else
+ TypeAssign = TypeAssign1
+ )
else
- type_assign_get_coerce_constraints(TypeAssign0, Coercions0),
Coercion = coerce_constraint(FromType, ToType, Context,
unsatisfiable),
- Coercions = [Coercion | Coercions0],
- type_assign_set_coerce_constraints(Coercions,
- TypeAssign0, TypeAssign)
+ add_coerce_constraint(Coercion, TypeAssign0, TypeAssign)
),
!:TypeAssignSet = [TypeAssign | !.TypeAssignSet]
else
@@ -1817,13 +1822,27 @@ typecheck_coerce_2(Context, FromVar, ToVar, TypeAssign0,
type_assign_fresh_type_var(ToVar, ToType,
TypeAssign1, TypeAssign2)
),
- type_assign_get_coerce_constraints(TypeAssign2, Coercions0),
Coercion = coerce_constraint(FromType, ToType, Context, need_to_check),
- Coercions = [Coercion | Coercions0],
- type_assign_set_coerce_constraints(Coercions, TypeAssign2, TypeAssign),
+ add_coerce_constraint(Coercion, TypeAssign2, TypeAssign),
!:TypeAssignSet = [TypeAssign | !.TypeAssignSet]
).
+:- pred is_same_type_after_subst(tsubst::in, mer_type::in, mer_type::in)
+ is semidet.
+
+is_same_type_after_subst(TypeBindings, TypeA0, TypeB0) :-
+ apply_rec_subst_to_type(TypeBindings, TypeA0, TypeA),
+ apply_rec_subst_to_type(TypeBindings, TypeB0, TypeB),
+ strip_kind_annotation(TypeA) = strip_kind_annotation(TypeB).
+
+:- pred add_coerce_constraint(coerce_constraint::in,
+ type_assign::in, type_assign::out) is det.
+
+add_coerce_constraint(Coercion, !TypeAssign) :-
+ type_assign_get_coerce_constraints(!.TypeAssign, Coercions0),
+ Coercions = [Coercion | Coercions0],
+ type_assign_set_coerce_constraints(Coercions, !TypeAssign).
+
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
@@ -2493,7 +2512,7 @@ typecheck_prune_coerce_constraints(TypeAssignSet0, TypeAssignSet, !Info) :-
typecheck_info_get_type_table(!.Info, TypeTable),
list.map(type_assign_prune_coerce_constraints(TypeTable),
TypeAssignSet0, TypeAssignSet1),
- list.filter(type_assign_has_no_coerce_constraints,
+ list.filter(type_assign_has_only_satisfied_coerce_constraints,
TypeAssignSet1, SatisfiedTypeAssignSet, UnsatisfiedTypeAssignSet),
(
SatisfiedTypeAssignSet = [_ | _],
@@ -2512,59 +2531,85 @@ type_assign_prune_coerce_constraints(TypeTable, !TypeAssign) :-
Coercions0 = []
;
Coercions0 = [_ | _],
- check_and_drop_coerce_constraints(TypeTable, Coercions0, Coercions,
+ check_pending_coerce_constraints(TypeTable, Coercions0, Coercions,
!TypeAssign),
type_assign_set_coerce_constraints(Coercions, !TypeAssign)
).
-:- pred check_and_drop_coerce_constraints(type_table::in,
+:- pred check_pending_coerce_constraints(type_table::in,
list(coerce_constraint)::in, list(coerce_constraint)::out,
type_assign::in, type_assign::out) is det.
-check_and_drop_coerce_constraints(_TypeTable, [], [], !TypeAssign).
-check_and_drop_coerce_constraints(TypeTable, [Coercion0 | Coercions0],
+check_pending_coerce_constraints(_TypeTable, [], [], !TypeAssign).
+check_pending_coerce_constraints(TypeTable, [Coercion0 | Coercions0],
KeepCoercions, !TypeAssign) :-
- check_coerce_constraint(TypeTable, Coercion0, !.TypeAssign, Satisfied),
+ Coercion0 = coerce_constraint(FromType0, ToType0, Context, Status0),
(
- Satisfied = yes(!:TypeAssign),
- check_and_drop_coerce_constraints(TypeTable, Coercions0,
- KeepCoercions, !TypeAssign)
- ;
- Satisfied = no,
- check_and_drop_coerce_constraints(TypeTable, Coercions0,
- TailKeepCoercions, !TypeAssign),
- KeepCoercions = [Coercion0 | TailKeepCoercions]
- ).
-
-:- pred check_coerce_constraint(type_table::in, coerce_constraint::in,
- type_assign::in, maybe(type_assign)::out) is det.
-
-check_coerce_constraint(TypeTable, Coercion, TypeAssign0, Satisfied) :-
- Coercion = coerce_constraint(FromType0, ToType0, _Context, Status),
- (
- Status = need_to_check,
- type_assign_get_type_bindings(TypeAssign0, TypeBindings),
+ Status0 = need_to_check,
+ TypeAssign0 = !.TypeAssign,
+ type_assign_get_type_bindings(TypeAssign0, TypeBindings0),
type_assign_get_typevarset(TypeAssign0, TVarSet),
- apply_rec_subst_to_type(TypeBindings, FromType0, FromType),
- apply_rec_subst_to_type(TypeBindings, ToType0, ToType),
+ apply_rec_subst_to_type(TypeBindings0, FromType0, FromType),
+ apply_rec_subst_to_type(TypeBindings0, ToType0, ToType),
( if
typecheck_coerce_between_types(TypeTable, TVarSet,
- FromType, ToType, TypeAssign0, TypeAssign)
+ FromType, ToType, TypeAssign0, TypeAssign1)
then
- Satisfied = yes(TypeAssign)
+ type_assign_get_type_bindings(TypeAssign1, TypeBindings1),
+ ( if is_same_type_after_subst(TypeBindings1, FromType, ToType) then
+ Keep = yes,
+ Coercion = coerce_constraint(FromType, ToType, Context,
+ satisfied_but_redundant)
+ else
+ Keep = no,
+ Coercion = Coercion0
+ ),
+ % XXX This biases the typechecker to type bindings made by coerce
+ % constraints that happen to be processed earlier. Perhaps we can
+ % just delete this line, but it needs more thought.
+ !:TypeAssign = TypeAssign1
else
- Satisfied = no
+ Keep = yes,
+ Coercion = coerce_constraint(FromType0, ToType0, Context,
+ unsatisfiable)
)
;
- Status = unsatisfiable,
- Satisfied = no
+ ( Status0 = unsatisfiable
+ ; Status0 = satisfied_but_redundant
+ ),
+ Keep = yes,
+ Coercion = Coercion0
+ ),
+ (
+ Keep = yes,
+ check_pending_coerce_constraints(TypeTable, Coercions0,
+ TailKeepCoercions, !TypeAssign),
+ KeepCoercions = [Coercion | TailKeepCoercions]
+ ;
+ Keep = no,
+ check_pending_coerce_constraints(TypeTable, Coercions0,
+ KeepCoercions, !TypeAssign)
).
-:- pred type_assign_has_no_coerce_constraints(type_assign::in)
+:- pred type_assign_has_only_satisfied_coerce_constraints(type_assign::in)
is semidet.
-type_assign_has_no_coerce_constraints(TypeAssign) :-
- type_assign_get_coerce_constraints(TypeAssign, []).
+type_assign_has_only_satisfied_coerce_constraints(TypeAssign) :-
+ type_assign_get_coerce_constraints(TypeAssign, Coercions),
+ all_true(coerce_constraint_is_satisfied, Coercions).
+
+:- pred coerce_constraint_is_satisfied(coerce_constraint::in) is semidet.
+
+coerce_constraint_is_satisfied(Coercion) :-
+ Coercion = coerce_constraint(_FromType, _ToType, _Context, Status),
+ require_complete_switch [Status]
+ (
+ Status = need_to_check, fail
+ ;
+ Status = unsatisfiable, fail
+ ;
+ Status = satisfied_but_redundant
+ ).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
diff --git a/compiler/typecheck_errors.m b/compiler/typecheck_errors.m
index 4c49725cd..a13021ec0 100644
--- a/compiler/typecheck_errors.m
+++ b/compiler/typecheck_errors.m
@@ -44,6 +44,9 @@
:- func report_invalid_coerce_from_to(type_error_clause_context, prog_context,
tvarset, mer_type, mer_type) = error_spec.
+:- func report_redundant_coerce(type_error_clause_context, prog_context,
+ tvarset, mer_type) = error_spec.
+
%---------------------------------------------------------------------------%
:- func report_error_unify_var_var(typecheck_info, unify_context, prog_context,
@@ -121,6 +124,8 @@
:- import_module hlds.hlds_out.
:- import_module hlds.hlds_out.hlds_out_util.
:- import_module hlds.hlds_pred.
+:- import_module libs.
+:- import_module libs.options.
:- import_module mdbcomp.builtin_modules.
:- import_module mdbcomp.sym_name.
:- import_module parse_tree.error_type_util.
@@ -136,6 +141,7 @@
:- import_module parse_tree.var_db.
:- import_module assoc_list.
+:- import_module bool.
:- import_module int.
:- import_module map.
:- import_module one_or_more.
@@ -277,13 +283,7 @@ report_invalid_coerce_from_to(ClauseContext, Context, TVarSet,
% - For tests/invalid/coerce_infer.m and some others, it says that
% you cannot coerce from one anonymous type variable to another.
%
- % - For tests/invalid/coerce_non_du.m, it says that you cannot coerce
- % from a given type to itself.
- %
- % For the first kind of error, is there something we can report
- % that would be more helpful?
- %
- % For the second kind, should it even be an error, or just a warning?
+ % Is there something we can report that would be more helpful?
InClauseForPieces = in_clause_for_pieces(ClauseContext),
FromTypeStr = mercury_type_to_string(TVarSet, print_num_only, FromType),
ToTypeStr = mercury_type_to_string(TVarSet, print_num_only, ToType),
@@ -293,16 +293,16 @@ report_invalid_coerce_from_to(ClauseContext, Context, TVarSet,
describe_if_non_du_type(FromType, FromTypeNonDuPieces),
(
FromTypeNonDuPieces = [],
- CausePieces = [words("You cannot coerce")] ++
- color_as_incorrect([words("from a type to the same type.")])
+ % We shouldn't get here. FromType and ToType must be the same du
+ % type, but a coercion from one du type to the same du type must be
+ % type-correct. However, throwing an exception would only punish an
+ % innocent user.
+ CausePieces = []
;
FromTypeNonDuPieces = [_ | _],
CausePieces = OnlyDuPieces ++
[quote(FromTypeStr), words("is a")] ++
- color_as_incorrect(FromTypeNonDuPieces ++ [suffix(".")]) ++
- [nl] ++
- [words("Also, you cannot coerce")] ++
- color_as_incorrect([words("from a type to the same type.")])
+ color_as_incorrect(FromTypeNonDuPieces ++ [suffix(".")])
)
else
describe_if_non_du_type(FromType, FromTypeNonDuPieces),
@@ -354,6 +354,17 @@ report_invalid_coerce_from_to(ClauseContext, Context, TVarSet,
Spec = spec($pred, severity_error, phase_type_check, Context,
InClauseForPieces ++ ErrorPieces).
+report_redundant_coerce(ClauseContext, Context, TVarSet, FromType) = Spec :-
+ InClauseForPieces = in_clause_for_pieces(ClauseContext),
+ FromTypeStr = mercury_type_to_string(TVarSet, print_num_only, FromType),
+ ErrorPieces = [words("warning: type conversion from")] ++
+ [quote(FromTypeStr), words("to the same type is")] ++
+ color_as_incorrect([words("redundant.")]) ++ [nl],
+ Severity = severity_conditional(warn_redundant_coerce, yes,
+ severity_warning, no),
+ Spec = spec($pred, Severity, phase_type_check, Context,
+ InClauseForPieces ++ ErrorPieces).
+
% If the given type is du type, return the empty list. Otherwise,
% return a description of what kind of non-du type it is.
%
diff --git a/doc/user_guide.texi b/doc/user_guide.texi
index 82237033a..050f4a4c0 100644
--- a/doc/user_guide.texi
+++ b/doc/user_guide.texi
@@ -7056,6 +7056,13 @@ could be packed more tightly if they were reordered.
@c the compiler generates to implement
@c a @code{type_spec_constrained_pred} pragma.
+ at sp 1
+ at item --no-warn-redundant-coerce
+ at findex --no-warn-redundant-coerce
+Do not warn about redundant type conversions,
+i.e.@: when the type of a @samp{coerce} expression
+is the same as the argument type.
+
@end table
@node Verbosity options
diff --git a/tests/invalid/coerce_ambig.err_exp b/tests/invalid/coerce_ambig.err_exp
index 9b3bcb354..43b3df14e 100644
--- a/tests/invalid/coerce_ambig.err_exp
+++ b/tests/invalid/coerce_ambig.err_exp
@@ -10,4 +10,12 @@ coerce_ambig.m:036: The following variables have ambiguous types:
coerce_ambig.m:036: The variable [38;5;87m`X'[39;49m can have either of the following types:
coerce_ambig.m:036: [38;5;226mcoerce_ambig.another_fruit,[39;49m
coerce_ambig.m:036: [38;5;226mcoerce_ambig.fruit.[39;49m
+coerce_ambig.m:044: In clause for predicate `ambig3'/1:
+coerce_ambig.m:044: warning: type conversion from
+coerce_ambig.m:044: `coerce_ambig.list(coerce_ambig.fruit)' to the same type
+coerce_ambig.m:044: is [38;5;203mredundant.[39;49m
+coerce_ambig.m:053: In clause for predicate `ambig4'/0:
+coerce_ambig.m:053: warning: type conversion from
+coerce_ambig.m:053: `coerce_ambig.list(coerce_ambig.fruit)' to the same type
+coerce_ambig.m:053: is [38;5;203mredundant.[39;49m
For more information, recompile with `-E'.
diff --git a/tests/invalid/coerce_ambig.m b/tests/invalid/coerce_ambig.m
index d8456f7d9..342f658d5 100644
--- a/tests/invalid/coerce_ambig.m
+++ b/tests/invalid/coerce_ambig.m
@@ -43,4 +43,13 @@ ambig3(Xs) :-
% Not ambiguous after we unify list(_T) with list(fruit).
Xs = coerce([]).
+:- pred ambig4 is det.
+
+ambig4 :-
+ % XXX The compiler wrongly picks X : list(fruit) or X : list(citrus)
+ % when it has no reason to reject the other possibility.
+ X = [],
+ coerce(X) = _ : list(citrus),
+ coerce(X) = _ : list(fruit).
+
%---------------------------------------------------------------------------%
diff --git a/tests/invalid/coerce_clobbered.err_exp b/tests/invalid/coerce_clobbered.err_exp
index e80f23167..c25024888 100644
--- a/tests/invalid/coerce_clobbered.err_exp
+++ b/tests/invalid/coerce_clobbered.err_exp
@@ -2,3 +2,7 @@ coerce_clobbered.m:021: In clause for `bad(in(clobbered), out)':
coerce_clobbered.m:021: in coerce expression:
coerce_clobbered.m:021: mode error: the [38;5;87mcoerced term[39;49m has instantiatedness
coerce_clobbered.m:021: [38;5;203m`clobbered',[39;49m but it must have a [38;5;40mground[39;49m inst.
+coerce_clobbered.m:021: In clause for predicate `bad'/2:
+coerce_clobbered.m:021: warning: type conversion from
+coerce_clobbered.m:021: `coerce_clobbered.fruit' to the same type is
+coerce_clobbered.m:021: [38;5;203mredundant.[39;49m
diff --git a/tests/invalid/coerce_int.err_exp b/tests/invalid/coerce_int.err_exp
index 5e47a7512..8c0afbfaf 100644
--- a/tests/invalid/coerce_int.err_exp
+++ b/tests/invalid/coerce_int.err_exp
@@ -1,3 +1,6 @@
+coerce_int.m:020: In clause for function `ok'/1:
+coerce_int.m:020: warning: type conversion from `coerce_int.wrap(int)' to the
+coerce_int.m:020: same type is [38;5;203mredundant.[39;49m
coerce_int.m:026: In clause for `bad(in(coerce_int.wrap(bound(1 ; 2)))) =
coerce_int.m:026: out(coerce_int.wrap(bound(1 ; 3)))':
coerce_int.m:026: mode error: the function result had the wrong
@@ -22,6 +25,9 @@ coerce_int.m:026: [38;5;40m3[39;49m
coerce_int.m:026: [38;5;40m)[39;49m
coerce_int.m:026: [38;5;40m)[39;49m
coerce_int.m:026: [38;5;40m).[39;49m
+coerce_int.m:026: In clause for function `bad'/1:
+coerce_int.m:026: warning: type conversion from `coerce_int.wrap(int)' to the
+coerce_int.m:026: same type is [38;5;203mredundant.[39;49m
coerce_int.m:032: In clause for `bad_wrong_type(in(coerce_int.wrap(bound(1 ; 2
coerce_int.m:032: ; 42u)))) = out(coerce_int.wrap(bound(1 ; 2)))':
coerce_int.m:032: in coerce expression:
@@ -32,3 +38,6 @@ coerce_int.m:032: `uint' because the following function symbols in the input
coerce_int.m:032: term's instantiatedness are [38;5;203mnot part of the input type:[39;49m
coerce_int.m:032: [38;5;203m`1',[39;49m
coerce_int.m:032: [38;5;203m`2'.[39;49m
+coerce_int.m:032: In clause for function `bad_wrong_type'/1:
+coerce_int.m:032: warning: type conversion from `coerce_int.wrap(uint)' to
+coerce_int.m:032: the same type is [38;5;203mredundant.[39;49m
diff --git a/tests/invalid/coerce_mode_error.err_exp b/tests/invalid/coerce_mode_error.err_exp
index ebcd99323..792c15af2 100644
--- a/tests/invalid/coerce_mode_error.err_exp
+++ b/tests/invalid/coerce_mode_error.err_exp
@@ -2,6 +2,10 @@ coerce_mode_error.m:035: In clause for `bad_coerce_free_input(in(free), out)':
coerce_mode_error.m:035: in coerce expression:
coerce_mode_error.m:035: mode error: the [38;5;87mcoerced term[39;49m has instantiatedness
coerce_mode_error.m:035: [38;5;203m`free',[39;49m but it must have a [38;5;40mground[39;49m inst.
+coerce_mode_error.m:035: In clause for predicate `bad_coerce_free_input'/2:
+coerce_mode_error.m:035: warning: type conversion from
+coerce_mode_error.m:035: `coerce_mode_error.fruit' to the same type is
+coerce_mode_error.m:035: [38;5;203mredundant.[39;49m
coerce_mode_error.m:045: In clause for `bad_fruit_to_citrus(in, out)':
coerce_mode_error.m:045: in coerce expression:
coerce_mode_error.m:045: mode error: cannot convert the [38;5;87mcoerced term[39;49m from
diff --git a/tests/invalid/coerce_non_du.err_exp b/tests/invalid/coerce_non_du.err_exp
index 0cae775cf..121755890 100644
--- a/tests/invalid/coerce_non_du.err_exp
+++ b/tests/invalid/coerce_non_du.err_exp
@@ -2,25 +2,20 @@ coerce_non_du.m:015: In clause for function `f1'/1:
coerce_non_du.m:015: cannot coerce from [38;5;171m`int'[39;49m to [38;5;171m`int'.[39;49m
coerce_non_du.m:015: You can only coerce from one discriminated union type to
coerce_non_du.m:015: another, and `int' is a [38;5;203mbuiltin type.[39;49m
-coerce_non_du.m:015: Also, you cannot coerce [38;5;203mfrom a type to the same type.[39;49m
coerce_non_du.m:019: In clause for function `f2'/1:
coerce_non_du.m:019: cannot coerce from [38;5;171m`float'[39;49m to [38;5;171m`float'.[39;49m
coerce_non_du.m:019: You can only coerce from one discriminated union type to
coerce_non_du.m:019: another, and `float' is a [38;5;203mbuiltin type.[39;49m
-coerce_non_du.m:019: Also, you cannot coerce [38;5;203mfrom a type to the same type.[39;49m
coerce_non_du.m:023: In clause for function `f3'/1:
coerce_non_du.m:023: cannot coerce from [38;5;171m`{}'[39;49m to [38;5;171m`{}'.[39;49m
coerce_non_du.m:023: You can only coerce from one discriminated union type to
coerce_non_du.m:023: another, and `{}' is a [38;5;203mtuple type.[39;49m
-coerce_non_du.m:023: Also, you cannot coerce [38;5;203mfrom a type to the same type.[39;49m
coerce_non_du.m:027: In clause for function `f4'/1:
coerce_non_du.m:027: cannot coerce from [38;5;171m`((func int) = int)'[39;49m to
coerce_non_du.m:027: [38;5;171m`((func int) = int)'.[39;49m
coerce_non_du.m:027: You can only coerce from one discriminated union type to
coerce_non_du.m:027: another, and `((func int) = int)' is a [38;5;203mfunction type.[39;49m
-coerce_non_du.m:027: Also, you cannot coerce [38;5;203mfrom a type to the same type.[39;49m
coerce_non_du.m:031: In clause for function `f5'/1:
coerce_non_du.m:031: cannot coerce from [38;5;171m`pred(int, int)'[39;49m to [38;5;171m`pred(int, int)'.[39;49m
coerce_non_du.m:031: You can only coerce from one discriminated union type to
coerce_non_du.m:031: another, and `pred(int, int)' is a [38;5;203mpredicate type.[39;49m
-coerce_non_du.m:031: Also, you cannot coerce [38;5;203mfrom a type to the same type.[39;49m
diff --git a/tests/invalid/coerce_uniq.err_exp b/tests/invalid/coerce_uniq.err_exp
index 4864ff12d..59e54e01a 100644
--- a/tests/invalid/coerce_uniq.err_exp
+++ b/tests/invalid/coerce_uniq.err_exp
@@ -3,3 +3,12 @@ coerce_uniq.m:024: mode error: argument 1 did not get sufficiently
coerce_uniq.m:024: instantiated.
coerce_uniq.m:024: Final instantiatedness of [38;5;87m`X'[39;49m was [38;5;203m`ground',[39;49m
coerce_uniq.m:024: expected final instantiatedness was [38;5;40m`unique'.[39;49m
+coerce_uniq.m:024: In clause for predicate `coerce_ui'/2:
+coerce_uniq.m:024: warning: type conversion from `coerce_uniq.fruit' to the
+coerce_uniq.m:024: same type is [38;5;203mredundant.[39;49m
+coerce_uniq.m:029: In clause for predicate `coerce_di'/2:
+coerce_uniq.m:029: warning: type conversion from `coerce_uniq.fruit' to the
+coerce_uniq.m:029: same type is [38;5;203mredundant.[39;49m
+coerce_uniq.m:034: In clause for predicate `coerce_become_shared'/2:
+coerce_uniq.m:034: warning: type conversion from `coerce_uniq.fruit' to the
+coerce_uniq.m:034: same type is [38;5;203mredundant.[39;49m
diff --git a/tests/invalid/coerce_void.err_exp b/tests/invalid/coerce_void.err_exp
index f8d575105..021789c65 100644
--- a/tests/invalid/coerce_void.err_exp
+++ b/tests/invalid/coerce_void.err_exp
@@ -4,4 +4,7 @@ coerce_void.m:010: [38;5;87m`List':[39;49m [38;5;203mlist.list(T),[39;49
coerce_void.m:010: [38;5;87m`V_8': [39;49m [38;5;203mlist.list(T).[39;49m
coerce_void.m:010: The unbound type variable [38;5;203m`T'[39;49m will be implicitly bound to
coerce_void.m:010: the builtin type `void'.
+coerce_void.m:019: In clause for predicate `main'/2:
+coerce_void.m:019: warning: type conversion from `list.list(V_1)' to the same
+coerce_void.m:019: type is [38;5;203mredundant.[39;49m
For more information, recompile with `-E'.
diff --git a/tests/warnings/Mmakefile b/tests/warnings/Mmakefile
index 1f24496ce..89a678728 100644
--- a/tests/warnings/Mmakefile
+++ b/tests/warnings/Mmakefile
@@ -47,6 +47,7 @@ ERRORCHECK_PROGS = \
occurs \
pragma_source_file \
purity_warnings \
+ redundant_coerce \
save \
simple_code \
singleton_test \
diff --git a/tests/warnings/redundant_coerce.err_exp b/tests/warnings/redundant_coerce.err_exp
new file mode 100644
index 000000000..248110a27
--- /dev/null
+++ b/tests/warnings/redundant_coerce.err_exp
@@ -0,0 +1,11 @@
+redundant_coerce.m:035: In clause for predicate `test1'/0:
+redundant_coerce.m:035: warning: type conversion from `maybe.maybe(int)' to
+redundant_coerce.m:035: the same type is [38;5;203mredundant.[39;49m
+redundant_coerce.m:039: In clause for predicate `test2'/0:
+redundant_coerce.m:039: warning: type conversion from
+redundant_coerce.m:039: `redundant_coerce.box(redundant_coerce.fruit)' to the
+redundant_coerce.m:039: same type is [38;5;203mredundant.[39;49m
+redundant_coerce.m:049: In clause for predicate `test3'/0:
+redundant_coerce.m:049: warning: type conversion from
+redundant_coerce.m:049: `redundant_coerce.maybe_box(redundant_coerce.citrus)'
+redundant_coerce.m:049: to the same type is [38;5;203mredundant.[39;49m
diff --git a/tests/warnings/redundant_coerce.m b/tests/warnings/redundant_coerce.m
new file mode 100644
index 000000000..2716a5281
--- /dev/null
+++ b/tests/warnings/redundant_coerce.m
@@ -0,0 +1,49 @@
+%---------------------------------------------------------------------------%
+% vim: ts=4 sw=4 et ft=mercury
+%---------------------------------------------------------------------------%
+
+:- module redundant_coerce.
+:- interface.
+
+:- pred test1 is det.
+:- pred test2 is det.
+:- pred test3 is det.
+
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module maybe.
+
+:- type maybe_box(T)
+ ---> box(T)
+ ; no_box.
+
+:- type box(T) =< maybe_box(T)
+ ---> box(T).
+
+:- type fruit
+ ---> apple
+ ; orange
+ ; lemon.
+
+:- type citrus =< fruit
+ ---> orange
+ ; lemon.
+
+test1 :-
+ coerce(yes(1)) = _ : maybe(T).
+
+test2 :-
+ X = box(orange) : box(fruit),
+ coerce(X) = _ : box(fruit),
+ coerce(X) = _ : box(citrus),
+ coerce(X) = _ : maybe_box(fruit),
+ coerce(X) = _ : maybe_box(citrus).
+
+test3 :-
+ X = box(orange : citrus) : maybe_box(T),
+ coerce(X) = _ : box(fruit),
+ coerce(X) = _ : box(citrus),
+ coerce(X) = _ : maybe_box(fruit),
+ coerce(X) = _ : maybe_box(citrus).
--
2.44.0
More information about the reviews
mailing list