[m-rev.] for review: a new decl debugging command
Mark Brown
dougl at cs.mu.OZ.AU
Thu Sep 26 19:48:23 AEST 2002
This is for review by Zoltan.
Estimated hours taken: 1
Branches: main
Add the command 'pd' to the declarative debugger. This command returns
to the procedural debugger at the event corresponding to the current
question; it is notionally the inverse of the 'dd' command in the
procedural debugger.
browser/declarative_user.m:
Handle the new command, and add a new alternative to the
user_response type.
browser/declarative_oracle.m:
Handle the new user response, and add a new alternative to the
oracle_response type.
browser/declarative_debugger.m:
Handle the new oracle response, and add a new alternative to the
diagnoser_response type.
Export some procedures to C so that the back end can interpret the
new diagnoser response.
Update an old comment.
trace/mercury_trace_declarative.c:
Handle the new diagnoser response. Rename the function
MR_decl_handle_bug_found, since it now also handles the case
where a symptom has been found.
Interpret the diagnoser response using something like a switch,
rather than something like an if-then-else. This gives better
error messages if the diagnoser response type is changed.
doc/user_guide.texi:
Document the new command.
tests/debugger/declarative/Mmakefile:
tests/debugger/declarative/pd.exp:
tests/debugger/declarative/pd.inp:
tests/debugger/declarative/pd.m:
Test the new feature.
Index: browser/declarative_debugger.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_debugger.m,v
retrieving revision 1.32
diff -u -r1.32 declarative_debugger.m
--- browser/declarative_debugger.m 13 Sep 2002 04:17:39 -0000 1.32
+++ browser/declarative_debugger.m 26 Sep 2002 08:42:13 -0000
@@ -176,10 +176,17 @@
% There was a bug found and confirmed. The
% event number is for a call port (inadmissible
% call), an exit port (incorrect contour),
- % or a fail port (partially uncovered atom).
+ % a fail port (partially uncovered atom),
+ % or an exception port (unhandled exception).
%
---> bug_found(event_number)
+ % There was another symptom of incorrect behaviour
+ % found; this symptom will be closer, in a sense,
+ % to the location of a bug.
+ %
+ ; symptom_found(event_number)
+
% There was no symptom found, or the diagnoser
% aborted before finding a bug.
%
@@ -375,6 +382,10 @@
handle_oracle_response(_, no_oracle_answers, no_bug_found, D, D) -->
[].
+handle_oracle_response(Store, exit_diagnosis(Node), Response, D, D) -->
+ { edt_subtree_details(Store, Node, Event, _) },
+ { Response = symptom_found(Event) }.
+
handle_oracle_response(_, abort_diagnosis, no_bug_found, D, D) -->
io__write_string("Diagnosis aborted.\n").
@@ -398,6 +409,8 @@
Response = no_bug_found
}.
+%-----------------------------------------------------------------------------%
+
% Export a monomorphic version of diagnosis_state_init/4, to
% make it easier to call from C code.
%
@@ -437,6 +450,21 @@
:- pragma export(diagnoser_bug_found(in, out), "MR_DD_diagnoser_bug_found").
diagnoser_bug_found(bug_found(Event), Event).
+
+:- pred diagnoser_symptom_found(diagnoser_response, event_number).
+:- mode diagnoser_symptom_found(in, out) is semidet.
+
+:- pragma export(diagnoser_symptom_found(in, out),
+ "MR_DD_diagnoser_symptom_found").
+
+diagnoser_symptom_found(symptom_found(Event), Event).
+
+:- pred diagnoser_no_bug_found(diagnoser_response).
+:- mode diagnoser_no_bug_found(in) is semidet.
+
+:- pragma export(diagnoser_no_bug_found(in), "MR_DD_diagnoser_no_bug_found").
+
+diagnoser_no_bug_found(no_bug_found).
:- pred diagnoser_require_subtree(diagnoser_response, event_number,
sequence_number).
Index: browser/declarative_oracle.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_oracle.m,v
retrieving revision 1.15
diff -u -r1.15 declarative_oracle.m
--- browser/declarative_oracle.m 13 Sep 2002 04:17:40 -0000 1.15
+++ browser/declarative_oracle.m 26 Sep 2002 08:03:45 -0000
@@ -33,6 +33,7 @@
:- type oracle_response(T)
---> oracle_answers(list(decl_answer(T)))
; no_oracle_answers
+ ; exit_diagnosis(T)
; abort_diagnosis.
% The oracle state. This is threaded around the declarative
@@ -82,6 +83,10 @@
;
UserResponse = no_user_answer,
Response = no_oracle_answers,
+ KB = KB0
+ ;
+ UserResponse = exit_diagnosis(Node),
+ Response = exit_diagnosis(Node),
KB = KB0
;
UserResponse = abort_diagnosis,
Index: browser/declarative_user.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_user.m,v
retrieving revision 1.20
diff -u -r1.20 declarative_user.m
--- browser/declarative_user.m 15 May 2002 11:24:08 -0000 1.20
+++ browser/declarative_user.m 26 Sep 2002 08:06:45 -0000
@@ -20,6 +20,7 @@
:- type user_response(T)
---> user_answer(decl_question(T), decl_answer(T))
; no_user_answer
+ ; exit_diagnosis(T)
; abort_diagnosis.
:- type user_state.
@@ -130,6 +131,10 @@
query_user_2([Question | Questions], Skipped, Response,
User2, User)
;
+ { Command = pd },
+ { Response = exit_diagnosis(Node) },
+ { User = User1 }
+ ;
{ Command = abort },
{ Response = abort_diagnosis },
{ User = User1 }
@@ -269,6 +274,8 @@
% answering.
; browse_io(int) % Browse the nth IO action before
% answering.
+ ; pd % Commence procedural debugging from
+ % this point.
; abort % Abort this diagnosis session.
; help % Request help before answering.
; illegal_command. % None of the above.
@@ -286,6 +293,7 @@
"\ts\tskip\t\tskip this question\n",
"\tr\trestart\t\task the skipped questions again\n",
"\tb <n>\tbrowse <n>\tbrowse the nth argument of the atom\n",
+ "\t\tpd\t\tcommence procedural debugging from this point\n",
"\ta\tabort\t\t",
"abort this diagnosis session and return to mdb\n",
"\th, ?\thelp\t\tthis help message\n"
@@ -348,6 +356,7 @@
cmd_handler("skip", one_word_cmd(skip)).
cmd_handler("r", one_word_cmd(restart)).
cmd_handler("restart", one_word_cmd(restart)).
+cmd_handler("pd", one_word_cmd(pd)).
cmd_handler("a", one_word_cmd(abort)).
cmd_handler("abort", one_word_cmd(abort)).
cmd_handler("?", one_word_cmd(help)).
Index: doc/user_guide.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/user_guide.texi,v
retrieving revision 1.327
diff -u -r1.327 user_guide.texi
--- doc/user_guide.texi 19 Sep 2002 13:59:04 -0000 1.327
+++ doc/user_guide.texi 26 Sep 2002 07:58:59 -0000
@@ -3234,7 +3234,8 @@
@subsection Commands
At the above mentioned prompts, the following commands may be given.
-Each command can also be abbreviated to just its first letter.
+Each command (with the exception of @samp{pd})
+can also be abbreviated to just its first letter.
@sp 1
@table @code
@item yes
@@ -3252,6 +3253,10 @@
@item browse @var{n}
Browse the @var{n}th argument before answering.
@sp 1
+ at item pd
+Commence procedural debugging from the current point.
+This command is notionally the inverse of the @samp{dd} command
+in the procedural debugger.
@item abort
End the declarative debugging session and return to
the event at which the @samp{dd} command was given.
Index: tests/debugger/declarative/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/Mmakefile,v
retrieving revision 1.42
diff -u -r1.42 Mmakefile
--- tests/debugger/declarative/Mmakefile 13 Sep 2002 04:17:46 -0000 1.42
+++ tests/debugger/declarative/Mmakefile 26 Sep 2002 08:18:04 -0000
@@ -29,6 +29,7 @@
negation \
oracle_db \
output_term_dep \
+ pd \
propositional \
queens \
shallow \
@@ -183,6 +184,9 @@
output_term_dep.out: output_term_dep output_term_dep.inp
$(MDB) ./output_term_dep < output_term_dep.inp \
> output_term_dep.out 2>&1
+
+pd.out: pd pd.inp
+ $(MDB) ./pd < pd.inp > pd.out 2>&1
propositional.out: propositional propositional.inp
$(MDB) ./propositional < propositional.inp > propositional.out 2>&1
Index: tests/debugger/declarative/pd.exp
===================================================================
RCS file: tests/debugger/declarative/pd.exp
diff -N tests/debugger/declarative/pd.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/pd.exp 26 Sep 2002 08:52:16 -0000
@@ -0,0 +1,40 @@
+ 1: 1 1 CALL pred pd:main/2-0 (det) pd.m:8
+mdb> echo on
+Command echo enabled.
+mdb> register --quiet
+mdb> break rev
+ 0: + stop interface func pd:rev/1-0 (det)
+mdb> continue
+ 2: 2 2 CALL func pd:rev/1-0 (det) pd.m:14 (pd.m:9)
+mdb> finish
+ 15: 2 2 EXIT func pd:rev/1-0 (det) pd.m:14 (pd.m:9)
+mdb> dd
+rev([1, 2, 3]) = []
+Valid? no
+rev_2([1, 2, 3], []) = []
+Valid? pd
+ 14: 3 3 EXIT func pd:rev_2/2-0 (det) pd.m:18 (pd.m:14)
+mdb> retry
+ 3: 3 3 CALL func pd:rev_2/2-0 (det) pd.m:18 (pd.m:14)
+mdb> step
+ 4: 3 3 SWTC func pd:rev_2/2-0 (det) s2; pd.m:19
+mdb> step
+ 5: 4 4 CALL func pd:rev_2/2-0 (det) pd.m:18 (pd.m:19)
+mdb> finish
+ 13: 4 4 EXIT func pd:rev_2/2-0 (det) pd.m:18 (pd.m:19)
+mdb> dd
+rev_2([2, 3], [1]) = []
+Valid? no
+rev_2([3], [2, 1]) = []
+Valid? pd
+ 12: 5 5 EXIT func pd:rev_2/2-0 (det) pd.m:18 (pd.m:19)
+mdb> dd
+rev_2([3], [2, 1]) = []
+Valid? no
+rev_2([], [3, 2, 1]) = []
+Valid? no
+Found incorrect contour:
+rev_2([], [3, 2, 1]) = []
+Is this a bug? yes
+ 11: 6 6 EXIT func pd:rev_2/2-0 (det) pd.m:18 (pd.m:19)
+mdb> quit -y
Index: tests/debugger/declarative/pd.inp
===================================================================
RCS file: tests/debugger/declarative/pd.inp
diff -N tests/debugger/declarative/pd.inp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/pd.inp 26 Sep 2002 08:51:42 -0000
@@ -0,0 +1,20 @@
+echo on
+register --quiet
+break rev
+continue
+finish
+dd
+no
+pd
+retry
+step
+step
+finish
+dd
+no
+pd
+dd
+no
+no
+yes
+quit -y
Index: tests/debugger/declarative/pd.m
===================================================================
RCS file: tests/debugger/declarative/pd.m
diff -N tests/debugger/declarative/pd.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/pd.m 26 Sep 2002 08:46:00 -0000
@@ -0,0 +1,20 @@
+:- module pd.
+:- interface.
+:- import_module io.
+:- pred main(io__state::di, io__state::uo) is det.
+:- implementation.
+:- import_module list.
+
+main -->
+ io__write(rev([1, 2, 3])),
+ io__nl.
+
+:- func rev(list(int)) = list(int).
+
+rev(As) = rev_2(As, []).
+
+:- func rev_2(list(int), list(int)) = list(int).
+
+rev_2([], _) = []. % oops
+rev_2([A | As], Bs) = rev_2(As, [A | Bs]).
+
Index: trace/mercury_trace_declarative.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_declarative.c,v
retrieving revision 1.56
diff -u -r1.56 mercury_trace_declarative.c
--- trace/mercury_trace_declarative.c 5 Aug 2002 21:46:18 -0000 1.56
+++ trace/mercury_trace_declarative.c 26 Sep 2002 08:33:47 -0000
@@ -217,7 +217,7 @@
MR_Trace_Cmd_Info *cmd,
MR_Event_Info *event_info,
MR_Event_Details *event_details);
-static MR_Code *MR_decl_handle_bug_found(MR_Unsigned event,
+static MR_Code *MR_decl_go_to_selected_event(MR_Unsigned event,
MR_Trace_Cmd_Info *cmd,
MR_Event_Info *event_info,
MR_Event_Details *event_details);
@@ -1219,8 +1219,11 @@
{
MR_Word response;
MR_bool bug_found;
+ MR_bool symptom_found;
+ MR_bool no_bug_found;
MR_bool require_subtree;
MR_Unsigned bug_event;
+ MR_Unsigned symptom_event;
MR_Unsigned final_event;
MR_Unsigned topmost_seqno;
MercuryFile stream;
@@ -1290,6 +1293,9 @@
);
bug_found = MR_DD_diagnoser_bug_found(response,
(MR_Word *) &bug_event);
+ symptom_found = MR_DD_diagnoser_symptom_found(response,
+ (MR_Word *) &symptom_event);
+ no_bug_found = MR_DD_diagnoser_no_bug_found(response);
require_subtree = MR_DD_diagnoser_require_subtree(response,
(MR_Word *) &final_event,
(MR_Word *) &topmost_seqno);
@@ -1300,10 +1306,25 @@
MR_trace_event_number = event_details->MR_event_number;
if (bug_found) {
- return MR_decl_handle_bug_found(bug_event, cmd,
+ return MR_decl_go_to_selected_event(bug_event, cmd,
event_info, event_details);
}
+ if (symptom_found) {
+ return MR_decl_go_to_selected_event(symptom_event, cmd,
+ event_info, event_details);
+ }
+
+ if (no_bug_found) {
+ /*
+ ** No bug found. Return to the procedural debugger at the
+ ** current event, which was the event it was left from.
+ */
+ MR_trace_decl_mode = MR_TRACE_INTERACTIVE;
+ MR_trace_enabled = MR_TRUE;
+ return MR_trace_event_internal(cmd, MR_TRUE, event_info);
+ }
+
if (require_subtree) {
/*
** Front end requires a subtree to be made explicit.
@@ -1314,17 +1335,12 @@
cmd, event_info, event_details);
}
- /*
- ** No bug found. Return to the procedural debugger at the
- ** current event, which was the event it was left from.
- */
- MR_trace_decl_mode = MR_TRACE_INTERACTIVE;
- MR_trace_enabled = MR_TRUE;
- return MR_trace_event_internal(cmd, MR_TRUE, event_info);
+ /* We shouldn't ever get here. */
+ MR_fatal_error("unknown diagnoser response");
}
static MR_Code *
-MR_decl_handle_bug_found(MR_Unsigned bug_event, MR_Trace_Cmd_Info *cmd,
+MR_decl_go_to_selected_event(MR_Unsigned event, MR_Trace_Cmd_Info *cmd,
MR_Event_Info *event_info, MR_Event_Details *event_details)
{
const char *problem;
@@ -1361,7 +1377,7 @@
}
cmd->MR_trace_cmd = MR_CMD_GOTO;
- cmd->MR_trace_stop_event = bug_event;
+ cmd->MR_trace_stop_event = event;
cmd->MR_trace_print_level = MR_PRINT_LEVEL_NONE;
cmd->MR_trace_strict = MR_TRUE;
cmd->MR_trace_must_check = MR_FALSE;
--------------------------------------------------------------------------
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