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    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    create_prolog_flag(answer_write_options, PrintOptions, []),
  600    create_prolog_flag(prompt_alternatives_on, determinism, []),
  601    create_prolog_flag(toplevel_extra_white_line, true, []),
  602    create_prolog_flag(toplevel_print_factorized, false, []),
  603    create_prolog_flag(print_write_options,
  604                       [ portray(true), quoted(true), numbervars(true) ],
  605                       []),
  606    create_prolog_flag(toplevel_residue_vars, false, []),
  607    create_prolog_flag(toplevel_list_wfs_residual_program, true, []),
  608    '$set_debugger_write_options'(print).

setup_backtrace: Initialise printing a backtrace.

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

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

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

setup_history: Enable per-directory persistent history.

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

setup_readline: Setup line editing.

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

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

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

$toplevel: Called from PL_toplevel()

  699'$toplevel' :-
  700    '$runtoplevel',
  701    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

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

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

  740'$compile' :-
  741    (   catch('$compile_', E, (print_message(error, E), halt(1)))
  742    ->  true
  743    ;   print_message(error, error(goal_failed('$compile'), _)),
  744        halt(1)
  745    ).
  746
  747'$compile_' :-
  748    '$load_system_init_file',
  749    '$set_file_search_paths',
  750    init_debug_flags,
  751    '$run_initialization',
  752    opt_attach_packs,
  753    use_module(library(qsave)),
  754    qsave:qsave_toplevel.

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

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

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.

  783prolog :-
  784    break.
  785
  786:- 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).

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

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.

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

read_query_line(+Input, -Line) is det

  881read_query_line(Input, Line) :-
  882    catch(read_term_as_atom(Input, Line), Error, true),
  883    save_debug_after_read,
  884    (   var(Error)
  885    ->  true
  886    ;   Error = error(syntax_error(_),_)
  887    ->  print_message(error, Error),
  888        fail
  889    ;   print_message(error, Error),
  890        throw(Error)
  891    ).

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

  898read_term_as_atom(In, Line) :-
  899    '$raw_read'(In, Line),
  900    (   Line == end_of_file
  901    ->  true
  902    ;   skip_to_nl(In)
  903    ).

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.

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

  946set_default_history :-
  947    current_prolog_flag(history, _),
  948    !.
  949set_default_history :-
  950    (   (   \+ current_prolog_flag(readline, false)
  951        ;   current_prolog_flag(emacs_inferior_process, true)
  952        )
  953    ->  create_prolog_flag(history, 0, [])
  954    ;   create_prolog_flag(history, 25, [])
  955    ).
  956
  957
  958                 /*******************************
  959                 *        TOPLEVEL DEBUG        *
  960                 *******************************/

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.

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

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

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

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

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

 1157:- multifile
 1158    residual_goal_collector/1. 1159
 1160:- meta_predicate
 1161    residual_goals(2). 1162
 1163residual_goals(NonTerminal) :-
 1164    throw(error(context_error(nodirective, residual_goals(NonTerminal)), _)).
 1165
 1166system:term_expansion((:- residual_goals(NonTerminal)),
 1167                      '$toplevel':residual_goal_collector(M2:Head)) :-
 1168    prolog_load_context(module, M),
 1169    strip_module(M:NonTerminal, M2, Head),
 1170    '$must_be'(callable, Head).

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

 1177:- public prolog:residual_goals//0. 1178
 1179prolog:residual_goals -->
 1180    { findall(NT, residual_goal_collector(NT), NTL) },
 1181    collect_residual_goals(NTL).
 1182
 1183collect_residual_goals([]) --> [].
 1184collect_residual_goals([H|T]) -->
 1185    ( call(H) -> [] ; [] ),
 1186    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.

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

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

 1321join_same_bindings([], []).
 1322join_same_bindings([Name=V0|T0], [[Name|Names]=V|T]) :-
 1323    take_same_bindings(T0, V0, V, Names, T1),
 1324    join_same_bindings(T1, T).
 1325
 1326take_same_bindings([], Val, Val, [], []).
 1327take_same_bindings([Name=V1|T0], V0, V, [Name|Names], T) :-
 1328    V0 == V1,
 1329    !,
 1330    take_same_bindings(T0, V1, V, Names, T).
 1331take_same_bindings([Pair|T0], V0, V, Names, [Pair|T]) :-
 1332    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.

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

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

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

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

 1464factorize_bindings([], []).
 1465factorize_bindings([Name=Value|T0], [binding(Name, Skel, Subst)|T]) :-
 1466    '$factorize_term'(Value, Skel, Subst0),
 1467    (   current_prolog_flag(toplevel_print_factorized, true)
 1468    ->  Subst = Subst0
 1469    ;   only_cycles(Subst0, Subst)
 1470    ),
 1471    factorize_bindings(T0, T).
 1472
 1473
 1474only_cycles([], []).
 1475only_cycles([B|T0], List) :-
 1476    (   B = (Var=Value),
 1477        Var = Value,
 1478        acyclic_term(Var)
 1479    ->  only_cycles(T0, List)
 1480    ;   List = [B|T],
 1481        only_cycles(T0, T)
 1482    ).

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

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

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

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