[m-rev.] for review: improve check for invalid invalid declarations
Peter Ross
pro at missioncriticalit.com
Fri Sep 28 15:32:18 AEST 2007
For juliensf or pwa to review.
===================================================================
Estimated hours taken: 4
Branches: main
Improve check for invalid instance declarations.
compiler/check_typeclass.m:
Check that each type in the instance declaration is a type with
no arguments of a polymorphic type whose arguments are all distinct
type variables.
compiler/type_util.m:
Fix a spelling mistake.
tests/invalid/Mmakefile:
tests/invalid/invalid_instance_declarations.err_exp:
tests/invalid/invalid_instance_declarations.m:
Test the new functionallity.
Index: compiler/check_typeclass.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/check_typeclass.m,v
retrieving revision 1.113
diff -u -r1.113 check_typeclass.m
--- compiler/check_typeclass.m 25 Sep 2007 04:56:37 -0000 1.113
+++ compiler/check_typeclass.m 28 Sep 2007 05:20:08 -0000
@@ -70,6 +70,10 @@
% generated, we should add the concrete definitions before this pass to
% ensure that they get checked.
%
+% Fifth, in check_instance_declaration_types/4, we check that each type
+% in the instance declaration must be either a type with no arguments,
+% or a polymorphic type whose arguments are all distinct type variables.
+%
% Last, in check_typeclass_constraints/4, we check typeclass constraints on
% predicate and function declarations and on existentially typed data
% constructors for ambiguity, taking into consideration the information
@@ -101,6 +105,7 @@
:- implementation.
:- import_module check_hlds.typeclasses.
+:- import_module check_hlds.type_util.
:- import_module hlds.hlds_code_util.
:- import_module hlds.hlds_data.
:- import_module hlds.hlds_error_util.
@@ -122,6 +127,7 @@
:- import_module parse_tree.prog_util.
:- import_module bool.
+:- import_module int.
:- import_module map.
:- import_module maybe.
:- import_module multi_map.
@@ -165,8 +171,14 @@
check_functional_dependencies(!ModuleInfo, !Specs),
trace [io(!IO5)] (
- maybe_write_string(Verbose, "% Checking typeclass constraints...\n",
- !IO5)
+ maybe_write_string(Verbose,
+ "% Checking instance declaration types...\n", !IO5)
+ ),
+ check_instance_declaration_types(!ModuleInfo, !Specs),
+
+ trace [io(!IO6)] (
+ maybe_write_string(Verbose, "% Checking typeclass constraints...\n",
+ !IO6)
),
check_typeclass_constraints(!ModuleInfo, !Specs).
@@ -1214,6 +1226,137 @@
;
true
).
+
+%---------------------------------------------------------------------------%
+
+ % In check_instance_declaration_types/4, we check that each type
+ % in the instance declaration must be either a type with no arguments,
+ % or a polymorphic type whose arguments are all distinct type variables.
+ %
+:- pred check_instance_declaration_types(module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+check_instance_declaration_types(!ModuleInfo, !Specs) :-
+ module_info_get_instance_table(!.ModuleInfo, InstanceTable),
+ map.foldl(check_instance_declaration_types(!.ModuleInfo),
+ InstanceTable, !Specs).
+
+:- pred check_instance_declaration_types(module_info::in,
+ class_id::in, list(hlds_instance_defn)::in,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+check_instance_declaration_types(MI, ClassId, InstanceDefns, !Specs) :-
+ list.foldl(check_one_instance_declaration_types(MI, ClassId),
+ InstanceDefns, !Specs).
+
+:- pred check_one_instance_declaration_types(module_info::in,
+ class_id::in, hlds_instance_defn::in,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+check_one_instance_declaration_types(MI, ClassId, InstanceDefn, !Specs) :-
+ Types = InstanceDefn ^ instance_types,
+ list.foldl3(is_valid_instance_type(MI, ClassId, InstanceDefn),
+ Types, 1, _, set.init, _, !Specs).
+
+ %
+ % Each of these types in the instance declaration must be either a
+ % type with no arguments, or a polymorphic type whose arguments are
+ % all distinct type variables.
+ %
+:- pred is_valid_instance_type(module_info::in,
+ class_id::in, hlds_instance_defn::in, mer_type::in,
+ int::in, int::out, set(mer_type)::in, set(mer_type)::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+is_valid_instance_type(_MI, _ClassId, _InstanceDefn,
+ builtin_type(_), N, N+1, !SeenTypes, !Specs).
+is_valid_instance_type(_MI, ClassId, InstanceDefn,
+ higher_order_type(_, _, _, _), N, N+1, !SeenTypes, !Specs) :-
+ Err = "is a higher order type",
+ Spec = error_message(ClassId, InstanceDefn, arg(N, Err)),
+ !:Specs = [Spec | !.Specs].
+is_valid_instance_type(_MI, ClassId, InstanceDefn,
+ tuple_type(Args, _), N, N+1, !SeenTypes, !Specs) :-
+ ( each_arg_is_a_distinct_type_variable(!.SeenTypes, Args) ->
+ svset.insert_list(Args, !SeenTypes)
+ ;
+ Err = "is not a type whose arguments are distinct type variables",
+ Spec = error_message(ClassId, InstanceDefn, arg(N, Err)),
+ !:Specs = [Spec | !.Specs]
+ ).
+is_valid_instance_type(_MI, ClassId, InstanceDefn,
+ apply_n_type(_, _, _), N, N+1, !SeenTypes, !Specs) :-
+ Err = "is a apply/N type",
+ Spec = error_message(ClassId, InstanceDefn, arg(N, Err)),
+ !:Specs = [Spec | !.Specs].
+is_valid_instance_type(_MI, _ClassId, _InstanceDefn,
+ kinded_type(_, _), N, N+1, !SeenTypes, !Specs) :-
+ unexpected("check_typeclass", "kinded_type").
+is_valid_instance_type(_MI, ClassId, InstanceDefn,
+ type_variable(_, _), N, N+1, !SeenTypes, !Specs) :-
+ Err = "is a type variable",
+ Spec = error_message(ClassId, InstanceDefn, arg(N, Err)),
+ !:Specs = [Spec | !.Specs].
+is_valid_instance_type(MI, ClassId, InstanceDefn,
+ Type @ defined_type(_, Args, _), N, N+1, !SeenTypes, !Specs) :-
+ ( each_arg_is_a_distinct_type_variable(!.SeenTypes, Args) ->
+ svset.insert_list(Args, !SeenTypes),
+ (
+ type_to_type_defn(MI, Type, TypeDefn),
+ get_type_defn_body(TypeDefn, TypeBody),
+ TypeBody = hlds_eqv_type(EqvType)
+ ->
+ is_valid_instance_type(MI,
+ ClassId, InstanceDefn, EqvType, N, _, !SeenTypes, !Specs)
+ ;
+ true
+ )
+ ;
+ Err = "is not a type whose arguments are distinct type variables",
+ Spec = error_message(ClassId, InstanceDefn, arg(N, Err)),
+ !:Specs = [Spec | !.Specs]
+ ).
+
+:- pred each_arg_is_a_distinct_type_variable(set(mer_type)::in,
+ list(mer_type)::in) is semidet.
+
+each_arg_is_a_distinct_type_variable(_, []).
+each_arg_is_a_distinct_type_variable(SeenTypes, [Type | Types]) :-
+ Type = type_variable(_, _),
+ not Type `list.member` Types,
+ not Type `set.member` SeenTypes,
+ each_arg_is_a_distinct_type_variable(SeenTypes, Types).
+
+:- type instance_decl_type_error
+ ---> arg(int, string)
+ .
+
+:- func error_message(
+ class_id, hlds_instance_defn, instance_decl_type_error) = error_spec.
+
+error_message(ClassId, InstanceDefn, E) = Spec :-
+ ClassId = class_id(ClassName, _),
+ ClassNameString = sym_name_to_string(ClassName),
+
+ InstanceVarSet = InstanceDefn ^ instance_tvarset,
+ InstanceTypes = InstanceDefn ^ instance_types,
+ InstanceContext = InstanceDefn ^ instance_context,
+ InstanceTypesString = mercury_type_list_to_string(InstanceVarSet,
+ InstanceTypes),
+
+ HeaderPieces =
+ [words("In instance declaration for"),
+ words("`" ++ ClassNameString ++
+ "(" ++ InstanceTypesString ++ ")':")
+ ],
+
+ E = arg(N, S),
+ Pieces = [words("arg #"), int_fixed(N), words(S)],
+
+ HeadingMsg = simple_msg(InstanceContext,
+ [always(HeaderPieces), always(Pieces)]),
+ Spec = error_spec(severity_error, phase_type_check, [HeadingMsg]).
+
%---------------------------------------------------------------------------%
% Look for pred or func declarations for which the type variables in
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.183
diff -u -r1.183 type_util.m
--- compiler/type_util.m 25 Sep 2007 04:56:43 -0000 1.183
+++ compiler/type_util.m 28 Sep 2007 05:20:08 -0000
@@ -187,7 +187,7 @@
:- pred get_cons_id_non_existential_arg_types(module_info::in,
mer_type::in, cons_id::in, list(mer_type)::out) is semidet.
- % The same as gget_cons_id_arg_types except that the cons_id is output
+ % The same as get_cons_id_arg_types except that the cons_id is output
% non-deterministically. The cons_id is not module-qualified.
%
:- pred cons_id_arg_types(module_info::in, mer_type::in,
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.221
diff -u -r1.221 Mmakefile
--- tests/invalid/Mmakefile 3 Sep 2007 11:44:07 -0000 1.221
+++ tests/invalid/Mmakefile 28 Sep 2007 05:20:08 -0000
@@ -114,6 +114,7 @@
invalid_event \
invalid_export_detism \
invalid_import_detism \
+ invalid_instance_declarations \
invalid_main \
invalid_mllibs \
invalid_new \
Index: tests/invalid/invalid_instance_declarations.err_exp
===================================================================
RCS file: tests/invalid/invalid_instance_declarations.err_exp
diff -N tests/invalid/invalid_instance_declarations.err_exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/invalid/invalid_instance_declarations.err_exp 28 Sep 2007 05:20:08 -0000
@@ -0,0 +1,18 @@
+invalid_instance_declarations.m:015: In instance declaration for
+invalid_instance_declarations.m:015: `invalid_instance_declarations.tc((invalid_instance_declarations.t(T,
+invalid_instance_declarations.m:015: T)))':
+invalid_instance_declarations.m:015: arg # 1 is not a type whose arguments
+invalid_instance_declarations.m:015: are distinct type variables
+invalid_instance_declarations.m:016: In instance declaration for
+invalid_instance_declarations.m:016: `invalid_instance_declarations.tc(((func)
+invalid_instance_declarations.m:016: = T))':
+invalid_instance_declarations.m:016: arg # 1 is a higher order type
+invalid_instance_declarations.m:017: In instance declaration for
+invalid_instance_declarations.m:017: `invalid_instance_declarations.tc({T,
+invalid_instance_declarations.m:017: T})':
+invalid_instance_declarations.m:017: arg # 1 is not a type whose arguments
+invalid_instance_declarations.m:017: are distinct type variables
+invalid_instance_declarations.m:018: In instance declaration for
+invalid_instance_declarations.m:018: `invalid_instance_declarations.tc((invalid_instance_declarations.t(int)))':
+invalid_instance_declarations.m:018: arg # 1 is not a type whose arguments
+invalid_instance_declarations.m:018: are distinct type variables
Index: tests/invalid/invalid_instance_declarations.m
===================================================================
RCS file: tests/invalid/invalid_instance_declarations.m
diff -N tests/invalid/invalid_instance_declarations.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/invalid/invalid_instance_declarations.m 28 Sep 2007 05:20:08 -0000
@@ -0,0 +1,18 @@
+:- module invalid_instance_declarations.
+:- interface.
+
+:- type t(T) ---> f(T).
+:- type t(T, U) ---> f(T, U).
+
+:- typeclass tc(T) where [].
+
+:- type e(T) == t(T, T).
+:- type f(T) == ((func) = T).
+:- type g(T) == {T, T}.
+:- type h == t(int).
+
+:- implementation.
+:- instance tc(e(T)) where [].
+:- instance tc(f(T)) where [].
+:- instance tc(g(T)) where [].
+:- instance tc(h) where [].
--------------------------------------------------------------------------
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