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-2017, 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    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
  522set_toplevel :-
  523    '$cmd_option_val'(toplevel, TopLevelAtom),
  524    catch(term_to_atom(TopLevel, TopLevelAtom), E,
  525          (print_message(error, E),
  526           halt(1))),
  527    create_prolog_flag(toplevel_goal, TopLevel, [type(term)]).
  528
  529load_only :-
  530    current_prolog_flag(os_argv, OSArgv),
  531    memberchk('-l', OSArgv),
  532    current_prolog_flag(argv, Argv),
  533    \+ memberchk('-l', Argv).

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

  540run_init_goals([]).
  541run_init_goals([H|T]) :-
  542    run_init_goal(H),
  543    run_init_goals(T).
  544
  545run_init_goal(Text) :-
  546    catch(term_to_atom(Goal, Text), E,
  547          (   print_message(error, init_goal_syntax(E, Text)),
  548              halt(2)
  549          )),
  550    run_init_goal(Goal, Text).

run_program_init is det: Run goals registered using

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

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

  591init_debug_flags :-
  592    once(print_predicate(_, [print], PrintOptions)),
  593    create_prolog_flag(answer_write_options, PrintOptions, []),
  594    create_prolog_flag(prompt_alternatives_on, determinism, []),
  595    create_prolog_flag(toplevel_extra_white_line, true, []),
  596    create_prolog_flag(toplevel_print_factorized, false, []),
  597    create_prolog_flag(print_write_options,
  598                       [ portray(true), quoted(true), numbervars(true) ],
  599                       []),
  600    create_prolog_flag(toplevel_residue_vars, false, []),
  601    create_prolog_flag(toplevel_list_wfs_residual_program, true, []),
  602    '$set_debugger_write_options'(print).

setup_backtrace: Initialise printing a backtrace.

  608setup_backtrace :-
  609    (   \+ current_prolog_flag(backtrace, false),
  610        load_setup_file(library(prolog_stack))
  611    ->  true
  612    ;   true
  613    ).

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

  619setup_colors :-
  620    (   \+ current_prolog_flag(color_term, false),
  621        stream_property(user_input, tty(true)),
  622        stream_property(user_error, tty(true)),
  623        stream_property(user_output, tty(true)),
  624        \+ getenv('TERM', dumb),
  625        load_setup_file(user:library(ansi_term))
  626    ->  true
  627    ;   true
  628    ).

setup_history: Enable per-directory persistent history.

  634setup_history :-
  635    (   \+ current_prolog_flag(save_history, false),
  636        stream_property(user_input, tty(true)),
  637        \+ current_prolog_flag(readline, false),
  638        load_setup_file(library(prolog_history))
  639    ->  prolog_history(enable)
  640    ;   true
  641    ),
  642    set_default_history,
  643    '$load_history'.

setup_readline: Setup line editing.

  649setup_readline :-
  650    (   current_prolog_flag(readline, swipl_win)
  651    ->  true
  652    ;   stream_property(user_input, tty(true)),
  653        current_prolog_flag(tty_control, true),
  654        \+ getenv('TERM', dumb),
  655        (   current_prolog_flag(readline, ReadLine)
  656        ->  true
  657        ;   ReadLine = true
  658        ),
  659        readline_library(ReadLine, Library),
  660        load_setup_file(library(Library))
  661    ->  set_prolog_flag(readline, Library)
  662    ;   set_prolog_flag(readline, false)
  663    ).
  664
  665readline_library(true, Library) :-
  666    !,
  667    preferred_readline(Library).
  668readline_library(false, _) :-
  669    !,
  670    fail.
  671readline_library(Library, Library).
  672
  673preferred_readline(editline).
  674preferred_readline(readline).

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

  680load_setup_file(File) :-
  681    catch(load_files(File,
  682                     [ silent(true),
  683                       if(not_loaded)
  684                     ]), _, fail).
  685
  686
  687:- '$hide'('$toplevel'/0).              % avoid in the GUI stacktrace

$toplevel: Called from PL_toplevel()

  693'$toplevel' :-
  694    '$runtoplevel',
  695    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

  705'$runtoplevel' :-
  706    current_prolog_flag(toplevel_goal, TopLevel0),
  707    toplevel_goal(TopLevel0, TopLevel),
  708    user:TopLevel.
  709
  710:- dynamic  setup_done/0.  711:- volatile setup_done/0.  712
  713toplevel_goal(default, '$query_loop') :-
  714    !,
  715    setup_interactive.
  716toplevel_goal(prolog, '$query_loop') :-
  717    !,
  718    setup_interactive.
  719toplevel_goal(Goal, Goal).
  720
  721setup_interactive :-
  722    setup_done,
  723    !.
  724setup_interactive :-
  725    asserta(setup_done),
  726    catch(setup_backtrace, E, print_message(warning, E)),
  727    catch(setup_readline,  E, print_message(warning, E)),
  728    catch(setup_history,   E, print_message(warning, E)).

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

  734'$compile' :-
  735    (   catch('$compile_', E, (print_message(error, E), halt(1)))
  736    ->  true
  737    ;   print_message(error, error(goal_failed('$compile'), _)),
  738        halt(1)
  739    ).
  740
  741'$compile_' :-
  742    '$load_system_init_file',
  743    '$set_file_search_paths',
  744    init_debug_flags,
  745    '$run_initialization',
  746    attach_packs,
  747    use_module(library(qsave)),
  748    qsave:qsave_toplevel.

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

  754'$config' :-
  755    '$load_system_init_file',
  756    '$set_file_search_paths',
  757    init_debug_flags,
  758    '$run_initialization',
  759    load_files(library(prolog_config)),
  760    (   catch(prolog_dump_runtime_variables, E,
  761              (print_message(error, E), halt(1)))
  762    ->  true
  763    ;   print_message(error, error(goal_failed(prolog_dump_runtime_variables),_))
  764    ).
  765
  766
  767                /********************************
  768                *    USER INTERACTIVE LOOP      *
  769                *********************************/

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.

  777prolog :-
  778    break.
  779
  780:- 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).

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

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.

  849read_query(Prompt, Goal, Bindings) :-
  850    current_prolog_flag(history, N),
  851    integer(N), N > 0,
  852    !,
  853    read_history(h, '!h',
  854                 [trace, end_of_file],
  855                 Prompt, Goal, Bindings).
  856read_query(Prompt, Goal, Bindings) :-
  857    remove_history_prompt(Prompt, Prompt1),
  858    repeat,                                 % over syntax errors
  859    prompt1(Prompt1),
  860    read_query_line(user_input, Line),
  861    '$save_history_line'(Line),             % save raw line (edit syntax errors)
  862    '$current_typein_module'(TypeIn),
  863    catch(read_term_from_atom(Line, Goal,
  864                              [ variable_names(Bindings),
  865                                module(TypeIn)
  866                              ]), E,
  867          (   print_message(error, E),
  868              fail
  869          )),
  870    !,
  871    '$save_history_event'(Line).            % save event (no syntax errors)

read_query_line(+Input, -Line) is det

  875read_query_line(Input, Line) :-
  876    catch(read_term_as_atom(Input, Line), Error, true),
  877    save_debug_after_read,
  878    (   var(Error)
  879    ->  true
  880    ;   Error = error(syntax_error(_),_)
  881    ->  print_message(error, Error),
  882        fail
  883    ;   print_message(error, Error),
  884        throw(Error)
  885    ).

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

  892read_term_as_atom(In, Line) :-
  893    '$raw_read'(In, Line),
  894    (   Line == end_of_file
  895    ->  true
  896    ;   skip_to_nl(In)
  897    ).

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.

  904skip_to_nl(In) :-
  905    repeat,
  906    peek_char(In, C),
  907    (   C == '%'
  908    ->  skip(In, '\n')
  909    ;   char_type(C, space)
  910    ->  get_char(In, _),
  911        C == '\n'
  912    ;   true
  913    ),
  914    !.
  915
  916remove_history_prompt('', '') :- !.
  917remove_history_prompt(Prompt0, Prompt) :-
  918    atom_chars(Prompt0, Chars0),
  919    clean_history_prompt_chars(Chars0, Chars1),
  920    delete_leading_blanks(Chars1, Chars),
  921    atom_chars(Prompt, Chars).
  922
  923clean_history_prompt_chars([], []).
  924clean_history_prompt_chars(['~', !|T], T) :- !.
  925clean_history_prompt_chars([H|T0], [H|T]) :-
  926    clean_history_prompt_chars(T0, T).
  927
  928delete_leading_blanks([' '|T0], T) :-
  929    !,
  930    delete_leading_blanks(T0, T).
  931delete_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.

  940set_default_history :-
  941    current_prolog_flag(history, _),
  942    !.
  943set_default_history :-
  944    (   (   \+ current_prolog_flag(readline, false)
  945        ;   current_prolog_flag(emacs_inferior_process, true)
  946        )
  947    ->  create_prolog_flag(history, 0, [])
  948    ;   create_prolog_flag(history, 25, [])
  949    ).
  950
  951
  952                 /*******************************
  953                 *        TOPLEVEL DEBUG        *
  954                 *******************************/

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.

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

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

 1054'$execute_query'(Var, _, true) :-
 1055    var(Var),
 1056    !,
 1057    print_message(informational, var_query(Var)).
 1058'$execute_query'(Goal, Bindings, Truth) :-
 1059    '$current_typein_module'(TypeIn),
 1060    '$dwim_correct_goal'(TypeIn:Goal, Bindings, Corrected),
 1061    !,
 1062    setup_call_cleanup(
 1063        '$set_source_module'(M0, TypeIn),
 1064        expand_goal(Corrected, Expanded),
 1065        '$set_source_module'(M0)),
 1066    print_message(silent, toplevel_goal(Expanded, Bindings)),
 1067    '$execute_goal2'(Expanded, Bindings, Truth).
 1068'$execute_query'(_, _, false) :-
 1069    notrace,
 1070    print_message(query, query(no)).
 1071
 1072'$execute_goal2'(Goal, Bindings, true) :-
 1073    restore_debug,
 1074    '$current_typein_module'(TypeIn),
 1075    residue_vars(Goal, Vars, TypeIn:Delays),
 1076    deterministic(Det),
 1077    (   save_debug
 1078    ;   restore_debug, fail
 1079    ),
 1080    flush_output(user_output),
 1081    call_expand_answer(Bindings, NewBindings),
 1082    (    \+ \+ write_bindings(NewBindings, Vars, Delays, Det)
 1083    ->   !
 1084    ).
 1085'$execute_goal2'(_, _, false) :-
 1086    save_debug,
 1087    print_message(query, query(no)).
 1088
 1089residue_vars(Goal, Vars, Delays) :-
 1090    current_prolog_flag(toplevel_residue_vars, true),
 1091    !,
 1092    '$wfs_call'(call_residue_vars(stop_backtrace(Goal), Vars), Delays).
 1093residue_vars(Goal, [], Delays) :-
 1094    '$wfs_call'(stop_backtrace(Goal), Delays).
 1095
 1096stop_backtrace(Goal) :-
 1097    toplevel_call(Goal),
 1098    no_lco.
 1099
 1100toplevel_call(Goal) :-
 1101    call(Goal),
 1102    no_lco.
 1103
 1104no_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.

 1120write_bindings(Bindings, ResidueVars, Delays, Det) :-
 1121    '$current_typein_module'(TypeIn),
 1122    translate_bindings(Bindings, Bindings1, ResidueVars, TypeIn:Residuals),
 1123    omit_qualifier(Delays, TypeIn, Delays1),
 1124    write_bindings2(Bindings1, Residuals, Delays1, Det).
 1125
 1126write_bindings2([], Residuals, Delays, _) :-
 1127    current_prolog_flag(prompt_alternatives_on, groundness),
 1128    !,
 1129    print_message(query, query(yes(Delays, Residuals))).
 1130write_bindings2(Bindings, Residuals, Delays, true) :-
 1131    current_prolog_flag(prompt_alternatives_on, determinism),
 1132    !,
 1133    print_message(query, query(yes(Bindings, Delays, Residuals))).
 1134write_bindings2(Bindings, Residuals, Delays, _Det) :-
 1135    repeat,
 1136        print_message(query, query(more(Bindings, Delays, Residuals))),
 1137        get_respons(Action),
 1138    (   Action == redo
 1139    ->  !, fail
 1140    ;   Action == show_again
 1141    ->  fail
 1142    ;   !,
 1143        print_message(query, query(done))
 1144    ).

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

 1151:- multifile
 1152    residual_goal_collector/1. 1153
 1154:- meta_predicate
 1155    residual_goals(2). 1156
 1157residual_goals(NonTerminal) :-
 1158    throw(error(context_error(nodirective, residual_goals(NonTerminal)), _)).
 1159
 1160system:term_expansion((:- residual_goals(NonTerminal)),
 1161                      '$toplevel':residual_goal_collector(M2:Head)) :-
 1162    prolog_load_context(module, M),
 1163    strip_module(M:NonTerminal, M2, Head),
 1164    '$must_be'(callable, Head).

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

 1171:- public prolog:residual_goals//0. 1172
 1173prolog:residual_goals -->
 1174    { findall(NT, residual_goal_collector(NT), NTL) },
 1175    collect_residual_goals(NTL).
 1176
 1177collect_residual_goals([]) --> [].
 1178collect_residual_goals([H|T]) -->
 1179    ( call(H) -> [] ; [] ),
 1180    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.

 1205:- public
 1206    prolog:translate_bindings/5. 1207:- meta_predicate
 1208    prolog:translate_bindings(+, -, +, +, :). 1209
 1210prolog:translate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals) :-
 1211    translate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals).
 1212
 1213translate_bindings(Bindings0, Bindings, ResidueVars, Residuals) :-
 1214    prolog:residual_goals(ResidueGoals, []),
 1215    translate_bindings(Bindings0, Bindings, ResidueVars, ResidueGoals,
 1216                       Residuals).
 1217
 1218translate_bindings(Bindings0, Bindings, [], [], _:[]-[]) :-
 1219    term_attvars(Bindings0, []),
 1220    !,
 1221    join_same_bindings(Bindings0, Bindings1),
 1222    factorize_bindings(Bindings1, Bindings2),
 1223    bind_vars(Bindings2, Bindings3),
 1224    filter_bindings(Bindings3, Bindings).
 1225translate_bindings(Bindings0, Bindings, ResidueVars, ResGoals0,
 1226                   TypeIn:Residuals-HiddenResiduals) :-
 1227    project_constraints(Bindings0, ResidueVars),
 1228    hidden_residuals(ResidueVars, Bindings0, HiddenResiduals0),
 1229    omit_qualifiers(HiddenResiduals0, TypeIn, HiddenResiduals),
 1230    copy_term(Bindings0+ResGoals0, Bindings1+ResGoals1, Residuals0),
 1231    '$append'(ResGoals1, Residuals0, Residuals1),
 1232    omit_qualifiers(Residuals1, TypeIn, Residuals),
 1233    join_same_bindings(Bindings1, Bindings2),
 1234    factorize_bindings(Bindings2, Bindings3),
 1235    bind_vars(Bindings3, Bindings4),
 1236    filter_bindings(Bindings4, Bindings).
 1237
 1238hidden_residuals(ResidueVars, Bindings, Goal) :-
 1239    term_attvars(ResidueVars, Remaining),
 1240    term_attvars(Bindings, QueryVars),
 1241    subtract_vars(Remaining, QueryVars, HiddenVars),
 1242    copy_term(HiddenVars, _, Goal).
 1243
 1244subtract_vars(All, Subtract, Remaining) :-
 1245    sort(All, AllSorted),
 1246    sort(Subtract, SubtractSorted),
 1247    ord_subtract(AllSorted, SubtractSorted, Remaining).
 1248
 1249ord_subtract([], _Not, []).
 1250ord_subtract([H1|T1], L2, Diff) :-
 1251    diff21(L2, H1, T1, Diff).
 1252
 1253diff21([], H1, T1, [H1|T1]).
 1254diff21([H2|T2], H1, T1, Diff) :-
 1255    compare(Order, H1, H2),
 1256    diff3(Order, H1, T1, H2, T2, Diff).
 1257
 1258diff12([], _H2, _T2, []).
 1259diff12([H1|T1], H2, T2, Diff) :-
 1260    compare(Order, H1, H2),
 1261    diff3(Order, H1, T1, H2, T2, Diff).
 1262
 1263diff3(<,  H1, T1,  H2, T2, [H1|Diff]) :-
 1264    diff12(T1, H2, T2, Diff).
 1265diff3(=, _H1, T1, _H2, T2, Diff) :-
 1266    ord_subtract(T1, T2, Diff).
 1267diff3(>,  H1, T1, _H2, T2, Diff) :-
 1268    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.

 1276project_constraints(Bindings, ResidueVars) :-
 1277    !,
 1278    term_attvars(Bindings, AttVars),
 1279    phrase(attribute_modules(AttVars), Modules0),
 1280    sort(Modules0, Modules),
 1281    term_variables(Bindings, QueryVars),
 1282    project_attributes(Modules, QueryVars, ResidueVars).
 1283project_constraints(_, _).
 1284
 1285project_attributes([], _, _).
 1286project_attributes([M|T], QueryVars, ResidueVars) :-
 1287    (   current_predicate(M:project_attributes/2),
 1288        catch(M:project_attributes(QueryVars, ResidueVars), E,
 1289              print_message(error, E))
 1290    ->  true
 1291    ;   true
 1292    ),
 1293    project_attributes(T, QueryVars, ResidueVars).
 1294
 1295attribute_modules([]) --> [].
 1296attribute_modules([H|T]) -->
 1297    { get_attrs(H, Attrs) },
 1298    attrs_modules(Attrs),
 1299    attribute_modules(T).
 1300
 1301attrs_modules([]) --> [].
 1302attrs_modules(att(Module, _, More)) -->
 1303    [Module],
 1304    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.

 1315join_same_bindings([], []).
 1316join_same_bindings([Name=V0|T0], [[Name|Names]=V|T]) :-
 1317    take_same_bindings(T0, V0, V, Names, T1),
 1318    join_same_bindings(T1, T).
 1319
 1320take_same_bindings([], Val, Val, [], []).
 1321take_same_bindings([Name=V1|T0], V0, V, [Name|Names], T) :-
 1322    V0 == V1,
 1323    !,
 1324    take_same_bindings(T0, V1, V, Names, T).
 1325take_same_bindings([Pair|T0], V0, V, Names, [Pair|T]) :-
 1326    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.

 1335omit_qualifiers([], _, []).
 1336omit_qualifiers([Goal0|Goals0], TypeIn, [Goal|Goals]) :-
 1337    omit_qualifier(Goal0, TypeIn, Goal),
 1338    omit_qualifiers(Goals0, TypeIn, Goals).
 1339
 1340omit_qualifier(M:G0, TypeIn, G) :-
 1341    M == TypeIn,
 1342    !,
 1343    omit_meta_qualifiers(G0, TypeIn, G).
 1344omit_qualifier(M:G0, TypeIn, G) :-
 1345    predicate_property(TypeIn:G0, imported_from(M)),
 1346    \+ predicate_property(G0, transparent),
 1347    !,
 1348    G0 = G.
 1349omit_qualifier(_:G0, _, G) :-
 1350    predicate_property(G0, built_in),
 1351    \+ predicate_property(G0, transparent),
 1352    !,
 1353    G0 = G.
 1354omit_qualifier(M:G0, _, M:G) :-
 1355    atom(M),
 1356    !,
 1357    omit_meta_qualifiers(G0, M, G).
 1358omit_qualifier(G0, TypeIn, G) :-
 1359    omit_meta_qualifiers(G0, TypeIn, G).
 1360
 1361omit_meta_qualifiers(V, _, V) :-
 1362    var(V),
 1363    !.
 1364omit_meta_qualifiers((QA,QB), TypeIn, (A,B)) :-
 1365    !,
 1366    omit_qualifier(QA, TypeIn, A),
 1367    omit_qualifier(QB, TypeIn, B).
 1368omit_meta_qualifiers(tnot(QA), TypeIn, tnot(A)) :-
 1369    !,
 1370    omit_qualifier(QA, TypeIn, A).
 1371omit_meta_qualifiers(freeze(V, QGoal), TypeIn, freeze(V, Goal)) :-
 1372    callable(QGoal),
 1373    !,
 1374    omit_qualifier(QGoal, TypeIn, Goal).
 1375omit_meta_qualifiers(when(Cond, QGoal), TypeIn, when(Cond, Goal)) :-
 1376    callable(QGoal),
 1377    !,
 1378    omit_qualifier(QGoal, TypeIn, Goal).
 1379omit_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.

 1388bind_vars(Bindings0, Bindings) :-
 1389    bind_query_vars(Bindings0, Bindings, SNames),
 1390    bind_skel_vars(Bindings, Bindings, SNames, 1, _).
 1391
 1392bind_query_vars([], [], []).
 1393bind_query_vars([binding(Names,Var,[Var2=Cycle])|T0],
 1394                [binding(Names,Cycle,[])|T], [Name|SNames]) :-
 1395    Var == Var2,                   % also implies var(Var)
 1396    !,
 1397    '$last'(Names, Name),
 1398    Var = '$VAR'(Name),
 1399    bind_query_vars(T0, T, SNames).
 1400bind_query_vars([B|T0], [B|T], AllNames) :-
 1401    B = binding(Names,Var,Skel),
 1402    bind_query_vars(T0, T, SNames),
 1403    (   var(Var), \+ attvar(Var), Skel == []
 1404    ->  AllNames = [Name|SNames],
 1405        '$last'(Names, Name),
 1406        Var = '$VAR'(Name)
 1407    ;   AllNames = SNames
 1408    ).
 1409
 1410
 1411
 1412bind_skel_vars([], _, _, N, N).
 1413bind_skel_vars([binding(_,_,Skel)|T], Bindings, SNames, N0, N) :-
 1414    bind_one_skel_vars(Skel, Bindings, SNames, N0, N1),
 1415    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).

 1434bind_one_skel_vars([], _, _, N, N).
 1435bind_one_skel_vars([Var=Value|T], Bindings, Names, N0, N) :-
 1436    (   var(Var)
 1437    ->  (   '$member'(binding(Names, VVal, []), Bindings),
 1438            same_term(Value, VVal)
 1439        ->  '$last'(Names, VName),
 1440            Var = '$VAR'(VName),
 1441            N2 = N0
 1442        ;   between(N0, infinite, N1),
 1443            atom_concat('_S', N1, Name),
 1444            \+ memberchk(Name, Names),
 1445            !,
 1446            Var = '$VAR'(Name),
 1447            N2 is N1 + 1
 1448        )
 1449    ;   N2 = N0
 1450    ),
 1451    bind_one_skel_vars(T, Bindings, Names, N2, N).

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

 1458factorize_bindings([], []).
 1459factorize_bindings([Name=Value|T0], [binding(Name, Skel, Subst)|T]) :-
 1460    '$factorize_term'(Value, Skel, Subst0),
 1461    (   current_prolog_flag(toplevel_print_factorized, true)
 1462    ->  Subst = Subst0
 1463    ;   only_cycles(Subst0, Subst)
 1464    ),
 1465    factorize_bindings(T0, T).
 1466
 1467
 1468only_cycles([], []).
 1469only_cycles([B|T0], List) :-
 1470    (   B = (Var=Value),
 1471        Var = Value,
 1472        acyclic_term(Var)
 1473    ->  only_cycles(T0, List)
 1474    ;   List = [B|T],
 1475        only_cycles(T0, T)
 1476    ).

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

 1485filter_bindings([], []).
 1486filter_bindings([H0|T0], T) :-
 1487    hide_vars(H0, H),
 1488    (   (   arg(1, H, [])
 1489        ;   self_bounded(H)
 1490        )
 1491    ->  filter_bindings(T0, T)
 1492    ;   T = [H|T1],
 1493        filter_bindings(T0, T1)
 1494    ).
 1495
 1496hide_vars(binding(Names0, Skel, Subst), binding(Names, Skel, Subst)) :-
 1497    hide_names(Names0, Skel, Subst, Names).
 1498
 1499hide_names([], _, _, []).
 1500hide_names([Name|T0], Skel, Subst, T) :-
 1501    (   sub_atom(Name, 0, _, _, '_'),
 1502        current_prolog_flag(toplevel_print_anon, false),
 1503        sub_atom(Name, 1, 1, _, Next),
 1504        char_type(Next, prolog_var_start)
 1505    ->  true
 1506    ;   Subst == [],
 1507        Skel == '$VAR'(Name)
 1508    ),
 1509    !,
 1510    hide_names(T0, Skel, Subst, T).
 1511hide_names([Name|T0], Skel, Subst, [Name|T]) :-
 1512    hide_names(T0, Skel, Subst, T).
 1513
 1514self_bounded(binding([Name], Value, [])) :-
 1515    Value == '$VAR'(Name).

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

 1521get_respons(Action) :-
 1522    repeat,
 1523        flush_output(user_output),
 1524        get_single_char(Char),
 1525        answer_respons(Char, Action),
 1526        (   Action == again
 1527        ->  print_message(query, query(action)),
 1528            fail
 1529        ;   !
 1530        ).
 1531
 1532answer_respons(Char, again) :-
 1533    '$in_reply'(Char, '?h'),
 1534    !,
 1535    print_message(help, query(help)).
 1536answer_respons(Char, redo) :-
 1537    '$in_reply'(Char, ';nrNR \t'),
 1538    !,
 1539    print_message(query, if_tty([ansi(bold, ';', [])])).
 1540answer_respons(Char, redo) :-
 1541    '$in_reply'(Char, 'tT'),
 1542    !,
 1543    trace,
 1544    save_debug,
 1545    print_message(query, if_tty([ansi(bold, '; [trace]', [])])).
 1546answer_respons(Char, continue) :-
 1547    '$in_reply'(Char, 'ca\n\ryY.'),
 1548    !,
 1549    print_message(query, if_tty([ansi(bold, '.', [])])).
 1550answer_respons(0'b, show_again) :-
 1551    !,
 1552    break.
 1553answer_respons(Char, show_again) :-
 1554    print_predicate(Char, Pred, Options),
 1555    !,
 1556    print_message(query, if_tty(['~w'-[Pred]])),
 1557    set_prolog_flag(answer_write_options, Options).
 1558answer_respons(-1, show_again) :-
 1559    !,
 1560    print_message(query, halt('EOF')),
 1561    halt(0).
 1562answer_respons(Char, again) :-
 1563    print_message(query, no_action(Char)).
 1564
 1565print_predicate(0'w, [write], [ quoted(true),
 1566                                spacing(next_argument)
 1567                              ]).
 1568print_predicate(0'p, [print], [ quoted(true),
 1569                                portray(true),
 1570                                max_depth(10),
 1571                                spacing(next_argument)
 1572                              ]).
 1573
 1574
 1575                 /*******************************
 1576                 *          EXPANSION           *
 1577                 *******************************/
 1578
 1579:- user:dynamic(expand_query/4). 1580:- user:multifile(expand_query/4). 1581
 1582call_expand_query(Goal, Expanded, Bindings, ExpandedBindings) :-
 1583    user:expand_query(Goal, Expanded, Bindings, ExpandedBindings),
 1584    !.
 1585call_expand_query(Goal, Expanded, Bindings, ExpandedBindings) :-
 1586    toplevel_variables:expand_query(Goal, Expanded, Bindings, ExpandedBindings),
 1587    !.
 1588call_expand_query(Goal, Goal, Bindings, Bindings).
 1589
 1590
 1591:- user:dynamic(expand_answer/2). 1592:- user:multifile(expand_answer/2). 1593
 1594call_expand_answer(Goal, Expanded) :-
 1595    user:expand_answer(Goal, Expanded),
 1596    !.
 1597call_expand_answer(Goal, Expanded) :-
 1598    toplevel_variables:expand_answer(Goal, Expanded),
 1599    !.
 1600call_expand_answer(Goal, Goal)