mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-17 06:47:17 +00:00
Estimated hours taken: 1 Branches: main Add the command 'pd' to the declarative debugger. This command returns to the procedural debugger at the event corresponding to the current question; it is notionally the inverse of the 'dd' command in the procedural debugger. browser/declarative_user.m: Handle the new command, and add a new alternative to the user_response type. browser/declarative_oracle.m: Handle the new user response, and add a new alternative to the oracle_response type. browser/declarative_debugger.m: Handle the new oracle response, and add a new alternative to the diagnoser_response type. Export some procedures to C so that the back end can interpret the new diagnoser response. Update an old comment. trace/mercury_trace_declarative.c: Handle the new diagnoser response. Rename the function MR_decl_handle_bug_found, since it now also handles the case where a symptom has been found. Interpret the diagnoser response using something like a switch, rather than something like an if-then-else. This gives better error messages if the diagnoser response type is changed. doc/user_guide.texi: Document the new command. tests/debugger/declarative/Mmakefile: tests/debugger/declarative/pd.exp: tests/debugger/declarative/pd.inp: tests/debugger/declarative/pd.m: Test the new feature.
660 lines
21 KiB
Mathematica
660 lines
21 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 1999-2002 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__declarative_debugger.
|
|
:- import_module list, io.
|
|
|
|
:- type user_response(T)
|
|
---> user_answer(decl_question(T), decl_answer(T))
|
|
; no_user_answer
|
|
; exit_diagnosis(T)
|
|
; abort_diagnosis.
|
|
|
|
:- type user_state.
|
|
|
|
:- pred user_state_init(io__input_stream, io__output_stream, user_state).
|
|
:- mode user_state_init(in, in, out) is det.
|
|
|
|
% This predicate handles the interactive part of the declarative
|
|
% debugging process. The user is presented with an EDT node,
|
|
% and is asked to respond about the truth of the node in the
|
|
% intended interpretation.
|
|
%
|
|
:- pred query_user(list(decl_question(T))::in, user_response(T)::out,
|
|
user_state::in, user_state::out, io__state::di, io__state::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__state::di, io__state::uo)
|
|
is cc_multi.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
:- import_module mdb__browser_info, mdb__browse, mdb__io_action, mdb__util.
|
|
:- import_module mdb__declarative_execution, mdb__program_representation.
|
|
:- import_module std_util, char, string, bool, int, deconstruct.
|
|
|
|
:- type user_state
|
|
---> user(
|
|
instr :: io__input_stream,
|
|
outstr :: io__output_stream,
|
|
browser :: browser_persistent_state
|
|
).
|
|
|
|
user_state_init(InStr, OutStr, User) :-
|
|
browser_info__init_persistent_state(Browser),
|
|
User = user(InStr, OutStr, Browser).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
query_user(Questions, Response, User0, User) -->
|
|
query_user_2(Questions, [], Response, User0, User).
|
|
|
|
:- pred query_user_2(list(decl_question(T))::in, list(decl_question(T))::in,
|
|
user_response(T)::out, user_state::in, user_state::out,
|
|
io__state::di, io__state::uo) is cc_multi.
|
|
|
|
query_user_2([], _, no_user_answer, User, User) -->
|
|
[].
|
|
query_user_2([Question | Questions], Skipped, Response, User0, User) -->
|
|
write_decl_question(Question, User0),
|
|
{ Node = get_decl_question_node(Question) },
|
|
{ decl_question_prompt(Question, Prompt) },
|
|
get_command(Prompt, Command, User0, User1),
|
|
(
|
|
{ Command = yes },
|
|
{ Response = user_answer(Question, truth_value(Node, yes)) },
|
|
{ User = User1 }
|
|
;
|
|
{ Command = no },
|
|
{ Response = user_answer(Question, truth_value(Node, no)) },
|
|
{ User = User1 }
|
|
;
|
|
{ Command = inadmissible },
|
|
io__write_string("Sorry, not implemented,\n"),
|
|
query_user_2([Question | Questions], Skipped, Response,
|
|
User1, User)
|
|
;
|
|
{ Command = skip },
|
|
query_user_2(Questions, [Question | Skipped], Response,
|
|
User1, User)
|
|
;
|
|
{ Command = restart },
|
|
{ reverse_and_append(Skipped, [Question | Questions],
|
|
RestartedQuestions) },
|
|
query_user(RestartedQuestions, Response, User1, User)
|
|
;
|
|
{ Command = browse_arg(ArgNum) },
|
|
{ edt_node_trace_atom(Question, TraceAtom) },
|
|
browse_atom_argument(TraceAtom, ArgNum, MaybeMark,
|
|
User1, User2),
|
|
(
|
|
{ MaybeMark = no },
|
|
query_user_2([Question | Questions], Skipped, Response,
|
|
User2, User)
|
|
;
|
|
{ MaybeMark = yes(Mark) },
|
|
{ Which = chosen_head_vars_presentation },
|
|
{
|
|
Which = only_user_headvars,
|
|
ArgPos = user_head_var(ArgNum)
|
|
;
|
|
Which = all_headvars,
|
|
ArgPos = any_head_var(ArgNum)
|
|
},
|
|
{ Answer = suspicious_subterm(Node, ArgPos, Mark) },
|
|
{ Response = user_answer(Question, Answer) },
|
|
{ User = User2 }
|
|
)
|
|
;
|
|
{ Command = browse_io(ActionNum) },
|
|
{ edt_node_io_actions(Question, IoActions) },
|
|
% We don't have code yet to trace a marked I/O action.
|
|
browse_chosen_io_action(IoActions, ActionNum, _MaybeMark,
|
|
User1, User2),
|
|
query_user_2([Question | Questions], Skipped, Response,
|
|
User2, User)
|
|
;
|
|
{ Command = pd },
|
|
{ Response = exit_diagnosis(Node) },
|
|
{ User = User1 }
|
|
;
|
|
{ Command = abort },
|
|
{ Response = abort_diagnosis },
|
|
{ User = User1 }
|
|
;
|
|
{ Command = help },
|
|
user_help_message(User1),
|
|
query_user_2([Question | Questions], Skipped, Response,
|
|
User1, User)
|
|
;
|
|
{ Command = illegal_command },
|
|
io__write_string("Unknown command, 'h' for help.\n"),
|
|
query_user_2([Question | Questions], Skipped, Response,
|
|
User1, User)
|
|
).
|
|
|
|
:- pred decl_question_prompt(decl_question(T), string).
|
|
:- mode decl_question_prompt(in, out) is det.
|
|
|
|
decl_question_prompt(wrong_answer(_, _), "Valid? ").
|
|
decl_question_prompt(missing_answer(_, _, _), "Complete? ").
|
|
decl_question_prompt(unexpected_exception(_, _, _), "Expected? ").
|
|
|
|
:- pred edt_node_trace_atom(decl_question(T)::in, trace_atom::out) is det.
|
|
|
|
edt_node_trace_atom(wrong_answer(_, FinalDeclAtom),
|
|
FinalDeclAtom ^ final_atom).
|
|
edt_node_trace_atom(missing_answer(_, InitDeclAtom, _),
|
|
InitDeclAtom ^ init_atom).
|
|
edt_node_trace_atom(unexpected_exception(_, InitDeclAtom, _),
|
|
InitDeclAtom ^ init_atom).
|
|
|
|
:- pred edt_node_io_actions(decl_question(T)::in, list(io_action)::out) is det.
|
|
|
|
edt_node_io_actions(wrong_answer(_, FinalDeclAtom),
|
|
FinalDeclAtom ^ final_io_actions).
|
|
edt_node_io_actions(missing_answer(_, _, _), []).
|
|
edt_node_io_actions(unexpected_exception(_, _, _), []).
|
|
|
|
:- pred decl_bug_trace_atom(decl_bug::in, trace_atom::out) is det.
|
|
|
|
decl_bug_trace_atom(e_bug(incorrect_contour(FinalDeclAtom, _, _)),
|
|
FinalDeclAtom ^ final_atom).
|
|
decl_bug_trace_atom(e_bug(partially_uncovered_atom(InitDeclAtom, _)),
|
|
InitDeclAtom ^ init_atom).
|
|
decl_bug_trace_atom(e_bug(unhandled_exception(InitDeclAtom, _, _)),
|
|
InitDeclAtom ^ init_atom).
|
|
decl_bug_trace_atom(i_bug(inadmissible_call(_, _, InitDeclAtom, _)),
|
|
InitDeclAtom ^ init_atom).
|
|
|
|
:- pred decl_bug_io_actions(decl_bug::in, list(io_action)::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(_, _)), []).
|
|
decl_bug_io_actions(e_bug(unhandled_exception(_, _, _)), []).
|
|
decl_bug_io_actions(i_bug(inadmissible_call(_, _, _, _)), []).
|
|
|
|
:- pred browse_chosen_io_action(list(io_action)::in, int::in,
|
|
maybe(term_path)::out, user_state::in, user_state::out,
|
|
io__state::di, io__state::uo) is cc_multi.
|
|
|
|
browse_chosen_io_action(IoActions, ActionNum, MaybeMark, User0, User) -->
|
|
( { list__index1(IoActions, ActionNum, IoAction) } ->
|
|
browse_io_action(IoAction, MaybeMark, User0, User)
|
|
;
|
|
io__write_string("No such IO action.\n"),
|
|
{ MaybeMark = no },
|
|
{ User = User0 }
|
|
).
|
|
|
|
:- pred browse_io_action(io_action::in, maybe(term_path)::out,
|
|
user_state::in, user_state::out, io__state::di, io__state::uo)
|
|
is cc_multi.
|
|
|
|
browse_io_action(IoAction, MaybeMark, User0, User) -->
|
|
{ io_action_to_synthetic_term(IoAction, ProcName, Args, IsFunc) },
|
|
browse_synthetic(ProcName, Args, IsFunc, User0 ^ instr, User0 ^ outstr,
|
|
MaybeDirs, User0 ^ browser, Browser),
|
|
{ maybe_convert_dirs_to_path(MaybeDirs, MaybeMark) },
|
|
{ User = User0 ^ browser := Browser }.
|
|
|
|
:- pred browse_decl_bug_arg(decl_bug::in, int::in,
|
|
user_state::in, user_state::out, io__state::di, io__state::uo)
|
|
is cc_multi.
|
|
|
|
browse_decl_bug_arg(Bug, ArgNum, User0, User) -->
|
|
{ decl_bug_trace_atom(Bug, Atom) },
|
|
browse_atom_argument(Atom, ArgNum, _, User0, User).
|
|
|
|
:- pred browse_atom_argument(trace_atom::in, int::in, maybe(term_path)::out,
|
|
user_state::in, user_state::out, io__state::di, io__state::uo)
|
|
is cc_multi.
|
|
|
|
browse_atom_argument(Atom, ArgNum, MaybeMark, User0, User) -->
|
|
{ Atom = atom(_, _, Args0) },
|
|
{ maybe_filter_headvars(chosen_head_vars_presentation, Args0, Args) },
|
|
(
|
|
{ list__index1(Args, ArgNum, ArgInfo) },
|
|
{ ArgInfo = arg_info(_, _, MaybeArg) },
|
|
{ MaybeArg = yes(Arg) }
|
|
->
|
|
browse(univ_value(Arg), User0 ^ instr, User0 ^ outstr,
|
|
MaybeDirs, User0 ^ browser, Browser),
|
|
{ maybe_convert_dirs_to_path(MaybeDirs, MaybeMark) },
|
|
{ User = User0 ^ browser := Browser }
|
|
;
|
|
io__write_string(User ^ outstr, "Invalid argument number\n"),
|
|
{ MaybeMark = no },
|
|
{ User = User0 }
|
|
).
|
|
|
|
:- pred maybe_convert_dirs_to_path(maybe(list(dir)), maybe(term_path)).
|
|
:- mode maybe_convert_dirs_to_path(in, 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), list(T), list(T)).
|
|
:- mode reverse_and_append(in, in, 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
|
|
---> yes % The node is correct.
|
|
; no % The node is incorrect.
|
|
; inadmissible % The node is inadmissible.
|
|
; skip % The user has no answer.
|
|
; restart % Ask the skipped questions again.
|
|
; browse_arg(int) % Browse the nth argument before
|
|
% answering.
|
|
; browse_io(int) % Browse the nth IO action before
|
|
% answering.
|
|
; pd % Commence procedural debugging from
|
|
% this point.
|
|
; abort % Abort this diagnosis session.
|
|
; help % Request help before answering.
|
|
; illegal_command. % None of the above.
|
|
|
|
:- pred user_help_message(user_state, io__state, io__state).
|
|
:- mode user_help_message(in, di, uo) is det.
|
|
|
|
user_help_message(User) -->
|
|
io__write_strings(User ^ outstr, [
|
|
"According to the intended interpretation of the program,",
|
|
" answer one of:\n",
|
|
"\ty\tyes\t\tthe node is correct\n",
|
|
"\tn\tno\t\tthe node is incorrect\n",
|
|
% "\ti\tinadmissible\tthe input arguments are out of range\n",
|
|
"\ts\tskip\t\tskip this question\n",
|
|
"\tr\trestart\t\task the skipped questions again\n",
|
|
"\tb <n>\tbrowse <n>\tbrowse the nth argument of the atom\n",
|
|
"\t\tpd\t\tcommence procedural debugging from this point\n",
|
|
"\ta\tabort\t\t",
|
|
"abort this diagnosis session and return to mdb\n",
|
|
"\th, ?\thelp\t\tthis help message\n"
|
|
]).
|
|
|
|
:- pred user_confirm_bug_help(user_state, io__state, io__state).
|
|
:- mode user_confirm_bug_help(in, di, uo) is det.
|
|
|
|
user_confirm_bug_help(User) -->
|
|
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",
|
|
"\ta\tabort\t\t",
|
|
"abort this diagnosis session and return to mdb\n",
|
|
"\th, ?\thelp\t\tthis help message\n"
|
|
]).
|
|
|
|
:- pred get_command(string, user_command, user_state, user_state,
|
|
io__state, io__state).
|
|
:- mode get_command(in, out, in, out, di, uo) is det.
|
|
|
|
get_command(Prompt, Command, User, User) -->
|
|
util__trace_getline(Prompt, Result, User ^ instr, User ^ outstr),
|
|
(
|
|
{ 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
|
|
}
|
|
;
|
|
{ Result = error(Error) },
|
|
{ io__error_message(Error, Msg) },
|
|
io__write_string(User ^ outstr, Msg),
|
|
io__nl(User ^ outstr),
|
|
{ Command = abort }
|
|
;
|
|
{ Result = eof },
|
|
{ Command = abort }
|
|
).
|
|
|
|
:- pred cmd_handler(string, func(list(string)) = user_command).
|
|
:- mode cmd_handler(in, 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("in", one_word_cmd(inadmissible)).
|
|
cmd_handler("inadmissible", one_word_cmd(inadmissible)).
|
|
cmd_handler("io", browse_io_cmd).
|
|
cmd_handler("s", one_word_cmd(skip)).
|
|
cmd_handler("skip", one_word_cmd(skip)).
|
|
cmd_handler("r", one_word_cmd(restart)).
|
|
cmd_handler("restart", one_word_cmd(restart)).
|
|
cmd_handler("pd", one_word_cmd(pd)).
|
|
cmd_handler("a", one_word_cmd(abort)).
|
|
cmd_handler("abort", one_word_cmd(abort)).
|
|
cmd_handler("?", one_word_cmd(help)).
|
|
cmd_handler("h", one_word_cmd(help)).
|
|
cmd_handler("help", one_word_cmd(help)).
|
|
cmd_handler("b", browse_arg_cmd).
|
|
cmd_handler("browse", browse_arg_cmd).
|
|
|
|
:- 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([Arg]) = browse_arg(ArgNum) :-
|
|
string__to_int(Arg, ArgNum).
|
|
|
|
:- func browse_io_cmd(list(string)::in) = (user_command::out) is semidet.
|
|
|
|
browse_io_cmd([Arg]) = browse_io(ArgNum) :-
|
|
string__to_int(Arg, ArgNum).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
user_confirm_bug(Bug, Response, User0, User) -->
|
|
write_decl_bug(Bug, User0),
|
|
get_command("Is this a bug? ", Command, User0, User1),
|
|
(
|
|
{ Command = yes }
|
|
->
|
|
{ Response = confirm_bug },
|
|
{ User = User1 }
|
|
;
|
|
{ Command = no }
|
|
->
|
|
{ Response = overrule_bug },
|
|
{ User = User1 }
|
|
;
|
|
{ Command = abort }
|
|
->
|
|
{ Response = abort_diagnosis },
|
|
{ User = User1 }
|
|
;
|
|
{ Command = browse_arg(ArgNum) }
|
|
->
|
|
browse_decl_bug_arg(Bug, ArgNum, User1, User2),
|
|
user_confirm_bug(Bug, Response, User2, User)
|
|
;
|
|
{ Command = browse_io(ActionNum) }
|
|
->
|
|
{ decl_bug_io_actions(Bug, IoActions) },
|
|
browse_chosen_io_action(IoActions, ActionNum, _MaybeMark,
|
|
User1, User2),
|
|
user_confirm_bug(Bug, Response, User2, User)
|
|
;
|
|
user_confirm_bug_help(User1),
|
|
user_confirm_bug(Bug, Response, User1, User)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Display the node in user readable form on the current
|
|
% output stream.
|
|
%
|
|
:- pred write_decl_question(decl_question(T)::in, user_state::in,
|
|
io__state::di, io__state::uo) is cc_multi.
|
|
|
|
write_decl_question(wrong_answer(_, Atom), User) -->
|
|
write_decl_final_atom(User, "", Atom).
|
|
|
|
write_decl_question(missing_answer(_, Call, Solns), User) -->
|
|
write_decl_init_atom(User, "Call ", Call),
|
|
(
|
|
{ Solns = [] }
|
|
->
|
|
io__write_string(User ^ outstr, "No solutions.\n")
|
|
;
|
|
io__write_string(User ^ outstr, "Solutions:\n"),
|
|
list__foldl(write_decl_final_atom(User, "\t"), Solns)
|
|
).
|
|
|
|
write_decl_question(unexpected_exception(_, Call, Exception), User) -->
|
|
write_decl_init_atom(User, "Call ", Call),
|
|
io__write_string(User ^ outstr, "Throws "),
|
|
io__write(User ^ outstr, include_details_cc, univ_value(Exception)),
|
|
io__nl(User ^ outstr).
|
|
|
|
:- pred write_decl_bug(decl_bug::in, user_state::in,
|
|
io__state::di, io__state::uo) is cc_multi.
|
|
|
|
write_decl_bug(e_bug(EBug), User) -->
|
|
(
|
|
{ EBug = incorrect_contour(Atom, _, _) },
|
|
io__write_string(User ^ outstr, "Found incorrect contour:\n"),
|
|
write_decl_final_atom(User, "", Atom)
|
|
;
|
|
{ EBug = partially_uncovered_atom(Atom, _) },
|
|
io__write_string(User ^ outstr,
|
|
"Found partially uncovered atom:\n"),
|
|
write_decl_init_atom(User, "", Atom)
|
|
;
|
|
{ EBug = unhandled_exception(Atom, Exception, _) },
|
|
io__write_string(User ^ outstr, "Found unhandled exception:\n"),
|
|
write_decl_init_atom(User, "", Atom),
|
|
io__write(User ^ outstr, include_details_cc,
|
|
univ_value(Exception)),
|
|
io__nl(User ^ outstr)
|
|
).
|
|
|
|
write_decl_bug(i_bug(IBug), User) -->
|
|
{ IBug = inadmissible_call(Parent, _, Call, _) },
|
|
io__write_string(User ^ outstr, "Found inadmissible call:\n"),
|
|
write_decl_atom(User, "Parent ", init(Parent)),
|
|
write_decl_atom(User, "Call ", init(Call)).
|
|
|
|
:- pred write_decl_init_atom(user_state::in, string::in, init_decl_atom::in,
|
|
io__state::di, io__state::uo) is cc_multi.
|
|
|
|
write_decl_init_atom(User, Indent, InitAtom) -->
|
|
write_decl_atom(User, Indent, init(InitAtom)).
|
|
|
|
:- pred write_decl_final_atom(user_state::in, string::in, final_decl_atom::in,
|
|
io__state::di, io__state::uo) is cc_multi.
|
|
|
|
write_decl_final_atom(User, Indent, FinalAtom) -->
|
|
write_decl_atom(User, Indent, final(FinalAtom)).
|
|
|
|
:- pred write_decl_atom(user_state::in, string::in, some_decl_atom::in,
|
|
io__state::di, io__state::uo) is cc_multi.
|
|
|
|
write_decl_atom(User, Indent, DeclAtom) -->
|
|
io__write_string(User ^ outstr, Indent),
|
|
%
|
|
% Check whether the atom is likely to fit on one line.
|
|
% If it's not, then call the browser to print the term
|
|
% to a limited depth. If it is, then we prefer to print
|
|
% it out directly so that all arguments are put on the
|
|
% same line.
|
|
%
|
|
{ unravel_decl_atom(DeclAtom, TraceAtom, IoActions) },
|
|
{ Which = chosen_head_vars_presentation },
|
|
{ check_trace_atom_size(Indent, Which, TraceAtom, RemSize) },
|
|
(
|
|
{ RemSize > 0 },
|
|
{ IoActions = [] }
|
|
->
|
|
write_decl_atom_direct(User ^ outstr, TraceAtom, Which)
|
|
;
|
|
write_decl_atom_limited(User, DeclAtom, Which)
|
|
).
|
|
|
|
:- pred check_trace_atom_size(string::in, which_headvars::in, trace_atom::in,
|
|
int::out) is cc_multi.
|
|
|
|
check_trace_atom_size(Indent, Which, atom(_, Functor, Args), RemSize) :-
|
|
trace_atom_size_limit(RemSize0),
|
|
string__length(Indent, I),
|
|
string__length(Functor, F),
|
|
P = 2, % parentheses
|
|
RemSize1 = RemSize0 - I - F - P,
|
|
size_left_after_args(Args, Which, RemSize1, RemSize).
|
|
|
|
:- pred size_left_after_args(list(trace_atom_arg)::in, which_headvars::in,
|
|
int::in, int::out) is cc_multi.
|
|
|
|
size_left_after_args([], _) -->
|
|
[].
|
|
size_left_after_args([arg_info(UserVis, _, MaybeUniv) | Args], Which) -->
|
|
(
|
|
{ MaybeUniv = yes(Univ) },
|
|
(
|
|
{ Which = only_user_headvars },
|
|
{ UserVis = no }
|
|
->
|
|
% This argument won't be printed.
|
|
[]
|
|
;
|
|
term_size_left_from_max(Univ)
|
|
)
|
|
;
|
|
{ MaybeUniv = no }
|
|
),
|
|
size_left_after_args(Args, Which).
|
|
|
|
:- pred trace_atom_size_limit(int).
|
|
:- mode trace_atom_size_limit(out) is det.
|
|
|
|
trace_atom_size_limit(79).
|
|
|
|
:- pred write_decl_atom_limited(user_state::in, some_decl_atom::in,
|
|
which_headvars::in, io__state::di, io__state::uo) is cc_multi.
|
|
|
|
write_decl_atom_limited(User, DeclAtom, Which) -->
|
|
{ unravel_decl_atom(DeclAtom, TraceAtom, IoActions) },
|
|
{ TraceAtom = atom(PredOrFunc, Functor, Args0) },
|
|
write_decl_atom_category(User ^ outstr, PredOrFunc),
|
|
io__write_string(User ^ outstr, Functor),
|
|
io__nl(User ^ outstr),
|
|
{ maybe_filter_headvars(Which, Args0, Args) },
|
|
list__foldl(print_decl_atom_arg(User), Args),
|
|
{ list__length(IoActions, NumIoActions) },
|
|
( { NumIoActions = 0 } ->
|
|
[]
|
|
;
|
|
( { NumIoActions = 1 } ->
|
|
io__write_string(User ^ outstr, "1 io action:")
|
|
;
|
|
io__write_int(User ^ outstr, NumIoActions),
|
|
io__write_string(User ^ outstr, " io actions:")
|
|
),
|
|
% XXX the 6 should be configurable
|
|
( { NumIoActions < 6 } ->
|
|
io__nl(User ^ outstr),
|
|
list__foldl(print_io_action(User), IoActions)
|
|
;
|
|
io__write_string(User ^ outstr, " too many to show"),
|
|
io__nl(User ^ outstr)
|
|
)
|
|
).
|
|
|
|
:- pred print_io_action(user_state::in, io_action::in,
|
|
io__state::di, io__state::uo) is cc_multi.
|
|
|
|
print_io_action(User, IoAction) -->
|
|
{ io_action_to_synthetic_term(IoAction, ProcName, Args, IsFunc) },
|
|
browse__print_synthetic(ProcName, Args, IsFunc, User ^ outstr,
|
|
print_all, User ^ browser).
|
|
|
|
:- pred write_decl_atom_category(io__output_stream::in, pred_or_func::in,
|
|
io__state::di, io__state::uo) is det.
|
|
|
|
write_decl_atom_category(OutStr, predicate) -->
|
|
io__write_string(OutStr, "pred ").
|
|
write_decl_atom_category(OutStr, function) -->
|
|
io__write_string(OutStr, "func ").
|
|
|
|
:- pred print_decl_atom_arg(user_state::in, trace_atom_arg::in,
|
|
io__state::di, io__state::uo) is cc_multi.
|
|
|
|
print_decl_atom_arg(User, arg_info(_, _, MaybeArg)) -->
|
|
(
|
|
{ MaybeArg = yes(Arg) },
|
|
io__write_string(User ^ outstr, "\t"),
|
|
browse__print(univ_value(Arg), User ^ outstr, print_all,
|
|
User ^ browser)
|
|
;
|
|
{ MaybeArg = no },
|
|
io__write_string(User ^ outstr, "\t_\n")
|
|
).
|
|
|
|
:- pred write_decl_atom_direct(io__output_stream::in, trace_atom::in,
|
|
which_headvars::in, io__state::di, io__state::uo) is cc_multi.
|
|
|
|
write_decl_atom_direct(OutStr, atom(PredOrFunc, Functor, Args0), Which) -->
|
|
io__write_string(OutStr, Functor),
|
|
{ maybe_filter_headvars(Which, Args0, Args) },
|
|
(
|
|
{ Args = [] }
|
|
;
|
|
{ Args = [FirstArg | ArgsRest] },
|
|
io__write_char(OutStr, '('),
|
|
(
|
|
{ PredOrFunc = predicate },
|
|
io__write_list(OutStr, Args, ", ",
|
|
write_decl_atom_arg(OutStr)),
|
|
io__write_char(OutStr, ')')
|
|
;
|
|
{ PredOrFunc = function },
|
|
{ get_inputs_and_result(FirstArg, ArgsRest, Inputs,
|
|
Result) },
|
|
io__write_list(OutStr, Inputs, ", ",
|
|
write_decl_atom_arg(OutStr)),
|
|
io__write_string(OutStr, ") = "),
|
|
write_decl_atom_arg(OutStr, Result)
|
|
)
|
|
),
|
|
io__nl(OutStr).
|
|
|
|
:- pred write_decl_atom_arg(io__output_stream, trace_atom_arg,
|
|
io__state, io__state).
|
|
:- mode write_decl_atom_arg(in, in, di, uo) is cc_multi.
|
|
|
|
write_decl_atom_arg(OutStr, arg_info(_, _, MaybeArg)) -->
|
|
(
|
|
{ MaybeArg = yes(Arg) },
|
|
io__write(OutStr, include_details_cc, univ_value(Arg))
|
|
;
|
|
{ MaybeArg = no },
|
|
io__write_char(OutStr, '_')
|
|
).
|
|
|
|
:- pred get_inputs_and_result(T, list(T), list(T), T).
|
|
:- mode get_inputs_and_result(in, in, out, out) is det.
|
|
|
|
get_inputs_and_result(A, [], [], A).
|
|
get_inputs_and_result(A1, [A2 | As], [A1 | Inputs0], Result) :-
|
|
get_inputs_and_result(A2, As, Inputs0, Result).
|
|
|
|
%-----------------------------------------------------------------------------%
|