mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-15 05:44:58 +00:00
672f77c4ec
Estimated hours taken: 20 Branches: main Add a new compiler option. --inform-ite-instead-of-switch. If this is enabled, the compiler will generate informational messages about if-then-elses that it thinks should be converted to switches for the sake of program reliability. Act on the output generated by this option. compiler/simplify.m: Implement the new option. Fix an old bug that could cause us to generate warnings about code that was OK in one duplicated copy but not in another (where a switch arm's code is duplicated due to the case being selected for more than one cons_id). compiler/options.m: Add the new option. Add a way to test for the bug fix in simplify. doc/user_guide.texi: Document the new option. NEWS: Mention the new option. library/*.m: mdbcomp/*.m: browser/*.m: compiler/*.m: deep_profiler/*.m: Convert if-then-elses to switches at most of the sites suggested by the new option. At the remaining sites, switching to switches would have nontrivial downsides. This typically happens with the switched-on type has many functors, and we treat one or two specially (e.g. cons/2 in the cons_id type). Perform misc cleanups in the vicinity of the if-then-else to switch conversions. In a few cases, improve the error messages generated. compiler/accumulator.m: compiler/hlds_goal.m: (Rename and) move insts for particular kinds of goal from accumulator.m to hlds_goal.m, to allow them to be used in other modules. Using these insts allowed us to eliminate some if-then-elses entirely. compiler/exprn_aux.m: Instead of fixing some if-then-elses, delete the predicates containing them, since they aren't used, and (as pointed out by the new option) would need considerable other fixing if they were ever needed again. compiler/lp_rational.m: Add prefixes to the names of the function symbols on some types, since without those prefixes, it was hard to figure out what type the switch corresponding to an old if-then-else was switching on. tests/invalid/reserve_tag.err_exp: Expect a new, improved error message.
1294 lines
46 KiB
Mathematica
1294 lines
46 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 2000-2007 The University of Melbourne.
|
|
% This file may only be copied under the terms of the GNU Library General
|
|
% Public License - see the file COPYING.LIB in the Mercury distribution.
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% File: browser_info.m
|
|
% Main author: Mark Brown
|
|
%
|
|
% Basic data structures used by the browser.
|
|
%
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- module mdb.browser_info.
|
|
:- interface.
|
|
|
|
:- import_module mdb.browser_term.
|
|
:- import_module mdb.parse.
|
|
:- import_module mdb.term_rep.
|
|
:- import_module mdbcomp.program_representation.
|
|
|
|
:- import_module bool.
|
|
:- import_module getopt.
|
|
:- import_module io.
|
|
:- import_module list.
|
|
:- import_module maybe.
|
|
:- import_module stream.
|
|
:- import_module univ.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% The non-persistent browser information. A new one of these is created
|
|
% every time the browser is called, based on the contents of the persistent
|
|
% state, and lasts for the duration of the call.
|
|
%
|
|
:- type browser_info
|
|
---> browser_info(
|
|
term :: browser_term,
|
|
% Term to browse.
|
|
|
|
dirs :: list(dir),
|
|
% The list of directories to take, starting from
|
|
% the root, to reach the current subterm.
|
|
|
|
caller_type :: browse_caller_type,
|
|
% What command called the browser?
|
|
|
|
format :: maybe(portray_format),
|
|
% Format specified as an option to the
|
|
% mdb command.
|
|
|
|
state :: browser_persistent_state,
|
|
% Persistent settings.
|
|
|
|
maybe_track :: maybe_track_subterm(list(dir)),
|
|
% Location of subterm for which the `track' or
|
|
% `mark' command was given, or `no_track' if
|
|
% the `track' command was not given.
|
|
|
|
maybe_mode_func :: maybe(browser_mode_func)
|
|
% An optional function to determine the mode
|
|
% of a particular sub-term should the user issue
|
|
% a `mode' query.
|
|
).
|
|
|
|
:- type maybe_track_subterm(P)
|
|
---> no_track
|
|
; track(how_track_subterm, should_assert_invalid, P).
|
|
|
|
:- type how_track_subterm
|
|
---> track_accurate
|
|
; track_fast.
|
|
|
|
:- type should_assert_invalid
|
|
---> assert_invalid
|
|
; no_assert_invalid.
|
|
|
|
% A signature for functions that can be used by the browser to work
|
|
% out the mode of a sub-term.
|
|
%
|
|
:- type browser_mode_func == (func(list(dir)) = browser_term_mode).
|
|
|
|
% The possible modes of a sub-term in the browser. Note these do
|
|
% not correspond directly with the declared Mercury modes.
|
|
%
|
|
:- type browser_term_mode
|
|
---> input
|
|
% The sub-term is bound at the call. For example the
|
|
% Mercury builtin modes `in', `di' and `ui'.
|
|
|
|
; output
|
|
% The sub-term is unbound at the call. The call
|
|
% succeeded and bound the sub-term. For example the
|
|
% Mercury builtin modes `out' and `uo'.
|
|
|
|
; unbound
|
|
% The sub-term is unbound at the call and at the
|
|
% final EXIT, FAIL or EXCP event.
|
|
|
|
; not_applicable.
|
|
% If the user asks about the mode of an atom, this
|
|
% value should be returned by the browser term mode
|
|
% function.
|
|
|
|
:- type dir
|
|
---> parent
|
|
; child_num(int)
|
|
; child_name(string).
|
|
|
|
:- inst dir_no_parent
|
|
---> child_num(ground)
|
|
; child_name(ground).
|
|
|
|
:- inst simplified_dirs == list_skel(dir_no_parent).
|
|
|
|
% The browser is required to behave differently for different
|
|
% caller circumstances. The following type enumerates the
|
|
% various possibilities.
|
|
%
|
|
:- type browse_caller_type
|
|
---> print % Non-interactively called via mdb's `print'
|
|
% command, to print a single value.
|
|
|
|
; browse % Interactively called via mdb's `browse' command.
|
|
|
|
; print_all. % Non-interactively called via mdb's `print *' command,
|
|
% to print one of a sequence of values.
|
|
|
|
% The various ways of representing terms by the browser.
|
|
%
|
|
:- type portray_format
|
|
---> flat
|
|
; raw_pretty % Calls pprint module directly, without first
|
|
% attempting to manipulate the term in any way.
|
|
; verbose
|
|
; pretty. % It allows the user to specify the maximum number
|
|
% of lines which the term has to be printed within.
|
|
|
|
:- type format_params
|
|
---> format_params(
|
|
depth :: int,
|
|
size :: int,
|
|
width :: int,
|
|
lines :: int
|
|
).
|
|
|
|
:- type setting
|
|
---> setting_depth(int)
|
|
; setting_size(int)
|
|
; setting_width(int)
|
|
; setting_lines(int)
|
|
; setting_format(portray_format).
|
|
|
|
% Initialise a new browser_info. The optional portray_format
|
|
% overrides the default format.
|
|
%
|
|
:- func init(browser_term, browse_caller_type,
|
|
maybe(portray_format), maybe(browser_mode_func),
|
|
browser_persistent_state) = browser_info.
|
|
|
|
% Get the format to use for the given caller type. The optional
|
|
% portray_format overrides the current default.
|
|
%
|
|
:- pred get_format(browser_info::in, browse_caller_type::in,
|
|
maybe(portray_format)::in, portray_format::out) is det.
|
|
|
|
% Get the format parameters for the given caller type and format.
|
|
%
|
|
:- pred get_format_params(browser_info::in, browse_caller_type::in,
|
|
portray_format::in, format_params::out) is det.
|
|
|
|
:- func get_num_printed_io_actions(browser_persistent_state) = int.
|
|
|
|
:- pred convert_dirs_to_term_path(term_rep::in, list(dir)::in(simplified_dirs),
|
|
term_path::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% A data type that holds persistent browser settings.
|
|
% This state must be saved by the caller of the browse module
|
|
% between calls.
|
|
%
|
|
:- type browser_persistent_state.
|
|
|
|
:- func browser_persistent_state ^ xml_browser_cmd = maybe(string).
|
|
:- func browser_persistent_state ^ xml_browser_cmd := maybe(string) =
|
|
browser_persistent_state.
|
|
|
|
:- func browser_persistent_state ^ xml_tmp_filename = maybe(string).
|
|
:- func browser_persistent_state ^ xml_tmp_filename := maybe(string) =
|
|
browser_persistent_state.
|
|
|
|
% Initialize the persistent browser state with default values.
|
|
%
|
|
:- pred init_persistent_state(browser_persistent_state).
|
|
:- mode init_persistent_state(out) is det.
|
|
|
|
% Update a setting in the browser state. The first argument should be
|
|
% true iff the set command is invoked from within the browser. The next
|
|
% seven arguments indicate the presence of the `set' options
|
|
% -P, -B, -A, -f, -r, -v and -p, in that order.
|
|
%
|
|
:- pred set_browser_param(bool::in, bool::in, bool::in, bool::in,
|
|
bool::in, bool::in, bool::in, bool::in, setting::in,
|
|
browser_persistent_state::in, browser_persistent_state::out) is det.
|
|
|
|
% As above but the first argument specifies where the browser was
|
|
% invoked from.
|
|
%
|
|
:- pred set_browser_param_with_caller_type(browse_caller_type::in,
|
|
bool::in, bool::in, bool::in, bool::in, bool::in, bool::in, bool::in,
|
|
setting::in, browser_persistent_state::in, browser_persistent_state::out)
|
|
is det.
|
|
|
|
% Update a setting in the browser state. The first argument should be
|
|
% true iff the set command is invoked from within the browser. The next
|
|
% argument indicates the presence of at most one of the options
|
|
% -P, -B, -A, while the next four indicate the presence of -f, -r, -v
|
|
% and -p, in that order.
|
|
%
|
|
:- pred set_browser_param_maybe_caller_type(bool::in,
|
|
maybe(browse_caller_type)::in,
|
|
bool::in, bool::in, bool::in, bool::in, setting::in,
|
|
browser_persistent_state::in, browser_persistent_state::out) is det.
|
|
|
|
% set_param_from_option_table(CallerType, OptionTable, Setting, !State).
|
|
%
|
|
% Same as set_param/11, but looks up the options in the
|
|
% supplied option table.
|
|
%
|
|
:- pred set_browser_param_from_option_table(browse_caller_type::in,
|
|
option_table(setting_option)::in, setting::in,
|
|
browser_persistent_state::in, browser_persistent_state::out) is det.
|
|
|
|
:- pred info_set_browse_param(option_table(setting_option)::in,
|
|
setting::in, browser_info::in, browser_info::out) is det.
|
|
|
|
:- pred info_set_num_io_actions(int::in,
|
|
browser_info::in, browser_info::out) is det.
|
|
|
|
:- pred info_set_xml_browser_cmd(string::in,
|
|
browser_info::in, browser_info::out) is det.
|
|
|
|
:- pred info_set_xml_tmp_filename(string::in,
|
|
browser_info::in, browser_info::out) is det.
|
|
|
|
:- pred get_num_io_actions(browser_persistent_state::in, int::out) is det.
|
|
:- pred set_num_io_actions(int::in,
|
|
browser_persistent_state::in, browser_persistent_state::out) is det.
|
|
|
|
:- type param_cmd
|
|
---> format(maybe_option_table(setting_option), setting)
|
|
; format_param(maybe_option_table(setting_option), setting)
|
|
; num_io_actions(int)
|
|
; print_params.
|
|
% We can't set the browser command from within the browser because we parse
|
|
% user commands from the browser by breaking them up into words at whitespace,
|
|
% which doesn't respect quotation marks. Since the browser command will usually
|
|
% include spaces, this parsing method would need to be changed before we could
|
|
% include xml_browser_cmd here. And until we handle xml_browser_cmd, there is
|
|
% no point in handling xml_tmp_filename.
|
|
%
|
|
% ; xml_browser_cmd(string)
|
|
% ; xml_tmp_filename(string)
|
|
|
|
:- type debugger
|
|
---> internal
|
|
; external.
|
|
%
|
|
% 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.
|
|
|
|
:- instance stream.stream(debugger, io).
|
|
:- instance stream.output(debugger, io).
|
|
:- instance stream.writer(debugger, string, io).
|
|
:- instance stream.writer(debugger, int, io).
|
|
|
|
:- pred run_param_command(debugger::in, param_cmd::in, bool::in,
|
|
browser_info::in, browser_info::out, io::di, io::uo) is det.
|
|
|
|
:- pred show_settings(debugger::in, bool::in, browser_info::in,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pred nl_debugger(debugger::in, io::di, io::uo) is det.
|
|
|
|
:- pred write_string_debugger(debugger::in, string::in, io::di, io::uo) is det.
|
|
|
|
:- pred write_int_debugger(debugger::in, int::in, io::di, io::uo) is det.
|
|
|
|
:- pred print_format_debugger(debugger::in, portray_format::in,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pred write_path(debugger::in, list(dir)::in, io::di, io::uo) is det.
|
|
|
|
:- pred send_term_to_socket(term_browser_response::in, io::di, io::uo) is det.
|
|
|
|
:- pred browser_params_to_string(browser_persistent_state::in, bool::in,
|
|
string::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% These three predicates are like the deconstruct, limited_deconstruct
|
|
% and functor procedures in deconstruct, except
|
|
%
|
|
% - they implicitly specify include_details_cc, and
|
|
% - they work on browser_terms instead of plain terms.
|
|
%
|
|
% The latter difference requires them to have an extra argument (the last).
|
|
% For deconstruct and limited_deconstruct, this returns the return value
|
|
% if the browser term represents a function call. For functor, it says
|
|
% whether the browser term represents a function call.
|
|
|
|
:- type browser_db
|
|
---> browser_db(
|
|
browser_stream_db :: io.stream_db
|
|
).
|
|
|
|
:- pred deconstruct_browser_term_cc(browser_db::in, browser_term::in,
|
|
string::out, int::out, list(univ)::out, maybe(univ)::out) is cc_multi.
|
|
|
|
:- pred limited_deconstruct_browser_term_cc(browser_db::in, browser_term::in,
|
|
int::in, maybe({string, int, list(univ)})::out, maybe(univ)::out)
|
|
is cc_multi.
|
|
|
|
:- pred functor_browser_term_cc(browser_db::in, browser_term::in, string::out,
|
|
int::out, bool::out) is cc_multi.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module mdb.term_rep.
|
|
|
|
:- import_module deconstruct.
|
|
:- import_module require.
|
|
:- import_module string.
|
|
:- import_module type_desc.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pragma foreign_export("C", init_persistent_state(out),
|
|
"ML_BROWSE_init_persistent_state").
|
|
|
|
%
|
|
% The following exported predicates are a convenient way to
|
|
% call set_param from C code.
|
|
%
|
|
|
|
:- pred set_depth_from_mdb(bool::in, bool::in, bool::in,
|
|
bool::in, bool::in, bool::in, bool::in, int::in,
|
|
browser_persistent_state::in, browser_persistent_state::out) is det.
|
|
:- pragma foreign_export("C",
|
|
set_depth_from_mdb(in, in, in, in, in, in, in, in, in, out),
|
|
"ML_BROWSE_set_depth_from_mdb").
|
|
|
|
set_depth_from_mdb(P, B, A, F, Pr, V, NPr, Depth, !Browser) :-
|
|
set_browser_param(no, P, B, A, F, Pr, V, NPr, setting_depth(Depth),
|
|
!Browser).
|
|
|
|
:- pred set_size_from_mdb(bool::in, bool::in, bool::in, bool::in,
|
|
bool::in, bool::in, bool::in, int::in,
|
|
browser_persistent_state::in, browser_persistent_state::out) is det.
|
|
:- pragma foreign_export("C",
|
|
set_size_from_mdb(in, in, in, in, in, in, in, in, in, out),
|
|
"ML_BROWSE_set_size_from_mdb").
|
|
|
|
set_size_from_mdb(P, B, A, F, Pr, NPr, V, Size, !Browser) :-
|
|
set_browser_param(no, P, B, A, F, Pr, V, NPr, setting_size(Size),
|
|
!Browser).
|
|
|
|
:- pred set_width_from_mdb(bool::in, bool::in, bool::in,
|
|
bool::in, bool::in, bool::in, bool::in, int::in,
|
|
browser_persistent_state::in, browser_persistent_state::out) is det.
|
|
:- pragma foreign_export("C",
|
|
set_width_from_mdb(in, in, in, in, in, in, in, in, in, out),
|
|
"ML_BROWSE_set_width_from_mdb").
|
|
|
|
set_width_from_mdb(P, B, A, F, Pr, V, NPr, Width, !Browser) :-
|
|
set_browser_param(no, P, B, A, F, Pr, V, NPr, setting_width(Width),
|
|
!Browser).
|
|
|
|
:- pred set_lines_from_mdb(bool::in, bool::in, bool::in,
|
|
bool::in, bool::in, bool::in, bool::in, int::in,
|
|
browser_persistent_state::in, browser_persistent_state::out) is det.
|
|
:- pragma foreign_export("C",
|
|
set_lines_from_mdb(in, in, in, in, in, in, in, in, in, out),
|
|
"ML_BROWSE_set_lines_from_mdb").
|
|
|
|
set_lines_from_mdb(P, B, A, F, Pr, V, NPr, Lines, !Browser) :-
|
|
set_browser_param(no, P, B, A, F, Pr, V, NPr, setting_lines(Lines),
|
|
!Browser).
|
|
|
|
info_set_browse_param(OptionTable, Setting, !Info) :-
|
|
PersistentState0 = !.Info ^ state,
|
|
CallerType = !.Info ^ caller_type,
|
|
set_browser_param_from_option_table(CallerType, OptionTable, Setting,
|
|
PersistentState0, PersistentState),
|
|
!:Info = !.Info ^ state := PersistentState.
|
|
|
|
info_set_num_io_actions(N, !Info) :-
|
|
PersistentState0 = !.Info ^ state,
|
|
set_num_io_actions(N, PersistentState0, PersistentState),
|
|
!:Info = !.Info ^ state := PersistentState.
|
|
|
|
info_set_xml_browser_cmd(Cmd, !Info) :-
|
|
PersistentState0 = !.Info ^ state,
|
|
set_xml_browser_cmd_from_mdb(Cmd, PersistentState0, PersistentState),
|
|
!:Info = !.Info ^ state := PersistentState.
|
|
|
|
info_set_xml_tmp_filename(FileName, !Info) :-
|
|
PersistentState0 = !.Info ^ state,
|
|
set_xml_tmp_filename_from_mdb(FileName, PersistentState0, PersistentState),
|
|
!:Info = !.Info ^ state := PersistentState.
|
|
|
|
:- pred set_format_from_mdb(bool::in, bool::in, bool::in, portray_format::in,
|
|
browser_persistent_state::in, browser_persistent_state::out) is det.
|
|
:- pragma foreign_export("C",
|
|
set_format_from_mdb(in, in, in, in, in, out),
|
|
"ML_BROWSE_set_format_from_mdb").
|
|
|
|
set_format_from_mdb(P, B, A, Format, !Browser) :-
|
|
% Any format flags are ignored for this parameter.
|
|
set_browser_param(no, P, B, A, no, no, no, no, setting_format(Format),
|
|
!Browser).
|
|
|
|
:- pragma foreign_export("C",
|
|
get_num_io_actions(in, out),
|
|
"ML_BROWSE_get_num_io_actions").
|
|
|
|
get_num_io_actions(Browser, NumIOActions) :-
|
|
NumIOActions = Browser ^ num_printed_io_actions.
|
|
|
|
:- pragma foreign_export("C",
|
|
set_num_io_actions(in, in, out),
|
|
"ML_BROWSE_set_num_io_actions").
|
|
|
|
set_num_io_actions(NumIOActions, !Browser) :-
|
|
!:Browser = !.Browser ^ num_printed_io_actions := NumIOActions.
|
|
|
|
:- pred get_xml_browser_cmd_from_mdb(browser_persistent_state::in,
|
|
string::out) is det.
|
|
:- pragma foreign_export("C",
|
|
get_xml_browser_cmd_from_mdb(in, out),
|
|
"ML_BROWSE_get_xml_browser_cmd_from_mdb").
|
|
|
|
get_xml_browser_cmd_from_mdb(Browser, Command) :-
|
|
MaybeCommand = Browser ^ xml_browser_cmd,
|
|
(
|
|
MaybeCommand = no,
|
|
Command = ""
|
|
;
|
|
MaybeCommand = yes(Command)
|
|
).
|
|
|
|
:- pred set_xml_browser_cmd_from_mdb(string::in,
|
|
browser_persistent_state::in, browser_persistent_state::out) is det.
|
|
:- pragma foreign_export("C",
|
|
set_xml_browser_cmd_from_mdb(in, in, out),
|
|
"ML_BROWSE_set_xml_browser_cmd_from_mdb").
|
|
|
|
set_xml_browser_cmd_from_mdb(Command, !Browser) :-
|
|
( Command = "" ->
|
|
!:Browser = !.Browser ^ xml_browser_cmd := no
|
|
;
|
|
!:Browser = !.Browser ^ xml_browser_cmd := yes(Command)
|
|
).
|
|
|
|
:- pred get_xml_tmp_filename_from_mdb(browser_persistent_state::in,
|
|
string::out) is det.
|
|
:- pragma foreign_export("C",
|
|
get_xml_tmp_filename_from_mdb(in, out),
|
|
"ML_BROWSE_get_xml_tmp_filename_from_mdb").
|
|
|
|
get_xml_tmp_filename_from_mdb(Browser, FileName) :-
|
|
MaybeFileName = Browser ^ xml_tmp_filename,
|
|
(
|
|
MaybeFileName = no,
|
|
FileName = ""
|
|
;
|
|
MaybeFileName = yes(FileName)
|
|
).
|
|
|
|
:- pred set_xml_tmp_filename_from_mdb(string::in,
|
|
browser_persistent_state::in, browser_persistent_state::out) is det.
|
|
:- pragma foreign_export("C",
|
|
set_xml_tmp_filename_from_mdb(in, in, out),
|
|
"ML_BROWSE_set_xml_tmp_filename_from_mdb").
|
|
|
|
set_xml_tmp_filename_from_mdb(FileName, !Browser) :-
|
|
( FileName = "" ->
|
|
!:Browser = !.Browser ^ xml_tmp_filename := no
|
|
;
|
|
!:Browser = !.Browser ^ xml_tmp_filename := yes(FileName)
|
|
).
|
|
|
|
%
|
|
% The following exported functions allow C code to create
|
|
% Mercury values of type bool.
|
|
%
|
|
|
|
:- func mercury_bool_yes = bool.
|
|
:- pragma foreign_export("C", mercury_bool_yes = out,
|
|
"ML_BROWSE_mercury_bool_yes").
|
|
|
|
mercury_bool_yes = yes.
|
|
|
|
:- func mercury_bool_no = bool.
|
|
:- pragma foreign_export("C", mercury_bool_no = out,
|
|
"ML_BROWSE_mercury_bool_no").
|
|
|
|
mercury_bool_no = no.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
init(BrowserTerm, CallerType, MaybeFormat, MaybeModeFunc, State) =
|
|
browser_info(BrowserTerm, [], CallerType, MaybeFormat, State, no_track,
|
|
MaybeModeFunc).
|
|
|
|
get_format(Info, Caller, MaybeFormat, Format) :-
|
|
(
|
|
MaybeFormat = yes(Format)
|
|
;
|
|
MaybeFormat = no,
|
|
MdbFormatOption = Info ^ format,
|
|
(
|
|
MdbFormatOption = yes(Format)
|
|
;
|
|
MdbFormatOption = no,
|
|
get_caller_params(Info ^ state, Caller, Params),
|
|
Format = Params ^ default_format
|
|
)
|
|
).
|
|
|
|
get_format_params(Info, Caller, Format, Params) :-
|
|
get_caller_params(Info ^ state, Caller, CallerParams),
|
|
get_caller_format_params(CallerParams, Format, Params).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- type browser_persistent_state
|
|
---> browser_persistent_state(
|
|
print_params :: caller_params,
|
|
browse_params :: caller_params,
|
|
print_all_params :: caller_params,
|
|
num_printed_io_actions :: int,
|
|
|
|
xml_browser_cmd :: maybe(string),
|
|
% The command to lauch the user's
|
|
% prefered XML browser.
|
|
|
|
xml_tmp_filename :: maybe(string)
|
|
% The file to save XML to before
|
|
% lauching the browser.
|
|
).
|
|
|
|
:- type caller_params
|
|
---> caller_params(
|
|
default_format :: portray_format,
|
|
flat_params :: format_params,
|
|
raw_pretty_params :: format_params,
|
|
verbose_params :: format_params,
|
|
pretty_params :: format_params
|
|
).
|
|
|
|
% Initialise the persistent settings with default values. The
|
|
% rationale for the default values is:
|
|
% Depth and Size:
|
|
% For non-interactive display, these are 3 and 10 resp.,
|
|
% so that terms will generally fit on one line. For
|
|
% interactive browsing these values are increased.
|
|
%
|
|
% Width:
|
|
% Defaults to 80 characters in any situation.
|
|
%
|
|
% Lines:
|
|
% If one term is printed then it is limited to 25 lines.
|
|
% If there can be more than one term (i.e., with
|
|
% `print *') then a much lower limit is imposed. For
|
|
% verbose format, there is not much point setting this to
|
|
% less than about 5 since otherwise very little of the
|
|
% term will be shown.
|
|
%
|
|
init_persistent_state(State) :-
|
|
Print = caller_type_print_defaults,
|
|
Browse = caller_type_browse_defaults,
|
|
PrintAll = caller_type_print_all_defaults,
|
|
State = browser_persistent_state(Print, Browse, PrintAll,
|
|
num_printed_io_actions_default, no, no).
|
|
|
|
:- func caller_type_print_defaults = caller_params.
|
|
|
|
caller_type_print_defaults = Params :-
|
|
DefaultFormat = flat,
|
|
Flat = format_params(3, 10, 80, 25),
|
|
RawPretty = format_params(3, 10, 80, 25),
|
|
Verbose = format_params(3, 10, 80, 25),
|
|
Pretty = format_params(3, 10, 80, 25),
|
|
Params = caller_params(DefaultFormat, Flat, RawPretty, Verbose, Pretty).
|
|
|
|
:- func caller_type_browse_defaults = caller_params.
|
|
|
|
caller_type_browse_defaults = Params :-
|
|
DefaultFormat = flat,
|
|
Flat = format_params(10, 30, 80, 25),
|
|
RawPretty = format_params(10, 30, 80, 25),
|
|
Verbose = format_params(10, 30, 80, 25),
|
|
Pretty = format_params(10, 30, 80, 25),
|
|
Params = caller_params(DefaultFormat, Flat, RawPretty, Verbose, Pretty).
|
|
|
|
:- func caller_type_print_all_defaults = caller_params.
|
|
|
|
caller_type_print_all_defaults = Params :-
|
|
DefaultFormat = flat,
|
|
Flat = format_params(3, 10, 80, 2),
|
|
RawPretty = format_params(3, 10, 80, 2),
|
|
Verbose = format_params(3, 10, 80, 5),
|
|
Pretty = format_params(3, 10, 80, 2),
|
|
Params = caller_params(DefaultFormat, Flat, RawPretty, Verbose, Pretty).
|
|
|
|
:- func num_printed_io_actions_default = int.
|
|
|
|
% Since each I/O action typically takes one line, this usually leaves room
|
|
% on the typical 24-line screen for the atom, the query, and some previous
|
|
% context.
|
|
num_printed_io_actions_default = 20.
|
|
|
|
set_browser_param(FromBrowser, P0, B0, A0, F0, Pr0, V0, NPr0, Setting,
|
|
!State) :-
|
|
(
|
|
FromBrowser = no,
|
|
default_all_yes(P0, B0, A0, P, B, A)
|
|
;
|
|
FromBrowser = yes,
|
|
(
|
|
P0 = no,
|
|
B0 = no,
|
|
A0 = no
|
|
->
|
|
affected_caller_types(FromBrowser, no, P, B, A)
|
|
;
|
|
P = P0,
|
|
B = B0,
|
|
A = A0
|
|
)
|
|
),
|
|
default_all_yes(F0, Pr0, V0, NPr0, F, Pr, V, NPr),
|
|
PParams0 = !.State ^ print_params,
|
|
BParams0 = !.State ^ browse_params,
|
|
AParams0 = !.State ^ print_all_params,
|
|
maybe_set_param(P, F, Pr, V, NPr, Setting, PParams0, PParams),
|
|
maybe_set_param(B, F, Pr, V, NPr, Setting, BParams0, BParams),
|
|
maybe_set_param(A, F, Pr, V, NPr, Setting, AParams0, AParams),
|
|
!:State = browser_persistent_state(PParams, BParams, AParams,
|
|
!.State ^ num_printed_io_actions,
|
|
!.State ^ xml_browser_cmd, !.State ^ xml_tmp_filename).
|
|
|
|
set_browser_param_with_caller_type(CallerType, P0, B0, A0, F0, Pr0, V0, NPr0,
|
|
Setting, !State) :-
|
|
(
|
|
P0 = no,
|
|
B0 = no,
|
|
A0 = no
|
|
->
|
|
% The value of DummyInBrowser doesn't matter because the second
|
|
% argument of the call to affected_caller_types/5 is yes/1.
|
|
DummyInBrowser = yes,
|
|
affected_caller_types(DummyInBrowser, yes(CallerType), P, B, A)
|
|
;
|
|
P = P0,
|
|
B = B0,
|
|
A = A0
|
|
),
|
|
default_all_yes(F0, Pr0, V0, NPr0, F, Pr, V, NPr),
|
|
PParams0 = !.State ^ print_params,
|
|
BParams0 = !.State ^ browse_params,
|
|
AParams0 = !.State ^ print_all_params,
|
|
maybe_set_param(P, F, Pr, V, NPr, Setting, PParams0, PParams),
|
|
maybe_set_param(B, F, Pr, V, NPr, Setting, BParams0, BParams),
|
|
maybe_set_param(A, F, Pr, V, NPr, Setting, AParams0, AParams),
|
|
!:State = browser_persistent_state(PParams, BParams, AParams,
|
|
!.State ^ num_printed_io_actions,
|
|
!.State ^ xml_browser_cmd, !.State ^ xml_tmp_filename).
|
|
|
|
set_browser_param_maybe_caller_type(FromBrowser, MaybeCallerType,
|
|
F0, Pr0, V0, NPr0, Setting, !State) :-
|
|
affected_caller_types(FromBrowser, MaybeCallerType, P, B, A),
|
|
set_browser_param(FromBrowser, P, B, A, F0, Pr0, V0, NPr0, Setting,
|
|
!State).
|
|
|
|
set_browser_param_from_option_table(CallerType, OptionTable, Setting,
|
|
!State) :-
|
|
set_browser_param_with_caller_type(CallerType,
|
|
lookup_bool_option(OptionTable, set_print) : bool,
|
|
lookup_bool_option(OptionTable, set_browse) : bool,
|
|
lookup_bool_option(OptionTable, set_print_all) : bool,
|
|
lookup_bool_option(OptionTable, set_flat) : bool,
|
|
lookup_bool_option(OptionTable, set_raw_pretty) : bool,
|
|
lookup_bool_option(OptionTable, set_verbose) : bool,
|
|
lookup_bool_option(OptionTable, set_pretty) : bool,
|
|
Setting, !State).
|
|
|
|
:- pred affected_caller_types(bool::in, maybe(browse_caller_type)::in,
|
|
bool::out, bool::out, bool::out) is det.
|
|
|
|
% If no caller type is specified, the set command by default
|
|
% applies to _all_ caller types if invoked from the mdb prompt,
|
|
% and to the browser only if invoked from the browser prompt.
|
|
affected_caller_types(no, no, yes, yes, yes).
|
|
affected_caller_types(yes, no, no, yes, no).
|
|
affected_caller_types(_, yes(print), yes, no, no).
|
|
affected_caller_types(_, yes(browse), no, yes, no).
|
|
affected_caller_types(_, yes(print_all), no, no, yes).
|
|
|
|
:- pred default_all_yes(bool::in, bool::in, bool::in,
|
|
bool::out, bool::out, bool::out) is det.
|
|
|
|
default_all_yes(A0, B0, C0, A, B, C) :-
|
|
%
|
|
% If none of the flags are set, the command by default
|
|
% applies to _all_ caller types/formats.
|
|
%
|
|
(
|
|
A0 = no,
|
|
B0 = no,
|
|
C0 = no
|
|
->
|
|
A = yes,
|
|
B = yes,
|
|
C = yes
|
|
;
|
|
A = A0,
|
|
B = B0,
|
|
C = C0
|
|
).
|
|
|
|
:- pred default_all_yes(bool::in, bool::in, bool::in, bool::in,
|
|
bool::out, bool::out, bool::out, bool::out) is det.
|
|
|
|
default_all_yes(A0, B0, C0, D0, A, B, C, D) :-
|
|
%
|
|
% If none of the format flags are set, the command by default
|
|
% applies to _all_ formats.
|
|
%
|
|
(
|
|
A0 = no,
|
|
B0 = no,
|
|
C0 = no,
|
|
D0 = no
|
|
->
|
|
A = yes,
|
|
B = yes,
|
|
C = yes,
|
|
D = yes
|
|
;
|
|
A = A0,
|
|
B = B0,
|
|
C = C0,
|
|
D = D0
|
|
).
|
|
|
|
:- pred maybe_set_param(bool::in, bool::in, bool::in, bool::in, bool::in,
|
|
setting::in, caller_params::in, caller_params::out) is det.
|
|
|
|
maybe_set_param(no, _, _, _, _, _, !Params).
|
|
maybe_set_param(yes, F, Pr, V, NPr, Setting, !Params) :-
|
|
(
|
|
Setting = setting_format(NewFormat),
|
|
!:Params = !.Params ^ default_format := NewFormat
|
|
;
|
|
( Setting = setting_depth(_)
|
|
; Setting = setting_width(_)
|
|
; Setting = setting_lines(_)
|
|
; Setting = setting_size(_)
|
|
),
|
|
Format0 = !.Params ^ default_format,
|
|
FParams0 = !.Params ^ flat_params,
|
|
PrParams0 = !.Params ^ raw_pretty_params,
|
|
VParams0 = !.Params ^ verbose_params,
|
|
NPrParams0 = !.Params ^ pretty_params,
|
|
maybe_set_param_2(F, Setting, FParams0, FParams),
|
|
maybe_set_param_2(Pr, Setting, PrParams0, PrParams),
|
|
maybe_set_param_2(V, Setting, VParams0, VParams),
|
|
maybe_set_param_2(NPr, Setting, NPrParams0, NPrParams),
|
|
!:Params = caller_params(Format0,
|
|
FParams, PrParams, VParams, NPrParams)
|
|
).
|
|
|
|
:- pred maybe_set_param_2(bool::in, setting::in,
|
|
format_params::in, format_params::out) is det.
|
|
|
|
maybe_set_param_2(no, _, Params, Params).
|
|
maybe_set_param_2(yes, setting_depth(D), Params, Params ^ depth := D).
|
|
maybe_set_param_2(yes, setting_size(S), Params, Params ^ size := S).
|
|
maybe_set_param_2(yes, setting_format(_), _, _) :-
|
|
error("maybe_set_param_2: cannot set format here").
|
|
maybe_set_param_2(yes, setting_width(W), Params, Params ^ width := W).
|
|
maybe_set_param_2(yes, setting_lines(L), Params, Params ^ lines := L).
|
|
|
|
:- pred get_caller_params(browser_persistent_state::in, browse_caller_type::in,
|
|
caller_params::out) is det.
|
|
|
|
get_caller_params(State, print, State ^ print_params).
|
|
get_caller_params(State, browse, State ^ browse_params).
|
|
get_caller_params(State, print_all, State ^ print_all_params).
|
|
|
|
:- pred get_caller_format_params(caller_params::in, portray_format::in,
|
|
format_params::out) is det.
|
|
|
|
get_caller_format_params(Params, flat, Params ^ flat_params).
|
|
get_caller_format_params(Params, raw_pretty, Params ^ raw_pretty_params).
|
|
get_caller_format_params(Params, verbose, Params ^ verbose_params).
|
|
get_caller_format_params(Params, pretty, Params ^ pretty_params).
|
|
|
|
get_num_printed_io_actions(State) =
|
|
State ^ num_printed_io_actions.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
run_param_command(Debugger, ParamCmd, ShowPath, !PersistentState, !IO) :-
|
|
(
|
|
ParamCmd = format(MaybeOptionTable, Setting),
|
|
(
|
|
MaybeOptionTable = ok(OptionTable),
|
|
info_set_browse_param(OptionTable, Setting, !PersistentState)
|
|
;
|
|
MaybeOptionTable = error(Msg),
|
|
write_string_debugger(Debugger, Msg, !IO)
|
|
)
|
|
;
|
|
ParamCmd = format_param(MaybeOptionTable, Setting),
|
|
(
|
|
MaybeOptionTable = ok(OptionTable),
|
|
info_set_browse_param(OptionTable, Setting, !PersistentState)
|
|
;
|
|
MaybeOptionTable = error(Msg),
|
|
write_string_debugger(Debugger, Msg, !IO)
|
|
)
|
|
;
|
|
ParamCmd = num_io_actions(N),
|
|
info_set_num_io_actions(N, !PersistentState)
|
|
;
|
|
ParamCmd = print_params,
|
|
show_settings(Debugger, ShowPath, !.PersistentState, !IO)
|
|
% ;
|
|
% ParamCmd = xml_browser_cmd(Cmd),
|
|
% set_xml_browser_cmd(Cmd, !PersistentState)
|
|
% ;
|
|
% ParamCmd = xml_tmp_filename(FileName),
|
|
% set_xml_tmp_filename(FileName, !PersistentState)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Display predicates.
|
|
%
|
|
|
|
show_settings(Debugger, ShowPath, 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,
|
|
"Number of I/O actions printed is: ", !IO),
|
|
write_int_debugger(Debugger,
|
|
get_num_printed_io_actions(Info ^ state), !IO),
|
|
nl_debugger(Debugger, !IO),
|
|
|
|
(
|
|
ShowPath = yes,
|
|
write_string_debugger(Debugger, "Current path is: ", !IO),
|
|
write_path(Debugger, Info ^ dirs, !IO),
|
|
nl_debugger(Debugger, !IO)
|
|
;
|
|
ShowPath = no
|
|
).
|
|
|
|
:- 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(" ", ' ', centering_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("width", ' ', width_len), !IO),
|
|
write_string_debugger(Debugger, pad_right("lines", ' ', 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.
|
|
|
|
nl_debugger(internal, !IO) :-
|
|
io.nl(!IO).
|
|
nl_debugger(external, !IO) :-
|
|
send_term_to_socket(browser_nl, !IO).
|
|
|
|
write_string_debugger(internal, String, !IO) :-
|
|
io.write_string(String, !IO).
|
|
write_string_debugger(external, String, !IO) :-
|
|
send_term_to_socket(browser_str(String), !IO).
|
|
|
|
write_int_debugger(internal, Int, !IO) :-
|
|
io.write_int(Int, !IO).
|
|
write_int_debugger(external, Int, !IO) :-
|
|
send_term_to_socket(browser_int(Int), !IO).
|
|
|
|
print_format_debugger(internal, X, !IO) :-
|
|
io.print(X, !IO).
|
|
print_format_debugger(external, X, !IO) :-
|
|
(
|
|
X = flat,
|
|
send_term_to_socket(browser_str("flat"), !IO)
|
|
;
|
|
X = raw_pretty,
|
|
send_term_to_socket(browser_str("raw_pretty"), !IO)
|
|
;
|
|
X = verbose,
|
|
send_term_to_socket(browser_str("verbose"), !IO)
|
|
;
|
|
X = pretty,
|
|
send_term_to_socket(browser_str("pretty"), !IO)
|
|
).
|
|
|
|
write_path(Debugger, [], !IO) :-
|
|
write_string_debugger(Debugger, "/", !IO).
|
|
write_path(Debugger, [Dir], !IO) :-
|
|
(
|
|
Dir = parent,
|
|
write_string_debugger(Debugger, "/", !IO)
|
|
;
|
|
Dir = child_num(N),
|
|
write_string_debugger(Debugger, "/", !IO),
|
|
write_int_debugger(Debugger, N, !IO)
|
|
;
|
|
Dir = child_name(Name),
|
|
write_string_debugger(Debugger, "/", !IO),
|
|
write_string_debugger(Debugger, Name, !IO)
|
|
).
|
|
write_path(Debugger, [Dir, Dir2 | Dirs], !IO) :-
|
|
write_path_2(Debugger, [Dir, Dir2 | Dirs], !IO).
|
|
|
|
:- pred write_path_2(debugger::in, list(dir)::in, io::di, io::uo) is det.
|
|
|
|
write_path_2(Debugger, [], !IO) :-
|
|
write_string_debugger(Debugger, "/", !IO).
|
|
write_path_2(Debugger, [Dir], !IO) :-
|
|
(
|
|
Dir = parent,
|
|
write_string_debugger(Debugger, "/..", !IO)
|
|
;
|
|
Dir = child_num(N),
|
|
write_string_debugger(Debugger, "/", !IO),
|
|
write_int_debugger(Debugger, N, !IO)
|
|
;
|
|
Dir = child_name(Name),
|
|
write_string_debugger(Debugger, "/", !IO),
|
|
write_string_debugger(Debugger, Name, !IO)
|
|
).
|
|
write_path_2(Debugger, [Dir, Dir2 | Dirs], !IO) :-
|
|
(
|
|
Dir = parent,
|
|
write_string_debugger(Debugger, "/..", !IO),
|
|
write_path_2(Debugger, [Dir2 | Dirs], !IO)
|
|
;
|
|
Dir = child_num(N),
|
|
write_string_debugger(Debugger, "/", !IO),
|
|
write_int_debugger(Debugger, N, !IO),
|
|
write_path_2(Debugger, [Dir2 | Dirs], !IO)
|
|
;
|
|
Dir = child_name(Name),
|
|
write_string_debugger(Debugger, "/", !IO),
|
|
write_string_debugger(Debugger, Name, !IO),
|
|
write_path_2(Debugger, [Dir2 | Dirs], !IO)
|
|
).
|
|
|
|
send_term_to_socket(Term, !IO) :-
|
|
write(Term, !IO),
|
|
print(".\n", !IO),
|
|
flush_output(!IO).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- instance stream.stream(debugger, io) where [
|
|
stream.name(_, "debugger", !IO)
|
|
].
|
|
|
|
:- instance stream.output(debugger, io) where [
|
|
(flush(internal, !IO) :-
|
|
io.flush_output(!IO)
|
|
),
|
|
(flush(external, !IO) :-
|
|
% XXX
|
|
true
|
|
)
|
|
].
|
|
|
|
:- instance stream.writer(debugger, string, io) where [
|
|
(put(D, S, !IO) :-
|
|
write_string_debugger(D, S, !IO)
|
|
)
|
|
].
|
|
|
|
:- instance stream.writer(debugger, int, io) where [
|
|
(put(D, I, !IO) :-
|
|
write_int_debugger(D, I, !IO)
|
|
)
|
|
].
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pragma foreign_export("C", browser_params_to_string(in, in, out),
|
|
"ML_BROWSE_browser_params_to_string").
|
|
|
|
browser_params_to_string(Browser, MDBCommandFormat, Desc) :-
|
|
Browser = browser_persistent_state(PrintParams, BrowseParams,
|
|
PrintAllParams, NumIOActions, MaybeXMLBrowserCmd, MaybeXMLTmpFileName),
|
|
(
|
|
MDBCommandFormat = yes,
|
|
ParamCmds =
|
|
caller_params_to_mdb_command("-P ", PrintParams) ++
|
|
caller_params_to_mdb_command("-B ", BrowseParams) ++
|
|
caller_params_to_mdb_command("-A ", PrintAllParams),
|
|
NumIOActionCmd =
|
|
"max_io_actions " ++ int_to_string(NumIOActions) ++ "\n",
|
|
(
|
|
MaybeXMLBrowserCmd = yes(XMLBrowserCmd),
|
|
% XMLBrowserCmd shouldn't be "" if MaybeXMLBrowserCmd is yes,
|
|
% but better safe than sorry.
|
|
XMLBrowserCmd \= ""
|
|
->
|
|
XMLBrowserCmdCmd =
|
|
"xml_browser_cmd " ++ XMLBrowserCmd ++ "\n"
|
|
;
|
|
XMLBrowserCmdCmd = ""
|
|
),
|
|
(
|
|
MaybeXMLTmpFileName = yes(XMLTmpFileName),
|
|
% XMLTmpFileName shouldn't be "" if MaybeXMLTmpFileName is yes,
|
|
% but better safe than sorry.
|
|
XMLTmpFileName \= ""
|
|
->
|
|
XMLTmpFileNameCmd =
|
|
"xml_tmp_filename " ++ XMLTmpFileName ++ "\n"
|
|
;
|
|
XMLTmpFileNameCmd = ""
|
|
),
|
|
Desc = ParamCmds ++ NumIOActionCmd ++
|
|
XMLBrowserCmdCmd ++ XMLTmpFileNameCmd
|
|
;
|
|
MDBCommandFormat = no,
|
|
ParamDesc =
|
|
"Print parameters:\n" ++
|
|
caller_params_to_desc(PrintParams) ++
|
|
"Browse parameters:\n" ++
|
|
caller_params_to_desc(BrowseParams) ++
|
|
"Print all parameters:\n" ++
|
|
caller_params_to_desc(PrintAllParams),
|
|
NumIOActionDesc =
|
|
"Maximum number of I/O actions printed: " ++
|
|
int_to_string(NumIOActions) ++ "\n",
|
|
(
|
|
MaybeXMLBrowserCmd = yes(XMLBrowserCmd),
|
|
XMLBrowserCmdDesc =
|
|
"XML browser command: " ++ XMLBrowserCmd ++ "\n"
|
|
;
|
|
MaybeXMLBrowserCmd = no,
|
|
XMLBrowserCmdDesc = ""
|
|
),
|
|
(
|
|
MaybeXMLTmpFileName = yes(XMLTmpFileName),
|
|
XMLTmpFileNameDesc =
|
|
"XML temporary filename: " ++ XMLTmpFileName ++ "\n"
|
|
;
|
|
MaybeXMLTmpFileName = no,
|
|
XMLTmpFileNameDesc = ""
|
|
),
|
|
Desc = ParamDesc ++ NumIOActionDesc ++
|
|
XMLBrowserCmdDesc ++ XMLTmpFileNameDesc
|
|
).
|
|
|
|
:- func caller_params_to_mdb_command(string, caller_params) = string.
|
|
|
|
caller_params_to_mdb_command(CallerOpt, CallerParams) = Cmds :-
|
|
CallerParams = caller_params(Format, FlatParams, RawPrettyParams,
|
|
VerboseParams, PrettyParams),
|
|
FormatCmd = "format " ++ CallerOpt ++ format_to_string(Format) ++ "\n",
|
|
CmdPrefix = "format_param " ++ CallerOpt,
|
|
FormatParamCmds =
|
|
format_params_to_mdb_command(CmdPrefix ++ "-f ", FlatParams) ++
|
|
format_params_to_mdb_command(CmdPrefix ++ "-r ", RawPrettyParams) ++
|
|
format_params_to_mdb_command(CmdPrefix ++ "-v ", VerboseParams) ++
|
|
format_params_to_mdb_command(CmdPrefix ++ "-p ", PrettyParams),
|
|
Cmds = FormatCmd ++ FormatParamCmds.
|
|
|
|
:- func caller_params_to_desc(caller_params) = string.
|
|
|
|
caller_params_to_desc(caller_params(Format, FlatParams, RawPrettyParams,
|
|
VerboseParams, PrettyParams)) =
|
|
"default format " ++ format_to_string(Format) ++ "\n" ++
|
|
"flat parameters: " ++ format_params_to_desc(FlatParams) ++
|
|
"raw_pretty parameters: " ++ format_params_to_desc(RawPrettyParams) ++
|
|
"verbose parameters: " ++ format_params_to_desc(VerboseParams) ++
|
|
"pretty parameters: " ++ format_params_to_desc(PrettyParams).
|
|
|
|
:- func format_params_to_mdb_command(string, format_params) = string.
|
|
|
|
format_params_to_mdb_command(CmdCallerOpt, FormatParams) = Cmds :-
|
|
FormatParams = format_params(Depth, Size, Width, Lines),
|
|
DepthCmd = CmdCallerOpt ++ "depth " ++ int_to_string(Depth) ++ "\n",
|
|
SizeCmd = CmdCallerOpt ++ "size " ++ int_to_string(Size) ++ "\n",
|
|
WidthCmd = CmdCallerOpt ++ "width " ++ int_to_string(Width) ++ "\n",
|
|
LinesCmd = CmdCallerOpt ++ "lines " ++ int_to_string(Lines) ++ "\n",
|
|
Cmds = DepthCmd ++ SizeCmd ++ WidthCmd ++ LinesCmd.
|
|
|
|
:- func format_params_to_desc(format_params) = string.
|
|
|
|
format_params_to_desc(format_params(Depth, Size, Width, Lines)) =
|
|
"depth " ++ int_to_string(Depth) ++ ", " ++
|
|
"size " ++ int_to_string(Size) ++ ", " ++
|
|
"width " ++ int_to_string(Width) ++ ", " ++
|
|
"lines " ++ int_to_string(Lines) ++ "\n".
|
|
|
|
:- func format_to_string(portray_format) = string.
|
|
|
|
format_to_string(flat) = "flat".
|
|
format_to_string(raw_pretty) = "raw_pretty".
|
|
format_to_string(verbose) = "verbose".
|
|
format_to_string(pretty) = "pretty".
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred browser_persistent_state_type(type_desc::out) is det.
|
|
:- pragma foreign_export("C", browser_persistent_state_type(out),
|
|
"ML_BROWSE_browser_persistent_state_type").
|
|
|
|
browser_persistent_state_type(type_of(State)) :-
|
|
init_persistent_state(State).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
deconstruct_browser_term_cc(BrowserDb, BrowserTerm, Functor, Arity,
|
|
Args, MaybeReturn) :-
|
|
(
|
|
BrowserTerm = plain_term(Univ),
|
|
deconstruct.deconstruct(pretty_value(BrowserDb, Univ),
|
|
include_details_cc, Functor, Arity, Args),
|
|
MaybeReturn = no
|
|
;
|
|
BrowserTerm = synthetic_term(Functor, Args, MaybeReturn),
|
|
list.length(Args, Arity)
|
|
).
|
|
|
|
limited_deconstruct_browser_term_cc(BrowserDb, BrowserTerm, Limit,
|
|
MaybeFunctorArityArgs, MaybeReturn) :-
|
|
(
|
|
BrowserTerm = plain_term(Univ),
|
|
deconstruct.limited_deconstruct_cc(pretty_value(BrowserDb, Univ),
|
|
Limit, MaybeFunctorArityArgs),
|
|
MaybeReturn = no
|
|
;
|
|
BrowserTerm = synthetic_term(Functor, Args, MaybeReturn),
|
|
list.length(Args, Arity),
|
|
MaybeFunctorArityArgs = yes({Functor, Arity, Args})
|
|
).
|
|
|
|
functor_browser_term_cc(BrowserDb, BrowserTerm, Functor, Arity, IsFunc) :-
|
|
(
|
|
BrowserTerm = plain_term(Univ),
|
|
deconstruct.functor(pretty_value(BrowserDb, Univ), include_details_cc,
|
|
Functor, Arity),
|
|
IsFunc = no
|
|
;
|
|
BrowserTerm = synthetic_term(Functor, Args, MaybeReturn),
|
|
list.length(Args, Arity),
|
|
(
|
|
MaybeReturn = yes(_),
|
|
IsFunc = yes
|
|
;
|
|
MaybeReturn = no,
|
|
IsFunc = no
|
|
)
|
|
).
|
|
|
|
:- some [T] func pretty_value(browser_db, univ) = T.
|
|
|
|
pretty_value(BrowserDb, Univ0) = Value :-
|
|
( univ_to_type(Univ0, InputStream) ->
|
|
io.input_stream_info(BrowserDb ^ browser_stream_db,
|
|
InputStream) = InputStreamInfo,
|
|
type_to_univ(InputStreamInfo, Univ)
|
|
; univ_to_type(Univ0, OutputStream) ->
|
|
io.output_stream_info(BrowserDb ^ browser_stream_db,
|
|
OutputStream) = OutputStreamInfo,
|
|
type_to_univ(OutputStreamInfo, Univ)
|
|
; univ_to_type(Univ0, BinaryInputStream) ->
|
|
io.binary_input_stream_info(BrowserDb ^ browser_stream_db,
|
|
BinaryInputStream) = BinaryInputStreamInfo,
|
|
type_to_univ(BinaryInputStreamInfo, Univ)
|
|
; univ_to_type(Univ0, BinaryOutputStream) ->
|
|
io.binary_output_stream_info(BrowserDb ^ browser_stream_db,
|
|
BinaryOutputStream) = BinaryOutputStreamInfo,
|
|
type_to_univ(BinaryOutputStreamInfo, Univ)
|
|
;
|
|
Univ = Univ0
|
|
),
|
|
Value = univ_value(Univ).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
convert_dirs_to_term_path(_, [], []).
|
|
convert_dirs_to_term_path(Term, [child_num(N) | Dirs], [N | TermPath]) :-
|
|
(
|
|
term_rep.argument(Term, N, Subterm)
|
|
->
|
|
convert_dirs_to_term_path(Subterm, Dirs, TermPath)
|
|
;
|
|
error("convert_dirs_to_term_path: invalid argument")
|
|
).
|
|
convert_dirs_to_term_path(Term, [child_name(Name) | Dirs], [N | TermPath]) :-
|
|
(
|
|
term_rep.field_pos(Name, Term, Pos),
|
|
term_rep.argument(Term, Pos, Subterm)
|
|
->
|
|
convert_dirs_to_term_path(Subterm, Dirs, TermPath),
|
|
N = Pos
|
|
;
|
|
error("convert_dirs_to_term_path: invalid field name")
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|