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