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