[m-dev.] for review: bring DD back end into line with the paper

Mark Anthony BROWN dougl at cs.mu.OZ.AU
Wed Feb 16 14:07:38 AEDT 2000


Estimated hours taken: 25 (plus ? by zs)

Bring the implementation up to date with the algorithm that is
described in the paper (papers/decl_debug).  Add some debugging
infrastructure to the back end, which was used to debug this
change.

browser/declarative_execution.m:
	- Store the call sequence number in call nodes.
	- Store the previous redo (if there is one) in fail nodes.
	- Use a functor specifically for switches.
	- Use a pointer to the first disj event, instead of a pointer
	  to the event before it.
	- Export two new predicates for dereferencing disj node ids.
	- Export (to C) a procedure for accessing the call sequence number,
	  and a procedure for getting to the first disj event.
	- Split the scan_backwards function into two: step_left_in_context
	  and find_prev_contour.

browser/declarative_debugger.m:
trace/mercury_trace_declarative.c:
	- Use the updated data structure.

runtime/mercury_conf_param.h:
	- Add the configuration parameter MR_USE_DECL_STACK_SLOT, which
	  makes the declarative debugger use stack slots reserved by
	  the compiler to cache the location of the call node.

trace/mercury_trace_declarative.h:
trace/mercury_trace_declarative.c:
	- Use stack slot only if MR_USE_DECL_STACK_SLOT is defined.
	- If not using stack slot, use the new algorithm to search
	  for a matching call or exit event.
	- Avoid using a global by passing the previous node to
	  MR_trace_decl_* and returning the new node.
	- Rename MR_trace_call_node_answer to
	  MR_trace_call_node_last_interface.
	- Update comments.

browser/declarative_execution.m:
trace/mercury_trace_declarative.c:
	- Added debugging output for various events of interest
	  in the back end.  It is activated when MR_DEBUG_DD_BACK_END
	  is set.

tests/debugger/declarative/aadebug.m:
tests/debugger/declarative/aadebug.inp:
tests/debugger/declarative/aadebug.exp:
tests/debugger/declarative/aadebug.exp2:
	- Update this test to match the example in the paper.

tests/debugger/declarative/propositional.inp:
tests/debugger/declarative/propositional.exp:
tests/debugger/declarative/propositional.exp2:
	- Update this test case so it gives a similar result in
	  debugging grades to non-debugging grades.

tests/debugger/declarative/app.exp2:
tests/debugger/declarative/if_then_else.exp2:
	- Update test case results.

tests/debugger/declarative/Mmakefile:
tests/debugger/declarative/backtrack.m:
tests/debugger/declarative/backtrack.inp:
tests/debugger/declarative/backtrack.exp:
	- New test case.

Index: browser/declarative_debugger.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_debugger.m,v
retrieving revision 1.10
diff -u -r1.10 declarative_debugger.m
--- declarative_debugger.m	2000/02/04 03:45:26	1.10
+++ declarative_debugger.m	2000/02/15 15:27:07
@@ -250,10 +250,10 @@
 trace_root(wrap(Store), dynamic(Ref), Root) :-
 	det_trace_node_from_id(Store, Ref, Node),
 	(
-		Node = fail(_, CallId)
+		Node = fail(_, CallId, RedoId)
 	->
 		call_node_from_id(Store, CallId, Call),
-		Call = call(_, RedoId, CallAtom),
+		Call = call(_, _, CallAtom, _),
 		get_answers(Store, RedoId, [], Answers),
 		Root = missing_answer(CallAtom, Answers)
 	;
@@ -291,7 +291,7 @@
 
 	det_trace_node_from_id(Store, Ref, Node),
 	(
-		Node = fail(PrecId, _)
+		Node = fail(PrecId, _, _)
 	->
 		missing_answer_children(Store, PrecId, [], Children)
 	;
@@ -309,21 +309,21 @@
 wrong_answer_children(Store, NodeId, Ns0, Ns) :-
 	det_trace_node_from_id(Store, NodeId, Node),
 	(
-		Node = call(_, _, _),
+		Node = call(_, _, _, _),
 		Ns = Ns0
 	;
 		Node = neg(_, _, _),
 		Ns = Ns0
 	;
 		Node = exit(_, Call, _, _),
-		call_node_from_id(Store, Call, call(Prec, _, _)),
+		call_node_from_id(Store, Call, call(Prec, _, _, _)),
 		wrong_answer_children(Store, Prec, [dynamic(NodeId) | Ns0], Ns)
 	;
 		Node = redo(_, _),
 		error("wrong_answer_children: unexpected REDO node")
 	;
-		Node = fail(_, Call),
-		call_node_from_id(Store, Call, call(Prec, _, _)),
+		Node = fail(_, Call, _),
+		call_node_from_id(Store, Call, call(Prec, _, _, _)),
 		wrong_answer_children(Store, Prec, [dynamic(NodeId) | Ns0], Ns)
 	;
 		Node = cond(Prec, _, Flag),
@@ -335,12 +335,16 @@
 			Ns = Ns0
 		)
 	;
-		Node = first_disj(Back, _, _),
+		Node = switch(Back, _),
 		wrong_answer_children(Store, Back, Ns0, Ns)
 	;
-		Node = later_disj(_, Back, _),
+		Node = first_disj(Back, _),
 		wrong_answer_children(Store, Back, Ns0, Ns)
 	;
+		Node = later_disj(_, _, FirstDisj),
+		first_disj_node_from_id(Store, FirstDisj, first_disj(Back, _)),
+		wrong_answer_children(Store, Back, Ns0, Ns)
+	;
 		Node = then(Back, _),
 		wrong_answer_children(Store, Back, Ns0, Ns)
 	;
@@ -367,7 +371,7 @@
 missing_answer_children(Store, NodeId, Ns0, Ns) :-
 	det_trace_node_from_id(Store, NodeId, Node),
 	(
-		Node = call(_, _, _),
+		Node = call(_, _, _, _),
 		Ns = Ns0
 	;
 		Node = neg(_, _, _),
@@ -379,7 +383,7 @@
 		->
 			Prec = Prec0
 		;
-			call_node_from_id(Store, Call, call(Prec, _, _))
+			call_node_from_id(Store, Call, call(Prec, _, _, _))
 		),
 		missing_answer_children(Store, Prec, [dynamic(NodeId) | Ns0],
 				Ns)
@@ -388,13 +392,15 @@
 		exit_node_from_id(Store, Exit, exit(Prec, _, _, _)),
 		missing_answer_children(Store, Prec, Ns0, Ns)
 	;
-		Node = fail(_, Call),
-		call_node_from_id(Store, Call, call(Back, Answer, _)),
+		Node = fail(_, CallId, MaybeRedo),
 		(
-			maybe_redo_node_from_id(Store, Answer, redo(Prec, _))
+			maybe_redo_node_from_id(Store, MaybeRedo, Redo)
 		->
+			Redo = redo(Prec, _),
 			Next = Prec
 		;
+			call_node_from_id(Store, CallId, Call),
+			Call = call(Back, _, _, _),
 			Next = Back
 		),
 		missing_answer_children(Store, Next, [dynamic(NodeId) | Ns0],
@@ -409,9 +415,12 @@
 			Ns = Ns0
 		)
 	;
-		Node = first_disj(Prec, _, _),
+		Node = switch(Prec, _),
 		missing_answer_children(Store, Prec, Ns0, Ns)
 	;
+		Node = first_disj(Prec, _),
+		missing_answer_children(Store, Prec, Ns0, Ns)
+	;
 		Node = later_disj(Prec, _, _),
 		missing_answer_children(Store, Prec, Ns0, Ns)
 	;
@@ -433,4 +442,3 @@
 		neg_node_from_id(Store, Neg, neg(Back, _, _)),
 		missing_answer_children(Store, Back, Ns1, Ns)
 	).
-
Index: browser/declarative_execution.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_execution.m,v
retrieving revision 1.2
diff -u -r1.2 declarative_execution.m
--- declarative_execution.m	2000/02/04 03:45:27	1.2
+++ declarative_execution.m	2000/02/15 03:58:38
@@ -7,17 +7,19 @@
 % Author: Mark Brown
 %
 % This module defines a Mercury representation of Mercury program
-% execution.  The declarative debugging infrastructure in the trace
-% directory builds such a representation, using predicates exported
-% from this module.  The debugging front end analyses the structure
+% execution, the annotated trace.  This structure is described in
+% papers/decl_debug.  The declarative debugging infrastructure in the
+% trace directory builds an annotated trace, using predicates exported
+% from this module.  Once built, the structure is passed to the front
+% end (in browser/declarative_debugger.m) where it is analysed
 % to produce a bug diagnosis.
 
 :- module mdb__declarative_execution.
 :- interface.
-:- import_module bool, list, std_util, string, io.
+:- import_module list, std_util, string, io.
 :- import_module mdb__util.
 
-	% This type represents a port in a stored event trace.
+	% This type represents a port in the annotated trace.
 	% The type R is the type of references to other nodes
 	% in the store.
 	%
@@ -29,12 +31,13 @@
 	--->	call(
 			R,			% Preceding event.
 			R,			% Last EXIT or REDO event.
-			trace_atom		% Atom that was called.
+			trace_atom,		% Atom that was called.
+			sequence_number		% Call sequence number.
 		)
 	;	exit(
 			R,			% Preceding event.
 			R,			% CALL event.
-			R,			% Previous REDO event.
+			R,			% Previous REDO event, if any.
 			trace_atom		% Atom in its final state.
 		)
 	;	redo(
@@ -43,17 +46,21 @@
 		)
 	;	fail(
 			R,			% Preceding event.
-			R			% CALL event.
+			R,			% CALL event.
+			R			% Previous REDO event, if any.
+		)
+	;	switch(
+			R,			% Preceding event.
+			goal_path		% Path for this event.
 		)
 	;	first_disj(
 			R,			% Preceding event.
-			goal_path,		% Path for this event.
-			bool			% Was this a switch?
+			goal_path		% Path for this event.
 		)
 	;	later_disj(
 			R,			% Preceding event.
-			R,			% Event before the first DISJ.
-			goal_path		% Path for this event.
+			goal_path,		% Path for this event.
+			R			% Event of the first DISJ.
 		)
 	;	cond(
 			R,			% Preceding event.
@@ -106,8 +113,10 @@
 
 :- type goal_path == goal_path_string.
 
-	% Members of this typeclass represent an entire stored
-	% event trace.  The second parameter is the type of identifiers
+:- type sequence_number == int.
+
+	% Members of this typeclass represent an entire annotated
+	% trace.  The second parameter is the type of identifiers
 	% for trace nodes, and the first parameter is the type of
 	% an abstract mapping from the identfiers to the nodes they
 	% identify.
@@ -129,7 +138,7 @@
 :- pred det_trace_node_from_id(S, R, trace_node(R)) <= execution_tree(S, R).
 :- mode det_trace_node_from_id(in, in, out) is det.
 
-:- inst trace_node_call = bound(call(ground, ground, ground)).
+:- inst trace_node_call = bound(call(ground, ground, ground, ground)).
 
 :- pred call_node_from_id(S, R, trace_node(R)) <= execution_tree(S, R).
 :- mode call_node_from_id(in, in, out(trace_node_call)) is det.
@@ -157,6 +166,17 @@
 :- pred neg_node_from_id(S, R, trace_node(R)) <= execution_tree(S, R).
 :- mode neg_node_from_id(in, in, out(trace_node_neg)) is det.
 
+:- inst trace_node_first_disj = bound(first_disj(ground, ground)).
+
+:- pred first_disj_node_from_id(S, R, trace_node(R)) <= execution_tree(S, R).
+:- mode first_disj_node_from_id(in, in, out(trace_node_first_disj)) is det.
+
+:- inst trace_node_disj = bound(first_disj(ground, ground);
+				later_disj(ground, ground, ground)).
+
+:- pred disj_node_from_id(S, R, trace_node(R)) <= execution_tree(S, R).
+:- mode disj_node_from_id(in, in, out(trace_node_disj)) is det.
+
 	% Load an execution tree which was previously saved by
 	% the back end.
 	%
@@ -207,7 +227,7 @@
 call_node_from_id(Store, NodeId, Node) :-
 	(
 		trace_node_from_id(Store, NodeId, Node0),
-		Node0 = call(_, _, _)
+		Node0 = call(_, _, _, _)
 	->
 		Node = Node0
 	;
@@ -254,6 +274,28 @@
 		error("neg_node_from_id: not a NEG node")
 	).
 
+first_disj_node_from_id(Store, NodeId, Node) :-
+	(
+		trace_node_from_id(Store, NodeId, Node0),
+		Node0 = first_disj(_, _)
+	->
+		Node = Node0
+	;
+		error("first_disj_node_from_id: not a first DISJ node")
+	).
+
+disj_node_from_id(Store, NodeId, Node) :-
+	(
+		trace_node_from_id(Store, NodeId, Node0),
+		( Node0 = first_disj(_, _)
+		; Node0 = later_disj(_, _, _)
+		)
+	->
+		Node = Node0
+	;
+		error("disj_node_from_id: not a DISJ node")
+	).
+
 %-----------------------------------------------------------------------------%
 
 :- instance execution_tree(trace_node_store, trace_node_id) where [
@@ -296,12 +338,12 @@
 :- pragma export(trace_node_port(in) = out,
 		"MR_DD_trace_node_port").
 
-trace_node_port(call(_, _, _))		= call.
+trace_node_port(call(_, _, _, _))	= call.
 trace_node_port(exit(_, _, _, _))	= exit.
 trace_node_port(redo(_, _))		= redo.
-trace_node_port(fail(_, _))		= fail.
-trace_node_port(first_disj(_, _, yes))	= switch.
-trace_node_port(first_disj(_, _, no))	= disj.
+trace_node_port(fail(_, _, _))		= fail.
+trace_node_port(switch(_, _))		= switch.
+trace_node_port(first_disj(_, _))	= disj.
 trace_node_port(later_disj(_, _, _))	= disj.
 trace_node_port(cond(_, _, _))		= ite_cond.
 trace_node_port(then(_, _))		= ite_then.
@@ -315,12 +357,13 @@
 :- pragma export(trace_node_path(in, in) = out,
 		"MR_DD_trace_node_path").
 
-trace_node_path(_, call(_, _, _)) = "".
+trace_node_path(_, call(_, _, _, _)) = "".
 trace_node_path(_, exit(_, _, _, _)) = "".
 trace_node_path(_, redo(_, _)) = "".
-trace_node_path(_, fail(_, _)) = "".
-trace_node_path(_, first_disj(_, P, _)) = P.
-trace_node_path(_, later_disj(_, _, P)) = P.
+trace_node_path(_, fail(_, _, _)) = "".
+trace_node_path(_, switch(_, P)) = P.
+trace_node_path(_, first_disj(_, P)) = P.
+trace_node_path(_, later_disj(_, P, _)) = P.
 trace_node_path(_, cond(_, P, _)) = P.
 trace_node_path(S, then(_, Cond)) = P :-
 	cond_node_from_id(S, Cond, cond(_, P, _)).
@@ -331,54 +374,149 @@
 	neg_node_from_id(S, Neg, neg(_, P, _)).
 trace_node_path(S, neg_fail(_, Neg)) = P :-
 	neg_node_from_id(S, Neg, neg(_, P, _)).
+
+:- pred trace_node_seqno(trace_node_store, trace_node(trace_node_id),
+		sequence_number).
+:- mode trace_node_seqno(in, in, out) is semidet.
+
+:- pragma export(trace_node_seqno(in, in, out), "MR_DD_trace_node_seqno").
+
+trace_node_seqno(S, Node, SeqNo) :-
+	(
+		Node = call(_, _, _, SeqNo0)
+	->
+		SeqNo = SeqNo0
+	;
+		trace_node_call(S, Node, Call),
+		call_node_from_id(S, Call, call(_, _, _, SeqNo))
+	).
+
+:- pred trace_node_call(trace_node_store, trace_node(trace_node_id),
+		trace_node_id).
+:- mode trace_node_call(in, in, out) is semidet.
+
+:- pragma export(trace_node_call(in, in, out), "MR_DD_trace_node_call").
+
+trace_node_call(_, exit(_, Call, _, _), Call).
+trace_node_call(S, redo(_, Exit), Call) :-
+	exit_node_from_id(S, Exit, exit(_, Call, _, _)).
+trace_node_call(_, fail(_, Call, _), Call).
+
+:- pred trace_node_first_disj(trace_node(trace_node_id), trace_node_id).
+:- mode trace_node_first_disj(in, out) is semidet.
 
-	% Given any node in a stored event trace, find the most recent
+:- pragma export(trace_node_first_disj(in, out),
+		"MR_DD_trace_node_first_disj").
+
+trace_node_first_disj(first_disj(_, _), NULL) :-
+	null_trace_node_id(NULL).
+trace_node_first_disj(later_disj(_, _, FirstDisj), FirstDisj).	
+
+	% Given any node in an annotated trace, find the most recent
 	% node in the same context which has not been backtracked over,
 	% skipping negations, conditions, the bodies of calls, and
 	% alternative disjuncts.  Return the NULL reference if there
 	% is no such node (eg. if we are at the start of a negation,
 	% condition, or call).
 	%
-:- func scan_backwards(trace_node_store, trace_node(trace_node_id))
+:- func step_left_in_context(trace_node_store, trace_node(trace_node_id))
 		= trace_node_id.
-:- pragma export(scan_backwards(in, in) = out,
-		"MR_DD_scan_backwards").
+:- pragma export(step_left_in_context(in, in) = out,
+		"MR_DD_step_left_in_context").
 
-scan_backwards(_, call(_, _, _)) = NULL :-
-	null_trace_node_id(NULL).
-scan_backwards(_, cond(_, _, _)) = NULL :-
-	null_trace_node_id(NULL).
-scan_backwards(_, neg(_, _, _)) = NULL :-
-	null_trace_node_id(NULL).
-scan_backwards(Store, exit(_, Call, _, _)) = Prec :-
-	call_node_from_id(Store, Call, call(Prec, _, _)).
-scan_backwards(Store, fail(_, Call)) = Prec :-
-	call_node_from_id(Store, Call, call(Prec, _, _)).
-scan_backwards(Store, redo(_, Exit)) = Prec :-
-	exit_node_from_id(Store, Exit, exit(Prec, _, _, _)).
-scan_backwards(_, first_disj(Prec, _, _)) = Prec.
-scan_backwards(_, later_disj(_, Back, _)) = Back.
-scan_backwards(Store, then(_, Cond)) = Prec :-
-	cond_node_from_id(Store, Cond, cond(Prec, _, _)).
-scan_backwards(Store, else(_, Cond)) = Prec :-
+step_left_in_context(_, call(_, _, _, _)) = _ :-
+	error("step_left_in_context: unexpected CALL node").
+step_left_in_context(_, cond(Prec, _, Status)) = Node :-
+	(
+		Status = succeeded
+	->
+		Node = Prec
+	;
+		null_trace_node_id(Node)
+	).
+step_left_in_context(_, neg(_, _, _)) = _ :-
+	error("step_left_in_context: unexpected NEGE node").
+step_left_in_context(Store, exit(_, Call, _, _)) = Prec :-
+	call_node_from_id(Store, Call, call(Prec, _, _, _)).
+step_left_in_context(Store, fail(_, Call, _)) = Prec :-
+	call_node_from_id(Store, Call, call(Prec, _, _, _)).
+step_left_in_context(_, redo(_, _)) = _ :-
+	error("step_left_in_context: unexpected REDO node").
+step_left_in_context(_, switch(Prec, _)) = Prec.
+step_left_in_context(_, first_disj(Prec, _)) = Prec.
+step_left_in_context(Store, later_disj(_, _, FirstDisj)) = Prec :-
+	first_disj_node_from_id(Store, FirstDisj, first_disj(Prec, _)).
+step_left_in_context(_, then(Prec, _)) = Prec.
+step_left_in_context(Store, else(_, Cond)) = Prec :-
 	cond_node_from_id(Store, Cond, cond(Prec, _, _)).
-scan_backwards(Store, neg_succ(_, Neg)) = Prec :-
+step_left_in_context(Store, neg_succ(_, Neg)) = Prec :-
 	neg_node_from_id(Store, Neg, neg(Prec, _, _)).
-scan_backwards(Store, neg_fail(_, Neg)) = Prec :-
+step_left_in_context(Store, neg_fail(_, Neg)) = Prec :-
 	neg_node_from_id(Store, Neg, neg(Prec, _, _)).
 
+	% Given any node in an annotated trace, find a node in
+	% the previous contour.
 	%
+:- func find_prev_contour(trace_node_store, trace_node_id)
+		= trace_node_id.
+:- pragma export(find_prev_contour(in, in) = out,
+		"MR_DD_find_prev_contour").
+
+find_prev_contour(Store, NodeId) = OnContour :-
+	det_trace_node_from_id(Store, NodeId, Node),
+	find_prev_contour_1(Store, NodeId, Node, OnContour).
+
+:- pred find_prev_contour_1(trace_node_store, trace_node_id,
+		trace_node(trace_node_id), trace_node_id).
+:- mode find_prev_contour_1(in, in, in, out) is det.
+
+find_prev_contour_1(_, _, call(_, _, _, _), _) :-
+	error("find_prev_contour: reached CALL node").
+find_prev_contour_1(_, Exit, exit(_, _, _, _), Exit).
+find_prev_contour_1(Store, _, redo(_, Exit), OnContour) :-
+	exit_node_from_id(Store, Exit, exit(OnContour, _, _, _)).
+find_prev_contour_1(Store, _, fail(_, Call, _), OnContour) :-
+	call_node_from_id(Store, Call, call(OnContour, _, _, _)).
+find_prev_contour_1(_, _, cond(_, _, _), _) :-
+	error("find_prev_contour: reached COND node").
+find_prev_contour_1(_, Then, then(_, _), Then).
+find_prev_contour_1(_, Else, else(_, _), Else).
+find_prev_contour_1(_, _, neg(_, _, _), _) :-
+	error("find_prev_contour: reached NEGE node").
+find_prev_contour_1(_, NegS, neg_succ(_, _), NegS).
+find_prev_contour_1(Store, _, neg_fail(_, Neg), OnContour) :-
+	neg_node_from_id(Store, Neg, neg(OnContour, _, _)).
+find_prev_contour_1(_, Swtc, switch(_, _), Swtc).
+find_prev_contour_1(_, FirstDisj, first_disj(_, _), FirstDisj).
+find_prev_contour_1(_, LaterDisj, later_disj(_, _, _), LaterDisj).
+
+	% Print a text representation of a trace node, useful
+	% for debugging purposes.
+	%
+:- pred print_trace_node(io__output_stream, trace_node(trace_node_id),
+		io__state, io__state).
+:- mode print_trace_node(in, in, di, uo) is det.
+:- pragma export(print_trace_node(in, in, di, uo), "MR_DD_print_trace_node").
+
+print_trace_node(OutStr, Node) -->
+	{ convert_node(Node, CNode) },
+	io__write(OutStr, CNode).
+
+%-----------------------------------------------------------------------------%
+
+	%
 	% Each node type has a Mercury function which constructs
 	% a node of that type.  The functions are exported to C so
 	% that the back end can build an execution tree.
 	%
 
-:- func construct_call_node(trace_node_id, trace_atom)
+:- func construct_call_node(trace_node_id, trace_atom, sequence_number)
 		= trace_node(trace_node_id).
-:- pragma export(construct_call_node(in, in) = out,
+:- pragma export(construct_call_node(in, in, in) = out,
 		"MR_DD_construct_call_node").
 
-construct_call_node(Preceding, Atom) = call(Preceding, Answer, Atom) :-
+construct_call_node(Preceding, Atom, SeqNo) = Call :-
+	Call = call(Preceding, Answer, Atom, SeqNo),
 	null_trace_node_id(Answer).
 
 
@@ -387,8 +525,8 @@
 :- pragma export(construct_exit_node(in, in, in, in) = out,
 		"MR_DD_construct_exit_node").
 
-construct_exit_node(Preceding, Call, Previous, Atom)
-		= exit(Preceding, Call, Previous, Atom).
+construct_exit_node(Preceding, Call, MaybeRedo, Atom)
+		= exit(Preceding, Call, MaybeRedo, Atom).
 
 
 :- func construct_redo_node(trace_node_id, trace_node_id)
@@ -399,30 +537,45 @@
 construct_redo_node(Preceding, Exit) = redo(Preceding, Exit).
 
 
-:- func construct_fail_node(trace_node_id, trace_node_id)
+:- func construct_fail_node(trace_node_id, trace_node_id, trace_node_id)
 		= trace_node(trace_node_id).
-:- pragma export(construct_fail_node(in, in) = out,
+:- pragma export(construct_fail_node(in, in, in) = out,
 		"MR_DD_construct_fail_node").
+
+construct_fail_node(Preceding, Call, Redo) = fail(Preceding, Call, Redo).
 
-construct_fail_node(Preceding, Call) = fail(Preceding, Call).
 
+:- func construct_switch_node(trace_node_id, goal_path_string)
+		= trace_node(trace_node_id).
+:- pragma export(construct_switch_node(in, in) = out,
+		"MR_DD_construct_switch_node").
+
+construct_switch_node(Preceding, Path) =
+		switch(Preceding, Path).
 
-:- func construct_first_disj_node(trace_node_id, goal_path_string, bool)
+:- func construct_first_disj_node(trace_node_id, goal_path_string)
 		= trace_node(trace_node_id).
-:- pragma export(construct_first_disj_node(in, in, in) = out,
+:- pragma export(construct_first_disj_node(in, in) = out,
 		"MR_DD_construct_first_disj_node").
 
-construct_first_disj_node(Preceding, Path, Flag) =
-		first_disj(Preceding, Path, Flag).
+construct_first_disj_node(Preceding, Path) =
+		first_disj(Preceding, Path).
 
 
-:- func construct_later_disj_node(trace_node_id, trace_node_id,
-		goal_path_string) = trace_node(trace_node_id).
-:- pragma export(construct_later_disj_node(in, in, in) = out,
+:- func construct_later_disj_node(trace_node_store, trace_node_id,
+		goal_path_string, trace_node_id) = trace_node(trace_node_id).
+:- pragma export(construct_later_disj_node(in, in, in, in) = out,
 		"MR_DD_construct_later_disj_node").
 
-construct_later_disj_node(Preceding, Back, Path)
-		= later_disj(Preceding, Back, Path).
+construct_later_disj_node(Store, Preceding, Path, PrevDisj)
+		= later_disj(Preceding, Path, FirstDisj) :-
+	disj_node_from_id(Store, PrevDisj, PrevDisjNode),
+	(
+		PrevDisjNode = first_disj(_, _),
+		FirstDisj = PrevDisj
+	;
+		PrevDisjNode = later_disj(_, _, FirstDisj)
+	).
 
 
 :- func construct_cond_node(trace_node_id, goal_path_string)
@@ -574,17 +727,18 @@
 		[will_not_call_mercury, thread_safe],
 		"N2 = N1;").
 
-	% Given a node in a stored trace, return a reference to
+	% Given a node in an annotated trace, return a reference to
 	% the preceding node in the trace, or a NULL reference if
 	% it is the first.
 	%
 :- func preceding_node(trace_node(T)) = T.
 
-preceding_node(call(P, _, _))		= P.
+preceding_node(call(P, _, _, _))	= P.
 preceding_node(exit(P, _, _, _))	= P.
 preceding_node(redo(P, _))		= P.
-preceding_node(fail(P, _))		= P.
-preceding_node(first_disj(P, _, _))	= P.
+preceding_node(fail(P, _, _))		= P.
+preceding_node(switch(P, _))		= P.
+preceding_node(first_disj(P, _))	= P.
 preceding_node(later_disj(P, _, _))	= P.
 preceding_node(cond(P, _, _))		= P.
 preceding_node(then(P, _))		= P.
Index: runtime/mercury_conf_param.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_conf_param.h,v
retrieving revision 1.33
diff -u -r1.33 mercury_conf_param.h
--- mercury_conf_param.h	2000/01/11 00:10:15	1.33
+++ mercury_conf_param.h	2000/02/15 16:18:12
@@ -322,6 +322,10 @@
 /*
 ** MR_USE_DECLARATIVE_DEBUGGER -- include support for declarative
 **				  debugging in the internal debugger.
+**
+** MR_USE_DECL_STACK_SLOT      -- reserve a stack slot for use by the
+**				  declarative debugger.  Requires programs
+**				  to be compiled with the flag `--trace-decl'.
 */
 
 #if defined(CONSERVATIVE_GC) && !defined(MR_DISABLE_DECLARATIVE_DEBUGGER)
Index: tests/debugger/declarative/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/Mmakefile,v
retrieving revision 1.10
diff -u -r1.10 Mmakefile
--- Mmakefile	2000/01/21 02:44:26	1.10
+++ Mmakefile	2000/02/15 17:26:21
@@ -19,6 +19,7 @@
 DECLARATIVE_PROGS=		\
 	aadebug			\
 	app			\
+	backtrack		\
 	big			\
 	gcf			\
 	if_then_else		\
@@ -36,7 +37,6 @@
 	ite_2			\
 	solutions
 
-
 MCFLAGS = --trace deep --trace-decl
 MLFLAGS = --trace
 C2INITFLAGS = --trace
@@ -74,6 +74,9 @@
 
 app.out: app app.inp
 	$(MDB) ./app < app.inp > app.out 2>&1
+
+backtrack.out: backtrack backtrack.inp
+	$(MDB) ./backtrack < backtrack.inp > backtrack.out 2>&1
 
 big.out: big big.inp
 	$(MDB) ./big < big.inp > big.out 2>&1
Index: tests/debugger/declarative/aadebug.exp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/aadebug.exp,v
retrieving revision 1.1
diff -u -r1.1 aadebug.exp
--- aadebug.exp	2000/01/21 02:44:27	1.1
+++ aadebug.exp	2000/02/14 14:35:50
@@ -5,55 +5,67 @@
 mdb> break p
  0: + stop  interface pred aadebug:p/2-0 (nondet)
 mdb> continue
-       3:      2  2 CALL pred aadebug:p/2-0 (nondet) aadebug.m:18 (aadebug.m:9)
+       3:      2  2 CALL pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
 mdb> finish
-      15:      2  2 EXIT pred aadebug:p/2-0 (nondet) aadebug.m:18 (aadebug.m:9)
+      15:      2  2 EXIT pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
 mdb> dd
-atom("p", [univ(1 : int), univ(27 : int)])
+atom("p", [univ('a' : character), univ(30 : int)])
 Valid? no
-atom("q", [univ(1 : int), univ(1 : int)])
+atom("q", [univ('a' : character), univ('a' : character)])
 Valid? yes
-atom("r", [univ(1 : int), univ(9 : int)])
+atom("r", [univ('a' : character), univ(10 : int)])
 Valid? yes
-atom("s", [univ(9 : int), univ(27 : int)])
+atom("s", [univ(10 : int), univ(30 : int)])
 Valid? yes
 Incorrect node found:
-wrong_answer(atom("p", [univ(1 : int), univ(27 : int)]))
-      15:      2  2 EXIT pred aadebug:p/2-0 (nondet) aadebug.m:18 (aadebug.m:9)
+wrong_answer(atom("p", [univ('a' : character), univ(30 : int)]))
+      15:      2  2 EXIT pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
 mdb> continue
-      16:      2  2 REDO pred aadebug:p/2-0 (nondet) aadebug.m:18 (aadebug.m:9)
+      18:      2  2 REDO pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
 mdb> finish
-      18:      2  2 EXIT pred aadebug:p/2-0 (nondet) aadebug.m:18 (aadebug.m:9)
+      20:      2  2 EXIT pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
 mdb> dd
-atom("p", [univ(1 : int), univ(1 : int)])
+atom("p", [univ('a' : character), univ(31 : int)])
 Valid? no
 Incorrect node found:
-wrong_answer(atom("p", [univ(1 : int), univ(1 : int)]))
-      18:      2  2 EXIT pred aadebug:p/2-0 (nondet) aadebug.m:18 (aadebug.m:9)
+wrong_answer(atom("p", [univ('a' : character), univ(31 : int)]))
+      20:      2  2 EXIT pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
 mdb> continue
-      19:      2  2 REDO pred aadebug:p/2-0 (nondet) aadebug.m:18 (aadebug.m:9)
+      23:      2  2 REDO pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
 mdb> finish
-      34:      2  2 FAIL pred aadebug:p/2-0 (nondet) aadebug.m:18 (aadebug.m:9)
+      35:      2  2 EXIT pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
 mdb> dd
-Call atom("p", [univ(1 : int)])
-Solutions:
-	atom("p", [univ(1 : int), univ(27 : int)])
-	atom("p", [univ(1 : int), univ(1 : int)])
-Complete? no
-atom("q", [univ(1 : int), univ(2 : int)])
+atom("p", [univ('a' : character), univ(32 : int)])
+Valid? no
+atom("q", [univ('a' : character), univ('b' : character)])
 Valid? yes
-Call atom("r", [univ(2 : int)])
+Call atom("r", [univ('b' : character)])
 Solutions:
 Complete? yes
-atom("q", [univ(2 : int), univ(4 : int)])
-Valid? yes
-Call atom("q", [univ(1 : int)])
+Call atom("q", [univ('b' : character)])
+Solutions:
+Complete? yes
+Incorrect node found:
+wrong_answer(atom("p", [univ('a' : character), univ(32 : int)]))
+      35:      2  2 EXIT pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
+mdb> continue
+      38:      2  2 REDO pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
+mdb> finish
+      41:      2  2 FAIL pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
+mdb> dd
+Call atom("p", [univ('a' : character)])
+Solutions:
+	atom("p", [univ('a' : character), univ(30 : int)])
+	atom("p", [univ('a' : character), univ(31 : int)])
+	atom("p", [univ('a' : character), univ(32 : int)])
+Complete? no
+Call atom("q", [univ('a' : character)])
 Solutions:
-	atom("q", [univ(1 : int), univ(1 : int)])
-	atom("q", [univ(1 : int), univ(2 : int)])
+	atom("q", [univ('a' : character), univ('a' : character)])
+	atom("q", [univ('a' : character), univ('b' : character)])
 Complete? yes
 Incorrect node found:
-missing_answer(atom("p", [univ(1 : int)]), [atom("p", [univ(1 : int), univ(27 : int)]), atom("p", [univ(1 : int), univ(1 : int)])])
-      34:      2  2 FAIL pred aadebug:p/2-0 (nondet) aadebug.m:18 (aadebug.m:9)
+missing_answer(atom("p", [univ('a' : character)]), [atom("p", [univ('a' : character), univ(30 : int)]), atom("p", [univ('a' : character), univ(31 : int)]), atom("p", [univ('a' : character), univ(32 : int)])])
+      41:      2  2 FAIL pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
 mdb> continue
 no
Index: tests/debugger/declarative/aadebug.inp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/aadebug.inp,v
retrieving revision 1.1
diff -u -r1.1 aadebug.inp
--- aadebug.inp	2000/01/21 02:44:27	1.1
+++ aadebug.inp	2000/02/15 04:28:21
@@ -19,6 +19,10 @@
 yes
 yes
 yes
+continue
+finish
+dd
+no
 yes
 continue
 
Index: tests/debugger/declarative/aadebug.m
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/aadebug.m,v
retrieving revision 1.1
diff -u -r1.1 aadebug.m
--- aadebug.m	2000/01/21 02:44:27	1.1
+++ aadebug.m	2000/02/15 04:23:48
@@ -3,16 +3,22 @@
 :- import_module io.
 :- pred main(io__state::di, io__state::uo) is det.
 :- implementation.
-:- import_module int.
+:- import_module int, std_util.
 
 main -->
-	( { p(1, -1) } ->
+	( { p('a', X), test(X) } ->
 		io__write_string("yes\n")
 	;
 		io__write_string("no\n")
 	).
 
-:- pred p(int, int).
+:- pred test(int).
+:- mode test(in) is semidet.
+
+test(_) :-
+	semidet_fail.
+
+:- pred p(character, int).
 :- mode p(in, out) is nondet.
 
 p(A, D) :-
@@ -23,28 +29,29 @@
 		(
 			s(C, D)
 		;
-			D = 1
+			D = 31
 		)
 	;
-		not q(B, _),
-		D = 2
+		not(
+			q(B, _)
+		),
+		D = 32
 	).
 
-:- pred q(int, int).
+:- pred q(character, character).
 :- mode q(in, out) is nondet.
 
-q(1, 1).
-q(1, 2).
-q(2, 4).
+q('a', 'a').
+q('a', 'b').
+q('c', 'c').
 
-:- pred r(int, int).
+:- pred r(character, int).
 :- mode r(in, out) is semidet.
 
-r(1, 9).
+r('a', 10).
 
 :- pred s(int, int).
 :- mode s(in, out) is det.
 
-s(A, B) :-
-	B = A * 3.
+s(N, 3 * N).
 
Index: tests/debugger/declarative/app.exp2
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/app.exp2,v
retrieving revision 1.2
diff -u -r1.2 app.exp2
--- app.exp2	2000/01/21 02:44:28	1.2
+++ app.exp2	2000/02/15 16:34:44
@@ -36,9 +36,9 @@
       19:      2  2 EXIT pred app:app/3-0 (det) app.m:26 (app.m:13)
 mdb> continue
 append([1, 2, 3, 4, 5], [6, 7, 8], [1, 2, 3, 4, 5, 6, 7, 8]).
-      24:    347  2 CALL pred app:app/3-0 (det) app.m:26 (app.m:18)
+      24:    395  2 CALL pred app:app/3-0 (det) app.m:26 (app.m:18)
 mdb> finish -n
-      71:    347  2 EXIT pred app:app/3-0 (det) app.m:26 (app.m:18)
+      71:    395  2 EXIT pred app:app/3-0 (det) app.m:26 (app.m:18)
 mdb> dd
 atom("app", [univ([1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 1, 2, 3, 4, 5] : list:list(int)), univ([6, 7, 8] : list:list(int)), univ([1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 1, 2, 3, 4, 5, 6, 7, 8] : list:list(int)), univ(int : private_builtin:type_info(int))])
 Valid? no
@@ -62,6 +62,6 @@
 Valid? no
 Incorrect node found:
 wrong_answer(atom("app", [univ([3, 4, 5] : list:list(int)), univ([6, 7, 8] : list:list(int)), univ([3, 4, 5, 6, 7, 8] : list:list(int)), univ(int : private_builtin:type_info(int))]))
-      71:    347  2 EXIT pred app:app/3-0 (det) app.m:26 (app.m:18)
+      71:    395  2 EXIT pred app:app/3-0 (det) app.m:26 (app.m:18)
 mdb> continue
 append([1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 1, 2, 3, 4, 5], [6, 7, 8], [1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 1, 2, 3, 4, 5, 6, 7, 8]).
Index: tests/debugger/declarative/if_then_else.exp2
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/if_then_else.exp2,v
retrieving revision 1.2
diff -u -r1.2 if_then_else.exp2
--- if_then_else.exp2	2000/01/21 02:44:30	1.2
+++ if_then_else.exp2	2000/02/15 16:36:58
@@ -20,9 +20,9 @@
        9:      2  2 EXIT pred if_then_else:ite/2-0 (det) if_then_else.m:22 (if_then_else.m:8)
 mdb> continue
 ite(0, 1).
-      16:    261  2 CALL pred if_then_else:ite/2-0 (det) if_then_else.m:22 (if_then_else.m:12)
+      16:    280  2 CALL pred if_then_else:ite/2-0 (det) if_then_else.m:22 (if_then_else.m:12)
 mdb> finish
-      23:    261  2 EXIT pred if_then_else:ite/2-0 (det) if_then_else.m:22 (if_then_else.m:12)
+      23:    280  2 EXIT pred if_then_else:ite/2-0 (det) if_then_else.m:22 (if_then_else.m:12)
 mdb> dd
 atom("ite", [univ(1 : int), univ(0 : int)])
 Valid? no
@@ -31,6 +31,6 @@
 Complete? yes
 Incorrect node found:
 wrong_answer(atom("ite", [univ(1 : int), univ(0 : int)]))
-      23:    261  2 EXIT pred if_then_else:ite/2-0 (det) if_then_else.m:22 (if_then_else.m:12)
+      23:    280  2 EXIT pred if_then_else:ite/2-0 (det) if_then_else.m:22 (if_then_else.m:12)
 mdb> continue
 ite(1, 0).
Index: tests/debugger/declarative/propositional.exp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/propositional.exp,v
retrieving revision 1.4
diff -u -r1.4 propositional.exp
--- propositional.exp	2000/01/21 02:44:33	1.4
+++ propositional.exp	2000/02/15 17:13:57
@@ -14,9 +14,9 @@
 atom("a", [])
 Valid? no
 atom("c", [])
-Valid? no
+Valid? yes
 Incorrect node found:
-wrong_answer(atom("c", []))
+wrong_answer(atom("a", []))
       11:      2  2 EXIT pred propositional:a/0-0 (semidet) propositional.m:27 (propositional.m:10)
 mdb> continue
       12:      5  2 CALL pred propositional:b/0-0 (semidet) propositional.m:29 (propositional.m:10)
Index: tests/debugger/declarative/propositional.exp2
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/propositional.exp2,v
retrieving revision 1.2
diff -u -r1.2 propositional.exp2
--- propositional.exp2	2000/01/21 02:44:33	1.2
+++ propositional.exp2	2000/02/15 16:52:05
@@ -14,14 +14,14 @@
 atom("a", [])
 Valid? no
 atom("c", [])
-Valid? no
+Valid? yes
 Incorrect node found:
-wrong_answer(atom("c", []))
+wrong_answer(atom("a", []))
       15:      2  2 EXIT pred propositional:a/0-0 (semidet) propositional.m:27 (propositional.m:10)
 mdb> continue
-      16:    203  2 CALL pred propositional:b/0-0 (semidet) propositional.m:29 (propositional.m:10)
+      16:    235  2 CALL pred propositional:b/0-0 (semidet) propositional.m:29 (propositional.m:10)
 mdb> finish
-      30:    203  2 EXIT pred propositional:b/0-0 (semidet) propositional.m:29 (propositional.m:10)
+      30:    235  2 EXIT pred propositional:b/0-0 (semidet) propositional.m:29 (propositional.m:10)
 mdb> dd
 atom("b", [])
 Valid? no
@@ -31,6 +31,6 @@
 Valid? yes
 Incorrect node found:
 wrong_answer(atom("f", []))
-      30:    203  2 EXIT pred propositional:b/0-0 (semidet) propositional.m:29 (propositional.m:10)
+      30:    235  2 EXIT pred propositional:b/0-0 (semidet) propositional.m:29 (propositional.m:10)
 mdb> continue
 yes
Index: tests/debugger/declarative/propositional.inp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/propositional.inp,v
retrieving revision 1.3
diff -u -r1.3 propositional.inp
--- propositional.inp	2000/01/21 02:44:34	1.3
+++ propositional.inp	2000/02/15 16:47:37
@@ -6,7 +6,7 @@
 finish
 dd
 no
-no
+yes
 continue
 finish
 dd
Index: trace/mercury_trace_declarative.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_declarative.c,v
retrieving revision 1.15
diff -u -r1.15 mercury_trace_declarative.c
--- mercury_trace_declarative.c	2000/02/04 03:45:42	1.15
+++ mercury_trace_declarative.c	2000/02/15 16:31:07
@@ -9,9 +9,9 @@
 **
 ** This file implements the back end of the declarative debugger.  The
 ** back end is an extension to the internal debugger which collects
-** related trace events and builds them into an execution tree.  Once
-** built, the tree is passed to the front end where it can be analysed
-** to find bugs.  The front end is implemented in
+** related trace events and builds them into an annotated trace.  Once
+** built, the structure is passed to the front end where it can be
+** analysed to find bugs.  The front end is implemented in
 ** browse/declarative_debugger.m.
 **
 ** The interface between the front and back ends is via the
@@ -39,7 +39,9 @@
 #include "mercury_trace_util.h"
 #include "mercury_layout_util.h"
 #include "mercury_deep_copy.h"
+#include "mercury_stack_trace.h"
 #include "mercury_string.h"
+#include "mercury_trace_base.h"
 #include "mdb.declarative_debugger.h"
 #include "mdb.declarative_execution.h"
 #include "std_util.h"
@@ -47,13 +49,47 @@
 #include <errno.h>
 
 /*
-** We only build the execution tree to a certain depth.  The following
-** macro gives the default depth limit (relative to the starting depth).
+** We only build the annotated trace for events down to a certain
+** depth.  The following macro gives the default depth limit (relative
+** to the starting depth).  In future it would be nice to dynamically
+** adjust this factor based on profiling information.
 */
 
 #define MR_EDT_DEPTH_STEP_SIZE		128
 
 /*
+** These macros are to aid debugging of the code which constructs
+** the annotated trace.
+*/
+
+#ifdef MR_DEBUG_DD_BACK_END
+
+#define MR_decl_checkpoint_event(event_info)				\
+		MR_decl_checkpoint_event_imp(event_info)
+
+#define MR_decl_checkpoint_find(location)				\
+		MR_decl_checkpoint_loc("FIND", location)
+
+#define MR_decl_checkpoint_step(location)				\
+		MR_decl_checkpoint_loc("STEP", location)
+
+#define MR_decl_checkpoint_match(location)				\
+		MR_decl_checkpoint_loc("MATCH", location)
+
+#define MR_decl_checkpoint_alloc(location)				\
+		MR_decl_checkpoint_loc("ALLOC", location)
+
+#else /* !MR_DEBUG_DD_BACK_END */
+
+#define MR_decl_checkpoint_event(event_info)
+#define MR_decl_checkpoint_find(location)
+#define MR_decl_checkpoint_step(location)
+#define MR_decl_checkpoint_match(location)
+#define MR_decl_checkpoint_alloc(location)
+
+#endif
+
+/*
 ** The declarative debugger back end is controlled by the
 ** settings of the following variables.  They are set in
 ** MR_trace_start_decl_debug when the back end is started.  They
@@ -101,35 +137,41 @@
 
 static	FILE		*MR_trace_store_file;
 
-static	void
-MR_trace_decl_call(MR_Event_Info *event_info);
+static	MR_Trace_Node
+MR_trace_decl_call(MR_Event_Info *event_info, MR_Trace_Node prev);
 
-static	void
-MR_trace_decl_exit(MR_Event_Info *event_info);
+static	MR_Trace_Node
+MR_trace_decl_exit(MR_Event_Info *event_info, MR_Trace_Node prev);
 
-static	void
-MR_trace_decl_redo(MR_Event_Info *event_info);
+static	MR_Trace_Node
+MR_trace_decl_redo(MR_Event_Info *event_info, MR_Trace_Node prev);
 
-static	void
-MR_trace_decl_fail(MR_Event_Info *event_info);
+static	MR_Trace_Node
+MR_trace_decl_fail(MR_Event_Info *event_info, MR_Trace_Node prev);
 
-static	void
-MR_trace_decl_switch(MR_Event_Info *event_info);
+static	MR_Trace_Node
+MR_trace_decl_switch(MR_Event_Info *event_info, MR_Trace_Node prev);
 
-static	void
-MR_trace_decl_disj(MR_Event_Info *event_info);
+static	MR_Trace_Node
+MR_trace_decl_disj(MR_Event_Info *event_info, MR_Trace_Node prev);
 
-static	void
-MR_trace_decl_cond(MR_Event_Info *event_info);
+static	MR_Trace_Node
+MR_trace_decl_cond(MR_Event_Info *event_info, MR_Trace_Node prev);
 
-static	void
-MR_trace_decl_then_else(MR_Event_Info *event_info);
+static	MR_Trace_Node
+MR_trace_decl_then(MR_Event_Info *event_info, MR_Trace_Node prev);
 
-static	void
-MR_trace_decl_enter_neg(MR_Event_Info *event_info);
+static	MR_Trace_Node
+MR_trace_decl_else(MR_Event_Info *event_info, MR_Trace_Node prev);
 
-static	void
-MR_trace_decl_leave_neg(MR_Event_Info *event_info);
+static	MR_Trace_Node
+MR_trace_decl_neg_enter(MR_Event_Info *event_info, MR_Trace_Node prev);
+
+static	MR_Trace_Node
+MR_trace_decl_neg_success(MR_Event_Info *event_info, MR_Trace_Node prev);
+
+static	MR_Trace_Node
+MR_trace_decl_neg_failure(MR_Event_Info *event_info, MR_Trace_Node prev);
 
 static	MR_Trace_Node
 MR_trace_decl_get_slot(const MR_Stack_Layout_Entry *entry, Word *saved_regs);
@@ -138,6 +180,12 @@
 MR_trace_decl_set_slot(const MR_Stack_Layout_Entry *entry, Word *saved_regs,
 		MR_Trace_Node node);
 
+static	MR_Trace_Node
+MR_trace_matching_call(MR_Trace_Node node);
+
+static	bool
+MR_trace_first_disjunct(MR_Event_Info *event_info);
+
 static	bool
 MR_trace_matching_cond(const char *path, MR_Trace_Node node);
 
@@ -171,14 +219,33 @@
 static	String
 MR_trace_node_path(MR_Trace_Node node);
 
+static	MR_Trace_Port
+MR_trace_node_port(MR_Trace_Node node);
+
+static	Unsigned
+MR_trace_node_seqno(MR_Trace_Node node);
+
+static	MR_Trace_Node
+MR_trace_node_first_disj(MR_Trace_Node node);
+
 static	MR_Trace_Node
-MR_trace_scan_backwards(MR_Trace_Node node);
+MR_trace_step_left_in_context(MR_Trace_Node node);
 
+static	MR_Trace_Node
+MR_trace_find_prev_contour(MR_Trace_Node node);
+
+static	void
+MR_decl_checkpoint_event_imp(MR_Event_Info *event_info);
+
+static	void
+MR_decl_checkpoint_loc(const char *str, MR_Trace_Node node);
+
 Code *
 MR_trace_decl_debug(MR_Trace_Cmd_Info *cmd, MR_Event_Info *event_info)
 {
 	MR_Stack_Layout_Entry 	*entry;
 	Unsigned		depth;
+	MR_Trace_Node		trace;
 
 	entry = event_info->MR_event_sll->MR_sll_entry;
 	depth = event_info->MR_call_depth;
@@ -198,66 +265,80 @@
 		fatal_error("layout has no execution tracing");
 	}
 
-	if (depth > MR_edt_max_depth ||
-		depth < MR_edt_min_depth ||
-		entry->MR_sle_maybe_decl_debug < 1 ) {
+	if (depth > MR_edt_max_depth || depth < MR_edt_min_depth) {
 		/*
-		** We ignore any event for a procedure that does not have
-		** slots reserved for declarative debugging.  Such
-		** procedures are assumed to be correct.  We also filter
-		** out events with a depth outside the range given by
-		** MR_edt_{min,max}_depth.  These events are either
-		** irrelevant, or else implicitly represented in the
-		** structure being built.  See comment in
+		** We filter out events with a depth outside the range
+		** given by MR_edt_{min,max}_depth.  These events are
+		** either irrelevant, or else implicitly represented in
+		** the structure being built.  See comment in
 		** trace/mercury_trace_declarative.h.
 		*/
 		return NULL;
 	}
 
-	MR_trace_enabled = FALSE;
+#ifdef MR_USE_DECL_STACK_SLOT
+	if (entry->MR_sle_maybe_decl_debug < 1) {
+		/*
+		** If using reserved stack slots, we ignore any event
+		** for a procedure that does not have a slot reserved.
+		** Such procedures are effectively assumed correct.
+		*/
+		return NULL;
+	}
+#endif /* MR_USE_DECL_STACK_SLOT */
 
+	MR_trace_enabled = FALSE;
+	MR_decl_checkpoint_event(event_info);
+	trace = MR_trace_current_node;
 	switch (event_info->MR_trace_port) {
 		case MR_PORT_CALL:
-			MR_trace_decl_call(event_info);
+			trace = MR_trace_decl_call(event_info, trace);
 			break;
 		case MR_PORT_EXIT:
-			MR_trace_decl_exit(event_info);
+			trace = MR_trace_decl_exit(event_info, trace);
 			break;
 		case MR_PORT_REDO:
-			MR_trace_decl_redo(event_info);
+			trace = MR_trace_decl_redo(event_info, trace);
 			break;
 		case MR_PORT_FAIL:
-			MR_trace_decl_fail(event_info);
+			trace = MR_trace_decl_fail(event_info, trace);
 			break;
 		case MR_PORT_DISJ:
-			MR_trace_decl_disj(event_info);
+			trace = MR_trace_decl_disj(event_info, trace);
 			break;
 		case MR_PORT_SWITCH:
-			MR_trace_decl_switch(event_info);
+			trace = MR_trace_decl_switch(event_info, trace);
 			break;
 		case MR_PORT_COND:
-			MR_trace_decl_cond(event_info);
+			trace = MR_trace_decl_cond(event_info, trace);
 			break;
 		case MR_PORT_THEN:
+			trace = MR_trace_decl_then(event_info, trace);
+			break;
 		case MR_PORT_ELSE:
-			MR_trace_decl_then_else(event_info);
+			trace = MR_trace_decl_else(event_info, trace);
 			break;
 		case MR_PORT_NEG_ENTER:
-			MR_trace_decl_enter_neg(event_info);
+			trace = MR_trace_decl_neg_enter(event_info, trace);
 			break;
 		case MR_PORT_NEG_SUCCESS:
+			trace = MR_trace_decl_neg_success(event_info, trace);
+			break;
 		case MR_PORT_NEG_FAILURE:
-			MR_trace_decl_leave_neg(event_info);
+			trace = MR_trace_decl_neg_failure(event_info, trace);
 			break;
 		case MR_PORT_PRAGMA_FIRST:
 		case MR_PORT_PRAGMA_LATER:
-			break;
+			fatal_error("MR_trace_decl_debug: "
+				"foreign language code is not handled (yet)");
 		case MR_PORT_EXCEPTION:
 			fatal_error("MR_trace_decl_debug: "
 				"exceptions are not handled (yet)");
 		default:
 			fatal_error("MR_trace_decl_debug: unknown port");
 	}
+	MR_decl_checkpoint_alloc(trace);
+	MR_trace_current_node = trace;
 	
 	if (MR_trace_event_number == MR_edt_last_event) {
 		switch (MR_trace_decl_mode) {
@@ -288,8 +369,8 @@
 	return NULL;
 }
 
-static	void
-MR_trace_decl_call(MR_Event_Info *event_info)
+static	MR_Trace_Node
+MR_trace_decl_call(MR_Event_Info *event_info, MR_Trace_Node prev)
 {
 	MR_Trace_Node			node;
 	Word				atom;
@@ -298,16 +379,20 @@
 	atom = MR_decl_make_atom(layout, event_info->MR_saved_regs);
 	MR_TRACE_CALL_MERCURY(
 		node = (MR_Trace_Node) MR_DD_construct_call_node(
-					(Word) MR_trace_current_node, atom);
+					(Word) prev, atom,
+					(Word) event_info->MR_call_seqno);
 	);
+
+#ifdef MR_USE_DECL_STACK_SLOT
 	MR_trace_decl_set_slot(layout->MR_sll_entry,
 					event_info->MR_saved_regs, node);
+#endif
 
-	MR_trace_current_node = node;
+	return node;
 }
 	
-static	void
-MR_trace_decl_exit(MR_Event_Info *event_info)
+static	MR_Trace_Node
+MR_trace_decl_exit(MR_Event_Info *event_info, MR_Trace_Node prev)
 {
 	MR_Trace_Node		node;
 	MR_Trace_Node		call;
@@ -315,246 +400,325 @@
 
 	atom = MR_decl_make_atom(event_info->MR_event_sll,
 				event_info->MR_saved_regs);
+
+#ifdef MR_USE_DECL_STACK_SLOT
 	call = MR_trace_decl_get_slot(event_info->MR_event_sll->MR_sll_entry,
 				event_info->MR_saved_regs);
+#else
+	call = MR_trace_matching_call(prev);
+	MR_decl_checkpoint_match(call);
+#endif
+	
 	MR_TRACE_CALL_MERCURY(
 		node = (MR_Trace_Node) MR_DD_construct_exit_node(
-					(Word) MR_trace_current_node, 
-					(Word) call,
-					MR_trace_call_node_answer(call),
-					atom);
+				(Word) prev, (Word) call,
+				MR_trace_call_node_last_interface(call),
+				atom);
 	);
-	MR_trace_call_node_answer(call) = (Word) node;
+	MR_trace_call_node_last_interface(call) = (Word) node;
 
-	MR_trace_current_node = node;
+	return node;
 }
 
-static	void
-MR_trace_decl_redo(MR_Event_Info *event_info)
+static	MR_Trace_Node
+MR_trace_decl_redo(MR_Event_Info *event_info, MR_Trace_Node prev)
 {
 	MR_Trace_Node		node;
 	MR_Trace_Node		call;
+	MR_Trace_Node		next;
 
+#ifdef MR_USE_DECL_STACK_SLOT
 	call = MR_trace_decl_get_slot(event_info->MR_event_sll->MR_sll_entry,
 				event_info->MR_saved_regs);
+#else
+	/*
+	** Search through previous contour for a matching EXIT event.
+	*/
+	next = MR_trace_find_prev_contour(prev);
+	while (MR_trace_node_port(next) != MR_PORT_EXIT
+		|| MR_trace_node_seqno(next) != event_info->MR_call_seqno)
+	{
+		next = MR_trace_step_left_in_context(next);
+	}
+	MR_decl_checkpoint_match(next);
+
+	MR_TRACE_CALL_MERCURY(
+		MR_trace_node_store++;
+		if (!MR_DD_trace_node_call(MR_trace_node_store, (Word) next,
+					(Word *) &call))
+		{
+			fatal_error("MR_trace_decl_redo: no matching EXIT");
+		}
+	);
+#endif /* !MR_USE_DECL_STACK_SLOT */
+
 	MR_TRACE_CALL_MERCURY(
 		node = (MR_Trace_Node) MR_DD_construct_redo_node(
-					(Word) MR_trace_current_node,
-					MR_trace_call_node_answer(call));
+					(Word) prev,
+				MR_trace_call_node_last_interface(call));
 	);
-	MR_trace_call_node_answer(call) = (Word) node;
+	MR_trace_call_node_last_interface(call) = (Word) node;
 
-	MR_trace_current_node = node;
+	return node;
 }
 
-static	void
-MR_trace_decl_fail(MR_Event_Info *event_info)
+static	MR_Trace_Node
+MR_trace_decl_fail(MR_Event_Info *event_info, MR_Trace_Node prev)
 {
 	MR_Trace_Node		node;
+	MR_Trace_Node		next;
 	MR_Trace_Node		call;
+	MR_Trace_Node		redo;
 
+#ifdef MR_USE_DECL_STACK_SLOT
 	call = MR_trace_decl_get_slot(event_info->MR_event_sll->MR_sll_entry,
 				event_info->MR_saved_regs);
+#else
+	if (MR_trace_node_port(prev) == MR_PORT_CALL)
+	{
+		/*
+		** We are already at the corresponding call, so there
+		** is no need to search for it.
+		*/
+		call = prev;
+	}
+	else
+	{
+		next = MR_trace_find_prev_contour(prev);
+		call = MR_trace_matching_call(next);
+	}
+	MR_decl_checkpoint_match(call);
+#endif
+
+	redo = MR_trace_call_node_last_interface(call);
 	MR_TRACE_CALL_MERCURY(
 		node = (MR_Trace_Node) MR_DD_construct_fail_node(
-						(Word) MR_trace_current_node,
-						(Word) call);
+						(Word) prev,
+						(Word) call,
+						(Word) redo);
 	);
 
-	MR_trace_current_node = node;
+	MR_trace_call_node_last_interface(call) = (Word) node;
+	return node;
 }
 
-static	void
-MR_trace_decl_cond(MR_Event_Info *event_info)
+static	MR_Trace_Node
+MR_trace_decl_cond(MR_Event_Info *event_info, MR_Trace_Node prev)
 {
 	MR_Trace_Node		node;
 
 	MR_TRACE_CALL_MERCURY(
 		node = (MR_Trace_Node) MR_DD_construct_cond_node(
-					(Word) MR_trace_current_node,
+					(Word) prev,
 					(String) event_info->MR_event_path);
 	);
-	MR_trace_current_node = node;
+	return node;
 }
 
-static	void
-MR_trace_decl_then_else(MR_Event_Info *event_info)
+static	MR_Trace_Node
+MR_trace_decl_then(MR_Event_Info *event_info, MR_Trace_Node prev)
 {
 	MR_Trace_Node		node;
-	MR_Trace_Node		prev;
+	MR_Trace_Node		next;
+	MR_Trace_Node		cond;
+	const char		*path = event_info->MR_event_path;
 
-	prev = MR_trace_current_node;
+	/*
+	** Search through current contour for a matching COND event.
+	*/
+	next = prev;
+	while (!MR_trace_matching_cond(path, next))
+	{
+		next = MR_trace_step_left_in_context(next);
+	}
+	cond = next;
+	MR_decl_checkpoint_match(cond);
+	
+	MR_trace_cond_node_status(cond) = MR_TRACE_STATUS_SUCCEEDED;
 
+	MR_TRACE_CALL_MERCURY(
+		node = (MR_Trace_Node) MR_DD_construct_then_node(
+					(Word) prev,
+					(Word) cond);
+	);
+	return node;
+}
+
+static	MR_Trace_Node
+MR_trace_decl_else(MR_Event_Info *event_info, MR_Trace_Node prev)
+{
+	MR_Trace_Node		node;
+	MR_Trace_Node		cond;
+	const char		*path = event_info->MR_event_path;
+
 	/*
-	** Search through previous nodes for a matching COND event.
+	** Search through previous contour for a matching COND event.
 	*/
-	while (prev != (MR_Trace_Node) NULL)
+	if (MR_trace_matching_cond(path, prev))
+	{
+		cond = prev;
+	}
+	else
 	{
-		if (MR_trace_matching_cond(event_info->MR_event_path, prev))
+		MR_Trace_Node		next;
+
+		next = prev;
+		while (!MR_trace_matching_cond(path, next))
 		{
-			break;
+			next = MR_trace_step_left_in_context(next);
 		}
-		prev = MR_trace_scan_backwards(prev);
-	}
-	if (prev == (MR_Trace_Node) NULL) {
-		fatal_error("MR_trace_decl_then_else: no matching COND");
+		cond = next;
 	}
+	MR_decl_checkpoint_match(cond);
 	
-	switch (event_info->MR_trace_port) {
-		case MR_PORT_THEN:
-			MR_trace_cond_node_status(prev) =
-					MR_TRACE_STATUS_SUCCEEDED;
-			MR_TRACE_CALL_MERCURY(
-				node = (MR_Trace_Node)
-					MR_DD_construct_then_node(
-						(Word) MR_trace_current_node,
-						(Word) prev);
-			);
-			break;
-		case MR_PORT_ELSE:
-			MR_trace_cond_node_status(prev) =
-					MR_TRACE_STATUS_FAILED;
-			MR_TRACE_CALL_MERCURY(
-				node = (MR_Trace_Node)
-					MR_DD_construct_else_node(
-						(Word) MR_trace_current_node,
-						(Word) prev);
-			);
-			break;
-		default:
-			fatal_error("MR_trace_decl_then_else: invalid node");
-			break;
-	}
-
-	MR_trace_current_node = node;
+	MR_trace_cond_node_status(cond) = MR_TRACE_STATUS_FAILED;
+	MR_TRACE_CALL_MERCURY(
+		node = (MR_Trace_Node) MR_DD_construct_else_node(
+					(Word) prev,
+					(Word) cond);
+	);
+	return node;
 }
 
-static	void
-MR_trace_decl_enter_neg(MR_Event_Info *event_info)
+static	MR_Trace_Node
+MR_trace_decl_neg_enter(MR_Event_Info *event_info, MR_Trace_Node prev)
 {
 	MR_Trace_Node		node;
 
 	MR_TRACE_CALL_MERCURY(
 		node = (MR_Trace_Node) MR_DD_construct_neg_node(
-					(Word) MR_trace_current_node,
+					(Word) prev,
 					(String) event_info->MR_event_path);
 	);
-	MR_trace_current_node = node;
+	return node;
 }
 
-static	void
-MR_trace_decl_leave_neg(MR_Event_Info *event_info)
+static	MR_Trace_Node
+MR_trace_decl_neg_success(MR_Event_Info *event_info, MR_Trace_Node prev)
 {
 	MR_Trace_Node		node;
-	MR_Trace_Node		prev;
+	MR_Trace_Node		nege;
+	const char		*path = event_info->MR_event_path;
 
-	prev = MR_trace_current_node;
-
 	/*
-	** Search through previous nodes for a matching NEGE event.
+	** Search through previous contour for a matching NEGE event.
 	*/
-	while (prev != (MR_Trace_Node) NULL)
+	if (MR_trace_matching_neg(path, prev))
+	{
+		nege = MR_trace_current_node;
+	}
+	else
 	{
-		if (MR_trace_matching_neg(event_info->MR_event_path, prev))
+		MR_Trace_Node		next;
+
+		next = prev;
+		while (!MR_trace_matching_neg(path, next))
 		{
-			break;
+			next = MR_trace_step_left_in_context(next);
 		}
-		prev = MR_trace_scan_backwards(prev);
-	}
-	if (prev == (MR_Trace_Node) NULL) {
-		fatal_error("MR_trace_decl_leave_neg: no matching NEGE");
+		nege = next;
 	}
+	MR_decl_checkpoint_match(nege);
 	
-	switch (event_info->MR_trace_port) {
-		case MR_PORT_NEG_SUCCESS:
-			MR_trace_neg_node_status(prev) =
-					MR_TRACE_STATUS_SUCCEEDED;
-			MR_TRACE_CALL_MERCURY(
-				node = (MR_Trace_Node)
-					MR_DD_construct_neg_succ_node(
-						(Word) MR_trace_current_node,
-						(Word) prev);
-			);
-			break;
-		case MR_PORT_NEG_FAILURE:
-			MR_trace_neg_node_status(prev) =
-					MR_TRACE_STATUS_FAILED;
-			MR_TRACE_CALL_MERCURY(
-				node = (MR_Trace_Node)
-					MR_DD_construct_neg_fail_node(
-						(Word) MR_trace_current_node,
-						(Word) prev);
-			);
-			break;
-		default:
-			fatal_error("MR_trace_decl_leave_neg: invalid node");
-			break;
-	}
-
-	MR_trace_current_node = node;
+	MR_trace_neg_node_status(nege) = MR_TRACE_STATUS_SUCCEEDED;
+	MR_TRACE_CALL_MERCURY(
+		node = (MR_Trace_Node) MR_DD_construct_neg_succ_node(
+						(Word) prev,
+						(Word) nege);
+	);
+	return node;
 }
 
-static	void
-MR_trace_decl_switch(MR_Event_Info *event_info)
+static	MR_Trace_Node
+MR_trace_decl_neg_failure(MR_Event_Info *event_info, MR_Trace_Node prev)
 {
 	MR_Trace_Node		node;
+	MR_Trace_Node		next;
 
+	/*
+	** Search through current context for a matching NEGE event.
+	*/
+	next = prev;
+	while (!MR_trace_matching_neg(event_info->MR_event_path, next))
+	{
+		next = MR_trace_step_left_in_context(next);
+	}
+	MR_decl_checkpoint_match(next);
+	
+	MR_trace_neg_node_status(next) = MR_TRACE_STATUS_FAILED;
 	MR_TRACE_CALL_MERCURY(
-		node = (MR_Trace_Node) MR_DD_construct_first_disj_node(
-					(Word) MR_trace_current_node,
-					(String) event_info->MR_event_path,
-					(Word) TRUE);
+		node = (MR_Trace_Node) MR_DD_construct_neg_fail_node(
+						(Word) prev,
+						(Word) next);
 	);
-	MR_trace_current_node = node;
+	return node;
 }
 
-static	void
-MR_trace_decl_disj(MR_Event_Info *event_info)
+static	MR_Trace_Node
+MR_trace_decl_switch(MR_Event_Info *event_info, MR_Trace_Node prev)
 {
 	MR_Trace_Node		node;
-	MR_Trace_Node		prev;
-	MR_Trace_Node		back;
 
-	prev = MR_trace_current_node;
+	MR_TRACE_CALL_MERCURY(
+		node = (MR_Trace_Node) MR_DD_construct_switch_node(
+					(Word) prev,
+					(String) event_info->MR_event_path);
+	);
+	return node;
+}
 
-	/*
-	** Search through previous nodes for a matching DISJ event.
-	*/
-	while (prev != (MR_Trace_Node) NULL)
+static	MR_Trace_Node
+MR_trace_decl_disj(MR_Event_Info *event_info, MR_Trace_Node prev)
+{
+	MR_Trace_Node		node;
+	const char		*path = event_info->MR_event_path;
+
+	if (MR_trace_first_disjunct(event_info))
 	{
-		if (MR_trace_matching_disj(event_info->MR_event_path, prev))
-		{
-			break;
-		}
-		prev = MR_trace_scan_backwards(prev);
+		MR_TRACE_CALL_MERCURY(
+			node = (MR_Trace_Node) MR_DD_construct_first_disj_node(
+					(Word) prev,
+					(String) path);
+		);
 	}
+	else
+	{
+		MR_Trace_Node		next;
+		MR_Trace_Node		first;
 
-	if (prev == (MR_Trace_Node) NULL) {
 		/*
-		** This is a first_disj.
+		** Search through previous nodes for a matching DISJ event.
 		*/
-		MR_TRACE_CALL_MERCURY(
-			node = (MR_Trace_Node) MR_DD_construct_first_disj_node(
-					(Word) MR_trace_current_node,
-					(String) event_info->MR_event_path,
-					(Word) FALSE);
-		);
-	} else {
+		next = MR_trace_find_prev_contour(prev);
+		while (!MR_trace_matching_disj(path, next))
+		{
+			next = MR_trace_step_left_in_context(next);
+		}
+		MR_decl_checkpoint_match(next);
+
 		/*
-		** This is a later_disj.
+		** Find the first disj event of this disjunction.
 		*/
-		back = MR_trace_scan_backwards(prev);
+		first = MR_trace_node_first_disj(next);
+		if (first == (MR_Trace_Node) NULL)
+		{
+			first = next;
+		}
+
 		MR_TRACE_CALL_MERCURY(
 			node = (MR_Trace_Node) MR_DD_construct_later_disj_node(
-					(Word) MR_trace_current_node,
-					(Word) back,
-					(String) event_info->MR_event_path);
+						MR_trace_node_store,
+						(Word) prev,
+						(String) path,
+						(Word) first);
 		);
 	}
 
-	MR_trace_current_node = node;
+	return node;
 }
 
+#ifdef MR_USE_DECL_STACK_SLOT
+
 static	MR_Trace_Node
 MR_trace_decl_get_slot(const MR_Stack_Layout_Entry *entry, Word *saved_regs)
 {
@@ -596,6 +760,47 @@
 	}
 }
 
+#endif /* MR_USE_DECL_STACK_SLOT */
+
+static	MR_Trace_Node
+MR_trace_matching_call(MR_Trace_Node node)
+{
+	MR_Trace_Node		next;
+
+	/*
+	** Search through contour for any CALL event.  Since there
+	** is only one CALL event which can be reached, we assume it
+	** is the correct one.
+	*/
+	next = node;
+	while (MR_trace_node_port(next) != MR_PORT_CALL)
+	{
+		next = MR_trace_step_left_in_context(next);
+	}
+	return next;
+}
+
+static	bool
+MR_trace_first_disjunct(MR_Event_Info *event_info)
+{
+	const char		*path;
+
+	/*
+	** Return TRUE iff the last component of the path is "d1;".
+	*/
+	path = event_info->MR_event_path;
+	while (*path)
+	{
+		if (MR_string_equal(path, "d1;"))
+		{
+			return TRUE;
+		}
+		path++;
+	}
+
+	return FALSE;
+}
+	
 static	bool
 MR_trace_matching_cond(const char *path, MR_Trace_Node node)
 {
@@ -640,7 +845,7 @@
 	MR_TRACE_CALL_MERCURY(
 		port = (MR_Trace_Port) MR_DD_trace_node_port(node);
 	);
-	if (port == MR_PORT_DISJ || port == MR_PORT_SWITCH) {
+	if (port == MR_PORT_DISJ) {
 		node_path = MR_trace_node_path(node);
 		return MR_trace_same_construct(path, node_path);
 	} else {
@@ -812,7 +1017,6 @@
 		Code **jumpaddr)
 {
 	MR_Stack_Layout_Entry 	*entry;
-	int			decl_slot;
 	const char		*message;
 	FILE			*out;
 
@@ -821,11 +1025,12 @@
 		return FALSE;
 	}
 
-	decl_slot = entry->MR_sle_maybe_decl_debug;
-	if (decl_slot < 1) {
+#ifdef MR_USE_DECL_STACK_SLOT
+	if (entry->MR_sle_maybe_decl_debug < 1) {
 		/* No slots are reserved for declarative debugging */
 		return FALSE;
 	}
+#endif /* MR_USE_DECL_STACK_SLOT */
 
 	message = MR_trace_retry(event_info, event_details, jumpaddr);
 	if (message != NULL) {
@@ -871,6 +1076,13 @@
 {
 	Word			response;
 
+#if 0
+	/*
+	** This is a quick and dirty way to debug the front end.
+	*/
+	MR_trace_enabled = TRUE;
+#endif
+
 	MR_TRACE_CALL_MERCURY(
 		MR_DD_decl_diagnosis(MR_trace_node_store, root, &response,
 				MR_trace_front_end_state,
@@ -912,17 +1124,109 @@
 	return path;
 }
 
+static	MR_Trace_Port
+MR_trace_node_port(MR_Trace_Node node)
+{
+	MR_Trace_Port		port;
+
+	MR_TRACE_CALL_MERCURY(
+		port = (MR_Trace_Port) MR_DD_trace_node_port((Word) node);
+	);
+	return port;
+}
+
+static	Unsigned
+MR_trace_node_seqno(MR_Trace_Node node)
+{
+	Unsigned		seqno;
+
+	MR_trace_node_store++;
+	MR_TRACE_CALL_MERCURY(
+		if (!MR_DD_trace_node_seqno(MR_trace_node_store,
+					(Word) node,
+					(Word *) &seqno))
+		{
+			fatal_error("MR_trace_node_seqno: "
+				"not an interface event");
+		}
+	);
+	return seqno;
+}
+
 static	MR_Trace_Node
-MR_trace_scan_backwards(MR_Trace_Node node)
+MR_trace_node_first_disj(MR_Trace_Node node)
 {
-	MR_Trace_Node		prev;
+	MR_Trace_Node		first;
 
+	MR_TRACE_CALL_MERCURY(
+		if (!MR_DD_trace_node_first_disj((Word) node, (Word *) &first))
+		{
+			fatal_error("MR_trace_node_first_disj: "
+				"not a DISJ event");
+		}
+	);
+	return first;
+}
+
+static	MR_Trace_Node
+MR_trace_step_left_in_context(MR_Trace_Node node)
+{
+	MR_Trace_Node		next;
+
+	MR_decl_checkpoint_step(node);
+
+	MR_trace_node_store++;
+	MR_TRACE_CALL_MERCURY(
+		next = (MR_Trace_Node) MR_DD_step_left_in_context(
+						MR_trace_node_store, node);
+	);
+	return next;
+}
+
+static	MR_Trace_Node
+MR_trace_find_prev_contour(MR_Trace_Node node)
+{
+	MR_Trace_Node		next;
+
+	MR_decl_checkpoint_find(node);
+
 	MR_trace_node_store++;
 	MR_TRACE_CALL_MERCURY(
-		prev = (MR_Trace_Node) MR_DD_scan_backwards(
+		next = (MR_Trace_Node) MR_DD_find_prev_contour(
 						MR_trace_node_store, node);
 	);
-	return prev;
+	return next;
 }
+
+#ifdef MR_DEBUG_DD_BACK_END
+
+static	void
+MR_decl_checkpoint_event_imp(MR_Event_Info *event_info)
+{
+	fprintf(MR_mdb_out, "DD EVENT %ld: #%ld %ld %s ",
+			(long) event_info->MR_event_number,
+			(long) event_info->MR_call_seqno,
+			(long) event_info->MR_call_depth,
+			MR_port_names[event_info->MR_trace_port]);
+	MR_print_proc_id(MR_mdb_out, event_info->MR_event_sll->MR_sll_entry);
+	fprintf(MR_mdb_out, "\n");
+}
+
+static	void
+MR_decl_checkpoint_loc(const char *str, MR_Trace_Node node)
+{
+	MercuryFile		mdb_out;
+
+	mdb_out.file = MR_mdb_out;
+	mdb_out.line_number = 1;
+
+	fprintf(MR_mdb_out, "DD %s: %ld ", str, (long) node);
+	MR_TRACE_CALL_MERCURY(
+		MR_DD_print_trace_node((Word) &mdb_out, (Word) node);
+	);
+	fprintf(MR_mdb_out, "\n");
+}
+
+#endif /* MR_DEBUG_DD_BACK_END */
 
 #endif /* defined(MR_USE_DECLARATIVE_DEBUGGER) */
Index: trace/mercury_trace_declarative.h
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_declarative.h,v
retrieving revision 1.6
diff -u -r1.6 mercury_trace_declarative.h
--- mercury_trace_declarative.h	2000/01/03 02:23:04	1.6
+++ mercury_trace_declarative.h	2000/02/07 01:13:24
@@ -37,7 +37,7 @@
 
 typedef Word MR_Trace_Node;
 
-#define	MR_trace_call_node_answer(node)					\
+#define	MR_trace_call_node_last_interface(node)				\
 		MR_field(MR_mktag(0), (node), (Integer) 1)
 
 #define MR_trace_cond_node_status(node)					\


New file tests/debugger/declarative/backtrack.exp:

       1:      1  1 CALL pred backtrack:main/2-0 (det) backtrack.m:8
mdb> echo on
Command echo enabled.
mdb> register --quiet
mdb> break p
 0: + stop  interface pred backtrack:p/2-0 (det)
mdb> continue
       2:      2  2 CALL pred backtrack:p/2-0 (det) backtrack.m:23 (backtrack.m:9)
mdb> finish
      17:      2  2 EXIT pred backtrack:p/2-0 (det) backtrack.m:23 (backtrack.m:9)
mdb> dd
atom("p", [univ(1 : int), univ(no : bool:bool)])
Valid? no
atom("q", [univ(1 : int), univ(1 : int)])
Valid? yes
atom("q", [univ(1 : int), univ(2 : int)])
Valid? yes
atom("q", [univ(1 : int), univ(3 : int)])
Valid? yes
Call atom("q", [univ(1 : int)])
Solutions:
	atom("q", [univ(1 : int), univ(1 : int)])
	atom("q", [univ(1 : int), univ(2 : int)])
	atom("q", [univ(1 : int), univ(3 : int)])
Complete? yes
Incorrect node found:
wrong_answer(atom("p", [univ(1 : int), univ(no : bool:bool)]))
      17:      2  2 EXIT pred backtrack:p/2-0 (det) backtrack.m:23 (backtrack.m:9)
mdb> continue
no


New file tests/debugger/declarative/backtrack.inp:

echo on
register --quiet
break p
continue
finish
dd
no
yes
yes
yes
yes
continue


New file tests/debugger/declarative/backtrack.m:

:- module backtrack.
:- interface.
:- import_module io.
:- pred main(io__state::di, io__state::uo) is det.
:- implementation.
:- import_module std_util, int, bool.

main -->
	{ p(1, R) },
	io__write(R),
	io__nl.

:- pred p(int::in, bool::out) is det.

p(N, R) :-
	(
%		some [M] (
			M > 5,
			q(N, M)
%		)
	->
		R = yes
	;
		R = no
	).

:- pred q(int::in, int::out) is nondet.

q(0, 0).
q(1, 1).
q(1, 2).
q(1, 3).
q(2, 2).
q(2, 4).


New file tests/debugger/declarative/aadebug.exp2:

       1:      1  1 CALL pred aadebug:main/2-0 (det) aadebug.m:11
mdb> echo on
Command echo enabled.
mdb> register --quiet
mdb> break p
 0: + stop  interface pred aadebug:p/2-0 (nondet)
mdb> continue
       3:      2  2 CALL pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
mdb> finish
      15:      2  2 EXIT pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
mdb> dd
atom("p", [univ('a' : character), univ(30 : int)])
Valid? no
atom("q", [univ('a' : character), univ('a' : character)])
Valid? yes
atom("r", [univ('a' : character), univ(10 : int)])
Valid? yes
atom("s", [univ(10 : int), univ(30 : int)])
Valid? yes
Incorrect node found:
wrong_answer(atom("p", [univ('a' : character), univ(30 : int)]))
      15:      2  2 EXIT pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
mdb> continue
      20:      2  2 REDO pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
mdb> finish
      22:      2  2 EXIT pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
mdb> dd
atom("p", [univ('a' : character), univ(31 : int)])
Valid? no
Incorrect node found:
wrong_answer(atom("p", [univ('a' : character), univ(31 : int)]))
      22:      2  2 EXIT pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
mdb> continue
      27:      2  2 REDO pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
mdb> finish
      39:      2  2 EXIT pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
mdb> dd
atom("p", [univ('a' : character), univ(32 : int)])
Valid? no
atom("q", [univ('a' : character), univ('b' : character)])
Valid? yes
Call atom("r", [univ('b' : character)])
Solutions:
Complete? yes
Call atom("q", [univ('b' : character)])
Solutions:
Complete? yes
Incorrect node found:
wrong_answer(atom("p", [univ('a' : character), univ(32 : int)]))
      39:      2  2 EXIT pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
mdb> continue
      44:      2  2 REDO pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
mdb> finish
      47:      2  2 FAIL pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
mdb> dd
Call atom("p", [univ('a' : character)])
Solutions:
	atom("p", [univ('a' : character), univ(30 : int)])
	atom("p", [univ('a' : character), univ(31 : int)])
	atom("p", [univ('a' : character), univ(32 : int)])
Complete? no
Call atom("q", [univ('a' : character)])
Solutions:
	atom("q", [univ('a' : character), univ('a' : character)])
	atom("q", [univ('a' : character), univ('b' : character)])
Complete? yes
Incorrect node found:
missing_answer(atom("p", [univ('a' : character)]), [atom("p", [univ('a' : character), univ(30 : int)]), atom("p", [univ('a' : character), univ(31 : int)]), atom("p", [univ('a' : character), univ(32 : int)])])
      47:      2  2 FAIL pred aadebug:p/2-0 (nondet) aadebug.m:24 (aadebug.m:9)
mdb> continue
no

-- 
Mark Brown, PhD student            )O+  |  "Another of Fortran's breakthroughs
(m.brown at cs.mu.oz.au)                   |  was the GOTO statement, which was...
Dept. of Computer Science and Software  |  uniquely simple and understandable"
Engineering, University of Melbourne    |              -- IEEE, 1994
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------



More information about the developers mailing list