[m-rev.] for review: implement undo for declarative debugger
Ian MacLarty
maclarty at cs.mu.OZ.AU
Mon Jul 25 22:31:30 AEST 2005
For review by anyone.
Estimated hours taken: 6
Branches: main
Implement `undo' command in the declarative debugger.
The `undo' command takes the debugger back to the state it was in before the
last answer was given (`skip' is counted as an answer in this case).
browser/declarative_analyser.m:
Add an interface predicate which allows us to get the last question
asked by the analyser.
Do not handle `show_info' in process_answer, since `show_info' is
no longer considered an answer (see below).
browser/declarative_debugger.m:
Make `show_info' an oracle response, instead of an oracle answer,
since it doesn't affect the search space.
Get rid of diagnoser_{get,set}_{analyser,oracle}, because they serve
no abstraction purpose and maintaining them is a pain.
Add a new field to the diagnoser which records the state of the
diagnoser before the previous oracle answer. This turns the
diagnoser into a stack. Add predicates to push and pop
diagnosers from this stack.
Push the current diagnoser onto the stack when an oracle answer
is received.
Pop the previous diagnoser when the `undo' command is issued.
browser/declarative_oracle.m:
Add `undo' to the set of possible oracle responses.
Add a predicate which makes the current knowledge base of one oracle
the revised knowledge base of another oracle.
Fix a spelling mistake.
Add a predicate to get the output stream used to communicate with the
user.
browser/declarative_user.m:
Add the `undo' user response.
Add a predicate to get the output stream used to communicate with the
user. This is used by the diagnoser to print a "Undo stack empty"
message.
tests/debugger/declarative/Mmakefile:
tests/debugger/declarative/undo.exp:
tests/debugger/declarative/undo.inp:
tests/debugger/declarative/undo.m:
Test the new command.
Index: browser/declarative_analyser.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_analyser.m,v
retrieving revision 1.26
diff -u -r1.26 declarative_analyser.m
--- browser/declarative_analyser.m 19 Jun 2005 02:14:16 -0000 1.26
+++ browser/declarative_analyser.m 25 Jul 2005 08:54:13 -0000
@@ -93,6 +93,12 @@
analyser_response(T)::out, analyser_state(T)::in,
analyser_state(T)::out) is det <= mercury_edt(S, T).
+ % Return a response which will cause the last question to be
+ % re-asked.
+ %
+:- pred reask_last_question(S::in, analyser_state(T)::in,
+ analyser_response(T)::out) is det <= mercury_edt(S, T).
+
% Continue analysis after the oracle has responded with an
% answer.
%
@@ -359,6 +365,20 @@
decide_analyser_response(Store, Oracle, Response, !Analyser)
).
+reask_last_question(Store, Analyser, Response) :-
+ MaybeLastQuestion = Analyser ^ last_search_question,
+ (
+ MaybeLastQuestion = yes(suspect_and_reason(SuspectId, _)),
+ SearchSpace = Analyser ^ search_space,
+ Node = get_edt_node(SearchSpace, SuspectId),
+ edt_question(Store, Node, OracleQuestion),
+ Response = oracle_question(OracleQuestion)
+ ;
+ MaybeLastQuestion = no,
+ throw(internal_error("reask_last_question",
+ "no last question"))
+ ).
+
continue_analysis(Store, Oracle, Answer, Response, !Analyser) :-
(
!.Analyser ^ last_search_question = yes(
@@ -399,12 +419,6 @@
assert_suspect_is_erroneous(SuspectId, !.Analyser ^ search_space,
SearchSpace),
!:Analyser = !.Analyser ^ search_space := SearchSpace.
-
- % process_answer shouldn't be called with a show_info oracle response.
- %
-process_answer(_, show_info(_), _, _, _) :-
- throw(internal_error("process_answer", "called with show_info/1")).
-
process_answer(Store, suspicious_subterm(Node, ArgPos, TermPath), SuspectId,
!Analyser) :-
Index: browser/declarative_debugger.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_debugger.m,v
retrieving revision 1.59
diff -u -r1.59 declarative_debugger.m
--- browser/declarative_debugger.m 19 Jun 2005 02:14:16 -0000 1.59
+++ browser/declarative_debugger.m 25 Jul 2005 10:40:59 -0000
@@ -187,17 +187,12 @@
; ignore(T)
% The oracle has deferred answering this question.
- ; skip(T)
+ ; skip(T).
- % The oracle has requested that the analyser display
- % information about the state of the search and
- % the last question asked.
- ; show_info(io.output_stream).
-
- % Answers that are known by the oracle without having to consult the user,
- % such as answers stored in the knowledge base or answers about trusted
- % predicates. mdb.declarative_oracle.answer_known/3 returns answers of
- % this subtype.
+ % Answers that are known by the oracle without having to consult the
+ % user, such as answers stored in the knowledge base or answers about
+ % trusted predicates. mdb.declarative_oracle.answer_known/3 returns
+ % answers of this subtype.
%
:- inst known_answer
---> truth_value(ground, ground)
@@ -291,6 +286,10 @@
:- type diagnoser_state(R).
+ % diagnoser_state_init(InputStream, OutputStream, Browser,
+ % HelpSystem, Diagnoser).
+ % Initialise a new diagnoser with the given properties.
+ %
:- pred diagnoser_state_init(io.input_stream::in,
io.output_stream::in, browser_info.browser_persistent_state::in,
help.system::in, diagnoser_state(R)::out) is det.
@@ -357,35 +356,34 @@
:- type diagnoser_state(R)
---> diagnoser(
- analyser_state :: analyser_state(edt_node(R)),
- oracle_state :: oracle_state
+ analyser_state :: analyser_state(edt_node(R)),
+ oracle_state :: oracle_state,
+
+ % The diagnoser state before the previous
+ % oracle answer (if there oracle has given any
+ % answers yet).
+ previous_diagnoser :: maybe(diagnoser_state(R))
).
-:- pred diagnoser_get_analyser(diagnoser_state(R)::in,
- analyser_state(edt_node(R))::out) is det.
-
-diagnoser_get_analyser(diagnoser(Analyser, _), Analyser).
-
-:- pred diagnoser_set_analyser(analyser_state(edt_node(R))::in,
- diagnoser_state(R)::in, diagnoser_state(R)::out) is det.
-
-diagnoser_set_analyser(Analyser, diagnoser(_, Oracle),
- diagnoser(Analyser, Oracle)).
-
-:- pred diagnoser_get_oracle(diagnoser_state(R)::in, oracle_state::out) is det.
+diagnoser_state_init(InStr, OutStr, Browser, HelpSystem, Diagnoser) :-
+ analyser_state_init(Analyser),
+ oracle_state_init(InStr, OutStr, Browser, HelpSystem, Oracle),
+ Diagnoser = diagnoser(Analyser, Oracle, no).
-diagnoser_get_oracle(diagnoser(_, Oracle), Oracle).
+:- pred push_diagnoser(diagnoser_state(R)::in, diagnoser_state(R)::out) is det.
-:- pred diagnoser_set_oracle(oracle_state::in, diagnoser_state(R)::in,
- diagnoser_state(R)::out) is det.
+push_diagnoser(!Diagnoser) :-
+ !:Diagnoser = !.Diagnoser ^ previous_diagnoser := yes(!.Diagnoser).
-diagnoser_set_oracle(Oracle, diagnoser(Analyser, _),
- diagnoser(Analyser, Oracle)).
+:- pred pop_diagnoser(diagnoser_state(R)::in, diagnoser_state(R)::out)
+ is semidet.
-diagnoser_state_init(InStr, OutStr, Browser, HelpSystem, Diagnoser) :-
- analyser_state_init(Analyser),
- oracle_state_init(InStr, OutStr, Browser, HelpSystem, Oracle),
- Diagnoser = diagnoser(Analyser, Oracle).
+pop_diagnoser(!Diagnoser) :-
+ LatestOracle = !.Diagnoser ^ oracle_state,
+ !.Diagnoser ^ previous_diagnoser = yes(!:Diagnoser),
+ LastPushedOracle = !.Diagnoser ^ oracle_state,
+ update_revised_knowledge_base(LastPushedOracle, LatestOracle, Oracle),
+ !:Diagnoser = !.Diagnoser ^ oracle_state := Oracle.
diagnosis(Store, AnalysisType, Response, !Diagnoser, !Browser, !IO) :-
mdb.declarative_oracle.set_browser_state(!.Browser, !.Diagnoser ^
@@ -417,7 +415,7 @@
Analyser0 = Diagnoser0 ^ analyser_state,
start_or_resume_analysis(wrap(Store), Diagnoser0 ^ oracle_state,
AnalysisType, AnalyserResponse, Analyser0, Analyser),
- diagnoser_set_analyser(Analyser, Diagnoser0, Diagnoser1),
+ Diagnoser1 = Diagnoser0 ^ analyser_state := Analyser,
debug_analyser_state(Analyser, MaybeOrigin),
handle_analyser_response(Store, AnalyserResponse, MaybeOrigin,
Response, Diagnoser1, Diagnoser, !IO).
@@ -436,7 +434,7 @@
handle_analyser_response(Store, oracle_question(Question), MaybeOrigin,
Response, !Diagnoser, !IO) :-
- diagnoser_get_oracle(!.Diagnoser, Oracle0),
+ Oracle0 = !.Diagnoser ^ oracle_state,
debug_origin(Flag, !IO),
(
MaybeOrigin = yes(Origin),
@@ -449,7 +447,14 @@
true
),
query_oracle(Question, OracleResponse, Oracle0, Oracle, !IO),
- diagnoser_set_oracle(Oracle, !Diagnoser),
+ (
+ OracleResponse = oracle_answer(_)
+ ->
+ push_diagnoser(!Diagnoser)
+ ;
+ true
+ ),
+ !:Diagnoser = !.Diagnoser ^ oracle_state := Oracle,
handle_oracle_response(Store, OracleResponse, Response, !Diagnoser,
!IO).
@@ -487,22 +492,38 @@
handle_oracle_response(Store, oracle_answer(Answer), Response, !Diagnoser,
!IO) :-
- diagnoser_get_analyser(!.Diagnoser, Analyser0),
+ Analyser0 = !.Diagnoser ^ analyser_state,
continue_analysis(wrap(Store), !.Diagnoser ^ oracle_state, Answer,
AnalyserResponse, Analyser0, Analyser),
- diagnoser_set_analyser(Analyser, !Diagnoser),
+ !:Diagnoser = !.Diagnoser ^ analyser_state := Analyser,
debug_analyser_state(Analyser, MaybeOrigin),
handle_analyser_response(Store, AnalyserResponse, MaybeOrigin,
Response, !Diagnoser, !IO).
handle_oracle_response(Store, show_info(OutStream), Response, !Diagnoser, !IO)
:-
- diagnoser_get_analyser(!.Diagnoser, Analyser),
+ Analyser = !.Diagnoser ^ analyser_state,
show_info(wrap(Store), OutStream, Analyser, AnalyserResponse, !IO),
debug_analyser_state(Analyser, MaybeOrigin),
handle_analyser_response(Store, AnalyserResponse, MaybeOrigin,
Response, !Diagnoser, !IO).
+handle_oracle_response(Store, undo, Response, !Diagnoser, !IO) :-
+ (
+ pop_diagnoser(!.Diagnoser, PoppedDiagnoser)
+ ->
+ !:Diagnoser = PoppedDiagnoser
+ ;
+ OutStream = mdb.declarative_oracle.get_user_output_stream(
+ !.Diagnoser ^ oracle_state),
+ io.write_string(OutStream, "Undo stack empty.\n", !IO)
+ ),
+ reask_last_question(wrap(Store), !.Diagnoser ^ analyser_state,
+ AnalyserResponse),
+ debug_analyser_state(!.Diagnoser ^ analyser_state, MaybeOrigin),
+ handle_analyser_response(Store, AnalyserResponse, MaybeOrigin,
+ Response, !Diagnoser, !IO).
+
handle_oracle_response(Store, exit_diagnosis(Node), Response, !Diagnoser, !IO)
:-
edt_subtree_details(Store, Node, Event, _, _),
@@ -517,9 +538,9 @@
<= annotated_trace(S, R).
confirm_bug(Store, Bug, Evidence, Response, !Diagnoser, !IO) :-
- diagnoser_get_oracle(!.Diagnoser, Oracle0),
+ Oracle0 = !.Diagnoser ^ oracle_state,
oracle_confirm_bug(Bug, Evidence, Confirmation, Oracle0, Oracle, !IO),
- diagnoser_set_oracle(Oracle, !Diagnoser),
+ !:Diagnoser = !.Diagnoser ^ oracle_state := Oracle,
(
Confirmation = confirm_bug,
decl_bug_get_event_number(Bug, Event),
@@ -678,7 +699,7 @@
:- pragma export(mdb.declarative_debugger.add_trusted_module(in, in, out),
"MR_DD_decl_add_trusted_module").
-
+
add_trusted_module(ModuleName, Diagnoser0, Diagnoser) :-
string_to_sym_name(ModuleName, ".", SymModuleName),
add_trusted_module(SymModuleName, Diagnoser0 ^ oracle_state, Oracle),
Index: browser/declarative_oracle.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_oracle.m,v
retrieving revision 1.43
diff -u -r1.43 declarative_oracle.m
--- browser/declarative_oracle.m 10 May 2005 04:28:21 -0000 1.43
+++ browser/declarative_oracle.m 25 Jul 2005 08:54:13 -0000
@@ -42,6 +42,9 @@
:- type oracle_response(T)
---> oracle_answer(decl_answer(T))
; show_info(io.output_stream)
+ % Ask the diagnoser to revert to the
+ % last question it asked.
+ ; undo
; exit_diagnosis(T)
; abort_diagnosis.
@@ -108,6 +111,14 @@
:- pred revise_oracle(decl_question(T)::in, oracle_state::in, oracle_state::out)
is det.
+ % update_revised_knowledge_base(Oracle1, Oracle2, Oracle3).
+ % Update the revised knowledge base in Oracle1 with the
+ % current knowledge base from Oracle2 and return the resulting
+ % oracle in Oracle3.
+ %
+:- pred update_revised_knowledge_base(oracle_state::in, oracle_state::in,
+ oracle_state::out) is det.
+
% Returns the state of the term browser.
%
:- func get_browser_state(oracle_state)
@@ -124,6 +135,10 @@
:- pred answer_known(oracle_state::in, decl_question(T)::in,
decl_answer(T)::out(known_answer)) is semidet.
+ % Return the output stream used for interacting with the user.
+ %
+:- func get_user_output_stream(oracle_state) = io.output_stream.
+
%-----------------------------------------------------------------------------%
:- implementation.
@@ -207,6 +222,9 @@
;
UserResponse = abort_diagnosis,
OracleResponse = abort_diagnosis
+ ;
+ UserResponse = undo,
+ OracleResponse = undo
),
!:Oracle = !.Oracle ^ user_state := User.
@@ -237,6 +255,9 @@
true
).
+update_revised_knowledge_base(Oracle1, Oracle2, Oracle3) :-
+ Oracle3 = Oracle1 ^ kb_revised := Oracle2 ^ kb_current.
+
%-----------------------------------------------------------------------------%
:- type oracle_state
@@ -494,7 +515,7 @@
trusted(Atom ^ proc_layout, Oracle)
->
% We tell the analyser that this node doesn't contain a bug,
- % however it's children may still contain bugs, since
+ % however its children may still contain bugs, since
% trusted procs may call untrusted procs (for example
% when an untrusted closure is passed to a trusted predicate).
Answer = ignore(get_decl_question_node(Question))
@@ -581,8 +602,6 @@
assert_oracle_kb(_, skip(_), KB, KB).
-assert_oracle_kb(_, show_info(_), KB, KB).
-
assert_oracle_kb(wrong_answer(_, _, Atom), truth_value(_, Truth), KB0, KB) :-
get_kb_ground_map(KB0, Map0),
ProcLayout = Atom ^ final_atom ^ proc_layout,
@@ -704,3 +723,6 @@
mdb.declarative_user.set_browser_state(Browser, !.Oracle ^ user_state,
User),
!:Oracle = !.Oracle ^ user_state := User.
+
+get_user_output_stream(Oracle) = mdb.declarative_user.get_user_output_stream(
+ Oracle ^ user_state).
Index: browser/declarative_user.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_user.m,v
retrieving revision 1.49
diff -u -r1.49 declarative_user.m
--- browser/declarative_user.m 19 Jun 2005 02:14:17 -0000 1.49
+++ browser/declarative_user.m 25 Jul 2005 08:54:13 -0000
@@ -34,6 +34,8 @@
% about the state of the search and the current
% question to the given output stream.
; show_info(io.output_stream)
+ % The user wants to undo the last answer they gave.
+ ; undo
; exit_diagnosis(T)
; abort_diagnosis.
@@ -65,6 +67,10 @@
:- pred set_browser_state(browser_info.browser_persistent_state::in,
user_state::in, user_state::out) is det.
+ % Return the output stream used for interacting with the user.
+ %
+:- func get_user_output_stream(user_state) = io.output_stream.
+
%-----------------------------------------------------------------------------%
:- implementation.
@@ -243,6 +249,8 @@
handle_command(info, _, show_info(!.User ^ outstr), !User, !IO).
+handle_command(undo, _, undo, !User, !IO).
+
handle_command(browse_io(ActionNum), UserQuestion, Response,
!User, !IO) :-
Question = get_decl_question(UserQuestion),
@@ -754,6 +762,9 @@
% Print some information about the current question.
; info
+ % Undo the user's last answer.
+ ; undo
+
% The user wants the current question re-asked.
; ask
@@ -846,6 +857,7 @@
cmd_handler("set", set_arg_cmd).
cmd_handler("t", trust_arg_cmd).
cmd_handler("trust", trust_arg_cmd).
+cmd_handler("undo", one_word_cmd(undo)).
:- func one_word_cmd(user_command::in, list(string)::in) = (user_command::out)
is semidet.
@@ -1189,5 +1201,7 @@
set_browser_state(Browser, !User) :-
!:User = !.User ^ browser := Browser.
+
+get_user_output_stream(User) = User ^ outstr.
%-----------------------------------------------------------------------------%
Index: tests/debugger/declarative/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/Mmakefile,v
retrieving revision 1.77
diff -u -r1.77 Mmakefile
--- tests/debugger/declarative/Mmakefile 14 Jun 2005 08:15:06 -0000 1.77
+++ tests/debugger/declarative/Mmakefile 25 Jul 2005 10:49:42 -0000
@@ -64,6 +64,7 @@
tabled_read_decl \
throw \
trust \
+ undo \
unsafe_cast
# The following should not be run in `debug' or `mm' grades.
@@ -456,6 +457,10 @@
trust.out: trust trust.inp
$(MDB_STD) ./trust < trust.inp > trust.out 2>&1 \
+ || { grep . $@ /dev/null; exit 1; }
+
+undo.out: undo undo.inp
+ $(MDB_STD) ./undo < undo.inp > undo.out 2>&1 \
|| { grep . $@ /dev/null; exit 1; }
unsafe_cast.out: unsafe_cast unsafe_cast.inp
Index: tests/debugger/declarative/undo.exp
===================================================================
RCS file: tests/debugger/declarative/undo.exp
diff -N tests/debugger/declarative/undo.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/undo.exp 25 Jul 2005 10:48:56 -0000
@@ -0,0 +1,52 @@
+ E1: C1 CALL pred undo.main/2-0 (det) undo.m:13
+mdb> mdb> Contexts will not be printed.
+mdb> echo on
+Command echo enabled.
+mdb> step
+ E2: C2 CALL pred undo.sum/2-0 (det)
+mdb> finish
+ E3: C2 EXIT pred undo.sum/2-0 (det)
+mdb> dd
+sum([1, 2, 3, 4, 5, 6], 21)
+Valid? no
+sum([2, 3, 4, 5, 6], 20)
+Valid? undo
+sum([1, 2, 3, 4, 5, 6], 21)
+Valid? [no] undo
+Undo stack empty.
+sum([1, 2, 3, 4, 5, 6], 21)
+Valid? [no]
+sum([2, 3, 4, 5, 6], 20)
+Valid? no
+sum([3, 4, 5, 6], 18)
+Valid?
+sum([4, 5, 6], 15)
+Valid? undo
+sum([3, 4, 5, 6], 18)
+Valid?
+sum([4, 5, 6], 15)
+Valid? no
+sum([5, 6], 11)
+Valid? no
+sum([6], 6)
+Valid? pd
+ E4: C3 EXIT pred undo.sum/2-0 (det)
+mdb> dd -r
+sum([6], 6)
+Valid? undo
+sum([5, 6], 11)
+Valid? [no] undo
+sum([4, 5, 6], 15)
+Valid? [no] undo
+sum([3, 4, 5, 6], 18)
+Valid? undo
+sum([2, 3, 4, 5, 6], 20)
+Valid? [no] undo
+sum([1, 2, 3, 4, 5, 6], 21)
+Valid? [no] undo
+Undo stack empty.
+sum([1, 2, 3, 4, 5, 6], 21)
+Valid? [no] q
+Diagnosis aborted.
+ E4: C3 EXIT pred undo.sum/2-0 (det)
+mdb> quit -y
Index: tests/debugger/declarative/undo.inp
===================================================================
RCS file: tests/debugger/declarative/undo.inp
diff -N tests/debugger/declarative/undo.inp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/undo.inp 25 Jul 2005 10:48:19 -0000
@@ -0,0 +1,26 @@
+register --quiet
+context none
+echo on
+step
+finish
+dd
+no
+undo
+undo
+
+no
+
+undo
+
+no
+no
+pd
+dd -r
+undo
+undo
+undo
+undo
+undo
+undo
+q
+quit -y
Index: tests/debugger/declarative/undo.m
===================================================================
RCS file: tests/debugger/declarative/undo.m
diff -N tests/debugger/declarative/undo.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/undo.m 25 Jul 2005 08:33:15 -0000
@@ -0,0 +1,21 @@
+:- module undo.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module list, int.
+
+main(!IO) :-
+ sum([1, 2, 3, 4, 5, 6], S),
+ io.write_int(S, !IO),
+ io.nl(!IO).
+
+:- pred sum(list(int)::in, int::out) is det.
+
+sum([], 0).
+sum([H | T], H + Sum) :- sum(T, Sum).
--------------------------------------------------------------------------
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