1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  1985-2025, University of Amsterdam
    7                              VU University Amsterdam
    8                              SWI-Prolog Solutions b.v.
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37:- module('$toplevel',
   38          [ '$initialise'/0,            % start Prolog
   39            '$toplevel'/0,              % Prolog top-level (re-entrant)
   40            '$compile'/0,               % `-c' toplevel
   41            '$config'/0,                % --dump-runtime-variables toplevel
   42            initialize/0,               % Run program initialization
   43            version/0,                  % Write initial banner
   44            version/1,                  % Add message to the banner
   45            prolog/0,                   % user toplevel predicate
   46            '$query_loop'/0,            % toplevel predicate
   47            '$execute_query'/3,         % +Query, +Bindings, -Truth
   48            residual_goals/1,           % +Callable
   49            (initialization)/1,         % initialization goal (directive)
   50            '$thread_init'/0,           % initialise thread
   51            (thread_initialization)/1   % thread initialization goal
   52            ]).   53
   54
   55                 /*******************************
   56                 *         VERSION BANNER       *
   57                 *******************************/
   58
   59:- dynamic prolog:version_msg/1.   60:- multifile prolog:version_msg/1.   61
   62%!  version is det.
   63%
   64%   Print the Prolog banner message and messages registered using
   65%   version/1.
   66
   67version :-
   68    print_message(banner, welcome).
   69
   70%!  version(+Message) is det.
   71%
   72%   Add message to version/0
   73
   74:- multifile
   75    system:term_expansion/2.   76
   77system:term_expansion((:- version(Message)),
   78                      prolog:version_msg(Message)).
   79
   80version(Message) :-
   81    (   prolog:version_msg(Message)
   82    ->  true
   83    ;   assertz(prolog:version_msg(Message))
   84    ).
   85
   86
   87                /********************************
   88                *         INITIALISATION        *
   89                *********************************/
   90
   91%!  load_init_file(+ScriptMode) is det.
   92%
   93%   Load the user customization file. This can  be done using ``swipl -f
   94%   file`` or simply using ``swipl``. In the   first  case we search the
   95%   file both directly and over  the   alias  `user_app_config`.  In the
   96%   latter case we only use the alias.
   97
   98load_init_file(_) :-
   99    '$cmd_option_val'(init_file, OsFile),
  100    !,
  101    prolog_to_os_filename(File, OsFile),
  102    load_init_file(File, explicit).
  103load_init_file(prolog) :-
  104    !,
  105    load_init_file('init.pl', implicit).
  106load_init_file(none) :-
  107    !,
  108    load_init_file('init.pl', implicit).
  109load_init_file(_).
  110
  111%!  loaded_init_file(?Base, ?AbsFile)
  112%
  113%   Used by prolog_load_context/2 to confirm we are loading a script.
  114
  115:- dynamic
  116    loaded_init_file/2.             % already loaded init files
  117
  118load_init_file(none, _) :- !.
  119load_init_file(Base, _) :-
  120    loaded_init_file(Base, _),
  121    !.
  122load_init_file(InitFile, explicit) :-
  123    exists_file(InitFile),
  124    !,
  125    ensure_loaded(user:InitFile).
  126load_init_file(Base, _) :-
  127    absolute_file_name(user_app_config(Base), InitFile,
  128                       [ access(read),
  129                         file_errors(fail)
  130                       ]),
  131    !,
  132    asserta(loaded_init_file(Base, InitFile)),
  133    load_files(user:InitFile,
  134               [ scope_settings(false)
  135               ]).
  136load_init_file('init.pl', implicit) :-
  137    (   current_prolog_flag(windows, true),
  138        absolute_file_name(user_profile('swipl.ini'), InitFile,
  139                           [ access(read),
  140                             file_errors(fail)
  141                           ])
  142    ;   expand_file_name('~/.swiplrc', [InitFile]),
  143        exists_file(InitFile)
  144    ),
  145    !,
  146    print_message(warning, backcomp(init_file_moved(InitFile))).
  147load_init_file(_, _).
  148
  149'$load_system_init_file' :-
  150    loaded_init_file(system, _),
  151    !.
  152'$load_system_init_file' :-
  153    '$cmd_option_val'(system_init_file, Base),
  154    Base \== none,
  155    current_prolog_flag(home, Home),
  156    file_name_extension(Base, rc, Name),
  157    atomic_list_concat([Home, '/', Name], File),
  158    absolute_file_name(File, Path,
  159                       [ file_type(prolog),
  160                         access(read),
  161                         file_errors(fail)
  162                       ]),
  163    asserta(loaded_init_file(system, Path)),
  164    load_files(user:Path,
  165               [ silent(true),
  166                 scope_settings(false)
  167               ]),
  168    !.
  169'$load_system_init_file'.
  170
  171'$load_script_file' :-
  172    loaded_init_file(script, _),
  173    !.
  174'$load_script_file' :-
  175    '$cmd_option_val'(script_file, OsFiles),
  176    load_script_files(OsFiles).
  177
  178load_script_files([]).
  179load_script_files([OsFile|More]) :-
  180    prolog_to_os_filename(File, OsFile),
  181    (   absolute_file_name(File, Path,
  182                           [ file_type(prolog),
  183                             access(read),
  184                             file_errors(fail)
  185                           ])
  186    ->  asserta(loaded_init_file(script, Path)),
  187        load_files(user:Path),
  188        load_files(user:More)
  189    ;   throw(error(existence_error(script_file, File), _))
  190    ).
  191
  192
  193                 /*******************************
  194                 *       AT_INITIALISATION      *
  195                 *******************************/
  196
  197:- meta_predicate
  198    initialization(0).  199
  200:- '$iso'((initialization)/1).  201
  202%!  initialization(:Goal)
  203%
  204%   Runs Goal after loading the file in which this directive
  205%   appears as well as after restoring a saved state.
  206%
  207%   @see initialization/2
  208
  209initialization(Goal) :-
  210    Goal = _:G,
  211    prolog:initialize_now(G, Use),
  212    !,
  213    print_message(warning, initialize_now(G, Use)),
  214    initialization(Goal, now).
  215initialization(Goal) :-
  216    initialization(Goal, after_load).
  217
  218:- multifile
  219    prolog:initialize_now/2,
  220    prolog:message//1.  221
  222prolog:initialize_now(load_foreign_library(_),
  223                      'use :- use_foreign_library/1 instead').
  224prolog:initialize_now(load_foreign_library(_,_),
  225                      'use :- use_foreign_library/2 instead').
  226
  227prolog:message(initialize_now(Goal, Use)) -->
  228    [ 'Initialization goal ~p will be executed'-[Goal],nl,
  229      'immediately for backward compatibility reasons', nl,
  230      '~w'-[Use]
  231    ].
  232
  233'$run_initialization' :-
  234    '$set_prolog_file_extension',
  235    '$run_initialization'(_, []),
  236    '$thread_init'.
  237
  238%!  initialize
  239%
  240%   Run goals registered with `:-  initialization(Goal, program).`. Stop
  241%   with an exception if a goal fails or raises an exception.
  242
  243initialize :-
  244    forall('$init_goal'(when(program), Goal, Ctx),
  245           run_initialize(Goal, Ctx)).
  246
  247run_initialize(Goal, Ctx) :-
  248    (   catch(Goal, E, true),
  249        (   var(E)
  250        ->  true
  251        ;   throw(error(initialization_error(E, Goal, Ctx), _))
  252        )
  253    ;   throw(error(initialization_error(failed, Goal, Ctx), _))
  254    ).
  255
  256
  257                 /*******************************
  258                 *     THREAD INITIALIZATION    *
  259                 *******************************/
  260
  261:- meta_predicate
  262    thread_initialization(0).  263:- dynamic
  264    '$at_thread_initialization'/1.  265
  266%!  thread_initialization(:Goal)
  267%
  268%   Run Goal now and everytime a new thread is created.
  269
  270thread_initialization(Goal) :-
  271    assert('$at_thread_initialization'(Goal)),
  272    call(Goal),
  273    !.
  274
  275'$thread_init' :-
  276    (   '$at_thread_initialization'(Goal),
  277        (   call(Goal)
  278        ->  fail
  279        ;   fail
  280        )
  281    ;   true
  282    ).
  283
  284
  285                 /*******************************
  286                 *     FILE SEARCH PATH (-p)    *
  287                 *******************************/
  288
  289%!  '$set_file_search_paths' is det.
  290%
  291%   Process -p PathSpec options.
  292
  293'$set_file_search_paths' :-
  294    '$cmd_option_val'(search_paths, Paths),
  295    (   '$member'(Path, Paths),
  296        atom_chars(Path, Chars),
  297        (   phrase('$search_path'(Name, Aliases), Chars)
  298        ->  '$reverse'(Aliases, Aliases1),
  299            forall('$member'(Alias, Aliases1),
  300                   asserta(user:file_search_path(Name, Alias)))
  301        ;   print_message(error, commandline_arg_type(p, Path))
  302        ),
  303        fail ; true
  304    ).
  305
  306'$search_path'(Name, Aliases) -->
  307    '$string'(NameChars),
  308    [=],
  309    !,
  310    {atom_chars(Name, NameChars)},
  311    '$search_aliases'(Aliases).
  312
  313'$search_aliases'([Alias|More]) -->
  314    '$string'(AliasChars),
  315    path_sep,
  316    !,
  317    { '$make_alias'(AliasChars, Alias) },
  318    '$search_aliases'(More).
  319'$search_aliases'([Alias]) -->
  320    '$string'(AliasChars),
  321    '$eos',
  322    !,
  323    { '$make_alias'(AliasChars, Alias) }.
  324
  325path_sep -->
  326    { current_prolog_flag(path_sep, Sep) },
  327    [Sep].
  328
  329'$string'([]) --> [].
  330'$string'([H|T]) --> [H], '$string'(T).
  331
  332'$eos'([], []).
  333
  334'$make_alias'(Chars, Alias) :-
  335    catch(term_to_atom(Alias, Chars), _, fail),
  336    (   atom(Alias)
  337    ;   functor(Alias, F, 1),
  338        F \== /
  339    ),
  340    !.
  341'$make_alias'(Chars, Alias) :-
  342    atom_chars(Alias, Chars).
  343
  344
  345                 /*******************************
  346                 *   LOADING ASSIOCIATED FILES  *
  347                 *******************************/
  348
  349%!  argv_prolog_files(-Files, -ScriptMode) is det.
  350%
  351%   Update the Prolog flag `argv`, extracting  the leading script files.
  352%   This is called after the C based  parser removed Prolog options such
  353%   as ``-q``, ``-f none``, etc.  These   options  are available through
  354%   '$cmd_option_val'/2.
  355%
  356%   Our task is to update the Prolog flag   `argv`  and return a list of
  357%   the files to be loaded.   The rules are:
  358%
  359%     - If we find ``--`` all remaining options must go to `argv`
  360%     - If we find *.pl files, these are added to Files and possibly
  361%       remaining arguments are "script" arguments.
  362%     - If we find an existing file, this is Files and possibly
  363%       remaining arguments are "script" arguments.
  364%     - File we find [search:]name, find search(name) as Prolog file,
  365%       make this the content of `Files` and pass the remainder as
  366%       options to `argv`.
  367%
  368%   @arg ScriptMode is one of
  369%
  370%     - exe
  371%       Program is a saved state
  372%     - prolog
  373%       One or more *.pl files on commandline
  374%     - script
  375%       Single existing file on commandline
  376%     - app
  377%       [path:]cli-name on commandline
  378%     - none
  379%       Normal interactive session
  380
  381argv_prolog_files([], exe) :-
  382    current_prolog_flag(saved_program_class, runtime),
  383    !,
  384    clean_argv.
  385argv_prolog_files(Files, ScriptMode) :-
  386    current_prolog_flag(argv, Argv),
  387    no_option_files(Argv, Argv1, Files, ScriptMode),
  388    (   (   nonvar(ScriptMode)
  389        ;   Argv1 == []
  390        )
  391    ->  (   Argv1 \== Argv
  392        ->  set_prolog_flag(argv, Argv1)
  393        ;   true
  394        )
  395    ;   '$usage',
  396        halt(1)
  397    ).
  398
  399no_option_files([--|Argv], Argv, [], ScriptMode) :-
  400    !,
  401    (   ScriptMode = none
  402    ->  true
  403    ;   true
  404    ).
  405no_option_files([Opt|_], _, _, ScriptMode) :-
  406    var(ScriptMode),
  407    sub_atom(Opt, 0, _, _, '-'),
  408    !,
  409    '$usage',
  410    halt(1).
  411no_option_files([OsFile|Argv0], Argv, [File|T], ScriptMode) :-
  412    file_name_extension(_, Ext, OsFile),
  413    user:prolog_file_type(Ext, prolog),
  414    !,
  415    ScriptMode = prolog,
  416    prolog_to_os_filename(File, OsFile),
  417    no_option_files(Argv0, Argv, T, ScriptMode).
  418no_option_files([OsScript|Argv], Argv, [Script], ScriptMode) :-
  419    var(ScriptMode),
  420    !,
  421    prolog_to_os_filename(PlScript, OsScript),
  422    (   exists_file(PlScript)
  423    ->  Script = PlScript,
  424        ScriptMode = script
  425    ;   cli_script(OsScript, Script)
  426    ->  ScriptMode = app,
  427        set_prolog_flag(app_name, OsScript)
  428    ;   '$existence_error'(file, PlScript)
  429    ).
  430no_option_files(Argv, Argv, [], ScriptMode) :-
  431    (   ScriptMode = none
  432    ->  true
  433    ;   true
  434    ).
  435
  436cli_script(CLI, Script) :-
  437    (   sub_atom(CLI, Pre, _, Post, ':')
  438    ->  sub_atom(CLI, 0, Pre, _, SearchPath),
  439        sub_atom(CLI, _, Post, 0, Base),
  440        Spec =.. [SearchPath, Base]
  441    ;   Spec = app(CLI)
  442    ),
  443    absolute_file_name(Spec, Script,
  444                       [ file_type(prolog),
  445                         access(exist),
  446                         file_errors(fail)
  447                       ]).
  448
  449clean_argv :-
  450    (   current_prolog_flag(argv, [--|Argv])
  451    ->  set_prolog_flag(argv, Argv)
  452    ;   true
  453    ).
  454
  455%!  win_associated_files(+Files)
  456%
  457%   If SWI-Prolog is started as <exe> <file>.<ext>, where <ext> is
  458%   the extension registered for associated files, set the Prolog
  459%   flag associated_file, switch to the directory holding the file
  460%   and -if possible- adjust the window title.
  461
  462win_associated_files(Files) :-
  463    (   Files = [File|_]
  464    ->  absolute_file_name(File, AbsFile),
  465        set_prolog_flag(associated_file, AbsFile),
  466        set_working_directory(File),
  467        set_window_title(Files)
  468    ;   true
  469    ).
  470
  471%!  set_working_directory(+File)
  472%
  473%   When opening as a GUI application, e.g.,  by opening a file from
  474%   the Finder/Explorer/..., we typically  want   to  change working
  475%   directory to the location of  the   primary  file.  We currently
  476%   detect that we are a GUI app  by the Prolog flag `console_menu`,
  477%   which is set by swipl-win[.exe].
  478
  479set_working_directory(File) :-
  480    current_prolog_flag(console_menu, true),
  481    access_file(File, read),
  482    !,
  483    file_directory_name(File, Dir),
  484    working_directory(_, Dir).
  485set_working_directory(_).
  486
  487set_window_title([File|More]) :-
  488    current_predicate(system:window_title/2),
  489    !,
  490    (   More == []
  491    ->  Extra = []
  492    ;   Extra = ['...']
  493    ),
  494    atomic_list_concat(['SWI-Prolog --', File | Extra], ' ', Title),
  495    system:window_title(_, Title).
  496set_window_title(_).
  497
  498
  499%!  start_pldoc
  500%
  501%   If the option ``--pldoc[=port]`` is given, load the PlDoc system.
  502
  503start_pldoc :-
  504    '$cmd_option_val'(pldoc_server, Server),
  505    (   Server == ''
  506    ->  call((doc_server(_), doc_browser))
  507    ;   catch(atom_number(Server, Port), _, fail)
  508    ->  call(doc_server(Port))
  509    ;   print_message(error, option_usage(pldoc)),
  510        halt(1)
  511    ).
  512start_pldoc.
  513
  514
  515%!  load_associated_files(+Files)
  516%
  517%   Load Prolog files specified from the commandline.
  518
  519load_associated_files(Files) :-
  520    load_files(user:Files).
  521
  522hkey('HKEY_CURRENT_USER/Software/SWI/Prolog').
  523hkey('HKEY_LOCAL_MACHINE/Software/SWI/Prolog').
  524
  525'$set_prolog_file_extension' :-
  526    current_prolog_flag(windows, true),
  527    hkey(Key),
  528    catch(win_registry_get_value(Key, fileExtension, Ext0),
  529          _, fail),
  530    !,
  531    (   atom_concat('.', Ext, Ext0)
  532    ->  true
  533    ;   Ext = Ext0
  534    ),
  535    (   user:prolog_file_type(Ext, prolog)
  536    ->  true
  537    ;   asserta(user:prolog_file_type(Ext, prolog))
  538    ).
  539'$set_prolog_file_extension'.
  540
  541
  542                /********************************
  543                *        TOPLEVEL GOALS         *
  544                *********************************/
  545
  546%!  '$initialise' is semidet.
  547%
  548%   Called from PL_initialise()  to  do  the   Prolog  part  of  the
  549%   initialization. If an exception  occurs,   this  is  printed and
  550%   '$initialise' fails.
  551
  552'$initialise' :-
  553    catch(initialise_prolog, E, initialise_error(E)).
  554
  555initialise_error(unwind(abort)) :- !.
  556initialise_error(unwind(halt(_))) :- !.
  557initialise_error(E) :-
  558    print_message(error, initialization_exception(E)),
  559    fail.
  560
  561initialise_prolog :-
  562    '$clean_history',
  563    apply_defines,
  564    apple_setup_app,                            % MacOS cwd/locale setup for swipl-win
  565    init_optimise,
  566    '$run_initialization',
  567    '$load_system_init_file',                   % -F file
  568    set_toplevel,                               % set `toplevel_goal` flag from -t
  569    '$set_file_search_paths',                   % handle -p alias=dir[:dir]*
  570    init_debug_flags,
  571    start_pldoc,                                % handle --pldoc[=port]
  572    main_thread_init.
  573
  574%!  main_thread_init
  575%
  576%   Deal with the _Epilog_ toplevel. If  the   flag  `epilog` is set and
  577%   xpce is around, create an epilog window   and complete the user part
  578%   of the initialization in the epilog thread.
  579
  580main_thread_init :-
  581    current_prolog_flag(epilog, true),
  582    thread_self(main),
  583    current_prolog_flag(xpce, true),
  584    exists_source(library(epilog)),
  585    !,
  586    use_module(library(epilog)),
  587    call(epilog([ init(user_thread_init),
  588                  main(true)
  589                ])).
  590main_thread_init :-
  591    user_thread_init.
  592
  593%!  user_thread_init
  594%
  595%   Complete the toplevel startup.  This may run in a separate thread.
  596
  597user_thread_init :-
  598    opt_attach_packs,
  599    argv_prolog_files(Files, ScriptMode),
  600    load_init_file(ScriptMode),                 % -f file
  601    catch(setup_colors, E, print_message(warning, E)),
  602    win_associated_files(Files),                % swipl-win: cd and update title
  603    '$load_script_file',                        % -s file (may be repeated)
  604    load_associated_files(Files),
  605    '$cmd_option_val'(goals, Goals),            % -g goal (may be repeated)
  606    (   ScriptMode == app
  607    ->  run_program_init,                       % initialization(Goal, program)
  608        run_main_init(true)
  609    ;   Goals == [],
  610        \+ '$init_goal'(when(_), _, _)          % no -g or -t or initialization(program)
  611    ->  version                                 % default interactive run
  612    ;   run_init_goals(Goals),                  % run -g goals
  613        (   load_only                           % used -l to load
  614        ->  version
  615        ;   run_program_init,                   % initialization(Goal, program)
  616            run_main_init(false)                % initialization(Goal, main)
  617        )
  618    ).
  619
  620apply_defines :-
  621    '$cmd_option_val'(defines, Defs),
  622    apply_defines(Defs).
  623
  624apply_defines([]).
  625apply_defines([H|T]) :-
  626    apply_define(H),
  627    apply_defines(T).
  628
  629apply_define(Def) :-
  630    sub_atom(Def, B, _, A, '='),
  631    !,
  632    sub_atom(Def, 0, B, _, Flag),
  633    sub_atom(Def, _, A, 0, Value0),
  634    (   '$current_prolog_flag'(Flag, Value0, _Scope, Access, Type)
  635    ->  (   Access \== write
  636        ->  '$permission_error'(set, prolog_flag, Flag)
  637        ;   text_flag_value(Type, Value0, Value)
  638        ),
  639	set_prolog_flag(Flag, Value)
  640    ;   (   atom_number(Value0, Value)
  641	->  true
  642	;   Value = Value0
  643	),
  644	create_prolog_flag(Flag, Value, [warn_not_accessed(true)])
  645    ).
  646apply_define(Def) :-
  647    atom_concat('no-', Flag, Def),
  648    !,
  649    set_user_boolean_flag(Flag, false).
  650apply_define(Def) :-
  651    set_user_boolean_flag(Def, true).
  652
  653set_user_boolean_flag(Flag, Value) :-
  654    current_prolog_flag(Flag, Old),
  655    !,
  656    (   Old == Value
  657    ->  true
  658    ;   set_prolog_flag(Flag, Value)
  659    ).
  660set_user_boolean_flag(Flag, Value) :-
  661    create_prolog_flag(Flag, Value, [warn_not_accessed(true)]).
  662
  663text_flag_value(integer, Text, Int) :-
  664    atom_number(Text, Int),
  665    !.
  666text_flag_value(float, Text, Float) :-
  667    atom_number(Text, Float),
  668    !.
  669text_flag_value(term, Text, Term) :-
  670    term_string(Term, Text, []),
  671    !.
  672text_flag_value(_, Value, Value).
  673
  674:- if(current_prolog_flag(apple,true)).  675apple_set_working_directory :-
  676    (   expand_file_name('~', [Dir]),
  677	exists_directory(Dir)
  678    ->  working_directory(_, Dir)
  679    ;   true
  680    ).
  681
  682apple_set_locale :-
  683    (   getenv('LC_CTYPE', 'UTF-8'),
  684	apple_current_locale_identifier(LocaleID),
  685	atom_concat(LocaleID, '.UTF-8', Locale),
  686	catch(setlocale(ctype, _Old, Locale), _, fail)
  687    ->  setenv('LANG', Locale),
  688        unsetenv('LC_CTYPE')
  689    ;   true
  690    ).
  691
  692apple_setup_app :-
  693    current_prolog_flag(apple, true),
  694    current_prolog_flag(console_menu, true),	% SWI-Prolog.app on MacOS
  695    apple_set_working_directory,
  696    apple_set_locale.
  697:- endif.  698apple_setup_app.
  699
  700init_optimise :-
  701    current_prolog_flag(optimise, true),
  702    !,
  703    use_module(user:library(apply_macros)).
  704init_optimise.
  705
  706opt_attach_packs :-
  707    current_prolog_flag(packs, true),
  708    !,
  709    attach_packs.
  710opt_attach_packs.
  711
  712set_toplevel :-
  713    '$cmd_option_val'(toplevel, TopLevelAtom),
  714    catch(term_to_atom(TopLevel, TopLevelAtom), E,
  715          (print_message(error, E),
  716           halt(1))),
  717    create_prolog_flag(toplevel_goal, TopLevel, [type(term)]).
  718
  719load_only :-
  720    current_prolog_flag(os_argv, OSArgv),
  721    memberchk('-l', OSArgv),
  722    current_prolog_flag(argv, Argv),
  723    \+ memberchk('-l', Argv).
  724
  725%!  run_init_goals(+Goals) is det.
  726%
  727%   Run registered initialization goals  on  order.   If  a  goal fails,
  728%   execution is halted.
  729
  730run_init_goals([]).
  731run_init_goals([H|T]) :-
  732    run_init_goal(H),
  733    run_init_goals(T).
  734
  735run_init_goal(Text) :-
  736    catch(term_to_atom(Goal, Text), E,
  737          (   print_message(error, init_goal_syntax(E, Text)),
  738              halt(2)
  739          )),
  740    run_init_goal(Goal, Text).
  741
  742%!  run_program_init is det.
  743%
  744%   Run goals registered using
  745
  746run_program_init :-
  747    forall('$init_goal'(when(program), Goal, Ctx),
  748           run_init_goal(Goal, @(Goal,Ctx))).
  749
  750run_main_init(_) :-
  751    findall(Goal-Ctx, '$init_goal'(when(main), Goal, Ctx), Pairs),
  752    '$last'(Pairs, Goal-Ctx),
  753    !,
  754    (   current_prolog_flag(toplevel_goal, default)
  755    ->  set_prolog_flag(toplevel_goal, halt)
  756    ;   true
  757    ),
  758    run_init_goal(Goal, @(Goal,Ctx)).
  759run_main_init(true) :-
  760    '$existence_error'(initialization, main).
  761run_main_init(_).
  762
  763run_init_goal(Goal, Ctx) :-
  764    (   catch_with_backtrace(user:Goal, E, true)
  765    ->  (   var(E)
  766        ->  true
  767        ;   print_message(error, init_goal_failed(E, Ctx)),
  768            halt(2)
  769        )
  770    ;   (   current_prolog_flag(verbose, silent)
  771        ->  Level = silent
  772        ;   Level = error
  773        ),
  774        print_message(Level, init_goal_failed(failed, Ctx)),
  775        halt(1)
  776    ).
  777
  778%!  init_debug_flags is det.
  779%
  780%   Initialize the various Prolog flags that   control  the debugger and
  781%   toplevel.
  782
  783init_debug_flags :-
  784    Keep = [keep(true)],
  785    create_prolog_flag(answer_write_options,
  786                       [ quoted(true), portray(true), max_depth(10),
  787                         spacing(next_argument)], Keep),
  788    create_prolog_flag(prompt_alternatives_on, determinism, Keep),
  789    create_prolog_flag(toplevel_extra_white_line, true, Keep),
  790    create_prolog_flag(toplevel_print_factorized, false, Keep),
  791    create_prolog_flag(print_write_options,
  792                       [ portray(true), quoted(true), numbervars(true) ],
  793                       Keep),
  794    create_prolog_flag(toplevel_residue_vars, false, Keep),
  795    create_prolog_flag(toplevel_list_wfs_residual_program, true, Keep),
  796    '$set_debugger_write_options'(print).
  797
  798%!  setup_backtrace
  799%
  800%   Initialise printing a backtrace.
  801
  802setup_backtrace :-
  803    (   \+ current_prolog_flag(backtrace, false),
  804        load_setup_file(library(prolog_stack))
  805    ->  true
  806    ;   true
  807    ).
  808
  809%!  setup_colors is det.
  810%
  811%   Setup  interactive  usage  by  enabling    colored   output.
  812
  813setup_colors :-
  814    (   \+ current_prolog_flag(color_term, false),
  815        stream_property(user_input, tty(true)),
  816        stream_property(user_error, tty(true)),
  817        stream_property(user_output, tty(true)),
  818        \+ getenv('TERM', dumb),
  819        load_setup_file(user:library(ansi_term))
  820    ->  true
  821    ;   true
  822    ).
  823
  824%!  setup_history
  825%
  826%   Enable per-directory persistent history.
  827
  828setup_history :-
  829    (   \+ current_prolog_flag(save_history, false),
  830        stream_property(user_input, tty(true)),
  831        \+ current_prolog_flag(readline, false),
  832        load_setup_file(library(prolog_history))
  833    ->  prolog_history(enable)
  834    ;   true
  835    ),
  836    set_default_history,
  837    '$load_history'.
  838
  839%!  setup_readline
  840%
  841%   Setup line editing.
  842
  843setup_readline :-
  844    (   current_prolog_flag(readline, swipl_win)
  845    ->  true
  846    ;   stream_property(user_input, tty(true)),
  847        current_prolog_flag(tty_control, true),
  848        \+ getenv('TERM', dumb),
  849        (   current_prolog_flag(readline, ReadLine)
  850        ->  true
  851        ;   ReadLine = true
  852        ),
  853        readline_library(ReadLine, Library),
  854        load_setup_file(library(Library))
  855    ->  set_prolog_flag(readline, Library)
  856    ;   set_prolog_flag(readline, false)
  857    ).
  858
  859readline_library(true, Library) :-
  860    !,
  861    preferred_readline(Library).
  862readline_library(false, _) :-
  863    !,
  864    fail.
  865readline_library(Library, Library).
  866
  867preferred_readline(editline).
  868preferred_readline(readline).
  869
  870%!  load_setup_file(+File) is semidet.
  871%
  872%   Load a file and fail silently if the file does not exist.
  873
  874load_setup_file(File) :-
  875    catch(load_files(File,
  876                     [ silent(true),
  877                       if(not_loaded)
  878                     ]), _, fail).
  879
  880
  881:- '$hide'('$toplevel'/0).              % avoid in the GUI stacktrace
  882
  883%!  '$toplevel'
  884%
  885%   Called from PL_toplevel()
  886
  887'$toplevel' :-
  888    '$runtoplevel',
  889    print_message(informational, halt).
  890
  891%!  '$runtoplevel'
  892%
  893%   Actually run the toplevel. The values   `default`  and `prolog` both
  894%   start the interactive toplevel, where `prolog` implies the user gave
  895%   =|-t prolog|=.
  896%
  897%   @see prolog/0 is the default interactive toplevel
  898
  899'$runtoplevel' :-
  900    current_prolog_flag(toplevel_goal, TopLevel0),
  901    toplevel_goal(TopLevel0, TopLevel),
  902    user:TopLevel.
  903
  904:- dynamic  setup_done/0.  905:- volatile setup_done/0.  906
  907toplevel_goal(default, '$query_loop') :-
  908    !,
  909    setup_interactive.
  910toplevel_goal(prolog, '$query_loop') :-
  911    !,
  912    setup_interactive.
  913toplevel_goal(Goal, Goal).
  914
  915setup_interactive :-
  916    setup_done,
  917    !.
  918setup_interactive :-
  919    asserta(setup_done),
  920    catch(setup_backtrace, E, print_message(warning, E)),
  921    catch(setup_readline,  E, print_message(warning, E)),
  922    catch(setup_history,   E, print_message(warning, E)).
  923
  924%!  '$compile'
  925%
  926%   Toplevel called when invoked with -c option.
  927
  928'$compile' :-
  929    (   catch('$compile_', E, (print_message(error, E), halt(1)))
  930    ->  true
  931    ;   print_message(error, error(goal_failed('$compile'), _)),
  932        halt(1)
  933    ),
  934    halt.                               % set exit code
  935
  936'$compile_' :-
  937    '$load_system_init_file',
  938    catch(setup_colors, _, true),
  939    '$set_file_search_paths',
  940    init_debug_flags,
  941    '$run_initialization',
  942    opt_attach_packs,
  943    use_module(library(qsave)),
  944    qsave:qsave_toplevel.
  945
  946%!  '$config'
  947%
  948%   Toplevel when invoked with --dump-runtime-variables
  949
  950'$config' :-
  951    '$load_system_init_file',
  952    '$set_file_search_paths',
  953    init_debug_flags,
  954    '$run_initialization',
  955    load_files(library(prolog_config)),
  956    (   catch(prolog_dump_runtime_variables, E,
  957              (print_message(error, E), halt(1)))
  958    ->  true
  959    ;   print_message(error, error(goal_failed(prolog_dump_runtime_variables),_))
  960    ).
  961
  962
  963                /********************************
  964                *    USER INTERACTIVE LOOP      *
  965                *********************************/
  966
  967%!  prolog:repl_loop_hook(+BeginEnd, +BreakLevel) is nondet.
  968%
  969%   Multifile  hook  that  allows  acting    on   starting/stopping  the
  970%   interactive REPL loop. Called as
  971%
  972%       forall(prolog:repl_loop_hook(BeginEnd, BreakLevel), true)
  973%
  974%   @arg BeginEnd is one of `begin` or `end`
  975%   @arg BreakLevel is 0 for the normal toplevel, -1 when
  976%   non-interactive and >0 for _break environments_.
  977
  978:- multifile
  979    prolog:repl_loop_hook/2.  980
  981%!  prolog
  982%
  983%   Run the Prolog toplevel. This is now  the same as break/0, which
  984%   pretends  to  be  in  a  break-level    if  there  is  a  parent
  985%   environment.
  986
  987prolog :-
  988    break.
  989
  990:- create_prolog_flag(toplevel_mode, backtracking, []).  991
  992%!  '$query_loop'
  993%
  994%   Run the normal Prolog query loop.  Note   that  the query is not
  995%   protected by catch/3. Dealing with  unhandled exceptions is done
  996%   by the C-function query_loop().  This   ensures  that  unhandled
  997%   exceptions are really unhandled (in Prolog).
  998
  999'$query_loop' :-
 1000    break_level(BreakLev),
 1001    setup_call_cleanup(
 1002        notrace(call_repl_loop_hook(begin, BreakLev)),
 1003        '$query_loop'(BreakLev),
 1004        notrace(call_repl_loop_hook(end, BreakLev))).
 1005
 1006call_repl_loop_hook(BeginEnd, BreakLev) :-
 1007    forall(prolog:repl_loop_hook(BeginEnd, BreakLev), true).
 1008
 1009
 1010'$query_loop'(BreakLev) :-
 1011    current_prolog_flag(toplevel_mode, recursive),
 1012    !,
 1013    read_expanded_query(BreakLev, Query, Bindings),
 1014    (   Query == end_of_file
 1015    ->  print_message(query, query(eof))
 1016    ;   '$call_no_catch'('$execute_query'(Query, Bindings, _)),
 1017        (   current_prolog_flag(toplevel_mode, recursive)
 1018        ->  '$query_loop'(BreakLev)
 1019        ;   '$switch_toplevel_mode'(backtracking),
 1020            '$query_loop'(BreakLev)     % Maybe throw('$switch_toplevel_mode')?
 1021        )
 1022    ).
 1023'$query_loop'(BreakLev) :-
 1024    repeat,
 1025        read_expanded_query(BreakLev, Query, Bindings),
 1026        (   Query == end_of_file
 1027        ->  !, print_message(query, query(eof))
 1028        ;   '$execute_query'(Query, Bindings, _),
 1029            (   current_prolog_flag(toplevel_mode, recursive)
 1030            ->  !,
 1031                '$switch_toplevel_mode'(recursive),
 1032                '$query_loop'(BreakLev)
 1033            ;   fail
 1034            )
 1035        ).
 1036
 1037break_level(BreakLev) :-
 1038    (   current_prolog_flag(break_level, BreakLev)
 1039    ->  true
 1040    ;   BreakLev = -1
 1041    ).
 1042
 1043read_expanded_query(BreakLev, ExpandedQuery, ExpandedBindings) :-
 1044    '$current_typein_module'(TypeIn),
 1045    (   stream_property(user_input, tty(true))
 1046    ->  '$system_prompt'(TypeIn, BreakLev, Prompt),
 1047        prompt(Old, '|    ')
 1048    ;   Prompt = '',
 1049        prompt(Old, '')
 1050    ),
 1051    trim_stacks,
 1052    trim_heap,
 1053    repeat,
 1054      (   catch(read_query(Prompt, Query, Bindings),
 1055                error(io_error(_,_),_), fail)
 1056      ->  prompt(_, Old),
 1057          catch(call_expand_query(Query, ExpandedQuery,
 1058                                  Bindings, ExpandedBindings),
 1059                Error,
 1060                (print_message(error, Error), fail))
 1061      ;   set_prolog_flag(debug_on_error, false),
 1062          thread_exit(io_error)
 1063      ),
 1064    !.
 1065
 1066
 1067%!  read_query(+Prompt, -Goal, -Bindings) is det.
 1068%
 1069%   Read the next query. The first  clause   deals  with  the case where
 1070%   !-based history is enabled. The second is   used  if we have command
 1071%   line editing.
 1072
 1073:- if(current_prolog_flag(emscripten, true)). 1074read_query(_Prompt, Goal, Bindings) :-
 1075    '$can_yield',
 1076    !,
 1077    await(query, GoalString),
 1078    term_string(Goal, GoalString, [variable_names(Bindings)]).
 1079:- endif. 1080read_query(Prompt, Goal, Bindings) :-
 1081    current_prolog_flag(history, N),
 1082    integer(N), N > 0,
 1083    !,
 1084    read_term_with_history(
 1085        Goal,
 1086        [ show(h),
 1087          help('!h'),
 1088          no_save([trace, end_of_file]),
 1089          prompt(Prompt),
 1090          variable_names(Bindings)
 1091        ]).
 1092read_query(Prompt, Goal, Bindings) :-
 1093    remove_history_prompt(Prompt, Prompt1),
 1094    repeat,                                 % over syntax errors
 1095    prompt1(Prompt1),
 1096    read_query_line(user_input, Line),
 1097    '$save_history_line'(Line),             % save raw line (edit syntax errors)
 1098    '$current_typein_module'(TypeIn),
 1099    catch(read_term_from_atom(Line, Goal,
 1100                              [ variable_names(Bindings),
 1101                                module(TypeIn)
 1102                              ]), E,
 1103          (   print_message(error, E),
 1104              fail
 1105          )),
 1106    !,
 1107    '$save_history_event'(Line).            % save event (no syntax errors)
 1108
 1109%!  read_query_line(+Input, -Line) is det.
 1110
 1111read_query_line(Input, Line) :-
 1112    stream_property(Input, error(true)),
 1113    !,
 1114    Line = end_of_file.
 1115read_query_line(Input, Line) :-
 1116    catch(read_term_as_atom(Input, Line), Error, true),
 1117    save_debug_after_read,
 1118    (   var(Error)
 1119    ->  true
 1120    ;   catch(print_message(error, Error), _, true),
 1121        (   Error = error(syntax_error(_),_)
 1122        ->  fail
 1123        ;   throw(Error)
 1124        )
 1125    ).
 1126
 1127%!  read_term_as_atom(+Input, -Line)
 1128%
 1129%   Read the next term as an  atom  and   skip  to  the newline or a
 1130%   non-space character.
 1131
 1132read_term_as_atom(In, Line) :-
 1133    '$raw_read'(In, Line),
 1134    (   Line == end_of_file
 1135    ->  true
 1136    ;   skip_to_nl(In)
 1137    ).
 1138
 1139%!  skip_to_nl(+Input) is det.
 1140%
 1141%   Read input after the term. Skips   white  space and %... comment
 1142%   until the end of the line or a non-blank character.
 1143
 1144skip_to_nl(In) :-
 1145    repeat,
 1146    peek_char(In, C),
 1147    (   C == '%'
 1148    ->  skip(In, '\n')
 1149    ;   char_type(C, space)
 1150    ->  get_char(In, _),
 1151        C == '\n'
 1152    ;   true
 1153    ),
 1154    !.
 1155
 1156remove_history_prompt('', '') :- !.
 1157remove_history_prompt(Prompt0, Prompt) :-
 1158    atom_chars(Prompt0, Chars0),
 1159    clean_history_prompt_chars(Chars0, Chars1),
 1160    delete_leading_blanks(Chars1, Chars),
 1161    atom_chars(Prompt, Chars).
 1162
 1163clean_history_prompt_chars([], []).
 1164clean_history_prompt_chars(['~', !|T], T) :- !.
 1165clean_history_prompt_chars([H|T0], [H|T]) :-
 1166    clean_history_prompt_chars(T0, T).
 1167
 1168delete_leading_blanks([' '|T0], T) :-
 1169    !,
 1170    delete_leading_blanks(T0, T).
 1171delete_leading_blanks(L, L).
 1172
 1173
 1174%!  set_default_history
 1175%
 1176%   Enable !-based numbered command history. This  is enabled by default
 1177%   if we are not running under GNU-emacs  and   we  do not have our own
 1178%   line editing.
 1179
 1180set_default_history :-
 1181    current_prolog_flag(history, _),
 1182    !.
 1183set_default_history :-
 1184    (   (   \+ current_prolog_flag(readline, false)
 1185        ;   current_prolog_flag(emacs_inferior_process, true)
 1186        )
 1187    ->  create_prolog_flag(history, 0, [])
 1188    ;   create_prolog_flag(history, 25, [])
 1189    ).
 1190
 1191
 1192                 /*******************************
 1193                 *        TOPLEVEL DEBUG        *
 1194                 *******************************/
 1195
 1196%!  save_debug_after_read
 1197%
 1198%   Called right after the toplevel read to save the debug status if
 1199%   it was modified from the GUI thread using e.g.
 1200%
 1201%     ==
 1202%     thread_signal(main, gdebug)
 1203%     ==
 1204%
 1205%   @bug Ideally, the prompt would change if debug mode is enabled.
 1206%        That is hard to realise with all the different console
 1207%        interfaces supported by SWI-Prolog.
 1208
 1209save_debug_after_read :-
 1210    current_prolog_flag(debug, true),
 1211    !,
 1212    save_debug.
 1213save_debug_after_read.
 1214
 1215save_debug :-
 1216    (   tracing,
 1217        notrace
 1218    ->  Tracing = true
 1219    ;   Tracing = false
 1220    ),
 1221    current_prolog_flag(debug, Debugging),
 1222    set_prolog_flag(debug, false),
 1223    create_prolog_flag(query_debug_settings,
 1224                       debug(Debugging, Tracing), []).
 1225
 1226restore_debug :-
 1227    current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)),
 1228    set_prolog_flag(debug, Debugging),
 1229    (   Tracing == true
 1230    ->  trace
 1231    ;   true
 1232    ).
 1233
 1234:- initialization
 1235    create_prolog_flag(query_debug_settings, debug(false, false), []). 1236
 1237
 1238                /********************************
 1239                *            PROMPTING          *
 1240                ********************************/
 1241
 1242'$system_prompt'(Module, BrekLev, Prompt) :-
 1243    current_prolog_flag(toplevel_prompt, PAtom),
 1244    atom_codes(PAtom, P0),
 1245    (    Module \== user
 1246    ->   '$substitute'('~m', [Module, ': '], P0, P1)
 1247    ;    '$substitute'('~m', [], P0, P1)
 1248    ),
 1249    (    BrekLev > 0
 1250    ->   '$substitute'('~l', ['[', BrekLev, '] '], P1, P2)
 1251    ;    '$substitute'('~l', [], P1, P2)
 1252    ),
 1253    current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)),
 1254    (    Tracing == true
 1255    ->   '$substitute'('~d', ['[trace] '], P2, P3)
 1256    ;    Debugging == true
 1257    ->   '$substitute'('~d', ['[debug] '], P2, P3)
 1258    ;    '$substitute'('~d', [], P2, P3)
 1259    ),
 1260    atom_chars(Prompt, P3).
 1261
 1262'$substitute'(From, T, Old, New) :-
 1263    atom_codes(From, FromCodes),
 1264    phrase(subst_chars(T), T0),
 1265    '$append'(Pre, S0, Old),
 1266    '$append'(FromCodes, Post, S0) ->
 1267    '$append'(Pre, T0, S1),
 1268    '$append'(S1, Post, New),
 1269    !.
 1270'$substitute'(_, _, Old, Old).
 1271
 1272subst_chars([]) -->
 1273    [].
 1274subst_chars([H|T]) -->
 1275    { atomic(H),
 1276      !,
 1277      atom_codes(H, Codes)
 1278    },
 1279    Codes,
 1280    subst_chars(T).
 1281subst_chars([H|T]) -->
 1282    H,
 1283    subst_chars(T).
 1284
 1285
 1286                /********************************
 1287                *           EXECUTION           *
 1288                ********************************/
 1289
 1290%!  '$execute_query'(Goal, Bindings, -Truth) is det.
 1291%
 1292%   Execute Goal using Bindings.
 1293
 1294'$execute_query'(Var, _, true) :-
 1295    var(Var),
 1296    !,
 1297    print_message(informational, var_query(Var)).
 1298'$execute_query'(Goal, Bindings, Truth) :-
 1299    '$current_typein_module'(TypeIn),
 1300    '$dwim_correct_goal'(TypeIn:Goal, Bindings, Corrected),
 1301    !,
 1302    setup_call_cleanup(
 1303        '$set_source_module'(M0, TypeIn),
 1304        expand_goal(Corrected, Expanded),
 1305        '$set_source_module'(M0)),
 1306    print_message(silent, toplevel_goal(Expanded, Bindings)),
 1307    '$execute_goal2'(Expanded, Bindings, Truth).
 1308'$execute_query'(_, _, false) :-
 1309    notrace,
 1310    print_message(query, query(no)).
 1311
 1312'$execute_goal2'(Goal, Bindings, true) :-
 1313    restore_debug,
 1314    '$current_typein_module'(TypeIn),
 1315    residue_vars(TypeIn:Goal, Vars, TypeIn:Delays, Chp),
 1316    deterministic(Det),
 1317    (   save_debug
 1318    ;   restore_debug, fail
 1319    ),
 1320    flush_output(user_output),
 1321    (   Det == true
 1322    ->  DetOrChp = true
 1323    ;   DetOrChp = Chp
 1324    ),
 1325    call_expand_answer(Goal, Bindings, NewBindings),
 1326    (    \+ \+ write_bindings(NewBindings, Vars, Delays, DetOrChp)
 1327    ->   !
 1328    ).
 1329'$execute_goal2'(_, _, false) :-
 1330    save_debug,
 1331    print_message(query, query(no)).
 1332
 1333residue_vars(Goal, Vars, Delays, Chp) :-
 1334    current_prolog_flag(toplevel_residue_vars, true),
 1335    !,
 1336    '$wfs_call'(call_residue_vars(stop_backtrace(Goal, Chp), Vars), Delays).
 1337residue_vars(Goal, [], Delays, Chp) :-
 1338    '$wfs_call'(stop_backtrace(Goal, Chp), Delays).
 1339
 1340stop_backtrace(Goal, Chp) :-
 1341    toplevel_call(Goal),
 1342    prolog_current_choice(Chp).
 1343
 1344toplevel_call(Goal) :-
 1345    call(Goal),
 1346    no_lco.
 1347
 1348no_lco.
 1349
 1350%!  write_bindings(+Bindings, +ResidueVars, +Delays, +DetOrChp)
 1351%!	is semidet.
 1352%
 1353%   Write   bindings   resulting   from   a     query.    The   flag
 1354%   prompt_alternatives_on determines whether the   user is prompted
 1355%   for alternatives. =groundness= gives   the  classical behaviour,
 1356%   =determinism= is considered more adequate and informative.
 1357%
 1358%   Succeeds if the user accepts the answer and fails otherwise.
 1359%
 1360%   @arg ResidueVars are the residual constraints and provided if
 1361%        the prolog flag `toplevel_residue_vars` is set to
 1362%        `project`.
 1363
 1364write_bindings(Bindings, ResidueVars, Delays, DetOrChp) :-
 1365    '$current_typein_module'(TypeIn),
 1366    translate_bindings(Bindings, Bindings1, ResidueVars, TypeIn:Residuals),
 1367    omit_qualifier(Delays, TypeIn, Delays1),
 1368    write_bindings2(Bindings, Bindings1, Residuals, Delays1, DetOrChp).
 1369
 1370write_bindings2(OrgBindings, [], Residuals, Delays, _) :-
 1371    current_prolog_flag(prompt_alternatives_on, groundness),
 1372    !,
 1373    name_vars(OrgBindings, [], t(Residuals, Delays)),
 1374    print_message(query, query(yes(Delays, Residuals))).
 1375write_bindings2(OrgBindings, Bindings, Residuals, Delays, true) :-
 1376    current_prolog_flag(prompt_alternatives_on, determinism),
 1377    !,
 1378    name_vars(OrgBindings, Bindings, t(Residuals, Delays)),
 1379    print_message(query, query(yes(Bindings, Delays, Residuals))).
 1380write_bindings2(OrgBindings, Bindings, Residuals, Delays, Chp) :-
 1381    repeat,
 1382        name_vars(OrgBindings, Bindings, t(Residuals, Delays)),
 1383        print_message(query, query(more(Bindings, Delays, Residuals))),
 1384        get_respons(Action, Chp),
 1385    (   Action == redo
 1386    ->  !, fail
 1387    ;   Action == show_again
 1388    ->  fail
 1389    ;   !,
 1390        print_message(query, query(done))
 1391    ).
 1392
 1393%!  name_vars(+OrgBinding, +Bindings, +Term) is det.
 1394%
 1395%   Give a name ``_[A-Z][0-9]*`` to all variables   in Term, that do not
 1396%   have a name due to Bindings. Singleton   variables in Term are named
 1397%   `_`. The behavior depends on these Prolog flags:
 1398%
 1399%     - toplevel_name_variables
 1400%       Only act when `true`, else name_vars/3 is a no-op.
 1401%     - toplevel_print_anon
 1402%
 1403%   Variables are named by unifying them to `'$VAR'(Name)`
 1404%
 1405%   @arg Bindings is a list Name=Value
 1406
 1407name_vars(OrgBindings, Bindings, Term) :-
 1408    current_prolog_flag(toplevel_name_variables, true),
 1409    answer_flags_imply_numbervars,
 1410    !,
 1411    '$term_multitons'(t(Bindings,Term), Vars),
 1412    bindings_var_names(OrgBindings, Bindings, VarNames),
 1413    name_vars_(Vars, VarNames, 0),
 1414    term_variables(t(Bindings,Term), SVars),
 1415    anon_vars(SVars).
 1416name_vars(_OrgBindings, _Bindings, _Term).
 1417
 1418name_vars_([], _, _).
 1419name_vars_([H|T], Bindings, N) :-
 1420    name_var(Bindings, Name, N, N1),
 1421    H = '$VAR'(Name),
 1422    name_vars_(T, Bindings, N1).
 1423
 1424anon_vars([]).
 1425anon_vars(['$VAR'('_')|T]) :-
 1426    anon_vars(T).
 1427
 1428%!  name_var(+Reserved, -Name, +N0, -N) is det.
 1429%
 1430%   True when Name is a valid name for   a new variable where the search
 1431%   is guided by the number N0. Name may not appear in Reserved.
 1432
 1433name_var(Reserved, Name, N0, N) :-
 1434    between(N0, infinite, N1),
 1435    I is N1//26,
 1436    J is 0'A + N1 mod 26,
 1437    (   I == 0
 1438    ->  format(atom(Name), '_~c', [J])
 1439    ;   format(atom(Name), '_~c~d', [J, I])
 1440    ),
 1441    \+ memberchk(Name, Reserved),
 1442    !,
 1443    N is N1+1.
 1444
 1445%!  bindings_var_names(+OrgBindings, +TransBindings, -VarNames) is det.
 1446%
 1447%   Find the joined set of variable names   in the original bindings and
 1448%   translated bindings. When generating new names,  we better also omit
 1449%   names  that  appear  in  the  original  bindings  (but  not  in  the
 1450%   translated bindigns).
 1451
 1452bindings_var_names(OrgBindings, TransBindings, VarNames) :-
 1453    phrase(bindings_var_names_(OrgBindings), VarNames0, Tail),
 1454    phrase(bindings_var_names_(TransBindings), Tail, []),
 1455    sort(VarNames0, VarNames).
 1456
 1457%!  bindings_var_names_(+Bindings)// is det.
 1458%
 1459%   Produce a list of variable names that appear in Bindings. This deals
 1460%   both with the single and joined representation of bindings.
 1461
 1462bindings_var_names_([]) --> [].
 1463bindings_var_names_([H|T]) -->
 1464    binding_var_names(H),
 1465    bindings_var_names_(T).
 1466
 1467binding_var_names(binding(Vars,_Value,_Subst)) ==>
 1468    var_names(Vars).
 1469binding_var_names(Name=_Value) ==>
 1470    [Name].
 1471
 1472var_names([]) --> [].
 1473var_names([H|T]) --> [H], var_names(T).
 1474
 1475
 1476%!  answer_flags_imply_numbervars
 1477%
 1478%   True when the answer will be  written recognising '$VAR'(N). If this
 1479%   is not the case we should not try to name the variables.
 1480
 1481answer_flags_imply_numbervars :-
 1482    current_prolog_flag(answer_write_options, Options),
 1483    numbervars_option(Opt),
 1484    memberchk(Opt, Options),
 1485    !.
 1486
 1487numbervars_option(portray(true)).
 1488numbervars_option(portrayed(true)).
 1489numbervars_option(numbervars(true)).
 1490
 1491%!  residual_goals(:NonTerminal)
 1492%
 1493%   Directive that registers NonTerminal as a collector for residual
 1494%   goals.
 1495
 1496:- multifile
 1497    residual_goal_collector/1. 1498
 1499:- meta_predicate
 1500    residual_goals(2). 1501
 1502residual_goals(NonTerminal) :-
 1503    throw(error(context_error(nodirective, residual_goals(NonTerminal)), _)).
 1504
 1505system:term_expansion((:- residual_goals(NonTerminal)),
 1506                      '$toplevel':residual_goal_collector(M2:Head)) :-
 1507    \+ current_prolog_flag(xref, true),
 1508    prolog_load_context(module, M),
 1509    strip_module(M:NonTerminal, M2, Head),
 1510    '$must_be'(callable, Head).
 1511
 1512%!  prolog:residual_goals// is det.
 1513%
 1514%   DCG that collects residual goals that   are  not associated with
 1515%   the answer through attributed variables.
 1516
 1517:- public prolog:residual_goals//0. 1518
 1519prolog:residual_goals -->
 1520    { findall(NT, residual_goal_collector(NT), NTL) },
 1521    collect_residual_goals(NTL).
 1522
 1523collect_residual_goals([]) --> [].
 1524collect_residual_goals([H|T]) -->
 1525    ( call(H) -> [] ; [] ),
 1526    collect_residual_goals(T).
 1527
 1528
 1529
 1530%!  prolog:translate_bindings(+Bindings0, -Bindings, +ResidueVars,
 1531%!                            +ResidualGoals, -Residuals) is det.
 1532%
 1533%   Translate the raw variable bindings  resulting from successfully
 1534%   completing a query into a  binding   list  and  list of residual
 1535%   goals suitable for human consumption.
 1536%
 1537%   @arg    Bindings is a list of binding(Vars,Value,Substitutions),
 1538%           where Vars is a list of variable names. E.g.
 1539%           binding(['A','B'],42,[])` means that both the variable
 1540%           A and B have the value 42. Values may contain terms
 1541%           '$VAR'(Name) to indicate sharing with a given variable.
 1542%           Value is always an acyclic term. If cycles appear in the
 1543%           answer, Substitutions contains a list of substitutions
 1544%           that restore the original term.
 1545%
 1546%   @arg    Residuals is a pair of two lists representing residual
 1547%           goals. The first element of the pair are residuals
 1548%           related to the query variables and the second are
 1549%           related that are disconnected from the query.
 1550
 1551:- public
 1552    prolog:translate_bindings/5. 1553:- meta_predicate
 1554    prolog:translate_bindings(+, -, +, +, :). 1555
 1556prolog:translate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals) :-
 1557    translate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals),
 1558    name_vars(Bindings0, Bindings, t(ResVars, ResGoals, Residuals)).
 1559
 1560% should not be required.
 1561prolog:name_vars(Bindings, Term) :- name_vars([], Bindings, Term).
 1562prolog:name_vars(Bindings0, Bindings, Term) :- name_vars(Bindings0, Bindings, Term).
 1563
 1564translate_bindings(Bindings0, Bindings, ResidueVars, Residuals) :-
 1565    prolog:residual_goals(ResidueGoals, []),
 1566    translate_bindings(Bindings0, Bindings, ResidueVars, ResidueGoals,
 1567                       Residuals).
 1568
 1569translate_bindings(Bindings0, Bindings, [], [], _:[]-[]) :-
 1570    term_attvars(Bindings0, []),
 1571    !,
 1572    join_same_bindings(Bindings0, Bindings1),
 1573    factorize_bindings(Bindings1, Bindings2),
 1574    bind_vars(Bindings2, Bindings3),
 1575    filter_bindings(Bindings3, Bindings).
 1576translate_bindings(Bindings0, Bindings, ResidueVars, ResGoals0,
 1577                   TypeIn:Residuals-HiddenResiduals) :-
 1578    project_constraints(Bindings0, ResidueVars),
 1579    hidden_residuals(ResidueVars, Bindings0, HiddenResiduals0),
 1580    omit_qualifiers(HiddenResiduals0, TypeIn, HiddenResiduals),
 1581    copy_term(Bindings0+ResGoals0, Bindings1+ResGoals1, Residuals0),
 1582    '$append'(ResGoals1, Residuals0, Residuals1),
 1583    omit_qualifiers(Residuals1, TypeIn, Residuals),
 1584    join_same_bindings(Bindings1, Bindings2),
 1585    factorize_bindings(Bindings2, Bindings3),
 1586    bind_vars(Bindings3, Bindings4),
 1587    filter_bindings(Bindings4, Bindings).
 1588
 1589hidden_residuals(ResidueVars, Bindings, Goal) :-
 1590    term_attvars(ResidueVars, Remaining),
 1591    term_attvars(Bindings, QueryVars),
 1592    subtract_vars(Remaining, QueryVars, HiddenVars),
 1593    copy_term(HiddenVars, _, Goal).
 1594
 1595subtract_vars(All, Subtract, Remaining) :-
 1596    sort(All, AllSorted),
 1597    sort(Subtract, SubtractSorted),
 1598    ord_subtract(AllSorted, SubtractSorted, Remaining).
 1599
 1600ord_subtract([], _Not, []).
 1601ord_subtract([H1|T1], L2, Diff) :-
 1602    diff21(L2, H1, T1, Diff).
 1603
 1604diff21([], H1, T1, [H1|T1]).
 1605diff21([H2|T2], H1, T1, Diff) :-
 1606    compare(Order, H1, H2),
 1607    diff3(Order, H1, T1, H2, T2, Diff).
 1608
 1609diff12([], _H2, _T2, []).
 1610diff12([H1|T1], H2, T2, Diff) :-
 1611    compare(Order, H1, H2),
 1612    diff3(Order, H1, T1, H2, T2, Diff).
 1613
 1614diff3(<,  H1, T1,  H2, T2, [H1|Diff]) :-
 1615    diff12(T1, H2, T2, Diff).
 1616diff3(=, _H1, T1, _H2, T2, Diff) :-
 1617    ord_subtract(T1, T2, Diff).
 1618diff3(>,  H1, T1, _H2, T2, Diff) :-
 1619    diff21(T2, H1, T1, Diff).
 1620
 1621
 1622%!  project_constraints(+Bindings, +ResidueVars) is det.
 1623%
 1624%   Call   <module>:project_attributes/2   if   the    Prolog   flag
 1625%   `toplevel_residue_vars` is set to `project`.
 1626
 1627project_constraints(Bindings, ResidueVars) :-
 1628    !,
 1629    term_attvars(Bindings, AttVars),
 1630    phrase(attribute_modules(AttVars), Modules0),
 1631    sort(Modules0, Modules),
 1632    term_variables(Bindings, QueryVars),
 1633    project_attributes(Modules, QueryVars, ResidueVars).
 1634project_constraints(_, _).
 1635
 1636project_attributes([], _, _).
 1637project_attributes([M|T], QueryVars, ResidueVars) :-
 1638    (   current_predicate(M:project_attributes/2),
 1639        catch(M:project_attributes(QueryVars, ResidueVars), E,
 1640              print_message(error, E))
 1641    ->  true
 1642    ;   true
 1643    ),
 1644    project_attributes(T, QueryVars, ResidueVars).
 1645
 1646attribute_modules([]) --> [].
 1647attribute_modules([H|T]) -->
 1648    { get_attrs(H, Attrs) },
 1649    attrs_modules(Attrs),
 1650    attribute_modules(T).
 1651
 1652attrs_modules([]) --> [].
 1653attrs_modules(att(Module, _, More)) -->
 1654    [Module],
 1655    attrs_modules(More).
 1656
 1657
 1658%!  join_same_bindings(Bindings0, Bindings)
 1659%
 1660%   Join variables that are bound to the   same  value. Note that we
 1661%   return the _last_ value. This is   because the factorization may
 1662%   be different and ultimately the names will   be  printed as V1 =
 1663%   V2, ... VN = Value. Using the  last, Value has the factorization
 1664%   of VN.
 1665
 1666join_same_bindings([], []).
 1667join_same_bindings([Name=V0|T0], [[Name|Names]=V|T]) :-
 1668    take_same_bindings(T0, V0, V, Names, T1),
 1669    join_same_bindings(T1, T).
 1670
 1671take_same_bindings([], Val, Val, [], []).
 1672take_same_bindings([Name=V1|T0], V0, V, [Name|Names], T) :-
 1673    V0 == V1,
 1674    !,
 1675    take_same_bindings(T0, V1, V, Names, T).
 1676take_same_bindings([Pair|T0], V0, V, Names, [Pair|T]) :-
 1677    take_same_bindings(T0, V0, V, Names, T).
 1678
 1679
 1680%!  omit_qualifiers(+QGoals, +TypeIn, -Goals) is det.
 1681%
 1682%   Omit unneeded module qualifiers  from   QGoals  relative  to the
 1683%   given module TypeIn.
 1684
 1685
 1686omit_qualifiers([], _, []).
 1687omit_qualifiers([Goal0|Goals0], TypeIn, [Goal|Goals]) :-
 1688    omit_qualifier(Goal0, TypeIn, Goal),
 1689    omit_qualifiers(Goals0, TypeIn, Goals).
 1690
 1691omit_qualifier(M:G0, TypeIn, G) :-
 1692    M == TypeIn,
 1693    !,
 1694    omit_meta_qualifiers(G0, TypeIn, G).
 1695omit_qualifier(M:G0, TypeIn, G) :-
 1696    predicate_property(TypeIn:G0, imported_from(M)),
 1697    \+ predicate_property(G0, transparent),
 1698    !,
 1699    G0 = G.
 1700omit_qualifier(_:G0, _, G) :-
 1701    predicate_property(G0, built_in),
 1702    \+ predicate_property(G0, transparent),
 1703    !,
 1704    G0 = G.
 1705omit_qualifier(M:G0, _, M:G) :-
 1706    atom(M),
 1707    !,
 1708    omit_meta_qualifiers(G0, M, G).
 1709omit_qualifier(G0, TypeIn, G) :-
 1710    omit_meta_qualifiers(G0, TypeIn, G).
 1711
 1712omit_meta_qualifiers(V, _, V) :-
 1713    var(V),
 1714    !.
 1715omit_meta_qualifiers((QA,QB), TypeIn, (A,B)) :-
 1716    !,
 1717    omit_qualifier(QA, TypeIn, A),
 1718    omit_qualifier(QB, TypeIn, B).
 1719omit_meta_qualifiers(tnot(QA), TypeIn, tnot(A)) :-
 1720    !,
 1721    omit_qualifier(QA, TypeIn, A).
 1722omit_meta_qualifiers(freeze(V, QGoal), TypeIn, freeze(V, Goal)) :-
 1723    callable(QGoal),
 1724    !,
 1725    omit_qualifier(QGoal, TypeIn, Goal).
 1726omit_meta_qualifiers(when(Cond, QGoal), TypeIn, when(Cond, Goal)) :-
 1727    callable(QGoal),
 1728    !,
 1729    omit_qualifier(QGoal, TypeIn, Goal).
 1730omit_meta_qualifiers(G, _, G).
 1731
 1732
 1733%!  bind_vars(+BindingsIn, -Bindings)
 1734%
 1735%   Bind variables to '$VAR'(Name), so they are printed by the names
 1736%   used in the query. Note that by   binding  in the reverse order,
 1737%   variables bound to one another come out in the natural order.
 1738
 1739bind_vars(Bindings0, Bindings) :-
 1740    bind_query_vars(Bindings0, Bindings, SNames),
 1741    bind_skel_vars(Bindings, Bindings, SNames, 1, _).
 1742
 1743bind_query_vars([], [], []).
 1744bind_query_vars([binding(Names,Var,[Var2=Cycle])|T0],
 1745                [binding(Names,Cycle,[])|T], [Name|SNames]) :-
 1746    Var == Var2,                   % also implies var(Var)
 1747    !,
 1748    '$last'(Names, Name),
 1749    Var = '$VAR'(Name),
 1750    bind_query_vars(T0, T, SNames).
 1751bind_query_vars([B|T0], [B|T], AllNames) :-
 1752    B = binding(Names,Var,Skel),
 1753    bind_query_vars(T0, T, SNames),
 1754    (   var(Var), \+ attvar(Var), Skel == []
 1755    ->  AllNames = [Name|SNames],
 1756        '$last'(Names, Name),
 1757        Var = '$VAR'(Name)
 1758    ;   AllNames = SNames
 1759    ).
 1760
 1761
 1762
 1763bind_skel_vars([], _, _, N, N).
 1764bind_skel_vars([binding(_,_,Skel)|T], Bindings, SNames, N0, N) :-
 1765    bind_one_skel_vars(Skel, Bindings, SNames, N0, N1),
 1766    bind_skel_vars(T, Bindings, SNames, N1, N).
 1767
 1768%!  bind_one_skel_vars(+Subst, +Bindings, +VarName, +N0, -N)
 1769%
 1770%   Give names to the factorized variables that   do not have a name
 1771%   yet. This introduces names  _S<N>,   avoiding  duplicates.  If a
 1772%   factorized variable shares with another binding, use the name of
 1773%   that variable.
 1774%
 1775%   @tbd    Consider the call below. We could remove either of the
 1776%           A = x(1).  Which is best?
 1777%
 1778%           ==
 1779%           ?- A = x(1), B = a(A,A).
 1780%           A = x(1),
 1781%           B = a(A, A), % where
 1782%               A = x(1).
 1783%           ==
 1784
 1785bind_one_skel_vars([], _, _, N, N).
 1786bind_one_skel_vars([Var=Value|T], Bindings, Names, N0, N) :-
 1787    (   var(Var)
 1788    ->  (   '$member'(binding(Names, VVal, []), Bindings),
 1789            same_term(Value, VVal)
 1790        ->  '$last'(Names, VName),
 1791            Var = '$VAR'(VName),
 1792            N2 = N0
 1793        ;   between(N0, infinite, N1),
 1794            atom_concat('_S', N1, Name),
 1795            \+ memberchk(Name, Names),
 1796            !,
 1797            Var = '$VAR'(Name),
 1798            N2 is N1 + 1
 1799        )
 1800    ;   N2 = N0
 1801    ),
 1802    bind_one_skel_vars(T, Bindings, Names, N2, N).
 1803
 1804
 1805%!  factorize_bindings(+Bindings0, -Factorized)
 1806%
 1807%   Factorize cycles and sharing in the bindings.
 1808
 1809factorize_bindings([], []).
 1810factorize_bindings([Name=Value|T0], [binding(Name, Skel, Subst)|T]) :-
 1811    '$factorize_term'(Value, Skel, Subst0),
 1812    (   current_prolog_flag(toplevel_print_factorized, true)
 1813    ->  Subst = Subst0
 1814    ;   only_cycles(Subst0, Subst)
 1815    ),
 1816    factorize_bindings(T0, T).
 1817
 1818
 1819only_cycles([], []).
 1820only_cycles([B|T0], List) :-
 1821    (   B = (Var=Value),
 1822        Var = Value,
 1823        acyclic_term(Var)
 1824    ->  only_cycles(T0, List)
 1825    ;   List = [B|T],
 1826        only_cycles(T0, T)
 1827    ).
 1828
 1829
 1830%!  filter_bindings(+Bindings0, -Bindings)
 1831%
 1832%   Remove bindings that must not be printed. There are two of them:
 1833%   Variables whose name start with '_'  and variables that are only
 1834%   bound to themselves (or, unbound).
 1835
 1836filter_bindings([], []).
 1837filter_bindings([H0|T0], T) :-
 1838    hide_vars(H0, H),
 1839    (   (   arg(1, H, [])
 1840        ;   self_bounded(H)
 1841        )
 1842    ->  filter_bindings(T0, T)
 1843    ;   T = [H|T1],
 1844        filter_bindings(T0, T1)
 1845    ).
 1846
 1847hide_vars(binding(Names0, Skel, Subst), binding(Names, Skel, Subst)) :-
 1848    hide_names(Names0, Skel, Subst, Names).
 1849
 1850hide_names([], _, _, []).
 1851hide_names([Name|T0], Skel, Subst, T) :-
 1852    (   sub_atom(Name, 0, _, _, '_'),
 1853        current_prolog_flag(toplevel_print_anon, false),
 1854        sub_atom(Name, 1, 1, _, Next),
 1855        char_type(Next, prolog_var_start)
 1856    ->  true
 1857    ;   Subst == [],
 1858        Skel == '$VAR'(Name)
 1859    ),
 1860    !,
 1861    hide_names(T0, Skel, Subst, T).
 1862hide_names([Name|T0], Skel, Subst, [Name|T]) :-
 1863    hide_names(T0, Skel, Subst, T).
 1864
 1865self_bounded(binding([Name], Value, [])) :-
 1866    Value == '$VAR'(Name).
 1867
 1868%!  get_respons(-Action, +Chp)
 1869%
 1870%   Read the continuation entered by the user.
 1871
 1872:- if(current_prolog_flag(emscripten, true)). 1873get_respons(Action, Chp) :-
 1874    '$can_yield',
 1875    !,
 1876    repeat,
 1877        await(more, CommandS),
 1878        atom_string(Command, CommandS),
 1879        more_action(Command, Chp, Action),
 1880        (   Action == again
 1881        ->  print_message(query, query(action)),
 1882            fail
 1883        ;   !
 1884        ).
 1885:- endif. 1886get_respons(Action, Chp) :-
 1887    repeat,
 1888        flush_output(user_output),
 1889        get_single_char(Code),
 1890        find_more_command(Code, Command, Feedback, Style),
 1891        (   Style \== '-'
 1892        ->  print_message(query, if_tty([ansi(Style, '~w', [Feedback])]))
 1893        ;   true
 1894        ),
 1895        more_action(Command, Chp, Action),
 1896        (   Action == again
 1897        ->  print_message(query, query(action)),
 1898            fail
 1899        ;   !
 1900        ).
 1901
 1902find_more_command(-1, end_of_file, 'EOF', warning) :-
 1903    !.
 1904find_more_command(Code, Command, Feedback, Style) :-
 1905    more_command(Command, Atom, Feedback, Style),
 1906    '$in_reply'(Code, Atom),
 1907    !.
 1908find_more_command(Code, again, '', -) :-
 1909    print_message(query, no_action(Code)).
 1910
 1911more_command(help,        '?h',        '',          -).
 1912more_command(redo,        ';nrNR \t',  ';',         bold).
 1913more_command(trace,       'tT',        '; [trace]', comment).
 1914more_command(continue,    'ca\n\ryY.', '.',         bold).
 1915more_command(break,       'b',         '',          -).
 1916more_command(choicepoint, '*',         '',          -).
 1917more_command(write,       'w',         '[write]',   comment).
 1918more_command(print,       'p',         '[print]',   comment).
 1919more_command(depth_inc,   '+',         Change,      comment) :-
 1920    (   print_depth(Depth0)
 1921    ->  depth_step(Step),
 1922        NewDepth is Depth0*Step,
 1923        format(atom(Change), '[max_depth(~D)]', [NewDepth])
 1924    ;   Change = 'no max_depth'
 1925    ).
 1926more_command(depth_dec,   '-',         Change,      comment) :-
 1927    (   print_depth(Depth0)
 1928    ->  depth_step(Step),
 1929        NewDepth is max(1, Depth0//Step),
 1930        format(atom(Change), '[max_depth(~D)]', [NewDepth])
 1931    ;   Change = '[max_depth(10)]'
 1932    ).
 1933
 1934more_action(help, _, Action) =>
 1935    Action = again,
 1936    print_message(help, query(help)).
 1937more_action(redo, _, Action) =>			% Next
 1938    Action = redo.
 1939more_action(trace, _, Action) =>
 1940    Action = redo,
 1941    trace,
 1942    save_debug.
 1943more_action(continue, _, Action) =>             % Stop
 1944    Action = continue.
 1945more_action(break, _, Action) =>
 1946    Action = show_again,
 1947    break.
 1948more_action(choicepoint, Chp, Action) =>
 1949    Action = show_again,
 1950    print_last_chpoint(Chp).
 1951more_action(end_of_file, _, Action) =>
 1952    Action = show_again,
 1953    halt(0).
 1954more_action(again, _, Action) =>
 1955    Action = again.
 1956more_action(Command, _, Action),
 1957    current_prolog_flag(answer_write_options, Options0),
 1958    print_predicate(Command, Options0, Options) =>
 1959    Action = show_again,
 1960    set_prolog_flag(answer_write_options, Options).
 1961
 1962print_depth(Depth) :-
 1963    current_prolog_flag(answer_write_options, Options),
 1964    memberchk(max_depth(Depth), Options),
 1965    !.
 1966
 1967%!  print_predicate(+Action, +Options0, -Options) is semidet.
 1968%
 1969%   Modify  the  `answer_write_options`  value  according  to  the  user
 1970%   command.
 1971
 1972print_predicate(write, Options0, Options) :-
 1973    edit_options([-portrayed(true),-portray(true)],
 1974                 Options0, Options).
 1975print_predicate(print, Options0, Options) :-
 1976    edit_options([+portrayed(true)],
 1977                 Options0, Options).
 1978print_predicate(depth_inc, Options0, Options) :-
 1979    (   '$select'(max_depth(D0), Options0, Options1)
 1980    ->  depth_step(Step),
 1981        D is D0*Step,
 1982        Options = [max_depth(D)|Options1]
 1983    ;   Options = Options0
 1984    ).
 1985print_predicate(depth_dec, Options0, Options) :-
 1986    (   '$select'(max_depth(D0), Options0, Options1)
 1987    ->  depth_step(Step),
 1988        D is max(1, D0//Step),
 1989        Options = [max_depth(D)|Options1]
 1990    ;   D = 10,
 1991        Options = [max_depth(D)|Options0]
 1992    ).
 1993
 1994depth_step(5).
 1995
 1996edit_options([], Options, Options).
 1997edit_options([H|T], Options0, Options) :-
 1998    edit_option(H, Options0, Options1),
 1999    edit_options(T, Options1, Options).
 2000
 2001edit_option(-Term, Options0, Options) =>
 2002    (   '$select'(Term, Options0, Options)
 2003    ->  true
 2004    ;   Options = Options0
 2005    ).
 2006edit_option(+Term, Options0, Options) =>
 2007    functor(Term, Name, 1),
 2008    functor(Var, Name, 1),
 2009    (   '$select'(Var, Options0, Options1)
 2010    ->  Options = [Term|Options1]
 2011    ;   Options = [Term|Options0]
 2012    ).
 2013
 2014%!  print_last_chpoint(+Chp) is det.
 2015%
 2016%   Print the last choicepoint when an answer is nondeterministic.
 2017
 2018print_last_chpoint(Chp) :-
 2019    current_predicate(print_last_choice_point/0),
 2020    !,
 2021    print_last_chpoint_(Chp).
 2022print_last_chpoint(Chp) :-
 2023    use_module(library(prolog_stack), [print_last_choicepoint/2]),
 2024    print_last_chpoint_(Chp).
 2025
 2026print_last_chpoint_(Chp) :-
 2027    print_last_choicepoint(Chp, [message_level(information)]).
 2028
 2029
 2030                 /*******************************
 2031                 *          EXPANSION           *
 2032                 *******************************/
 2033
 2034:- user:dynamic(expand_query/4). 2035:- user:multifile(expand_query/4). 2036
 2037call_expand_query(Goal, Expanded, Bindings, ExpandedBindings) :-
 2038    (   '$replace_toplevel_vars'(Goal, Expanded0, Bindings, ExpandedBindings0)
 2039    ->  true
 2040    ;   Expanded0 = Goal, ExpandedBindings0 = Bindings
 2041    ),
 2042    (   user:expand_query(Expanded0, Expanded, ExpandedBindings0, ExpandedBindings)
 2043    ->  true
 2044    ;   Expanded = Expanded0, ExpandedBindings = ExpandedBindings0
 2045    ).
 2046
 2047
 2048:- dynamic
 2049    user:expand_answer/2,
 2050    prolog:expand_answer/3. 2051:- multifile
 2052    user:expand_answer/2,
 2053    prolog:expand_answer/3. 2054
 2055call_expand_answer(Goal, BindingsIn, BindingsOut) :-
 2056    (   prolog:expand_answer(Goal, BindingsIn, BindingsOut)
 2057    ->  true
 2058    ;   user:expand_answer(BindingsIn, BindingsOut)
 2059    ->  true
 2060    ;   BindingsOut = BindingsIn
 2061    ),
 2062    '$save_toplevel_vars'(BindingsOut),
 2063    !.
 2064call_expand_answer(_, Bindings, Bindings)