View source with formatted 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.   84
   85%!  version is det.
   86%
   87%   Print the Prolog banner message and messages registered using
   88%   version/1.
   89
   90version :-
   91    print_message(banner, welcome).
   92
   93%!  version(+Message) is det.
   94%
   95%   Add message to version/0
   96
   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).  191
  192%!  initialization(:Goal)
  193%
  194%   Runs Goal after loading the file in which this directive
  195%   appears as well as after restoring a saved state.
  196%
  197%   @see initialization/2
  198
  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'.
  226
  227%!  initialize
  228%
  229%   Run goals registered with `:-  initialization(Goal, program).`. Stop
  230%   with an exception if a goal fails or raises an exception.
  231
  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.  254
  255%!  thread_initialization(:Goal)
  256%
  257%   Run Goal now and everytime a new thread is created.
  258
  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                 *******************************/
  277
  278%!  '$set_file_search_paths' is det.
  279%
  280%   Process -p PathSpec options.
  281
  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                 *******************************/
  341
  342%!  argv_files(-Files) is det.
  343%
  344%   Update the Prolog flag =argv=, extracting  the leading directory and
  345%   files.
  346
  347argv_files(Files) :-
  348    current_prolog_flag(argv, Argv),
  349    no_option_files(Argv, Argv1, Files),
  350    (   Argv1 \== Argv
  351    ->  set_prolog_flag(argv, Argv1)
  352    ;   true
  353    ).
  354
  355no_option_files([--|Argv], Argv, []) :- !.
  356no_option_files([OsScript|Argv], Argv, [Script]) :-
  357    prolog_to_os_filename(Script, OsScript),
  358    access_file(Script, read),
  359    catch(setup_call_cleanup(
  360              open(Script, read, In),
  361              ( get_char(In, '#'),
  362                get_char(In, '!')
  363              ),
  364              close(In)),
  365          _, fail),
  366    !.
  367no_option_files([OsFile|Argv0], Argv, [File|T]) :-
  368    file_name_extension(_, Ext, OsFile),
  369    user:prolog_file_type(Ext, prolog),
  370    !,
  371    prolog_to_os_filename(File, OsFile),
  372    no_option_files(Argv0, Argv, T).
  373no_option_files(Argv, Argv, []).
  374
  375clean_argv :-
  376    (   current_prolog_flag(argv, [--|Argv])
  377    ->  set_prolog_flag(argv, Argv)
  378    ;   true
  379    ).
  380
  381%!  associated_files(-Files)
  382%
  383%   If SWI-Prolog is started as <exe> <file>.<ext>, where <ext> is
  384%   the extension registered for associated files, set the Prolog
  385%   flag associated_file, switch to the directory holding the file
  386%   and -if possible- adjust the window title.
  387
  388associated_files([]) :-
  389    current_prolog_flag(saved_program_class, runtime),
  390    !,
  391    clean_argv.
  392associated_files(Files) :-
  393    '$set_prolog_file_extension',
  394    argv_files(Files),
  395    (   Files = [File|_]
  396    ->  absolute_file_name(File, AbsFile),
  397        set_prolog_flag(associated_file, AbsFile),
  398        set_working_directory(File),
  399        set_window_title(Files)
  400    ;   true
  401    ).
  402
  403%!  set_working_directory(+File)
  404%
  405%   When opening as a GUI application, e.g.,  by opening a file from
  406%   the Finder/Explorer/..., we typically  want   to  change working
  407%   directory to the location of  the   primary  file.  We currently
  408%   detect that we are a GUI app  by the Prolog flag =console_menu=,
  409%   which is set by swipl-win[.exe].
  410
  411set_working_directory(File) :-
  412    current_prolog_flag(console_menu, true),
  413    access_file(File, read),
  414    !,
  415    file_directory_name(File, Dir),
  416    working_directory(_, Dir).
  417set_working_directory(_).
  418
  419set_window_title([File|More]) :-
  420    current_predicate(system:window_title/2),
  421    !,
  422    (   More == []
  423    ->  Extra = []
  424    ;   Extra = ['...']
  425    ),
  426    atomic_list_concat(['SWI-Prolog --', File | Extra], ' ', Title),
  427    system:window_title(_, Title).
  428set_window_title(_).
  429
  430
  431%!  start_pldoc
  432%
  433%   If the option  =|--pldoc[=port]|=  is   given,  load  the  PlDoc
  434%   system.
  435
  436start_pldoc :-
  437    '$cmd_option_val'(pldoc_server, Server),
  438    (   Server == ''
  439    ->  call((doc_server(_), doc_browser))
  440    ;   catch(atom_number(Server, Port), _, fail)
  441    ->  call(doc_server(Port))
  442    ;   print_message(error, option_usage(pldoc)),
  443        halt(1)
  444    ).
  445start_pldoc.
  446
  447
  448%!  load_associated_files(+Files)
  449%
  450%   Load Prolog files specified from the commandline.
  451
  452load_associated_files(Files) :-
  453    (   '$member'(File, Files),
  454        load_files(user:File, [expand(false)]),
  455        fail
  456    ;   true
  457    ).
  458
  459hkey('HKEY_CURRENT_USER/Software/SWI/Prolog').
  460hkey('HKEY_LOCAL_MACHINE/Software/SWI/Prolog').
  461
  462'$set_prolog_file_extension' :-
  463    current_prolog_flag(windows, true),
  464    hkey(Key),
  465    catch(win_registry_get_value(Key, fileExtension, Ext0),
  466          _, fail),
  467    !,
  468    (   atom_concat('.', Ext, Ext0)
  469    ->  true
  470    ;   Ext = Ext0
  471    ),
  472    (   user:prolog_file_type(Ext, prolog)
  473    ->  true
  474    ;   asserta(user:prolog_file_type(Ext, prolog))
  475    ).
  476'$set_prolog_file_extension'.
  477
  478
  479                /********************************
  480                *        TOPLEVEL GOALS         *
  481                *********************************/
  482
  483%!  '$initialise' is semidet.
  484%
  485%   Called from PL_initialise()  to  do  the   Prolog  part  of  the
  486%   initialization. If an exception  occurs,   this  is  printed and
  487%   '$initialise' fails.
  488
  489'$initialise' :-
  490    catch(initialise_prolog, E, initialise_error(E)).
  491
  492initialise_error('$aborted') :- !.
  493initialise_error(E) :-
  494    print_message(error, initialization_exception(E)),
  495    fail.
  496
  497initialise_prolog :-
  498    '$clean_history',
  499    '$run_initialization',
  500    '$load_system_init_file',
  501    set_toplevel,
  502    associated_files(Files),
  503    '$set_file_search_paths',
  504    init_debug_flags,
  505    start_pldoc,
  506    attach_packs,
  507    '$cmd_option_val'(init_file, OsFile),
  508    prolog_to_os_filename(File, OsFile),
  509    '$load_init_file'(File),
  510    catch(setup_colors, E, print_message(warning, E)),
  511    '$load_script_file',
  512    load_associated_files(Files),
  513    '$cmd_option_val'(goals, Goals),
  514    (   Goals == [],
  515        \+ '$init_goal'(when(_), _, _)
  516    ->  version                                 % default interactive run
  517    ;   run_init_goals(Goals),
  518        (   load_only
  519        ->  version
  520        ;   run_program_init,
  521            run_main_init
  522        )
  523    ).
  524
  525set_toplevel :-
  526    '$cmd_option_val'(toplevel, TopLevelAtom),
  527    catch(term_to_atom(TopLevel, TopLevelAtom), E,
  528          (print_message(error, E),
  529           halt(1))),
  530    create_prolog_flag(toplevel_goal, TopLevel, [type(term)]).
  531
  532load_only :-
  533    current_prolog_flag(os_argv, OSArgv),
  534    memberchk('-l', OSArgv),
  535    current_prolog_flag(argv, Argv),
  536    \+ memberchk('-l', Argv).
  537
  538%!  run_init_goals(+Goals) is det.
  539%
  540%   Run registered initialization goals  on  order.   If  a  goal fails,
  541%   execution is halted.
  542
  543run_init_goals([]).
  544run_init_goals([H|T]) :-
  545    run_init_goal(H),
  546    run_init_goals(T).
  547
  548run_init_goal(Text) :-
  549    catch(term_to_atom(Goal, Text), E,
  550          (   print_message(error, init_goal_syntax(E, Text)),
  551              halt(2)
  552          )),
  553    run_init_goal(Goal, Text).
  554
  555%!  run_program_init is det.
  556%
  557%   Run goals registered using
  558
  559run_program_init :-
  560    forall('$init_goal'(when(program), Goal, Ctx),
  561           run_init_goal(Goal, @(Goal,Ctx))).
  562
  563run_main_init :-
  564    findall(Goal-Ctx, '$init_goal'(when(main), Goal, Ctx), Pairs),
  565    '$last'(Pairs, Goal-Ctx),
  566    !,
  567    (   current_prolog_flag(toplevel_goal, default)
  568    ->  set_prolog_flag(toplevel_goal, halt)
  569    ;   true
  570    ),
  571    run_init_goal(Goal, @(Goal,Ctx)).
  572run_main_init.
  573
  574run_init_goal(Goal, Ctx) :-
  575    (   catch_with_backtrace(user:Goal, E, true)
  576    ->  (   var(E)
  577        ->  true
  578        ;   print_message(error, init_goal_failed(E, Ctx)),
  579            halt(2)
  580        )
  581    ;   (   current_prolog_flag(verbose, silent)
  582        ->  Level = silent
  583        ;   Level = error
  584        ),
  585        print_message(Level, init_goal_failed(failed, Ctx)),
  586        halt(1)
  587    ).
  588
  589%!  init_debug_flags is det.
  590%
  591%   Initialize the various Prolog flags that   control  the debugger and
  592%   toplevel.
  593
  594init_debug_flags :-
  595    once(print_predicate(_, [print], PrintOptions)),
  596    create_prolog_flag(answer_write_options, PrintOptions, []),
  597    create_prolog_flag(prompt_alternatives_on, determinism, []),
  598    create_prolog_flag(toplevel_extra_white_line, true, []),
  599    create_prolog_flag(toplevel_print_factorized, false, []),
  600    create_prolog_flag(print_write_options,
  601                       [ portray(true), quoted(true), numbervars(true) ],
  602                       []),
  603    create_prolog_flag(toplevel_residue_vars, false, []),
  604    '$set_debugger_write_options'(print).
  605
  606%!  setup_backtrace
  607%
  608%   Initialise printing a backtrace.
  609
  610setup_backtrace :-
  611    (   \+ current_prolog_flag(backtrace, false),
  612        load_setup_file(library(prolog_stack))
  613    ->  true
  614    ;   true
  615    ).
  616
  617%!  setup_colors is det.
  618%
  619%   Setup  interactive  usage  by  enabling    colored   output.
  620
  621setup_colors :-
  622    (   \+ current_prolog_flag(color_term, false),
  623        stream_property(user_input, tty(true)),
  624        stream_property(user_error, tty(true)),
  625        stream_property(user_output, tty(true)),
  626        load_setup_file(user:library(ansi_term))
  627    ->  true
  628    ;   true
  629    ).
  630
  631%!  setup_history
  632%
  633%   Enable per-directory persistent history.
  634
  635setup_history :-
  636    (   \+ current_prolog_flag(save_history, false),
  637        stream_property(user_input, tty(true)),
  638        \+ current_prolog_flag(readline, false),
  639        load_setup_file(library(prolog_history))
  640    ->  prolog_history(enable)
  641    ;   true
  642    ),
  643    set_default_history,
  644    '$load_history'.
  645
  646%!  setup_readline
  647%
  648%   Setup line editing.
  649
  650setup_readline :-
  651    (   current_prolog_flag(readline, swipl_win)
  652    ->  true
  653    ;   stream_property(user_input, tty(true)),
  654        current_prolog_flag(tty_control, true),
  655        \+ getenv('TERM', dumb),
  656        (   current_prolog_flag(readline, ReadLine)
  657        ->  true
  658        ;   ReadLine = true
  659        ),
  660        readline_library(ReadLine, Library),
  661        load_setup_file(library(Library))
  662    ->  set_prolog_flag(readline, Library)
  663    ;   set_prolog_flag(readline, false)
  664    ).
  665
  666readline_library(true, Library) :-
  667    !,
  668    preferred_readline(Library).
  669readline_library(false, _) :-
  670    !,
  671    fail.
  672readline_library(Library, Library).
  673
  674preferred_readline(editline).
  675preferred_readline(readline).
  676
  677%!  load_setup_file(+File) is semidet.
  678%
  679%   Load a file and fail silently if the file does not exist.
  680
  681load_setup_file(File) :-
  682    catch(load_files(File,
  683                     [ silent(true),
  684                       if(not_loaded)
  685                     ]), _, fail).
  686
  687
  688:- '$hide'('$toplevel'/0).              % avoid in the GUI stacktrace
  689
  690%!  '$toplevel'
  691%
  692%   Called from PL_toplevel()
  693
  694'$toplevel' :-
  695    '$runtoplevel',
  696    print_message(informational, halt).
  697
  698%!  '$runtoplevel'
  699%
  700%   Actually run the toplevel. The values   `default`  and `prolog` both
  701%   start the interactive toplevel, where `prolog` implies the user gave
  702%   =|-t prolog|=.
  703%
  704%   @see prolog/0 is the default interactive toplevel
  705
  706'$runtoplevel' :-
  707    current_prolog_flag(toplevel_goal, TopLevel0),
  708    toplevel_goal(TopLevel0, TopLevel),
  709    user:TopLevel.
  710
  711:- dynamic  setup_done/0.  712:- volatile setup_done/0.  713
  714toplevel_goal(default, '$query_loop') :-
  715    !,
  716    setup_interactive.
  717toplevel_goal(prolog, '$query_loop') :-
  718    !,
  719    setup_interactive.
  720toplevel_goal(Goal, Goal).
  721
  722setup_interactive :-
  723    setup_done,
  724    !.
  725setup_interactive :-
  726    asserta(setup_done),
  727    catch(setup_backtrace, E, print_message(warning, E)),
  728    catch(setup_readline,  E, print_message(warning, E)),
  729    catch(setup_history,   E, print_message(warning, E)).
  730
  731%!  '$compile'
  732%
  733%   Toplevel called when invoked with -c option.
  734
  735'$compile' :-
  736    '$load_system_init_file',
  737    '$set_file_search_paths',
  738    init_debug_flags,
  739    '$run_initialization',
  740    attach_packs,
  741    use_module(library(qsave)),
  742    catch(qsave:qsave_toplevel, E, (print_message(error, E), halt(1))).
  743
  744%!  '$config'
  745%
  746%   Toplevel when invoked with --dump-runtime-variables
  747
  748'$config' :-
  749    '$load_system_init_file',
  750    '$set_file_search_paths',
  751    init_debug_flags,
  752    '$run_initialization',
  753    load_files(library(prolog_config)),
  754    (   catch(prolog_dump_runtime_variables, E,
  755              (print_message(error, E), halt(1)))
  756    ->  true
  757    ;   print_message(error, error(goal_failed(prolog_dump_runtime_variables),_))
  758    ).
  759
  760
  761                /********************************
  762                *    USER INTERACTIVE LOOP      *
  763                *********************************/
  764
  765%!  prolog
  766%
  767%   Run the Prolog toplevel. This is now  the same as break/0, which
  768%   pretends  to  be  in  a  break-level    if  there  is  a  parent
  769%   environment.
  770
  771prolog :-
  772    break.
  773
  774:- create_prolog_flag(toplevel_mode, backtracking, []).  775
  776%!  '$query_loop'
  777%
  778%   Run the normal Prolog query loop.  Note   that  the query is not
  779%   protected by catch/3. Dealing with  unhandled exceptions is done
  780%   by the C-function query_loop().  This   ensures  that  unhandled
  781%   exceptions are really unhandled (in Prolog).
  782
  783'$query_loop' :-
  784    current_prolog_flag(toplevel_mode, recursive),
  785    !,
  786    break_level(Level),
  787    read_expanded_query(Level, Query, Bindings),
  788    (   Query == end_of_file
  789    ->  print_message(query, query(eof))
  790    ;   '$call_no_catch'('$execute'(Query, Bindings)),
  791        (   current_prolog_flag(toplevel_mode, recursive)
  792        ->  '$query_loop'
  793        ;   '$switch_toplevel_mode'(backtracking),
  794            '$query_loop'           % Maybe throw('$switch_toplevel_mode')?
  795        )
  796    ).
  797'$query_loop' :-
  798    break_level(BreakLev),
  799    repeat,
  800        read_expanded_query(BreakLev, Query, Bindings),
  801        (   Query == end_of_file
  802        ->  !, print_message(query, query(eof))
  803        ;   '$execute'(Query, Bindings),
  804            (   current_prolog_flag(toplevel_mode, recursive)
  805            ->  !,
  806                '$switch_toplevel_mode'(recursive),
  807                '$query_loop'
  808            ;   fail
  809            )
  810        ).
  811
  812break_level(BreakLev) :-
  813    (   current_prolog_flag(break_level, BreakLev)
  814    ->  true
  815    ;   BreakLev = -1
  816    ).
  817
  818read_expanded_query(BreakLev, ExpandedQuery, ExpandedBindings) :-
  819    '$current_typein_module'(TypeIn),
  820    (   stream_property(user_input, tty(true))
  821    ->  '$system_prompt'(TypeIn, BreakLev, Prompt),
  822        prompt(Old, '|    ')
  823    ;   Prompt = '',
  824        prompt(Old, '')
  825    ),
  826    trim_stacks,
  827    repeat,
  828      read_query(Prompt, Query, Bindings),
  829      prompt(_, Old),
  830      catch(call_expand_query(Query, ExpandedQuery,
  831                              Bindings, ExpandedBindings),
  832            Error,
  833            (print_message(error, Error), fail)),
  834    !.
  835
  836
  837%!  read_query(+Prompt, -Goal, -Bindings) is det.
  838%
  839%   Read the next query. The first  clause   deals  with  the case where
  840%   !-based history is enabled. The second is   used  if we have command
  841%   line editing.
  842
  843read_query(Prompt, Goal, Bindings) :-
  844    current_prolog_flag(history, N),
  845    integer(N), N > 0,
  846    !,
  847    read_history(h, '!h',
  848                 [trace, end_of_file],
  849                 Prompt, Goal, Bindings).
  850read_query(Prompt, Goal, Bindings) :-
  851    remove_history_prompt(Prompt, Prompt1),
  852    repeat,                                 % over syntax errors
  853    prompt1(Prompt1),
  854    read_query_line(user_input, Line),
  855    '$save_history_line'(Line),             % save raw line (edit syntax errors)
  856    '$current_typein_module'(TypeIn),
  857    catch(read_term_from_atom(Line, Goal,
  858                              [ variable_names(Bindings),
  859                                module(TypeIn)
  860                              ]), E,
  861          (   print_message(error, E),
  862              fail
  863          )),
  864    !,
  865    '$save_history_event'(Line).            % save event (no syntax errors)
  866
  867%!  read_query_line(+Input, -Line) is det.
  868
  869read_query_line(Input, Line) :-
  870    catch(read_term_as_atom(Input, Line), Error, true),
  871    save_debug_after_read,
  872    (   var(Error)
  873    ->  true
  874    ;   Error = error(syntax_error(_),_)
  875    ->  print_message(error, Error),
  876        fail
  877    ;   print_message(error, Error),
  878        throw(Error)
  879    ).
  880
  881%!  read_term_as_atom(+Input, -Line)
  882%
  883%   Read the next term as an  atom  and   skip  to  the newline or a
  884%   non-space character.
  885
  886read_term_as_atom(In, Line) :-
  887    '$raw_read'(In, Line),
  888    (   Line == end_of_file
  889    ->  true
  890    ;   skip_to_nl(In)
  891    ).
  892
  893%!  skip_to_nl(+Input) is det.
  894%
  895%   Read input after the term. Skips   white  space and %... comment
  896%   until the end of the line or a non-blank character.
  897
  898skip_to_nl(In) :-
  899    repeat,
  900    peek_char(In, C),
  901    (   C == '%'
  902    ->  skip(In, '\n')
  903    ;   char_type(C, space)
  904    ->  get_char(In, _),
  905        C == '\n'
  906    ;   true
  907    ),
  908    !.
  909
  910remove_history_prompt('', '') :- !.
  911remove_history_prompt(Prompt0, Prompt) :-
  912    atom_chars(Prompt0, Chars0),
  913    clean_history_prompt_chars(Chars0, Chars1),
  914    delete_leading_blanks(Chars1, Chars),
  915    atom_chars(Prompt, Chars).
  916
  917clean_history_prompt_chars([], []).
  918clean_history_prompt_chars(['~', !|T], T) :- !.
  919clean_history_prompt_chars([H|T0], [H|T]) :-
  920    clean_history_prompt_chars(T0, T).
  921
  922delete_leading_blanks([' '|T0], T) :-
  923    !,
  924    delete_leading_blanks(T0, T).
  925delete_leading_blanks(L, L).
  926
  927
  928%!  set_default_history
  929%
  930%   Enable !-based numbered command history. This  is enabled by default
  931%   if we are not running under GNU-emacs  and   we  do not have our own
  932%   line editing.
  933
  934set_default_history :-
  935    current_prolog_flag(history, _),
  936    !.
  937set_default_history :-
  938    (   (   \+ current_prolog_flag(readline, false)
  939        ;   current_prolog_flag(emacs_inferior_process, true)
  940        )
  941    ->  create_prolog_flag(history, 0, [])
  942    ;   create_prolog_flag(history, 25, [])
  943    ).
  944
  945
  946                 /*******************************
  947                 *        TOPLEVEL DEBUG        *
  948                 *******************************/
  949
  950%!  save_debug_after_read
  951%
  952%   Called right after the toplevel read to save the debug status if
  953%   it was modified from the GUI thread using e.g.
  954%
  955%     ==
  956%     thread_signal(main, gdebug)
  957%     ==
  958%
  959%   @bug Ideally, the prompt would change if debug mode is enabled.
  960%        That is hard to realise with all the different console
  961%        interfaces supported by SWI-Prolog.
  962
  963save_debug_after_read :-
  964    current_prolog_flag(debug, true),
  965    !,
  966    save_debug.
  967save_debug_after_read.
  968
  969save_debug :-
  970    (   tracing,
  971        notrace
  972    ->  Tracing = true
  973    ;   Tracing = false
  974    ),
  975    current_prolog_flag(debug, Debugging),
  976    set_prolog_flag(debug, false),
  977    create_prolog_flag(query_debug_settings,
  978                       debug(Debugging, Tracing), []).
  979
  980restore_debug :-
  981    current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)),
  982    set_prolog_flag(debug, Debugging),
  983    (   Tracing == true
  984    ->  trace
  985    ;   true
  986    ).
  987
  988:- initialization
  989    create_prolog_flag(query_debug_settings, debug(false, false), []).  990
  991
  992                /********************************
  993                *            PROMPTING          *
  994                ********************************/
  995
  996'$system_prompt'(Module, BrekLev, Prompt) :-
  997    current_prolog_flag(toplevel_prompt, PAtom),
  998    atom_codes(PAtom, P0),
  999    (    Module \== user
 1000    ->   '$substitute'('~m', [Module, ': '], P0, P1)
 1001    ;    '$substitute'('~m', [], P0, P1)
 1002    ),
 1003    (    BrekLev > 0
 1004    ->   '$substitute'('~l', ['[', BrekLev, '] '], P1, P2)
 1005    ;    '$substitute'('~l', [], P1, P2)
 1006    ),
 1007    current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)),
 1008    (    Tracing == true
 1009    ->   '$substitute'('~d', ['[trace] '], P2, P3)
 1010    ;    Debugging == true
 1011    ->   '$substitute'('~d', ['[debug] '], P2, P3)
 1012    ;    '$substitute'('~d', [], P2, P3)
 1013    ),
 1014    atom_chars(Prompt, P3).
 1015
 1016'$substitute'(From, T, Old, New) :-
 1017    atom_codes(From, FromCodes),
 1018    phrase(subst_chars(T), T0),
 1019    '$append'(Pre, S0, Old),
 1020    '$append'(FromCodes, Post, S0) ->
 1021    '$append'(Pre, T0, S1),
 1022    '$append'(S1, Post, New),
 1023    !.
 1024'$substitute'(_, _, Old, Old).
 1025
 1026subst_chars([]) -->
 1027    [].
 1028subst_chars([H|T]) -->
 1029    { atomic(H),
 1030      !,
 1031      atom_codes(H, Codes)
 1032    },
 1033    Codes,
 1034    subst_chars(T).
 1035subst_chars([H|T]) -->
 1036    H,
 1037    subst_chars(T).
 1038
 1039
 1040                /********************************
 1041                *           EXECUTION           *
 1042                ********************************/
 1043
 1044%!  '$execute'(Goal, Bindings) is det.
 1045%
 1046%   Execute Goal using Bindings.
 1047
 1048'$execute'(Var, _) :-
 1049    var(Var),
 1050    !,
 1051    print_message(informational, var_query(Var)).
 1052'$execute'(Goal, Bindings) :-
 1053    '$current_typein_module'(TypeIn),
 1054    '$dwim_correct_goal'(TypeIn:Goal, Bindings, Corrected),
 1055    !,
 1056    setup_call_cleanup(
 1057        '$set_source_module'(M0, TypeIn),
 1058        expand_goal(Corrected, Expanded),
 1059        '$set_source_module'(M0)),
 1060    print_message(silent, toplevel_goal(Expanded, Bindings)),
 1061    '$execute_goal2'(Expanded, Bindings).
 1062'$execute'(_, _) :-
 1063    notrace,
 1064    print_message(query, query(no)).
 1065
 1066'$execute_goal2'(Goal, Bindings) :-
 1067    restore_debug,
 1068    residue_vars(Goal, Vars),
 1069    deterministic(Det),
 1070    (   save_debug
 1071    ;   restore_debug, fail
 1072    ),
 1073    flush_output(user_output),
 1074    call_expand_answer(Bindings, NewBindings),
 1075    (    \+ \+ write_bindings(NewBindings, Vars, Det)
 1076    ->   !
 1077    ).
 1078'$execute_goal2'(_, _) :-
 1079    save_debug,
 1080    print_message(query, query(no)).
 1081
 1082residue_vars(Goal, Vars) :-
 1083    current_prolog_flag(toplevel_residue_vars, true),
 1084    !,
 1085    call_residue_vars(Goal, Vars).
 1086residue_vars(Goal, []) :-
 1087    toplevel_call(Goal).
 1088
 1089toplevel_call(Goal) :-
 1090    call(Goal),
 1091    no_lco.
 1092
 1093no_lco.
 1094
 1095%!  write_bindings(+Bindings, +ResidueVars, +Deterministic) is semidet.
 1096%
 1097%   Write   bindings   resulting   from   a     query.    The   flag
 1098%   prompt_alternatives_on determines whether the   user is prompted
 1099%   for alternatives. =groundness= gives   the  classical behaviour,
 1100%   =determinism= is considered more adequate and informative.
 1101%
 1102%   Succeeds if the user accepts the answer and fails otherwise.
 1103%
 1104%   @arg ResidueVars are the residual constraints and provided if
 1105%        the prolog flag `toplevel_residue_vars` is set to
 1106%        `project`.
 1107
 1108write_bindings(Bindings, ResidueVars, Det) :-
 1109    '$current_typein_module'(TypeIn),
 1110    translate_bindings(Bindings, Bindings1, ResidueVars, TypeIn:Residuals),
 1111    write_bindings2(Bindings1, Residuals, Det).
 1112
 1113write_bindings2([], Residuals, _) :-
 1114    current_prolog_flag(prompt_alternatives_on, groundness),
 1115    !,
 1116    print_message(query, query(yes(Residuals))).
 1117write_bindings2(Bindings, Residuals, true) :-
 1118    current_prolog_flag(prompt_alternatives_on, determinism),
 1119    !,
 1120    print_message(query, query(yes(Bindings, Residuals))).
 1121write_bindings2(Bindings, Residuals, _Det) :-
 1122    repeat,
 1123        print_message(query, query(more(Bindings, Residuals))),
 1124        get_respons(Action),
 1125    (   Action == redo
 1126    ->  !, fail
 1127    ;   Action == show_again
 1128    ->  fail
 1129    ;   !,
 1130        print_message(query, query(done))
 1131    ).
 1132
 1133%!  residual_goals(:NonTerminal)
 1134%
 1135%   Directive that registers NonTerminal as a collector for residual
 1136%   goals.
 1137
 1138:- multifile
 1139    residual_goal_collector/1. 1140
 1141:- meta_predicate
 1142    residual_goals(2). 1143
 1144residual_goals(NonTerminal) :-
 1145    throw(error(context_error(nodirective, residual_goals(NonTerminal)), _)).
 1146
 1147system:term_expansion((:- residual_goals(NonTerminal)),
 1148                      '$toplevel':residual_goal_collector(M2:Head)) :-
 1149    prolog_load_context(module, M),
 1150    strip_module(M:NonTerminal, M2, Head),
 1151    '$must_be'(callable, Head).
 1152
 1153%!  prolog:residual_goals// is det.
 1154%
 1155%   DCG that collects residual goals that   are  not associated with
 1156%   the answer through attributed variables.
 1157
 1158:- public prolog:residual_goals//0. 1159
 1160prolog:residual_goals -->
 1161    { findall(NT, residual_goal_collector(NT), NTL) },
 1162    collect_residual_goals(NTL).
 1163
 1164collect_residual_goals([]) --> [].
 1165collect_residual_goals([H|T]) -->
 1166    ( call(H) -> [] ; [] ),
 1167    collect_residual_goals(T).
 1168
 1169
 1170
 1171%!  prolog:translate_bindings(+Bindings0, -Bindings, +ResidueVars,
 1172%!                            +ResidualGoals, -Residuals) is det.
 1173%
 1174%   Translate the raw variable bindings  resulting from successfully
 1175%   completing a query into a  binding   list  and  list of residual
 1176%   goals suitable for human consumption.
 1177%
 1178%   @arg    Bindings is a list of binding(Vars,Value,Substitutions),
 1179%           where Vars is a list of variable names. E.g.
 1180%           binding(['A','B'],42,[])` means that both the variable
 1181%           A and B have the value 42. Values may contain terms
 1182%           '$VAR'(Name) to indicate sharing with a given variable.
 1183%           Value is always an acyclic term. If cycles appear in the
 1184%           answer, Substitutions contains a list of substitutions
 1185%           that restore the original term.
 1186%
 1187%   @arg    Residuals is a pair of two lists representing residual
 1188%           goals. The first element of the pair are residuals
 1189%           related to the query variables and the second are
 1190%           related that are disconnected from the query.
 1191
 1192:- public
 1193    prolog:translate_bindings/5. 1194:- meta_predicate
 1195    prolog:translate_bindings(+, -, +, +, :). 1196
 1197prolog:translate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals) :-
 1198    translate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals).
 1199
 1200translate_bindings(Bindings0, Bindings, ResidueVars, Residuals) :-
 1201    prolog:residual_goals(ResidueGoals, []),
 1202    translate_bindings(Bindings0, Bindings, ResidueVars, ResidueGoals,
 1203                       Residuals).
 1204
 1205translate_bindings(Bindings0, Bindings, [], [], _:[]-[]) :-
 1206    term_attvars(Bindings0, []),
 1207    !,
 1208    join_same_bindings(Bindings0, Bindings1),
 1209    factorize_bindings(Bindings1, Bindings2),
 1210    bind_vars(Bindings2, Bindings3),
 1211    filter_bindings(Bindings3, Bindings).
 1212translate_bindings(Bindings0, Bindings, ResidueVars, ResGoals0,
 1213                   TypeIn:Residuals-HiddenResiduals) :-
 1214    project_constraints(Bindings0, ResidueVars),
 1215    hidden_residuals(ResidueVars, Bindings0, HiddenResiduals0),
 1216    omit_qualifiers(HiddenResiduals0, TypeIn, HiddenResiduals),
 1217    copy_term(Bindings0+ResGoals0, Bindings1+ResGoals1, Residuals0),
 1218    '$append'(ResGoals1, Residuals0, Residuals1),
 1219    omit_qualifiers(Residuals1, TypeIn, Residuals),
 1220    join_same_bindings(Bindings1, Bindings2),
 1221    factorize_bindings(Bindings2, Bindings3),
 1222    bind_vars(Bindings3, Bindings4),
 1223    filter_bindings(Bindings4, Bindings).
 1224
 1225hidden_residuals(ResidueVars, Bindings, Goal) :-
 1226    term_attvars(ResidueVars, Remaining),
 1227    term_attvars(Bindings, QueryVars),
 1228    subtract_vars(Remaining, QueryVars, HiddenVars),
 1229    copy_term(HiddenVars, _, Goal).
 1230
 1231subtract_vars(All, Subtract, Remaining) :-
 1232    sort(All, AllSorted),
 1233    sort(Subtract, SubtractSorted),
 1234    ord_subtract(AllSorted, SubtractSorted, Remaining).
 1235
 1236ord_subtract([], _Not, []).
 1237ord_subtract([H1|T1], L2, Diff) :-
 1238    diff21(L2, H1, T1, Diff).
 1239
 1240diff21([], H1, T1, [H1|T1]).
 1241diff21([H2|T2], H1, T1, Diff) :-
 1242    compare(Order, H1, H2),
 1243    diff3(Order, H1, T1, H2, T2, Diff).
 1244
 1245diff12([], _H2, _T2, []).
 1246diff12([H1|T1], H2, T2, Diff) :-
 1247    compare(Order, H1, H2),
 1248    diff3(Order, H1, T1, H2, T2, Diff).
 1249
 1250diff3(<,  H1, T1,  H2, T2, [H1|Diff]) :-
 1251    diff12(T1, H2, T2, Diff).
 1252diff3(=, _H1, T1, _H2, T2, Diff) :-
 1253    ord_subtract(T1, T2, Diff).
 1254diff3(>,  H1, T1, _H2, T2, Diff) :-
 1255    diff21(T2, H1, T1, Diff).
 1256
 1257
 1258%!  project_constraints(+Bindings, +ResidueVars) is det.
 1259%
 1260%   Call   <module>:project_attributes/2   if   the    Prolog   flag
 1261%   `toplevel_residue_vars` is set to `project`.
 1262
 1263project_constraints(Bindings, ResidueVars) :-
 1264    !,
 1265    term_attvars(Bindings, AttVars),
 1266    phrase(attribute_modules(AttVars), Modules0),
 1267    sort(Modules0, Modules),
 1268    term_variables(Bindings, QueryVars),
 1269    project_attributes(Modules, QueryVars, ResidueVars).
 1270project_constraints(_, _).
 1271
 1272project_attributes([], _, _).
 1273project_attributes([M|T], QueryVars, ResidueVars) :-
 1274    (   current_predicate(M:project_attributes/2),
 1275        catch(M:project_attributes(QueryVars, ResidueVars), E,
 1276              print_message(error, E))
 1277    ->  true
 1278    ;   true
 1279    ),
 1280    project_attributes(T, QueryVars, ResidueVars).
 1281
 1282attribute_modules([]) --> [].
 1283attribute_modules([H|T]) -->
 1284    { get_attrs(H, Attrs) },
 1285    attrs_modules(Attrs),
 1286    attribute_modules(T).
 1287
 1288attrs_modules([]) --> [].
 1289attrs_modules(att(Module, _, More)) -->
 1290    [Module],
 1291    attrs_modules(More).
 1292
 1293
 1294%!  join_same_bindings(Bindings0, Bindings)
 1295%
 1296%   Join variables that are bound to the   same  value. Note that we
 1297%   return the _last_ value. This is   because the factorization may
 1298%   be different and ultimately the names will   be  printed as V1 =
 1299%   V2, ... VN = Value. Using the  last, Value has the factorization
 1300%   of VN.
 1301
 1302join_same_bindings([], []).
 1303join_same_bindings([Name=V0|T0], [[Name|Names]=V|T]) :-
 1304    take_same_bindings(T0, V0, V, Names, T1),
 1305    join_same_bindings(T1, T).
 1306
 1307take_same_bindings([], Val, Val, [], []).
 1308take_same_bindings([Name=V1|T0], V0, V, [Name|Names], T) :-
 1309    V0 == V1,
 1310    !,
 1311    take_same_bindings(T0, V1, V, Names, T).
 1312take_same_bindings([Pair|T0], V0, V, Names, [Pair|T]) :-
 1313    take_same_bindings(T0, V0, V, Names, T).
 1314
 1315
 1316%!  omit_qualifiers(+QGoals, +TypeIn, -Goals) is det.
 1317%
 1318%   Omit unneeded module qualifiers  from   QGoals  relative  to the
 1319%   given module TypeIn.
 1320
 1321
 1322omit_qualifiers([], _, []).
 1323omit_qualifiers([Goal0|Goals0], TypeIn, [Goal|Goals]) :-
 1324    omit_qualifier(Goal0, TypeIn, Goal),
 1325    omit_qualifiers(Goals0, TypeIn, Goals).
 1326
 1327omit_qualifier(M:G0, TypeIn, G) :-
 1328    M == TypeIn,
 1329    !,
 1330    omit_meta_qualifiers(G0, TypeIn, G).
 1331omit_qualifier(M:G0, TypeIn, G) :-
 1332    predicate_property(TypeIn:G0, imported_from(M)),
 1333    \+ predicate_property(G0, transparent),
 1334    !,
 1335    G0 = G.
 1336omit_qualifier(_:G0, _, G) :-
 1337    predicate_property(G0, built_in),
 1338    \+ predicate_property(G0, transparent),
 1339    !,
 1340    G0 = G.
 1341omit_qualifier(M:G0, _, M:G) :-
 1342    atom(M),
 1343    !,
 1344    omit_meta_qualifiers(G0, M, G).
 1345omit_qualifier(G0, TypeIn, G) :-
 1346    omit_meta_qualifiers(G0, TypeIn, G).
 1347
 1348omit_meta_qualifiers(V, _, V) :-
 1349    var(V),
 1350    !.
 1351omit_meta_qualifiers((QA,QB), TypeIn, (A,B)) :-
 1352    !,
 1353    omit_qualifier(QA, TypeIn, A),
 1354    omit_qualifier(QB, TypeIn, B).
 1355omit_meta_qualifiers(freeze(V, QGoal), TypeIn, freeze(V, Goal)) :-
 1356    callable(QGoal),
 1357    !,
 1358    omit_qualifier(QGoal, TypeIn, Goal).
 1359omit_meta_qualifiers(when(Cond, QGoal), TypeIn, when(Cond, Goal)) :-
 1360    callable(QGoal),
 1361    !,
 1362    omit_qualifier(QGoal, TypeIn, Goal).
 1363omit_meta_qualifiers(G, _, G).
 1364
 1365
 1366%!  bind_vars(+BindingsIn, -Bindings)
 1367%
 1368%   Bind variables to '$VAR'(Name), so they are printed by the names
 1369%   used in the query. Note that by   binding  in the reverse order,
 1370%   variables bound to one another come out in the natural order.
 1371
 1372bind_vars(Bindings0, Bindings) :-
 1373    bind_query_vars(Bindings0, Bindings, SNames),
 1374    bind_skel_vars(Bindings, Bindings, SNames, 1, _).
 1375
 1376bind_query_vars([], [], []).
 1377bind_query_vars([binding(Names,Var,[Var2=Cycle])|T0],
 1378                [binding(Names,Cycle,[])|T], [Name|SNames]) :-
 1379    Var == Var2,                   % also implies var(Var)
 1380    !,
 1381    '$last'(Names, Name),
 1382    Var = '$VAR'(Name),
 1383    bind_query_vars(T0, T, SNames).
 1384bind_query_vars([B|T0], [B|T], AllNames) :-
 1385    B = binding(Names,Var,Skel),
 1386    bind_query_vars(T0, T, SNames),
 1387    (   var(Var), \+ attvar(Var), Skel == []
 1388    ->  AllNames = [Name|SNames],
 1389        '$last'(Names, Name),
 1390        Var = '$VAR'(Name)
 1391    ;   AllNames = SNames
 1392    ).
 1393
 1394
 1395
 1396bind_skel_vars([], _, _, N, N).
 1397bind_skel_vars([binding(_,_,Skel)|T], Bindings, SNames, N0, N) :-
 1398    bind_one_skel_vars(Skel, Bindings, SNames, N0, N1),
 1399    bind_skel_vars(T, Bindings, SNames, N1, N).
 1400
 1401%!  bind_one_skel_vars(+Subst, +Bindings, +VarName, +N0, -N)
 1402%
 1403%   Give names to the factorized variables that   do not have a name
 1404%   yet. This introduces names  _S<N>,   avoiding  duplicates.  If a
 1405%   factorized variable shares with another binding, use the name of
 1406%   that variable.
 1407%
 1408%   @tbd    Consider the call below. We could remove either of the
 1409%           A = x(1).  Which is best?
 1410%
 1411%           ==
 1412%           ?- A = x(1), B = a(A,A).
 1413%           A = x(1),
 1414%           B = a(A, A), % where
 1415%               A = x(1).
 1416%           ==
 1417
 1418bind_one_skel_vars([], _, _, N, N).
 1419bind_one_skel_vars([Var=Value|T], Bindings, Names, N0, N) :-
 1420    (   var(Var)
 1421    ->  (   '$member'(binding(Names, VVal, []), Bindings),
 1422            same_term(Value, VVal)
 1423        ->  '$last'(Names, VName),
 1424            Var = '$VAR'(VName),
 1425            N2 = N0
 1426        ;   between(N0, infinite, N1),
 1427            atom_concat('_S', N1, Name),
 1428            \+ memberchk(Name, Names),
 1429            !,
 1430            Var = '$VAR'(Name),
 1431            N2 is N1 + 1
 1432        )
 1433    ;   N2 = N0
 1434    ),
 1435    bind_one_skel_vars(T, Bindings, Names, N2, N).
 1436
 1437
 1438%!  factorize_bindings(+Bindings0, -Factorized)
 1439%
 1440%   Factorize cycles and sharing in the bindings.
 1441
 1442factorize_bindings([], []).
 1443factorize_bindings([Name=Value|T0], [binding(Name, Skel, Subst)|T]) :-
 1444    '$factorize_term'(Value, Skel, Subst0),
 1445    (   current_prolog_flag(toplevel_print_factorized, true)
 1446    ->  Subst = Subst0
 1447    ;   only_cycles(Subst0, Subst)
 1448    ),
 1449    factorize_bindings(T0, T).
 1450
 1451
 1452only_cycles([], []).
 1453only_cycles([B|T0], List) :-
 1454    (   B = (Var=Value),
 1455        Var = Value,
 1456        acyclic_term(Var)
 1457    ->  only_cycles(T0, List)
 1458    ;   List = [B|T],
 1459        only_cycles(T0, T)
 1460    ).
 1461
 1462
 1463%!  filter_bindings(+Bindings0, -Bindings)
 1464%
 1465%   Remove bindings that must not be printed. There are two of them:
 1466%   Variables whose name start with '_'  and variables that are only
 1467%   bound to themselves (or, unbound).
 1468
 1469filter_bindings([], []).
 1470filter_bindings([H0|T0], T) :-
 1471    hide_vars(H0, H),
 1472    (   (   arg(1, H, [])
 1473        ;   self_bounded(H)
 1474        )
 1475    ->  filter_bindings(T0, T)
 1476    ;   T = [H|T1],
 1477        filter_bindings(T0, T1)
 1478    ).
 1479
 1480hide_vars(binding(Names0, Skel, Subst), binding(Names, Skel, Subst)) :-
 1481    hide_names(Names0, Skel, Subst, Names).
 1482
 1483hide_names([], _, _, []).
 1484hide_names([Name|T0], Skel, Subst, T) :-
 1485    (   sub_atom(Name, 0, _, _, '_'),
 1486        current_prolog_flag(toplevel_print_anon, false),
 1487        sub_atom(Name, 1, 1, _, Next),
 1488        char_type(Next, prolog_var_start)
 1489    ->  true
 1490    ;   Subst == [],
 1491        Skel == '$VAR'(Name)
 1492    ),
 1493    !,
 1494    hide_names(T0, Skel, Subst, T).
 1495hide_names([Name|T0], Skel, Subst, [Name|T]) :-
 1496    hide_names(T0, Skel, Subst, T).
 1497
 1498self_bounded(binding([Name], Value, [])) :-
 1499    Value == '$VAR'(Name).
 1500
 1501%!  get_respons(-Action)
 1502%
 1503%   Read the continuation entered by the user.
 1504
 1505get_respons(Action) :-
 1506    repeat,
 1507        flush_output(user_output),
 1508        get_single_char(Char),
 1509        answer_respons(Char, Action),
 1510        (   Action == again
 1511        ->  print_message(query, query(action)),
 1512            fail
 1513        ;   !
 1514        ).
 1515
 1516answer_respons(Char, again) :-
 1517    '$in_reply'(Char, '?h'),
 1518    !,
 1519    print_message(help, query(help)).
 1520answer_respons(Char, redo) :-
 1521    '$in_reply'(Char, ';nrNR \t'),
 1522    !,
 1523    print_message(query, if_tty([ansi(bold, ';', [])])).
 1524answer_respons(Char, redo) :-
 1525    '$in_reply'(Char, 'tT'),
 1526    !,
 1527    trace,
 1528    save_debug,
 1529    print_message(query, if_tty([ansi(bold, '; [trace]', [])])).
 1530answer_respons(Char, continue) :-
 1531    '$in_reply'(Char, 'ca\n\ryY.'),
 1532    !,
 1533    print_message(query, if_tty([ansi(bold, '.', [])])).
 1534answer_respons(0'b, show_again) :-
 1535    !,
 1536    break.
 1537answer_respons(Char, show_again) :-
 1538    print_predicate(Char, Pred, Options),
 1539    !,
 1540    print_message(query, if_tty(['~w'-[Pred]])),
 1541    set_prolog_flag(answer_write_options, Options).
 1542answer_respons(-1, show_again) :-
 1543    !,
 1544    print_message(query, halt('EOF')),
 1545    halt(0).
 1546answer_respons(Char, again) :-
 1547    print_message(query, no_action(Char)).
 1548
 1549print_predicate(0'w, [write], [ quoted(true),
 1550                                spacing(next_argument)
 1551                              ]).
 1552print_predicate(0'p, [print], [ quoted(true),
 1553                                portray(true),
 1554                                max_depth(10),
 1555                                spacing(next_argument)
 1556                              ]).
 1557
 1558
 1559                 /*******************************
 1560                 *          EXPANSION           *
 1561                 *******************************/
 1562
 1563:- user:dynamic(expand_query/4). 1564:- user:multifile(expand_query/4). 1565
 1566call_expand_query(Goal, Expanded, Bindings, ExpandedBindings) :-
 1567    user:expand_query(Goal, Expanded, Bindings, ExpandedBindings),
 1568    !.
 1569call_expand_query(Goal, Expanded, Bindings, ExpandedBindings) :-
 1570    toplevel_variables:expand_query(Goal, Expanded, Bindings, ExpandedBindings),
 1571    !.
 1572call_expand_query(Goal, Goal, Bindings, Bindings).
 1573
 1574
 1575:- user:dynamic(expand_answer/2). 1576:- user:multifile(expand_answer/2). 1577
 1578call_expand_answer(Goal, Expanded) :-
 1579    user:expand_answer(Goal, Expanded),
 1580    !.
 1581call_expand_answer(Goal, Expanded) :-
 1582    toplevel_variables:expand_answer(Goal, Expanded),
 1583    !.
 1584call_expand_answer(Goal, Goal)