[m-rev.] for review: exception analysis

Julien Fischer juliensf at students.cs.mu.OZ.AU
Mon Mar 22 15:28:36 AEDT 2004


Estimated hours taken: 65
Branches: main

Add an analysis that tries to identify those procedures
in a module that will not throw an exception.
(I guess it may be more accurate to call it a non-exception analysis).

For those procedures that might throw exceptions the
analysis further tries to distinguish between those
that throw an exception as a result of a call to throw
and those that throw an exception as a result of a
call to a unification/comparison predicate that may involve
calls to user-defined equality/comparison predicates that throw
exceptions.

This sort of thing used to be done by the termination analysis,
where being able to prove termination was equated with not
throwing an exception.  This no longer works now that
the termination analyser considers exception.throw/1 to
be terminating - and in fact it never quite worked anyway
because the termination analyser was not handling things
like foreign code and user-defined equality and comparison
predicates correctly.

There are currently a few limitations, the main ones being:

- we currently use transitive-intermodule optimization rather
  than the intermodule-analysis framework.  This may causes
  problems when their are cycles in the module dependency graph.

- we currently assume that all calls to higher-order predicates
  may result in an exception being thrown.

- we currently assume that all foreign procs that make calls
  back to Mercury may throw exceptions.

These limitations will be removed in later versions.

This diff also modifies the cannot_loop_or_throw family of
predicates in goal_form.m.  There are now two versions of each
predicate; one that can make use of information from the
termination and exception analyses and one that cannot.


compiler/exception_analysis.m:
	The new analysis.

compiler/prog_data.m:
compiler/prog_io_pragma.m:
	Handle `:- pragma exceptions(...' in .opt and .trans_opt files.

compiler/hlds_module.m:
	Attach information to each module about whether each procedure
	in the module may throw an exception.

compiler/goal_form.m:
	Rewrite the predicates in this module so that they can
	optionally use information from the exception analysis.

compiler/constraint.m:
compiler/goal_util.m:
compiler/rl.m:
compiler/simplify.m:
	Use information from exception and termination analyses
	when performing various optimizations.

compiler/mercury_compile.m:
compiler/mercury_to_mercury.m:
compiler/modules.m:
compiler/options.m:
compiler/module_qual.m:
compiler/make_hlds.m:
compiler/recompilation.version.m:
compiler/transform_hlds.m:
	Minor changes needed by the above.

compiler/trans_opt.m:
	Minor changes needed by the above.
	Bring this module more into line with our current coding
	standards.

NEWS:
compiler/notes/compiler_design.html:
doc/user_guide.texi:
	Mention the new analysis.

tests/README:
	Include a description of the term directory.

tests/term/Mercury.options:
tests/term/Mmakefile:
tests/term/exception_analysis_test.m:
tests/term/exception_analysis_test.trans_opt_exp:
	Add a test for the new analysis.

Julien.

Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.330
diff -u -r1.330 NEWS
--- NEWS	19 Mar 2004 14:33:36 -0000	1.330
+++ NEWS	22 Mar 2004 04:24:40 -0000
@@ -24,6 +24,9 @@
   code.
 * It's now easier to use shared libraries on Linux/x86 systems
   with `mmc --make'.
+* A new analysis: `--analyse-exceptions'.
+  The compiler can use the results of this analysis to try and improve
+  some optimizations.

 Changes to the Mercury standard library:
 * We've added two new modules: cord, for sequences with O(1) consing and
@@ -276,6 +279,10 @@
   location of the standard library (MERCURY_ALL_C_INCL_DIRS,
   MERCURY_ALL_MC_C_INCL_DIRS, MERCURY_INT_DIR, MERCURY_C_LIB_DIR,
   MERCURY_MOD_LIB_MODS, MERCURY_TRACE_LIB_MODS) have been removed.
+
+* There is a new analysis: `--analyse-exceptions'.  This identifies
+  predicates that will not throw an exception.  This information is
+  made available to the optimizing passes of the compiler.

 Portability improvements:

Index: compiler/constraint.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/constraint.m,v
retrieving revision 1.53
diff -u -r1.53 constraint.m
--- compiler/constraint.m	28 Nov 2003 02:23:06 -0000	1.53
+++ compiler/constraint.m	17 Feb 2004 06:19:42 -0000
@@ -417,7 +417,7 @@
 		{ goal_info_is_pure(GoalInfo) },

 		% Don't propagate goals that can loop.
-		{ goal_cannot_loop_or_throw(Goal) }
+		{ goal_cannot_loop_or_throw(ModuleInfo, Goal) }
 	->
 		% It's a constraint, add it to the list of constraints
 		% to be attached to goals earlier in the conjunction.
@@ -473,7 +473,7 @@
 	;
 		% Don't move goals which can fail before a goal which
 		% can loop if `--fully-strict' is set.
-		{ \+ goal_cannot_loop_or_throw(Goal) },
+		{ \+ goal_cannot_loop_or_throw(ModuleInfo, Goal) },
 		{ module_info_globals(ModuleInfo, Globals) },
 		{ globals__lookup_bool_option(Globals, fully_strict, yes) }
 	->
Index: compiler/exception_analysis.m
===================================================================
RCS file: compiler/exception_analysis.m
diff -N compiler/exception_analysis.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ compiler/exception_analysis.m	22 Mar 2004 04:16:10 -0000
@@ -0,0 +1,669 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2004 The University of Melbourne.
+% 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
+%
+% The module performs an exception tracing analysis.  The aim is to
+% annotate the HLDS with information about whether each procedure
+% might/will not throw an exception.
+%
+% This information can be useful to the compiler when applying
+% certain types of optimization, e.g. constraint propagation.
+%
+% After running the analysis the exception behaviour of each procedure
+% is one of:
+%
+%	(1) will_not_throw_exception
+%	(2) may_throw_an_exception
+%	(3) conditional
+%
+% (1) guarantees that the procedure will not throw an exception.
+%
+% (2) means that a call to that procedure might result in an exception
+%     being thrown (it doesn't mean that one will be thrown).
+%
+%     We distinguish between two kinds of exception.  Those that
+%     are ultimately as a result of a call to exception.throw/1, which
+%     we refer to as "user exceptions" and those that result from calls
+%     to unification or comparison predicates where one of the types
+%     involved as user-defined equality/comparison predicate that throw
+%     an exception.  We refer to the latter kind, as "type exceptions".
+%
+%     This means that for some polymorphic procedures we cannot
+%     say what will happen until we know the values of the type variables.
+%     And so we have ...
+%
+% (3) means that the exception status of the procedure is dependent upon the
+%     values of some higher-order variables, or the values of some type
+%     variables or both.  This means that we cannot say anything definite
+%     about the procedure but for calls to the procedure where have the
+%     necessary information we can say what will happen.
+%
+% In the event that we cannot determine the exception status we just assume
+% the worst and mark the procedure as maybe throwing a user exception.
+%
+% For procedures that are defined using the FFI we currently assume that if a
+% procedure will not make calls back to Mercury then it cannot throw
+% a Mercury exception; if it does make calls to Mercury then it might
+% throw an exception.
+%
+% TODO:
+%	- higher order stuff
+%	- annotations for foreign_procs
+% 	- use intermodule-analysis framework
+%	- check what user-defined equality and comparison preds
+%	  actually do rather than assuming that they always
+%	  may throw exceptions.
+%
+% XXX Because transitive-intermodule optimization can't handle cycles
+% in the module dependency graph, the results are sometimes not what
+% you might expect - using the intermodule-analysis framework should
+% fix most of these problems.
+%
+%----------------------------------------------------------------------------%
+
+:- module transform_hlds.exception_analysis.
+
+:- interface.
+
+:- import_module hlds.hlds_module.
+:- import_module hlds.hlds_pred.
+
+:- import_module io.
+
+	% Perform the exception analysis on a module.
+	%
+:- pred exception_analysis.process_module(module_info::in, module_info::out,
+	io::di, io::uo) is det.
+
+:- pred exception_analysis.write_pragma_exceptions(module_info::in,
+	exception_info::in, pred_id::in, io::di, io::uo) is det.
+
+%----------------------------------------------------------------------------%
+%----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module check_hlds.mode_util.
+:- import_module check_hlds.type_util.
+:- import_module hlds.hlds_goal.
+:- import_module hlds.hlds_pred.
+:- import_module hlds.make_hlds.
+:- import_module hlds.passes_aux.
+:- import_module hlds.special_pred.
+:- import_module libs.globals.
+:- import_module libs.options.
+:- import_module parse_tree.error_util.
+:- import_module parse_tree.mercury_to_mercury.
+:- import_module parse_tree.modules.
+:- import_module parse_tree.prog_data.
+:- import_module parse_tree.prog_util.
+:- import_module transform_hlds.dependency_graph.
+
+:- import_module bool, list, map, set, std_util, string, term, term_io, varset.
+
+%----------------------------------------------------------------------------%
+%
+% Analyse a module.
+%
+
+exception_analysis.process_module(!Module, !IO) :-
+	module_info_ensure_dependency_info(!Module),
+	module_info_dependency_info(!.Module, DepInfo),
+	hlds_dependency_info_get_dependency_ordering(DepInfo, SCCs),
+	list.foldl(process_scc, SCCs, !Module),
+	globals.io_lookup_bool_option(make_optimization_interface,
+		MakeOptInt, !IO),
+	( if	MakeOptInt = yes
+	  then	exception_analysis.make_opt_int(!.Module, !IO)
+	  else	true
+	).
+
+%----------------------------------------------------------------------------%
+%
+% Analyse an SCC.
+%
+
+:- type scc == list(pred_proc_id).
+
+:- type proc_results == list(proc_result).
+
+:- type proc_result
+	---> proc_result(
+			ppid :: pred_proc_id,
+
+			status :: exception_status,
+					% Exception status of this procedure
+					% not counting any input from
+					% (mutually-)recursive inputs.
+			rec_calls :: type_status
+					% The collective type status of the
+					% types of the terms that are arguments
+					% of (mutually-)recursive calls.
+	).
+
+:- pred process_scc(scc::in, module_info::in, module_info::out) is det.
+
+process_scc(SCC, !Module) :-
+	check_procs_for_exceptions(SCC, !.Module, ProcResults),
+	%
+	% The `Results' above are the results of analysing each
+	% individual procedure in the SCC - we now have to combine
+	% them in a meaningful way.
+	%
+	Status = combine_individual_proc_results(ProcResults),
+	%
+	% Update the exception info. with information about this
+	% SCC.
+	%
+	module_info_exception_info(!.Module, ExceptionInfo0),
+	Update = (pred(PPId::in, Info0::in, Info::out) is det :-
+		Info = Info0 ^ elem(PPId) := Status
+	),
+	list.foldl(Update, SCC, ExceptionInfo0, ExceptionInfo),
+	module_info_set_exception_info(ExceptionInfo, !Module).
+
+	% Check each procedure in the SCC individually.
+	%
+:- pred check_procs_for_exceptions(scc::in, module_info::in,
+	proc_results::out) is det.
+
+check_procs_for_exceptions(SCC, Module, Result) :-
+	list.foldl(check_proc_for_exceptions(SCC, Module), SCC, [], Result).
+
+	% Examine how the procedures interact with other procedures that
+	% are mutually-recursive to them.
+	%
+:- func combine_individual_proc_results(proc_results) = exception_status.
+
+combine_individual_proc_results([]) = _ :-
+	unexpected(this_file, "Empty SCC during exception analysis.").
+combine_individual_proc_results(ProcResults @ [_|_]) = SCC_Result :-
+	(
+		% If none of the procedures may throw an exception or
+		% are conditional then the SCC cannot throw an exception
+		% either.
+		all [ProcResult] list.member(ProcResult, ProcResults) =>
+			ProcResult ^ status = will_not_throw
+	->
+		SCC_Result = will_not_throw
+	;
+		% If none of the procedures may throw an exception but
+		% at least one of them is conditional then somewhere in
+		% the SCC there is a call to unify or compare that may
+		% rely on the values of the polymorphically typed
+		% arguments.
+		%
+		% We need to check that any recursive calls
+		% do not introduce types that might have user-defined
+		% equality or comparison predicate that throw
+		% exceptions.
+		all [EResult] list.member(EResult, ProcResults) =>
+			EResult ^ status \= may_throw(_),
+		some [CResult] (
+			list.member(CResult, ProcResults),
+			CResult ^ status = conditional
+		)
+	->
+		SCC_Result = handle_mixed_conditional_scc(ProcResults)
+	;
+		% If none of the procedures can throw a user_exception
+		% but one or more can throw a type_exception then mark
+		% the SCC as maybe throwing a type_exception.
+		all [EResult] list.member(EResult, ProcResults) =>
+			EResult ^ status \= may_throw(user_exception),
+		some [TResult] (
+			list.member(TResult, ProcResults),
+			TResult ^ status = may_throw(type_exception)
+		)
+	->
+		SCC_Result = may_throw(type_exception)
+	;
+		% Otherwise just assume that the SCC can throw
+		% an exception.
+		SCC_Result = may_throw(user_exception)
+	).
+
+%----------------------------------------------------------------------------%
+%
+% Process individual procedures.
+%
+
+:- pred check_proc_for_exceptions(scc::in, module_info::in,
+	pred_proc_id::in, proc_results::in, proc_results::out) is det.
+
+check_proc_for_exceptions(SCC, Module, PPId, !Results) :-
+	module_info_pred_proc_info(Module, PPId, _, ProcInfo),
+	proc_info_goal(ProcInfo, Body),
+	proc_info_vartypes(ProcInfo, VarTypes),
+	Result0 = proc_result(PPId, will_not_throw, type_will_not_throw),
+	check_goal_for_exceptions(SCC, Module, VarTypes, Body, Result0, Result),
+	list.cons(Result, !Results).
+
+:- pred check_goal_for_exceptions(scc::in, module_info::in, vartypes::in,
+	hlds_goal::in, proc_result::in, proc_result::out) is det.
+
+check_goal_for_exceptions(SCC, Module, VarTypes, Goal - GoalInfo,
+		!Result) :-
+	( goal_info_get_determinism(GoalInfo, erroneous) ->
+		!:Result = !.Result ^ status := may_throw(user_exception)
+	;
+		check_goal_for_exceptions_2(SCC, Module, VarTypes, Goal,
+			!Result)
+	).
+
+:- pred check_goal_for_exceptions_2(scc::in, module_info::in, vartypes::in,
+	hlds_goal_expr::in, proc_result::in, proc_result::out) is det.
+
+check_goal_for_exceptions_2(_, _, _, unify(_, _, _, Kind, _), !Result) :-
+	( Kind = complicated_unify(_, _, _) ->
+		unexpected(this_file,
+			"complicated unify during exception analysis.")
+	;
+		true
+	).
+check_goal_for_exceptions_2(SCC, Module, VarTypes,
+		call(CallPredId, CallProcId, CallArgs, _, _, _), !Result) :-
+	CallPPId = proc(CallPredId, CallProcId),
+	module_info_pred_info(Module, CallPredId, CallPredInfo),
+	(
+		% Handle (mutually-)recursive calls.
+		list.member(CallPPId, SCC)
+	->
+		Types = list.map((func(Var) = VarTypes ^ det_elem(Var)),
+			CallArgs),
+		TypeStatus = check_types(Module, Types),
+		combine_type_status(TypeStatus, !.Result ^ rec_calls,
+			NewTypeStatus),
+		!:Result = !.Result ^ rec_calls := NewTypeStatus
+	;
+		pred_info_is_builtin(CallPredInfo)
+	->
+		% Builtins won't throw exceptions.
+		true
+	;
+		% Handle unify and compare.
+		(
+			ModuleName = pred_info_module(CallPredInfo),
+			any_mercury_builtin_module(ModuleName),
+			Name = pred_info_name(CallPredInfo),
+			Arity = pred_info_arity(CallPredInfo),
+			( SpecialPredId = compare
+			; SpecialPredId = unify ),
+			special_pred_name_arity(SpecialPredId, Name,
+				Arity)
+		;
+			pred_info_get_maybe_special_pred(CallPredInfo,
+				MaybeSpecial),
+			MaybeSpecial = yes(SpecialPredId - _),
+			( SpecialPredId = compare
+			; SpecialPredId = unify )
+		)
+	->
+		% For unification/comparison the exception status depends
+		% upon the the types of the arguments.  In particular
+		% whether some component of that type has a user-defined
+		% equality/comparison predicate that throws an exception.
+		check_vars(Module, VarTypes, CallArgs, !Result)
+	;
+		check_nonrecursive_call(Module, VarTypes, CallPPId, CallArgs,
+			!Result)
+	).
+check_goal_for_exceptions_2(_, _, _, generic_call(_,_,_,_), !Result) :-
+	!:Result = !.Result ^ status := may_throw(user_exception).
+check_goal_for_exceptions_2(SCC, Module, VarTypes, not(Goal), !Result) :-
+	check_goal_for_exceptions(SCC, Module, VarTypes, Goal, !Result).
+check_goal_for_exceptions_2(SCC, Module, VarTypes, some(_, _, Goal),
+		!Result) :-
+	check_goal_for_exceptions(SCC, Module, VarTypes, Goal, !Result).
+
+	% XXX If we provided annotations for foreign procs we could
+	% do better here.  Currently we only consider foreign_procs
+	% that do not call Mercury as not throwing exceptions.
+check_goal_for_exceptions_2(_, _, _,
+		foreign_proc(Attributes, _, _, _, _, _, _), !Result) :-
+	( if 	may_call_mercury(Attributes) = may_call_mercury
+	  then	!:Result = !.Result ^ status := may_throw(user_exception)
+	  else	true
+	).
+check_goal_for_exceptions_2(_, _, _, shorthand(_), _, _) :-
+	unexpected(this_file,
+		"shorthand goal encountered during exception analysis.").
+check_goal_for_exceptions_2(SCC, Module, VarTypes, switch(_, _, Cases),
+		!Result) :-
+	Goals = list.map((func(case(_, Goal)) = Goal), Cases),
+	check_goals_for_exceptions(SCC, Module, VarTypes, Goals, !Result).
+check_goal_for_exceptions_2(SCC, Module, VarTypes,
+		if_then_else(_, If, Then, Else), !Result) :-
+	check_goals_for_exceptions(SCC, Module, VarTypes, [If, Then, Else],
+		!Result).
+check_goal_for_exceptions_2(SCC, Module, VarTypes, disj(Goals), !Result) :-
+	check_goals_for_exceptions(SCC, Module, VarTypes, Goals, !Result).
+check_goal_for_exceptions_2(SCC, Module, VarTypes, par_conj(Goals), !Result) :-
+	check_goals_for_exceptions(SCC, Module, VarTypes, Goals, !Result).
+check_goal_for_exceptions_2(SCC, Module, VarTypes, conj(Goals), !Result) :-
+	check_goals_for_exceptions(SCC, Module, VarTypes, Goals, !Result).
+
+:- pred check_goals_for_exceptions(scc::in, module_info::in, vartypes::in,
+	hlds_goals::in, proc_result::in, proc_result::out) is det.
+
+check_goals_for_exceptions(_, _, _, [], !Result).
+check_goals_for_exceptions(SCC, Module, VarTypes, [ Goal | Goals ], !Result) :-
+	check_goal_for_exceptions(SCC, Module, VarTypes, Goal, !Result),
+	%
+	% We can stop searching if we find a user exception.  However if
+	% find a type exception then we still need to check that there is
+	% not a user exception somewhere in the rest of the SCC.
+	%
+	( if	!.Result ^ status = may_throw(user_exception)
+	  then	true
+	  else	check_goals_for_exceptions(SCC, Module, VarTypes, Goals,
+			!Result)
+	).
+
+%----------------------------------------------------------------------------%
+
+:- pred update_proc_result(exception_status::in, proc_result::in,
+	proc_result::out) is det.
+
+update_proc_result(CurrentStatus, !Result) :-
+	OldStatus = !.Result ^ status,
+	NewStatus = combine_exception_status(CurrentStatus, OldStatus),
+	!:Result  = !.Result ^ status := NewStatus.
+
+:- func combine_exception_status(exception_status, exception_status)
+	= exception_status.
+
+combine_exception_status(will_not_throw, Y) = Y.
+combine_exception_status(X @ may_throw(user_exception), _) = X.
+combine_exception_status(X @ may_throw(type_exception), will_not_throw) = X.
+combine_exception_status(X @ may_throw(type_exception), conditional) = X.
+combine_exception_status(may_throw(type_exception), Y @ may_throw(_)) = Y.
+combine_exception_status(conditional, conditional) = conditional.
+combine_exception_status(conditional, will_not_throw) = conditional.
+combine_exception_status(conditional, Y @ may_throw(_)) = Y.
+
+%----------------------------------------------------------------------------%
+%
+% Extra procedures for handling calls.
+%
+
+:- pred check_nonrecursive_call(module_info::in, vartypes::in,
+	pred_proc_id::in, prog_vars::in, proc_result::in,
+	proc_result::out) is det.
+
+check_nonrecursive_call(Module, VarTypes, PPId, Args, !Result) :-
+	module_info_exception_info(Module, ExceptionInfo),
+	( map.search(ExceptionInfo, PPId, CalleeExceptionStatus) ->
+		(
+			CalleeExceptionStatus = will_not_throw
+		;
+			CalleeExceptionStatus = may_throw(ExceptionType),
+			update_proc_result(may_throw(ExceptionType), !Result)
+		;
+			CalleeExceptionStatus = conditional,
+			check_vars(Module, VarTypes, Args, !Result)
+		)
+	;
+		% If we do not have any information about the callee procedure
+		% assume the worst.
+		update_proc_result(may_throw(user_exception), !Result)
+	).
+
+:- pred check_vars(module_info::in, vartypes::in, prog_vars::in,
+	proc_result::in, proc_result::out) is det.
+
+check_vars(Module, VarTypes, Vars, !Result) :-
+	Types = list.map((func(Var) = VarTypes ^ det_elem(Var)), Vars),
+	TypeStatus = check_types(Module, Types),
+	(
+		TypeStatus = type_will_not_throw
+	;
+		TypeStatus = type_may_throw,
+		update_proc_result(may_throw(type_exception), !Result)
+	;
+		TypeStatus = type_conditional,
+		update_proc_result(conditional, !Result)
+	).
+
+%----------------------------------------------------------------------------%
+%
+% Predicates for checking mixed SCCs.
+%
+% A "mixed SCC" is one where at least one of the procedures in the SCC is
+% known not to throw an exception, at least one of them is conditional
+% and none of them may throw an exception (of either sort).
+%
+% In order to determine the status of such a SCC we also need to take the
+% affect of the recursive calls into account.  This is because calls to a
+% conditional procedure from a procedure that is mutually recursive to it may
+% introduce types that could cause a type_exception to be thrown.
+%
+% The most conservative assumption is that if these types are introduced
+% somewhere in the SCC then they may be propagated around the entire
+% SCC - hence if a part of the SCC is conditional we need to make
+% sure other parts don't supply it with input whose types may have
+% user-defined equality/comparison predicates.
+%
+% NOTE: It's possible to write rather contrived programs that can
+% exhibit rather strange behaviour which is why all this is necessary.
+
+:- func handle_mixed_conditional_scc(proc_results) = exception_status.
+
+handle_mixed_conditional_scc(Results) =
+	(
+		all [TypeStatus] list.member(Result, Results) =>
+			Result ^ rec_calls \= type_may_throw
+	->
+		conditional
+	;
+		% Somewhere a type that causes an exception is being
+		% passed around the SCC via one or more of the recursive
+		% calls.
+		may_throw(type_exception)
+	).
+
+%----------------------------------------------------------------------------%
+%
+% Stuff for processing types.
+%
+% This is used in the analysis of calls to polymorphic procedures.
+%
+% By saying a `type can throw an exception' we mean that an exception
+% might be thrown as a result of a unification or comparison involving
+% the type because it has a user-defined equality/comparison predicate
+% that may throw an exception.
+%
+% XXX We don't actually need to examine all the types, just those
+% that are potentially going to be involved in unification/comparisons.
+% At the moment we don't keep track of that information so the current
+% procedure is as follows:
+%
+% Examine the functor and then recursively examine the arguments.
+% * If everything will not throw then the type will not throw
+% * If at least one of the types may_throw then the type will throw
+% * If at least one of the types is conditional  and none of them throw then
+%   the type is conditional.
+%
+%----------------------------------------------------------------------------%
+
+:- type type_status
+	--->	type_will_not_throw
+			% This type does not have user-defined equality
+			% or comparison predicates.
+			% XXX (Or it has ones that are known not to throw
+			%      exceptions).
+
+	;	type_may_throw
+			% This type has a user-defined equality or comparison
+			% predicate that is known to throw an exception.
+
+	;	type_conditional.
+			% This type is polymorphic.  We cannot say anything about
+			% it until we know the values of the type-variables.
+
+	% Return the collective type status of a list of types.
+	%
+:- func check_types(module_info, list((type))) = type_status.
+
+check_types(Module, Types) = Status :-
+	list.foldl(check_type(Module), Types, type_will_not_throw, Status).
+
+:- pred check_type(module_info::in, (type)::in, type_status::in,
+	type_status::out) is det.
+
+check_type(Module, Type, !Status) :-
+	combine_type_status(check_type(Module, Type), !Status).
+
+:- pred combine_type_status(type_status::in, type_status::in,
+	type_status::out) is det.
+
+combine_type_status(type_will_not_throw, type_will_not_throw,
+		type_will_not_throw).
+combine_type_status(type_will_not_throw, type_conditional, type_conditional).
+combine_type_status(type_will_not_throw, type_may_throw, type_may_throw).
+combine_type_status(type_conditional, type_will_not_throw, type_conditional).
+combine_type_status(type_conditional, type_conditional, type_conditional).
+combine_type_status(type_conditional, type_may_throw, type_may_throw).
+combine_type_status(type_may_throw, _, type_may_throw).
+
+	% Return the type status of an individual type.
+	%
+:- func check_type(module_info, (type)) = type_status.
+
+check_type(Module, Type) = Status :-
+	TypeCategory = type_util.classify_type(Module, Type),
+	Status = check_type_2(Module, Type, TypeCategory).
+
+:- func check_type_2(module_info, (type), type_category) = type_status.
+
+check_type_2(_, _, int_type) = type_will_not_throw.
+check_type_2(_, _, char_type) = type_will_not_throw.
+check_type_2(_, _, str_type) = type_will_not_throw.
+check_type_2(_, _, float_type) = type_will_not_throw.
+check_type_2(_, _, higher_order_type) = type_will_not_throw.
+check_type_2(_, _, type_info_type) = type_will_not_throw.
+check_type_2(_, _, type_ctor_info_type) = type_will_not_throw.
+check_type_2(_, _, typeclass_info_type) = type_will_not_throw.
+check_type_2(_, _, base_typeclass_info_type) = type_will_not_throw.
+check_type_2(_, _, void_type) = type_will_not_throw.
+
+check_type_2(_, _, variable_type) = type_conditional.
+
+check_type_2(Module, Type, tuple_type) = check_user_type(Module, Type).
+check_type_2(Module, Type, enum_type)  = check_user_type(Module, Type).
+check_type_2(Module, Type, user_ctor_type) = check_user_type(Module, Type).
+
+:- func check_user_type(module_info, (type)) = type_status.
+
+check_user_type(Module, Type) = Status :-
+	( type_to_ctor_and_args(Type, _TypeCtor, Args) ->
+		(
+			type_has_user_defined_equality_pred(Module, Type,
+				_UnifyCompare)
+		->
+			% XXX We can do better than this by examining
+			% what these preds actually do.  Something
+			% similar needs to be sorted out for termination
+			% analysis as well, so we'll wait until that is
+			% done.
+			Status = type_may_throw
+		;
+			Status = check_types(Module, Args)
+		)
+
+	;
+		unexpected(this_file, "Unable to get ctor and args.")
+	).
+
+%----------------------------------------------------------------------------%
+%
+% Stuff for intermodule optimization.
+%
+
+:- pred exception_analysis.make_opt_int(module_info::in, io::di, io::uo) is det.
+
+exception_analysis.make_opt_int(Module, !IO) :-
+	module_info_name(Module, ModuleName),
+	module_name_to_file_name(ModuleName, ".opt.tmp", no, OptFileName, !IO),
+	globals.io_lookup_bool_option(verbose, Verbose, !IO),
+	maybe_write_string(Verbose,
+		"% Appending exceptions pragmas to `", !IO),
+	maybe_write_string(Verbose, OptFileName, !IO),
+	maybe_write_string(Verbose, "'...", !IO),
+	maybe_flush_output(Verbose, !IO),
+	io.open_append(OptFileName, OptFileRes, !IO),
+	(
+		OptFileRes = ok(OptFile),
+		io.set_output_stream(OptFile, OldStream, !IO),
+		module_info_exception_info(Module, ExceptionInfo),
+		module_info_predids(Module, PredIds),
+		list.foldl(write_pragma_exceptions(Module, ExceptionInfo),
+			PredIds, !IO),
+		io.set_output_stream(OldStream, _, !IO),
+		io.close_output(OptFile, !IO),
+		maybe_write_string(Verbose, " done.\n", !IO)
+	;
+		OptFileRes = error(IOError),
+		maybe_write_string(Verbose, " failed!\n", !IO),
+		io.error_message(IOError, IOErrorMessage),
+		io.write_strings(["Error opening file `",
+			OptFileName, "' for output: ", IOErrorMessage], !IO),
+		io.set_exit_status(1, !IO)
+	).
+
+write_pragma_exceptions(Module, ExceptionInfo, PredId, !IO) :-
+	module_info_pred_info(Module, PredId, PredInfo),
+	pred_info_import_status(PredInfo, ImportStatus),
+	(
+		( ImportStatus = exported
+		; ImportStatus = opt_exported
+		),
+		not is_unify_or_compare_pred(PredInfo),
+		module_info_type_spec_info(Module, TypeSpecInfo),
+		TypeSpecInfo = type_spec_info(_, TypeSpecForcePreds, _, _),
+		not set.member(PredId, TypeSpecForcePreds),
+			% XXX Writing out pragmas for the automatically
+			% generated class instance methods causes the
+			% compiler to abort when it reads them back in.
+		pred_info_get_markers(PredInfo, Markers),
+		not check_marker(Markers, class_instance_method),
+		not check_marker(Markers, named_class_instance_method)
+	->
+		ModuleName = pred_info_module(PredInfo),
+		Name       = pred_info_name(PredInfo),
+		Arity      = pred_info_arity(PredInfo),
+		PredOrFunc = pred_info_is_pred_or_func(PredInfo),
+		ProcIds    = pred_info_procids(PredInfo),
+		% XXX The termination analyser outputs pragmas even if
+		% it doesn't have any information - should we be doing
+		% this?
+		list.foldl((pred(ProcId::in, !.IO::di, !:IO::uo) is det :-
+			proc_id_to_int(ProcId, ModeNum),
+			(
+				map.search(ExceptionInfo, proc(PredId, ProcId),
+					Status)
+			->
+				mercury_output_pragma_exceptions(PredOrFunc,
+					qualified(ModuleName, Name), Arity,
+					ModeNum, Status, !IO)
+			;
+				true
+			)), ProcIds, !IO)
+	;
+		true
+	).
+
+%----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "exception_analysis.m".
+
+%----------------------------------------------------------------------------%
+:- end_module exception_analysis.
+%----------------------------------------------------------------------------%
Index: compiler/goal_form.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/goal_form.m,v
retrieving revision 1.7
diff -u -r1.7 goal_form.m
--- compiler/goal_form.m	18 Feb 2004 01:39:38 -0000	1.7
+++ compiler/goal_form.m	21 Mar 2004 13:39:12 -0000
@@ -21,16 +21,38 @@

 :- import_module list.

+%
+% The first three versions may be more accurate because they can use
+% results of the termination and exception analyses.
+%
+
 	% Succeeds if the goal cannot loop forever.
 :- pred goal_cannot_loop(module_info::in, hlds_goal::in) is semidet.
-
-	% Succeeds if the goal cannot loop forever or throw an exception.
-:- pred goal_cannot_loop_or_throw(hlds_goal::in) is semidet.
-
+
 	% Succeeds if the goal can loop forever.
 :- pred goal_can_loop(module_info::in, hlds_goal::in) is semidet.

+	% Succeeds if the goal cannot throw an exception.
+:- pred goal_cannot_throw(module_info::in, hlds_goal::in) is semidet.
+
+	% Succeeds if the goal can throw an exception.
+:- pred goal_can_throw(module_info::in, hlds_goal::in) is semidet.
+
+	% Succeeds if the goal cannot loop forever or throw an exception.
+:- pred goal_cannot_loop_or_throw(module_info::in, hlds_goal::in) is semidet.
+
 	% Succeeds if the goal can loop forever or throw an exception.
+:- pred goal_can_loop_or_throw(module_info::in, hlds_goal::in) is semidet.
+
+%
+% These versions do not use the results of the termination or exception
+% analyses.
+%
+
+	% Succeeds if the goal cannot loop forever or throw an exception.
+:- pred goal_cannot_loop_or_throw(hlds_goal::in) is semidet.
+
+	% Succeed if the goal can loop forever or throw an exception.
 :- pred goal_can_loop_or_throw(hlds_goal::in) is semidet.

 	% contains_only_builtins(G) is true if G is a leaf procedure,
@@ -95,24 +117,38 @@
 :- implementation.

 :- import_module hlds__hlds_data.
+:- import_module parse_tree__prog_data.
 :- import_module transform_hlds__term_util.

-:- import_module bool, int, std_util, require.
+:- import_module bool, int, map, std_util, require.

 %-----------------------------------------------------------------------------%

+goal_cannot_loop(ModuleInfo, Goal) :-
+	goal_cannot_loop_aux(yes(ModuleInfo), Goal).
+
 goal_can_loop(ModuleInfo, Goal) :-
 	\+ goal_cannot_loop(ModuleInfo, Goal).

-goal_can_loop_or_throw(Goal) :-
-	\+ goal_cannot_loop_or_throw(Goal).
+goal_cannot_throw(ModuleInfo, Goal) :-
+	goal_cannot_throw_aux(yes(ModuleInfo), Goal).

-goal_cannot_loop(ModuleInfo, Goal) :-
-	goal_cannot_loop_aux(yes(ModuleInfo), Goal).
+goal_can_throw(ModuleInfo, Goal) :-
+	not goal_cannot_throw(ModuleInfo, Goal).
+
+goal_cannot_loop_or_throw(ModuleInfo, Goal) :-
+	goal_cannot_loop_aux(yes(ModuleInfo), Goal),
+	goal_cannot_throw_aux(yes(ModuleInfo), Goal).
+
+goal_can_loop_or_throw(ModuleInfo, Goal) :-
+	not goal_cannot_loop_or_throw(ModuleInfo, Goal).

 goal_cannot_loop_or_throw(Goal) :-
 	goal_cannot_loop_aux(no, Goal).

+goal_can_loop_or_throw(Goal) :-
+	\+ goal_cannot_loop_or_throw(Goal).
+
 :- pred goal_cannot_loop_aux(maybe(module_info)::in, hlds_goal::in) is semidet.

 goal_cannot_loop_aux(MaybeModuleInfo, Goal) :-
@@ -161,6 +197,54 @@
 	).
 		% Complicated unifies are _non_builtin_

+%-----------------------------------------------------------------------------%
+
+goal_cannot_throw(ModuleInfo, Goal) :-
+	goal_cannot_throw_aux(yes(ModuleInfo), Goal).
+
+:- pred goal_cannot_throw_aux(maybe(module_info)::in,
+		hlds_goal::in) is semidet.
+
+goal_cannot_throw_aux(MaybeModuleInfo, GoalExpr - _) :-
+	goal_cannot_throw_expr(MaybeModuleInfo, GoalExpr).
+
+:- pred goal_cannot_throw_expr(maybe(module_info)::in,
+		hlds_goal_expr::in) is semidet.
+
+goal_cannot_throw_expr(MaybeModuleInfo, conj(Goals)) :-
+	list.member(Goal, Goals) =>
+		goal_cannot_throw_aux(MaybeModuleInfo, Goal).
+goal_cannot_throw_expr(MaybeModuleInfo, disj(Goals)) :-
+	list.member(Goal, Goals) =>
+		goal_cannot_throw_aux(MaybeModuleInfo, Goal).
+goal_cannot_throw_expr(MaybeModuleInfo, switch(_Var, _Category, Cases)) :-
+	list.member(case(_, Goal), Cases) =>
+		goal_cannot_throw_aux(MaybeModuleInfo, Goal).
+goal_cannot_throw_expr(MaybeModuleInfo, not(Goal)) :-
+	goal_cannot_throw_aux(MaybeModuleInfo, Goal).
+goal_cannot_throw_expr(MaybeModuleInfo, some(_Vars, _, Goal)) :-
+	goal_cannot_throw_aux(MaybeModuleInfo, Goal).
+goal_cannot_throw_expr(MaybeModuleInfo, if_then_else(_, Cond, Then, Else)) :-
+	goal_cannot_throw_aux(MaybeModuleInfo, Cond),
+	goal_cannot_throw_aux(MaybeModuleInfo, Then),
+	goal_cannot_throw_aux(MaybeModuleInfo, Else).
+goal_cannot_loop_expr(MaybeModuleInfo,
+		call(PredId, ProcId, _, _, _, _)) :-
+	MaybeModuleInfo = yes(ModuleInfo),
+	module_info_exception_info(ModuleInfo, ExceptionInfo),
+	map.search(ExceptionInfo, proc(PredId, ProcId), will_not_throw).
+goal_cannot_throw_expr(_, unify(_, _, _, Uni, _)) :-
+	(
+		Uni = assign(_, _)
+	;
+		Uni = simple_test(_, _)
+	;
+		Uni = construct(_, _, _, _, _, _, _)
+	;
+		Uni = deconstruct(_, _, _, _, _, _)
+	).
+		% Complicated unifies are _non_builtin_
+
 %-----------------------------------------------------------------------------%

 contains_only_builtins(Goal - _GoalInfo) :-
Index: compiler/goal_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/goal_util.m,v
retrieving revision 1.93
diff -u -r1.93 goal_util.m
--- compiler/goal_util.m	21 Dec 2003 05:04:33 -0000	1.93
+++ compiler/goal_util.m	17 Feb 2004 06:23:01 -0000
@@ -1116,7 +1116,7 @@
 		InstmapBeforeLaterGoal, VarTypes, ModuleInfo).


-goal_util__reordering_maintains_termination(_ModuleInfo, FullyStrict,
+goal_util__reordering_maintains_termination(ModuleInfo, FullyStrict,
 		EarlierGoal, LaterGoal) :-
 	EarlierGoal = _ - EarlierGoalInfo,
 	LaterGoal = _ - LaterGoalInfo,
@@ -1140,7 +1140,7 @@
 		% (can_loop, can_fail), since this could worsen
 		% the termination properties of the program.
 	( EarlierCanFail = can_fail ->
-		goal_cannot_loop_or_throw(LaterGoal)
+		goal_cannot_loop_or_throw(ModuleInfo, LaterGoal)
 	;
 		true
 	).
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_module.m,v
retrieving revision 1.96
diff -u -r1.96 hlds_module.m
--- compiler/hlds_module.m	19 Mar 2004 11:13:14 -0000	1.96
+++ compiler/hlds_module.m	22 Mar 2004 04:10:37 -0000
@@ -84,6 +84,10 @@
 	% map from proc to a list of unused argument numbers.
 :- type unused_arg_info == map(pred_proc_id, list(int)).

+	% Map from proc to an indication of whether or not it
+	% might throw an exception.
+:- type exception_info == map(pred_proc_id, exception_status).
+
 	% List of procedures for which there are user-requested type
 	% specializations, and a list of predicates which should be
 	% processed by higher_order.m to ensure the production of those
@@ -295,12 +299,18 @@
 :- pred module_info_unused_arg_info(module_info::in, unused_arg_info::out)
 	is det.

+:- pred module_info_exception_info(module_info::in, exception_info::out)
+	is det.
+
 :- pred module_info_set_proc_requests(proc_requests::in,
 	module_info::in, module_info::out) is det.

 :- pred module_info_set_unused_arg_info(unused_arg_info::in,
 	module_info::in, module_info::out) is det.

+:- pred module_info_set_exception_info(exception_info::in,
+	module_info::in, module_info::out) is det.
+
 :- pred module_info_set_num_errors(int::in, module_info::in, module_info::out)
 	is det.

@@ -521,6 +531,12 @@
 						% module which has been
 						% exported in .opt files.

+		exception_info			:: exception_info,
+						% exception information about
+						% procedures in the current
+						% module (this includes
+						% opt_imported procedures).
+
 		lambda_number_counter		:: counter,

 		model_non_pragma_counter	:: counter,
@@ -576,6 +592,7 @@
 	map__init(Ctors),
 	set__init(StratPreds),
 	map__init(UnusedArgInfo),
+	map__init(ExceptionInfo),

 	set__init(TypeSpecPreds),
 	set__init(TypeSpecForcePreds),
@@ -598,10 +615,10 @@
 	map__init(FieldNameTable),

 	map__init(NoTagTypes),
-	ModuleSubInfo = module_sub(Name, Globals, no, [], [], [], [], no, 0,
-		[], [], StratPreds, UnusedArgInfo, counter__init(1),
-		counter__init(1), ImportedModules, IndirectlyImportedModules,
-		no_aditi_compilation, TypeSpecInfo,
+	ModuleSubInfo = module_sub(Name, Globals, no, [], [], [], [], no, 0,
+		[], [], StratPreds, UnusedArgInfo, ExceptionInfo,
+		counter__init(1), counter__init(1), ImportedModules,
+		IndirectlyImportedModules, no_aditi_compilation, TypeSpecInfo,
 		NoTagTypes, init_analysis_info(mmc)),
 	ModuleInfo = module(ModuleSubInfo, PredicateTable, Requests,
 		UnifyPredMap, QualifierInfo, Types, Insts, Modes, Ctors,
@@ -671,6 +688,7 @@
 module_info_type_ctor_gen_infos(MI, MI ^ sub_info ^ type_ctor_gen_infos).
 module_info_stratified_preds(MI, MI ^ sub_info ^ must_be_stratified_preds).
 module_info_unused_arg_info(MI, MI ^ sub_info ^ unused_arg_info).
+module_info_exception_info(MI, MI ^ sub_info ^ exception_info).
 module_info_get_lambda_counter(MI, MI ^ sub_info ^ lambda_number_counter).
 module_info_get_model_non_pragma_counter(MI,
 	MI ^ sub_info ^ model_non_pragma_counter).
@@ -711,6 +729,8 @@
 	MI ^ sub_info ^ must_be_stratified_preds := NewVal).
 module_info_set_unused_arg_info(NewVal, MI,
 	MI ^ sub_info ^ unused_arg_info := NewVal).
+module_info_set_exception_info(NewVal, MI,
+	MI ^ sub_info ^ exception_info := NewVal).
 module_info_set_lambda_counter(NewVal, MI,
 	MI ^ sub_info ^ lambda_number_counter := NewVal).
 module_info_set_model_non_pragma_counter(NewVal, MI,
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.462
diff -u -r1.462 make_hlds.m
--- compiler/make_hlds.m	19 Mar 2004 11:13:15 -0000	1.462
+++ compiler/make_hlds.m	22 Mar 2004 03:01:53 -0000
@@ -524,6 +524,18 @@
 				ModeNum, UnusedArgs, Context, !Module, !IO)
 		)
 	;
+		Pragma = exceptions(PredOrFunc, SymName, Arity, ModeNum,
+			ThrowStatus),
+		( ImportStatus \= opt_imported ->
+			prog_out.write_context(Context, !IO),
+			io.write_string("Error: illegal use of pragma " ++
+				"`exceptions'.\n", !IO),
+			module_info_incr_errors(!Module)
+		;
+			add_pragma_exceptions(PredOrFunc, SymName, Arity,
+				ModeNum, ThrowStatus, Context, !Module, !IO)
+		)
+	;
 		% Handle pragma type_spec decls later on (when we process
 		% clauses).
 		Pragma = type_spec(_, _, _, _, _, _, _, _)
@@ -1095,6 +1107,36 @@
 		io__write_string("Internal compiler error: " ++
 			"unknown predicate in `pragma unused_args'.\n", !IO),
 		module_info_incr_errors(!Module)
+	).
+
+%-----------------------------------------------------------------------------%
+
+:- pred add_pragma_exceptions(pred_or_func::in, sym_name::in, arity::in,
+	mode_num::in, exception_status::in, prog_context::in,
+	module_info::in, module_info::out, io::di, io::uo) is det.
+
+add_pragma_exceptions(PredOrFunc, SymName, Arity, ModeNum, ThrowStatus,
+		_Context, !Module, !IO) :-
+	module_info_get_predicate_table(!.Module, Preds),
+	(
+		predicate_table_search_pf_sym_arity(Preds,
+			is_fully_qualified, PredOrFunc, SymName,
+			Arity, [PredId])
+	->
+		module_info_exception_info(!.Module, ExceptionsInfo0),
+		% convert the mode number to a proc_id
+		proc_id_to_int(ProcId, ModeNum),
+		map__set(ExceptionsInfo0, proc(PredId, ProcId), ThrowStatus,
+			ExceptionsInfo),
+		module_info_set_exception_info(ExceptionsInfo, !Module)
+	;
+		% XXX We'll just ignore this for the time being -
+		% it causes errors with transitive-intermodule optimization.
+		%prog_out__write_context(Context, !IO),
+		%io__write_string("Internal compiler error: " ++
+		%	"unknown predicate in `pragma exceptions'.\n", !IO),
+		%module_info_incr_errors(!Module)
+		true
 	).

 %-----------------------------------------------------------------------------%
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.304
diff -u -r1.304 mercury_compile.m
--- compiler/mercury_compile.m	19 Mar 2004 11:13:15 -0000	1.304
+++ compiler/mercury_compile.m	21 Mar 2004 12:17:01 -0000
@@ -65,6 +65,7 @@
 :- import_module transform_hlds__lambda.
 :- import_module backend_libs__type_ctor_info.
 :- import_module transform_hlds__termination.
+:- import_module transform_hlds__exception_analysis.
 :- import_module transform_hlds__higher_order.
 :- import_module transform_hlds__accumulator.
 :- import_module transform_hlds__inlining.
@@ -1817,7 +1818,7 @@
 		( MaybeTransOptDeps = yes(TransOptDeps) ->
 			% When creating the trans_opt file, only import the
 			% trans_opt files which are lower in the ordering.
-			trans_opt__grab_optfiles(Imports1, TransOptDeps,
+			trans_opt__grab_optfiles(TransOptDeps, Imports1,
 				Imports, Error2, !IO)
 		;
 			Imports = Imports1,
@@ -1863,7 +1864,7 @@
 			list__condense([Imports0 ^ parent_deps,
 				Imports0 ^ int_deps, Imports0 ^ impl_deps],
 				TransOptFiles),
-			trans_opt__grab_optfiles(Imports1, TransOptFiles,
+			trans_opt__grab_optfiles(TransOptFiles, Imports1,
 				Imports, Error2, !IO)
 		;
 			Imports = Imports1,
@@ -2093,6 +2094,8 @@
 	globals__lookup_bool_option(Globals, verbose, Verbose),
 	globals__lookup_bool_option(Globals, statistics, Stats),
 	globals__lookup_bool_option(Globals, termination, Termination),
+	globals__lookup_bool_option(Globals, analyse_exceptions,
+		ExceptionAnalysis),

 	( MakeOptInt = yes ->
 		intermod__write_optfile(!HLDS, !IO),
@@ -2104,11 +2107,18 @@
 		(
 			( IntermodArgs = yes
 			; Termination = yes
+			; ExceptionAnalysis = yes
 			)
 		->
 			mercury_compile__frontend_pass_by_phases(!HLDS,
 				FoundModeError, !IO),
 			( FoundModeError = no ->
+				( ExceptionAnalysis = yes ->
+				    mercury_compile__maybe_exception_analysis(
+				        Verbose, Stats, !HLDS, !IO)
+				;
+				    true
+				),
 				( IntermodArgs = yes ->
 					mercury_compile__maybe_unused_args(
 						Verbose, Stats, !HLDS, !IO)
@@ -2165,10 +2175,15 @@
 :- pred mercury_compile__output_trans_opt_file(module_info::in,
 	io::di, io::uo) is det.

-mercury_compile__output_trans_opt_file(HLDS25, !IO) :-
+mercury_compile__output_trans_opt_file(HLDS27, !IO) :-
 	globals__io_lookup_bool_option(verbose, Verbose, !IO),
 	globals__io_lookup_bool_option(statistics, Stats, !IO),
-	mercury_compile__maybe_termination(Verbose, Stats, HLDS25, HLDS28, !IO),
+	mercury_compile__maybe_exception_analysis(Verbose, Stats, HLDS27,
+		HLDS27b, !IO),
+	mercury_compile__maybe_dump_hlds(HLDS27b, "27b", "exception_analysis",
+		!IO),
+	mercury_compile__maybe_termination(Verbose, Stats, HLDS27b, HLDS28,
+		!IO),
 	mercury_compile__maybe_dump_hlds(HLDS28, "28", "termination", !IO),
 	trans_opt__write_optfile(HLDS28, !IO).

@@ -2272,6 +2287,14 @@
 	% ;
 	%	true
 	% ),
+
+	% Exception analysis and termination analysis need to come before any
+	% optimization passes that could benefit from the information that
+	% they provide.
+	%
+	mercury_compile__maybe_exception_analysis(Verbose, Stats, !HLDS, !IO),
+	mercury_compile__maybe_dump_hlds(!.HLDS, "27b", "exception_analysis",
+		!IO),

 	mercury_compile__maybe_termination(Verbose, Stats, !HLDS, !IO),
 	mercury_compile__maybe_dump_hlds(!.HLDS, "28", "termination", !IO),
@@ -2747,6 +2770,22 @@
 			"% Program is determinism-correct.\n", !IO)
 	),
 	maybe_report_stats(Stats, !IO).
+
+:- pred mercury_compile.maybe_exception_analysis(bool::in, bool::in,
+	module_info::in, module_info::out, io::di, io::uo) is det.
+
+mercury_compile.maybe_exception_analysis(Verbose, Stats, !HLDS, !IO) :-
+	globals.io_lookup_bool_option(analyse_exceptions, ExceptionAnalysis,
+		!IO),
+	(
+		ExceptionAnalysis = yes,
+		maybe_write_string(Verbose, "% Analysing exceptions...\n", !IO),
+		exception_analysis.process_module(!HLDS, !IO),
+		maybe_write_string(Verbose, "% done.\n", !IO),
+		maybe_report_stats(Stats, !IO)
+	;
+		ExceptionAnalysis = no
+	).

 :- pred mercury_compile__maybe_termination(bool::in, bool::in,
 	module_info::in, module_info::out, io::di, io::uo) is det.
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.236
diff -u -r1.236 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m	21 Dec 2003 05:04:36 -0000	1.236
+++ compiler/mercury_to_mercury.m	9 Mar 2004 05:55:40 -0000
@@ -169,6 +169,9 @@
 		int, mode_num, list(int), io__state, io__state).
 :- mode mercury_output_pragma_unused_args(in, in, in, in, in, di, uo) is det.

+:- pred mercury_output_pragma_exceptions(pred_or_func::in, sym_name::in,
+	int::in, mode_num::in, exception_status::in, io::di, io::uo) is det.
+
 	% Write an Aditi index specifier.
 :- pred mercury_output_index_spec(index_spec, io__state, io__state).
 :- mode mercury_output_index_spec(in, di, uo) is det.
@@ -583,6 +586,11 @@
 		mercury_output_pragma_unused_args(PredOrFunc,
 			PredName, Arity, ModeNum, UnusedArgs)
 	;
+		{ Pragma = exceptions(PredOrFunc, PredName,
+			Arity, ModeNum, ThrowStatus) },
+		mercury_output_pragma_exceptions(PredOrFunc,
+			PredName, Arity, ModeNum, ThrowStatus)
+	;
 		{ Pragma = fact_table(Pred, Arity, FileName) },
 		mercury_format_pragma_fact_table(Pred, Arity, FileName)
 	;
@@ -3140,6 +3148,38 @@
 	add_string(", "),
 	add_int(First),
 	mercury_format_int_list_2(Rest).
+
+%-----------------------------------------------------------------------------%
+
+mercury_output_pragma_exceptions(PredOrFunc, SymName, Arity, ModeNum,
+		ThrowStatus, !IO) :-
+	io.write_string(":- pragma exceptions(", !IO),
+	hlds_out.write_pred_or_func(PredOrFunc, !IO),
+	io.write_string(", ", !IO),
+	mercury_output_bracketed_sym_name(SymName, !IO),
+	io.write_string(", ", !IO),
+	io.write_int(Arity, !IO),
+	io.write_string(", ", !IO),
+	io.write_int(ModeNum, !IO),
+	io.write_string(", ", !IO),
+	(
+		ThrowStatus = will_not_throw,
+		io.write_string("will_not_throw", !IO)
+	;
+		ThrowStatus = may_throw(ExceptionType),
+		io.write_string("may_throw(", !IO),
+		(
+			ExceptionType = user_exception,
+			io.write_string("user_exception)", !IO)
+		;
+			ExceptionType = type_exception,
+			io.write_string("type_exception)", !IO)
+		)
+	;
+		ThrowStatus = conditional,
+		io.write_string("conditional", !IO)
+	),
+	io.write_string(").\n", !IO).

 %-----------------------------------------------------------------------------%

Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.89
diff -u -r1.89 module_qual.m
--- compiler/module_qual.m	1 Dec 2003 15:55:43 -0000	1.89
+++ compiler/module_qual.m	29 Jan 2004 07:09:44 -0000
@@ -1013,6 +1013,7 @@
 		export(Name, PredOrFunc, Modes, CFunc), Info0, Info) -->
 	qualify_mode_list(Modes0, Modes, Info0, Info).
 qualify_pragma(X at unused_args(_, _, _, _, _), X, Info, Info) --> [].
+qualify_pragma(X at exceptions(_, _, _, _, _), X, Info, Info) --> [].
 qualify_pragma(type_spec(A, B, C, D, MaybeModes0, Subst0, G, H),
 		type_spec(A, B, C, D, MaybeModes, Subst, G, H),
 		Info0, Info) -->
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.299
diff -u -r1.299 modules.m
--- compiler/modules.m	19 Mar 2004 10:19:24 -0000	1.299
+++ compiler/modules.m	19 Mar 2004 14:23:51 -0000
@@ -1687,6 +1687,7 @@
 pragma_allowed_in_interface(promise_pure(_, _), no).
 pragma_allowed_in_interface(promise_semipure(_, _), no).
 pragma_allowed_in_interface(unused_args(_, _, _, _, _), no).
+pragma_allowed_in_interface(exceptions(_, _, _, _, _), no).
 pragma_allowed_in_interface(type_spec(_, _, _, _, _, _, _, _), yes).
 pragma_allowed_in_interface(termination_info(_, _, _, _, _), yes).
 pragma_allowed_in_interface(terminates(_, _), yes).
Index: compiler/options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.423
diff -u -r1.423 options.m
--- compiler/options.m	10 Feb 2004 12:43:31 -0000	1.423
+++ compiler/options.m	22 Mar 2004 04:13:42 -0000
@@ -481,6 +481,7 @@
 		;	termination_norm
 		;	termination_error_limit
 		;	termination_path_limit
+		;	analyse_exceptions
 	%	- HLDS->LLDS
 		;	smart_indexing
 		;	  dense_switch_req_density
@@ -1012,7 +1013,8 @@
 	termination_norm	-	string("total"),
 	termination_error_limit	-	int(3),
 	termination_path_limit	-	int(256),
-	split_c_files		-	bool(no)
+	split_c_files		-	bool(no),
+	analyse_exceptions 	-	bool(no)
 ]).
 option_defaults_2(optimization_option, [
 		% Optimization options
@@ -1733,6 +1735,7 @@
 long_option("term-err-limit",		termination_error_limit).
 long_option("termination-path-limit",	termination_path_limit).
 long_option("term-path-limit",		termination_path_limit).
+long_option("analyse-exceptions", 	analyse_exceptions).

 % HLDS->LLDS optimizations
 long_option("smart-indexing",		smart_indexing).
@@ -3630,7 +3633,11 @@
 		"--deforestation-size-threshold <threshold>",
 		"\tSpecify a rough limit on the size of a goal",
 		"\tto be optimized by deforestation.",
-		"\tA value of -1 specifies no limit. The default is 15."
+		"\tA value of -1 specifies no limit. The default is 15.",
+		"--analyse-exceptions",
+		"\tEnable exception analysis.  This tries to identify those",
+		"\tprocedures that will not throw an exception.",
+		"\tSome optimizations can make use of this information."
 	]).

 :- pred options_help_hlds_llds_optimization(io__state::di, io__state::uo) is det.
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.105
diff -u -r1.105 prog_data.m
--- compiler/prog_data.m	25 Feb 2004 02:38:49 -0000	1.105
+++ compiler/prog_data.m	21 Mar 2004 12:14:07 -0000
@@ -329,7 +329,16 @@
 			% Used for inter-module unused argument
 			% removal, should only appear in .opt files.
 		)
-
+	;
+		exceptions(
+			exceptions_p_or_f :: pred_or_func,
+			exceptions_name	  :: sym_name,
+			exceptions_arity  :: arity,
+			exceptions_mode   :: mode_num,
+			exceptions_status :: exception_status
+			% PredName, Arity, Mode number, Exception status.
+			% Should only appear in `.opt' or `.trans_opt' files.
+		)
 	%
 	% Diagnostics pragmas (pragmas related to compiler warnings/errors)
 	%
@@ -631,6 +640,38 @@
 :- type mode_num == int.

 %
+% Stuff for the `exceptions' pragma.
+%
+
+:- type exception_status
+		---> 	will_not_throw
+				% This procedure will not throw an
+				% exception.
+
+		;	may_throw(exception_type)
+				% This procedure may throw an exception
+				% The exception is classified by the
+				% `exception_type' type.
+		;	conditional.
+				% Whether the procedure will not throw an
+				% exception depends upon the value of one
+				% or more polymorpyhic arguments.
+				% XXX This needs to be extended for ho
+				% preds.  (See exception_analysis.m for
+				% more details).
+:- type exception_type
+		--->	user_exception
+				% The exception that might be thrown is of
+				% a result of some code calling
+				% exception.throw/1.
+		;	type_exception.
+				% The exception is a result of a compiler
+				% introduced unification/comparison maybe
+				% throwing an exception (in the case of
+				% user-defined equality or comparison) or
+				% propagating an exception from them.
+
+%
 % Stuff for the `type_spec' pragma.
 %

@@ -902,7 +943,7 @@
 			% The termination of the foreign code depends
 			% on whether the code makes calls back to Mercury
 			% (See termination.m for details).
-
+
 :- type pragma_foreign_proc_extra_attribute
 	--->	max_stack_size(int).

@@ -1445,7 +1486,7 @@
 		TerminatesStrList = []
 	),
 	StringList = [MayCallMercuryStr, ThreadSafeStr, TabledForIOStr |
-			PurityStrList] ++ TerminatesStrList ++
+			PurityStrList] ++ TerminatesStrList ++
 		list__map(extra_attribute_to_string, ExtraAttributes).

 add_extra_attribute(NewAttribute, Attributes0,
@@ -1458,4 +1499,6 @@
 extra_attribute_to_string(max_stack_size(Size)) =
 	"max_stack_size(" ++ string__int_to_string(Size) ++ ")".

+%-----------------------------------------------------------------------------%
+:- end_module prog_data.
 %-----------------------------------------------------------------------------%
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.64
diff -u -r1.64 prog_io_pragma.m
--- compiler/prog_io_pragma.m	12 Feb 2004 03:36:15 -0000	1.64
+++ compiler/prog_io_pragma.m	21 Mar 2004 11:35:19 -0000
@@ -1118,6 +1118,59 @@
 			Pragma = check_termination(Name, Arity)),
 		PragmaTerms, ErrorTerm, Result).

+parse_pragma_type(ModuleName, "exceptions", PragmaTerms,
+		ErrorTerm, _VarSet, Result) :-
+	(
+		PragmaTerms = [
+			PredOrFuncTerm,
+			PredNameTerm,
+			term__functor(term__integer(Arity), [], _),
+			term__functor(term__integer(ModeNum), [], _),
+			ThrowStatusTerm
+		],
+		(
+			PredOrFuncTerm = term__functor(
+					term__atom("predicate"), [], _),
+			PredOrFunc = predicate
+		;
+			PredOrFuncTerm = term__functor(
+					term__atom("function"), [], _),
+			PredOrFunc = function
+		),
+		parse_implicitly_qualified_term(ModuleName, PredNameTerm,
+			ErrorTerm, "`:- pragma exceptions' declaration",
+			PredNameResult),
+		PredNameResult = ok(PredName, []),
+		(
+			ThrowStatusTerm = term__functor(
+				term__atom("will_not_throw"), [], _),
+			ThrowStatus = will_not_throw
+		;
+			ThrowStatusTerm = term__functor(
+				term__atom("may_throw"),
+				[ExceptionTypeTerm], _),
+			(
+				ExceptionTypeTerm = term__functor(
+					term__atom("user_exception"), [], _),
+				ExceptionType = user_exception
+			;
+				ExceptionTypeTerm = term__functor(
+					term__atom("type_exception"), [], _),
+				ExceptionType = type_exception
+			),
+			ThrowStatus = may_throw(ExceptionType)
+		;
+			ThrowStatusTerm = term__functor(
+				term__atom("conditional"), [], _),
+			ThrowStatus = conditional
+		)
+	->
+		Result = ok(pragma(exceptions(PredOrFunc, PredName,
+				Arity, ModeNum, ThrowStatus)))
+	;
+		Result = error("error in `:- pragma exceptions'", ErrorTerm)
+	).
+
 	% This parses a pragma that refers to a predicate or function.
 :- pred parse_simple_pragma(module_name, string,
 			pred(sym_name, int, pragma_type),
@@ -1360,7 +1413,7 @@
 		Flag = purity(Purity)
 	; parse_terminates(Term, Terminates) ->
 		Flag = terminates(Terminates)
-	;
+	;
 		fail
 	).

Index: compiler/recompilation.version.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/recompilation.version.m,v
retrieving revision 1.7
diff -u -r1.7 recompilation.version.m
--- compiler/recompilation.version.m	1 Dec 2003 15:55:48 -0000	1.7
+++ compiler/recompilation.version.m	29 Jan 2004 07:15:27 -0000
@@ -581,6 +581,8 @@
 is_pred_pragma(source_file(_), no).
 is_pred_pragma(unused_args(PredOrFunc, Name, Arity, _, _),
 		yes(yes(PredOrFunc) - Name / Arity)).
+is_pred_pragma(exceptions(PredOrFunc, Name, Arity, _, _),
+		yes(yes(PredOrFunc) - Name / Arity)).
 is_pred_pragma(fact_table(Name, Arity, _), yes(no - Name / Arity)).
 is_pred_pragma(reserve_tag(_TypeName, _TypeArity), no).
 is_pred_pragma(aditi(Name, Arity), yes(no - Name / Arity)).
Index: compiler/rl.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl.m,v
retrieving revision 1.27
diff -u -r1.27 rl.m
--- compiler/rl.m	28 Nov 2003 02:23:07 -0000	1.27
+++ compiler/rl.m	17 Feb 2004 06:23:38 -0000
@@ -948,7 +948,7 @@
 		all [Goal] (
 			list__member(Goal, Goals)
 		=>
-			goal_cannot_loop_or_throw(Goal)
+			goal_cannot_loop_or_throw(ModuleInfo, Goal)
 		)
 	).

Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.129
diff -u -r1.129 simplify.m
--- compiler/simplify.m	8 Mar 2004 02:30:31 -0000	1.129
+++ compiler/simplify.m	10 Mar 2004 02:34:37 -0000
@@ -333,6 +333,7 @@
 simplify__goal(Goal0, Goal - GoalInfo, !Info) :-
 	Goal0 = _ - GoalInfo0,
 	goal_info_get_determinism(GoalInfo0, Detism),
+	simplify_info_get_module_info(!.Info, ModuleInfo),
 	simplify_info_get_det_info(!.Info, DetInfo),
 	(
 		%
@@ -343,7 +344,7 @@
 		% ensure goal is pure or semipure
 		\+ goal_info_is_impure(GoalInfo0),
 		( det_info_get_fully_strict(DetInfo, no)
-		; goal_cannot_loop_or_throw(Goal0)
+		; goal_cannot_loop_or_throw(ModuleInfo, Goal0)
 		)
 	->
 		% warn about this, unless the goal was an explicit
@@ -393,7 +394,7 @@
 		% ensure goal is pure or semipure
 		\+ goal_info_is_impure(GoalInfo0),
 		( det_info_get_fully_strict(DetInfo, no)
-		; goal_cannot_loop_or_throw(Goal0)
+		; goal_cannot_loop_or_throw(ModuleInfo, Goal0)
 		)
 	->
 % The following warning is disabled, because it often results in spurious
Index: compiler/trans_opt.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/trans_opt.m,v
retrieving revision 1.21
diff -u -r1.21 trans_opt.m
--- compiler/trans_opt.m	15 Mar 2003 03:09:12 -0000	1.21
+++ compiler/trans_opt.m	21 Mar 2004 13:44:43 -0000
@@ -30,14 +30,16 @@
 %
 % This module writes out the interface for transitive intermodule optimization.
 % The .trans_opt file includes:
-%	- pragma termination_info declarations for all exported preds
+%	:- pragma termination_info declarations for all exported preds
+%	:- pragma exceptions declartions for all exported preds
 % All these items should be module qualified.
 % Constructors should be explicitly type qualified.
 %
 % Note that the .trans_opt file does not (yet) include clauses,
 % `pragma c_code' declarations, or any of the other information
 % that would be needed for inlining or other optimizations;
-% currently it is used *only* for termination analysis.
+% currently it is only used for termination analysis and
+% exception analysis.
 %
 % This module also contains predicates to read in the .trans_opt files.
 %
@@ -47,8 +49,6 @@

 :- module transform_hlds__trans_opt.

-%-----------------------------------------------------------------------------%
-
 :- interface.

 :- import_module hlds__hlds_module.
@@ -57,16 +57,14 @@

 :- import_module io, bool, list.

-:- pred trans_opt__write_optfile(module_info, io__state, io__state).
-:- mode trans_opt__write_optfile(in, di, uo) is det.
+:- pred trans_opt__write_optfile(module_info::in, io::di, io::uo) is det.

 	% trans_opt__grab_optfiles(ModuleImports0, ModuleList, ModuleImports,
 	% 	Error, IO0, IO).
 	% Add the items from each of the modules in ModuleList.trans_opt to
 	% the items in ModuleImports.
-:- pred trans_opt__grab_optfiles(module_imports, list(module_name),
-	module_imports, bool, io__state, io__state).
-:- mode trans_opt__grab_optfiles(in, in, out, out, di, uo) is det.
+:- pred trans_opt__grab_optfiles(list(module_name)::in, module_imports::in,
+	module_imports::out, bool::out, io::di, io::uo) is det.

 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
@@ -83,6 +81,7 @@
 :- import_module parse_tree__prog_out.
 :- import_module transform_hlds__intermod.
 :- import_module transform_hlds__termination.
+:- import_module transform_hlds__exception_analysis.

 :- import_module set, string, list, map, varset, term, std_util.

@@ -91,53 +90,61 @@
 % Open the file "<module-name>.trans_opt.tmp", and write out the
 % declarations.

-trans_opt__write_optfile(Module) -->
-	{ module_info_name(Module, ModuleName) },
+trans_opt__write_optfile(Module, !IO) :-
+	module_info_name(Module, ModuleName),
 	module_name_to_file_name(ModuleName, ".trans_opt.tmp", yes,
-					TmpOptName),
-	io__open_output(TmpOptName, Result),
+		TmpOptName, !IO),
+	io__open_output(TmpOptName, Result, !IO),
 	(
-		{ Result = error(Error) },
-		{ io__error_message(Error, Msg) },
-		io__progname_base("trans_opt.m", ProgName),
-		io__write_string(ProgName),
+		Result = error(Error),
+		io__error_message(Error, Msg),
+		io__progname_base("trans_opt.m", ProgName, !IO),
+		io__write_string(ProgName, !IO),
 		io__write_string(
-			": cannot open transitive optimisation file `"),
-		io__write_string(TmpOptName),
-		io__write_string("' \n"),
-		io__write_string(ProgName),
-		io__write_string(": for output: "),
-		io__write_string(Msg),
-		io__nl,
-		io__set_exit_status(1)
+			": cannot open transitive optimisation file `", !IO),
+		io__write_string(TmpOptName, !IO),
+		io__write_string("' \n", !IO),
+		io__write_string(ProgName, !IO),
+		io__write_string(": for output: ", !IO),
+		io__write_string(Msg, !IO),
+		io__nl(!IO),
+		io__set_exit_status(1, !IO)
 	;
-		{ Result = ok(Stream) },
-		io__set_output_stream(Stream, OldStream),
-		{ module_info_name(Module, ModName) },
-		io__write_string(":- module "),
-		mercury_output_bracketed_sym_name(ModName),
-		io__write_string(".\n"),
+		Result = ok(Stream),
+		io__set_output_stream(Stream, OldStream, !IO),
+		module_info_name(Module, ModName),
+		io__write_string(":- module ", !IO),
+		mercury_output_bracketed_sym_name(ModName, !IO),
+		io__write_string(".\n", !IO),

 		% All predicates to write global items into the .trans_opt
 		% file should go here.

-		{ module_info_predids(Module, PredIds) },
+	 	module_info_predids(Module, PredIds),
 		list__foldl(termination__write_pred_termination_info(Module),
-			PredIds),
-
-		io__set_output_stream(OldStream, _),
-		io__close_output(Stream),
+			PredIds, !IO),
+
+		module_info_exception_info(Module, ExceptionInfo),
+		list__foldl(
+			exception_analysis__write_pragma_exceptions(Module,
+				ExceptionInfo),
+			PredIds, !IO),
+
+		io__set_output_stream(OldStream, _, !IO),
+		io__close_output(Stream, !IO),

 		module_name_to_file_name(ModuleName, ".trans_opt", no,
-				OptName),
-		update_interface(OptName),
-		touch_interface_datestamp(ModuleName, ".trans_opt_date")
+			OptName, !IO),
+		update_interface(OptName, !IO),
+		touch_interface_datestamp(ModuleName, ".trans_opt_date", !IO)
 	).

 %-----------------------------------------------------------------------------%
-	% Read in and process the transitive optimization interfaces.
+%
+% Read and process th etransitive optimization interfaces.
+%

-trans_opt__grab_optfiles(Module0, TransOptDeps, Module, FoundError) -->
+trans_opt__grab_optfiles(TransOptDeps, Module0, Module, FoundError) -->
 	globals__io_lookup_bool_option(verbose, Verbose),
 	maybe_write_string(Verbose, "% Reading .trans_opt files..\n"),
 	maybe_flush_output(Verbose),
@@ -180,3 +187,6 @@
 	{ list__append(Items0, Items1, Items2) },
 	read_trans_opt_files(Imports, Items2, Items, Error1, Error).

+%-----------------------------------------------------------------------------%
+:- end_module trans_opt.
+%-----------------------------------------------------------------------------%
Index: compiler/transform_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/transform_hlds.m,v
retrieving revision 1.8
diff -u -r1.8 transform_hlds.m
--- compiler/transform_hlds.m	1 Dec 2003 15:55:49 -0000	1.8
+++ compiler/transform_hlds.m	12 Mar 2004 04:01:08 -0000
@@ -35,6 +35,8 @@
    :- include_module term_util.
    :- include_module lp. % this could alternatively go in the `libs' module

+:- include_module exception_analysis.
+
 % Optimizations (HLDS -> HLDS)
 :- include_module higher_order.
 :- include_module inlining.
Index: compiler/notes/compiler_design.html
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/notes/compiler_design.html,v
retrieving revision 1.90
diff -u -r1.90 compiler_design.html
--- compiler/notes/compiler_design.html	19 Mar 2004 10:19:37 -0000	1.90
+++ compiler/notes/compiler_design.html	21 Mar 2004 13:45:24 -0000
@@ -715,6 +715,16 @@

 <p>

+Exception analysis. (exception_analysis.m)
+
+<ul>
+<li>
+	This pass annotates each module with information about whether
+	the procedures in the module may throw an exception or not.
+</ul>
+
+<p>
+
 The next pass is termination analysis. The various modules involved are:

 <ul>
Index: doc/user_guide.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/user_guide.texi,v
retrieving revision 1.383
diff -u -r1.383 user_guide.texi
--- doc/user_guide.texi	18 Mar 2004 03:42:10 -0000	1.383
+++ doc/user_guide.texi	22 Mar 2004 04:19:36 -0000
@@ -6168,6 +6168,13 @@
 to be optimized by deforestation.
 A value of -1 specifies no limit. The default is 15.

+ at sp 1
+ at item --analyse-exceptions
+ at findex --analyse-exceptions
+Try to identify those procedures that cannot throw an
+exception.  This information can be used by some
+optimization passes.
+
 @end table

 @node MLDS backend (MLDS -> MLDS) optimization options
Index: tests/README
===================================================================
RCS file: /home/mercury1/repository/tests/README,v
retrieving revision 1.7
diff -u -r1.7 README
--- tests/README	17 Aug 2002 13:51:54 -0000	1.7
+++ tests/README	19 Mar 2004 05:51:11 -0000
@@ -67,3 +67,8 @@
 	comparing the warnings emitted by the compiler with those given
 	in the hand-written `.exp' file.

+term
+	This directory tests the compiler's termination analyser.  These
+	tests work by comparing the contents of the .trans_opt file emitted
+	by the compiler with the hand-written `.trans_opt_exp' file.
+	This directory is also used for testing the compiler's exception analysis.
Index: tests/term/Mercury.options
===================================================================
RCS file: /home/mercury1/repository/tests/term/Mercury.options,v
retrieving revision 1.4
diff -u -r1.4 Mercury.options
--- tests/term/Mercury.options	15 Dec 2003 07:11:06 -0000	1.4
+++ tests/term/Mercury.options	20 Mar 2004 13:20:38 -0000
@@ -8,6 +8,7 @@
 MCFLAGS-dds3_15=--term-norm=simple
 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-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.24
diff -u -r1.24 Mmakefile
--- tests/term/Mmakefile	12 Feb 2004 03:36:17 -0000	1.24
+++ tests/term/Mmakefile	19 Mar 2004 00:47:04 -0000
@@ -19,6 +19,7 @@
 	dds3_15 \
 	dds3_17 \
 	dds3_8 \
+	exception_analysis_test \
 	existential_error1 \
 	existential_error2 \
 	existential_error3 \
Index: tests/term/exception_analysis_test.m
===================================================================
RCS file: tests/term/exception_analysis_test.m
diff -N tests/term/exception_analysis_test.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/term/exception_analysis_test.m	19 Mar 2004 00:33:11 -0000
@@ -0,0 +1,81 @@
+	% This module performs a basic test of the compiler's
+	% exception analysis.
+	%
+:- module exception_analysis_test.
+
+:- interface.
+
+	% Uses user-defined equality that may throw an exception
+	% but will not throw an exception itself.
+:- pred test1(T::in) is det.
+
+	% Uses user-defined equality that throws an exception
+	% and throws a (type) exception.
+:- pred test2(T::in, T::in) is semidet.
+
+	% Conditional.
+	%
+:- pred test3(T::in, T::in) is semidet.
+
+	% Throws a user exception.
+	%
+:- pred test4(T::in, T::in) is semidet.
+
+	%  This will be conditional...if we had
+	% a more precise analysis we could work out
+	% that it is only conditional if you enter
+	% the SCC via the predicate mutual_test1.
+	% If we enter via mutual_test2 then an
+	% exception will never be thrown.
+:- pred mutual_test1(T::in, T::in) is semidet.
+
+:- pred mutual_test2(int::in, int::in) is semidet.
+
+:- implementation.
+
+:- import_module require.
+
+:- type wrap(T) ---> wrap(T) where equality is wrap_equals.
+
+:- pred wrap_equals(wrap(T)::in, wrap(T)::in) is semidet.
+
+wrap_equals(_, _) :- error("Type exception.").
+
+test1(T) :- test1(wrap(T)).
+
+test2(X, Y) :-
+	( X = Y ->
+		true
+	;
+		test2(wrap(X), wrap(Y))
+	).
+
+test3(X, Y) :-
+	( X = Y ->
+		true
+	;
+		test3(X, Y)
+	).
+
+test4(X, Y) :-
+	( X = Y ->
+		error("User exception.")
+	;
+		test4(X, Y)
+	).
+
+mutual_test1(X::in, Y::in) :-
+	( X = Y ->
+		mutual_test2(3, 4)
+	;
+		mutual_test1("hello", "world")
+	).
+
+mutual_test2(X::in, Y::in) :-
+	( X = Y ->
+		mutual_test1(500, 400)
+	;
+		mutual_test2(60, 20)
+	).
+
+:- end_module exception_analysis_test.
Index: tests/term/exception_analysis_test.trans_opt_exp
===================================================================
RCS file: tests/term/exception_analysis_test.trans_opt_exp
diff -N tests/term/exception_analysis_test.trans_opt_exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/term/exception_analysis_test.trans_opt_exp	20 Mar 2004 13:22:44 -0000
@@ -0,0 +1,15 @@
+:- module exception_analysis_test.
+:- pragma termination_info(exception_analysis_test.test1((builtin.in)), finite(0, [no, no]), can_loop).
+:- pragma termination_info(exception_analysis_test.test2((builtin.in), (builtin.in)), finite(0, [no, no, no]), can_loop).
+:- pragma termination_info(exception_analysis_test.test3((builtin.in), (builtin.in)), finite(0, [no, no, no]), can_loop).
+:- pragma termination_info(exception_analysis_test.test4((builtin.in), (builtin.in)), finite(0, [no, no, no]), can_loop).
+:- pragma termination_info(exception_analysis_test.mutual_test1((builtin.in), (builtin.in)), finite(0, [no, no, no]), can_loop).
+:- pragma termination_info(exception_analysis_test.mutual_test2((builtin.in), (builtin.in)), finite(0, [no, no]), can_loop).
+:- pragma termination_info(exception_analysis_test.wrap_equals((builtin.in), (builtin.in)), infinite, cannot_loop).
+:- pragma exceptions(predicate, (exception_analysis_test.test1), 1, 0, will_not_throw).
+:- pragma exceptions(predicate, (exception_analysis_test.test2), 2, 0, may_throw(type_exception)).
+:- pragma exceptions(predicate, (exception_analysis_test.test3), 2, 0, conditional).
+:- pragma exceptions(predicate, (exception_analysis_test.test4), 2, 0, may_throw(user_exception)).
+:- pragma exceptions(predicate, (exception_analysis_test.mutual_test1), 2, 0, conditional).
+:- pragma exceptions(predicate, (exception_analysis_test.mutual_test2), 2, 0, conditional).
+:- pragma exceptions(predicate, (exception_analysis_test.wrap_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