[m-dev.] for review: term dependencies in the declarative debugger (first part)

Mark Anthony BROWN dougl at cs.mu.OZ.AU
Fri Nov 24 04:12:27 AEDT 2000


Hi,

This is for review by Zoltan.

Cheers,
Mark.

Estimated hours taken: 80

This is the first part of a change to support term dependency analysis
in the declarative debugger.  A method is added to the mercury_edt
typeclass which finds the origin of a selected subterm in an EDT node,
somewhere in the body of the call or in the body of the parent.  The
other parts of the change required before this can be useful are to
modify the search strategy (in browser/declarative_analyser.m) to make
use of the new information, and to modify the user interface to allow
a subterm to be selected.  They will be committed as separate changes.

The typeclass method first traverses one or more contours, matching the
contour events up with goals in a procedure representation.  This matching
process requires a left to right traversal, because we need to know which
disjunct/arm/branch was taken before we can match subgoals, and the
DISJ/SWTCH/THEN/ELSE events which tell us this information occur at the
left edge of the subgoals to which they apply.  But we must always start
from the right hand side of the contour being traversed, so this means
that a right to left traversal is required before the matching can start.

Using the contour matched up with the atomic goals, we track the location
of a subterm by looking at which variables are bound, while scanning right
to left along the contour.  Because this must happen after the matching,
this must be a separate right to left traversal than the earlier one.
Therefore the algorithm implemented here requires two passes over the
contours in order to find the origin of the selected subterm.

browser/declarative_execution.m:
	Add a maybe(goal_rep) to call nodes in the annotated trace.  This
	is `no' if the relevant module was compiled below trace level `rep'.

trace/mercury_trace_declarative.c:
	If the information is available, fill in the goal_rep when
	constructing call nodes.

browser/declarative_analyser.m:
	Add the new method to the mercury_edt typeclass.

browser/declarative_debugger.m:
	Implement the new method.  Update for the changed call nodes.

browser/program_representation.m:
	Add a version of goal_paths to be used by the declarative debugger,
	and a predicate to parse these from goal_path_strings.  Add the
	types arg_pos and term_path to represent a subterm of a call or exit.

browser/program_representation.m:
compiler/prog_rep.m:
	No longer store conjunctions in reverse order in the goal_rep; we now
	store them in the same order as in the HLDS.

	Although we search conjunctions in reverse order, we need to match
	them up with contour events before doing that.  This can only be
	done in the forwards direction, so it turns out that there is no
	advantage in storing them in reverse order.

compiler/hlds_goal.m:
compiler/trace.m:
	Add comments to the existing definitions of goal_path and
	path_step_to_string.

Index: browser/declarative_analyser.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_analyser.m,v
retrieving revision 1.5
diff -u -r1.5 declarative_analyser.m
--- browser/declarative_analyser.m	2000/08/18 10:59:27	1.5
+++ browser/declarative_analyser.m	2000/11/23 16:13:39
@@ -13,7 +13,7 @@
 :- module mdb__declarative_analyser.
 :- interface.
 :- import_module list.
-:- import_module mdb__declarative_debugger.
+:- import_module mdb__declarative_debugger, mdb__program_representation.
 
 	% This typeclass defines how EDTs may be accessed by this module.
 	% An EDT is a tree of nodes, each of which contains a question
@@ -38,8 +38,40 @@
 		% represented implicitly, then the procedure fails.
 		%
 	pred edt_children(S, T, list(T)),
-	mode edt_children(in, in, out) is semidet
+	mode edt_children(in, in, out) is semidet,
+
+		% Given a subterm of a tree, find the mode of that subterm
+		% and the origin of it amongst the parent, siblings or
+		% children.
+		%
+	pred edt_dependency(S, T, arg_pos, term_path, subterm_mode,
+			subterm_origin(T)),
+	mode edt_dependency(in, in, in, in, out, out) is det
 ].
+
+:- type subterm_mode
+	--->	subterm_in
+	;	subterm_out.
+
+:- type subterm_origin(T)
+
+			% Subterm came from an output of a child or sibling.
+			%
+	--->	output(T, arg_pos, term_path)
+
+			% Subterm came from an input of the parent.
+			%
+	;	input(arg_pos, term_path)
+
+			% Subterm was constructed in the body.  We record
+			% the filename and line number of the unification.
+			%
+	;	unification(string, int)
+
+			% The origin could not be found due to missing
+			% information.
+			%
+	;	not_found.
 
 :- type analyser_response(T)
 
Index: browser/declarative_debugger.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_debugger.m,v
retrieving revision 1.18
diff -u -r1.18 declarative_debugger.m
--- browser/declarative_debugger.m	2000/08/18 10:59:28	1.18
+++ browser/declarative_debugger.m	2000/11/23 16:13:55
@@ -158,8 +158,9 @@
 %-----------------------------------------------------------------------------%
 
 :- implementation.
-:- import_module require, int, char.
+:- import_module require, int, char, string.
 :- import_module mdb__declarative_analyser, mdb__declarative_oracle.
+:- import_module mdb__program_representation.
 
 :- type diagnoser_state(R)
 	--->	diagnoser(
@@ -334,7 +335,8 @@
 	where [
 		pred(edt_root_question/3) is trace_root_question,
 		pred(edt_root_e_bug/3) is trace_root_e_bug,
-		pred(edt_children/3) is trace_children
+		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
@@ -351,7 +353,7 @@
 	(
 		Node = fail(_, CallId, RedoId, _),
 		call_node_from_id(Store, CallId, Call),
-		Call = call(_, _, CallAtom, _, _, _),
+		Call = call(_, _, CallAtom, _, _, _, _),
 		get_answers(Store, RedoId, [], Answers),
 		Root = missing_answer(CallAtom, Answers)
 	;
@@ -360,7 +362,7 @@
 	;
 		Node = excp(_, CallId, _, Exception, _),
 		call_node_from_id(Store, CallId, Call),
-		Call = call(_, _, CallAtom, _, _, _),
+		Call = call(_, _, CallAtom, _, _, _, _),
 		Root = unexpected_exception(CallAtom, Exception)
 	).
 
@@ -390,12 +392,12 @@
 	;
 		Node = fail(_, CallId, _, Event),
 		call_node_from_id(S, CallId, Call),
-		Call = call(_, _, CallAtom, _, _, _),
+		Call = call(_, _, CallAtom, _, _, _, _),
 		Bug = partially_uncovered_atom(CallAtom, Event)
 	;
 		Node = excp(_, CallId, _, Exception, Event),
 		call_node_from_id(S, CallId, Call),
-		Call = call(_, _, CallAtom, _, _, _),
+		Call = call(_, _, CallAtom, _, _, _, _),
 		Bug = unhandled_exception(CallAtom, Exception, Event)
 	).
 
@@ -423,7 +425,7 @@
 :- mode not_at_depth_limit(in, in) is semidet.
 
 not_at_depth_limit(Store, Ref) :-
-	call_node_from_id(Store, Ref, call(_, _, _, _, _, no)).
+	call_node_from_id(Store, Ref, call(_, _, _, _, _, no, _)).
 
 :- pred wrong_answer_children(S, R, list(edt_node(R)), list(edt_node(R)))
 		<= annotated_trace(S, R).
@@ -432,7 +434,7 @@
 wrong_answer_children(Store, NodeId, Ns0, Ns) :-
 	det_trace_node_from_id(Store, NodeId, Node),
 	(
-		( Node = call(_, _, _, _, _, _)
+		( Node = call(_, _, _, _, _, _, _)
 		; Node = neg(_, _, _)
 		; Node = cond(_, _, failed)
 		)
@@ -476,7 +478,7 @@
 missing_answer_children(Store, NodeId, Ns0, Ns) :-
 	det_trace_node_from_id(Store, NodeId, Node),
 	(
-		( Node = call(_, _, _, _, _, _)
+		( Node = call(_, _, _, _, _, _, _)
 		; Node = neg(_, _, _)
 		; Node = cond(_, _, failed)
 		)
@@ -530,7 +532,7 @@
 unexpected_exception_children(Store, NodeId, Ns0, Ns) :-
 	det_trace_node_from_id(Store, NodeId, Node),
 	(
-		( Node = call(_, _, _, _, _, _)
+		( Node = call(_, _, _, _, _, _, _)
 		; Node = neg(_, _, failed)
 		; Node = cond(_, _, failed)
 		)
@@ -565,6 +567,441 @@
 		unexpected_exception_children(Store, Next, 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 unification 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.  If the mode is `out', the origin could be:
+%	- a unification within the body of the call,
+%	- an output subterm of a child of the node, or
+%	- an input subterm of the node itself.
+% In the case we look at the contour leading up to the exit or exception event
+% associated with the given node.
+%
+% If the contour starts with a neg or cond event, then we also look at the
+% contour leading up to that event (and so on, recursively).  We eventually
+% stop when a call event is reached.  The goal representation used comes from
+% this call event.
+%
+% We first make a full pass of the contour(s), matching up the contour events
+% with atomic events in the goal representation, and constructing a list of
+% `atom_info's, information about atomic goals in the contour(s).  We then
+% traverse this list, keeping track of the variable which contains the
+% selected subterm, and the location within this variable.
+
+:- pred trace_dependency(wrap(S), edt_node(R), arg_pos, term_path,
+		subterm_mode, subterm_origin(edt_node(R)))
+		<= annotated_trace(S, R).
+:- mode trace_dependency(in, in, in, in, out, out) is det.
+
+trace_dependency(wrap(Store), dynamic(Ref), ArgPos, TermPath, Mode, Origin) :-
+	det_edt_node_from_id(Store, Ref, Node),
+	(
+		Node = exit(ExitPrec, CallId, _, ExitAtom, _),
+		call_node_from_id(Store, CallId, Call),
+		Call = call(CallPrec, _, CallAtom, _, _, _, _),
+		(
+			trace_atom_subterm_is_ground(CallAtom, ArgPos, TermPath)
+		->
+			Mode = subterm_in,
+			Start = CallPrec
+		;
+			trace_atom_subterm_is_ground(ExitAtom, ArgPos, TermPath)
+		->
+			Mode = subterm_out,
+			Start = ExitPrec
+		;
+			error("trace_dependency: wrong answer subterm unbound")
+		)
+	;
+		Node = fail(_, CallId, _, _),
+		call_node_from_id(Store, CallId, Call),
+		Call = call(CallPrec, _, CallAtom, _, _, _, _),
+		(
+			trace_atom_subterm_is_ground(CallAtom, ArgPos, TermPath)
+		->
+			Mode = subterm_in,
+			Start = CallPrec
+		;
+			error(
+			    "trace_dependency: missing answer subterm unbound")
+		)
+	;
+		Node = excp(_, CallId, _, _, _),
+		call_node_from_id(Store, CallId, Call),
+		Call = call(CallPrec, _, CallAtom, _, _, _, _),
+		%
+		% XXX we don't yet handle tracking of the exception value.
+		%
+		(
+			trace_atom_subterm_is_ground(CallAtom, ArgPos, TermPath)
+		->
+			Mode = subterm_in,
+			Start = CallPrec
+		;
+			error("trace_dependency: exception subterm unbound")
+		)
+	),
+
+	contour_foldl2(Store, process_trace_event, Start, next_contour(Store),
+			GoalCont, AtomInfo0),
+	(
+		GoalCont = unknown_goal
+	->
+		%
+		% There was no goal_rep to match the contour up with, so the
+		% origin cannot be found.
+		%
+		Origin = not_found
+	;
+		%
+		% Use up any remaining goals which are not associated with
+		% any events (e.g. unifications).
+		%
+		process_non_event_goals(GoalCont, MaybeCallArgs, AtomInfo,
+				AtomInfo0),
+		(
+			Mode = subterm_in,
+			MaybeCallArgs = yes(CallArgs)
+		->
+			list__index1_det(CallArgs, ArgPos, VarRep)
+		;
+			Mode = subterm_out,
+			MaybeCallArgs = no
+		->
+			%
+			% Headvars have the same number as their argument
+			% position.
+			%
+			VarRep = ArgPos
+		;
+			error("trace_dependency: contour mismatch")
+		),
+		Origin = find_subterm_origin(AtomInfo, VarRep, TermPath)
+	).
+
+	% contour_foldl2(Store, Pred, Right, Init, A, B) is analogous to
+	% other foldl2 predicates which keep track of two accumulators
+	% over a sequence.  In this case the sequence is the contour defined
+	% by Right, the rightmost event of the contour.  The main difference
+	% is that instead of supplying the initial accumulator values, the
+	% Init closure calculates them from the event at the left boundary
+	% of the contour.
+	%
+	% The mode that we have chosen has the last two arguments of the
+	% accumulator predicate (second argument) with the opposite modes to
+	% normal.  This is so the accumulator predicate can construct a
+	% list using the DCG syntax.
+	%
+:- pred contour_foldl2(S, pred(R, trace_node(R), A, A, B, B), R,
+		pred(trace_node(R), A, B), A, B) <= annotated_trace(S, R).
+:- mode contour_foldl2(in, pred(in, in, in, out, out, in) is det, in,
+		pred(in, out, out) is det, out, out) is det.
+
+contour_foldl2(Store, ProcessEvent, Ref, Init, A, B) :-
+	det_trace_node_from_id(Store, Ref, Node),
+	(
+		( Node = call(_, _, _, _, _, _, _)
+		; Node = neg(_, _, _)
+		; Node = cond(_, _, failed)
+		)
+	->
+		Init(Node, A, B)
+	;
+		Next = step_left_in_contour(Store, Node),
+		contour_foldl2(Store, ProcessEvent, Next, Init, A0, B0),
+		ProcessEvent(Ref, Node, A0, A, B, B0)
+	).
+
+	% This type represents the remainder of a goal after some of it
+	% has been executed, like a continuation.  We don't actually
+	% execute this code, but match it up with the remainder of a contour
+	% after some events have been processed.
+	%
+:- type goal_cont
+	--->	subgoal_cont(
+			goal_rep,	% A subgoal to execute.
+			goal_cont	% Code after the subgoal.
+		)
+	;	conj_cont(
+			list(goal_rep), % The rest of a conjunction to execute.
+			goal_cont	% Code after the conjunction.
+		)
+	;	ite_cont(
+			goal_rep,	% Then branch.
+			goal_rep,	% Else branch.
+			goal_cont	% Code after the if-then-else.
+		)
+	;	neg_cont(
+			goal_cont	% Code after the negation.
+		)
+	;	return			% End of the procedure.
+	;	unknown_goal.		% We don't have access to the
+					% program representation.
+
+:- type atom_info(R)
+	--->	call_info(R, goal_rep)
+	;	unify_info(goal_rep).
+
+:- pred next_contour(S, trace_node(R), goal_cont, list(atom_info(R)))
+		<= annotated_trace(S, R).
+:- mode next_contour(in, in, out, out) is det.
+
+next_contour(Store, Node, Cont, AtomInfo) :-
+	(
+		Node = call(_, _, _, _, _, _, MaybeGoal)
+	->
+		AtomInfo = [],
+		(
+			MaybeGoal = yes(Goal)
+		->
+			Cont = subgoal_cont(Goal, return)
+		;
+			Cont = unknown_goal
+		)
+	;
+		( Node = neg(Prec, _, _)
+		; Node = cond(Prec, _, _)
+		)
+	->
+		%
+		% We continue into the next contour up, since the subterm
+		% could have come from there.
+		%
+		contour_foldl2(Store, process_trace_event, Prec,
+				next_contour(Store), Cont, AtomInfo)
+	;
+		error("next_contour: not a contour boundary")
+	).
+
+	% Match the goal_cont up with one trace event, leaving a new
+	% goal_cont.
+	%
+:- pred process_trace_event(R, trace_node(R), goal_cont, goal_cont,
+		list(atom_info(R)), list(atom_info(R))).
+:- mode process_trace_event(in, in, in, out, out, in) is det.
+
+process_trace_event(Ref, Event, subgoal_cont(Goal, Cont0), Cont) -->
+	process_trace_event_goal(Ref, Event, Goal, Cont0, Cont).
+process_trace_event(Ref, Event, conj_cont([], Cont0), Cont) -->
+	process_trace_event(Ref, Event, Cont0, Cont).
+process_trace_event(Ref, Event, conj_cont([G | Gs], Cont0), Cont) -->
+	process_trace_event_goal(Ref, Event, G, conj_cont(Gs, Cont0), Cont).
+process_trace_event(_, Event, ite_cont(Then, Else, Cont0), Cont) -->
+	{
+		Event = then(_, _)
+	->
+		Cont = subgoal_cont(Then, Cont0)
+	;
+		Event = else(_, _)
+	->
+		Cont = subgoal_cont(Else, Cont0)
+	;
+		error("process_trace_event: ite mismatch")
+	}.
+process_trace_event(_, _, neg_cont(_), _) -->
+	{ error("process_trace_event: unexpected end of negation") }.
+process_trace_event(_, _, return, _) -->
+	{ error("process_trace_event: unexpected end of goal") }.
+process_trace_event(_, _, unknown_goal, unknown_goal) -->
+	[].
+
+:- pred process_trace_event_goal(R, trace_node(R), goal_rep, goal_cont,
+		goal_cont, list(atom_info(R)), list(atom_info(R))).
+:- mode process_trace_event_goal(in, in, in, in, out, out, in) is det.
+
+process_trace_event_goal(Ref, Event, conj_rep([]), Cont0, Cont) -->
+	process_trace_event(Ref, Event, Cont0, Cont).
+process_trace_event_goal(Ref, Event, conj_rep([G | Gs]), Cont0, Cont) -->
+	process_trace_event_goal(Ref, Event, G, conj_cont(Gs, Cont0), Cont).
+process_trace_event_goal(_, Event, disj_rep(Ds), Cont0, Cont) -->
+	{ list__index1_det(Ds, disj_event_branch_number(Event), D) },
+	{ Cont = subgoal_cont(D, Cont0) }.
+process_trace_event_goal(_, Event, switch_rep(As), Cont0, Cont) -->
+	{ list__index1_det(As, switch_event_branch_number(Event), A) },
+	{ Cont = subgoal_cont(A, Cont0) }.
+process_trace_event_goal(_, Event, ite_rep(Cond, Then, Else), Cont0, Cont) -->
+	{
+		Event = cond(_, _, _)
+	->
+		Cont = subgoal_cont(Cond, ite_cont(Then, Else, Cont0))
+	;
+		Event = else(_, _)
+	->
+		%
+		% The contour stepped over the (failed) condition.
+		%
+		Cont = subgoal_cont(Else, Cont0)
+	;
+		error("process_trace_event_goal: ite mismatch")
+	}.
+process_trace_event_goal(Ref, Event, negation_rep(Goal), Cont0, Cont) -->
+	(
+		{ Event = neg_succ(_, _) }
+	->
+		{ Cont = Cont0 }
+	;
+		process_trace_event_goal(Ref, Event, Goal, neg_cont(Cont0),
+				Cont)
+	).
+process_trace_event_goal(Ref, Event, some_rep(Goal), Cont0, Cont) -->
+	process_trace_event_goal(Ref, Event, Goal, Cont0, Cont).
+process_trace_event_goal(Ref, Event, GoalRep, Cont0, Cont) -->
+	{ GoalRep = atomic_goal_rep(_, _, _, _, AtomicGoal) },
+	(
+		{ atomic_goal_rep_is_call(AtomicGoal, _) }
+	->
+		{
+			Event = exit(_, _, _, _, _)
+		->
+			Cont = Cont0
+		;
+			error("process_trace_event_goal: exit mismatch")
+		},
+		[ call_info(Ref, GoalRep) ]
+	;
+		[ unify_info(GoalRep) ],
+		process_trace_event(Ref, Event, Cont0, Cont)
+	).
+
+:- pred process_non_event_goals(goal_cont, maybe(list(var_rep)),
+		list(atom_info(R)), list(atom_info(R))).
+:- mode process_non_event_goals(in, out, out, in) is det.
+
+process_non_event_goals(subgoal_cont(Goal, Cont), MaybeArgs) -->
+	process_non_event_goals_2(Goal, Cont, MaybeArgs).
+process_non_event_goals(conj_cont([], Cont), MaybeArgs) -->
+	process_non_event_goals(Cont, MaybeArgs).
+process_non_event_goals(conj_cont([G | Gs], Cont), MaybeArgs) -->
+	process_non_event_goals_2(G, conj_cont(Gs, Cont), MaybeArgs).
+process_non_event_goals(ite_cont(_, _, _), _) -->
+	{ error("process_non_event_goals: ite event expected") }.
+process_non_event_goals(neg_cont(_), _) -->
+	{ error("process_non_event_goals: neg event expected") }.
+process_non_event_goals(return, no) -->
+	[].
+process_non_event_goals(unknown_goal, _) -->
+	{ error("process_non_event_goals: goal is unknown") }.
+
+:- pred process_non_event_goals_2(goal_rep, goal_cont, maybe(list(var_rep)),
+		list(atom_info(R)), list(atom_info(R))).
+:- mode process_non_event_goals_2(in, in, out, out, in) is det.
+
+process_non_event_goals_2(conj_rep([]), Cont, MaybeArgs) -->
+	process_non_event_goals(Cont, MaybeArgs).
+process_non_event_goals_2(conj_rep([G | Gs]), Cont, MaybeArgs) -->
+	process_non_event_goals_2(G, conj_cont(Gs, Cont), MaybeArgs).
+process_non_event_goals_2(disj_rep(_), _, _) -->
+	{ error("process_non_event_goals_2: disj event expected") }.
+process_non_event_goals_2(switch_rep(_), _, _) -->
+	{ error("process_non_event_goals_2: swtc event expected") }.
+process_non_event_goals_2(ite_rep(_, _, _), _, _) -->
+	{ error("process_non_event_goals_2: cond event expected") }.
+process_non_event_goals_2(negation_rep(Goal), Cont, MaybeArgs) -->
+	process_non_event_goals_2(Goal, neg_cont(Cont), MaybeArgs).
+process_non_event_goals_2(some_rep(Goal), Cont, MaybeArgs) -->
+	process_non_event_goals_2(Goal, Cont, MaybeArgs).
+process_non_event_goals_2(Goal, Cont, MaybeArgs) -->
+	{ Goal = atomic_goal_rep(_, _, _, _, AtomicGoal) },
+	(
+		{ atomic_goal_rep_is_call(AtomicGoal, Args) }
+	->
+		{ MaybeArgs = yes(Args) }
+	;
+		[ unify_info(Goal) ],
+		process_non_event_goals(Cont, MaybeArgs)
+	).
+
+	% Scan through the information derived from the contour, and
+	% track the location of the selected subterm.
+	%
+:- func find_subterm_origin(list(atom_info(R)), var_rep, term_path)
+		= subterm_origin(edt_node(R)).
+
+find_subterm_origin([], VarRep, TermPath) = input(VarRep, TermPath).
+find_subterm_origin([unify_info(Goal) | AtomInfo], VarRep, TermPath)
+		= Origin :-
+	(
+		Goal = atomic_goal_rep(_, File, Line, BoundVars, AtomicGoal),
+		list__member(VarRep, BoundVars)
+	->
+		Origin = find_subterm_origin_unify(File, Line, AtomicGoal,
+				AtomInfo, VarRep, TermPath)
+	;
+		Origin = find_subterm_origin(AtomInfo, VarRep, TermPath)
+	).
+find_subterm_origin([call_info(Ref, Goal) | AtomInfo], VarRep, TermPath)
+		= Origin :-
+	(
+		Goal = atomic_goal_rep(_, _, _, BoundVars, AtomicGoal),
+		list__member(VarRep, BoundVars)
+	->
+		Origin = find_subterm_origin_call(Ref, AtomicGoal, VarRep,
+				TermPath)
+	;
+		Origin = find_subterm_origin(AtomInfo, VarRep, TermPath)
+	).
+
+:- func find_subterm_origin_unify(string, int, atomic_goal_rep,
+		list(atom_info(R)), var_rep, term_path)
+		= subterm_origin(edt_node(R)).
+
+find_subterm_origin_unify(File, Line, unify_construct_rep(_, _, Args),
+		AtomInfo, _, TermPath0) = Origin :-
+	(
+		TermPath0 = [ArgPos | TermPath],
+		list__index1_det(Args, ArgPos, VarRep),
+		Origin = find_subterm_origin(AtomInfo, VarRep, TermPath)
+	;
+		TermPath0 = [],
+		Origin = unification(File, Line)
+	).
+find_subterm_origin_unify(_, _, unify_deconstruct_rep(VarRep, _, Args),
+		AtomInfo, VarRep0, TermPath0) = Origin :-
+	(
+		list__nth_member_search(Args, VarRep0, ArgPos)
+	->
+		TermPath = [ArgPos | TermPath0],
+		Origin = find_subterm_origin(AtomInfo, VarRep, TermPath)
+	;
+		error("find_subterm_origin_unify: arg not found")
+	).
+find_subterm_origin_unify(_, _, unify_assign_rep(_, Source), AtomInfo, _,
+		TermPath) = find_subterm_origin(AtomInfo, Source, TermPath).
+find_subterm_origin_unify(_, _, unify_simple_test_rep(_, _), _, _, _) = _ :-
+	error("find_subterm_origin_unify: unexpected test").
+find_subterm_origin_unify(_, _, pragma_foreign_code_rep(_), _, _, _) = _ :-
+	error("find_subterm_origin_unify: unexpected pragma call").
+find_subterm_origin_unify(_, _, higher_order_call_rep(_, _), _, _, _) = _ :-
+	error("find_subterm_origin_unify: unexpected ho call").
+find_subterm_origin_unify(_, _, method_call_rep(_, _, _), _, _, _) = _ :-
+	error("find_subterm_origin_unify: unexpected method call").
+find_subterm_origin_unify(_, _, plain_call_rep(_, _), _, _, _) = _ :-
+	error("find_subterm_origin_unify: unexpected call").
+
+:- func find_subterm_origin_call(R, atomic_goal_rep, var_rep, term_path)
+		= subterm_origin(edt_node(R)).
+
+find_subterm_origin_call(Ref, Call, VarRep, TermPath) = Origin :-
+	(
+		atomic_goal_rep_is_call(Call, Args),
+		list__nth_member_search(Args, VarRep, ArgPos)
+	->
+		Origin = output(dynamic(Ref), ArgPos, TermPath)
+	;
+		error("find_subterm_origin_call: arg not found")
+	).
+
+%-----------------------------------------------------------------------------%
+
 :- 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.
@@ -578,7 +1015,7 @@
 	;
 		Node = excp(_, Call, _, _, Event)
 	),
-	call_node_from_id(Store, Call, call(_, _, _, SeqNo, _, _)).
+	call_node_from_id(Store, Call, call(_, _, _, SeqNo, _, _, _)).
 
 :- inst trace_node_edt_node =
 		bound(	exit(ground, ground, ground, ground, ground)
@@ -603,6 +1040,47 @@
 	;
 		error("det_edt_node_from_id: not an EXIT, FAIL or EXCP 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, _) :-
+	list__index1_det(Args, ArgPos, yes(_)).
+
+:- func disj_event_branch_number(trace_node(R)) = int.
+
+disj_event_branch_number(Node) = N :-
+	(
+		(
+			Node = first_disj(_, Str)
+		;
+			Node = later_disj(_, Str, _)
+		),
+		list__last(string__words(is_semicolon, Str), LastStepStr),
+		path_step_from_string(LastStepStr, disj(N0))
+	->
+		N = N0
+	;
+		error("disj_event_branch_number: not a DISJ event")
+	).
+
+:- func switch_event_branch_number(trace_node(R)) = int.
+
+switch_event_branch_number(Node) = N :-
+	(
+		Node = switch(_, Str),
+		list__last(string__words(is_semicolon, Str), LastStepStr),
+		path_step_from_string(LastStepStr, switch(N0))
+	->
+		N = N0
+	;
+		error("switch_event_branch_number: not a SWTC event")
+	).
+
+:- pred is_semicolon(char).
+:- mode is_semicolon(in) is semidet.
+
+is_semicolon(';').
 
 %-----------------------------------------------------------------------------%
 
Index: browser/declarative_execution.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_execution.m,v
retrieving revision 1.14
diff -u -r1.14 declarative_execution.m
--- browser/declarative_execution.m	2000/10/16 01:33:22	1.14
+++ browser/declarative_execution.m	2000/11/23 16:14:00
@@ -17,7 +17,7 @@
 :- module mdb__declarative_execution.
 :- interface.
 :- import_module list, std_util, string, io, bool.
-:- import_module mdb__util.
+:- import_module mdb__util, mdb__program_representation.
 
 	% This type represents a port in the annotated trace.
 	% The type R is the type of references to other nodes
@@ -34,7 +34,8 @@
 			trace_atom,		% Atom that was called.
 			sequence_number,	% Call sequence number.
 			event_number,		% Trace event number.
-			bool			% At the maximum depth?
+			bool,			% At the maximum depth?
+			maybe(goal_rep)		% Body of the called procedure.
 		)
 	;	exit(
 			R,			% Preceding event.
@@ -62,20 +63,20 @@
 		)
 	;	switch(
 			R,			% Preceding event.
-			goal_path		% Path for this event.
+			goal_path_string	% Path for this event.
 		)
 	;	first_disj(
 			R,			% Preceding event.
-			goal_path		% Path for this event.
+			goal_path_string	% Path for this event.
 		)
 	;	later_disj(
 			R,			% Preceding event.
-			goal_path,		% Path for this event.
+			goal_path_string,	% Path for this event.
 			R			% Event of the first DISJ.
 		)
 	;	cond(
 			R,			% Preceding event.
-			goal_path,		% Path for this event.
+			goal_path_string,	% Path for this event.
 			goal_status		% Whether we have reached
 						% a THEN or ELSE event.
 		)
@@ -89,7 +90,7 @@
 		)
 	;	neg(
 			R,			% Preceding event.
-			goal_path,		% Path for this event.
+			goal_path_string,	% Path for this event.
 			goal_status		% Whether we have reached
 						% a NEGS or NEGF event.
 		)
@@ -127,8 +128,6 @@
 	;	failed
 	;	undecided.
 
-:- type goal_path == goal_path_string.
-
 :- type sequence_number == int.
 :- type event_number == int.
 
@@ -179,7 +178,8 @@
 :- mode det_trace_node_from_id(in, in, out) is det.
 
 :- inst trace_node_call =
-		bound(call(ground, ground, ground, ground, ground, ground)).
+		bound(call(ground, ground, ground, ground, ground,
+				ground, ground)).
 
 :- pred call_node_from_id(S, R, trace_node(R)) <= annotated_trace(S, R).
 :- mode call_node_from_id(in, in, out(trace_node_call)) is det.
@@ -257,9 +257,9 @@
 :- import_module map, require, store.
 
 step_left_in_contour(Store, exit(_, Call, _, _, _)) = Prec :-
-	call_node_from_id(Store, Call, call(Prec, _, _, _, _, _)).
+	call_node_from_id(Store, Call, call(Prec, _, _, _, _, _, _)).
 step_left_in_contour(Store, excp(_, Call, _, _, _)) = Prec :-
-	call_node_from_id(Store, Call, call(Prec, _, _, _, _, _)).
+	call_node_from_id(Store, Call, call(Prec, _, _, _, _, _, _)).
 step_left_in_contour(_, switch(Prec, _)) = Prec.
 step_left_in_contour(_, first_disj(Prec, _)) = Prec.
 step_left_in_contour(Store, later_disj(_, _, FirstDisj)) = Prec :-
@@ -281,7 +281,7 @@
 	% The following cases are possibly at the left end of a contour,
 	% where we cannot step any further.
 	%
-step_left_in_contour(_, call(_, _, _, _, _, _)) = _ :-
+step_left_in_contour(_, call(_, _, _, _, _, _, _)) = _ :-
 	error("step_left_in_contour: unexpected CALL node").
 step_left_in_contour(_, neg(Prec, _, Status)) = Next :-
 	(
@@ -323,7 +323,7 @@
 	;	neg_fail(ground, ground)).
 
 find_prev_contour(Store, fail(_, Call, _, _), OnContour) :-
-	call_node_from_id(Store, Call, call(OnContour, _, _, _, _, _)).
+	call_node_from_id(Store, Call, call(OnContour, _, _, _, _, _, _)).
 find_prev_contour(Store, redo(_, Exit), OnContour) :-
 	exit_node_from_id(Store, Exit, exit(OnContour, _, _, _, _)).
 find_prev_contour(Store, neg_fail(_, Neg), OnContour) :-
@@ -332,7 +332,7 @@
 	% The following cases are at the left end of a contour,
 	% so there are no previous contours in the same stratum.
 	%
-find_prev_contour(_, call(_, _, _, _, _, _), _) :-
+find_prev_contour(_, call(_, _, _, _, _, _, _), _) :-
 	error("find_prev_contour: reached CALL node").
 find_prev_contour(_, cond(_, _, _), _) :-
 	error("find_prev_contour: reached COND node").
@@ -369,7 +369,7 @@
 	% The following cases mark the boundary of the stratum,
 	% so we cannot step any further.
 	%
-step_in_stratum(_, call(_, _, _, _, _, _)) = _ :-
+step_in_stratum(_, call(_, _, _, _, _, _, _)) = _ :-
 	error("step_in_stratum: unexpected CALL node").
 step_in_stratum(_, neg(_, _, _)) = _ :-
 	error("step_in_stratum: unexpected NEGE node").
@@ -382,7 +382,7 @@
 	->
 		Redo = redo(Next, _)
 	;
-		call_node_from_id(Store, Call, call(Next, _, _, _, _, _))
+		call_node_from_id(Store, Call, call(Next, _, _, _, _, _, _))
 	).
 
 det_trace_node_from_id(Store, NodeId, Node) :-
@@ -397,7 +397,7 @@
 call_node_from_id(Store, NodeId, Node) :-
 	(
 		trace_node_from_id(Store, NodeId, Node0),
-		Node0 = call(_, _, _, _, _, _)
+		Node0 = call(_, _, _, _, _, _, _)
 	->
 		Node = Node0
 	;
@@ -511,7 +511,7 @@
 
 call_node_get_last_interface(Call) = Last :-
 	(
-		Call = call(_, Last0, _, _, _, _)
+		Call = call(_, Last0, _, _, _, _, _)
 	->
 		Last = Last0
 	;
@@ -526,7 +526,7 @@
 
 call_node_set_last_interface(Call0, Last) = Call :-
 	(
-		Call0 = call(_, _, _, _, _, _)
+		Call0 = call(_, _, _, _, _, _, _)
 	->
 		Call1 = Call0
 	;
@@ -590,7 +590,7 @@
 :- 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.
@@ -610,7 +610,7 @@
 :- 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(_, _, _, _)) = "".
@@ -637,12 +637,12 @@
 
 trace_node_seqno(S, Node, SeqNo) :-
 	(
-		Node = call(_, _, _, SeqNo0, _, _)
+		Node = call(_, _, _, SeqNo0, _, _, _)
 	->
 		SeqNo = SeqNo0
 	;
 		trace_node_call(S, Node, Call),
-		call_node_from_id(S, Call, call(_, _, _, SeqNo, _, _))
+		call_node_from_id(S, Call, call(_, _, _, SeqNo, _, _, _))
 	).
 
 :- pred trace_node_call(trace_node_store, trace_node(trace_node_id),
@@ -724,7 +724,19 @@
 		"MR_DD_construct_call_node").
 
 construct_call_node(Preceding, Atom, SeqNo, EventNo, MaxDepth) = Call :-
-	Call = call(Preceding, Answer, Atom, SeqNo, EventNo, MaxDepth),
+	Call = call(Preceding, Answer, Atom, SeqNo, EventNo, MaxDepth, no),
+	null_trace_node_id(Answer).
+
+:- func construct_call_node_with_goal(trace_node_id, trace_atom,
+		sequence_number, event_number, bool, goal_rep)
+		= trace_node(trace_node_id).
+:- pragma export(construct_call_node_with_goal(in, in, in, in, in, in) = out,
+		"MR_DD_construct_call_node_with_goal").
+
+construct_call_node_with_goal(Preceding, Atom, SeqNo, EventNo, MaxDepth,
+		GoalRep) = Call :-
+	Call = call(Preceding, Answer, Atom, SeqNo, EventNo, MaxDepth,
+			yes(GoalRep)),
 	null_trace_node_id(Answer).
 
 
@@ -967,7 +979,7 @@
 	%
 :- 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.
Index: browser/program_representation.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/program_representation.m,v
retrieving revision 1.3
diff -u -r1.3 program_representation.m
--- browser/program_representation.m	2000/11/18 11:28:46	1.3
+++ browser/program_representation.m	2000/11/23 16:14:02
@@ -39,12 +39,11 @@
 	% generated statically and stored inside the executable.
 	%
 	% Each element of this structure will correspond one-to-one
-	% to the original stage 90 HLDS, with the exception of conj
-	% goal_reps, which are stored in reversed order.
+	% to the original stage 90 HLDS.
 
 :- type goal_rep
 	--->	conj_rep(
-			list(goal_rep)		% The conjuncts in reverse
+			list(goal_rep)		% The conjuncts in the original
 						% order.
 		)
 	;	disj_rep(
@@ -126,12 +125,77 @@
 	;	erroneous_rep
 	;	failure_rep.
 
+:- pred atomic_goal_rep_is_call(atomic_goal_rep, list(var_rep)).
+:- mode atomic_goal_rep_is_call(in, out) is semidet.
+
+%-----------------------------------------------------------------------------%
+
+	% The following three types are derived from compiler/hlds_goal.m.
+
+:- type goal_path == list(goal_path_step).
+
+:- type goal_path_step  --->    conj(int)
+                        ;       disj(int)
+                        ;       switch(int)
+                        ;       ite_cond
+                        ;       ite_then
+                        ;       ite_else
+                        ;       neg
+                        ;       exist(maybe_cut)
+                        ;       first
+                        ;       later.
+
+:- type maybe_cut       --->    cut ; no_cut.
+
+:- pred path_step_from_string(string, goal_path_step).
+:- mode path_step_from_string(in, out) is semidet.
+
+	% Head variables are represented by a number from 1..N,
+	% where N is the arity.
+	
+:- type arg_pos ==	var_rep.
+
+	% A particular subterm within a term is represented by a term_path.
+	% This is the list of argument positions that need to be followed
+	% in order to travel from the root to the subterm.  In contrast to
+	% goal_paths, this list is in top-down order.
+
+:- type term_path ==	list(arg_pos).
+
 	% Returns type_of(_ `with_type` goal_rep), for use in C code.
 :- func goal_rep_type = type_desc.
 
 %-----------------------------------------------------------------------------%
 
 :- implementation.
+:- import_module string, char.
+
+atomic_goal_rep_is_call(pragma_foreign_code_rep(Args), Args).
+atomic_goal_rep_is_call(higher_order_call_rep(_, Args), Args).
+atomic_goal_rep_is_call(method_call_rep(_, _, Args), Args).
+atomic_goal_rep_is_call(plain_call_rep(_, Args), Args).
+
+path_step_from_string(String, Step) :-
+	string__first_char(String, First, Rest),
+	path_step_from_string_2(First, Rest, Step).
+
+:- pred path_step_from_string_2(char, string, goal_path_step).
+:- mode path_step_from_string_2(in, in, out) is semidet.
+
+path_step_from_string_2('c', NStr, conj(N)) :-
+	string__to_int(NStr, N).
+path_step_from_string_2('d', NStr, disj(N)) :-
+	string__to_int(NStr, N).
+path_step_from_string_2('s', NStr, switch(N)) :-
+	string__to_int(NStr, N).
+path_step_from_string_2('?', "", ite_cond).
+path_step_from_string_2('t', "", ite_then).
+path_step_from_string_2('e', "", ite_else).
+path_step_from_string_2('~', "", neg).
+path_step_from_string_2('q', "!", exist(cut)).
+path_step_from_string_2('q', "", exist(no_cut)).
+path_step_from_string_2('f', "", first).
+path_step_from_string_2('l', "", later).
 
 :- pragma export(goal_rep_type = out, "ML_goal_rep_type").
 goal_rep_type = type_of(_ `with_type` goal_rep).
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_goal.m,v
retrieving revision 1.82
diff -u -r1.82 hlds_goal.m
--- compiler/hlds_goal.m	2000/11/23 04:32:18	1.82
+++ compiler/hlds_goal.m	2000/11/23 16:14:21
@@ -713,6 +713,10 @@
 	% the root is last. (Keeping the list in reverse order makes the
 	% common operations constant-time instead of linear in the length
 	% of the list.)
+	%
+	% If any of the following three types is changed, then the
+	% corresponding types in browser/program_representation.m must be
+	% updated.
 
 :- type goal_path == list(goal_path_step).
 
Index: compiler/prog_rep.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_rep.m,v
retrieving revision 1.4
diff -u -r1.4 prog_rep.m
--- compiler/prog_rep.m	2000/11/17 17:48:35	1.4
+++ compiler/prog_rep.m	2000/11/23 16:14:25
@@ -142,8 +142,7 @@
 		AtomicGoalRep).
 prog_rep__represent_goal_expr(conj(Goals), _, InstMap0, Info, Rep) :-
 	prog_rep__represent_conj(Goals, InstMap0, Info, Reps),
-	list__reverse(Reps, ReverseReps),
-	Rep = conj_rep(ReverseReps).
+	Rep = conj_rep(Reps).
 prog_rep__represent_goal_expr(par_conj(_, _), _, _, _, _) :-
 	error("Sorry, not yet implemented:\n\
 	parallel conjunctions and declarative debugging").
Index: compiler/trace.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/trace.m,v
retrieving revision 1.40
diff -u -r1.40 trace.m
--- compiler/trace.m	2000/11/23 04:32:49	1.40
+++ compiler/trace.m	2000/11/23 16:14:36
@@ -923,6 +923,10 @@
 	trace__path_step_to_string(Step, StepStr),
 	trace__path_steps_to_strings(Steps, StepStrs).
 
+	% The inverse of this procedure is implemented in
+	% browser/program_representation.m, and must be updated if this
+	% is changed.
+
 :- pred trace__path_step_to_string(goal_path_step::in, string::out) is det.
 
 trace__path_step_to_string(conj(N), Str) :-
Index: trace/mercury_trace_declarative.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_declarative.c,v
retrieving revision 1.33
diff -u -r1.33 mercury_trace_declarative.c
--- trace/mercury_trace_declarative.c	2000/11/10 01:01:04	1.33
+++ trace/mercury_trace_declarative.c	2000/11/23 16:15:15
@@ -477,6 +477,7 @@
 	MR_Word				atom;
 	bool				at_depth_limit;
 	const MR_Stack_Layout_Label	*layout = event_info->MR_event_sll;
+	MR_Word				proc_rep;
 
 	if (event_info->MR_call_depth == MR_edt_max_depth) {
 		at_depth_limit = TRUE;
@@ -484,14 +485,24 @@
 		at_depth_limit = FALSE;
 	}
 
+	proc_rep = layout->MR_sll_entry->MR_sle_proc_rep;
 	atom = MR_decl_make_atom(layout, event_info->MR_saved_regs,
 			MR_PORT_CALL);
 	MR_TRACE_CALL_MERCURY(
-		node = (MR_Trace_Node) MR_DD_construct_call_node(
+		if (proc_rep) {
+			node = (MR_Trace_Node)
+				MR_DD_construct_call_node_with_goal(
 					(MR_Word) prev, atom,
 					(MR_Word) event_info->MR_call_seqno,
 					(MR_Word) event_info->MR_event_number,
+					(MR_Word) at_depth_limit, proc_rep);
+		} else {
+			node = (MR_Trace_Node)
+				MR_DD_construct_call_node((MR_Word) prev, atom,
+					(MR_Word) event_info->MR_call_seqno,
+					(MR_Word) event_info->MR_event_number,
 					(MR_Word) at_depth_limit);
+		}
 	);
 
 #ifdef MR_USE_DECL_STACK_SLOT
--------------------------------------------------------------------------
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