[m-rev.] for review: disallow d.u. dummy types with user-defind uc

Julien Fischer juliensf at cs.mu.OZ.AU
Wed May 31 15:51:48 AEST 2006


For review by anyone.

This was discussed on mercury-developers the other day.  The consensus
there was that this was the preferable solution.

Estimated hours taken: 4
Branches: main, release

Do not allow discriminated unions with a single zero-arity constructor to have
user-defined equality or comparison.  Defining such types causes an assertion
failure in the compiler because the types are considered to be dummy types and
the runtime currently doesn't support (and probably won't ever) d.u. dummy
types with user-defined equality or comparison.

Fix another bug that where the compiler was not printing out the recompile
with `-E' prompt at the appropriate time.  The bug was caused by the fact that
there were several copies of the globals structure and the one that was being
checked at the time the prompt was being printed out was not the one that had
been updated during the rest of compilation.

compiler/add_types.m:
	Emit an error message if an attempt is made to define a d.u.
	dummy type with user-defined equality or comparison.

compiler/globals.m:
	Remove the extra_error_info field from the globals structure and turn
	it into a mutable.  Export access predicates for this mutable.  The
	reason for doing this is that the compiler was sometimes looking at
	the wrong copy of the globals structure when checking the value of
	this flag - this meant that sometimes the recompile with `-E' prompt
	was not being displayed.  Turning this flag into a mutable avoids the
	problem because now there is only one copy.

compiler/make_hlds.m:
	s/__/./  in a few spots.

doc/reference_manual.texi:
	Mention the new restrictions on discriminated union types with
	user-defined equality or comparison.

tests/invalid/exported_unify2.m:
tests/invalid/exported_unify3.m:
	Change some types with user-defined equality or comparison so that
	they are no longer dummy types.  These test cases have not been
	triggering the assertion failure in the compiler because they are only
	error checked and the assertion that is failing occurs further along
	in the compilation process.

tests/invalid/user_eq_dummy.{m,err_exp}:
	Test the new error message for dummy types with user-defined equality
	or comparison.

tests/invalid/extra_info_prompt.{m,err_exp}:
	Test that the recompile with `-E' prompt is being displayed when it
	should.

tests/invalid/Mercury.options:
tests/invalid/Mmakefile:
	Include the new test cases.

Julien.

Index: compiler/add_type.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/add_type.m,v
retrieving revision 1.14
diff -u -r1.14 add_type.m
--- compiler/add_type.m	20 Apr 2006 05:36:49 -0000	1.14
+++ compiler/add_type.m	31 May 2006 05:32:57 -0000
@@ -5,9 +5,10 @@
 % This file may only be copied under the terms of the GNU General
 % Public License - see the file COPYING in the Mercury distribution.
 %-----------------------------------------------------------------------------%
-
+%
 % This submodule of make_hlds handles the declarations of new types.
-
+%
+%-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%

 :- module hlds.make_hlds.add_type.
@@ -83,6 +84,7 @@
 module_add_type_defn(TVarSet, Name, Args, TypeDefn, _Cond, Context,
         item_status(Status0, NeedQual), !ModuleInfo, !IO) :-
     globals.io_get_globals(Globals, !IO),
+    globals.lookup_bool_option(Globals, verbose_errors, VerboseErrors),
     list.length(Args, Arity),
     TypeCtor = type_ctor(Name, Arity),
     convert_type_defn(TypeDefn, TypeCtor, Globals, Body0),
@@ -104,6 +106,42 @@
         Status1 = Status0
     ),
     (
+        % Discriminated unions whose definition consists of a single
+        % zero-arity constructor are not allowed to have user-defined
+        % equality or comparison.
+        %
+        TypeDefn = du_type(Ctors, MaybeUserUC),
+        Ctors = [ Constructor ],
+        list.length(Constructor ^ cons_args, 0),
+        MaybeUserUC \= no,
+        % Only report errors for types defined in this module.
+        status_defined_in_this_module(Status0, yes)
+    ->
+        DummyTypeError = [
+            words("Error: the type"),
+            sym_name_and_arity(Name / Arity),
+            words("is not allowed to have user-defined equality"),
+            words("or comparison.")
+        ],
+        (
+            VerboseErrors = yes,
+            VerboseDummyTypeError = [
+                words("Discriminated unions whose body consists of a single"),
+                words("zero-arity constructor cannot have user-defined"),
+                words("equality or comparison.")
+            ],
+            CompleteDummyTypeError = DummyTypeError ++ VerboseDummyTypeError
+        ;
+            VerboseErrors = no,
+            globals.io_set_extra_error_info(yes, !IO),
+            CompleteDummyTypeError = DummyTypeError
+        ),
+        write_error_pieces(Context, 0, CompleteDummyTypeError, !IO),
+        io.set_exit_status(1, !IO)
+    ;
+        true
+    ),
+    (
         % The type is exported if *any* occurrence is exported,
         % even a previous abstract occurrence.
         map.search(Types0, TypeCtor, OldDefn0)
@@ -251,7 +289,6 @@
                 words("with monomorphic definition,"),
                 words("exported as abstract type.")],
             write_error_pieces(Context, 0, Pieces, !IO),
-            globals.io_lookup_bool_option(verbose_errors, VerboseErrors, !IO),
             (
                 VerboseErrors = yes,
                 write_error_pieces(Context, 0, abstract_monotype_workaround,
Index: compiler/globals.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/globals.m,v
retrieving revision 1.74
diff -u -r1.74 globals.m
--- compiler/globals.m	29 Mar 2006 08:06:45 -0000	1.74
+++ compiler/globals.m	31 May 2006 04:42:13 -0000
@@ -5,15 +5,16 @@
 % This file may only be copied under the terms of the GNU General
 % Public License - see the file COPYING in the Mercury distribution.
 %-----------------------------------------------------------------------------%
-
+%
 % File: globals.m.
 % Main author: fjh.
-
+%
 % This module exports the `globals' type and associated access predicates.
 % The globals type is used to collect together all the various data
 % that would be global variables in an imperative language.
 % This global data is stored in the io.state.
-
+%
+%-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%

 :- module libs.globals.
@@ -152,7 +153,6 @@
     is det.
 :- pred get_maybe_thread_safe(globals::in, maybe_thread_safe::out)
     is det.
-:- pred get_extra_error_info(globals::in, bool::out) is det.

 :- pred set_option(option::in, option_data::in,
     globals::in, globals::out) is det.
@@ -167,8 +167,6 @@
 :- pred set_trace_level_none(globals::in, globals::out) is det.
 :- pred set_source_file_map(maybe(source_file_map)::in,
     globals::in, globals::out) is det.
-:- pred set_extra_error_info(bool::in, globals::in, globals::out)
-    is det.

 :- pred lookup_option(globals::in, option::in, option_data::out)
     is det.
@@ -367,20 +365,21 @@
                 trace_suppress_items    :: trace_suppress_items,
                 source_file_map         :: maybe(source_file_map),
                 have_printed_usage      :: bool,
-                maybe_thread_safe       :: bool,
-                extra_error_info        :: bool
-                                        % Is there extra information
-                                        % about errors available, that
-                                        % could be printed out if `-E'
-                                        % were enabled.
+                maybe_thread_safe       :: bool
             ).

+    % Is there extra information about errors available that could be printed
+    % out if `-E' were enabled.
+    %
+:- mutable(extra_error_info, bool, no, ground,
+    [untrailed, attach_to_io_state]).
+
 globals_init(Options, Target, GC_Method, TagsMethod,
         TerminationNorm, Termination2Norm, TraceLevel, TraceSuppress,
         MaybeThreadSafe,
     globals(Options, Target, GC_Method, TagsMethod,
         TerminationNorm, Termination2Norm, TraceLevel, TraceSuppress,
-        no, no, MaybeThreadSafe, no)).
+        no, no, MaybeThreadSafe)).

 get_options(Globals, Globals ^ options).
 get_target(Globals, Globals ^ target).
@@ -392,7 +391,6 @@
 get_trace_suppress(Globals, Globals ^ trace_suppress_items).
 get_source_file_map(Globals, Globals ^ source_file_map).
 get_maybe_thread_safe(Globals, Globals ^ maybe_thread_safe).
-get_extra_error_info(Globals, Globals ^ extra_error_info).

 get_backend_foreign_languages(Globals, ForeignLangs) :-
     lookup_accumulating_option(Globals, backend_foreign_languages,
@@ -429,9 +427,6 @@
     get_options(Globals, OptionTable),
     map.lookup(OptionTable, Option, OptionData).

-set_extra_error_info(ExtraErrorInfo, Globals,
-    Globals ^ extra_error_info := ExtraErrorInfo).
-
 %-----------------------------------------------------------------------------%

 lookup_bool_option(Globals, Option, Value) :-
@@ -580,8 +575,7 @@
     get_maybe_thread_safe(Globals, MaybeThreadSafe).

 io_get_extra_error_info(ExtraErrorInfo, !IO) :-
-    io_get_globals(Globals, !IO),
-    get_extra_error_info(Globals, ExtraErrorInfo).
+    get_extra_error_info(ExtraErrorInfo, !IO).

 io_get_globals(Globals, !IO) :-
     io.get_globals(UnivGlobals, !IO),
@@ -637,14 +631,7 @@
     io_set_globals(Globals, !IO).

 io_set_extra_error_info(ExtraErrorInfo, !IO) :-
-    some [!Globals] (
-        io_get_globals(!:Globals, !IO),
-        set_extra_error_info(ExtraErrorInfo, !Globals),
-        unsafe_promise_unique(!Globals),
-        % XXX there is a bit of a design flaw with regard to
-        % uniqueness and io.set_globals
-        io_set_globals(!.Globals, !IO)
-    ).
+    set_extra_error_info(ExtraErrorInfo, !IO).

     % This predicate is needed because mercury_compile.m doesn't know
     % anything about type trace_level.
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.523
diff -u -r1.523 make_hlds.m
--- compiler/make_hlds.m	29 Mar 2006 08:06:56 -0000	1.523
+++ compiler/make_hlds.m	30 May 2006 08:22:57 -0000
@@ -5,10 +5,10 @@
 % This file may only be copied under the terms of the GNU General
 % Public License - see the file COPYING in the Mercury distribution.
 %-----------------------------------------------------------------------------%
-
+%
 % File: make_hlds.m.
 % Main author: fjh.
-
+%
 % This module converts from the parse tree structure which is read in by
 % prog_io.m, into the simplified high level data structure defined in
 % hlds.m.  In the parse tree, the program is represented as a list of
@@ -18,10 +18,13 @@
 % super-homogenous form, and introduce implicit quantification.
 %
 % XXX we should record each error using module_info_incr_errors.
-
+%
 % WISHLIST - we should handle explicit module quantification
+%
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%

-:- module hlds__make_hlds.
+:- module hlds.make_hlds.
 :- interface.

 :- import_module hlds.hlds_clauses.
@@ -93,7 +96,7 @@
     %
 :- pred produce_instance_method_clauses(instance_proc_def::in,
     pred_or_func::in, arity::in, list(mer_type)::in, pred_markers::in,
-    term__context::in, import_status::in, clauses_info::out,
+    term.context::in, import_status::in, clauses_info::out,
     module_info::in, module_info::out,
     make_hlds_qual_info::in, make_hlds_qual_info::out, io::di, io::uo) is det.

@@ -103,6 +106,9 @@
 :- pred set_module_recomp_info(make_hlds_qual_info::in,
     module_info::in, module_info::out) is det.

+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
 :- implementation.

 :- include_module add_class.
@@ -127,7 +133,9 @@
 :- import_module hlds.make_hlds.make_hlds_passes.
 :- import_module hlds.make_hlds.qual_info.

-:- type make_hlds_qual_info == hlds__make_hlds__qual_info__qual_info.
+%-----------------------------------------------------------------------------%
+
+:- type make_hlds_qual_info == hlds.make_hlds.qual_info.qual_info.

 parse_tree_to_hlds(Module, MQInfo0, EqvMap, ModuleInfo,
         QualInfo, InvalidTypes, InvalidModes, !IO) :-
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.388
diff -u -r1.388 mercury_compile.m
--- compiler/mercury_compile.m	10 May 2006 10:56:52 -0000	1.388
+++ compiler/mercury_compile.m	31 May 2006 05:14:26 -0000
@@ -438,10 +438,10 @@
             % the `-E' (`--verbose-errors') option, give them a
             % hint about it.  Of course, we should only output the
             % hint when we have further information to give the user.
-
+            %
             globals.lookup_bool_option(Globals, verbose_errors,
                 VerboseErrors),
-            globals.get_extra_error_info(Globals, ExtraErrorInfo),
+            globals.io_get_extra_error_info(ExtraErrorInfo, !IO),
             (
                 VerboseErrors = no,
                 (
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.351
diff -u -r1.351 reference_manual.texi
--- doc/reference_manual.texi	27 Apr 2006 07:34:34 -0000	1.351
+++ doc/reference_manual.texi	31 May 2006 03:31:13 -0000
@@ -3832,6 +3832,10 @@
 could be any of @samp{det}, @samp{failure} or @samp{erroneous}).

 @item
+If the type is a discriminated union then its definition cannot be
+a single zero-arity constructor.
+
+ at item
 The equality predicate must be ``pure'' (@pxref{Impurity}).

 @item
@@ -3908,6 +3912,10 @@
 determinism to be more permissive.

 @item
+If the type is a discriminated union then its definition cannot be
+a single zero-arity constructor.
+
+ at item
 The comparison predicate must also be ``pure'' (@pxref{Impurity}).

 @item
Index: tests/invalid/Mercury.options
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/Mercury.options,v
retrieving revision 1.13
diff -u -r1.13 Mercury.options
--- tests/invalid/Mercury.options	27 Jan 2006 05:52:23 -0000	1.13
+++ tests/invalid/Mercury.options	31 May 2006 05:24:58 -0000
@@ -96,3 +96,6 @@
 				--no-automatic-intermodule-optimization
 MCFLAGS-undef_symbol = 		--no-intermodule-optimization \
 				--no-automatic-intermodule-optimization
+
+# Include the verbose part of the error message.
+MCFLAGS-user_eq_dummy = -E
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.191
diff -u -r1.191 Mmakefile
--- tests/invalid/Mmakefile	21 Mar 2006 22:25:39 -0000	1.191
+++ tests/invalid/Mmakefile	31 May 2006 05:37:20 -0000
@@ -75,6 +75,7 @@
 	exist_foreign_error \
 	exported_mode \
 	external \
+	extra_info_prompt \
 	ext_type \
 	ext_type_bug \
 	field_syntax_error \
@@ -200,6 +201,7 @@
 	uniq_neg \
 	unsatisfiable_constraint \
 	unsatisfiable_super \
+	user_eq_dummy \
 	uu_type \
 	vars_in_wrong_places \
 	with_type
Index: tests/invalid/exported_unify2.m
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/exported_unify2.m,v
retrieving revision 1.1
diff -u -r1.1 exported_unify2.m
--- tests/invalid/exported_unify2.m	19 May 2003 14:24:36 -0000	1.1
+++ tests/invalid/exported_unify2.m	31 May 2006 05:23:22 -0000
@@ -2,7 +2,7 @@

 :- interface.

-:- type foo ---> foo where equality is unify_foo.
+:- type foo ---> foo1 ; foo2 where equality is unify_foo.

 :- implementation.

Index: tests/invalid/exported_unify3.m
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/exported_unify3.m,v
retrieving revision 1.1
diff -u -r1.1 exported_unify3.m
--- tests/invalid/exported_unify3.m	19 May 2003 14:24:36 -0000	1.1
+++ tests/invalid/exported_unify3.m	31 May 2006 05:22:33 -0000
@@ -2,13 +2,13 @@

 :- interface.

-:- type foo ---> foo where equality is defined_in_wrong_module.
+:- type foo ---> foo1 ; foo2 where equality is defined_in_wrong_module.

 	:- module exported_unify3.sub.

 	:- interface.

-	:- type bar ---> bar where equality is not_exported.
+	:- type bar ---> bar1 ; bar2 where equality is not_exported.

 	:- pred defined_in_wrong_module(foo::in, foo::in) is semidet.

Index: tests/invalid/extra_info_prompt.err_exp
===================================================================
RCS file: tests/invalid/extra_info_prompt.err_exp
diff -N tests/invalid/extra_info_prompt.err_exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/invalid/extra_info_prompt.err_exp	31 May 2006 05:35:36 -0000
@@ -0,0 +1,3 @@
+extra_info_prompt.m:006: Error: the type `extra_info_prompt.foo'/0 is not
+extra_info_prompt.m:006:   allowed to have user-defined equality or comparison.
+For more information, recompile with `-E'.
Index: tests/invalid/extra_info_prompt.m
===================================================================
RCS file: tests/invalid/extra_info_prompt.m
diff -N tests/invalid/extra_info_prompt.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/invalid/extra_info_prompt.m	31 May 2006 05:35:07 -0000
@@ -0,0 +1,15 @@
+% rotd-2006-05-27 wasn't printing out the recompile with `-E' prompt.
+
+:- module extra_info_prompt.
+:- interface.
+
+:- type foo
+	--->	foo
+	where equality is foo_eq.
+
+:- pred foo_eq(foo::in, foo::in) is semidet.
+
+:- implementation.
+
+foo_eq(_, _) :- semidet_true.
+
Index: tests/invalid/user_eq_dummy.err_exp
===================================================================
RCS file: tests/invalid/user_eq_dummy.err_exp
diff -N tests/invalid/user_eq_dummy.err_exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/invalid/user_eq_dummy.err_exp	31 May 2006 05:33:58 -0000
@@ -0,0 +1,10 @@
+user_eq_dummy.m:010: Error: the type `user_eq_dummy.foo'/0 is not allowed to
+user_eq_dummy.m:010:   have user-defined equality or comparison. Discriminated
+user_eq_dummy.m:010:   unions whose body consists of a single zero-arity
+user_eq_dummy.m:010:   constructor cannot have user-defined equality or
+user_eq_dummy.m:010:   comparison.
+user_eq_dummy.m:014: Error: the type `user_eq_dummy.bar'/0 is not allowed to
+user_eq_dummy.m:014:   have user-defined equality or comparison. Discriminated
+user_eq_dummy.m:014:   unions whose body consists of a single zero-arity
+user_eq_dummy.m:014:   constructor cannot have user-defined equality or
+user_eq_dummy.m:014:   comparison.
Index: tests/invalid/user_eq_dummy.m
===================================================================
RCS file: tests/invalid/user_eq_dummy.m
diff -N tests/invalid/user_eq_dummy.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/invalid/user_eq_dummy.m	31 May 2006 05:15:46 -0000
@@ -0,0 +1,25 @@
+% The following modules causes rotd-2006-05-27 to abort with the following:
+%
+% Uncaught Mercury exception:
+% Software Error: rtti.m: Unexpected: type_ctor_rep_to_string: dummy type with
+% user equality
+
+:- module user_eq_dummy.
+:- interface.
+
+:- type foo
+	--->	foo
+	where equality is foo_eq.
+
+:- type bar
+	--->	bar
+	where comparison is bar_cmp.
+
+:- pred foo_eq(foo::in, foo::in) is semidet.
+:- pred bar_cmp(comparison_result::uo, bar::in, bar::in) is det.
+
+:- implementation.
+
+foo_eq(_, _) :- semidet_true.
+
+bar_cmp((=), _, _).

--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------



More information about the reviews mailing list