mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-17 14:57:03 +00:00
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.
1260 lines
38 KiB
Mathematica
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).
|
|
|
|
%-----------------------------------------------------------------------------%
|