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            residual_goals/1,           % +Callable
   47            (initialization)/1,         % initialization goal (directive)
   48            '$thread_init'/0,           % initialise thread
   49            (thread_initialization)/1   % thread initialization goal
   50            ]).   51
   52
   53                 /*******************************
   54                 *       FILE_SEARCH_PATH       *
   55                 *******************************/
   56
   57:- multifile user:file_search_path/2.   58
   59user:file_search_path(app_data, PrologAppData) :-
   60    (   current_prolog_flag(windows, true)
   61    ->  catch(win_folder(appdata, AppData), _, fail),
   62        atom_concat(AppData, '/SWI-Prolog', PrologAppData),
   63        (   exists_directory(PrologAppData)
   64        ->  true
   65        ;   catch(make_directory(PrologAppData), _, fail)
   66        )
   67    ;   catch(expand_file_name('~/lib/swipl', [PrologAppData]), _, fail)
   68    ).
   69user:file_search_path(app_preferences, Preferences) :-
   70    (   current_prolog_flag(windows, true)
   71    ->  Preferences = app_data('.')
   72    ;   catch(expand_file_name(~, [UserHome]), _, fail)
   73    ->  Preferences = UserHome
   74    ).
   75user:file_search_path(user_profile, app_preferences('.')).
   76
   77
   78                 /*******************************
   79                 *         VERSION BANNER       *
   80                 *******************************/
   81
   82:- dynamic
   83    prolog:version_msg/1.

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

   90version :-
   91    print_message(banner, welcome).

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

   97:- multifile
   98    system:term_expansion/2.   99
  100system:term_expansion((:- version(Message)),
  101                      prolog:version_msg(Message)).
  102
  103version(Message) :-
  104    (   prolog:version_msg(Message)
  105    ->  true
  106    ;   assertz(prolog:version_msg(Message))
  107    ).
  108
  109
  110                /********************************
  111                *         INITIALISATION        *
  112                *********************************/
  113
  114%       note: loaded_init_file/2 is used by prolog_load_context/2 to
  115%       confirm we are loading a script.
  116
  117:- dynamic
  118    loaded_init_file/2.             % already loaded init files
  119
  120'$load_init_file'(none) :- !.
  121'$load_init_file'(Base) :-
  122    loaded_init_file(Base, _),
  123    !.
  124'$load_init_file'(InitFile) :-
  125    exists_file(InitFile),
  126    !,
  127    ensure_loaded(user:InitFile).
  128'$load_init_file'(Base) :-
  129    absolute_file_name(user_profile(Base), InitFile,
  130                       [ access(read),
  131                         file_errors(fail)
  132                       ]),
  133    asserta(loaded_init_file(Base, InitFile)),
  134    load_files(user:InitFile,
  135               [ scope_settings(false)
  136               ]).
  137'$load_init_file'(_).
  138
  139'$load_system_init_file' :-
  140    loaded_init_file(system, _),
  141    !.
  142'$load_system_init_file' :-
  143    '$cmd_option_val'(system_init_file, Base),
  144    Base \== none,
  145    current_prolog_flag(home, Home),
  146    file_name_extension(Base, rc, Name),
  147    atomic_list_concat([Home, '/', Name], File),
  148    absolute_file_name(File, Path,
  149                       [ file_type(prolog),
  150                         access(read),
  151                         file_errors(fail)
  152                       ]),
  153    asserta(loaded_init_file(system, Path)),
  154    load_files(user:Path,
  155               [ silent(true),
  156                 scope_settings(false)
  157               ]),
  158    !.
  159'$load_system_init_file'.
  160
  161'$load_script_file' :-
  162    loaded_init_file(script, _),
  163    !.
  164'$load_script_file' :-
  165    '$cmd_option_val'(script_file, OsFiles),
  166    load_script_files(OsFiles).
  167
  168load_script_files([]).
  169load_script_files([OsFile|More]) :-
  170    prolog_to_os_filename(File, OsFile),
  171    (   absolute_file_name(File, Path,
  172                           [ file_type(prolog),
  173                             access(read),
  174                             file_errors(fail)
  175                           ])
  176    ->  asserta(loaded_init_file(script, Path)),
  177        load_files(user:Path, []),
  178        load_files(More)
  179    ;   throw(error(existence_error(script_file, File), _))
  180    ).
  181
  182
  183                 /*******************************
  184                 *       AT_INITIALISATION      *
  185                 *******************************/
  186
  187:- meta_predicate
  188    initialization(0).  189
  190:- '$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

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

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

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

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

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

$set_file_search_paths is det: Process -p PathSpec options.

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

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

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

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.

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

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

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

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

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

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

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

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

  499'$initialise' :-
  500    catch(initialise_prolog, E, initialise_error(E)).
  501
  502initialise_error('$aborted') :- !.
  503initialise_error(E) :-
  504    print_message(error, initialization_exception(E)),
  505    fail.
  506
  507initialise_prolog :-
  508    '$clean_history',
  509    '$run_initialization',
  510    '$load_system_init_file',
  511    set_toplevel,
  512    '$set_file_search_paths',
  513    init_debug_flags,
  514    start_pldoc,
  515    attach_packs,
  516    '$cmd_option_val'(init_file, OsFile),
  517    prolog_to_os_filename(File, OsFile),
  518    '$load_init_file'(File),
  519    catch(setup_colors, E, print_message(warning, E)),
  520    '$load_script_file',
  521    associated_files(Files),
  522    load_associated_files(Files),
  523    '$cmd_option_val'(goals, Goals),
  524    (   Goals == [],
  525        \+ '$init_goal'(when(_), _, _)
  526    ->  version                                 % default interactive run
  527    ;   run_init_goals(Goals),
  528        (   load_only
  529        ->  version
  530        ;   run_program_init,
  531            run_main_init
  532        )
  533    ).
  534
  535set_toplevel :-
  536    '$cmd_option_val'(toplevel, TopLevelAtom),
  537    catch(term_to_atom(TopLevel, TopLevelAtom), E,
  538          (print_message(error, E),
  539           halt(1))),
  540    create_prolog_flag(toplevel_goal, TopLevel, [type(term)]).
  541
  542load_only :-
  543    current_prolog_flag(os_argv, OSArgv),
  544    memberchk('-l', OSArgv),
  545    current_prolog_flag(argv, Argv),
  546    \+ memberchk('-l', Argv).

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

  553run_init_goals([]).
  554run_init_goals([H|T]) :-
  555    run_init_goal(H),
  556    run_init_goals(T).
  557
  558run_init_goal(Text) :-
  559    catch(term_to_atom(Goal, Text), E,
  560          (   print_message(error, init_goal_syntax(E, Text)),
  561              halt(2)
  562          )),
  563    run_init_goal(Goal, Text).

run_program_init is det: Run goals registered using

  569run_program_init :-
  570    forall('$init_goal'(when(program), Goal, Ctx),
  571           run_init_goal(Goal, @(Goal,Ctx))).
  572
  573run_main_init :-
  574    findall(Goal-Ctx, '$init_goal'(when(main), Goal, Ctx), Pairs),
  575    '$last'(Pairs, Goal-Ctx),
  576    !,
  577    (   current_prolog_flag(toplevel_goal, default)
  578    ->  set_prolog_flag(toplevel_goal, halt)
  579    ;   true
  580    ),
  581    run_init_goal(Goal, @(Goal,Ctx)).
  582run_main_init.
  583
  584run_init_goal(Goal, Ctx) :-
  585    (   catch_with_backtrace(user:Goal, E, true)
  586    ->  (   var(E)
  587        ->  true
  588        ;   print_message(error, init_goal_failed(E, Ctx)),
  589            halt(2)
  590        )
  591    ;   (   current_prolog_flag(verbose, silent)
  592        ->  Level = silent
  593        ;   Level = error
  594        ),
  595        print_message(Level, init_goal_failed(failed, Ctx)),
  596        halt(1)
  597    ).

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

  604init_debug_flags :-
  605    once(print_predicate(_, [print], PrintOptions)),
  606    create_prolog_flag(answer_write_options, PrintOptions, []),
  607    create_prolog_flag(prompt_alternatives_on, determinism, []),
  608    create_prolog_flag(toplevel_extra_white_line, true, []),
  609    create_prolog_flag(toplevel_print_factorized, false, []),
  610    create_prolog_flag(print_write_options,
  611                       [ portray(true), quoted(true), numbervars(true) ],
  612                       []),
  613    create_prolog_flag(toplevel_residue_vars, false, []),
  614    create_prolog_flag(toplevel_list_wfs_residual_program, true, []),
  615    '$set_debugger_write_options'(print).

setup_backtrace: Initialise printing a backtrace.

  621setup_backtrace :-
  622    (   \+ current_prolog_flag(backtrace, false),
  623        load_setup_file(library(prolog_stack))
  624    ->  true
  625    ;   true
  626    ).

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

  632setup_colors :-
  633    (   \+ current_prolog_flag(color_term, false),
  634        stream_property(user_input, tty(true)),
  635        stream_property(user_error, tty(true)),
  636        stream_property(user_output, tty(true)),
  637        \+ getenv('TERM', dumb),
  638        load_setup_file(user:library(ansi_term))
  639    ->  true
  640    ;   true
  641    ).

setup_history: Enable per-directory persistent history.

  647setup_history :-
  648    (   \+ current_prolog_flag(save_history, false),
  649        stream_property(user_input, tty(true)),
  650        \+ current_prolog_flag(readline, false),
  651        load_setup_file(library(prolog_history))
  652    ->  prolog_history(enable)
  653    ;   true
  654    ),
  655    set_default_history,
  656    '$load_history'.

setup_readline: Setup line editing.

  662setup_readline :-
  663    (   current_prolog_flag(readline, swipl_win)
  664    ->  true
  665    ;   stream_property(user_input, tty(true)),
  666        current_prolog_flag(tty_control, true),
  667        \+ getenv('TERM', dumb),
  668        (   current_prolog_flag(readline, ReadLine)
  669        ->  true
  670        ;   ReadLine = true
  671        ),
  672        readline_library(ReadLine, Library),
  673        load_setup_file(library(Library))
  674    ->  set_prolog_flag(readline, Library)
  675    ;   set_prolog_flag(readline, false)
  676    ).
  677
  678readline_library(true, Library) :-
  679    !,
  680    preferred_readline(Library).
  681readline_library(false, _) :-
  682    !,
  683    fail.
  684readline_library(Library, Library).
  685
  686preferred_readline(editline).
  687preferred_readline(readline).

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

  693load_setup_file(File) :-
  694    catch(load_files(File,
  695                     [ silent(true),
  696                       if(not_loaded)
  697                     ]), _, fail).
  698
  699
  700:- '$hide'('$toplevel'/0).              % avoid in the GUI stacktrace

$toplevel: Called from PL_toplevel()

  706'$toplevel' :-
  707    '$runtoplevel',
  708    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

  718'$runtoplevel' :-
  719    current_prolog_flag(toplevel_goal, TopLevel0),
  720    toplevel_goal(TopLevel0, TopLevel),
  721    user:TopLevel.
  722
  723:- dynamic  setup_done/0.  724:- volatile setup_done/0.  725
  726toplevel_goal(default, '$query_loop') :-
  727    !,
  728    setup_interactive.
  729toplevel_goal(prolog, '$query_loop') :-
  730    !,
  731    setup_interactive.
  732toplevel_goal(Goal, Goal).
  733
  734setup_interactive :-
  735    setup_done,
  736    !.
  737setup_interactive :-
  738    asserta(setup_done),
  739    catch(setup_backtrace, E, print_message(warning, E)),
  740    catch(setup_readline,  E, print_message(warning, E)),
  741    catch(setup_history,   E, print_message(warning, E)).

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

  747'$compile' :-
  748    (   catch('$compile_', E, (print_message(error, E), halt(1)))
  749    ->  true
  750    ;   print_message(error, error(goal_failed('$compile'), _)),
  751        halt(1)
  752    ).
  753
  754'$compile_' :-
  755    '$load_system_init_file',
  756    '$set_file_search_paths',
  757    init_debug_flags,
  758    '$run_initialization',
  759    attach_packs,
  760    use_module(library(qsave)),
  761    qsave:qsave_toplevel.

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

  767'$config' :-
  768    '$load_system_init_file',
  769    '$set_file_search_paths',
  770    init_debug_flags,
  771    '$run_initialization',
  772    load_files(library(prolog_config)),
  773    (   catch(prolog_dump_runtime_variables, E,
  774              (print_message(error, E), halt(1)))
  775    ->  true
  776    ;   print_message(error, error(goal_failed(prolog_dump_runtime_variables),_))
  777    ).
  778
  779
  780                /********************************
  781                *    USER INTERACTIVE LOOP      *
  782                *********************************/

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.

  790prolog :-
  791    break.
  792
  793:- 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).

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

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.

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

read_query_line(+Input, -Line) is det

  888read_query_line(Input, Line) :-
  889    catch(read_term_as_atom(Input, Line), Error, true),
  890    save_debug_after_read,
  891    (   var(Error)
  892    ->  true
  893    ;   Error = error(syntax_error(_),_)
  894    ->  print_message(error, Error),
  895        fail
  896    ;   print_message(error, Error),
  897        throw(Error)
  898    ).

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

  905read_term_as_atom(In, Line) :-
  906    '$raw_read'(In, Line),
  907    (   Line == end_of_file
  908    ->  true
  909    ;   skip_to_nl(In)
  910    ).

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.

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

  953set_default_history :-
  954    current_prolog_flag(history, _),
  955    !.
  956set_default_history :-
  957    (   (   \+ current_prolog_flag(readline, false)
  958        ;   current_prolog_flag(emacs_inferior_process, true)
  959        )
  960    ->  create_prolog_flag(history, 0, [])
  961    ;   create_prolog_flag(history, 25, [])
  962    ).
  963
  964
  965                 /*******************************
  966                 *        TOPLEVEL DEBUG        *
  967                 *******************************/

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.

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

$execute(Goal, Bindings) is det: Execute Goal using Bindings.

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

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

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

 1164:- multifile
 1165    residual_goal_collector/1. 1166
 1167:- meta_predicate
 1168    residual_goals(2). 1169
 1170residual_goals(NonTerminal) :-
 1171    throw(error(context_error(nodirective, residual_goals(NonTerminal)), _)).
 1172
 1173system:term_expansion((:- residual_goals(NonTerminal)),
 1174                      '$toplevel':residual_goal_collector(M2:Head)) :-
 1175    prolog_load_context(module, M),
 1176    strip_module(M:NonTerminal, M2, Head),
 1177    '$must_be'(callable, Head).

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

 1184:- public prolog:residual_goals//0. 1185
 1186prolog:residual_goals -->
 1187    { findall(NT, residual_goal_collector(NT), NTL) },
 1188    collect_residual_goals(NTL).
 1189
 1190collect_residual_goals([]) --> [].
 1191collect_residual_goals([H|T]) -->
 1192    ( call(H) -> [] ; [] ),
 1193    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.

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

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

 1328join_same_bindings([], []).
 1329join_same_bindings([Name=V0|T0], [[Name|Names]=V|T]) :-
 1330    take_same_bindings(T0, V0, V, Names, T1),
 1331    join_same_bindings(T1, T).
 1332
 1333take_same_bindings([], Val, Val, [], []).
 1334take_same_bindings([Name=V1|T0], V0, V, [Name|Names], T) :-
 1335    V0 == V1,
 1336    !,
 1337    take_same_bindings(T0, V1, V, Names, T).
 1338take_same_bindings([Pair|T0], V0, V, Names, [Pair|T]) :-
 1339    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.

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

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

 1447bind_one_skel_vars([], _, _, N, N).
 1448bind_one_skel_vars([Var=Value|T], Bindings, Names, N0, N) :-
 1449    (   var(Var)
 1450    ->  (   '$member'(binding(Names, VVal, []), Bindings),
 1451            same_term(Value, VVal)
 1452        ->  '$last'(Names, VName),
 1453            Var = '$VAR'(VName),
 1454            N2 = N0
 1455        ;   between(N0, infinite, N1),
 1456            atom_concat('_S', N1, Name),
 1457            \+ memberchk(Name, Names),
 1458            !,
 1459            Var = '$VAR'(Name),
 1460            N2 is N1 + 1
 1461        )
 1462    ;   N2 = N0
 1463    ),
 1464    bind_one_skel_vars(T, Bindings, Names, N2, N).

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

 1471factorize_bindings([], []).
 1472factorize_bindings([Name=Value|T0], [binding(Name, Skel, Subst)|T]) :-
 1473    '$factorize_term'(Value, Skel, Subst0),
 1474    (   current_prolog_flag(toplevel_print_factorized, true)
 1475    ->  Subst = Subst0
 1476    ;   only_cycles(Subst0, Subst)
 1477    ),
 1478    factorize_bindings(T0, T).
 1479
 1480
 1481only_cycles([], []).
 1482only_cycles([B|T0], List) :-
 1483    (   B = (Var=Value),
 1484        Var = Value,
 1485        acyclic_term(Var)
 1486    ->  only_cycles(T0, List)
 1487    ;   List = [B|T],
 1488        only_cycles(T0, T)
 1489    ).

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

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

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

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