mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2025-12-08 10:23:03 +00:00
Code Issues Projects Releases Wiki Activity
Files
026148c907be6be23f45cf69862d1fcfc2b7e947
mercury/browser/browse.m
Mark Brown d465fa53cb Update the COPYING.LIB file and references to it. 
Discussion of these changes can be found on the Mercury developers
mailing list archives from June 2018.

COPYING.LIB:
    Add a special linking exception to the LGPL.

*:
    Update references to COPYING.LIB.

    Clean up some minor errors that have accumulated in copyright
    messages.
2018-06-09 17:43:12 +10:00

1901 lines
67 KiB
Mathematica
Raw Blame History

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 1998-2007, 2009-2010 The University of Melbourne.
% Copyright (C) 2017-2018 The Mercury team.
% This file is distributed under the terms specified in COPYING.LIB.
%---------------------------------------------------------------------------%
%
% File: browse.m.
% Author: aet.
% Stability: low.
%
% Implements a very simple term browser.
% There are a number of features that haven't been incorporated:
%
% - Scripting language that allows precise control over
% how types are printed.
% - User preferences, which use the scripting language
% to allow user control beyond the provided defaults.
% - Node expansion and contraction in the style of Windows Explorer.
%
%---------------------------------------------------------------------------%
:- module mdb.browse.
:- interface.
:- import_module mdb.browser_info.
:- import_module mdb.browser_term.
:- import_module bool.
:- import_module io.
:- import_module list.
:- import_module maybe.
:- import_module univ.
%---------------------------------------------------------------------------%
% The non-interactive term browser. The caller type should be either
% `print' or `print_all'. The default portray format for that
% caller type is used.
%
:- pred print_browser_term(browser_term::in,
io.output_stream::in, browse_caller_type::in,
browser_persistent_state::in, io::di, io::uo) is cc_multi.
% As above, except that the supplied format will override the default.
%
:- pred print_browser_term_format(browser_term::in,
io.output_stream::in, browse_caller_type::in, portray_format::in,
browser_persistent_state::in, io::di, io::uo) is cc_multi.
%---------------------------------------------------------------------------%
% The interactive term browser. The caller type will be `browse', and
% the default format for the `browse' caller type will be used. Since
% this predicate is exported to be used by C code, no browser term
% mode function can be supplied.
%
:- pred browse_browser_term_no_modes(browser_term::in,
io.input_stream::in, io.output_stream::in,
maybe_track_subterm(list(down_dir))::out,
browser_persistent_state::in, browser_persistent_state::out,
io::di, io::uo) is cc_multi.
% The interactive term browser. The caller type will be `browse' and
% the default format for the `browse' caller type will be used.
%
:- pred browse_browser_term(browser_term::in,
io.input_stream::in, io.output_stream::in,
maybe(browser_mode_func)::in, maybe_track_subterm(list(down_dir))::out,
browser_persistent_state::in, browser_persistent_state::out,
io::di, io::uo) is cc_multi.
% As above, except that the supplied format will override the default.
% Again, this is exported to C code, so the browser term mode function
% can't be supplied.
%
:- pred browse_browser_term_format_no_modes(browser_term::in,
io.input_stream::in, io.output_stream::in, portray_format::in,
browser_persistent_state::in, browser_persistent_state::out,
io::di, io::uo) is cc_multi.
% As above, except that the supplied format will override the default.
%
:- pred browse_browser_term_format(browser_term::in,
io.input_stream::in, io.output_stream::in, portray_format::in,
maybe(browser_mode_func)::in,
browser_persistent_state::in, browser_persistent_state::out,
io::di, io::uo) is cc_multi.
% The browser interface for the external debugger. The caller type
% will be `browse', and the default format will be used.
% This version is exported for use in C code, so no browser term mode
% function can be supplied.
%
:- pred browse_external_no_modes(T::in, io.input_stream::in,
io.output_stream::in,
browser_persistent_state::in, browser_persistent_state::out,
io::di, io::uo) is cc_multi.
% The browser interface for the external debugger. The caller type
% will be `browse', and the default format will be used.
%
:- pred browse_external(T::in, io.input_stream::in,
io.output_stream::in, maybe(browser_mode_func)::in,
browser_persistent_state::in, browser_persistent_state::out,
io::di, io::uo) is cc_multi.
% Estimate the total term size, in characters, We count the number of
% characters in the functor, plus two characters for each argument:
% "(" and ")" for the first, and ", " for each of the rest, plus the
% sizes of the arguments themselves. This is only approximate since it
% doesn't take into account all the special cases such as operators.
%
% This predicate returns not the estimated total term size,
% but the difference between the given maximum size the caller
% is interested in and the estimated total term size.
% This difference is positive if the term is smaller than the
% maximum and negative if it is bigger. If the difference is
% negative, term_size_left_from_max will return a negative difference
% but the value will usually not be accurate, since in such cases
% by definition the caller is not interested in the accurate value.
%
:- pred term_size_left_from_max(univ::in, int::in, int::out) is cc_multi.
:- pred browser_term_size_left_from_max(browser_term::in,
int::in, int::out) is cc_multi.
%---------------------------------------------------------------------------%
% save_term_to_file(FileName, Format, BrowserTerm, Out, !IO):
%
% Save BrowserTerm to the file FileName. If there is an error,
% print an error message to Out.
%
% The format of the saved term can be influenced by the Format
% argument, but how this works is not specified.
%
:- pred save_term_to_file(string::in, string::in, browser_term::in,
io.output_stream::in, io::di, io::uo) is cc_multi.
% save_term_to_file_xml(FileName, BrowserTerm, Out, !IO):
%
% Save BrowserTerm to FileName as an XML document. If there is an error,
% print an error message to Out.
%
:- pred save_term_to_file_xml(string::in, browser_term::in,
io.output_stream::in, io::di, io::uo) is cc_multi.
% Dump the term as an XML file and launch the XML browser specified
% by the xml_browser_cmd field in the browser_persistent_state.
%
:- pred save_and_browse_browser_term_xml(browser_term::in,
io.output_stream::in, io.output_stream::in,
browser_persistent_state::in, io::di, io::uo) is cc_multi.
% Save BrowserTerm in an HTML file and launch the web browser specified
% by the web_browser_cmd field in the browser_persistent_state.
%
:- pred save_and_browse_browser_term_web(browser_term::in,
io.output_stream::in, io.output_stream::in,
browser_persistent_state::in, io::di, io::uo) is cc_multi.
% Exported for term_to_html.
%
:- pred browser_term_to_html_flat_string(browser_term::in, string::out,
bool::out, io::di, io::uo) is cc_multi.
%---------------------------------------------------------------------------%
% Remove "/dir/../" sequences from a list of directories to yield
% a form that lacks ".." entries.
% If there are more ".." entries than normal entries, we return
% the empty list.
%
:- pred simplify_dirs(list(up_down_dir)::in, list(down_dir)::out) is det.
% True if the given string can be used to cd to the return value of a
% function.
%
:- pred string_is_return_value_alias(string::in) is semidet.
% For use in representing unbound head variables in the "print goal"
% commands in the debugger.
:- type unbound
---> '_'.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module mdb.parse.
:- import_module mdb.frame.
:- import_module mdb.sized_pretty.
:- import_module mdb.term_to_html.
:- import_module deconstruct.
:- import_module dir.
:- import_module getopt.
:- import_module int.
:- import_module map.
:- import_module pair.
:- import_module pretty_printer.
:- import_module stream.
:- import_module stream.string_writer.
:- import_module string.
:- import_module string.builder.
:- import_module term_io.
:- import_module term_to_xml.
:- import_module type_desc.
%---------------------------------------------------------------------------%
%
% We export these predicates to C for use by the tracer:
% they are used in trace/mercury_trace_browse.c.
%
:- pragma foreign_export("C",
browse_browser_term_no_modes(in, in, in, out, in, out, di, uo),
"ML_BROWSE_browse_browser_term").
:- pragma foreign_export("C",
browse_browser_term_format_no_modes(in, in, in, in, in, out, di, uo),
"ML_BROWSE_browse_browser_term_format").
:- pragma foreign_export("C",
browse_external_no_modes(in, in, in, in, out, di, uo),
"ML_BROWSE_browse_external").
:- pragma foreign_export("C", print_browser_term(in, in, in, in, di, uo),
"ML_BROWSE_print_browser_term").
:- pragma foreign_export("C",
print_browser_term_format(in, in, in, in, in, di, uo),
"ML_BROWSE_print_browser_term_format").
:- pragma foreign_export("C", save_term_to_file(in, in, in, in, di, uo),
"ML_BROWSE_save_term_to_file").
:- pragma foreign_export("C", save_term_to_file_xml(in, in, in, di, uo),
"ML_BROWSE_save_term_to_file_xml").
:- pragma foreign_export("C",
save_and_browse_browser_term_xml(in, in, in, in, di, uo),
"ML_BROWSE_browse_term_xml").
:- pragma foreign_export("C",
save_and_browse_browser_term_web(in, in, in, in, di, uo),
"ML_BROWSE_browse_term_web").
%---------------------------------------------------------------------------%
%
% Non-interactive display.
%
print_browser_term(Term, OutputStream, Caller, State, !IO) :-
print_common(Term, OutputStream, Caller, no, State, !IO).
print_browser_term_format(Term, OutputStream, Caller, Format, State, !IO):-
print_common(Term, OutputStream, Caller, yes(Format), State, !IO).
:- pred print_common(browser_term::in, io.output_stream::in,
browse_caller_type::in, maybe(portray_format)::in,
browser_persistent_state::in, io::di, io::uo) is cc_multi.
print_common(BrowserTerm, OutputStream, Caller, MaybeFormat, State, !IO):-
Info = browser_info.init(BrowserTerm, Caller, MaybeFormat, no, State),
io.set_output_stream(OutputStream, OldStream, !IO),
browser_info.get_format(Info, Caller, MaybeFormat, Format),
% For plain terms, we assume that the variable name has been printed
% on the first part of the line. If the format is something other than
% `flat', then we need to start on the next line.
( if
BrowserTerm = plain_term(_),
Format \= flat
then
io.nl(!IO)
else
true
),
portray(debugger_internal, Caller, no, Info, !IO),
io.set_output_stream(OldStream, _, !IO).
%---------------------------------------------------------------------------%
%
% Interactive display.
%
browse_browser_term_no_modes(Term, InputStream, OutputStream,
MaybeTrack, !State, !IO) :-
browse_common(debugger_internal, Term, InputStream, OutputStream,
no, no, MaybeTrack, !State, !IO).
browse_browser_term(Term, InputStream, OutputStream, MaybeModeFunc,
MaybeTrack, !State, !IO) :-
browse_common(debugger_internal, Term, InputStream, OutputStream,
no, MaybeModeFunc, MaybeTrack, !State, !IO).
browse_browser_term_format_no_modes(Term, InputStream, OutputStream,
Format, !State, !IO) :-
browse_common(debugger_internal, Term, InputStream, OutputStream,
yes(Format), no, _, !State, !IO).
browse_browser_term_format(Term, InputStream, OutputStream,
Format, MaybeModeFunc, !State, !IO) :-
browse_common(debugger_internal, Term, InputStream, OutputStream,
yes(Format), MaybeModeFunc, _, !State, !IO).
browse_external_no_modes(Term, InputStream, OutputStream, !State, !IO) :-
browse_common(debugger_external, plain_term(univ(Term)),
InputStream, OutputStream, no, no, _, !State, !IO).
browse_external(Term, InputStream, OutputStream, MaybeModeFunc, !State, !IO) :-
browse_common(debugger_external, plain_term(univ(Term)),
InputStream, OutputStream, no, MaybeModeFunc, _, !State, !IO).
:- pred browse_common(debugger::in, browser_term::in, io.input_stream::in,
io.output_stream::in, maybe(portray_format)::in,
maybe(browser_mode_func)::in, maybe_track_subterm(list(down_dir))::out,
browser_persistent_state::in, browser_persistent_state::out,
io::di, io::uo) is cc_multi.
browse_common(Debugger, Object, InputStream, OutputStream, MaybeFormat,
MaybeModeFunc, MaybeTrack, !State, !IO) :-
Info0 = browser_info.init(Object, browse, MaybeFormat, MaybeModeFunc,
!.State),
io.set_input_stream(InputStream, OldInputStream, !IO),
io.set_output_stream(OutputStream, OldOutputStream, !IO),
browse_main_loop(Debugger, Info0, Info, !IO),
io.set_input_stream(OldInputStream, _, !IO),
io.set_output_stream(OldOutputStream, _, !IO),
MaybeTrack = Info ^ bri_maybe_track,
!:State = Info ^ bri_state.
:- pred browse_main_loop(debugger::in, browser_info::in, browser_info::out,
io::di, io::uo) is cc_multi.
browse_main_loop(Debugger, !Info, !IO) :-
(
Debugger = debugger_internal,
parse.read_command(prompt, Command, !IO)
;
Debugger = debugger_external,
parse.read_command_external(Command, !IO)
),
run_command(Debugger, Command, Quit, !Info, !IO),
(
Quit = yes,
% write_string_debugger(Debugger, "quitting...\n", !IO)
(
Debugger = debugger_external,
send_term_to_socket(browser_quit, !IO)
;
Debugger = debugger_internal
)
;
Quit = no,
browse_main_loop(Debugger, !Info, !IO)
).
:- func prompt = string.
prompt = "browser> ".
:- pred run_command(debugger::in, command::in, bool::out,
browser_info::in, browser_info::out, io::di, io::uo) is cc_multi.
run_command(Debugger, Command, Quit, !Info, !IO) :-
% Please keep the code implementing commands in the same order
% as the definition of the command type.
% XXX The commands `set', `ls' and `print' should allow the format
% to be specified by an option. In each case we instead pass `no' to
% the respective handler.
(
Command = cmd_print(PrintOption, MaybePath),
do_portray(Debugger, browse, PrintOption, !.Info, MaybePath, !IO),
Quit = no
;
Command = cmd_display,
write_string_debugger(Debugger, "command not yet implemented\n", !IO),
Quit = no
;
Command = cmd_write,
write_string_debugger(Debugger, "command not yet implemented\n", !IO),
Quit = no
;
Command = cmd_memory_addr(MaybePath),
do_print_memory_addr(Debugger, !.Info, MaybePath, !IO),
Quit = no
;
Command = cmd_cd_no_path,
set_path(root_rel([]), !Info),
Quit = no
;
Command = cmd_cd_path(Path),
change_dir(!.Info ^ bri_dirs, Path, NewPwd),
deref_subterm(!.Info ^ bri_term, NewPwd, Result),
(
Result = deref_result(_),
!Info ^ bri_dirs := NewPwd
;
Result = deref_error(OKPath, ErrorDir),
report_deref_error(Debugger, OKPath, ErrorDir, !IO)
),
Quit = no
;
Command = cmd_pwd,
write_down_path(Debugger, !.Info ^ bri_dirs, !IO),
nl_debugger(Debugger, !IO),
Quit = no
;
Command = cmd_track(HowTrack, ShouldAssertInvalid, MaybePath),
(
MaybePath = yes(Path),
change_dir(!.Info ^ bri_dirs, Path, NewPwd),
deref_subterm(!.Info ^ bri_term, NewPwd, SubResult),
(
SubResult = deref_result(_),
!Info ^ bri_maybe_track :=
track(HowTrack, ShouldAssertInvalid, NewPwd),
Quit = yes
;
SubResult = deref_error(_, _),
write_string_debugger(Debugger,
"error: cannot track subterm\n", !IO),
Quit = no
)
;
MaybePath = no,
!Info ^ bri_maybe_track :=
track(HowTrack, ShouldAssertInvalid, !.Info ^ bri_dirs),
Quit = yes
)
;
Command = cmd_mode_query(Path),
change_dir(!.Info ^ bri_dirs, Path, NewPwd),
MaybeModeFunc = !.Info ^ bri_maybe_mode_func,
write_term_mode_debugger(Debugger, MaybeModeFunc, NewPwd, !IO),
Quit = no
;
Command = cmd_mode_query_no_path,
MaybeModeFunc = !.Info ^ bri_maybe_mode_func,
write_term_mode_debugger(Debugger, MaybeModeFunc, !.Info ^ bri_dirs,
!IO),
Quit = no
;
Command = cmd_param(ParamCmd),
run_param_command(Debugger, ParamCmd, yes, !Info, !IO),
Quit = no
;
Command = cmd_help,
help(Debugger, !IO),
Quit = no
;
Command = cmd_quit,
Quit = yes
;
Command = cmd_empty,
Quit = no
;
Command = cmd_unknown,
write_string_debugger(Debugger,
"Error: unknown command or syntax error.\n", !IO),
write_string_debugger(Debugger, "Type \"help\" for help.\n", !IO),
Quit = no
),
(
Debugger = debugger_external,
send_term_to_socket(browser_end_command, !IO)
;
Debugger = debugger_internal
).
:- pred do_portray(debugger::in, browse_caller_type::in,
maybe(maybe_option_table(format_option))::in, browser_info::in,
maybe(path)::in, io::di, io::uo) is cc_multi.
do_portray(Debugger, CallerType, MaybeMaybeOptionTable, Info, MaybePath,
!IO) :-
(
MaybeMaybeOptionTable = no,
portray_maybe_path(Debugger, CallerType, no, Info, MaybePath, !IO)
;
MaybeMaybeOptionTable = yes(MaybeOptionTable),
(
MaybeOptionTable = ok(OptionTable),
interpret_format_options(OptionTable, FormatResult),
(
FormatResult = ok(MaybeFormat),
portray_maybe_path(Debugger, CallerType, MaybeFormat, Info,
MaybePath, !IO)
;
FormatResult = error(Msg),
write_string_debugger(Debugger, Msg, !IO),
write_string_debugger(Debugger, "\n", !IO)
)
;
MaybeOptionTable = error(Msg),
write_string_debugger(Debugger, Msg, !IO),
write_string_debugger(Debugger, "\n", !IO)
)
).
:- pred do_print_memory_addr(debugger::in, browser_info::in, maybe(path)::in,
io::di, io::uo) is cc_multi.
do_print_memory_addr(Debugger, Info, MaybePath, !IO) :-
Dirs0 = Info ^ bri_dirs,
(
MaybePath = no,
Dirs = Dirs0
;
MaybePath = yes(Path),
change_dir(Dirs0, Path, Dirs)
),
deref_subterm(Info ^ bri_term, Dirs, DerefResult),
(
DerefResult = deref_result(BrowserTerm),
(
BrowserTerm = plain_term(Univ),
Value = univ_value(Univ),
get_value_representation(Value, Addr),
string.format("addr = %x\n", [i(Addr)], Str)
;
BrowserTerm = synthetic_term(_, _, _),
Str = "synthetic terms have no addresses\n"
),
write_string_debugger(Debugger, Str, !IO)
;
DerefResult = deref_error(OKPath, ErrorDir),
report_deref_error(Debugger, OKPath, ErrorDir, !IO),
nl_debugger(Debugger, !IO)
).
:- pred get_value_representation(T::in, int::out) is cc_multi.
:- pragma foreign_proc("C",
get_value_representation(Value::in, Addr::out),
[will_not_call_mercury, promise_pure],
"
Addr = (MR_Integer) Value;
").
% Java doesn't support converting addresses to integers, so we just
% return zero. For other backends the debugger doesn't yet work,
% so it doesn't matter what we return.
get_value_representation(_Value, X) :-
cc_multi_equal(0, X).
:- pred interpret_format_options(option_table(format_option)::in,
maybe_error(maybe(portray_format))::out) is det.
interpret_format_options(OptionTable, MaybeMaybeFormat) :-
map.to_assoc_list(OptionTable, OptionAssocList),
list.filter_map(bool_format_option_is_true, OptionAssocList,
TrueFormatOptions),
(
TrueFormatOptions = [],
MaybeMaybeFormat = ok(no)
;
TrueFormatOptions = [FormatOption],
(
FormatOption = flat,
Format = flat
;
FormatOption = raw_pretty,
Format = raw_pretty
;
FormatOption = pretty,
Format = pretty
;
FormatOption = verbose,
Format = verbose
),
MaybeMaybeFormat = ok(yes(Format))
;
TrueFormatOptions = [_, _ | _],
MaybeMaybeFormat = error("error: inconsistent format options")
).
:- pred bool_format_option_is_true(pair(format_option, option_data)::in,
format_option::out) is semidet.
bool_format_option_is_true(Format - bool(yes), Format).
:- pred help(debugger::in, io::di, io::uo) is det.
help(Debugger, !IO) :-
string.append_list([
"Commands are:\n",
"\t[print|p|ls] [format_options] [path]\n",
"\t -- print the specified subterm using the `browse' params\n",
% "\t[d|display] [path]\n",
% The display command is not yet implemented
% "\t[w|write] [path]\n",
% The write command is not yet implemented
"\t[addr|memory_addr] [path]\n",
"\t -- print the raw memory address of the specified subterm\n",
"\tcd [path] -- cd to the specified subterm (default is root)\n",
"\tcdr n path -- repeatedly apply the cd command n times\n",
"\tpwd -- print the path to the current subterm\n",
% How should we document the "[a|accurate]" option on [t|track|m|mark]?
"\t[t|track] [path]\n",
"\t -- mark the specified subterm (default is current)\n",
"\t for tracking, and quit\n",
"\t[m|mark] [path]\n",
"\t -- mark the specified subterm (default is current)\n",
"\t for tracking, asserting for the declarative debugger\n",
"\t that it makes the current goal invalid\n",
"\tmode [path] -- show the mode of the specified subterm\n",
"\t (default is current)\n",
"\tformat [format_options] <flat|raw-pretty|verbose|pretty>\n",
"\t -- set the format\n",
"\tdepth [format_param_options] <n>\n",
"\tsize [format_param_options] <n>\n",
"\twidth [format_param_options] <n>\n",
"\tlines [format_param_options] <n>\n",
"\tnum_io_actions <n>\n",
"\t -- set the named parameter value\n",
"\tparams -- show format and parameter values\n",
"\tquit -- quit browser\n",
"\thelp -- show this help message\n",
"SICStus Prolog style commands are:\n",
"\tp -- print\n",
"\t< n -- set depth\n",
"\t^ [path] -- cd to the specified subterm (default is root)\n",
"\t? -- help\n",
"\th -- help\n",
"\n",
"-- Paths can be Unix-style or SICStus-style: /2/3/1 or ^2^3^1\n",
"\n"],
HelpMessage),
write_string_debugger(Debugger, HelpMessage, !IO).
%---------------------------------------------------------------------------%
%
% Various pretty-print routines.
%
:- pred portray_maybe_path(debugger::in, browse_caller_type::in,
maybe(portray_format)::in, browser_info::in,
maybe(path)::in, io::di, io::uo) is cc_multi.
portray_maybe_path(Debugger, Caller, MaybeFormat, Info, MaybePath, !IO) :-
(
MaybePath = no,
portray(Debugger, Caller, MaybeFormat, Info, !IO)
;
MaybePath = yes(Path),
portray_path(Debugger, Caller, MaybeFormat, Info, Path, !IO)
).
:- pred portray(debugger::in, browse_caller_type::in,
maybe(portray_format)::in, browser_info::in,
io::di, io::uo) is cc_multi.
portray(Debugger, Caller, MaybeFormat, Info, !IO) :-
browser_info.get_format(Info, Caller, MaybeFormat, Format),
browser_info.get_format_params(Info, Caller, Format, Params),
deref_subterm(Info ^ bri_term, Info ^ bri_dirs, SubResult),
(
SubResult = deref_result(SubUniv),
(
Format = flat,
portray_flat(Debugger, SubUniv, Params, !IO)
;
Format = raw_pretty,
portray_raw_pretty(Debugger, SubUniv, Params, !IO)
;
Format = verbose,
portray_verbose(Debugger, SubUniv, Params, !IO)
;
Format = pretty,
portray_pretty(Debugger, SubUniv, Params, !IO)
)
;
SubResult = deref_error(OKPath, ErrorDir),
report_deref_error(Debugger, OKPath, ErrorDir, !IO)
% write_string_debugger(Debugger, "error: no such subterm")
),
nl_debugger(Debugger, !IO).
:- pred portray_path(debugger::in, browse_caller_type::in,
maybe(portray_format)::in, browser_info::in, path::in,
io::di, io::uo) is cc_multi.
portray_path(Debugger, Caller, MaybeFormat, Info0, Path, !IO) :-
set_path(Path, Info0, Info),
portray(Debugger, Caller, MaybeFormat, Info, !IO).
:- pred portray_flat(debugger::in, browser_term::in, format_params::in,
io::di, io::uo) is cc_multi.
portray_flat(Debugger, BrowserTerm, Params, !IO) :-
% io.write handles the special cases such as lists, operators, etc better,
% so we prefer to use it if we can. However, io.write doesn't have
% a depth or size limit, so we need to check the size first; if the term
% is small enough, we use string_writer.write (actually
% string_writer.write_univ), otherwise we use term_to_string/4.
%
% XXX This ignores the maximum number of lines.
browser_term_size_left_from_max(BrowserTerm, max_print_size,
RemainingSize),
( if RemainingSize >= 0 then
io.output_stream(Stream, !IO),
portray_flat_write_browser_term(Stream, BrowserTerm, !IO)
else
io.get_stream_db(StreamDb, !IO),
BrowserDb = browser_db(StreamDb),
browser_term_to_string(BrowserDb, BrowserTerm, Params ^ size,
Params ^ depth, Str),
write_string_debugger(Debugger, Str, !IO)
).
:- pred portray_flat_write_browser_term(Stream::in, browser_term::in,
State::di, State::uo) is cc_multi
<= (stream.writer(Stream, string, State),
stream.writer(Stream, character, State)).
portray_flat_write_browser_term(Stream, plain_term(Univ), !IO) :-
string_writer.write_univ(Stream, include_details_cc, Univ, !IO).
portray_flat_write_browser_term(Stream, synthetic_term(Functor, Args, MaybeReturn),
!IO) :-
put(Stream, Functor, !IO),
(
Args = []
;
Args = [_ | _],
put(Stream, "(", !IO),
put_list(Stream, write_univ_or_unbound, put_comma_space, Args, !IO),
put(Stream, ")", !IO)
),
(
MaybeReturn = yes(Return),
put(Stream, " = ", !IO),
string_writer.write_univ(Stream, include_details_cc, Return, !IO)
;
MaybeReturn = no
).
:- pred put_comma_space(Stream::in, State::di, State::uo) is det
<= stream.writer(Stream, string, State).
put_comma_space(Stream, !State) :-
put(Stream, ", ", !State).
:- pred portray_verbose(debugger::in, browser_term::in, format_params::in,
io::di, io::uo) is cc_multi.
portray_verbose(Debugger, BrowserTerm, Params, !IO) :-
io.get_stream_db(StreamDb, !IO),
BrowserDb = browser_db(StreamDb),
browser_term_to_string_verbose(BrowserDb, BrowserTerm, Params ^ size,
Params ^ depth, Params ^ width, Params ^ lines, Str),
write_string_debugger(Debugger, Str, !IO).
:- pred portray_pretty(debugger::in, browser_term::in, format_params::in,
io::di, io::uo) is det.
portray_pretty(Debugger, BrowserTerm, Params, !IO) :-
browser_term_to_string_pretty(Debugger, BrowserTerm, Params ^ width,
Params ^ lines, Params ^ size, Params ^ depth, !IO).
:- pred portray_raw_pretty(debugger::in, browser_term::in, format_params::in,
io::di, io::uo) is cc_multi.
portray_raw_pretty(Debugger, BrowserTerm, Params, !IO) :-
io.get_stream_db(StreamDb, !IO),
BrowserDb = browser_db(StreamDb),
sized_pretty.browser_term_to_string_line(BrowserDb, BrowserTerm,
Params ^ width, Params ^ lines, Str),
write_string_debugger(Debugger, Str, !IO).
% The maximum estimated size for which we use `io.write'.
%
:- func max_print_size = int.
max_print_size = 60.
term_size_left_from_max(Univ, MaxSize, RemainingSize) :-
( if MaxSize < 0 then
RemainingSize = MaxSize
else
deconstruct.limited_deconstruct_cc(univ_value(Univ), MaxSize,
MaybeFunctorArityArgs),
(
MaybeFunctorArityArgs = yes({Functor, Arity, Args}),
string.length(Functor, FunctorSize),
% "()", plus Arity-1 times ", "
PrincipalSize = FunctorSize + Arity * 2,
MaxArgsSize = MaxSize - PrincipalSize,
list.foldl(term_size_left_from_max, Args,
MaxArgsSize, RemainingSize)
;
MaybeFunctorArityArgs = no,
RemainingSize = -1
)
;
RemainingSize = -1
).
browser_term_size_left_from_max(BrowserTerm, MaxSize, RemainingSize) :-
(
BrowserTerm = plain_term(Univ),
term_size_left_from_max(Univ, MaxSize, RemainingSize)
;
BrowserTerm = synthetic_term(Functor, Args, MaybeReturn),
string.length(Functor, FunctorSize),
list.length(Args, Arity),
(
MaybeReturn = yes(_),
% "()", " = ", plus Arity-1 times ", "
PrincipalSize = FunctorSize + Arity * 2 + 3
;
MaybeReturn = no,
% "()", plus Arity-1 times ", "
PrincipalSize = FunctorSize + Arity * 2
),
MaxArgsSize = MaxSize - PrincipalSize,
list.foldl(term_size_left_from_max, Args, MaxArgsSize, RemainingSize)
).
:- pred write_univ_or_unbound(Stream::in, univ::in, State::di, State::uo)
is cc_multi
<= (stream.writer(Stream, string, State),
stream.writer(Stream, character, State)).
write_univ_or_unbound(Stream, Univ, !IO) :-
( if univ_to_type(Univ, _ `with_type` unbound) then
put_char(Stream, '_', !IO)
else
string_writer.write_univ(Stream, include_details_cc, Univ, !IO)
).
:- pred report_deref_error(debugger::in, list(down_dir)::in, down_dir::in,
io::di, io::uo) is det.
report_deref_error(Debugger, OKPath, ErrorDir, !IO) :-
write_string_debugger(Debugger, "error: ", !IO),
(
OKPath = [_ | _],
Context = "in subdir " ++ down_dirs_to_string(OKPath) ++ ": ",
write_string_debugger(Debugger, Context, !IO)
;
OKPath = []
),
Msg = "there is no subterm " ++ down_dir_to_string(ErrorDir) ++ "\n",
write_string_debugger(Debugger, Msg, !IO).
%---------------------------------------------------------------------------%
%
% Single-line representation of a term.
%
:- pred browser_term_to_string(browser_db::in, browser_term::in,
int::in, int::in, string::out) is cc_multi.
browser_term_to_string(BrowserDb, BrowserTerm, MaxSize, MaxDepth, Str) :-
CurSize = 0,
CurDepth = 0,
browser_term_to_string_2(BrowserDb, BrowserTerm,
MaxSize, CurSize, _NewSize, MaxDepth, CurDepth, Str).
% Note: When the size limit is reached, we simply display further subterms
% compressed. This is consistent with the User's Guide, which describes
% the size limit as a "suggested maximum".
%
:- pred browser_term_to_string_2(browser_db::in, browser_term::in,
int::in, int::in, int::out, int::in, int::in, string::out) is cc_multi.
browser_term_to_string_2(BrowserDb, BrowserTerm, MaxSize, CurSize, NewSize,
MaxDepth, CurDepth, Str) :-
limited_deconstruct_browser_term_cc(BrowserDb, BrowserTerm, MaxSize,
MaybeFunctorArityArgs, MaybeReturn),
( if
CurSize < MaxSize,
CurDepth < MaxDepth,
MaybeFunctorArityArgs = yes({Functor, _Arity, Args})
then
browser_term_to_string_3(BrowserDb, Functor, Args, MaybeReturn,
MaxSize, CurSize, NewSize, MaxDepth, CurDepth, Str)
else
browser_term_compress(BrowserDb, BrowserTerm, Str),
NewSize = CurSize
).
:- pred browser_term_to_string_3(browser_db::in, string::in,
list(univ)::in, maybe(univ)::in, int::in, int::in, int::out,
int::in, int::in, string::out) is cc_multi.
browser_term_to_string_3(BrowserDb, Functor, Args, MaybeReturn,
MaxSize, Size0, Size, MaxDepth, Depth0, Str) :-
( if
Functor = "[|]",
Args = [ListHead, ListTail],
MaybeReturn = no
then
% For the purposes of size and depth, we treat lists as if they consist
% of one functor plus an argument for each element of the list.
Size1 = Size0 + 1,
Depth1 = Depth0 + 1,
browser_term_to_string_2(BrowserDb, plain_term(ListHead),
MaxSize, Size1, Size2, MaxDepth, Depth1, HeadStr),
list_tail_to_string_list(BrowserDb, ListTail,
MaxSize, Size2, Size, MaxDepth, Depth1, TailStrs),
list.append(TailStrs, ["]"], Strs),
string.append_list(["[", HeadStr | Strs], Str)
else if
Functor = "[]",
Args = [],
MaybeReturn = no
then
Size = Size0 + 1,
Str = "[]"
else
Size1 = Size0 + 1,
Depth1 = Depth0 + 1,
args_to_string_list(BrowserDb, Args, MaxSize, Size1, Size2,
MaxDepth, Depth1, ArgStrs),
BracketedArgsStr = bracket_string_list(ArgStrs),
(
MaybeReturn = yes(Return),
browser_term_to_string_2(BrowserDb, plain_term(Return),
MaxSize, Size2, Size, MaxDepth, Depth1, ReturnStr),
string.append_list([Functor, BracketedArgsStr, " = ", ReturnStr],
Str)
;
MaybeReturn = no,
Size = Size2,
string.append_list([Functor, BracketedArgsStr], Str)
)
).
:- pred list_tail_to_string_list(browser_db::in, univ::in,
int::in, int::in, int::out, int::in, int::in, list(string)::out)
is cc_multi.
list_tail_to_string_list(BrowserDb, TailUniv, MaxSize, Size0, Size,
MaxDepth, Depth0, TailStrs) :-
% We want the limit to be at least two to ensure that the limited
% deconstruct won't fail for any list term.
Limit = max(MaxSize, 2),
limited_deconstruct_browser_term_cc(BrowserDb, plain_term(TailUniv),
Limit, MaybeFunctorArityArgs, MaybeReturn),
(
MaybeFunctorArityArgs = yes({Functor, _Arity, Args}),
( if
Functor = "[]",
Args = [],
MaybeReturn = no
then
Size = Size0,
TailStrs = []
else if
Functor = "[|]",
Args = [ListHead, ListTail],
MaybeReturn = no
then
( if
Size0 < MaxSize,
Depth0 < MaxDepth
then
browser_term_to_string_2(BrowserDb, plain_term(ListHead),
MaxSize, Size0, Size1, MaxDepth, Depth0, HeadStr),
list_tail_to_string_list(BrowserDb, ListTail, MaxSize,
Size1, Size, MaxDepth, Depth0, TailStrs0),
TailStrs = [", ", HeadStr | TailStrs0]
else
Size = Size0,
TailStrs = [", ..."]
)
else
( if
Size0 < MaxSize,
Depth0 < MaxDepth
then
browser_term_to_string_3(BrowserDb, Functor, Args, MaybeReturn,
MaxSize, Size0, Size, MaxDepth, Depth0, TailStr),
TailStrs = [" | ", TailStr]
else
Size = Size0,
browser_term_compress(BrowserDb, plain_term(TailUniv),
TailCompressedStr),
TailStrs = [" | ", TailCompressedStr]
)
)
;
MaybeFunctorArityArgs = no,
Size = Size0,
browser_term_compress(BrowserDb, plain_term(TailUniv),
TailCompressedStr),
TailStrs = [" | ", TailCompressedStr]
).
:- pred args_to_string_list(browser_db::in, list(univ)::in,
int::in, int::in, int::out, int::in, int::in, list(string)::out)
is cc_multi.
args_to_string_list(_BrowserDb, [], _MaxSize, CurSize, NewSize,
_MaxDepth, _CurDepth, Strs) :-
Strs = [],
NewSize = CurSize.
args_to_string_list(BrowserDb, [Univ | Univs], MaxSize, CurSize, NewSize,
MaxDepth, CurDepth, Strs) :-
browser_term_to_string_2(BrowserDb, plain_term(Univ),
MaxSize, CurSize, NewSize1, MaxDepth, CurDepth, Str),
args_to_string_list(BrowserDb, Univs, MaxSize, NewSize1, NewSize,
MaxDepth, CurDepth, RestStrs),
Strs = [Str | RestStrs].
:- func bracket_string_list(list(string)) = string.
bracket_string_list(Args) = Str :-
(
Args = [],
Str = ""
;
Args = [_ | _],
string.append_list(["(", comma_string_list(Args), ")"], Str)
).
:- func comma_string_list(list(string)) = string.
comma_string_list(Args) = Str :-
(
Args = [],
Str = ""
;
Args = [S],
Str = S
;
Args = [S1, S2 | Ss],
Rest = comma_string_list([S2 | Ss]),
string.append_list([S1, ", ", Rest], Str)
).
:- pred browser_term_compress(browser_db::in, browser_term::in, string::out)
is cc_multi.
browser_term_compress(BrowserDb, BrowserTerm, Str) :-
functor_browser_term_cc(BrowserDb, BrowserTerm, Functor, Arity, IsFunc),
( if Arity = 0 then
Str = Functor
else
int_to_string(Arity, ArityStr),
(
IsFunc = yes,
append_list([Functor, "/", ArityStr, "+1"], Str)
;
IsFunc = no,
append_list([Functor, "/", ArityStr], Str)
)
).
%---------------------------------------------------------------------------%
% Print using the pretty printer from the standard library.
% XXX Because the pretty printer doesn't support a combination
% of both size and depth, we use the depth, except when depth is 0,
% in which case we use the size.
%
:- pred browser_term_to_string_pretty(S::in,
browser_term::in, int::in, int::in,
int::in, int::in, io::di, io::uo) is det
<= stream.writer(S, string, io).
browser_term_to_string_pretty(S, Term, Width, Lines, Size, Depth, !IO) :-
(
Term = plain_term(Univ),
Doc = format_univ(Univ)
;
Term = synthetic_term(Functor, Args, MaybeReturn),
Doc = synthetic_term_to_doc(Functor, Args, MaybeReturn)
),
get_default_formatter_map(Formatters, !IO),
( if Depth > 0 then
Limit = triangular(Depth)
else
Limit = linear(Size)
),
Params = pp_params(Width, Lines, Limit),
promise_equivalent_solutions [!:IO] (
put_doc(S, include_details_cc, Formatters, Params, Doc, !IO)
).
%---------------------------------------------------------------------------%
% Verbose printing. Tree layout with numbered branches.
% Numbering makes it easier to change to subterms.
%
:- pred browser_term_to_string_verbose(browser_db::in, browser_term::in,
int::in, int::in, int::in, int::in, string::out) is cc_multi.
browser_term_to_string_verbose(BrowserDb, BrowserTerm, MaxSize, MaxDepth,
X, Y, Str) :-
CurSize = 0,
CurDepth = 0,
browser_term_to_string_verbose_2(BrowserDb, BrowserTerm,
MaxSize, CurSize, _NewSize, MaxDepth, CurDepth, Frame),
ClippedFrame = frame.clip(X-Y, Frame),
unlines(ClippedFrame, Str).
:- pred browser_term_to_string_verbose_2(browser_db::in, browser_term::in,
int::in, int::in, int::out, int::in, int::in, frame::out) is cc_multi.
browser_term_to_string_verbose_2(BrowserDb, BrowserTerm,
MaxSize, CurSize, NewSize, MaxDepth, CurDepth, Frame) :-
limited_deconstruct_browser_term_cc(BrowserDb, BrowserTerm, MaxSize,
MaybeFunctorArityArgs, MaybeReturn),
( if
CurSize < MaxSize,
CurDepth < MaxDepth,
MaybeFunctorArityArgs = yes({Functor, _Arity, Args0})
then
% XXX We should consider formatting function terms differently.
(
MaybeReturn = yes(Return),
list.append(Args0, [Return], Args)
;
MaybeReturn = no,
Args = Args0
),
CurSize1 = CurSize + 1,
CurDepth1 = CurDepth + 1,
ArgNum = 1,
args_to_string_verbose_list(BrowserDb, Args, ArgNum,
MaxSize, CurSize1, NewSize, MaxDepth, CurDepth1, ArgsFrame),
Frame = frame.vglue([Functor], ArgsFrame)
else
browser_term_compress(BrowserDb, BrowserTerm, Line),
Frame = [Line],
NewSize = CurSize
).
:- pred args_to_string_verbose_list(browser_db::in, list(univ)::in,
int::in, int::in, int::in, int::out, int::in, int::in, frame::out)
is cc_multi.
args_to_string_verbose_list(_BrowserDb, [], _ArgNum,
_MaxSize, CurSize, NewSize, _MaxDepth, _CurDepth, []) :-
NewSize = CurSize.
args_to_string_verbose_list(BrowserDb, [Univ], ArgNum,
MaxSize, CurSize, NewSize, MaxDepth, CurDepth, Frame) :-
browser_term_to_string_verbose_2(BrowserDb, plain_term(Univ), MaxSize,
CurSize, NewSize, MaxDepth, CurDepth, TreeFrame),
% XXX: ArgNumS must have fixed length 2.
string.int_to_string(ArgNum, ArgNumS),
string.append_list([ArgNumS, "-"], LastBranchS),
Frame = frame.hglue([LastBranchS], TreeFrame).
args_to_string_verbose_list(BrowserDb, [Univ1, Univ2 | Univs], ArgNum, MaxSize,
CurSize, NewSize, MaxDepth, CurDepth, Frame) :-
browser_term_to_string_verbose_2(BrowserDb, plain_term(Univ1),
MaxSize, CurSize, NewSize1, MaxDepth, CurDepth, TreeFrame),
ArgNum1 = ArgNum + 1,
args_to_string_verbose_list(BrowserDb, [Univ2 | Univs], ArgNum1,
MaxSize, NewSize1, NewSize2, MaxDepth, CurDepth, RestTreesFrame),
NewSize = NewSize2,
% XXX: ArgNumS must have fixed length 2.
string.int_to_string(ArgNum, ArgNumS),
string.append_list([ArgNumS, "-"], BranchFrameS),
Height = frame.vsize(TreeFrame) - 1,
list.duplicate(Height, "|", VBranchFrame),
LeftFrame = frame.vglue([BranchFrameS], VBranchFrame),
TopFrame = frame.hglue(LeftFrame, TreeFrame),
Frame = frame.vglue(TopFrame, RestTreesFrame).
:- pred unlines(list(string)::in, string::out) is det.
unlines([], "").
unlines([Line | Lines], Str) :-
string.append(Line, "\n", NLine),
unlines(Lines, Strs),
string.append(NLine, Strs, Str).
%---------------------------------------------------------------------------%
%
% Miscellaneous path handling.
%
:- type deref_result(T)
---> deref_result(T)
; deref_error(list(down_dir), down_dir).
% We assume a root-relative path. We assume Term is the entire term
% passed into browse/3, not a subterm.
%
:- pred deref_subterm(browser_term::in, list(down_dir)::in,
deref_result(browser_term)::out) is cc_multi.
deref_subterm(BrowserTerm, Path, Result) :-
(
BrowserTerm = plain_term(Univ),
deref_subterm_2(Univ, Path, [], SubResult),
deref_result_univ_to_browser_term(SubResult, Result)
;
BrowserTerm = synthetic_term(_Functor, Args, MaybeReturn),
(
Path = [],
SubBrowserTerm = BrowserTerm,
Result = deref_result(SubBrowserTerm)
;
Path = [Step | PathTail],
( if
(
Step = down_child_num(N),
( if
N = list.length(Args) + 1,
MaybeReturn = yes(ReturnValue)
then
ArgUniv = ReturnValue
else
% The first argument of a non-array
% is numbered argument 1.
list.index1(Args, N, ArgUniv)
)
;
Step = down_child_name(Name),
string_is_return_value_alias(Name),
MaybeReturn = yes(ArgUniv)
)
then
deref_subterm_2(ArgUniv, PathTail, [Step], SubResult),
deref_result_univ_to_browser_term(SubResult, Result)
else
Result = deref_error([], Step)
)
)
).
:- pred deref_result_univ_to_browser_term(deref_result(univ)::in,
deref_result(browser_term)::out) is det.
deref_result_univ_to_browser_term(SubResult, Result) :-
(
SubResult = deref_result(SubUniv),
SubBrowserTerm = plain_term(SubUniv),
Result = deref_result(SubBrowserTerm)
;
SubResult = deref_error(OKPath, ErrorDir),
Result = deref_error(OKPath, ErrorDir)
).
:- pred deref_subterm_2(univ::in, list(down_dir)::in, list(down_dir)::in,
deref_result(univ)::out) is cc_multi.
deref_subterm_2(Univ, Path, RevPath0, Result) :-
(
Path = [],
Result = deref_result(Univ)
;
Path = [Dir | Dirs],
(
Dir = down_child_num(N),
( if
TypeCtor = type_ctor(univ_type(Univ)),
type_ctor_name(TypeCtor) = "array",
type_ctor_module_name(TypeCtor) = "array"
then
% The first element of an array is at index zero.
arg_cc(univ_value(Univ), N, MaybeValue)
else
% The first argument of a non-array is numbered argument 1
% by the user but argument 0 by deconstruct.argument.
arg_cc(univ_value(Univ), N - 1, MaybeValue)
)
;
Dir = down_child_name(Name),
named_arg_cc(univ_value(Univ), Name, MaybeValue)
),
(
MaybeValue = arg(Value),
ArgN = univ(Value),
deref_subterm_2(ArgN, Dirs, [Dir | RevPath0], Result)
;
MaybeValue = no_arg,
Result = deref_error(list.reverse(RevPath0), Dir)
)
).
%---------------------------------------------------------------------------%
:- pred set_path(path::in, browser_info::in, browser_info::out) is det.
set_path(NewPath, !Info) :-
Dirs0 = !.Info ^ bri_dirs,
change_dir(Dirs0, NewPath, Dirs),
!Info ^ bri_dirs := Dirs.
:- pred change_dir(list(down_dir)::in, path::in, list(down_dir)::out) is det.
change_dir(PwdDirs, Path, RootRelDirs) :-
(
Path = root_rel(Dirs),
NewDirs = Dirs
;
Path = dot_rel(Dirs),
NewDirs = down_to_up_down_dirs(PwdDirs) ++ Dirs
),
simplify_dirs(NewDirs, RootRelDirs).
%---------------------------------------------------------------------------%
%
% Saving terms to files.
%
save_term_to_file(FileName, _Format, BrowserTerm, OutStream, !IO) :-
trace [compile_time(flag("debug_save_term_to_file")), io(!TIO)] (
io.write_string(FileName, !TIO),
io.nl(!TIO),
io.write(BrowserTerm, !TIO),
io.nl(!TIO)
),
io.tell(FileName, FileStreamRes, !IO),
(
FileStreamRes = ok,
(
BrowserTerm = plain_term(Term),
save_univ(0, Term, !IO),
io.nl(!IO)
;
BrowserTerm = synthetic_term(Functor, Args, MaybeRes),
io.write_string(Functor, !IO),
io.write_string("(\n", !IO),
save_args(1, Args, !IO),
io.write_string("\n)\n", !IO),
(
MaybeRes = no
;
MaybeRes = yes(Result),
io.write_string("=\n", !IO),
save_univ(1, Result, !IO),
io.write_string("\n", !IO)
)
),
io.told(!IO)
;
FileStreamRes = error(Error),
io.error_message(Error, Msg),
io.write_string(OutStream, Msg, !IO)
).
:- type xml_predicate_wrapper
---> predicate(
predicate_name :: string,
predicate_arguments :: list(univ)
).
:- type xml_function_wrapper
---> function(
function_name :: string,
function_arguments :: list(univ),
return_value :: univ
).
save_term_to_file_xml(FileName, BrowserTerm, OutStream, !IO) :-
maybe_save_term_to_file_xml(FileName, BrowserTerm, Result, !IO),
(
Result = ok(_)
;
Result = error(Error),
io.error_message(Error, Msg),
io.write_string(OutStream, Msg, !IO),
io.nl(!IO)
).
:- pred maybe_save_term_to_file_xml(string::in, browser_term::in,
io.res(io.output_stream)::out, io::di, io::uo) is cc_multi.
maybe_save_term_to_file_xml(FileName, BrowserTerm, FileStreamRes, !IO) :-
io.open_output(FileName, FileStreamRes, !IO),
(
FileStreamRes = ok(OutputStream),
(
BrowserTerm = plain_term(Univ),
Term = univ_value(Univ),
term_to_xml.write_xml_doc_general_cc(OutputStream, Term, simple,
no_stylesheet, no_dtd, _, !IO)
;
BrowserTerm = synthetic_term(Functor, Args, MaybeRes),
(
MaybeRes = no,
PredicateTerm = predicate(Functor, Args),
term_to_xml.write_xml_doc_general_cc(OutputStream,
PredicateTerm, simple, no_stylesheet, no_dtd, _, !IO)
;
MaybeRes = yes(Result),
FunctionTerm = function(Functor, Args, Result),
term_to_xml.write_xml_doc_general_cc(OutputStream,
FunctionTerm, simple, no_stylesheet, no_dtd, _, !IO)
)
),
io.close_output(OutputStream, !IO)
;
FileStreamRes = error(_)
).
%---------------------------------------------------------------------------%
save_and_browse_browser_term_xml(Term, OutStream, ErrStream, State, !IO) :-
MaybeXMLBrowserCmd = State ^ xml_browser_cmd,
MaybeTmpFileName = State ^ xml_tmp_filename,
(
MaybeXMLBrowserCmd = yes(CommandStr),
MaybeTmpFileName = yes(TmpFileName),
io.write_string(OutStream, "Saving term to XML file...\n", !IO),
maybe_save_term_to_file_xml(TmpFileName, Term, SaveResult, !IO),
(
SaveResult = ok(_),
launch_xml_browser(OutStream, ErrStream, CommandStr, !IO)
;
SaveResult = error(Error),
io.error_message(Error, Msg),
io.write_string(ErrStream,
"Error opening file `" ++ TmpFileName ++ "': ", !IO),
io.write_string(ErrStream, Msg, !IO),
io.nl(!IO)
)
;
MaybeXMLBrowserCmd = yes(_),
MaybeTmpFileName = no,
io.write_string(ErrStream, "mdb: You need to issue a " ++
"\"set xml_tmp_filename '<filename>'\" command first.\n", !IO)
;
MaybeXMLBrowserCmd = no,
MaybeTmpFileName = yes(_),
io.write_string(ErrStream, "mdb: You need to issue a " ++
"\"set xml_browser_cmd '<command>'\" command first.\n", !IO)
;
MaybeXMLBrowserCmd = no,
MaybeTmpFileName = no,
io.write_string(ErrStream, "mdb: You need to issue a " ++
"\"set xml_browser_cmd '<command>'\" command\n" ++
"and a \"set xml_tmp_filename '<filename>'\" command first.\n",
!IO)
).
:- pred launch_xml_browser(io.output_stream::in, io.output_stream::in,
string::in, io::di, io::uo) is det.
launch_xml_browser(OutStream, ErrStream, CommandStr, !IO) :-
io.write_string(OutStream, "Launching XML browser "
++ "(this may take some time) ...\n", !IO),
% Flush the output stream, so output appears in the correct order
% for tests where the `cat' command is used as the XML browser.
io.flush_output(OutStream, !IO),
io.call_system_return_signal(CommandStr, Result, !IO),
(
Result = ok(ExitStatus),
(
ExitStatus = exited(ExitCode),
( if ExitCode = 0 then
true
else
io.write_string(ErrStream,
"mdb: The command `" ++ CommandStr ++
"' terminated with a non-zero exit code.\n", !IO)
)
;
ExitStatus = signalled(_),
io.write_string(ErrStream, "mdb: The browser was killed.\n", !IO)
)
;
Result = error(Error),
io.write_string(ErrStream, "mdb: Error launching browser: "
++ string.string(Error) ++ ".\n", !IO)
).
%---------------------------------------------------------------------------%
save_and_browse_browser_term_web(Term, OutStream, ErrStream, State, !IO) :-
get_mdb_dir(MaybeMdbDir, !IO),
(
MaybeMdbDir = yes(MdbDir),
MaybeBrowserCmd = State ^ web_browser_cmd,
(
MaybeBrowserCmd = yes(BrowserCmd),
io.get_temp_directory(TmpDir, !IO),
io.make_temp_file(TmpDir, "mdb", ".html", TmpResult, !IO),
(
TmpResult = ok(TmpFileName0),
( if string.suffix(TmpFileName0, ".html") then
TmpFileName = TmpFileName0
else
% Work around io.make_temp_file ignoring suffix.
io.remove_file(TmpFileName0, _, !IO),
TmpFileName = TmpFileName0 ++ ".html"
),
save_term_to_file_web(TmpFileName, Term, MdbDir,
SaveResult, !IO),
(
SaveResult = ok(_),
% We should actually quote the file name.
CommandStr = BrowserCmd ++ " " ++ TmpFileName,
launch_web_browser(OutStream, ErrStream, CommandStr, !IO)
;
SaveResult = error(Error),
io.error_message(Error, Msg),
io.write_string(ErrStream,
"Error opening file `" ++ TmpFileName ++ "': ", !IO),
io.write_string(ErrStream, Msg, !IO),
io.nl(!IO)
)
;
TmpResult = error(Error),
io.error_message(Error, Msg),
io.write_string(ErrStream, "Error opening temporary file: ",
!IO),
io.write_string(ErrStream, Msg, !IO),
io.nl(!IO)
)
;
MaybeBrowserCmd = no,
io.write_string(ErrStream,
"mdb: You need to specify the shell command that launches " ++
"your preferred web browser, by issuing an mdb command " ++
"\"web_browser_cmd <command>\".\n", !IO)
)
;
MaybeMdbDir = no,
io.write_string(ErrStream,
"Could not determine directory containing mdb files.\n", !IO)
).
:- pred get_mdb_dir(maybe(string)::out, io::di, io::uo) is det.
get_mdb_dir(Res, !IO) :-
get_environment_var("MERCURY_DEBUGGER_INIT", MaybeValue, !IO),
( if
MaybeValue = yes(Path),
dir.path_name_is_absolute(Path),
dir.split_name(Path, MdbDir, "mdbrc")
then
Res = yes(MdbDir)
else
Res = no
).
:- pred save_term_to_file_web(string::in, browser_term::in, string::in,
io.res(io.output_stream)::out, io::di, io::uo) is cc_multi.
save_term_to_file_web(FileName, BrowserTerm, MdbDir, FileStreamRes,
!IO) :-
io.open_output(FileName, FileStreamRes, !IO),
(
FileStreamRes = ok(OutputStream),
term_to_html.write_html_doc(OutputStream, BrowserTerm, MdbDir, _, !IO),
io.close_output(OutputStream, !IO)
;
FileStreamRes = error(_)
).
:- pred launch_web_browser(io.output_stream::in, io.output_stream::in,
string::in, io::di, io::uo) is det.
launch_web_browser(OutStream, ErrStream, CommandStr, !IO) :-
io.write_string(OutStream, "Launching web browser...\n", !IO),
io.flush_output(OutStream, !IO),
io.call_system_return_signal(CommandStr, Result, !IO),
(
Result = ok(ExitStatus),
(
ExitStatus = exited(ExitCode),
( if ExitCode = 0 then
true
else
io.write_string(ErrStream,
"mdb: The command `" ++ CommandStr ++
"' terminated with a non-zero exit code.\n", !IO)
)
;
ExitStatus = signalled(_),
io.write_string(ErrStream, "mdb: The browser was killed.\n", !IO)
)
;
Result = error(Error),
io.write_string(ErrStream, "mdb: Error launching browser: "
++ string.string(Error) ++ ".\n", !IO)
).
browser_term_to_html_flat_string(BrowserTerm, Str, Elided, !IO) :-
% Mimic portray_flat. We can afford larger sizes in a web browser due to
% proportional fonts and horizontal scrolling.
MaxTermSize = 120,
browser_term_size_left_from_max(BrowserTerm, MaxTermSize, RemainingSize),
( if RemainingSize >= 0 then
portray_flat_write_browser_term(string.builder.handle, BrowserTerm,
string.builder.init, State),
Str = to_string(State),
Elided = no
else
io.get_stream_db(StreamDb, !IO),
BrowserDb = browser_db(StreamDb),
MaxSize = 10,
MaxDepth = 5,
browser_term_to_string(BrowserDb, BrowserTerm, MaxSize, MaxDepth, Str),
Elided = yes
).
%---------------------------------------------------------------------------%
:- pred save_univ(int::in, univ::in, io::di, io::uo) is cc_multi.
save_univ(Indent, Univ, !IO) :-
save_term(Indent, univ_value(Univ), !IO).
:- pred save_term(int::in, T::in, io::di, io::uo) is cc_multi.
save_term(Indent, Term, !IO) :-
( if dynamic_cast_to_list(Term, List) then
(
List = [],
write_indent(Indent, !IO),
io.write_string("[]", !IO)
;
List = [_ | _],
MakeUniv =
( func(Element) = (ElementUniv) :-
ElementUniv = univ(Element)
),
Univs = list.map(MakeUniv, List),
write_indent(Indent, !IO),
io.write_string("[\n", !IO),
save_args(Indent + 1, Univs, !IO),
io.write_string("\n", !IO),
write_indent(Indent, !IO),
io.write_string("]", !IO)
)
else
deconstruct(Term, include_details_cc, Functor, _Arity, Args),
write_indent(Indent, !IO),
io.write_string(Functor, !IO),
(
Args = []
;
Args = [_ | _],
io.write_string("(\n", !IO),
save_args(Indent + 1, Args, !IO),
io.write_string("\n", !IO),
write_indent(Indent, !IO),
io.write_string(")", !IO)
)
).
:- some [T2] pred dynamic_cast_to_list(T1::in, list(T2)::out) is semidet.
dynamic_cast_to_list(X, L) :-
% The code of this predicate is copied from pprint.m.
[ArgTypeDesc] = type_args(type_of(X)),
(_ `with_type` ArgType) `has_type` ArgTypeDesc,
dynamic_cast(X, L `with_type` list(ArgType)).
:- pred save_args(int::in, list(univ)::in, io::di, io::uo) is cc_multi.
save_args(_Indent, [], !IO).
save_args(Indent, [Univ | Univs], !IO) :-
save_univ(Indent, Univ, !IO),
(
Univs = []
;
Univs = [_ | _],
io.write_string(",\n", !IO),
save_args(Indent, Univs, !IO)
).
:- pred write_indent(int::in, io::di, io::uo) is det.
write_indent(Indent, !IO) :-
( if Indent =< 0 then
true
else
io.write_char(' ', !IO),
write_indent(Indent - 1, !IO)
).
%---------------------------------------------------------------------------%
%
% Display predicates.
%
:- pred show_settings(debugger::in, browser_info::in, io::di, io::uo) is det.
show_settings(Debugger, Info, !IO) :-
show_settings_caller(Debugger, Info, browse, "Browser", !IO),
show_settings_caller(Debugger, Info, print, "Print", !IO),
show_settings_caller(Debugger, Info, print_all, "Printall", !IO),
write_string_debugger(Debugger, "Current path is: ", !IO),
write_down_path(Debugger, Info ^ bri_dirs, !IO),
nl_debugger(Debugger, !IO),
write_string_debugger(Debugger, "Number of I/O actions printed is: ", !IO),
write_int_debugger(Debugger,
get_num_printed_io_actions(Info ^ bri_state), !IO),
nl_debugger(Debugger, !IO).
:- pred show_settings_caller(debugger::in, browser_info::in,
browse_caller_type::in, string::in, io::di, io::uo) is det.
show_settings_caller(Debugger, Info, Caller, CallerName, !IO) :-
browser_info.get_format(Info, Caller, no, Format),
write_string_debugger(Debugger, CallerName ++ " default format: ", !IO),
print_format_debugger(Debugger, Format, !IO),
nl_debugger(Debugger, !IO),
write_string_debugger(Debugger, pad_right("", ' ', row_name_len), !IO),
write_string_debugger(Debugger, pad_right("depth", ' ', depth_len), !IO),
write_string_debugger(Debugger, pad_right("size", ' ', size_len), !IO),
write_string_debugger(Debugger, pad_right("x clip", ' ', width_len), !IO),
write_string_debugger(Debugger, pad_right("y clip", ' ', lines_len), !IO),
nl_debugger(Debugger, !IO),
show_settings_caller_format(Debugger, Info, Caller, CallerName,
flat, "flat", !IO),
show_settings_caller_format(Debugger, Info, Caller, CallerName,
verbose, "verbose", !IO),
show_settings_caller_format(Debugger, Info, Caller, CallerName,
pretty, "pretty", !IO),
show_settings_caller_format(Debugger, Info, Caller, CallerName,
raw_pretty, "raw_pretty", !IO),
nl_debugger(Debugger, !IO).
:- pred show_settings_caller_format(debugger::in, browser_info::in,
browse_caller_type::in, string::in, portray_format::in, string::in,
io::di, io::uo) is det.
show_settings_caller_format(Debugger, Info, Caller, CallerName,
Format, FormatName, !IO) :-
browser_info.get_format_params(Info, Caller, Format, Params),
write_string_debugger(Debugger,
pad_right(CallerName ++ " " ++ FormatName ++ ":", ' ', row_name_len),
!IO),
write_string_debugger(Debugger,
pad_right(" ", ' ', centering_len), !IO),
write_string_debugger(Debugger,
pad_right(int_to_string(Params ^ depth), ' ', depth_len), !IO),
write_string_debugger(Debugger,
pad_right(int_to_string(Params ^ size), ' ', size_len), !IO),
write_string_debugger(Debugger,
pad_right(int_to_string(Params ^ width), ' ', width_len), !IO),
write_string_debugger(Debugger,
pad_right(int_to_string(Params ^ lines), ' ', lines_len), !IO),
nl_debugger(Debugger, !IO).
:- func row_name_len = int.
:- func centering_len = int.
:- func depth_len = int.
:- func size_len = int.
:- func width_len = int.
:- func lines_len = int.
row_name_len = 30.
centering_len = 3.
depth_len = 10.
size_len = 10.
width_len = 10.
lines_len = 10.
simplify_dirs(Dirs, SimpleDirs) :-
list.reverse(Dirs, RevDirs),
simplify_rev_dirs(RevDirs, 0, [], SimpleDirs).
% simplify_rev_dirs(RevUpDownDirs, ToDelete, !DownDirs):
%
% Assumes a reverse list of directories and removes redundant `..'
% entries by scanning from the bottom most directory to the top,
% counting how many `..' occurred (!.ToDelete) and removing entries
% accordingly. !DownDirs accumulates the simplified dirs processed so far
% so we can be tail recursive.
%
:- pred simplify_rev_dirs(list(up_down_dir)::in, int::in,
list(down_dir)::in, list(down_dir)::out) is det.
simplify_rev_dirs([], _, !DownDirs).
simplify_rev_dirs([RevUpDownDir | RevUpDownDirs], !.ToDelete, !DownDirs) :-
(
RevUpDownDir = updown_parent,
!:ToDelete = !.ToDelete + 1
;
(
RevUpDownDir = updown_child_num(ChildNum),
DownDir = down_child_num(ChildNum)
;
RevUpDownDir = updown_child_name(ChildName),
DownDir = down_child_name(ChildName)
),
( if !.ToDelete > 0 then
!:ToDelete = !.ToDelete - 1
else
!:DownDirs = [DownDir | !.DownDirs]
)
),
simplify_rev_dirs(RevUpDownDirs, !.ToDelete, !DownDirs).
:- func down_dir_to_string(down_dir) = string.
down_dir_to_string(down_child_num(Num)) = int_to_string(Num).
down_dir_to_string(down_child_name(Name)) = Name.
:- func down_dirs_to_string(list(down_dir)) = string.
down_dirs_to_string([]) = "".
down_dirs_to_string([Dir | Dirs]) = DirStr :-
(
Dirs = [],
DirStr = down_dir_to_string(Dir)
;
Dirs = [_ | _],
DirStr = down_dir_to_string(Dir) ++ "/" ++ down_dirs_to_string(Dirs)
).
string_is_return_value_alias("r").
string_is_return_value_alias("res").
string_is_return_value_alias("rv").
string_is_return_value_alias("result").
string_is_return_value_alias("return").
string_is_return_value_alias("ret").
%---------------------------------------------------------------------------%
:- pred write_term_mode_debugger(debugger::in, maybe(browser_mode_func)::in,
list(down_dir)::in, io::di, io::uo) is det.
write_term_mode_debugger(Debugger, MaybeModeFunc, Dirs, !IO) :-
(
MaybeModeFunc = yes(ModeFunc),
Mode = ModeFunc(Dirs),
ModeStr = browser_mode_to_string(Mode),
write_string_debugger(Debugger, ModeStr ++ "\n", !IO)
;
MaybeModeFunc = no,
write_string_debugger(Debugger,
"Mode information not available.\n", !IO)
).
:- func browser_mode_to_string(browser_term_mode) = string.
browser_mode_to_string(btm_input) = "Input".
browser_mode_to_string(btm_output) = "Output".
browser_mode_to_string(btm_not_applicable) = "Not Applicable".
browser_mode_to_string(btm_unbound) = "Unbound".
%---------------------------------------------------------------------------%
% These two functions are just like pprint.to_doc, except their input
% is not a natural term, but a synthetic term defined by a functor, a list
% of arguments, and if the synthetic term is a function application, then
% the result of that function application.
%
% The functor name has to be treated specially because '.'s therein
% usually denote separators in a module qualified name; the
% default pretty_printer formatter does not know this and will quote
% such names.
%
:- func synthetic_term_to_doc(string, list(univ), maybe(univ)) = doc.
synthetic_term_to_doc(Functor0, Args, MaybeReturn) = Doc :-
( if
( Functor0 = "!."
; Functor0 = "."
; Functor0 = ".."
; Functor0 = "=.."
; not string.contains_char(Functor0, ('.'))
)
then
Doc0 = format_term(Functor0, Args)
else
FunctorDoc =
qualified_functor_to_doc(string.split_at_char(('.'), Functor0)),
(
Args = [],
Doc0 = FunctorDoc
;
Args = [_ | _],
Doc0 = indent([
FunctorDoc, str("("),
format_list(Args, group([str(", "), nl])),
str(")")
])
)
),
(
MaybeReturn = no,
Doc = Doc0
;
MaybeReturn = yes(Return),
Doc = docs([Doc0, str(" = "), format_arg(format_univ(Return))])
).
%---------------------------------------------------------------------------%
:- func qualified_functor_to_doc(list(string)) = doc.
qualified_functor_to_doc([]) = str("").
qualified_functor_to_doc([Part]) = str(term_io.quoted_atom(Part)).
qualified_functor_to_doc([PartA, PartB | Parts]) =
docs([str(term_io.quoted_atom(PartA)), str("."),
qualified_functor_to_doc([PartB | Parts])]).
%---------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink