[m-rev.] for review: allow tracking of input subterms through builtin_catch

Ian MacLarty maclarty at cs.mu.OZ.AU
Thu Dec 8 08:31:31 AEDT 2005


For review by anyone.

Estimated hours taken: 5
Branches: main

Allow input subterms to be tracked through builtin_catch.  By making
a special case of catch_impl, which is the only predicate that calls
builtin_catch (we have to make catch_impl the special case, because
builtin_catch doesn't generate any events, so has no node in the EDT).

browser/declarative_tree.m:
	Break trace_dependency into two smaller predicates.
	If tracking an input to builtin_catch then return what we know
	the origin will be instead of invoking the usual subterm dependency
	tracking algorithm.

library/exception.m:
	Note that the debugger assumes builtin_catch is only called from
	catch_impl.

tests/debugger/declarative/Mmakefile:
tests/debugger/declarative/track_through_catch.exp:
tests/debugger/declarative/track_through_catch.inp:
tests/debugger/declarative/track_through_catch.m:
	Test the change.

Index: browser/declarative_tree.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_tree.m,v
retrieving revision 1.35
diff -u -r1.35 declarative_tree.m
--- browser/declarative_tree.m	7 Dec 2005 16:06:59 -0000	1.35
+++ browser/declarative_tree.m	7 Dec 2005 21:12:25 -0000
@@ -829,60 +829,35 @@
 trace_dependency(wrap(Store), dynamic(Ref), ArgPos, TermPath, Mode, Origin) :-
 	find_chain_start(Store, Ref, ArgPos, TermPath, ChainStart),
 	(
-		ChainStart = chain_start(StartLoc, ArgNum, TotalArgs, NodeId,
-			StartPath, MaybeProcRep),
+		ChainStart = chain_start(StartLoc, ArgNum, TotalArgs,
+			NodeId, StartPath, MaybeProcRep),
 		Mode = start_loc_to_subterm_mode(StartLoc),
 		(
 			MaybeProcRep = no,
 			Origin = not_found
 		;
 			MaybeProcRep = yes(ProcRep),
-			det_trace_node_from_id(Store, NodeId, Node),
-			materialize_contour(Store, NodeId, Node, [], Contour0),
 			(
-				StartLoc = parent_goal(CallId, CallNode),
-				Contour = list.append(Contour0,
-					[CallId - CallNode])
-			;
-				StartLoc = cur_goal,
-				Contour = Contour0
-			),
-			ProcRep = proc_rep(HeadVars, GoalRep),
-			is_traced_grade(AllTraced),
-			MaybePrims = make_primitive_list(Store,
-				[goal_and_path(GoalRep, [])],
-				Contour, StartPath, ArgNum, TotalArgs,
-				HeadVars, AllTraced, []),
-			(
-				MaybePrims = yes(primitive_list_and_var(
-					Primitives, Var, MaybeClosure)),
-				%
-				% If the subterm is in a closure argument (i.e.
-				% an argument passed to the predicate that
-				% originally formed the closure), then the
-				% argument number of the closure argument is
-				% prefixed to the term path, since the closure
-				% is itself a term.  This is done because at
-				% the time of the closure call it is not easy
-				% to decide if the call is higher order or not,
-				% without repeating all the work done in
-				% make_primitive_list, so the original TermPath
-				% doesn't reflect the closure argument
-				% position.
 				%
-				(
-					MaybeClosure = yes,
-					AdjustedTermPath = [ArgNum | TermPath]
-				;
-					MaybeClosure = no,
-					AdjustedTermPath = TermPath
-				),
-				traverse_primitives(Primitives, Var,
-					AdjustedTermPath, Store, ProcRep,
-					Origin)
+				% catch_impl's body is a single call to
+				% builtin_catch.  builtin_catch doesn't
+				% generate any events, so we need to
+				% handle catch_impl specially.
+				% If the subterm being tracked is an
+				% input to builtin_catch then we know the
+				% origin will be in the first argument of
+				% catch_impl, because builtin_catch is
+				% only called from catch_impl.
+				% 
+				proc_rep_is_catch_impl(ProcRep),
+				StartLoc = parent_goal(_, _)
+			->
+				Origin = input(user_head_var(1),
+					[ArgNum | TermPath])
 			;
-				MaybePrims = no,
-				Origin = not_found
+				trace_dependency_in_proc_rep(Store, TermPath,
+					StartLoc, ArgNum, TotalArgs, NodeId,
+					StartPath, ProcRep, Origin)
 			)
 		)
 	;
@@ -893,6 +868,67 @@
 		Mode = subterm_out
 	).
 
+:- pred trace_dependency_in_proc_rep(S::in, term_path::in, 
+	start_loc(R)::in, int::in, int::in, R::in, maybe(goal_path)::in,
+	proc_rep::in, subterm_origin(edt_node(R))::out) 
+	is det <= annotated_trace(S, R).
+
+trace_dependency_in_proc_rep(Store, TermPath, StartLoc, ArgNum,
+	TotalArgs, NodeId, StartPath, ProcRep, Origin) :-
+	det_trace_node_from_id(Store, NodeId, Node),
+	materialize_contour(Store, NodeId, Node, [], Contour0),
+	(
+		StartLoc = parent_goal(CallId, CallNode),
+		Contour = list.append(Contour0,
+			[CallId - CallNode])
+	;
+		StartLoc = cur_goal,
+		Contour = Contour0
+	),
+	ProcRep = proc_rep(HeadVars, GoalRep),
+	is_traced_grade(AllTraced),
+	MaybePrims = make_primitive_list(Store,
+		[goal_and_path(GoalRep, [])],
+		Contour, StartPath, ArgNum, TotalArgs,
+		HeadVars, AllTraced, []),
+	(
+		MaybePrims = yes(primitive_list_and_var(
+			Primitives, Var, MaybeClosure)),
+		%
+		% If the subterm is in a closure argument then the argument
+		% number of the closure argument is prefixed to the term path,
+		% since the closure is itself a term.  This is done here
+		% because at the time of the closure call it is not easy to
+		% decide if the call is higher order or not, without repeating
+		% all the work done in make_primitive_list.
+		%
+		(
+			MaybeClosure = yes,
+			AdjustedTermPath = [ArgNum | TermPath]
+		;
+			MaybeClosure = no,
+			AdjustedTermPath = TermPath
+		),
+		traverse_primitives(Primitives, Var,
+			AdjustedTermPath, Store, ProcRep,
+			Origin)
+	;
+		MaybePrims = no,
+		Origin = not_found
+	).
+
+	% proc_rep_is_catch_impl(ProcRep) is true if ProcRep is a
+	% representation of exception.catch_impl (the conserve
+	% is true assuming exception.builtin_catch is only called from
+	% exception.catch_impl).
+	%
+:- pred proc_rep_is_catch_impl(proc_rep::in) is semidet.
+
+proc_rep_is_catch_impl(ProcRep) :-
+	ProcRep = proc_rep([A, B, C, D], atomic_goal_rep(_, "exception.m", _,
+		[D], plain_call_rep("exception", "builtin_catch",
+			[A, B, C, D]))).
+
 :- pred find_chain_start(S::in, R::in, arg_pos::in, term_path::in,
 	dependency_chain_start(R)::out) is det <= annotated_trace(S, R).
 
@@ -1423,7 +1459,6 @@
 					MaybePrims = yes(
 						primitive_list_and_var(
 							Primitives0, Var, no))
-
 				;
 					% Perhaps this is a closure and the
 					% argument was passed in when the
Index: library/exception.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/exception.m,v
retrieving revision 1.101
diff -u -r1.101 exception.m
--- library/exception.m	7 Dec 2005 16:07:10 -0000	1.101
+++ library/exception.m	7 Dec 2005 21:27:38 -0000
@@ -699,8 +699,15 @@
 :- mode catch_impl(pred(out) is multi,     in(handler), out) is multi.
 :- mode catch_impl(pred(out) is nondet,    in(handler), out) is nondet.
 
-% by default we call the external implementation, but specific backends
+%
+% By default we call the external implementation, but specific backends
 % can provide their own definition using foreign_proc.
+% NOTE: The subterm dependency tracking algorithm in the declarative
+%       debugger expects builtin_catch to only be called from catch_impl.
+%       If catch_impl is modified for a backend that supports debugging,
+%       or builtin_catch is called from somewhere else, then
+%       the code in browser/declarative_tree.m will need to be modified.
+%
 
 throw_impl(Univ::in) :-
 	builtin_throw(Univ).
Index: tests/debugger/declarative/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/Mmakefile,v
retrieving revision 1.87
diff -u -r1.87 Mmakefile
--- tests/debugger/declarative/Mmakefile	7 Dec 2005 16:07:15 -0000	1.87
+++ tests/debugger/declarative/Mmakefile	7 Dec 2005 20:31:38 -0000
@@ -86,6 +86,7 @@
 	catch_retry		\
 	priv_builtin_bug	\
 	sort			\
+	track_through_catch	\
 	typed_unify
 	
 # The following should not be run in decldebug grades.
@@ -433,6 +434,11 @@
 		priv_builtin_bug.out 2>&1 \
 	|| { grep . $@ /dev/null; exit 1; }
 
+track_through_catch.out: track_through_catch track_through_catch.inp
+	$(MDB_STD) ./track_through_catch < track_through_catch.inp > \
+		track_through_catch.out 2>&1 \
+	|| { grep . $@ /dev/null; exit 1; }
+
 typed_unify.out: typed_unify typed_unify.inp
 	$(MDB_STD) ./typed_unify < typed_unify.inp > \
 		typed_unify.out 2>&1 \
Index: tests/debugger/declarative/track_through_catch.exp
===================================================================
RCS file: tests/debugger/declarative/track_through_catch.exp
diff -N tests/debugger/declarative/track_through_catch.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/track_through_catch.exp	7 Dec 2005 19:50:37 -0000
@@ -0,0 +1,30 @@
+      E1:     C1 CALL pred track_through_catch.main/2-0 (cc_multi) track_through_catch.m:13
+mdb> mdb> echo on
+Command echo enabled.
+mdb> untrust 0
+mdb> table_io start
+I/O tabling started.
+mdb> break r
+ 0: + stop  interface pred track_through_catch.r/2-0 (det)
+mdb> c
+      E2:     C2 CALL pred track_through_catch.r/2-0 (det) track_through_catch.m:30 (track_through_catch.m:26)
+mdb> delete *
+ 0: E stop  interface pred track_through_catch.r/2-0 (det)
+mdb> f
+      E3:     C2 EXIT pred track_through_catch.r/2-0 (det) track_through_catch.m:30 (track_through_catch.m:26)
+mdb> dd
+r(2, 2)
+Valid? b 1
+browser> track -a
+succeeded(2)
+p(2)
+Valid? info
+Context of current question : track_through_catch.m:21 (track_through_catch.m:14)
+Search mode                 : top down                                           
+The current question was chosen because the marked subterm was bound by
+the unification inside the predicate track_through_catch.p/1
+(track_through_catch.m:21). The path to the subterm in the atom is 1.
+dd> quit
+Diagnosis aborted.
+      E3:     C2 EXIT pred track_through_catch.r/2-0 (det) track_through_catch.m:30 (track_through_catch.m:26)
+mdb> quit -y
Index: tests/debugger/declarative/track_through_catch.inp
===================================================================
RCS file: tests/debugger/declarative/track_through_catch.inp
diff -N tests/debugger/declarative/track_through_catch.inp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/track_through_catch.inp	7 Dec 2005 15:37:11 -0000
@@ -0,0 +1,14 @@
+register --quiet
+echo on
+untrust 0
+table_io start
+break r
+c
+delete *
+f
+dd
+b 1
+track -a
+info
+quit
+quit -y
Index: tests/debugger/declarative/track_through_catch.m
===================================================================
RCS file: tests/debugger/declarative/track_through_catch.m
diff -N tests/debugger/declarative/track_through_catch.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/track_through_catch.m	7 Dec 2005 15:22:24 -0000
@@ -0,0 +1,30 @@
+:- module track_through_catch.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is cc_multi.
+
+:- implementation.
+
+:- import_module exception, int.
+
+main(!IO) :-
+	p(X),
+	try(q(X), Result),
+	io.write(Result, !IO),
+	nl(!IO).
+
+:- pred p(int::out) is det.
+
+p(2).
+
+:- pred q(int::in, int::out) is det.
+
+q(X, Y) :-
+	r(X, Y).
+
+:- pred r(int::in, int::out) is det.
+
+r(X, X).
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------



More information about the reviews mailing list