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