[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