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-2024, University of Amsterdam 7 VU University Amsterdam 8 SWI-Prolog Solutions b.v. 9 All rights reserved. 10 11 Redistribution and use in source and binary forms, with or without 12 modification, are permitted provided that the following conditions 13 are met: 14 15 1. Redistributions of source code must retain the above copyright 16 notice, this list of conditions and the following disclaimer. 17 18 2. Redistributions in binary form must reproduce the above copyright 19 notice, this list of conditions and the following disclaimer in 20 the documentation and/or other materials provided with the 21 distribution. 22 23 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 24 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 25 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 26 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 27 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 28 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 29 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 30 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 31 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 32 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 33 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 34 POSSIBILITY OF SUCH DAMAGE. 35*/ 36 37:- module('$toplevel', 38 [ '$initialise'/0, % start Prolog 39 '$toplevel'/0, % Prolog top-level (re-entrant) 40 '$compile'/0, % `-c' toplevel 41 '$config'/0, % --dump-runtime-variables toplevel 42 initialize/0, % Run program initialization 43 version/0, % Write initial banner 44 version/1, % Add message to the banner 45 prolog/0, % user toplevel predicate 46 '$query_loop'/0, % toplevel predicate 47 '$execute_query'/3, % +Query, +Bindings, -Truth 48 residual_goals/1, % +Callable 49 (initialization)/1, % initialization goal (directive) 50 '$thread_init'/0, % initialise thread 51 (thread_initialization)/1 % thread initialization goal 52 ]). 53 54 55 /******************************* 56 * VERSION BANNER * 57 *******************************/ 58 59:- dynamic 60 prolog:version_msg/1.
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 ( '$member'(File, Files), 521 load_files(user:File, [expand(false)]), 522 fail 523 ; true 524 ). 525 526hkey('HKEY_CURRENT_USER/Software/SWI/Prolog'). 527hkey('HKEY_LOCAL_MACHINE/Software/SWI/Prolog'). 528 529'$set_prolog_file_extension' :- 530 current_prolog_flag(windows, true), 531 hkey(Key), 532 catch(win_registry_get_value(Key, fileExtension, Ext0), 533 _, fail), 534 !, 535 ( atom_concat('.', Ext, Ext0) 536 -> true 537 ; Ext = Ext0 538 ), 539 ( user:prolog_file_type(Ext, prolog) 540 -> true 541 ; asserta(user:prolog_file_type(Ext, prolog)) 542 ). 543'$set_prolog_file_extension'. 544 545 546 /******************************** 547 * TOPLEVEL GOALS * 548 *********************************/
556'$initialise' :- 557 catch(initialise_prolog, E, initialise_error(E)). 558 559initialise_error(unwind(abort)) :- !. 560initialise_error(unwind(halt(_))) :- !. 561initialise_error(E) :- 562 print_message(error, initialization_exception(E)), 563 fail. 564 565initialise_prolog :- 566 '$clean_history', 567 apply_defines, 568 apple_setup_app, % MacOS cwd/locale setup for swipl-win 569 init_optimise, 570 '$run_initialization', 571 '$load_system_init_file', % -F file 572 set_toplevel, % set `toplevel_goal` flag from -t 573 '$set_file_search_paths', % handle -p alias=dir[:dir]* 574 init_debug_flags, 575 start_pldoc, % handle --pldoc[=port] 576 opt_attach_packs, 577 argv_prolog_files(Files, ScriptMode), 578 load_init_file(ScriptMode), % -f file 579 catch(setup_colors, E, print_message(warning, E)), 580 win_associated_files(Files), % swipl-win: cd and update title 581 '$load_script_file', % -s file (may be repeated) 582 load_associated_files(Files), 583 '$cmd_option_val'(goals, Goals), % -g goal (may be repeated) 584 ( ScriptMode == app 585 -> run_program_init, % initialization(Goal, program) 586 run_main_init(true) 587 ; Goals == [], 588 \+ '$init_goal'(when(_), _, _) % no -g or -t or initialization(program) 589 -> version % default interactive run 590 ; run_init_goals(Goals), % run -g goals 591 ( load_only % used -l to load 592 -> version 593 ; run_program_init, % initialization(Goal, program) 594 run_main_init(false) % initialization(Goal, main) 595 ) 596 ). 597 598apply_defines :- 599 '$cmd_option_val'(defines, Defs), 600 apply_defines(Defs). 601 602apply_defines([]). 603apply_defines([H|T]) :- 604 apply_define(H), 605 apply_defines(T). 606 607apply_define(Def) :- 608 sub_atom(Def, B, _, A, '='), 609 !, 610 sub_atom(Def, 0, B, _, Flag), 611 sub_atom(Def, _, A, 0, Value0), 612 ( '$current_prolog_flag'(Flag, Value0, _Scope, Access, Type) 613 -> ( Access \== write 614 -> '$permission_error'(set, prolog_flag, Flag) 615 ; text_flag_value(Type, Value0, Value) 616 ), 617 set_prolog_flag(Flag, Value) 618 ; ( atom_number(Value0, Value) 619 -> true 620 ; Value = Value0 621 ), 622 create_prolog_flag(Flag, Value, [warn_not_accessed]) 623 ). 624apply_define(Def) :- 625 atom_concat('no-', Flag, Def), 626 !, 627 set_user_boolean_flag(Flag, false). 628apply_define(Def) :- 629 set_user_boolean_flag(Def, true). 630 631set_user_boolean_flag(Flag, Value) :- 632 current_prolog_flag(Flag, Old), 633 !, 634 ( Old == Value 635 -> true 636 ; set_prolog_flag(Flag, Value) 637 ). 638set_user_boolean_flag(Flag, Value) :- 639 create_prolog_flag(Flag, Value, [warn_not_accessed]). 640 641text_flag_value(integer, Text, Int) :- 642 atom_number(Text, Int), 643 !. 644text_flag_value(float, Text, Float) :- 645 atom_number(Text, Float), 646 !. 647text_flag_value(term, Text, Term) :- 648 term_string(Term, Text, []), 649 !. 650text_flag_value(_, Value, Value). 651 652:- if(current_prolog_flag(apple,true)). 653apple_set_working_directory :- 654 ( expand_file_name('~', [Dir]), 655 exists_directory(Dir) 656 -> working_directory(_, Dir) 657 ; true 658 ). 659 660apple_set_locale :- 661 ( getenv('LC_CTYPE', 'UTF-8'), 662 apple_current_locale_identifier(LocaleID), 663 atom_concat(LocaleID, '.UTF-8', Locale), 664 catch(setlocale(ctype, _Old, Locale), _, fail) 665 -> setenv('LANG', Locale), 666 unsetenv('LC_CTYPE') 667 ; true 668 ). 669 670apple_setup_app :- 671 current_prolog_flag(apple, true), 672 current_prolog_flag(console_menu, true), % SWI-Prolog.app on MacOS 673 apple_set_working_directory, 674 apple_set_locale. 675:- endif. 676apple_setup_app. 677 678init_optimise :- 679 current_prolog_flag(optimise, true), 680 !, 681 use_module(user:library(apply_macros)). 682init_optimise. 683 684opt_attach_packs :- 685 current_prolog_flag(packs, true), 686 !, 687 attach_packs. 688opt_attach_packs. 689 690set_toplevel :- 691 '$cmd_option_val'(toplevel, TopLevelAtom), 692 catch(term_to_atom(TopLevel, TopLevelAtom), E, 693 (print_message(error, E), 694 halt(1))), 695 create_prolog_flag(toplevel_goal, TopLevel, [type(term)]). 696 697load_only :- 698 current_prolog_flag(os_argv, OSArgv), 699 memberchk('-l', OSArgv), 700 current_prolog_flag(argv, Argv), 701 \+ memberchk('-l', Argv).
708run_init_goals([]). 709run_init_goals([H|T]) :- 710 run_init_goal(H), 711 run_init_goals(T). 712 713run_init_goal(Text) :- 714 catch(term_to_atom(Goal, Text), E, 715 ( print_message(error, init_goal_syntax(E, Text)), 716 halt(2) 717 )), 718 run_init_goal(Goal, Text).
724run_program_init :- 725 forall('$init_goal'(when(program), Goal, Ctx), 726 run_init_goal(Goal, @(Goal,Ctx))). 727 728run_main_init(_) :- 729 findall(Goal-Ctx, '$init_goal'(when(main), Goal, Ctx), Pairs), 730 '$last'(Pairs, Goal-Ctx), 731 !, 732 ( current_prolog_flag(toplevel_goal, default) 733 -> set_prolog_flag(toplevel_goal, halt) 734 ; true 735 ), 736 run_init_goal(Goal, @(Goal,Ctx)). 737run_main_init(true) :- 738 '$existence_error'(initialization, main). 739run_main_init(_). 740 741run_init_goal(Goal, Ctx) :- 742 ( catch_with_backtrace(user:Goal, E, true) 743 -> ( var(E) 744 -> true 745 ; print_message(error, init_goal_failed(E, Ctx)), 746 halt(2) 747 ) 748 ; ( current_prolog_flag(verbose, silent) 749 -> Level = silent 750 ; Level = error 751 ), 752 print_message(Level, init_goal_failed(failed, Ctx)), 753 halt(1) 754 ).
761init_debug_flags :-
762 Keep = [keep(true)],
763 create_prolog_flag(answer_write_options,
764 [ quoted(true), portray(true), max_depth(10),
765 spacing(next_argument)], Keep),
766 create_prolog_flag(prompt_alternatives_on, determinism, Keep),
767 create_prolog_flag(toplevel_extra_white_line, true, Keep),
768 create_prolog_flag(toplevel_print_factorized, false, Keep),
769 create_prolog_flag(print_write_options,
770 [ portray(true), quoted(true), numbervars(true) ],
771 Keep),
772 create_prolog_flag(toplevel_residue_vars, false, Keep),
773 create_prolog_flag(toplevel_list_wfs_residual_program, true, Keep),
774 '$set_debugger_write_options'(print).
780setup_backtrace :-
781 ( \+ current_prolog_flag(backtrace, false),
782 load_setup_file(library(prolog_stack))
783 -> true
784 ; true
785 ).
791setup_colors :-
792 ( \+ current_prolog_flag(color_term, false),
793 stream_property(user_input, tty(true)),
794 stream_property(user_error, tty(true)),
795 stream_property(user_output, tty(true)),
796 \+ getenv('TERM', dumb),
797 load_setup_file(user:library(ansi_term))
798 -> true
799 ; true
800 ).
806setup_history :-
807 ( \+ current_prolog_flag(save_history, false),
808 stream_property(user_input, tty(true)),
809 \+ current_prolog_flag(readline, false),
810 load_setup_file(library(prolog_history))
811 -> prolog_history(enable)
812 ; true
813 ),
814 set_default_history,
815 '$load_history'.
821setup_readline :- 822 ( current_prolog_flag(readline, swipl_win) 823 -> true 824 ; stream_property(user_input, tty(true)), 825 current_prolog_flag(tty_control, true), 826 \+ getenv('TERM', dumb), 827 ( current_prolog_flag(readline, ReadLine) 828 -> true 829 ; ReadLine = true 830 ), 831 readline_library(ReadLine, Library), 832 load_setup_file(library(Library)) 833 -> set_prolog_flag(readline, Library) 834 ; set_prolog_flag(readline, false) 835 ). 836 837readline_library(true, Library) :- 838 !, 839 preferred_readline(Library). 840readline_library(false, _) :- 841 !, 842 fail. 843readline_library(Library, Library). 844 845preferred_readline(editline). 846preferred_readline(readline).
852load_setup_file(File) :- 853 catch(load_files(File, 854 [ silent(true), 855 if(not_loaded) 856 ]), _, fail). 857 858 859:- '$hide'('$toplevel'/0). % avoid in the GUI stacktrace
865'$toplevel' :-
866 '$runtoplevel',
867 print_message(informational, halt).
default
and prolog
both
start the interactive toplevel, where prolog
implies the user gave
-t prolog
.
877'$runtoplevel' :- 878 current_prolog_flag(toplevel_goal, TopLevel0), 879 toplevel_goal(TopLevel0, TopLevel), 880 user:TopLevel. 881 882:- dynamic setup_done/0. 883:- volatile setup_done/0. 884 885toplevel_goal(default, '$query_loop') :- 886 !, 887 setup_interactive. 888toplevel_goal(prolog, '$query_loop') :- 889 !, 890 setup_interactive. 891toplevel_goal(Goal, Goal). 892 893setup_interactive :- 894 setup_done, 895 !. 896setup_interactive :- 897 asserta(setup_done), 898 catch(setup_backtrace, E, print_message(warning, E)), 899 catch(setup_readline, E, print_message(warning, E)), 900 catch(setup_history, E, print_message(warning, E)).
906'$compile' :- 907 ( catch('$compile_', E, (print_message(error, E), halt(1))) 908 -> true 909 ; print_message(error, error(goal_failed('$compile'), _)), 910 halt(1) 911 ), 912 halt. % set exit code 913 914'$compile_' :- 915 '$load_system_init_file', 916 catch(setup_colors, _, true), 917 '$set_file_search_paths', 918 init_debug_flags, 919 '$run_initialization', 920 opt_attach_packs, 921 use_module(library(qsave)), 922 qsave:qsave_toplevel.
928'$config' :- 929 '$load_system_init_file', 930 '$set_file_search_paths', 931 init_debug_flags, 932 '$run_initialization', 933 load_files(library(prolog_config)), 934 ( catch(prolog_dump_runtime_variables, E, 935 (print_message(error, E), halt(1))) 936 -> true 937 ; print_message(error, error(goal_failed(prolog_dump_runtime_variables),_)) 938 ). 939 940 941 /******************************** 942 * USER INTERACTIVE LOOP * 943 *********************************/
forall(prolog:repl_loop_hook(BeginEnd, BreakLevel), true)
956:- multifile
957 prolog:repl_loop_hook/2.
965prolog :- 966 break. 967 968:- create_prolog_flag(toplevel_mode, backtracking, []).
query_loop()
. This ensures that unhandled
exceptions are really unhandled (in Prolog).977'$query_loop' :- 978 break_level(BreakLev), 979 setup_call_cleanup( 980 notrace(call_repl_loop_hook(begin, BreakLev)), 981 '$query_loop'(BreakLev), 982 notrace(call_repl_loop_hook(end, BreakLev))). 983 984call_repl_loop_hook(BeginEnd, BreakLev) :- 985 forall(prolog:repl_loop_hook(BeginEnd, BreakLev), true). 986 987 988'$query_loop'(BreakLev) :- 989 current_prolog_flag(toplevel_mode, recursive), 990 !, 991 read_expanded_query(BreakLev, Query, Bindings), 992 ( Query == end_of_file 993 -> print_message(query, query(eof)) 994 ; '$call_no_catch'('$execute_query'(Query, Bindings, _)), 995 ( current_prolog_flag(toplevel_mode, recursive) 996 -> '$query_loop'(BreakLev) 997 ; '$switch_toplevel_mode'(backtracking), 998 '$query_loop'(BreakLev) % Maybe throw('$switch_toplevel_mode')? 999 ) 1000 ). 1001'$query_loop'(BreakLev) :- 1002 repeat, 1003 read_expanded_query(BreakLev, Query, Bindings), 1004 ( Query == end_of_file 1005 -> !, print_message(query, query(eof)) 1006 ; '$execute_query'(Query, Bindings, _), 1007 ( current_prolog_flag(toplevel_mode, recursive) 1008 -> !, 1009 '$switch_toplevel_mode'(recursive), 1010 '$query_loop'(BreakLev) 1011 ; fail 1012 ) 1013 ). 1014 1015break_level(BreakLev) :- 1016 ( current_prolog_flag(break_level, BreakLev) 1017 -> true 1018 ; BreakLev = -1 1019 ). 1020 1021read_expanded_query(BreakLev, ExpandedQuery, ExpandedBindings) :- 1022 '$current_typein_module'(TypeIn), 1023 ( stream_property(user_input, tty(true)) 1024 -> '$system_prompt'(TypeIn, BreakLev, Prompt), 1025 prompt(Old, '| ') 1026 ; Prompt = '', 1027 prompt(Old, '') 1028 ), 1029 trim_stacks, 1030 trim_heap, 1031 repeat, 1032 read_query(Prompt, Query, Bindings), 1033 prompt(_, Old), 1034 catch(call_expand_query(Query, ExpandedQuery, 1035 Bindings, ExpandedBindings), 1036 Error, 1037 (print_message(error, Error), fail)), 1038 !.
1047:- if(current_prolog_flag(emscripten, true)). 1048read_query(_Prompt, Goal, Bindings) :- 1049 '$can_yield', 1050 !, 1051 await(goal, GoalString), 1052 term_string(Goal, GoalString, [variable_names(Bindings)]). 1053:- endif. 1054read_query(Prompt, Goal, Bindings) :- 1055 current_prolog_flag(history, N), 1056 integer(N), N > 0, 1057 !, 1058 read_term_with_history( 1059 Goal, 1060 [ show(h), 1061 help('!h'), 1062 no_save([trace, end_of_file]), 1063 prompt(Prompt), 1064 variable_names(Bindings) 1065 ]). 1066read_query(Prompt, Goal, Bindings) :- 1067 remove_history_prompt(Prompt, Prompt1), 1068 repeat, % over syntax errors 1069 prompt1(Prompt1), 1070 read_query_line(user_input, Line), 1071 '$save_history_line'(Line), % save raw line (edit syntax errors) 1072 '$current_typein_module'(TypeIn), 1073 catch(read_term_from_atom(Line, Goal, 1074 [ variable_names(Bindings), 1075 module(TypeIn) 1076 ]), E, 1077 ( print_message(error, E), 1078 fail 1079 )), 1080 !, 1081 '$save_history_event'(Line). % save event (no syntax errors)
1085read_query_line(Input, Line) :- 1086 stream_property(Input, error(true)), 1087 !, 1088 Line = end_of_file. 1089read_query_line(Input, Line) :- 1090 catch(read_term_as_atom(Input, Line), Error, true), 1091 save_debug_after_read, 1092 ( var(Error) 1093 -> true 1094 ; catch(print_message(error, Error), _, true), 1095 ( Error = error(syntax_error(_),_) 1096 -> fail 1097 ; throw(Error) 1098 ) 1099 ).
1106read_term_as_atom(In, Line) :-
1107 '$raw_read'(In, Line),
1108 ( Line == end_of_file
1109 -> true
1110 ; skip_to_nl(In)
1111 ).
1118skip_to_nl(In) :- 1119 repeat, 1120 peek_char(In, C), 1121 ( C == '%' 1122 -> skip(In, '\n') 1123 ; char_type(C, space) 1124 -> get_char(In, _), 1125 C == '\n' 1126 ; true 1127 ), 1128 !. 1129 1130remove_history_prompt('', '') :- !. 1131remove_history_prompt(Prompt0, Prompt) :- 1132 atom_chars(Prompt0, Chars0), 1133 clean_history_prompt_chars(Chars0, Chars1), 1134 delete_leading_blanks(Chars1, Chars), 1135 atom_chars(Prompt, Chars). 1136 1137clean_history_prompt_chars([], []). 1138clean_history_prompt_chars(['~', !|T], T) :- !. 1139clean_history_prompt_chars([H|T0], [H|T]) :- 1140 clean_history_prompt_chars(T0, T). 1141 1142delete_leading_blanks([' '|T0], T) :- 1143 !, 1144 delete_leading_blanks(T0, T). 1145delete_leading_blanks(L, L).
1154set_default_history :- 1155 current_prolog_flag(history, _), 1156 !. 1157set_default_history :- 1158 ( ( \+ current_prolog_flag(readline, false) 1159 ; current_prolog_flag(emacs_inferior_process, true) 1160 ) 1161 -> create_prolog_flag(history, 0, []) 1162 ; create_prolog_flag(history, 25, []) 1163 ). 1164 1165 1166 /******************************* 1167 * TOPLEVEL DEBUG * 1168 *******************************/
thread_signal(main, gdebug)
1183save_debug_after_read :- 1184 current_prolog_flag(debug, true), 1185 !, 1186 save_debug. 1187save_debug_after_read. 1188 1189save_debug :- 1190 ( tracing, 1191 notrace 1192 -> Tracing = true 1193 ; Tracing = false 1194 ), 1195 current_prolog_flag(debug, Debugging), 1196 set_prolog_flag(debug, false), 1197 create_prolog_flag(query_debug_settings, 1198 debug(Debugging, Tracing), []). 1199 1200restore_debug :- 1201 current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)), 1202 set_prolog_flag(debug, Debugging), 1203 ( Tracing == true 1204 -> trace 1205 ; true 1206 ). 1207 1208:- initialization 1209 create_prolog_flag(query_debug_settings, debug(false, false), []). 1210 1211 1212 /******************************** 1213 * PROMPTING * 1214 ********************************/ 1215 1216'$system_prompt'(Module, BrekLev, Prompt) :- 1217 current_prolog_flag(toplevel_prompt, PAtom), 1218 atom_codes(PAtom, P0), 1219 ( Module \== user 1220 -> '$substitute'('~m', [Module, ': '], P0, P1) 1221 ; '$substitute'('~m', [], P0, P1) 1222 ), 1223 ( BrekLev > 0 1224 -> '$substitute'('~l', ['[', BrekLev, '] '], P1, P2) 1225 ; '$substitute'('~l', [], P1, P2) 1226 ), 1227 current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)), 1228 ( Tracing == true 1229 -> '$substitute'('~d', ['[trace] '], P2, P3) 1230 ; Debugging == true 1231 -> '$substitute'('~d', ['[debug] '], P2, P3) 1232 ; '$substitute'('~d', [], P2, P3) 1233 ), 1234 atom_chars(Prompt, P3). 1235 1236'$substitute'(From, T, Old, New) :- 1237 atom_codes(From, FromCodes), 1238 phrase(subst_chars(T), T0), 1239 '$append'(Pre, S0, Old), 1240 '$append'(FromCodes, Post, S0) -> 1241 '$append'(Pre, T0, S1), 1242 '$append'(S1, Post, New), 1243 !. 1244'$substitute'(_, _, Old, Old). 1245 1246subst_chars([]) --> 1247 []. 1248subst_chars([H|T]) --> 1249 { atomic(H), 1250 !, 1251 atom_codes(H, Codes) 1252 }, 1253 , 1254 subst_chars(T). 1255subst_chars([H|T]) --> 1256 , 1257 subst_chars(T). 1258 1259 1260 /******************************** 1261 * EXECUTION * 1262 ********************************/
1268'$execute_query'(Var, _, true) :- 1269 var(Var), 1270 !, 1271 print_message(informational, var_query(Var)). 1272'$execute_query'(Goal, Bindings, Truth) :- 1273 '$current_typein_module'(TypeIn), 1274 '$dwim_correct_goal'(TypeIn:Goal, Bindings, Corrected), 1275 !, 1276 setup_call_cleanup( 1277 '$set_source_module'(M0, TypeIn), 1278 expand_goal(Corrected, Expanded), 1279 '$set_source_module'(M0)), 1280 print_message(silent, toplevel_goal(Expanded, Bindings)), 1281 '$execute_goal2'(Expanded, Bindings, Truth). 1282'$execute_query'(_, _, false) :- 1283 notrace, 1284 print_message(query, query(no)). 1285 1286'$execute_goal2'(Goal, Bindings, true) :- 1287 restore_debug, 1288 '$current_typein_module'(TypeIn), 1289 residue_vars(TypeIn:Goal, Vars, TypeIn:Delays, Chp), 1290 deterministic(Det), 1291 ( save_debug 1292 ; restore_debug, fail 1293 ), 1294 flush_output(user_output), 1295 ( Det == true 1296 -> DetOrChp = true 1297 ; DetOrChp = Chp 1298 ), 1299 call_expand_answer(Goal, Bindings, NewBindings), 1300 ( \+ \+ write_bindings(NewBindings, Vars, Delays, DetOrChp) 1301 -> ! 1302 ). 1303'$execute_goal2'(_, _, false) :- 1304 save_debug, 1305 print_message(query, query(no)). 1306 1307residue_vars(Goal, Vars, Delays, Chp) :- 1308 current_prolog_flag(toplevel_residue_vars, true), 1309 !, 1310 '$wfs_call'(call_residue_vars(stop_backtrace(Goal, Chp), Vars), Delays). 1311residue_vars(Goal, [], Delays, Chp) :- 1312 '$wfs_call'(stop_backtrace(Goal, Chp), Delays). 1313 1314stop_backtrace(Goal, Chp) :- 1315 toplevel_call(Goal), 1316 prolog_current_choice(Chp). 1317 1318toplevel_call(Goal) :- 1319 call(Goal), 1320 no_lco. 1321 1322no_lco.
groundness
gives the classical behaviour,
determinism
is considered more adequate and informative.
Succeeds if the user accepts the answer and fails otherwise.
1338write_bindings(Bindings, ResidueVars, Delays, DetOrChp) :- 1339 '$current_typein_module'(TypeIn), 1340 translate_bindings(Bindings, Bindings1, ResidueVars, TypeIn:Residuals), 1341 omit_qualifier(Delays, TypeIn, Delays1), 1342 write_bindings2(Bindings1, Residuals, Delays1, DetOrChp). 1343 1344write_bindings2([], Residuals, Delays, _) :- 1345 current_prolog_flag(prompt_alternatives_on, groundness), 1346 !, 1347 name_vars([], t(Residuals, Delays)), 1348 print_message(query, query(yes(Delays, Residuals))). 1349write_bindings2(Bindings, Residuals, Delays, true) :- 1350 current_prolog_flag(prompt_alternatives_on, determinism), 1351 !, 1352 name_vars(Bindings, t(Residuals, Delays)), 1353 print_message(query, query(yes(Bindings, Delays, Residuals))). 1354write_bindings2(Bindings, Residuals, Delays, Chp) :- 1355 repeat, 1356 name_vars(Bindings, t(Residuals, Delays)), 1357 print_message(query, query(more(Bindings, Delays, Residuals))), 1358 get_respons(Action, Chp), 1359 ( Action == redo 1360 -> !, fail 1361 ; Action == show_again 1362 -> fail 1363 ; !, 1364 print_message(query, query(done)) 1365 ).
_[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/2 is a no-op.
Variables are named by unifying them to '$VAR'(Name)
1381name_vars(Bindings, Term) :- 1382 current_prolog_flag(toplevel_name_variables, true), 1383 answer_flags_imply_numbervars, 1384 !, 1385 '$term_multitons'(t(Bindings,Term), Vars), 1386 name_vars_(Vars, Bindings, 0), 1387 term_variables(t(Bindings,Term), SVars), 1388 anon_vars(SVars). 1389name_vars(_Bindings, _Term). 1390 1391name_vars_([], _, _). 1392name_vars_([H|T], Bindings, N) :- 1393 name_var(Bindings, Name, N, N1), 1394 H = '$VAR'(Name), 1395 name_vars_(T, Bindings, N1). 1396 1397anon_vars([]). 1398anon_vars(['$VAR'('_')|T]) :- 1399 anon_vars(T).
1406name_var(Bindings, Name, N0, N) :- 1407 between(N0, infinite, N1), 1408 I is N1//26, 1409 J is 0'A + N1 mod 26, 1410 ( I == 0 1411 -> format(atom(Name), '_~c', [J]) 1412 ; format(atom(Name), '_~c~d', [J, I]) 1413 ), 1414 ( current_prolog_flag(toplevel_print_anon, false) 1415 -> true 1416 ; \+ is_bound(Bindings, Name) 1417 ), 1418 !, 1419 N is N1+1. 1420 1421is_bound([binding(Vars,_Value,_Subst)|T], Name) :- 1422 ( in_vars(Vars, Name) 1423 -> true 1424 ; is_bound(T, Name) 1425 ). 1426 1427in_vars(Name, Name) :- !. 1428in_vars(Names, Name) :- 1429 '$member'(Name, Names).
1436answer_flags_imply_numbervars :- 1437 current_prolog_flag(answer_write_options, Options), 1438 numbervars_option(Opt), 1439 memberchk(Opt, Options), 1440 !. 1441 1442numbervars_option(portray(true)). 1443numbervars_option(portrayed(true)). 1444numbervars_option(numbervars(true)).
1451:- multifile 1452 residual_goal_collector/1. 1453 1454:- meta_predicate 1455 residual_goals( ). 1456 1457residual_goals(NonTerminal) :- 1458 throw(error(context_error(nodirective, residual_goals(NonTerminal)), _)). 1459 1460systemterm_expansion((:- residual_goals(NonTerminal)), 1461 '$toplevel':residual_goal_collector(M2:Head)) :- 1462 \+ current_prolog_flag(xref, true), 1463 prolog_load_context(module, M), 1464 strip_module(M:NonTerminal, M2, Head), 1465 '$must_be'(callable, Head).
1472:- public prolog:residual_goals//0. 1473 1474prolog:residual_goals --> 1475 { findall(NT, residual_goal_collector(NT), NTL) }, 1476 collect_residual_goals(NTL). 1477 1478collect_residual_goals([]) --> []. 1479collect_residual_goals([H|T]) --> 1480 ( call(H) -> [] ; [] ), 1481 collect_residual_goals(T).
1506:- public 1507 prolog:translate_bindings/5. 1508:- meta_predicate 1509 prolog:translate_bindings( , , , , ). 1510 1511prologtranslate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals) :- 1512 translate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals), 1513 name_vars(Bindings, t(ResVars, ResGoals, Residuals)). 1514 1515% should not be required. 1516prologname_vars(Bindings, Term) :- name_vars(Bindings, Term). 1517 1518translate_bindings(Bindings0, Bindings, ResidueVars, Residuals) :- 1519 prolog:residual_goals(ResidueGoals, []), 1520 translate_bindings(Bindings0, Bindings, ResidueVars, ResidueGoals, 1521 Residuals). 1522 1523translate_bindings(Bindings0, Bindings, [], [], _:[]-[]) :- 1524 term_attvars(Bindings0, []), 1525 !, 1526 join_same_bindings(Bindings0, Bindings1), 1527 factorize_bindings(Bindings1, Bindings2), 1528 bind_vars(Bindings2, Bindings3), 1529 filter_bindings(Bindings3, Bindings). 1530translate_bindings(Bindings0, Bindings, ResidueVars, ResGoals0, 1531 TypeIn:Residuals-HiddenResiduals) :- 1532 project_constraints(Bindings0, ResidueVars), 1533 hidden_residuals(ResidueVars, Bindings0, HiddenResiduals0), 1534 omit_qualifiers(HiddenResiduals0, TypeIn, HiddenResiduals), 1535 copy_term(Bindings0+ResGoals0, Bindings1+ResGoals1, Residuals0), 1536 '$append'(ResGoals1, Residuals0, Residuals1), 1537 omit_qualifiers(Residuals1, TypeIn, Residuals), 1538 join_same_bindings(Bindings1, Bindings2), 1539 factorize_bindings(Bindings2, Bindings3), 1540 bind_vars(Bindings3, Bindings4), 1541 filter_bindings(Bindings4, Bindings). 1542 ResidueVars, Bindings, Goal) (:- 1544 term_attvars(ResidueVars, Remaining), 1545 term_attvars(Bindings, QueryVars), 1546 subtract_vars(Remaining, QueryVars, HiddenVars), 1547 copy_term(HiddenVars, _, Goal). 1548 1549subtract_vars(All, Subtract, Remaining) :- 1550 sort(All, AllSorted), 1551 sort(Subtract, SubtractSorted), 1552 ord_subtract(AllSorted, SubtractSorted, Remaining). 1553 1554ord_subtract([], _Not, []). 1555ord_subtract([H1|T1], L2, Diff) :- 1556 diff21(L2, H1, T1, Diff). 1557 1558diff21([], H1, T1, [H1|T1]). 1559diff21([H2|T2], H1, T1, Diff) :- 1560 compare(Order, H1, H2), 1561 diff3(Order, H1, T1, H2, T2, Diff). 1562 1563diff12([], _H2, _T2, []). 1564diff12([H1|T1], H2, T2, Diff) :- 1565 compare(Order, H1, H2), 1566 diff3(Order, H1, T1, H2, T2, Diff). 1567 1568diff3(<, H1, T1, H2, T2, [H1|Diff]) :- 1569 diff12(T1, H2, T2, Diff). 1570diff3(=, _H1, T1, _H2, T2, Diff) :- 1571 ord_subtract(T1, T2, Diff). 1572diff3(>, H1, T1, _H2, T2, Diff) :- 1573 diff21(T2, H1, T1, Diff).
toplevel_residue_vars
is set to project
.1581project_constraints(Bindings, ResidueVars) :- 1582 !, 1583 term_attvars(Bindings, AttVars), 1584 phrase(attribute_modules(AttVars), Modules0), 1585 sort(Modules0, Modules), 1586 term_variables(Bindings, QueryVars), 1587 project_attributes(Modules, QueryVars, ResidueVars). 1588project_constraints(_, _). 1589 1590project_attributes([], _, _). 1591project_attributes([M|T], QueryVars, ResidueVars) :- 1592 ( current_predicate(M:project_attributes/2), 1593 catch(M:project_attributes(QueryVars, ResidueVars), E, 1594 print_message(error, E)) 1595 -> true 1596 ; true 1597 ), 1598 project_attributes(T, QueryVars, ResidueVars). 1599 1600attribute_modules([]) --> []. 1601attribute_modules([H|T]) --> 1602 { get_attrs(H, Attrs) }, 1603 attrs_modules(Attrs), 1604 attribute_modules(T). 1605 1606attrs_modules([]) --> []. 1607attrs_modules(att(Module, _, More)) --> 1608 [Module], 1609 attrs_modules(More).
1620join_same_bindings([], []). 1621join_same_bindings([Name=V0|T0], [[Name|Names]=V|T]) :- 1622 take_same_bindings(T0, V0, V, Names, T1), 1623 join_same_bindings(T1, T). 1624 1625take_same_bindings([], Val, Val, [], []). 1626take_same_bindings([Name=V1|T0], V0, V, [Name|Names], T) :- 1627 V0 == V1, 1628 !, 1629 take_same_bindings(T0, V1, V, Names, T). 1630take_same_bindings([Pair|T0], V0, V, Names, [Pair|T]) :- 1631 take_same_bindings(T0, V0, V, Names, T).
1640omit_qualifiers([], _, []). 1641omit_qualifiers([Goal0|Goals0], TypeIn, [Goal|Goals]) :- 1642 omit_qualifier(Goal0, TypeIn, Goal), 1643 omit_qualifiers(Goals0, TypeIn, Goals). 1644 1645omit_qualifier(M:G0, TypeIn, G) :- 1646 M == TypeIn, 1647 !, 1648 omit_meta_qualifiers(G0, TypeIn, G). 1649omit_qualifier(M:G0, TypeIn, G) :- 1650 predicate_property(TypeIn:G0, imported_from(M)), 1651 \+ predicate_property(G0, transparent), 1652 !, 1653 G0 = G. 1654omit_qualifier(_:G0, _, G) :- 1655 predicate_property(G0, built_in), 1656 \+ predicate_property(G0, transparent), 1657 !, 1658 G0 = G. 1659omit_qualifier(M:G0, _, M:G) :- 1660 atom(M), 1661 !, 1662 omit_meta_qualifiers(G0, M, G). 1663omit_qualifier(G0, TypeIn, G) :- 1664 omit_meta_qualifiers(G0, TypeIn, G). 1665 1666omit_meta_qualifiers(V, _, V) :- 1667 var(V), 1668 !. 1669omit_meta_qualifiers((QA,QB), TypeIn, (A,B)) :- 1670 !, 1671 omit_qualifier(QA, TypeIn, A), 1672 omit_qualifier(QB, TypeIn, B). 1673omit_meta_qualifiers(tnot(QA), TypeIn, tnot(A)) :- 1674 !, 1675 omit_qualifier(QA, TypeIn, A). 1676omit_meta_qualifiers(freeze(V, QGoal), TypeIn, freeze(V, Goal)) :- 1677 callable(QGoal), 1678 !, 1679 omit_qualifier(QGoal, TypeIn, Goal). 1680omit_meta_qualifiers(when(Cond, QGoal), TypeIn, when(Cond, Goal)) :- 1681 callable(QGoal), 1682 !, 1683 omit_qualifier(QGoal, TypeIn, Goal). 1684omit_meta_qualifiers(G, _, G).
1693bind_vars(Bindings0, Bindings) :- 1694 bind_query_vars(Bindings0, Bindings, SNames), 1695 bind_skel_vars(Bindings, Bindings, SNames, 1, _). 1696 1697bind_query_vars([], [], []). 1698bind_query_vars([binding(Names,Var,[Var2=Cycle])|T0], 1699 [binding(Names,Cycle,[])|T], [Name|SNames]) :- 1700 Var == Var2, % also implies var(Var) 1701 !, 1702 '$last'(Names, Name), 1703 Var = '$VAR'(Name), 1704 bind_query_vars(T0, T, SNames). 1705bind_query_vars([B|T0], [B|T], AllNames) :- 1706 B = binding(Names,Var,Skel), 1707 bind_query_vars(T0, T, SNames), 1708 ( var(Var), \+ attvar(Var), Skel == [] 1709 -> AllNames = [Name|SNames], 1710 '$last'(Names, Name), 1711 Var = '$VAR'(Name) 1712 ; AllNames = SNames 1713 ). 1714 1715 1716 1717bind_skel_vars([], _, _, N, N). 1718bind_skel_vars([binding(_,_,Skel)|T], Bindings, SNames, N0, N) :- 1719 bind_one_skel_vars(Skel, Bindings, SNames, N0, N1), 1720 bind_skel_vars(T, Bindings, SNames, N1, N).
1739bind_one_skel_vars([], _, _, N, N). 1740bind_one_skel_vars([Var=Value|T], Bindings, Names, N0, N) :- 1741 ( var(Var) 1742 -> ( '$member'(binding(Names, VVal, []), Bindings), 1743 same_term(Value, VVal) 1744 -> '$last'(Names, VName), 1745 Var = '$VAR'(VName), 1746 N2 = N0 1747 ; between(N0, infinite, N1), 1748 atom_concat('_S', N1, Name), 1749 \+ memberchk(Name, Names), 1750 !, 1751 Var = '$VAR'(Name), 1752 N2 is N1 + 1 1753 ) 1754 ; N2 = N0 1755 ), 1756 bind_one_skel_vars(T, Bindings, Names, N2, N).
1763factorize_bindings([], []). 1764factorize_bindings([Name=Value|T0], [binding(Name, Skel, Subst)|T]) :- 1765 '$factorize_term'(Value, Skel, Subst0), 1766 ( current_prolog_flag(toplevel_print_factorized, true) 1767 -> Subst = Subst0 1768 ; only_cycles(Subst0, Subst) 1769 ), 1770 factorize_bindings(T0, T). 1771 1772 1773only_cycles([], []). 1774only_cycles([B|T0], List) :- 1775 ( B = (Var=Value), 1776 Var = Value, 1777 acyclic_term(Var) 1778 -> only_cycles(T0, List) 1779 ; List = [B|T], 1780 only_cycles(T0, T) 1781 ).
1790filter_bindings([], []). 1791filter_bindings([H0|T0], T) :- 1792 hide_vars(H0, H), 1793 ( ( arg(1, H, []) 1794 ; self_bounded(H) 1795 ) 1796 -> filter_bindings(T0, T) 1797 ; T = [H|T1], 1798 filter_bindings(T0, T1) 1799 ). 1800 1801hide_vars(binding(Names0, Skel, Subst), binding(Names, Skel, Subst)) :- 1802 hide_names(Names0, Skel, Subst, Names). 1803 1804hide_names([], _, _, []). 1805hide_names([Name|T0], Skel, Subst, T) :- 1806 ( sub_atom(Name, 0, _, _, '_'), 1807 current_prolog_flag(toplevel_print_anon, false), 1808 sub_atom(Name, 1, 1, _, Next), 1809 char_type(Next, prolog_var_start) 1810 -> true 1811 ; Subst == [], 1812 Skel == '$VAR'(Name) 1813 ), 1814 !, 1815 hide_names(T0, Skel, Subst, T). 1816hide_names([Name|T0], Skel, Subst, [Name|T]) :- 1817 hide_names(T0, Skel, Subst, T). 1818 1819self_bounded(binding([Name], Value, [])) :- 1820 Value == '$VAR'(Name).
1826:- if(current_prolog_flag(emscripten, true)). 1827get_respons(Action, _Chp) :- 1828 '$can_yield', 1829 !, 1830 await(more, ActionS), 1831 atom_string(Action, ActionS). 1832:- endif. 1833get_respons(Action, Chp) :- 1834 repeat, 1835 flush_output(user_output), 1836 get_single_char(Char), 1837 answer_respons(Char, Chp, Action), 1838 ( Action == again 1839 -> print_message(query, query(action)), 1840 fail 1841 ; ! 1842 ). 1843 1844answer_respons(Char, _, again) :- 1845 '$in_reply'(Char, '?h'), 1846 !, 1847 print_message(help, query(help)). 1848answer_respons(Char, _, redo) :- 1849 '$in_reply'(Char, ';nrNR \t'), 1850 !, 1851 print_message(query, if_tty([ansi(bold, ';', [])])). 1852answer_respons(Char, _, redo) :- 1853 '$in_reply'(Char, 'tT'), 1854 !, 1855 trace, 1856 save_debug, 1857 print_message(query, if_tty([ansi(bold, '; [trace]', [])])). 1858answer_respons(Char, _, continue) :- 1859 '$in_reply'(Char, 'ca\n\ryY.'), 1860 !, 1861 print_message(query, if_tty([ansi(bold, '.', [])])). 1862answer_respons(0'b, _, show_again) :- 1863 !, 1864 break. 1865answer_respons(0'*, Chp, show_again) :- 1866 !, 1867 print_last_chpoint(Chp). 1868answer_respons(Char, _, show_again) :- 1869 current_prolog_flag(answer_write_options, Options0), 1870 print_predicate(Char, Pred, Options0, Options), 1871 !, 1872 print_message(query, if_tty(['~w'-[Pred]])), 1873 set_prolog_flag(answer_write_options, Options). 1874answer_respons(-1, _, show_again) :- 1875 !, 1876 print_message(query, halt('EOF')), 1877 halt(0). 1878answer_respons(Char, _, again) :- 1879 print_message(query, no_action(Char)).
answer_write_options
value according to the user
command.1886print_predicate(0'w, [write], Options0, Options) :- 1887 edit_options([-portrayed(true),-portray(true)], 1888 Options0, Options). 1889print_predicate(0'p, [print], Options0, Options) :- 1890 edit_options([+portrayed(true)], 1891 Options0, Options). 1892print_predicate(0'+, [Change], Options0, Options) :- 1893 ( '$select'(max_depth(D0), Options0, Options1) 1894 -> D is D0*10, 1895 format(string(Change), 'max_depth(~D)', [D]), 1896 Options = [max_depth(D)|Options1] 1897 ; Options = Options0, 1898 Change = 'no max_depth' 1899 ). 1900print_predicate(0'-, [Change], Options0, Options) :- 1901 ( '$select'(max_depth(D0), Options0, Options1) 1902 -> D is max(1, D0//10), 1903 Options = [max_depth(D)|Options1] 1904 ; D = 10, 1905 Options = [max_depth(D)|Options0] 1906 ), 1907 format(string(Change), 'max_depth(~D)', [D]). 1908 1909edit_options([], Options, Options). 1910edit_options([H|T], Options0, Options) :- 1911 edit_option(H, Options0, Options1), 1912 edit_options(T, Options1, Options). 1913 1914edit_option(-Term, Options0, Options) => 1915 ( '$select'(Term, Options0, Options) 1916 -> true 1917 ; Options = Options0 1918 ). 1919edit_option(+Term, Options0, Options) => 1920 functor(Term, Name, 1), 1921 functor(Var, Name, 1), 1922 ( '$select'(Var, Options0, Options1) 1923 -> Options = [Term|Options1] 1924 ; Options = [Term|Options0] 1925 ).
1931print_last_chpoint(Chp) :- 1932 current_predicate(print_last_choice_point/0), 1933 !, 1934 print_last_chpoint_(Chp). 1935print_last_chpoint(Chp) :- 1936 use_module(library(prolog_stack), [print_last_choicepoint/2]), 1937 print_last_chpoint_(Chp). 1938 1939print_last_chpoint_(Chp) :- 1940 print_last_choicepoint(Chp, [message_level(information)]). 1941 1942 1943 /******************************* 1944 * EXPANSION * 1945 *******************************/ 1946 1947:- user:dynamic(expand_query/4). 1948:- user:multifile(expand_query/4). 1949 1950call_expand_query(Goal, Expanded, Bindings, ExpandedBindings) :- 1951 ( '$replace_toplevel_vars'(Goal, Expanded0, Bindings, ExpandedBindings0) 1952 -> true 1953 ; Expanded0 = Goal, ExpandedBindings0 = Bindings 1954 ), 1955 ( user:expand_query(Expanded0, Expanded, ExpandedBindings0, ExpandedBindings) 1956 -> true 1957 ; Expanded = Expanded0, ExpandedBindings = ExpandedBindings0 1958 ). 1959 1960 1961:- dynamic 1962 user:expand_answer/2, 1963 prolog:expand_answer/3. 1964:- multifile 1965 user:expand_answer/2, 1966 prolog:expand_answer/3. 1967 1968call_expand_answer(Goal, BindingsIn, BindingsOut) :- 1969 ( prolog:expand_answer(Goal, BindingsIn, BindingsOut) 1970 -> true 1971 ; user:expand_answer(BindingsIn, BindingsOut) 1972 -> true 1973 ; BindingsOut = BindingsIn 1974 ), 1975 '$save_toplevel_vars'(BindingsOut), 1976 !. 1977call_expand_answer(_, Bindings, Bindings)