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%   Load the theme file for the Prolog flag `theme`.  Setting the flag
  615%   using ``-Dtheme=Name`` already tried to load it, but that is before
  616%   the file search path is complete.
  617
  618:- multifile
  619    prolog:theme/1.  620
  621setup_theme :-
  622    current_prolog_flag(theme, Theme),
  623    load_theme_file(Theme).
  624
  625load_theme_file(Theme) :-
  626    prolog:theme(Theme),
  627    !.
  628load_theme_file(Theme) :-
  629    exists_source(library(theme/Theme)),
  630    !,
  631    use_module(library(theme/Theme)).
  632load_theme_file(_).
  633
  634%!  theme_changed(+Theme) is det.
  635%
  636%   Called from C if the Prolog flag  `theme` is about to get the new
  637%   value Theme.  Calls all solutions of prolog:theme_hook/1.  Our own
  638%   hook loads library(theme/Theme), unless Theme is already defined,
  639%   i.e., prolog:theme/1 is true for it.  This allows for a theme that
  640%   is defined in memory, e.g., by a theme editor.
  641
  642:- multifile
  643    prolog:theme_hook/1.  644
  645:- public theme_changed/1.  646
  647theme_changed(Theme) :-
  648    forall(prolog:theme_hook(Theme), true).
  649
  650prolog:theme_hook(Theme) :-
  651    load_theme_file(Theme).
  652
  653%!  apply_defines
  654%
  655%   Handle -Dflag[=value] options
  656
  657apply_defines :-
  658    '$cmd_option_val'(defines, Defs),
  659    apply_defines(Defs).
  660
  661apply_defines([]).
  662apply_defines([H|T]) :-
  663    apply_define(H),
  664    apply_defines(T).
  665
  666apply_define(Def) :-
  667    sub_atom(Def, B, _, A, '='),
  668    !,
  669    sub_atom(Def, 0, B, _, Flag),
  670    sub_atom(Def, _, A, 0, Value0),
  671    (   '$current_prolog_flag'(Flag, Value0, _Scope, Access, Type)
  672    ->  (   Access \== write
  673        ->  '$permission_error'(set, prolog_flag, Flag)
  674        ;   text_flag_value(Type, Value0, Value)
  675        ),
  676	set_prolog_flag(Flag, Value)
  677    ;   (   atom_number(Value0, Value)
  678	->  true
  679	;   Value = Value0
  680	),
  681	set_defined(Flag, Value)
  682    ).
  683apply_define(Def) :-
  684    atom_concat('no-', Flag, Def),
  685    !,
  686    set_user_boolean_flag(Flag, false).
  687apply_define(Def) :-
  688    set_user_boolean_flag(Def, true).
  689
  690set_user_boolean_flag(Flag, Value) :-
  691    current_prolog_flag(Flag, Old),
  692    !,
  693    (   Old == Value
  694    ->  true
  695    ;   set_prolog_flag(Flag, Value)
  696    ).
  697set_user_boolean_flag(Flag, Value) :-
  698    set_defined(Flag, Value).
  699
  700text_flag_value(integer, Text, Int) :-
  701    atom_number(Text, Int),
  702    !.
  703text_flag_value(float, Text, Float) :-
  704    atom_number(Text, Float),
  705    !.
  706text_flag_value(term, Text, Term) :-
  707    term_string(Term, Text, []),
  708    !.
  709text_flag_value(_, Value, Value).
  710
  711set_defined(Flag, Value) :-
  712    define_options(Flag, Options), !,
  713    create_prolog_flag(Flag, Value, Options).
  714
  715%!  define_options(+Flag, -Options)
  716%
  717%   Define the options with which to create   Flag. This can be used for
  718%   known flags to control -for example- their type.
  719
  720define_options('SDL_VIDEODRIVER', []).
  721define_options(_, [warn_not_accessed(true)]).
  722
  723%!  init_optimise
  724%
  725%   Load library(apply_macros) if ``-O`` is effective.
  726
  727init_optimise :-
  728    current_prolog_flag(optimise, true),
  729    !,
  730    use_module(user:library(apply_macros)).
  731init_optimise.
  732
  733opt_attach_packs :-
  734    current_prolog_flag(packs, true),
  735    !,
  736    attach_packs.
  737opt_attach_packs.
  738
  739set_toplevel :-
  740    '$cmd_option_val'(toplevel, TopLevelAtom),
  741    catch(term_to_atom(TopLevel, TopLevelAtom), E,
  742          (print_message(error, E),
  743           halt(1))),
  744    create_prolog_flag(toplevel_goal, TopLevel, [type(term)]).
  745
  746load_only :-
  747    current_prolog_flag(os_argv, OSArgv),
  748    memberchk('-l', OSArgv),
  749    current_prolog_flag(argv, Argv),
  750    \+ memberchk('-l', Argv).
  751
  752%!  run_init_goals(+Goals) is det.
  753%
  754%   Run registered initialization goals  on  order.   If  a  goal fails,
  755%   execution is halted.
  756
  757run_init_goals([]).
  758run_init_goals([H|T]) :-
  759    run_init_goal(H),
  760    run_init_goals(T).
  761
  762run_init_goal(Text) :-
  763    catch(term_to_atom(Goal, Text), E,
  764          (   print_message(error, init_goal_syntax(E, Text)),
  765              halt(2)
  766          )),
  767    run_init_goal(Goal, Text).
  768
  769%!  run_program_init is det.
  770%
  771%   Run goals registered using
  772
  773run_program_init :-
  774    forall('$init_goal'(when(program), Goal, Ctx),
  775           run_init_goal(Goal, @(Goal,Ctx))).
  776
  777run_main_init(_) :-
  778    findall(Goal-Ctx, '$init_goal'(when(main), Goal, Ctx), Pairs),
  779    '$last'(Pairs, Goal-Ctx),
  780    !,
  781    (   current_prolog_flag(toplevel_goal, default)
  782    ->  set_prolog_flag(toplevel_goal, halt)
  783    ;   true
  784    ),
  785    run_init_goal(Goal, @(Goal,Ctx)).
  786run_main_init(true) :-
  787    '$existence_error'(initialization, main).
  788run_main_init(_).
  789
  790run_init_goal(Goal, Ctx) :-
  791    (   catch_with_backtrace(user:Goal, E, true)
  792    ->  (   var(E)
  793        ->  true
  794        ;   init_goal_failed(E, Ctx)
  795        )
  796    ;   (   current_prolog_flag(verbose, silent)
  797        ->  Level = silent
  798        ;   Level = error
  799        ),
  800        print_message(Level, init_goal_failed(failed, Ctx)),
  801        halt(1)
  802    ).
  803
  804init_goal_failed(E, Ctx) :-
  805    print_message(error, init_goal_failed(E, Ctx)),
  806    init_goal_failed(E).
  807
  808init_goal_failed(_) :-
  809    thread_self(main),
  810    !,
  811    halt(2).
  812init_goal_failed(_).
  813
  814%!  init_debug_flags is det.
  815%
  816%   Initialize the various Prolog flags that   control  the debugger and
  817%   toplevel.
  818
  819init_debug_flags :-
  820    Keep = [keep(true)],
  821    create_prolog_flag(answer_write_options,
  822                       [ quoted(true), portray(true), max_depth(10),
  823                         spacing(next_argument)], Keep),
  824    create_prolog_flag(prompt_alternatives_on, determinism, Keep),
  825    create_prolog_flag(toplevel_extra_white_line, true, Keep),
  826    create_prolog_flag(toplevel_print_factorized, false, Keep),
  827    create_prolog_flag(print_write_options,
  828                       [ portray(true), quoted(true), numbervars(true) ],
  829                       Keep),
  830    create_prolog_flag(toplevel_residue_vars, false, Keep),
  831    create_prolog_flag(toplevel_list_wfs_residual_program, true, Keep),
  832    '$set_debugger_write_options'(print).
  833
  834%!  setup_backtrace
  835%
  836%   Initialise printing a backtrace.
  837
  838setup_backtrace :-
  839    (   \+ current_prolog_flag(backtrace, false),
  840        load_setup_file(library(prolog_stack))
  841    ->  true
  842    ;   true
  843    ).
  844
  845%!  setup_colors is det.
  846%
  847%   Setup  interactive  usage  by  enabling    colored   output.
  848
  849setup_colors :-
  850    (   \+ current_prolog_flag(color_term, false),
  851        stream_property(user_input, tty(true)),
  852        stream_property(user_error, tty(true)),
  853        stream_property(user_output, tty(true)),
  854        \+ getenv('TERM', dumb),
  855        load_setup_file(user:library(ansi_term))
  856    ->  true
  857    ;   true
  858    ).
  859
  860%!  setup_history
  861%
  862%   Enable per-directory persistent history.
  863
  864setup_history :-
  865    (   \+ current_prolog_flag(save_history, false),
  866        stream_property(user_input, tty(true)),
  867        \+ current_prolog_flag(readline, false),
  868        load_setup_file(library(prolog_history))
  869    ->  prolog_history(enable)
  870    ;   true
  871    ).
  872
  873%!  setup_readline
  874%
  875%   Setup line editing.
  876
  877setup_readline :-
  878    (   stream_property(user_input, tty(true)),
  879        current_prolog_flag(tty_control, true),
  880        \+ getenv('TERM', dumb),
  881        (   current_prolog_flag(readline, ReadLine)
  882        ->  true
  883        ;   ReadLine = true
  884        ),
  885        readline_library(ReadLine, Library),
  886        (   load_setup_file(library(Library))
  887        ->  true
  888        ;   current_prolog_flag(epilog, true),
  889            print_message(warning,
  890                          error(existence_error(library, library(Library)),
  891                                _)),
  892            fail
  893        )
  894    ->  set_prolog_flag(readline, Library)
  895    ;   set_prolog_flag(readline, false)
  896    ).
  897
  898readline_library(true, Library) :-
  899    !,
  900    preferred_readline(Library).
  901readline_library(false, _) :-
  902    !,
  903    fail.
  904readline_library(Library, Library).
  905
  906preferred_readline(editline).
  907
  908%!  load_setup_file(+File) is semidet.
  909%
  910%   Load a file and fail silently if the file does not exist.
  911
  912load_setup_file(File) :-
  913    catch(load_files(File,
  914                     [ silent(true),
  915                       if(not_loaded)
  916                     ]), error(_,_), fail).
  917
  918
  919%!  setup_app is det.
  920%
  921%   When running as an "app", behave as such. The behaviour depends on
  922%   the platform.
  923%
  924%     - Windows
  925%       If Prolog is started using --win_app, try to change directory
  926%       to <My Documents>\Prolog.
  927
  928:- if(current_prolog_flag(windows,true)).  929
  930setup_app :-
  931    current_prolog_flag(associated_file, _),
  932    !.
  933setup_app :-
  934    '$cmd_option_val'(win_app, true),
  935    !,
  936    catch(my_prolog, E, print_message(warning, E)).
  937setup_app.
  938
  939my_prolog :-
  940    win_folder(personal, MyDocs),
  941    atom_concat(MyDocs, '/Prolog', PrologDir),
  942    (   ensure_dir(PrologDir)
  943    ->  working_directory(_, PrologDir)
  944    ;   working_directory(_, MyDocs)
  945    ).
  946
  947ensure_dir(Dir) :-
  948    exists_directory(Dir),
  949    !.
  950ensure_dir(Dir) :-
  951    catch(make_directory(Dir), E, (print_message(warning, E), fail)).
  952
  953:- elif(current_prolog_flag(apple, true)).  954use_app_settings(true).                        % Indicate we need app settings
  955
  956setup_app :-
  957    apple_set_locale,
  958    current_prolog_flag(associated_file, _),
  959    !.
  960setup_app :-
  961    current_prolog_flag(bundle, true),
  962    current_prolog_flag(epilog, true),
  963    getenv('__CFBundleIdentifier', _),
  964    !,
  965    setup_macos_app.
  966setup_app.
  967
  968apple_set_locale :-
  969    (   getenv('LC_CTYPE', 'UTF-8'),
  970        apple_current_locale_identifier(LocaleID),
  971        atom_concat(LocaleID, '.UTF-8', Locale),
  972        catch(setlocale(ctype, _Old, Locale), _, fail)
  973    ->  setenv('LANG', Locale),
  974        unsetenv('LC_CTYPE')
  975    ;   true
  976    ).
  977
  978setup_macos_app :-
  979    restore_working_directory,
  980    !.
  981setup_macos_app :-
  982    expand_file_name('~/Prolog', [PrologDir]),
  983    (   exists_directory(PrologDir)
  984    ->  true
  985    ;   catch(make_directory(PrologDir), MkDirError,
  986              print_message(warning, MkDirError))
  987    ),
  988    catch(working_directory(_, PrologDir), CdError,
  989          print_message(warning, CdError)),
  990    !.
  991setup_macos_app.
  992
  993:- elif(current_prolog_flag(emscripten, true)).  994setup_app.
  995:- else.  996use_app_settings(true).                        % Indicate we need app settings
  997
  998% Other (Unix-like) platforms.
  999setup_app :-
 1000    running_as_app,
 1001    restore_working_directory,
 1002    !.
 1003setup_app.
 1004
 1005%!  running_as_app is semidet.
 1006%
 1007%   True if we were started from the dock.
 1008
 1009running_as_app :-
 1010%   getenv('FLATPAK_SANDBOX_DIR', _),
 1011    current_prolog_flag(epilog, true),
 1012    stream_property(In, file_no(0)),
 1013    \+ stream_property(In, tty(true)),
 1014    !.
 1015
 1016:- endif. 1017
 1018
 1019:- if((current_predicate(use_app_settings/1),
 1020       use_app_settings(true))). 1021
 1022
 1023                /*******************************
 1024                *    APP WORKING DIRECTORY     *
 1025                *******************************/
 1026
 1027save_working_directory :-
 1028    working_directory(WD, WD),
 1029    app_settings(Settings),
 1030    (   Settings.get(working_directory) == WD
 1031    ->  true
 1032    ;   app_save_settings(Settings.put(working_directory, WD))
 1033    ).
 1034
 1035restore_working_directory :-
 1036    at_halt(save_working_directory),
 1037    app_settings(Settings),
 1038    WD = Settings.get(working_directory),
 1039    catch(working_directory(_, WD), _, fail),
 1040    !.
 1041
 1042                /*******************************
 1043                *           SETTINGS           *
 1044                *******************************/
 1045
 1046%!  app_settings(-Settings:dict) is det.
 1047%
 1048%   Get a dict holding the persistent application settings.
 1049
 1050app_settings(Settings) :-
 1051    app_settings_file(File),
 1052    access_file(File, read),
 1053    catch(setup_call_cleanup(
 1054              open(File, read, In, [encoding(utf8)]),
 1055              read_term(In, Settings, []),
 1056              close(In)),
 1057          Error,
 1058          (print_message(warning, Error), fail)),
 1059    !.
 1060app_settings(#{}).
 1061
 1062%!  app_save_settings(+Settings:dict) is det.
 1063%
 1064%   Save the given application settings dict.
 1065
 1066app_save_settings(Settings) :-
 1067    app_settings_file(File),
 1068    catch(setup_call_cleanup(
 1069              open(File, write, Out, [encoding(utf8)]),
 1070              write_term(Out, Settings,
 1071                         [ quoted(true),
 1072                           module(system), % default operators
 1073                           fullstop(true),
 1074                           nl(true)
 1075                         ]),
 1076              close(Out)),
 1077          Error,
 1078          (print_message(warning, Error), fail)).
 1079
 1080
 1081app_settings_file(File) :-
 1082    absolute_file_name(user_app_config('app_settings.pl'), File,
 1083                       [ access(write),
 1084                         file_errors(fail)
 1085                       ]).
 1086:- endif.% app_settings
 1087
 1088                /*******************************
 1089                *           TOPLEVEL           *
 1090                *******************************/
 1091
 1092:- '$hide'('$toplevel'/0).              % avoid in the GUI stacktrace
 1093
 1094%!  '$toplevel'
 1095%
 1096%   Called from PL_toplevel()
 1097
 1098'$toplevel' :-
 1099    '$runtoplevel',
 1100    print_message(informational, halt).
 1101
 1102%!  '$runtoplevel'
 1103%
 1104%   Actually run the toplevel. The values   `default`  and `prolog` both
 1105%   start the interactive toplevel, where `prolog` implies the user gave
 1106%   =|-t prolog|=.
 1107%
 1108%   @see prolog/0 is the default interactive toplevel
 1109
 1110'$runtoplevel' :-
 1111    current_prolog_flag(toplevel_goal, TopLevel0),
 1112    toplevel_goal(TopLevel0, TopLevel),
 1113    user:TopLevel.
 1114
 1115:- dynamic  setup_done/0. 1116:- volatile setup_done/0. 1117
 1118toplevel_goal(default, '$query_loop') :-
 1119    !,
 1120    setup_interactive.
 1121toplevel_goal(prolog, '$query_loop') :-
 1122    !,
 1123    setup_interactive.
 1124toplevel_goal(Goal, Goal).
 1125
 1126setup_interactive :-
 1127    setup_done,
 1128    !.
 1129setup_interactive :-
 1130    asserta(setup_done),
 1131    catch(setup_backtrace, E, print_message(warning, E)),
 1132    catch(setup_readline,  E, print_message(warning, E)),
 1133    catch(setup_history,   E, print_message(warning, E)).
 1134
 1135%!  '$compile'
 1136%
 1137%   Toplevel called when invoked with -c option.
 1138
 1139'$compile' :-
 1140    (   catch('$compile_', E, (print_message(error, E), halt(1)))
 1141    ->  true
 1142    ;   print_message(error, error(goal_failed('$compile'), _)),
 1143        halt(1)
 1144    ),
 1145    halt.                               % set exit code
 1146
 1147'$compile_' :-
 1148    '$load_system_init_file',
 1149    catch(setup_colors, _, true),
 1150    '$set_file_search_paths',
 1151    init_debug_flags,
 1152    '$run_initialization',
 1153    opt_attach_packs,
 1154    use_module(library(qsave)),
 1155    qsave:qsave_toplevel.
 1156
 1157%!  '$config'
 1158%
 1159%   Toplevel when invoked with --dump-runtime-variables
 1160
 1161'$config' :-
 1162    '$load_system_init_file',
 1163    '$set_file_search_paths',
 1164    init_debug_flags,
 1165    '$run_initialization',
 1166    load_files(library(prolog_config)),
 1167    (   catch(prolog_dump_runtime_variables, E,
 1168              (print_message(error, E), halt(1)))
 1169    ->  true
 1170    ;   print_message(error, error(goal_failed(prolog_dump_runtime_variables),_))
 1171    ).
 1172
 1173
 1174                /********************************
 1175                *    USER INTERACTIVE LOOP      *
 1176                *********************************/
 1177
 1178%!  prolog:repl_loop_hook(+BeginEnd, +BreakLevel) is nondet.
 1179%
 1180%   Multifile  hook  that  allows  acting    on   starting/stopping  the
 1181%   interactive REPL loop. Called as
 1182%
 1183%       forall(prolog:repl_loop_hook(BeginEnd, BreakLevel), true)
 1184%
 1185%   @arg BeginEnd is one of `begin` or `end`
 1186%   @arg BreakLevel is 0 for the normal toplevel, -1 when
 1187%   non-interactive and >0 for _break environments_.
 1188
 1189:- multifile
 1190    prolog:repl_loop_hook/2. 1191
 1192%!  prolog
 1193%
 1194%   Run the Prolog toplevel. This is now  the same as break/0, which
 1195%   pretends  to  be  in  a  break-level    if  there  is  a  parent
 1196%   environment.
 1197
 1198prolog :-
 1199    break.
 1200
 1201:- create_prolog_flag(toplevel_mode, backtracking, []). 1202
 1203%!  '$query_loop'
 1204%
 1205%   Run the normal Prolog query loop.  Note   that  the query is not
 1206%   protected by catch/3. Dealing with  unhandled exceptions is done
 1207%   by the C-function query_loop().  This   ensures  that  unhandled
 1208%   exceptions are really unhandled (in Prolog).
 1209
 1210'$query_loop' :-
 1211    break_level(BreakLev),
 1212    setup_call_cleanup(
 1213        notrace(call_repl_loop_hook(begin, BreakLev, IsToplevel)),
 1214        '$query_loop'(BreakLev),
 1215        notrace(call_repl_loop_hook(end, BreakLev, IsToplevel))).
 1216
 1217call_repl_loop_hook(begin, BreakLev, IsToplevel) =>
 1218    (   current_prolog_flag(toplevel_thread, IsToplevel)
 1219    ->  true
 1220    ;   IsToplevel = false
 1221    ),
 1222    set_prolog_flag(toplevel_thread, true),
 1223    call_repl_loop_hook_(begin, BreakLev).
 1224call_repl_loop_hook(end, BreakLev, IsToplevel) =>
 1225    set_prolog_flag(toplevel_thread, IsToplevel),
 1226    call_repl_loop_hook_(end, BreakLev).
 1227
 1228call_repl_loop_hook_(BeginEnd, BreakLev) :-
 1229    forall(prolog:repl_loop_hook(BeginEnd, BreakLev), true).
 1230
 1231
 1232'$query_loop'(BreakLev) :-
 1233    current_prolog_flag(toplevel_mode, recursive),
 1234    !,
 1235    read_expanded_query(BreakLev, Query, Bindings),
 1236    (   Query == end_of_file
 1237    ->  print_message(query, query(eof))
 1238    ;   '$call_no_catch'('$execute_query'(Query, Bindings, _)),
 1239        (   current_prolog_flag(toplevel_mode, recursive)
 1240        ->  '$query_loop'(BreakLev)
 1241        ;   '$switch_toplevel_mode'(backtracking),
 1242            '$query_loop'(BreakLev)     % Maybe throw('$switch_toplevel_mode')?
 1243        )
 1244    ).
 1245'$query_loop'(BreakLev) :-
 1246    repeat,
 1247        read_expanded_query(BreakLev, Query, Bindings),
 1248        (   Query == end_of_file
 1249        ->  !, print_message(query, query(eof))
 1250        ;   '$execute_query'(Query, Bindings, _),
 1251            (   current_prolog_flag(toplevel_mode, recursive)
 1252            ->  !,
 1253                '$switch_toplevel_mode'(recursive),
 1254                '$query_loop'(BreakLev)
 1255            ;   fail
 1256            )
 1257        ).
 1258
 1259break_level(BreakLev) :-
 1260    (   current_prolog_flag(break_level, BreakLev)
 1261    ->  true
 1262    ;   BreakLev = -1
 1263    ).
 1264
 1265read_expanded_query(BreakLev, ExpandedQuery, ExpandedBindings) :-
 1266    '$current_typein_module'(TypeIn),
 1267    (   stream_property(user_input, tty(true))
 1268    ->  '$system_prompt'(TypeIn, BreakLev, Prompt),
 1269        decorate_prompt('|    ', Continue),
 1270        prompt(Old, Continue)
 1271    ;   Prompt = '',
 1272        prompt(Old, '')
 1273    ),
 1274    reset_answer_count,
 1275    trim_stacks,
 1276    trim_heap,
 1277    repeat,
 1278      (   catch(call_cleanup(read_query(Prompt, Query, Bindings),
 1279                             end_input_style),
 1280                error(io_error(_,_),_), fail)
 1281      ->  prompt(_, Old),
 1282          catch(call_expand_query(Query, ExpandedQuery,
 1283                                  Bindings, ExpandedBindings),
 1284                Error,
 1285                (print_message(error, Error), fail))
 1286      ;   set_prolog_flag(debug_on_error, false),
 1287          thread_exit(io_error)
 1288      ),
 1289    !.
 1290
 1291
 1292%!  read_query(+Prompt, -Goal, -Bindings) is det.
 1293%
 1294%   Read the next query. The first  clause   deals  with  the case where
 1295%   !-based history is enabled. The second is   used  if we have command
 1296%   line editing.
 1297
 1298:- multifile
 1299    prolog:history/2. 1300
 1301:- if(current_prolog_flag(emscripten, true)). 1302read_query(_Prompt, Goal, Bindings) :-
 1303    '$can_yield',
 1304    !,
 1305    await(query, GoalString),
 1306    term_string(Goal, GoalString, [variable_names(Bindings)]).
 1307:- endif. 1308read_query(Prompt, Goal, Bindings) :-
 1309    prolog:history(current_input, enabled),
 1310    !,
 1311    decorate_prompt(Prompt, DPrompt),
 1312    read_term_with_history(
 1313        Goal,
 1314        [ show(h),
 1315          help('!h'),
 1316          no_save([trace]),
 1317          prompt(DPrompt),
 1318          variable_names(Bindings)
 1319        ]).
 1320read_query(Prompt, Goal, Bindings) :-
 1321    remove_history_prompt(Prompt, Prompt0),
 1322    decorate_prompt(Prompt0, Prompt1),
 1323    repeat,                                 % over syntax errors
 1324    prompt1(Prompt1),
 1325    read_query_line(user_input, Line),
 1326    '$current_typein_module'(TypeIn),
 1327    catch(read_term_from_atom(Line, Goal,
 1328                              [ variable_names(Bindings),
 1329                                module(TypeIn),
 1330                                blob(resolve)
 1331                              ]), E,
 1332          (   print_message(error, E),
 1333              fail
 1334          )),
 1335    !.
 1336
 1337%!  read_query_line(+Input, -Query:atom) is det.
 1338%
 1339%   Read a query as an atom. If Query is '$silent'(Goal), execute `Goal`
 1340%   in module `user` and read the   next  query. This supports injecting
 1341%   goals in some GNU-Emacs modes.
 1342
 1343read_query_line(Input, Line) :-
 1344    stream_property(Input, error(true)),
 1345    !,
 1346    Line = end_of_file.
 1347read_query_line(Input, Line) :-
 1348    catch(read_term_as_atom(Input, Line0), Error, true),
 1349    end_input_style,                    % before a possible syntax error
 1350    save_debug_after_read,
 1351    (   var(Error)
 1352    ->  (   catch(term_string(Goal, Line0), error(_,_), fail),
 1353            Goal = '$silent'(SilentGoal)
 1354        ->  Error = error(_,_),
 1355            catch_with_backtrace(ignore(SilentGoal), Error,
 1356                                 print_message(error, Error)),
 1357            read_query_line(Input, Line)
 1358        ;   Line = Line0
 1359        )
 1360    ;   catch(print_message(error, Error), _, true),
 1361        (   Error = error(syntax_error(_),_)
 1362        ->  fail
 1363        ;   throw(Error)
 1364        )
 1365    ).
 1366
 1367%!  read_term_as_atom(+Input, -Line)
 1368%
 1369%   Read the next term as an  atom  and   skip  to  the newline or a
 1370%   non-space character.
 1371
 1372read_term_as_atom(In, Line) :-
 1373    '$raw_read'(In, Line),
 1374    (   Line == end_of_file
 1375    ->  true
 1376    ;   skip_to_nl(In)
 1377    ).
 1378
 1379%!  skip_to_nl(+Input) is det.
 1380%
 1381%   Read input after the term. Skips   white  space and %... comment
 1382%   until the end of the line or a non-blank character.
 1383
 1384skip_to_nl(In) :-
 1385    repeat,
 1386    peek_char(In, C),
 1387    (   C == '%'
 1388    ->  skip(In, '\n')
 1389    ;   char_type(C, space)
 1390    ->  get_char(In, _),
 1391        C == '\n'
 1392    ;   true
 1393    ),
 1394    !.
 1395
 1396remove_history_prompt('', '') :- !.
 1397remove_history_prompt(Prompt0, Prompt) :-
 1398    atom_chars(Prompt0, Chars0),
 1399    clean_history_prompt_chars(Chars0, Chars1),
 1400    delete_leading_blanks(Chars1, Chars),
 1401    atom_chars(Prompt, Chars).
 1402
 1403clean_history_prompt_chars([], []).
 1404clean_history_prompt_chars(['~', !|T], T) :- !.
 1405clean_history_prompt_chars([H|T0], [H|T]) :-
 1406    clean_history_prompt_chars(T0, T).
 1407
 1408delete_leading_blanks([' '|T0], T) :-
 1409    !,
 1410    delete_leading_blanks(T0, T).
 1411delete_leading_blanks(L, L).
 1412
 1413
 1414                 /*******************************
 1415                 *        TOPLEVEL DEBUG        *
 1416                 *******************************/
 1417
 1418%!  save_debug_after_read
 1419%
 1420%   Called right after the toplevel read to save the debug status if
 1421%   it was modified from the GUI thread using e.g.
 1422%
 1423%     ==
 1424%     thread_signal(main, gdebug)
 1425%     ==
 1426%
 1427%   @bug Ideally, the prompt would change if debug mode is enabled.
 1428%        That is hard to realise with all the different console
 1429%        interfaces supported by SWI-Prolog.
 1430
 1431save_debug_after_read :-
 1432    current_prolog_flag(debug, true),
 1433    !,
 1434    save_debug.
 1435save_debug_after_read.
 1436
 1437save_debug :-
 1438    (   tracing,
 1439        notrace
 1440    ->  Tracing = true
 1441    ;   Tracing = false
 1442    ),
 1443    current_prolog_flag(debug, Debugging),
 1444    set_prolog_flag(debug, false),
 1445    create_prolog_flag(query_debug_settings,
 1446                       debug(Debugging, Tracing), []).
 1447
 1448restore_debug :-
 1449    current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)),
 1450    set_prolog_flag(debug, Debugging),
 1451    (   Tracing == true
 1452    ->  trace
 1453    ;   true
 1454    ).
 1455
 1456:- initialization
 1457    create_prolog_flag(query_debug_settings, debug(false, false), []). 1458
 1459
 1460                /********************************
 1461                *            PROMPTING          *
 1462                ********************************/
 1463
 1464%!  '$answer_class'(-Class) is semidet.
 1465%
 1466%   Colour class for the answer that is  being written, or fail if it
 1467%   must not be decorated.  Class  is  `answer(odd)`  or `answer(even)`,
 1468%   alternating over the answers of a single  query.  Using a different
 1469%   background colour for both _stripes_  the   answers, which separates
 1470%   the answers of a non-deterministic query.
 1471%
 1472%   Only an answer that shows bindings, residual goals or delays is
 1473%   decorated: ``true.`` and ``false.`` are not answers to stripe.
 1474%
 1475%   Exported (and thus `$`-prefixed) because it is used by
 1476%   boot/messages.pl.  It is not intended for use by applications.
 1477
 1478'$answer_class'(Class) :-
 1479    nb_current('$answer_class', Class),
 1480    Class \== none.
 1481
 1482answer_count(Count) :-
 1483    (   nb_current('$answer_count', C)
 1484    ->  Count = C
 1485    ;   Count = 0
 1486    ).
 1487
 1488reset_answer_count :-
 1489    nb_setval('$answer_count', 0),
 1490    no_answer.
 1491
 1492%!  no_answer is det.
 1493%
 1494%   The message about to be written is not an answer that shows
 1495%   bindings.  Used for ``true.``, ``false.`` and the empty line that
 1496%   ends the interaction.
 1497
 1498no_answer :-
 1499    nb_setval('$answer_class', none).
 1500
 1501%!  next_answer(+Bindings, +Delays, +Residuals) is det.
 1502%
 1503%   Start a new answer.  See '$answer_class'/1.
 1504
 1505next_answer([], true, []-[]) :-
 1506    !,
 1507    no_answer.
 1508next_answer(_Bindings, _Delays, _Residuals) :-
 1509    answer_count(C0),
 1510    C is C0+1,
 1511    nb_setval('$answer_count', C),
 1512    (   C mod 2 =:= 0
 1513    ->  Class = answer(even)
 1514    ;   Class = answer(odd)
 1515    ),
 1516    nb_setval('$answer_class', Class).
 1517
 1518%!  decorate_prompt(+Plain, -Decorated) is det.
 1519%
 1520%   Add ANSI escape sequences to the  prompt   Plain.  The  result has a
 1521%   three-part structure:
 1522%
 1523%     1. The attributes of the colour class `input` followed by `\e[K`.
 1524%        As the prompt is written at the  start of a line this paints
 1525%        the entire line, which makes a background colour extend to the
 1526%        right margin.
 1527%     2. The attributes of the colour class `prompt`, the prompt itself
 1528%        and a reset.
 1529%     3. The attributes of `input` again.  These remain in effect while
 1530%        the user is typing, which is  how   the  typed text is coloured
 1531%        differently from the output.  end_input_style/0 cancels this
 1532%        once the query has been read.
 1533%
 1534%   Note that the line editor (see  library(editline)) does not count
 1535%   escape sequences  towards  the  prompt   width  and  neither  does
 1536%   line_position/2.
 1537
 1538decorate_prompt('', Prompt) :-
 1539    !,
 1540    Prompt = ''.                        % not connected to a terminal
 1541decorate_prompt(Plain, Decorated) :-
 1542    prompt_sgr(input, Input),
 1543    prompt_sgr(prompt, Prompt),
 1544    line_editor_attributes(Input),
 1545    (   Input == '',
 1546        Prompt == ''
 1547    ->  Decorated = Plain
 1548    ;   Input == ''                     % nothing to paint the line with
 1549    ->  atomic_list_concat([Prompt, Plain, '\e[0m'], Decorated)
 1550    ;   atomic_list_concat([Input, '\e[K', Prompt, Plain, '\e[0m', Input],
 1551                           Decorated)
 1552    ).
 1553
 1554%!  line_editor_attributes(+Input) is det.
 1555%
 1556%   Tell the line editor how to switch  the decoration of the input line
 1557%   off and on again.  The line editor  erases the rows the line no longer
 1558%   uses when it gets shorter, for example when a wrapped line is
 1559%   shortened or when we move to a shorter history entry.  Erasing paints
 1560%   with the current background colour, so   it must switch our attributes
 1561%   off first and put them back afterwards.
 1562%
 1563%   This is called each time we build a prompt rather than once, so that a
 1564%   theme loaded at run time is picked up.
 1565%
 1566%   @see the hook prolog:line_editor_attributes/2, implemented by
 1567%   library(editline).
 1568
 1569line_editor_attributes(Input) :-
 1570    (   Input == ''
 1571    ->  Off = '', On = ''
 1572    ;   Off = '\e[0m', On = Input
 1573    ),
 1574    ignore(prolog:line_editor_attributes(Off, On)).
 1575
 1576prompt_sgr(Class, Sequence) :-
 1577    colour_console,
 1578    current_predicate(ansi_term:ansi_sgr/2),
 1579    catch(ansi_term:ansi_sgr(Class, String), _, fail),
 1580    String \== "",
 1581    !,
 1582    atom_string(Sequence, String).
 1583prompt_sgr(_, '').
 1584
 1585colour_console :-
 1586    current_prolog_flag(color_term, true),
 1587    stream_property(user_output, tty(true)).
 1588
 1589%!  end_input_style is det.
 1590%
 1591%   Cancel the attributes  installed  by   decorate_prompt/2  once the
 1592%   query has been read.  Without this,   output  of  the query would be
 1593%   written using the attributes of the colour class `input`.
 1594
 1595end_input_style :-
 1596    (   colour_console
 1597    ->  write(user_output, '\e[0m'),
 1598        flush_output(user_output)
 1599    ;   true
 1600    ).
 1601
 1602'$system_prompt'(Module, BrekLev, Prompt) :-
 1603    current_prolog_flag(toplevel_prompt, PAtom),
 1604    atom_codes(PAtom, P0),
 1605    (    Module \== user
 1606    ->   '$substitute'('~m', [Module, ': '], P0, P1)
 1607    ;    '$substitute'('~m', [], P0, P1)
 1608    ),
 1609    (    BrekLev > 0
 1610    ->   '$substitute'('~l', ['[', BrekLev, '] '], P1, P2)
 1611    ;    '$substitute'('~l', [], P1, P2)
 1612    ),
 1613    current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)),
 1614    (    Tracing == true
 1615    ->   '$substitute'('~d', ['[trace] '], P2, P3)
 1616    ;    Debugging == true
 1617    ->   '$substitute'('~d', ['[debug] '], P2, P3)
 1618    ;    '$substitute'('~d', [], P2, P3)
 1619    ),
 1620    atom_chars(Prompt, P3).
 1621
 1622'$substitute'(From, T, Old, New) :-
 1623    atom_codes(From, FromCodes),
 1624    phrase(subst_chars(T), T0),
 1625    '$append'(Pre, S0, Old),
 1626    '$append'(FromCodes, Post, S0) ->
 1627    '$append'(Pre, T0, S1),
 1628    '$append'(S1, Post, New),
 1629    !.
 1630'$substitute'(_, _, Old, Old).
 1631
 1632subst_chars([]) -->
 1633    [].
 1634subst_chars([H|T]) -->
 1635    { atomic(H),
 1636      !,
 1637      atom_codes(H, Codes)
 1638    },
 1639    Codes,
 1640    subst_chars(T).
 1641subst_chars([H|T]) -->
 1642    H,
 1643    subst_chars(T).
 1644
 1645
 1646                /********************************
 1647                *           EXECUTION           *
 1648                ********************************/
 1649
 1650%!  '$execute_query'(Goal, Bindings, -Truth) is det.
 1651%
 1652%   Execute Goal using Bindings.
 1653
 1654'$execute_query'(Var, _, true) :-
 1655    var(Var),
 1656    !,
 1657    print_message(informational, var_query(Var)).
 1658'$execute_query'(Goal, Bindings, Truth) :-
 1659    '$current_typein_module'(TypeIn),
 1660    '$dwim_correct_goal'(TypeIn:Goal, Bindings, Corrected),
 1661    !,
 1662    setup_call_cleanup(
 1663        '$set_source_module'(M0, TypeIn),
 1664        expand_goal(Corrected, Expanded),
 1665        '$set_source_module'(M0)),
 1666    print_message(silent, toplevel_goal(Expanded, Bindings)),
 1667    '$execute_goal2'(Expanded, Bindings, Truth).
 1668'$execute_query'(_, _, false) :-
 1669    notrace,
 1670    no_answer,
 1671    print_message(query, query(no)).
 1672
 1673'$execute_goal2'(Goal, Bindings, true) :-
 1674    restore_debug,
 1675    '$current_typein_module'(TypeIn),
 1676    residue_vars(TypeIn:Goal, Vars, TypeIn:Delays, Chp),
 1677    deterministic(Det),
 1678    (   save_debug
 1679    ;   restore_debug, fail
 1680    ),
 1681    flush_output(user_output),
 1682    (   Det == true
 1683    ->  DetOrChp = true
 1684    ;   DetOrChp = Chp
 1685    ),
 1686    call_expand_answer(Goal, Bindings, NewBindings),
 1687    (    \+ \+ write_bindings(NewBindings, Vars, Delays, DetOrChp)
 1688    ->   !
 1689    ).
 1690'$execute_goal2'(_, _, false) :-
 1691    save_debug,
 1692    no_answer,
 1693    print_message(query, query(no)).
 1694
 1695residue_vars(Goal, Vars, Delays, Chp) :-
 1696    current_prolog_flag(toplevel_residue_vars, true),
 1697    !,
 1698    '$wfs_call'(call_residue_vars(stop_backtrace(Goal, Chp), Vars), Delays).
 1699residue_vars(Goal, [], Delays, Chp) :-
 1700    '$wfs_call'(stop_backtrace(Goal, Chp), Delays).
 1701
 1702stop_backtrace(Goal, Chp) :-
 1703    toplevel_call(Goal),
 1704    prolog_current_choice(Chp).
 1705
 1706toplevel_call(Goal) :-
 1707    call(Goal),
 1708    no_lco.
 1709
 1710no_lco.
 1711
 1712%!  write_bindings(+Bindings, +ResidueVars, +Delays, +DetOrChp)
 1713%!	is semidet.
 1714%
 1715%   Write   bindings   resulting   from   a     query.    The   flag
 1716%   prompt_alternatives_on determines whether the   user is prompted
 1717%   for alternatives. =groundness= gives   the  classical behaviour,
 1718%   =determinism= is considered more adequate and informative.
 1719%
 1720%   Succeeds if the user accepts the answer and fails otherwise.
 1721%
 1722%   @arg ResidueVars are the residual constraints and provided if
 1723%        the prolog flag `toplevel_residue_vars` is set to
 1724%        `project`.
 1725
 1726write_bindings(Bindings, ResidueVars, Delays, DetOrChp) :-
 1727    '$current_typein_module'(TypeIn),
 1728    translate_bindings(Bindings, Bindings1, ResidueVars, TypeIn:Residuals),
 1729    omit_qualifier(Delays, TypeIn, Delays1),
 1730    next_answer(Bindings1, Delays1, Residuals),
 1731    write_bindings2(Bindings, Bindings1, Residuals, Delays1, DetOrChp).
 1732
 1733write_bindings2(OrgBindings, [], Residuals, Delays, _) :-
 1734    current_prolog_flag(prompt_alternatives_on, groundness),
 1735    !,
 1736    name_vars(OrgBindings, [], t(Residuals, Delays)),
 1737    print_message(query, query(yes(Delays, Residuals))).
 1738write_bindings2(OrgBindings, Bindings, Residuals, Delays, true) :-
 1739    current_prolog_flag(prompt_alternatives_on, determinism),
 1740    !,
 1741    name_vars(OrgBindings, Bindings, t(Residuals, Delays)),
 1742    print_message(query, query(yes(Bindings, Delays, Residuals))).
 1743write_bindings2(OrgBindings, Bindings, Residuals, Delays, Chp) :-
 1744    repeat,
 1745        name_vars(OrgBindings, Bindings, t(Residuals, Delays)),
 1746        print_message(query, query(more(Bindings, Delays, Residuals))),
 1747        get_respons(Action, Chp),
 1748    (   Action == redo
 1749    ->  !, fail
 1750    ;   Action == show_again
 1751    ->  fail
 1752    ;   !,
 1753        no_answer,
 1754        print_message(query, query(done))
 1755    ).
 1756
 1757%!  name_vars(+OrgBinding, +Bindings, +Term) is det.
 1758%
 1759%   Give a name ``_[A-Z][0-9]*`` to all variables   in Term, that do not
 1760%   have a name due to Bindings. Singleton   variables in Term are named
 1761%   `_`. The behavior depends on these Prolog flags:
 1762%
 1763%     - toplevel_name_variables
 1764%       Only act when `true`, else name_vars/3 is a no-op.
 1765%     - toplevel_print_anon
 1766%
 1767%   Variables are named by unifying them to `'$VAR'(Name)`
 1768%
 1769%   @arg Bindings is a list Name=Value
 1770
 1771name_vars(OrgBindings, Bindings, Term) :-
 1772    current_prolog_flag(toplevel_name_variables, true),
 1773    answer_flags_imply_numbervars,
 1774    !,
 1775    '$term_multitons'(t(Bindings,Term), Vars),
 1776    bindings_var_names(OrgBindings, Bindings, VarNames),
 1777    name_vars_(Vars, VarNames, 0),
 1778    term_variables(t(Bindings,Term), SVars),
 1779    anon_vars(SVars).
 1780name_vars(_OrgBindings, _Bindings, _Term).
 1781
 1782name_vars_([], _, _).
 1783name_vars_([H|T], Bindings, N) :-
 1784    name_var(Bindings, Name, N, N1),
 1785    H = '$VAR'(Name),
 1786    name_vars_(T, Bindings, N1).
 1787
 1788anon_vars([]).
 1789anon_vars(['$VAR'('_')|T]) :-
 1790    anon_vars(T).
 1791
 1792%!  name_var(+Reserved, -Name, +N0, -N) is det.
 1793%
 1794%   True when Name is a valid name for   a new variable where the search
 1795%   is guided by the number N0. Name may not appear in Reserved.
 1796
 1797name_var(Reserved, Name, N0, N) :-
 1798    between(N0, infinite, N1),
 1799    I is N1//26,
 1800    J is 0'A + N1 mod 26,
 1801    (   I == 0
 1802    ->  format(atom(Name), '_~c', [J])
 1803    ;   format(atom(Name), '_~c~d', [J, I])
 1804    ),
 1805    \+ memberchk(Name, Reserved),
 1806    !,
 1807    N is N1+1.
 1808
 1809%!  bindings_var_names(+OrgBindings, +TransBindings, -VarNames) is det.
 1810%
 1811%   Find the joined set of variable names   in the original bindings and
 1812%   translated bindings. When generating new names,  we better also omit
 1813%   names  that  appear  in  the  original  bindings  (but  not  in  the
 1814%   translated bindigns).
 1815
 1816bindings_var_names(OrgBindings, TransBindings, VarNames) :-
 1817    phrase(bindings_var_names_(OrgBindings), VarNames0, Tail),
 1818    phrase(bindings_var_names_(TransBindings), Tail, []),
 1819    sort(VarNames0, VarNames).
 1820
 1821%!  bindings_var_names_(+Bindings)// is det.
 1822%
 1823%   Produce a list of variable names that appear in Bindings. This deals
 1824%   both with the single and joined representation of bindings.
 1825
 1826bindings_var_names_([]) --> [].
 1827bindings_var_names_([H|T]) -->
 1828    binding_var_names(H),
 1829    bindings_var_names_(T).
 1830
 1831binding_var_names(binding(Vars,_Value,_Subst)) ==>
 1832    var_names(Vars).
 1833binding_var_names(Name=_Value) ==>
 1834    [Name].
 1835
 1836var_names([]) --> [].
 1837var_names([H|T]) --> [H], var_names(T).
 1838
 1839
 1840%!  answer_flags_imply_numbervars
 1841%
 1842%   True when the answer will be  written recognising '$VAR'(N). If this
 1843%   is not the case we should not try to name the variables.
 1844
 1845answer_flags_imply_numbervars :-
 1846    current_prolog_flag(answer_write_options, Options),
 1847    numbervars_option(Opt),
 1848    '$option'(Opt, Options),
 1849    !.
 1850
 1851numbervars_option(portray(true)).
 1852numbervars_option(portrayed(true)).
 1853numbervars_option(numbervars(true)).
 1854
 1855%!  residual_goals(:NonTerminal)
 1856%
 1857%   Directive that registers NonTerminal as a collector for residual
 1858%   goals.
 1859
 1860:- multifile
 1861    residual_goal_collector/1. 1862
 1863:- meta_predicate
 1864    residual_goals(2). 1865
 1866residual_goals(NonTerminal) :-
 1867    throw(error(context_error(nodirective, residual_goals(NonTerminal)), _)).
 1868
 1869system:term_expansion((:- residual_goals(NonTerminal)),
 1870                      '$toplevel':residual_goal_collector(M2:Head)) :-
 1871    \+ current_prolog_flag(xref, true),
 1872    prolog_load_context(module, M),
 1873    strip_module(M:NonTerminal, M2, Head),
 1874    '$must_be'(callable, Head).
 1875
 1876%!  prolog:residual_goals// is det.
 1877%
 1878%   DCG that collects residual goals that   are  not associated with
 1879%   the answer through attributed variables.
 1880
 1881:- public prolog:residual_goals//0. 1882
 1883prolog:residual_goals -->
 1884    { findall(NT, residual_goal_collector(NT), NTL) },
 1885    collect_residual_goals(NTL).
 1886
 1887collect_residual_goals([]) --> [].
 1888collect_residual_goals([H|T]) -->
 1889    ( call(H) -> [] ; [] ),
 1890    collect_residual_goals(T).
 1891
 1892
 1893
 1894%!  prolog:translate_bindings(+Bindings0, -Bindings, +ResidueVars,
 1895%!                            +ResidualGoals, -Residuals) is det.
 1896%
 1897%   Translate the raw variable bindings  resulting from successfully
 1898%   completing a query into a  binding   list  and  list of residual
 1899%   goals suitable for human consumption.
 1900%
 1901%   @arg    Bindings is a list of binding(Vars,Value,Substitutions),
 1902%           where Vars is a list of variable names. E.g.
 1903%           binding(['A','B'],42,[])` means that both the variable
 1904%           A and B have the value 42. Values may contain terms
 1905%           '$VAR'(Name) to indicate sharing with a given variable.
 1906%           Value is always an acyclic term. If cycles appear in the
 1907%           answer, Substitutions contains a list of substitutions
 1908%           that restore the original term.
 1909%
 1910%   @arg    Residuals is a pair of two lists representing residual
 1911%           goals. The first element of the pair are residuals
 1912%           related to the query variables and the second are
 1913%           related that are disconnected from the query.
 1914
 1915:- public
 1916    prolog:translate_bindings/5. 1917:- meta_predicate
 1918    prolog:translate_bindings(+, -, +, +, :). 1919
 1920prolog:translate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals) :-
 1921    translate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals),
 1922    name_vars(Bindings0, Bindings, t(ResVars, ResGoals, Residuals)).
 1923
 1924% should not be required.
 1925prolog:name_vars(Bindings, Term) :- name_vars([], Bindings, Term).
 1926prolog:name_vars(Bindings0, Bindings, Term) :- name_vars(Bindings0, Bindings, Term).
 1927
 1928translate_bindings(Bindings0, Bindings, ResidueVars, Residuals) :-
 1929    prolog:residual_goals(ResidueGoals, []),
 1930    translate_bindings(Bindings0, Bindings, ResidueVars, ResidueGoals,
 1931                       Residuals).
 1932
 1933translate_bindings(Bindings0, Bindings, [], [], _:[]-[]) :-
 1934    term_attvars(Bindings0, []),
 1935    !,
 1936    join_same_bindings(Bindings0, Bindings1),
 1937    factorize_bindings(Bindings1, Bindings2),
 1938    bind_vars(Bindings2, Bindings3),
 1939    filter_bindings(Bindings3, Bindings).
 1940translate_bindings(Bindings0, Bindings, ResidueVars, ResGoals0,
 1941                   TypeIn:Residuals-HiddenResiduals) :-
 1942    project_constraints(Bindings0, ResidueVars),
 1943    hidden_residuals(ResidueVars, Bindings0, HiddenResiduals0),
 1944    omit_qualifiers(HiddenResiduals0, TypeIn, HiddenResiduals),
 1945    copy_term(Bindings0+ResGoals0, Bindings1+ResGoals1, Residuals0),
 1946    '$append'(ResGoals1, Residuals0, Residuals1),
 1947    omit_qualifiers(Residuals1, TypeIn, Residuals),
 1948    join_same_bindings(Bindings1, Bindings2),
 1949    factorize_bindings(Bindings2, Bindings3),
 1950    bind_vars(Bindings3, Bindings4),
 1951    filter_bindings(Bindings4, Bindings).
 1952
 1953hidden_residuals(ResidueVars, Bindings, Goal) :-
 1954    term_attvars(ResidueVars, Remaining),
 1955    term_attvars(Bindings, QueryVars),
 1956    subtract_vars(Remaining, QueryVars, HiddenVars),
 1957    copy_term(HiddenVars, _, Goal).
 1958
 1959subtract_vars(All, Subtract, Remaining) :-
 1960    sort(All, AllSorted),
 1961    sort(Subtract, SubtractSorted),
 1962    ord_subtract(AllSorted, SubtractSorted, Remaining).
 1963
 1964ord_subtract([], _Not, []).
 1965ord_subtract([H1|T1], L2, Diff) :-
 1966    diff21(L2, H1, T1, Diff).
 1967
 1968diff21([], H1, T1, [H1|T1]).
 1969diff21([H2|T2], H1, T1, Diff) :-
 1970    compare(Order, H1, H2),
 1971    diff3(Order, H1, T1, H2, T2, Diff).
 1972
 1973diff12([], _H2, _T2, []).
 1974diff12([H1|T1], H2, T2, Diff) :-
 1975    compare(Order, H1, H2),
 1976    diff3(Order, H1, T1, H2, T2, Diff).
 1977
 1978diff3(<,  H1, T1,  H2, T2, [H1|Diff]) :-
 1979    diff12(T1, H2, T2, Diff).
 1980diff3(=, _H1, T1, _H2, T2, Diff) :-
 1981    ord_subtract(T1, T2, Diff).
 1982diff3(>,  H1, T1, _H2, T2, Diff) :-
 1983    diff21(T2, H1, T1, Diff).
 1984
 1985
 1986%!  project_constraints(+Bindings, +ResidueVars) is det.
 1987%
 1988%   Call   <module>:project_attributes/2   if   the    Prolog   flag
 1989%   `toplevel_residue_vars` is set to `project`.
 1990
 1991project_constraints(Bindings, ResidueVars) :-
 1992    !,
 1993    term_attvars(Bindings, AttVars),
 1994    phrase(attribute_modules(AttVars), Modules0),
 1995    sort(Modules0, Modules),
 1996    term_variables(Bindings, QueryVars),
 1997    project_attributes(Modules, QueryVars, ResidueVars).
 1998project_constraints(_, _).
 1999
 2000project_attributes([], _, _).
 2001project_attributes([M|T], QueryVars, ResidueVars) :-
 2002    (   current_predicate(M:project_attributes/2),
 2003        catch(M:project_attributes(QueryVars, ResidueVars), E,
 2004              print_message(error, E))
 2005    ->  true
 2006    ;   true
 2007    ),
 2008    project_attributes(T, QueryVars, ResidueVars).
 2009
 2010attribute_modules([]) --> [].
 2011attribute_modules([H|T]) -->
 2012    { get_attrs(H, Attrs) },
 2013    attrs_modules(Attrs),
 2014    attribute_modules(T).
 2015
 2016attrs_modules([]) --> [].
 2017attrs_modules(att(Module, _, More)) -->
 2018    [Module],
 2019    attrs_modules(More).
 2020
 2021
 2022%!  join_same_bindings(Bindings0, Bindings)
 2023%
 2024%   Join variables that are bound to the   same  value. Note that we
 2025%   return the _last_ value. This is   because the factorization may
 2026%   be different and ultimately the names will   be  printed as V1 =
 2027%   V2, ... VN = Value. Using the  last, Value has the factorization
 2028%   of VN.
 2029
 2030join_same_bindings([], []).
 2031join_same_bindings([Name=V0|T0], [[Name|Names]=V|T]) :-
 2032    take_same_bindings(T0, V0, V, Names, T1),
 2033    join_same_bindings(T1, T).
 2034
 2035take_same_bindings([], Val, Val, [], []).
 2036take_same_bindings([Name=V1|T0], V0, V, [Name|Names], T) :-
 2037    V0 == V1,
 2038    !,
 2039    take_same_bindings(T0, V1, V, Names, T).
 2040take_same_bindings([Pair|T0], V0, V, Names, [Pair|T]) :-
 2041    take_same_bindings(T0, V0, V, Names, T).
 2042
 2043
 2044%!  omit_qualifiers(+QGoals, +TypeIn, -Goals) is det.
 2045%
 2046%   Omit unneeded module qualifiers  from   QGoals  relative  to the
 2047%   given module TypeIn.
 2048
 2049
 2050omit_qualifiers([], _, []).
 2051omit_qualifiers([Goal0|Goals0], TypeIn, [Goal|Goals]) :-
 2052    omit_qualifier(Goal0, TypeIn, Goal),
 2053    omit_qualifiers(Goals0, TypeIn, Goals).
 2054
 2055omit_qualifier(M:G0, TypeIn, G) :-
 2056    M == TypeIn,
 2057    !,
 2058    omit_meta_qualifiers(G0, TypeIn, G).
 2059omit_qualifier(M:G0, TypeIn, G) :-
 2060    predicate_property(TypeIn:G0, imported_from(M)),
 2061    \+ predicate_property(G0, transparent),
 2062    !,
 2063    G0 = G.
 2064omit_qualifier(_:G0, _, G) :-
 2065    predicate_property(G0, built_in),
 2066    \+ predicate_property(G0, transparent),
 2067    !,
 2068    G0 = G.
 2069omit_qualifier(M:G0, _, M:G) :-
 2070    atom(M),
 2071    !,
 2072    omit_meta_qualifiers(G0, M, G).
 2073omit_qualifier(G0, TypeIn, G) :-
 2074    omit_meta_qualifiers(G0, TypeIn, G).
 2075
 2076omit_meta_qualifiers(V, _, V) :-
 2077    var(V),
 2078    !.
 2079omit_meta_qualifiers((QA,QB), TypeIn, (A,B)) :-
 2080    !,
 2081    omit_qualifier(QA, TypeIn, A),
 2082    omit_qualifier(QB, TypeIn, B).
 2083omit_meta_qualifiers(tnot(QA), TypeIn, tnot(A)) :-
 2084    !,
 2085    omit_qualifier(QA, TypeIn, A).
 2086omit_meta_qualifiers(freeze(V, QGoal), TypeIn, freeze(V, Goal)) :-
 2087    callable(QGoal),
 2088    !,
 2089    omit_qualifier(QGoal, TypeIn, Goal).
 2090omit_meta_qualifiers(when(Cond, QGoal), TypeIn, when(Cond, Goal)) :-
 2091    callable(QGoal),
 2092    !,
 2093    omit_qualifier(QGoal, TypeIn, Goal).
 2094omit_meta_qualifiers(G, _, G).
 2095
 2096
 2097%!  bind_vars(+BindingsIn, -Bindings)
 2098%
 2099%   Bind variables to '$VAR'(Name), so they are printed by the names
 2100%   used in the query. Note that by   binding  in the reverse order,
 2101%   variables bound to one another come out in the natural order.
 2102
 2103bind_vars(Bindings0, Bindings) :-
 2104    bind_query_vars(Bindings0, Bindings, SNames),
 2105    bind_skel_vars(Bindings, Bindings, SNames, 1, _).
 2106
 2107bind_query_vars([], [], []).
 2108bind_query_vars([binding(Names,Var,[Var2=Cycle])|T0],
 2109                [binding(Names,Cycle,[])|T], [Name|SNames]) :-
 2110    Var == Var2,                   % also implies var(Var)
 2111    !,
 2112    '$last'(Names, Name),
 2113    Var = '$VAR'(Name),
 2114    bind_query_vars(T0, T, SNames).
 2115bind_query_vars([B|T0], [B|T], AllNames) :-
 2116    B = binding(Names,Var,Skel),
 2117    bind_query_vars(T0, T, SNames),
 2118    (   var(Var), \+ attvar(Var), Skel == []
 2119    ->  AllNames = [Name|SNames],
 2120        '$last'(Names, Name),
 2121        Var = '$VAR'(Name)
 2122    ;   AllNames = SNames
 2123    ).
 2124
 2125
 2126
 2127bind_skel_vars([], _, _, N, N).
 2128bind_skel_vars([binding(_,_,Skel)|T], Bindings, SNames, N0, N) :-
 2129    bind_one_skel_vars(Skel, Bindings, SNames, N0, N1),
 2130    bind_skel_vars(T, Bindings, SNames, N1, N).
 2131
 2132%!  bind_one_skel_vars(+Subst, +Bindings, +VarName, +N0, -N)
 2133%
 2134%   Give names to the factorized variables that   do not have a name
 2135%   yet. This introduces names  _S<N>,   avoiding  duplicates.  If a
 2136%   factorized variable shares with another binding, use the name of
 2137%   that variable.
 2138%
 2139%   @tbd    Consider the call below. We could remove either of the
 2140%           A = x(1).  Which is best?
 2141%
 2142%           ==
 2143%           ?- A = x(1), B = a(A,A).
 2144%           A = x(1),
 2145%           B = a(A, A), % where
 2146%               A = x(1).
 2147%           ==
 2148
 2149bind_one_skel_vars([], _, _, N, N).
 2150bind_one_skel_vars([Var=Value|T], Bindings, Names, N0, N) :-
 2151    (   var(Var)
 2152    ->  (   '$member'(binding(Names, VVal, []), Bindings),
 2153            same_term(Value, VVal)
 2154        ->  '$last'(Names, VName),
 2155            Var = '$VAR'(VName),
 2156            N2 = N0
 2157        ;   between(N0, infinite, N1),
 2158            atom_concat('_S', N1, Name),
 2159            \+ memberchk(Name, Names),
 2160            !,
 2161            Var = '$VAR'(Name),
 2162            N2 is N1 + 1
 2163        )
 2164    ;   N2 = N0
 2165    ),
 2166    bind_one_skel_vars(T, Bindings, Names, N2, N).
 2167
 2168
 2169%!  factorize_bindings(+Bindings0, -Factorized)
 2170%
 2171%   Factorize cycles and sharing in the bindings.
 2172
 2173factorize_bindings([], []).
 2174factorize_bindings([Name=Value|T0], [binding(Name, Skel, Subst)|T]) :-
 2175    '$factorize_term'(Value, Skel, Subst0),
 2176    (   current_prolog_flag(toplevel_print_factorized, true)
 2177    ->  Subst = Subst0
 2178    ;   only_cycles(Subst0, Subst)
 2179    ),
 2180    factorize_bindings(T0, T).
 2181
 2182
 2183only_cycles([], []).
 2184only_cycles([B|T0], List) :-
 2185    (   B = (Var=Value),
 2186        Var = Value,
 2187        acyclic_term(Var)
 2188    ->  only_cycles(T0, List)
 2189    ;   List = [B|T],
 2190        only_cycles(T0, T)
 2191    ).
 2192
 2193
 2194%!  filter_bindings(+Bindings0, -Bindings)
 2195%
 2196%   Remove bindings that must not be printed. There are two of them:
 2197%   Variables whose name start with '_'  and variables that are only
 2198%   bound to themselves (or, unbound).
 2199
 2200filter_bindings([], []).
 2201filter_bindings([H0|T0], T) :-
 2202    hide_vars(H0, H),
 2203    (   (   arg(1, H, [])
 2204        ;   self_bounded(H)
 2205        )
 2206    ->  filter_bindings(T0, T)
 2207    ;   T = [H|T1],
 2208        filter_bindings(T0, T1)
 2209    ).
 2210
 2211hide_vars(binding(Names0, Skel, Subst), binding(Names, Skel, Subst)) :-
 2212    hide_names(Names0, Skel, Subst, Names).
 2213
 2214hide_names([], _, _, []).
 2215hide_names([Name|T0], Skel, Subst, T) :-
 2216    (   anon_var_name(Name),
 2217        current_prolog_flag(toplevel_print_anon, false)
 2218    ->  true
 2219    ;   Subst == [],
 2220        Skel == '$VAR'(Name)
 2221    ),
 2222    !,
 2223    hide_names(T0, Skel, Subst, T).
 2224hide_names([Name|T0], Skel, Subst, [Name|T]) :-
 2225    hide_names(T0, Skel, Subst, T).
 2226
 2227%   anon_var_name(+Name) is semidet.
 2228%
 2229%   True if Name is `_X`, or `?_X` if the flag `var_prefix` is `?`.
 2230
 2231anon_var_name(Name) :-
 2232    (   sub_atom(Name, 0, 1, _, '_')
 2233    ->  S = 1
 2234    ;   sub_atom(Name, 0, 1, _, P),
 2235        char_type(P, prolog_symbol),
 2236        sub_atom(Name, 1, 1, _, '_')
 2237    ->  S = 2
 2238    ),
 2239    sub_atom(Name, S, 1, _, Next),
 2240    char_type(Next, prolog_var_start).
 2241
 2242self_bounded(binding([Name], Value, [])) :-
 2243    Value == '$VAR'(Name).
 2244
 2245%!  get_respons(-Action, +Chp)
 2246%
 2247%   Read the continuation entered by the user.
 2248
 2249:- if(current_prolog_flag(emscripten, true)). 2250get_respons(Action, Chp) :-
 2251    '$can_yield',
 2252    !,
 2253    repeat,
 2254        await(more, CommandS),
 2255        atom_string(Command, CommandS),
 2256        more_action(Command, Chp, Action),
 2257        (   Action == again
 2258        ->  print_message(query, query(action)),
 2259            fail
 2260        ;   !
 2261        ).
 2262:- endif. 2263get_respons(Action, Chp) :-
 2264    repeat,
 2265        flush_output(user_output),
 2266        get_single_char(Code),
 2267        find_more_command(Code, Command, Feedback, Style),
 2268        (   Style \== '-'
 2269        ->  print_message(query, if_tty([ansi(Style, '~w', [Feedback])]))
 2270        ;   true
 2271        ),
 2272        more_action(Command, Chp, Action),
 2273        (   Action == again
 2274        ->  print_message(query, query(action)),
 2275            fail
 2276        ;   !
 2277        ).
 2278
 2279find_more_command(-1, end_of_file, 'EOF', warning) :-
 2280    !.
 2281find_more_command(Code, Command, Feedback, Style) :-
 2282    more_command(Command, Atom, Feedback, Style),
 2283    '$in_reply'(Code, Atom),
 2284    !.
 2285find_more_command(Code, again, '', -) :-
 2286    print_message(query, no_action(Code)).
 2287
 2288more_command(help,        '?h',        '',          -).
 2289more_command(redo,        ';nrNR \t',  ';',         bold).
 2290more_command(trace,       'tT',        '; [trace]', comment).
 2291more_command(continue,    'ca\n\ryY.', '.',         bold).
 2292more_command(break,       'b',         '',          -).
 2293more_command(choicepoint, '*',         '',          -).
 2294more_command(write,       'w',         '[write]',   comment).
 2295more_command(print,       'p',         '[print]',   comment).
 2296more_command(depth_inc,   '+',         Change,      comment) :-
 2297    (   print_depth(Depth0)
 2298    ->  depth_step(Step),
 2299        NewDepth is Depth0*Step,
 2300        format(atom(Change), '[max_depth(~D)]', [NewDepth])
 2301    ;   Change = 'no max_depth'
 2302    ).
 2303more_command(depth_dec,   '-',         Change,      comment) :-
 2304    (   print_depth(Depth0)
 2305    ->  depth_step(Step),
 2306        NewDepth is max(1, Depth0//Step),
 2307        format(atom(Change), '[max_depth(~D)]', [NewDepth])
 2308    ;   Change = '[max_depth(10)]'
 2309    ).
 2310
 2311more_action(help, _, Action) =>
 2312    Action = again,
 2313    print_message(help, query(help)).
 2314more_action(redo, _, Action) =>			% Next
 2315    Action = redo.
 2316more_action(trace, _, Action) =>
 2317    Action = redo,
 2318    trace,
 2319    save_debug.
 2320more_action(continue, _, Action) =>             % Stop
 2321    Action = continue.
 2322more_action(break, _, Action) =>
 2323    Action = show_again,
 2324    break.
 2325more_action(choicepoint, Chp, Action) =>
 2326    Action = show_again,
 2327    print_last_chpoint(Chp).
 2328more_action(end_of_file, _, Action) =>
 2329    Action = show_again,
 2330    halt(0).
 2331more_action(again, _, Action) =>
 2332    Action = again.
 2333more_action(Command, _, Action),
 2334    current_prolog_flag(answer_write_options, Options0),
 2335    print_predicate(Command, Options0, Options) =>
 2336    Action = show_again,
 2337    set_prolog_flag(answer_write_options, Options).
 2338
 2339print_depth(Depth) :-
 2340    current_prolog_flag(answer_write_options, Options),
 2341    '$option'(max_depth(Depth), Options),
 2342    !.
 2343
 2344%!  print_predicate(+Action, +Options0, -Options) is semidet.
 2345%
 2346%   Modify  the  `answer_write_options`  value  according  to  the  user
 2347%   command.
 2348
 2349print_predicate(write, Options0, Options) :-
 2350    edit_options([-portrayed(true),-portray(true)],
 2351                 Options0, Options).
 2352print_predicate(print, Options0, Options) :-
 2353    edit_options([+portrayed(true)],
 2354                 Options0, Options).
 2355print_predicate(depth_inc, Options0, Options) :-
 2356    (   '$select'(max_depth(D0), Options0, Options1)
 2357    ->  depth_step(Step),
 2358        D is D0*Step,
 2359        Options = [max_depth(D)|Options1]
 2360    ;   Options = Options0
 2361    ).
 2362print_predicate(depth_dec, Options0, Options) :-
 2363    (   '$select'(max_depth(D0), Options0, Options1)
 2364    ->  depth_step(Step),
 2365        D is max(1, D0//Step),
 2366        Options = [max_depth(D)|Options1]
 2367    ;   D = 10,
 2368        Options = [max_depth(D)|Options0]
 2369    ).
 2370
 2371depth_step(5).
 2372
 2373edit_options([], Options, Options).
 2374edit_options([H|T], Options0, Options) :-
 2375    edit_option(H, Options0, Options1),
 2376    edit_options(T, Options1, Options).
 2377
 2378edit_option(-Term, Options0, Options) =>
 2379    (   '$select'(Term, Options0, Options)
 2380    ->  true
 2381    ;   Options = Options0
 2382    ).
 2383edit_option(+Term, Options0, Options) =>
 2384    functor(Term, Name, 1),
 2385    functor(Var, Name, 1),
 2386    (   '$select'(Var, Options0, Options1)
 2387    ->  Options = [Term|Options1]
 2388    ;   Options = [Term|Options0]
 2389    ).
 2390
 2391%!  print_last_chpoint(+Chp) is det.
 2392%
 2393%   Print the last choicepoint when an answer is nondeterministic.
 2394
 2395print_last_chpoint(Chp) :-
 2396    current_predicate(print_last_choice_point/0),
 2397    !,
 2398    print_last_chpoint_(Chp).
 2399print_last_chpoint(Chp) :-
 2400    use_module(library(prolog_stack), [print_last_choicepoint/2]),
 2401    print_last_chpoint_(Chp).
 2402
 2403print_last_chpoint_(Chp) :-
 2404    print_last_choicepoint(Chp, [message_level(information)]).
 2405
 2406
 2407                 /*******************************
 2408                 *          EXPANSION           *
 2409                 *******************************/
 2410
 2411:- user:dynamic(expand_query/4). 2412:- user:multifile(expand_query/4). 2413
 2414call_expand_query(Goal, Expanded, Bindings, ExpandedBindings) :-
 2415    (   '$replace_toplevel_vars'(Goal, Expanded0, Bindings, ExpandedBindings0)
 2416    ->  true
 2417    ;   Expanded0 = Goal, ExpandedBindings0 = Bindings
 2418    ),
 2419    (   user:expand_query(Expanded0, Expanded, ExpandedBindings0, ExpandedBindings)
 2420    ->  true
 2421    ;   Expanded = Expanded0, ExpandedBindings = ExpandedBindings0
 2422    ).
 2423
 2424
 2425:- dynamic
 2426    user:expand_answer/2,
 2427    prolog:expand_answer/3. 2428:- multifile
 2429    user:expand_answer/2,
 2430    prolog:expand_answer/3. 2431
 2432call_expand_answer(Goal, BindingsIn, BindingsOut) :-
 2433    (   prolog:expand_answer(Goal, BindingsIn, BindingsOut)
 2434    ->  true
 2435    ;   user:expand_answer(BindingsIn, BindingsOut)
 2436    ->  true
 2437    ;   BindingsOut = BindingsIn
 2438    ),
 2439    '$save_toplevel_vars'(BindingsOut),
 2440    !.
 2441call_expand_answer(_, Bindings, Bindings)