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