Files
mercury/browser/declarative_user.m
Ian MacLarty cfa50105ba Allow the search mode to be changed from within the declarative debugger.
Estimated hours taken: 15
Branches: main

Allow the search mode to be changed from within the declarative debugger.

Make binary search independent of subterm dependency tracking.  The
user can now perform a binary search along the path between the current
question and the root of the search space using the command `mode binary'
(or `m b').

browser/declarative_analyser.m:
	Make reask_last_question fail instead of throwing an exception
	if there is no last question.  If it fails we
	recompute the question.  This happens when the user
	resumes with a new search mode.

	Do not return an analyser response when showing info, since we can
	just call reask_last_question.

	Make set_fallback_search_mode set the last_search_question field to
	no.  This will force the question to be recomputed with the new
	search strategy when analysis continues.

	Add change_search_mode which handles the users request to change the
	current search mode from within a declarative debugging session.

	Do not perform a binary search after tracking a subterm unless
	instructed to do so by the user.

browser/declarative_debugger.m:
	Allow search mode changes to be undone.
	Handle the new change_search oracle response.
	Handle the fact that reask_last_question is now semidet.

browser/declarative_oracle.m:
	Add a change_search oracle response.
	Add a predicate to indicate which oracle responses are undoable.

browser/declarative_user.m:
	Add a change_search user response.

doc/user_guide.texi:
	Rephrase the description of the undo command to take into account that
	search mode changes can be undone.
	Add a section about the binary search mode.
	Rearrange some text and reword some sentences slightly.

tests/debugger/mdb_command_test.inp:
tests/debugger/declarative/Mmakefile:
tests/debugger/declarative/binary_search.exp:
tests/debugger/declarative/binary_search.exp2:
tests/debugger/declarative/binary_search.inp:
tests/debugger/declarative/binary_search.inp2:
tests/debugger/declarative/change_search.exp:
tests/debugger/declarative/change_search.inp:
tests/debugger/declarative/change_search.m:
tests/debugger/declarative/info.exp:
tests/debugger/declarative/info.inp:
	Test the `mode' command and do not expect the declarative debugger to
	automatically go into binary search mode once it has tracked a subterm.
2005-08-19 16:08:31 +00:00

1260 lines
38 KiB
Mathematica

%-----------------------------------------------------------------------------%
% Copyright (C) 1999-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
%-----------------------------------------------------------------------------%
% File: declarative_user.m
% Author: Mark Brown
% Purpose:
% This module performs all the user interaction of the front
% end of the declarative debugger. It is responsible for displaying
% questions and bugs in a human-readable format, and for getting
% responses to debugger queries from the user.
%
:- module mdb.declarative_user.
:- interface.
:- import_module mdb.browser_info.
:- import_module mdb.declarative_debugger.
:- import_module mdb.help.
:- import_module bool.
:- import_module io.
:- type user_question(T)
---> plain_question(decl_question(T))
; question_with_default(decl_question(T), decl_truth).
:- type user_response(T)
---> user_answer(decl_question(T), decl_answer(T))
; trust_predicate(decl_question(T))
; trust_module(decl_question(T))
% Request that the analyser display some information
% about the state of the search and the current
% question to the given output stream.
; show_info(io.output_stream)
% Request that a new search strategy be used.
; change_search(user_search_mode)
% The user wants to undo the last answer they gave.
; undo
; exit_diagnosis(T)
; abort_diagnosis.
:- type user_search_mode
---> top_down
; divide_and_query
; binary.
:- type user_state.
:- pred user_state_init(io.input_stream::in, io.output_stream::in,
browser_info.browser_persistent_state::in, help.system::in,
user_state::out) is det.
% This predicate handles the interactive part of the declarative
% debugging process. The user is presented with a question,
% possibly with a default answer, and is asked to respond about the
% truth of it in the intended interpretation.
%
:- pred query_user(user_question(T)::in, user_response(T)::out,
user_state::in, user_state::out, io::di, io::uo) is cc_multi.
% Confirm that the node found is indeed an e_bug or an i_bug.
%
:- pred user_confirm_bug(decl_bug::in, decl_confirmation::out,
user_state::in, user_state::out, io::di, io::uo) is cc_multi.
% Returns the state of the term browser.
%
:- func get_browser_state(user_state) = browser_info.browser_persistent_state.
% Sets the state of the term browser.
%
:- 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.
% Set the testing flag of the user_state.
%
:- pred set_user_testing_flag(bool::in, user_state::in, user_state::out)
is det.
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module mdb.browse.
:- import_module mdb.browser_term.
:- import_module mdb.declarative_execution.
:- import_module mdb.declarative_tree.
:- import_module mdb.io_action.
:- import_module mdb.parse.
:- import_module mdb.term_rep.
:- import_module mdb.util.
:- import_module mdbcomp.prim_data.
:- import_module mdbcomp.program_representation.
:- import_module bool.
:- import_module char.
:- import_module deconstruct.
:- import_module exception.
:- import_module getopt.
:- import_module int.
:- import_module list.
:- import_module std_util.
:- import_module string.
:- type user_state
---> user(
instr :: io.input_stream,
outstr :: io.output_stream,
browser :: browser_persistent_state,
% yes if the question should be displayed when
% querying the user. This is used to
% supress the displaying of the question after
% the user issues a command which does not
% answer the question (such as an `info'
% command).
display_question :: bool,
help_system :: help.system,
% If this following flag is set to yes then
% user responses will be simulated and will
% always be `no', except when confirming a
% bug in which case the response will be `yes'.
testing :: bool
).
user_state_init(InStr, OutStr, Browser, HelpSystem,
user(InStr, OutStr, Browser, yes, HelpSystem, no)).
%-----------------------------------------------------------------------------%
query_user(UserQuestion, Response, !User, !IO) :-
Question = get_decl_question(UserQuestion),
(
!.User ^ testing = yes,
Node = get_decl_question_node(Question),
Response = user_answer(Question, truth_value(Node, erroneous))
;
!.User ^ testing = no,
(
!.User ^ display_question = yes,
write_decl_question(Question, !.User, !IO),
user_question_prompt(UserQuestion, Prompt),
!:User = !.User ^ display_question := no
;
!.User ^ display_question = no,
Prompt = "dd> "
),
get_command(Prompt, Command, !User, !IO),
handle_command(Command, UserQuestion, Response, !User, !IO),
(
Response \= show_info(_)
->
!:User = !.User ^ display_question := yes
;
true
)
).
:- pred handle_command(user_command::in, user_question(T)::in,
user_response(T)::out, user_state::in, user_state::out,
io::di, io::uo) is cc_multi.
handle_command(yes, UserQuestion, Response, !User, !IO) :-
Question = get_decl_question(UserQuestion),
Node = get_decl_question_node(Question),
Response = user_answer(Question, truth_value(Node, correct)).
handle_command(no, UserQuestion, Response, !User, !IO) :-
Question = get_decl_question(UserQuestion),
Node = get_decl_question_node(Question),
Response = user_answer(Question, truth_value(Node, erroneous)).
handle_command(inadmissible, UserQuestion, Response, !User, !IO) :-
Question = get_decl_question(UserQuestion),
Node = get_decl_question_node(Question),
Response = user_answer(Question, truth_value(Node, inadmissible)).
handle_command(skip, UserQuestion, Response, !User, !IO) :-
Question = get_decl_question(UserQuestion),
Node = get_decl_question_node(Question),
Response = user_answer(Question, skip(Node)).
handle_command(browse_arg(MaybeArgNum), UserQuestion, Response,
!User, !IO) :-
Question = get_decl_question(UserQuestion),
edt_node_trace_atoms(Question, InitAtom, FinalAtom),
(
MaybeArgNum = yes(ArgNum),
browse_atom_argument(InitAtom, FinalAtom, ArgNum, MaybeMark,
!User, !IO),
(
MaybeMark = no,
query_user(UserQuestion, Response,
!User, !IO)
;
MaybeMark = yes(Mark),
ArgPos = arg_num_to_arg_pos(ArgNum),
Node = get_decl_question_node(Question),
Answer = suspicious_subterm(Node, ArgPos, Mark),
Response = user_answer(Question, Answer)
)
;
MaybeArgNum = no,
browse_atom(InitAtom, FinalAtom, MaybeMark, !User, !IO),
(
MaybeMark = no,
query_user(UserQuestion, Response,
!User, !IO)
;
%
% If the user marks the predicate or function,
% we make the atom erroneous.
%
MaybeMark = yes([]),
Node = get_decl_question_node(Question),
Answer = truth_value(Node, erroneous),
Response = user_answer(Question, Answer)
;
MaybeMark = yes([ArgNum | Mark]),
ArgPos = arg_num_to_arg_pos(ArgNum),
Node = get_decl_question_node(Question),
Answer = suspicious_subterm(Node, ArgPos, Mark),
Response = user_answer(Question, Answer)
)
).
handle_command(browse_xml_arg(MaybeArgNum), UserQuestion, Response,
!User, !IO) :-
Question = get_decl_question(UserQuestion),
edt_node_trace_atoms(Question, _, FinalAtom),
(
MaybeArgNum = yes(ArgNum),
browse_xml_atom_argument(FinalAtom, ArgNum, !.User, !IO)
;
MaybeArgNum = no,
browse_xml_atom(FinalAtom, !.User, !IO)
),
query_user(UserQuestion, Response, !User, !IO).
handle_command(print_arg(From, To), UserQuestion, Response,
!User, !IO) :-
Question = get_decl_question(UserQuestion),
edt_node_trace_atoms(Question, _, TraceAtom),
print_atom_arguments(TraceAtom, From, To, !.User, !IO),
query_user(UserQuestion, Response, !User, !IO).
handle_command(set(MaybeOptionTable, Setting), UserQuestion, Response, !User,
!IO) :-
(
MaybeOptionTable = ok(OptionTable),
browser_info.set_param(no, OptionTable, Setting,
!.User ^ browser, Browser),
!:User = !.User ^ browser := Browser
;
MaybeOptionTable = error(Msg),
io.write_string(Msg++"\n", !IO)
),
query_user(UserQuestion, Response, !User, !IO).
handle_command(trust_predicate, UserQuestion, trust_predicate(Question),
!User, !IO) :-
Question = get_decl_question(UserQuestion).
handle_command(trust_module, UserQuestion, trust_module(Question),
!User, !IO) :-
Question = get_decl_question(UserQuestion).
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),
edt_node_io_actions(Question, MaybeIoActions),
% We don't have code yet to trace a marked I/O action.
browse_chosen_io_action(MaybeIoActions, ActionNum, _MaybeMark,
!User, !IO),
query_user(UserQuestion, Response, !User, !IO).
handle_command(print_io(From, To), UserQuestion, Response,
!User, !IO) :-
Question = get_decl_question(UserQuestion),
edt_node_io_actions(Question, MaybeIoActions),
print_chosen_io_actions(MaybeIoActions, From, To, !.User, !IO),
query_user(UserQuestion, Response, !User, !IO).
handle_command(change_search(Mode), _, change_search(Mode), !User, !IO).
handle_command(ask, UserQuestion, Response, !User, !IO) :-
!:User = !.User ^ display_question := yes,
query_user(UserQuestion, Response, !User, !IO).
handle_command(pd, UserQuestion, Response, !User, !IO) :-
Question = get_decl_question(UserQuestion),
Node = get_decl_question_node(Question),
Response = exit_diagnosis(Node).
handle_command(quit, _, Response, !User, !IO) :-
Response = abort_diagnosis.
handle_command(help(MaybeCmd), UserQuestion, Response, !User, !IO) :-
(
MaybeCmd = yes(Cmd),
Path = ["decl", Cmd]
;
MaybeCmd = no,
Path = ["concepts", "decl_debug"]
),
help.path(!.User ^ help_system, Path, !.User ^ outstr, Res, !IO),
(
Res = help.ok
;
Res = help.error(Message),
io.write_strings([Message, "\n"], !IO)
),
query_user(UserQuestion, Response, !User, !IO).
handle_command(empty_command, UserQuestion, Response, !User,
!IO) :-
(
UserQuestion = plain_question(_),
Command = skip
;
UserQuestion = question_with_default(_, Truth),
(
Truth = correct,
Command = yes
;
Truth = erroneous,
Command = no
;
Truth = inadmissible,
Command = inadmissible
)
),
handle_command(Command, UserQuestion, Response, !User, !IO).
handle_command(illegal_command, UserQuestion, Response, !User, !IO) :-
io.write_string(!.User ^ outstr, "Unknown command, 'h' for help.\n",
!IO),
query_user(UserQuestion, Response, !User, !IO).
:- func arg_num_to_arg_pos(int) = arg_pos.
arg_num_to_arg_pos(ArgNum) = ArgPos :-
Which = chosen_head_vars_presentation,
(
Which = only_user_headvars,
ArgPos = user_head_var(ArgNum)
;
Which = all_headvars,
ArgPos = any_head_var(ArgNum)
).
:- func get_decl_question(user_question(T)) = decl_question(T).
get_decl_question(plain_question(Q)) = Q.
get_decl_question(question_with_default(Q, _)) = Q.
:- pred user_question_prompt(user_question(T)::in, string::out) is det.
user_question_prompt(plain_question(Question), Prompt) :-
decl_question_prompt(Question, Prompt).
user_question_prompt(question_with_default(Question, DefaultTruth), Prompt) :-
decl_question_prompt(Question, QuestionPrompt),
default_prompt(DefaultTruth, DefaultPrompt),
string.append(QuestionPrompt, DefaultPrompt, Prompt).
:- pred decl_question_prompt(decl_question(T)::in, string::out) is det.
decl_question_prompt(wrong_answer(_, _, _), "Valid? ").
decl_question_prompt(missing_answer(_, _, [_ | _]), "Complete? ").
decl_question_prompt(missing_answer(_, _, []), "Unsatisfiable? ").
decl_question_prompt(unexpected_exception(_, _, _), "Expected? ").
:- pred default_prompt(decl_truth::in, string::out) is det.
default_prompt(correct, "[yes] ").
default_prompt(erroneous, "[no] ").
default_prompt(inadmissible, "[inadmissible] ").
% Find the initial and final atoms for a question. For all
% questions besides wrong answer questions the initial and
% final atoms will be the same.
%
:- pred edt_node_trace_atoms(decl_question(T)::in, trace_atom::out,
trace_atom::out) is det.
edt_node_trace_atoms(wrong_answer(_, InitDeclAtom, FinalDeclAtom),
InitDeclAtom ^ init_atom, FinalDeclAtom ^ final_atom).
edt_node_trace_atoms(missing_answer(_, InitDeclAtom, _),
InitDeclAtom ^ init_atom, InitDeclAtom ^ init_atom).
edt_node_trace_atoms(unexpected_exception(_, InitDeclAtom, _),
InitDeclAtom ^ init_atom, InitDeclAtom ^ init_atom).
:- pred edt_node_io_actions(decl_question(T)::in, maybe(io_action_range)::out)
is det.
edt_node_io_actions(wrong_answer(_, _, FinalDeclAtom),
FinalDeclAtom ^ final_io_actions).
edt_node_io_actions(missing_answer(_, _, _), no).
edt_node_io_actions(unexpected_exception(_, _, _), no).
:- pred decl_bug_trace_atom(decl_bug::in, trace_atom::out, trace_atom::out)
is det.
decl_bug_trace_atom(e_bug(incorrect_contour(InitDeclAtom, FinalDeclAtom, _,
_)), InitDeclAtom ^ init_atom, FinalDeclAtom ^ final_atom).
decl_bug_trace_atom(e_bug(partially_uncovered_atom(InitDeclAtom, _)),
InitDeclAtom ^ init_atom, InitDeclAtom ^ init_atom).
decl_bug_trace_atom(e_bug(unhandled_exception(InitDeclAtom, _, _)),
InitDeclAtom ^ init_atom, InitDeclAtom ^ init_atom).
decl_bug_trace_atom(i_bug(inadmissible_call(_, _, InitDeclAtom, _)),
InitDeclAtom ^ init_atom, InitDeclAtom ^ init_atom).
:- pred decl_bug_io_actions(decl_bug::in, maybe(io_action_range)::out) is det.
decl_bug_io_actions(e_bug(incorrect_contour(_, FinalDeclAtom, _, _)),
FinalDeclAtom ^ final_io_actions).
decl_bug_io_actions(e_bug(partially_uncovered_atom(_, _)), no).
decl_bug_io_actions(e_bug(unhandled_exception(_, _, _)), no).
decl_bug_io_actions(i_bug(inadmissible_call(_, _, _, _)), no).
:- pred browse_chosen_io_action(maybe(io_action_range)::in, int::in,
maybe(term_path)::out, user_state::in, user_state::out,
io::di, io::uo) is cc_multi.
browse_chosen_io_action(MaybeIoActions, ActionNum, MaybeMark, !User, !IO) :-
(
MaybeIoActions = yes(IoActions),
find_tabled_io_action(IoActions, ActionNum, MaybeIoAction,
!IO),
(
MaybeIoAction = yes(IoAction),
browse_io_action(IoAction, MaybeMark, !User, !IO)
;
MaybeIoAction = no,
MaybeMark = no
)
;
MaybeIoActions = no,
io.write_string("No such IO action.\n", !IO),
MaybeMark = no
).
:- pred find_tabled_io_action(io_action_range::in, int::in,
maybe(io_action)::out, io::di, io::uo) is det.
find_tabled_io_action(io_action_range(Cur, End), TabledActionNum,
MaybeIoAction, !IO) :-
(
Cur = End
->
MaybeIoAction = no
;
get_maybe_io_action(Cur, MaybeTabledIoAction, !IO),
(
MaybeTabledIoAction = tabled(IoAction),
(
TabledActionNum = 1
->
MaybeIoAction = yes(IoAction)
;
find_tabled_io_action(io_action_range(Cur + 1,
End), TabledActionNum - 1,
MaybeIoAction, !IO)
)
;
MaybeTabledIoAction = untabled,
find_tabled_io_action(io_action_range(Cur + 1, End),
TabledActionNum, MaybeIoAction, !IO)
)
).
:- pred print_chosen_io_actions(maybe(io_action_range)::in, int::in, int::in,
user_state::in, io::di, io::uo) is cc_multi.
print_chosen_io_actions(MaybeIoActions, From, To, User0, !IO) :-
print_chosen_io_action(MaybeIoActions, From, User0, OK, !IO),
( OK = yes, From + 1 =< To ->
print_chosen_io_actions(MaybeIoActions, From + 1, To, User0,
!IO)
;
true
).
:- pred print_chosen_io_action(maybe(io_action_range)::in, int::in,
user_state::in, bool::out, io::di, io::uo) is cc_multi.
print_chosen_io_action(MaybeIoActions, ActionNum, User0, OK, !IO) :-
(
MaybeIoActions = yes(IoActions),
find_tabled_io_action(IoActions, ActionNum, MaybeIoAction,
!IO),
(
MaybeIoAction = yes(IoAction),
print_tabled_io_action(User0, tabled(IoAction), !IO),
OK = yes
;
MaybeIoAction = no,
io.write_string("No such IO action.\n", !IO),
OK = no
)
;
MaybeIoActions = no,
io.write_string("No such IO action.\n", !IO),
OK = no
).
:- pred browse_io_action(io_action::in, maybe(term_path)::out,
user_state::in, user_state::out, io::di, io::uo) is cc_multi.
browse_io_action(IoAction, MaybeMark, !User, !IO) :-
Term = io_action_to_browser_term(IoAction),
browse_browser_term(Term, !.User ^ instr, !.User ^ outstr, no,
MaybeDirs, !.User ^ browser, Browser, !IO),
maybe_convert_dirs_to_path(MaybeDirs, MaybeMark),
!:User = !.User ^ browser := Browser.
:- pred browse_decl_bug(decl_bug::in, maybe(int)::in, user_state::in,
user_state::out, io::di, io::uo) is cc_multi.
browse_decl_bug(Bug, MaybeArgNum, !User, !IO) :-
decl_bug_trace_atom(Bug, InitAtom, FinalAtom),
(
MaybeArgNum = yes(ArgNum),
browse_atom_argument(InitAtom, FinalAtom, ArgNum, _, !User,
!IO)
;
MaybeArgNum = no,
browse_atom(InitAtom, FinalAtom, _, !User, !IO)
).
:- pred browse_xml_decl_bug(decl_bug::in, maybe(int)::in, user_state::in,
io::di, io::uo) is cc_multi.
browse_xml_decl_bug(Bug, MaybeArgNum, User, !IO) :-
decl_bug_trace_atom(Bug, _, FinalAtom),
(
MaybeArgNum = yes(ArgNum),
browse_xml_atom_argument(FinalAtom, ArgNum, User, !IO)
;
MaybeArgNum = no,
browse_xml_atom(FinalAtom, User, !IO)
).
:- pred browse_atom_argument(trace_atom::in, trace_atom::in, int::in,
maybe(term_path)::out, user_state::in, user_state::out,
io::di, io::uo) is cc_multi.
browse_atom_argument(InitAtom, FinalAtom, ArgNum, MaybeMark, !User, !IO) :-
FinalAtom = atom(_, Args0),
maybe_filter_headvars(chosen_head_vars_presentation, Args0, Args),
(
list.index1(Args, ArgNum, ArgInfo),
ArgInfo = arg_info(_, _, MaybeArg),
MaybeArg = yes(ArgRep),
term_rep.rep_to_univ(ArgRep, Arg)
->
browse_browser_term(univ_to_browser_term(Arg),
!.User ^ instr, !.User ^ outstr,
yes(get_subterm_mode_from_atoms_for_arg(ArgNum,
InitAtom, FinalAtom)),
MaybeDirs, !.User ^ browser, Browser, !IO),
maybe_convert_dirs_to_path(MaybeDirs, MaybeMark),
!:User = !.User ^ browser := Browser
;
io.write_string(!.User ^ outstr, "Invalid argument number\n",
!IO),
MaybeMark = no
).
:- pred browse_xml_atom_argument(trace_atom::in, int::in, user_state::in,
io::di, io::uo) is cc_multi.
browse_xml_atom_argument(Atom, ArgNum, User, !IO) :-
Atom = atom(_, Args0),
maybe_filter_headvars(chosen_head_vars_presentation, Args0, Args),
(
list.index1(Args, ArgNum, ArgInfo),
ArgInfo = arg_info(_, _, MaybeArg),
MaybeArg = yes(ArgRep),
term_rep.rep_to_univ(ArgRep, Arg)
->
save_and_browse_browser_term_xml(univ_to_browser_term(Arg),
User ^ outstr, User ^ outstr, User ^ browser, !IO)
;
io.write_string(User ^ outstr, "Invalid argument number\n",
!IO)
).
:- pred browse_atom(trace_atom::in, trace_atom::in, maybe(term_path)::out,
user_state::in, user_state::out, io::di, io::uo) is cc_multi.
browse_atom(InitAtom, FinalAtom, MaybeMark, !User, !IO) :-
FinalAtom = atom(ProcLayout, Args),
ProcLabel = get_proc_label_from_layout(ProcLayout),
get_user_arg_values(Args, ArgValues),
get_pred_attributes(ProcLabel, Module, Name, _, PredOrFunc),
IsFunction = pred_to_bool(unify(PredOrFunc, function)),
sym_name_to_string(Module, ".", ModuleStr),
BrowserTerm = synthetic_term_to_browser_term(ModuleStr ++ "." ++ Name,
ArgValues, IsFunction),
browse_browser_term(BrowserTerm, !.User ^ instr, !.User ^ outstr,
yes(get_subterm_mode_from_atoms(InitAtom, FinalAtom)),
MaybeDirs, !.User ^ browser, Browser, !IO),
maybe_convert_dirs_to_path(MaybeDirs, MaybeMark),
!:User = !.User ^ browser := Browser.
:- pred browse_xml_atom(trace_atom::in, user_state::in, io::di, io::uo)
is cc_multi.
browse_xml_atom(Atom, User, !IO) :-
Atom = atom(ProcLayout, Args),
ProcLabel = get_proc_label_from_layout(ProcLayout),
get_user_arg_values(Args, ArgValues),
get_pred_attributes(ProcLabel, Module, Name, _, PredOrFunc),
IsFunction = pred_to_bool(unify(PredOrFunc, function)),
sym_name_to_string(Module, ".", ModuleStr),
BrowserTerm = synthetic_term_to_browser_term(ModuleStr ++ "." ++ Name,
ArgValues, IsFunction),
save_and_browse_browser_term_xml(BrowserTerm, User ^ outstr,
User ^ outstr, User ^ browser, !IO).
:- func get_subterm_mode_from_atoms(trace_atom, trace_atom, list(dir))
= browser_term_mode.
get_subterm_mode_from_atoms(InitAtom, FinalAtom, Dirs) = Mode :-
convert_dirs_to_term_path(Dirs, Path),
(
Path = [ArgNum | TermPath],
ArgPos = arg_num_to_arg_pos(ArgNum),
Mode = get_subterm_mode_from_atoms_and_term_path(InitAtom,
FinalAtom, ArgPos, TermPath)
;
Path = [],
Mode = not_applicable
).
:- func get_subterm_mode_from_atoms_and_term_path(trace_atom, trace_atom,
arg_pos, term_path) = browser_term_mode.
get_subterm_mode_from_atoms_and_term_path(InitAtom, FinalAtom, ArgPos,
TermPath) = Mode :-
( trace_atom_subterm_is_ground(InitAtom, ArgPos, TermPath) ->
Mode = input
; trace_atom_subterm_is_ground(FinalAtom, ArgPos, TermPath) ->
Mode = output
;
Mode = unbound
).
:- func get_subterm_mode_from_atoms_for_arg(int, trace_atom, trace_atom,
list(dir)) = browser_term_mode.
get_subterm_mode_from_atoms_for_arg(ArgNum, InitAtom, FinalAtom, Dirs)
= Mode :-
convert_dirs_to_term_path(Dirs, TermPath),
ArgPos = arg_num_to_arg_pos(ArgNum),
Mode = get_subterm_mode_from_atoms_and_term_path(InitAtom, FinalAtom,
ArgPos, TermPath).
:- pred get_user_arg_values(list(trace_atom_arg)::in, list(univ)::out) is det.
get_user_arg_values([], []).
get_user_arg_values([arg_info(UserVisible, _, MaybeValue) | Args], Values) :-
get_user_arg_values(Args, Values0),
(
UserVisible = yes
->
(
MaybeValue = yes(ValueRep),
term_rep.rep_to_univ(ValueRep, Value)
;
MaybeValue = no,
Value = univ('_'`with_type`unbound)
),
Values = [Value | Values0]
;
Values = Values0
).
:- pred print_atom_arguments(trace_atom::in, int::in, int::in, user_state::in,
io::di, io::uo) is cc_multi.
print_atom_arguments(Atom, From, To, User, !IO) :-
print_atom_argument(Atom, From, User, OK, !IO),
(
OK = yes,
From + 1 =< To
->
print_atom_arguments(Atom, From + 1, To, User, !IO)
;
true
).
:- pred print_atom_argument(trace_atom::in, int::in, user_state::in, bool::out,
io::di, io::uo) is cc_multi.
print_atom_argument(Atom, ArgNum, User, OK, !IO) :-
Atom = atom(_, Args0),
maybe_filter_headvars(chosen_head_vars_presentation, Args0, Args),
(
list.index1(Args, ArgNum, ArgInfo),
ArgInfo = arg_info(_, _, MaybeArg),
MaybeArg = yes(ArgRep),
term_rep.rep_to_univ(ArgRep, Arg)
->
print_browser_term(univ_to_browser_term(Arg), User ^ outstr,
decl_caller_type, User ^ browser, !IO),
OK = yes
;
io.write_string(User ^ outstr, "Invalid argument number\n",
!IO),
OK = no
).
:- pred maybe_convert_dirs_to_path(maybe(list(dir))::in,
maybe(term_path)::out) is det.
maybe_convert_dirs_to_path(no, no).
maybe_convert_dirs_to_path(yes(Dirs), yes(TermPath)) :-
convert_dirs_to_term_path(Dirs, TermPath).
% Reverse the first argument and append the second to it.
%
:- pred reverse_and_append(list(T)::in, list(T)::in, list(T)::out) is det.
reverse_and_append([], Bs, Bs).
reverse_and_append([A | As], Bs, Cs) :-
reverse_and_append(As, [A | Bs], Cs).
%-----------------------------------------------------------------------------%
:- type user_command
% The node is correct.
---> yes
% The node is erroneous.
; no
% The node is inadmissible.
; inadmissible
% The user has no answer.
; skip
% Browse the nth argument before answering. Or browse
% the whole predicate/function if the maybe is no.
; browse_arg(maybe(int))
% Browse the argument using an XML browser.
; browse_xml_arg(maybe(int))
% Browse the nth IO action before answering.
; browse_io(int)
% Print the nth to the mth arguments
% before answering.
; print_arg(int, int)
% Print the nth to the mth IO actions
% before answering.
; print_io(int, int)
% Commence procedural debugging from
% this point.
; pd
% Set a browser option.
; set(maybe_option_table(setting_option), setting)
% Trust the predicate being asked
% about.
; trust_predicate
% Trust the module being asked about.
; trust_module
% Print some information about the current question.
; info
% Undo the user's last answer.
; undo
% The user wants the current question re-asked.
; ask
% Change the current search strategy.
; change_search(user_search_mode)
% Abort this diagnosis session.
; quit
% Request help before answering. If the maybe argument
% is no then a general help message is displayed,
% otherwise help on the given command is displayed.
; help(maybe(string))
% User just pressed return.
; empty_command
% None of the above.
; illegal_command.
:- pred user_confirm_bug_help(user_state::in, io::di, io::uo) is det.
user_confirm_bug_help(User, !IO) :-
io.write_strings(User ^ outstr, [
"Answer one of:\n",
"\ty\tyes\t\tconfirm that the suspect is a bug\n",
"\tn\tno\t\tdo not accept that the suspect is a bug\n",
"\tb\tbrowse\t\tbrowse the suspect\n",
"\tq\tquit\t\t",
"abort this diagnosis session and return to mdb\n",
"\th, ?\thelp\t\tthis help message\n"
], !IO).
:- pred get_command(string::in, user_command::out,
user_state::in, user_state::out, io::di, io::uo) is det.
get_command(Prompt, Command, User, User, !IO) :-
util.trace_getline(Prompt, Result, User ^ instr, User ^ outstr, !IO),
(
Result = ok(String),
Words = string.words(char.is_whitespace, String),
(
Words = [CmdWord | CmdArgs],
(
cmd_handler(CmdWord, CmdHandler),
CommandPrime = CmdHandler(CmdArgs)
->
Command = CommandPrime
;
Command = illegal_command
)
;
Words = [],
Command = empty_command
)
;
Result = error(Error),
io.error_message(Error, Msg),
io.write_string(User ^ outstr, Msg, !IO),
io.nl(User ^ outstr, !IO),
Command = quit
;
Result = eof,
Command = quit
).
:- pred cmd_handler(string::in,
(func(list(string)) = user_command)::out(func(in) = out is semidet))
is semidet.
cmd_handler("y", one_word_cmd(yes)).
cmd_handler("yes", one_word_cmd(yes)).
cmd_handler("n", one_word_cmd(no)).
cmd_handler("no", one_word_cmd(no)).
cmd_handler("i", one_word_cmd(inadmissible)).
cmd_handler("inadmissible", one_word_cmd(inadmissible)).
cmd_handler("s", one_word_cmd(skip)).
cmd_handler("skip", one_word_cmd(skip)).
cmd_handler("pd", one_word_cmd(pd)).
% `abort' is a synonym for `quit' and is just here for backwards compatibility.
cmd_handler("a", one_word_cmd(quit)).
cmd_handler("abort", one_word_cmd(quit)).
cmd_handler("q", one_word_cmd(quit)).
cmd_handler("quit", one_word_cmd(quit)).
cmd_handler("?", help_cmd).
cmd_handler("h", help_cmd).
cmd_handler("help", help_cmd).
cmd_handler("info", one_word_cmd(info)).
cmd_handler("b", browse_arg_cmd).
cmd_handler("browse", browse_arg_cmd).
cmd_handler("p", print_arg_cmd).
cmd_handler("print", print_arg_cmd).
cmd_handler("set", set_arg_cmd).
cmd_handler("t", trust_arg_cmd).
cmd_handler("trust", trust_arg_cmd).
cmd_handler("mode", search_mode_cmd).
cmd_handler("m", search_mode_cmd).
cmd_handler("undo", one_word_cmd(undo)).
:- func one_word_cmd(user_command::in, list(string)::in) = (user_command::out)
is semidet.
one_word_cmd(Cmd, []) = Cmd.
:- func browse_arg_cmd(list(string)::in) = (user_command::out) is semidet.
browse_arg_cmd([]) = browse_arg(no).
browse_arg_cmd([Arg]) = BrowseCmd :-
(
string.to_int(Arg, ArgNum)
->
BrowseCmd = browse_arg(yes(ArgNum))
;
( Arg = "-x" ; Arg = "--xml" ),
BrowseCmd = browse_xml_arg(no)
).
browse_arg_cmd(["-x", Arg]) = browse_xml_arg(yes(ArgNum)) :-
string.to_int(Arg, ArgNum).
browse_arg_cmd(["--xml", Arg]) = browse_xml_arg(yes(ArgNum)) :-
string.to_int(Arg, ArgNum).
browse_arg_cmd(["io", Arg]) = browse_io(ArgNum) :-
string.to_int(Arg, ArgNum).
:- func print_arg_cmd(list(string)::in) = (user_command::out) is semidet.
print_arg_cmd([]) = ask.
print_arg_cmd([Arg]) = print_arg(From, To) :-
string_to_range(Arg, From, To).
print_arg_cmd(["io", Arg]) = print_io(From, To) :-
string_to_range(Arg, From, To).
:- pred string_to_range(string::in, int::out, int::out) is semidet.
:- func set_arg_cmd(list(string)::in) = (user_command::out) is semidet.
set_arg_cmd(ArgWords) = set(MaybeOptionTable, Setting) :-
ArgWords \= [],
parse.parse(["set" | ArgWords], set(MaybeOptionTable, Setting)).
:- func trust_arg_cmd(list(string)::in) = (user_command::out) is semidet.
trust_arg_cmd([]) = trust_predicate.
trust_arg_cmd(["module"]) = trust_module.
:- func search_mode_cmd(list(string)::in) = (user_command::out) is semidet.
search_mode_cmd(["top-down"]) = change_search(top_down).
search_mode_cmd(["top_down"]) = change_search(top_down).
search_mode_cmd(["td"]) = change_search(top_down).
search_mode_cmd(["divide-and-query"]) = change_search(divide_and_query).
search_mode_cmd(["divide_and_query"]) = change_search(divide_and_query).
search_mode_cmd(["dq"]) = change_search(divide_and_query).
search_mode_cmd(["binary"]) = change_search(binary).
search_mode_cmd(["b"]) = change_search(binary).
:- func help_cmd(list(string)::in) = (user_command::out) is semidet.
help_cmd([]) = help(no).
help_cmd([Cmd]) = help(yes(Cmd)).
string_to_range(Arg, From, To) :-
( string.to_int(Arg, Num) ->
From = Num,
To = Num
;
[FirstStr, SecondStr] = string.words(is_dash, Arg),
string.to_int(FirstStr, First),
string.to_int(SecondStr, Second),
( First =< Second ->
From = First,
To = Second
;
From = Second,
To = First
)
).
:- pred is_dash(char::in) is semidet.
is_dash('-').
%-----------------------------------------------------------------------------%
user_confirm_bug(Bug, Response, !User, !IO) :-
(
!.User ^ testing = yes,
Response = confirm_bug
;
!.User ^ testing = no,
write_decl_bug(Bug, !.User, !IO),
get_command("Is this a bug? ", Command, !User, !IO),
(
Command = yes
->
Response = confirm_bug
;
Command = no
->
Response = overrule_bug
;
Command = quit
->
Response = abort_diagnosis
;
Command = browse_arg(MaybeArgNum)
->
browse_decl_bug(Bug, MaybeArgNum, !User, !IO),
user_confirm_bug(Bug, Response, !User, !IO)
;
Command = browse_xml_arg(MaybeArgNum)
->
browse_xml_decl_bug(Bug, MaybeArgNum, !.User, !IO),
user_confirm_bug(Bug, Response, !User, !IO)
;
Command = browse_io(ActionNum)
->
decl_bug_io_actions(Bug, MaybeIoActions),
browse_chosen_io_action(MaybeIoActions, ActionNum,
_MaybeMark, !User, !IO),
user_confirm_bug(Bug, Response, !User, !IO)
;
user_confirm_bug_help(!.User, !IO),
user_confirm_bug(Bug, Response, !User, !IO)
)
).
%-----------------------------------------------------------------------------%
% Returns the caller type we want to use throughout the
% declarative debugger.
:- func decl_caller_type = browse_caller_type.
decl_caller_type = print.
% Display the node in user readable form on the current
% output stream.
%
:- pred write_decl_question(decl_question(T)::in, user_state::in,
io::di, io::uo) is cc_multi.
write_decl_question(wrong_answer(_, _, Atom), User, !IO) :-
write_decl_final_atom(User, "", decl_caller_type, Atom, !IO).
write_decl_question(missing_answer(_, Call, Solns), User, !IO) :-
write_decl_init_atom(User, "Call ", decl_caller_type, Call, !IO),
(
Solns = []
;
Solns = [_ | _],
io.write_string(User ^ outstr, "Solutions:\n", !IO),
list.foldl(write_decl_final_atom(User, "\t", print_all), Solns,
!IO)
).
write_decl_question(unexpected_exception(_, Call, ExceptionRep), User, !IO) :-
write_decl_init_atom(User, "Call ", decl_caller_type, Call, !IO),
io.write_string(User ^ outstr, "Throws ", !IO),
term_rep.rep_to_univ(ExceptionRep, Exception),
io.write(User ^ outstr, include_details_cc, univ_value(Exception),
!IO),
io.nl(User ^ outstr, !IO).
:- pred write_decl_bug(decl_bug::in, user_state::in, io::di, io::uo)
is cc_multi.
write_decl_bug(e_bug(EBug), User, !IO) :-
(
EBug = incorrect_contour(_, Atom, Contour, _),
io.write_string(User ^ outstr, "Found incorrect contour:\n",
!IO),
io.write_list(Contour, "", write_decl_final_atom(User, "",
decl_caller_type), !IO),
write_decl_final_atom(User, "", decl_caller_type, Atom, !IO)
;
EBug = partially_uncovered_atom(Atom, _),
io.write_string(User ^ outstr,
"Found partially uncovered atom:\n", !IO),
write_decl_init_atom(User, "", decl_caller_type, Atom, !IO)
;
EBug = unhandled_exception(Atom, ExceptionRep, _),
io.write_string(User ^ outstr,
"Found unhandled or incorrect exception:\n", !IO),
write_decl_init_atom(User, "", decl_caller_type, Atom, !IO),
term_rep.rep_to_univ(ExceptionRep, Exception),
io.write(User ^ outstr, include_details_cc,
univ_value(Exception), !IO),
io.nl(User ^ outstr, !IO)
).
write_decl_bug(i_bug(IBug), User, !IO) :-
IBug = inadmissible_call(Parent, _, Call, _),
io.write_string(User ^ outstr, "Found inadmissible call:\n", !IO),
write_decl_atom(User, "Parent ", decl_caller_type, init(Parent), !IO),
write_decl_atom(User, "Call ", decl_caller_type, init(Call), !IO).
:- pred write_decl_init_atom(user_state::in, string::in,
browse_caller_type::in, init_decl_atom::in,
io::di, io::uo) is cc_multi.
write_decl_init_atom(User, Indent, CallerType, InitAtom, !IO) :-
write_decl_atom(User, Indent, CallerType, init(InitAtom), !IO).
:- pred write_decl_final_atom(user_state::in, string::in,
browse_caller_type::in, final_decl_atom::in,
io::di, io::uo) is cc_multi.
write_decl_final_atom(User, Indent, CallerType, FinalAtom, !IO) :-
write_decl_atom(User, Indent, CallerType, final(FinalAtom), !IO).
:- pred write_decl_atom(user_state::in, string::in, browse_caller_type::in,
some_decl_atom::in, io::di, io::uo) is cc_multi.
write_decl_atom(User, Indent, CallerType, DeclAtom, !IO) :-
io.write_string(User ^ outstr, Indent, !IO),
unravel_decl_atom(DeclAtom, TraceAtom, MaybeIoActions),
TraceAtom = atom(ProcLayout, Args0),
ProcLabel = get_proc_label_from_layout(ProcLayout),
get_pred_attributes(ProcLabel, _, Functor, _, PredOrFunc),
Which = chosen_head_vars_presentation,
maybe_filter_headvars(Which, Args0, Args1),
list.map(trace_atom_arg_to_univ, Args1, Args),
%
% Call the term browser to print the atom (or part of it
% up to a size limit) as a goal.
%
BrowserTerm = synthetic_term_to_browser_term(Functor, Args,
is_function(PredOrFunc)),
browse.print_browser_term(BrowserTerm, User ^ outstr, CallerType,
User ^ browser, !IO),
write_maybe_tabled_io_actions(User, MaybeIoActions, !IO).
:- pred write_maybe_tabled_io_actions(user_state::in,
maybe(io_action_range)::in, io::di, io::uo) is cc_multi.
write_maybe_tabled_io_actions(User, MaybeIoActions, !IO) :-
(
MaybeIoActions = yes(IoActions),
count_tabled_io_actions(IoActions, NumTabled, NumUntabled,
!IO),
write_io_actions(User, NumTabled, IoActions, !IO),
(
NumUntabled > 0
->
io.write_string(User ^ outstr, "Warning: some IO " ++
"actions for this atom are not tabled.\n", !IO)
;
true
)
;
MaybeIoActions = no
).
:- pred count_tabled_io_actions(io_action_range::in, int::out, int::out,
io::di, io::uo) is det.
count_tabled_io_actions(io_action_range(Start, End), NumTabled,
NumUntabled, !IO) :-
count_tabled_io_actions_2(Start, End, 0, NumTabled, 0,
NumUntabled, !IO).
:- pred count_tabled_io_actions_2(io_seq_num::in,
io_seq_num::in, int::in, int::out, int::in, int::out, io::di, io::uo)
is det.
count_tabled_io_actions_2(Cur, End, PrevTabled, Tabled,
PrevUntabled, Untabled, !IO) :-
(
Cur = End
->
Untabled = PrevUntabled,
Tabled = PrevTabled
;
get_maybe_io_action(Cur, MaybeIoAction, !IO),
(
MaybeIoAction = tabled(_),
NewPrevUntabled = PrevUntabled,
NewPrevTabled = PrevTabled + 1
;
MaybeIoAction = untabled,
NewPrevUntabled = PrevUntabled + 1,
NewPrevTabled = PrevTabled
),
count_tabled_io_actions_2(Cur + 1, End,
NewPrevTabled, Tabled, NewPrevUntabled, Untabled, !IO)
).
:- pred trace_atom_arg_to_univ(trace_atom_arg::in, univ::out) is det.
trace_atom_arg_to_univ(TraceAtomArg, Univ) :-
MaybeUniv = TraceAtomArg ^ arg_value,
(
MaybeUniv = yes(Rep),
term_rep.rep_to_univ(Rep, Univ)
;
MaybeUniv = no,
Univ = univ('_' `with_type` unbound)
).
:- pred write_io_actions(user_state::in, int::in, io_action_range::in,
io::di, io::uo) is cc_multi.
write_io_actions(User, NumTabled, IoActions, !IO) :-
( NumTabled = 0 ->
true
;
( NumTabled = 1 ->
io.write_string(User ^ outstr, "1 tabled IO action:",
!IO)
;
io.write_int(User ^ outstr, NumTabled, !IO),
io.write_string(User ^ outstr, " tabled IO actions:",
!IO)
),
NumPrinted = get_num_printed_io_actions(User ^ browser),
( NumTabled =< NumPrinted ->
io.nl(User ^ outstr, !IO),
print_tabled_io_actions(User, IoActions, !IO)
;
io.write_string(User ^ outstr, " too many to show",
!IO),
io.nl(User ^ outstr, !IO)
)
).
:- pred print_tabled_io_actions(user_state::in, io_action_range::in,
io::di, io::uo) is cc_multi.
print_tabled_io_actions(User, IoActions, !IO) :-
IoActions = io_action_range(Start, End),
print_tabled_io_actions_2(User, Start, End, !IO).
:- pred print_tabled_io_actions_2(user_state::in,
io_seq_num::in, io_seq_num::in, io::di, io::uo) is cc_multi.
print_tabled_io_actions_2(User, Cur, End, !IO) :-
( Cur = End ->
true
;
get_maybe_io_action(Cur, MaybeIoAction, !IO),
print_tabled_io_action(User, MaybeIoAction, !IO),
print_tabled_io_actions_2(User, Cur + 1, End, !IO)
).
:- pred print_tabled_io_action(user_state::in, maybe_tabled_io_action::in,
io::di, io::uo) is cc_multi.
print_tabled_io_action(_, untabled, !IO).
print_tabled_io_action(User, tabled(IoAction), !IO) :-
Term = io_action_to_browser_term(IoAction),
browse.print_browser_term(Term, User ^ outstr, print_all,
User ^ browser, !IO).
%-----------------------------------------------------------------------------%
get_browser_state(User) = User ^ browser.
set_browser_state(Browser, !User) :-
!:User = !.User ^ browser := Browser.
get_user_output_stream(User) = User ^ outstr.
set_user_testing_flag(Testing, User, User ^ testing := Testing).
%-----------------------------------------------------------------------------%