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