%---------------------------------------------------------------------------% % Copyright (C) 1998-2003 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, int, char, map, std_util, getopt. :- import_module parser, require, pprint, getopt, deconstruct. %---------------------------------------------------------------------------% % % 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, Caller, 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, browse, 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, !Info, !IO) :- % 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 = empty, Quit = no ; Command = 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 ; Command = help, help(Debugger, !IO), Quit = no ; Command = set, show_settings(Debugger, !.Info, !IO), Quit = no ; Command = set(MaybeOptionTable, Setting), ( MaybeOptionTable = ok(OptionTable), set_browse_param(OptionTable, Setting, !Info) ; MaybeOptionTable = error(Msg), write_string_debugger(Debugger, Msg, !IO) ), Quit = no ; Command = cd, set_path(root_rel([]), !Info), Quit = no ; Command = cd(Path), change_dir(!.Info ^ dirs, Path, NewPwd), ( deref_subterm(!.Info ^ term, NewPwd, _SubUniv) -> !:Info = !.Info ^ dirs := NewPwd ; write_string_debugger(Debugger, "error: cannot change to subterm\n", !IO) ), Quit = no ; Command = print(PrintOption, MaybePath), do_portray(Debugger, browse, PrintOption, !.Info, MaybePath, !IO), Quit = no ; Command = pwd, write_path(Debugger, !.Info ^ dirs, !IO), nl_debugger(Debugger, !IO), Quit = no ; Command = mark, !:Info = !.Info ^ maybe_mark := yes(!.Info ^ dirs), Quit = yes ; Command = mark(Path), change_dir(!.Info ^ dirs, Path, NewPwd), ( deref_subterm(!.Info ^ term, NewPwd, _SubUniv) -> !:Info = !.Info ^ maybe_mark := yes(NewPwd), Quit = yes ; write_string_debugger(Debugger, "error: cannot mark subterm\n", !IO), Quit = no ) ; Command = quit, Quit = yes ; Command = display, write_string_debugger(Debugger, "command not yet implemented\n", !IO), Quit = no ; Command = write, write_string_debugger(Debugger, "command not yet implemented\n", !IO), Quit = no ), ( Debugger = external -> send_term_to_socket(browser_end_command, !IO) ; true ). :- pred do_portray(debugger::in, browse_caller_type::in, maybe(maybe_option_table(format_option))::in, browser_info::in, maybe(path)::in, io__state::di, io__state::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) ) ; MaybeOptionTable = error(Msg), write_string_debugger(Debugger, Msg, !IO) ) ). :- 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 set_browse_param(option_table(setting_option)::in, setting::in, browser_info::in, browser_info::out) is det. set_browse_param(OptionTable, Setting, Info0, Info) :- browser_info__set_param(yes, lookup_bool_option(OptionTable, print) `with_type` bool, lookup_bool_option(OptionTable, browse) `with_type` bool, lookup_bool_option(OptionTable, print_all) `with_type` bool, lookup_bool_option(OptionTable, flat) `with_type` bool, lookup_bool_option(OptionTable, raw_pretty) `with_type` bool, lookup_bool_option(OptionTable, verbose) `with_type` bool, lookup_bool_option(OptionTable, pretty) `with_type` bool, 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", "\t[print|p|ls] [format_options] [path]\n", "\t -- print the specified subterm using the `browse' params\n", "\tcd [path] -- cd to the specified subterm (default is root)\n", "\tpwd -- print the path to the current subterm\n", "\tset [setting_options] var value\n", "\t -- set a parameter value\n", "\tset -- show parameter values\n", "\tmark [path] -- mark the given subterm (default is current) and quit\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", "-- Parameter variables with integer values:\n", "-- size ; depth ; path ; width ; lines ; num_io_actions ;\n", "-- Parameter variables with non-integer values:\n", "-- format ;\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_maybe_path(debugger::in, browse_caller_type::in, maybe(portray_format)::in, browser_info::in, maybe(path)::in, io__state::di, io__state::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__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) ; io__get_stream_db(StreamDb), { BrowserDb = browser_db(StreamDb) }, { browser_term_to_string(BrowserDb, 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 cc_multi. portray_flat_write_browser_term(plain_term(Univ)) --> io__output_stream(Stream), io__write_univ(Stream, include_details_cc, Univ). portray_flat_write_browser_term(synthetic_term(Functor, Args, MaybeReturn)) --> io__write_string(Functor), io__output_stream(Stream), ( { Args = [] } -> [] ; io__write_string("("), io__write_list(Args, ", ", pred(U::in, di, uo) is cc_multi --> ( { univ_to_type(U, _ `with_type` unbound) } -> io__write_char(Stream, '_') ; io__write_univ(Stream, include_details_cc, U) )), io__write_string(")") ), ( { MaybeReturn = yes(Return) }, io__write_string(" = "), io__write_univ(Stream, include_details_cc, 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) --> io__get_stream_db(StreamDb), { 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). :- 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) --> io__get_stream_db(StreamDb), { BrowserDb = browser_db(StreamDb) }, { sized_pretty__browser_term_to_string_line(BrowserDb, 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 ; 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) ). %---------------------------------------------------------------------------% % % 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), ( CurSize < MaxSize, CurDepth < MaxDepth, MaybeFunctorArityArgs = yes({Functor, _Arity, Args}) -> browser_term_to_string_3(BrowserDb, Functor, Args, MaybeReturn, MaxSize, CurSize, NewSize, MaxDepth, CurDepth, Str) ; 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) :- ( Functor = "[|]", Args = [ListHead, ListTail], MaybeReturn = no -> % 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) ; Functor = "[]", Args = [], MaybeReturn = no -> Size = Size0 + 1, Str = "[]" ; 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}), ( Functor = "[]", Args = [], MaybeReturn = no -> Size = Size0, TailStrs = [] ; Functor = "[|]", Args = [ListHead, ListTail], MaybeReturn = no -> ( Size0 < MaxSize, Depth0 < MaxDepth -> 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] ; Size = Size0, TailStrs = [", ..."] ) ; ( Size0 < MaxSize, Depth0 < MaxDepth -> browser_term_to_string_3(BrowserDb, Functor, Args, MaybeReturn, MaxSize, Size0, Size, MaxDepth, Depth0, TailStr), TailStrs = [" | ", TailStr] ; 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 = "" ; 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), ( 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_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), frame__clip(X-Y, Frame, ClippedFrame), 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), ( CurSize < MaxSize, CurDepth < MaxDepth, MaybeFunctorArityArgs = yes({Functor, _Arity, Args0}) -> % 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__vglue([Functor], ArgsFrame, Frame) ; 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__hglue([LastBranchS], TreeFrame, Frame). 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), frame__vsize(TreeFrame, Height), Height1 = 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::in, browser_info::in, io__state::di, io__state::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_path(Debugger, Info ^ 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 ^ state), !IO), nl_debugger(Debugger, !IO). :- pred show_settings_caller(debugger::in, browser_info::in, browse_caller_type::in, string::in, io__state::di, io__state::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", ' ', x_len), !IO), write_string_debugger(Debugger, pad_right("y clip", ' ', y_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__state::di, io__state::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), ' ', x_len), !IO), write_string_debugger(Debugger, pad_right(int_to_string(Params ^ lines), ' ', y_len), !IO), nl_debugger(Debugger, !IO). :- func row_name_len = int. :- func centering_len = int. :- func depth_len = int. :- func size_len = int. :- func x_len = int. :- func y_len = int. row_name_len = 30. centering_len = 3. depth_len = 10. size_len = 10. x_len = 10. y_len = 10. :- 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) ) ) ) ) ). %---------------------------------------------------------------------------%