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