[m-rev.] for review: do not allow type classes with variables as names
Julien Fischer
jfischer at opturion.com
Mon Dec 30 02:55:55 AEDT 2019
For review by anyone.
--------------------
Do not allow type classes with variables as names.
The compiler currently incorrectly accepts type classes with variable names;
change it to generate an error message instead.
Fix the confusing error messages we currently generate for instance
declarations with variables as names.
compiler/parse_class.m:
Make the above changes.
compiler/parse_item.m:
Extend the the check for variables as names to handle typeclass and
instance declarations.
Export some things for use by parse_class.m.
tests/invalid/Mmakefile:
tests/invalid/var_as_class_name.{m,err_exp}:
Add a test for the above.
Julien.
diff --git a/compiler/parse_class.m b/compiler/parse_class.m
index fe12112..f3356d9 100644
--- a/compiler/parse_class.m
+++ b/compiler/parse_class.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 1997-2011 University of Melbourne.
+% Copyright (C) 2016-2019 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.
%---------------------------------------------------------------------------%
@@ -330,44 +331,51 @@ parse_unconstrained_class(ModuleName, TVarSet, NameTerm, Context, SeqNum,
MaybeTypeClassInfo) :-
ContextPieces = cord.singleton(words("In typeclass declaration:")),
varset.coerce(TVarSet, VarSet),
- parse_implicitly_qualified_sym_name_and_args(ModuleName, NameTerm,
- VarSet, ContextPieces, MaybeClassName),
- (
- MaybeClassName = ok2(ClassName, TermVars0),
- list.map(term.coerce, TermVars0, TermVars),
+ ( if is_the_name_a_variable(VarSet, vtk_class_decl, NameTerm, Spec) then
+ MaybeTypeClassInfo = error1([Spec])
+ else
+ parse_implicitly_qualified_sym_name_and_args(ModuleName, NameTerm,
+ VarSet, ContextPieces, MaybeClassName),
(
- TermVars = [],
- Pieces = [words("Error: typeclass declarations require"),
- words("at least one class parameter."), nl],
- Spec = simplest_spec(severity_error, phase_term_to_parse_tree,
- get_term_context(NameTerm), Pieces),
- MaybeTypeClassInfo = error1([Spec])
- ;
- TermVars = [_ | _],
- ( if
- term.term_list_to_var_list(TermVars, Vars),
- list.sort_and_remove_dups(TermVars, SortedTermVars),
- list.length(SortedTermVars, NumSortedTermVars),
- list.length(TermVars, NumTermVars),
- NumSortedTermVars = NumTermVars
- then
- % XXX Would this be a better context?
- % Context = get_term_context(NameTerm),
- TypeClassInfo = item_typeclass_info(ClassName, Vars, [], [],
- class_interface_abstract, TVarSet, Context, SeqNum),
- MaybeTypeClassInfo = ok1(TypeClassInfo)
- else
- Pieces = [words("Error: expected distinct variables"),
- words("as class parameters."), nl],
- % XXX Would Context be better than get_term_context(NameTerm)?
+ MaybeClassName = ok2(ClassName, TermVars0),
+ list.map(term.coerce, TermVars0, TermVars),
+ (
+ TermVars = [],
+ Pieces = [words("Error: typeclass declarations require"),
+ words("at least one class parameter."), nl],
Spec = simplest_spec(severity_error, phase_term_to_parse_tree,
get_term_context(NameTerm), Pieces),
MaybeTypeClassInfo = error1([Spec])
+ ;
+ TermVars = [_ | _],
+ ( if
+ term.term_list_to_var_list(TermVars, Vars),
+ list.sort_and_remove_dups(TermVars, SortedTermVars),
+ list.length(SortedTermVars, NumSortedTermVars),
+ list.length(TermVars, NumTermVars),
+ NumSortedTermVars = NumTermVars
+ then
+ % XXX Would this be a better context?
+ % Context = get_term_context(NameTerm),
+ TypeClassInfo = item_typeclass_info(ClassName, Vars, [],
+ [], class_interface_abstract, TVarSet, Context,
+ SeqNum),
+ MaybeTypeClassInfo = ok1(TypeClassInfo)
+ else
+ Pieces = [words("Error: expected distinct variables"),
+ words("as class parameters."), nl],
+ % XXX Would Context be better than
+ % get_term_context(NameTerm)?
+ Spec = simplest_spec(severity_error,
+ phase_term_to_parse_tree, get_term_context(NameTerm),
+ Pieces),
+ MaybeTypeClassInfo = error1([Spec])
+ )
)
+ ;
+ MaybeClassName = error2(Specs),
+ MaybeTypeClassInfo = error1(Specs)
)
- ;
- MaybeClassName = error2(Specs),
- MaybeTypeClassInfo = error1(Specs)
).
:- pred parse_class_decls(module_name::in, varset::in, term::in,
@@ -506,25 +514,30 @@ parse_underived_instance(ModuleName, TVarSet, NameTerm, Context, SeqNum,
% could well be for a typeclass defined in another module.
NameContextPieces = cord.singleton(words("In instance declaration:")),
varset.coerce(TVarSet, VarSet),
- parse_sym_name_and_args(VarSet, NameContextPieces,
- NameTerm, MaybeClassName),
- (
- MaybeClassName = ok2(ClassName, TypeTerms),
- TypesContextPieces = NameContextPieces,
- parse_types(no_allow_ho_inst_info(wnhii_class_constraint),
- VarSet, TypesContextPieces, TypeTerms, MaybeTypes),
+ ( if is_the_name_a_variable(VarSet, vtk_instance_decl, NameTerm, Spec) then
+ MaybeItemInstanceInfo = error1([Spec])
+ else
+ parse_sym_name_and_args(VarSet, NameContextPieces,
+ NameTerm, MaybeClassName),
(
- MaybeTypes = ok1(Types),
- ItemInstanceInfo = item_instance_info(ClassName, Types, Types, [],
- instance_body_abstract, TVarSet, ModuleName, Context, SeqNum),
- MaybeItemInstanceInfo = ok1(ItemInstanceInfo)
+ MaybeClassName = ok2(ClassName, TypeTerms),
+ TypesContextPieces = NameContextPieces,
+ parse_types(no_allow_ho_inst_info(wnhii_class_constraint),
+ VarSet, TypesContextPieces, TypeTerms, MaybeTypes),
+ (
+ MaybeTypes = ok1(Types),
+ ItemInstanceInfo = item_instance_info(ClassName, Types, Types,
+ [], instance_body_abstract, TVarSet, ModuleName, Context,
+ SeqNum),
+ MaybeItemInstanceInfo = ok1(ItemInstanceInfo)
+ ;
+ MaybeTypes = error1(Specs),
+ MaybeItemInstanceInfo = error1(Specs)
+ )
;
- MaybeTypes = error1(Specs),
+ MaybeClassName = error2(Specs),
MaybeItemInstanceInfo = error1(Specs)
)
- ;
- MaybeClassName = error2(Specs),
- MaybeItemInstanceInfo = error1(Specs)
).
:- pred parse_non_empty_instance(module_name::in, varset::in, tvarset::in,
diff --git a/compiler/parse_item.m b/compiler/parse_item.m
index 711f2e7..30d7070 100644
--- a/compiler/parse_item.m
+++ b/compiler/parse_item.m
@@ -1,7 +1,7 @@
%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
-% Copyright (C) 2014 The Mercury team.
+% Copyright (C) 2014, 2016-2019 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.
%---------------------------------------------------------------------------%
@@ -16,6 +16,7 @@
:- import_module mdbcomp.
:- import_module mdbcomp.sym_name.
+:- import_module parse_tree.error_util.
:- import_module parse_tree.maybe_error.
:- import_module parse_tree.parse_types.
:- import_module parse_tree.prog_item.
@@ -56,6 +57,40 @@
maybe1(class_decl)::out) is det.
%---------------------------------------------------------------------------%
+
+ % This type specifies whether the declaration we are attempting to parse
+ % occurs inside a typeclass declaration or not.
+ % XXX possibly we should also include the identity of the typeclass
+ % involved in the case where parsing the class head succeeds.
+ %
+:- type decl_in_class
+ ---> decl_is_in_class
+ ; decl_is_not_in_class.
+
+%---------------------------------------------------------------------------%
+
+:- type var_term_kind
+ ---> vtk_type_decl_pred(decl_in_class)
+ ; vtk_type_decl_func(decl_in_class)
+ ; vtk_mode_decl_pred(decl_in_class)
+ ; vtk_mode_decl_func(decl_in_class)
+ ; vtk_class_decl
+ ; vtk_instance_decl
+ ; vtk_clause_pred
+ ; vtk_clause_func.
+
+ % The term parser turns "X(a, b)" into "`'(X, a, b)".
+ %
+ % Check whether Term is the result of this transformation,
+ % and if yes, return an error message that reflects what
+ % the term was supposed to be.
+ %
+ % Exported for use by parse_class.m.
+ %
+:- pred is_the_name_a_variable(varset::in, var_term_kind::in, term::in,
+ error_spec::out) is semidet.
+
+%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
@@ -63,7 +98,6 @@
:- import_module libs.
:- import_module libs.options.
:- import_module mdbcomp.prim_data.
-:- import_module parse_tree.error_util.
:- import_module parse_tree.parse_class.
:- import_module parse_tree.parse_dcg_goal.
:- import_module parse_tree.parse_goal.
@@ -146,15 +180,6 @@ decl_functor_is_not_valid(Term, Functor) = Spec :-
%---------------------------------------------------------------------------%
- % This type specifies whether the declaration we are attempting to parse
- % occurs inside a typeclass declaration or not.
- % XXX possibly we should also include the identity of the typeclass
- % involved in the case where parsing the class head succeeds.
- %
-:- type decl_in_class
- ---> decl_is_in_class
- ; decl_is_not_in_class.
-
:- pred parse_decl_item_or_marker(module_name::in, varset::in,
string::in, list(term)::in, decl_in_class::in, prog_context::in,
int::in, maybe1(item_or_marker)::out) is semidet.
@@ -1937,23 +1962,6 @@ parse_implicitly_qualified_module_name(DefaultModuleName, VarSet, Term,
%---------------------------------------------------------------------------%
-:- type var_term_kind
- ---> vtk_type_decl_pred(decl_in_class)
- ; vtk_type_decl_func(decl_in_class)
- ; vtk_mode_decl_pred(decl_in_class)
- ; vtk_mode_decl_func(decl_in_class)
- ; vtk_clause_pred
- ; vtk_clause_func.
-
- % The term parser turns "X(a, b)" into "`'(X, a, b)".
- %
- % Check whether Term is the result of this transformation,
- % and if yes, return an error message that reflects what
- % the term was supposed to be.
- %
-:- pred is_the_name_a_variable(varset::in, var_term_kind::in, term::in,
- error_spec::out) is semidet.
-
is_the_name_a_variable(VarSet, Kind, Term, Spec) :-
( if Term = term.functor(term.atom(""), ArgTerms, TermContext) then
( if
@@ -1965,6 +1973,7 @@ is_the_name_a_variable(VarSet, Kind, Term, Spec) :-
else
VarPieces = []
),
+ require_complete_switch [Kind]
(
Kind = vtk_type_decl_pred(IsInClass),
(
@@ -2002,6 +2011,12 @@ is_the_name_a_variable(VarSet, Kind, Term, Spec) :-
WhatPieces = [words("a mode for a type class function method")]
)
;
+ Kind = vtk_class_decl,
+ WhatPieces = [words("a type class")]
+ ;
+ Kind = vtk_instance_decl,
+ WhatPieces = [words("an instance for a type class")]
+ ;
Kind = vtk_clause_pred,
WhatPieces = [words("a clause for a predicate")]
;
diff --git a/tests/invalid/Mmakefile b/tests/invalid/Mmakefile
index 8d90b76..8d0cb27 100644
--- a/tests/invalid/Mmakefile
+++ b/tests/invalid/Mmakefile
@@ -346,6 +346,7 @@ SINGLEMODULE= \
unterminated_octal_escape \
user_eq_dummy \
uu_type \
+ var_as_class_name \
var_as_pred_name \
vars_in_wrong_places \
where_abstract_enum \
diff --git a/tests/invalid/var_as_class_name.err_exp b/tests/invalid/var_as_class_name.err_exp
index e69de29..4cdf5bd 100644
--- a/tests/invalid/var_as_class_name.err_exp
+++ b/tests/invalid/var_as_class_name.err_exp
@@ -0,0 +1,12 @@
+var_as_class_name.m:014: Error: you cannot declare a type class whose name is a
+var_as_class_name.m:014: variable such as `A'.
+var_as_class_name.m:015: Error: you cannot declare a type class whose name is a
+var_as_class_name.m:015: variable such as `B'.
+var_as_class_name.m:016: Error: you cannot declare a type class whose name is a
+var_as_class_name.m:016: variable such as `C'.
+var_as_class_name.m:017: Error: you cannot declare a type class whose name is a
+var_as_class_name.m:017: variable such as `D'.
+var_as_class_name.m:019: Error: you cannot declare an instance for a type class
+var_as_class_name.m:019: whose name is a variable such as `A'.
+var_as_class_name.m:020: Error: you cannot declare an instance for a type class
+var_as_class_name.m:020: whose name is a variable such as `B'.
diff --git a/tests/invalid/var_as_class_name.m b/tests/invalid/var_as_class_name.m
index e69de29..a8b9542 100644
--- a/tests/invalid/var_as_class_name.m
+++ b/tests/invalid/var_as_class_name.m
@@ -0,0 +1,20 @@
+%---------------------------------------------------------------------------%
+% vim: ts=4 sw=4 et ft=mercury
+%---------------------------------------------------------------------------%
+%
+% The term parser turns "X(a, b)" into "`'(X, a, b)". This would leads us to
+% generate confusing error messages for invalid declarations such as those
+% below if we didn't detect them, and handle them specially.
+%
+:- module var_as_class_name.
+:- interface.
+
+:- typeclass foo(T) where [].
+
+:- typeclass A(T).
+:- typeclass B(T) where [].
+:- typeclass C(T) <= foo(T).
+:- typeclass D(T) <= foo(T) where [].
+
+:- instance A(int).
+:- instance B(bar(T)) <= foo(T).
More information about the reviews
mailing list