[m-rev.] for review: emit error for non-visible types in instance decls
Julien Fischer
juliensf at csse.unimelb.edu.au
Fri Oct 19 18:18:39 AEST 2007
For review by anyone.
Estimated hours taken: 2
Branches: main
Fix a bug where the compiler failed to emit an error if an exported instance
declaration contained a type that was only visible in the implementation
of the module. (This is bug #11 in mantis.)
compiler/check_typeclass.m:
Check for the above situation and emit an error message.
Unrelated change: fix the wording of another error message.
Change some if-then-elses into switches.
compiler/make_hlds_passes.m:
Break an overlong line.
tests/invalid/Mmakefile:
tests/invalid/instance_no_type.{m,err_exp}:
Test case for the new error message.
Julien.
Index: compiler/check_typeclass.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/check_typeclass.m,v
retrieving revision 1.114
diff -u -r1.114 check_typeclass.m
--- compiler/check_typeclass.m 2 Oct 2007 04:32:48 -0000 1.114
+++ compiler/check_typeclass.m 19 Oct 2007 08:13:01 -0000
@@ -73,6 +73,9 @@
% 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.
+% We also check that all of the types in exported instance declarations are
+% in scope here. XXX that should really be done earlier, but with the
+% current implementation this is the most convenient spot.
%
% Last, in check_typeclass_constraints/4, we check typeclass constraints on
% predicate and function declarations and on existentially typed data
@@ -1258,7 +1261,6 @@
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.
@@ -1291,7 +1293,7 @@
).
is_valid_instance_type(_MI, ClassId, InstanceDefn,
apply_n_type(_, _, _), N, N+1, !SeenTypes, !Specs) :-
- Err = [words("is a apply/N type")],
+ Err = [words("is an apply/N type")],
Spec = error_message_2(ClassId, InstanceDefn, N, Err),
!:Specs = [Spec | !.Specs].
is_valid_instance_type(_MI, _ClassId, _InstanceDefn,
@@ -1303,19 +1305,29 @@
Spec = error_message_2(ClassId, InstanceDefn, N, Err),
!:Specs = [Spec | !.Specs].
is_valid_instance_type(MI, ClassId, InstanceDefn,
- Type @ defined_type(_, Args, _), N, N+1, !SeenTypes, !Specs) :-
+ Type @ defined_type(TypeName, Args, _), N, N+1, !SeenTypes, !Specs) :-
each_arg_is_a_distinct_type_variable(!.SeenTypes, Args, 1, Result),
(
Result = no_error,
svset.insert_list(Args, !SeenTypes),
- (
- type_to_type_defn(MI, Type, TypeDefn),
+ ( type_to_type_defn(MI, Type, TypeDefn) ->
+ list.length(Args, TypeArity),
+ is_visible_instance_type(TypeName, TypeArity, TypeDefn, ClassId,
+ InstanceDefn, !Specs),
get_type_defn_body(TypeDefn, TypeBody),
- TypeBody = hlds_eqv_type(EqvType)
- ->
- is_valid_instance_type(MI,
- ClassId, InstanceDefn, EqvType, N, _, !SeenTypes, !Specs)
+ (
+ TypeBody = hlds_eqv_type(EqvType),
+ is_valid_instance_type(MI, ClassId, InstanceDefn, EqvType, N,
+ _, !SeenTypes, !Specs)
+ ;
+ ( TypeBody = hlds_du_type(_, _, _, _, _, _, _)
+ ; TypeBody = hlds_foreign_type(_)
+ ; TypeBody = hlds_solver_type(_, _)
+ ; TypeBody = hlds_abstract_type(_)
+ )
+ )
;
+ % The type is either a builtin type or a type variable.
true
)
;
@@ -1327,6 +1339,53 @@
!:Specs = [Spec | !.Specs]
).
+ % Check that types that are referred to in an abstract instance
+ % declaration in a module interface are visible in the module
+ % interface, i.e they are either exported by the module or imported
+ % in the module interface.
+ %
+:- pred is_visible_instance_type(sym_name::in, arity::in, hlds_type_defn::in,
+ class_id::in, hlds_instance_defn::in,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+is_visible_instance_type(TypeName, TypeArity, TypeDefn, ClassId,
+ InstanceDefn, !Specs) :-
+ InstanceBody = InstanceDefn ^ instance_body,
+ (
+ InstanceBody = instance_body_abstract,
+ InstanceImportStatus = InstanceDefn ^ instance_status,
+ InstanceIsExported =
+ status_is_exported_to_non_submodules(InstanceImportStatus),
+ (
+ InstanceIsExported = yes,
+ get_type_defn_status(TypeDefn, TypeDefnImportStatus),
+ (
+ status_is_imported(TypeDefnImportStatus) = no,
+ status_is_exported_to_non_submodules(TypeDefnImportStatus) = no
+ ->
+ ClassId = class_id(ClassName, ClassArity),
+ Pieces = [
+ words("Error: abstract instance declaration for"),
+ words("type class"),
+ sym_name_and_arity(ClassName / ClassArity),
+ words("contains the type"),
+ sym_name_and_arity(TypeName / TypeArity),
+ words("but that type is not visible in the"),
+ words("module interface.")
+ ],
+ Context = InstanceDefn ^ instance_context,
+ Msg = simple_msg(Context, [always(Pieces)]),
+ Spec = error_spec(severity_error, phase_type_check, [Msg]),
+ !:Specs = [Spec | !.Specs]
+ ;
+ true
+ )
+ ;
+ InstanceIsExported = no
+ )
+ ;
+ InstanceBody = instance_body_concrete(_)
+ ).
:- type instance_arg_result
---> no_error
@@ -1341,13 +1400,13 @@
; arg_not_type_variable(ground)
.
-
:- pred each_arg_is_a_distinct_type_variable(set(mer_type)::in,
list(mer_type)::in, int::in, instance_arg_result::out) is det.
each_arg_is_a_distinct_type_variable(_, [], _, no_error).
each_arg_is_a_distinct_type_variable(SeenTypes, [Type | Types], N, Result) :-
- ( Type = type_variable(_, _) ->
+ (
+ Type = type_variable(_, _),
( Type `list.member` Types ->
Result = local_non_distinct
; Type `set.member` SeenTypes ->
@@ -1356,6 +1415,13 @@
each_arg_is_a_distinct_type_variable(SeenTypes, Types, N+1, Result)
)
;
+ ( Type = defined_type(_, _, _)
+ ; Type = builtin_type(_)
+ ; Type = higher_order_type(_, _, _, _)
+ ; Type = tuple_type(_, _)
+ ; Type = apply_n_type(_, _, _)
+ ; Type = kinded_type(_, _)
+ ),
Result = arg_not_type_variable(N)
).
Index: compiler/make_hlds_passes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make_hlds_passes.m,v
retrieving revision 1.73
diff -u -r1.73 make_hlds_passes.m
--- compiler/make_hlds_passes.m 2 Oct 2007 07:41:47 -0000 1.73
+++ compiler/make_hlds_passes.m 19 Oct 2007 08:13:01 -0000
@@ -340,7 +340,8 @@
Item = item_inst_defn(VarSet, Name, Params, InstDefn, Cond),
module_add_inst_defn(VarSet, Name, Params, InstDefn, Cond, Context,
!.Status, !ModuleInfo, InvalidMode, !Specs).
-add_item_decl_pass_1(Item, Context, !Status, !ModuleInfo, InvalidMode, !Specs) :-
+add_item_decl_pass_1(Item, Context, !Status, !ModuleInfo, InvalidMode,
+ !Specs) :-
Item = item_mode_defn(VarSet, Name, Params, ModeDefn, Cond),
module_add_mode_defn(VarSet, Name, Params, ModeDefn,
Cond, Context, !.Status, !ModuleInfo, InvalidMode, !Specs).
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.223
diff -u -r1.223 Mmakefile
--- tests/invalid/Mmakefile 19 Oct 2007 05:10:36 -0000 1.223
+++ tests/invalid/Mmakefile 19 Oct 2007 08:13:01 -0000
@@ -112,6 +112,7 @@
inst_list_dup \
instance_bug \
instance_dup_var \
+ instance_no_type \
invalid_event \
invalid_export_detism \
invalid_import_detism \
Index: tests/invalid/instance_no_type.err_exp
===================================================================
RCS file: tests/invalid/instance_no_type.err_exp
diff -N tests/invalid/instance_no_type.err_exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/invalid/instance_no_type.err_exp 19 Oct 2007 08:13:01 -0000
@@ -0,0 +1,12 @@
+instance_no_type.m:019: Error: abstract instance declaration for type class
+instance_no_type.m:019: `instance_no_type.tc'/1 contains the type
+instance_no_type.m:019: `instance_no_type.no_such_type'/0 but that type is
+instance_no_type.m:019: not visible in the module interface.
+instance_no_type.m:024: Error: abstract instance declaration for type class
+instance_no_type.m:024: `instance_no_type.tc2'/2 contains the type
+instance_no_type.m:024: `instance_no_type.no_such_type'/0 but that type is
+instance_no_type.m:024: not visible in the module interface.
+instance_no_type.m:024: Error: abstract instance declaration for type class
+instance_no_type.m:024: `instance_no_type.tc2'/2 contains the type
+instance_no_type.m:024: `instance_no_type.no_such_type2'/0 but that type is
+instance_no_type.m:024: not visible in the module interface.
Index: tests/invalid/instance_no_type.m
===================================================================
RCS file: tests/invalid/instance_no_type.m
diff -N tests/invalid/instance_no_type.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/invalid/instance_no_type.m 19 Oct 2007 08:13:01 -0000
@@ -0,0 +1,42 @@
+% rotd-2007-10-19 and before would not emit an error if you used a type
+% that was only visible in the implementation section of a module in
+% an abstract instance declaration in the interface of the module.
+%-----------------------------------------------------------------------------%
+
+:- module instance_no_type.
+:- interface.
+
+:- import_module list.
+
+:- type foo ---> foo.
+
+:- typeclass tc(T) where [].
+:- typeclass tc2(A, B) where [].
+
+:- instance tc(int). % Builtin type, no error.
+:- instance tc(foo). % Exported type, no error.
+:- instance tc(list(T)) <= tc(T). % Type imported in interface, no error.
+:- instance tc(no_such_type). % Non-exported type, ERROR.
+
+% The compiler already detects the case when an imported type that is
+% only visible in the interface is used in an abstract instance decl.
+
+:- instance tc2(no_such_type, no_such_type2).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- type no_such_type ---> no_such_type.
+:- type no_such_type2 ---> no_such_type2.
+
+:- instance tc(int) where [].
+:- instance tc(foo) where [].
+:- instance tc(list(T)) <= tc(T) where [].
+:- instance tc(no_such_type) where [].
+
+:- instance tc2(no_such_type, no_such_type2) where [].
+
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=8 sw=4 et wm=0 tw=0
--------------------------------------------------------------------------
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