toplevel.pl

View source with raw 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-2021, University of Amsterdam
    7                              VU University Amsterdam
    8                              SWI-Prolog Solutions b.v.
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37:- module('$toplevel',
   38          [ '$initialise'/0,            % start Prolog
   39            '$toplevel'/0,              % Prolog top-level (re-entrant)
   40            '$compile'/0,               % `-c' toplevel
   41            '$config'/0,                % --dump-runtime-variables toplevel
   42            initialize/0,               % Run program initialization
   43            version/0,                  % Write initial banner
   44            version/1,                  % Add message to the banner
   45            prolog/0,                   % user toplevel predicate
   46            '$query_loop'/0,            % toplevel predicate
   47            '$execute_query'/3,         % +Query, +Bindings, -Truth
   48            residual_goals/1,           % +Callable
   49            (initialization)/1,         % initialization goal (directive)
   50            '$thread_init'/0,           % initialise thread
   51            (thread_initialization)/1   % thread initialization goal
   52            ]).   53
   54
   55                 /*******************************
   56                 *         VERSION BANNER       *
   57                 *******************************/
   58
   59:- dynamic
   60    prolog:version_msg/1.

version is det: Print the Prolog banner message and messages registered using version/1.

   67version :-
   68    print_message(banner, welcome).

version(+Message) is det: Add message to version/0

   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%       note: loaded_init_file/2 is used by prolog_load_context/2 to
   92%       confirm we are loading a script.
   93
   94:- dynamic
   95    loaded_init_file/2.             % already loaded init files
   96
   97'$load_init_file'(none) :- !.
   98'$load_init_file'(Base) :-
   99    loaded_init_file(Base, _),
  100    !.
  101'$load_init_file'(InitFile) :-
  102    exists_file(InitFile),
  103    !,
  104    ensure_loaded(user:InitFile).
  105'$load_init_file'(Base) :-
  106    absolute_file_name(user_app_config(Base), InitFile,
  107                       [ access(read),
  108                         file_errors(fail)
  109                       ]),
  110    asserta(loaded_init_file(Base, InitFile)),
  111    load_files(user:InitFile,
  112               [ scope_settings(false)
  113               ]).
  114'$load_init_file'('init.pl') :-
  115    (   current_prolog_flag(windows, true),
  116        absolute_file_name(user_profile('swipl.ini'), InitFile,
  117                           [ access(read),
  118                             file_errors(fail)
  119                           ])
  120    ;   expand_file_name('~/.swiplrc', [InitFile]),
  121        exists_file(InitFile)
  122    ),
  123    !,
  124    print_message(warning, backcomp(init_file_moved(InitFile))).
  125'$load_init_file'(_).
  126
  127'$load_system_init_file' :-
  128    loaded_init_file(system, _),
  129    !.
  130'$load_system_init_file' :-
  131    '$cmd_option_val'(system_init_file, Base),
  132    Base \== none,
  133    current_prolog_flag(home, Home),
  134    file_name_extension(Base, rc, Name),
  135    atomic_list_concat([Home, '/', Name], File),
  136    absolute_file_name(File, Path,
  137                       [ file_type(prolog),
  138                         access(read),
  139                         file_errors(fail)
  140                       ]),
  141    asserta(loaded_init_file(system, Path)),
  142    load_files(user:Path,
  143               [ silent(true),
  144                 scope_settings(false)
  145               ]),
  146    !.
  147'$load_system_init_file'.
  148
  149'$load_script_file' :-
  150    loaded_init_file(script, _),
  151    !.
  152'$load_script_file' :-
  153    '$cmd_option_val'(script_file, OsFiles),
  154    load_script_files(OsFiles).
  155
  156load_script_files([]).
  157load_script_files([OsFile|More]) :-
  158    prolog_to_os_filename(File, OsFile),
  159    (   absolute_file_name(File, Path,
  160                           [ file_type(prolog),
  161                             access(read),
  162                             file_errors(fail)
  163                           ])
  164    ->  asserta(loaded_init_file(script, Path)),
  165        load_files(user:Path, []),
  166        load_files(More)
  167    ;   throw(error(existence_error(script_file, File), _))
  168    ).
  169
  170
  171                 /*******************************
  172                 *       AT_INITIALISATION      *
  173                 *******************************/
  174
  175:- meta_predicate
  176    initialization(0).  177
  178:- '$iso'((initialization)/1).

initialization :Goal

Runs Goal after loading the file in which this directive appears as well as after restoring a saved state.

See also: - initialization/2

  187initialization(Goal) :-
  188    Goal = _:G,
  189    prolog:initialize_now(G, Use),
  190    !,
  191    print_message(warning, initialize_now(G, Use)),
  192    initialization(Goal, now).
  193initialization(Goal) :-
  194    initialization(Goal, after_load).
  195
  196:- multifile
  197    prolog:initialize_now/2,
  198    prolog:message//1.  199
  200prolog:initialize_now(load_foreign_library(_),
  201                      'use :- use_foreign_library/1 instead').
  202prolog:initialize_now(load_foreign_library(_,_),
  203                      'use :- use_foreign_library/2 instead').
  204
  205prolog:message(initialize_now(Goal, Use)) -->
  206    [ 'Initialization goal ~p will be executed'-[Goal],nl,
  207      'immediately for backward compatibility reasons', nl,
  208      '~w'-[Use]
  209    ].
  210
  211'$run_initialization' :-
  212    '$run_initialization'(_, []),
  213    '$thread_init'.

initialize: Run goals registered with :- initialization(Goal, program).. Stop with an exception if a goal fails or raises an exception.

  220initialize :-
  221    forall('$init_goal'(when(program), Goal, Ctx),
  222           run_initialize(Goal, Ctx)).
  223
  224run_initialize(Goal, Ctx) :-
  225    (   catch(Goal, E, true),
  226        (   var(E)
  227        ->  true
  228        ;   throw(error(initialization_error(E, Goal, Ctx), _))
  229        )
  230    ;   throw(error(initialization_error(failed, Goal, Ctx), _))
  231    ).
  232
  233
  234                 /*******************************
  235                 *     THREAD INITIALIZATION    *
  236                 *******************************/
  237
  238:- meta_predicate
  239    thread_initialization(0).  240:- dynamic
  241    '$at_thread_initialization'/1.

thread_initialization :Goal: Run Goal now and everytime a new thread is created.

  247thread_initialization(Goal) :-
  248    assert('$at_thread_initialization'(Goal)),
  249    call(Goal),
  250    !.
  251
  252'$thread_init' :-
  253    (   '$at_thread_initialization'(Goal),
  254        (   call(Goal)
  255        ->  fail
  256        ;   fail
  257        )
  258    ;   true
  259    ).
  260
  261
  262                 /*******************************
  263                 *     FILE SEARCH PATH (-p)    *
  264                 *******************************/

$set_file_search_paths is det: Process -p PathSpec options.

  270'$set_file_search_paths' :-
  271    '$cmd_option_val'(search_paths, Paths),
  272    (   '$member'(Path, Paths),
  273        atom_chars(Path, Chars),
  274        (   phrase('$search_path'(Name, Aliases), Chars)
  275        ->  '$reverse'(Aliases, Aliases1),
  276            forall('$member'(Alias, Aliases1),
  277                   asserta(user:file_search_path(Name, Alias)))
  278        ;   print_message(error, commandline_arg_type(p, Path))
  279        ),
  280        fail ; true
  281    ).
  282
  283'$search_path'(Name, Aliases) -->
  284    '$string'(NameChars),
  285    [=],
  286    !,
  287    {atom_chars(Name, NameChars)},
  288    '$search_aliases'(Aliases).
  289
  290'$search_aliases'([Alias|More]) -->
  291    '$string'(AliasChars),
  292    path_sep,
  293    !,
  294    { '$make_alias'(AliasChars, Alias) },
  295    '$search_aliases'(More).
  296'$search_aliases'([Alias]) -->
  297    '$string'(AliasChars),
  298    '$eos',
  299    !,
  300    { '$make_alias'(AliasChars, Alias) }.
  301
  302path_sep -->
  303    { current_prolog_flag(windows, true)
  304    },
  305    !,
  306    [;].
  307path_sep -->
  308    [:].
  309
  310'$string'([]) --> [].
  311'$string'([H|T]) --> [H], '$string'(T).
  312
  313'$eos'([], []).
  314
  315'$make_alias'(Chars, Alias) :-
  316    catch(term_to_atom(Alias, Chars), _, fail),
  317    (   atom(Alias)
  318    ;   functor(Alias, F, 1),
  319        F \== /
  320    ),
  321    !.
  322'$make_alias'(Chars, Alias) :-
  323    atom_chars(Alias, Chars).
  324
  325
  326                 /*******************************
  327                 *   LOADING ASSIOCIATED FILES  *
  328                 *******************************/

argv_files(-Files) is det: Update the Prolog flag argv, extracting the leading script files.

  334argv_files(Files) :-
  335    current_prolog_flag(argv, Argv),
  336    no_option_files(Argv, Argv1, Files, ScriptArgs),
  337    (   (   ScriptArgs == true
  338        ;   Argv1 == []
  339        )
  340    ->  (   Argv1 \== Argv
  341        ->  set_prolog_flag(argv, Argv1)
  342        ;   true
  343        )
  344    ;   '$usage',
  345        halt(1)
  346    ).
  347
  348no_option_files([--|Argv], Argv, [], true) :- !.
  349no_option_files([Opt|_], _, _, ScriptArgs) :-
  350    ScriptArgs \== true,
  351    sub_atom(Opt, 0, _, _, '-'),
  352    !,
  353    '$usage',
  354    halt(1).
  355no_option_files([OsFile|Argv0], Argv, [File|T], ScriptArgs) :-
  356    file_name_extension(_, Ext, OsFile),
  357    user:prolog_file_type(Ext, prolog),
  358    !,
  359    ScriptArgs = true,
  360    prolog_to_os_filename(File, OsFile),
  361    no_option_files(Argv0, Argv, T, ScriptArgs).
  362no_option_files([OsScript|Argv], Argv, [Script], ScriptArgs) :-
  363    ScriptArgs \== true,
  364    !,
  365    prolog_to_os_filename(Script, OsScript),
  366    (   exists_file(Script)
  367    ->  true
  368    ;   '$existence_error'(file, Script)
  369    ),
  370    ScriptArgs = true.
  371no_option_files(Argv, Argv, [], _).
  372
  373clean_argv :-
  374    (   current_prolog_flag(argv, [--|Argv])
  375    ->  set_prolog_flag(argv, Argv)
  376    ;   true
  377    ).

associated_files(-Files): If SWI-Prolog is started as <exe> <file>.<ext>, where <ext> is the extension registered for associated files, set the Prolog flag associated_file, switch to the directory holding the file and -if possible- adjust the window title.

  386associated_files([]) :-
  387    current_prolog_flag(saved_program_class, runtime),
  388    !,
  389    clean_argv.
  390associated_files(Files) :-
  391    '$set_prolog_file_extension',
  392    argv_files(Files),
  393    (   Files = [File|_]
  394    ->  absolute_file_name(File, AbsFile),
  395        set_prolog_flag(associated_file, AbsFile),
  396        set_working_directory(File),
  397        set_window_title(Files)
  398    ;   true
  399    ).

set_working_directory(+File): When opening as a GUI application, e.g., by opening a file from the Finder/Explorer/..., we typically want to change working directory to the location of the primary file. We currently detect that we are a GUI app by the Prolog flag console_menu, which is set by swipl-win[.exe].

  409set_working_directory(File) :-
  410    current_prolog_flag(console_menu, true),
  411    access_file(File, read),
  412    !,
  413    file_directory_name(File, Dir),
  414    working_directory(_, Dir).
  415set_working_directory(_).
  416
  417set_window_title([File|More]) :-
  418    current_predicate(system:window_title/2),
  419    !,
  420    (   More == []
  421    ->  Extra = []
  422    ;   Extra = ['...']
  423    ),
  424    atomic_list_concat(['SWI-Prolog --', File | Extra], ' ', Title),
  425    system:window_title(_, Title).
  426set_window_title(_).

start_pldoc: If the option --pldoc[=port] is given, load the PlDoc system.

  434start_pldoc :-
  435    '$cmd_option_val'(pldoc_server, Server),
  436    (   Server == ''
  437    ->  call((doc_server(_), doc_browser))
  438    ;   catch(atom_number(Server, Port), _, fail)
  439    ->  call(doc_server(Port))
  440    ;   print_message(error, option_usage(pldoc)),
  441        halt(1)
  442    ).
  443start_pldoc.

load_associated_files(+Files): Load Prolog files specified from the commandline.

  450load_associated_files(Files) :-
  451    (   '$member'(File, Files),
  452        load_files(user:File, [expand(false)]),
  453        fail
  454    ;   true
  455    ).
  456
  457hkey('HKEY_CURRENT_USER/Software/SWI/Prolog').
  458hkey('HKEY_LOCAL_MACHINE/Software/SWI/Prolog').
  459
  460'$set_prolog_file_extension' :-
  461    current_prolog_flag(windows, true),
  462    hkey(Key),
  463    catch(win_registry_get_value(Key, fileExtension, Ext0),
  464          _, fail),
  465    !,
  466    (   atom_concat('.', Ext, Ext0)
  467    ->  true
  468    ;   Ext = Ext0
  469    ),
  470    (   user:prolog_file_type(Ext, prolog)
  471    ->  true
  472    ;   asserta(user:prolog_file_type(Ext, prolog))
  473    ).
  474'$set_prolog_file_extension'.
  475
  476
  477                /********************************
  478                *        TOPLEVEL GOALS         *
  479                *********************************/

$initialise is semidet: Called from PL_initialise() to do the Prolog part of the initialization. If an exception occurs, this is printed and '$initialise' fails.

  487'$initialise' :-
  488    catch(initialise_prolog, E, initialise_error(E)).
  489
  490initialise_error('$aborted') :- !.
  491initialise_error(E) :-
  492    print_message(error, initialization_exception(E)),
  493    fail.
  494
  495initialise_prolog :-
  496    '$clean_history',
  497    '$run_initialization',
  498    '$load_system_init_file',
  499    set_toplevel,
  500    '$set_file_search_paths',
  501    init_debug_flags,
  502    start_pldoc,
  503    opt_attach_packs,
  504    '$cmd_option_val'(init_file, OsFile),
  505    prolog_to_os_filename(File, OsFile),
  506    '$load_init_file'(File),
  507    catch(setup_colors, E, print_message(warning, E)),
  508    '$load_script_file',
  509    associated_files(Files),
  510    load_associated_files(Files),
  511    '$cmd_option_val'(goals, Goals),
  512    (   Goals == [],
  513        \+ '$init_goal'(when(_), _, _)
  514    ->  version                                 % default interactive run
  515    ;   run_init_goals(Goals),
  516        (   load_only
  517        ->  version
  518        ;   run_program_init,
  519            run_main_init
  520        )
  521    ).
  522
  523opt_attach_packs :-
  524    current_prolog_flag(packs, true),
  525    !,
  526    attach_packs.
  527opt_attach_packs.
  528
  529set_toplevel :-
  530    '$cmd_option_val'(toplevel, TopLevelAtom),
  531    catch(term_to_atom(TopLevel, TopLevelAtom), E,
  532          (print_message(error, E),
  533           halt(1))),
  534    create_prolog_flag(toplevel_goal, TopLevel, [type(term)]).
  535
  536load_only :-
  537    current_prolog_flag(os_argv, OSArgv),
  538    memberchk('-l', OSArgv),
  539    current_prolog_flag(argv, Argv),
  540    \+ memberchk('-l', Argv).

run_init_goals(+Goals) is det: Run registered initialization goals on order. If a goal fails, execution is halted.

  547run_init_goals([]).
  548run_init_goals([H|T]) :-
  549    run_init_goal(H),
  550    run_init_goals(T).
  551
  552run_init_goal(Text) :-
  553    catch(term_to_atom(Goal, Text), E,
  554          (   print_message(error, init_goal_syntax(E, Text)),
  555              halt(2)
  556          )),
  557    run_init_goal(Goal, Text).

run_program_init is det: Run goals registered using

  563run_program_init :-
  564    forall('$init_goal'(when(program), Goal, Ctx),
  565           run_init_goal(Goal, @(Goal,Ctx))).
  566
  567run_main_init :-
  568    findall(Goal-Ctx, '$init_goal'(when(main), Goal, Ctx), Pairs),
  569    '$last'(Pairs, Goal-Ctx),
  570    !,
  571    (   current_prolog_flag(toplevel_goal, default)
  572    ->  set_prolog_flag(toplevel_goal, halt)
  573    ;   true
  574    ),
  575    run_init_goal(Goal, @(Goal,Ctx)).
  576run_main_init.
  577
  578run_init_goal(Goal, Ctx) :-
  579    (   catch_with_backtrace(user:Goal, E, true)
  580    ->  (   var(E)
  581        ->  true
  582        ;   print_message(error, init_goal_failed(E, Ctx)),
  583            halt(2)
  584        )
  585    ;   (   current_prolog_flag(verbose, silent)
  586        ->  Level = silent
  587        ;   Level = error
  588        ),
  589        print_message(Level, init_goal_failed(failed, Ctx)),
  590        halt(1)
  591    ).

init_debug_flags is det: Initialize the various Prolog flags that control the debugger and toplevel.

  598init_debug_flags :-
  599    once(print_predicate(_, [print], PrintOptions)),
  600    Keep = [keep(true)],
  601    create_prolog_flag(answer_write_options, PrintOptions, Keep),
  602    create_prolog_flag(prompt_alternatives_on, determinism, Keep),
  603    create_prolog_flag(toplevel_extra_white_line, true, Keep),
  604    create_prolog_flag(toplevel_print_factorized, false, Keep),
  605    create_prolog_flag(print_write_options,
  606                       [ portray(true), quoted(true), numbervars(true) ],
  607                       Keep),
  608    create_prolog_flag(toplevel_residue_vars, false, Keep),
  609    create_prolog_flag(toplevel_list_wfs_residual_program, true, Keep),
  610    '$set_debugger_write_options'(print).

setup_backtrace: Initialise printing a backtrace.

  616setup_backtrace :-
  617    (   \+ current_prolog_flag(backtrace, false),
  618        load_setup_file(library(prolog_stack))
  619    ->  true
  620    ;   true
  621    ).

setup_colors is det: Setup interactive usage by enabling colored output.

  627setup_colors :-
  628    (   \+ current_prolog_flag(color_term, false),
  629        stream_property(user_input, tty(true)),
  630        stream_property(user_error, tty(true)),
  631        stream_property(user_output, tty(true)),
  632        \+ getenv('TERM', dumb),
  633        load_setup_file(user:library(ansi_term))
  634    ->  true
  635    ;   true
  636    ).

setup_history: Enable per-directory persistent history.

  642setup_history :-
  643    (   \+ current_prolog_flag(save_history, false),
  644        stream_property(user_input, tty(true)),
  645        \+ current_prolog_flag(readline, false),
  646        load_setup_file(library(prolog_history))
  647    ->  prolog_history(enable)
  648    ;   true
  649    ),
  650    set_default_history,
  651    '$load_history'.

setup_readline: Setup line editing.

  657setup_readline :-
  658    (   current_prolog_flag(readline, swipl_win)
  659    ->  true
  660    ;   stream_property(user_input, tty(true)),
  661        current_prolog_flag(tty_control, true),
  662        \+ getenv('TERM', dumb),
  663        (   current_prolog_flag(readline, ReadLine)
  664        ->  true
  665        ;   ReadLine = true
  666        ),
  667        readline_library(ReadLine, Library),
  668        load_setup_file(library(Library))
  669    ->  set_prolog_flag(readline, Library)
  670    ;   set_prolog_flag(readline, false)
  671    ).
  672
  673readline_library(true, Library) :-
  674    !,
  675    preferred_readline(Library).
  676readline_library(false, _) :-
  677    !,
  678    fail.
  679readline_library(Library, Library).
  680
  681preferred_readline(editline).
  682preferred_readline(readline).

load_setup_file(+File) is semidet: Load a file and fail silently if the file does not exist.

  688load_setup_file(File) :-
  689    catch(load_files(File,
  690                     [ silent(true),
  691                       if(not_loaded)
  692                     ]), _, fail).
  693
  694
  695:- '$hide'('$toplevel'/0).              % avoid in the GUI stacktrace

$toplevel: Called from PL_toplevel()

  701'$toplevel' :-
  702    '$runtoplevel',
  703    print_message(informational, halt).

$runtoplevel

Actually run the toplevel. The values default and prolog both start the interactive toplevel, where prolog implies the user gave -t prolog.

See also: - prolog/0 is the default interactive toplevel

  713'$runtoplevel' :-
  714    current_prolog_flag(toplevel_goal, TopLevel0),
  715    toplevel_goal(TopLevel0, TopLevel),
  716    user:TopLevel.
  717
  718:- dynamic  setup_done/0.  719:- volatile setup_done/0.  720
  721toplevel_goal(default, '$query_loop') :-
  722    !,
  723    setup_interactive.
  724toplevel_goal(prolog, '$query_loop') :-
  725    !,
  726    setup_interactive.
  727toplevel_goal(Goal, Goal).
  728
  729setup_interactive :-
  730    setup_done,
  731    !.
  732setup_interactive :-
  733    asserta(setup_done),
  734    catch(setup_backtrace, E, print_message(warning, E)),
  735    catch(setup_readline,  E, print_message(warning, E)),
  736    catch(setup_history,   E, print_message(warning, E)).

$compile: Toplevel called when invoked with -c option.

  742'$compile' :-
  743    (   catch('$compile_', E, (print_message(error, E), halt(1)))
  744    ->  true
  745    ;   print_message(error, error(goal_failed('$compile'), _)),
  746        halt(1)
  747    ),
  748    halt.                               % set exit code
  749
  750'$compile_' :-
  751    '$load_system_init_file',
  752    catch(setup_colors, _, true),
  753    '$set_file_search_paths',
  754    init_debug_flags,
  755    '$run_initialization',
  756    opt_attach_packs,
  757    use_module(library(qsave)),
  758    qsave:qsave_toplevel.

$config: Toplevel when invoked with --dump-runtime-variables

  764'$config' :-
  765    '$load_system_init_file',
  766    '$set_file_search_paths',
  767    init_debug_flags,
  768    '$run_initialization',
  769    load_files(library(prolog_config)),
  770    (   catch(prolog_dump_runtime_variables, E,
  771              (print_message(error, E), halt(1)))
  772    ->  true
  773    ;   print_message(error, error(goal_failed(prolog_dump_runtime_variables),_))
  774    ).
  775
  776
  777                /********************************
  778                *    USER INTERACTIVE LOOP      *
  779                *********************************/

prolog: Run the Prolog toplevel. This is now the same as break/0, which pretends to be in a break-level if there is a parent environment.

  787prolog :-
  788    break.
  789
  790:- create_prolog_flag(toplevel_mode, backtracking, []).

$query_loop: Run the normal Prolog query loop. Note that the query is not protected by catch/3. Dealing with unhandled exceptions is done by the C-function query_loop(). This ensures that unhandled exceptions are really unhandled (in Prolog).

  799'$query_loop' :-
  800    current_prolog_flag(toplevel_mode, recursive),
  801    !,
  802    break_level(Level),
  803    read_expanded_query(Level, Query, Bindings),
  804    (   Query == end_of_file
  805    ->  print_message(query, query(eof))
  806    ;   '$call_no_catch'('$execute_query'(Query, Bindings, _)),
  807        (   current_prolog_flag(toplevel_mode, recursive)
  808        ->  '$query_loop'
  809        ;   '$switch_toplevel_mode'(backtracking),
  810            '$query_loop'           % Maybe throw('$switch_toplevel_mode')?
  811        )
  812    ).
  813'$query_loop' :-
  814    break_level(BreakLev),
  815    repeat,
  816        read_expanded_query(BreakLev, Query, Bindings),
  817        (   Query == end_of_file
  818        ->  !, print_message(query, query(eof))
  819        ;   '$execute_query'(Query, Bindings, _),
  820            (   current_prolog_flag(toplevel_mode, recursive)
  821            ->  !,
  822                '$switch_toplevel_mode'(recursive),
  823                '$query_loop'
  824            ;   fail
  825            )
  826        ).
  827
  828break_level(BreakLev) :-
  829    (   current_prolog_flag(break_level, BreakLev)
  830    ->  true
  831    ;   BreakLev = -1
  832    ).
  833
  834read_expanded_query(BreakLev, ExpandedQuery, ExpandedBindings) :-
  835    '$current_typein_module'(TypeIn),
  836    (   stream_property(user_input, tty(true))
  837    ->  '$system_prompt'(TypeIn, BreakLev, Prompt),
  838        prompt(Old, '|    ')
  839    ;   Prompt = '',
  840        prompt(Old, '')
  841    ),
  842    trim_stacks,
  843    trim_heap,
  844    repeat,
  845      read_query(Prompt, Query, Bindings),
  846      prompt(_, Old),
  847      catch(call_expand_query(Query, ExpandedQuery,
  848                              Bindings, ExpandedBindings),
  849            Error,
  850            (print_message(error, Error), fail)),
  851    !.

read_query(+Prompt, -Goal, -Bindings) is det: Read the next query. The first clause deals with the case where !-based history is enabled. The second is used if we have command line editing.

  860read_query(Prompt, Goal, Bindings) :-
  861    current_prolog_flag(history, N),
  862    integer(N), N > 0,
  863    !,
  864    read_term_with_history(
  865        Goal,
  866        [ show(h),
  867          help('!h'),
  868          no_save([trace, end_of_file]),
  869          prompt(Prompt),
  870          variable_names(Bindings)
  871        ]).
  872read_query(Prompt, Goal, Bindings) :-
  873    remove_history_prompt(Prompt, Prompt1),
  874    repeat,                                 % over syntax errors
  875    prompt1(Prompt1),
  876    read_query_line(user_input, Line),
  877    '$save_history_line'(Line),             % save raw line (edit syntax errors)
  878    '$current_typein_module'(TypeIn),
  879    catch(read_term_from_atom(Line, Goal,
  880                              [ variable_names(Bindings),
  881                                module(TypeIn)
  882                              ]), E,
  883          (   print_message(error, E),
  884              fail
  885          )),
  886    !,
  887    '$save_history_event'(Line).            % save event (no syntax errors)

read_query_line(+Input, -Line) is det

  891read_query_line(Input, Line) :-
  892    catch(read_term_as_atom(Input, Line), Error, true),
  893    save_debug_after_read,
  894    (   var(Error)
  895    ->  true
  896    ;   Error = error(syntax_error(_),_)
  897    ->  print_message(error, Error),
  898        fail
  899    ;   print_message(error, Error),
  900        throw(Error)
  901    ).

read_term_as_atom(+Input, -Line): Read the next term as an atom and skip to the newline or a non-space character.

  908read_term_as_atom(In, Line) :-
  909    '$raw_read'(In, Line),
  910    (   Line == end_of_file
  911    ->  true
  912    ;   skip_to_nl(In)
  913    ).

skip_to_nl(+Input) is det: Read input after the term. Skips white space and %... comment until the end of the line or a non-blank character.

  920skip_to_nl(In) :-
  921    repeat,
  922    peek_char(In, C),
  923    (   C == '%'
  924    ->  skip(In, '\n')
  925    ;   char_type(C, space)
  926    ->  get_char(In, _),
  927        C == '\n'
  928    ;   true
  929    ),
  930    !.
  931
  932remove_history_prompt('', '') :- !.
  933remove_history_prompt(Prompt0, Prompt) :-
  934    atom_chars(Prompt0, Chars0),
  935    clean_history_prompt_chars(Chars0, Chars1),
  936    delete_leading_blanks(Chars1, Chars),
  937    atom_chars(Prompt, Chars).
  938
  939clean_history_prompt_chars([], []).
  940clean_history_prompt_chars(['~', !|T], T) :- !.
  941clean_history_prompt_chars([H|T0], [H|T]) :-
  942    clean_history_prompt_chars(T0, T).
  943
  944delete_leading_blanks([' '|T0], T) :-
  945    !,
  946    delete_leading_blanks(T0, T).
  947delete_leading_blanks(L, L).

set_default_history: Enable !-based numbered command history. This is enabled by default if we are not running under GNU-emacs and we do not have our own line editing.

  956set_default_history :-
  957    current_prolog_flag(history, _),
  958    !.
  959set_default_history :-
  960    (   (   \+ current_prolog_flag(readline, false)
  961        ;   current_prolog_flag(emacs_inferior_process, true)
  962        )
  963    ->  create_prolog_flag(history, 0, [])
  964    ;   create_prolog_flag(history, 25, [])
  965    ).
  966
  967
  968                 /*******************************
  969                 *        TOPLEVEL DEBUG        *
  970                 *******************************/

save_debug_after_read

Called right after the toplevel read to save the debug status if it was modified from the GUI thread using e.g.

thread_signal(main, gdebug)

bug: - Ideally, the prompt would change if debug mode is enabled. That is hard to realise with all the different console interfaces supported by SWI-Prolog.

  985save_debug_after_read :-
  986    current_prolog_flag(debug, true),
  987    !,
  988    save_debug.
  989save_debug_after_read.
  990
  991save_debug :-
  992    (   tracing,
  993        notrace
  994    ->  Tracing = true
  995    ;   Tracing = false
  996    ),
  997    current_prolog_flag(debug, Debugging),
  998    set_prolog_flag(debug, false),
  999    create_prolog_flag(query_debug_settings,
 1000                       debug(Debugging, Tracing), []).
 1001
 1002restore_debug :-
 1003    current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)),
 1004    set_prolog_flag(debug, Debugging),
 1005    (   Tracing == true
 1006    ->  trace
 1007    ;   true
 1008    ).
 1009
 1010:- initialization
 1011    create_prolog_flag(query_debug_settings, debug(false, false), []). 1012
 1013
 1014                /********************************
 1015                *            PROMPTING          *
 1016                ********************************/
 1017
 1018'$system_prompt'(Module, BrekLev, Prompt) :-
 1019    current_prolog_flag(toplevel_prompt, PAtom),
 1020    atom_codes(PAtom, P0),
 1021    (    Module \== user
 1022    ->   '$substitute'('~m', [Module, ': '], P0, P1)
 1023    ;    '$substitute'('~m', [], P0, P1)
 1024    ),
 1025    (    BrekLev > 0
 1026    ->   '$substitute'('~l', ['[', BrekLev, '] '], P1, P2)
 1027    ;    '$substitute'('~l', [], P1, P2)
 1028    ),
 1029    current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)),
 1030    (    Tracing == true
 1031    ->   '$substitute'('~d', ['[trace] '], P2, P3)
 1032    ;    Debugging == true
 1033    ->   '$substitute'('~d', ['[debug] '], P2, P3)
 1034    ;    '$substitute'('~d', [], P2, P3)
 1035    ),
 1036    atom_chars(Prompt, P3).
 1037
 1038'$substitute'(From, T, Old, New) :-
 1039    atom_codes(From, FromCodes),
 1040    phrase(subst_chars(T), T0),
 1041    '$append'(Pre, S0, Old),
 1042    '$append'(FromCodes, Post, S0) ->
 1043    '$append'(Pre, T0, S1),
 1044    '$append'(S1, Post, New),
 1045    !.
 1046'$substitute'(_, _, Old, Old).
 1047
 1048subst_chars([]) -->
 1049    [].
 1050subst_chars([H|T]) -->
 1051    { atomic(H),
 1052      !,
 1053      atom_codes(H, Codes)
 1054    },
 1055    Codes,
 1056    subst_chars(T).
 1057subst_chars([H|T]) -->
 1058    H,
 1059    subst_chars(T).
 1060
 1061
 1062                /********************************
 1063                *           EXECUTION           *
 1064                ********************************/

$execute_query(Goal, Bindings, -Truth) is det: Execute Goal using Bindings.

 1070'$execute_query'(Var, _, true) :-
 1071    var(Var),
 1072    !,
 1073    print_message(informational, var_query(Var)).
 1074'$execute_query'(Goal, Bindings, Truth) :-
 1075    '$current_typein_module'(TypeIn),
 1076    '$dwim_correct_goal'(TypeIn:Goal, Bindings, Corrected),
 1077    !,
 1078    setup_call_cleanup(
 1079        '$set_source_module'(M0, TypeIn),
 1080        expand_goal(Corrected, Expanded),
 1081        '$set_source_module'(M0)),
 1082    print_message(silent, toplevel_goal(Expanded, Bindings)),
 1083    '$execute_goal2'(Expanded, Bindings, Truth).
 1084'$execute_query'(_, _, false) :-
 1085    notrace,
 1086    print_message(query, query(no)).
 1087
 1088'$execute_goal2'(Goal, Bindings, true) :-
 1089    restore_debug,
 1090    '$current_typein_module'(TypeIn),
 1091    residue_vars(TypeIn:Goal, Vars, TypeIn:Delays),
 1092    deterministic(Det),
 1093    (   save_debug
 1094    ;   restore_debug, fail
 1095    ),
 1096    flush_output(user_output),
 1097    call_expand_answer(Bindings, NewBindings),
 1098    (    \+ \+ write_bindings(NewBindings, Vars, Delays, Det)
 1099    ->   !
 1100    ).
 1101'$execute_goal2'(_, _, false) :-
 1102    save_debug,
 1103    print_message(query, query(no)).
 1104
 1105residue_vars(Goal, Vars, Delays) :-
 1106    current_prolog_flag(toplevel_residue_vars, true),
 1107    !,
 1108    '$wfs_call'(call_residue_vars(stop_backtrace(Goal), Vars), Delays).
 1109residue_vars(Goal, [], Delays) :-
 1110    '$wfs_call'(stop_backtrace(Goal), Delays).
 1111
 1112stop_backtrace(Goal) :-
 1113    toplevel_call(Goal),
 1114    no_lco.
 1115
 1116toplevel_call(Goal) :-
 1117    call(Goal),
 1118    no_lco.
 1119
 1120no_lco.

Write bindings resulting from a query. The flag prompt_alternatives_on determines whether the user is prompted for alternatives. groundness gives the classical behaviour, determinism is considered more adequate and informative.

Succeeds if the user accepts the answer and fails otherwise.

Arguments:

ResidueVars - are the residual constraints and provided if the prolog flag toplevel_residue_vars is set to project.

 1136write_bindings(Bindings, ResidueVars, Delays, Det) :-
 1137    '$current_typein_module'(TypeIn),
 1138    translate_bindings(Bindings, Bindings1, ResidueVars, TypeIn:Residuals),
 1139    omit_qualifier(Delays, TypeIn, Delays1),
 1140    name_vars(Bindings1, Residuals, Delays1),
 1141    write_bindings2(Bindings1, Residuals, Delays1, Det).
 1142
 1143write_bindings2([], Residuals, Delays, _) :-
 1144    current_prolog_flag(prompt_alternatives_on, groundness),
 1145    !,
 1146    print_message(query, query(yes(Delays, Residuals))).
 1147write_bindings2(Bindings, Residuals, Delays, true) :-
 1148    current_prolog_flag(prompt_alternatives_on, determinism),
 1149    !,
 1150    print_message(query, query(yes(Bindings, Delays, Residuals))).
 1151write_bindings2(Bindings, Residuals, Delays, _Det) :-
 1152    repeat,
 1153        print_message(query, query(more(Bindings, Delays, Residuals))),
 1154        get_respons(Action),
 1155    (   Action == redo
 1156    ->  !, fail
 1157    ;   Action == show_again
 1158    ->  fail
 1159    ;   !,
 1160        print_message(query, query(done))
 1161    ).
 1162
 1163name_vars(Bindings, Residuals, Delays) :-
 1164    current_prolog_flag(toplevel_name_variables, true),
 1165    !,
 1166    '$term_multitons'(t(Bindings,Residuals,Delays), Vars),
 1167    name_vars_(Vars, Bindings, 0),
 1168    term_variables(t(Bindings,Residuals,Delays), SVars),
 1169    anon_vars(SVars).
 1170name_vars(_Bindings, _Residuals, _Delays).
 1171
 1172name_vars_([], _, _).
 1173name_vars_([H|T], Bindings, N) :-
 1174    name_var(Bindings, Name, N, N1),
 1175    H = '$VAR'(Name),
 1176    name_vars_(T, Bindings, N1).
 1177
 1178anon_vars([]).
 1179anon_vars(['$VAR'('_')|T]) :-
 1180    anon_vars(T).
 1181
 1182name_var(Bindings, Name, N0, N) :-
 1183    between(N0, infinite, N1),
 1184    I is N1//26,
 1185    J is 0'A + N1 mod 26,
 1186    (   I == 0
 1187    ->  format(atom(Name), '_~c', [J])
 1188    ;   format(atom(Name), '_~c~d', [J, I])
 1189    ),
 1190    (   current_prolog_flag(toplevel_print_anon, false)
 1191    ->  true
 1192    ;   \+ is_bound(Bindings, Name)
 1193    ),
 1194    !,
 1195    N is N1+1.
 1196
 1197is_bound([Vars=_|T], Name) :-
 1198    (   in_vars(Vars, Name)
 1199    ->  true
 1200    ;   is_bound(T, Name)
 1201    ).
 1202
 1203in_vars(Name, Name) :- !.
 1204in_vars(Names, Name) :-
 1205    '$member'(Name, Names).

residual_goals(:NonTerminal): Directive that registers NonTerminal as a collector for residual goals.

 1212:- multifile
 1213    residual_goal_collector/1. 1214
 1215:- meta_predicate
 1216    residual_goals(2). 1217
 1218residual_goals(NonTerminal) :-
 1219    throw(error(context_error(nodirective, residual_goals(NonTerminal)), _)).
 1220
 1221system:term_expansion((:- residual_goals(NonTerminal)),
 1222                      '$toplevel':residual_goal_collector(M2:Head)) :-
 1223    \+ current_prolog_flag(xref, true),
 1224    prolog_load_context(module, M),
 1225    strip_module(M:NonTerminal, M2, Head),
 1226    '$must_be'(callable, Head).

prolog:residual_goals// is det: DCG that collects residual goals that are not associated with the answer through attributed variables.

 1233:- public prolog:residual_goals//0. 1234
 1235prolog:residual_goals -->
 1236    { findall(NT, residual_goal_collector(NT), NTL) },
 1237    collect_residual_goals(NTL).
 1238
 1239collect_residual_goals([]) --> [].
 1240collect_residual_goals([H|T]) -->
 1241    ( call(H) -> [] ; [] ),
 1242    collect_residual_goals(T).

prolog:translate_bindings(+Bindings0, -Bindings, +ResidueVars, +ResidualGoals, -Residuals) is det

Translate the raw variable bindings resulting from successfully completing a query into a binding list and list of residual goals suitable for human consumption.

Arguments:

Bindings - is a list of binding(Vars,Value,Substitutions), where Vars is a list of variable names. E.g. binding(['A','B'],42,[])` means that both the variable A and B have the value 42. Values may contain terms '$VAR'(Name) to indicate sharing with a given variable. Value is always an acyclic term. If cycles appear in the answer, Substitutions contains a list of substitutions that restore the original term.

Residuals - is a pair of two lists representing residual goals. The first element of the pair are residuals related to the query variables and the second are related that are disconnected from the query.

 1267:- public
 1268    prolog:translate_bindings/5. 1269:- meta_predicate
 1270    prolog:translate_bindings(+, -, +, +, :). 1271
 1272prolog:translate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals) :-
 1273    translate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals).
 1274
 1275translate_bindings(Bindings0, Bindings, ResidueVars, Residuals) :-
 1276    prolog:residual_goals(ResidueGoals, []),
 1277    translate_bindings(Bindings0, Bindings, ResidueVars, ResidueGoals,
 1278                       Residuals).
 1279
 1280translate_bindings(Bindings0, Bindings, [], [], _:[]-[]) :-
 1281    term_attvars(Bindings0, []),
 1282    !,
 1283    join_same_bindings(Bindings0, Bindings1),
 1284    factorize_bindings(Bindings1, Bindings2),
 1285    bind_vars(Bindings2, Bindings3),
 1286    filter_bindings(Bindings3, Bindings).
 1287translate_bindings(Bindings0, Bindings, ResidueVars, ResGoals0,
 1288                   TypeIn:Residuals-HiddenResiduals) :-
 1289    project_constraints(Bindings0, ResidueVars),
 1290    hidden_residuals(ResidueVars, Bindings0, HiddenResiduals0),
 1291    omit_qualifiers(HiddenResiduals0, TypeIn, HiddenResiduals),
 1292    copy_term(Bindings0+ResGoals0, Bindings1+ResGoals1, Residuals0),
 1293    '$append'(ResGoals1, Residuals0, Residuals1),
 1294    omit_qualifiers(Residuals1, TypeIn, Residuals),
 1295    join_same_bindings(Bindings1, Bindings2),
 1296    factorize_bindings(Bindings2, Bindings3),
 1297    bind_vars(Bindings3, Bindings4),
 1298    filter_bindings(Bindings4, Bindings).
 1299
 1300hidden_residuals(ResidueVars, Bindings, Goal) :-
 1301    term_attvars(ResidueVars, Remaining),
 1302    term_attvars(Bindings, QueryVars),
 1303    subtract_vars(Remaining, QueryVars, HiddenVars),
 1304    copy_term(HiddenVars, _, Goal).
 1305
 1306subtract_vars(All, Subtract, Remaining) :-
 1307    sort(All, AllSorted),
 1308    sort(Subtract, SubtractSorted),
 1309    ord_subtract(AllSorted, SubtractSorted, Remaining).
 1310
 1311ord_subtract([], _Not, []).
 1312ord_subtract([H1|T1], L2, Diff) :-
 1313    diff21(L2, H1, T1, Diff).
 1314
 1315diff21([], H1, T1, [H1|T1]).
 1316diff21([H2|T2], H1, T1, Diff) :-
 1317    compare(Order, H1, H2),
 1318    diff3(Order, H1, T1, H2, T2, Diff).
 1319
 1320diff12([], _H2, _T2, []).
 1321diff12([H1|T1], H2, T2, Diff) :-
 1322    compare(Order, H1, H2),
 1323    diff3(Order, H1, T1, H2, T2, Diff).
 1324
 1325diff3(<,  H1, T1,  H2, T2, [H1|Diff]) :-
 1326    diff12(T1, H2, T2, Diff).
 1327diff3(=, _H1, T1, _H2, T2, Diff) :-
 1328    ord_subtract(T1, T2, Diff).
 1329diff3(>,  H1, T1, _H2, T2, Diff) :-
 1330    diff21(T2, H1, T1, Diff).

project_constraints(+Bindings, +ResidueVars) is det: Call <module>:project_attributes/2 if the Prolog flag toplevel_residue_vars is set to project.

 1338project_constraints(Bindings, ResidueVars) :-
 1339    !,
 1340    term_attvars(Bindings, AttVars),
 1341    phrase(attribute_modules(AttVars), Modules0),
 1342    sort(Modules0, Modules),
 1343    term_variables(Bindings, QueryVars),
 1344    project_attributes(Modules, QueryVars, ResidueVars).
 1345project_constraints(_, _).
 1346
 1347project_attributes([], _, _).
 1348project_attributes([M|T], QueryVars, ResidueVars) :-
 1349    (   current_predicate(M:project_attributes/2),
 1350        catch(M:project_attributes(QueryVars, ResidueVars), E,
 1351              print_message(error, E))
 1352    ->  true
 1353    ;   true
 1354    ),
 1355    project_attributes(T, QueryVars, ResidueVars).
 1356
 1357attribute_modules([]) --> [].
 1358attribute_modules([H|T]) -->
 1359    { get_attrs(H, Attrs) },
 1360    attrs_modules(Attrs),
 1361    attribute_modules(T).
 1362
 1363attrs_modules([]) --> [].
 1364attrs_modules(att(Module, _, More)) -->
 1365    [Module],
 1366    attrs_modules(More).

join_same_bindings(Bindings0, Bindings): Join variables that are bound to the same value. Note that we return the last value. This is because the factorization may be different and ultimately the names will be printed as V1 = V2, ... VN = Value. Using the last, Value has the factorization of VN.

 1377join_same_bindings([], []).
 1378join_same_bindings([Name=V0|T0], [[Name|Names]=V|T]) :-
 1379    take_same_bindings(T0, V0, V, Names, T1),
 1380    join_same_bindings(T1, T).
 1381
 1382take_same_bindings([], Val, Val, [], []).
 1383take_same_bindings([Name=V1|T0], V0, V, [Name|Names], T) :-
 1384    V0 == V1,
 1385    !,
 1386    take_same_bindings(T0, V1, V, Names, T).
 1387take_same_bindings([Pair|T0], V0, V, Names, [Pair|T]) :-
 1388    take_same_bindings(T0, V0, V, Names, T).

omit_qualifiers(+QGoals, +TypeIn, -Goals) is det: Omit unneeded module qualifiers from QGoals relative to the given module TypeIn.

 1397omit_qualifiers([], _, []).
 1398omit_qualifiers([Goal0|Goals0], TypeIn, [Goal|Goals]) :-
 1399    omit_qualifier(Goal0, TypeIn, Goal),
 1400    omit_qualifiers(Goals0, TypeIn, Goals).
 1401
 1402omit_qualifier(M:G0, TypeIn, G) :-
 1403    M == TypeIn,
 1404    !,
 1405    omit_meta_qualifiers(G0, TypeIn, G).
 1406omit_qualifier(M:G0, TypeIn, G) :-
 1407    predicate_property(TypeIn:G0, imported_from(M)),
 1408    \+ predicate_property(G0, transparent),
 1409    !,
 1410    G0 = G.
 1411omit_qualifier(_:G0, _, G) :-
 1412    predicate_property(G0, built_in),
 1413    \+ predicate_property(G0, transparent),
 1414    !,
 1415    G0 = G.
 1416omit_qualifier(M:G0, _, M:G) :-
 1417    atom(M),
 1418    !,
 1419    omit_meta_qualifiers(G0, M, G).
 1420omit_qualifier(G0, TypeIn, G) :-
 1421    omit_meta_qualifiers(G0, TypeIn, G).
 1422
 1423omit_meta_qualifiers(V, _, V) :-
 1424    var(V),
 1425    !.
 1426omit_meta_qualifiers((QA,QB), TypeIn, (A,B)) :-
 1427    !,
 1428    omit_qualifier(QA, TypeIn, A),
 1429    omit_qualifier(QB, TypeIn, B).
 1430omit_meta_qualifiers(tnot(QA), TypeIn, tnot(A)) :-
 1431    !,
 1432    omit_qualifier(QA, TypeIn, A).
 1433omit_meta_qualifiers(freeze(V, QGoal), TypeIn, freeze(V, Goal)) :-
 1434    callable(QGoal),
 1435    !,
 1436    omit_qualifier(QGoal, TypeIn, Goal).
 1437omit_meta_qualifiers(when(Cond, QGoal), TypeIn, when(Cond, Goal)) :-
 1438    callable(QGoal),
 1439    !,
 1440    omit_qualifier(QGoal, TypeIn, Goal).
 1441omit_meta_qualifiers(G, _, G).

bind_vars(+BindingsIn, -Bindings): Bind variables to '$VAR'(Name), so they are printed by the names used in the query. Note that by binding in the reverse order, variables bound to one another come out in the natural order.

 1450bind_vars(Bindings0, Bindings) :-
 1451    bind_query_vars(Bindings0, Bindings, SNames),
 1452    bind_skel_vars(Bindings, Bindings, SNames, 1, _).
 1453
 1454bind_query_vars([], [], []).
 1455bind_query_vars([binding(Names,Var,[Var2=Cycle])|T0],
 1456                [binding(Names,Cycle,[])|T], [Name|SNames]) :-
 1457    Var == Var2,                   % also implies var(Var)
 1458    !,
 1459    '$last'(Names, Name),
 1460    Var = '$VAR'(Name),
 1461    bind_query_vars(T0, T, SNames).
 1462bind_query_vars([B|T0], [B|T], AllNames) :-
 1463    B = binding(Names,Var,Skel),
 1464    bind_query_vars(T0, T, SNames),
 1465    (   var(Var), \+ attvar(Var), Skel == []
 1466    ->  AllNames = [Name|SNames],
 1467        '$last'(Names, Name),
 1468        Var = '$VAR'(Name)
 1469    ;   AllNames = SNames
 1470    ).
 1471
 1472
 1473
 1474bind_skel_vars([], _, _, N, N).
 1475bind_skel_vars([binding(_,_,Skel)|T], Bindings, SNames, N0, N) :-
 1476    bind_one_skel_vars(Skel, Bindings, SNames, N0, N1),
 1477    bind_skel_vars(T, Bindings, SNames, N1, N).

bind_one_skel_vars(+Subst, +Bindings, +VarName, +N0, -N)

Give names to the factorized variables that do not have a name yet. This introduces names _S<N>, avoiding duplicates. If a factorized variable shares with another binding, use the name of that variable.

To be done

- Consider the call below. We could remove either of the A = x(1). Which is best?

?- A = x(1), B = a(A,A).
A = x(1),
B = a(A, A), % where
    A = x(1).

 1496bind_one_skel_vars([], _, _, N, N).
 1497bind_one_skel_vars([Var=Value|T], Bindings, Names, N0, N) :-
 1498    (   var(Var)
 1499    ->  (   '$member'(binding(Names, VVal, []), Bindings),
 1500            same_term(Value, VVal)
 1501        ->  '$last'(Names, VName),
 1502            Var = '$VAR'(VName),
 1503            N2 = N0
 1504        ;   between(N0, infinite, N1),
 1505            atom_concat('_S', N1, Name),
 1506            \+ memberchk(Name, Names),
 1507            !,
 1508            Var = '$VAR'(Name),
 1509            N2 is N1 + 1
 1510        )
 1511    ;   N2 = N0
 1512    ),
 1513    bind_one_skel_vars(T, Bindings, Names, N2, N).

factorize_bindings(+Bindings0, -Factorized): Factorize cycles and sharing in the bindings.

 1520factorize_bindings([], []).
 1521factorize_bindings([Name=Value|T0], [binding(Name, Skel, Subst)|T]) :-
 1522    '$factorize_term'(Value, Skel, Subst0),
 1523    (   current_prolog_flag(toplevel_print_factorized, true)
 1524    ->  Subst = Subst0
 1525    ;   only_cycles(Subst0, Subst)
 1526    ),
 1527    factorize_bindings(T0, T).
 1528
 1529
 1530only_cycles([], []).
 1531only_cycles([B|T0], List) :-
 1532    (   B = (Var=Value),
 1533        Var = Value,
 1534        acyclic_term(Var)
 1535    ->  only_cycles(T0, List)
 1536    ;   List = [B|T],
 1537        only_cycles(T0, T)
 1538    ).

filter_bindings(+Bindings0, -Bindings): Remove bindings that must not be printed. There are two of them: Variables whose name start with '_' and variables that are only bound to themselves (or, unbound).

 1547filter_bindings([], []).
 1548filter_bindings([H0|T0], T) :-
 1549    hide_vars(H0, H),
 1550    (   (   arg(1, H, [])
 1551        ;   self_bounded(H)
 1552        )
 1553    ->  filter_bindings(T0, T)
 1554    ;   T = [H|T1],
 1555        filter_bindings(T0, T1)
 1556    ).
 1557
 1558hide_vars(binding(Names0, Skel, Subst), binding(Names, Skel, Subst)) :-
 1559    hide_names(Names0, Skel, Subst, Names).
 1560
 1561hide_names([], _, _, []).
 1562hide_names([Name|T0], Skel, Subst, T) :-
 1563    (   sub_atom(Name, 0, _, _, '_'),
 1564        current_prolog_flag(toplevel_print_anon, false),
 1565        sub_atom(Name, 1, 1, _, Next),
 1566        char_type(Next, prolog_var_start)
 1567    ->  true
 1568    ;   Subst == [],
 1569        Skel == '$VAR'(Name)
 1570    ),
 1571    !,
 1572    hide_names(T0, Skel, Subst, T).
 1573hide_names([Name|T0], Skel, Subst, [Name|T]) :-
 1574    hide_names(T0, Skel, Subst, T).
 1575
 1576self_bounded(binding([Name], Value, [])) :-
 1577    Value == '$VAR'(Name).

get_respons(-Action): Read the continuation entered by the user.

 1583get_respons(Action) :-
 1584    repeat,
 1585        flush_output(user_output),
 1586        get_single_char(Char),
 1587        answer_respons(Char, Action),
 1588        (   Action == again
 1589        ->  print_message(query, query(action)),
 1590            fail
 1591        ;   !
 1592        ).
 1593
 1594answer_respons(Char, again) :-
 1595    '$in_reply'(Char, '?h'),
 1596    !,
 1597    print_message(help, query(help)).
 1598answer_respons(Char, redo) :-
 1599    '$in_reply'(Char, ';nrNR \t'),
 1600    !,
 1601    print_message(query, if_tty([ansi(bold, ';', [])])).
 1602answer_respons(Char, redo) :-
 1603    '$in_reply'(Char, 'tT'),
 1604    !,
 1605    trace,
 1606    save_debug,
 1607    print_message(query, if_tty([ansi(bold, '; [trace]', [])])).
 1608answer_respons(Char, continue) :-
 1609    '$in_reply'(Char, 'ca\n\ryY.'),
 1610    !,
 1611    print_message(query, if_tty([ansi(bold, '.', [])])).
 1612answer_respons(0'b, show_again) :-
 1613    !,
 1614    break.
 1615answer_respons(Char, show_again) :-
 1616    print_predicate(Char, Pred, Options),
 1617    !,
 1618    print_message(query, if_tty(['~w'-[Pred]])),
 1619    set_prolog_flag(answer_write_options, Options).
 1620answer_respons(-1, show_again) :-
 1621    !,
 1622    print_message(query, halt('EOF')),
 1623    halt(0).
 1624answer_respons(Char, again) :-
 1625    print_message(query, no_action(Char)).
 1626
 1627print_predicate(0'w, [write], [ quoted(true),
 1628                                spacing(next_argument)
 1629                              ]).
 1630print_predicate(0'p, [print], [ quoted(true),
 1631                                portray(true),
 1632                                max_depth(10),
 1633                                spacing(next_argument)
 1634                              ]).
 1635
 1636
 1637                 /*******************************
 1638                 *          EXPANSION           *
 1639                 *******************************/
 1640
 1641:- user:dynamic(expand_query/4). 1642:- user:multifile(expand_query/4). 1643
 1644call_expand_query(Goal, Expanded, Bindings, ExpandedBindings) :-
 1645    user:expand_query(Goal, Expanded, Bindings, ExpandedBindings),
 1646    !.
 1647call_expand_query(Goal, Expanded, Bindings, ExpandedBindings) :-
 1648    toplevel_variables:expand_query(Goal, Expanded, Bindings, ExpandedBindings),
 1649    !.
 1650call_expand_query(Goal, Goal, Bindings, Bindings).
 1651
 1652
 1653:- user:dynamic(expand_answer/2). 1654:- user:multifile(expand_answer/2). 1655
 1656call_expand_answer(Goal, Expanded) :-
 1657    user:expand_answer(Goal, Expanded),
 1658    !.
 1659call_expand_answer(Goal, Expanded) :-
 1660    toplevel_variables:expand_answer(Goal, Expanded),
 1661    !.
 1662call_expand_answer(Goal, Goal)