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-2020, University of Amsterdam
    7                              VU University Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module('$toplevel',
   37          [ '$initialise'/0,            % start Prolog
   38            '$toplevel'/0,              % Prolog top-level (re-entrant)
   39            '$compile'/0,               % `-c' toplevel
   40            '$config'/0,                % --dump-runtime-variables toplevel
   41            initialize/0,               % Run program initialization
   42            version/0,                  % Write initial banner
   43            version/1,                  % Add message to the banner
   44            prolog/0,                   % user toplevel predicate
   45            '$query_loop'/0,            % toplevel predicate
   46            '$execute_query'/3,         % +Query, +Bindings, -Truth
   47            residual_goals/1,           % +Callable
   48            (initialization)/1,         % initialization goal (directive)
   49            '$thread_init'/0,           % initialise thread
   50            (thread_initialization)/1   % thread initialization goal
   51            ]).   52
   53
   54                 /*******************************
   55                 *         VERSION BANNER       *
   56                 *******************************/
   57
   58:- dynamic
   59    prolog:version_msg/1.
 version is det
Print the Prolog banner message and messages registered using version/1.
   66version :-
   67    print_message(banner, welcome).
 version(+Message) is det
Add message to version/0
   73:- multifile
   74    system:term_expansion/2.   75
   76system:term_expansion((:- version(Message)),
   77                      prolog:version_msg(Message)).
   78
   79version(Message) :-
   80    (   prolog:version_msg(Message)
   81    ->  true
   82    ;   assertz(prolog:version_msg(Message))
   83    ).
   84
   85
   86                /********************************
   87                *         INITIALISATION        *
   88                *********************************/
   89
   90%       note: loaded_init_file/2 is used by prolog_load_context/2 to
   91%       confirm we are loading a script.
   92
   93:- dynamic
   94    loaded_init_file/2.             % already loaded init files
   95
   96'$load_init_file'(none) :- !.
   97'$load_init_file'(Base) :-
   98    loaded_init_file(Base, _),
   99    !.
  100'$load_init_file'(InitFile) :-
  101    exists_file(InitFile),
  102    !,
  103    ensure_loaded(user:InitFile).
  104'$load_init_file'(Base) :-
  105    absolute_file_name(user_app_config(Base), InitFile,
  106                       [ access(read),
  107                         file_errors(fail)
  108                       ]),
  109    asserta(loaded_init_file(Base, InitFile)),
  110    load_files(user:InitFile,
  111               [ scope_settings(false)
  112               ]).
  113'$load_init_file'('init.pl') :-
  114    (   current_prolog_flag(windows, true),
  115        absolute_file_name(user_profile('swipl.ini'), InitFile,
  116                           [ access(read),
  117                             file_errors(fail)
  118                           ])
  119    ;   expand_file_name('~/.swiplrc', [InitFile]),
  120        exists_file(InitFile)
  121    ),
  122    !,
  123    print_message(warning, backcomp(init_file_moved(InitFile))).
  124'$load_init_file'(_).
  125
  126'$load_system_init_file' :-
  127    loaded_init_file(system, _),
  128    !.
  129'$load_system_init_file' :-
  130    '$cmd_option_val'(system_init_file, Base),
  131    Base \== none,
  132    current_prolog_flag(home, Home),
  133    file_name_extension(Base, rc, Name),
  134    atomic_list_concat([Home, '/', Name], File),
  135    absolute_file_name(File, Path,
  136                       [ file_type(prolog),
  137                         access(read),
  138                         file_errors(fail)
  139                       ]),
  140    asserta(loaded_init_file(system, Path)),
  141    load_files(user:Path,
  142               [ silent(true),
  143                 scope_settings(false)
  144               ]),
  145    !.
  146'$load_system_init_file'.
  147
  148'$load_script_file' :-
  149    loaded_init_file(script, _),
  150    !.
  151'$load_script_file' :-
  152    '$cmd_option_val'(script_file, OsFiles),
  153    load_script_files(OsFiles).
  154
  155load_script_files([]).
  156load_script_files([OsFile|More]) :-
  157    prolog_to_os_filename(File, OsFile),
  158    (   absolute_file_name(File, Path,
  159                           [ file_type(prolog),
  160                             access(read),
  161                             file_errors(fail)
  162                           ])
  163    ->  asserta(loaded_init_file(script, Path)),
  164        load_files(user:Path, []),
  165        load_files(More)
  166    ;   throw(error(existence_error(script_file, File), _))
  167    ).
  168
  169
  170                 /*******************************
  171                 *       AT_INITIALISATION      *
  172                 *******************************/
  173
  174:- meta_predicate
  175    initialization(0).  176
  177:- '$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
  186initialization(Goal) :-
  187    Goal = _:G,
  188    prolog:initialize_now(G, Use),
  189    !,
  190    print_message(warning, initialize_now(G, Use)),
  191    initialization(Goal, now).
  192initialization(Goal) :-
  193    initialization(Goal, after_load).
  194
  195:- multifile
  196    prolog:initialize_now/2,
  197    prolog:message//1.  198
  199prolog:initialize_now(load_foreign_library(_),
  200                      'use :- use_foreign_library/1 instead').
  201prolog:initialize_now(load_foreign_library(_,_),
  202                      'use :- use_foreign_library/2 instead').
  203
  204prolog:message(initialize_now(Goal, Use)) -->
  205    [ 'Initialization goal ~p will be executed'-[Goal],nl,
  206      'immediately for backward compatibility reasons', nl,
  207      '~w'-[Use]
  208    ].
  209
  210'$run_initialization' :-
  211    '$run_initialization'(_, []),
  212    '$thread_init'.
 initialize
Run goals registered with :- initialization(Goal, program).. Stop with an exception if a goal fails or raises an exception.
  219initialize :-
  220    forall('$init_goal'(when(program), Goal, Ctx),
  221           run_initialize(Goal, Ctx)).
  222
  223run_initialize(Goal, Ctx) :-
  224    (   catch(Goal, E, true),
  225        (   var(E)
  226        ->  true
  227        ;   throw(error(initialization_error(E, Goal, Ctx), _))
  228        )
  229    ;   throw(error(initialization_error(failed, Goal, Ctx), _))
  230    ).
  231
  232
  233                 /*******************************
  234                 *     THREAD INITIALIZATION    *
  235                 *******************************/
  236
  237:- meta_predicate
  238    thread_initialization(0).  239:- dynamic
  240    '$at_thread_initialization'/1.
 thread_initialization :Goal
Run Goal now and everytime a new thread is created.
  246thread_initialization(Goal) :-
  247    assert('$at_thread_initialization'(Goal)),
  248    call(Goal),
  249    !.
  250
  251'$thread_init' :-
  252    (   '$at_thread_initialization'(Goal),
  253        (   call(Goal)
  254        ->  fail
  255        ;   fail
  256        )
  257    ;   true
  258    ).
  259
  260
  261                 /*******************************
  262                 *     FILE SEARCH PATH (-p)    *
  263                 *******************************/
 $set_file_search_paths is det
Process -p PathSpec options.
  269'$set_file_search_paths' :-
  270    '$cmd_option_val'(search_paths, Paths),
  271    (   '$member'(Path, Paths),
  272        atom_chars(Path, Chars),
  273        (   phrase('$search_path'(Name, Aliases), Chars)
  274        ->  '$reverse'(Aliases, Aliases1),
  275            forall('$member'(Alias, Aliases1),
  276                   asserta(user:file_search_path(Name, Alias)))
  277        ;   print_message(error, commandline_arg_type(p, Path))
  278        ),
  279        fail ; true
  280    ).
  281
  282'$search_path'(Name, Aliases) -->
  283    '$string'(NameChars),
  284    [=],
  285    !,
  286    {atom_chars(Name, NameChars)},
  287    '$search_aliases'(Aliases).
  288
  289'$search_aliases'([Alias|More]) -->
  290    '$string'(AliasChars),
  291    path_sep,
  292    !,
  293    { '$make_alias'(AliasChars, Alias) },
  294    '$search_aliases'(More).
  295'$search_aliases'([Alias]) -->
  296    '$string'(AliasChars),
  297    '$eos',
  298    !,
  299    { '$make_alias'(AliasChars, Alias) }.
  300
  301path_sep -->
  302    { current_prolog_flag(windows, true)
  303    },
  304    !,
  305    [;].
  306path_sep -->
  307    [:].
  308
  309'$string'([]) --> [].
  310'$string'([H|T]) --> [H], '$string'(T).
  311
  312'$eos'([], []).
  313
  314'$make_alias'(Chars, Alias) :-
  315    catch(term_to_atom(Alias, Chars), _, fail),
  316    (   atom(Alias)
  317    ;   functor(Alias, F, 1),
  318        F \== /
  319    ),
  320    !.
  321'$make_alias'(Chars, Alias) :-
  322    atom_chars(Alias, Chars).
  323
  324
  325                 /*******************************
  326                 *   LOADING ASSIOCIATED FILES  *
  327                 *******************************/
 argv_files(-Files) is det
Update the Prolog flag argv, extracting the leading script files.
  333argv_files(Files) :-
  334    current_prolog_flag(argv, Argv),
  335    no_option_files(Argv, Argv1, Files, ScriptArgs),
  336    (   (   ScriptArgs == true
  337        ;   Argv1 == []
  338        )
  339    ->  (   Argv1 \== Argv
  340        ->  set_prolog_flag(argv, Argv1)
  341        ;   true
  342        )
  343    ;   '$usage',
  344        halt(1)
  345    ).
  346
  347no_option_files([--|Argv], Argv, [], true) :- !.
  348no_option_files([Opt|_], _, _, ScriptArgs) :-
  349    ScriptArgs \== true,
  350    sub_atom(Opt, 0, _, _, '-'),
  351    !,
  352    '$usage',
  353    halt(1).
  354no_option_files([OsFile|Argv0], Argv, [File|T], ScriptArgs) :-
  355    file_name_extension(_, Ext, OsFile),
  356    user:prolog_file_type(Ext, prolog),
  357    !,
  358    ScriptArgs = true,
  359    prolog_to_os_filename(File, OsFile),
  360    no_option_files(Argv0, Argv, T, ScriptArgs).
  361no_option_files([OsScript|Argv], Argv, [Script], ScriptArgs) :-
  362    ScriptArgs \== true,
  363    !,
  364    prolog_to_os_filename(Script, OsScript),
  365    (   exists_file(Script)
  366    ->  true
  367    ;   '$existence_error'(file, Script)
  368    ),
  369    ScriptArgs = true.
  370no_option_files(Argv, Argv, [], _).
  371
  372clean_argv :-
  373    (   current_prolog_flag(argv, [--|Argv])
  374    ->  set_prolog_flag(argv, Argv)
  375    ;   true
  376    ).
 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.
  385associated_files([]) :-
  386    current_prolog_flag(saved_program_class, runtime),
  387    !,
  388    clean_argv.
  389associated_files(Files) :-
  390    '$set_prolog_file_extension',
  391    argv_files(Files),
  392    (   Files = [File|_]
  393    ->  absolute_file_name(File, AbsFile),
  394        set_prolog_flag(associated_file, AbsFile),
  395        set_working_directory(File),
  396        set_window_title(Files)
  397    ;   true
  398    ).
 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].
  408set_working_directory(File) :-
  409    current_prolog_flag(console_menu, true),
  410    access_file(File, read),
  411    !,
  412    file_directory_name(File, Dir),
  413    working_directory(_, Dir).
  414set_working_directory(_).
  415
  416set_window_title([File|More]) :-
  417    current_predicate(system:window_title/2),
  418    !,
  419    (   More == []
  420    ->  Extra = []
  421    ;   Extra = ['...']
  422    ),
  423    atomic_list_concat(['SWI-Prolog --', File | Extra], ' ', Title),
  424    system:window_title(_, Title).
  425set_window_title(_).
 start_pldoc
If the option --pldoc[=port] is given, load the PlDoc system.
  433start_pldoc :-
  434    '$cmd_option_val'(pldoc_server, Server),
  435    (   Server == ''
  436    ->  call((doc_server(_), doc_browser))
  437    ;   catch(atom_number(Server, Port), _, fail)
  438    ->  call(doc_server(Port))
  439    ;   print_message(error, option_usage(pldoc)),
  440        halt(1)
  441    ).
  442start_pldoc.
 load_associated_files(+Files)
Load Prolog files specified from the commandline.
  449load_associated_files(Files) :-
  450    (   '$member'(File, Files),
  451        load_files(user:File, [expand(false)]),
  452        fail
  453    ;   true
  454    ).
  455
  456hkey('HKEY_CURRENT_USER/Software/SWI/Prolog').
  457hkey('HKEY_LOCAL_MACHINE/Software/SWI/Prolog').
  458
  459'$set_prolog_file_extension' :-
  460    current_prolog_flag(windows, true),
  461    hkey(Key),
  462    catch(win_registry_get_value(Key, fileExtension, Ext0),
  463          _, fail),
  464    !,
  465    (   atom_concat('.', Ext, Ext0)
  466    ->  true
  467    ;   Ext = Ext0
  468    ),
  469    (   user:prolog_file_type(Ext, prolog)
  470    ->  true
  471    ;   asserta(user:prolog_file_type(Ext, prolog))
  472    ).
  473'$set_prolog_file_extension'.
  474
  475
  476                /********************************
  477                *        TOPLEVEL GOALS         *
  478                *********************************/
 $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.
  486'$initialise' :-
  487    catch(initialise_prolog, E, initialise_error(E)).
  488
  489initialise_error('$aborted') :- !.
  490initialise_error(E) :-
  491    print_message(error, initialization_exception(E)),
  492    fail.
  493
  494initialise_prolog :-
  495    '$clean_history',
  496    '$run_initialization',
  497    '$load_system_init_file',
  498    set_toplevel,
  499    '$set_file_search_paths',
  500    init_debug_flags,
  501    start_pldoc,
  502    opt_attach_packs,
  503    '$cmd_option_val'(init_file, OsFile),
  504    prolog_to_os_filename(File, OsFile),
  505    '$load_init_file'(File),
  506    catch(setup_colors, E, print_message(warning, E)),
  507    '$load_script_file',
  508    associated_files(Files),
  509    load_associated_files(Files),
  510    '$cmd_option_val'(goals, Goals),
  511    (   Goals == [],
  512        \+ '$init_goal'(when(_), _, _)
  513    ->  version                                 % default interactive run
  514    ;   run_init_goals(Goals),
  515        (   load_only
  516        ->  version
  517        ;   run_program_init,
  518            run_main_init
  519        )
  520    ).
  521
  522opt_attach_packs :-
  523    current_prolog_flag(packs, true),
  524    !,
  525    attach_packs.
  526opt_attach_packs.
  527
  528set_toplevel :-
  529    '$cmd_option_val'(toplevel, TopLevelAtom),
  530    catch(term_to_atom(TopLevel, TopLevelAtom), E,
  531          (print_message(error, E),
  532           halt(1))),
  533    create_prolog_flag(toplevel_goal, TopLevel, [type(term)]).
  534
  535load_only :-
  536    current_prolog_flag(os_argv, OSArgv),
  537    memberchk('-l', OSArgv),
  538    current_prolog_flag(argv, Argv),
  539    \+ memberchk('-l', Argv).
 run_init_goals(+Goals) is det
Run registered initialization goals on order. If a goal fails, execution is halted.
  546run_init_goals([]).
  547run_init_goals([H|T]) :-
  548    run_init_goal(H),
  549    run_init_goals(T).
  550
  551run_init_goal(Text) :-
  552    catch(term_to_atom(Goal, Text), E,
  553          (   print_message(error, init_goal_syntax(E, Text)),
  554              halt(2)
  555          )),
  556    run_init_goal(Goal, Text).
 run_program_init is det
Run goals registered using
  562run_program_init :-
  563    forall('$init_goal'(when(program), Goal, Ctx),
  564           run_init_goal(Goal, @(Goal,Ctx))).
  565
  566run_main_init :-
  567    findall(Goal-Ctx, '$init_goal'(when(main), Goal, Ctx), Pairs),
  568    '$last'(Pairs, Goal-Ctx),
  569    !,
  570    (   current_prolog_flag(toplevel_goal, default)
  571    ->  set_prolog_flag(toplevel_goal, halt)
  572    ;   true
  573    ),
  574    run_init_goal(Goal, @(Goal,Ctx)).
  575run_main_init.
  576
  577run_init_goal(Goal, Ctx) :-
  578    (   catch_with_backtrace(user:Goal, E, true)
  579    ->  (   var(E)
  580        ->  true
  581        ;   print_message(error, init_goal_failed(E, Ctx)),
  582            halt(2)
  583        )
  584    ;   (   current_prolog_flag(verbose, silent)
  585        ->  Level = silent
  586        ;   Level = error
  587        ),
  588        print_message(Level, init_goal_failed(failed, Ctx)),
  589        halt(1)
  590    ).
 init_debug_flags is det
Initialize the various Prolog flags that control the debugger and toplevel.
  597init_debug_flags :-
  598    once(print_predicate(_, [print], PrintOptions)),
  599    Keep = [keep(true)],
  600    create_prolog_flag(answer_write_options, PrintOptions, Keep),
  601    create_prolog_flag(prompt_alternatives_on, determinism, Keep),
  602    create_prolog_flag(toplevel_extra_white_line, true, Keep),
  603    create_prolog_flag(toplevel_print_factorized, false, Keep),
  604    create_prolog_flag(print_write_options,
  605                       [ portray(true), quoted(true), numbervars(true) ],
  606                       Keep),
  607    create_prolog_flag(toplevel_residue_vars, false, Keep),
  608    create_prolog_flag(toplevel_list_wfs_residual_program, true, Keep),
  609    '$set_debugger_write_options'(print).
 setup_backtrace
Initialise printing a backtrace.
  615setup_backtrace :-
  616    (   \+ current_prolog_flag(backtrace, false),
  617        load_setup_file(library(prolog_stack))
  618    ->  true
  619    ;   true
  620    ).
 setup_colors is det
Setup interactive usage by enabling colored output.
  626setup_colors :-
  627    (   \+ current_prolog_flag(color_term, false),
  628        stream_property(user_input, tty(true)),
  629        stream_property(user_error, tty(true)),
  630        stream_property(user_output, tty(true)),
  631        \+ getenv('TERM', dumb),
  632        load_setup_file(user:library(ansi_term))
  633    ->  true
  634    ;   true
  635    ).
 setup_history
Enable per-directory persistent history.
  641setup_history :-
  642    (   \+ current_prolog_flag(save_history, false),
  643        stream_property(user_input, tty(true)),
  644        \+ current_prolog_flag(readline, false),
  645        load_setup_file(library(prolog_history))
  646    ->  prolog_history(enable)
  647    ;   true
  648    ),
  649    set_default_history,
  650    '$load_history'.
 setup_readline
Setup line editing.
  656setup_readline :-
  657    (   current_prolog_flag(readline, swipl_win)
  658    ->  true
  659    ;   stream_property(user_input, tty(true)),
  660        current_prolog_flag(tty_control, true),
  661        \+ getenv('TERM', dumb),
  662        (   current_prolog_flag(readline, ReadLine)
  663        ->  true
  664        ;   ReadLine = true
  665        ),
  666        readline_library(ReadLine, Library),
  667        load_setup_file(library(Library))
  668    ->  set_prolog_flag(readline, Library)
  669    ;   set_prolog_flag(readline, false)
  670    ).
  671
  672readline_library(true, Library) :-
  673    !,
  674    preferred_readline(Library).
  675readline_library(false, _) :-
  676    !,
  677    fail.
  678readline_library(Library, Library).
  679
  680preferred_readline(editline).
  681preferred_readline(readline).
 load_setup_file(+File) is semidet
Load a file and fail silently if the file does not exist.
  687load_setup_file(File) :-
  688    catch(load_files(File,
  689                     [ silent(true),
  690                       if(not_loaded)
  691                     ]), _, fail).
  692
  693
  694:- '$hide'('$toplevel'/0).              % avoid in the GUI stacktrace
 $toplevel
Called from PL_toplevel()
  700'$toplevel' :-
  701    '$runtoplevel',
  702    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
  712'$runtoplevel' :-
  713    current_prolog_flag(toplevel_goal, TopLevel0),
  714    toplevel_goal(TopLevel0, TopLevel),
  715    user:TopLevel.
  716
  717:- dynamic  setup_done/0.  718:- volatile setup_done/0.  719
  720toplevel_goal(default, '$query_loop') :-
  721    !,
  722    setup_interactive.
  723toplevel_goal(prolog, '$query_loop') :-
  724    !,
  725    setup_interactive.
  726toplevel_goal(Goal, Goal).
  727
  728setup_interactive :-
  729    setup_done,
  730    !.
  731setup_interactive :-
  732    asserta(setup_done),
  733    catch(setup_backtrace, E, print_message(warning, E)),
  734    catch(setup_readline,  E, print_message(warning, E)),
  735    catch(setup_history,   E, print_message(warning, E)).
 $compile
Toplevel called when invoked with -c option.
  741'$compile' :-
  742    (   catch('$compile_', E, (print_message(error, E), halt(1)))
  743    ->  true
  744    ;   print_message(error, error(goal_failed('$compile'), _)),
  745        halt(1)
  746    ),
  747    halt.                               % set exit code
  748
  749'$compile_' :-
  750    '$load_system_init_file',
  751    catch(setup_colors, _, true),
  752    '$set_file_search_paths',
  753    init_debug_flags,
  754    '$run_initialization',
  755    opt_attach_packs,
  756    use_module(library(qsave)),
  757    qsave:qsave_toplevel.
 $config
Toplevel when invoked with --dump-runtime-variables
  763'$config' :-
  764    '$load_system_init_file',
  765    '$set_file_search_paths',
  766    init_debug_flags,
  767    '$run_initialization',
  768    load_files(library(prolog_config)),
  769    (   catch(prolog_dump_runtime_variables, E,
  770              (print_message(error, E), halt(1)))
  771    ->  true
  772    ;   print_message(error, error(goal_failed(prolog_dump_runtime_variables),_))
  773    ).
  774
  775
  776                /********************************
  777                *    USER INTERACTIVE LOOP      *
  778                *********************************/
 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.
  786prolog :-
  787    break.
  788
  789:- 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).
  798'$query_loop' :-
  799    current_prolog_flag(toplevel_mode, recursive),
  800    !,
  801    break_level(Level),
  802    read_expanded_query(Level, Query, Bindings),
  803    (   Query == end_of_file
  804    ->  print_message(query, query(eof))
  805    ;   '$call_no_catch'('$execute_query'(Query, Bindings, _)),
  806        (   current_prolog_flag(toplevel_mode, recursive)
  807        ->  '$query_loop'
  808        ;   '$switch_toplevel_mode'(backtracking),
  809            '$query_loop'           % Maybe throw('$switch_toplevel_mode')?
  810        )
  811    ).
  812'$query_loop' :-
  813    break_level(BreakLev),
  814    repeat,
  815        read_expanded_query(BreakLev, Query, Bindings),
  816        (   Query == end_of_file
  817        ->  !, print_message(query, query(eof))
  818        ;   '$execute_query'(Query, Bindings, _),
  819            (   current_prolog_flag(toplevel_mode, recursive)
  820            ->  !,
  821                '$switch_toplevel_mode'(recursive),
  822                '$query_loop'
  823            ;   fail
  824            )
  825        ).
  826
  827break_level(BreakLev) :-
  828    (   current_prolog_flag(break_level, BreakLev)
  829    ->  true
  830    ;   BreakLev = -1
  831    ).
  832
  833read_expanded_query(BreakLev, ExpandedQuery, ExpandedBindings) :-
  834    '$current_typein_module'(TypeIn),
  835    (   stream_property(user_input, tty(true))
  836    ->  '$system_prompt'(TypeIn, BreakLev, Prompt),
  837        prompt(Old, '|    ')
  838    ;   Prompt = '',
  839        prompt(Old, '')
  840    ),
  841    trim_stacks,
  842    repeat,
  843      read_query(Prompt, Query, Bindings),
  844      prompt(_, Old),
  845      catch(call_expand_query(Query, ExpandedQuery,
  846                              Bindings, ExpandedBindings),
  847            Error,
  848            (print_message(error, Error), fail)),
  849    !.
 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.
  858read_query(Prompt, Goal, Bindings) :-
  859    current_prolog_flag(history, N),
  860    integer(N), N > 0,
  861    !,
  862    read_term_with_history(
  863        Goal,
  864        [ show(h),
  865          help('!h'),
  866          no_save([trace, end_of_file]),
  867          prompt(Prompt),
  868          variable_names(Bindings)
  869        ]).
  870read_query(Prompt, Goal, Bindings) :-
  871    remove_history_prompt(Prompt, Prompt1),
  872    repeat,                                 % over syntax errors
  873    prompt1(Prompt1),
  874    read_query_line(user_input, Line),
  875    '$save_history_line'(Line),             % save raw line (edit syntax errors)
  876    '$current_typein_module'(TypeIn),
  877    catch(read_term_from_atom(Line, Goal,
  878                              [ variable_names(Bindings),
  879                                module(TypeIn)
  880                              ]), E,
  881          (   print_message(error, E),
  882              fail
  883          )),
  884    !,
  885    '$save_history_event'(Line).            % save event (no syntax errors)
 read_query_line(+Input, -Line) is det
  889read_query_line(Input, Line) :-
  890    catch(read_term_as_atom(Input, Line), Error, true),
  891    save_debug_after_read,
  892    (   var(Error)
  893    ->  true
  894    ;   Error = error(syntax_error(_),_)
  895    ->  print_message(error, Error),
  896        fail
  897    ;   print_message(error, Error),
  898        throw(Error)
  899    ).
 read_term_as_atom(+Input, -Line)
Read the next term as an atom and skip to the newline or a non-space character.
  906read_term_as_atom(In, Line) :-
  907    '$raw_read'(In, Line),
  908    (   Line == end_of_file
  909    ->  true
  910    ;   skip_to_nl(In)
  911    ).
 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.
  918skip_to_nl(In) :-
  919    repeat,
  920    peek_char(In, C),
  921    (   C == '%'
  922    ->  skip(In, '\n')
  923    ;   char_type(C, space)
  924    ->  get_char(In, _),
  925        C == '\n'
  926    ;   true
  927    ),
  928    !.
  929
  930remove_history_prompt('', '') :- !.
  931remove_history_prompt(Prompt0, Prompt) :-
  932    atom_chars(Prompt0, Chars0),
  933    clean_history_prompt_chars(Chars0, Chars1),
  934    delete_leading_blanks(Chars1, Chars),
  935    atom_chars(Prompt, Chars).
  936
  937clean_history_prompt_chars([], []).
  938clean_history_prompt_chars(['~', !|T], T) :- !.
  939clean_history_prompt_chars([H|T0], [H|T]) :-
  940    clean_history_prompt_chars(T0, T).
  941
  942delete_leading_blanks([' '|T0], T) :-
  943    !,
  944    delete_leading_blanks(T0, T).
  945delete_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.
  954set_default_history :-
  955    current_prolog_flag(history, _),
  956    !.
  957set_default_history :-
  958    (   (   \+ current_prolog_flag(readline, false)
  959        ;   current_prolog_flag(emacs_inferior_process, true)
  960        )
  961    ->  create_prolog_flag(history, 0, [])
  962    ;   create_prolog_flag(history, 25, [])
  963    ).
  964
  965
  966                 /*******************************
  967                 *        TOPLEVEL DEBUG        *
  968                 *******************************/
 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.
  983save_debug_after_read :-
  984    current_prolog_flag(debug, true),
  985    !,
  986    save_debug.
  987save_debug_after_read.
  988
  989save_debug :-
  990    (   tracing,
  991        notrace
  992    ->  Tracing = true
  993    ;   Tracing = false
  994    ),
  995    current_prolog_flag(debug, Debugging),
  996    set_prolog_flag(debug, false),
  997    create_prolog_flag(query_debug_settings,
  998                       debug(Debugging, Tracing), []).
  999
 1000restore_debug :-
 1001    current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)),
 1002    set_prolog_flag(debug, Debugging),
 1003    (   Tracing == true
 1004    ->  trace
 1005    ;   true
 1006    ).
 1007
 1008:- initialization
 1009    create_prolog_flag(query_debug_settings, debug(false, false), []). 1010
 1011
 1012                /********************************
 1013                *            PROMPTING          *
 1014                ********************************/
 1015
 1016'$system_prompt'(Module, BrekLev, Prompt) :-
 1017    current_prolog_flag(toplevel_prompt, PAtom),
 1018    atom_codes(PAtom, P0),
 1019    (    Module \== user
 1020    ->   '$substitute'('~m', [Module, ': '], P0, P1)
 1021    ;    '$substitute'('~m', [], P0, P1)
 1022    ),
 1023    (    BrekLev > 0
 1024    ->   '$substitute'('~l', ['[', BrekLev, '] '], P1, P2)
 1025    ;    '$substitute'('~l', [], P1, P2)
 1026    ),
 1027    current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)),
 1028    (    Tracing == true
 1029    ->   '$substitute'('~d', ['[trace] '], P2, P3)
 1030    ;    Debugging == true
 1031    ->   '$substitute'('~d', ['[debug] '], P2, P3)
 1032    ;    '$substitute'('~d', [], P2, P3)
 1033    ),
 1034    atom_chars(Prompt, P3).
 1035
 1036'$substitute'(From, T, Old, New) :-
 1037    atom_codes(From, FromCodes),
 1038    phrase(subst_chars(T), T0),
 1039    '$append'(Pre, S0, Old),
 1040    '$append'(FromCodes, Post, S0) ->
 1041    '$append'(Pre, T0, S1),
 1042    '$append'(S1, Post, New),
 1043    !.
 1044'$substitute'(_, _, Old, Old).
 1045
 1046subst_chars([]) -->
 1047    [].
 1048subst_chars([H|T]) -->
 1049    { atomic(H),
 1050      !,
 1051      atom_codes(H, Codes)
 1052    },
 1053    Codes,
 1054    subst_chars(T).
 1055subst_chars([H|T]) -->
 1056    H,
 1057    subst_chars(T).
 1058
 1059
 1060                /********************************
 1061                *           EXECUTION           *
 1062                ********************************/
 $execute_query(Goal, Bindings, -Truth) is det
Execute Goal using Bindings.
 1068'$execute_query'(Var, _, true) :-
 1069    var(Var),
 1070    !,
 1071    print_message(informational, var_query(Var)).
 1072'$execute_query'(Goal, Bindings, Truth) :-
 1073    '$current_typein_module'(TypeIn),
 1074    '$dwim_correct_goal'(TypeIn:Goal, Bindings, Corrected),
 1075    !,
 1076    setup_call_cleanup(
 1077        '$set_source_module'(M0, TypeIn),
 1078        expand_goal(Corrected, Expanded),
 1079        '$set_source_module'(M0)),
 1080    print_message(silent, toplevel_goal(Expanded, Bindings)),
 1081    '$execute_goal2'(Expanded, Bindings, Truth).
 1082'$execute_query'(_, _, false) :-
 1083    notrace,
 1084    print_message(query, query(no)).
 1085
 1086'$execute_goal2'(Goal, Bindings, true) :-
 1087    restore_debug,
 1088    '$current_typein_module'(TypeIn),
 1089    residue_vars(TypeIn:Goal, Vars, TypeIn:Delays),
 1090    deterministic(Det),
 1091    (   save_debug
 1092    ;   restore_debug, fail
 1093    ),
 1094    flush_output(user_output),
 1095    call_expand_answer(Bindings, NewBindings),
 1096    (    \+ \+ write_bindings(NewBindings, Vars, Delays, Det)
 1097    ->   !
 1098    ).
 1099'$execute_goal2'(_, _, false) :-
 1100    save_debug,
 1101    print_message(query, query(no)).
 1102
 1103residue_vars(Goal, Vars, Delays) :-
 1104    current_prolog_flag(toplevel_residue_vars, true),
 1105    !,
 1106    '$wfs_call'(call_residue_vars(stop_backtrace(Goal), Vars), Delays).
 1107residue_vars(Goal, [], Delays) :-
 1108    '$wfs_call'(stop_backtrace(Goal), Delays).
 1109
 1110stop_backtrace(Goal) :-
 1111    toplevel_call(Goal),
 1112    no_lco.
 1113
 1114toplevel_call(Goal) :-
 1115    call(Goal),
 1116    no_lco.
 1117
 1118no_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.
 1134write_bindings(Bindings, ResidueVars, Delays, Det) :-
 1135    '$current_typein_module'(TypeIn),
 1136    translate_bindings(Bindings, Bindings1, ResidueVars, TypeIn:Residuals),
 1137    omit_qualifier(Delays, TypeIn, Delays1),
 1138    write_bindings2(Bindings1, Residuals, Delays1, Det).
 1139
 1140write_bindings2([], Residuals, Delays, _) :-
 1141    current_prolog_flag(prompt_alternatives_on, groundness),
 1142    !,
 1143    print_message(query, query(yes(Delays, Residuals))).
 1144write_bindings2(Bindings, Residuals, Delays, true) :-
 1145    current_prolog_flag(prompt_alternatives_on, determinism),
 1146    !,
 1147    print_message(query, query(yes(Bindings, Delays, Residuals))).
 1148write_bindings2(Bindings, Residuals, Delays, _Det) :-
 1149    repeat,
 1150        print_message(query, query(more(Bindings, Delays, Residuals))),
 1151        get_respons(Action),
 1152    (   Action == redo
 1153    ->  !, fail
 1154    ;   Action == show_again
 1155    ->  fail
 1156    ;   !,
 1157        print_message(query, query(done))
 1158    ).
 residual_goals(:NonTerminal)
Directive that registers NonTerminal as a collector for residual goals.
 1165:- multifile
 1166    residual_goal_collector/1. 1167
 1168:- meta_predicate
 1169    residual_goals(2). 1170
 1171residual_goals(NonTerminal) :-
 1172    throw(error(context_error(nodirective, residual_goals(NonTerminal)), _)).
 1173
 1174system:term_expansion((:- residual_goals(NonTerminal)),
 1175                      '$toplevel':residual_goal_collector(M2:Head)) :-
 1176    prolog_load_context(module, M),
 1177    strip_module(M:NonTerminal, M2, Head),
 1178    '$must_be'(callable, Head).
 prolog:residual_goals// is det
DCG that collects residual goals that are not associated with the answer through attributed variables.
 1185:- public prolog:residual_goals//0. 1186
 1187prolog:residual_goals -->
 1188    { findall(NT, residual_goal_collector(NT), NTL) },
 1189    collect_residual_goals(NTL).
 1190
 1191collect_residual_goals([]) --> [].
 1192collect_residual_goals([H|T]) -->
 1193    ( call(H) -> [] ; [] ),
 1194    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.
 1219:- public
 1220    prolog:translate_bindings/5. 1221:- meta_predicate
 1222    prolog:translate_bindings(+, -, +, +, :). 1223
 1224prolog:translate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals) :-
 1225    translate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals).
 1226
 1227translate_bindings(Bindings0, Bindings, ResidueVars, Residuals) :-
 1228    prolog:residual_goals(ResidueGoals, []),
 1229    translate_bindings(Bindings0, Bindings, ResidueVars, ResidueGoals,
 1230                       Residuals).
 1231
 1232translate_bindings(Bindings0, Bindings, [], [], _:[]-[]) :-
 1233    term_attvars(Bindings0, []),
 1234    !,
 1235    join_same_bindings(Bindings0, Bindings1),
 1236    factorize_bindings(Bindings1, Bindings2),
 1237    bind_vars(Bindings2, Bindings3),
 1238    filter_bindings(Bindings3, Bindings).
 1239translate_bindings(Bindings0, Bindings, ResidueVars, ResGoals0,
 1240                   TypeIn:Residuals-HiddenResiduals) :-
 1241    project_constraints(Bindings0, ResidueVars),
 1242    hidden_residuals(ResidueVars, Bindings0, HiddenResiduals0),
 1243    omit_qualifiers(HiddenResiduals0, TypeIn, HiddenResiduals),
 1244    copy_term(Bindings0+ResGoals0, Bindings1+ResGoals1, Residuals0),
 1245    '$append'(ResGoals1, Residuals0, Residuals1),
 1246    omit_qualifiers(Residuals1, TypeIn, Residuals),
 1247    join_same_bindings(Bindings1, Bindings2),
 1248    factorize_bindings(Bindings2, Bindings3),
 1249    bind_vars(Bindings3, Bindings4),
 1250    filter_bindings(Bindings4, Bindings).
 1251
 1252hidden_residuals(ResidueVars, Bindings, Goal) :-
 1253    term_attvars(ResidueVars, Remaining),
 1254    term_attvars(Bindings, QueryVars),
 1255    subtract_vars(Remaining, QueryVars, HiddenVars),
 1256    copy_term(HiddenVars, _, Goal).
 1257
 1258subtract_vars(All, Subtract, Remaining) :-
 1259    sort(All, AllSorted),
 1260    sort(Subtract, SubtractSorted),
 1261    ord_subtract(AllSorted, SubtractSorted, Remaining).
 1262
 1263ord_subtract([], _Not, []).
 1264ord_subtract([H1|T1], L2, Diff) :-
 1265    diff21(L2, H1, T1, Diff).
 1266
 1267diff21([], H1, T1, [H1|T1]).
 1268diff21([H2|T2], H1, T1, Diff) :-
 1269    compare(Order, H1, H2),
 1270    diff3(Order, H1, T1, H2, T2, Diff).
 1271
 1272diff12([], _H2, _T2, []).
 1273diff12([H1|T1], H2, T2, Diff) :-
 1274    compare(Order, H1, H2),
 1275    diff3(Order, H1, T1, H2, T2, Diff).
 1276
 1277diff3(<,  H1, T1,  H2, T2, [H1|Diff]) :-
 1278    diff12(T1, H2, T2, Diff).
 1279diff3(=, _H1, T1, _H2, T2, Diff) :-
 1280    ord_subtract(T1, T2, Diff).
 1281diff3(>,  H1, T1, _H2, T2, Diff) :-
 1282    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.
 1290project_constraints(Bindings, ResidueVars) :-
 1291    !,
 1292    term_attvars(Bindings, AttVars),
 1293    phrase(attribute_modules(AttVars), Modules0),
 1294    sort(Modules0, Modules),
 1295    term_variables(Bindings, QueryVars),
 1296    project_attributes(Modules, QueryVars, ResidueVars).
 1297project_constraints(_, _).
 1298
 1299project_attributes([], _, _).
 1300project_attributes([M|T], QueryVars, ResidueVars) :-
 1301    (   current_predicate(M:project_attributes/2),
 1302        catch(M:project_attributes(QueryVars, ResidueVars), E,
 1303              print_message(error, E))
 1304    ->  true
 1305    ;   true
 1306    ),
 1307    project_attributes(T, QueryVars, ResidueVars).
 1308
 1309attribute_modules([]) --> [].
 1310attribute_modules([H|T]) -->
 1311    { get_attrs(H, Attrs) },
 1312    attrs_modules(Attrs),
 1313    attribute_modules(T).
 1314
 1315attrs_modules([]) --> [].
 1316attrs_modules(att(Module, _, More)) -->
 1317    [Module],
 1318    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.
 1329join_same_bindings([], []).
 1330join_same_bindings([Name=V0|T0], [[Name|Names]=V|T]) :-
 1331    take_same_bindings(T0, V0, V, Names, T1),
 1332    join_same_bindings(T1, T).
 1333
 1334take_same_bindings([], Val, Val, [], []).
 1335take_same_bindings([Name=V1|T0], V0, V, [Name|Names], T) :-
 1336    V0 == V1,
 1337    !,
 1338    take_same_bindings(T0, V1, V, Names, T).
 1339take_same_bindings([Pair|T0], V0, V, Names, [Pair|T]) :-
 1340    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.
 1349omit_qualifiers([], _, []).
 1350omit_qualifiers([Goal0|Goals0], TypeIn, [Goal|Goals]) :-
 1351    omit_qualifier(Goal0, TypeIn, Goal),
 1352    omit_qualifiers(Goals0, TypeIn, Goals).
 1353
 1354omit_qualifier(M:G0, TypeIn, G) :-
 1355    M == TypeIn,
 1356    !,
 1357    omit_meta_qualifiers(G0, TypeIn, G).
 1358omit_qualifier(M:G0, TypeIn, G) :-
 1359    predicate_property(TypeIn:G0, imported_from(M)),
 1360    \+ predicate_property(G0, transparent),
 1361    !,
 1362    G0 = G.
 1363omit_qualifier(_:G0, _, G) :-
 1364    predicate_property(G0, built_in),
 1365    \+ predicate_property(G0, transparent),
 1366    !,
 1367    G0 = G.
 1368omit_qualifier(M:G0, _, M:G) :-
 1369    atom(M),
 1370    !,
 1371    omit_meta_qualifiers(G0, M, G).
 1372omit_qualifier(G0, TypeIn, G) :-
 1373    omit_meta_qualifiers(G0, TypeIn, G).
 1374
 1375omit_meta_qualifiers(V, _, V) :-
 1376    var(V),
 1377    !.
 1378omit_meta_qualifiers((QA,QB), TypeIn, (A,B)) :-
 1379    !,
 1380    omit_qualifier(QA, TypeIn, A),
 1381    omit_qualifier(QB, TypeIn, B).
 1382omit_meta_qualifiers(tnot(QA), TypeIn, tnot(A)) :-
 1383    !,
 1384    omit_qualifier(QA, TypeIn, A).
 1385omit_meta_qualifiers(freeze(V, QGoal), TypeIn, freeze(V, Goal)) :-
 1386    callable(QGoal),
 1387    !,
 1388    omit_qualifier(QGoal, TypeIn, Goal).
 1389omit_meta_qualifiers(when(Cond, QGoal), TypeIn, when(Cond, Goal)) :-
 1390    callable(QGoal),
 1391    !,
 1392    omit_qualifier(QGoal, TypeIn, Goal).
 1393omit_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.
 1402bind_vars(Bindings0, Bindings) :-
 1403    bind_query_vars(Bindings0, Bindings, SNames),
 1404    bind_skel_vars(Bindings, Bindings, SNames, 1, _).
 1405
 1406bind_query_vars([], [], []).
 1407bind_query_vars([binding(Names,Var,[Var2=Cycle])|T0],
 1408                [binding(Names,Cycle,[])|T], [Name|SNames]) :-
 1409    Var == Var2,                   % also implies var(Var)
 1410    !,
 1411    '$last'(Names, Name),
 1412    Var = '$VAR'(Name),
 1413    bind_query_vars(T0, T, SNames).
 1414bind_query_vars([B|T0], [B|T], AllNames) :-
 1415    B = binding(Names,Var,Skel),
 1416    bind_query_vars(T0, T, SNames),
 1417    (   var(Var), \+ attvar(Var), Skel == []
 1418    ->  AllNames = [Name|SNames],
 1419        '$last'(Names, Name),
 1420        Var = '$VAR'(Name)
 1421    ;   AllNames = SNames
 1422    ).
 1423
 1424
 1425
 1426bind_skel_vars([], _, _, N, N).
 1427bind_skel_vars([binding(_,_,Skel)|T], Bindings, SNames, N0, N) :-
 1428    bind_one_skel_vars(Skel, Bindings, SNames, N0, N1),
 1429    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).
 1448bind_one_skel_vars([], _, _, N, N).
 1449bind_one_skel_vars([Var=Value|T], Bindings, Names, N0, N) :-
 1450    (   var(Var)
 1451    ->  (   '$member'(binding(Names, VVal, []), Bindings),
 1452            same_term(Value, VVal)
 1453        ->  '$last'(Names, VName),
 1454            Var = '$VAR'(VName),
 1455            N2 = N0
 1456        ;   between(N0, infinite, N1),
 1457            atom_concat('_S', N1, Name),
 1458            \+ memberchk(Name, Names),
 1459            !,
 1460            Var = '$VAR'(Name),
 1461            N2 is N1 + 1
 1462        )
 1463    ;   N2 = N0
 1464    ),
 1465    bind_one_skel_vars(T, Bindings, Names, N2, N).
 factorize_bindings(+Bindings0, -Factorized)
Factorize cycles and sharing in the bindings.
 1472factorize_bindings([], []).
 1473factorize_bindings([Name=Value|T0], [binding(Name, Skel, Subst)|T]) :-
 1474    '$factorize_term'(Value, Skel, Subst0),
 1475    (   current_prolog_flag(toplevel_print_factorized, true)
 1476    ->  Subst = Subst0
 1477    ;   only_cycles(Subst0, Subst)
 1478    ),
 1479    factorize_bindings(T0, T).
 1480
 1481
 1482only_cycles([], []).
 1483only_cycles([B|T0], List) :-
 1484    (   B = (Var=Value),
 1485        Var = Value,
 1486        acyclic_term(Var)
 1487    ->  only_cycles(T0, List)
 1488    ;   List = [B|T],
 1489        only_cycles(T0, T)
 1490    ).
 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).
 1499filter_bindings([], []).
 1500filter_bindings([H0|T0], T) :-
 1501    hide_vars(H0, H),
 1502    (   (   arg(1, H, [])
 1503        ;   self_bounded(H)
 1504        )
 1505    ->  filter_bindings(T0, T)
 1506    ;   T = [H|T1],
 1507        filter_bindings(T0, T1)
 1508    ).
 1509
 1510hide_vars(binding(Names0, Skel, Subst), binding(Names, Skel, Subst)) :-
 1511    hide_names(Names0, Skel, Subst, Names).
 1512
 1513hide_names([], _, _, []).
 1514hide_names([Name|T0], Skel, Subst, T) :-
 1515    (   sub_atom(Name, 0, _, _, '_'),
 1516        current_prolog_flag(toplevel_print_anon, false),
 1517        sub_atom(Name, 1, 1, _, Next),
 1518        char_type(Next, prolog_var_start)
 1519    ->  true
 1520    ;   Subst == [],
 1521        Skel == '$VAR'(Name)
 1522    ),
 1523    !,
 1524    hide_names(T0, Skel, Subst, T).
 1525hide_names([Name|T0], Skel, Subst, [Name|T]) :-
 1526    hide_names(T0, Skel, Subst, T).
 1527
 1528self_bounded(binding([Name], Value, [])) :-
 1529    Value == '$VAR'(Name).
 get_respons(-Action)
Read the continuation entered by the user.
 1535get_respons(Action) :-
 1536    repeat,
 1537        flush_output(user_output),
 1538        get_single_char(Char),
 1539        answer_respons(Char, Action),
 1540        (   Action == again
 1541        ->  print_message(query, query(action)),
 1542            fail
 1543        ;   !
 1544        ).
 1545
 1546answer_respons(Char, again) :-
 1547    '$in_reply'(Char, '?h'),
 1548    !,
 1549    print_message(help, query(help)).
 1550answer_respons(Char, redo) :-
 1551    '$in_reply'(Char, ';nrNR \t'),
 1552    !,
 1553    print_message(query, if_tty([ansi(bold, ';', [])])).
 1554answer_respons(Char, redo) :-
 1555    '$in_reply'(Char, 'tT'),
 1556    !,
 1557    trace,
 1558    save_debug,
 1559    print_message(query, if_tty([ansi(bold, '; [trace]', [])])).
 1560answer_respons(Char, continue) :-
 1561    '$in_reply'(Char, 'ca\n\ryY.'),
 1562    !,
 1563    print_message(query, if_tty([ansi(bold, '.', [])])).
 1564answer_respons(0'b, show_again) :-
 1565    !,
 1566    break.
 1567answer_respons(Char, show_again) :-
 1568    print_predicate(Char, Pred, Options),
 1569    !,
 1570    print_message(query, if_tty(['~w'-[Pred]])),
 1571    set_prolog_flag(answer_write_options, Options).
 1572answer_respons(-1, show_again) :-
 1573    !,
 1574    print_message(query, halt('EOF')),
 1575    halt(0).
 1576answer_respons(Char, again) :-
 1577    print_message(query, no_action(Char)).
 1578
 1579print_predicate(0'w, [write], [ quoted(true),
 1580                                spacing(next_argument)
 1581                              ]).
 1582print_predicate(0'p, [print], [ quoted(true),
 1583                                portray(true),
 1584                                max_depth(10),
 1585                                spacing(next_argument)
 1586                              ]).
 1587
 1588
 1589                 /*******************************
 1590                 *          EXPANSION           *
 1591                 *******************************/
 1592
 1593:- user:dynamic(expand_query/4). 1594:- user:multifile(expand_query/4). 1595
 1596call_expand_query(Goal, Expanded, Bindings, ExpandedBindings) :-
 1597    user:expand_query(Goal, Expanded, Bindings, ExpandedBindings),
 1598    !.
 1599call_expand_query(Goal, Expanded, Bindings, ExpandedBindings) :-
 1600    toplevel_variables:expand_query(Goal, Expanded, Bindings, ExpandedBindings),
 1601    !.
 1602call_expand_query(Goal, Goal, Bindings, Bindings).
 1603
 1604
 1605:- user:dynamic(expand_answer/2). 1606:- user:multifile(expand_answer/2). 1607
 1608call_expand_answer(Goal, Expanded) :-
 1609    user:expand_answer(Goal, Expanded),
 1610    !.
 1611call_expand_answer(Goal, Expanded) :-
 1612    toplevel_variables:expand_answer(Goal, Expanded),
 1613    !.
 1614call_expand_answer(Goal, Goal)