mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-12 04:14:06 +00:00
Estimated hours taken: 2 Branches: main browser/*.m: Make the debugger use the committed choice versions of the deconstruction predicates, and propagate the committed choice environment up the call chain as far as necessary.
1240 lines
38 KiB
Mathematica
1240 lines
38 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 1998-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.
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% browse - 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.
|
|
%
|
|
% authors: aet
|
|
% stability: low
|
|
|
|
:- module mdb__browse.
|
|
|
|
:- interface.
|
|
|
|
:- import_module mdb__browser_info.
|
|
:- import_module io, bool, std_util, list.
|
|
|
|
% The interactive term browser. The caller type will be `browse', and
|
|
% the default format for the `browse' caller type will be used.
|
|
%
|
|
:- pred browse__browse(T::in, io__input_stream::in,
|
|
io__output_stream::in, maybe(list(dir))::out,
|
|
browser_persistent_state::in, browser_persistent_state::out,
|
|
io__state::di, io__state::uo) is cc_multi.
|
|
|
|
% As above, except that the supplied format will override the default.
|
|
%
|
|
:- pred browse__browse_format(T::in, io__input_stream::in,
|
|
io__output_stream::in, portray_format::in,
|
|
browser_persistent_state::in, browser_persistent_state::out,
|
|
io__state::di, io__state::uo) is cc_multi.
|
|
|
|
% A version of browse__browse that works on synthetic terms
|
|
% in the sense of browser_info:browser_term.
|
|
%
|
|
:- pred browse__browse_synthetic(string::in, list(univ)::in, bool::in,
|
|
io__input_stream::in, io__output_stream::in, maybe(list(dir))::out,
|
|
browser_persistent_state::in, browser_persistent_state::out,
|
|
io__state::di, io__state::uo) is cc_multi.
|
|
|
|
% A version of browse__browse_format that works on synthetic terms
|
|
% in the sense of browser_info:browser_term.
|
|
%
|
|
:- pred browse__browse_format_synthetic(string::in, list(univ)::in, bool::in,
|
|
io__input_stream::in, io__output_stream::in, portray_format::in,
|
|
browser_persistent_state::in, browser_persistent_state::out,
|
|
io__state::di, io__state::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__browse_external(T::in, io__input_stream::in,
|
|
io__output_stream::in,
|
|
browser_persistent_state::in, browser_persistent_state::out,
|
|
io__state::di, io__state::uo) is cc_multi.
|
|
|
|
% 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 browse__print(T::in, io__output_stream::in, browse_caller_type::in,
|
|
browser_persistent_state::in, io__state::di, io__state::uo)
|
|
is cc_multi.
|
|
|
|
% A version of browse__print that works on synthetic terms
|
|
% in the sense of browser_info:browser_term.
|
|
%
|
|
:- pred browse__print_synthetic(string::in, list(univ)::in, bool::in,
|
|
io__output_stream::in, browse_caller_type::in,
|
|
browser_persistent_state::in, io__state::di, io__state::uo)
|
|
is cc_multi.
|
|
|
|
% As above, except that the supplied format will override the default.
|
|
%
|
|
:- pred browse__print_format(T::in, io__output_stream::in,
|
|
browse_caller_type::in, portray_format::in,
|
|
browser_persistent_state::in, io__state::di, io__state::uo)
|
|
is cc_multi.
|
|
|
|
% A version of browse__print_format that works on synthetic terms
|
|
% in the sense of browser_info:browser_term.
|
|
%
|
|
:- pred browse__print_format_synthetic(string::in, list(univ)::in, bool::in,
|
|
io__output_stream::in, browse_caller_type::in, portray_format::in,
|
|
browser_persistent_state::in, io__state::di, io__state::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.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- implementation.
|
|
|
|
:- import_module mdb__parse, mdb__util, mdb__frame, mdb__sized_pretty.
|
|
:- import_module string, parser, require, std_util, int, char, pprint.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% We export these predicates to C for use by the tracer:
|
|
% they are used in trace/mercury_trace_browser.c.
|
|
%
|
|
|
|
:- pragma export(browse__browse(in, in, in, out, in, out, di, uo),
|
|
"ML_BROWSE_browse").
|
|
:- pragma export(browse__browse_format(in, in, in, in, in, out, di, uo),
|
|
"ML_BROWSE_browse_format").
|
|
:- pragma export(browse__browse_synthetic(in, in, in, in, in, out,
|
|
in, out, di, uo), "ML_BROWSE_browse_synthetic").
|
|
:- pragma export(browse__browse_format_synthetic(in, in, in, in, in, in,
|
|
in, out, di, uo), "ML_BROWSE_browse_format_synthetic").
|
|
:- pragma export(browse__browse_external(in, in, in, in, out, di, uo),
|
|
"ML_BROWSE_browse_external").
|
|
:- pragma export(browse__print(in, in, in, in, di, uo),
|
|
"ML_BROWSE_print").
|
|
:- pragma export(browse__print_format(in, in, in, in, in, di, uo),
|
|
"ML_BROWSE_print_format").
|
|
:- pragma export(browse__print_synthetic(in, in, in, in, in, in, di, uo),
|
|
"ML_BROWSE_print_synthetic").
|
|
:- pragma export(browse__print_format_synthetic(in, in, in, in, in, in, in,
|
|
di, uo), "ML_BROWSE_print_format_synthetic").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
% If the term browser is called from the internal debugger, input is
|
|
% done via a call to the readline library (if available), using streams
|
|
% MR_mdb_in and MR_mdb_out. If it is called from the external debugger,
|
|
% Input/Output are done via MR_debugger_socket_in/MR_debugger_socket_out.
|
|
% In the latter case we need to output terms; their type is
|
|
% term_browser_response.
|
|
|
|
|
|
:- type term_browser_response
|
|
---> browser_str(string)
|
|
; browser_int(int)
|
|
; browser_nl
|
|
; browser_end_command
|
|
; browser_quit.
|
|
|
|
:- type debugger
|
|
---> internal
|
|
; external.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Non-interactive display
|
|
%
|
|
|
|
browse__print(Term, OutputStream, Caller, State) -->
|
|
browse__print_common(plain_term(univ(Term)), OutputStream,
|
|
Caller, no, State).
|
|
|
|
browse__print_format(Term, OutputStream, Caller, Format, State) -->
|
|
browse__print_common(plain_term(univ(Term)), OutputStream,
|
|
Caller, yes(Format), State).
|
|
|
|
browse__print_synthetic(FunctorString, Args, IsFunc, OutputStream,
|
|
Caller, State) -->
|
|
{ synthetic_term_to_browser_term(FunctorString, Args, IsFunc,
|
|
BrowserTerm) },
|
|
browse__print_common(BrowserTerm, OutputStream, Caller, no, State).
|
|
|
|
browse__print_format_synthetic(FunctorString, Args, IsFunc, OutputStream,
|
|
Caller, Format, State) -->
|
|
{ synthetic_term_to_browser_term(FunctorString, Args, IsFunc,
|
|
BrowserTerm) },
|
|
browse__print_common(BrowserTerm, OutputStream,
|
|
Caller, yes(Format), State).
|
|
|
|
:- pred browse__print_common(browser_term::in, io__output_stream::in,
|
|
browse_caller_type::in, maybe(portray_format)::in,
|
|
browser_persistent_state::in, io__state::di, io__state::uo)
|
|
is cc_multi.
|
|
|
|
browse__print_common(BrowserTerm, OutputStream, Caller, MaybeFormat, State) -->
|
|
{ Info = browser_info__init(BrowserTerm, MaybeFormat, State) },
|
|
io__set_output_stream(OutputStream, OldStream),
|
|
{ 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.
|
|
%
|
|
(
|
|
{ BrowserTerm = plain_term(_) },
|
|
{ Format \= flat }
|
|
->
|
|
io__nl
|
|
;
|
|
[]
|
|
),
|
|
portray(internal, Caller, no, Info),
|
|
io__set_output_stream(OldStream, _).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Interactive display
|
|
%
|
|
|
|
browse__browse(Object, InputStream, OutputStream, MaybeMark, State0, State) -->
|
|
browse_common(internal, plain_term(univ(Object)),
|
|
InputStream, OutputStream, no, MaybeMark, State0, State).
|
|
|
|
browse__browse_format(Object, InputStream, OutputStream, Format,
|
|
State0, State) -->
|
|
browse_common(internal, plain_term(univ(Object)),
|
|
InputStream, OutputStream, yes(Format), _, State0, State).
|
|
|
|
browse__browse_synthetic(FunctorString, Args, IsFunc,
|
|
InputStream, OutputStream, MaybeMark, State0, State) -->
|
|
{ synthetic_term_to_browser_term(FunctorString, Args, IsFunc,
|
|
BrowserTerm) },
|
|
browse_common(internal, BrowserTerm,
|
|
InputStream, OutputStream, no, MaybeMark, State0, State).
|
|
|
|
browse__browse_format_synthetic(FunctorString, Args, IsFunc,
|
|
InputStream, OutputStream, Format, State0, State) -->
|
|
{ synthetic_term_to_browser_term(FunctorString, Args, IsFunc,
|
|
BrowserTerm) },
|
|
browse_common(internal, BrowserTerm,
|
|
InputStream, OutputStream, yes(Format), _, State0, State).
|
|
|
|
browse__browse_external(Object, InputStream, OutputStream, State0, State) -->
|
|
browse_common(external, plain_term(univ(Object)),
|
|
InputStream, OutputStream, no, _, State0, State).
|
|
|
|
:- pred browse_common(debugger::in, browser_term::in, io__input_stream::in,
|
|
io__output_stream::in, maybe(portray_format)::in,
|
|
maybe(list(dir))::out, browser_persistent_state::in,
|
|
browser_persistent_state::out, io__state::di, io__state::uo)
|
|
is cc_multi.
|
|
|
|
browse_common(Debugger, Object, InputStream, OutputStream, MaybeFormat,
|
|
MaybeMark, State0, State) -->
|
|
{ Info0 = browser_info__init(Object, MaybeFormat, State0) },
|
|
io__set_input_stream(InputStream, OldInputStream),
|
|
io__set_output_stream(OutputStream, OldOutputStream),
|
|
% startup_message,
|
|
browse_main_loop(Debugger, Info0, Info),
|
|
io__set_input_stream(OldInputStream, _),
|
|
io__set_output_stream(OldOutputStream, _),
|
|
{ MaybeMark = Info ^ maybe_mark },
|
|
{ State = Info ^ state }.
|
|
|
|
% This predicate converts synthetic terms from the representation used in the
|
|
% trace directory (as a list of arguments, the last of which represents the
|
|
% return value for function calls) to the representation used in the browser
|
|
% directory, in which a function call's return value is stored separately from
|
|
% the other arguments.
|
|
%
|
|
% The reason why the trace directory does not use the latter representation
|
|
% is that it would require C code to construct values of type maybe(T).
|
|
|
|
:- pred synthetic_term_to_browser_term(string::in, list(univ)::in, bool::in,
|
|
browser_term::out) is det.
|
|
|
|
synthetic_term_to_browser_term(FunctorString, Args, IsFunc, BrowserTerm) :-
|
|
(
|
|
IsFunc = no,
|
|
BrowserTerm = synthetic_term(FunctorString, Args, no)
|
|
;
|
|
IsFunc = yes,
|
|
list__split_last_det(Args, FuncArgs, Return),
|
|
BrowserTerm = synthetic_term(FunctorString, FuncArgs,
|
|
yes(Return))
|
|
).
|
|
|
|
:- pred browse_main_loop(debugger::in, browser_info::in, browser_info::out,
|
|
io__state::di, io__state::uo) is cc_multi.
|
|
|
|
browse_main_loop(Debugger, Info0, Info) -->
|
|
(
|
|
{ Debugger = internal },
|
|
{ prompt(Prompt) },
|
|
parse__read_command(Prompt, Command)
|
|
;
|
|
{ Debugger = external },
|
|
parse__read_command_external(Command)
|
|
),
|
|
run_command(Debugger, Command, Quit, Info0, Info1),
|
|
(
|
|
{ Quit = yes },
|
|
% write_string_debugger(Debugger, "quitting...\n")
|
|
(
|
|
{ Debugger = external },
|
|
send_term_to_socket(browser_quit)
|
|
;
|
|
{ Debugger = internal }
|
|
),
|
|
{ Info = Info1 }
|
|
;
|
|
{ Quit = no },
|
|
browse_main_loop(Debugger, Info1, Info)
|
|
).
|
|
|
|
:- pred startup_message(debugger::in, io__state::di, io__state::uo) is det.
|
|
|
|
startup_message(Debugger) -->
|
|
write_string_debugger(Debugger, "-- Simple Mercury Term Browser.\n"),
|
|
write_string_debugger(Debugger, "-- Type \"help\" for help.\n\n").
|
|
|
|
:- pred prompt(string::out) is det.
|
|
|
|
prompt("browser> ").
|
|
|
|
:- pred run_command(debugger::in, command::in, bool::out, browser_info::in,
|
|
browser_info::out, io__state::di, io__state::uo) is cc_multi.
|
|
|
|
run_command(Debugger, Command, Quit, Info0, Info) -->
|
|
% 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 = unknown },
|
|
write_string_debugger(Debugger,
|
|
"Error: unknown command or syntax error.\n"),
|
|
write_string_debugger(Debugger, "Type \"help\" for help.\n"),
|
|
{ Quit = no },
|
|
{ Info = Info0 }
|
|
; { Command = help },
|
|
help(Debugger),
|
|
{ Quit = no },
|
|
{ Info = Info0 }
|
|
; { Command = set },
|
|
show_settings(Debugger, Info0, no),
|
|
{ Quit = no },
|
|
{ Info = Info0 }
|
|
; { Command = set(Setting) },
|
|
{ set_browse_param(Setting, Info0, Info) },
|
|
{ Quit = no }
|
|
; { Command = ls },
|
|
portray(Debugger, browse, no, Info0),
|
|
{ Quit = no },
|
|
{ Info = Info0 }
|
|
; { Command = ls(Path) },
|
|
portray_path(Debugger, browse, no, Info0, Path),
|
|
{ Quit = no },
|
|
{ Info = Info0 }
|
|
; { Command = cd },
|
|
{ set_path(root_rel([]), Info0, Info) },
|
|
{ Quit = no }
|
|
; { Command = cd(Path) },
|
|
{ change_dir(Info0 ^ dirs, Path, NewPwd) },
|
|
( { deref_subterm(Info0 ^ term, NewPwd, _SubUniv) } ->
|
|
{ Info = Info0 ^ dirs := NewPwd }
|
|
;
|
|
write_string_debugger(Debugger,
|
|
"error: cannot change to subterm\n"),
|
|
{ Info = Info0 }
|
|
),
|
|
{ Quit = no }
|
|
; { Command = print },
|
|
portray(Debugger, print, no, Info0),
|
|
{ Quit = no },
|
|
{ Info = Info0 }
|
|
; { Command = pwd },
|
|
write_path(Debugger, Info0 ^ dirs),
|
|
nl_debugger(Debugger),
|
|
{ Quit = no },
|
|
{ Info = Info0 }
|
|
; { Command = mark },
|
|
{ Quit = yes },
|
|
{ Info = Info0 ^ maybe_mark := yes(Info0 ^ dirs) }
|
|
; { Command = mark(Path) },
|
|
{ change_dir(Info0 ^ dirs, Path, NewPwd) },
|
|
( { deref_subterm(Info0 ^ term, NewPwd, _SubUniv) } ->
|
|
{ Quit = yes },
|
|
{ Info = Info0 ^ maybe_mark := yes(NewPwd) }
|
|
;
|
|
write_string_debugger(Debugger,
|
|
"error: cannot mark subterm\n"),
|
|
{ Quit = no },
|
|
{ Info = Info0 }
|
|
)
|
|
; { Command = quit },
|
|
{ Quit = yes },
|
|
{ Info = Info0 }
|
|
; { Command = display },
|
|
write_string_debugger(Debugger,
|
|
"command not yet implemented\n"),
|
|
{ Quit = no },
|
|
{ Info = Info0 }
|
|
; { Command = write },
|
|
write_string_debugger(Debugger,
|
|
"command not yet implemented\n"),
|
|
{ Quit = no },
|
|
{ Info = Info0 }
|
|
),
|
|
( { Debugger = external } ->
|
|
send_term_to_socket(browser_end_command)
|
|
;
|
|
{ true }
|
|
).
|
|
|
|
:- pred set_browse_param(setting, browser_info, browser_info).
|
|
:- mode set_browse_param(in, in, out) is det.
|
|
|
|
set_browse_param(Setting, Info0, Info) :-
|
|
%
|
|
% XXX We can't yet give options to the `set' command.
|
|
%
|
|
No = bool__no,
|
|
browser_info__set_param(No, No, No, No, No, No, No, Setting,
|
|
Info0 ^ state, NewState),
|
|
Info = Info0 ^ state := NewState.
|
|
|
|
:- pred help(debugger::in, io__state::di, io__state::uo) is det.
|
|
help(Debugger) -->
|
|
{ string__append_list([
|
|
"Commands are:\n",
|
|
"\tls [path] -- list subterm (expanded)\n",
|
|
"\tcd [path] -- cd current subterm (default is root)\n",
|
|
"\thelp -- show this help message\n",
|
|
"\tset var value -- set a setting\n",
|
|
"\tset -- show settings\n",
|
|
"\tprint -- show single line representation of current term\n",
|
|
"\tquit -- quit browser\n",
|
|
"\tmark [path] -- mark the given subterm (default is current) and quit\n",
|
|
"SICStus Prolog style commands are:\n",
|
|
"\tp -- print\n",
|
|
"\t< n -- set depth\n",
|
|
"\t^ [path] -- cd [path] (default is root)\n",
|
|
"\t? -- help\n",
|
|
"\th -- help\n",
|
|
"\n",
|
|
"-- settings:\n",
|
|
"-- size; depth; path; format (flat raw_pretty verbose pretty); width; ",
|
|
"lines\n",
|
|
"-- Paths can be Unix-style or SICStus-style: /2/3/1 or ^2^3^1\n",
|
|
"\n"],
|
|
HelpMessage) },
|
|
write_string_debugger(Debugger, HelpMessage).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Various pretty-print routines
|
|
%
|
|
|
|
:- pred portray(debugger::in, browse_caller_type::in,
|
|
maybe(portray_format)::in, browser_info::in,
|
|
io__state::di, io__state::uo) is cc_multi.
|
|
|
|
portray(Debugger, Caller, MaybeFormat, Info) -->
|
|
{ browser_info__get_format(Info, Caller, MaybeFormat, Format) },
|
|
{ browser_info__get_format_params(Info, Caller, Format, Params) },
|
|
(
|
|
{ deref_subterm(Info ^ term, Info ^ dirs, SubUniv) }
|
|
->
|
|
(
|
|
{ Format = flat },
|
|
portray_flat(Debugger, SubUniv, Params)
|
|
;
|
|
{ Format = raw_pretty },
|
|
portray_raw_pretty(Debugger, SubUniv, Params)
|
|
;
|
|
{ Format = verbose },
|
|
portray_verbose(Debugger, SubUniv, Params)
|
|
;
|
|
{ Format = pretty },
|
|
portray_pretty(Debugger, SubUniv, Params)
|
|
)
|
|
;
|
|
write_string_debugger(Debugger, "error: no such subterm")
|
|
),
|
|
nl_debugger(Debugger).
|
|
|
|
:- pred portray_path(debugger::in, browse_caller_type::in,
|
|
maybe(portray_format)::in, browser_info::in, path::in,
|
|
io__state::di, io__state::uo) is cc_multi.
|
|
|
|
portray_path(Debugger, Caller, MaybeFormat, Info0, Path) -->
|
|
{ set_path(Path, Info0, Info) },
|
|
portray(Debugger, Caller, MaybeFormat, Info).
|
|
|
|
:- pred portray_flat(debugger::in, browser_term::in, format_params::in,
|
|
io__state::di, io__state::uo) is cc_multi.
|
|
|
|
portray_flat(Debugger, BrowserTerm, Params) -->
|
|
%
|
|
% 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 io__write (actually io__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) },
|
|
( { RemainingSize >= 0 } ->
|
|
portray_flat_write_browser_term(BrowserTerm)
|
|
;
|
|
{ browser_term_to_string(BrowserTerm, Params ^ size,
|
|
Params ^ depth, Str) },
|
|
write_string_debugger(Debugger, Str)
|
|
).
|
|
|
|
:- pred portray_flat_write_browser_term(browser_term::in,
|
|
io__state::di, io__state::uo) is det.
|
|
|
|
portray_flat_write_browser_term(plain_term(Univ)) -->
|
|
io__write_univ(Univ).
|
|
portray_flat_write_browser_term(synthetic_term(Functor, Args, MaybeReturn)) -->
|
|
io__write_string(Functor),
|
|
( { Args = [] } ->
|
|
[]
|
|
;
|
|
io__write_string("("),
|
|
io__write_list(Args, ", ", io__write_univ),
|
|
io__write_string(")")
|
|
),
|
|
(
|
|
{ MaybeReturn = yes(Return) },
|
|
io__write_string(" = "),
|
|
io__write_univ(Return)
|
|
;
|
|
{ MaybeReturn = no }
|
|
).
|
|
|
|
:- pred portray_verbose(debugger::in, browser_term::in, format_params::in,
|
|
io__state::di, io__state::uo) is cc_multi.
|
|
|
|
portray_verbose(Debugger, BrowserTerm, Params) -->
|
|
{ browser_term_to_string_verbose(BrowserTerm, Params ^ size,
|
|
Params ^ depth, Params ^ width, Params ^ lines, Str) },
|
|
write_string_debugger(Debugger, Str).
|
|
|
|
:- pred portray_raw_pretty(debugger::in, browser_term::in, format_params::in,
|
|
io__state::di, io__state::uo) is det.
|
|
|
|
portray_raw_pretty(Debugger, BrowserTerm, Params) -->
|
|
{ browser_term_to_string_raw_pretty(BrowserTerm, Params ^ width,
|
|
Params ^ depth, Str) },
|
|
write_string_debugger(Debugger, Str).
|
|
|
|
:- pred portray_pretty(debugger::in, browser_term::in, format_params::in,
|
|
io__state::di, io__state::uo) is cc_multi.
|
|
|
|
portray_pretty(Debugger, BrowserTerm, Params) -->
|
|
{ sized_pretty__browser_term_to_string_line(BrowserTerm,
|
|
Params ^ width, Params ^ lines, Str) },
|
|
write_string_debugger(Debugger, Str).
|
|
|
|
% 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) :-
|
|
(
|
|
MaxSize < 0
|
|
->
|
|
RemainingSize = MaxSize
|
|
;
|
|
limited_deconstruct_cc(univ_value(Univ), MaxSize,
|
|
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)
|
|
;
|
|
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)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Single-line representation of a term.
|
|
%
|
|
|
|
:- pred browser_term_to_string(browser_term::in, int::in, int::in,
|
|
string::out) is cc_multi.
|
|
|
|
browser_term_to_string(BrowserTerm, MaxSize, MaxDepth, Str) :-
|
|
CurSize = 0,
|
|
CurDepth = 0,
|
|
browser_term_to_string_2(BrowserTerm, MaxSize, CurSize, _NewSize,
|
|
MaxDepth, CurDepth, Str).
|
|
|
|
% Note: When the size limit is reached, we simply display
|
|
% further subterms compressed. We don't just stop printing.
|
|
% XXX: Is this reasonable?
|
|
:- pred browser_term_to_string_2(browser_term::in, int::in, int::in, int::out,
|
|
int::in, int::in, string::out) is cc_multi.
|
|
|
|
browser_term_to_string_2(BrowserTerm, MaxSize, CurSize, NewSize,
|
|
MaxDepth, CurDepth, Str) :-
|
|
(
|
|
CurSize < MaxSize,
|
|
CurDepth < MaxDepth,
|
|
limited_deconstruct_browser_term_cc(BrowserTerm, MaxSize,
|
|
Functor, _Arity, Args, MaybeReturn)
|
|
->
|
|
CurSize1 = CurSize + 1,
|
|
CurDepth1 = CurDepth + 1,
|
|
args_to_string_list(Args, MaxSize, CurSize1, NewSize1,
|
|
MaxDepth, CurDepth1, ArgStrs),
|
|
BracketedArgsStr = bracket_string_list(ArgStrs),
|
|
(
|
|
MaybeReturn = yes(Return),
|
|
browser_term_to_string_2(plain_term(Return), MaxSize,
|
|
NewSize1, NewSize, MaxDepth, CurDepth1,
|
|
ReturnStr),
|
|
string__append_list([Functor, BracketedArgsStr,
|
|
" = ", ReturnStr], Str)
|
|
;
|
|
MaybeReturn = no,
|
|
NewSize = NewSize1,
|
|
string__append_list([Functor, BracketedArgsStr], Str)
|
|
)
|
|
;
|
|
% Str = "...",
|
|
browser_term_compress(BrowserTerm, Str),
|
|
NewSize = CurSize
|
|
).
|
|
|
|
:- pred args_to_string_list(list(univ)::in, int::in, int::in, int::out,
|
|
int::in, int::in, list(string)::out) is cc_multi.
|
|
|
|
args_to_string_list([], _MaxSize, CurSize, NewSize,
|
|
_MaxDepth, _CurDepth, Strs) :-
|
|
Strs = [],
|
|
NewSize = CurSize.
|
|
args_to_string_list([Univ | Univs], MaxSize, CurSize, NewSize,
|
|
MaxDepth, CurDepth, Strs) :-
|
|
browser_term_to_string_2(plain_term(Univ), MaxSize, CurSize, NewSize1,
|
|
MaxDepth, CurDepth, Str),
|
|
args_to_string_list(Univs, MaxSize, NewSize1, NewSize,
|
|
MaxDepth, CurDepth, RestStrs),
|
|
Strs = [Str | RestStrs].
|
|
|
|
:- func bracket_string_list(list(string)) = string.
|
|
|
|
bracket_string_list(Args) = Str :-
|
|
( Args = [] ->
|
|
Str = ""
|
|
;
|
|
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_term::in, string::out) is cc_multi.
|
|
|
|
browser_term_compress(BrowserTerm, Str) :-
|
|
functor_browser_term_cc(BrowserTerm, Functor, Arity, IsFunc),
|
|
( Arity = 0 ->
|
|
Str = Functor
|
|
;
|
|
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 the size of the term is not limited---the pretty printer
|
|
% provides no way of doing this.
|
|
%
|
|
|
|
:- pred browser_term_to_string_raw_pretty(browser_term::in, int::in, int::in,
|
|
string::out) is det.
|
|
|
|
browser_term_to_string_raw_pretty(plain_term(Univ), Width, MaxDepth, Str) :-
|
|
Value = univ_value(Univ),
|
|
Doc = to_doc(MaxDepth, Value),
|
|
Str = to_string(Width, Doc).
|
|
browser_term_to_string_raw_pretty(synthetic_term(Functor, Args, MaybeReturn),
|
|
Width, MaxDepth, Str) :-
|
|
Doc = synthetic_term_to_doc(MaxDepth, Functor, Args, MaybeReturn),
|
|
Str = to_string(Width, Doc).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Verbose printing. Tree layout with numbered branches.
|
|
% Numbering makes it easier to change to subterms.
|
|
%
|
|
|
|
:- pred browser_term_to_string_verbose(browser_term::in, int::in, int::in,
|
|
int::in, int::in, string::out) is cc_multi.
|
|
|
|
browser_term_to_string_verbose(BrowserTerm, MaxSize, MaxDepth, X, Y, Str) :-
|
|
CurSize = 0,
|
|
CurDepth = 0,
|
|
browser_term_to_string_verbose_2(BrowserTerm, MaxSize, CurSize,
|
|
_NewSize, MaxDepth, CurDepth, Frame),
|
|
frame__clip(X-Y, Frame, ClippedFrame),
|
|
unlines(ClippedFrame, Str).
|
|
|
|
:- pred browser_term_to_string_verbose_2(browser_term::in, int::in, int::in,
|
|
int::out, int::in, int::in, frame::out) is cc_multi.
|
|
|
|
browser_term_to_string_verbose_2(BrowserTerm, MaxSize, CurSize, NewSize,
|
|
MaxDepth, CurDepth, Frame) :-
|
|
(
|
|
CurSize < MaxSize,
|
|
CurDepth < MaxDepth,
|
|
limited_deconstruct_browser_term_cc(BrowserTerm, MaxSize,
|
|
Functor, _Arity, Args0, MaybeReturn)
|
|
->
|
|
% XXX we should consider formatting function terms differently.
|
|
(
|
|
MaybeReturn = yes(Return),
|
|
list__append(Args0, [Return], Args)
|
|
;
|
|
MaybeReturn = no,
|
|
Args = Args0
|
|
),
|
|
CurSize1 is CurSize + 1,
|
|
CurDepth1 is CurDepth + 1,
|
|
ArgNum = 1,
|
|
args_to_string_verbose_list(Args, ArgNum, MaxSize, CurSize1,
|
|
NewSize, MaxDepth, CurDepth1, ArgsFrame),
|
|
frame__vglue([Functor], ArgsFrame, Frame)
|
|
;
|
|
browser_term_compress(BrowserTerm, Line),
|
|
Frame = [Line],
|
|
NewSize = CurSize
|
|
).
|
|
|
|
:- pred args_to_string_verbose_list(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([], _ArgNum, _MaxSize, CurSize, NewSize,
|
|
_MaxDepth, _CurDepth, []) :-
|
|
NewSize = CurSize.
|
|
args_to_string_verbose_list([Univ], ArgNum, MaxSize, CurSize, NewSize,
|
|
MaxDepth, CurDepth, Frame) :-
|
|
browser_term_to_string_verbose_2(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__hglue([LastBranchS], TreeFrame, Frame).
|
|
args_to_string_verbose_list([Univ1, Univ2 | Univs], ArgNum, MaxSize,
|
|
CurSize, NewSize, MaxDepth, CurDepth, Frame) :-
|
|
browser_term_to_string_verbose_2(plain_term(Univ1), MaxSize, CurSize,
|
|
NewSize1, MaxDepth, CurDepth, TreeFrame),
|
|
ArgNum1 is ArgNum + 1,
|
|
args_to_string_verbose_list([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),
|
|
frame__vsize(TreeFrame, Height),
|
|
Height1 is Height - 1,
|
|
list__duplicate(Height1, "|", VBranchFrame),
|
|
frame__vglue([BranchFrameS], VBranchFrame, LeftFrame),
|
|
frame__hglue(LeftFrame, TreeFrame, TopFrame),
|
|
frame__vglue(TopFrame, RestTreesFrame, Frame).
|
|
|
|
:- 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
|
|
%
|
|
|
|
:- pred write_path(debugger, list(dir), io__state, io__state).
|
|
:- mode write_path(in, in, di, uo) is det.
|
|
write_path(Debugger, []) -->
|
|
write_string_debugger(Debugger, "/").
|
|
write_path(Debugger, [Dir]) -->
|
|
(
|
|
{ Dir = parent },
|
|
write_string_debugger(Debugger, "/")
|
|
;
|
|
{ Dir = child_num(N) },
|
|
write_string_debugger(Debugger, "/"),
|
|
write_int_debugger(Debugger, N)
|
|
;
|
|
{ Dir = child_name(Name) },
|
|
write_string_debugger(Debugger, "/"),
|
|
write_string_debugger(Debugger, Name)
|
|
).
|
|
write_path(Debugger, [Dir, Dir2 | Dirs]) -->
|
|
write_path_2(Debugger, [Dir, Dir2 | Dirs]).
|
|
|
|
|
|
:- pred write_path_2(debugger, list(dir), io__state, io__state).
|
|
:- mode write_path_2(in, in, di, uo) is det.
|
|
write_path_2(Debugger, []) -->
|
|
write_string_debugger(Debugger, "/").
|
|
write_path_2(Debugger, [Dir]) -->
|
|
(
|
|
{ Dir = parent },
|
|
write_string_debugger(Debugger, "/..")
|
|
;
|
|
{ Dir = child_num(N) },
|
|
write_string_debugger(Debugger, "/"),
|
|
write_int_debugger(Debugger, N)
|
|
;
|
|
{ Dir = child_name(Name) },
|
|
write_string_debugger(Debugger, "/"),
|
|
write_string_debugger(Debugger, Name)
|
|
).
|
|
write_path_2(Debugger, [Dir, Dir2 | Dirs]) -->
|
|
(
|
|
{ Dir = parent },
|
|
write_string_debugger(Debugger, "/.."),
|
|
write_path_2(Debugger, [Dir2 | Dirs])
|
|
;
|
|
{ Dir = child_num(N) },
|
|
write_string_debugger(Debugger, "/"),
|
|
write_int_debugger(Debugger, N),
|
|
write_path_2(Debugger, [Dir2 | Dirs])
|
|
;
|
|
{ Dir = child_name(Name) },
|
|
write_string_debugger(Debugger, "/"),
|
|
write_string_debugger(Debugger, Name),
|
|
write_path_2(Debugger, [Dir2 | Dirs])
|
|
).
|
|
|
|
% 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(dir)::in, browser_term::out)
|
|
is semidet.
|
|
|
|
deref_subterm(BrowserTerm, Path, SubBrowserTerm) :-
|
|
simplify_dirs(Path, SimplifiedPath),
|
|
(
|
|
BrowserTerm = plain_term(Univ),
|
|
deref_subterm_2(Univ, SimplifiedPath, SubUniv),
|
|
SubBrowserTerm = plain_term(SubUniv)
|
|
;
|
|
BrowserTerm = synthetic_term(_Functor, Args, MaybeReturn),
|
|
(
|
|
SimplifiedPath = [],
|
|
SubBrowserTerm = BrowserTerm
|
|
;
|
|
SimplifiedPath = [Step | SimplifiedPathTail],
|
|
(
|
|
Step = child_num(N),
|
|
% The first argument of a non-array is numbered
|
|
% argument 1.
|
|
list__index1(Args, N, ArgUniv)
|
|
;
|
|
Step = child_name(Name),
|
|
(
|
|
MaybeReturn = yes(ArgUnivPrime),
|
|
( Name = "r"
|
|
; Name = "res"
|
|
; Name = "result"
|
|
)
|
|
->
|
|
ArgUniv = ArgUnivPrime
|
|
;
|
|
fail
|
|
)
|
|
;
|
|
Step = parent,
|
|
error("deref_subterm: found parent")
|
|
),
|
|
deref_subterm_2(ArgUniv, SimplifiedPathTail, SubUniv),
|
|
SubBrowserTerm = plain_term(SubUniv)
|
|
)
|
|
).
|
|
|
|
:- pred deref_subterm_2(univ::in, list(dir)::in, univ::out) is semidet.
|
|
|
|
deref_subterm_2(Univ, Path, SubUniv) :-
|
|
(
|
|
Path = [],
|
|
Univ = SubUniv
|
|
;
|
|
Path = [Dir | Dirs],
|
|
(
|
|
Dir = child_num(N),
|
|
(
|
|
TypeCtor = type_ctor(univ_type(Univ)),
|
|
type_ctor_name(TypeCtor) = "array",
|
|
type_ctor_module_name(TypeCtor) = "array"
|
|
->
|
|
% The first element of an array is at
|
|
% index zero.
|
|
ArgN = argument(univ_value(Univ), N)
|
|
;
|
|
% The first argument of a non-array is numbered
|
|
% argument 1 by the user but argument 0 by
|
|
% std_util:argument.
|
|
ArgN = argument(univ_value(Univ), N - 1)
|
|
)
|
|
;
|
|
Dir = child_name(Name),
|
|
ArgN = named_argument(univ_value(Univ), Name)
|
|
;
|
|
Dir = parent,
|
|
error("deref_subterm_2: found parent")
|
|
),
|
|
deref_subterm_2(ArgN, Dirs, SubUniv)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred get_path(browser_info, path).
|
|
:- mode get_path(in, out) is det.
|
|
get_path(Info, root_rel(Info ^ dirs)).
|
|
|
|
:- pred set_path(path, browser_info, browser_info).
|
|
:- mode set_path(in, in, out) is det.
|
|
set_path(NewPath, Info0, Info) :-
|
|
change_dir(Info0 ^ dirs, NewPath, NewDirs),
|
|
Info = Info0 ^ dirs := NewDirs.
|
|
|
|
:- pred change_dir(list(dir), path, list(dir)).
|
|
:- mode change_dir(in, in, out) is det.
|
|
change_dir(PwdDirs, Path, RootRelDirs) :-
|
|
(
|
|
Path = root_rel(Dirs),
|
|
NewDirs = Dirs
|
|
;
|
|
Path = dot_rel(Dirs),
|
|
list__append(PwdDirs, Dirs, NewDirs)
|
|
),
|
|
simplify_dirs(NewDirs, RootRelDirs).
|
|
|
|
:- pred set_term(univ::in, browser_info::in, browser_info::out) is det.
|
|
|
|
set_term(Term, Info0, Info) :-
|
|
set_browser_term(plain_term(Term), Info0, Info1),
|
|
% Display from the root term.
|
|
% This avoid errors due to dereferencing non-existent subterms.
|
|
set_path(root_rel([]), Info1, Info).
|
|
|
|
:- pred set_browser_term(browser_term::in, browser_info::in, browser_info::out)
|
|
is det.
|
|
|
|
set_browser_term(BrowserTerm, Info, Info ^ term := BrowserTerm).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Display predicates.
|
|
%
|
|
|
|
:- pred show_settings(debugger, browser_info, maybe(portray_format),
|
|
io__state, io__state).
|
|
:- mode show_settings(in, in, in, di, uo) is det.
|
|
|
|
show_settings(Debugger, Info, MaybeFormat) -->
|
|
{ browser_info__get_format(Info, browse, MaybeFormat, Format) },
|
|
{ browser_info__get_format_params(Info, browse, Format, Params) },
|
|
write_string_debugger(Debugger, "Max depth is: "),
|
|
write_int_debugger(Debugger, Params ^ depth),
|
|
nl_debugger(Debugger),
|
|
write_string_debugger(Debugger, "Max size is: "),
|
|
write_int_debugger(Debugger, Params ^ size),
|
|
nl_debugger(Debugger),
|
|
write_string_debugger(Debugger, "X clip is: "),
|
|
write_int_debugger(Debugger, Params ^ width),
|
|
nl_debugger(Debugger),
|
|
write_string_debugger(Debugger, "Y clip is: "),
|
|
write_int_debugger(Debugger, Params ^ lines),
|
|
nl_debugger(Debugger),
|
|
write_string_debugger(Debugger, "Current path is: "),
|
|
write_path(Debugger, Info ^ dirs),
|
|
nl_debugger(Debugger),
|
|
{ browser_info__get_format(Info, browse, no, LsFormat) },
|
|
write_string_debugger(Debugger, "Ls format is "),
|
|
print_format_debugger(Debugger, LsFormat),
|
|
nl_debugger(Debugger),
|
|
{ browser_info__get_format(Info, print, no, PrintFormat) },
|
|
write_string_debugger(Debugger, "Print format is "),
|
|
print_format_debugger(Debugger, PrintFormat),
|
|
nl_debugger(Debugger).
|
|
|
|
:- pred string_to_path(string, path).
|
|
:- mode string_to_path(in, out) is semidet.
|
|
string_to_path(Str, Path) :-
|
|
string__to_char_list(Str, Cs),
|
|
chars_to_path(Cs, Path).
|
|
|
|
:- pred chars_to_path(list(char), path).
|
|
:- mode chars_to_path(in, out) is semidet.
|
|
chars_to_path([C | Cs], Path) :-
|
|
( C = ('/') ->
|
|
Path = root_rel(Dirs),
|
|
chars_to_dirs(Cs, Dirs)
|
|
;
|
|
Path = dot_rel(Dirs),
|
|
chars_to_dirs([C | Cs], Dirs)
|
|
).
|
|
|
|
:- pred chars_to_dirs(list(char), list(dir)).
|
|
:- mode chars_to_dirs(in, out) is semidet.
|
|
chars_to_dirs(Cs, Dirs) :-
|
|
split_dirs(Cs, Names),
|
|
names_to_dirs(Names, Dirs).
|
|
|
|
:- pred names_to_dirs(list(string), list(dir)).
|
|
:- mode names_to_dirs(in, out) is semidet.
|
|
names_to_dirs([], []).
|
|
names_to_dirs([Name | Names], Dirs) :-
|
|
( Name = ".." ->
|
|
Dirs = [parent | RestDirs],
|
|
names_to_dirs(Names, RestDirs)
|
|
; Name = "." ->
|
|
names_to_dirs(Names, Dirs)
|
|
; string__to_int(Name, Num) ->
|
|
Dirs = [child_num(Num) | RestDirs],
|
|
names_to_dirs(Names, RestDirs)
|
|
;
|
|
Dirs = [child_name(Name) | RestDirs],
|
|
names_to_dirs(Names, RestDirs)
|
|
).
|
|
|
|
|
|
:- pred split_dirs(list(char), list(string)).
|
|
:- mode split_dirs(in, out) is det.
|
|
split_dirs(Cs, Names) :-
|
|
takewhile(not_slash, Cs, NameCs, Rest),
|
|
string__from_char_list(NameCs, Name),
|
|
( NameCs = [] ->
|
|
Names = []
|
|
; Rest = [] ->
|
|
Names = [Name]
|
|
; Rest = [_Slash | RestCs] ->
|
|
split_dirs(RestCs, RestNames),
|
|
Names = [Name | RestNames]
|
|
;
|
|
error("split_dirs: software error")
|
|
).
|
|
|
|
|
|
:- pred not_slash(char).
|
|
:- mode not_slash(in) is semidet.
|
|
not_slash(C) :-
|
|
C \= ('/').
|
|
|
|
% Remove "/dir/../" sequences from a list of directories to yield
|
|
% a form that lacks ".." entries.
|
|
% NB: This can be done more efficiently than simple iteration
|
|
% to a limit.
|
|
:- pred simplify_dirs(list(dir), list(dir)).
|
|
:- mode simplify_dirs(in, out) is det.
|
|
simplify_dirs(Dirs, SimpleDirs) :-
|
|
util__limit(simplify, Dirs, SimpleDirs).
|
|
|
|
% If possible, remove a single occurence of
|
|
% either:
|
|
% - "dir/../"
|
|
% or:
|
|
% - "/.." (parent of root is root)
|
|
%
|
|
:- pred simplify(list(dir), list(dir)).
|
|
:- mode simplify(in, out) is det.
|
|
simplify([], []).
|
|
simplify([First | Rest], Simplified) :-
|
|
( First = parent ->
|
|
Simplified = Rest
|
|
; Rest = [] ->
|
|
Simplified = [First]
|
|
; Rest = [parent | Tail] ->
|
|
Simplified = Tail
|
|
;
|
|
simplify(Rest, SimplifiedRest),
|
|
Simplified = [First | SimplifiedRest]
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred write_string_debugger(debugger, string, io__state, io__state).
|
|
:- mode write_string_debugger(in, in, di, uo) is det.
|
|
write_string_debugger(internal, String) -->
|
|
io__write_string(String).
|
|
write_string_debugger(external, String) -->
|
|
send_term_to_socket(browser_str(String)).
|
|
|
|
:- pred nl_debugger(debugger, io__state, io__state).
|
|
:- mode nl_debugger(in, di, uo) is det.
|
|
nl_debugger(internal) -->
|
|
io__nl.
|
|
nl_debugger(external) -->
|
|
send_term_to_socket(browser_nl).
|
|
|
|
:- pred write_int_debugger(debugger, int, io__state, io__state).
|
|
:- mode write_int_debugger(in, in, di, uo) is det.
|
|
write_int_debugger(internal, Int) -->
|
|
io__write_int(Int).
|
|
write_int_debugger(external, Int) -->
|
|
send_term_to_socket(browser_int(Int)).
|
|
|
|
|
|
:- pred print_format_debugger(debugger, portray_format, io__state, io__state).
|
|
:- mode print_format_debugger(in, in, di, uo) is det.
|
|
print_format_debugger(internal, X) -->
|
|
io__print(X).
|
|
print_format_debugger(external, X) -->
|
|
(
|
|
{ X = flat },
|
|
send_term_to_socket(browser_str("flat"))
|
|
;
|
|
{ X = raw_pretty },
|
|
send_term_to_socket(browser_str("raw_pretty"))
|
|
;
|
|
{ X = verbose },
|
|
send_term_to_socket(browser_str("verbose"))
|
|
;
|
|
{ X = pretty },
|
|
send_term_to_socket(browser_str("pretty"))
|
|
).
|
|
|
|
:- pred send_term_to_socket(term_browser_response, io__state, io__state).
|
|
:- mode send_term_to_socket(in, di, uo) is det.
|
|
send_term_to_socket(Term) -->
|
|
write(Term),
|
|
print(".\n"),
|
|
flush_output.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% These two functions are just like 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.
|
|
|
|
:- func synthetic_term_to_doc(string, list(univ), maybe(univ)) = doc.
|
|
:- func synthetic_term_to_doc(int, string, list(univ), maybe(univ)) = doc.
|
|
|
|
synthetic_term_to_doc(Functor, Args, MaybeReturn) =
|
|
synthetic_term_to_doc(int__max_int, Functor, Args, MaybeReturn).
|
|
|
|
synthetic_term_to_doc(Depth, Functor, Args, MaybeReturn) = Doc :-
|
|
Arity = list__length(Args),
|
|
( Depth =< 0 ->
|
|
( Arity = 0 ->
|
|
Doc = text(Functor)
|
|
;
|
|
(
|
|
MaybeReturn = yes(_),
|
|
Doc = text(Functor) `<>` text("/") `<>`
|
|
poly(i(Arity)) `<>` text("+1")
|
|
;
|
|
MaybeReturn = no,
|
|
Doc = text(Functor) `<>` text("/") `<>`
|
|
poly(i(Arity))
|
|
)
|
|
)
|
|
;
|
|
( Arity = 0 ->
|
|
Doc = text(Functor)
|
|
;
|
|
ArgDocs = packed_cs_univ_args(Depth - 1, Args),
|
|
(
|
|
MaybeReturn = yes(Return),
|
|
Doc = group(
|
|
text(Functor) `<>`
|
|
parentheses(
|
|
nest(2, ArgDocs)
|
|
) `<>`
|
|
nest(2, text(" = ") `<>`
|
|
to_doc(Depth - 1, Return)
|
|
)
|
|
)
|
|
;
|
|
MaybeReturn = no,
|
|
Doc = group(
|
|
text(Functor) `<>` parentheses(
|
|
nest(2, ArgDocs)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|