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