[m-dev.] for review: declarative debugging of exceptions
Mark Anthony BROWN
dougl at cs.mu.OZ.AU
Wed Jul 19 22:31:40 AEST 2000
Hi,
This is for review by DJ or Zoltan.
Cheers,
Mark.
--
Estimated hours taken: 8
Implement declarative debugging of code that throws exceptions.
This aborts if used on code that handles exceptions. There is no point
dealing with this yet, since the oracle won't handle the higher order
argument to try/2.
browser/declarative_debugger.m:
Add "unexpected exception" questions and "unhandled exception" bugs,
and generate these from EXCP events. Handle the exception case
in various switches.
Add a predicate unexpected_exception_children/4, analogous to
{wrong,missing}_answer_children/4.
browser/declarative_execution.m:
Add excp/5 nodes to the event trace, and export a C function to
construct them. Handle these nodes in various switches.
Allow contours to extend beyond NEGE events, if the status is
`undecided'. Such events have no matching NEGS or NEGF event,
so they do not mark the boundary of a separate context.
browser/declarative_oracle.m:
Store information about which exceptions should/shouldn't be thrown
from various calls, and use this information to answer questions
where possible.
browser/declarative_user.m:
Handle the new questions and bugs.
trace/mercury_trace_declarative.c:
Add a function to deal with EXCP events.
trace/mercury_trace_internal.c:
Allow declarative debugging to be started from EXCP events.
tests/debugger/declarative/Mmakefile:
tests/debugger/declarative/throw.m:
tests/debugger/declarative/throw.inp:
tests/debugger/declarative/throw.exp:
tests/debugger/declarative/throw.exp2:
A test case for this feature.
tests/debugger/declarative/queens.exp:
Update the output from this test.
Index: browser/declarative_debugger.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_debugger.m,v
retrieving revision 1.16
diff -u -r1.16 declarative_debugger.m
--- browser/declarative_debugger.m 2000/07/14 07:02:08 1.16
+++ browser/declarative_debugger.m 2000/07/19 12:13:17
@@ -63,6 +63,12 @@
decl_atom, % The called atom, in its initial
% state.
event_number % The fail event.
+ )
+ ; unhandled_exception(
+ decl_atom, % The called atom, in its initial
+ % state.
+ decl_exception, % The exception thrown.
+ event_number % The excp event.
).
:- type decl_i_bug
@@ -97,12 +103,21 @@
% of instantiatedness (ie. at the CALL event),
% and the second argument is the list of solutions.
%
- ; missing_answer(decl_atom, list(decl_atom)).
+ ; missing_answer(decl_atom, list(decl_atom))
+
+ % The node is a possibly unexpected exception.
+ % The first argument is the atom in its initial
+ % state of instantiation, and the second argument
+ % is the exception thrown.
+ %
+ ; unexpected_exception(decl_atom, decl_exception).
:- type decl_answer == pair(decl_question, decl_truth).
:- type decl_atom == trace_atom.
+:- type decl_exception == univ.
+
% The diagnoser eventually responds with a value of this type
% after it is called.
%
@@ -342,6 +357,11 @@
;
Node = exit(_, _, _, ExitAtom, _),
Root = wrong_answer(ExitAtom)
+ ;
+ Node = excp(_, CallId, _, Exception, _),
+ call_node_from_id(Store, CallId, Call),
+ Call = call(_, _, CallAtom, _, _, _),
+ Root = unexpected_exception(CallAtom, Exception)
).
:- pred get_answers(S, R, list(decl_atom), list(decl_atom))
@@ -372,6 +392,11 @@
call_node_from_id(S, CallId, Call),
Call = call(_, _, CallAtom, _, _, _),
Bug = partially_uncovered_atom(CallAtom, Event)
+ ;
+ Node = excp(_, CallId, _, Exception, Event),
+ call_node_from_id(S, CallId, Call),
+ Call = call(_, _, CallAtom, _, _, _),
+ Bug = unhandled_exception(CallAtom, Exception, Event)
).
:- pred trace_children(wrap(S), edt_node(R), list(edt_node(R)))
@@ -388,6 +413,10 @@
Node = exit(PrecId, CallId, _, _, _),
not_at_depth_limit(Store, CallId),
wrong_answer_children(Store, PrecId, [], Children)
+ ;
+ Node = excp(PrecId, CallId, _, _, _),
+ not_at_depth_limit(Store, CallId),
+ unexpected_exception_children(Store, PrecId, [], Children)
).
:- pred not_at_depth_limit(S, R) <= annotated_trace(S, R).
@@ -413,6 +442,10 @@
%
Ns = Ns0
;
+ Node = excp(_, _, _, _, _)
+ ->
+ error("wrong_answer_children: exception handling not supported")
+ ;
(
Node = exit(_, _, _, _, _)
->
@@ -453,6 +486,11 @@
%
Ns = Ns0
;
+ Node = excp(_, _, _, _, _)
+ ->
+ error(
+ "missing_answer_children: exception handling not supported")
+ ;
(
( Node = exit(_, _, _, _, _)
; Node = fail(_, _, _, _)
@@ -485,6 +523,48 @@
missing_answer_children(Store, Next, Ns1, Ns)
).
+:- pred unexpected_exception_children(S, R, list(edt_node(R)),
+ list(edt_node(R))) <= annotated_trace(S, R).
+:- mode unexpected_exception_children(in, in, in, out) is det.
+
+unexpected_exception_children(Store, NodeId, Ns0, Ns) :-
+ det_trace_node_from_id(Store, NodeId, Node),
+ (
+ ( Node = call(_, _, _, _, _, _)
+ ; Node = neg(_, _, failed)
+ ; Node = cond(_, _, failed)
+ )
+ ->
+ %
+ % We have reached the end of the contour.
+ %
+ Ns = Ns0
+ ;
+ (
+ ( Node = exit(_, _, _, _, _)
+ ; Node = excp(_, _, _, _, _)
+ )
+ ->
+ %
+ % Add a child for this node.
+ %
+ Ns1 = [dynamic(NodeId) | Ns0]
+ ;
+ ( Node = else(Prec, _)
+ ; Node = neg_succ(Prec, _)
+ )
+ ->
+ %
+ % There is a nested context.
+ %
+ missing_answer_children(Store, Prec, Ns0, Ns1)
+ ;
+ Ns1 = Ns0
+ ),
+ Next = step_left_in_contour(Store, Node),
+ unexpected_exception_children(Store, Next, Ns1, Ns)
+ ).
+
:- 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.
@@ -495,12 +575,15 @@
Node = exit(_, Call, _, _, Event)
;
Node = fail(_, Call, _, Event)
+ ;
+ Node = excp(_, Call, _, _, Event)
),
call_node_from_id(Store, Call, call(_, _, _, SeqNo, _, _)).
:- inst trace_node_edt_node =
bound( exit(ground, ground, ground, ground, ground)
- ; fail(ground, ground, ground, ground)).
+ ; fail(ground, ground, ground, ground)
+ ; excp(ground, ground, ground, ground, ground)).
:- pred det_edt_node_from_id(S, R, trace_node(R)) <= annotated_trace(S, R).
:- mode det_edt_node_from_id(in, in, out(trace_node_edt_node)) is det.
@@ -512,11 +595,13 @@
Node0 = exit(_, _, _, _, _)
;
Node0 = fail(_, _, _, _)
+ ;
+ Node0 = excp(_, _, _, _, _)
)
->
Node = Node0
;
- error("det_edt_node_from_id: not an EXIT or FAIL node")
+ error("det_edt_node_from_id: not an EXIT, FAIL or EXCP node")
).
%-----------------------------------------------------------------------------%
@@ -529,6 +614,8 @@
EBug = incorrect_contour(_, _, Event)
;
EBug = partially_uncovered_atom(_, Event)
+ ;
+ EBug = unhandled_exception(_, _, Event)
).
decl_bug_get_event_number(i_bug(IBug), Event) :-
IBug = inadmissible_call(_, _, _, Event).
Index: browser/declarative_execution.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_execution.m,v
retrieving revision 1.11
diff -u -r1.11 declarative_execution.m
--- browser/declarative_execution.m 2000/07/14 07:02:08 1.11
+++ browser/declarative_execution.m 2000/07/19 12:13:27
@@ -53,6 +53,13 @@
R, % Previous REDO event, if any.
event_number % Trace event number.
)
+ ; excp(
+ R, % Preceding event.
+ R, % Call event.
+ R, % Previous redo, if any.
+ univ, % Exception thrown.
+ event_number % Trace event number.
+ )
; switch(
R, % Preceding event.
goal_path % Path for this event.
@@ -249,6 +256,8 @@
step_left_in_contour(Store, exit(_, 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, _, _, _, _, _)).
step_left_in_contour(_, switch(Prec, _)) = Prec.
step_left_in_contour(_, first_disj(Prec, _)) = Prec.
step_left_in_contour(Store, later_disj(_, _, FirstDisj)) = Prec :-
@@ -267,13 +276,24 @@
step_left_in_contour(Store, neg_succ(_, Neg)) = Prec :-
neg_node_from_id(Store, Neg, neg(Prec, _, _)).
%
- % The following cases are at the left end of a contour,
- % so we cannot step any further.
+ % The following cases are possibly at the left end of a contour,
+ % where we cannot step any further.
%
step_left_in_contour(_, call(_, _, _, _, _, _)) = _ :-
error("step_left_in_contour: unexpected CALL node").
-step_left_in_contour(_, neg(_, _, _)) = _ :-
- error("step_left_in_contour: unexpected NEGE node").
+step_left_in_contour(_, neg(Prec, _, Status)) = Next :-
+ (
+ Status = undecided
+ ->
+ %
+ % An exception must have been thrown inside the
+ % negation, so we don't consider it a separate
+ % context.
+ %
+ Next = Prec
+ ;
+ error("step_left_in_contour: unexpected NEGE node")
+ ).
%
% In the remaining cases we have reached a dead end, so we
% step to the previous contour instead.
@@ -317,22 +337,12 @@
find_prev_contour(_, neg(_, _, _), _) :-
error("find_prev_contour: reached NEGE node").
-step_in_stratum(Store, exit(_, Call, MaybeRedo, _, _)) = Next :-
- (
- maybe_redo_node_from_id(Store, MaybeRedo, Redo)
- ->
- Redo = redo(Next, _)
- ;
- call_node_from_id(Store, Call, call(Next, _, _, _, _, _))
- ).
-step_in_stratum(Store, fail(_, Call, MaybeRedo, _)) = Next :-
- (
- maybe_redo_node_from_id(Store, MaybeRedo, Redo)
- ->
- Redo = redo(Next, _)
- ;
- call_node_from_id(Store, Call, call(Next, _, _, _, _, _))
- ).
+step_in_stratum(Store, exit(_, Call, MaybeRedo, _, _)) =
+ step_over_redo_or_call(Store, Call, MaybeRedo).
+step_in_stratum(Store, fail(_, Call, MaybeRedo, _)) =
+ step_over_redo_or_call(Store, Call, MaybeRedo).
+step_in_stratum(Store, excp(_, Call, MaybeRedo, _, _)) =
+ step_over_redo_or_call(Store, Call, MaybeRedo).
step_in_stratum(Store, redo(_, Exit)) = Next :-
exit_node_from_id(Store, Exit, exit(Next, _, _, _, _)).
step_in_stratum(_, switch(Next, _)) = Next.
@@ -362,6 +372,17 @@
step_in_stratum(_, neg(_, _, _)) = _ :-
error("step_in_stratum: unexpected NEGE node").
+:- func step_over_redo_or_call(S, R, R) = R <= annotated_trace(S, R).
+
+step_over_redo_or_call(Store, Call, MaybeRedo) = Next :-
+ (
+ maybe_redo_node_from_id(Store, MaybeRedo, Redo)
+ ->
+ Redo = redo(Next, _)
+ ;
+ call_node_from_id(Store, Call, call(Next, _, _, _, _, _))
+ ).
+
det_trace_node_from_id(Store, NodeId, Node) :-
(
trace_node_from_id(Store, NodeId, Node0)
@@ -571,6 +592,7 @@
trace_node_port(exit(_, _, _, _, _)) = exit.
trace_node_port(redo(_, _)) = redo.
trace_node_port(fail(_, _, _, _)) = fail.
+trace_node_port(excp(_, _, _, _, _)) = exception.
trace_node_port(switch(_, _)) = switch.
trace_node_port(first_disj(_, _)) = disj.
trace_node_port(later_disj(_, _, _)) = disj.
@@ -590,6 +612,7 @@
trace_node_path(_, exit(_, _, _, _, _)) = "".
trace_node_path(_, redo(_, _)) = "".
trace_node_path(_, fail(_, _, _, _)) = "".
+trace_node_path(_, excp(_, _, _, _, _)) = "".
trace_node_path(_, switch(_, P)) = P.
trace_node_path(_, first_disj(_, P)) = P.
trace_node_path(_, later_disj(_, P, _)) = P.
@@ -630,6 +653,7 @@
trace_node_call(S, redo(_, Exit), Call) :-
exit_node_from_id(S, Exit, exit(_, Call, _, _, _)).
trace_node_call(_, fail(_, Call, _, _), Call).
+trace_node_call(_, excp(_, Call, _, _, _), Call).
:- pred trace_node_first_disj(trace_node(trace_node_id), trace_node_id).
:- mode trace_node_first_disj(in, out) is semidet.
@@ -728,6 +752,15 @@
fail(Preceding, Call, Redo, EventNo).
+:- func construct_excp_node(trace_node_id, trace_node_id, trace_node_id,
+ univ, event_number) = trace_node(trace_node_id).
+:- pragma export(construct_excp_node(in, in, in, in, in) = out,
+ "MR_DD_construct_excp_node").
+
+construct_excp_node(Preceding, Call, MaybeRedo, Exception, EventNo) =
+ excp(Preceding, Call, MaybeRedo, Exception, EventNo).
+
+
:- func construct_switch_node(trace_node_id, goal_path_string)
= trace_node(trace_node_id).
:- pragma export(construct_switch_node(in, in) = out,
@@ -935,6 +968,7 @@
preceding_node(exit(P, _, _, _, _)) = P.
preceding_node(redo(P, _)) = P.
preceding_node(fail(P, _, _, _)) = P.
+preceding_node(excp(P, _, _, _, _)) = P.
preceding_node(switch(P, _)) = P.
preceding_node(first_disj(P, _)) = P.
preceding_node(later_disj(P, _, _)) = P.
Index: browser/declarative_oracle.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_oracle.m,v
retrieving revision 1.8
diff -u -r1.8 declarative_oracle.m
--- browser/declarative_oracle.m 2000/03/01 04:17:23 1.8
+++ browser/declarative_oracle.m 2000/07/19 12:13:30
@@ -166,48 +166,71 @@
% The sets in this map are all incomplete---there
% exists a correct solution which is not in the set.
%
- map(decl_atom, set(decl_atom))
+ map(decl_atom, set(decl_atom)),
+
+ % Mapping from call atoms to information about which
+ % exceptions are possible or impossible.
+ %
+ map(decl_atom, known_exceptions)
).
+:- type known_exceptions
+ ---> known_excp(
+ set(univ), % Possible exceptions.
+ set(univ) % Impossible exceptions.
+ ).
+
:- pred oracle_kb_init(oracle_kb).
:- mode oracle_kb_init(out) is det.
-oracle_kb_init(oracle_kb(G, Y, N)) :-
+oracle_kb_init(oracle_kb(G, Y, N, X)) :-
map__init(G),
map__init(Y),
- map__init(N).
+ map__init(N),
+ map__init(X).
:- pred get_kb_ground_map(oracle_kb, map(decl_atom, decl_truth)).
:- mode get_kb_ground_map(in, out) is det.
-get_kb_ground_map(oracle_kb(Map, _, _), Map).
+get_kb_ground_map(oracle_kb(Map, _, _, _), Map).
:- pred set_kb_ground_map(oracle_kb, map(decl_atom, decl_truth), oracle_kb).
:- mode set_kb_ground_map(in, in, out) is det.
-set_kb_ground_map(oracle_kb(_, Y, N), G, oracle_kb(G, Y, N)).
+set_kb_ground_map(oracle_kb(_, Y, N, X), G, oracle_kb(G, Y, N, X)).
:- pred get_kb_complete_map(oracle_kb, map(decl_atom, set(decl_atom))).
:- mode get_kb_complete_map(in, out) is det.
-get_kb_complete_map(oracle_kb(_, Map, _), Map).
+get_kb_complete_map(oracle_kb(_, Map, _, _), Map).
:- pred set_kb_complete_map(oracle_kb, map(decl_atom, set(decl_atom)),
oracle_kb).
:- mode set_kb_complete_map(in, in, out) is det.
-set_kb_complete_map(oracle_kb(G, _, N), Y, oracle_kb(G, Y, N)).
+set_kb_complete_map(oracle_kb(G, _, N, X), Y, oracle_kb(G, Y, N, X)).
:- pred get_kb_incomplete_map(oracle_kb, map(decl_atom, set(decl_atom))).
:- mode get_kb_incomplete_map(in, out) is det.
-get_kb_incomplete_map(oracle_kb(_, _, Map), Map).
+get_kb_incomplete_map(oracle_kb(_, _, Map, _), Map).
:- pred set_kb_incomplete_map(oracle_kb, map(decl_atom, set(decl_atom)),
oracle_kb).
:- mode set_kb_incomplete_map(in, in, out) is det.
+
+set_kb_incomplete_map(oracle_kb(G, Y, _, X), N, oracle_kb(G, Y, N, X)).
+
+:- pred get_kb_exceptions_map(oracle_kb, map(decl_atom, known_exceptions)).
+:- mode get_kb_exceptions_map(in, out) is det.
+
+get_kb_exceptions_map(oracle_kb(_, _, _, Map), Map).
-set_kb_incomplete_map(oracle_kb(G, Y, _), N, oracle_kb(G, Y, N)).
+:- pred set_kb_exceptions_map(oracle_kb, map(decl_atom, known_exceptions),
+ oracle_kb).
+:- mode set_kb_exceptions_map(in, in, out) is det.
+
+set_kb_exceptions_map(oracle_kb(G, Y, N, _), X, oracle_kb(G, Y, N, X)).
%-----------------------------------------------------------------------------%
@@ -235,6 +258,19 @@
Truth = no
).
+query_oracle_kb(KB, Node, Node - Truth) :-
+ Node = unexpected_exception(Call, Exception),
+ get_kb_exceptions_map(KB, XMap),
+ map__search(XMap, Call, known_excp(Possible, Impossible)),
+ (
+ set__member(Exception, Possible)
+ ->
+ Truth = yes
+ ;
+ set__member(Exception, Impossible),
+ Truth = no
+ ).
+
% assert_oracle_kb/3 assumes that the asserted fact is consistent
% with the current knowledge base. This will generally be the
% case, since the user will never be asked questions which
@@ -273,4 +309,27 @@
%
map__set(Map0, Call, Ss, Map),
set_kb_incomplete_map(KB0, Map, KB).
+
+assert_oracle_kb(unexpected_exception(Call, Exception) - Truth, KB0, KB) :-
+ get_kb_exceptions_map(KB0, Map0),
+ (
+ map__search(Map0, Call, known_excp(Possible0, Impossible0))
+ ->
+ Possible1 = Possible0,
+ Impossible1 = Impossible0
+ ;
+ set__init(Possible1),
+ set__init(Impossible1)
+ ),
+ (
+ Truth = yes,
+ set__insert(Possible1, Exception, Possible),
+ Impossible = Impossible1
+ ;
+ Truth = no,
+ Possible = Possible1,
+ set__insert(Impossible1, Exception, Impossible)
+ ),
+ map__set(Map0, Call, known_excp(Possible, Impossible), Map),
+ set_kb_exceptions_map(KB0, Map, KB).
Index: browser/declarative_user.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_user.m,v
retrieving revision 1.7
diff -u -r1.7 declarative_user.m
--- browser/declarative_user.m 2000/05/08 18:16:24 1.7
+++ browser/declarative_user.m 2000/07/19 12:13:34
@@ -112,6 +112,7 @@
decl_question_prompt(wrong_answer(_), "Valid? ").
decl_question_prompt(missing_answer(_, _), "Complete? ").
+decl_question_prompt(unexpected_exception(_, _), "Expected? ").
:- pred browse_edt_node(decl_question, user_state, user_state,
io__state, io__state).
@@ -273,6 +274,13 @@
list__foldl(write_decl_atom(OutStr, "\t"), Solns)
).
+write_decl_question(unexpected_exception(Call, Exception), User) -->
+ { User = user(_, OutStr) },
+ write_decl_atom(OutStr, "Call ", Call),
+ io__write_string(OutStr, "Throws "),
+ io__print(OutStr, Exception),
+ io__nl(OutStr).
+
:- pred write_decl_bug(decl_bug, user_state, io__state, io__state).
:- mode write_decl_bug(in, in, di, uo) is det.
@@ -286,6 +294,12 @@
{ EBug = partially_uncovered_atom(Atom, _) },
io__write_string(OutStr, "Found partially uncovered atom:\n"),
write_decl_atom(OutStr, "", Atom)
+ ;
+ { EBug = unhandled_exception(Atom, Exception, _) },
+ io__write_string(OutStr, "Found unhandled exception:\n"),
+ write_decl_atom(OutStr, "", Atom),
+ io__write(OutStr, univ_value(Exception)),
+ io__nl(OutStr)
).
write_decl_bug(i_bug(IBug), User) -->
Index: tests/debugger/declarative/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/Mmakefile,v
retrieving revision 1.17
diff -u -r1.17 Mmakefile
--- tests/debugger/declarative/Mmakefile 2000/07/14 07:02:09 1.17
+++ tests/debugger/declarative/Mmakefile 2000/07/19 12:13:44
@@ -33,7 +33,8 @@
oracle_db \
propositional \
queens \
- small
+ small \
+ throw
# The following should not be run in `debug' grades.
NONDEBUG_DECLARATIVE_PROGS= \
@@ -145,6 +146,9 @@
solutions.out: solutions solutions.inp
$(MDB) ./solutions < solutions.inp > solutions.out 2>&1
+
+throw.out: throw throw.inp
+ $(MDB) ./throw < throw.inp > throw.out 2>&1
untraced_subgoal.out: untraced_subgoal untraced_subgoal.inp
$(MDB) ./untraced_subgoal < untraced_subgoal.inp \
Index: tests/debugger/declarative/queens.exp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/queens.exp,v
retrieving revision 1.7
diff -u -r1.7 queens.exp
--- tests/debugger/declarative/queens.exp 2000/05/08 18:17:04 1.7
+++ tests/debugger/declarative/queens.exp 2000/07/19 12:13:45
@@ -3,7 +3,7 @@
Command echo enabled.
mdb> register --quiet
mdb> dd
-mdb: declarative debugging is only available from EXIT or FAIL events.
+mdb: declarative debugging is only available from EXIT, FAIL or EXCP events.
mdb> break queen
0: + stop interface pred queens:queen/2-0 (nondet)
mdb> continue
Index: trace/mercury_trace_declarative.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_declarative.c,v
retrieving revision 1.25
diff -u -r1.25 mercury_trace_declarative.c
--- trace/mercury_trace_declarative.c 2000/07/14 07:02:11 1.25
+++ trace/mercury_trace_declarative.c 2000/07/19 12:14:14
@@ -166,6 +166,9 @@
MR_trace_decl_fail(MR_Event_Info *event_info, MR_Trace_Node prev);
static MR_Trace_Node
+MR_trace_decl_excp(MR_Event_Info *event_info, MR_Trace_Node prev);
+
+static MR_Trace_Node
MR_trace_decl_switch(MR_Event_Info *event_info, MR_Trace_Node prev);
static MR_Trace_Node
@@ -400,8 +403,8 @@
MR_fatal_error("MR_trace_decl_debug: "
"foreign language code is not handled (yet)");
case MR_PORT_EXCEPTION:
- MR_fatal_error("MR_trace_decl_debug: "
- "exceptions are not handled (yet)");
+ trace = MR_trace_decl_excp(event_info, trace);
+ break;
default:
MR_fatal_error("MR_trace_decl_debug: unknown port");
}
@@ -585,6 +588,34 @@
(Word) event_info->MR_event_number);
MR_DD_call_node_set_last_interface((Word) call, (Word) node);
);
+ return node;
+}
+
+static MR_Trace_Node
+MR_trace_decl_excp(MR_Event_Info *event_info, MR_Trace_Node prev)
+{
+ MR_Trace_Node node;
+ MR_Trace_Node call;
+ Word last_interface;
+
+#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(
+ last_interface = MR_DD_call_node_get_last_interface(
+ (Word) call);
+ node = (MR_Trace_Node) MR_DD_construct_excp_node(
+ (Word) prev, (Word) call, last_interface,
+ MR_trace_get_exception_value(),
+ (Word) event_info->MR_event_number);
+ MR_DD_call_node_set_last_interface((Word) call, (Word) node);
+ );
+
return node;
}
Index: trace/mercury_trace_internal.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_internal.c,v
retrieving revision 1.71
diff -u -r1.71 mercury_trace_internal.c
--- trace/mercury_trace_internal.c 2000/07/19 01:35:01 1.71
+++ trace/mercury_trace_internal.c 2000/07/19 12:14:34
@@ -1631,7 +1631,7 @@
fflush(MR_mdb_out);
fprintf(MR_mdb_err,
"mdb: dd requires no arguments.\n");
- } else if (port == MR_PORT_EXIT || port == MR_PORT_FAIL) {
+ } else if (MR_port_is_final(port)) {
if (MR_trace_start_decl_debug((const char *) NULL, cmd,
event_info, event_details,
jumpaddr))
@@ -1642,7 +1642,7 @@
fflush(MR_mdb_out);
fprintf(MR_mdb_err,
"mdb: declarative debugging is only "
- "available from EXIT or FAIL events.\n");
+ "available from EXIT, FAIL or EXCP events.\n");
}
} else if (streq(words[0], "dd_dd")) {
MR_Trace_Port port = event_info->MR_trace_port;
@@ -1651,7 +1651,7 @@
fflush(MR_mdb_out);
fprintf(MR_mdb_err,
"mdb: dd_dd requires one argument.\n");
- } else if (port == MR_PORT_EXIT || port == MR_PORT_FAIL) {
+ } else if (MR_port_is_final(port)) {
if (MR_trace_start_decl_debug((const char *) words[1],
cmd, event_info, event_details,
jumpaddr))
@@ -1662,7 +1662,7 @@
fflush(MR_mdb_out);
fprintf(MR_mdb_err,
"mdb: declarative debugging is only "
- "available from EXIT or FAIL events.\n");
+ "available from EXIT, FAIL or EXCP events.\n");
}
#endif /* MR_USE_DECLARATIVE_DEBUGGER */
} else {
New file tests/debugger/declarative/throw.m:
:- module throw.
:- interface.
:- import_module io.
:- pred main(io__state, io__state).
:- mode main(di, uo) is cc_multi.
:- implementation.
:- import_module int, exception.
main -->
{ try(p, X) },
io__write(X),
io__nl,
{ try(q, Y) },
io__write(Y),
io__nl.
:- pred p(int::out) is cc_nondet.
p(X) :-
a(A),
b(A, X),
X < 0.
:- pred a(int::out) is multi.
a(2).
a(3).
:- pred b(int::in, int::out) is multi.
b(A, B) :-
(
B = A * 3
;
B = A * 4
),
(
B > 10
->
throw("Too big")
;
true
).
:- pred q(int::out) is semidet.
q(1) :-
not (
a2(A),
not (
b2(A, 0)
),
A < 0
).
:- pred a2(int::out) is multi.
a2(2).
a2(3).
:- pred b2(int::in, int::out) is multi.
b2(A, B) :-
(
B = A * 3
;
B = A * 4
),
(
B > 10
->
throw("Too big")
;
true
).
New file tests/debugger/declarative/throw.inp:
echo on
register --quiet
break p
break q
continue
finish
dd
yes
yes
yes
continue
finish
dd
yes
yes
yes
continue
New file tests/debugger/declarative/throw.exp:
1: 1 1 CALL pred throw:main/2-0 (cc_multi) throw.m:10
mdb> echo on
Command echo enabled.
mdb> register --quiet
mdb> break p
0: + stop interface pred throw:p/1-0 (cc_nondet)
mdb> break q
1: + stop interface pred throw:q/1-0 (semidet)
mdb> continue
2: 2 2 CALL pred throw:p/1-0 (cc_nondet) throw.m:20
mdb> finish
31: 2 2 EXCP pred throw:p/1-0 (cc_nondet) throw.m:22
mdb> dd
a(3)
Valid? yes
Call b(3, _)
Throws "Too big"
Expected? yes
Found unhandled exception:
p(_)
"Too big"
Is this a bug? yes
31: 2 2 EXCP pred throw:p/1-0 (cc_nondet) throw.m:22
mdb> continue
mdb: warning: reached unknown label
This may result in some exception events
being omitted from the trace.
exception(univ("Too big" : string))
32: 6 2 CALL pred throw:q/1-0 (semidet) throw.m:48
mdb> finish
65: 6 2 EXCP pred throw:q/1-0 (semidet) throw.m:52
mdb> dd
a2(3)
Valid? yes
Call b2(3, _)
Throws "Too big"
Expected? yes
Found unhandled exception:
q(_)
"Too big"
Is this a bug? yes
65: 6 2 EXCP pred throw:q/1-0 (semidet) throw.m:52
mdb> continue
mdb: warning: reached unknown label
This may result in some exception events
being omitted from the trace.
exception(univ("Too big" : string))
New file tests/debugger/declarative/throw.exp2:
1: 1 1 CALL pred throw:main/2-0 (cc_multi) throw.m:10
mdb> echo on
Command echo enabled.
mdb> register --quiet
mdb> break p
0: + stop interface pred throw:p/1-0 (cc_nondet)
mdb> break q
1: + stop interface pred throw:q/1-0 (semidet)
mdb> continue
3: 3 3 CALL pred throw:p/1-0 (cc_nondet) throw.m:20 (exception.m:320)
mdb> finish
34: 3 3 EXCP pred throw:p/1-0 (cc_nondet) throw.m:22 (exception.m:320)
mdb> dd
a(3)
Valid? yes
Call b(3, _)
Throws "Too big"
Expected? yes
Found unhandled exception:
p(_)
"Too big"
Is this a bug? yes
34: 3 3 EXCP pred throw:p/1-0 (cc_nondet) throw.m:22 (exception.m:320)
mdb> continue
exception(univ("Too big" : string))
41: 11 3 CALL pred throw:q/1-0 (semidet) throw.m:48 (exception.m:320)
mdb> finish
76: 11 3 EXCP pred throw:q/1-0 (semidet) throw.m:52 (exception.m:320)
mdb> dd
a2(3)
Valid? yes
Call b2(3, _)
Throws "Too big"
Expected? yes
Found unhandled exception:
q(_)
"Too big"
Is this a bug? yes
76: 11 3 EXCP pred throw:q/1-0 (semidet) throw.m:52 (exception.m:320)
mdb> continue
exception(univ("Too big" : string))
--------------------------------------------------------------------------
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