[m-rev.] diff: rearrange some decl debug code and handle exceptions

[Mark Brown]

Estimated hours taken: 1
Branches: main

Move the code that defines an instance of mercury_edt/2 from
browser/declarative_debugger.m into a module of its own.  This section
of code is large and reasonably self-contained, so it makes sense for it
to have its own module.  Moreover, declarative_debugger.m contains the
main declarative debugging definitions and the upper levels of code for
the front end, and the mercury_edt/2 instance doesn't fit into either of
these categories.

Add an exception handler to the front end, so that if declarative debugging
fails for whatever reason, the debugging session can at least continue using
the procedural debugger.  Rather than calling error in the front end, throw
exceptions that are of a type specific to the front end (so we know which
errors are ours and which aren't).

browser/declarative_debugger.m:
	Add a new type, diagnoser_exception/0.  Handle these exceptions
	but rethrow any other kind.

browser/declarative_debugger.m:
browser/declarative_tree.m:
	Move the mercury_edt/2 instance to the new module.

browser/mdb.m:
	Add the new module to the mdb library.

browser/declarative_*.m:
	Call throw/1 instead of error/1.

tests/debugger/declarative/Mmakefile:
tests/debugger/declarative/catch.exp:
tests/debugger/declarative/catch.inp:
tests/debugger/declarative/catch.m:
	A test case for debugging code that catches exceptions.  This sort
	of code is still not supported by the front end, but at least we
	now give a decent error message and allow debugging to resume.

Index: browser/declarative_analyser.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_analyser.m,v
retrieving revision 1.12
diff -u -r1.12 declarative_analyser.m
--- browser/declarative_analyser.m	15 May 2002 11:24:07 -0000	1.12
+++ browser/declarative_analyser.m	8 Sep 2002 16:29:46 -0000
@@ -145,7 +145,7 @@
 %-----------------------------------------------------------------------------%
 
 :- implementation.
-:- import_module std_util, bool, require.
+:- import_module std_util, bool, exception.
 
 	% The analyser state records all of the information that needs
 	% to be remembered across multiple invocations of the analyser.
@@ -449,5 +449,5 @@
 	Prime = prime_suspect(S, Evidence, M).
 
 prime_suspect_add_evidence(_, _, no, _) :-
-	error("prime_suspect_add_evidence: not evidence").
+	throw(internal_error("prime_suspect_add_evidence", "not evidence")).
 
Index: browser/declarative_debugger.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_debugger.m,v
retrieving revision 1.31
diff -u -r1.31 declarative_debugger.m
--- browser/declarative_debugger.m	8 Sep 2002 15:46:29 -0000	1.31
+++ browser/declarative_debugger.m	8 Sep 2002 17:59:51 -0000
@@ -38,7 +38,7 @@
 :- interface.
 :- import_module mdb__declarative_execution, mdb__program_representation.
 :- import_module mdb__io_action.
-:- import_module io, bool, list, std_util.
+:- import_module io, bool, list, std_util, string.
 
 	% This type represents the possible truth values for nodes
 	% in the EDT.
@@ -209,9 +209,27 @@
 
 %-----------------------------------------------------------------------------%
 
+	% The diagnoser generates exceptions of the following type.
+	%
+:- type diagnoser_exception
+	--->	internal_error(
+			string,			% predicate/function name
+			string			% error message
+		)
+	;	io_error(
+			string,			% predicate/function name
+			string			% error message
+		)
+	;	unimplemented_feature(
+			string			% feature that is NYI
+		).
+
+%-----------------------------------------------------------------------------%
+
 :- implementation.
 :- import_module mdb__declarative_analyser, mdb__declarative_oracle.
-:- import_module require, int, char, string, assoc_list, map.
+:- import_module mdb__declarative_tree.
+:- import_module exception, int, map.
 
 unravel_decl_atom(DeclAtom, TraceAtom, IoActions) :-
 	(
@@ -264,8 +282,7 @@
 diagnosis(Store, NodeId, UseOldIoActionMap, IoActionStart, IoActionEnd,
 		Response, Diagnoser0, Diagnoser) -->
 	( { UseOldIoActionMap > 0 } ->
-		{ Diagnoser1 = Diagnoser0 },
-		{ diagnoser_get_analyser(Diagnoser1, Analyser1) }
+		{ Diagnoser1 = Diagnoser0 }
 	;
 		make_io_action_map(IoActionStart, IoActionEnd, IoActionMap),
 		{ Analyser0 = Diagnoser0 ^ analyser_state },
@@ -273,12 +290,33 @@
 			Analyser0, Analyser1) },
 		{ Diagnoser1 = Diagnoser0 ^ analyser_state := Analyser1 }
 	),
+	try_io(diagnosis_2(Store, NodeId, Diagnoser1), Result),
+	(
+		{ Result = succeeded({Response, Diagnoser}) }
+	;
+		{ Result = exception(UnivException) },
+		(
+			{ univ_to_type(UnivException, DiagnoserException) }
+		->
+			handle_diagnoser_exception(DiagnoserException,
+				Response, Diagnoser1, Diagnoser)
+		;
+			{ rethrow(Result) }
+		)
+	).
+
+:- pred diagnosis_2(S::in, R::in, diagnoser_state(R)::in,
+	{diagnoser_response, diagnoser_state(R)}::out,
+	io__state::di, io__state::uo) is cc_multi <= annotated_trace(S, R).
+
+diagnosis_2(Store, NodeId, Diagnoser0, {Response, Diagnoser}) -->
+	{ Analyser0 = Diagnoser0 ^ analyser_state },
 	{ start_analysis(wrap(Store), dynamic(NodeId), AnalyserResponse,
-		Analyser1, Analyser) },
-	{ diagnoser_set_analyser(Diagnoser1, Analyser, Diagnoser2) },
+		Analyser0, Analyser) },
+	{ diagnoser_set_analyser(Diagnoser0, Analyser, Diagnoser1) },
 	{ debug_analyser_state(Analyser, MaybeOrigin) },
 	handle_analyser_response(Store, AnalyserResponse, MaybeOrigin,
-		Response, Diagnoser2, Diagnoser).
+		Response, Diagnoser1, Diagnoser).
 
 :- pred handle_analyser_response(S::in, analyser_response(edt_node(R))::in,
 	maybe(subterm_origin(edt_node(R)))::in, diagnoser_response::out,
@@ -411,1035 +449,35 @@
 
 %-----------------------------------------------------------------------------%
 
-	%
-	% This section defines an instance of the EDT in terms of
-	% any instance of execution tree.
-	%
-
-	% The type of nodes in our implementation of EDTs.  The parameter
-	% is meant to be the type of references to trace nodes.  In
-	% particular, the references should be to trace nodes that could
-	% be considered nodes in the EDT, namely those for exit, fail
-	% and exception events.
-	% 
-:- type edt_node(R)
-	--->	dynamic(R).
-
-:- instance mercury_edt(wrap(S), edt_node(R)) <= annotated_trace(S, R)
-	where [
-		pred(edt_root_question/4) is trace_root_question,
-		pred(edt_root_e_bug/4) is trace_root_e_bug,
-		pred(edt_children/3) is trace_children,
-		pred(edt_dependency/6) is trace_dependency
-	].
-
-	% The wrap/1 around the first argument of the instance is
-	% required by the language.
-	%
-:- type wrap(S) ---> wrap(S).
-
-%-----------------------------------------------------------------------------%
-
-:- func exit_node_decl_atom(io_action_map::in, S::in,
-	trace_node(R)::in(trace_node_exit)) = (final_decl_atom::out) is det
-	<= annotated_trace(S, R).
-
-exit_node_decl_atom(IoActionMap, Store, ExitNode) = DeclAtom :-
-	ExitAtom = ExitNode ^ exit_atom,
-	CallId = ExitNode ^ exit_call,
-	call_node_from_id(Store, CallId, Call),
-	CallIoSeq = Call ^ call_io_seq_num,
-	ExitIoSeq = ExitNode ^ exit_io_seq_num,
-	IoActions = make_io_actions(IoActionMap, CallIoSeq, ExitIoSeq),
-	DeclAtom = final_decl_atom(ExitAtom, IoActions).
-
-:- func call_node_decl_atom(S, R) = init_decl_atom <= annotated_trace(S, R).
-
-call_node_decl_atom(Store, CallId) = DeclAtom :-
-	call_node_from_id(Store, CallId, CallNode),
-	CallAtom = CallNode ^ call_atom,
-	DeclAtom = init_decl_atom(CallAtom).
-
-:- func make_io_actions(io_action_map, int, int) = list(io_action).
-
-make_io_actions(IoActionMap, InitIoSeq, ExitIoSeq) =
-	( InitIoSeq = ExitIoSeq ->
-		[]
-	;
-		[map__lookup(IoActionMap, InitIoSeq) |
-			make_io_actions(IoActionMap, InitIoSeq + 1, ExitIoSeq)]
-	).
+:- pred handle_diagnoser_exception(diagnoser_exception::in,
+	diagnoser_response::out, diagnoser_state(R)::in,
+	diagnoser_state(R)::out, io__state::di, io__state::uo) is det.
+
+handle_diagnoser_exception(internal_error(Loc, Msg), Response, D, D) -->
+	io__stderr_stream(StdErr),
+	io__write_strings(StdErr, [
+		"An internal error has occurred; diagnosis will be aborted.  Debugging\n",
+		"message follows:\n",
+		Loc, ": ", Msg, "\n",
+		"Please report bugs to mercury-bugs at cs.mu.oz.au.\n"]),
+	{ Response = no_bug_found }.
+
+handle_diagnoser_exception(io_error(Loc, Msg), Response, D, D) -->
+	io__stderr_stream(StdErr),
+	io__write_strings(StdErr, [
+		"I/O error: ", Loc, ": ", Msg, ".\n",
+		"Diagnosis will be aborted.\n"]),
+	{ Response = no_bug_found }.
+
+handle_diagnoser_exception(unimplemented_feature(Feature), Response, D, D) -->
+	io__write_strings([
+		"Sorry, the diagnosis cannot continue because it requires support for\n",
+		"the following: ", Feature, ".\n",
+		"The debugger is a work in progress, and this is not supported in the\n",
+		"current version.\n"]),
+	{ Response = no_bug_found }.
 
 %-----------------------------------------------------------------------------%
-
-:- pred trace_root_question(io_action_map::in, wrap(S)::in, edt_node(R)::in,
-	decl_question(edt_node(R))::out) is det <= annotated_trace(S, R).
-
-trace_root_question(IoActionMap, wrap(Store), dynamic(Ref), Root) :-
-	det_edt_return_node_from_id(Store, Ref, Node),
-	(
-		Node = fail(_, CallId, RedoId, _),
-		DeclAtom = call_node_decl_atom(Store, CallId),
-		get_answers(IoActionMap, Store, RedoId, [], Answers),
-		Root = missing_answer(dynamic(Ref), DeclAtom, Answers)
-	;
-		Node = exit(_, _, _, _, _, _),
-		DeclAtom = exit_node_decl_atom(IoActionMap, Store, Node),
-		Root = wrong_answer(dynamic(Ref), DeclAtom)
-	;
-		Node = excp(_, CallId, _, Exception, _),
-		DeclAtom = call_node_decl_atom(Store, CallId),
-		Root = unexpected_exception(dynamic(Ref), DeclAtom, Exception)
-	).
-
-:- pred get_answers(io_action_map::in, S::in, R::in,
-	list(final_decl_atom)::in, list(final_decl_atom)::out) is det
-	<= annotated_trace(S, R).
-
-get_answers(IoActionMap, Store, RedoId, DeclAtoms0, DeclAtoms) :-
-	(
-		maybe_redo_node_from_id(Store, RedoId, redo(_, ExitId))
-	->
-		exit_node_from_id(Store, ExitId, ExitNode),
-		NextId = ExitNode ^ exit_prev_redo,
-		DeclAtom = exit_node_decl_atom(IoActionMap, Store, ExitNode),
-		get_answers(IoActionMap, Store, NextId,
-			[DeclAtom | DeclAtoms0], DeclAtoms)
-	;
-		DeclAtoms = DeclAtoms0
-	).
-
-:- pred trace_root_e_bug(io_action_map::in, wrap(S)::in, edt_node(R)::in,
-	decl_e_bug::out) is det <= annotated_trace(S, R).
-
-trace_root_e_bug(IoActionMap, wrap(Store), dynamic(Ref), Bug) :-
-	det_edt_return_node_from_id(Store, Ref, Node),
-	(
-		Node = exit(_, _, _, _, Event, _),
-		DeclAtom = exit_node_decl_atom(IoActionMap, Store, Node),
-		Bug = incorrect_contour(DeclAtom, unit, Event)
-	;
-		Node = fail(_, CallId, _, Event),
-		DeclAtom = call_node_decl_atom(Store, CallId),
-		Bug = partially_uncovered_atom(DeclAtom, Event)
-	;
-		Node = excp(_, CallId, _, Exception, Event),
-		DeclAtom = call_node_decl_atom(Store, CallId),
-		Bug = unhandled_exception(DeclAtom, Exception, Event)
-	).
-
-:- pred trace_children(wrap(S), edt_node(R), list(edt_node(R)))
-		<= annotated_trace(S, R).
-:- mode trace_children(in, in, out) is semidet.
-
-trace_children(wrap(Store), dynamic(Ref), Children) :-
-	det_edt_return_node_from_id(Store, Ref, Node),
-	(
-		Node = fail(PrecId, CallId, _, _),
-		not_at_depth_limit(Store, CallId),
-		missing_answer_children(Store, PrecId, CallId, [], Children)
-	;
-		Node = exit(PrecId, CallId, _, _, _, _),
-		not_at_depth_limit(Store, CallId),
-		wrong_answer_children(Store, PrecId, CallId, [], Children)
-	;
-		Node = excp(PrecId, CallId, _, _, _),
-		not_at_depth_limit(Store, CallId),
-		unexpected_exception_children(Store, PrecId, CallId, [],
-			Children)
-	).
-
-:- pred not_at_depth_limit(S, R) <= annotated_trace(S, R).
-:- mode not_at_depth_limit(in, in) is semidet.
-
-not_at_depth_limit(Store, Ref) :-
-	call_node_from_id(Store, Ref, CallNode),
-	CallNode ^ call_at_max_depth = no.
-
-:- pred wrong_answer_children(S, R, R, list(edt_node(R)), list(edt_node(R)))
-		<= annotated_trace(S, R).
-:- mode wrong_answer_children(in, in, in, in, out) is det.
-
-wrong_answer_children(Store, NodeId, StartId, Ns0, Ns) :-
-	(
-		NodeId = StartId
-	->
-		Ns = Ns0
-	;
-		wrong_answer_children_2(Store, NodeId, StartId, Ns0, Ns)
-	).
-
-:- pred wrong_answer_children_2(S, R, R, list(edt_node(R)),
-	list(edt_node(R))) <= annotated_trace(S, R).
-:- mode wrong_answer_children_2(in, in, in, in, out) is det.
-
-wrong_answer_children_2(Store, NodeId, StartId, Ns0, Ns) :-
-	det_trace_node_from_id(Store, NodeId, Node),
-	(
-		( Node = call(_, _, _, _, _, _, _, _, _)
-		; Node = neg(_, _, _)
-		; Node = cond(_, _, failed)
-		)
-	->
-		error("wrong_answer_children_2: unexpected start of contour")
-	;
-		Node = excp(_, _, _, _, _)
-	->
-		error("wrong_answer_children_2: exception handling not supported")
-	;
-		Node = exit(_, _, _, _, _, _)
-	->
-			%
-			% Add a child for this node.
-			%
-		Ns1 = [dynamic(NodeId) | Ns0]
-	;
-		Node = fail(_, CallId, _, _)
-	->
-			%
-			% Fail events can be reached here if there
-			% were events missing due to a parent being
-			% shallow traced.  In this case, we can't tell
-			% whether the call was in a negated context
-			% or backtracked over, so we have to assume
-			% the former.
-			%
-			% Fail events can also be reached here if the
-			% parent was a variant of solutions/2.
-			%
-			% If this really is in a negated context, the start of
-			% the context would be just before the entry to this
-			% failed call, modulo any det/semidet code which
-			% succeeded.
-			%
-		call_node_from_id(Store, CallId, Call),
-		NestedStartId = Call ^ call_preceding,
-		missing_answer_children(Store, NodeId, NestedStartId, Ns0, Ns1)
-	;
-		Node = neg_fail(Prec, NestedStartId)
-	->
-			%
-			% There is a nested context.  Neg_fail events can be
-			% reached here if there were events missing due to a
-			% parent being shallow traced.  In this case, we can't
-			% tell whether the call was in a negated context or
-			% backtracked over, so we have to assume the former.
-			%
-		wrong_answer_children(Store, Prec, NestedStartId, Ns0, Ns1)
-	;
-		( Node = else(Prec, NestedStartId)
-		; Node = neg_succ(Prec, NestedStartId)
-		)
-	->
-			%
-			% There is a nested context.
-			%
-		missing_answer_children(Store, Prec, NestedStartId, Ns0, Ns1)
-	;
-			%
-			% This handles the following cases:
-			% redo, switch, first_disj, later_disj, and
-			% then.  Also handles cond when the status is
-			% anything other than failed.
-			%
-			% Redo events can be reached here if there
-			% were missing events due to a shallow tracing.
-			% In this case, we have to scan over the entire
-			% previous contour, since there is no way to
-			% tell how much of it was backtracked over.
-			%
-		Ns1 = Ns0
-	),
-	Next = step_left_in_contour(Store, Node),
-	wrong_answer_children(Store, Next, StartId, Ns1, Ns).
-
-:- pred missing_answer_children(S, R, R, list(edt_node(R)), list(edt_node(R)))
-		<= annotated_trace(S, R).
-:- mode missing_answer_children(in, in, in, in, out) is det.
-
-missing_answer_children(Store, NodeId, StartId, Ns0, Ns) :-
-	(
-		NodeId = StartId
-	->
-		Ns = Ns0
-	;
-		missing_answer_children_2(Store, NodeId, StartId, Ns0, Ns)
-	).
-
-:- pred missing_answer_children_2(S, R, R, list(edt_node(R)), list(edt_node(R)))
-	<= annotated_trace(S, R).
-:- mode missing_answer_children_2(in, in, in, in, out) is det.
-
-missing_answer_children_2(Store, NodeId, StartId, Ns0, Ns) :-
-	det_trace_node_from_id(Store, NodeId, Node),
-	(
-		( Node = call(_, _, _, _, _, _, _, _, _)
-		; Node = neg(_, _, _)
-		; Node = cond(_, _, failed)
-		)
-	->
-		error("missing_answer_children_2: unexpected start of contour")
-	;
-		Node = excp(_, _, _, _, _)
-	->
-		error("missing_answer_children_2: exception handling not supported")
-	;
-		( Node = exit(_, _, _, _, _, _)
-		; Node = fail(_, _, _, _)
-		)
-	->
-			%
-			% Add a child for this node.
-			%
-		Ns1 = [dynamic(NodeId) | Ns0]
-	;
-		Node = neg_fail(Prec, NestedStartId)
-	->
-			%
-			% There is a nested successful context.
-			%
-		wrong_answer_children(Store, Prec, NestedStartId, Ns0, Ns1)
-	;
-		( Node = else(Prec, NestedStartId)
-		; Node = neg_succ(Prec, NestedStartId)
-		)
-	->
-			%
-			% There is a nested failed context.
-			%
-		missing_answer_children(Store, Prec, NestedStartId, Ns0, Ns1)
-	;
-			%
-			% This handles the following cases:
-			% redo, switch, first_disj, later_disj and
-			% then.  Also handles cond when the status
-			% is anything other than failed.
-			%
-		Ns1 = Ns0
-	),
-	Next = step_in_stratum(Store, Node),
-	missing_answer_children(Store, Next, StartId, Ns1, Ns).
-
-:- pred unexpected_exception_children(S, R, R, list(edt_node(R)),
-		list(edt_node(R))) <= annotated_trace(S, R).
-:- mode unexpected_exception_children(in, in, in, in, out) is det.
-
-unexpected_exception_children(Store, NodeId, StartId, Ns0, Ns) :-
-	(
-		NodeId = StartId
-	->
-		Ns = Ns0
-	;
-		unexpected_exception_children_2(Store, NodeId, StartId, Ns0, Ns)
-	).
-
-:- pred unexpected_exception_children_2(S, R, R, list(edt_node(R)),
-	list(edt_node(R))) <= annotated_trace(S, R).
-:- mode unexpected_exception_children_2(in, in, in, in, out) is det.
-
-unexpected_exception_children_2(Store, NodeId, StartId, Ns0, Ns) :-
-	det_trace_node_from_id(Store, NodeId, Node),
-	(
-		( Node = call(_, _, _, _, _, _, _, _, _)
-		; Node = neg(_, _, failed)
-		; Node = cond(_, _, failed)
-		)
-	->
-		error("unexpected_exception_children_2: unexpected start of contour")
-	;
-		( Node = exit(_, _, _, _, _, _)
-		; Node = excp(_, _, _, _, _)
-		)
-	->
-			%
-			% Add a child for this node.
-			%
-		Ns1 = [dynamic(NodeId) | Ns0]
-	;
-		Node = fail(_, CallId, _, _)
-	->
-			%
-			% Fail events can be reached here if there
-			% were events missing due to a parent being
-			% shallow traced.  In this case, we can't tell
-			% whether the call was in a negated context
-			% or backtracked over, so we have to assume
-			% the former.
-			%
-			% Fail events can also be reached here if the
-			% parent was a variant of solutions/2.
-			%
-			% If this really is in a negated context, the start of
-			% the context would be just before the entry to this
-			% failed call, modulo any det/semidet code which
-			% succeeded.
-			%
-		call_node_from_id(Store, CallId, Call),
-		NestedStartId = Call ^ call_preceding,
-		missing_answer_children(Store, NodeId, NestedStartId, Ns0, Ns1)
-	;
-		Node = neg_fail(Prec, NestedStartId)
-	->
-			%
-			% There is a nested context.  Neg_fail events can be
-			% reached here if there were events missing due to a
-			% parent being shallow traced.  In this case, we can't
-			% tell whether the call was in a negated context or
-			% backtracked over, so we have to assume the former.
-			%
-		wrong_answer_children(Store, Prec, NestedStartId, Ns0, Ns1)
-	;
-		( Node = else(Prec, NestedStartId)
-		; Node = neg_succ(Prec, NestedStartId)
-		)
-	->
-			%
-			% There is a nested context.
-			%
-		missing_answer_children(Store, Prec, NestedStartId, Ns0, Ns1)
-	;
-			%
-			% This handles the following cases:
-			% redo, switch, first_disj, later_disj, and
-			% then.  Also handles neg and cond when the
-			% status is anything other than failed.
-			%
-			% Redo events can be reached here if there
-			% were missing events due to a shallow tracing.
-			% In this case, we have to scan over the entire
-			% previous contour, since there is no way to
-			% tell how much of it was backtracked over.
-			%
-		Ns1 = Ns0
-	),
-	Next = step_left_in_contour(Store, Node),
-	unexpected_exception_children(Store, Next, StartId, Ns1, Ns).
-
-%-----------------------------------------------------------------------------%
-%
-% Tracking a subterm dependency.
-%
-% We are given an EDT node, an argument position, and a path to the selected
-% subterm.  We wish to find the origin of that subterm within the body of the
-% given node, or within the body of its parent.  We can figure out the mode of
-% the top of the selected subterm.
-%
-% If the mode is `in', the origin could be:
-%	- a primitive (unification of foreign_proc) within the body of the
-%	  parent,
-%	- an output subterm in a sibling node, or
-%	- an input subterm of the parent node.
-% In this case we look at the contour leading up to the call event associated
-% with the given node. This contour will be wholly within the parent call.
-%
-% If the mode is `out', the origin could be:
-%	- a primitive (unification or foreign_proc) within the body of the
-%	  call,
-%	- an output subterm of a child of the node, or
-%	- an input subterm of the node itself.
-% In this case we look at the contour leading up to the exit or exception event
-% associated with the given node. This contour will be wholly within the
-% current call.
-%
-% Our algorithm for finding the origin has three phases.
-%
-% In the first phase, we materialize a list of the nodes in the contour.
-%
-% In the second phase, we use this list of nodes to construct a list of the
-% primitive goals along that contour in the body of the relevant procedure,
-% leading up to either the call event (if subterm_mode is `in') or the exit
-% event (if subterm_mode is `out').
-%
-% In the third phase, we traverse the list of primitive goals backwards, from
-% the most recently executed primitive to the earliest one, keeping track of
-% the variable which contains the selected subterm, and the location within
-% this variable.
-
-:- type dependency_chain_start(R)
-	--->	chain_start(
-			start_loc(R),
-			int,		% The argument number of the selected
-					% position in the full list of
-					% arguments, including the
-					% compiler-generated ones.
-			R,		% The id of the node preceding the exit
-					% node, if start_loc is cur_goal
-					% and the id of the node preceding the
-					% call node if start_loc is
-					% parent_goal.
-			maybe(goal_path),
-					% No if start_loc is cur_goal;
-					% and yes wrapped around the goal path
-					% of the call in the parent procedure
-					% if start_loc is parent_goal.
-			maybe(proc_rep)	% The body of the procedure indicated
-					% by start_loc.
-		).
-
-:- type start_loc(R)
-	--->	cur_goal
-	;	parent_goal(R, trace_node(R)).
-
-:- type goal_and_path	--->	goal_and_path(goal_rep, goal_path).
-
-:- type goal_and_path_list ==	list(goal_and_path).
-
-:- type annotated_primitive(R)
-	--->	primitive(
-			string,		% filename
-			int,		% line number
-			list(var_rep),	% vars bound by the atomic goal
-			atomic_goal_rep,% the atomic goal itself
-			goal_path,	% its goal path
-			maybe(R)
-					% if the atomic goal is a call,
-					% the id of the call's exit event
-		).
-
-:- pred trace_dependency(wrap(S)::in, edt_node(R)::in,
-	arg_pos::in, term_path::in, subterm_mode::out,
-	subterm_origin(edt_node(R))::out) is det <= annotated_trace(S, R).
-
-trace_dependency(wrap(Store), dynamic(Ref), ArgPos, TermPath, Mode, Origin) :-
-	find_chain_start(Store, Ref, ArgPos, TermPath, ChainStart),
-	ChainStart = chain_start(StartLoc, ArgNum, NodeId, StartPath,
-		MaybeProcRep),
-	Mode = start_loc_to_subterm_mode(StartLoc),
-	(
-		MaybeProcRep = no,
-		Origin = not_found
-	;
-		MaybeProcRep = yes(ProcRep),
-		det_trace_node_from_id(Store, NodeId, Node),
-		materialize_contour(Store, NodeId, Node, [], Contour0),
-		(
-			StartLoc = parent_goal(CallId, CallNode),
-			Contour = list__append(Contour0, [CallId - CallNode])
-		;
-			StartLoc = cur_goal,
-			Contour = Contour0
-		),
-		ProcRep = proc_rep(HeadVars, GoalRep),
-		make_primitive_list(Store, [goal_and_path(GoalRep, [])],
-			Contour, StartPath, ArgNum, HeadVars, Var,
-			[], Primitives),
-		traverse_primitives(Primitives, Var, TermPath,
-			Store, ProcRep, Origin)
-	).
-
-:- pred find_chain_start(S::in, R::in, arg_pos::in, term_path::in,
-	dependency_chain_start(R)::out) is det <= annotated_trace(S, R).
-
-find_chain_start(Store, Ref, ArgPos, TermPath, ChainStart) :-
-	det_edt_return_node_from_id(Store, Ref, Node),
-	(
-		Node = exit(_, CallId, _, ExitAtom, _, _),
-		call_node_from_id(Store, CallId, CallNode),
-		CallAtom = CallNode ^ call_atom,
-		( trace_atom_subterm_is_ground(CallAtom, ArgPos, TermPath) ->
-			find_chain_start_inside(Store, CallId, CallNode,
-				ArgPos, ChainStart)
-		; trace_atom_subterm_is_ground(ExitAtom, ArgPos, TermPath) ->
-			find_chain_start_outside(CallNode, Node, ArgPos,
-				ChainStart)
-		;
-			error("find_chain_start: unbound wrong answer term")
-		)
-	;
-		Node = fail(_, CallId, _, _),
-		call_node_from_id(Store, CallId, CallNode),
-		CallAtom = CallNode ^ call_atom,
-		( trace_atom_subterm_is_ground(CallAtom, ArgPos, TermPath) ->
-			find_chain_start_inside(Store, CallId, CallNode,
-				ArgPos, ChainStart)
-		;
-			error("find_chain_start: unbound missing answer term")
-		)
-	;
-		Node = excp(_, CallId, _, _, _),
-		call_node_from_id(Store, CallId, CallNode),
-		CallAtom = CallNode ^ call_atom,
-		%
-		% XXX we don't yet handle tracking of the exception value.
-		%
-		( trace_atom_subterm_is_ground(CallAtom, ArgPos, TermPath) ->
-			find_chain_start_inside(Store, CallId, CallNode,
-				ArgPos, ChainStart)
-		;
-			error("find_chain_start: unbound exception term")
-		)
-	).
-
-:- pred find_chain_start_inside(S::in, R::in,
-	trace_node(R)::in(trace_node_call), arg_pos::in,
-	dependency_chain_start(R)::out) is det <= annotated_trace(S, R).
-
-find_chain_start_inside(Store, CallId, CallNode, ArgPos, ChainStart) :-
-	CallPrecId = CallNode ^ call_preceding,
-	CallAtom = CallNode ^ call_atom,
-	CallPathStr = CallNode ^ call_goal_path,
-	path_from_string_det(CallPathStr, CallPath),
-	StartLoc = parent_goal(CallId, CallNode),
-	absolute_arg_num(ArgPos, CallAtom, ArgNum),
-	StartId = CallPrecId,
-	StartPath = yes(CallPath),
-	parent_proc_rep(Store, CallId, StartRep),
-	ChainStart = chain_start(StartLoc, ArgNum, StartId, StartPath,
-		StartRep).
-
-:- pred find_chain_start_outside(trace_node(R)::in(trace_node_call),
-	trace_node(R)::in(trace_node_exit), arg_pos::in,
-	dependency_chain_start(R)::out) is det.
-
-find_chain_start_outside(CallNode, ExitNode, ArgPos, ChainStart) :-
-	StartLoc = cur_goal,
-	ExitAtom = ExitNode ^ exit_atom,
-	absolute_arg_num(ArgPos, ExitAtom, ArgNum),
-	StartId = ExitNode ^ exit_preceding,
-	StartPath = no,
-	StartRep = CallNode ^ call_proc_rep,
-	ChainStart = chain_start(StartLoc, ArgNum, StartId,
-		StartPath, StartRep).
-
-:- pred parent_proc_rep(S::in, R::in, maybe(proc_rep)::out)
-	is det <= annotated_trace(S, R).
-
-parent_proc_rep(Store, CallId, ProcRep) :-
-	call_node_from_id(Store, CallId, Call),
-	CallPrecId = Call ^ call_preceding,
-	( trace_node_from_id(Store, CallPrecId, CallPrecNode) ->
-		step_left_to_call(Store, CallPrecNode, ParentCallNode),
-		ProcRep = ParentCallNode ^ call_proc_rep
-	;
-		% The parent call is outside the annotated trace.
-		ProcRep = no
-	).
-
-:- pred step_left_to_call(S::in, trace_node(R)::in,
-	trace_node(R)::out(trace_node_call)) is det <= annotated_trace(S, R).
-
-step_left_to_call(Store, Node, ParentCallNode) :-
-	( Node = call(_, _, _, _, _, _, _, _, _) ->
-		ParentCallNode = Node
-	;
-		( Node = neg(NegPrec, _, _) ->
-			PrevNodeId = NegPrec
-		;
-			PrevNodeId = step_left_in_contour(Store, Node)
-		),
-		det_trace_node_from_id(Store, PrevNodeId, PrevNode),
-		step_left_to_call(Store, PrevNode, ParentCallNode)
-	).
-
-:- pred materialize_contour(S::in, R::in, trace_node(R)::in,
-	assoc_list(R, trace_node(R))::in, assoc_list(R, trace_node(R))::out)
-	is det <= annotated_trace(S, R).
-
-materialize_contour(Store, NodeId, Node, Nodes0, Nodes) :-
-	( Node = call(_, _, _, _, _, _, _, _, _) ->
-		Nodes = Nodes0
-	;
-		( Node = neg(NegPrec, _, _) ->
-			PrevNodeId = NegPrec
-		;
-			PrevNodeId = step_left_in_contour(Store, Node)
-		),
-		det_trace_node_from_id(Store, PrevNodeId, PrevNode),
-		( Node = then(_, _) ->
-			% The cond node is enough to tell us which way the
-			% if-then-else went; the then node would just
-			% complicate the job of make_primitive_list.
-			Nodes1 = Nodes0
-		;
-			Nodes1 = [NodeId - Node | Nodes0]
-		),
-		materialize_contour(Store, PrevNodeId, PrevNode,
-			Nodes1, Nodes)
-	).
-
-:- pred make_primitive_list(S::in, goal_and_path_list::in,
-	assoc_list(R, trace_node(R))::in, maybe(goal_path)::in,
-	int::in, list(var_rep)::in, var_rep::out,
-	list(annotated_primitive(R))::in, list(annotated_primitive(R))::out)
-	is det <= annotated_trace(S, R).
-
-make_primitive_list(Store, [goal_and_path(Goal, Path) | GoalPaths],
-		Contour, MaybeEnd, ArgNum, HeadVars, Var,
-		Primitives0, Primitives) :-
-	(
-		Goal = conj_rep(Conjs),
-		add_paths_to_conjuncts(Conjs, Path, 1, ConjPaths),
-		make_primitive_list(Store, list__append(ConjPaths, GoalPaths),
-			Contour, MaybeEnd, ArgNum, HeadVars, Var,
-			Primitives0, Primitives)
-	;
-		Goal = disj_rep(Disjs),
-		(
-			Contour = [_ - ContourHeadNode | ContourTail],
-			( ContourHeadNode = first_disj(_, DisjPathStr)
-			; ContourHeadNode = later_disj(_, DisjPathStr, _)
-			),
-			path_from_string_det(DisjPathStr, DisjPath),
-			list__append(Path, PathTail, DisjPath),
-			PathTail = [disj(N)]
-		->
-			list__index1_det(Disjs, N, Disj),
-			DisjAndPath = goal_and_path(Disj, DisjPath),
-			make_primitive_list(Store, [DisjAndPath | GoalPaths],
-				ContourTail, MaybeEnd, ArgNum, HeadVars, Var,
-				Primitives0, Primitives)
-		;
-			error("make_primitive_list: mismatch on disj")
-		)
-	;
-		Goal = switch_rep(Arms),
-		(
-			Contour = [_ - ContourHeadNode | ContourTail],
-			ContourHeadNode = switch(_, ArmPathStr),
-			path_from_string_det(ArmPathStr, ArmPath),
-			list__append(Path, PathTail, ArmPath),
-			PathTail = [switch(N)]
-		->
-			list__index1_det(Arms, N, Arm),
-			ArmAndPath = goal_and_path(Arm, ArmPath),
-			make_primitive_list(Store, [ArmAndPath | GoalPaths],
-				ContourTail, MaybeEnd, ArgNum, HeadVars, Var,
-				Primitives0, Primitives)
-		;
-			error("make_primitive_list: mismatch on switch")
-		)
-	;
-		Goal = ite_rep(Cond, Then, Else),
-		(
-			Contour = [_ - ContourHeadNode | ContourTail],
-			ContourHeadNode = cond(_, CondPathStr, _),
-			path_from_string_det(CondPathStr, CondPath),
-			list__append(Path, PathTail, CondPath),
-			PathTail = [ite_cond]
-		->
-			ThenPath = list__append(Path, [ite_then]),
-			CondAndPath = goal_and_path(Cond, CondPath),
-			ThenAndPath = goal_and_path(Then, ThenPath),
-			make_primitive_list(Store,
-				[CondAndPath, ThenAndPath | GoalPaths],
-				ContourTail, MaybeEnd, ArgNum, HeadVars, Var,
-				Primitives0, Primitives)
-		;
-			Contour = [_ - ContourHeadNode | ContourTail],
-			ContourHeadNode = else(_, ElseCondId),
-			cond_node_from_id(Store, ElseCondId, CondNode),
-			CondNode = cond(_, CondPathStr, _),
-			path_from_string_det(CondPathStr, CondPath),
-			list__append(Path, PathTail, CondPath),
-			PathTail = [ite_cond]
-		->
-			ElsePath = list__append(Path, [ite_else]),
-			ElseAndPath = goal_and_path(Else, ElsePath),
-			make_primitive_list(Store, [ElseAndPath | GoalPaths],
-				ContourTail, MaybeEnd, ArgNum, HeadVars, Var,
-				Primitives0, Primitives)
-		;
-			error("make_primitive_list: mismatch on if-then-else")
-		)
-	;
-		Goal = negation_rep(NegGoal),
-		(
-			Contour = [_ - ContourHeadNode | ContourTail],
-			ContourHeadNode = neg_succ(_, _)
-		->
-			% The negated goal cannot contribute any bindings.
-			make_primitive_list(Store, GoalPaths,
-				ContourTail, MaybeEnd, ArgNum, HeadVars, Var,
-				Primitives0, Primitives)
-		;
-			Contour = [_ - ContourHeadNode | ContourTail],
-			ContourHeadNode = neg(_, _, _)
-		->
-			% The end of the primitive list is somewhere inside
-			% NegGoal.
-			NegPath = list__append(Path, [neg]),
-			NegAndPath = goal_and_path(NegGoal, NegPath),
-			make_primitive_list(Store, [NegAndPath],
-				ContourTail, MaybeEnd, ArgNum, HeadVars, Var,
-				Primitives0, Primitives)
-		;
-			error("make_primitive_list: mismatch on negation")
-		)
-	;
-		Goal = some_rep(InnerGoal, MaybeCut),
-		InnerPath = list__append(Path, [exist(MaybeCut)]),
-		InnerAndPath = goal_and_path(InnerGoal, InnerPath),
-		make_primitive_list(Store, [InnerAndPath | GoalPaths],
-			Contour, MaybeEnd, ArgNum, HeadVars, Var,
-			Primitives0, Primitives)
-	;
-		Goal = atomic_goal_rep(_, File, Line, BoundVars, AtomicGoal),
-		GeneratesEvent = atomic_goal_generates_event(AtomicGoal),
-		(
-			GeneratesEvent = yes(Args),
-			(
-				Contour = [ContourHeadId - ContourHeadNode
-					| ContourTail],
-				CallId = ContourHeadNode ^ exit_call,
-				call_node_from_id(Store, CallId, CallNode),
-				CallPathStr = CallNode ^ call_goal_path,
-				path_from_string_det(CallPathStr, CallPath),
-				CallPath = Path,
-				\+ (
-					MaybeEnd = yes(EndPath),
-					EndPath = Path
-				)
-			->
-				Primitive = primitive(File, Line, BoundVars,
-					AtomicGoal, Path, yes(ContourHeadId)),
-				Primitives1 = [Primitive | Primitives0],
-				make_primitive_list(Store, GoalPaths,
-					ContourTail, MaybeEnd, ArgNum,
-					HeadVars, Var, Primitives1, Primitives)
-			;
-				Contour = [_ContourHeadId - ContourHeadNode],
-				CallPathStr = ContourHeadNode ^ call_goal_path,
-				path_from_string_det(CallPathStr, CallPath),
-				CallPath = Path,
-				MaybeEnd = yes(EndPath),
-				EndPath = Path
-			->
-				list__index1_det(Args, ArgNum, Var),
-				Primitives = Primitives0
-			;
-				error("make_primitive_list: mismatch on call")
-			)
-		;
-			GeneratesEvent = no,
-			Primitive = primitive(File, Line, BoundVars,
-				AtomicGoal, Path, no),
-			Primitives1 = [Primitive | Primitives0],
-			make_primitive_list(Store, GoalPaths,
-				Contour, MaybeEnd, ArgNum, HeadVars, Var,
-				Primitives1, Primitives)
-		)
-	).
-make_primitive_list(_, [], Contour, MaybeEnd, ArgNum, HeadVars, Var,
-		Primitives, Primitives) :-
-	require(unify(Contour, []),
-		"make_primitive_list: nonempty contour at end"),
-	require(unify(MaybeEnd, no),
-		"make_primitive_list: found end when looking for call"),
-	list__index1_det(HeadVars, ArgNum, Var).
-
-:- pred traverse_primitives(list(annotated_primitive(R))::in,
-	var_rep::in, term_path::in, S::in, proc_rep::in,
-	subterm_origin(edt_node(R))::out) is det <= annotated_trace(S, R).
-
-traverse_primitives([], Var0, TermPath0, _, ProcRep, Origin) :-
-	ProcRep = proc_rep(HeadVars, _),
-	ArgPos = find_arg_pos(HeadVars, Var0),
-	Origin = input(ArgPos, TermPath0).
-traverse_primitives([Prim | Prims], Var0, TermPath0, Store, ProcRep,
-		Origin) :-
-	Prim = primitive(File, Line, BoundVars, AtomicGoal, _GoalPath,
-		MaybeNodeId),
-	(
-		AtomicGoal = unify_construct_rep(_CellVar, _Cons, FieldVars),
-		( list__member(Var0, BoundVars) ->
-			(
-				TermPath0 = [],
-				Origin = primitive_op(File, Line)
-			;
-				TermPath0 = [TermPathStep0 | TermPath],
-				list__index1_det(FieldVars, TermPathStep0,
-					Var),
-				traverse_primitives(Prims, Var, TermPath,
-					Store, ProcRep, Origin)
-			)
-		;
-			traverse_primitives(Prims, Var0, TermPath0,
-				Store, ProcRep, Origin)
-		)
-	;
-		AtomicGoal = unify_deconstruct_rep(CellVar, _Cons, FieldVars),
-		( list__member(Var0, BoundVars) ->
-			( list__nth_member_search(FieldVars, Var0, Pos) ->
-				traverse_primitives(Prims,
-					CellVar, [Pos | TermPath0],
-					Store, ProcRep, Origin)
-			;
-				error("traverse_primitives: bad deconstruct")
-			)
-		;
-			traverse_primitives(Prims, Var0, TermPath0,
-				Store, ProcRep, Origin)
-		)
-	;
-		AtomicGoal = unify_assign_rep(ToVar, FromVar),
-		( list__member(Var0, BoundVars) ->
-			require(unify(Var0, ToVar),
-				"traverse_primitives: bad assign"),
-			traverse_primitives(Prims, FromVar, TermPath0,
-				Store, ProcRep, Origin)
-		;
-			traverse_primitives(Prims, Var0, TermPath0,
-				Store, ProcRep, Origin)
-		)
-	;
-		AtomicGoal = pragma_foreign_code_rep(_Args),
-		( list__member(Var0, BoundVars) ->
-			Origin = primitive_op(File, Line)
-		;
-			traverse_primitives(Prims, Var0, TermPath0,
-				Store, ProcRep, Origin)
-		)
-	;
-		AtomicGoal = unify_simple_test_rep(_LVar, _RVar),
-		( list__member(Var0, BoundVars) ->
-			error("traverse_primitives: bad test")
-		;
-			traverse_primitives(Prims, Var0, TermPath0,
-				Store, ProcRep, Origin)
-		)
-	;
-		AtomicGoal = higher_order_call_rep(_, Args),
-		traverse_call(BoundVars, no, Args, MaybeNodeId, Prims,
-			Var0, TermPath0, Store, ProcRep, Origin)
-	;
-		AtomicGoal = method_call_rep(_, _, Args),
-		traverse_call(BoundVars, no, Args, MaybeNodeId, Prims,
-			Var0, TermPath0, Store, ProcRep, Origin)
-	;
-		AtomicGoal = plain_call_rep(ModuleName, PredName, Args),
-		PlainCallInfo = plain_call_info(File, Line,
-			ModuleName, PredName),
-		traverse_call(BoundVars, yes(PlainCallInfo), Args, MaybeNodeId,
-			Prims, Var0, TermPath0, Store, ProcRep, Origin)
-	).
-
-:- type plain_call_info
-	--->	plain_call_info(
-			file_name	:: string,
-			line_number	:: int,
-			module_name	:: string,
-			pred_name	:: string
-		).
-
-:- pred traverse_call(list(var_rep)::in, maybe(plain_call_info)::in,
-	list(var_rep)::in, maybe(R)::in,
-	list(annotated_primitive(R))::in, var_rep::in, term_path::in,
-	S::in, proc_rep::in, subterm_origin(edt_node(R))::out) is det
-	<= annotated_trace(S, R).
-
-traverse_call(BoundVars, MaybePlainCallInfo, Args, MaybeNodeId,
-		Prims, Var, TermPath, Store, ProcRep, Origin) :-
-	( list__member(Var, BoundVars) ->
-		Pos = find_arg_pos(Args, Var),
-		(
-			MaybeNodeId = yes(NodeId),
-			Origin = output(dynamic(NodeId), Pos, TermPath)
-		;
-			MaybeNodeId = no,
-			(
-				MaybePlainCallInfo = yes(PlainCallInfo),
-				PlainCallInfo = plain_call_info(File, Line,
-					ModuleName, PredName),
-				call_is_primitive(ModuleName, PredName)
-			->
-				Origin = primitive_op(File, Line)
-			;
-				error("traverse_call: no node id")
-			)
-		)
-	;
-		traverse_primitives(Prims, Var, TermPath, Store, ProcRep,
-			Origin)
-	).
-
-%-----------------------------------------------------------------------------%
-
-:- pred add_paths_to_conjuncts(list(goal_rep)::in, goal_path::in, int::in,
-	goal_and_path_list::out) is det.
-
-add_paths_to_conjuncts([], _, _, []).
-add_paths_to_conjuncts([Goal | Goals], ParentPath, N,
-		[goal_and_path(Goal, Path) | GoalAndPaths]) :-
-	list__append(ParentPath, [conj(N)], Path),
-	add_paths_to_conjuncts(Goals, ParentPath, N + 1, GoalAndPaths).
-
-%-----------------------------------------------------------------------------%
-
-:- func start_loc_to_subterm_mode(start_loc(R)) = subterm_mode.
-
-start_loc_to_subterm_mode(cur_goal) = subterm_out.
-start_loc_to_subterm_mode(parent_goal(_, _)) = subterm_in.
-
-%-----------------------------------------------------------------------------%
-
-:- func find_arg_pos(list(var_rep), var_rep) = arg_pos.
-
-find_arg_pos(HeadVars, Var) = ArgPos :-
-	find_arg_pos_2(HeadVars, Var, 1, ArgPos).
-
-:- pred find_arg_pos_2(list(var_rep)::in, var_rep::in, int::in, arg_pos::out)
-	is det.
-
-find_arg_pos_2([], _, _, _) :-
-	error("find_arg_pos_2: empty list").
-find_arg_pos_2([HeadVar | HeadVars], Var, Pos, ArgPos) :-
-	( HeadVar = Var ->
-		ArgPos = any_head_var(Pos)
-	;
-		find_arg_pos_2(HeadVars, Var, Pos + 1, ArgPos)
-	).
-
-%-----------------------------------------------------------------------------%
-
-:- pred edt_subtree_details(S, edt_node(R), event_number, sequence_number)
-		<= annotated_trace(S, R).
-:- mode edt_subtree_details(in, in, out, out) is det.
-
-edt_subtree_details(Store, dynamic(Ref), Event, SeqNo) :-
-	det_edt_return_node_from_id(Store, Ref, Node),
-	(
-		Node = exit(_, Call, _, _, Event, _)
-	;
-		Node = fail(_, Call, _, Event)
-	;
-		Node = excp(_, Call, _, _, Event)
-	),
-	call_node_from_id(Store, Call, CallNode),
-	SeqNo = CallNode ^ call_seq.
-
-:- inst edt_return_node =
-		bound(	exit(ground, ground, ground, ground, ground, ground)
-		;	fail(ground, ground, ground, ground)
-		;	excp(ground, ground, ground, ground, ground)).
-
-:- pred det_edt_return_node_from_id(S::in, R::in,
-	trace_node(R)::out(edt_return_node)) is det <= annotated_trace(S, R).
-
-det_edt_return_node_from_id(Store, Ref, Node) :-
-	(
-		trace_node_from_id(Store, Ref, Node0),
-		(
-			Node0 = exit(_, _, _, _, _, _)
-		;
-			Node0 = fail(_, _, _, _)
-		;
-			Node0 = excp(_, _, _, _, _)
-		)
-	->
-		Node = Node0
-	;
-		error("det_edt_return_node_from_id: not a return node")
-	).
-
-%-----------------------------------------------------------------------------%
-
-:- pred trace_atom_subterm_is_ground(trace_atom, arg_pos, term_path).
-:- mode trace_atom_subterm_is_ground(in, in, in) is semidet.
-
-trace_atom_subterm_is_ground(atom(_, _, Args), ArgPos, _) :-
-	select_arg_at_pos(ArgPos, Args, ArgInfo),
-	ArgInfo = arg_info(_, _, MaybeArg),
-	MaybeArg = yes(_).
 
 :- pred decl_bug_get_event_number(decl_bug, event_number).
 :- mode decl_bug_get_event_number(in, out) is det.
Index: browser/declarative_execution.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_execution.m,v
retrieving revision 1.20
diff -u -r1.20 declarative_execution.m
--- browser/declarative_execution.m	22 Jul 2002 07:12:54 -0000	1.20
+++ browser/declarative_execution.m	8 Sep 2002 18:01:03 -0000
@@ -345,7 +345,8 @@
 %-----------------------------------------------------------------------------%
 
 :- implementation.
-:- import_module int, map, require, store.
+:- import_module mdb__declarative_debugger.
+:- import_module int, map, exception, store.
 
 %-----------------------------------------------------------------------------%
 
@@ -363,7 +364,8 @@
 	(
 		Status = failed
 	->
-		error("step_left_in_contour: failed COND node")
+		throw(internal_error("step_left_in_contour",
+			"failed COND node"))
 	;
 		Node = Prec
 	).
@@ -377,7 +379,7 @@
 	% where we cannot step any further.
 	%
 step_left_in_contour(_, call(_, _, _, _, _, _, _, _, _)) = _ :-
-	error("step_left_in_contour: unexpected CALL node").
+	throw(internal_error("step_left_in_contour", "unexpected CALL node")).
 step_left_in_contour(_, neg(Prec, _, Status)) = Next :-
 	(
 		Status = undecided
@@ -389,7 +391,8 @@
 			%
 		Next = Prec
 	;
-		error("step_left_in_contour: unexpected NEGE node")
+		throw(internal_error("step_left_in_contour",
+			"unexpected NEGE node"))
 	).
 	%
 	% In the remaining cases we have reached a dead end, so we
@@ -430,11 +433,11 @@
 	% so there are no previous contours in the same stratum.
 	%
 find_prev_contour(_, call(_, _, _, _, _, _, _, _, _), _) :-
-	error("find_prev_contour: reached CALL node").
+	throw(internal_error("find_prev_contour", "reached CALL node")).
 find_prev_contour(_, cond(_, _, _), _) :-
-	error("find_prev_contour: reached COND node").
+	throw(internal_error("find_prev_contour", "reached COND node")).
 find_prev_contour(_, neg(_, _, _), _) :-
-	error("find_prev_contour: reached NEGE node").
+	throw(internal_error("find_prev_contour", "reached NEGE node")).
 
 step_in_stratum(Store, exit(_, Call, MaybeRedo, _, _, _)) =
 	step_over_redo_or_call(Store, Call, MaybeRedo).
@@ -452,7 +455,7 @@
 	(
 		Status = failed
 	->
-		error("step_in_stratum: failed COND node")
+		throw(internal_error("step_in_stratum", "failed COND node"))
 	;
 		Next = Prec
 	).
@@ -468,9 +471,9 @@
 	% so we cannot step any further.
 	%
 step_in_stratum(_, call(_, _, _, _, _, _, _, _, _)) = _ :-
-	error("step_in_stratum: unexpected CALL node").
+	throw(internal_error("step_in_stratum", "unexpected CALL node")).
 step_in_stratum(_, neg(_, _, _)) = _ :-
-	error("step_in_stratum: unexpected NEGE node").
+	throw(internal_error("step_in_stratum", "unexpected NEGE node")).
 
 :- func step_over_redo_or_call(S, R, R) = R <= annotated_trace(S, R).
 
@@ -490,7 +493,7 @@
 	->
 		Node = Node0
 	;
-		error("det_trace_node_from_id: NULL node id")
+		throw(internal_error("det_trace_node_from_id", "NULL node id"))
 	).
 
 call_node_from_id(Store, NodeId, Node) :-
@@ -500,7 +503,7 @@
 	->
 		Node = Node0
 	;
-		error("call_node_from_id: not a CALL node")
+		throw(internal_error("call_node_from_id", "not a CALL node"))
 	).
 
 maybe_redo_node_from_id(Store, NodeId, Node) :-
@@ -510,7 +513,8 @@
 	->
 		Node = Node0
 	;
-		error("maybe_redo_node_from_id: not a REDO node or NULL")
+		throw(internal_error("maybe_redo_node_from_id",
+			"not a REDO node or NULL"))
 	).
 
 exit_node_from_id(Store, NodeId, Node) :-
@@ -520,7 +524,7 @@
 	->
 		Node = Node0
 	;
-		error("exit_node_from_id: not an EXIT node")
+		throw(internal_error("exit_node_from_id", "not an EXIT node"))
 	).
 
 cond_node_from_id(Store, NodeId, Node) :-
@@ -530,7 +534,7 @@
 	->
 		Node = Node0
 	;
-		error("cond_node_from_id: not a COND node")
+		throw(internal_error("cond_node_from_id", "not a COND node"))
 	).
 
 neg_node_from_id(Store, NodeId, Node) :-
@@ -540,7 +544,7 @@
 	->
 		Node = Node0
 	;
-		error("neg_node_from_id: not a NEG node")
+		throw(internal_error("neg_node_from_id", "not a NEG node"))
 	).
 
 first_disj_node_from_id(Store, NodeId, Node) :-
@@ -550,7 +554,8 @@
 	->
 		Node = Node0
 	;
-		error("first_disj_node_from_id: not a first DISJ node")
+		throw(internal_error("first_disj_node_from_id",
+			"not a first DISJ node"))
 	).
 
 disj_node_from_id(Store, NodeId, Node) :-
@@ -562,7 +567,8 @@
 	->
 		Node = Node0
 	;
-		error("disj_node_from_id: not a DISJ node")
+		throw(internal_error("disj_node_from_id",
+			"not a DISJ node"))
 	).
 
 %-----------------------------------------------------------------------------%
@@ -614,7 +620,8 @@
 	->
 		Last = Last0
 	;
-		error("call_node_get_last_interface: not a CALL node")
+		throw(internal_error("call_node_get_last_interface",
+			"not a CALL node"))
 	).
 
 :- func call_node_set_last_interface(trace_node(trace_node_id), trace_node_id)
@@ -629,7 +636,8 @@
 	->
 		Call1 = Call0
 	;
-		error("call_node_set_last_interface: not a CALL node")
+		throw(internal_error("call_node_set_last_interface",
+			"not a CALL node"))
 	),
 		% The last interface is the second field, so we pass 1
 		% (since argument numbers start from 0).
@@ -648,7 +656,7 @@
 	->
 		Cond1 = Cond0
 	;
-		error("cond_node_set_status: not a COND node")
+		throw(internal_error("cond_node_set_status", "not a COND node"))
 	),
 		% The goal status is the third field, so we pass 2
 		% (since argument numbers start from 0).
@@ -667,7 +675,7 @@
 	->
 		Neg1 = Neg0
 	;
-		error("neg_node_set_status: not a NEGE node")
+		throw(internal_error("neg_node_set_status", "not a NEGE node"))
 	),
 		% The goal status is the third field, so we pass 2
 		% (since argument numbers start from 0).
@@ -1039,20 +1047,20 @@
 		ResKey = ok(Key)
 	;
 		ResKey = eof,
-		error("load_trace_node_map: unexpected EOF")
+		throw(io_error("load_trace_node_map", "unexpected EOF"))
 	;
 		ResKey = error(Msg, _),
-		error(Msg)
+		throw(io_error("load_trace_node_map", Msg))
 	},
 	io__read(Stream, ResMap),
 	{
 		ResMap = ok(Map)
 	;
 		ResMap = eof,
-		error("load_trace_node_map: unexpected EOF")
+		throw(io_error("load_trace_node_map", "unexpected EOF"))
 	;
 		ResMap = error(Msg, _),
-		error(Msg)
+		throw(io_error("load_trace_node_map", Msg))
 	}.
 
 :- pragma export(save_trace_node_store(in, in, in, di, uo),
@@ -1153,7 +1161,8 @@
 	int::out) is det.
 
 head_var_num_to_arg_num([], _, _, _) :-
-	error("head_var_num_to_arg_num: nonexistent head_var_num").
+	throw(internal_error("head_var_num_to_arg_num",
+		"nonexistent head_var_num")).
 head_var_num_to_arg_num([Arg | Args], SearchUserHeadVarNum, CurArgNum,
 		ArgNum) :-
 	Arg = arg_info(UserVis, _, _),
Index: browser/declarative_oracle.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_oracle.m,v
retrieving revision 1.14
diff -u -r1.14 declarative_oracle.m
--- browser/declarative_oracle.m	15 May 2002 11:24:07 -0000	1.14
+++ browser/declarative_oracle.m	8 Sep 2002 16:43:06 -0000
@@ -65,7 +65,7 @@
 
 :- implementation.
 :- import_module mdb__declarative_user, mdb__tree234_cc, mdb__util.
-:- import_module bool, std_util, set, require.
+:- import_module bool, std_util, set.
 
 query_oracle(Questions, Response, Oracle0, Oracle) -->
 	{ get_oracle_kb(Oracle0, KB0) },
Index: browser/declarative_tree.m
===================================================================
RCS file: browser/declarative_tree.m
diff -N browser/declarative_tree.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ browser/declarative_tree.m	8 Sep 2002 18:10:29 -0000
@@ -0,0 +1,1078 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2002 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+% File: declarative_tree.m
+% Author: Mark Brown
+%
+% This module defines an instance of mercury_edt/2, the debugging tree.
+%
+%-----------------------------------------------------------------------------%
+
+:- module mdb__declarative_tree.
+:- interface.
+:- import_module mdb__declarative_analyser, mdb__declarative_execution.
+
+	% The type of nodes in our implementation of EDTs.  The parameter
+	% is meant to be the type of references to trace nodes.  In
+	% particular, the references should be to trace nodes that could
+	% be considered nodes in the EDT, namely those for exit, fail
+	% and exception events.
+	% 
+:- type edt_node(R)
+	--->	dynamic(R).
+
+:- instance mercury_edt(wrap(S), edt_node(R)) <= annotated_trace(S, R).
+
+	% The wrap/1 around the first argument of the instance is
+	% required by the language.
+	%
+:- type wrap(S) ---> wrap(S).
+
+:- pred edt_subtree_details(S, edt_node(R), event_number, sequence_number)
+		<= annotated_trace(S, R).
+:- mode edt_subtree_details(in, in, out, out) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+:- import_module mdb__declarative_debugger, mdb__io_action.
+:- import_module mdb__program_representation.
+:- import_module assoc_list, bool, exception, int, list, map, std_util.
+
+:- instance mercury_edt(wrap(S), edt_node(R)) <= annotated_trace(S, R)
+	where [
+		pred(edt_root_question/4) is trace_root_question,
+		pred(edt_root_e_bug/4) is trace_root_e_bug,
+		pred(edt_children/3) is trace_children,
+		pred(edt_dependency/6) is trace_dependency
+	].
+
+%-----------------------------------------------------------------------------%
+
+:- func exit_node_decl_atom(io_action_map::in, S::in,
+	trace_node(R)::in(trace_node_exit)) = (final_decl_atom::out) is det
+	<= annotated_trace(S, R).
+
+exit_node_decl_atom(IoActionMap, Store, ExitNode) = DeclAtom :-
+	ExitAtom = ExitNode ^ exit_atom,
+	CallId = ExitNode ^ exit_call,
+	call_node_from_id(Store, CallId, Call),
+	CallIoSeq = Call ^ call_io_seq_num,
+	ExitIoSeq = ExitNode ^ exit_io_seq_num,
+	IoActions = make_io_actions(IoActionMap, CallIoSeq, ExitIoSeq),
+	DeclAtom = final_decl_atom(ExitAtom, IoActions).
+
+:- func call_node_decl_atom(S, R) = init_decl_atom <= annotated_trace(S, R).
+
+call_node_decl_atom(Store, CallId) = DeclAtom :-
+	call_node_from_id(Store, CallId, CallNode),
+	CallAtom = CallNode ^ call_atom,
+	DeclAtom = init_decl_atom(CallAtom).
+
+:- func make_io_actions(io_action_map, int, int) = list(io_action).
+
+make_io_actions(IoActionMap, InitIoSeq, ExitIoSeq) =
+	( InitIoSeq = ExitIoSeq ->
+		[]
+	;
+		[map__lookup(IoActionMap, InitIoSeq) |
+			make_io_actions(IoActionMap, InitIoSeq + 1, ExitIoSeq)]
+	).
+
+%-----------------------------------------------------------------------------%
+
+:- pred trace_root_question(io_action_map::in, wrap(S)::in, edt_node(R)::in,
+	decl_question(edt_node(R))::out) is det <= annotated_trace(S, R).
+
+trace_root_question(IoActionMap, wrap(Store), dynamic(Ref), Root) :-
+	det_edt_return_node_from_id(Store, Ref, Node),
+	(
+		Node = fail(_, CallId, RedoId, _),
+		DeclAtom = call_node_decl_atom(Store, CallId),
+		get_answers(IoActionMap, Store, RedoId, [], Answers),
+		Root = missing_answer(dynamic(Ref), DeclAtom, Answers)
+	;
+		Node = exit(_, _, _, _, _, _),
+		DeclAtom = exit_node_decl_atom(IoActionMap, Store, Node),
+		Root = wrong_answer(dynamic(Ref), DeclAtom)
+	;
+		Node = excp(_, CallId, _, Exception, _),
+		DeclAtom = call_node_decl_atom(Store, CallId),
+		Root = unexpected_exception(dynamic(Ref), DeclAtom, Exception)
+	).
+
+:- pred get_answers(io_action_map::in, S::in, R::in,
+	list(final_decl_atom)::in, list(final_decl_atom)::out) is det
+	<= annotated_trace(S, R).
+
+get_answers(IoActionMap, Store, RedoId, DeclAtoms0, DeclAtoms) :-
+	(
+		maybe_redo_node_from_id(Store, RedoId, redo(_, ExitId))
+	->
+		exit_node_from_id(Store, ExitId, ExitNode),
+		NextId = ExitNode ^ exit_prev_redo,
+		DeclAtom = exit_node_decl_atom(IoActionMap, Store, ExitNode),
+		get_answers(IoActionMap, Store, NextId,
+			[DeclAtom | DeclAtoms0], DeclAtoms)
+	;
+		DeclAtoms = DeclAtoms0
+	).
+
+:- pred trace_root_e_bug(io_action_map::in, wrap(S)::in, edt_node(R)::in,
+	decl_e_bug::out) is det <= annotated_trace(S, R).
+
+trace_root_e_bug(IoActionMap, wrap(Store), dynamic(Ref), Bug) :-
+	det_edt_return_node_from_id(Store, Ref, Node),
+	(
+		Node = exit(_, _, _, _, Event, _),
+		DeclAtom = exit_node_decl_atom(IoActionMap, Store, Node),
+		Bug = incorrect_contour(DeclAtom, unit, Event)
+	;
+		Node = fail(_, CallId, _, Event),
+		DeclAtom = call_node_decl_atom(Store, CallId),
+		Bug = partially_uncovered_atom(DeclAtom, Event)
+	;
+		Node = excp(_, CallId, _, Exception, Event),
+		DeclAtom = call_node_decl_atom(Store, CallId),
+		Bug = unhandled_exception(DeclAtom, Exception, Event)
+	).
+
+:- pred trace_children(wrap(S), edt_node(R), list(edt_node(R)))
+		<= annotated_trace(S, R).
+:- mode trace_children(in, in, out) is semidet.
+
+trace_children(wrap(Store), dynamic(Ref), Children) :-
+	det_edt_return_node_from_id(Store, Ref, Node),
+	(
+		Node = fail(PrecId, CallId, _, _),
+		not_at_depth_limit(Store, CallId),
+		missing_answer_children(Store, PrecId, CallId, [], Children)
+	;
+		Node = exit(PrecId, CallId, _, _, _, _),
+		not_at_depth_limit(Store, CallId),
+		wrong_answer_children(Store, PrecId, CallId, [], Children)
+	;
+		Node = excp(PrecId, CallId, _, _, _),
+		not_at_depth_limit(Store, CallId),
+		unexpected_exception_children(Store, PrecId, CallId, [],
+			Children)
+	).
+
+:- pred not_at_depth_limit(S, R) <= annotated_trace(S, R).
+:- mode not_at_depth_limit(in, in) is semidet.
+
+not_at_depth_limit(Store, Ref) :-
+	call_node_from_id(Store, Ref, CallNode),
+	CallNode ^ call_at_max_depth = no.
+
+:- pred wrong_answer_children(S, R, R, list(edt_node(R)), list(edt_node(R)))
+		<= annotated_trace(S, R).
+:- mode wrong_answer_children(in, in, in, in, out) is det.
+
+wrong_answer_children(Store, NodeId, StartId, Ns0, Ns) :-
+	(
+		NodeId = StartId
+	->
+		Ns = Ns0
+	;
+		wrong_answer_children_2(Store, NodeId, StartId, Ns0, Ns)
+	).
+
+:- pred wrong_answer_children_2(S, R, R, list(edt_node(R)),
+	list(edt_node(R))) <= annotated_trace(S, R).
+:- mode wrong_answer_children_2(in, in, in, in, out) is det.
+
+wrong_answer_children_2(Store, NodeId, StartId, Ns0, Ns) :-
+	det_trace_node_from_id(Store, NodeId, Node),
+	(
+		( Node = call(_, _, _, _, _, _, _, _, _)
+		; Node = neg(_, _, _)
+		; Node = cond(_, _, failed)
+		)
+	->
+		throw(internal_error("wrong_answer_children_2",
+			"unexpected start of contour"))
+	;
+		Node = excp(_, _, _, _, _)
+	->
+		throw(unimplemented_feature("code that catches exceptions"))
+	;
+		Node = exit(_, _, _, _, _, _)
+	->
+			%
+			% Add a child for this node.
+			%
+		Ns1 = [dynamic(NodeId) | Ns0]
+	;
+		Node = fail(_, CallId, _, _)
+	->
+			%
+			% Fail events can be reached here if there
+			% were events missing due to a parent being
+			% shallow traced.  In this case, we can't tell
+			% whether the call was in a negated context
+			% or backtracked over, so we have to assume
+			% the former.
+			%
+			% Fail events can also be reached here if the
+			% parent was a variant of solutions/2.
+			%
+			% If this really is in a negated context, the start of
+			% the context would be just before the entry to this
+			% failed call, modulo any det/semidet code which
+			% succeeded.
+			%
+		call_node_from_id(Store, CallId, Call),
+		NestedStartId = Call ^ call_preceding,
+		missing_answer_children(Store, NodeId, NestedStartId, Ns0, Ns1)
+	;
+		Node = neg_fail(Prec, NestedStartId)
+	->
+			%
+			% There is a nested context.  Neg_fail events can be
+			% reached here if there were events missing due to a
+			% parent being shallow traced.  In this case, we can't
+			% tell whether the call was in a negated context or
+			% backtracked over, so we have to assume the former.
+			%
+		wrong_answer_children(Store, Prec, NestedStartId, Ns0, Ns1)
+	;
+		( Node = else(Prec, NestedStartId)
+		; Node = neg_succ(Prec, NestedStartId)
+		)
+	->
+			%
+			% There is a nested context.
+			%
+		missing_answer_children(Store, Prec, NestedStartId, Ns0, Ns1)
+	;
+			%
+			% This handles the following cases:
+			% redo, switch, first_disj, later_disj, and
+			% then.  Also handles cond when the status is
+			% anything other than failed.
+			%
+			% Redo events can be reached here if there
+			% were missing events due to a shallow tracing.
+			% In this case, we have to scan over the entire
+			% previous contour, since there is no way to
+			% tell how much of it was backtracked over.
+			%
+		Ns1 = Ns0
+	),
+	Next = step_left_in_contour(Store, Node),
+	wrong_answer_children(Store, Next, StartId, Ns1, Ns).
+
+:- pred missing_answer_children(S, R, R, list(edt_node(R)), list(edt_node(R)))
+		<= annotated_trace(S, R).
+:- mode missing_answer_children(in, in, in, in, out) is det.
+
+missing_answer_children(Store, NodeId, StartId, Ns0, Ns) :-
+	(
+		NodeId = StartId
+	->
+		Ns = Ns0
+	;
+		missing_answer_children_2(Store, NodeId, StartId, Ns0, Ns)
+	).
+
+:- pred missing_answer_children_2(S, R, R, list(edt_node(R)), list(edt_node(R)))
+	<= annotated_trace(S, R).
+:- mode missing_answer_children_2(in, in, in, in, out) is det.
+
+missing_answer_children_2(Store, NodeId, StartId, Ns0, Ns) :-
+	det_trace_node_from_id(Store, NodeId, Node),
+	(
+		( Node = call(_, _, _, _, _, _, _, _, _)
+		; Node = neg(_, _, _)
+		; Node = cond(_, _, failed)
+		)
+	->
+		throw(internal_error("missing_answer_children_2",
+			"unexpected start of contour"))
+	;
+		Node = excp(_, _, _, _, _)
+	->
+		throw(unimplemented_feature("code that catches exceptions"))
+	;
+		( Node = exit(_, _, _, _, _, _)
+		; Node = fail(_, _, _, _)
+		)
+	->
+			%
+			% Add a child for this node.
+			%
+		Ns1 = [dynamic(NodeId) | Ns0]
+	;
+		Node = neg_fail(Prec, NestedStartId)
+	->
+			%
+			% There is a nested successful context.
+			%
+		wrong_answer_children(Store, Prec, NestedStartId, Ns0, Ns1)
+	;
+		( Node = else(Prec, NestedStartId)
+		; Node = neg_succ(Prec, NestedStartId)
+		)
+	->
+			%
+			% There is a nested failed context.
+			%
+		missing_answer_children(Store, Prec, NestedStartId, Ns0, Ns1)
+	;
+			%
+			% This handles the following cases:
+			% redo, switch, first_disj, later_disj and
+			% then.  Also handles cond when the status
+			% is anything other than failed.
+			%
+		Ns1 = Ns0
+	),
+	Next = step_in_stratum(Store, Node),
+	missing_answer_children(Store, Next, StartId, Ns1, Ns).
+
+:- pred unexpected_exception_children(S, R, R, list(edt_node(R)),
+		list(edt_node(R))) <= annotated_trace(S, R).
+:- mode unexpected_exception_children(in, in, in, in, out) is det.
+
+unexpected_exception_children(Store, NodeId, StartId, Ns0, Ns) :-
+	(
+		NodeId = StartId
+	->
+		Ns = Ns0
+	;
+		unexpected_exception_children_2(Store, NodeId, StartId, Ns0, Ns)
+	).
+
+:- pred unexpected_exception_children_2(S, R, R, list(edt_node(R)),
+	list(edt_node(R))) <= annotated_trace(S, R).
+:- mode unexpected_exception_children_2(in, in, in, in, out) is det.
+
+unexpected_exception_children_2(Store, NodeId, StartId, Ns0, Ns) :-
+	det_trace_node_from_id(Store, NodeId, Node),
+	(
+		( Node = call(_, _, _, _, _, _, _, _, _)
+		; Node = neg(_, _, failed)
+		; Node = cond(_, _, failed)
+		)
+	->
+		throw(internal_error("unexpected_exception_children_2",
+			"unexpected start of contour"))
+	;
+		( Node = exit(_, _, _, _, _, _)
+		; Node = excp(_, _, _, _, _)
+		)
+	->
+			%
+			% Add a child for this node.
+			%
+		Ns1 = [dynamic(NodeId) | Ns0]
+	;
+		Node = fail(_, CallId, _, _)
+	->
+			%
+			% Fail events can be reached here if there
+			% were events missing due to a parent being
+			% shallow traced.  In this case, we can't tell
+			% whether the call was in a negated context
+			% or backtracked over, so we have to assume
+			% the former.
+			%
+			% Fail events can also be reached here if the
+			% parent was a variant of solutions/2.
+			%
+			% If this really is in a negated context, the start of
+			% the context would be just before the entry to this
+			% failed call, modulo any det/semidet code which
+			% succeeded.
+			%
+		call_node_from_id(Store, CallId, Call),
+		NestedStartId = Call ^ call_preceding,
+		missing_answer_children(Store, NodeId, NestedStartId, Ns0, Ns1)
+	;
+		Node = neg_fail(Prec, NestedStartId)
+	->
+			%
+			% There is a nested context.  Neg_fail events can be
+			% reached here if there were events missing due to a
+			% parent being shallow traced.  In this case, we can't
+			% tell whether the call was in a negated context or
+			% backtracked over, so we have to assume the former.
+			%
+		wrong_answer_children(Store, Prec, NestedStartId, Ns0, Ns1)
+	;
+		( Node = else(Prec, NestedStartId)
+		; Node = neg_succ(Prec, NestedStartId)
+		)
+	->
+			%
+			% There is a nested context.
+			%
+		missing_answer_children(Store, Prec, NestedStartId, Ns0, Ns1)
+	;
+			%
+			% This handles the following cases:
+			% redo, switch, first_disj, later_disj, and
+			% then.  Also handles neg and cond when the
+			% status is anything other than failed.
+			%
+			% Redo events can be reached here if there
+			% were missing events due to a shallow tracing.
+			% In this case, we have to scan over the entire
+			% previous contour, since there is no way to
+			% tell how much of it was backtracked over.
+			%
+		Ns1 = Ns0
+	),
+	Next = step_left_in_contour(Store, Node),
+	unexpected_exception_children(Store, Next, StartId, Ns1, Ns).
+
+%-----------------------------------------------------------------------------%
+%
+% Tracking a subterm dependency.
+%
+% We are given an EDT node, an argument position, and a path to the selected
+% subterm.  We wish to find the origin of that subterm within the body of the
+% given node, or within the body of its parent.  We can figure out the mode of
+% the top of the selected subterm.
+%
+% If the mode is `in', the origin could be:
+%	- a primitive (unification of foreign_proc) within the body of the
+%	  parent,
+%	- an output subterm in a sibling node, or
+%	- an input subterm of the parent node.
+% In this case we look at the contour leading up to the call event associated
+% with the given node. This contour will be wholly within the parent call.
+%
+% If the mode is `out', the origin could be:
+%	- a primitive (unification or foreign_proc) within the body of the
+%	  call,
+%	- an output subterm of a child of the node, or
+%	- an input subterm of the node itself.
+% In this case we look at the contour leading up to the exit or exception event
+% associated with the given node. This contour will be wholly within the
+% current call.
+%
+% Our algorithm for finding the origin has three phases.
+%
+% In the first phase, we materialize a list of the nodes in the contour.
+%
+% In the second phase, we use this list of nodes to construct a list of the
+% primitive goals along that contour in the body of the relevant procedure,
+% leading up to either the call event (if subterm_mode is `in') or the exit
+% event (if subterm_mode is `out').
+%
+% In the third phase, we traverse the list of primitive goals backwards, from
+% the most recently executed primitive to the earliest one, keeping track of
+% the variable which contains the selected subterm, and the location within
+% this variable.
+
+:- type dependency_chain_start(R)
+	--->	chain_start(
+			start_loc(R),
+			int,		% The argument number of the selected
+					% position in the full list of
+					% arguments, including the
+					% compiler-generated ones.
+			R,		% The id of the node preceding the exit
+					% node, if start_loc is cur_goal
+					% and the id of the node preceding the
+					% call node if start_loc is
+					% parent_goal.
+			maybe(goal_path),
+					% No if start_loc is cur_goal;
+					% and yes wrapped around the goal path
+					% of the call in the parent procedure
+					% if start_loc is parent_goal.
+			maybe(proc_rep)	% The body of the procedure indicated
+					% by start_loc.
+		).
+
+:- type start_loc(R)
+	--->	cur_goal
+	;	parent_goal(R, trace_node(R)).
+
+:- type goal_and_path	--->	goal_and_path(goal_rep, goal_path).
+
+:- type goal_and_path_list ==	list(goal_and_path).
+
+:- type annotated_primitive(R)
+	--->	primitive(
+			string,		% filename
+			int,		% line number
+			list(var_rep),	% vars bound by the atomic goal
+			atomic_goal_rep,% the atomic goal itself
+			goal_path,	% its goal path
+			maybe(R)
+					% if the atomic goal is a call,
+					% the id of the call's exit event
+		).
+
+:- pred trace_dependency(wrap(S)::in, edt_node(R)::in,
+	arg_pos::in, term_path::in, subterm_mode::out,
+	subterm_origin(edt_node(R))::out) is det <= annotated_trace(S, R).
+
+trace_dependency(wrap(Store), dynamic(Ref), ArgPos, TermPath, Mode, Origin) :-
+	find_chain_start(Store, Ref, ArgPos, TermPath, ChainStart),
+	ChainStart = chain_start(StartLoc, ArgNum, NodeId, StartPath,
+		MaybeProcRep),
+	Mode = start_loc_to_subterm_mode(StartLoc),
+	(
+		MaybeProcRep = no,
+		Origin = not_found
+	;
+		MaybeProcRep = yes(ProcRep),
+		det_trace_node_from_id(Store, NodeId, Node),
+		materialize_contour(Store, NodeId, Node, [], Contour0),
+		(
+			StartLoc = parent_goal(CallId, CallNode),
+			Contour = list__append(Contour0, [CallId - CallNode])
+		;
+			StartLoc = cur_goal,
+			Contour = Contour0
+		),
+		ProcRep = proc_rep(HeadVars, GoalRep),
+		make_primitive_list(Store, [goal_and_path(GoalRep, [])],
+			Contour, StartPath, ArgNum, HeadVars, Var,
+			[], Primitives),
+		traverse_primitives(Primitives, Var, TermPath,
+			Store, ProcRep, Origin)
+	).
+
+:- pred find_chain_start(S::in, R::in, arg_pos::in, term_path::in,
+	dependency_chain_start(R)::out) is det <= annotated_trace(S, R).
+
+find_chain_start(Store, Ref, ArgPos, TermPath, ChainStart) :-
+	det_edt_return_node_from_id(Store, Ref, Node),
+	(
+		Node = exit(_, CallId, _, ExitAtom, _, _),
+		call_node_from_id(Store, CallId, CallNode),
+		CallAtom = CallNode ^ call_atom,
+		( trace_atom_subterm_is_ground(CallAtom, ArgPos, TermPath) ->
+			find_chain_start_inside(Store, CallId, CallNode,
+				ArgPos, ChainStart)
+		; trace_atom_subterm_is_ground(ExitAtom, ArgPos, TermPath) ->
+			find_chain_start_outside(CallNode, Node, ArgPos,
+				ChainStart)
+		;
+			throw(internal_error("find_chain_start",
+				"unbound wrong answer term"))
+		)
+	;
+		Node = fail(_, CallId, _, _),
+		call_node_from_id(Store, CallId, CallNode),
+		CallAtom = CallNode ^ call_atom,
+		( trace_atom_subterm_is_ground(CallAtom, ArgPos, TermPath) ->
+			find_chain_start_inside(Store, CallId, CallNode,
+				ArgPos, ChainStart)
+		;
+			throw(internal_error("find_chain_start",
+				"unbound missing answer term"))
+		)
+	;
+		Node = excp(_, CallId, _, _, _),
+		call_node_from_id(Store, CallId, CallNode),
+		CallAtom = CallNode ^ call_atom,
+		%
+		% XXX we don't yet handle tracking of the exception value.
+		%
+		( trace_atom_subterm_is_ground(CallAtom, ArgPos, TermPath) ->
+			find_chain_start_inside(Store, CallId, CallNode,
+				ArgPos, ChainStart)
+		;
+			throw(internal_error("find_chain_start",
+				"unbound exception term"))
+		)
+	).
+
+:- pred find_chain_start_inside(S::in, R::in,
+	trace_node(R)::in(trace_node_call), arg_pos::in,
+	dependency_chain_start(R)::out) is det <= annotated_trace(S, R).
+
+find_chain_start_inside(Store, CallId, CallNode, ArgPos, ChainStart) :-
+	CallPrecId = CallNode ^ call_preceding,
+	CallAtom = CallNode ^ call_atom,
+	CallPathStr = CallNode ^ call_goal_path,
+	path_from_string_det(CallPathStr, CallPath),
+	StartLoc = parent_goal(CallId, CallNode),
+	absolute_arg_num(ArgPos, CallAtom, ArgNum),
+	StartId = CallPrecId,
+	StartPath = yes(CallPath),
+	parent_proc_rep(Store, CallId, StartRep),
+	ChainStart = chain_start(StartLoc, ArgNum, StartId, StartPath,
+		StartRep).
+
+:- pred find_chain_start_outside(trace_node(R)::in(trace_node_call),
+	trace_node(R)::in(trace_node_exit), arg_pos::in,
+	dependency_chain_start(R)::out) is det.
+
+find_chain_start_outside(CallNode, ExitNode, ArgPos, ChainStart) :-
+	StartLoc = cur_goal,
+	ExitAtom = ExitNode ^ exit_atom,
+	absolute_arg_num(ArgPos, ExitAtom, ArgNum),
+	StartId = ExitNode ^ exit_preceding,
+	StartPath = no,
+	StartRep = CallNode ^ call_proc_rep,
+	ChainStart = chain_start(StartLoc, ArgNum, StartId,
+		StartPath, StartRep).
+
+:- pred parent_proc_rep(S::in, R::in, maybe(proc_rep)::out)
+	is det <= annotated_trace(S, R).
+
+parent_proc_rep(Store, CallId, ProcRep) :-
+	call_node_from_id(Store, CallId, Call),
+	CallPrecId = Call ^ call_preceding,
+	( trace_node_from_id(Store, CallPrecId, CallPrecNode) ->
+		step_left_to_call(Store, CallPrecNode, ParentCallNode),
+		ProcRep = ParentCallNode ^ call_proc_rep
+	;
+		% The parent call is outside the annotated trace.
+		ProcRep = no
+	).
+
+:- pred step_left_to_call(S::in, trace_node(R)::in,
+	trace_node(R)::out(trace_node_call)) is det <= annotated_trace(S, R).
+
+step_left_to_call(Store, Node, ParentCallNode) :-
+	( Node = call(_, _, _, _, _, _, _, _, _) ->
+		ParentCallNode = Node
+	;
+		( Node = neg(NegPrec, _, _) ->
+			PrevNodeId = NegPrec
+		;
+			PrevNodeId = step_left_in_contour(Store, Node)
+		),
+		det_trace_node_from_id(Store, PrevNodeId, PrevNode),
+		step_left_to_call(Store, PrevNode, ParentCallNode)
+	).
+
+:- pred materialize_contour(S::in, R::in, trace_node(R)::in,
+	assoc_list(R, trace_node(R))::in, assoc_list(R, trace_node(R))::out)
+	is det <= annotated_trace(S, R).
+
+materialize_contour(Store, NodeId, Node, Nodes0, Nodes) :-
+	( Node = call(_, _, _, _, _, _, _, _, _) ->
+		Nodes = Nodes0
+	;
+		( Node = neg(NegPrec, _, _) ->
+			PrevNodeId = NegPrec
+		;
+			PrevNodeId = step_left_in_contour(Store, Node)
+		),
+		det_trace_node_from_id(Store, PrevNodeId, PrevNode),
+		( Node = then(_, _) ->
+			% The cond node is enough to tell us which way the
+			% if-then-else went; the then node would just
+			% complicate the job of make_primitive_list.
+			Nodes1 = Nodes0
+		;
+			Nodes1 = [NodeId - Node | Nodes0]
+		),
+		materialize_contour(Store, PrevNodeId, PrevNode,
+			Nodes1, Nodes)
+	).
+
+:- pred make_primitive_list(S::in, goal_and_path_list::in,
+	assoc_list(R, trace_node(R))::in, maybe(goal_path)::in,
+	int::in, list(var_rep)::in, var_rep::out,
+	list(annotated_primitive(R))::in, list(annotated_primitive(R))::out)
+	is det <= annotated_trace(S, R).
+
+make_primitive_list(Store, [goal_and_path(Goal, Path) | GoalPaths],
+		Contour, MaybeEnd, ArgNum, HeadVars, Var,
+		Primitives0, Primitives) :-
+	(
+		Goal = conj_rep(Conjs),
+		add_paths_to_conjuncts(Conjs, Path, 1, ConjPaths),
+		make_primitive_list(Store, list__append(ConjPaths, GoalPaths),
+			Contour, MaybeEnd, ArgNum, HeadVars, Var,
+			Primitives0, Primitives)
+	;
+		Goal = disj_rep(Disjs),
+		(
+			Contour = [_ - ContourHeadNode | ContourTail],
+			( ContourHeadNode = first_disj(_, DisjPathStr)
+			; ContourHeadNode = later_disj(_, DisjPathStr, _)
+			),
+			path_from_string_det(DisjPathStr, DisjPath),
+			list__append(Path, PathTail, DisjPath),
+			PathTail = [disj(N)]
+		->
+			list__index1_det(Disjs, N, Disj),
+			DisjAndPath = goal_and_path(Disj, DisjPath),
+			make_primitive_list(Store, [DisjAndPath | GoalPaths],
+				ContourTail, MaybeEnd, ArgNum, HeadVars, Var,
+				Primitives0, Primitives)
+		;
+			throw(internal_error("make_primitive_list",
+				"mismatch on disj"))
+		)
+	;
+		Goal = switch_rep(Arms),
+		(
+			Contour = [_ - ContourHeadNode | ContourTail],
+			ContourHeadNode = switch(_, ArmPathStr),
+			path_from_string_det(ArmPathStr, ArmPath),
+			list__append(Path, PathTail, ArmPath),
+			PathTail = [switch(N)]
+		->
+			list__index1_det(Arms, N, Arm),
+			ArmAndPath = goal_and_path(Arm, ArmPath),
+			make_primitive_list(Store, [ArmAndPath | GoalPaths],
+				ContourTail, MaybeEnd, ArgNum, HeadVars, Var,
+				Primitives0, Primitives)
+		;
+			throw(internal_error("make_primitive_list",
+				"mismatch on switch"))
+		)
+	;
+		Goal = ite_rep(Cond, Then, Else),
+		(
+			Contour = [_ - ContourHeadNode | ContourTail],
+			ContourHeadNode = cond(_, CondPathStr, _),
+			path_from_string_det(CondPathStr, CondPath),
+			list__append(Path, PathTail, CondPath),
+			PathTail = [ite_cond]
+		->
+			ThenPath = list__append(Path, [ite_then]),
+			CondAndPath = goal_and_path(Cond, CondPath),
+			ThenAndPath = goal_and_path(Then, ThenPath),
+			make_primitive_list(Store,
+				[CondAndPath, ThenAndPath | GoalPaths],
+				ContourTail, MaybeEnd, ArgNum, HeadVars, Var,
+				Primitives0, Primitives)
+		;
+			Contour = [_ - ContourHeadNode | ContourTail],
+			ContourHeadNode = else(_, ElseCondId),
+			cond_node_from_id(Store, ElseCondId, CondNode),
+			CondNode = cond(_, CondPathStr, _),
+			path_from_string_det(CondPathStr, CondPath),
+			list__append(Path, PathTail, CondPath),
+			PathTail = [ite_cond]
+		->
+			ElsePath = list__append(Path, [ite_else]),
+			ElseAndPath = goal_and_path(Else, ElsePath),
+			make_primitive_list(Store, [ElseAndPath | GoalPaths],
+				ContourTail, MaybeEnd, ArgNum, HeadVars, Var,
+				Primitives0, Primitives)
+		;
+			throw(internal_error("make_primitive_list",
+				"mismatch on if-then-else"))
+		)
+	;
+		Goal = negation_rep(NegGoal),
+		(
+			Contour = [_ - ContourHeadNode | ContourTail],
+			ContourHeadNode = neg_succ(_, _)
+		->
+			% The negated goal cannot contribute any bindings.
+			make_primitive_list(Store, GoalPaths,
+				ContourTail, MaybeEnd, ArgNum, HeadVars, Var,
+				Primitives0, Primitives)
+		;
+			Contour = [_ - ContourHeadNode | ContourTail],
+			ContourHeadNode = neg(_, _, _)
+		->
+			% The end of the primitive list is somewhere inside
+			% NegGoal.
+			NegPath = list__append(Path, [neg]),
+			NegAndPath = goal_and_path(NegGoal, NegPath),
+			make_primitive_list(Store, [NegAndPath],
+				ContourTail, MaybeEnd, ArgNum, HeadVars, Var,
+				Primitives0, Primitives)
+		;
+			throw(internal_error("make_primitive_list",
+				"mismatch on negation"))
+		)
+	;
+		Goal = some_rep(InnerGoal, MaybeCut),
+		InnerPath = list__append(Path, [exist(MaybeCut)]),
+		InnerAndPath = goal_and_path(InnerGoal, InnerPath),
+		make_primitive_list(Store, [InnerAndPath | GoalPaths],
+			Contour, MaybeEnd, ArgNum, HeadVars, Var,
+			Primitives0, Primitives)
+	;
+		Goal = atomic_goal_rep(_, File, Line, BoundVars, AtomicGoal),
+		GeneratesEvent = atomic_goal_generates_event(AtomicGoal),
+		(
+			GeneratesEvent = yes(Args),
+			(
+				Contour = [ContourHeadId - ContourHeadNode
+					| ContourTail],
+				CallId = ContourHeadNode ^ exit_call,
+				call_node_from_id(Store, CallId, CallNode),
+				CallPathStr = CallNode ^ call_goal_path,
+				path_from_string_det(CallPathStr, CallPath),
+				CallPath = Path,
+				\+ (
+					MaybeEnd = yes(EndPath),
+					EndPath = Path
+				)
+			->
+				Primitive = primitive(File, Line, BoundVars,
+					AtomicGoal, Path, yes(ContourHeadId)),
+				Primitives1 = [Primitive | Primitives0],
+				make_primitive_list(Store, GoalPaths,
+					ContourTail, MaybeEnd, ArgNum,
+					HeadVars, Var, Primitives1, Primitives)
+			;
+				Contour = [_ContourHeadId - ContourHeadNode],
+				CallPathStr = ContourHeadNode ^ call_goal_path,
+				path_from_string_det(CallPathStr, CallPath),
+				CallPath = Path,
+				MaybeEnd = yes(EndPath),
+				EndPath = Path
+			->
+				list__index1_det(Args, ArgNum, Var),
+				Primitives = Primitives0
+			;
+				throw(internal_error("make_primitive_list",
+					"mismatch on call"))
+			)
+		;
+			GeneratesEvent = no,
+			Primitive = primitive(File, Line, BoundVars,
+				AtomicGoal, Path, no),
+			Primitives1 = [Primitive | Primitives0],
+			make_primitive_list(Store, GoalPaths,
+				Contour, MaybeEnd, ArgNum, HeadVars, Var,
+				Primitives1, Primitives)
+		)
+	).
+make_primitive_list(_, [], Contour, MaybeEnd, ArgNum, HeadVars, Var,
+		Primitives, Primitives) :-
+	decl_require(unify(Contour, []),
+		"make_primitive_list", "nonempty contour at end"),
+	decl_require(unify(MaybeEnd, no),
+		"make_primitive_list", "found end when looking for call"),
+	list__index1_det(HeadVars, ArgNum, Var).
+
+:- pred traverse_primitives(list(annotated_primitive(R))::in,
+	var_rep::in, term_path::in, S::in, proc_rep::in,
+	subterm_origin(edt_node(R))::out) is det <= annotated_trace(S, R).
+
+traverse_primitives([], Var0, TermPath0, _, ProcRep, Origin) :-
+	ProcRep = proc_rep(HeadVars, _),
+	ArgPos = find_arg_pos(HeadVars, Var0),
+	Origin = input(ArgPos, TermPath0).
+traverse_primitives([Prim | Prims], Var0, TermPath0, Store, ProcRep,
+		Origin) :-
+	Prim = primitive(File, Line, BoundVars, AtomicGoal, _GoalPath,
+		MaybeNodeId),
+	(
+		AtomicGoal = unify_construct_rep(_CellVar, _Cons, FieldVars),
+		( list__member(Var0, BoundVars) ->
+			(
+				TermPath0 = [],
+				Origin = primitive_op(File, Line)
+			;
+				TermPath0 = [TermPathStep0 | TermPath],
+				list__index1_det(FieldVars, TermPathStep0,
+					Var),
+				traverse_primitives(Prims, Var, TermPath,
+					Store, ProcRep, Origin)
+			)
+		;
+			traverse_primitives(Prims, Var0, TermPath0,
+				Store, ProcRep, Origin)
+		)
+	;
+		AtomicGoal = unify_deconstruct_rep(CellVar, _Cons, FieldVars),
+		( list__member(Var0, BoundVars) ->
+			( list__nth_member_search(FieldVars, Var0, Pos) ->
+				traverse_primitives(Prims,
+					CellVar, [Pos | TermPath0],
+					Store, ProcRep, Origin)
+			;
+				throw(internal_error("traverse_primitives",
+					"bad deconstruct"))
+			)
+		;
+			traverse_primitives(Prims, Var0, TermPath0,
+				Store, ProcRep, Origin)
+		)
+	;
+		AtomicGoal = unify_assign_rep(ToVar, FromVar),
+		( list__member(Var0, BoundVars) ->
+			decl_require(unify(Var0, ToVar),
+				"traverse_primitives", "bad assign"),
+			traverse_primitives(Prims, FromVar, TermPath0,
+				Store, ProcRep, Origin)
+		;
+			traverse_primitives(Prims, Var0, TermPath0,
+				Store, ProcRep, Origin)
+		)
+	;
+		AtomicGoal = pragma_foreign_code_rep(_Args),
+		( list__member(Var0, BoundVars) ->
+			Origin = primitive_op(File, Line)
+		;
+			traverse_primitives(Prims, Var0, TermPath0,
+				Store, ProcRep, Origin)
+		)
+	;
+		AtomicGoal = unify_simple_test_rep(_LVar, _RVar),
+		( list__member(Var0, BoundVars) ->
+			throw(internal_error("traverse_primitives", "bad test"))
+		;
+			traverse_primitives(Prims, Var0, TermPath0,
+				Store, ProcRep, Origin)
+		)
+	;
+		AtomicGoal = higher_order_call_rep(_, Args),
+		traverse_call(BoundVars, no, Args, MaybeNodeId, Prims,
+			Var0, TermPath0, Store, ProcRep, Origin)
+	;
+		AtomicGoal = method_call_rep(_, _, Args),
+		traverse_call(BoundVars, no, Args, MaybeNodeId, Prims,
+			Var0, TermPath0, Store, ProcRep, Origin)
+	;
+		AtomicGoal = plain_call_rep(ModuleName, PredName, Args),
+		PlainCallInfo = plain_call_info(File, Line,
+			ModuleName, PredName),
+		traverse_call(BoundVars, yes(PlainCallInfo), Args, MaybeNodeId,
+			Prims, Var0, TermPath0, Store, ProcRep, Origin)
+	).
+
+:- type plain_call_info
+	--->	plain_call_info(
+			file_name	:: string,
+			line_number	:: int,
+			module_name	:: string,
+			pred_name	:: string
+		).
+
+:- pred traverse_call(list(var_rep)::in, maybe(plain_call_info)::in,
+	list(var_rep)::in, maybe(R)::in,
+	list(annotated_primitive(R))::in, var_rep::in, term_path::in,
+	S::in, proc_rep::in, subterm_origin(edt_node(R))::out) is det
+	<= annotated_trace(S, R).
+
+traverse_call(BoundVars, MaybePlainCallInfo, Args, MaybeNodeId,
+		Prims, Var, TermPath, Store, ProcRep, Origin) :-
+	( list__member(Var, BoundVars) ->
+		Pos = find_arg_pos(Args, Var),
+		(
+			MaybeNodeId = yes(NodeId),
+			Origin = output(dynamic(NodeId), Pos, TermPath)
+		;
+			MaybeNodeId = no,
+			(
+				MaybePlainCallInfo = yes(PlainCallInfo),
+				PlainCallInfo = plain_call_info(File, Line,
+					ModuleName, PredName),
+				call_is_primitive(ModuleName, PredName)
+			->
+				Origin = primitive_op(File, Line)
+			;
+				throw(internal_error("traverse_call",
+					"no node id"))
+			)
+		)
+	;
+		traverse_primitives(Prims, Var, TermPath, Store, ProcRep,
+			Origin)
+	).
+
+%-----------------------------------------------------------------------------%
+
+:- pred add_paths_to_conjuncts(list(goal_rep)::in, goal_path::in, int::in,
+	goal_and_path_list::out) is det.
+
+add_paths_to_conjuncts([], _, _, []).
+add_paths_to_conjuncts([Goal | Goals], ParentPath, N,
+		[goal_and_path(Goal, Path) | GoalAndPaths]) :-
+	list__append(ParentPath, [conj(N)], Path),
+	add_paths_to_conjuncts(Goals, ParentPath, N + 1, GoalAndPaths).
+
+%-----------------------------------------------------------------------------%
+
+:- func start_loc_to_subterm_mode(start_loc(R)) = subterm_mode.
+
+start_loc_to_subterm_mode(cur_goal) = subterm_out.
+start_loc_to_subterm_mode(parent_goal(_, _)) = subterm_in.
+
+%-----------------------------------------------------------------------------%
+
+:- func find_arg_pos(list(var_rep), var_rep) = arg_pos.
+
+find_arg_pos(HeadVars, Var) = ArgPos :-
+	find_arg_pos_2(HeadVars, Var, 1, ArgPos).
+
+:- pred find_arg_pos_2(list(var_rep)::in, var_rep::in, int::in, arg_pos::out)
+	is det.
+
+find_arg_pos_2([], _, _, _) :-
+	throw(internal_error("find_arg_pos_2", "empty list")).
+find_arg_pos_2([HeadVar | HeadVars], Var, Pos, ArgPos) :-
+	( HeadVar = Var ->
+		ArgPos = any_head_var(Pos)
+	;
+		find_arg_pos_2(HeadVars, Var, Pos + 1, ArgPos)
+	).
+
+%-----------------------------------------------------------------------------%
+
+edt_subtree_details(Store, dynamic(Ref), Event, SeqNo) :-
+	det_edt_return_node_from_id(Store, Ref, Node),
+	(
+		Node = exit(_, Call, _, _, Event, _)
+	;
+		Node = fail(_, Call, _, Event)
+	;
+		Node = excp(_, Call, _, _, Event)
+	),
+	call_node_from_id(Store, Call, CallNode),
+	SeqNo = CallNode ^ call_seq.
+
+:- inst edt_return_node =
+		bound(	exit(ground, ground, ground, ground, ground, ground)
+		;	fail(ground, ground, ground, ground)
+		;	excp(ground, ground, ground, ground, ground)).
+
+:- pred det_edt_return_node_from_id(S::in, R::in,
+	trace_node(R)::out(edt_return_node)) is det <= annotated_trace(S, R).
+
+det_edt_return_node_from_id(Store, Ref, Node) :-
+	(
+		trace_node_from_id(Store, Ref, Node0),
+		(
+			Node0 = exit(_, _, _, _, _, _)
+		;
+			Node0 = fail(_, _, _, _)
+		;
+			Node0 = excp(_, _, _, _, _)
+		)
+	->
+		Node = Node0
+	;
+		throw(internal_error("det_edt_return_node_from_id",
+			"not a return node"))
+	).
+
+%-----------------------------------------------------------------------------%
+
+:- pred trace_atom_subterm_is_ground(trace_atom, arg_pos, term_path).
+:- mode trace_atom_subterm_is_ground(in, in, in) is semidet.
+
+trace_atom_subterm_is_ground(atom(_, _, Args), ArgPos, _) :-
+	select_arg_at_pos(ArgPos, Args, ArgInfo),
+	ArgInfo = arg_info(_, _, MaybeArg),
+	MaybeArg = yes(_).
+
+%-----------------------------------------------------------------------------%
+
+:- pred decl_require(pred, string, string).
+:- mode decl_require((pred) is semidet, in, in) is det.
+
+decl_require(Goal, Loc, Msg) :-
+	(
+		call(Goal)
+	->
+		true
+	;
+		throw(internal_error(Loc, Msg))
+	).
+
Index: browser/mdb.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/mdb.m,v
retrieving revision 1.8
diff -u -r1.8 mdb.m
--- browser/mdb.m	22 Jul 2002 07:12:55 -0000	1.8
+++ browser/mdb.m	8 Sep 2002 16:07:14 -0000
@@ -21,7 +21,8 @@
 :- implementation.
 
 :- include_module frame, parse, util, sized_pretty.
-:- include_module declarative_analyser, declarative_oracle, declarative_user.
+:- include_module declarative_analyser, declarative_oracle, declarative_tree.
+:- include_module declarative_user.
 :- include_module tree234_cc.
 
 	% XXX these modules are more generally useful, but the
Index: tests/debugger/declarative/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/Mmakefile,v
retrieving revision 1.41
diff -u -r1.41 Mmakefile
--- tests/debugger/declarative/Mmakefile	8 Sep 2002 15:47:02 -0000	1.41
+++ tests/debugger/declarative/Mmakefile	13 Sep 2002 03:48:29 -0000
@@ -39,7 +39,15 @@
 	throw
 
 # The following should not be run in `debug' grades.
+#
+# XXX 'catch' test case does not work properly in debug grades, due to some
+# unknown bug.  The result of this bug is that the declarative debugger
+# gives a warning about missed events and refuses to start.  Since the
+# previous behaviour was to throw a software error, this is not really
+# a regression, but we would still like to find the bug and fix it.
+#
 NONDEBUG_DECLARATIVE_PROGS=	\
+	catch			\
 	untraced_subgoal
 
 NONWORKING_DECLARATIVE_PROGS=	\
@@ -117,6 +125,9 @@
 
 browse_arg.out: browse_arg browse_arg.inp
 	$(MDB) ./browse_arg < browse_arg.inp > browse_arg.out 2>&1
+
+catch.out: catch catch.inp
+	$(MDB) ./catch < catch.inp > catch.out 2>&1
 
 comp_gen.out: comp_gen comp_gen.inp
 	$(MDB) ./comp_gen < comp_gen.inp > comp_gen.out 2>&1
Index: tests/debugger/declarative/catch.exp
===================================================================
RCS file: tests/debugger/declarative/catch.exp
diff -N tests/debugger/declarative/catch.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/catch.exp	9 Sep 2002 04:00:45 -0000
@@ -0,0 +1,40 @@
+       1:      1  1 CALL pred catch:main/2-0 (cc_multi) catch.m:8
+mdb> echo on
+Command echo enabled.
+mdb> register --quiet
+mdb> break p
+ 0: + stop  interface pred catch:p/2-0 (cc_multi)
+mdb> continue
+       2:      2  2 CALL pred catch:p/2-0 (cc_multi) catch.m:18 (catch.m:9)
+mdb> finish
+mdb: warning: reached unknown label
+This may result in some exception events
+being omitted from the trace.
+       7:      2  2 EXIT pred catch:p/2-0 (cc_multi) catch.m:18 (catch.m:9)
+mdb> dd
+mdb: warning: reached unknown label
+This may result in some exception events
+being omitted from the trace.
+p(1, exception(univ_cons("q: bad input")))
+Valid? no
+Sorry, the diagnosis cannot continue because it requires support for
+the following: code that catches exceptions.
+The debugger is a work in progress, and this is not supported in the
+current version.
+       7:      2  2 EXIT pred catch:p/2-0 (cc_multi) catch.m:18 (catch.m:9)
+mdb> continue
+exception(univ_cons("q: bad input"))
+       8:      4  2 CALL pred catch:p/2-0 (cc_multi) catch.m:18 (catch.m:12)
+mdb> finish
+      13:      4  2 EXIT pred catch:p/2-0 (cc_multi) catch.m:18 (catch.m:12)
+mdb> dd
+p(2, succeeded(2))
+Valid? no
+q(2, 2)
+Valid? yes
+Found incorrect contour:
+p(2, succeeded(2))
+Is this a bug? yes
+      13:      4  2 EXIT pred catch:p/2-0 (cc_multi) catch.m:18 (catch.m:12)
+mdb> continue
+succeeded(2)
Index: tests/debugger/declarative/catch.inp
===================================================================
RCS file: tests/debugger/declarative/catch.inp
diff -N tests/debugger/declarative/catch.inp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/catch.inp	9 Sep 2002 04:00:23 -0000
@@ -0,0 +1,14 @@
+echo on
+register --quiet
+break p
+continue
+finish
+dd
+no
+continue
+finish
+dd
+no
+yes
+yes
+continue
Index: tests/debugger/declarative/catch.m
===================================================================
RCS file: tests/debugger/declarative/catch.m
diff -N tests/debugger/declarative/catch.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/catch.m	9 Sep 2002 03:47:21 -0000
@@ -0,0 +1,31 @@
+:- module catch.
+:- interface.
+:- import_module io.
+:- pred main(io__state::di, io__state::uo) is cc_multi.
+:- implementation.
+:- import_module exception, int.
+
+main -->
+	{ p(1, R1) },
+	io__write(R1),
+	io__nl,
+	{ p(2, R2) },
+	io__write(R2),
+	io__nl.
+
+:- pred p(int::in, exception_result(int)::out) is cc_multi.
+
+p(N, R) :-
+	try(q(N), R).
+
+:- pred q(int::in, int::out) is det.
+
+q(N, M) :-
+	(
+		N > 1
+	->
+		M = N
+	;
+		throw("q: bad input")
+	).
+
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------