toplevel.pl

View source with raw comments or as raw

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

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

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

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

   74:- multifile
   75    system:term_expansion/2.   76
   77system:term_expansion((:- version(Message)),
   78                      prolog:version_msg(Message)).
   79
   80version(Message) :-
   81    (   prolog:version_msg(Message)
   82    ->  true
   83    ;   assertz(prolog:version_msg(Message))
   84    ).
   85
   86
   87                /********************************
   88                *         INITIALISATION        *
   89                *********************************/

load_init_file is det: Load the user customization file. This can be done using swipl -f file or simply using swipl. In the first case we search the file both directly and over the alias user_app_config. In the latter case we only use the alias.

   98load_init_file :-
   99    '$cmd_option_val'(init_file, OsFile),
  100    !,
  101    prolog_to_os_filename(File, OsFile),
  102    load_init_file(File, explicit).
  103load_init_file :-
  104    load_init_file('init.pl', implicit).

loaded_init_file(?Base, ?AbsFile): Used by prolog_load_context/2 to confirm we are loading a script.

  110:- dynamic
  111    loaded_init_file/2.             % already loaded init files
  112
  113load_init_file(none, _) :- !.
  114load_init_file(Base, _) :-
  115    loaded_init_file(Base, _),
  116    !.
  117load_init_file(InitFile, explicit) :-
  118    exists_file(InitFile),
  119    !,
  120    ensure_loaded(user:InitFile).
  121load_init_file(Base, _) :-
  122    absolute_file_name(user_app_config(Base), InitFile,
  123                       [ access(read),
  124                         file_errors(fail)
  125                       ]),
  126    asserta(loaded_init_file(Base, InitFile)),
  127    load_files(user:InitFile,
  128               [ scope_settings(false)
  129               ]).
  130load_init_file('init.pl', implicit) :-
  131    (   current_prolog_flag(windows, true),
  132        absolute_file_name(user_profile('swipl.ini'), InitFile,
  133                           [ access(read),
  134                             file_errors(fail)
  135                           ])
  136    ;   expand_file_name('~/.swiplrc', [InitFile]),
  137        exists_file(InitFile)
  138    ),
  139    !,
  140    print_message(warning, backcomp(init_file_moved(InitFile))).
  141load_init_file(_, _).
  142
  143'$load_system_init_file' :-
  144    loaded_init_file(system, _),
  145    !.
  146'$load_system_init_file' :-
  147    '$cmd_option_val'(system_init_file, Base),
  148    Base \== none,
  149    current_prolog_flag(home, Home),
  150    file_name_extension(Base, rc, Name),
  151    atomic_list_concat([Home, '/', Name], File),
  152    absolute_file_name(File, Path,
  153                       [ file_type(prolog),
  154                         access(read),
  155                         file_errors(fail)
  156                       ]),
  157    asserta(loaded_init_file(system, Path)),
  158    load_files(user:Path,
  159               [ silent(true),
  160                 scope_settings(false)
  161               ]),
  162    !.
  163'$load_system_init_file'.
  164
  165'$load_script_file' :-
  166    loaded_init_file(script, _),
  167    !.
  168'$load_script_file' :-
  169    '$cmd_option_val'(script_file, OsFiles),
  170    load_script_files(OsFiles).
  171
  172load_script_files([]).
  173load_script_files([OsFile|More]) :-
  174    prolog_to_os_filename(File, OsFile),
  175    (   absolute_file_name(File, Path,
  176                           [ file_type(prolog),
  177                             access(read),
  178                             file_errors(fail)
  179                           ])
  180    ->  asserta(loaded_init_file(script, Path)),
  181        load_files(user:Path, []),
  182        load_files(More)
  183    ;   throw(error(existence_error(script_file, File), _))
  184    ).
  185
  186
  187                 /*******************************
  188                 *       AT_INITIALISATION      *
  189                 *******************************/
  190
  191:- meta_predicate
  192    initialization(0).  193
  194:- '$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

  203initialization(Goal) :-
  204    Goal = _:G,
  205    prolog:initialize_now(G, Use),
  206    !,
  207    print_message(warning, initialize_now(G, Use)),
  208    initialization(Goal, now).
  209initialization(Goal) :-
  210    initialization(Goal, after_load).
  211
  212:- multifile
  213    prolog:initialize_now/2,
  214    prolog:message//1.  215
  216prolog:initialize_now(load_foreign_library(_),
  217                      'use :- use_foreign_library/1 instead').
  218prolog:initialize_now(load_foreign_library(_,_),
  219                      'use :- use_foreign_library/2 instead').
  220
  221prolog:message(initialize_now(Goal, Use)) -->
  222    [ 'Initialization goal ~p will be executed'-[Goal],nl,
  223      'immediately for backward compatibility reasons', nl,
  224      '~w'-[Use]
  225    ].
  226
  227'$run_initialization' :-
  228    '$run_initialization'(_, []),
  229    '$thread_init'.

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

  236initialize :-
  237    forall('$init_goal'(when(program), Goal, Ctx),
  238           run_initialize(Goal, Ctx)).
  239
  240run_initialize(Goal, Ctx) :-
  241    (   catch(Goal, E, true),
  242        (   var(E)
  243        ->  true
  244        ;   throw(error(initialization_error(E, Goal, Ctx), _))
  245        )
  246    ;   throw(error(initialization_error(failed, Goal, Ctx), _))
  247    ).
  248
  249
  250                 /*******************************
  251                 *     THREAD INITIALIZATION    *
  252                 *******************************/
  253
  254:- meta_predicate
  255    thread_initialization(0).  256:- dynamic
  257    '$at_thread_initialization'/1.

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

  263thread_initialization(Goal) :-
  264    assert('$at_thread_initialization'(Goal)),
  265    call(Goal),
  266    !.
  267
  268'$thread_init' :-
  269    (   '$at_thread_initialization'(Goal),
  270        (   call(Goal)
  271        ->  fail
  272        ;   fail
  273        )
  274    ;   true
  275    ).
  276
  277
  278                 /*******************************
  279                 *     FILE SEARCH PATH (-p)    *
  280                 *******************************/

$set_file_search_paths is det: Process -p PathSpec options.

  286'$set_file_search_paths' :-
  287    '$cmd_option_val'(search_paths, Paths),
  288    (   '$member'(Path, Paths),
  289        atom_chars(Path, Chars),
  290        (   phrase('$search_path'(Name, Aliases), Chars)
  291        ->  '$reverse'(Aliases, Aliases1),
  292            forall('$member'(Alias, Aliases1),
  293                   asserta(user:file_search_path(Name, Alias)))
  294        ;   print_message(error, commandline_arg_type(p, Path))
  295        ),
  296        fail ; true
  297    ).
  298
  299'$search_path'(Name, Aliases) -->
  300    '$string'(NameChars),
  301    [=],
  302    !,
  303    {atom_chars(Name, NameChars)},
  304    '$search_aliases'(Aliases).
  305
  306'$search_aliases'([Alias|More]) -->
  307    '$string'(AliasChars),
  308    path_sep,
  309    !,
  310    { '$make_alias'(AliasChars, Alias) },
  311    '$search_aliases'(More).
  312'$search_aliases'([Alias]) -->
  313    '$string'(AliasChars),
  314    '$eos',
  315    !,
  316    { '$make_alias'(AliasChars, Alias) }.
  317
  318path_sep -->
  319    { current_prolog_flag(windows, true)
  320    },
  321    !,
  322    [;].
  323path_sep -->
  324    [:].
  325
  326'$string'([]) --> [].
  327'$string'([H|T]) --> [H], '$string'(T).
  328
  329'$eos'([], []).
  330
  331'$make_alias'(Chars, Alias) :-
  332    catch(term_to_atom(Alias, Chars), _, fail),
  333    (   atom(Alias)
  334    ;   functor(Alias, F, 1),
  335        F \== /
  336    ),
  337    !.
  338'$make_alias'(Chars, Alias) :-
  339    atom_chars(Alias, Chars).
  340
  341
  342                 /*******************************
  343                 *   LOADING ASSIOCIATED FILES  *
  344                 *******************************/

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

  350argv_files(Files) :-
  351    current_prolog_flag(argv, Argv),
  352    no_option_files(Argv, Argv1, Files, ScriptArgs),
  353    (   (   ScriptArgs == true
  354        ;   Argv1 == []
  355        )
  356    ->  (   Argv1 \== Argv
  357        ->  set_prolog_flag(argv, Argv1)
  358        ;   true
  359        )
  360    ;   '$usage',
  361        halt(1)
  362    ).
  363
  364no_option_files([--|Argv], Argv, [], true) :- !.
  365no_option_files([Opt|_], _, _, ScriptArgs) :-
  366    ScriptArgs \== true,
  367    sub_atom(Opt, 0, _, _, '-'),
  368    !,
  369    '$usage',
  370    halt(1).
  371no_option_files([OsFile|Argv0], Argv, [File|T], ScriptArgs) :-
  372    file_name_extension(_, Ext, OsFile),
  373    user:prolog_file_type(Ext, prolog),
  374    !,
  375    ScriptArgs = true,
  376    prolog_to_os_filename(File, OsFile),
  377    no_option_files(Argv0, Argv, T, ScriptArgs).
  378no_option_files([OsScript|Argv], Argv, [Script], ScriptArgs) :-
  379    ScriptArgs \== true,
  380    !,
  381    prolog_to_os_filename(Script, OsScript),
  382    (   exists_file(Script)
  383    ->  true
  384    ;   '$existence_error'(file, Script)
  385    ),
  386    ScriptArgs = true.
  387no_option_files(Argv, Argv, [], _).
  388
  389clean_argv :-
  390    (   current_prolog_flag(argv, [--|Argv])
  391    ->  set_prolog_flag(argv, Argv)
  392    ;   true
  393    ).

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.

  402associated_files([]) :-
  403    current_prolog_flag(saved_program_class, runtime),
  404    !,
  405    clean_argv.
  406associated_files(Files) :-
  407    '$set_prolog_file_extension',
  408    argv_files(Files),
  409    (   Files = [File|_]
  410    ->  absolute_file_name(File, AbsFile),
  411        set_prolog_flag(associated_file, AbsFile),
  412        set_working_directory(File),
  413        set_window_title(Files)
  414    ;   true
  415    ).

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

  425set_working_directory(File) :-
  426    current_prolog_flag(console_menu, true),
  427    access_file(File, read),
  428    !,
  429    file_directory_name(File, Dir),
  430    working_directory(_, Dir).
  431set_working_directory(_).
  432
  433set_window_title([File|More]) :-
  434    current_predicate(system:window_title/2),
  435    !,
  436    (   More == []
  437    ->  Extra = []
  438    ;   Extra = ['...']
  439    ),
  440    atomic_list_concat(['SWI-Prolog --', File | Extra], ' ', Title),
  441    system:window_title(_, Title).
  442set_window_title(_).

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

  450start_pldoc :-
  451    '$cmd_option_val'(pldoc_server, Server),
  452    (   Server == ''
  453    ->  call((doc_server(_), doc_browser))
  454    ;   catch(atom_number(Server, Port), _, fail)
  455    ->  call(doc_server(Port))
  456    ;   print_message(error, option_usage(pldoc)),
  457        halt(1)
  458    ).
  459start_pldoc.

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

  466load_associated_files(Files) :-
  467    (   '$member'(File, Files),
  468        load_files(user:File, [expand(false)]),
  469        fail
  470    ;   true
  471    ).
  472
  473hkey('HKEY_CURRENT_USER/Software/SWI/Prolog').
  474hkey('HKEY_LOCAL_MACHINE/Software/SWI/Prolog').
  475
  476'$set_prolog_file_extension' :-
  477    current_prolog_flag(windows, true),
  478    hkey(Key),
  479    catch(win_registry_get_value(Key, fileExtension, Ext0),
  480          _, fail),
  481    !,
  482    (   atom_concat('.', Ext, Ext0)
  483    ->  true
  484    ;   Ext = Ext0
  485    ),
  486    (   user:prolog_file_type(Ext, prolog)
  487    ->  true
  488    ;   asserta(user:prolog_file_type(Ext, prolog))
  489    ).
  490'$set_prolog_file_extension'.
  491
  492
  493                /********************************
  494                *        TOPLEVEL GOALS         *
  495                *********************************/

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

  503'$initialise' :-
  504    catch(initialise_prolog, E, initialise_error(E)).
  505
  506initialise_error('$aborted') :- !.
  507initialise_error(E) :-
  508    print_message(error, initialization_exception(E)),
  509    fail.
  510
  511initialise_prolog :-
  512    '$clean_history',
  513    apple_setup_app,
  514    '$run_initialization',
  515    '$load_system_init_file',
  516    set_toplevel,
  517    '$set_file_search_paths',
  518    init_debug_flags,
  519    start_pldoc,
  520    opt_attach_packs,
  521    load_init_file,
  522    catch(setup_colors, E, print_message(warning, E)),
  523    '$load_script_file',
  524    associated_files(Files),
  525    load_associated_files(Files),
  526    '$cmd_option_val'(goals, Goals),
  527    (   Goals == [],
  528        \+ '$init_goal'(when(_), _, _)
  529    ->  version                                 % default interactive run
  530    ;   run_init_goals(Goals),
  531        (   load_only
  532        ->  version
  533        ;   run_program_init,
  534            run_main_init
  535        )
  536    ).
  537
  538:- if(current_prolog_flag(apple,true)).  539apple_set_working_directory :-
  540    (   expand_file_name('~', [Dir]),
  541	exists_directory(Dir)
  542    ->  working_directory(_, Dir)
  543    ;   true
  544    ).
  545
  546apple_set_locale :-
  547    (   getenv('LC_CTYPE', 'UTF-8'),
  548	apple_current_locale_identifier(LocaleID),
  549	atom_concat(LocaleID, '.UTF-8', Locale),
  550	catch(setlocale(ctype, _Old, Locale), _, fail)
  551    ->  setenv('LANG', Locale),
  552        unsetenv('LC_CTYPE')
  553    ;   true
  554    ).
  555
  556apple_setup_app :-
  557    current_prolog_flag(apple, true),
  558    current_prolog_flag(console_menu, true),	% SWI-Prolog.app on MacOS
  559    apple_set_working_directory,
  560    apple_set_locale.
  561:- endif.  562apple_setup_app.
  563
  564opt_attach_packs :-
  565    current_prolog_flag(packs, true),
  566    !,
  567    attach_packs.
  568opt_attach_packs.
  569
  570set_toplevel :-
  571    '$cmd_option_val'(toplevel, TopLevelAtom),
  572    catch(term_to_atom(TopLevel, TopLevelAtom), E,
  573          (print_message(error, E),
  574           halt(1))),
  575    create_prolog_flag(toplevel_goal, TopLevel, [type(term)]).
  576
  577load_only :-
  578    current_prolog_flag(os_argv, OSArgv),
  579    memberchk('-l', OSArgv),
  580    current_prolog_flag(argv, Argv),
  581    \+ memberchk('-l', Argv).

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

  588run_init_goals([]).
  589run_init_goals([H|T]) :-
  590    run_init_goal(H),
  591    run_init_goals(T).
  592
  593run_init_goal(Text) :-
  594    catch(term_to_atom(Goal, Text), E,
  595          (   print_message(error, init_goal_syntax(E, Text)),
  596              halt(2)
  597          )),
  598    run_init_goal(Goal, Text).

run_program_init is det: Run goals registered using

  604run_program_init :-
  605    forall('$init_goal'(when(program), Goal, Ctx),
  606           run_init_goal(Goal, @(Goal,Ctx))).
  607
  608run_main_init :-
  609    findall(Goal-Ctx, '$init_goal'(when(main), Goal, Ctx), Pairs),
  610    '$last'(Pairs, Goal-Ctx),
  611    !,
  612    (   current_prolog_flag(toplevel_goal, default)
  613    ->  set_prolog_flag(toplevel_goal, halt)
  614    ;   true
  615    ),
  616    run_init_goal(Goal, @(Goal,Ctx)).
  617run_main_init.
  618
  619run_init_goal(Goal, Ctx) :-
  620    (   catch_with_backtrace(user:Goal, E, true)
  621    ->  (   var(E)
  622        ->  true
  623        ;   print_message(error, init_goal_failed(E, Ctx)),
  624            halt(2)
  625        )
  626    ;   (   current_prolog_flag(verbose, silent)
  627        ->  Level = silent
  628        ;   Level = error
  629        ),
  630        print_message(Level, init_goal_failed(failed, Ctx)),
  631        halt(1)
  632    ).

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

  639init_debug_flags :-
  640    once(print_predicate(_, [print], PrintOptions)),
  641    Keep = [keep(true)],
  642    create_prolog_flag(answer_write_options, PrintOptions, Keep),
  643    create_prolog_flag(prompt_alternatives_on, determinism, Keep),
  644    create_prolog_flag(toplevel_extra_white_line, true, Keep),
  645    create_prolog_flag(toplevel_print_factorized, false, Keep),
  646    create_prolog_flag(print_write_options,
  647                       [ portray(true), quoted(true), numbervars(true) ],
  648                       Keep),
  649    create_prolog_flag(toplevel_residue_vars, false, Keep),
  650    create_prolog_flag(toplevel_list_wfs_residual_program, true, Keep),
  651    '$set_debugger_write_options'(print).

setup_backtrace: Initialise printing a backtrace.

  657setup_backtrace :-
  658    (   \+ current_prolog_flag(backtrace, false),
  659        load_setup_file(library(prolog_stack))
  660    ->  true
  661    ;   true
  662    ).

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

  668setup_colors :-
  669    (   \+ current_prolog_flag(color_term, false),
  670        stream_property(user_input, tty(true)),
  671        stream_property(user_error, tty(true)),
  672        stream_property(user_output, tty(true)),
  673        \+ getenv('TERM', dumb),
  674        load_setup_file(user:library(ansi_term))
  675    ->  true
  676    ;   true
  677    ).

setup_history: Enable per-directory persistent history.

  683setup_history :-
  684    (   \+ current_prolog_flag(save_history, false),
  685        stream_property(user_input, tty(true)),
  686        \+ current_prolog_flag(readline, false),
  687        load_setup_file(library(prolog_history))
  688    ->  prolog_history(enable)
  689    ;   true
  690    ),
  691    set_default_history,
  692    '$load_history'.

setup_readline: Setup line editing.

  698setup_readline :-
  699    (   current_prolog_flag(readline, swipl_win)
  700    ->  true
  701    ;   stream_property(user_input, tty(true)),
  702        current_prolog_flag(tty_control, true),
  703        \+ getenv('TERM', dumb),
  704        (   current_prolog_flag(readline, ReadLine)
  705        ->  true
  706        ;   ReadLine = true
  707        ),
  708        readline_library(ReadLine, Library),
  709        load_setup_file(library(Library))
  710    ->  set_prolog_flag(readline, Library)
  711    ;   set_prolog_flag(readline, false)
  712    ).
  713
  714readline_library(true, Library) :-
  715    !,
  716    preferred_readline(Library).
  717readline_library(false, _) :-
  718    !,
  719    fail.
  720readline_library(Library, Library).
  721
  722preferred_readline(editline).
  723preferred_readline(readline).

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

  729load_setup_file(File) :-
  730    catch(load_files(File,
  731                     [ silent(true),
  732                       if(not_loaded)
  733                     ]), _, fail).
  734
  735
  736:- '$hide'('$toplevel'/0).              % avoid in the GUI stacktrace

$toplevel: Called from PL_toplevel()

  742'$toplevel' :-
  743    '$runtoplevel',
  744    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

  754'$runtoplevel' :-
  755    current_prolog_flag(toplevel_goal, TopLevel0),
  756    toplevel_goal(TopLevel0, TopLevel),
  757    user:TopLevel.
  758
  759:- dynamic  setup_done/0.  760:- volatile setup_done/0.  761
  762toplevel_goal(default, '$query_loop') :-
  763    !,
  764    setup_interactive.
  765toplevel_goal(prolog, '$query_loop') :-
  766    !,
  767    setup_interactive.
  768toplevel_goal(Goal, Goal).
  769
  770setup_interactive :-
  771    setup_done,
  772    !.
  773setup_interactive :-
  774    asserta(setup_done),
  775    catch(setup_backtrace, E, print_message(warning, E)),
  776    catch(setup_readline,  E, print_message(warning, E)),
  777    catch(setup_history,   E, print_message(warning, E)).

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

  783'$compile' :-
  784    (   catch('$compile_', E, (print_message(error, E), halt(1)))
  785    ->  true
  786    ;   print_message(error, error(goal_failed('$compile'), _)),
  787        halt(1)
  788    ),
  789    halt.                               % set exit code
  790
  791'$compile_' :-
  792    '$load_system_init_file',
  793    catch(setup_colors, _, true),
  794    '$set_file_search_paths',
  795    init_debug_flags,
  796    '$run_initialization',
  797    opt_attach_packs,
  798    use_module(library(qsave)),
  799    qsave:qsave_toplevel.

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

  805'$config' :-
  806    '$load_system_init_file',
  807    '$set_file_search_paths',
  808    init_debug_flags,
  809    '$run_initialization',
  810    load_files(library(prolog_config)),
  811    (   catch(prolog_dump_runtime_variables, E,
  812              (print_message(error, E), halt(1)))
  813    ->  true
  814    ;   print_message(error, error(goal_failed(prolog_dump_runtime_variables),_))
  815    ).
  816
  817
  818                /********************************
  819                *    USER INTERACTIVE LOOP      *
  820                *********************************/

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.

  828prolog :-
  829    break.
  830
  831:- 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).

  840'$query_loop' :-
  841    current_prolog_flag(toplevel_mode, recursive),
  842    !,
  843    break_level(Level),
  844    read_expanded_query(Level, Query, Bindings),
  845    (   Query == end_of_file
  846    ->  print_message(query, query(eof))
  847    ;   '$call_no_catch'('$execute_query'(Query, Bindings, _)),
  848        (   current_prolog_flag(toplevel_mode, recursive)
  849        ->  '$query_loop'
  850        ;   '$switch_toplevel_mode'(backtracking),
  851            '$query_loop'           % Maybe throw('$switch_toplevel_mode')?
  852        )
  853    ).
  854'$query_loop' :-
  855    break_level(BreakLev),
  856    repeat,
  857        read_expanded_query(BreakLev, Query, Bindings),
  858        (   Query == end_of_file
  859        ->  !, print_message(query, query(eof))
  860        ;   '$execute_query'(Query, Bindings, _),
  861            (   current_prolog_flag(toplevel_mode, recursive)
  862            ->  !,
  863                '$switch_toplevel_mode'(recursive),
  864                '$query_loop'
  865            ;   fail
  866            )
  867        ).
  868
  869break_level(BreakLev) :-
  870    (   current_prolog_flag(break_level, BreakLev)
  871    ->  true
  872    ;   BreakLev = -1
  873    ).
  874
  875read_expanded_query(BreakLev, ExpandedQuery, ExpandedBindings) :-
  876    '$current_typein_module'(TypeIn),
  877    (   stream_property(user_input, tty(true))
  878    ->  '$system_prompt'(TypeIn, BreakLev, Prompt),
  879        prompt(Old, '|    ')
  880    ;   Prompt = '',
  881        prompt(Old, '')
  882    ),
  883    trim_stacks,
  884    trim_heap,
  885    repeat,
  886      read_query(Prompt, Query, Bindings),
  887      prompt(_, Old),
  888      catch(call_expand_query(Query, ExpandedQuery,
  889                              Bindings, ExpandedBindings),
  890            Error,
  891            (print_message(error, Error), fail)),
  892    !.

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.

  901read_query(Prompt, Goal, Bindings) :-
  902    current_prolog_flag(history, N),
  903    integer(N), N > 0,
  904    !,
  905    read_term_with_history(
  906        Goal,
  907        [ show(h),
  908          help('!h'),
  909          no_save([trace, end_of_file]),
  910          prompt(Prompt),
  911          variable_names(Bindings)
  912        ]).
  913read_query(Prompt, Goal, Bindings) :-
  914    remove_history_prompt(Prompt, Prompt1),
  915    repeat,                                 % over syntax errors
  916    prompt1(Prompt1),
  917    read_query_line(user_input, Line),
  918    '$save_history_line'(Line),             % save raw line (edit syntax errors)
  919    '$current_typein_module'(TypeIn),
  920    catch(read_term_from_atom(Line, Goal,
  921                              [ variable_names(Bindings),
  922                                module(TypeIn)
  923                              ]), E,
  924          (   print_message(error, E),
  925              fail
  926          )),
  927    !,
  928    '$save_history_event'(Line).            % save event (no syntax errors)

read_query_line(+Input, -Line) is det

  932read_query_line(Input, Line) :-
  933    catch(read_term_as_atom(Input, Line), Error, true),
  934    save_debug_after_read,
  935    (   var(Error)
  936    ->  true
  937    ;   Error = error(syntax_error(_),_)
  938    ->  print_message(error, Error),
  939        fail
  940    ;   print_message(error, Error),
  941        throw(Error)
  942    ).

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

  949read_term_as_atom(In, Line) :-
  950    '$raw_read'(In, Line),
  951    (   Line == end_of_file
  952    ->  true
  953    ;   skip_to_nl(In)
  954    ).

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.

  961skip_to_nl(In) :-
  962    repeat,
  963    peek_char(In, C),
  964    (   C == '%'
  965    ->  skip(In, '\n')
  966    ;   char_type(C, space)
  967    ->  get_char(In, _),
  968        C == '\n'
  969    ;   true
  970    ),
  971    !.
  972
  973remove_history_prompt('', '') :- !.
  974remove_history_prompt(Prompt0, Prompt) :-
  975    atom_chars(Prompt0, Chars0),
  976    clean_history_prompt_chars(Chars0, Chars1),
  977    delete_leading_blanks(Chars1, Chars),
  978    atom_chars(Prompt, Chars).
  979
  980clean_history_prompt_chars([], []).
  981clean_history_prompt_chars(['~', !|T], T) :- !.
  982clean_history_prompt_chars([H|T0], [H|T]) :-
  983    clean_history_prompt_chars(T0, T).
  984
  985delete_leading_blanks([' '|T0], T) :-
  986    !,
  987    delete_leading_blanks(T0, T).
  988delete_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.

  997set_default_history :-
  998    current_prolog_flag(history, _),
  999    !.
 1000set_default_history :-
 1001    (   (   \+ current_prolog_flag(readline, false)
 1002        ;   current_prolog_flag(emacs_inferior_process, true)
 1003        )
 1004    ->  create_prolog_flag(history, 0, [])
 1005    ;   create_prolog_flag(history, 25, [])
 1006    ).
 1007
 1008
 1009                 /*******************************
 1010                 *        TOPLEVEL DEBUG        *
 1011                 *******************************/

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.

 1026save_debug_after_read :-
 1027    current_prolog_flag(debug, true),
 1028    !,
 1029    save_debug.
 1030save_debug_after_read.
 1031
 1032save_debug :-
 1033    (   tracing,
 1034        notrace
 1035    ->  Tracing = true
 1036    ;   Tracing = false
 1037    ),
 1038    current_prolog_flag(debug, Debugging),
 1039    set_prolog_flag(debug, false),
 1040    create_prolog_flag(query_debug_settings,
 1041                       debug(Debugging, Tracing), []).
 1042
 1043restore_debug :-
 1044    current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)),
 1045    set_prolog_flag(debug, Debugging),
 1046    (   Tracing == true
 1047    ->  trace
 1048    ;   true
 1049    ).
 1050
 1051:- initialization
 1052    create_prolog_flag(query_debug_settings, debug(false, false), []). 1053
 1054
 1055                /********************************
 1056                *            PROMPTING          *
 1057                ********************************/
 1058
 1059'$system_prompt'(Module, BrekLev, Prompt) :-
 1060    current_prolog_flag(toplevel_prompt, PAtom),
 1061    atom_codes(PAtom, P0),
 1062    (    Module \== user
 1063    ->   '$substitute'('~m', [Module, ': '], P0, P1)
 1064    ;    '$substitute'('~m', [], P0, P1)
 1065    ),
 1066    (    BrekLev > 0
 1067    ->   '$substitute'('~l', ['[', BrekLev, '] '], P1, P2)
 1068    ;    '$substitute'('~l', [], P1, P2)
 1069    ),
 1070    current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)),
 1071    (    Tracing == true
 1072    ->   '$substitute'('~d', ['[trace] '], P2, P3)
 1073    ;    Debugging == true
 1074    ->   '$substitute'('~d', ['[debug] '], P2, P3)
 1075    ;    '$substitute'('~d', [], P2, P3)
 1076    ),
 1077    atom_chars(Prompt, P3).
 1078
 1079'$substitute'(From, T, Old, New) :-
 1080    atom_codes(From, FromCodes),
 1081    phrase(subst_chars(T), T0),
 1082    '$append'(Pre, S0, Old),
 1083    '$append'(FromCodes, Post, S0) ->
 1084    '$append'(Pre, T0, S1),
 1085    '$append'(S1, Post, New),
 1086    !.
 1087'$substitute'(_, _, Old, Old).
 1088
 1089subst_chars([]) -->
 1090    [].
 1091subst_chars([H|T]) -->
 1092    { atomic(H),
 1093      !,
 1094      atom_codes(H, Codes)
 1095    },
 1096    Codes,
 1097    subst_chars(T).
 1098subst_chars([H|T]) -->
 1099    H,
 1100    subst_chars(T).
 1101
 1102
 1103                /********************************
 1104                *           EXECUTION           *
 1105                ********************************/

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

 1111'$execute_query'(Var, _, true) :-
 1112    var(Var),
 1113    !,
 1114    print_message(informational, var_query(Var)).
 1115'$execute_query'(Goal, Bindings, Truth) :-
 1116    '$current_typein_module'(TypeIn),
 1117    '$dwim_correct_goal'(TypeIn:Goal, Bindings, Corrected),
 1118    !,
 1119    setup_call_cleanup(
 1120        '$set_source_module'(M0, TypeIn),
 1121        expand_goal(Corrected, Expanded),
 1122        '$set_source_module'(M0)),
 1123    print_message(silent, toplevel_goal(Expanded, Bindings)),
 1124    '$execute_goal2'(Expanded, Bindings, Truth).
 1125'$execute_query'(_, _, false) :-
 1126    notrace,
 1127    print_message(query, query(no)).
 1128
 1129'$execute_goal2'(Goal, Bindings, true) :-
 1130    restore_debug,
 1131    '$current_typein_module'(TypeIn),
 1132    residue_vars(TypeIn:Goal, Vars, TypeIn:Delays, Chp),
 1133    deterministic(Det),
 1134    (   save_debug
 1135    ;   restore_debug, fail
 1136    ),
 1137    flush_output(user_output),
 1138    (   Det == true
 1139    ->  DetOrChp = true
 1140    ;   DetOrChp = Chp
 1141    ),
 1142    call_expand_answer(Bindings, NewBindings),
 1143    (    \+ \+ write_bindings(NewBindings, Vars, Delays, DetOrChp)
 1144    ->   !
 1145    ).
 1146'$execute_goal2'(_, _, false) :-
 1147    save_debug,
 1148    print_message(query, query(no)).
 1149
 1150residue_vars(Goal, Vars, Delays, Chp) :-
 1151    current_prolog_flag(toplevel_residue_vars, true),
 1152    !,
 1153    '$wfs_call'(call_residue_vars(stop_backtrace(Goal, Chp), Vars), Delays).
 1154residue_vars(Goal, [], Delays, Chp) :-
 1155    '$wfs_call'(stop_backtrace(Goal, Chp), Delays).
 1156
 1157stop_backtrace(Goal, Chp) :-
 1158    toplevel_call(Goal),
 1159    prolog_current_choice(Chp).
 1160
 1161toplevel_call(Goal) :-
 1162    call(Goal),
 1163    no_lco.
 1164
 1165no_lco.

write_bindings(+Bindings, +ResidueVars, +Delays, +DetOrChp) is semidet

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.

 1181write_bindings(Bindings, ResidueVars, Delays, DetOrChp) :-
 1182    '$current_typein_module'(TypeIn),
 1183    translate_bindings(Bindings, Bindings1, ResidueVars, TypeIn:Residuals),
 1184    omit_qualifier(Delays, TypeIn, Delays1),
 1185    name_vars(Bindings1, Residuals, Delays1),
 1186    write_bindings2(Bindings1, Residuals, Delays1, DetOrChp).
 1187
 1188write_bindings2([], Residuals, Delays, _) :-
 1189    current_prolog_flag(prompt_alternatives_on, groundness),
 1190    !,
 1191    print_message(query, query(yes(Delays, Residuals))).
 1192write_bindings2(Bindings, Residuals, Delays, true) :-
 1193    current_prolog_flag(prompt_alternatives_on, determinism),
 1194    !,
 1195    print_message(query, query(yes(Bindings, Delays, Residuals))).
 1196write_bindings2(Bindings, Residuals, Delays, Chp) :-
 1197    repeat,
 1198        print_message(query, query(more(Bindings, Delays, Residuals))),
 1199        get_respons(Action, Chp),
 1200    (   Action == redo
 1201    ->  !, fail
 1202    ;   Action == show_again
 1203    ->  fail
 1204    ;   !,
 1205        print_message(query, query(done))
 1206    ).
 1207
 1208name_vars(Bindings, Residuals, Delays) :-
 1209    current_prolog_flag(toplevel_name_variables, true),
 1210    !,
 1211    '$term_multitons'(t(Bindings,Residuals,Delays), Vars),
 1212    name_vars_(Vars, Bindings, 0),
 1213    term_variables(t(Bindings,Residuals,Delays), SVars),
 1214    anon_vars(SVars).
 1215name_vars(_Bindings, _Residuals, _Delays).
 1216
 1217name_vars_([], _, _).
 1218name_vars_([H|T], Bindings, N) :-
 1219    name_var(Bindings, Name, N, N1),
 1220    H = '$VAR'(Name),
 1221    name_vars_(T, Bindings, N1).
 1222
 1223anon_vars([]).
 1224anon_vars(['$VAR'('_')|T]) :-
 1225    anon_vars(T).
 1226
 1227name_var(Bindings, Name, N0, N) :-
 1228    between(N0, infinite, N1),
 1229    I is N1//26,
 1230    J is 0'A + N1 mod 26,
 1231    (   I == 0
 1232    ->  format(atom(Name), '_~c', [J])
 1233    ;   format(atom(Name), '_~c~d', [J, I])
 1234    ),
 1235    (   current_prolog_flag(toplevel_print_anon, false)
 1236    ->  true
 1237    ;   \+ is_bound(Bindings, Name)
 1238    ),
 1239    !,
 1240    N is N1+1.
 1241
 1242is_bound([Vars=_|T], Name) :-
 1243    (   in_vars(Vars, Name)
 1244    ->  true
 1245    ;   is_bound(T, Name)
 1246    ).
 1247
 1248in_vars(Name, Name) :- !.
 1249in_vars(Names, Name) :-
 1250    '$member'(Name, Names).

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

 1257:- multifile
 1258    residual_goal_collector/1. 1259
 1260:- meta_predicate
 1261    residual_goals(2). 1262
 1263residual_goals(NonTerminal) :-
 1264    throw(error(context_error(nodirective, residual_goals(NonTerminal)), _)).
 1265
 1266system:term_expansion((:- residual_goals(NonTerminal)),
 1267                      '$toplevel':residual_goal_collector(M2:Head)) :-
 1268    \+ current_prolog_flag(xref, true),
 1269    prolog_load_context(module, M),
 1270    strip_module(M:NonTerminal, M2, Head),
 1271    '$must_be'(callable, Head).

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

 1278:- public prolog:residual_goals//0. 1279
 1280prolog:residual_goals -->
 1281    { findall(NT, residual_goal_collector(NT), NTL) },
 1282    collect_residual_goals(NTL).
 1283
 1284collect_residual_goals([]) --> [].
 1285collect_residual_goals([H|T]) -->
 1286    ( call(H) -> [] ; [] ),
 1287    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.

 1312:- public
 1313    prolog:translate_bindings/5. 1314:- meta_predicate
 1315    prolog:translate_bindings(+, -, +, +, :). 1316
 1317prolog:translate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals) :-
 1318    translate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals).
 1319
 1320translate_bindings(Bindings0, Bindings, ResidueVars, Residuals) :-
 1321    prolog:residual_goals(ResidueGoals, []),
 1322    translate_bindings(Bindings0, Bindings, ResidueVars, ResidueGoals,
 1323                       Residuals).
 1324
 1325translate_bindings(Bindings0, Bindings, [], [], _:[]-[]) :-
 1326    term_attvars(Bindings0, []),
 1327    !,
 1328    join_same_bindings(Bindings0, Bindings1),
 1329    factorize_bindings(Bindings1, Bindings2),
 1330    bind_vars(Bindings2, Bindings3),
 1331    filter_bindings(Bindings3, Bindings).
 1332translate_bindings(Bindings0, Bindings, ResidueVars, ResGoals0,
 1333                   TypeIn:Residuals-HiddenResiduals) :-
 1334    project_constraints(Bindings0, ResidueVars),
 1335    hidden_residuals(ResidueVars, Bindings0, HiddenResiduals0),
 1336    omit_qualifiers(HiddenResiduals0, TypeIn, HiddenResiduals),
 1337    copy_term(Bindings0+ResGoals0, Bindings1+ResGoals1, Residuals0),
 1338    '$append'(ResGoals1, Residuals0, Residuals1),
 1339    omit_qualifiers(Residuals1, TypeIn, Residuals),
 1340    join_same_bindings(Bindings1, Bindings2),
 1341    factorize_bindings(Bindings2, Bindings3),
 1342    bind_vars(Bindings3, Bindings4),
 1343    filter_bindings(Bindings4, Bindings).
 1344
 1345hidden_residuals(ResidueVars, Bindings, Goal) :-
 1346    term_attvars(ResidueVars, Remaining),
 1347    term_attvars(Bindings, QueryVars),
 1348    subtract_vars(Remaining, QueryVars, HiddenVars),
 1349    copy_term(HiddenVars, _, Goal).
 1350
 1351subtract_vars(All, Subtract, Remaining) :-
 1352    sort(All, AllSorted),
 1353    sort(Subtract, SubtractSorted),
 1354    ord_subtract(AllSorted, SubtractSorted, Remaining).
 1355
 1356ord_subtract([], _Not, []).
 1357ord_subtract([H1|T1], L2, Diff) :-
 1358    diff21(L2, H1, T1, Diff).
 1359
 1360diff21([], H1, T1, [H1|T1]).
 1361diff21([H2|T2], H1, T1, Diff) :-
 1362    compare(Order, H1, H2),
 1363    diff3(Order, H1, T1, H2, T2, Diff).
 1364
 1365diff12([], _H2, _T2, []).
 1366diff12([H1|T1], H2, T2, Diff) :-
 1367    compare(Order, H1, H2),
 1368    diff3(Order, H1, T1, H2, T2, Diff).
 1369
 1370diff3(<,  H1, T1,  H2, T2, [H1|Diff]) :-
 1371    diff12(T1, H2, T2, Diff).
 1372diff3(=, _H1, T1, _H2, T2, Diff) :-
 1373    ord_subtract(T1, T2, Diff).
 1374diff3(>,  H1, T1, _H2, T2, Diff) :-
 1375    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.

 1383project_constraints(Bindings, ResidueVars) :-
 1384    !,
 1385    term_attvars(Bindings, AttVars),
 1386    phrase(attribute_modules(AttVars), Modules0),
 1387    sort(Modules0, Modules),
 1388    term_variables(Bindings, QueryVars),
 1389    project_attributes(Modules, QueryVars, ResidueVars).
 1390project_constraints(_, _).
 1391
 1392project_attributes([], _, _).
 1393project_attributes([M|T], QueryVars, ResidueVars) :-
 1394    (   current_predicate(M:project_attributes/2),
 1395        catch(M:project_attributes(QueryVars, ResidueVars), E,
 1396              print_message(error, E))
 1397    ->  true
 1398    ;   true
 1399    ),
 1400    project_attributes(T, QueryVars, ResidueVars).
 1401
 1402attribute_modules([]) --> [].
 1403attribute_modules([H|T]) -->
 1404    { get_attrs(H, Attrs) },
 1405    attrs_modules(Attrs),
 1406    attribute_modules(T).
 1407
 1408attrs_modules([]) --> [].
 1409attrs_modules(att(Module, _, More)) -->
 1410    [Module],
 1411    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.

 1422join_same_bindings([], []).
 1423join_same_bindings([Name=V0|T0], [[Name|Names]=V|T]) :-
 1424    take_same_bindings(T0, V0, V, Names, T1),
 1425    join_same_bindings(T1, T).
 1426
 1427take_same_bindings([], Val, Val, [], []).
 1428take_same_bindings([Name=V1|T0], V0, V, [Name|Names], T) :-
 1429    V0 == V1,
 1430    !,
 1431    take_same_bindings(T0, V1, V, Names, T).
 1432take_same_bindings([Pair|T0], V0, V, Names, [Pair|T]) :-
 1433    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.

 1442omit_qualifiers([], _, []).
 1443omit_qualifiers([Goal0|Goals0], TypeIn, [Goal|Goals]) :-
 1444    omit_qualifier(Goal0, TypeIn, Goal),
 1445    omit_qualifiers(Goals0, TypeIn, Goals).
 1446
 1447omit_qualifier(M:G0, TypeIn, G) :-
 1448    M == TypeIn,
 1449    !,
 1450    omit_meta_qualifiers(G0, TypeIn, G).
 1451omit_qualifier(M:G0, TypeIn, G) :-
 1452    predicate_property(TypeIn:G0, imported_from(M)),
 1453    \+ predicate_property(G0, transparent),
 1454    !,
 1455    G0 = G.
 1456omit_qualifier(_:G0, _, G) :-
 1457    predicate_property(G0, built_in),
 1458    \+ predicate_property(G0, transparent),
 1459    !,
 1460    G0 = G.
 1461omit_qualifier(M:G0, _, M:G) :-
 1462    atom(M),
 1463    !,
 1464    omit_meta_qualifiers(G0, M, G).
 1465omit_qualifier(G0, TypeIn, G) :-
 1466    omit_meta_qualifiers(G0, TypeIn, G).
 1467
 1468omit_meta_qualifiers(V, _, V) :-
 1469    var(V),
 1470    !.
 1471omit_meta_qualifiers((QA,QB), TypeIn, (A,B)) :-
 1472    !,
 1473    omit_qualifier(QA, TypeIn, A),
 1474    omit_qualifier(QB, TypeIn, B).
 1475omit_meta_qualifiers(tnot(QA), TypeIn, tnot(A)) :-
 1476    !,
 1477    omit_qualifier(QA, TypeIn, A).
 1478omit_meta_qualifiers(freeze(V, QGoal), TypeIn, freeze(V, Goal)) :-
 1479    callable(QGoal),
 1480    !,
 1481    omit_qualifier(QGoal, TypeIn, Goal).
 1482omit_meta_qualifiers(when(Cond, QGoal), TypeIn, when(Cond, Goal)) :-
 1483    callable(QGoal),
 1484    !,
 1485    omit_qualifier(QGoal, TypeIn, Goal).
 1486omit_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.

 1495bind_vars(Bindings0, Bindings) :-
 1496    bind_query_vars(Bindings0, Bindings, SNames),
 1497    bind_skel_vars(Bindings, Bindings, SNames, 1, _).
 1498
 1499bind_query_vars([], [], []).
 1500bind_query_vars([binding(Names,Var,[Var2=Cycle])|T0],
 1501                [binding(Names,Cycle,[])|T], [Name|SNames]) :-
 1502    Var == Var2,                   % also implies var(Var)
 1503    !,
 1504    '$last'(Names, Name),
 1505    Var = '$VAR'(Name),
 1506    bind_query_vars(T0, T, SNames).
 1507bind_query_vars([B|T0], [B|T], AllNames) :-
 1508    B = binding(Names,Var,Skel),
 1509    bind_query_vars(T0, T, SNames),
 1510    (   var(Var), \+ attvar(Var), Skel == []
 1511    ->  AllNames = [Name|SNames],
 1512        '$last'(Names, Name),
 1513        Var = '$VAR'(Name)
 1514    ;   AllNames = SNames
 1515    ).
 1516
 1517
 1518
 1519bind_skel_vars([], _, _, N, N).
 1520bind_skel_vars([binding(_,_,Skel)|T], Bindings, SNames, N0, N) :-
 1521    bind_one_skel_vars(Skel, Bindings, SNames, N0, N1),
 1522    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).

 1541bind_one_skel_vars([], _, _, N, N).
 1542bind_one_skel_vars([Var=Value|T], Bindings, Names, N0, N) :-
 1543    (   var(Var)
 1544    ->  (   '$member'(binding(Names, VVal, []), Bindings),
 1545            same_term(Value, VVal)
 1546        ->  '$last'(Names, VName),
 1547            Var = '$VAR'(VName),
 1548            N2 = N0
 1549        ;   between(N0, infinite, N1),
 1550            atom_concat('_S', N1, Name),
 1551            \+ memberchk(Name, Names),
 1552            !,
 1553            Var = '$VAR'(Name),
 1554            N2 is N1 + 1
 1555        )
 1556    ;   N2 = N0
 1557    ),
 1558    bind_one_skel_vars(T, Bindings, Names, N2, N).

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

 1565factorize_bindings([], []).
 1566factorize_bindings([Name=Value|T0], [binding(Name, Skel, Subst)|T]) :-
 1567    '$factorize_term'(Value, Skel, Subst0),
 1568    (   current_prolog_flag(toplevel_print_factorized, true)
 1569    ->  Subst = Subst0
 1570    ;   only_cycles(Subst0, Subst)
 1571    ),
 1572    factorize_bindings(T0, T).
 1573
 1574
 1575only_cycles([], []).
 1576only_cycles([B|T0], List) :-
 1577    (   B = (Var=Value),
 1578        Var = Value,
 1579        acyclic_term(Var)
 1580    ->  only_cycles(T0, List)
 1581    ;   List = [B|T],
 1582        only_cycles(T0, T)
 1583    ).

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

 1592filter_bindings([], []).
 1593filter_bindings([H0|T0], T) :-
 1594    hide_vars(H0, H),
 1595    (   (   arg(1, H, [])
 1596        ;   self_bounded(H)
 1597        )
 1598    ->  filter_bindings(T0, T)
 1599    ;   T = [H|T1],
 1600        filter_bindings(T0, T1)
 1601    ).
 1602
 1603hide_vars(binding(Names0, Skel, Subst), binding(Names, Skel, Subst)) :-
 1604    hide_names(Names0, Skel, Subst, Names).
 1605
 1606hide_names([], _, _, []).
 1607hide_names([Name|T0], Skel, Subst, T) :-
 1608    (   sub_atom(Name, 0, _, _, '_'),
 1609        current_prolog_flag(toplevel_print_anon, false),
 1610        sub_atom(Name, 1, 1, _, Next),
 1611        char_type(Next, prolog_var_start)
 1612    ->  true
 1613    ;   Subst == [],
 1614        Skel == '$VAR'(Name)
 1615    ),
 1616    !,
 1617    hide_names(T0, Skel, Subst, T).
 1618hide_names([Name|T0], Skel, Subst, [Name|T]) :-
 1619    hide_names(T0, Skel, Subst, T).
 1620
 1621self_bounded(binding([Name], Value, [])) :-
 1622    Value == '$VAR'(Name).

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

 1628get_respons(Action, Chp) :-
 1629    repeat,
 1630        flush_output(user_output),
 1631        get_single_char(Char),
 1632        answer_respons(Char, Chp, Action),
 1633        (   Action == again
 1634        ->  print_message(query, query(action)),
 1635            fail
 1636        ;   !
 1637        ).
 1638
 1639answer_respons(Char, _, again) :-
 1640    '$in_reply'(Char, '?h'),
 1641    !,
 1642    print_message(help, query(help)).
 1643answer_respons(Char, _, redo) :-
 1644    '$in_reply'(Char, ';nrNR \t'),
 1645    !,
 1646    print_message(query, if_tty([ansi(bold, ';', [])])).
 1647answer_respons(Char, _, redo) :-
 1648    '$in_reply'(Char, 'tT'),
 1649    !,
 1650    trace,
 1651    save_debug,
 1652    print_message(query, if_tty([ansi(bold, '; [trace]', [])])).
 1653answer_respons(Char, _, continue) :-
 1654    '$in_reply'(Char, 'ca\n\ryY.'),
 1655    !,
 1656    print_message(query, if_tty([ansi(bold, '.', [])])).
 1657answer_respons(0'b, _, show_again) :-
 1658    !,
 1659    break.
 1660answer_respons(0'*, Chp, show_again) :-
 1661    !,
 1662    print_last_chpoint(Chp).
 1663answer_respons(Char, _, show_again) :-
 1664    print_predicate(Char, Pred, Options),
 1665    !,
 1666    print_message(query, if_tty(['~w'-[Pred]])),
 1667    set_prolog_flag(answer_write_options, Options).
 1668answer_respons(-1, _, show_again) :-
 1669    !,
 1670    print_message(query, halt('EOF')),
 1671    halt(0).
 1672answer_respons(Char, _, again) :-
 1673    print_message(query, no_action(Char)).
 1674
 1675print_predicate(0'w, [write], [ quoted(true),
 1676                                spacing(next_argument)
 1677                              ]).
 1678print_predicate(0'p, [print], [ quoted(true),
 1679                                portray(true),
 1680                                max_depth(10),
 1681                                spacing(next_argument)
 1682                              ]).
 1683
 1684
 1685print_last_chpoint(Chp) :-
 1686    current_predicate(print_last_choice_point/0),
 1687    !,
 1688    print_last_chpoint_(Chp).
 1689print_last_chpoint(Chp) :-
 1690    use_module(library(prolog_stack), [print_last_choicepoint/2]),
 1691    print_last_chpoint_(Chp).
 1692
 1693print_last_chpoint_(Chp) :-
 1694    print_last_choicepoint(Chp, [message_level(information)]).
 1695
 1696
 1697                 /*******************************
 1698                 *          EXPANSION           *
 1699                 *******************************/
 1700
 1701:- user:dynamic(expand_query/4). 1702:- user:multifile(expand_query/4). 1703
 1704call_expand_query(Goal, Expanded, Bindings, ExpandedBindings) :-
 1705    user:expand_query(Goal, Expanded, Bindings, ExpandedBindings),
 1706    !.
 1707call_expand_query(Goal, Expanded, Bindings, ExpandedBindings) :-
 1708    toplevel_variables:expand_query(Goal, Expanded, Bindings, ExpandedBindings),
 1709    !.
 1710call_expand_query(Goal, Goal, Bindings, Bindings).
 1711
 1712
 1713:- user:dynamic(expand_answer/2). 1714:- user:multifile(expand_answer/2). 1715
 1716call_expand_answer(Goal, Expanded) :-
 1717    user:expand_answer(Goal, Expanded),
 1718    !.
 1719call_expand_answer(Goal, Expanded) :-
 1720    toplevel_variables:expand_answer(Goal, Expanded),
 1721    !.
 1722call_expand_answer(Goal, Goal)