[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