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