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    prolog_load_context(module, M),
 1224    strip_module(M:NonTerminal, M2, Head),
 1225    '$must_be'(callable, Head).

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

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

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

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

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

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

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

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

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

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

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).

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

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

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