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.
  901:- if(current_prolog_flag(emscripten, true)).  902read_query(_Prompt, Goal, Bindings) :-
  903    '$can_yield',
  904    !,
  905    await(goal, GoalString),
  906    term_string(Goal, GoalString, [variable_names(Bindings)]).
  907:- endif.  908read_query(Prompt, Goal, Bindings) :-
  909    current_prolog_flag(history, N),
  910    integer(N), N > 0,
  911    !,
  912    read_term_with_history(
  913        Goal,
  914        [ show(h),
  915          help('!h'),
  916          no_save([trace, end_of_file]),
  917          prompt(Prompt),
  918          variable_names(Bindings)
  919        ]).
  920read_query(Prompt, Goal, Bindings) :-
  921    remove_history_prompt(Prompt, Prompt1),
  922    repeat,                                 % over syntax errors
  923    prompt1(Prompt1),
  924    read_query_line(user_input, Line),
  925    '$save_history_line'(Line),             % save raw line (edit syntax errors)
  926    '$current_typein_module'(TypeIn),
  927    catch(read_term_from_atom(Line, Goal,
  928                              [ variable_names(Bindings),
  929                                module(TypeIn)
  930                              ]), E,
  931          (   print_message(error, E),
  932              fail
  933          )),
  934    !,
  935    '$save_history_event'(Line).            % save event (no syntax errors)
 read_query_line(+Input, -Line) is det
  939read_query_line(Input, Line) :-
  940    catch(read_term_as_atom(Input, Line), Error, true),
  941    save_debug_after_read,
  942    (   var(Error)
  943    ->  true
  944    ;   Error = error(syntax_error(_),_)
  945    ->  print_message(error, Error),
  946        fail
  947    ;   print_message(error, Error),
  948        throw(Error)
  949    ).
 read_term_as_atom(+Input, -Line)
Read the next term as an atom and skip to the newline or a non-space character.
  956read_term_as_atom(In, Line) :-
  957    '$raw_read'(In, Line),
  958    (   Line == end_of_file
  959    ->  true
  960    ;   skip_to_nl(In)
  961    ).
 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.
  968skip_to_nl(In) :-
  969    repeat,
  970    peek_char(In, C),
  971    (   C == '%'
  972    ->  skip(In, '\n')
  973    ;   char_type(C, space)
  974    ->  get_char(In, _),
  975        C == '\n'
  976    ;   true
  977    ),
  978    !.
  979
  980remove_history_prompt('', '') :- !.
  981remove_history_prompt(Prompt0, Prompt) :-
  982    atom_chars(Prompt0, Chars0),
  983    clean_history_prompt_chars(Chars0, Chars1),
  984    delete_leading_blanks(Chars1, Chars),
  985    atom_chars(Prompt, Chars).
  986
  987clean_history_prompt_chars([], []).
  988clean_history_prompt_chars(['~', !|T], T) :- !.
  989clean_history_prompt_chars([H|T0], [H|T]) :-
  990    clean_history_prompt_chars(T0, T).
  991
  992delete_leading_blanks([' '|T0], T) :-
  993    !,
  994    delete_leading_blanks(T0, T).
  995delete_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.
 1004set_default_history :-
 1005    current_prolog_flag(history, _),
 1006    !.
 1007set_default_history :-
 1008    (   (   \+ current_prolog_flag(readline, false)
 1009        ;   current_prolog_flag(emacs_inferior_process, true)
 1010        )
 1011    ->  create_prolog_flag(history, 0, [])
 1012    ;   create_prolog_flag(history, 25, [])
 1013    ).
 1014
 1015
 1016                 /*******************************
 1017                 *        TOPLEVEL DEBUG        *
 1018                 *******************************/
 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.
 1033save_debug_after_read :-
 1034    current_prolog_flag(debug, true),
 1035    !,
 1036    save_debug.
 1037save_debug_after_read.
 1038
 1039save_debug :-
 1040    (   tracing,
 1041        notrace
 1042    ->  Tracing = true
 1043    ;   Tracing = false
 1044    ),
 1045    current_prolog_flag(debug, Debugging),
 1046    set_prolog_flag(debug, false),
 1047    create_prolog_flag(query_debug_settings,
 1048                       debug(Debugging, Tracing), []).
 1049
 1050restore_debug :-
 1051    current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)),
 1052    set_prolog_flag(debug, Debugging),
 1053    (   Tracing == true
 1054    ->  trace
 1055    ;   true
 1056    ).
 1057
 1058:- initialization
 1059    create_prolog_flag(query_debug_settings, debug(false, false), []). 1060
 1061
 1062                /********************************
 1063                *            PROMPTING          *
 1064                ********************************/
 1065
 1066'$system_prompt'(Module, BrekLev, Prompt) :-
 1067    current_prolog_flag(toplevel_prompt, PAtom),
 1068    atom_codes(PAtom, P0),
 1069    (    Module \== user
 1070    ->   '$substitute'('~m', [Module, ': '], P0, P1)
 1071    ;    '$substitute'('~m', [], P0, P1)
 1072    ),
 1073    (    BrekLev > 0
 1074    ->   '$substitute'('~l', ['[', BrekLev, '] '], P1, P2)
 1075    ;    '$substitute'('~l', [], P1, P2)
 1076    ),
 1077    current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)),
 1078    (    Tracing == true
 1079    ->   '$substitute'('~d', ['[trace] '], P2, P3)
 1080    ;    Debugging == true
 1081    ->   '$substitute'('~d', ['[debug] '], P2, P3)
 1082    ;    '$substitute'('~d', [], P2, P3)
 1083    ),
 1084    atom_chars(Prompt, P3).
 1085
 1086'$substitute'(From, T, Old, New) :-
 1087    atom_codes(From, FromCodes),
 1088    phrase(subst_chars(T), T0),
 1089    '$append'(Pre, S0, Old),
 1090    '$append'(FromCodes, Post, S0) ->
 1091    '$append'(Pre, T0, S1),
 1092    '$append'(S1, Post, New),
 1093    !.
 1094'$substitute'(_, _, Old, Old).
 1095
 1096subst_chars([]) -->
 1097    [].
 1098subst_chars([H|T]) -->
 1099    { atomic(H),
 1100      !,
 1101      atom_codes(H, Codes)
 1102    },
 1103    Codes,
 1104    subst_chars(T).
 1105subst_chars([H|T]) -->
 1106    H,
 1107    subst_chars(T).
 1108
 1109
 1110                /********************************
 1111                *           EXECUTION           *
 1112                ********************************/
 $execute_query(Goal, Bindings, -Truth) is det
Execute Goal using Bindings.
 1118'$execute_query'(Var, _, true) :-
 1119    var(Var),
 1120    !,
 1121    print_message(informational, var_query(Var)).
 1122'$execute_query'(Goal, Bindings, Truth) :-
 1123    '$current_typein_module'(TypeIn),
 1124    '$dwim_correct_goal'(TypeIn:Goal, Bindings, Corrected),
 1125    !,
 1126    setup_call_cleanup(
 1127        '$set_source_module'(M0, TypeIn),
 1128        expand_goal(Corrected, Expanded),
 1129        '$set_source_module'(M0)),
 1130    print_message(silent, toplevel_goal(Expanded, Bindings)),
 1131    '$execute_goal2'(Expanded, Bindings, Truth).
 1132'$execute_query'(_, _, false) :-
 1133    notrace,
 1134    print_message(query, query(no)).
 1135
 1136'$execute_goal2'(Goal, Bindings, true) :-
 1137    restore_debug,
 1138    '$current_typein_module'(TypeIn),
 1139    residue_vars(TypeIn:Goal, Vars, TypeIn:Delays, Chp),
 1140    deterministic(Det),
 1141    (   save_debug
 1142    ;   restore_debug, fail
 1143    ),
 1144    flush_output(user_output),
 1145    (   Det == true
 1146    ->  DetOrChp = true
 1147    ;   DetOrChp = Chp
 1148    ),
 1149    call_expand_answer(Bindings, NewBindings),
 1150    (    \+ \+ write_bindings(NewBindings, Vars, Delays, DetOrChp)
 1151    ->   !
 1152    ).
 1153'$execute_goal2'(_, _, false) :-
 1154    save_debug,
 1155    print_message(query, query(no)).
 1156
 1157residue_vars(Goal, Vars, Delays, Chp) :-
 1158    current_prolog_flag(toplevel_residue_vars, true),
 1159    !,
 1160    '$wfs_call'(call_residue_vars(stop_backtrace(Goal, Chp), Vars), Delays).
 1161residue_vars(Goal, [], Delays, Chp) :-
 1162    '$wfs_call'(stop_backtrace(Goal, Chp), Delays).
 1163
 1164stop_backtrace(Goal, Chp) :-
 1165    toplevel_call(Goal),
 1166    prolog_current_choice(Chp).
 1167
 1168toplevel_call(Goal) :-
 1169    call(Goal),
 1170    no_lco.
 1171
 1172no_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.
 1188write_bindings(Bindings, ResidueVars, Delays, DetOrChp) :-
 1189    '$current_typein_module'(TypeIn),
 1190    translate_bindings(Bindings, Bindings1, ResidueVars, TypeIn:Residuals),
 1191    omit_qualifier(Delays, TypeIn, Delays1),
 1192    name_vars(Bindings1, Residuals, Delays1),
 1193    write_bindings2(Bindings1, Residuals, Delays1, DetOrChp).
 1194
 1195write_bindings2([], Residuals, Delays, _) :-
 1196    current_prolog_flag(prompt_alternatives_on, groundness),
 1197    !,
 1198    print_message(query, query(yes(Delays, Residuals))).
 1199write_bindings2(Bindings, Residuals, Delays, true) :-
 1200    current_prolog_flag(prompt_alternatives_on, determinism),
 1201    !,
 1202    print_message(query, query(yes(Bindings, Delays, Residuals))).
 1203write_bindings2(Bindings, Residuals, Delays, Chp) :-
 1204    repeat,
 1205        print_message(query, query(more(Bindings, Delays, Residuals))),
 1206        get_respons(Action, Chp),
 1207    (   Action == redo
 1208    ->  !, fail
 1209    ;   Action == show_again
 1210    ->  fail
 1211    ;   !,
 1212        print_message(query, query(done))
 1213    ).
 1214
 1215name_vars(Bindings, Residuals, Delays) :-
 1216    current_prolog_flag(toplevel_name_variables, true),
 1217    !,
 1218    '$term_multitons'(t(Bindings,Residuals,Delays), Vars),
 1219    name_vars_(Vars, Bindings, 0),
 1220    term_variables(t(Bindings,Residuals,Delays), SVars),
 1221    anon_vars(SVars).
 1222name_vars(_Bindings, _Residuals, _Delays).
 1223
 1224name_vars_([], _, _).
 1225name_vars_([H|T], Bindings, N) :-
 1226    name_var(Bindings, Name, N, N1),
 1227    H = '$VAR'(Name),
 1228    name_vars_(T, Bindings, N1).
 1229
 1230anon_vars([]).
 1231anon_vars(['$VAR'('_')|T]) :-
 1232    anon_vars(T).
 1233
 1234name_var(Bindings, Name, N0, N) :-
 1235    between(N0, infinite, N1),
 1236    I is N1//26,
 1237    J is 0'A + N1 mod 26,
 1238    (   I == 0
 1239    ->  format(atom(Name), '_~c', [J])
 1240    ;   format(atom(Name), '_~c~d', [J, I])
 1241    ),
 1242    (   current_prolog_flag(toplevel_print_anon, false)
 1243    ->  true
 1244    ;   \+ is_bound(Bindings, Name)
 1245    ),
 1246    !,
 1247    N is N1+1.
 1248
 1249is_bound([Vars=_|T], Name) :-
 1250    (   in_vars(Vars, Name)
 1251    ->  true
 1252    ;   is_bound(T, Name)
 1253    ).
 1254
 1255in_vars(Name, Name) :- !.
 1256in_vars(Names, Name) :-
 1257    '$member'(Name, Names).
 residual_goals(:NonTerminal)
Directive that registers NonTerminal as a collector for residual goals.
 1264:- multifile
 1265    residual_goal_collector/1. 1266
 1267:- meta_predicate
 1268    residual_goals(2). 1269
 1270residual_goals(NonTerminal) :-
 1271    throw(error(context_error(nodirective, residual_goals(NonTerminal)), _)).
 1272
 1273system:term_expansion((:- residual_goals(NonTerminal)),
 1274                      '$toplevel':residual_goal_collector(M2:Head)) :-
 1275    \+ current_prolog_flag(xref, true),
 1276    prolog_load_context(module, M),
 1277    strip_module(M:NonTerminal, M2, Head),
 1278    '$must_be'(callable, Head).
 prolog:residual_goals// is det
DCG that collects residual goals that are not associated with the answer through attributed variables.
 1285:- public prolog:residual_goals//0. 1286
 1287prolog:residual_goals -->
 1288    { findall(NT, residual_goal_collector(NT), NTL) },
 1289    collect_residual_goals(NTL).
 1290
 1291collect_residual_goals([]) --> [].
 1292collect_residual_goals([H|T]) -->
 1293    ( call(H) -> [] ; [] ),
 1294    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.
 1319:- public
 1320    prolog:translate_bindings/5. 1321:- meta_predicate
 1322    prolog:translate_bindings(+, -, +, +, :). 1323
 1324prolog:translate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals) :-
 1325    translate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals).
 1326
 1327translate_bindings(Bindings0, Bindings, ResidueVars, Residuals) :-
 1328    prolog:residual_goals(ResidueGoals, []),
 1329    translate_bindings(Bindings0, Bindings, ResidueVars, ResidueGoals,
 1330                       Residuals).
 1331
 1332translate_bindings(Bindings0, Bindings, [], [], _:[]-[]) :-
 1333    term_attvars(Bindings0, []),
 1334    !,
 1335    join_same_bindings(Bindings0, Bindings1),
 1336    factorize_bindings(Bindings1, Bindings2),
 1337    bind_vars(Bindings2, Bindings3),
 1338    filter_bindings(Bindings3, Bindings).
 1339translate_bindings(Bindings0, Bindings, ResidueVars, ResGoals0,
 1340                   TypeIn:Residuals-HiddenResiduals) :-
 1341    project_constraints(Bindings0, ResidueVars),
 1342    hidden_residuals(ResidueVars, Bindings0, HiddenResiduals0),
 1343    omit_qualifiers(HiddenResiduals0, TypeIn, HiddenResiduals),
 1344    copy_term(Bindings0+ResGoals0, Bindings1+ResGoals1, Residuals0),
 1345    '$append'(ResGoals1, Residuals0, Residuals1),
 1346    omit_qualifiers(Residuals1, TypeIn, Residuals),
 1347    join_same_bindings(Bindings1, Bindings2),
 1348    factorize_bindings(Bindings2, Bindings3),
 1349    bind_vars(Bindings3, Bindings4),
 1350    filter_bindings(Bindings4, Bindings).
 1351
 1352hidden_residuals(ResidueVars, Bindings, Goal) :-
 1353    term_attvars(ResidueVars, Remaining),
 1354    term_attvars(Bindings, QueryVars),
 1355    subtract_vars(Remaining, QueryVars, HiddenVars),
 1356    copy_term(HiddenVars, _, Goal).
 1357
 1358subtract_vars(All, Subtract, Remaining) :-
 1359    sort(All, AllSorted),
 1360    sort(Subtract, SubtractSorted),
 1361    ord_subtract(AllSorted, SubtractSorted, Remaining).
 1362
 1363ord_subtract([], _Not, []).
 1364ord_subtract([H1|T1], L2, Diff) :-
 1365    diff21(L2, H1, T1, Diff).
 1366
 1367diff21([], H1, T1, [H1|T1]).
 1368diff21([H2|T2], H1, T1, Diff) :-
 1369    compare(Order, H1, H2),
 1370    diff3(Order, H1, T1, H2, T2, Diff).
 1371
 1372diff12([], _H2, _T2, []).
 1373diff12([H1|T1], H2, T2, Diff) :-
 1374    compare(Order, H1, H2),
 1375    diff3(Order, H1, T1, H2, T2, Diff).
 1376
 1377diff3(<,  H1, T1,  H2, T2, [H1|Diff]) :-
 1378    diff12(T1, H2, T2, Diff).
 1379diff3(=, _H1, T1, _H2, T2, Diff) :-
 1380    ord_subtract(T1, T2, Diff).
 1381diff3(>,  H1, T1, _H2, T2, Diff) :-
 1382    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.
 1390project_constraints(Bindings, ResidueVars) :-
 1391    !,
 1392    term_attvars(Bindings, AttVars),
 1393    phrase(attribute_modules(AttVars), Modules0),
 1394    sort(Modules0, Modules),
 1395    term_variables(Bindings, QueryVars),
 1396    project_attributes(Modules, QueryVars, ResidueVars).
 1397project_constraints(_, _).
 1398
 1399project_attributes([], _, _).
 1400project_attributes([M|T], QueryVars, ResidueVars) :-
 1401    (   current_predicate(M:project_attributes/2),
 1402        catch(M:project_attributes(QueryVars, ResidueVars), E,
 1403              print_message(error, E))
 1404    ->  true
 1405    ;   true
 1406    ),
 1407    project_attributes(T, QueryVars, ResidueVars).
 1408
 1409attribute_modules([]) --> [].
 1410attribute_modules([H|T]) -->
 1411    { get_attrs(H, Attrs) },
 1412    attrs_modules(Attrs),
 1413    attribute_modules(T).
 1414
 1415attrs_modules([]) --> [].
 1416attrs_modules(att(Module, _, More)) -->
 1417    [Module],
 1418    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.
 1429join_same_bindings([], []).
 1430join_same_bindings([Name=V0|T0], [[Name|Names]=V|T]) :-
 1431    take_same_bindings(T0, V0, V, Names, T1),
 1432    join_same_bindings(T1, T).
 1433
 1434take_same_bindings([], Val, Val, [], []).
 1435take_same_bindings([Name=V1|T0], V0, V, [Name|Names], T) :-
 1436    V0 == V1,
 1437    !,
 1438    take_same_bindings(T0, V1, V, Names, T).
 1439take_same_bindings([Pair|T0], V0, V, Names, [Pair|T]) :-
 1440    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.
 1449omit_qualifiers([], _, []).
 1450omit_qualifiers([Goal0|Goals0], TypeIn, [Goal|Goals]) :-
 1451    omit_qualifier(Goal0, TypeIn, Goal),
 1452    omit_qualifiers(Goals0, TypeIn, Goals).
 1453
 1454omit_qualifier(M:G0, TypeIn, G) :-
 1455    M == TypeIn,
 1456    !,
 1457    omit_meta_qualifiers(G0, TypeIn, G).
 1458omit_qualifier(M:G0, TypeIn, G) :-
 1459    predicate_property(TypeIn:G0, imported_from(M)),
 1460    \+ predicate_property(G0, transparent),
 1461    !,
 1462    G0 = G.
 1463omit_qualifier(_:G0, _, G) :-
 1464    predicate_property(G0, built_in),
 1465    \+ predicate_property(G0, transparent),
 1466    !,
 1467    G0 = G.
 1468omit_qualifier(M:G0, _, M:G) :-
 1469    atom(M),
 1470    !,
 1471    omit_meta_qualifiers(G0, M, G).
 1472omit_qualifier(G0, TypeIn, G) :-
 1473    omit_meta_qualifiers(G0, TypeIn, G).
 1474
 1475omit_meta_qualifiers(V, _, V) :-
 1476    var(V),
 1477    !.
 1478omit_meta_qualifiers((QA,QB), TypeIn, (A,B)) :-
 1479    !,
 1480    omit_qualifier(QA, TypeIn, A),
 1481    omit_qualifier(QB, TypeIn, B).
 1482omit_meta_qualifiers(tnot(QA), TypeIn, tnot(A)) :-
 1483    !,
 1484    omit_qualifier(QA, TypeIn, A).
 1485omit_meta_qualifiers(freeze(V, QGoal), TypeIn, freeze(V, Goal)) :-
 1486    callable(QGoal),
 1487    !,
 1488    omit_qualifier(QGoal, TypeIn, Goal).
 1489omit_meta_qualifiers(when(Cond, QGoal), TypeIn, when(Cond, Goal)) :-
 1490    callable(QGoal),
 1491    !,
 1492    omit_qualifier(QGoal, TypeIn, Goal).
 1493omit_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.
 1502bind_vars(Bindings0, Bindings) :-
 1503    bind_query_vars(Bindings0, Bindings, SNames),
 1504    bind_skel_vars(Bindings, Bindings, SNames, 1, _).
 1505
 1506bind_query_vars([], [], []).
 1507bind_query_vars([binding(Names,Var,[Var2=Cycle])|T0],
 1508                [binding(Names,Cycle,[])|T], [Name|SNames]) :-
 1509    Var == Var2,                   % also implies var(Var)
 1510    !,
 1511    '$last'(Names, Name),
 1512    Var = '$VAR'(Name),
 1513    bind_query_vars(T0, T, SNames).
 1514bind_query_vars([B|T0], [B|T], AllNames) :-
 1515    B = binding(Names,Var,Skel),
 1516    bind_query_vars(T0, T, SNames),
 1517    (   var(Var), \+ attvar(Var), Skel == []
 1518    ->  AllNames = [Name|SNames],
 1519        '$last'(Names, Name),
 1520        Var = '$VAR'(Name)
 1521    ;   AllNames = SNames
 1522    ).
 1523
 1524
 1525
 1526bind_skel_vars([], _, _, N, N).
 1527bind_skel_vars([binding(_,_,Skel)|T], Bindings, SNames, N0, N) :-
 1528    bind_one_skel_vars(Skel, Bindings, SNames, N0, N1),
 1529    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).
 1548bind_one_skel_vars([], _, _, N, N).
 1549bind_one_skel_vars([Var=Value|T], Bindings, Names, N0, N) :-
 1550    (   var(Var)
 1551    ->  (   '$member'(binding(Names, VVal, []), Bindings),
 1552            same_term(Value, VVal)
 1553        ->  '$last'(Names, VName),
 1554            Var = '$VAR'(VName),
 1555            N2 = N0
 1556        ;   between(N0, infinite, N1),
 1557            atom_concat('_S', N1, Name),
 1558            \+ memberchk(Name, Names),
 1559            !,
 1560            Var = '$VAR'(Name),
 1561            N2 is N1 + 1
 1562        )
 1563    ;   N2 = N0
 1564    ),
 1565    bind_one_skel_vars(T, Bindings, Names, N2, N).
 factorize_bindings(+Bindings0, -Factorized)
Factorize cycles and sharing in the bindings.
 1572factorize_bindings([], []).
 1573factorize_bindings([Name=Value|T0], [binding(Name, Skel, Subst)|T]) :-
 1574    '$factorize_term'(Value, Skel, Subst0),
 1575    (   current_prolog_flag(toplevel_print_factorized, true)
 1576    ->  Subst = Subst0
 1577    ;   only_cycles(Subst0, Subst)
 1578    ),
 1579    factorize_bindings(T0, T).
 1580
 1581
 1582only_cycles([], []).
 1583only_cycles([B|T0], List) :-
 1584    (   B = (Var=Value),
 1585        Var = Value,
 1586        acyclic_term(Var)
 1587    ->  only_cycles(T0, List)
 1588    ;   List = [B|T],
 1589        only_cycles(T0, T)
 1590    ).
 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).
 1599filter_bindings([], []).
 1600filter_bindings([H0|T0], T) :-
 1601    hide_vars(H0, H),
 1602    (   (   arg(1, H, [])
 1603        ;   self_bounded(H)
 1604        )
 1605    ->  filter_bindings(T0, T)
 1606    ;   T = [H|T1],
 1607        filter_bindings(T0, T1)
 1608    ).
 1609
 1610hide_vars(binding(Names0, Skel, Subst), binding(Names, Skel, Subst)) :-
 1611    hide_names(Names0, Skel, Subst, Names).
 1612
 1613hide_names([], _, _, []).
 1614hide_names([Name|T0], Skel, Subst, T) :-
 1615    (   sub_atom(Name, 0, _, _, '_'),
 1616        current_prolog_flag(toplevel_print_anon, false),
 1617        sub_atom(Name, 1, 1, _, Next),
 1618        char_type(Next, prolog_var_start)
 1619    ->  true
 1620    ;   Subst == [],
 1621        Skel == '$VAR'(Name)
 1622    ),
 1623    !,
 1624    hide_names(T0, Skel, Subst, T).
 1625hide_names([Name|T0], Skel, Subst, [Name|T]) :-
 1626    hide_names(T0, Skel, Subst, T).
 1627
 1628self_bounded(binding([Name], Value, [])) :-
 1629    Value == '$VAR'(Name).
 get_respons(-Action, +Chp)
Read the continuation entered by the user.
 1635:- if(current_prolog_flag(emscripten, true)). 1636get_respons(Action, _Chp) :-
 1637    '$can_yield',
 1638    !,
 1639    await(more, ActionS),
 1640    atom_string(Action, ActionS).
 1641:- endif. 1642get_respons(Action, Chp) :-
 1643    repeat,
 1644        flush_output(user_output),
 1645        get_single_char(Char),
 1646        answer_respons(Char, Chp, Action),
 1647        (   Action == again
 1648        ->  print_message(query, query(action)),
 1649            fail
 1650        ;   !
 1651        ).
 1652
 1653answer_respons(Char, _, again) :-
 1654    '$in_reply'(Char, '?h'),
 1655    !,
 1656    print_message(help, query(help)).
 1657answer_respons(Char, _, redo) :-
 1658    '$in_reply'(Char, ';nrNR \t'),
 1659    !,
 1660    print_message(query, if_tty([ansi(bold, ';', [])])).
 1661answer_respons(Char, _, redo) :-
 1662    '$in_reply'(Char, 'tT'),
 1663    !,
 1664    trace,
 1665    save_debug,
 1666    print_message(query, if_tty([ansi(bold, '; [trace]', [])])).
 1667answer_respons(Char, _, continue) :-
 1668    '$in_reply'(Char, 'ca\n\ryY.'),
 1669    !,
 1670    print_message(query, if_tty([ansi(bold, '.', [])])).
 1671answer_respons(0'b, _, show_again) :-
 1672    !,
 1673    break.
 1674answer_respons(0'*, Chp, show_again) :-
 1675    !,
 1676    print_last_chpoint(Chp).
 1677answer_respons(Char, _, show_again) :-
 1678    print_predicate(Char, Pred, Options),
 1679    !,
 1680    print_message(query, if_tty(['~w'-[Pred]])),
 1681    set_prolog_flag(answer_write_options, Options).
 1682answer_respons(-1, _, show_again) :-
 1683    !,
 1684    print_message(query, halt('EOF')),
 1685    halt(0).
 1686answer_respons(Char, _, again) :-
 1687    print_message(query, no_action(Char)).
 1688
 1689print_predicate(0'w, [write], [ quoted(true),
 1690                                spacing(next_argument)
 1691                              ]).
 1692print_predicate(0'p, [print], [ quoted(true),
 1693                                portray(true),
 1694                                max_depth(10),
 1695                                spacing(next_argument)
 1696                              ]).
 1697
 1698
 1699print_last_chpoint(Chp) :-
 1700    current_predicate(print_last_choice_point/0),
 1701    !,
 1702    print_last_chpoint_(Chp).
 1703print_last_chpoint(Chp) :-
 1704    use_module(library(prolog_stack), [print_last_choicepoint/2]),
 1705    print_last_chpoint_(Chp).
 1706
 1707print_last_chpoint_(Chp) :-
 1708    print_last_choicepoint(Chp, [message_level(information)]).
 1709
 1710
 1711                 /*******************************
 1712                 *          EXPANSION           *
 1713                 *******************************/
 1714
 1715:- user:dynamic(expand_query/4). 1716:- user:multifile(expand_query/4). 1717
 1718call_expand_query(Goal, Expanded, Bindings, ExpandedBindings) :-
 1719    user:expand_query(Goal, Expanded, Bindings, ExpandedBindings),
 1720    !.
 1721call_expand_query(Goal, Expanded, Bindings, ExpandedBindings) :-
 1722    toplevel_variables:expand_query(Goal, Expanded, Bindings, ExpandedBindings),
 1723    !.
 1724call_expand_query(Goal, Goal, Bindings, Bindings).
 1725
 1726
 1727:- user:dynamic(expand_answer/2). 1728:- user:multifile(expand_answer/2). 1729
 1730call_expand_answer(Goal, Expanded) :-
 1731    user:expand_answer(Goal, Expanded),
 1732    !.
 1733call_expand_answer(Goal, Expanded) :-
 1734    toplevel_variables:expand_answer(Goal, Expanded),
 1735    !.
 1736call_expand_answer(Goal, Goal)