mercury/browser/browser_info.m

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2000-2007, 2009-2010 The University of Melbourne.
% Copyright (C) 2017-2018 The Mercury team.
% This file is distributed under the terms specified in COPYING.LIB.
%---------------------------------------------------------------------------%
%
% File: 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.
:- 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(
                % The term to browse.
                bri_term        :: browser_term,

                % The list of directories to take, starting from the root,
                % to reach the current subterm.
                bri_dirs        :: list(down_dir),

                % What command called the browser?
                bri_caller_type :: browse_caller_type,

                % Format specified as an option to the mdb command.
                bri_format      :: maybe(portray_format),

                % Persistent settings.
                bri_state       :: browser_persistent_state,

                % Location of subterm for which the `track' or `mark' command
                % was given, or `no_track' if no `track' command was given.
                bri_maybe_track :: maybe_track_subterm(list(down_dir)),

                % An optional function to determine the mode of a particular
                % subterm should the user issue a `mode' query.
                bri_maybe_mode_func :: maybe(browser_mode_func)
            ).

:- 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(down_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
    --->    btm_input
            % The sub-term is bound at the call. For example the Mercury
            % builtin modes `in', `di' and `ui'.

    ;       btm_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'.

    ;       btm_unbound
            % The sub-term is unbound at the call and at the final EXIT, FAIL
            % or EXCP event.

    ;       btm_not_applicable.
            % If the user asks about the mode of an atom, this value should be
            % returned by the browser term mode function.

:- type up_down_dir
    --->    updown_parent
    ;       updown_child_num(int)
    ;       updown_child_name(string).

:- type down_dir
    --->    down_child_num(int)
    ;       down_child_name(string).

:- func down_to_up_down_dir(down_dir) = up_down_dir.
:- func down_to_up_down_dirs(list(down_dir)) = list(up_down_dir).

:- pred convert_dirs_to_term_path(term_rep::in, list(down_dir)::in,
    term_path::out) is det.

    % 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 browser_info_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.

:- 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_web_browser_cmd(string::in,
    browser_info::in, browser_info::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 ^ web_browser_cmd = maybe(string).
:- func browser_persistent_state ^ web_browser_cmd := 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.

:- func get_num_printed_io_actions(browser_persistent_state) = int.
:- 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.

    % 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.

:- type param_cmd
    --->    format(maybe_option_table(setting_option), setting)
    ;       format_param(maybe_option_table(setting_option), setting)
    ;       num_io_actions(int)
    ;       print_params.

:- type debugger
    --->    debugger_internal(io.text_output_stream)
    ;       debugger_external(io.text_output_stream).

% 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_down_path(debugger::in, list(down_dir)::in,
    io::di, io::uo) is det.

:- pred send_term_to_socket(io.text_output_stream::in,
    term_browser_response::in, io::di, io::uo) is det.

:- pred browser_params_to_string(browser_persistent_state::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 deconstruct.
:- import_module require.
:- import_module string.
:- import_module type_desc.

%---------------------------------------------------------------------------%

down_to_up_down_dir(down_child_num(Num)) = updown_child_num(Num).
down_to_up_down_dir(down_child_name(Name)) = updown_child_name(Name).

down_to_up_down_dirs([]) = [].
down_to_up_down_dirs([DownDir | DownDirs]) =
    [down_to_up_down_dir(DownDir) | down_to_up_down_dirs(DownDirs)].

%---------------------------------------------------------------------------%

convert_dirs_to_term_path(Term, Dirs, TermPath) :-
    (
        Dirs = [],
        TermPath = []
    ;
        Dirs = [down_child_num(N) | DirsTail],
        ( if
            term_rep.argument(Term, N, Subterm)
        then
            convert_dirs_to_term_path(Subterm, DirsTail, TermPathTail)
        else
            unexpected($pred, "invalid argument")
        ),
        TermPath = [N | TermPathTail]
    ;
        Dirs =  [down_child_name(Name) | DirsTail],
        ( if
            term_rep.field_pos(Name, Term, Pos),
            term_rep.argument(Term, Pos, Subterm)
        then
            convert_dirs_to_term_path(Subterm, DirsTail, TermPathTail),
            N = Pos
        else
            unexpected($pred, "invalid field name")
        ),
        TermPath = [N | TermPathTail]
    ).

%---------------------------------------------------------------------------%

browser_info_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 ^ bri_format,
        (
            MdbFormatOption = yes(Format)
        ;
            MdbFormatOption = no,
            get_caller_params(Info ^ bri_state, Caller, Params),
            Format = Params ^ default_format
        )
    ).

get_format_params(Info, Caller, Format, Params) :-
    get_caller_params(Info ^ bri_state, Caller, CallerParams),
    get_caller_format_params(CallerParams, Format, Params).

info_set_browse_param(OptionTable, Setting, !Info) :-
    PersistentState0 = !.Info ^ bri_state,
    CallerType = !.Info ^ bri_caller_type,
    set_browser_param_from_option_table(CallerType, OptionTable, Setting,
        PersistentState0, PersistentState),
    !Info ^ bri_state := PersistentState.

info_set_num_io_actions(N, !Info) :-
    PersistentState0 = !.Info ^ bri_state,
    set_num_io_actions(N, PersistentState0, PersistentState),
    !Info ^ bri_state := PersistentState.

info_set_web_browser_cmd(Cmd, !Info) :-
    PersistentState0 = !.Info ^ bri_state,
    set_web_browser_cmd_from_mdb(Cmd, PersistentState0, PersistentState),
    !Info ^ bri_state := PersistentState.

%---------------------------------------------------------------------------%

%
% 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).

:- 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).

:- pred get_web_browser_cmd_from_mdb(browser_persistent_state::in,
    string::out) is det.
:- pragma foreign_export("C", get_web_browser_cmd_from_mdb(in, out),
    "ML_BROWSE_get_web_browser_cmd_from_mdb").

get_web_browser_cmd_from_mdb(Browser, Command) :-
    MaybeCommand = Browser ^ web_browser_cmd,
    (
        MaybeCommand = no,
        Command = ""
    ;
        MaybeCommand = yes(Command)
    ).

:- pred set_web_browser_cmd_from_mdb(string::in,
    browser_persistent_state::in, browser_persistent_state::out) is det.
:- pragma foreign_export("C", set_web_browser_cmd_from_mdb(in, in, out),
    "ML_BROWSE_set_web_browser_cmd_from_mdb").

set_web_browser_cmd_from_mdb(Command, !Browser) :-
    ( if Command = "" then
        !Browser ^ web_browser_cmd := no
    else
        !Browser ^ web_browser_cmd := yes(Command)
    ).

%---------------------------------------------------------------------------%
%
% The following 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.

%---------------------------------------------------------------------------%

:- 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,

                % The command to launch the user's preferred web browser.
                web_browser_cmd         :: maybe(string)
            ).

:- 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
            ).

:- pragma foreign_export("C", init_persistent_state(out),
    "ML_BROWSE_init_persistent_state").

    % 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 respectively,
    %       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).

:- 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.

get_num_printed_io_actions(State) =
    State ^ num_printed_io_actions.

:- 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 ^ num_printed_io_actions := NumIOActions.

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,
        ( if
            P0 = no,
            B0 = no,
            A0 = no
        then
            affected_caller_types(FromBrowser, no, P, B, A)
        else
            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 ^ web_browser_cmd).

set_browser_param_with_caller_type(CallerType, P0, B0, A0, F0, Pr0, V0, NPr0,
        Setting, !State) :-
    ( if
        P0 = no,
        B0 = no,
        A0 = no
    then
        % 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)
    else
        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 ^ web_browser_cmd).

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.
    ( if
        A0 = no,
        B0 = no,
        C0 = no
    then
        A = yes,
        B = yes,
        C = yes
    else
        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.
    ( if
        A0 = no,
        B0 = no,
        C0 = no,
        D0 = no
    then
        A = yes,
        B = yes,
        C = yes,
        D = yes
    else
        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 ^ 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(_), _, _) :-
    unexpected($pred, "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).

%---------------------------------------------------------------------------%

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)
    ).

%---------------------------------------------------------------------------%
%
% 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 ^ bri_state), !IO),
    nl_debugger(Debugger, !IO),

    (
        ShowPath = yes,
        write_string_debugger(Debugger, "Current path is: ", !IO),
        write_down_path(Debugger, Info ^ bri_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(debugger_internal(Stream), !IO) :-
    io.nl(Stream, !IO).
nl_debugger(debugger_external(Stream), !IO) :-
    send_term_to_socket(Stream, browser_nl, !IO).

write_string_debugger(debugger_internal(Stream), String, !IO) :-
    io.write_string(Stream, String, !IO).
write_string_debugger(debugger_external(Stream), String, !IO) :-
    send_term_to_socket(Stream, browser_str(String), !IO).

write_int_debugger(debugger_internal(Stream), Int, !IO) :-
    io.write_int(Stream, Int, !IO).
write_int_debugger(debugger_external(Stream), Int, !IO) :-
    send_term_to_socket(Stream, browser_int(Int), !IO).

print_format_debugger(debugger_internal(Stream), X, !IO) :-
    io.print(Stream, X, !IO).
print_format_debugger(debugger_external(Stream), X, !IO) :-
    (
        X = flat,
        send_term_to_socket(Stream, browser_str("flat"), !IO)
    ;
        X = raw_pretty,
        send_term_to_socket(Stream, browser_str("raw_pretty"), !IO)
    ;
        X = verbose,
        send_term_to_socket(Stream, browser_str("verbose"), !IO)
    ;
        X = pretty,
        send_term_to_socket(Stream, browser_str("pretty"), !IO)
    ).

%---------------------------------------------------------------------------%

write_down_path(Debugger, Dirs, !IO) :-
    (
        Dirs = [],
        % If the whole path is empty, we print a top level "/".
        % This is the difference between write_down_path and
        % write_down_path_loop.
        write_string_debugger(Debugger, "/", !IO)
    ;
        Dirs = [HeadDir | TailDirs],
        write_down_step(Debugger, HeadDir, !IO),
        write_down_path_loop(Debugger, TailDirs, !IO)
    ).

:- pred write_down_path_loop(debugger::in, list(down_dir)::in,
    io::di, io::uo) is det.

write_down_path_loop(Debugger, Dirs, !IO) :-
    (
        Dirs = []
    ;
        Dirs = [HeadDir | TailDirs],
        write_down_step(Debugger, HeadDir, !IO),
        write_down_path_loop(Debugger, TailDirs, !IO)
    ).

:- pred write_down_step(debugger::in, down_dir::in, io::di, io::uo) is det.

write_down_step(Debugger, Dir, !IO) :-
    (
        Dir = down_child_num(N),
        write_string_debugger(Debugger, "/", !IO),
        write_int_debugger(Debugger, N, !IO)
    ;
        Dir = down_child_name(Name),
        write_string_debugger(Debugger, "/", !IO),
        write_string_debugger(Debugger, Name, !IO)
    ).

%---------------------------------------------------------------------------%

send_term_to_socket(Stream, Term, !IO) :-
    io.write(Stream, Term, !IO),
    io.print(Stream, ".\n", !IO),
    io.flush_output(Stream, !IO).

%---------------------------------------------------------------------------%

:- instance stream.stream(debugger, io) where [
    stream.name(_, "debugger", !IO)
].

:- instance stream.output(debugger, io) where [
    (flush(debugger_internal(Stream), !IO) :-
        io.flush_output(Stream, !IO)
    ),
    (flush(debugger_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, out),
    "ML_BROWSE_browser_params_to_string").

browser_params_to_string(Browser, Desc) :-
    Browser = browser_persistent_state(PrintParams, BrowseParams,
        PrintAllParams, NumIOActions, MaybeWebBrowserCmd),
    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",
    ( if
        MaybeWebBrowserCmd = yes(WebBrowserCmd),
        WebBrowserCmd \= ""
    then
        WebBrowserCmdCmd = "web_browser_cmd " ++ WebBrowserCmd ++ "\n"
    else
        WebBrowserCmdCmd = ""
    ),
    Desc = ParamCmds ++ NumIOActionCmd ++
        WebBrowserCmdCmd.

:- 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 :-
    ( if univ_to_type(Univ0, InputStream) then
        io.input_stream_info(BrowserDb ^ browser_stream_db,
            InputStream) = InputStreamInfo,
        type_to_univ(InputStreamInfo, Univ)
    else if univ_to_type(Univ0, OutputStream) then
        io.output_stream_info(BrowserDb ^ browser_stream_db,
            OutputStream) = OutputStreamInfo,
        type_to_univ(OutputStreamInfo, Univ)
    else if univ_to_type(Univ0, BinaryInputStream) then
        io.binary_input_stream_info(BrowserDb ^ browser_stream_db,
            BinaryInputStream) = BinaryInputStreamInfo,
        type_to_univ(BinaryInputStreamInfo, Univ)
    else if univ_to_type(Univ0, BinaryOutputStream) then
        io.binary_output_stream_info(BrowserDb ^ browser_stream_db,
            BinaryOutputStream) = BinaryOutputStreamInfo,
        type_to_univ(BinaryOutputStreamInfo, Univ)
    else
        Univ = Univ0
    ),
    Value = univ_value(Univ).

%---------------------------------------------------------------------------%