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    associated_files(Files),
  524    '$load_script_file',
  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
  901:- if(current_prolog_flag(emscripten, true)).  902read_query(_Prompt, Goal, Bindings) :-
  903    '$can_yield',
  904    !,
  905    await(goal, GoalString),
  906    term_string(Goal, GoalString, [variable_names(Bindings)]).
  907:- endif.  908read_query(Prompt, Goal, Bindings) :-
  909    current_prolog_flag(history, N),
  910    integer(N), N > 0,
  911    !,
  912    read_term_with_history(
  913        Goal,
  914        [ show(h),
  915          help('!h'),
  916          no_save([trace, end_of_file]),
  917          prompt(Prompt),
  918          variable_names(Bindings)
  919        ]).
  920read_query(Prompt, Goal, Bindings) :-
  921    remove_history_prompt(Prompt, Prompt1),
  922    repeat,                                 % over syntax errors
  923    prompt1(Prompt1),
  924    read_query_line(user_input, Line),
  925    '$save_history_line'(Line),             % save raw line (edit syntax errors)
  926    '$current_typein_module'(TypeIn),
  927    catch(read_term_from_atom(Line, Goal,
  928                              [ variable_names(Bindings),
  929                                module(TypeIn)
  930                              ]), E,
  931          (   print_message(error, E),
  932              fail
  933          )),
  934    !,
  935    '$save_history_event'(Line).            % save event (no syntax errors)
  936
  937%!  read_query_line(+Input, -Line) is det.
  938
  939read_query_line(Input, Line) :-
  940    stream_property(Input, error(true)),
  941    !,
  942    Line = end_of_file.
  943read_query_line(Input, Line) :-
  944    catch(read_term_as_atom(Input, Line), Error, true),
  945    save_debug_after_read,
  946    (   var(Error)
  947    ->  true
  948    ;   catch(print_message(error, Error), _, true),
  949        (   Error = error(syntax_error(_),_)
  950        ->  fail
  951        ;   throw(Error)
  952        )
  953    ).
  954
  955%!  read_term_as_atom(+Input, -Line)
  956%
  957%   Read the next term as an  atom  and   skip  to  the newline or a
  958%   non-space character.
  959
  960read_term_as_atom(In, Line) :-
  961    '$raw_read'(In, Line),
  962    (   Line == end_of_file
  963    ->  true
  964    ;   skip_to_nl(In)
  965    ).
  966
  967%!  skip_to_nl(+Input) is det.
  968%
  969%   Read input after the term. Skips   white  space and %... comment
  970%   until the end of the line or a non-blank character.
  971
  972skip_to_nl(In) :-
  973    repeat,
  974    peek_char(In, C),
  975    (   C == '%'
  976    ->  skip(In, '\n')
  977    ;   char_type(C, space)
  978    ->  get_char(In, _),
  979        C == '\n'
  980    ;   true
  981    ),
  982    !.
  983
  984remove_history_prompt('', '') :- !.
  985remove_history_prompt(Prompt0, Prompt) :-
  986    atom_chars(Prompt0, Chars0),
  987    clean_history_prompt_chars(Chars0, Chars1),
  988    delete_leading_blanks(Chars1, Chars),
  989    atom_chars(Prompt, Chars).
  990
  991clean_history_prompt_chars([], []).
  992clean_history_prompt_chars(['~', !|T], T) :- !.
  993clean_history_prompt_chars([H|T0], [H|T]) :-
  994    clean_history_prompt_chars(T0, T).
  995
  996delete_leading_blanks([' '|T0], T) :-
  997    !,
  998    delete_leading_blanks(T0, T).
  999delete_leading_blanks(L, L).
 1000
 1001
 1002%!  set_default_history
 1003%
 1004%   Enable !-based numbered command history. This  is enabled by default
 1005%   if we are not running under GNU-emacs  and   we  do not have our own
 1006%   line editing.
 1007
 1008set_default_history :-
 1009    current_prolog_flag(history, _),
 1010    !.
 1011set_default_history :-
 1012    (   (   \+ current_prolog_flag(readline, false)
 1013        ;   current_prolog_flag(emacs_inferior_process, true)
 1014        )
 1015    ->  create_prolog_flag(history, 0, [])
 1016    ;   create_prolog_flag(history, 25, [])
 1017    ).
 1018
 1019
 1020                 /*******************************
 1021                 *        TOPLEVEL DEBUG        *
 1022                 *******************************/
 1023
 1024%!  save_debug_after_read
 1025%
 1026%   Called right after the toplevel read to save the debug status if
 1027%   it was modified from the GUI thread using e.g.
 1028%
 1029%     ==
 1030%     thread_signal(main, gdebug)
 1031%     ==
 1032%
 1033%   @bug Ideally, the prompt would change if debug mode is enabled.
 1034%        That is hard to realise with all the different console
 1035%        interfaces supported by SWI-Prolog.
 1036
 1037save_debug_after_read :-
 1038    current_prolog_flag(debug, true),
 1039    !,
 1040    save_debug.
 1041save_debug_after_read.
 1042
 1043save_debug :-
 1044    (   tracing,
 1045        notrace
 1046    ->  Tracing = true
 1047    ;   Tracing = false
 1048    ),
 1049    current_prolog_flag(debug, Debugging),
 1050    set_prolog_flag(debug, false),
 1051    create_prolog_flag(query_debug_settings,
 1052                       debug(Debugging, Tracing), []).
 1053
 1054restore_debug :-
 1055    current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)),
 1056    set_prolog_flag(debug, Debugging),
 1057    (   Tracing == true
 1058    ->  trace
 1059    ;   true
 1060    ).
 1061
 1062:- initialization
 1063    create_prolog_flag(query_debug_settings, debug(false, false), []). 1064
 1065
 1066                /********************************
 1067                *            PROMPTING          *
 1068                ********************************/
 1069
 1070'$system_prompt'(Module, BrekLev, Prompt) :-
 1071    current_prolog_flag(toplevel_prompt, PAtom),
 1072    atom_codes(PAtom, P0),
 1073    (    Module \== user
 1074    ->   '$substitute'('~m', [Module, ': '], P0, P1)
 1075    ;    '$substitute'('~m', [], P0, P1)
 1076    ),
 1077    (    BrekLev > 0
 1078    ->   '$substitute'('~l', ['[', BrekLev, '] '], P1, P2)
 1079    ;    '$substitute'('~l', [], P1, P2)
 1080    ),
 1081    current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)),
 1082    (    Tracing == true
 1083    ->   '$substitute'('~d', ['[trace] '], P2, P3)
 1084    ;    Debugging == true
 1085    ->   '$substitute'('~d', ['[debug] '], P2, P3)
 1086    ;    '$substitute'('~d', [], P2, P3)
 1087    ),
 1088    atom_chars(Prompt, P3).
 1089
 1090'$substitute'(From, T, Old, New) :-
 1091    atom_codes(From, FromCodes),
 1092    phrase(subst_chars(T), T0),
 1093    '$append'(Pre, S0, Old),
 1094    '$append'(FromCodes, Post, S0) ->
 1095    '$append'(Pre, T0, S1),
 1096    '$append'(S1, Post, New),
 1097    !.
 1098'$substitute'(_, _, Old, Old).
 1099
 1100subst_chars([]) -->
 1101    [].
 1102subst_chars([H|T]) -->
 1103    { atomic(H),
 1104      !,
 1105      atom_codes(H, Codes)
 1106    },
 1107    Codes,
 1108    subst_chars(T).
 1109subst_chars([H|T]) -->
 1110    H,
 1111    subst_chars(T).
 1112
 1113
 1114                /********************************
 1115                *           EXECUTION           *
 1116                ********************************/
 1117
 1118%!  '$execute_query'(Goal, Bindings, -Truth) is det.
 1119%
 1120%   Execute Goal using Bindings.
 1121
 1122'$execute_query'(Var, _, true) :-
 1123    var(Var),
 1124    !,
 1125    print_message(informational, var_query(Var)).
 1126'$execute_query'(Goal, Bindings, Truth) :-
 1127    '$current_typein_module'(TypeIn),
 1128    '$dwim_correct_goal'(TypeIn:Goal, Bindings, Corrected),
 1129    !,
 1130    setup_call_cleanup(
 1131        '$set_source_module'(M0, TypeIn),
 1132        expand_goal(Corrected, Expanded),
 1133        '$set_source_module'(M0)),
 1134    print_message(silent, toplevel_goal(Expanded, Bindings)),
 1135    '$execute_goal2'(Expanded, Bindings, Truth).
 1136'$execute_query'(_, _, false) :-
 1137    notrace,
 1138    print_message(query, query(no)).
 1139
 1140'$execute_goal2'(Goal, Bindings, true) :-
 1141    restore_debug,
 1142    '$current_typein_module'(TypeIn),
 1143    residue_vars(TypeIn:Goal, Vars, TypeIn:Delays, Chp),
 1144    deterministic(Det),
 1145    (   save_debug
 1146    ;   restore_debug, fail
 1147    ),
 1148    flush_output(user_output),
 1149    (   Det == true
 1150    ->  DetOrChp = true
 1151    ;   DetOrChp = Chp
 1152    ),
 1153    call_expand_answer(Bindings, NewBindings),
 1154    (    \+ \+ write_bindings(NewBindings, Vars, Delays, DetOrChp)
 1155    ->   !
 1156    ).
 1157'$execute_goal2'(_, _, false) :-
 1158    save_debug,
 1159    print_message(query, query(no)).
 1160
 1161residue_vars(Goal, Vars, Delays, Chp) :-
 1162    current_prolog_flag(toplevel_residue_vars, true),
 1163    !,
 1164    '$wfs_call'(call_residue_vars(stop_backtrace(Goal, Chp), Vars), Delays).
 1165residue_vars(Goal, [], Delays, Chp) :-
 1166    '$wfs_call'(stop_backtrace(Goal, Chp), Delays).
 1167
 1168stop_backtrace(Goal, Chp) :-
 1169    toplevel_call(Goal),
 1170    prolog_current_choice(Chp).
 1171
 1172toplevel_call(Goal) :-
 1173    call(Goal),
 1174    no_lco.
 1175
 1176no_lco.
 1177
 1178%!  write_bindings(+Bindings, +ResidueVars, +Delays, +DetOrChp)
 1179%!	is semidet.
 1180%
 1181%   Write   bindings   resulting   from   a     query.    The   flag
 1182%   prompt_alternatives_on determines whether the   user is prompted
 1183%   for alternatives. =groundness= gives   the  classical behaviour,
 1184%   =determinism= is considered more adequate and informative.
 1185%
 1186%   Succeeds if the user accepts the answer and fails otherwise.
 1187%
 1188%   @arg ResidueVars are the residual constraints and provided if
 1189%        the prolog flag `toplevel_residue_vars` is set to
 1190%        `project`.
 1191
 1192write_bindings(Bindings, ResidueVars, Delays, DetOrChp) :-
 1193    '$current_typein_module'(TypeIn),
 1194    translate_bindings(Bindings, Bindings1, ResidueVars, TypeIn:Residuals),
 1195    omit_qualifier(Delays, TypeIn, Delays1),
 1196    name_vars(Bindings1, Residuals, Delays1),
 1197    write_bindings2(Bindings1, Residuals, Delays1, DetOrChp).
 1198
 1199write_bindings2([], Residuals, Delays, _) :-
 1200    current_prolog_flag(prompt_alternatives_on, groundness),
 1201    !,
 1202    print_message(query, query(yes(Delays, Residuals))).
 1203write_bindings2(Bindings, Residuals, Delays, true) :-
 1204    current_prolog_flag(prompt_alternatives_on, determinism),
 1205    !,
 1206    print_message(query, query(yes(Bindings, Delays, Residuals))).
 1207write_bindings2(Bindings, Residuals, Delays, Chp) :-
 1208    repeat,
 1209        print_message(query, query(more(Bindings, Delays, Residuals))),
 1210        get_respons(Action, Chp),
 1211    (   Action == redo
 1212    ->  !, fail
 1213    ;   Action == show_again
 1214    ->  fail
 1215    ;   !,
 1216        print_message(query, query(done))
 1217    ).
 1218
 1219name_vars(Bindings, Residuals, Delays) :-
 1220    current_prolog_flag(toplevel_name_variables, true),
 1221    !,
 1222    '$term_multitons'(t(Bindings,Residuals,Delays), Vars),
 1223    name_vars_(Vars, Bindings, 0),
 1224    term_variables(t(Bindings,Residuals,Delays), SVars),
 1225    anon_vars(SVars).
 1226name_vars(_Bindings, _Residuals, _Delays).
 1227
 1228name_vars_([], _, _).
 1229name_vars_([H|T], Bindings, N) :-
 1230    name_var(Bindings, Name, N, N1),
 1231    H = '$VAR'(Name),
 1232    name_vars_(T, Bindings, N1).
 1233
 1234anon_vars([]).
 1235anon_vars(['$VAR'('_')|T]) :-
 1236    anon_vars(T).
 1237
 1238name_var(Bindings, Name, N0, N) :-
 1239    between(N0, infinite, N1),
 1240    I is N1//26,
 1241    J is 0'A + N1 mod 26,
 1242    (   I == 0
 1243    ->  format(atom(Name), '_~c', [J])
 1244    ;   format(atom(Name), '_~c~d', [J, I])
 1245    ),
 1246    (   current_prolog_flag(toplevel_print_anon, false)
 1247    ->  true
 1248    ;   \+ is_bound(Bindings, Name)
 1249    ),
 1250    !,
 1251    N is N1+1.
 1252
 1253is_bound([Vars=_|T], Name) :-
 1254    (   in_vars(Vars, Name)
 1255    ->  true
 1256    ;   is_bound(T, Name)
 1257    ).
 1258
 1259in_vars(Name, Name) :- !.
 1260in_vars(Names, Name) :-
 1261    '$member'(Name, Names).
 1262
 1263%!  residual_goals(:NonTerminal)
 1264%
 1265%   Directive that registers NonTerminal as a collector for residual
 1266%   goals.
 1267
 1268:- multifile
 1269    residual_goal_collector/1. 1270
 1271:- meta_predicate
 1272    residual_goals(2). 1273
 1274residual_goals(NonTerminal) :-
 1275    throw(error(context_error(nodirective, residual_goals(NonTerminal)), _)).
 1276
 1277system:term_expansion((:- residual_goals(NonTerminal)),
 1278                      '$toplevel':residual_goal_collector(M2:Head)) :-
 1279    \+ current_prolog_flag(xref, true),
 1280    prolog_load_context(module, M),
 1281    strip_module(M:NonTerminal, M2, Head),
 1282    '$must_be'(callable, Head).
 1283
 1284%!  prolog:residual_goals// is det.
 1285%
 1286%   DCG that collects residual goals that   are  not associated with
 1287%   the answer through attributed variables.
 1288
 1289:- public prolog:residual_goals//0. 1290
 1291prolog:residual_goals -->
 1292    { findall(NT, residual_goal_collector(NT), NTL) },
 1293    collect_residual_goals(NTL).
 1294
 1295collect_residual_goals([]) --> [].
 1296collect_residual_goals([H|T]) -->
 1297    ( call(H) -> [] ; [] ),
 1298    collect_residual_goals(T).
 1299
 1300
 1301
 1302%!  prolog:translate_bindings(+Bindings0, -Bindings, +ResidueVars,
 1303%!                            +ResidualGoals, -Residuals) is det.
 1304%
 1305%   Translate the raw variable bindings  resulting from successfully
 1306%   completing a query into a  binding   list  and  list of residual
 1307%   goals suitable for human consumption.
 1308%
 1309%   @arg    Bindings is a list of binding(Vars,Value,Substitutions),
 1310%           where Vars is a list of variable names. E.g.
 1311%           binding(['A','B'],42,[])` means that both the variable
 1312%           A and B have the value 42. Values may contain terms
 1313%           '$VAR'(Name) to indicate sharing with a given variable.
 1314%           Value is always an acyclic term. If cycles appear in the
 1315%           answer, Substitutions contains a list of substitutions
 1316%           that restore the original term.
 1317%
 1318%   @arg    Residuals is a pair of two lists representing residual
 1319%           goals. The first element of the pair are residuals
 1320%           related to the query variables and the second are
 1321%           related that are disconnected from the query.
 1322
 1323:- public
 1324    prolog:translate_bindings/5. 1325:- meta_predicate
 1326    prolog:translate_bindings(+, -, +, +, :). 1327
 1328prolog:translate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals) :-
 1329    translate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals).
 1330
 1331translate_bindings(Bindings0, Bindings, ResidueVars, Residuals) :-
 1332    prolog:residual_goals(ResidueGoals, []),
 1333    translate_bindings(Bindings0, Bindings, ResidueVars, ResidueGoals,
 1334                       Residuals).
 1335
 1336translate_bindings(Bindings0, Bindings, [], [], _:[]-[]) :-
 1337    term_attvars(Bindings0, []),
 1338    !,
 1339    join_same_bindings(Bindings0, Bindings1),
 1340    factorize_bindings(Bindings1, Bindings2),
 1341    bind_vars(Bindings2, Bindings3),
 1342    filter_bindings(Bindings3, Bindings).
 1343translate_bindings(Bindings0, Bindings, ResidueVars, ResGoals0,
 1344                   TypeIn:Residuals-HiddenResiduals) :-
 1345    project_constraints(Bindings0, ResidueVars),
 1346    hidden_residuals(ResidueVars, Bindings0, HiddenResiduals0),
 1347    omit_qualifiers(HiddenResiduals0, TypeIn, HiddenResiduals),
 1348    copy_term(Bindings0+ResGoals0, Bindings1+ResGoals1, Residuals0),
 1349    '$append'(ResGoals1, Residuals0, Residuals1),
 1350    omit_qualifiers(Residuals1, TypeIn, Residuals),
 1351    join_same_bindings(Bindings1, Bindings2),
 1352    factorize_bindings(Bindings2, Bindings3),
 1353    bind_vars(Bindings3, Bindings4),
 1354    filter_bindings(Bindings4, Bindings).
 1355
 1356hidden_residuals(ResidueVars, Bindings, Goal) :-
 1357    term_attvars(ResidueVars, Remaining),
 1358    term_attvars(Bindings, QueryVars),
 1359    subtract_vars(Remaining, QueryVars, HiddenVars),
 1360    copy_term(HiddenVars, _, Goal).
 1361
 1362subtract_vars(All, Subtract, Remaining) :-
 1363    sort(All, AllSorted),
 1364    sort(Subtract, SubtractSorted),
 1365    ord_subtract(AllSorted, SubtractSorted, Remaining).
 1366
 1367ord_subtract([], _Not, []).
 1368ord_subtract([H1|T1], L2, Diff) :-
 1369    diff21(L2, H1, T1, Diff).
 1370
 1371diff21([], H1, T1, [H1|T1]).
 1372diff21([H2|T2], H1, T1, Diff) :-
 1373    compare(Order, H1, H2),
 1374    diff3(Order, H1, T1, H2, T2, Diff).
 1375
 1376diff12([], _H2, _T2, []).
 1377diff12([H1|T1], H2, T2, Diff) :-
 1378    compare(Order, H1, H2),
 1379    diff3(Order, H1, T1, H2, T2, Diff).
 1380
 1381diff3(<,  H1, T1,  H2, T2, [H1|Diff]) :-
 1382    diff12(T1, H2, T2, Diff).
 1383diff3(=, _H1, T1, _H2, T2, Diff) :-
 1384    ord_subtract(T1, T2, Diff).
 1385diff3(>,  H1, T1, _H2, T2, Diff) :-
 1386    diff21(T2, H1, T1, Diff).
 1387
 1388
 1389%!  project_constraints(+Bindings, +ResidueVars) is det.
 1390%
 1391%   Call   <module>:project_attributes/2   if   the    Prolog   flag
 1392%   `toplevel_residue_vars` is set to `project`.
 1393
 1394project_constraints(Bindings, ResidueVars) :-
 1395    !,
 1396    term_attvars(Bindings, AttVars),
 1397    phrase(attribute_modules(AttVars), Modules0),
 1398    sort(Modules0, Modules),
 1399    term_variables(Bindings, QueryVars),
 1400    project_attributes(Modules, QueryVars, ResidueVars).
 1401project_constraints(_, _).
 1402
 1403project_attributes([], _, _).
 1404project_attributes([M|T], QueryVars, ResidueVars) :-
 1405    (   current_predicate(M:project_attributes/2),
 1406        catch(M:project_attributes(QueryVars, ResidueVars), E,
 1407              print_message(error, E))
 1408    ->  true
 1409    ;   true
 1410    ),
 1411    project_attributes(T, QueryVars, ResidueVars).
 1412
 1413attribute_modules([]) --> [].
 1414attribute_modules([H|T]) -->
 1415    { get_attrs(H, Attrs) },
 1416    attrs_modules(Attrs),
 1417    attribute_modules(T).
 1418
 1419attrs_modules([]) --> [].
 1420attrs_modules(att(Module, _, More)) -->
 1421    [Module],
 1422    attrs_modules(More).
 1423
 1424
 1425%!  join_same_bindings(Bindings0, Bindings)
 1426%
 1427%   Join variables that are bound to the   same  value. Note that we
 1428%   return the _last_ value. This is   because the factorization may
 1429%   be different and ultimately the names will   be  printed as V1 =
 1430%   V2, ... VN = Value. Using the  last, Value has the factorization
 1431%   of VN.
 1432
 1433join_same_bindings([], []).
 1434join_same_bindings([Name=V0|T0], [[Name|Names]=V|T]) :-
 1435    take_same_bindings(T0, V0, V, Names, T1),
 1436    join_same_bindings(T1, T).
 1437
 1438take_same_bindings([], Val, Val, [], []).
 1439take_same_bindings([Name=V1|T0], V0, V, [Name|Names], T) :-
 1440    V0 == V1,
 1441    !,
 1442    take_same_bindings(T0, V1, V, Names, T).
 1443take_same_bindings([Pair|T0], V0, V, Names, [Pair|T]) :-
 1444    take_same_bindings(T0, V0, V, Names, T).
 1445
 1446
 1447%!  omit_qualifiers(+QGoals, +TypeIn, -Goals) is det.
 1448%
 1449%   Omit unneeded module qualifiers  from   QGoals  relative  to the
 1450%   given module TypeIn.
 1451
 1452
 1453omit_qualifiers([], _, []).
 1454omit_qualifiers([Goal0|Goals0], TypeIn, [Goal|Goals]) :-
 1455    omit_qualifier(Goal0, TypeIn, Goal),
 1456    omit_qualifiers(Goals0, TypeIn, Goals).
 1457
 1458omit_qualifier(M:G0, TypeIn, G) :-
 1459    M == TypeIn,
 1460    !,
 1461    omit_meta_qualifiers(G0, TypeIn, G).
 1462omit_qualifier(M:G0, TypeIn, G) :-
 1463    predicate_property(TypeIn:G0, imported_from(M)),
 1464    \+ predicate_property(G0, transparent),
 1465    !,
 1466    G0 = G.
 1467omit_qualifier(_:G0, _, G) :-
 1468    predicate_property(G0, built_in),
 1469    \+ predicate_property(G0, transparent),
 1470    !,
 1471    G0 = G.
 1472omit_qualifier(M:G0, _, M:G) :-
 1473    atom(M),
 1474    !,
 1475    omit_meta_qualifiers(G0, M, G).
 1476omit_qualifier(G0, TypeIn, G) :-
 1477    omit_meta_qualifiers(G0, TypeIn, G).
 1478
 1479omit_meta_qualifiers(V, _, V) :-
 1480    var(V),
 1481    !.
 1482omit_meta_qualifiers((QA,QB), TypeIn, (A,B)) :-
 1483    !,
 1484    omit_qualifier(QA, TypeIn, A),
 1485    omit_qualifier(QB, TypeIn, B).
 1486omit_meta_qualifiers(tnot(QA), TypeIn, tnot(A)) :-
 1487    !,
 1488    omit_qualifier(QA, TypeIn, A).
 1489omit_meta_qualifiers(freeze(V, QGoal), TypeIn, freeze(V, Goal)) :-
 1490    callable(QGoal),
 1491    !,
 1492    omit_qualifier(QGoal, TypeIn, Goal).
 1493omit_meta_qualifiers(when(Cond, QGoal), TypeIn, when(Cond, Goal)) :-
 1494    callable(QGoal),
 1495    !,
 1496    omit_qualifier(QGoal, TypeIn, Goal).
 1497omit_meta_qualifiers(G, _, G).
 1498
 1499
 1500%!  bind_vars(+BindingsIn, -Bindings)
 1501%
 1502%   Bind variables to '$VAR'(Name), so they are printed by the names
 1503%   used in the query. Note that by   binding  in the reverse order,
 1504%   variables bound to one another come out in the natural order.
 1505
 1506bind_vars(Bindings0, Bindings) :-
 1507    bind_query_vars(Bindings0, Bindings, SNames),
 1508    bind_skel_vars(Bindings, Bindings, SNames, 1, _).
 1509
 1510bind_query_vars([], [], []).
 1511bind_query_vars([binding(Names,Var,[Var2=Cycle])|T0],
 1512                [binding(Names,Cycle,[])|T], [Name|SNames]) :-
 1513    Var == Var2,                   % also implies var(Var)
 1514    !,
 1515    '$last'(Names, Name),
 1516    Var = '$VAR'(Name),
 1517    bind_query_vars(T0, T, SNames).
 1518bind_query_vars([B|T0], [B|T], AllNames) :-
 1519    B = binding(Names,Var,Skel),
 1520    bind_query_vars(T0, T, SNames),
 1521    (   var(Var), \+ attvar(Var), Skel == []
 1522    ->  AllNames = [Name|SNames],
 1523        '$last'(Names, Name),
 1524        Var = '$VAR'(Name)
 1525    ;   AllNames = SNames
 1526    ).
 1527
 1528
 1529
 1530bind_skel_vars([], _, _, N, N).
 1531bind_skel_vars([binding(_,_,Skel)|T], Bindings, SNames, N0, N) :-
 1532    bind_one_skel_vars(Skel, Bindings, SNames, N0, N1),
 1533    bind_skel_vars(T, Bindings, SNames, N1, N).
 1534
 1535%!  bind_one_skel_vars(+Subst, +Bindings, +VarName, +N0, -N)
 1536%
 1537%   Give names to the factorized variables that   do not have a name
 1538%   yet. This introduces names  _S<N>,   avoiding  duplicates.  If a
 1539%   factorized variable shares with another binding, use the name of
 1540%   that variable.
 1541%
 1542%   @tbd    Consider the call below. We could remove either of the
 1543%           A = x(1).  Which is best?
 1544%
 1545%           ==
 1546%           ?- A = x(1), B = a(A,A).
 1547%           A = x(1),
 1548%           B = a(A, A), % where
 1549%               A = x(1).
 1550%           ==
 1551
 1552bind_one_skel_vars([], _, _, N, N).
 1553bind_one_skel_vars([Var=Value|T], Bindings, Names, N0, N) :-
 1554    (   var(Var)
 1555    ->  (   '$member'(binding(Names, VVal, []), Bindings),
 1556            same_term(Value, VVal)
 1557        ->  '$last'(Names, VName),
 1558            Var = '$VAR'(VName),
 1559            N2 = N0
 1560        ;   between(N0, infinite, N1),
 1561            atom_concat('_S', N1, Name),
 1562            \+ memberchk(Name, Names),
 1563            !,
 1564            Var = '$VAR'(Name),
 1565            N2 is N1 + 1
 1566        )
 1567    ;   N2 = N0
 1568    ),
 1569    bind_one_skel_vars(T, Bindings, Names, N2, N).
 1570
 1571
 1572%!  factorize_bindings(+Bindings0, -Factorized)
 1573%
 1574%   Factorize cycles and sharing in the bindings.
 1575
 1576factorize_bindings([], []).
 1577factorize_bindings([Name=Value|T0], [binding(Name, Skel, Subst)|T]) :-
 1578    '$factorize_term'(Value, Skel, Subst0),
 1579    (   current_prolog_flag(toplevel_print_factorized, true)
 1580    ->  Subst = Subst0
 1581    ;   only_cycles(Subst0, Subst)
 1582    ),
 1583    factorize_bindings(T0, T).
 1584
 1585
 1586only_cycles([], []).
 1587only_cycles([B|T0], List) :-
 1588    (   B = (Var=Value),
 1589        Var = Value,
 1590        acyclic_term(Var)
 1591    ->  only_cycles(T0, List)
 1592    ;   List = [B|T],
 1593        only_cycles(T0, T)
 1594    ).
 1595
 1596
 1597%!  filter_bindings(+Bindings0, -Bindings)
 1598%
 1599%   Remove bindings that must not be printed. There are two of them:
 1600%   Variables whose name start with '_'  and variables that are only
 1601%   bound to themselves (or, unbound).
 1602
 1603filter_bindings([], []).
 1604filter_bindings([H0|T0], T) :-
 1605    hide_vars(H0, H),
 1606    (   (   arg(1, H, [])
 1607        ;   self_bounded(H)
 1608        )
 1609    ->  filter_bindings(T0, T)
 1610    ;   T = [H|T1],
 1611        filter_bindings(T0, T1)
 1612    ).
 1613
 1614hide_vars(binding(Names0, Skel, Subst), binding(Names, Skel, Subst)) :-
 1615    hide_names(Names0, Skel, Subst, Names).
 1616
 1617hide_names([], _, _, []).
 1618hide_names([Name|T0], Skel, Subst, T) :-
 1619    (   sub_atom(Name, 0, _, _, '_'),
 1620        current_prolog_flag(toplevel_print_anon, false),
 1621        sub_atom(Name, 1, 1, _, Next),
 1622        char_type(Next, prolog_var_start)
 1623    ->  true
 1624    ;   Subst == [],
 1625        Skel == '$VAR'(Name)
 1626    ),
 1627    !,
 1628    hide_names(T0, Skel, Subst, T).
 1629hide_names([Name|T0], Skel, Subst, [Name|T]) :-
 1630    hide_names(T0, Skel, Subst, T).
 1631
 1632self_bounded(binding([Name], Value, [])) :-
 1633    Value == '$VAR'(Name).
 1634
 1635%!  get_respons(-Action, +Chp)
 1636%
 1637%   Read the continuation entered by the user.
 1638
 1639:- if(current_prolog_flag(emscripten, true)). 1640get_respons(Action, _Chp) :-
 1641    '$can_yield',
 1642    !,
 1643    await(more, ActionS),
 1644    atom_string(Action, ActionS).
 1645:- endif. 1646get_respons(Action, Chp) :-
 1647    repeat,
 1648        flush_output(user_output),
 1649        get_single_char(Char),
 1650        answer_respons(Char, Chp, Action),
 1651        (   Action == again
 1652        ->  print_message(query, query(action)),
 1653            fail
 1654        ;   !
 1655        ).
 1656
 1657answer_respons(Char, _, again) :-
 1658    '$in_reply'(Char, '?h'),
 1659    !,
 1660    print_message(help, query(help)).
 1661answer_respons(Char, _, redo) :-
 1662    '$in_reply'(Char, ';nrNR \t'),
 1663    !,
 1664    print_message(query, if_tty([ansi(bold, ';', [])])).
 1665answer_respons(Char, _, redo) :-
 1666    '$in_reply'(Char, 'tT'),
 1667    !,
 1668    trace,
 1669    save_debug,
 1670    print_message(query, if_tty([ansi(bold, '; [trace]', [])])).
 1671answer_respons(Char, _, continue) :-
 1672    '$in_reply'(Char, 'ca\n\ryY.'),
 1673    !,
 1674    print_message(query, if_tty([ansi(bold, '.', [])])).
 1675answer_respons(0'b, _, show_again) :-
 1676    !,
 1677    break.
 1678answer_respons(0'*, Chp, show_again) :-
 1679    !,
 1680    print_last_chpoint(Chp).
 1681answer_respons(Char, _, show_again) :-
 1682    print_predicate(Char, Pred, Options),
 1683    !,
 1684    print_message(query, if_tty(['~w'-[Pred]])),
 1685    set_prolog_flag(answer_write_options, Options).
 1686answer_respons(-1, _, show_again) :-
 1687    !,
 1688    print_message(query, halt('EOF')),
 1689    halt(0).
 1690answer_respons(Char, _, again) :-
 1691    print_message(query, no_action(Char)).
 1692
 1693print_predicate(0'w, [write], [ quoted(true),
 1694                                spacing(next_argument)
 1695                              ]).
 1696print_predicate(0'p, [print], [ quoted(true),
 1697                                portray(true),
 1698                                max_depth(10),
 1699                                spacing(next_argument)
 1700                              ]).
 1701
 1702
 1703print_last_chpoint(Chp) :-
 1704    current_predicate(print_last_choice_point/0),
 1705    !,
 1706    print_last_chpoint_(Chp).
 1707print_last_chpoint(Chp) :-
 1708    use_module(library(prolog_stack), [print_last_choicepoint/2]),
 1709    print_last_chpoint_(Chp).
 1710
 1711print_last_chpoint_(Chp) :-
 1712    print_last_choicepoint(Chp, [message_level(information)]).
 1713
 1714
 1715                 /*******************************
 1716                 *          EXPANSION           *
 1717                 *******************************/
 1718
 1719:- user:dynamic(expand_query/4). 1720:- user:multifile(expand_query/4). 1721
 1722call_expand_query(Goal, Expanded, Bindings, ExpandedBindings) :-
 1723    user:expand_query(Goal, Expanded, Bindings, ExpandedBindings),
 1724    !.
 1725call_expand_query(Goal, Expanded, Bindings, ExpandedBindings) :-
 1726    toplevel_variables:expand_query(Goal, Expanded, Bindings, ExpandedBindings),
 1727    !.
 1728call_expand_query(Goal, Goal, Bindings, Bindings).
 1729
 1730
 1731:- user:dynamic(expand_answer/2). 1732:- user:multifile(expand_answer/2). 1733
 1734call_expand_answer(Goal, Expanded) :-
 1735    user:expand_answer(Goal, Expanded),
 1736    !.
 1737call_expand_answer(Goal, Expanded) :-
 1738    toplevel_variables:expand_answer(Goal, Expanded),
 1739    !.
 1740call_expand_answer(Goal, Goal)