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