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        ;   print_message(warning,
  849                          error(existence_error(library, library(Library)),
  850                                _)),
  851            fail
  852        )
  853    ->  set_prolog_flag(readline, Library)
  854    ;   set_prolog_flag(readline, false)
  855    ).
  856
  857readline_library(true, Library) :-
  858    !,
  859    preferred_readline(Library).
  860readline_library(false, _) :-
  861    !,
  862    fail.
  863readline_library(Library, Library).
  864
  865preferred_readline(editline).
  866
  867%!  load_setup_file(+File) is semidet.
  868%
  869%   Load a file and fail silently if the file does not exist.
  870
  871load_setup_file(File) :-
  872    catch(load_files(File,
  873                     [ silent(true),
  874                       if(not_loaded)
  875                     ]), error(_,_), fail).
  876
  877
  878%!  setup_app is det.
  879%
  880%   When running as an "app", behave as such. The behaviour depends on
  881%   the platform.
  882%
  883%     - Windows
  884%       If Prolog is started using --win_app, try to change directory
  885%       to <My Documents>\Prolog.
  886
  887:- if(current_prolog_flag(windows,true)).  888
  889setup_app :-
  890    current_prolog_flag(associated_file, _),
  891    !.
  892setup_app :-
  893    '$cmd_option_val'(win_app, true),
  894    !,
  895    catch(my_prolog, E, print_message(warning, E)).
  896setup_app.
  897
  898my_prolog :-
  899    win_folder(personal, MyDocs),
  900    atom_concat(MyDocs, '/Prolog', PrologDir),
  901    (   ensure_dir(PrologDir)
  902    ->  working_directory(_, PrologDir)
  903    ;   working_directory(_, MyDocs)
  904    ).
  905
  906ensure_dir(Dir) :-
  907    exists_directory(Dir),
  908    !.
  909ensure_dir(Dir) :-
  910    catch(make_directory(Dir), E, (print_message(warning, E), fail)).
  911
  912:- elif(current_prolog_flag(apple, true)).  913use_app_settings(true).                        % Indicate we need app settings
  914
  915setup_app :-
  916    apple_set_locale,
  917    current_prolog_flag(associated_file, _),
  918    !.
  919setup_app :-
  920    current_prolog_flag(bundle, true),
  921    current_prolog_flag(executable, Exe),
  922    file_base_name(Exe, 'SWI-Prolog'),
  923    !,
  924    setup_macos_app.
  925setup_app.
  926
  927apple_set_locale :-
  928    (   getenv('LC_CTYPE', 'UTF-8'),
  929        apple_current_locale_identifier(LocaleID),
  930        atom_concat(LocaleID, '.UTF-8', Locale),
  931        catch(setlocale(ctype, _Old, Locale), _, fail)
  932    ->  setenv('LANG', Locale),
  933        unsetenv('LC_CTYPE')
  934    ;   true
  935    ).
  936
  937setup_macos_app :-
  938    restore_working_directory,
  939    !.
  940setup_macos_app :-
  941    expand_file_name('~/Prolog', [PrologDir]),
  942    (   exists_directory(PrologDir)
  943    ->  true
  944    ;   catch(make_directory(PrologDir), MkDirError,
  945              print_message(warning, MkDirError))
  946    ),
  947    catch(working_directory(_, PrologDir), CdError,
  948          print_message(warning, CdError)),
  949    !.
  950setup_macos_app.
  951
  952:- elif(current_prolog_flag(emscripten, true)).  953setup_app.
  954:- else.  955use_app_settings(true).                        % Indicate we need app settings
  956
  957% Other (Unix-like) platforms.
  958setup_app :-
  959    running_as_app,
  960    restore_working_directory,
  961    !.
  962setup_app.
  963
  964%!  running_as_app is semidet.
  965%
  966%   True if we were started from the dock.
  967
  968running_as_app :-
  969%   getenv('FLATPAK_SANDBOX_DIR', _),
  970    current_prolog_flag(epilog, true),
  971    stream_property(In, file_no(0)),
  972    \+ stream_property(In, tty(true)),
  973    !.
  974
  975:- endif.  976
  977
  978:- if((current_predicate(use_app_settings/1),
  979       use_app_settings(true))).  980
  981
  982                /*******************************
  983                *    APP WORKING DIRECTORY     *
  984                *******************************/
  985
  986save_working_directory :-
  987    working_directory(WD, WD),
  988    app_settings(Settings),
  989    (   Settings.get(working_directory) == WD
  990    ->  true
  991    ;   app_save_settings(Settings.put(working_directory, WD))
  992    ).
  993
  994restore_working_directory :-
  995    at_halt(save_working_directory),
  996    app_settings(Settings),
  997    WD = Settings.get(working_directory),
  998    catch(working_directory(_, WD), _, fail),
  999    !.
 1000
 1001                /*******************************
 1002                *           SETTINGS           *
 1003                *******************************/
 1004
 1005%!  app_settings(-Settings:dict) is det.
 1006%
 1007%   Get a dict holding the persistent application settings.
 1008
 1009app_settings(Settings) :-
 1010    app_settings_file(File),
 1011    access_file(File, read),
 1012    catch(setup_call_cleanup(
 1013              open(File, read, In, [encoding(utf8)]),
 1014              read_term(In, Settings, []),
 1015              close(In)),
 1016          Error,
 1017          (print_message(warning, Error), fail)),
 1018    !.
 1019app_settings(#{}).
 1020
 1021%!  app_save_settings(+Settings:dict) is det.
 1022%
 1023%   Save the given application settings dict.
 1024
 1025app_save_settings(Settings) :-
 1026    app_settings_file(File),
 1027    catch(setup_call_cleanup(
 1028              open(File, write, Out, [encoding(utf8)]),
 1029              write_term(Out, Settings,
 1030                         [ quoted(true),
 1031                           module(system), % default operators
 1032                           fullstop(true),
 1033                           nl(true)
 1034                         ]),
 1035              close(Out)),
 1036          Error,
 1037          (print_message(warning, Error), fail)).
 1038
 1039
 1040app_settings_file(File) :-
 1041    absolute_file_name(user_app_config('app_settings.pl'), File,
 1042                       [ access(write),
 1043                         file_errors(fail)
 1044                       ]).
 1045:- endif.% app_settings
 1046
 1047                /*******************************
 1048                *           TOPLEVEL           *
 1049                *******************************/
 1050
 1051:- '$hide'('$toplevel'/0).              % avoid in the GUI stacktrace
 1052
 1053%!  '$toplevel'
 1054%
 1055%   Called from PL_toplevel()
 1056
 1057'$toplevel' :-
 1058    '$runtoplevel',
 1059    print_message(informational, halt).
 1060
 1061%!  '$runtoplevel'
 1062%
 1063%   Actually run the toplevel. The values   `default`  and `prolog` both
 1064%   start the interactive toplevel, where `prolog` implies the user gave
 1065%   =|-t prolog|=.
 1066%
 1067%   @see prolog/0 is the default interactive toplevel
 1068
 1069'$runtoplevel' :-
 1070    current_prolog_flag(toplevel_goal, TopLevel0),
 1071    toplevel_goal(TopLevel0, TopLevel),
 1072    user:TopLevel.
 1073
 1074:- dynamic  setup_done/0. 1075:- volatile setup_done/0. 1076
 1077toplevel_goal(default, '$query_loop') :-
 1078    !,
 1079    setup_interactive.
 1080toplevel_goal(prolog, '$query_loop') :-
 1081    !,
 1082    setup_interactive.
 1083toplevel_goal(Goal, Goal).
 1084
 1085setup_interactive :-
 1086    setup_done,
 1087    !.
 1088setup_interactive :-
 1089    asserta(setup_done),
 1090    catch(setup_backtrace, E, print_message(warning, E)),
 1091    catch(setup_readline,  E, print_message(warning, E)),
 1092    catch(setup_history,   E, print_message(warning, E)).
 1093
 1094%!  '$compile'
 1095%
 1096%   Toplevel called when invoked with -c option.
 1097
 1098'$compile' :-
 1099    (   catch('$compile_', E, (print_message(error, E), halt(1)))
 1100    ->  true
 1101    ;   print_message(error, error(goal_failed('$compile'), _)),
 1102        halt(1)
 1103    ),
 1104    halt.                               % set exit code
 1105
 1106'$compile_' :-
 1107    '$load_system_init_file',
 1108    catch(setup_colors, _, true),
 1109    '$set_file_search_paths',
 1110    init_debug_flags,
 1111    '$run_initialization',
 1112    opt_attach_packs,
 1113    use_module(library(qsave)),
 1114    qsave:qsave_toplevel.
 1115
 1116%!  '$config'
 1117%
 1118%   Toplevel when invoked with --dump-runtime-variables
 1119
 1120'$config' :-
 1121    '$load_system_init_file',
 1122    '$set_file_search_paths',
 1123    init_debug_flags,
 1124    '$run_initialization',
 1125    load_files(library(prolog_config)),
 1126    (   catch(prolog_dump_runtime_variables, E,
 1127              (print_message(error, E), halt(1)))
 1128    ->  true
 1129    ;   print_message(error, error(goal_failed(prolog_dump_runtime_variables),_))
 1130    ).
 1131
 1132
 1133                /********************************
 1134                *    USER INTERACTIVE LOOP      *
 1135                *********************************/
 1136
 1137%!  prolog:repl_loop_hook(+BeginEnd, +BreakLevel) is nondet.
 1138%
 1139%   Multifile  hook  that  allows  acting    on   starting/stopping  the
 1140%   interactive REPL loop. Called as
 1141%
 1142%       forall(prolog:repl_loop_hook(BeginEnd, BreakLevel), true)
 1143%
 1144%   @arg BeginEnd is one of `begin` or `end`
 1145%   @arg BreakLevel is 0 for the normal toplevel, -1 when
 1146%   non-interactive and >0 for _break environments_.
 1147
 1148:- multifile
 1149    prolog:repl_loop_hook/2. 1150
 1151%!  prolog
 1152%
 1153%   Run the Prolog toplevel. This is now  the same as break/0, which
 1154%   pretends  to  be  in  a  break-level    if  there  is  a  parent
 1155%   environment.
 1156
 1157prolog :-
 1158    break.
 1159
 1160:- create_prolog_flag(toplevel_mode, backtracking, []). 1161
 1162%!  '$query_loop'
 1163%
 1164%   Run the normal Prolog query loop.  Note   that  the query is not
 1165%   protected by catch/3. Dealing with  unhandled exceptions is done
 1166%   by the C-function query_loop().  This   ensures  that  unhandled
 1167%   exceptions are really unhandled (in Prolog).
 1168
 1169'$query_loop' :-
 1170    break_level(BreakLev),
 1171    setup_call_cleanup(
 1172        notrace(call_repl_loop_hook(begin, BreakLev, IsToplevel)),
 1173        '$query_loop'(BreakLev),
 1174        notrace(call_repl_loop_hook(end, BreakLev, IsToplevel))).
 1175
 1176call_repl_loop_hook(begin, BreakLev, IsToplevel) =>
 1177    (   current_prolog_flag(toplevel_thread, IsToplevel)
 1178    ->  true
 1179    ;   IsToplevel = false
 1180    ),
 1181    set_prolog_flag(toplevel_thread, true),
 1182    call_repl_loop_hook_(begin, BreakLev).
 1183call_repl_loop_hook(end, BreakLev, IsToplevel) =>
 1184    set_prolog_flag(toplevel_thread, IsToplevel),
 1185    call_repl_loop_hook_(end, BreakLev).
 1186
 1187call_repl_loop_hook_(BeginEnd, BreakLev) :-
 1188    forall(prolog:repl_loop_hook(BeginEnd, BreakLev), true).
 1189
 1190
 1191'$query_loop'(BreakLev) :-
 1192    current_prolog_flag(toplevel_mode, recursive),
 1193    !,
 1194    read_expanded_query(BreakLev, Query, Bindings),
 1195    (   Query == end_of_file
 1196    ->  print_message(query, query(eof))
 1197    ;   '$call_no_catch'('$execute_query'(Query, Bindings, _)),
 1198        (   current_prolog_flag(toplevel_mode, recursive)
 1199        ->  '$query_loop'(BreakLev)
 1200        ;   '$switch_toplevel_mode'(backtracking),
 1201            '$query_loop'(BreakLev)     % Maybe throw('$switch_toplevel_mode')?
 1202        )
 1203    ).
 1204'$query_loop'(BreakLev) :-
 1205    repeat,
 1206        read_expanded_query(BreakLev, Query, Bindings),
 1207        (   Query == end_of_file
 1208        ->  !, print_message(query, query(eof))
 1209        ;   '$execute_query'(Query, Bindings, _),
 1210            (   current_prolog_flag(toplevel_mode, recursive)
 1211            ->  !,
 1212                '$switch_toplevel_mode'(recursive),
 1213                '$query_loop'(BreakLev)
 1214            ;   fail
 1215            )
 1216        ).
 1217
 1218break_level(BreakLev) :-
 1219    (   current_prolog_flag(break_level, BreakLev)
 1220    ->  true
 1221    ;   BreakLev = -1
 1222    ).
 1223
 1224read_expanded_query(BreakLev, ExpandedQuery, ExpandedBindings) :-
 1225    '$current_typein_module'(TypeIn),
 1226    (   stream_property(user_input, tty(true))
 1227    ->  '$system_prompt'(TypeIn, BreakLev, Prompt),
 1228        prompt(Old, '|    ')
 1229    ;   Prompt = '',
 1230        prompt(Old, '')
 1231    ),
 1232    trim_stacks,
 1233    trim_heap,
 1234    repeat,
 1235      (   catch(read_query(Prompt, Query, Bindings),
 1236                error(io_error(_,_),_), fail)
 1237      ->  prompt(_, Old),
 1238          catch(call_expand_query(Query, ExpandedQuery,
 1239                                  Bindings, ExpandedBindings),
 1240                Error,
 1241                (print_message(error, Error), fail))
 1242      ;   set_prolog_flag(debug_on_error, false),
 1243          thread_exit(io_error)
 1244      ),
 1245    !.
 1246
 1247
 1248%!  read_query(+Prompt, -Goal, -Bindings) is det.
 1249%
 1250%   Read the next query. The first  clause   deals  with  the case where
 1251%   !-based history is enabled. The second is   used  if we have command
 1252%   line editing.
 1253
 1254:- multifile
 1255    prolog:history/2. 1256
 1257:- if(current_prolog_flag(emscripten, true)). 1258read_query(_Prompt, Goal, Bindings) :-
 1259    '$can_yield',
 1260    !,
 1261    await(query, GoalString),
 1262    term_string(Goal, GoalString, [variable_names(Bindings)]).
 1263:- endif. 1264read_query(Prompt, Goal, Bindings) :-
 1265    prolog:history(current_input, enabled),
 1266    !,
 1267    read_term_with_history(
 1268        Goal,
 1269        [ show(h),
 1270          help('!h'),
 1271          no_save([trace]),
 1272          prompt(Prompt),
 1273          variable_names(Bindings)
 1274        ]).
 1275read_query(Prompt, Goal, Bindings) :-
 1276    remove_history_prompt(Prompt, Prompt1),
 1277    repeat,                                 % over syntax errors
 1278    prompt1(Prompt1),
 1279    read_query_line(user_input, Line),
 1280    '$current_typein_module'(TypeIn),
 1281    catch(read_term_from_atom(Line, Goal,
 1282                              [ variable_names(Bindings),
 1283                                module(TypeIn)
 1284                              ]), E,
 1285          (   print_message(error, E),
 1286              fail
 1287          )),
 1288    !.
 1289
 1290%!  read_query_line(+Input, -Query:atom) is det.
 1291%
 1292%   Read a query as an atom. If Query is '$silent'(Goal), execute `Goal`
 1293%   in module `user` and read the   next  query. This supports injecting
 1294%   goals in some GNU-Emacs modes.
 1295
 1296read_query_line(Input, Line) :-
 1297    stream_property(Input, error(true)),
 1298    !,
 1299    Line = end_of_file.
 1300read_query_line(Input, Line) :-
 1301    catch(read_term_as_atom(Input, Line0), Error, true),
 1302    save_debug_after_read,
 1303    (   var(Error)
 1304    ->  (   catch(term_string(Goal, Line0), error(_,_), fail),
 1305            Goal = '$silent'(SilentGoal)
 1306        ->  Error = error(_,_),
 1307            catch_with_backtrace(ignore(SilentGoal), Error,
 1308                                 print_message(error, Error)),
 1309            read_query_line(Input, Line)
 1310        ;   Line = Line0
 1311        )
 1312    ;   catch(print_message(error, Error), _, true),
 1313        (   Error = error(syntax_error(_),_)
 1314        ->  fail
 1315        ;   throw(Error)
 1316        )
 1317    ).
 1318
 1319%!  read_term_as_atom(+Input, -Line)
 1320%
 1321%   Read the next term as an  atom  and   skip  to  the newline or a
 1322%   non-space character.
 1323
 1324read_term_as_atom(In, Line) :-
 1325    '$raw_read'(In, Line),
 1326    (   Line == end_of_file
 1327    ->  true
 1328    ;   skip_to_nl(In)
 1329    ).
 1330
 1331%!  skip_to_nl(+Input) is det.
 1332%
 1333%   Read input after the term. Skips   white  space and %... comment
 1334%   until the end of the line or a non-blank character.
 1335
 1336skip_to_nl(In) :-
 1337    repeat,
 1338    peek_char(In, C),
 1339    (   C == '%'
 1340    ->  skip(In, '\n')
 1341    ;   char_type(C, space)
 1342    ->  get_char(In, _),
 1343        C == '\n'
 1344    ;   true
 1345    ),
 1346    !.
 1347
 1348remove_history_prompt('', '') :- !.
 1349remove_history_prompt(Prompt0, Prompt) :-
 1350    atom_chars(Prompt0, Chars0),
 1351    clean_history_prompt_chars(Chars0, Chars1),
 1352    delete_leading_blanks(Chars1, Chars),
 1353    atom_chars(Prompt, Chars).
 1354
 1355clean_history_prompt_chars([], []).
 1356clean_history_prompt_chars(['~', !|T], T) :- !.
 1357clean_history_prompt_chars([H|T0], [H|T]) :-
 1358    clean_history_prompt_chars(T0, T).
 1359
 1360delete_leading_blanks([' '|T0], T) :-
 1361    !,
 1362    delete_leading_blanks(T0, T).
 1363delete_leading_blanks(L, L).
 1364
 1365
 1366                 /*******************************
 1367                 *        TOPLEVEL DEBUG        *
 1368                 *******************************/
 1369
 1370%!  save_debug_after_read
 1371%
 1372%   Called right after the toplevel read to save the debug status if
 1373%   it was modified from the GUI thread using e.g.
 1374%
 1375%     ==
 1376%     thread_signal(main, gdebug)
 1377%     ==
 1378%
 1379%   @bug Ideally, the prompt would change if debug mode is enabled.
 1380%        That is hard to realise with all the different console
 1381%        interfaces supported by SWI-Prolog.
 1382
 1383save_debug_after_read :-
 1384    current_prolog_flag(debug, true),
 1385    !,
 1386    save_debug.
 1387save_debug_after_read.
 1388
 1389save_debug :-
 1390    (   tracing,
 1391        notrace
 1392    ->  Tracing = true
 1393    ;   Tracing = false
 1394    ),
 1395    current_prolog_flag(debug, Debugging),
 1396    set_prolog_flag(debug, false),
 1397    create_prolog_flag(query_debug_settings,
 1398                       debug(Debugging, Tracing), []).
 1399
 1400restore_debug :-
 1401    current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)),
 1402    set_prolog_flag(debug, Debugging),
 1403    (   Tracing == true
 1404    ->  trace
 1405    ;   true
 1406    ).
 1407
 1408:- initialization
 1409    create_prolog_flag(query_debug_settings, debug(false, false), []). 1410
 1411
 1412                /********************************
 1413                *            PROMPTING          *
 1414                ********************************/
 1415
 1416'$system_prompt'(Module, BrekLev, Prompt) :-
 1417    current_prolog_flag(toplevel_prompt, PAtom),
 1418    atom_codes(PAtom, P0),
 1419    (    Module \== user
 1420    ->   '$substitute'('~m', [Module, ': '], P0, P1)
 1421    ;    '$substitute'('~m', [], P0, P1)
 1422    ),
 1423    (    BrekLev > 0
 1424    ->   '$substitute'('~l', ['[', BrekLev, '] '], P1, P2)
 1425    ;    '$substitute'('~l', [], P1, P2)
 1426    ),
 1427    current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)),
 1428    (    Tracing == true
 1429    ->   '$substitute'('~d', ['[trace] '], P2, P3)
 1430    ;    Debugging == true
 1431    ->   '$substitute'('~d', ['[debug] '], P2, P3)
 1432    ;    '$substitute'('~d', [], P2, P3)
 1433    ),
 1434    atom_chars(Prompt, P3).
 1435
 1436'$substitute'(From, T, Old, New) :-
 1437    atom_codes(From, FromCodes),
 1438    phrase(subst_chars(T), T0),
 1439    '$append'(Pre, S0, Old),
 1440    '$append'(FromCodes, Post, S0) ->
 1441    '$append'(Pre, T0, S1),
 1442    '$append'(S1, Post, New),
 1443    !.
 1444'$substitute'(_, _, Old, Old).
 1445
 1446subst_chars([]) -->
 1447    [].
 1448subst_chars([H|T]) -->
 1449    { atomic(H),
 1450      !,
 1451      atom_codes(H, Codes)
 1452    },
 1453    Codes,
 1454    subst_chars(T).
 1455subst_chars([H|T]) -->
 1456    H,
 1457    subst_chars(T).
 1458
 1459
 1460                /********************************
 1461                *           EXECUTION           *
 1462                ********************************/
 1463
 1464%!  '$execute_query'(Goal, Bindings, -Truth) is det.
 1465%
 1466%   Execute Goal using Bindings.
 1467
 1468'$execute_query'(Var, _, true) :-
 1469    var(Var),
 1470    !,
 1471    print_message(informational, var_query(Var)).
 1472'$execute_query'(Goal, Bindings, Truth) :-
 1473    '$current_typein_module'(TypeIn),
 1474    '$dwim_correct_goal'(TypeIn:Goal, Bindings, Corrected),
 1475    !,
 1476    setup_call_cleanup(
 1477        '$set_source_module'(M0, TypeIn),
 1478        expand_goal(Corrected, Expanded),
 1479        '$set_source_module'(M0)),
 1480    print_message(silent, toplevel_goal(Expanded, Bindings)),
 1481    '$execute_goal2'(Expanded, Bindings, Truth).
 1482'$execute_query'(_, _, false) :-
 1483    notrace,
 1484    print_message(query, query(no)).
 1485
 1486'$execute_goal2'(Goal, Bindings, true) :-
 1487    restore_debug,
 1488    '$current_typein_module'(TypeIn),
 1489    residue_vars(TypeIn:Goal, Vars, TypeIn:Delays, Chp),
 1490    deterministic(Det),
 1491    (   save_debug
 1492    ;   restore_debug, fail
 1493    ),
 1494    flush_output(user_output),
 1495    (   Det == true
 1496    ->  DetOrChp = true
 1497    ;   DetOrChp = Chp
 1498    ),
 1499    call_expand_answer(Goal, Bindings, NewBindings),
 1500    (    \+ \+ write_bindings(NewBindings, Vars, Delays, DetOrChp)
 1501    ->   !
 1502    ).
 1503'$execute_goal2'(_, _, false) :-
 1504    save_debug,
 1505    print_message(query, query(no)).
 1506
 1507residue_vars(Goal, Vars, Delays, Chp) :-
 1508    current_prolog_flag(toplevel_residue_vars, true),
 1509    !,
 1510    '$wfs_call'(call_residue_vars(stop_backtrace(Goal, Chp), Vars), Delays).
 1511residue_vars(Goal, [], Delays, Chp) :-
 1512    '$wfs_call'(stop_backtrace(Goal, Chp), Delays).
 1513
 1514stop_backtrace(Goal, Chp) :-
 1515    toplevel_call(Goal),
 1516    prolog_current_choice(Chp).
 1517
 1518toplevel_call(Goal) :-
 1519    call(Goal),
 1520    no_lco.
 1521
 1522no_lco.
 1523
 1524%!  write_bindings(+Bindings, +ResidueVars, +Delays, +DetOrChp)
 1525%!	is semidet.
 1526%
 1527%   Write   bindings   resulting   from   a     query.    The   flag
 1528%   prompt_alternatives_on determines whether the   user is prompted
 1529%   for alternatives. =groundness= gives   the  classical behaviour,
 1530%   =determinism= is considered more adequate and informative.
 1531%
 1532%   Succeeds if the user accepts the answer and fails otherwise.
 1533%
 1534%   @arg ResidueVars are the residual constraints and provided if
 1535%        the prolog flag `toplevel_residue_vars` is set to
 1536%        `project`.
 1537
 1538write_bindings(Bindings, ResidueVars, Delays, DetOrChp) :-
 1539    '$current_typein_module'(TypeIn),
 1540    translate_bindings(Bindings, Bindings1, ResidueVars, TypeIn:Residuals),
 1541    omit_qualifier(Delays, TypeIn, Delays1),
 1542    write_bindings2(Bindings, Bindings1, Residuals, Delays1, DetOrChp).
 1543
 1544write_bindings2(OrgBindings, [], Residuals, Delays, _) :-
 1545    current_prolog_flag(prompt_alternatives_on, groundness),
 1546    !,
 1547    name_vars(OrgBindings, [], t(Residuals, Delays)),
 1548    print_message(query, query(yes(Delays, Residuals))).
 1549write_bindings2(OrgBindings, Bindings, Residuals, Delays, true) :-
 1550    current_prolog_flag(prompt_alternatives_on, determinism),
 1551    !,
 1552    name_vars(OrgBindings, Bindings, t(Residuals, Delays)),
 1553    print_message(query, query(yes(Bindings, Delays, Residuals))).
 1554write_bindings2(OrgBindings, Bindings, Residuals, Delays, Chp) :-
 1555    repeat,
 1556        name_vars(OrgBindings, Bindings, t(Residuals, Delays)),
 1557        print_message(query, query(more(Bindings, Delays, Residuals))),
 1558        get_respons(Action, Chp),
 1559    (   Action == redo
 1560    ->  !, fail
 1561    ;   Action == show_again
 1562    ->  fail
 1563    ;   !,
 1564        print_message(query, query(done))
 1565    ).
 1566
 1567%!  name_vars(+OrgBinding, +Bindings, +Term) is det.
 1568%
 1569%   Give a name ``_[A-Z][0-9]*`` to all variables   in Term, that do not
 1570%   have a name due to Bindings. Singleton   variables in Term are named
 1571%   `_`. The behavior depends on these Prolog flags:
 1572%
 1573%     - toplevel_name_variables
 1574%       Only act when `true`, else name_vars/3 is a no-op.
 1575%     - toplevel_print_anon
 1576%
 1577%   Variables are named by unifying them to `'$VAR'(Name)`
 1578%
 1579%   @arg Bindings is a list Name=Value
 1580
 1581name_vars(OrgBindings, Bindings, Term) :-
 1582    current_prolog_flag(toplevel_name_variables, true),
 1583    answer_flags_imply_numbervars,
 1584    !,
 1585    '$term_multitons'(t(Bindings,Term), Vars),
 1586    bindings_var_names(OrgBindings, Bindings, VarNames),
 1587    name_vars_(Vars, VarNames, 0),
 1588    term_variables(t(Bindings,Term), SVars),
 1589    anon_vars(SVars).
 1590name_vars(_OrgBindings, _Bindings, _Term).
 1591
 1592name_vars_([], _, _).
 1593name_vars_([H|T], Bindings, N) :-
 1594    name_var(Bindings, Name, N, N1),
 1595    H = '$VAR'(Name),
 1596    name_vars_(T, Bindings, N1).
 1597
 1598anon_vars([]).
 1599anon_vars(['$VAR'('_')|T]) :-
 1600    anon_vars(T).
 1601
 1602%!  name_var(+Reserved, -Name, +N0, -N) is det.
 1603%
 1604%   True when Name is a valid name for   a new variable where the search
 1605%   is guided by the number N0. Name may not appear in Reserved.
 1606
 1607name_var(Reserved, Name, N0, N) :-
 1608    between(N0, infinite, N1),
 1609    I is N1//26,
 1610    J is 0'A + N1 mod 26,
 1611    (   I == 0
 1612    ->  format(atom(Name), '_~c', [J])
 1613    ;   format(atom(Name), '_~c~d', [J, I])
 1614    ),
 1615    \+ memberchk(Name, Reserved),
 1616    !,
 1617    N is N1+1.
 1618
 1619%!  bindings_var_names(+OrgBindings, +TransBindings, -VarNames) is det.
 1620%
 1621%   Find the joined set of variable names   in the original bindings and
 1622%   translated bindings. When generating new names,  we better also omit
 1623%   names  that  appear  in  the  original  bindings  (but  not  in  the
 1624%   translated bindigns).
 1625
 1626bindings_var_names(OrgBindings, TransBindings, VarNames) :-
 1627    phrase(bindings_var_names_(OrgBindings), VarNames0, Tail),
 1628    phrase(bindings_var_names_(TransBindings), Tail, []),
 1629    sort(VarNames0, VarNames).
 1630
 1631%!  bindings_var_names_(+Bindings)// is det.
 1632%
 1633%   Produce a list of variable names that appear in Bindings. This deals
 1634%   both with the single and joined representation of bindings.
 1635
 1636bindings_var_names_([]) --> [].
 1637bindings_var_names_([H|T]) -->
 1638    binding_var_names(H),
 1639    bindings_var_names_(T).
 1640
 1641binding_var_names(binding(Vars,_Value,_Subst)) ==>
 1642    var_names(Vars).
 1643binding_var_names(Name=_Value) ==>
 1644    [Name].
 1645
 1646var_names([]) --> [].
 1647var_names([H|T]) --> [H], var_names(T).
 1648
 1649
 1650%!  answer_flags_imply_numbervars
 1651%
 1652%   True when the answer will be  written recognising '$VAR'(N). If this
 1653%   is not the case we should not try to name the variables.
 1654
 1655answer_flags_imply_numbervars :-
 1656    current_prolog_flag(answer_write_options, Options),
 1657    numbervars_option(Opt),
 1658    memberchk(Opt, Options),
 1659    !.
 1660
 1661numbervars_option(portray(true)).
 1662numbervars_option(portrayed(true)).
 1663numbervars_option(numbervars(true)).
 1664
 1665%!  residual_goals(:NonTerminal)
 1666%
 1667%   Directive that registers NonTerminal as a collector for residual
 1668%   goals.
 1669
 1670:- multifile
 1671    residual_goal_collector/1. 1672
 1673:- meta_predicate
 1674    residual_goals(2). 1675
 1676residual_goals(NonTerminal) :-
 1677    throw(error(context_error(nodirective, residual_goals(NonTerminal)), _)).
 1678
 1679system:term_expansion((:- residual_goals(NonTerminal)),
 1680                      '$toplevel':residual_goal_collector(M2:Head)) :-
 1681    \+ current_prolog_flag(xref, true),
 1682    prolog_load_context(module, M),
 1683    strip_module(M:NonTerminal, M2, Head),
 1684    '$must_be'(callable, Head).
 1685
 1686%!  prolog:residual_goals// is det.
 1687%
 1688%   DCG that collects residual goals that   are  not associated with
 1689%   the answer through attributed variables.
 1690
 1691:- public prolog:residual_goals//0. 1692
 1693prolog:residual_goals -->
 1694    { findall(NT, residual_goal_collector(NT), NTL) },
 1695    collect_residual_goals(NTL).
 1696
 1697collect_residual_goals([]) --> [].
 1698collect_residual_goals([H|T]) -->
 1699    ( call(H) -> [] ; [] ),
 1700    collect_residual_goals(T).
 1701
 1702
 1703
 1704%!  prolog:translate_bindings(+Bindings0, -Bindings, +ResidueVars,
 1705%!                            +ResidualGoals, -Residuals) is det.
 1706%
 1707%   Translate the raw variable bindings  resulting from successfully
 1708%   completing a query into a  binding   list  and  list of residual
 1709%   goals suitable for human consumption.
 1710%
 1711%   @arg    Bindings is a list of binding(Vars,Value,Substitutions),
 1712%           where Vars is a list of variable names. E.g.
 1713%           binding(['A','B'],42,[])` means that both the variable
 1714%           A and B have the value 42. Values may contain terms
 1715%           '$VAR'(Name) to indicate sharing with a given variable.
 1716%           Value is always an acyclic term. If cycles appear in the
 1717%           answer, Substitutions contains a list of substitutions
 1718%           that restore the original term.
 1719%
 1720%   @arg    Residuals is a pair of two lists representing residual
 1721%           goals. The first element of the pair are residuals
 1722%           related to the query variables and the second are
 1723%           related that are disconnected from the query.
 1724
 1725:- public
 1726    prolog:translate_bindings/5. 1727:- meta_predicate
 1728    prolog:translate_bindings(+, -, +, +, :). 1729
 1730prolog:translate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals) :-
 1731    translate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals),
 1732    name_vars(Bindings0, Bindings, t(ResVars, ResGoals, Residuals)).
 1733
 1734% should not be required.
 1735prolog:name_vars(Bindings, Term) :- name_vars([], Bindings, Term).
 1736prolog:name_vars(Bindings0, Bindings, Term) :- name_vars(Bindings0, Bindings, Term).
 1737
 1738translate_bindings(Bindings0, Bindings, ResidueVars, Residuals) :-
 1739    prolog:residual_goals(ResidueGoals, []),
 1740    translate_bindings(Bindings0, Bindings, ResidueVars, ResidueGoals,
 1741                       Residuals).
 1742
 1743translate_bindings(Bindings0, Bindings, [], [], _:[]-[]) :-
 1744    term_attvars(Bindings0, []),
 1745    !,
 1746    join_same_bindings(Bindings0, Bindings1),
 1747    factorize_bindings(Bindings1, Bindings2),
 1748    bind_vars(Bindings2, Bindings3),
 1749    filter_bindings(Bindings3, Bindings).
 1750translate_bindings(Bindings0, Bindings, ResidueVars, ResGoals0,
 1751                   TypeIn:Residuals-HiddenResiduals) :-
 1752    project_constraints(Bindings0, ResidueVars),
 1753    hidden_residuals(ResidueVars, Bindings0, HiddenResiduals0),
 1754    omit_qualifiers(HiddenResiduals0, TypeIn, HiddenResiduals),
 1755    copy_term(Bindings0+ResGoals0, Bindings1+ResGoals1, Residuals0),
 1756    '$append'(ResGoals1, Residuals0, Residuals1),
 1757    omit_qualifiers(Residuals1, TypeIn, Residuals),
 1758    join_same_bindings(Bindings1, Bindings2),
 1759    factorize_bindings(Bindings2, Bindings3),
 1760    bind_vars(Bindings3, Bindings4),
 1761    filter_bindings(Bindings4, Bindings).
 1762
 1763hidden_residuals(ResidueVars, Bindings, Goal) :-
 1764    term_attvars(ResidueVars, Remaining),
 1765    term_attvars(Bindings, QueryVars),
 1766    subtract_vars(Remaining, QueryVars, HiddenVars),
 1767    copy_term(HiddenVars, _, Goal).
 1768
 1769subtract_vars(All, Subtract, Remaining) :-
 1770    sort(All, AllSorted),
 1771    sort(Subtract, SubtractSorted),
 1772    ord_subtract(AllSorted, SubtractSorted, Remaining).
 1773
 1774ord_subtract([], _Not, []).
 1775ord_subtract([H1|T1], L2, Diff) :-
 1776    diff21(L2, H1, T1, Diff).
 1777
 1778diff21([], H1, T1, [H1|T1]).
 1779diff21([H2|T2], H1, T1, Diff) :-
 1780    compare(Order, H1, H2),
 1781    diff3(Order, H1, T1, H2, T2, Diff).
 1782
 1783diff12([], _H2, _T2, []).
 1784diff12([H1|T1], H2, T2, Diff) :-
 1785    compare(Order, H1, H2),
 1786    diff3(Order, H1, T1, H2, T2, Diff).
 1787
 1788diff3(<,  H1, T1,  H2, T2, [H1|Diff]) :-
 1789    diff12(T1, H2, T2, Diff).
 1790diff3(=, _H1, T1, _H2, T2, Diff) :-
 1791    ord_subtract(T1, T2, Diff).
 1792diff3(>,  H1, T1, _H2, T2, Diff) :-
 1793    diff21(T2, H1, T1, Diff).
 1794
 1795
 1796%!  project_constraints(+Bindings, +ResidueVars) is det.
 1797%
 1798%   Call   <module>:project_attributes/2   if   the    Prolog   flag
 1799%   `toplevel_residue_vars` is set to `project`.
 1800
 1801project_constraints(Bindings, ResidueVars) :-
 1802    !,
 1803    term_attvars(Bindings, AttVars),
 1804    phrase(attribute_modules(AttVars), Modules0),
 1805    sort(Modules0, Modules),
 1806    term_variables(Bindings, QueryVars),
 1807    project_attributes(Modules, QueryVars, ResidueVars).
 1808project_constraints(_, _).
 1809
 1810project_attributes([], _, _).
 1811project_attributes([M|T], QueryVars, ResidueVars) :-
 1812    (   current_predicate(M:project_attributes/2),
 1813        catch(M:project_attributes(QueryVars, ResidueVars), E,
 1814              print_message(error, E))
 1815    ->  true
 1816    ;   true
 1817    ),
 1818    project_attributes(T, QueryVars, ResidueVars).
 1819
 1820attribute_modules([]) --> [].
 1821attribute_modules([H|T]) -->
 1822    { get_attrs(H, Attrs) },
 1823    attrs_modules(Attrs),
 1824    attribute_modules(T).
 1825
 1826attrs_modules([]) --> [].
 1827attrs_modules(att(Module, _, More)) -->
 1828    [Module],
 1829    attrs_modules(More).
 1830
 1831
 1832%!  join_same_bindings(Bindings0, Bindings)
 1833%
 1834%   Join variables that are bound to the   same  value. Note that we
 1835%   return the _last_ value. This is   because the factorization may
 1836%   be different and ultimately the names will   be  printed as V1 =
 1837%   V2, ... VN = Value. Using the  last, Value has the factorization
 1838%   of VN.
 1839
 1840join_same_bindings([], []).
 1841join_same_bindings([Name=V0|T0], [[Name|Names]=V|T]) :-
 1842    take_same_bindings(T0, V0, V, Names, T1),
 1843    join_same_bindings(T1, T).
 1844
 1845take_same_bindings([], Val, Val, [], []).
 1846take_same_bindings([Name=V1|T0], V0, V, [Name|Names], T) :-
 1847    V0 == V1,
 1848    !,
 1849    take_same_bindings(T0, V1, V, Names, T).
 1850take_same_bindings([Pair|T0], V0, V, Names, [Pair|T]) :-
 1851    take_same_bindings(T0, V0, V, Names, T).
 1852
 1853
 1854%!  omit_qualifiers(+QGoals, +TypeIn, -Goals) is det.
 1855%
 1856%   Omit unneeded module qualifiers  from   QGoals  relative  to the
 1857%   given module TypeIn.
 1858
 1859
 1860omit_qualifiers([], _, []).
 1861omit_qualifiers([Goal0|Goals0], TypeIn, [Goal|Goals]) :-
 1862    omit_qualifier(Goal0, TypeIn, Goal),
 1863    omit_qualifiers(Goals0, TypeIn, Goals).
 1864
 1865omit_qualifier(M:G0, TypeIn, G) :-
 1866    M == TypeIn,
 1867    !,
 1868    omit_meta_qualifiers(G0, TypeIn, G).
 1869omit_qualifier(M:G0, TypeIn, G) :-
 1870    predicate_property(TypeIn:G0, imported_from(M)),
 1871    \+ predicate_property(G0, transparent),
 1872    !,
 1873    G0 = G.
 1874omit_qualifier(_:G0, _, G) :-
 1875    predicate_property(G0, built_in),
 1876    \+ predicate_property(G0, transparent),
 1877    !,
 1878    G0 = G.
 1879omit_qualifier(M:G0, _, M:G) :-
 1880    atom(M),
 1881    !,
 1882    omit_meta_qualifiers(G0, M, G).
 1883omit_qualifier(G0, TypeIn, G) :-
 1884    omit_meta_qualifiers(G0, TypeIn, G).
 1885
 1886omit_meta_qualifiers(V, _, V) :-
 1887    var(V),
 1888    !.
 1889omit_meta_qualifiers((QA,QB), TypeIn, (A,B)) :-
 1890    !,
 1891    omit_qualifier(QA, TypeIn, A),
 1892    omit_qualifier(QB, TypeIn, B).
 1893omit_meta_qualifiers(tnot(QA), TypeIn, tnot(A)) :-
 1894    !,
 1895    omit_qualifier(QA, TypeIn, A).
 1896omit_meta_qualifiers(freeze(V, QGoal), TypeIn, freeze(V, Goal)) :-
 1897    callable(QGoal),
 1898    !,
 1899    omit_qualifier(QGoal, TypeIn, Goal).
 1900omit_meta_qualifiers(when(Cond, QGoal), TypeIn, when(Cond, Goal)) :-
 1901    callable(QGoal),
 1902    !,
 1903    omit_qualifier(QGoal, TypeIn, Goal).
 1904omit_meta_qualifiers(G, _, G).
 1905
 1906
 1907%!  bind_vars(+BindingsIn, -Bindings)
 1908%
 1909%   Bind variables to '$VAR'(Name), so they are printed by the names
 1910%   used in the query. Note that by   binding  in the reverse order,
 1911%   variables bound to one another come out in the natural order.
 1912
 1913bind_vars(Bindings0, Bindings) :-
 1914    bind_query_vars(Bindings0, Bindings, SNames),
 1915    bind_skel_vars(Bindings, Bindings, SNames, 1, _).
 1916
 1917bind_query_vars([], [], []).
 1918bind_query_vars([binding(Names,Var,[Var2=Cycle])|T0],
 1919                [binding(Names,Cycle,[])|T], [Name|SNames]) :-
 1920    Var == Var2,                   % also implies var(Var)
 1921    !,
 1922    '$last'(Names, Name),
 1923    Var = '$VAR'(Name),
 1924    bind_query_vars(T0, T, SNames).
 1925bind_query_vars([B|T0], [B|T], AllNames) :-
 1926    B = binding(Names,Var,Skel),
 1927    bind_query_vars(T0, T, SNames),
 1928    (   var(Var), \+ attvar(Var), Skel == []
 1929    ->  AllNames = [Name|SNames],
 1930        '$last'(Names, Name),
 1931        Var = '$VAR'(Name)
 1932    ;   AllNames = SNames
 1933    ).
 1934
 1935
 1936
 1937bind_skel_vars([], _, _, N, N).
 1938bind_skel_vars([binding(_,_,Skel)|T], Bindings, SNames, N0, N) :-
 1939    bind_one_skel_vars(Skel, Bindings, SNames, N0, N1),
 1940    bind_skel_vars(T, Bindings, SNames, N1, N).
 1941
 1942%!  bind_one_skel_vars(+Subst, +Bindings, +VarName, +N0, -N)
 1943%
 1944%   Give names to the factorized variables that   do not have a name
 1945%   yet. This introduces names  _S<N>,   avoiding  duplicates.  If a
 1946%   factorized variable shares with another binding, use the name of
 1947%   that variable.
 1948%
 1949%   @tbd    Consider the call below. We could remove either of the
 1950%           A = x(1).  Which is best?
 1951%
 1952%           ==
 1953%           ?- A = x(1), B = a(A,A).
 1954%           A = x(1),
 1955%           B = a(A, A), % where
 1956%               A = x(1).
 1957%           ==
 1958
 1959bind_one_skel_vars([], _, _, N, N).
 1960bind_one_skel_vars([Var=Value|T], Bindings, Names, N0, N) :-
 1961    (   var(Var)
 1962    ->  (   '$member'(binding(Names, VVal, []), Bindings),
 1963            same_term(Value, VVal)
 1964        ->  '$last'(Names, VName),
 1965            Var = '$VAR'(VName),
 1966            N2 = N0
 1967        ;   between(N0, infinite, N1),
 1968            atom_concat('_S', N1, Name),
 1969            \+ memberchk(Name, Names),
 1970            !,
 1971            Var = '$VAR'(Name),
 1972            N2 is N1 + 1
 1973        )
 1974    ;   N2 = N0
 1975    ),
 1976    bind_one_skel_vars(T, Bindings, Names, N2, N).
 1977
 1978
 1979%!  factorize_bindings(+Bindings0, -Factorized)
 1980%
 1981%   Factorize cycles and sharing in the bindings.
 1982
 1983factorize_bindings([], []).
 1984factorize_bindings([Name=Value|T0], [binding(Name, Skel, Subst)|T]) :-
 1985    '$factorize_term'(Value, Skel, Subst0),
 1986    (   current_prolog_flag(toplevel_print_factorized, true)
 1987    ->  Subst = Subst0
 1988    ;   only_cycles(Subst0, Subst)
 1989    ),
 1990    factorize_bindings(T0, T).
 1991
 1992
 1993only_cycles([], []).
 1994only_cycles([B|T0], List) :-
 1995    (   B = (Var=Value),
 1996        Var = Value,
 1997        acyclic_term(Var)
 1998    ->  only_cycles(T0, List)
 1999    ;   List = [B|T],
 2000        only_cycles(T0, T)
 2001    ).
 2002
 2003
 2004%!  filter_bindings(+Bindings0, -Bindings)
 2005%
 2006%   Remove bindings that must not be printed. There are two of them:
 2007%   Variables whose name start with '_'  and variables that are only
 2008%   bound to themselves (or, unbound).
 2009
 2010filter_bindings([], []).
 2011filter_bindings([H0|T0], T) :-
 2012    hide_vars(H0, H),
 2013    (   (   arg(1, H, [])
 2014        ;   self_bounded(H)
 2015        )
 2016    ->  filter_bindings(T0, T)
 2017    ;   T = [H|T1],
 2018        filter_bindings(T0, T1)
 2019    ).
 2020
 2021hide_vars(binding(Names0, Skel, Subst), binding(Names, Skel, Subst)) :-
 2022    hide_names(Names0, Skel, Subst, Names).
 2023
 2024hide_names([], _, _, []).
 2025hide_names([Name|T0], Skel, Subst, T) :-
 2026    (   sub_atom(Name, 0, _, _, '_'),
 2027        current_prolog_flag(toplevel_print_anon, false),
 2028        sub_atom(Name, 1, 1, _, Next),
 2029        char_type(Next, prolog_var_start)
 2030    ->  true
 2031    ;   Subst == [],
 2032        Skel == '$VAR'(Name)
 2033    ),
 2034    !,
 2035    hide_names(T0, Skel, Subst, T).
 2036hide_names([Name|T0], Skel, Subst, [Name|T]) :-
 2037    hide_names(T0, Skel, Subst, T).
 2038
 2039self_bounded(binding([Name], Value, [])) :-
 2040    Value == '$VAR'(Name).
 2041
 2042%!  get_respons(-Action, +Chp)
 2043%
 2044%   Read the continuation entered by the user.
 2045
 2046:- if(current_prolog_flag(emscripten, true)). 2047get_respons(Action, Chp) :-
 2048    '$can_yield',
 2049    !,
 2050    repeat,
 2051        await(more, CommandS),
 2052        atom_string(Command, CommandS),
 2053        more_action(Command, Chp, Action),
 2054        (   Action == again
 2055        ->  print_message(query, query(action)),
 2056            fail
 2057        ;   !
 2058        ).
 2059:- endif. 2060get_respons(Action, Chp) :-
 2061    repeat,
 2062        flush_output(user_output),
 2063        get_single_char(Code),
 2064        find_more_command(Code, Command, Feedback, Style),
 2065        (   Style \== '-'
 2066        ->  print_message(query, if_tty([ansi(Style, '~w', [Feedback])]))
 2067        ;   true
 2068        ),
 2069        more_action(Command, Chp, Action),
 2070        (   Action == again
 2071        ->  print_message(query, query(action)),
 2072            fail
 2073        ;   !
 2074        ).
 2075
 2076find_more_command(-1, end_of_file, 'EOF', warning) :-
 2077    !.
 2078find_more_command(Code, Command, Feedback, Style) :-
 2079    more_command(Command, Atom, Feedback, Style),
 2080    '$in_reply'(Code, Atom),
 2081    !.
 2082find_more_command(Code, again, '', -) :-
 2083    print_message(query, no_action(Code)).
 2084
 2085more_command(help,        '?h',        '',          -).
 2086more_command(redo,        ';nrNR \t',  ';',         bold).
 2087more_command(trace,       'tT',        '; [trace]', comment).
 2088more_command(continue,    'ca\n\ryY.', '.',         bold).
 2089more_command(break,       'b',         '',          -).
 2090more_command(choicepoint, '*',         '',          -).
 2091more_command(write,       'w',         '[write]',   comment).
 2092more_command(print,       'p',         '[print]',   comment).
 2093more_command(depth_inc,   '+',         Change,      comment) :-
 2094    (   print_depth(Depth0)
 2095    ->  depth_step(Step),
 2096        NewDepth is Depth0*Step,
 2097        format(atom(Change), '[max_depth(~D)]', [NewDepth])
 2098    ;   Change = 'no max_depth'
 2099    ).
 2100more_command(depth_dec,   '-',         Change,      comment) :-
 2101    (   print_depth(Depth0)
 2102    ->  depth_step(Step),
 2103        NewDepth is max(1, Depth0//Step),
 2104        format(atom(Change), '[max_depth(~D)]', [NewDepth])
 2105    ;   Change = '[max_depth(10)]'
 2106    ).
 2107
 2108more_action(help, _, Action) =>
 2109    Action = again,
 2110    print_message(help, query(help)).
 2111more_action(redo, _, Action) =>			% Next
 2112    Action = redo.
 2113more_action(trace, _, Action) =>
 2114    Action = redo,
 2115    trace,
 2116    save_debug.
 2117more_action(continue, _, Action) =>             % Stop
 2118    Action = continue.
 2119more_action(break, _, Action) =>
 2120    Action = show_again,
 2121    break.
 2122more_action(choicepoint, Chp, Action) =>
 2123    Action = show_again,
 2124    print_last_chpoint(Chp).
 2125more_action(end_of_file, _, Action) =>
 2126    Action = show_again,
 2127    halt(0).
 2128more_action(again, _, Action) =>
 2129    Action = again.
 2130more_action(Command, _, Action),
 2131    current_prolog_flag(answer_write_options, Options0),
 2132    print_predicate(Command, Options0, Options) =>
 2133    Action = show_again,
 2134    set_prolog_flag(answer_write_options, Options).
 2135
 2136print_depth(Depth) :-
 2137    current_prolog_flag(answer_write_options, Options),
 2138    memberchk(max_depth(Depth), Options),
 2139    !.
 2140
 2141%!  print_predicate(+Action, +Options0, -Options) is semidet.
 2142%
 2143%   Modify  the  `answer_write_options`  value  according  to  the  user
 2144%   command.
 2145
 2146print_predicate(write, Options0, Options) :-
 2147    edit_options([-portrayed(true),-portray(true)],
 2148                 Options0, Options).
 2149print_predicate(print, Options0, Options) :-
 2150    edit_options([+portrayed(true)],
 2151                 Options0, Options).
 2152print_predicate(depth_inc, Options0, Options) :-
 2153    (   '$select'(max_depth(D0), Options0, Options1)
 2154    ->  depth_step(Step),
 2155        D is D0*Step,
 2156        Options = [max_depth(D)|Options1]
 2157    ;   Options = Options0
 2158    ).
 2159print_predicate(depth_dec, Options0, Options) :-
 2160    (   '$select'(max_depth(D0), Options0, Options1)
 2161    ->  depth_step(Step),
 2162        D is max(1, D0//Step),
 2163        Options = [max_depth(D)|Options1]
 2164    ;   D = 10,
 2165        Options = [max_depth(D)|Options0]
 2166    ).
 2167
 2168depth_step(5).
 2169
 2170edit_options([], Options, Options).
 2171edit_options([H|T], Options0, Options) :-
 2172    edit_option(H, Options0, Options1),
 2173    edit_options(T, Options1, Options).
 2174
 2175edit_option(-Term, Options0, Options) =>
 2176    (   '$select'(Term, Options0, Options)
 2177    ->  true
 2178    ;   Options = Options0
 2179    ).
 2180edit_option(+Term, Options0, Options) =>
 2181    functor(Term, Name, 1),
 2182    functor(Var, Name, 1),
 2183    (   '$select'(Var, Options0, Options1)
 2184    ->  Options = [Term|Options1]
 2185    ;   Options = [Term|Options0]
 2186    ).
 2187
 2188%!  print_last_chpoint(+Chp) is det.
 2189%
 2190%   Print the last choicepoint when an answer is nondeterministic.
 2191
 2192print_last_chpoint(Chp) :-
 2193    current_predicate(print_last_choice_point/0),
 2194    !,
 2195    print_last_chpoint_(Chp).
 2196print_last_chpoint(Chp) :-
 2197    use_module(library(prolog_stack), [print_last_choicepoint/2]),
 2198    print_last_chpoint_(Chp).
 2199
 2200print_last_chpoint_(Chp) :-
 2201    print_last_choicepoint(Chp, [message_level(information)]).
 2202
 2203
 2204                 /*******************************
 2205                 *          EXPANSION           *
 2206                 *******************************/
 2207
 2208:- user:dynamic(expand_query/4). 2209:- user:multifile(expand_query/4). 2210
 2211call_expand_query(Goal, Expanded, Bindings, ExpandedBindings) :-
 2212    (   '$replace_toplevel_vars'(Goal, Expanded0, Bindings, ExpandedBindings0)
 2213    ->  true
 2214    ;   Expanded0 = Goal, ExpandedBindings0 = Bindings
 2215    ),
 2216    (   user:expand_query(Expanded0, Expanded, ExpandedBindings0, ExpandedBindings)
 2217    ->  true
 2218    ;   Expanded = Expanded0, ExpandedBindings = ExpandedBindings0
 2219    ).
 2220
 2221
 2222:- dynamic
 2223    user:expand_answer/2,
 2224    prolog:expand_answer/3. 2225:- multifile
 2226    user:expand_answer/2,
 2227    prolog:expand_answer/3. 2228
 2229call_expand_answer(Goal, BindingsIn, BindingsOut) :-
 2230    (   prolog:expand_answer(Goal, BindingsIn, BindingsOut)
 2231    ->  true
 2232    ;   user:expand_answer(BindingsIn, BindingsOut)
 2233    ->  true
 2234    ;   BindingsOut = BindingsIn
 2235    ),
 2236    '$save_toplevel_vars'(BindingsOut),
 2237    !.
 2238call_expand_answer(_, Bindings, Bindings)