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