[m-rev.] for review: exception analysis, polymorphism and user-defined equality

Julien Fischer juliensf at cs.mu.OZ.AU
Mon May 29 16:45:46 AEST 2006


For review by anyone

I intend this to be part of the 0.13 release but it should (hopefully) be
replaced with the longer term fix described below for the release after
that.  (It isn't a problem for trail-usage analysis since that has always
considered calls to builtin.{unify/2,compare/3} as possibly modifying
the trail.)

Estimated hours taken: 3.5
Branches: main, release

Workaround a hole in exception analysis that was causing it to incorrectly
conclude that polymorphic procedures that might throw an exception would not.
The problem involved types like the following:

	:- type foo
		---> 	foo1
		;	foo2(bar).

	:- type bar ... where equality is bar_equals.

	where bar_equals is a predicate that may throw an exception.

The problem was that calls to builtin.unify (and by extension all procedures
the analysis considers conditional) with arguments of type foo were not being
treated as possibly throwing an exception.  This is because exception analysis
was considering only the head of the type and not what was contained in the
body.  In particular it missed the situation above where a type with
user-defined equality was embedded in a monomorphic type.

The workaround in this diff restricts exception analysis to declaring
polmorphic procedures not to throw an exception only if the properties of the
type can be determined by examining the head of the type.  In practice this
means restricting it to enumerations and to types exported by the standard
library.  In the case of the latter, the information is hardcoded into the
analyser.  (The above is in reference to so-called type-exceptions, exceptions
that result from a call to a user-defined equality or comparison predicate
that throws an exception - the behaviour of polymorphic procedures with
user-exceptions, exceptions (ultimately) caused by a call to throw/1, is
unchanged.)

The long term fix is to add an analysis that analyses type definitions for
features of interest to other optimizations, e.g. whether they contain other
types that have user-defined equality or whether they contain existentially
quantified constructors.  (Such an analysis will also eventually be required
for things like trail-usage optimization and the experimental optimization for
removing the overhead of minimal model tabling.)

compiler/exception_analysis.m:
	Fix the handling of polymorphism so that we don't erroneously
	conclude that procedures that may throw exceptions do not.

tests/term/Makefile:
tests/term/Mercury.options:
tests/term/exception_analysis_test2.m:
tests/term/exception_analysis_test2.trans_opt_exp:
	Add a test case for the above problem and also check that
	we handle enumerations with user-defined equality correctly.

Julien.

Index: compiler/exception_analysis.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/exception_analysis.m,v
retrieving revision 1.25
diff -u -r1.25 exception_analysis.m
--- compiler/exception_analysis.m	29 Mar 2006 08:06:43 -0000	1.25
+++ compiler/exception_analysis.m	29 May 2006 06:37:23 -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: exception_analysis.m.
 % Author: juliensf.
-
+%
 % This module performs an exception tracing analysis.  The aim is to annotate
 % the HLDS with information about whether each procedure might or will not
 % throw an exception.
@@ -58,6 +58,8 @@
 %       language for various things but we're not interested in that here.
 %
 % TODO:
+%   - improve handling of polymorphic procedures (requires type features
+%     analysis)
 %   - higher order stuff
 %   - check what user-defined equality and comparison preds
 %     actually do rather than assuming that they always
@@ -68,11 +70,12 @@
 %   - Fix optimizations to use exception information from the analysis
 %     registry correctly - predicates in goal_form.m and the optimizations
 %     that use them need to be updated.
-
+%
 % XXX We need to be a bit careful with transformations like tabling that
 % might add calls to exception.throw - at the moment this isn't a problem
 % because exception analysis takes place after the tabling transformation.
-
+%
+%----------------------------------------------------------------------------%
 %----------------------------------------------------------------------------%

 :- module transform_hlds.exception_analysis.
@@ -876,20 +879,27 @@
 check_type_2(_, _, type_cat_base_typeclass_info) = type_will_not_throw.
 check_type_2(_, _, type_cat_void) = type_will_not_throw.
 check_type_2(_, _, type_cat_dummy) = type_will_not_throw.
-
 check_type_2(_, _, type_cat_variable) = type_conditional.
-
-check_type_2(ModuleInfo, Type, type_cat_tuple) =
-    check_user_type(ModuleInfo, Type).
+check_type_2(ModuleInfo, Type, type_cat_tuple) = Status :-
+    ( type_to_ctor_and_args(Type, _TypeCtor, Args) ->
+        Status = check_types(ModuleInfo, Args)
+    ;
+        unexpected(this_file, "check_type_2/3: expected tuple type")
+    ).
 check_type_2(ModuleInfo, Type, type_cat_enum) =
-    check_user_type(ModuleInfo, Type).
+    ( type_has_user_defined_equality_pred(ModuleInfo, Type, _UnifyCompare) ->
+        % XXX This is very conservative.
+        type_may_throw
+    ;
+        type_will_not_throw
+    ).
 check_type_2(ModuleInfo, Type, type_cat_user_ctor) =
     check_user_type(ModuleInfo, Type).

 :- func check_user_type(module_info, mer_type) = type_status.

 check_user_type(ModuleInfo, Type) = Status :-
-    ( type_to_ctor_and_args(Type, _TypeCtor, Args) ->
+    ( type_to_ctor_and_args(Type, TypeCtor, Args) ->
         (
             type_has_user_defined_equality_pred(ModuleInfo, Type,
                 _UnifyCompare)
@@ -899,12 +909,78 @@
             % termination analysis as well, so we'll wait until that is done.
             Status = type_may_throw
         ;
-            Status = check_types(ModuleInfo, Args)
+            ( type_ctor_is_safe(TypeCtor) ->
+                Status = check_types(ModuleInfo, Args)
+            ;
+                Status = type_may_throw
+            )
         )
     ;
         unexpected(this_file, "Unable to get ctor and args.")
     ).

+    % Succeeds if the exception status of the type represented by the given
+    % type_ctor can be determined by examining the exception status of the
+    % arguments, if any.
+    %
+    % NOTE: this list does not need to include enumerations since they
+    %       are already handled above.  Also, this list does not need to
+    %       include non-abstract equivalence types.
+    %
+:- pred type_ctor_is_safe(type_ctor::in) is semidet.
+
+type_ctor_is_safe(TypeCtor) :-
+    TypeCtor = type_ctor(qualified(unqualified(ModuleName), CtorName), Arity),
+    type_ctor_is_safe_2(ModuleName, CtorName, Arity).
+
+:- pred type_ctor_is_safe_2(string::in, string::in, arity::in) is semidet.
+
+type_ctor_is_safe_2("assoc_list",    "assoc_list",    1).
+type_ctor_is_safe_2("bag",           "bag",           1).
+type_ctor_is_safe_2("bimap",         "bimap",         2).
+type_ctor_is_safe_2("builtin",       "c_pointer",     0).
+type_ctor_is_safe_2("cord",          "cord",          1).
+type_ctor_is_safe_2("eqvclass",      "eqvclass",      1).
+type_ctor_is_safe_2("injection",     "injection",     2).
+type_ctor_is_safe_2("integer",       "integer",       0).
+type_ctor_is_safe_2("io",            "input_stream",  0).
+type_ctor_is_safe_2("io",            "output_stream", 0).
+type_ctor_is_safe_2("io",            "binary_stream", 0).
+type_ctor_is_safe_2("io",            "stream_id",     0).
+type_ctor_is_safe_2("io",            "res",           0).
+type_ctor_is_safe_2("io",            "res",           1).
+type_ctor_is_safe_2("io",            "maybe_partial_res", 1).
+type_ctor_is_safe_2("io",            "result",            0).
+type_ctor_is_safe_2("io",            "result",            1).
+type_ctor_is_safe_2("io",            "read_result",       1).
+type_ctor_is_safe_2("io",            "error",         0).
+type_ctor_is_safe_2("list",          "list",          1).
+type_ctor_is_safe_2("map",           "map",           2).
+type_ctor_is_safe_2("maybe",         "maybe",         1).
+type_ctor_is_safe_2("maybe_error",   "maybe_error",   1).
+type_ctor_is_safe_2("multi_map",     "multi_map",     2).
+type_ctor_is_safe_2("pair",          "pair",          2).
+type_ctor_is_safe_2("pqueue",        "pqueue",        2).
+type_ctor_is_safe_2("queue",         "queue",         1).
+type_ctor_is_safe_2("rational",      "rational",      0).
+type_ctor_is_safe_2("rbtree",        "rbtree",        2).
+type_ctor_is_safe_2("rtree",         "rtree",         2).
+type_ctor_is_safe_2("set",           "set",           1).
+type_ctor_is_safe_2("set_bbbtree",   "set_bbbtree",   1).
+type_ctor_is_safe_2("set_ctree234",  "set_ctree234",  1).
+type_ctor_is_safe_2("set_ordlist",   "set_ordlist",   1).
+type_ctor_is_safe_2("set_tree234",   "set_tree234",   1).
+type_ctor_is_safe_2("set_unordlist", "set_unordlist", 1).
+type_ctor_is_safe_2("stack",         "stack",         1).
+type_ctor_is_safe_2("string",        "poly_type",     0).
+type_ctor_is_safe_2("string",        "justified_column", 0).
+type_ctor_is_safe_2("term",          "term",          1).
+type_ctor_is_safe_2("term",          "const",         0).
+type_ctor_is_safe_2("term",          "context",       0).
+type_ctor_is_safe_2("term",          "var",           1).
+type_ctor_is_safe_2("term",          "var_supply",    1).
+type_ctor_is_safe_2("varset",        "varset",        1).
+
 %----------------------------------------------------------------------------%
 %
 % Types and instances for the intermodule analysis framework
Index: tests/term/Mercury.options
===================================================================
RCS file: /home/mercury1/repository/tests/term/Mercury.options,v
retrieving revision 1.7
diff -u -r1.7 Mercury.options
--- tests/term/Mercury.options	4 Aug 2005 09:43:16 -0000	1.7
+++ tests/term/Mercury.options	29 May 2006 04:38:01 -0000
@@ -9,6 +9,7 @@
 MCFLAGS-dds3_17=--term-norm=simple
 MCFLAGS-dds3_8=--term-norm=simple
 MCFLAGS-exception_analysis_test=--analyse-exceptions --no-warn-inferred-erroneous --no-warn-simple-code
+MCFLAGS-exception_analysis_test2=--analyse-exceptions --no-warn-inferred-erroneous
 MCFLAGS-existential_error1=--term-norm=num-data-elems
 MCFLAGS-existential_error2=--term-norm=num-data-elems
 MCFLAGS-existential_error3=--term-norm=num-data-elems
Index: tests/term/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/term/Mmakefile,v
retrieving revision 1.29
diff -u -r1.29 Mmakefile
--- tests/term/Mmakefile	4 Aug 2005 09:43:16 -0000	1.29
+++ tests/term/Mmakefile	29 May 2006 04:34:38 -0000
@@ -20,6 +20,7 @@
 	dds3_17 \
 	dds3_8 \
 	exception_analysis_test \
+	exception_analysis_test2 \
 	existential_error1 \
 	existential_error2 \
 	existential_error3 \
Index: tests/term/exception_analysis_test2.m
===================================================================
RCS file: tests/term/exception_analysis_test2.m
diff -N tests/term/exception_analysis_test2.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/term/exception_analysis_test2.m	29 May 2006 04:34:16 -0000
@@ -0,0 +1,37 @@
+:- module exception_analysis_test2.
+:- interface.
+
+	% Test for correct handling of enumerations with
+	% user-defined equality.
+	%
+:- pred test1(foo::in, foo::in) is semidet.
+
+:- pred test2(bar::in, bar::in) is semidet.
+
+:- type foo
+	---> 	foo0
+	;	foo1
+	;	foo2
+	;	foo3
+	where equality is foo_equals.
+
+:- pred my_unify(T::in, T::in) is semidet.
+
+:- pred foo_equals(foo::in, foo::in) is semidet.
+
+:- type bar
+	--->	bar1
+	;	bar2(int)
+	;	bar3(foo).
+
+:- implementation.
+
+:- import_module exception.
+
+test1(A, B) :- my_unify(A, B).
+test2(A, B) :- my_unify(A, B).
+
+my_unify(A, B) :- unify(B, A).
+
+foo_equals(_, _) :-
+	throw("Cannot compare values of type foo").
Index: tests/term/exception_analysis_test2.trans_opt_exp
===================================================================
RCS file: tests/term/exception_analysis_test2.trans_opt_exp
diff -N tests/term/exception_analysis_test2.trans_opt_exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/term/exception_analysis_test2.trans_opt_exp	29 May 2006 04:39:20 -0000
@@ -0,0 +1,13 @@
+:- module exception_analysis_test2.
+:- pragma termination_info(exception_analysis_test2.test1((builtin.in), (builtin.in)), finite(0, [no, no]), cannot_loop).
+:- pragma termination_info(exception_analysis_test2.test2((builtin.in), (builtin.in)), finite(0, [no, no]), cannot_loop).
+:- pragma termination_info(exception_analysis_test2.my_unify((builtin.in), (builtin.in)), finite(0, [no, no, no]), cannot_loop).
+:- pragma termination_info(exception_analysis_test2.foo_equals((builtin.in), (builtin.in)), infinite, cannot_loop).
+:- pragma termination2_info(exception_analysis_test2.test1((builtin.in), (builtin.in)), constraints([]), not_set, cannot_loop).
+:- pragma termination2_info(exception_analysis_test2.test2((builtin.in), (builtin.in)), constraints([eq([term(0, r(1, 1)), term(1, r(-1, 1))], r(0, 1))]), not_set, cannot_loop).
+:- pragma termination2_info(exception_analysis_test2.my_unify((builtin.in), (builtin.in)), constraints([eq([term(1, r(-1, 1)), term(2, r(1, 1))], r(0, 1))]), not_set, cannot_loop).
+:- pragma termination2_info(exception_analysis_test2.foo_equals((builtin.in), (builtin.in)), constraints([]), not_set, can_loop).
+:- pragma exceptions(predicate, (exception_analysis_test2.test1), 2, 0, may_throw(type_exception)).
+:- pragma exceptions(predicate, (exception_analysis_test2.test2), 2, 0, may_throw(type_exception)).
+:- pragma exceptions(predicate, (exception_analysis_test2.my_unify), 2, 0, conditional).
+:- pragma exceptions(predicate, (exception_analysis_test2.foo_equals), 2, 0, may_throw(user_exception)).

--------------------------------------------------------------------------
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