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-2025, University of Amsterdam 7 VU University Amsterdam 8 SWI-Prolog Solutions b.v. 9 All rights reserved. 10 11 Redistribution and use in source and binary forms, with or without 12 modification, are permitted provided that the following conditions 13 are met: 14 15 1. Redistributions of source code must retain the above copyright 16 notice, this list of conditions and the following disclaimer. 17 18 2. Redistributions in binary form must reproduce the above copyright 19 notice, this list of conditions and the following disclaimer in 20 the documentation and/or other materials provided with the 21 distribution. 22 23 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 24 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 25 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 26 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 27 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 28 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 29 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 30 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 31 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 32 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 33 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 34 POSSIBILITY OF SUCH DAMAGE. 35*/ 36 37:- module('$toplevel', 38 [ '$initialise'/0, % start Prolog 39 '$toplevel'/0, % Prolog top-level (re-entrant) 40 '$compile'/0, % `-c' toplevel 41 '$config'/0, % --dump-runtime-variables toplevel 42 initialize/0, % Run program initialization 43 version/0, % Write initial banner 44 version/1, % Add message to the banner 45 prolog/0, % user toplevel predicate 46 '$query_loop'/0, % toplevel predicate 47 '$execute_query'/3, % +Query, +Bindings, -Truth 48 residual_goals/1, % +Callable 49 (initialization)/1, % initialization goal (directive) 50 '$thread_init'/0, % initialise thread 51 (thread_initialization)/1 % thread initialization goal 52 ]). 53 54 55 /******************************* 56 * VERSION BANNER * 57 *******************************/ 58 59:- dynamic prolog:version_msg/1. 60:- multifile prolog:version_msg/1.
67version :-
68 print_message(banner, welcome).
74:- multifile 75 system:term_expansion/2. 76 77systemterm_expansion((:- version(Message)), 78 prolog:version_msg(Message)). 79 80version(Message) :- 81 ( prolog:version_msg(Message) 82 -> true 83 ; assertz(prolog:version_msg(Message)) 84 ). 85 86 87 /******************************** 88 * INITIALISATION * 89 *********************************/
swipl -f
file
or simply using swipl
. In the first case we search the
file both directly and over the alias user_app_config
. In the
latter case we only use the alias.98load_init_file(_) :- 99 '$cmd_option_val'(init_file, OsFile), 100 !, 101 prolog_to_os_filename(File, OsFile), 102 load_init_file(File, explicit). 103load_init_file(prolog) :- 104 !, 105 load_init_file('init.pl', implicit). 106load_init_file(none) :- 107 !, 108 load_init_file('init.pl', implicit). 109load_init_file(_).
115:- dynamic 116 loaded_init_file/2. % already loaded init files 117 118load_init_file(none, _) :- !. 119load_init_file(Base, _) :- 120 loaded_init_file(Base, _), 121 !. 122load_init_file(InitFile, explicit) :- 123 exists_file(InitFile), 124 !, 125 ensure_loaded(user:InitFile). 126load_init_file(Base, _) :- 127 absolute_file_name(user_app_config(Base), InitFile, 128 [ access(read), 129 file_errors(fail) 130 ]), 131 !, 132 asserta(loaded_init_file(Base, InitFile)), 133 load_files(user:InitFile, 134 [ scope_settings(false) 135 ]). 136load_init_file('init.pl', implicit) :- 137 ( current_prolog_flag(windows, true), 138 absolute_file_name(user_profile('swipl.ini'), InitFile, 139 [ access(read), 140 file_errors(fail) 141 ]) 142 ; expand_file_name('~/.swiplrc', [InitFile]), 143 exists_file(InitFile) 144 ), 145 !, 146 print_message(warning, backcomp(init_file_moved(InitFile))). 147load_init_file(_, _). 148 149'$load_system_init_file' :- 150 loaded_init_file(system, _), 151 !. 152'$load_system_init_file' :- 153 '$cmd_option_val'(system_init_file, Base), 154 Base \== none, 155 current_prolog_flag(home, Home), 156 file_name_extension(Base, rc, Name), 157 atomic_list_concat([Home, '/', Name], File), 158 absolute_file_name(File, Path, 159 [ file_type(prolog), 160 access(read), 161 file_errors(fail) 162 ]), 163 asserta(loaded_init_file(system, Path)), 164 load_files(user:Path, 165 [ silent(true), 166 scope_settings(false) 167 ]), 168 !. 169'$load_system_init_file'. 170 171'$load_script_file' :- 172 loaded_init_file(script, _), 173 !. 174'$load_script_file' :- 175 '$cmd_option_val'(script_file, OsFiles), 176 load_script_files(OsFiles). 177 178load_script_files([]). 179load_script_files([OsFile|More]) :- 180 prolog_to_os_filename(File, OsFile), 181 ( absolute_file_name(File, Path, 182 [ file_type(prolog), 183 access(read), 184 file_errors(fail) 185 ]) 186 -> asserta(loaded_init_file(script, Path)), 187 load_files(user:Path), 188 load_files(user:More) 189 ; throw(error(existence_error(script_file, File), _)) 190 ). 191 192 193 /******************************* 194 * AT_INITIALISATION * 195 *******************************/ 196 197:- meta_predicate 198 initialization( ). 199 200:- '$iso'((initialization)/1).
209initialization(Goal) :- 210 Goal = _:G, 211 prolog:initialize_now(G, Use), 212 !, 213 print_message(warning, initialize_now(G, Use)), 214 initialization(Goal, now). 215initialization(Goal) :- 216 initialization(Goal, after_load). 217 218:- multifile 219 prolog:initialize_now/2, 220 prolog:message//1. 221 222prologinitialize_now(load_foreign_library(_), 223 'use :- use_foreign_library/1 instead'). 224prologinitialize_now(load_foreign_library(_,_), 225 'use :- use_foreign_library/2 instead'). 226 227prologmessage(initialize_now(Goal, Use)) --> 228 [ 'Initialization goal ~p will be executed'-[Goal],nl, 229 'immediately for backward compatibility reasons', nl, 230 '~w'-[Use] 231 ]. 232 233'$run_initialization' :- 234 '$set_prolog_file_extension', 235 '$run_initialization'(_, []), 236 '$thread_init'.
:- initialization(Goal, program).
. Stop
with an exception if a goal fails or raises an exception.243initialize :- 244 forall('$init_goal'(when(program), Goal, Ctx), 245 run_initialize(Goal, Ctx)). 246 247run_initialize(Goal, Ctx) :- 248 ( catch(Goal, E, true), 249 ( var(E) 250 -> true 251 ; throw(error(initialization_error(E, Goal, Ctx), _)) 252 ) 253 ; throw(error(initialization_error(failed, Goal, Ctx), _)) 254 ). 255 256 257 /******************************* 258 * THREAD INITIALIZATION * 259 *******************************/ 260 261:- meta_predicate 262 thread_initialization( ). 263:- dynamic 264 '$at_thread_initialization'/1.
270thread_initialization(Goal) :- 271 assert('$at_thread_initialization'(Goal)), 272 call(Goal), 273 !. 274 275'$thread_init' :- 276 ( '$at_thread_initialization'(Goal), 277 ( call(Goal) 278 -> fail 279 ; fail 280 ) 281 ; true 282 ). 283 284 285 /******************************* 286 * FILE SEARCH PATH (-p) * 287 *******************************/
293'$set_file_search_paths' :- 294 '$cmd_option_val'(search_paths, Paths), 295 ( '$member'(Path, Paths), 296 atom_chars(Path, Chars), 297 ( phrase('$search_path'(Name, Aliases), Chars) 298 -> '$reverse'(Aliases, Aliases1), 299 forall('$member'(Alias, Aliases1), 300 asserta(user:file_search_path(Name, Alias))) 301 ; print_message(error, commandline_arg_type(p, Path)) 302 ), 303 fail ; true 304 ). 305 306'$search_path'(Name, Aliases) --> 307 '$string'(NameChars), 308 [=], 309 !, 310 {atom_chars(Name, NameChars)}, 311 '$search_aliases'(Aliases). 312 313'$search_aliases'([Alias|More]) --> 314 '$string'(AliasChars), 315 path_sep, 316 !, 317 { '$make_alias'(AliasChars, Alias) }, 318 '$search_aliases'(More). 319'$search_aliases'([Alias]) --> 320 '$string'(AliasChars), 321 '$eos', 322 !, 323 { '$make_alias'(AliasChars, Alias) }. 324 325path_sep --> 326 { current_prolog_flag(path_sep, Sep) }, 327 [Sep]. 328 329'$string'([]) --> []. 330'$string'([H|T]) --> [H], '$string'(T). 331 332'$eos'([], []). 333 334'$make_alias'(Chars, Alias) :- 335 catch(term_to_atom(Alias, Chars), _, fail), 336 ( atom(Alias) 337 ; functor(Alias, F, 1), 338 F \== / 339 ), 340 !. 341'$make_alias'(Chars, Alias) :- 342 atom_chars(Alias, Chars). 343 344 345 /******************************* 346 * LOADING ASSIOCIATED FILES * 347 *******************************/
argv
, extracting the leading script files.
This is called after the C based parser removed Prolog options such
as -q
, -f none
, etc. These options are available through
'$cmd_option_val'/2.
Our task is to update the Prolog flag argv
and return a list of
the files to be loaded. The rules are:
--
all remaining options must go to argv
search(name)
as Prolog file,
make this the content of Files and pass the remainder as
options to argv
.381argv_prolog_files([], exe) :- 382 current_prolog_flag(saved_program_class, runtime), 383 !, 384 clean_argv. 385argv_prolog_files(Files, ScriptMode) :- 386 current_prolog_flag(argv, Argv), 387 no_option_files(Argv, Argv1, Files, ScriptMode), 388 ( ( nonvar(ScriptMode) 389 ; Argv1 == [] 390 ) 391 -> ( Argv1 \== Argv 392 -> set_prolog_flag(argv, Argv1) 393 ; true 394 ) 395 ; '$usage', 396 halt(1) 397 ). 398 399no_option_files([--|Argv], Argv, [], ScriptMode) :- 400 !, 401 ( ScriptMode = none 402 -> true 403 ; true 404 ). 405no_option_files([Opt|_], _, _, ScriptMode) :- 406 var(ScriptMode), 407 sub_atom(Opt, 0, _, _, '-'), 408 !, 409 '$usage', 410 halt(1). 411no_option_files([OsFile|Argv0], Argv, [File|T], ScriptMode) :- 412 file_name_extension(_, Ext, OsFile), 413 user:prolog_file_type(Ext, prolog), 414 !, 415 ScriptMode = prolog, 416 prolog_to_os_filename(File, OsFile), 417 no_option_files(Argv0, Argv, T, ScriptMode). 418no_option_files([OsScript|Argv], Argv, [Script], ScriptMode) :- 419 var(ScriptMode), 420 !, 421 prolog_to_os_filename(PlScript, OsScript), 422 ( exists_file(PlScript) 423 -> Script = PlScript, 424 ScriptMode = script 425 ; cli_script(OsScript, Script) 426 -> ScriptMode = app, 427 set_prolog_flag(app_name, OsScript) 428 ; '$existence_error'(file, PlScript) 429 ). 430no_option_files(Argv, Argv, [], ScriptMode) :- 431 ( ScriptMode = none 432 -> true 433 ; true 434 ). 435 436cli_script(CLI, Script) :- 437 ( sub_atom(CLI, Pre, _, Post, ':') 438 -> sub_atom(CLI, 0, Pre, _, SearchPath), 439 sub_atom(CLI, _, Post, 0, Base), 440 Spec =.. [SearchPath, Base] 441 ; Spec = app(CLI) 442 ), 443 absolute_file_name(Spec, Script, 444 [ file_type(prolog), 445 access(exist), 446 file_errors(fail) 447 ]). 448 449clean_argv :- 450 ( current_prolog_flag(argv, [--|Argv]) 451 -> set_prolog_flag(argv, Argv) 452 ; true 453 ).
462win_associated_files(Files) :-
463 ( Files = [File|_]
464 -> absolute_file_name(File, AbsFile),
465 set_prolog_flag(associated_file, AbsFile),
466 set_working_directory(File),
467 set_window_title(Files)
468 ; true
469 ).
console_menu
,
which is set by swipl-win[.exe].479set_working_directory(File) :- 480 current_prolog_flag(console_menu, true), 481 access_file(File, read), 482 !, 483 file_directory_name(File, Dir), 484 working_directory(_, Dir). 485set_working_directory(_). 486 487set_window_title([File|More]) :- 488 current_predicate(system:window_title/2), 489 !, 490 ( More == [] 491 -> Extra = [] 492 ; Extra = ['...'] 493 ), 494 atomic_list_concat(['SWI-Prolog --', File | Extra], ' ', Title), 495 system:window_title(_, Title). 496set_window_title(_).
--pldoc[=port]
is given, load the PlDoc system.503start_pldoc :- 504 '$cmd_option_val'(pldoc_server, Server), 505 ( Server == '' 506 -> call((doc_server(_), doc_browser)) 507 ; catch(atom_number(Server, Port), _, fail) 508 -> call(doc_server(Port)) 509 ; print_message(error, option_usage(pldoc)), 510 halt(1) 511 ). 512start_pldoc.
519load_associated_files(Files) :- 520 load_files(user:Files). 521 522hkey('HKEY_CURRENT_USER/Software/SWI/Prolog'). 523hkey('HKEY_LOCAL_MACHINE/Software/SWI/Prolog'). 524 525'$set_prolog_file_extension' :- 526 current_prolog_flag(windows, true), 527 hkey(Key), 528 catch(win_registry_get_value(Key, fileExtension, Ext0), 529 _, fail), 530 !, 531 ( atom_concat('.', Ext, Ext0) 532 -> true 533 ; Ext = Ext0 534 ), 535 ( user:prolog_file_type(Ext, prolog) 536 -> true 537 ; asserta(user:prolog_file_type(Ext, prolog)) 538 ). 539'$set_prolog_file_extension'. 540 541 542 /******************************** 543 * TOPLEVEL GOALS * 544 *********************************/
552'$initialise' :- 553 catch(initialise_prolog, E, initialise_error(E)). 554 555initialise_error(unwind(abort)) :- !. 556initialise_error(unwind(halt(_))) :- !. 557initialise_error(E) :- 558 print_message(error, initialization_exception(E)), 559 fail. 560 561initialise_prolog :- 562 '$clean_history', 563 apply_defines, 564 apple_setup_app, % MacOS cwd/locale setup for swipl-win 565 init_optimise, 566 '$run_initialization', 567 '$load_system_init_file', % -F file 568 set_toplevel, % set `toplevel_goal` flag from -t 569 '$set_file_search_paths', % handle -p alias=dir[:dir]* 570 init_debug_flags, 571 start_pldoc, % handle --pldoc[=port] 572 main_thread_init.
epilog
is set and
xpce is around, create an epilog window and complete the user part
of the initialization in the epilog thread.580main_thread_init :- 581 current_prolog_flag(epilog, true), 582 thread_self(main), 583 current_prolog_flag(xpce, true), 584 exists_source(library(epilog)), 585 !, 586 use_module(library(epilog)), 587 call(epilog([ init(user_thread_init), 588 main(true) 589 ])). 590main_thread_init :- 591 user_thread_init.
597user_thread_init :- 598 opt_attach_packs, 599 argv_prolog_files(Files, ScriptMode), 600 load_init_file(ScriptMode), % -f file 601 catch(setup_colors, E, print_message(warning, E)), 602 win_associated_files(Files), % swipl-win: cd and update title 603 '$load_script_file', % -s file (may be repeated) 604 load_associated_files(Files), 605 '$cmd_option_val'(goals, Goals), % -g goal (may be repeated) 606 ( ScriptMode == app 607 -> run_program_init, % initialization(Goal, program) 608 run_main_init(true) 609 ; Goals == [], 610 \+ '$init_goal'(when(_), _, _) % no -g or -t or initialization(program) 611 -> version % default interactive run 612 ; run_init_goals(Goals), % run -g goals 613 ( load_only % used -l to load 614 -> version 615 ; run_program_init, % initialization(Goal, program) 616 run_main_init(false) % initialization(Goal, main) 617 ) 618 ). 619 620apply_defines :- 621 '$cmd_option_val'(defines, Defs), 622 apply_defines(Defs). 623 624apply_defines([]). 625apply_defines([H|T]) :- 626 apply_define(H), 627 apply_defines(T). 628 629apply_define(Def) :- 630 sub_atom(Def, B, _, A, '='), 631 !, 632 sub_atom(Def, 0, B, _, Flag), 633 sub_atom(Def, _, A, 0, Value0), 634 ( '$current_prolog_flag'(Flag, Value0, _Scope, Access, Type) 635 -> ( Access \== write 636 -> '$permission_error'(set, prolog_flag, Flag) 637 ; text_flag_value(Type, Value0, Value) 638 ), 639 set_prolog_flag(Flag, Value) 640 ; ( atom_number(Value0, Value) 641 -> true 642 ; Value = Value0 643 ), 644 create_prolog_flag(Flag, Value, [warn_not_accessed(true)]) 645 ). 646apply_define(Def) :- 647 atom_concat('no-', Flag, Def), 648 !, 649 set_user_boolean_flag(Flag, false). 650apply_define(Def) :- 651 set_user_boolean_flag(Def, true). 652 653set_user_boolean_flag(Flag, Value) :- 654 current_prolog_flag(Flag, Old), 655 !, 656 ( Old == Value 657 -> true 658 ; set_prolog_flag(Flag, Value) 659 ). 660set_user_boolean_flag(Flag, Value) :- 661 create_prolog_flag(Flag, Value, [warn_not_accessed(true)]). 662 663text_flag_value(integer, Text, Int) :- 664 atom_number(Text, Int), 665 !. 666text_flag_value(float, Text, Float) :- 667 atom_number(Text, Float), 668 !. 669text_flag_value(term, Text, Term) :- 670 term_string(Term, Text, []), 671 !. 672text_flag_value(_, Value, Value). 673 674:- if(current_prolog_flag(apple,true)). 675apple_set_working_directory :- 676 ( expand_file_name('~', [Dir]), 677 exists_directory(Dir) 678 -> working_directory(_, Dir) 679 ; true 680 ). 681 682apple_set_locale :- 683 ( getenv('LC_CTYPE', 'UTF-8'), 684 apple_current_locale_identifier(LocaleID), 685 atom_concat(LocaleID, '.UTF-8', Locale), 686 catch(setlocale(ctype, _Old, Locale), _, fail) 687 -> setenv('LANG', Locale), 688 unsetenv('LC_CTYPE') 689 ; true 690 ). 691 692apple_setup_app :- 693 current_prolog_flag(apple, true), 694 current_prolog_flag(console_menu, true), % SWI-Prolog.app on MacOS 695 apple_set_working_directory, 696 apple_set_locale. 697:- endif. 698apple_setup_app. 699 700init_optimise :- 701 current_prolog_flag(optimise, true), 702 !, 703 use_module(user:library(apply_macros)). 704init_optimise. 705 706opt_attach_packs :- 707 current_prolog_flag(packs, true), 708 !, 709 attach_packs. 710opt_attach_packs. 711 712set_toplevel :- 713 '$cmd_option_val'(toplevel, TopLevelAtom), 714 catch(term_to_atom(TopLevel, TopLevelAtom), E, 715 (print_message(error, E), 716 halt(1))), 717 create_prolog_flag(toplevel_goal, TopLevel, [type(term)]). 718 719load_only :- 720 current_prolog_flag(os_argv, OSArgv), 721 memberchk('-l', OSArgv), 722 current_prolog_flag(argv, Argv), 723 \+ memberchk('-l', Argv).
730run_init_goals([]). 731run_init_goals([H|T]) :- 732 run_init_goal(H), 733 run_init_goals(T). 734 735run_init_goal(Text) :- 736 catch(term_to_atom(Goal, Text), E, 737 ( print_message(error, init_goal_syntax(E, Text)), 738 halt(2) 739 )), 740 run_init_goal(Goal, Text).
746run_program_init :- 747 forall('$init_goal'(when(program), Goal, Ctx), 748 run_init_goal(Goal, @(Goal,Ctx))). 749 750run_main_init(_) :- 751 findall(Goal-Ctx, '$init_goal'(when(main), Goal, Ctx), Pairs), 752 '$last'(Pairs, Goal-Ctx), 753 !, 754 ( current_prolog_flag(toplevel_goal, default) 755 -> set_prolog_flag(toplevel_goal, halt) 756 ; true 757 ), 758 run_init_goal(Goal, @(Goal,Ctx)). 759run_main_init(true) :- 760 '$existence_error'(initialization, main). 761run_main_init(_). 762 763run_init_goal(Goal, Ctx) :- 764 ( catch_with_backtrace(user:Goal, E, true) 765 -> ( var(E) 766 -> true 767 ; print_message(error, init_goal_failed(E, Ctx)), 768 halt(2) 769 ) 770 ; ( current_prolog_flag(verbose, silent) 771 -> Level = silent 772 ; Level = error 773 ), 774 print_message(Level, init_goal_failed(failed, Ctx)), 775 halt(1) 776 ).
783init_debug_flags :-
784 Keep = [keep(true)],
785 create_prolog_flag(answer_write_options,
786 [ quoted(true), portray(true), max_depth(10),
787 spacing(next_argument)], Keep),
788 create_prolog_flag(prompt_alternatives_on, determinism, Keep),
789 create_prolog_flag(toplevel_extra_white_line, true, Keep),
790 create_prolog_flag(toplevel_print_factorized, false, Keep),
791 create_prolog_flag(print_write_options,
792 [ portray(true), quoted(true), numbervars(true) ],
793 Keep),
794 create_prolog_flag(toplevel_residue_vars, false, Keep),
795 create_prolog_flag(toplevel_list_wfs_residual_program, true, Keep),
796 '$set_debugger_write_options'(print).
802setup_backtrace :-
803 ( \+ current_prolog_flag(backtrace, false),
804 load_setup_file(library(prolog_stack))
805 -> true
806 ; true
807 ).
813setup_colors :-
814 ( \+ current_prolog_flag(color_term, false),
815 stream_property(user_input, tty(true)),
816 stream_property(user_error, tty(true)),
817 stream_property(user_output, tty(true)),
818 \+ getenv('TERM', dumb),
819 load_setup_file(user:library(ansi_term))
820 -> true
821 ; true
822 ).
828setup_history :-
829 ( \+ current_prolog_flag(save_history, false),
830 stream_property(user_input, tty(true)),
831 \+ current_prolog_flag(readline, false),
832 load_setup_file(library(prolog_history))
833 -> prolog_history(enable)
834 ; true
835 ),
836 set_default_history,
837 '$load_history'.
843setup_readline :- 844 ( current_prolog_flag(readline, swipl_win) 845 -> true 846 ; stream_property(user_input, tty(true)), 847 current_prolog_flag(tty_control, true), 848 \+ getenv('TERM', dumb), 849 ( current_prolog_flag(readline, ReadLine) 850 -> true 851 ; ReadLine = true 852 ), 853 readline_library(ReadLine, Library), 854 load_setup_file(library(Library)) 855 -> set_prolog_flag(readline, Library) 856 ; set_prolog_flag(readline, false) 857 ). 858 859readline_library(true, Library) :- 860 !, 861 preferred_readline(Library). 862readline_library(false, _) :- 863 !, 864 fail. 865readline_library(Library, Library). 866 867preferred_readline(editline). 868preferred_readline(readline).
874load_setup_file(File) :- 875 catch(load_files(File, 876 [ silent(true), 877 if(not_loaded) 878 ]), _, fail). 879 880 881:- '$hide'('$toplevel'/0). % avoid in the GUI stacktrace
887'$toplevel' :-
888 '$runtoplevel',
889 print_message(informational, halt).
default
and prolog
both
start the interactive toplevel, where prolog
implies the user gave
-t prolog
.
899'$runtoplevel' :- 900 current_prolog_flag(toplevel_goal, TopLevel0), 901 toplevel_goal(TopLevel0, TopLevel), 902 user:TopLevel. 903 904:- dynamic setup_done/0. 905:- volatile setup_done/0. 906 907toplevel_goal(default, '$query_loop') :- 908 !, 909 setup_interactive. 910toplevel_goal(prolog, '$query_loop') :- 911 !, 912 setup_interactive. 913toplevel_goal(Goal, Goal). 914 915setup_interactive :- 916 setup_done, 917 !. 918setup_interactive :- 919 asserta(setup_done), 920 catch(setup_backtrace, E, print_message(warning, E)), 921 catch(setup_readline, E, print_message(warning, E)), 922 catch(setup_history, E, print_message(warning, E)).
928'$compile' :- 929 ( catch('$compile_', E, (print_message(error, E), halt(1))) 930 -> true 931 ; print_message(error, error(goal_failed('$compile'), _)), 932 halt(1) 933 ), 934 halt. % set exit code 935 936'$compile_' :- 937 '$load_system_init_file', 938 catch(setup_colors, _, true), 939 '$set_file_search_paths', 940 init_debug_flags, 941 '$run_initialization', 942 opt_attach_packs, 943 use_module(library(qsave)), 944 qsave:qsave_toplevel.
950'$config' :- 951 '$load_system_init_file', 952 '$set_file_search_paths', 953 init_debug_flags, 954 '$run_initialization', 955 load_files(library(prolog_config)), 956 ( catch(prolog_dump_runtime_variables, E, 957 (print_message(error, E), halt(1))) 958 -> true 959 ; print_message(error, error(goal_failed(prolog_dump_runtime_variables),_)) 960 ). 961 962 963 /******************************** 964 * USER INTERACTIVE LOOP * 965 *********************************/
forall(prolog:repl_loop_hook(BeginEnd, BreakLevel), true)
978:- multifile
979 prolog:repl_loop_hook/2.
987prolog :- 988 break. 989 990:- create_prolog_flag(toplevel_mode, backtracking, []).
query_loop()
. This ensures that unhandled
exceptions are really unhandled (in Prolog).999'$query_loop' :- 1000 break_level(BreakLev), 1001 setup_call_cleanup( 1002 notrace(call_repl_loop_hook(begin, BreakLev)), 1003 '$query_loop'(BreakLev), 1004 notrace(call_repl_loop_hook(end, BreakLev))). 1005 1006call_repl_loop_hook(BeginEnd, BreakLev) :- 1007 forall(prolog:repl_loop_hook(BeginEnd, BreakLev), true). 1008 1009 1010'$query_loop'(BreakLev) :- 1011 current_prolog_flag(toplevel_mode, recursive), 1012 !, 1013 read_expanded_query(BreakLev, Query, Bindings), 1014 ( Query == end_of_file 1015 -> print_message(query, query(eof)) 1016 ; '$call_no_catch'('$execute_query'(Query, Bindings, _)), 1017 ( current_prolog_flag(toplevel_mode, recursive) 1018 -> '$query_loop'(BreakLev) 1019 ; '$switch_toplevel_mode'(backtracking), 1020 '$query_loop'(BreakLev) % Maybe throw('$switch_toplevel_mode')? 1021 ) 1022 ). 1023'$query_loop'(BreakLev) :- 1024 repeat, 1025 read_expanded_query(BreakLev, Query, Bindings), 1026 ( Query == end_of_file 1027 -> !, print_message(query, query(eof)) 1028 ; '$execute_query'(Query, Bindings, _), 1029 ( current_prolog_flag(toplevel_mode, recursive) 1030 -> !, 1031 '$switch_toplevel_mode'(recursive), 1032 '$query_loop'(BreakLev) 1033 ; fail 1034 ) 1035 ). 1036 1037break_level(BreakLev) :- 1038 ( current_prolog_flag(break_level, BreakLev) 1039 -> true 1040 ; BreakLev = -1 1041 ). 1042 1043read_expanded_query(BreakLev, ExpandedQuery, ExpandedBindings) :- 1044 '$current_typein_module'(TypeIn), 1045 ( stream_property(user_input, tty(true)) 1046 -> '$system_prompt'(TypeIn, BreakLev, Prompt), 1047 prompt(Old, '| ') 1048 ; Prompt = '', 1049 prompt(Old, '') 1050 ), 1051 trim_stacks, 1052 trim_heap, 1053 repeat, 1054 ( catch(read_query(Prompt, Query, Bindings), 1055 error(io_error(_,_),_), fail) 1056 -> prompt(_, Old), 1057 catch(call_expand_query(Query, ExpandedQuery, 1058 Bindings, ExpandedBindings), 1059 Error, 1060 (print_message(error, Error), fail)) 1061 ; set_prolog_flag(debug_on_error, false), 1062 thread_exit(io_error) 1063 ), 1064 !.
1073:- if(current_prolog_flag(emscripten, true)). 1074read_query(_Prompt, Goal, Bindings) :- 1075 '$can_yield', 1076 !, 1077 await(query, GoalString), 1078 term_string(Goal, GoalString, [variable_names(Bindings)]). 1079:- endif. 1080read_query(Prompt, Goal, Bindings) :- 1081 current_prolog_flag(history, N), 1082 integer(N), N > 0, 1083 !, 1084 read_term_with_history( 1085 Goal, 1086 [ show(h), 1087 help('!h'), 1088 no_save([trace, end_of_file]), 1089 prompt(Prompt), 1090 variable_names(Bindings) 1091 ]). 1092read_query(Prompt, Goal, Bindings) :- 1093 remove_history_prompt(Prompt, Prompt1), 1094 repeat, % over syntax errors 1095 prompt1(Prompt1), 1096 read_query_line(user_input, Line), 1097 '$save_history_line'(Line), % save raw line (edit syntax errors) 1098 '$current_typein_module'(TypeIn), 1099 catch(read_term_from_atom(Line, Goal, 1100 [ variable_names(Bindings), 1101 module(TypeIn) 1102 ]), E, 1103 ( print_message(error, E), 1104 fail 1105 )), 1106 !, 1107 '$save_history_event'(Line). % save event (no syntax errors)
1111read_query_line(Input, Line) :- 1112 stream_property(Input, error(true)), 1113 !, 1114 Line = end_of_file. 1115read_query_line(Input, Line) :- 1116 catch(read_term_as_atom(Input, Line), Error, true), 1117 save_debug_after_read, 1118 ( var(Error) 1119 -> true 1120 ; catch(print_message(error, Error), _, true), 1121 ( Error = error(syntax_error(_),_) 1122 -> fail 1123 ; throw(Error) 1124 ) 1125 ).
1132read_term_as_atom(In, Line) :-
1133 '$raw_read'(In, Line),
1134 ( Line == end_of_file
1135 -> true
1136 ; skip_to_nl(In)
1137 ).
1144skip_to_nl(In) :- 1145 repeat, 1146 peek_char(In, C), 1147 ( C == '%' 1148 -> skip(In, '\n') 1149 ; char_type(C, space) 1150 -> get_char(In, _), 1151 C == '\n' 1152 ; true 1153 ), 1154 !. 1155 1156remove_history_prompt('', '') :- !. 1157remove_history_prompt(Prompt0, Prompt) :- 1158 atom_chars(Prompt0, Chars0), 1159 clean_history_prompt_chars(Chars0, Chars1), 1160 delete_leading_blanks(Chars1, Chars), 1161 atom_chars(Prompt, Chars). 1162 1163clean_history_prompt_chars([], []). 1164clean_history_prompt_chars(['~', !|T], T) :- !. 1165clean_history_prompt_chars([H|T0], [H|T]) :- 1166 clean_history_prompt_chars(T0, T). 1167 1168delete_leading_blanks([' '|T0], T) :- 1169 !, 1170 delete_leading_blanks(T0, T). 1171delete_leading_blanks(L, L).
1180set_default_history :- 1181 current_prolog_flag(history, _), 1182 !. 1183set_default_history :- 1184 ( ( \+ current_prolog_flag(readline, false) 1185 ; current_prolog_flag(emacs_inferior_process, true) 1186 ) 1187 -> create_prolog_flag(history, 0, []) 1188 ; create_prolog_flag(history, 25, []) 1189 ). 1190 1191 1192 /******************************* 1193 * TOPLEVEL DEBUG * 1194 *******************************/
thread_signal(main, gdebug)
1209save_debug_after_read :- 1210 current_prolog_flag(debug, true), 1211 !, 1212 save_debug. 1213save_debug_after_read. 1214 1215save_debug :- 1216 ( tracing, 1217 notrace 1218 -> Tracing = true 1219 ; Tracing = false 1220 ), 1221 current_prolog_flag(debug, Debugging), 1222 set_prolog_flag(debug, false), 1223 create_prolog_flag(query_debug_settings, 1224 debug(Debugging, Tracing), []). 1225 1226restore_debug :- 1227 current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)), 1228 set_prolog_flag(debug, Debugging), 1229 ( Tracing == true 1230 -> trace 1231 ; true 1232 ). 1233 1234:- initialization 1235 create_prolog_flag(query_debug_settings, debug(false, false), []). 1236 1237 1238 /******************************** 1239 * PROMPTING * 1240 ********************************/ 1241 1242'$system_prompt'(Module, BrekLev, Prompt) :- 1243 current_prolog_flag(toplevel_prompt, PAtom), 1244 atom_codes(PAtom, P0), 1245 ( Module \== user 1246 -> '$substitute'('~m', [Module, ': '], P0, P1) 1247 ; '$substitute'('~m', [], P0, P1) 1248 ), 1249 ( BrekLev > 0 1250 -> '$substitute'('~l', ['[', BrekLev, '] '], P1, P2) 1251 ; '$substitute'('~l', [], P1, P2) 1252 ), 1253 current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)), 1254 ( Tracing == true 1255 -> '$substitute'('~d', ['[trace] '], P2, P3) 1256 ; Debugging == true 1257 -> '$substitute'('~d', ['[debug] '], P2, P3) 1258 ; '$substitute'('~d', [], P2, P3) 1259 ), 1260 atom_chars(Prompt, P3). 1261 1262'$substitute'(From, T, Old, New) :- 1263 atom_codes(From, FromCodes), 1264 phrase(subst_chars(T), T0), 1265 '$append'(Pre, S0, Old), 1266 '$append'(FromCodes, Post, S0) -> 1267 '$append'(Pre, T0, S1), 1268 '$append'(S1, Post, New), 1269 !. 1270'$substitute'(_, _, Old, Old). 1271 1272subst_chars([]) --> 1273 []. 1274subst_chars([H|T]) --> 1275 { atomic(H), 1276 !, 1277 atom_codes(H, Codes) 1278 }, 1279 , 1280 subst_chars(T). 1281subst_chars([H|T]) --> 1282 , 1283 subst_chars(T). 1284 1285 1286 /******************************** 1287 * EXECUTION * 1288 ********************************/
1294'$execute_query'(Var, _, true) :- 1295 var(Var), 1296 !, 1297 print_message(informational, var_query(Var)). 1298'$execute_query'(Goal, Bindings, Truth) :- 1299 '$current_typein_module'(TypeIn), 1300 '$dwim_correct_goal'(TypeIn:Goal, Bindings, Corrected), 1301 !, 1302 setup_call_cleanup( 1303 '$set_source_module'(M0, TypeIn), 1304 expand_goal(Corrected, Expanded), 1305 '$set_source_module'(M0)), 1306 print_message(silent, toplevel_goal(Expanded, Bindings)), 1307 '$execute_goal2'(Expanded, Bindings, Truth). 1308'$execute_query'(_, _, false) :- 1309 notrace, 1310 print_message(query, query(no)). 1311 1312'$execute_goal2'(Goal, Bindings, true) :- 1313 restore_debug, 1314 '$current_typein_module'(TypeIn), 1315 residue_vars(TypeIn:Goal, Vars, TypeIn:Delays, Chp), 1316 deterministic(Det), 1317 ( save_debug 1318 ; restore_debug, fail 1319 ), 1320 flush_output(user_output), 1321 ( Det == true 1322 -> DetOrChp = true 1323 ; DetOrChp = Chp 1324 ), 1325 call_expand_answer(Goal, Bindings, NewBindings), 1326 ( \+ \+ write_bindings(NewBindings, Vars, Delays, DetOrChp) 1327 -> ! 1328 ). 1329'$execute_goal2'(_, _, false) :- 1330 save_debug, 1331 print_message(query, query(no)). 1332 1333residue_vars(Goal, Vars, Delays, Chp) :- 1334 current_prolog_flag(toplevel_residue_vars, true), 1335 !, 1336 '$wfs_call'(call_residue_vars(stop_backtrace(Goal, Chp), Vars), Delays). 1337residue_vars(Goal, [], Delays, Chp) :- 1338 '$wfs_call'(stop_backtrace(Goal, Chp), Delays). 1339 1340stop_backtrace(Goal, Chp) :- 1341 toplevel_call(Goal), 1342 prolog_current_choice(Chp). 1343 1344toplevel_call(Goal) :- 1345 call(Goal), 1346 no_lco. 1347 1348no_lco.
groundness
gives the classical behaviour,
determinism
is considered more adequate and informative.
Succeeds if the user accepts the answer and fails otherwise.
1364write_bindings(Bindings, ResidueVars, Delays, DetOrChp) :- 1365 '$current_typein_module'(TypeIn), 1366 translate_bindings(Bindings, Bindings1, ResidueVars, TypeIn:Residuals), 1367 omit_qualifier(Delays, TypeIn, Delays1), 1368 write_bindings2(Bindings, Bindings1, Residuals, Delays1, DetOrChp). 1369 1370write_bindings2(OrgBindings, [], Residuals, Delays, _) :- 1371 current_prolog_flag(prompt_alternatives_on, groundness), 1372 !, 1373 name_vars(OrgBindings, [], t(Residuals, Delays)), 1374 print_message(query, query(yes(Delays, Residuals))). 1375write_bindings2(OrgBindings, Bindings, Residuals, Delays, true) :- 1376 current_prolog_flag(prompt_alternatives_on, determinism), 1377 !, 1378 name_vars(OrgBindings, Bindings, t(Residuals, Delays)), 1379 print_message(query, query(yes(Bindings, Delays, Residuals))). 1380write_bindings2(OrgBindings, Bindings, Residuals, Delays, Chp) :- 1381 repeat, 1382 name_vars(OrgBindings, Bindings, t(Residuals, Delays)), 1383 print_message(query, query(more(Bindings, Delays, Residuals))), 1384 get_respons(Action, Chp), 1385 ( Action == redo 1386 -> !, fail 1387 ; Action == show_again 1388 -> fail 1389 ; !, 1390 print_message(query, query(done)) 1391 ).
_[A-Z][0-9]*
to all variables in Term, that do not
have a name due to Bindings. Singleton variables in Term are named
_. The behavior depends on these Prolog flags:
true
, else name_vars/3 is a no-op.
Variables are named by unifying them to '$VAR'(Name)
1407name_vars(OrgBindings, Bindings, Term) :- 1408 current_prolog_flag(toplevel_name_variables, true), 1409 answer_flags_imply_numbervars, 1410 !, 1411 '$term_multitons'(t(Bindings,Term), Vars), 1412 bindings_var_names(OrgBindings, Bindings, VarNames), 1413 name_vars_(Vars, VarNames, 0), 1414 term_variables(t(Bindings,Term), SVars), 1415 anon_vars(SVars). 1416name_vars(_OrgBindings, _Bindings, _Term). 1417 1418name_vars_([], _, _). 1419name_vars_([H|T], Bindings, N) :- 1420 name_var(Bindings, Name, N, N1), 1421 H = '$VAR'(Name), 1422 name_vars_(T, Bindings, N1). 1423 1424anon_vars([]). 1425anon_vars(['$VAR'('_')|T]) :- 1426 anon_vars(T).
1433name_var(Reserved, Name, N0, N) :-
1434 between(N0, infinite, N1),
1435 I is N1//26,
1436 J is 0'A + N1 mod 26,
1437 ( I == 0
1438 -> format(atom(Name), '_~c', [J])
1439 ; format(atom(Name), '_~c~d', [J, I])
1440 ),
1441 \+ memberchk(Name, Reserved),
1442 !,
1443 N is N1+1.
1452bindings_var_names(OrgBindings, TransBindings, VarNames) :-
1453 phrase(bindings_var_names_(OrgBindings), VarNames0, Tail),
1454 phrase(bindings_var_names_(TransBindings), Tail, []),
1455 sort(VarNames0, VarNames).
1462bindings_var_names_([]) --> []. 1463bindings_var_names_([H|T]) --> 1464 binding_var_names(H), 1465 bindings_var_names_(T). 1466 1467binding_var_names(binding(Vars,_Value,_Subst)) ==> 1468 var_names(Vars). 1469binding_var_names(Name=_Value) ==> 1470 [Name]. 1471 1472var_names([]) --> []. 1473var_names([H|T]) --> [H], var_names(T).
1481answer_flags_imply_numbervars :- 1482 current_prolog_flag(answer_write_options, Options), 1483 numbervars_option(Opt), 1484 memberchk(Opt, Options), 1485 !. 1486 1487numbervars_option(portray(true)). 1488numbervars_option(portrayed(true)). 1489numbervars_option(numbervars(true)).
1496:- multifile 1497 residual_goal_collector/1. 1498 1499:- meta_predicate 1500 residual_goals( ). 1501 1502residual_goals(NonTerminal) :- 1503 throw(error(context_error(nodirective, residual_goals(NonTerminal)), _)). 1504 1505systemterm_expansion((:- residual_goals(NonTerminal)), 1506 '$toplevel':residual_goal_collector(M2:Head)) :- 1507 \+ current_prolog_flag(xref, true), 1508 prolog_load_context(module, M), 1509 strip_module(M:NonTerminal, M2, Head), 1510 '$must_be'(callable, Head).
1517:- public prolog:residual_goals//0. 1518 1519prolog:residual_goals --> 1520 { findall(NT, residual_goal_collector(NT), NTL) }, 1521 collect_residual_goals(NTL). 1522 1523collect_residual_goals([]) --> []. 1524collect_residual_goals([H|T]) --> 1525 ( call(H) -> [] ; [] ), 1526 collect_residual_goals(T).
1551:- public 1552 prolog:translate_bindings/5. 1553:- meta_predicate 1554 prolog:translate_bindings( , , , , ). 1555 1556prologtranslate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals) :- 1557 translate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals), 1558 name_vars(Bindings0, Bindings, t(ResVars, ResGoals, Residuals)). 1559 1560% should not be required. 1561prologname_vars(Bindings, Term) :- name_vars([], Bindings, Term). 1562prologname_vars(Bindings0, Bindings, Term) :- name_vars(Bindings0, Bindings, Term). 1563 1564translate_bindings(Bindings0, Bindings, ResidueVars, Residuals) :- 1565 prolog:residual_goals(ResidueGoals, []), 1566 translate_bindings(Bindings0, Bindings, ResidueVars, ResidueGoals, 1567 Residuals). 1568 1569translate_bindings(Bindings0, Bindings, [], [], _:[]-[]) :- 1570 term_attvars(Bindings0, []), 1571 !, 1572 join_same_bindings(Bindings0, Bindings1), 1573 factorize_bindings(Bindings1, Bindings2), 1574 bind_vars(Bindings2, Bindings3), 1575 filter_bindings(Bindings3, Bindings). 1576translate_bindings(Bindings0, Bindings, ResidueVars, ResGoals0, 1577 TypeIn:Residuals-HiddenResiduals) :- 1578 project_constraints(Bindings0, ResidueVars), 1579 hidden_residuals(ResidueVars, Bindings0, HiddenResiduals0), 1580 omit_qualifiers(HiddenResiduals0, TypeIn, HiddenResiduals), 1581 copy_term(Bindings0+ResGoals0, Bindings1+ResGoals1, Residuals0), 1582 '$append'(ResGoals1, Residuals0, Residuals1), 1583 omit_qualifiers(Residuals1, TypeIn, Residuals), 1584 join_same_bindings(Bindings1, Bindings2), 1585 factorize_bindings(Bindings2, Bindings3), 1586 bind_vars(Bindings3, Bindings4), 1587 filter_bindings(Bindings4, Bindings). 1588 ResidueVars, Bindings, Goal) (:- 1590 term_attvars(ResidueVars, Remaining), 1591 term_attvars(Bindings, QueryVars), 1592 subtract_vars(Remaining, QueryVars, HiddenVars), 1593 copy_term(HiddenVars, _, Goal). 1594 1595subtract_vars(All, Subtract, Remaining) :- 1596 sort(All, AllSorted), 1597 sort(Subtract, SubtractSorted), 1598 ord_subtract(AllSorted, SubtractSorted, Remaining). 1599 1600ord_subtract([], _Not, []). 1601ord_subtract([H1|T1], L2, Diff) :- 1602 diff21(L2, H1, T1, Diff). 1603 1604diff21([], H1, T1, [H1|T1]). 1605diff21([H2|T2], H1, T1, Diff) :- 1606 compare(Order, H1, H2), 1607 diff3(Order, H1, T1, H2, T2, Diff). 1608 1609diff12([], _H2, _T2, []). 1610diff12([H1|T1], H2, T2, Diff) :- 1611 compare(Order, H1, H2), 1612 diff3(Order, H1, T1, H2, T2, Diff). 1613 1614diff3(<, H1, T1, H2, T2, [H1|Diff]) :- 1615 diff12(T1, H2, T2, Diff). 1616diff3(=, _H1, T1, _H2, T2, Diff) :- 1617 ord_subtract(T1, T2, Diff). 1618diff3(>, H1, T1, _H2, T2, Diff) :- 1619 diff21(T2, H1, T1, Diff).
toplevel_residue_vars
is set to project
.1627project_constraints(Bindings, ResidueVars) :- 1628 !, 1629 term_attvars(Bindings, AttVars), 1630 phrase(attribute_modules(AttVars), Modules0), 1631 sort(Modules0, Modules), 1632 term_variables(Bindings, QueryVars), 1633 project_attributes(Modules, QueryVars, ResidueVars). 1634project_constraints(_, _). 1635 1636project_attributes([], _, _). 1637project_attributes([M|T], QueryVars, ResidueVars) :- 1638 ( current_predicate(M:project_attributes/2), 1639 catch(M:project_attributes(QueryVars, ResidueVars), E, 1640 print_message(error, E)) 1641 -> true 1642 ; true 1643 ), 1644 project_attributes(T, QueryVars, ResidueVars). 1645 1646attribute_modules([]) --> []. 1647attribute_modules([H|T]) --> 1648 { get_attrs(H, Attrs) }, 1649 attrs_modules(Attrs), 1650 attribute_modules(T). 1651 1652attrs_modules([]) --> []. 1653attrs_modules(att(Module, _, More)) --> 1654 [Module], 1655 attrs_modules(More).
1666join_same_bindings([], []). 1667join_same_bindings([Name=V0|T0], [[Name|Names]=V|T]) :- 1668 take_same_bindings(T0, V0, V, Names, T1), 1669 join_same_bindings(T1, T). 1670 1671take_same_bindings([], Val, Val, [], []). 1672take_same_bindings([Name=V1|T0], V0, V, [Name|Names], T) :- 1673 V0 == V1, 1674 !, 1675 take_same_bindings(T0, V1, V, Names, T). 1676take_same_bindings([Pair|T0], V0, V, Names, [Pair|T]) :- 1677 take_same_bindings(T0, V0, V, Names, T).
1686omit_qualifiers([], _, []). 1687omit_qualifiers([Goal0|Goals0], TypeIn, [Goal|Goals]) :- 1688 omit_qualifier(Goal0, TypeIn, Goal), 1689 omit_qualifiers(Goals0, TypeIn, Goals). 1690 1691omit_qualifier(M:G0, TypeIn, G) :- 1692 M == TypeIn, 1693 !, 1694 omit_meta_qualifiers(G0, TypeIn, G). 1695omit_qualifier(M:G0, TypeIn, G) :- 1696 predicate_property(TypeIn:G0, imported_from(M)), 1697 \+ predicate_property(G0, transparent), 1698 !, 1699 G0 = G. 1700omit_qualifier(_:G0, _, G) :- 1701 predicate_property(G0, built_in), 1702 \+ predicate_property(G0, transparent), 1703 !, 1704 G0 = G. 1705omit_qualifier(M:G0, _, M:G) :- 1706 atom(M), 1707 !, 1708 omit_meta_qualifiers(G0, M, G). 1709omit_qualifier(G0, TypeIn, G) :- 1710 omit_meta_qualifiers(G0, TypeIn, G). 1711 1712omit_meta_qualifiers(V, _, V) :- 1713 var(V), 1714 !. 1715omit_meta_qualifiers((QA,QB), TypeIn, (A,B)) :- 1716 !, 1717 omit_qualifier(QA, TypeIn, A), 1718 omit_qualifier(QB, TypeIn, B). 1719omit_meta_qualifiers(tnot(QA), TypeIn, tnot(A)) :- 1720 !, 1721 omit_qualifier(QA, TypeIn, A). 1722omit_meta_qualifiers(freeze(V, QGoal), TypeIn, freeze(V, Goal)) :- 1723 callable(QGoal), 1724 !, 1725 omit_qualifier(QGoal, TypeIn, Goal). 1726omit_meta_qualifiers(when(Cond, QGoal), TypeIn, when(Cond, Goal)) :- 1727 callable(QGoal), 1728 !, 1729 omit_qualifier(QGoal, TypeIn, Goal). 1730omit_meta_qualifiers(G, _, G).
1739bind_vars(Bindings0, Bindings) :- 1740 bind_query_vars(Bindings0, Bindings, SNames), 1741 bind_skel_vars(Bindings, Bindings, SNames, 1, _). 1742 1743bind_query_vars([], [], []). 1744bind_query_vars([binding(Names,Var,[Var2=Cycle])|T0], 1745 [binding(Names,Cycle,[])|T], [Name|SNames]) :- 1746 Var == Var2, % also implies var(Var) 1747 !, 1748 '$last'(Names, Name), 1749 Var = '$VAR'(Name), 1750 bind_query_vars(T0, T, SNames). 1751bind_query_vars([B|T0], [B|T], AllNames) :- 1752 B = binding(Names,Var,Skel), 1753 bind_query_vars(T0, T, SNames), 1754 ( var(Var), \+ attvar(Var), Skel == [] 1755 -> AllNames = [Name|SNames], 1756 '$last'(Names, Name), 1757 Var = '$VAR'(Name) 1758 ; AllNames = SNames 1759 ). 1760 1761 1762 1763bind_skel_vars([], _, _, N, N). 1764bind_skel_vars([binding(_,_,Skel)|T], Bindings, SNames, N0, N) :- 1765 bind_one_skel_vars(Skel, Bindings, SNames, N0, N1), 1766 bind_skel_vars(T, Bindings, SNames, N1, N).
1785bind_one_skel_vars([], _, _, N, N). 1786bind_one_skel_vars([Var=Value|T], Bindings, Names, N0, N) :- 1787 ( var(Var) 1788 -> ( '$member'(binding(Names, VVal, []), Bindings), 1789 same_term(Value, VVal) 1790 -> '$last'(Names, VName), 1791 Var = '$VAR'(VName), 1792 N2 = N0 1793 ; between(N0, infinite, N1), 1794 atom_concat('_S', N1, Name), 1795 \+ memberchk(Name, Names), 1796 !, 1797 Var = '$VAR'(Name), 1798 N2 is N1 + 1 1799 ) 1800 ; N2 = N0 1801 ), 1802 bind_one_skel_vars(T, Bindings, Names, N2, N).
1809factorize_bindings([], []). 1810factorize_bindings([Name=Value|T0], [binding(Name, Skel, Subst)|T]) :- 1811 '$factorize_term'(Value, Skel, Subst0), 1812 ( current_prolog_flag(toplevel_print_factorized, true) 1813 -> Subst = Subst0 1814 ; only_cycles(Subst0, Subst) 1815 ), 1816 factorize_bindings(T0, T). 1817 1818 1819only_cycles([], []). 1820only_cycles([B|T0], List) :- 1821 ( B = (Var=Value), 1822 Var = Value, 1823 acyclic_term(Var) 1824 -> only_cycles(T0, List) 1825 ; List = [B|T], 1826 only_cycles(T0, T) 1827 ).
1836filter_bindings([], []). 1837filter_bindings([H0|T0], T) :- 1838 hide_vars(H0, H), 1839 ( ( arg(1, H, []) 1840 ; self_bounded(H) 1841 ) 1842 -> filter_bindings(T0, T) 1843 ; T = [H|T1], 1844 filter_bindings(T0, T1) 1845 ). 1846 1847hide_vars(binding(Names0, Skel, Subst), binding(Names, Skel, Subst)) :- 1848 hide_names(Names0, Skel, Subst, Names). 1849 1850hide_names([], _, _, []). 1851hide_names([Name|T0], Skel, Subst, T) :- 1852 ( sub_atom(Name, 0, _, _, '_'), 1853 current_prolog_flag(toplevel_print_anon, false), 1854 sub_atom(Name, 1, 1, _, Next), 1855 char_type(Next, prolog_var_start) 1856 -> true 1857 ; Subst == [], 1858 Skel == '$VAR'(Name) 1859 ), 1860 !, 1861 hide_names(T0, Skel, Subst, T). 1862hide_names([Name|T0], Skel, Subst, [Name|T]) :- 1863 hide_names(T0, Skel, Subst, T). 1864 1865self_bounded(binding([Name], Value, [])) :- 1866 Value == '$VAR'(Name).
1872:- if(current_prolog_flag(emscripten, true)). 1873get_respons(Action, Chp) :- 1874 '$can_yield', 1875 !, 1876 repeat, 1877 await(more, CommandS), 1878 atom_string(Command, CommandS), 1879 more_action(Command, Chp, Action), 1880 ( Action == again 1881 -> print_message(query, query(action)), 1882 fail 1883 ; ! 1884 ). 1885:- endif. 1886get_respons(Action, Chp) :- 1887 repeat, 1888 flush_output(user_output), 1889 get_single_char(Code), 1890 find_more_command(Code, Command, Feedback, Style), 1891 ( Style \== '-' 1892 -> print_message(query, if_tty([ansi(Style, '~w', [Feedback])])) 1893 ; true 1894 ), 1895 more_action(Command, Chp, Action), 1896 ( Action == again 1897 -> print_message(query, query(action)), 1898 fail 1899 ; ! 1900 ). 1901 1902find_more_command(-1, end_of_file, 'EOF', warning) :- 1903 !. 1904find_more_command(Code, Command, Feedback, Style) :- 1905 more_command(Command, Atom, Feedback, Style), 1906 '$in_reply'(Code, Atom), 1907 !. 1908find_more_command(Code, again, '', -) :- 1909 print_message(query, no_action(Code)). 1910 1911more_command(help, '?h', '', -). 1912more_command(redo, ';nrNR \t', ';', bold). 1913more_command(trace, 'tT', '; [trace]', comment). 1914more_command(continue, 'ca\n\ryY.', '.', bold). 1915more_command(break, 'b', '', -). 1916more_command(choicepoint, '*', '', -). 1917more_command(write, 'w', '[write]', comment). 1918more_command(print, 'p', '[print]', comment). 1919more_command(depth_inc, '+', Change, comment) :- 1920 ( print_depth(Depth0) 1921 -> depth_step(Step), 1922 NewDepth is Depth0*Step, 1923 format(atom(Change), '[max_depth(~D)]', [NewDepth]) 1924 ; Change = 'no max_depth' 1925 ). 1926more_command(depth_dec, '-', Change, comment) :- 1927 ( print_depth(Depth0) 1928 -> depth_step(Step), 1929 NewDepth is max(1, Depth0//Step), 1930 format(atom(Change), '[max_depth(~D)]', [NewDepth]) 1931 ; Change = '[max_depth(10)]' 1932 ). 1933 1934more_action(help, _, Action) => 1935 Action = again, 1936 print_message(help, query(help)). 1937more_action(redo, _, Action) => % Next 1938 Action = redo. 1939more_action(trace, _, Action) => 1940 Action = redo, 1941 trace, 1942 save_debug. 1943more_action(continue, _, Action) => % Stop 1944 Action = continue. 1945more_action(break, _, Action) => 1946 Action = show_again, 1947 break. 1948more_action(choicepoint, Chp, Action) => 1949 Action = show_again, 1950 print_last_chpoint(Chp). 1951more_action(end_of_file, _, Action) => 1952 Action = show_again, 1953 halt(0). 1954more_action(again, _, Action) => 1955 Action = again. 1956more_action(Command, _, Action), 1957 current_prolog_flag(answer_write_options, Options0), 1958 print_predicate(Command, Options0, Options) => 1959 Action = show_again, 1960 set_prolog_flag(answer_write_options, Options). 1961 1962print_depth(Depth) :- 1963 current_prolog_flag(answer_write_options, Options), 1964 memberchk(max_depth(Depth), Options), 1965 !.
answer_write_options
value according to the user
command.1972print_predicate(write, Options0, Options) :- 1973 edit_options([-portrayed(true),-portray(true)], 1974 Options0, Options). 1975print_predicate(print, Options0, Options) :- 1976 edit_options([+portrayed(true)], 1977 Options0, Options). 1978print_predicate(depth_inc, Options0, Options) :- 1979 ( '$select'(max_depth(D0), Options0, Options1) 1980 -> depth_step(Step), 1981 D is D0*Step, 1982 Options = [max_depth(D)|Options1] 1983 ; Options = Options0 1984 ). 1985print_predicate(depth_dec, Options0, Options) :- 1986 ( '$select'(max_depth(D0), Options0, Options1) 1987 -> depth_step(Step), 1988 D is max(1, D0//Step), 1989 Options = [max_depth(D)|Options1] 1990 ; D = 10, 1991 Options = [max_depth(D)|Options0] 1992 ). 1993 1994depth_step(5). 1995 1996edit_options([], Options, Options). 1997edit_options([H|T], Options0, Options) :- 1998 edit_option(H, Options0, Options1), 1999 edit_options(T, Options1, Options). 2000 2001edit_option(-Term, Options0, Options) => 2002 ( '$select'(Term, Options0, Options) 2003 -> true 2004 ; Options = Options0 2005 ). 2006edit_option(+Term, Options0, Options) => 2007 functor(Term, Name, 1), 2008 functor(Var, Name, 1), 2009 ( '$select'(Var, Options0, Options1) 2010 -> Options = [Term|Options1] 2011 ; Options = [Term|Options0] 2012 ).
2018print_last_chpoint(Chp) :- 2019 current_predicate(print_last_choice_point/0), 2020 !, 2021 print_last_chpoint_(Chp). 2022print_last_chpoint(Chp) :- 2023 use_module(library(prolog_stack), [print_last_choicepoint/2]), 2024 print_last_chpoint_(Chp). 2025 2026print_last_chpoint_(Chp) :- 2027 print_last_choicepoint(Chp, [message_level(information)]). 2028 2029 2030 /******************************* 2031 * EXPANSION * 2032 *******************************/ 2033 2034:- user:dynamic(expand_query/4). 2035:- user:multifile(expand_query/4). 2036 2037call_expand_query(Goal, Expanded, Bindings, ExpandedBindings) :- 2038 ( '$replace_toplevel_vars'(Goal, Expanded0, Bindings, ExpandedBindings0) 2039 -> true 2040 ; Expanded0 = Goal, ExpandedBindings0 = Bindings 2041 ), 2042 ( user:expand_query(Expanded0, Expanded, ExpandedBindings0, ExpandedBindings) 2043 -> true 2044 ; Expanded = Expanded0, ExpandedBindings = ExpandedBindings0 2045 ). 2046 2047 2048:- dynamic 2049 user:expand_answer/2, 2050 prolog:expand_answer/3. 2051:- multifile 2052 user:expand_answer/2, 2053 prolog:expand_answer/3. 2054 2055call_expand_answer(Goal, BindingsIn, BindingsOut) :- 2056 ( prolog:expand_answer(Goal, BindingsIn, BindingsOut) 2057 -> true 2058 ; user:expand_answer(BindingsIn, BindingsOut) 2059 -> true 2060 ; BindingsOut = BindingsIn 2061 ), 2062 '$save_toplevel_vars'(BindingsOut), 2063 !. 2064call_expand_answer(_, Bindings, Bindings)