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). 1399 1400name_var(Bindings, Name, N0, N) :- 1401 between(N0, infinite, N1), 1402 I is N1//26, 1403 J is 0'A + N1 mod 26, 1404 ( I == 0 1405 -> format(atom(Name), '_~c', [J]) 1406 ; format(atom(Name), '_~c~d', [J, I]) 1407 ), 1408 ( current_prolog_flag(toplevel_print_anon, false) 1409 -> true 1410 ; \+ is_bound(Bindings, Name) 1411 ), 1412 !, 1413 N is N1+1. 1414 1415is_bound([Vars=_|T], Name) :- 1416 ( in_vars(Vars, Name) 1417 -> true 1418 ; is_bound(T, Name) 1419 ). 1420 1421in_vars(Name, Name) :- !. 1422in_vars(Names, Name) :- 1423 '$member'(Name, Names).
1430answer_flags_imply_numbervars :- 1431 current_prolog_flag(answer_write_options, Options), 1432 numbervars_option(Opt), 1433 memberchk(Opt, Options), 1434 !. 1435 1436numbervars_option(portray(true)). 1437numbervars_option(portrayed(true)). 1438numbervars_option(numbervars(true)).
1445:- multifile 1446 residual_goal_collector/1. 1447 1448:- meta_predicate 1449 residual_goals( ). 1450 1451residual_goals(NonTerminal) :- 1452 throw(error(context_error(nodirective, residual_goals(NonTerminal)), _)). 1453 1454systemterm_expansion((:- residual_goals(NonTerminal)), 1455 '$toplevel':residual_goal_collector(M2:Head)) :- 1456 \+ current_prolog_flag(xref, true), 1457 prolog_load_context(module, M), 1458 strip_module(M:NonTerminal, M2, Head), 1459 '$must_be'(callable, Head).
1466:- public prolog:residual_goals//0. 1467 1468prolog:residual_goals --> 1469 { findall(NT, residual_goal_collector(NT), NTL) }, 1470 collect_residual_goals(NTL). 1471 1472collect_residual_goals([]) --> []. 1473collect_residual_goals([H|T]) --> 1474 ( call(H) -> [] ; [] ), 1475 collect_residual_goals(T).
1500:- public 1501 prolog:translate_bindings/5. 1502:- meta_predicate 1503 prolog:translate_bindings( , , , , ). 1504 1505prologtranslate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals) :- 1506 translate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals), 1507 name_vars(Bindings, t(ResVars, ResGoals, Residuals)). 1508 1509% should not be required. 1510prologname_vars(Bindings, Term) :- name_vars(Bindings, Term). 1511 1512translate_bindings(Bindings0, Bindings, ResidueVars, Residuals) :- 1513 prolog:residual_goals(ResidueGoals, []), 1514 translate_bindings(Bindings0, Bindings, ResidueVars, ResidueGoals, 1515 Residuals). 1516 1517translate_bindings(Bindings0, Bindings, [], [], _:[]-[]) :- 1518 term_attvars(Bindings0, []), 1519 !, 1520 join_same_bindings(Bindings0, Bindings1), 1521 factorize_bindings(Bindings1, Bindings2), 1522 bind_vars(Bindings2, Bindings3), 1523 filter_bindings(Bindings3, Bindings). 1524translate_bindings(Bindings0, Bindings, ResidueVars, ResGoals0, 1525 TypeIn:Residuals-HiddenResiduals) :- 1526 project_constraints(Bindings0, ResidueVars), 1527 hidden_residuals(ResidueVars, Bindings0, HiddenResiduals0), 1528 omit_qualifiers(HiddenResiduals0, TypeIn, HiddenResiduals), 1529 copy_term(Bindings0+ResGoals0, Bindings1+ResGoals1, Residuals0), 1530 '$append'(ResGoals1, Residuals0, Residuals1), 1531 omit_qualifiers(Residuals1, TypeIn, Residuals), 1532 join_same_bindings(Bindings1, Bindings2), 1533 factorize_bindings(Bindings2, Bindings3), 1534 bind_vars(Bindings3, Bindings4), 1535 filter_bindings(Bindings4, Bindings). 1536 ResidueVars, Bindings, Goal) (:- 1538 term_attvars(ResidueVars, Remaining), 1539 term_attvars(Bindings, QueryVars), 1540 subtract_vars(Remaining, QueryVars, HiddenVars), 1541 copy_term(HiddenVars, _, Goal). 1542 1543subtract_vars(All, Subtract, Remaining) :- 1544 sort(All, AllSorted), 1545 sort(Subtract, SubtractSorted), 1546 ord_subtract(AllSorted, SubtractSorted, Remaining). 1547 1548ord_subtract([], _Not, []). 1549ord_subtract([H1|T1], L2, Diff) :- 1550 diff21(L2, H1, T1, Diff). 1551 1552diff21([], H1, T1, [H1|T1]). 1553diff21([H2|T2], H1, T1, Diff) :- 1554 compare(Order, H1, H2), 1555 diff3(Order, H1, T1, H2, T2, Diff). 1556 1557diff12([], _H2, _T2, []). 1558diff12([H1|T1], H2, T2, Diff) :- 1559 compare(Order, H1, H2), 1560 diff3(Order, H1, T1, H2, T2, Diff). 1561 1562diff3(<, H1, T1, H2, T2, [H1|Diff]) :- 1563 diff12(T1, H2, T2, Diff). 1564diff3(=, _H1, T1, _H2, T2, Diff) :- 1565 ord_subtract(T1, T2, Diff). 1566diff3(>, H1, T1, _H2, T2, Diff) :- 1567 diff21(T2, H1, T1, Diff).
toplevel_residue_vars
is set to project
.1575project_constraints(Bindings, ResidueVars) :- 1576 !, 1577 term_attvars(Bindings, AttVars), 1578 phrase(attribute_modules(AttVars), Modules0), 1579 sort(Modules0, Modules), 1580 term_variables(Bindings, QueryVars), 1581 project_attributes(Modules, QueryVars, ResidueVars). 1582project_constraints(_, _). 1583 1584project_attributes([], _, _). 1585project_attributes([M|T], QueryVars, ResidueVars) :- 1586 ( current_predicate(M:project_attributes/2), 1587 catch(M:project_attributes(QueryVars, ResidueVars), E, 1588 print_message(error, E)) 1589 -> true 1590 ; true 1591 ), 1592 project_attributes(T, QueryVars, ResidueVars). 1593 1594attribute_modules([]) --> []. 1595attribute_modules([H|T]) --> 1596 { get_attrs(H, Attrs) }, 1597 attrs_modules(Attrs), 1598 attribute_modules(T). 1599 1600attrs_modules([]) --> []. 1601attrs_modules(att(Module, _, More)) --> 1602 [Module], 1603 attrs_modules(More).
1614join_same_bindings([], []). 1615join_same_bindings([Name=V0|T0], [[Name|Names]=V|T]) :- 1616 take_same_bindings(T0, V0, V, Names, T1), 1617 join_same_bindings(T1, T). 1618 1619take_same_bindings([], Val, Val, [], []). 1620take_same_bindings([Name=V1|T0], V0, V, [Name|Names], T) :- 1621 V0 == V1, 1622 !, 1623 take_same_bindings(T0, V1, V, Names, T). 1624take_same_bindings([Pair|T0], V0, V, Names, [Pair|T]) :- 1625 take_same_bindings(T0, V0, V, Names, T).
1634omit_qualifiers([], _, []). 1635omit_qualifiers([Goal0|Goals0], TypeIn, [Goal|Goals]) :- 1636 omit_qualifier(Goal0, TypeIn, Goal), 1637 omit_qualifiers(Goals0, TypeIn, Goals). 1638 1639omit_qualifier(M:G0, TypeIn, G) :- 1640 M == TypeIn, 1641 !, 1642 omit_meta_qualifiers(G0, TypeIn, G). 1643omit_qualifier(M:G0, TypeIn, G) :- 1644 predicate_property(TypeIn:G0, imported_from(M)), 1645 \+ predicate_property(G0, transparent), 1646 !, 1647 G0 = G. 1648omit_qualifier(_:G0, _, G) :- 1649 predicate_property(G0, built_in), 1650 \+ predicate_property(G0, transparent), 1651 !, 1652 G0 = G. 1653omit_qualifier(M:G0, _, M:G) :- 1654 atom(M), 1655 !, 1656 omit_meta_qualifiers(G0, M, G). 1657omit_qualifier(G0, TypeIn, G) :- 1658 omit_meta_qualifiers(G0, TypeIn, G). 1659 1660omit_meta_qualifiers(V, _, V) :- 1661 var(V), 1662 !. 1663omit_meta_qualifiers((QA,QB), TypeIn, (A,B)) :- 1664 !, 1665 omit_qualifier(QA, TypeIn, A), 1666 omit_qualifier(QB, TypeIn, B). 1667omit_meta_qualifiers(tnot(QA), TypeIn, tnot(A)) :- 1668 !, 1669 omit_qualifier(QA, TypeIn, A). 1670omit_meta_qualifiers(freeze(V, QGoal), TypeIn, freeze(V, Goal)) :- 1671 callable(QGoal), 1672 !, 1673 omit_qualifier(QGoal, TypeIn, Goal). 1674omit_meta_qualifiers(when(Cond, QGoal), TypeIn, when(Cond, Goal)) :- 1675 callable(QGoal), 1676 !, 1677 omit_qualifier(QGoal, TypeIn, Goal). 1678omit_meta_qualifiers(G, _, G).
1687bind_vars(Bindings0, Bindings) :- 1688 bind_query_vars(Bindings0, Bindings, SNames), 1689 bind_skel_vars(Bindings, Bindings, SNames, 1, _). 1690 1691bind_query_vars([], [], []). 1692bind_query_vars([binding(Names,Var,[Var2=Cycle])|T0], 1693 [binding(Names,Cycle,[])|T], [Name|SNames]) :- 1694 Var == Var2, % also implies var(Var) 1695 !, 1696 '$last'(Names, Name), 1697 Var = '$VAR'(Name), 1698 bind_query_vars(T0, T, SNames). 1699bind_query_vars([B|T0], [B|T], AllNames) :- 1700 B = binding(Names,Var,Skel), 1701 bind_query_vars(T0, T, SNames), 1702 ( var(Var), \+ attvar(Var), Skel == [] 1703 -> AllNames = [Name|SNames], 1704 '$last'(Names, Name), 1705 Var = '$VAR'(Name) 1706 ; AllNames = SNames 1707 ). 1708 1709 1710 1711bind_skel_vars([], _, _, N, N). 1712bind_skel_vars([binding(_,_,Skel)|T], Bindings, SNames, N0, N) :- 1713 bind_one_skel_vars(Skel, Bindings, SNames, N0, N1), 1714 bind_skel_vars(T, Bindings, SNames, N1, N).
1733bind_one_skel_vars([], _, _, N, N). 1734bind_one_skel_vars([Var=Value|T], Bindings, Names, N0, N) :- 1735 ( var(Var) 1736 -> ( '$member'(binding(Names, VVal, []), Bindings), 1737 same_term(Value, VVal) 1738 -> '$last'(Names, VName), 1739 Var = '$VAR'(VName), 1740 N2 = N0 1741 ; between(N0, infinite, N1), 1742 atom_concat('_S', N1, Name), 1743 \+ memberchk(Name, Names), 1744 !, 1745 Var = '$VAR'(Name), 1746 N2 is N1 + 1 1747 ) 1748 ; N2 = N0 1749 ), 1750 bind_one_skel_vars(T, Bindings, Names, N2, N).
1757factorize_bindings([], []). 1758factorize_bindings([Name=Value|T0], [binding(Name, Skel, Subst)|T]) :- 1759 '$factorize_term'(Value, Skel, Subst0), 1760 ( current_prolog_flag(toplevel_print_factorized, true) 1761 -> Subst = Subst0 1762 ; only_cycles(Subst0, Subst) 1763 ), 1764 factorize_bindings(T0, T). 1765 1766 1767only_cycles([], []). 1768only_cycles([B|T0], List) :- 1769 ( B = (Var=Value), 1770 Var = Value, 1771 acyclic_term(Var) 1772 -> only_cycles(T0, List) 1773 ; List = [B|T], 1774 only_cycles(T0, T) 1775 ).
1784filter_bindings([], []). 1785filter_bindings([H0|T0], T) :- 1786 hide_vars(H0, H), 1787 ( ( arg(1, H, []) 1788 ; self_bounded(H) 1789 ) 1790 -> filter_bindings(T0, T) 1791 ; T = [H|T1], 1792 filter_bindings(T0, T1) 1793 ). 1794 1795hide_vars(binding(Names0, Skel, Subst), binding(Names, Skel, Subst)) :- 1796 hide_names(Names0, Skel, Subst, Names). 1797 1798hide_names([], _, _, []). 1799hide_names([Name|T0], Skel, Subst, T) :- 1800 ( sub_atom(Name, 0, _, _, '_'), 1801 current_prolog_flag(toplevel_print_anon, false), 1802 sub_atom(Name, 1, 1, _, Next), 1803 char_type(Next, prolog_var_start) 1804 -> true 1805 ; Subst == [], 1806 Skel == '$VAR'(Name) 1807 ), 1808 !, 1809 hide_names(T0, Skel, Subst, T). 1810hide_names([Name|T0], Skel, Subst, [Name|T]) :- 1811 hide_names(T0, Skel, Subst, T). 1812 1813self_bounded(binding([Name], Value, [])) :- 1814 Value == '$VAR'(Name).
1820:- if(current_prolog_flag(emscripten, true)). 1821get_respons(Action, _Chp) :- 1822 '$can_yield', 1823 !, 1824 await(more, ActionS), 1825 atom_string(Action, ActionS). 1826:- endif. 1827get_respons(Action, Chp) :- 1828 repeat, 1829 flush_output(user_output), 1830 get_single_char(Char), 1831 answer_respons(Char, Chp, Action), 1832 ( Action == again 1833 -> print_message(query, query(action)), 1834 fail 1835 ; ! 1836 ). 1837 1838answer_respons(Char, _, again) :- 1839 '$in_reply'(Char, '?h'), 1840 !, 1841 print_message(help, query(help)). 1842answer_respons(Char, _, redo) :- 1843 '$in_reply'(Char, ';nrNR \t'), 1844 !, 1845 print_message(query, if_tty([ansi(bold, ';', [])])). 1846answer_respons(Char, _, redo) :- 1847 '$in_reply'(Char, 'tT'), 1848 !, 1849 trace, 1850 save_debug, 1851 print_message(query, if_tty([ansi(bold, '; [trace]', [])])). 1852answer_respons(Char, _, continue) :- 1853 '$in_reply'(Char, 'ca\n\ryY.'), 1854 !, 1855 print_message(query, if_tty([ansi(bold, '.', [])])). 1856answer_respons(0'b, _, show_again) :- 1857 !, 1858 break. 1859answer_respons(0'*, Chp, show_again) :- 1860 !, 1861 print_last_chpoint(Chp). 1862answer_respons(Char, _, show_again) :- 1863 current_prolog_flag(answer_write_options, Options0), 1864 print_predicate(Char, Pred, Options0, Options), 1865 !, 1866 print_message(query, if_tty(['~w'-[Pred]])), 1867 set_prolog_flag(answer_write_options, Options). 1868answer_respons(-1, _, show_again) :- 1869 !, 1870 print_message(query, halt('EOF')), 1871 halt(0). 1872answer_respons(Char, _, again) :- 1873 print_message(query, no_action(Char)).
answer_write_options
value according to the user
command.1880print_predicate(0'w, [write], Options0, Options) :- 1881 edit_options([-portrayed(true),-portray(true)], 1882 Options0, Options). 1883print_predicate(0'p, [print], Options0, Options) :- 1884 edit_options([+portrayed(true)], 1885 Options0, Options). 1886print_predicate(0'+, [Change], Options0, Options) :- 1887 ( '$select'(max_depth(D0), Options0, Options1) 1888 -> D is D0*10, 1889 format(string(Change), 'max_depth(~D)', [D]), 1890 Options = [max_depth(D)|Options1] 1891 ; Options = Options0, 1892 Change = 'no max_depth' 1893 ). 1894print_predicate(0'-, [Change], Options0, Options) :- 1895 ( '$select'(max_depth(D0), Options0, Options1) 1896 -> D is max(1, D0//10), 1897 Options = [max_depth(D)|Options1] 1898 ; D = 10, 1899 Options = [max_depth(D)|Options0] 1900 ), 1901 format(string(Change), 'max_depth(~D)', [D]). 1902 1903edit_options([], Options, Options). 1904edit_options([H|T], Options0, Options) :- 1905 edit_option(H, Options0, Options1), 1906 edit_options(T, Options1, Options). 1907 1908edit_option(-Term, Options0, Options) => 1909 ( '$select'(Term, Options0, Options) 1910 -> true 1911 ; Options = Options0 1912 ). 1913edit_option(+Term, Options0, Options) => 1914 functor(Term, Name, 1), 1915 functor(Var, Name, 1), 1916 ( '$select'(Var, Options0, Options1) 1917 -> Options = [Term|Options1] 1918 ; Options = [Term|Options0] 1919 ).
1925print_last_chpoint(Chp) :- 1926 current_predicate(print_last_choice_point/0), 1927 !, 1928 print_last_chpoint_(Chp). 1929print_last_chpoint(Chp) :- 1930 use_module(library(prolog_stack), [print_last_choicepoint/2]), 1931 print_last_chpoint_(Chp). 1932 1933print_last_chpoint_(Chp) :- 1934 print_last_choicepoint(Chp, [message_level(information)]). 1935 1936 1937 /******************************* 1938 * EXPANSION * 1939 *******************************/ 1940 1941:- user:dynamic(expand_query/4). 1942:- user:multifile(expand_query/4). 1943 1944call_expand_query(Goal, Expanded, Bindings, ExpandedBindings) :- 1945 ( '$replace_toplevel_vars'(Goal, Expanded0, Bindings, ExpandedBindings0) 1946 -> true 1947 ; Expanded0 = Goal, ExpandedBindings0 = Bindings 1948 ), 1949 ( user:expand_query(Expanded0, Expanded, ExpandedBindings0, ExpandedBindings) 1950 -> true 1951 ; Expanded = Expanded0, ExpandedBindings = ExpandedBindings0 1952 ). 1953 1954 1955:- dynamic 1956 user:expand_answer/2, 1957 prolog:expand_answer/3. 1958:- multifile 1959 user:expand_answer/2, 1960 prolog:expand_answer/3. 1961 1962call_expand_answer(Goal, BindingsIn, BindingsOut) :- 1963 ( prolog:expand_answer(Goal, BindingsIn, BindingsOut) 1964 -> true 1965 ; user:expand_answer(BindingsIn, BindingsOut) 1966 -> true 1967 ; BindingsOut = BindingsIn 1968 ), 1969 '$save_toplevel_vars'(BindingsOut), 1970 !. 1971call_expand_answer(_, Bindings, Bindings)