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