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-2023, 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 asserta(loaded_init_file(Base, InitFile)), 132 load_files(user:InitFile, 133 [ scope_settings(false) 134 ]). 135load_init_file('init.pl', implicit) :- 136 ( current_prolog_flag(windows, true), 137 absolute_file_name(user_profile('swipl.ini'), InitFile, 138 [ access(read), 139 file_errors(fail) 140 ]) 141 ; expand_file_name('~/.swiplrc', [InitFile]), 142 exists_file(InitFile) 143 ), 144 !, 145 print_message(warning, backcomp(init_file_moved(InitFile))). 146load_init_file(_, _). 147 148'$load_system_init_file' :- 149 loaded_init_file(system, _), 150 !. 151'$load_system_init_file' :- 152 '$cmd_option_val'(system_init_file, Base), 153 Base \== none, 154 current_prolog_flag(home, Home), 155 file_name_extension(Base, rc, Name), 156 atomic_list_concat([Home, '/', Name], File), 157 absolute_file_name(File, Path, 158 [ file_type(prolog), 159 access(read), 160 file_errors(fail) 161 ]), 162 asserta(loaded_init_file(system, Path)), 163 load_files(user:Path, 164 [ silent(true), 165 scope_settings(false) 166 ]), 167 !. 168'$load_system_init_file'. 169 170'$load_script_file' :- 171 loaded_init_file(script, _), 172 !. 173'$load_script_file' :- 174 '$cmd_option_val'(script_file, OsFiles), 175 load_script_files(OsFiles). 176 177load_script_files([]). 178load_script_files([OsFile|More]) :- 179 prolog_to_os_filename(File, OsFile), 180 ( absolute_file_name(File, Path, 181 [ file_type(prolog), 182 access(read), 183 file_errors(fail) 184 ]) 185 -> asserta(loaded_init_file(script, Path)), 186 load_files(user:Path, []), 187 load_files(More) 188 ; throw(error(existence_error(script_file, File), _)) 189 ). 190 191 192 /******************************* 193 * AT_INITIALISATION * 194 *******************************/ 195 196:- meta_predicate 197 initialization(). 198 199:- '$iso'((initialization)/1).
208initialization(Goal) :- 209 Goal = _:G, 210 prolog:initialize_now(G, Use), 211 !, 212 print_message(warning, initialize_now(G, Use)), 213 initialization(Goal, now). 214initialization(Goal) :- 215 initialization(Goal, after_load). 216 217:- multifile 218 prolog:initialize_now/2, 219 prolog:message//1. 220 221prologinitialize_now(load_foreign_library(_), 222 'use :- use_foreign_library/1 instead'). 223prologinitialize_now(load_foreign_library(_,_), 224 'use :- use_foreign_library/2 instead'). 225 226prologmessage(initialize_now(Goal, Use)) --> 227 [ 'Initialization goal ~p will be executed'-[Goal],nl, 228 'immediately for backward compatibility reasons', nl, 229 '~w'-[Use] 230 ]. 231 232'$run_initialization' :- 233 '$set_prolog_file_extension', 234 '$run_initialization'(_, []), 235 '$thread_init'.
:- initialization(Goal, program).. Stop
with an exception if a goal fails or raises an exception.242initialize :- 243 forall('$init_goal'(when(program), Goal, Ctx), 244 run_initialize(Goal, Ctx)). 245 246run_initialize(Goal, Ctx) :- 247 ( catch(Goal, E, true), 248 ( var(E) 249 -> true 250 ; throw(error(initialization_error(E, Goal, Ctx), _)) 251 ) 252 ; throw(error(initialization_error(failed, Goal, Ctx), _)) 253 ). 254 255 256 /******************************* 257 * THREAD INITIALIZATION * 258 *******************************/ 259 260:- meta_predicate 261 thread_initialization(). 262:- dynamic 263 '$at_thread_initialization'/1.
269thread_initialization(Goal) :- 270 assert('$at_thread_initialization'(Goal)), 271 call(Goal), 272 !. 273 274'$thread_init' :- 275 ( '$at_thread_initialization'(Goal), 276 ( call(Goal) 277 -> fail 278 ; fail 279 ) 280 ; true 281 ). 282 283 284 /******************************* 285 * FILE SEARCH PATH (-p) * 286 *******************************/
292'$set_file_search_paths' :- 293 '$cmd_option_val'(search_paths, Paths), 294 ( '$member'(Path, Paths), 295 atom_chars(Path, Chars), 296 ( phrase('$search_path'(Name, Aliases), Chars) 297 -> '$reverse'(Aliases, Aliases1), 298 forall('$member'(Alias, Aliases1), 299 asserta(user:file_search_path(Name, Alias))) 300 ; print_message(error, commandline_arg_type(p, Path)) 301 ), 302 fail ; true 303 ). 304 305'$search_path'(Name, Aliases) --> 306 '$string'(NameChars), 307 [=], 308 !, 309 {atom_chars(Name, NameChars)}, 310 '$search_aliases'(Aliases). 311 312'$search_aliases'([Alias|More]) --> 313 '$string'(AliasChars), 314 path_sep, 315 !, 316 { '$make_alias'(AliasChars, Alias) }, 317 '$search_aliases'(More). 318'$search_aliases'([Alias]) --> 319 '$string'(AliasChars), 320 '$eos', 321 !, 322 { '$make_alias'(AliasChars, Alias) }. 323 324path_sep --> 325 { current_prolog_flag(windows, true) 326 }, 327 !, 328 [;]. 329path_sep --> 330 [:]. 331 332'$string'([]) --> []. 333'$string'([H|T]) --> [H], '$string'(T). 334 335'$eos'([], []). 336 337'$make_alias'(Chars, Alias) :- 338 catch(term_to_atom(Alias, Chars), _, fail), 339 ( atom(Alias) 340 ; functor(Alias, F, 1), 341 F \== / 342 ), 343 !. 344'$make_alias'(Chars, Alias) :- 345 atom_chars(Alias, Chars). 346 347 348 /******************************* 349 * LOADING ASSIOCIATED FILES * 350 *******************************/
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 argvsearch(name) as Prolog file,
make this the content of Files and pass the remainder as
options to argv.384argv_prolog_files([], exe) :- 385 current_prolog_flag(saved_program_class, runtime), 386 !, 387 clean_argv. 388argv_prolog_files(Files, ScriptMode) :- 389 current_prolog_flag(argv, Argv), 390 no_option_files(Argv, Argv1, Files, ScriptMode), 391 ( ( nonvar(ScriptMode) 392 ; Argv1 == [] 393 ) 394 -> ( Argv1 \== Argv 395 -> set_prolog_flag(argv, Argv1) 396 ; true 397 ) 398 ; '$usage', 399 halt(1) 400 ). 401 402no_option_files([--|Argv], Argv, [], ScriptMode) :- 403 !, 404 ( ScriptMode = none 405 -> true 406 ; true 407 ). 408no_option_files([Opt|_], _, _, ScriptMode) :- 409 var(ScriptMode), 410 sub_atom(Opt, 0, _, _, '-'), 411 !, 412 '$usage', 413 halt(1). 414no_option_files([OsFile|Argv0], Argv, [File|T], ScriptMode) :- 415 file_name_extension(_, Ext, OsFile), 416 user:prolog_file_type(Ext, prolog), 417 !, 418 ScriptMode = prolog, 419 prolog_to_os_filename(File, OsFile), 420 no_option_files(Argv0, Argv, T, ScriptMode). 421no_option_files([OsScript|Argv], Argv, [Script], ScriptMode) :- 422 var(ScriptMode), 423 !, 424 prolog_to_os_filename(PlScript, OsScript), 425 ( exists_file(PlScript) 426 -> Script = PlScript, 427 ScriptMode = script 428 ; cli_script(OsScript, Script) 429 -> ScriptMode = app, 430 set_prolog_flag(app_name, OsScript) 431 ; '$existence_error'(file, PlScript) 432 ). 433no_option_files(Argv, Argv, [], ScriptMode) :- 434 ( ScriptMode = none 435 -> true 436 ; true 437 ). 438 439cli_script(CLI, Script) :- 440 ( sub_atom(CLI, Pre, _, Post, ':') 441 -> sub_atom(CLI, 0, Pre, _, SearchPath), 442 sub_atom(CLI, _, Post, 0, Base), 443 Spec =.. [SearchPath, Base] 444 ; Spec = app(CLI) 445 ), 446 absolute_file_name(Spec, Script, 447 [ file_type(prolog), 448 access(exist), 449 file_errors(fail) 450 ]). 451 452clean_argv :- 453 ( current_prolog_flag(argv, [--|Argv]) 454 -> set_prolog_flag(argv, Argv) 455 ; true 456 ).
465win_associated_files(Files) :-
466 ( Files = [File|_]
467 -> absolute_file_name(File, AbsFile),
468 set_prolog_flag(associated_file, AbsFile),
469 set_working_directory(File),
470 set_window_title(Files)
471 ; true
472 ).console_menu,
which is set by swipl-win[.exe].482set_working_directory(File) :- 483 current_prolog_flag(console_menu, true), 484 access_file(File, read), 485 !, 486 file_directory_name(File, Dir), 487 working_directory(_, Dir). 488set_working_directory(_). 489 490set_window_title([File|More]) :- 491 current_predicate(system:window_title/2), 492 !, 493 ( More == [] 494 -> Extra = [] 495 ; Extra = ['...'] 496 ), 497 atomic_list_concat(['SWI-Prolog --', File | Extra], ' ', Title), 498 system:window_title(_, Title). 499set_window_title(_).
--pldoc[=port] is given, load the PlDoc system.506start_pldoc :- 507 '$cmd_option_val'(pldoc_server, Server), 508 ( Server == '' 509 -> call((doc_server(_), doc_browser)) 510 ; catch(atom_number(Server, Port), _, fail) 511 -> call(doc_server(Port)) 512 ; print_message(error, option_usage(pldoc)), 513 halt(1) 514 ). 515start_pldoc.
522load_associated_files(Files) :- 523 ( '$member'(File, Files), 524 load_files(user:File, [expand(false)]), 525 fail 526 ; true 527 ). 528 529hkey('HKEY_CURRENT_USER/Software/SWI/Prolog'). 530hkey('HKEY_LOCAL_MACHINE/Software/SWI/Prolog'). 531 532'$set_prolog_file_extension' :- 533 current_prolog_flag(windows, true), 534 hkey(Key), 535 catch(win_registry_get_value(Key, fileExtension, Ext0), 536 _, fail), 537 !, 538 ( atom_concat('.', Ext, Ext0) 539 -> true 540 ; Ext = Ext0 541 ), 542 ( user:prolog_file_type(Ext, prolog) 543 -> true 544 ; asserta(user:prolog_file_type(Ext, prolog)) 545 ). 546'$set_prolog_file_extension'. 547 548 549 /******************************** 550 * TOPLEVEL GOALS * 551 *********************************/
559'$initialise' :- 560 catch(initialise_prolog, E, initialise_error(E)). 561 562initialise_error('$aborted') :- !. 563initialise_error(E) :- 564 print_message(error, initialization_exception(E)), 565 fail. 566 567initialise_prolog :- 568 '$clean_history', 569 apply_defines, 570 apple_setup_app, % MacOS cwd/locale setup for swipl-win 571 init_optimise, 572 '$run_initialization', 573 argv_prolog_files(Files, ScriptMode), 574 '$load_system_init_file', % -F file 575 set_toplevel, % set `toplevel_goal` flag from -t 576 '$set_file_search_paths', % handle -p alias=dir[:dir]* 577 init_debug_flags, 578 start_pldoc, % handle --pldoc[=port] 579 opt_attach_packs, 580 load_init_file(ScriptMode), % -f file 581 catch(setup_colors, E, print_message(warning, E)), 582 win_associated_files(Files), % swipl-win: cd and update title 583 '$load_script_file', % -s file (may be repeated) 584 load_associated_files(Files), 585 '$cmd_option_val'(goals, Goals), % -g goal (may be repeated) 586 ( ScriptMode == app 587 -> run_program_init, % initialization(Goal, program) 588 run_main_init(true) 589 ; Goals == [], 590 \+ '$init_goal'(when(_), _, _) % no -g or -t or initialization(program) 591 -> version % default interactive run 592 ; run_init_goals(Goals), % run -g goals 593 ( load_only % used -l to load 594 -> version 595 ; run_program_init, % initialization(Goal, program) 596 run_main_init(false) % initialization(Goal, main) 597 ) 598 ). 599 600apply_defines :- 601 '$cmd_option_val'(defines, Defs), 602 apply_defines(Defs). 603 604apply_defines([]). 605apply_defines([H|T]) :- 606 apply_define(H), 607 apply_defines(T). 608 609apply_define(Def) :- 610 sub_atom(Def, B, _, A, '='), 611 !, 612 sub_atom(Def, 0, B, _, Flag), 613 sub_atom(Def, _, A, 0, Value0), 614 ( '$current_prolog_flag'(Flag, Value0, _Scope, Access, Type) 615 -> ( Access \== write 616 -> '$permission_error'(set, prolog_flag, Flag) 617 ; text_flag_value(Type, Value0, Value) 618 ), 619 set_prolog_flag(Flag, Value) 620 ; ( atom_number(Value0, Value) 621 -> true 622 ; Value = Value0 623 ), 624 create_prolog_flag(Flag, Value, [warn_not_accessed]) 625 ). 626apply_define(Def) :- 627 atom_concat('no-', Flag, Def), 628 !, 629 set_user_boolean_flag(Flag, false). 630apply_define(Def) :- 631 set_user_boolean_flag(Def, true). 632 633set_user_boolean_flag(Flag, Value) :- 634 current_prolog_flag(Flag, Old), 635 !, 636 ( Old == Value 637 -> true 638 ; set_prolog_flag(Flag, Value) 639 ). 640set_user_boolean_flag(Flag, Value) :- 641 create_prolog_flag(Flag, Value, [warn_not_accessed]). 642 643text_flag_value(integer, Text, Int) :- 644 atom_number(Text, Int), 645 !. 646text_flag_value(float, Text, Float) :- 647 atom_number(Text, Float), 648 !. 649text_flag_value(term, Text, Term) :- 650 term_string(Term, Text, []), 651 !. 652text_flag_value(_, Value, Value). 653 654:- if(current_prolog_flag(apple,true)). 655apple_set_working_directory :- 656 ( expand_file_name('~', [Dir]), 657 exists_directory(Dir) 658 -> working_directory(_, Dir) 659 ; true 660 ). 661 662apple_set_locale :- 663 ( getenv('LC_CTYPE', 'UTF-8'), 664 apple_current_locale_identifier(LocaleID), 665 atom_concat(LocaleID, '.UTF-8', Locale), 666 catch(setlocale(ctype, _Old, Locale), _, fail) 667 -> setenv('LANG', Locale), 668 unsetenv('LC_CTYPE') 669 ; true 670 ). 671 672apple_setup_app :- 673 current_prolog_flag(apple, true), 674 current_prolog_flag(console_menu, true), % SWI-Prolog.app on MacOS 675 apple_set_working_directory, 676 apple_set_locale. 677:- endif. 678apple_setup_app. 679 680init_optimise :- 681 current_prolog_flag(optimise, true), 682 !, 683 use_module(user:library(apply_macros)). 684init_optimise. 685 686opt_attach_packs :- 687 current_prolog_flag(packs, true), 688 !, 689 attach_packs. 690opt_attach_packs. 691 692set_toplevel :- 693 '$cmd_option_val'(toplevel, TopLevelAtom), 694 catch(term_to_atom(TopLevel, TopLevelAtom), E, 695 (print_message(error, E), 696 halt(1))), 697 create_prolog_flag(toplevel_goal, TopLevel, [type(term)]). 698 699load_only :- 700 current_prolog_flag(os_argv, OSArgv), 701 memberchk('-l', OSArgv), 702 current_prolog_flag(argv, Argv), 703 \+ memberchk('-l', Argv).
710run_init_goals([]). 711run_init_goals([H|T]) :- 712 run_init_goal(H), 713 run_init_goals(T). 714 715run_init_goal(Text) :- 716 catch(term_to_atom(Goal, Text), E, 717 ( print_message(error, init_goal_syntax(E, Text)), 718 halt(2) 719 )), 720 run_init_goal(Goal, Text).
726run_program_init :- 727 forall('$init_goal'(when(program), Goal, Ctx), 728 run_init_goal(Goal, @(Goal,Ctx))). 729 730run_main_init(_) :- 731 findall(Goal-Ctx, '$init_goal'(when(main), Goal, Ctx), Pairs), 732 '$last'(Pairs, Goal-Ctx), 733 !, 734 ( current_prolog_flag(toplevel_goal, default) 735 -> set_prolog_flag(toplevel_goal, halt) 736 ; true 737 ), 738 run_init_goal(Goal, @(Goal,Ctx)). 739run_main_init(true) :- 740 '$existence_error'(initialization, main). 741run_main_init(_). 742 743run_init_goal(Goal, Ctx) :- 744 ( catch_with_backtrace(user:Goal, E, true) 745 -> ( var(E) 746 -> true 747 ; print_message(error, init_goal_failed(E, Ctx)), 748 halt(2) 749 ) 750 ; ( current_prolog_flag(verbose, silent) 751 -> Level = silent 752 ; Level = error 753 ), 754 print_message(Level, init_goal_failed(failed, Ctx)), 755 halt(1) 756 ).
763init_debug_flags :-
764 once(print_predicate(_, [print], PrintOptions)),
765 Keep = [keep(true)],
766 create_prolog_flag(answer_write_options, PrintOptions, Keep),
767 create_prolog_flag(prompt_alternatives_on, determinism, Keep),
768 create_prolog_flag(toplevel_extra_white_line, true, Keep),
769 create_prolog_flag(toplevel_print_factorized, false, Keep),
770 create_prolog_flag(print_write_options,
771 [ portray(true), quoted(true), numbervars(true) ],
772 Keep),
773 create_prolog_flag(toplevel_residue_vars, false, Keep),
774 create_prolog_flag(toplevel_list_wfs_residual_program, true, Keep),
775 '$set_debugger_write_options'(print).
781setup_backtrace :-
782 ( \+ current_prolog_flag(backtrace, false),
783 load_setup_file(library(prolog_stack))
784 -> true
785 ; true
786 ).
792setup_colors :-
793 ( \+ current_prolog_flag(color_term, false),
794 stream_property(user_input, tty(true)),
795 stream_property(user_error, tty(true)),
796 stream_property(user_output, tty(true)),
797 \+ getenv('TERM', dumb),
798 load_setup_file(user:library(ansi_term))
799 -> true
800 ; true
801 ).
807setup_history :-
808 ( \+ current_prolog_flag(save_history, false),
809 stream_property(user_input, tty(true)),
810 \+ current_prolog_flag(readline, false),
811 load_setup_file(library(prolog_history))
812 -> prolog_history(enable)
813 ; true
814 ),
815 set_default_history,
816 '$load_history'.822setup_readline :- 823 ( current_prolog_flag(readline, swipl_win) 824 -> true 825 ; stream_property(user_input, tty(true)), 826 current_prolog_flag(tty_control, true), 827 \+ getenv('TERM', dumb), 828 ( current_prolog_flag(readline, ReadLine) 829 -> true 830 ; ReadLine = true 831 ), 832 readline_library(ReadLine, Library), 833 load_setup_file(library(Library)) 834 -> set_prolog_flag(readline, Library) 835 ; set_prolog_flag(readline, false) 836 ). 837 838readline_library(true, Library) :- 839 !, 840 preferred_readline(Library). 841readline_library(false, _) :- 842 !, 843 fail. 844readline_library(Library, Library). 845 846preferred_readline(editline). 847preferred_readline(readline).
853load_setup_file(File) :- 854 catch(load_files(File, 855 [ silent(true), 856 if(not_loaded) 857 ]), _, fail). 858 859 860:- '$hide'('$toplevel'/0). % avoid in the GUI stacktrace
866'$toplevel' :-
867 '$runtoplevel',
868 print_message(informational, halt).default and prolog both
start the interactive toplevel, where prolog implies the user gave
-t prolog.
878'$runtoplevel' :- 879 current_prolog_flag(toplevel_goal, TopLevel0), 880 toplevel_goal(TopLevel0, TopLevel), 881 user:TopLevel. 882 883:- dynamic setup_done/0. 884:- volatile setup_done/0. 885 886toplevel_goal(default, '$query_loop') :- 887 !, 888 setup_interactive. 889toplevel_goal(prolog, '$query_loop') :- 890 !, 891 setup_interactive. 892toplevel_goal(Goal, Goal). 893 894setup_interactive :- 895 setup_done, 896 !. 897setup_interactive :- 898 asserta(setup_done), 899 catch(setup_backtrace, E, print_message(warning, E)), 900 catch(setup_readline, E, print_message(warning, E)), 901 catch(setup_history, E, print_message(warning, E)).
907'$compile' :- 908 ( catch('$compile_', E, (print_message(error, E), halt(1))) 909 -> true 910 ; print_message(error, error(goal_failed('$compile'), _)), 911 halt(1) 912 ), 913 halt. % set exit code 914 915'$compile_' :- 916 '$load_system_init_file', 917 catch(setup_colors, _, true), 918 '$set_file_search_paths', 919 init_debug_flags, 920 '$run_initialization', 921 opt_attach_packs, 922 use_module(library(qsave)), 923 qsave:qsave_toplevel.
929'$config' :- 930 '$load_system_init_file', 931 '$set_file_search_paths', 932 init_debug_flags, 933 '$run_initialization', 934 load_files(library(prolog_config)), 935 ( catch(prolog_dump_runtime_variables, E, 936 (print_message(error, E), halt(1))) 937 -> true 938 ; print_message(error, error(goal_failed(prolog_dump_runtime_variables),_)) 939 ). 940 941 942 /******************************** 943 * USER INTERACTIVE LOOP * 944 *********************************/
952prolog :- 953 break. 954 955:- create_prolog_flag(toplevel_mode, backtracking, []).
query_loop(). This ensures that unhandled
exceptions are really unhandled (in Prolog).964'$query_loop' :- 965 current_prolog_flag(toplevel_mode, recursive), 966 !, 967 break_level(Level), 968 read_expanded_query(Level, Query, Bindings), 969 ( Query == end_of_file 970 -> print_message(query, query(eof)) 971 ; '$call_no_catch'('$execute_query'(Query, Bindings, _)), 972 ( current_prolog_flag(toplevel_mode, recursive) 973 -> '$query_loop' 974 ; '$switch_toplevel_mode'(backtracking), 975 '$query_loop' % Maybe throw('$switch_toplevel_mode')? 976 ) 977 ). 978'$query_loop' :- 979 break_level(BreakLev), 980 repeat, 981 read_expanded_query(BreakLev, Query, Bindings), 982 ( Query == end_of_file 983 -> !, print_message(query, query(eof)) 984 ; '$execute_query'(Query, Bindings, _), 985 ( current_prolog_flag(toplevel_mode, recursive) 986 -> !, 987 '$switch_toplevel_mode'(recursive), 988 '$query_loop' 989 ; fail 990 ) 991 ). 992 993break_level(BreakLev) :- 994 ( current_prolog_flag(break_level, BreakLev) 995 -> true 996 ; BreakLev = -1 997 ). 998 999read_expanded_query(BreakLev, ExpandedQuery, ExpandedBindings) :- 1000 '$current_typein_module'(TypeIn), 1001 ( stream_property(user_input, tty(true)) 1002 -> '$system_prompt'(TypeIn, BreakLev, Prompt), 1003 prompt(Old, '| ') 1004 ; Prompt = '', 1005 prompt(Old, '') 1006 ), 1007 trim_stacks, 1008 trim_heap, 1009 repeat, 1010 read_query(Prompt, Query, Bindings), 1011 prompt(_, Old), 1012 catch(call_expand_query(Query, ExpandedQuery, 1013 Bindings, ExpandedBindings), 1014 Error, 1015 (print_message(error, Error), fail)), 1016 !.
1025:- if(current_prolog_flag(emscripten, true)). 1026read_query(_Prompt, Goal, Bindings) :- 1027 '$can_yield', 1028 !, 1029 await(goal, GoalString), 1030 term_string(Goal, GoalString, [variable_names(Bindings)]). 1031:- endif. 1032read_query(Prompt, Goal, Bindings) :- 1033 current_prolog_flag(history, N), 1034 integer(N), N > 0, 1035 !, 1036 read_term_with_history( 1037 Goal, 1038 [ show(h), 1039 help('!h'), 1040 no_save([trace, end_of_file]), 1041 prompt(Prompt), 1042 variable_names(Bindings) 1043 ]). 1044read_query(Prompt, Goal, Bindings) :- 1045 remove_history_prompt(Prompt, Prompt1), 1046 repeat, % over syntax errors 1047 prompt1(Prompt1), 1048 read_query_line(user_input, Line), 1049 '$save_history_line'(Line), % save raw line (edit syntax errors) 1050 '$current_typein_module'(TypeIn), 1051 catch(read_term_from_atom(Line, Goal, 1052 [ variable_names(Bindings), 1053 module(TypeIn) 1054 ]), E, 1055 ( print_message(error, E), 1056 fail 1057 )), 1058 !, 1059 '$save_history_event'(Line). % save event (no syntax errors)
1063read_query_line(Input, Line) :- 1064 stream_property(Input, error(true)), 1065 !, 1066 Line = end_of_file. 1067read_query_line(Input, Line) :- 1068 catch(read_term_as_atom(Input, Line), Error, true), 1069 save_debug_after_read, 1070 ( var(Error) 1071 -> true 1072 ; catch(print_message(error, Error), _, true), 1073 ( Error = error(syntax_error(_),_) 1074 -> fail 1075 ; throw(Error) 1076 ) 1077 ).
1084read_term_as_atom(In, Line) :-
1085 '$raw_read'(In, Line),
1086 ( Line == end_of_file
1087 -> true
1088 ; skip_to_nl(In)
1089 ).1096skip_to_nl(In) :- 1097 repeat, 1098 peek_char(In, C), 1099 ( C == '%' 1100 -> skip(In, '\n') 1101 ; char_type(C, space) 1102 -> get_char(In, _), 1103 C == '\n' 1104 ; true 1105 ), 1106 !. 1107 1108remove_history_prompt('', '') :- !. 1109remove_history_prompt(Prompt0, Prompt) :- 1110 atom_chars(Prompt0, Chars0), 1111 clean_history_prompt_chars(Chars0, Chars1), 1112 delete_leading_blanks(Chars1, Chars), 1113 atom_chars(Prompt, Chars). 1114 1115clean_history_prompt_chars([], []). 1116clean_history_prompt_chars(['~', !|T], T) :- !. 1117clean_history_prompt_chars([H|T0], [H|T]) :- 1118 clean_history_prompt_chars(T0, T). 1119 1120delete_leading_blanks([' '|T0], T) :- 1121 !, 1122 delete_leading_blanks(T0, T). 1123delete_leading_blanks(L, L).
1132set_default_history :- 1133 current_prolog_flag(history, _), 1134 !. 1135set_default_history :- 1136 ( ( \+ current_prolog_flag(readline, false) 1137 ; current_prolog_flag(emacs_inferior_process, true) 1138 ) 1139 -> create_prolog_flag(history, 0, []) 1140 ; create_prolog_flag(history, 25, []) 1141 ). 1142 1143 1144 /******************************* 1145 * TOPLEVEL DEBUG * 1146 *******************************/
thread_signal(main, gdebug)
1161save_debug_after_read :- 1162 current_prolog_flag(debug, true), 1163 !, 1164 save_debug. 1165save_debug_after_read. 1166 1167save_debug :- 1168 ( tracing, 1169 notrace 1170 -> Tracing = true 1171 ; Tracing = false 1172 ), 1173 current_prolog_flag(debug, Debugging), 1174 set_prolog_flag(debug, false), 1175 create_prolog_flag(query_debug_settings, 1176 debug(Debugging, Tracing), []). 1177 1178restore_debug :- 1179 current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)), 1180 set_prolog_flag(debug, Debugging), 1181 ( Tracing == true 1182 -> trace 1183 ; true 1184 ). 1185 1186:- initialization 1187 create_prolog_flag(query_debug_settings, debug(false, false), []). 1188 1189 1190 /******************************** 1191 * PROMPTING * 1192 ********************************/ 1193 1194'$system_prompt'(Module, BrekLev, Prompt) :- 1195 current_prolog_flag(toplevel_prompt, PAtom), 1196 atom_codes(PAtom, P0), 1197 ( Module \== user 1198 -> '$substitute'('~m', [Module, ': '], P0, P1) 1199 ; '$substitute'('~m', [], P0, P1) 1200 ), 1201 ( BrekLev > 0 1202 -> '$substitute'('~l', ['[', BrekLev, '] '], P1, P2) 1203 ; '$substitute'('~l', [], P1, P2) 1204 ), 1205 current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)), 1206 ( Tracing == true 1207 -> '$substitute'('~d', ['[trace] '], P2, P3) 1208 ; Debugging == true 1209 -> '$substitute'('~d', ['[debug] '], P2, P3) 1210 ; '$substitute'('~d', [], P2, P3) 1211 ), 1212 atom_chars(Prompt, P3). 1213 1214'$substitute'(From, T, Old, New) :- 1215 atom_codes(From, FromCodes), 1216 phrase(subst_chars(T), T0), 1217 '$append'(Pre, S0, Old), 1218 '$append'(FromCodes, Post, S0) -> 1219 '$append'(Pre, T0, S1), 1220 '$append'(S1, Post, New), 1221 !. 1222'$substitute'(_, _, Old, Old). 1223 1224subst_chars([]) --> 1225 []. 1226subst_chars([H|T]) --> 1227 { atomic(H), 1228 !, 1229 atom_codes(H, Codes) 1230 }, 1231 , 1232 subst_chars(T). 1233subst_chars([H|T]) --> 1234 , 1235 subst_chars(T). 1236 1237 1238 /******************************** 1239 * EXECUTION * 1240 ********************************/
1246'$execute_query'(Var, _, true) :- 1247 var(Var), 1248 !, 1249 print_message(informational, var_query(Var)). 1250'$execute_query'(Goal, Bindings, Truth) :- 1251 '$current_typein_module'(TypeIn), 1252 '$dwim_correct_goal'(TypeIn:Goal, Bindings, Corrected), 1253 !, 1254 setup_call_cleanup( 1255 '$set_source_module'(M0, TypeIn), 1256 expand_goal(Corrected, Expanded), 1257 '$set_source_module'(M0)), 1258 print_message(silent, toplevel_goal(Expanded, Bindings)), 1259 '$execute_goal2'(Expanded, Bindings, Truth). 1260'$execute_query'(_, _, false) :- 1261 notrace, 1262 print_message(query, query(no)). 1263 1264'$execute_goal2'(Goal, Bindings, true) :- 1265 restore_debug, 1266 '$current_typein_module'(TypeIn), 1267 residue_vars(TypeIn:Goal, Vars, TypeIn:Delays, Chp), 1268 deterministic(Det), 1269 ( save_debug 1270 ; restore_debug, fail 1271 ), 1272 flush_output(user_output), 1273 ( Det == true 1274 -> DetOrChp = true 1275 ; DetOrChp = Chp 1276 ), 1277 call_expand_answer(Bindings, NewBindings), 1278 ( \+ \+ write_bindings(NewBindings, Vars, Delays, DetOrChp) 1279 -> ! 1280 ). 1281'$execute_goal2'(_, _, false) :- 1282 save_debug, 1283 print_message(query, query(no)). 1284 1285residue_vars(Goal, Vars, Delays, Chp) :- 1286 current_prolog_flag(toplevel_residue_vars, true), 1287 !, 1288 '$wfs_call'(call_residue_vars(stop_backtrace(Goal, Chp), Vars), Delays). 1289residue_vars(Goal, [], Delays, Chp) :- 1290 '$wfs_call'(stop_backtrace(Goal, Chp), Delays). 1291 1292stop_backtrace(Goal, Chp) :- 1293 toplevel_call(Goal), 1294 prolog_current_choice(Chp). 1295 1296toplevel_call(Goal) :- 1297 call(Goal), 1298 no_lco. 1299 1300no_lco.
groundness gives the classical behaviour,
determinism is considered more adequate and informative.
Succeeds if the user accepts the answer and fails otherwise.
1316write_bindings(Bindings, ResidueVars, Delays, DetOrChp) :- 1317 '$current_typein_module'(TypeIn), 1318 translate_bindings(Bindings, Bindings1, ResidueVars, TypeIn:Residuals), 1319 omit_qualifier(Delays, TypeIn, Delays1), 1320 name_vars(Bindings1, Residuals, Delays1), 1321 write_bindings2(Bindings1, Residuals, Delays1, DetOrChp). 1322 1323write_bindings2([], Residuals, Delays, _) :- 1324 current_prolog_flag(prompt_alternatives_on, groundness), 1325 !, 1326 print_message(query, query(yes(Delays, Residuals))). 1327write_bindings2(Bindings, Residuals, Delays, true) :- 1328 current_prolog_flag(prompt_alternatives_on, determinism), 1329 !, 1330 print_message(query, query(yes(Bindings, Delays, Residuals))). 1331write_bindings2(Bindings, Residuals, Delays, Chp) :- 1332 repeat, 1333 print_message(query, query(more(Bindings, Delays, Residuals))), 1334 get_respons(Action, Chp), 1335 ( Action == redo 1336 -> !, fail 1337 ; Action == show_again 1338 -> fail 1339 ; !, 1340 print_message(query, query(done)) 1341 ). 1342 1343name_vars(Bindings, Residuals, Delays) :- 1344 current_prolog_flag(toplevel_name_variables, true), 1345 !, 1346 '$term_multitons'(t(Bindings,Residuals,Delays), Vars), 1347 name_vars_(Vars, Bindings, 0), 1348 term_variables(t(Bindings,Residuals,Delays), SVars), 1349 anon_vars(SVars). 1350name_vars(_Bindings, _Residuals, _Delays). 1351 1352name_vars_([], _, _). 1353name_vars_([H|T], Bindings, N) :- 1354 name_var(Bindings, Name, N, N1), 1355 H = '$VAR'(Name), 1356 name_vars_(T, Bindings, N1). 1357 1358anon_vars([]). 1359anon_vars(['$VAR'('_')|T]) :- 1360 anon_vars(T). 1361 1362name_var(Bindings, Name, N0, N) :- 1363 between(N0, infinite, N1), 1364 I is N1//26, 1365 J is 0'A + N1 mod 26, 1366 ( I == 0 1367 -> format(atom(Name), '_~c', [J]) 1368 ; format(atom(Name), '_~c~d', [J, I]) 1369 ), 1370 ( current_prolog_flag(toplevel_print_anon, false) 1371 -> true 1372 ; \+ is_bound(Bindings, Name) 1373 ), 1374 !, 1375 N is N1+1. 1376 1377is_bound([Vars=_|T], Name) :- 1378 ( in_vars(Vars, Name) 1379 -> true 1380 ; is_bound(T, Name) 1381 ). 1382 1383in_vars(Name, Name) :- !. 1384in_vars(Names, Name) :- 1385 '$member'(Name, Names).
1392:- multifile 1393 residual_goal_collector/1. 1394 1395:- meta_predicate 1396 residual_goals(). 1397 1398residual_goals(NonTerminal) :- 1399 throw(error(context_error(nodirective, residual_goals(NonTerminal)), _)). 1400 1401systemterm_expansion((:- residual_goals(NonTerminal)), 1402 '$toplevel':residual_goal_collector(M2:Head)) :- 1403 \+ current_prolog_flag(xref, true), 1404 prolog_load_context(module, M), 1405 strip_module(M:NonTerminal, M2, Head), 1406 '$must_be'(callable, Head).
1413:- public prolog:residual_goals//0. 1414 1415prolog:residual_goals --> 1416 { findall(NT, residual_goal_collector(NT), NTL) }, 1417 collect_residual_goals(NTL). 1418 1419collect_residual_goals([]) --> []. 1420collect_residual_goals([H|T]) --> 1421 ( call(H) -> [] ; [] ), 1422 collect_residual_goals(T).
1447:- public 1448 prolog:translate_bindings/5. 1449:- meta_predicate 1450 prolog:translate_bindings(, , , , ). 1451 1452prologtranslate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals) :- 1453 translate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals). 1454 1455translate_bindings(Bindings0, Bindings, ResidueVars, Residuals) :- 1456 prolog:residual_goals(ResidueGoals, []), 1457 translate_bindings(Bindings0, Bindings, ResidueVars, ResidueGoals, 1458 Residuals). 1459 1460translate_bindings(Bindings0, Bindings, [], [], _:[]-[]) :- 1461 term_attvars(Bindings0, []), 1462 !, 1463 join_same_bindings(Bindings0, Bindings1), 1464 factorize_bindings(Bindings1, Bindings2), 1465 bind_vars(Bindings2, Bindings3), 1466 filter_bindings(Bindings3, Bindings). 1467translate_bindings(Bindings0, Bindings, ResidueVars, ResGoals0, 1468 TypeIn:Residuals-HiddenResiduals) :- 1469 project_constraints(Bindings0, ResidueVars), 1470 hidden_residuals(ResidueVars, Bindings0, HiddenResiduals0), 1471 omit_qualifiers(HiddenResiduals0, TypeIn, HiddenResiduals), 1472 copy_term(Bindings0+ResGoals0, Bindings1+ResGoals1, Residuals0), 1473 '$append'(ResGoals1, Residuals0, Residuals1), 1474 omit_qualifiers(Residuals1, TypeIn, Residuals), 1475 join_same_bindings(Bindings1, Bindings2), 1476 factorize_bindings(Bindings2, Bindings3), 1477 bind_vars(Bindings3, Bindings4), 1478 filter_bindings(Bindings4, Bindings). 1479 (ResidueVars, Bindings, Goal) :- 1481 term_attvars(ResidueVars, Remaining), 1482 term_attvars(Bindings, QueryVars), 1483 subtract_vars(Remaining, QueryVars, HiddenVars), 1484 copy_term(HiddenVars, _, Goal). 1485 1486subtract_vars(All, Subtract, Remaining) :- 1487 sort(All, AllSorted), 1488 sort(Subtract, SubtractSorted), 1489 ord_subtract(AllSorted, SubtractSorted, Remaining). 1490 1491ord_subtract([], _Not, []). 1492ord_subtract([H1|T1], L2, Diff) :- 1493 diff21(L2, H1, T1, Diff). 1494 1495diff21([], H1, T1, [H1|T1]). 1496diff21([H2|T2], H1, T1, Diff) :- 1497 compare(Order, H1, H2), 1498 diff3(Order, H1, T1, H2, T2, Diff). 1499 1500diff12([], _H2, _T2, []). 1501diff12([H1|T1], H2, T2, Diff) :- 1502 compare(Order, H1, H2), 1503 diff3(Order, H1, T1, H2, T2, Diff). 1504 1505diff3(<, H1, T1, H2, T2, [H1|Diff]) :- 1506 diff12(T1, H2, T2, Diff). 1507diff3(=, _H1, T1, _H2, T2, Diff) :- 1508 ord_subtract(T1, T2, Diff). 1509diff3(>, H1, T1, _H2, T2, Diff) :- 1510 diff21(T2, H1, T1, Diff).
toplevel_residue_vars is set to project.1518project_constraints(Bindings, ResidueVars) :- 1519 !, 1520 term_attvars(Bindings, AttVars), 1521 phrase(attribute_modules(AttVars), Modules0), 1522 sort(Modules0, Modules), 1523 term_variables(Bindings, QueryVars), 1524 project_attributes(Modules, QueryVars, ResidueVars). 1525project_constraints(_, _). 1526 1527project_attributes([], _, _). 1528project_attributes([M|T], QueryVars, ResidueVars) :- 1529 ( current_predicate(M:project_attributes/2), 1530 catch(M:project_attributes(QueryVars, ResidueVars), E, 1531 print_message(error, E)) 1532 -> true 1533 ; true 1534 ), 1535 project_attributes(T, QueryVars, ResidueVars). 1536 1537attribute_modules([]) --> []. 1538attribute_modules([H|T]) --> 1539 { get_attrs(H, Attrs) }, 1540 attrs_modules(Attrs), 1541 attribute_modules(T). 1542 1543attrs_modules([]) --> []. 1544attrs_modules(att(Module, _, More)) --> 1545 [Module], 1546 attrs_modules(More).
1557join_same_bindings([], []). 1558join_same_bindings([Name=V0|T0], [[Name|Names]=V|T]) :- 1559 take_same_bindings(T0, V0, V, Names, T1), 1560 join_same_bindings(T1, T). 1561 1562take_same_bindings([], Val, Val, [], []). 1563take_same_bindings([Name=V1|T0], V0, V, [Name|Names], T) :- 1564 V0 == V1, 1565 !, 1566 take_same_bindings(T0, V1, V, Names, T). 1567take_same_bindings([Pair|T0], V0, V, Names, [Pair|T]) :- 1568 take_same_bindings(T0, V0, V, Names, T).
1577omit_qualifiers([], _, []). 1578omit_qualifiers([Goal0|Goals0], TypeIn, [Goal|Goals]) :- 1579 omit_qualifier(Goal0, TypeIn, Goal), 1580 omit_qualifiers(Goals0, TypeIn, Goals). 1581 1582omit_qualifier(M:G0, TypeIn, G) :- 1583 M == TypeIn, 1584 !, 1585 omit_meta_qualifiers(G0, TypeIn, G). 1586omit_qualifier(M:G0, TypeIn, G) :- 1587 predicate_property(TypeIn:G0, imported_from(M)), 1588 \+ predicate_property(G0, transparent), 1589 !, 1590 G0 = G. 1591omit_qualifier(_:G0, _, G) :- 1592 predicate_property(G0, built_in), 1593 \+ predicate_property(G0, transparent), 1594 !, 1595 G0 = G. 1596omit_qualifier(M:G0, _, M:G) :- 1597 atom(M), 1598 !, 1599 omit_meta_qualifiers(G0, M, G). 1600omit_qualifier(G0, TypeIn, G) :- 1601 omit_meta_qualifiers(G0, TypeIn, G). 1602 1603omit_meta_qualifiers(V, _, V) :- 1604 var(V), 1605 !. 1606omit_meta_qualifiers((QA,QB), TypeIn, (A,B)) :- 1607 !, 1608 omit_qualifier(QA, TypeIn, A), 1609 omit_qualifier(QB, TypeIn, B). 1610omit_meta_qualifiers(tnot(QA), TypeIn, tnot(A)) :- 1611 !, 1612 omit_qualifier(QA, TypeIn, A). 1613omit_meta_qualifiers(freeze(V, QGoal), TypeIn, freeze(V, Goal)) :- 1614 callable(QGoal), 1615 !, 1616 omit_qualifier(QGoal, TypeIn, Goal). 1617omit_meta_qualifiers(when(Cond, QGoal), TypeIn, when(Cond, Goal)) :- 1618 callable(QGoal), 1619 !, 1620 omit_qualifier(QGoal, TypeIn, Goal). 1621omit_meta_qualifiers(G, _, G).
1630bind_vars(Bindings0, Bindings) :- 1631 bind_query_vars(Bindings0, Bindings, SNames), 1632 bind_skel_vars(Bindings, Bindings, SNames, 1, _). 1633 1634bind_query_vars([], [], []). 1635bind_query_vars([binding(Names,Var,[Var2=Cycle])|T0], 1636 [binding(Names,Cycle,[])|T], [Name|SNames]) :- 1637 Var == Var2, % also implies var(Var) 1638 !, 1639 '$last'(Names, Name), 1640 Var = '$VAR'(Name), 1641 bind_query_vars(T0, T, SNames). 1642bind_query_vars([B|T0], [B|T], AllNames) :- 1643 B = binding(Names,Var,Skel), 1644 bind_query_vars(T0, T, SNames), 1645 ( var(Var), \+ attvar(Var), Skel == [] 1646 -> AllNames = [Name|SNames], 1647 '$last'(Names, Name), 1648 Var = '$VAR'(Name) 1649 ; AllNames = SNames 1650 ). 1651 1652 1653 1654bind_skel_vars([], _, _, N, N). 1655bind_skel_vars([binding(_,_,Skel)|T], Bindings, SNames, N0, N) :- 1656 bind_one_skel_vars(Skel, Bindings, SNames, N0, N1), 1657 bind_skel_vars(T, Bindings, SNames, N1, N).
1676bind_one_skel_vars([], _, _, N, N). 1677bind_one_skel_vars([Var=Value|T], Bindings, Names, N0, N) :- 1678 ( var(Var) 1679 -> ( '$member'(binding(Names, VVal, []), Bindings), 1680 same_term(Value, VVal) 1681 -> '$last'(Names, VName), 1682 Var = '$VAR'(VName), 1683 N2 = N0 1684 ; between(N0, infinite, N1), 1685 atom_concat('_S', N1, Name), 1686 \+ memberchk(Name, Names), 1687 !, 1688 Var = '$VAR'(Name), 1689 N2 is N1 + 1 1690 ) 1691 ; N2 = N0 1692 ), 1693 bind_one_skel_vars(T, Bindings, Names, N2, N).
1700factorize_bindings([], []). 1701factorize_bindings([Name=Value|T0], [binding(Name, Skel, Subst)|T]) :- 1702 '$factorize_term'(Value, Skel, Subst0), 1703 ( current_prolog_flag(toplevel_print_factorized, true) 1704 -> Subst = Subst0 1705 ; only_cycles(Subst0, Subst) 1706 ), 1707 factorize_bindings(T0, T). 1708 1709 1710only_cycles([], []). 1711only_cycles([B|T0], List) :- 1712 ( B = (Var=Value), 1713 Var = Value, 1714 acyclic_term(Var) 1715 -> only_cycles(T0, List) 1716 ; List = [B|T], 1717 only_cycles(T0, T) 1718 ).
1727filter_bindings([], []). 1728filter_bindings([H0|T0], T) :- 1729 hide_vars(H0, H), 1730 ( ( arg(1, H, []) 1731 ; self_bounded(H) 1732 ) 1733 -> filter_bindings(T0, T) 1734 ; T = [H|T1], 1735 filter_bindings(T0, T1) 1736 ). 1737 1738hide_vars(binding(Names0, Skel, Subst), binding(Names, Skel, Subst)) :- 1739 hide_names(Names0, Skel, Subst, Names). 1740 1741hide_names([], _, _, []). 1742hide_names([Name|T0], Skel, Subst, T) :- 1743 ( sub_atom(Name, 0, _, _, '_'), 1744 current_prolog_flag(toplevel_print_anon, false), 1745 sub_atom(Name, 1, 1, _, Next), 1746 char_type(Next, prolog_var_start) 1747 -> true 1748 ; Subst == [], 1749 Skel == '$VAR'(Name) 1750 ), 1751 !, 1752 hide_names(T0, Skel, Subst, T). 1753hide_names([Name|T0], Skel, Subst, [Name|T]) :- 1754 hide_names(T0, Skel, Subst, T). 1755 1756self_bounded(binding([Name], Value, [])) :- 1757 Value == '$VAR'(Name).
1763:- if(current_prolog_flag(emscripten, true)). 1764get_respons(Action, _Chp) :- 1765 '$can_yield', 1766 !, 1767 await(more, ActionS), 1768 atom_string(Action, ActionS). 1769:- endif. 1770get_respons(Action, Chp) :- 1771 repeat, 1772 flush_output(user_output), 1773 get_single_char(Char), 1774 answer_respons(Char, Chp, Action), 1775 ( Action == again 1776 -> print_message(query, query(action)), 1777 fail 1778 ; ! 1779 ). 1780 1781answer_respons(Char, _, again) :- 1782 '$in_reply'(Char, '?h'), 1783 !, 1784 print_message(help, query(help)). 1785answer_respons(Char, _, redo) :- 1786 '$in_reply'(Char, ';nrNR \t'), 1787 !, 1788 print_message(query, if_tty([ansi(bold, ';', [])])). 1789answer_respons(Char, _, redo) :- 1790 '$in_reply'(Char, 'tT'), 1791 !, 1792 trace, 1793 save_debug, 1794 print_message(query, if_tty([ansi(bold, '; [trace]', [])])). 1795answer_respons(Char, _, continue) :- 1796 '$in_reply'(Char, 'ca\n\ryY.'), 1797 !, 1798 print_message(query, if_tty([ansi(bold, '.', [])])). 1799answer_respons(0'b, _, show_again) :- 1800 !, 1801 break. 1802answer_respons(0'*, Chp, show_again) :- 1803 !, 1804 print_last_chpoint(Chp). 1805answer_respons(Char, _, show_again) :- 1806 print_predicate(Char, Pred, Options), 1807 !, 1808 print_message(query, if_tty(['~w'-[Pred]])), 1809 set_prolog_flag(answer_write_options, Options). 1810answer_respons(-1, _, show_again) :- 1811 !, 1812 print_message(query, halt('EOF')), 1813 halt(0). 1814answer_respons(Char, _, again) :- 1815 print_message(query, no_action(Char)). 1816 1817print_predicate(0'w, [write], [ quoted(true), 1818 spacing(next_argument) 1819 ]). 1820print_predicate(0'p, [print], [ quoted(true), 1821 portray(true), 1822 max_depth(10), 1823 spacing(next_argument) 1824 ]). 1825 1826 1827print_last_chpoint(Chp) :- 1828 current_predicate(print_last_choice_point/0), 1829 !, 1830 print_last_chpoint_(Chp). 1831print_last_chpoint(Chp) :- 1832 use_module(library(prolog_stack), [print_last_choicepoint/2]), 1833 print_last_chpoint_(Chp). 1834 1835print_last_chpoint_(Chp) :- 1836 print_last_choicepoint(Chp, [message_level(information)]). 1837 1838 1839 /******************************* 1840 * EXPANSION * 1841 *******************************/ 1842 1843:- user:dynamic(expand_query/4). 1844:- user:multifile(expand_query/4). 1845 1846call_expand_query(Goal, Expanded, Bindings, ExpandedBindings) :- 1847 user:expand_query(Goal, Expanded, Bindings, ExpandedBindings), 1848 !. 1849call_expand_query(Goal, Expanded, Bindings, ExpandedBindings) :- 1850 toplevel_variables:expand_query(Goal, Expanded, Bindings, ExpandedBindings), 1851 !. 1852call_expand_query(Goal, Goal, Bindings, Bindings). 1853 1854 1855:- user:dynamic(expand_answer/2). 1856:- user:multifile(expand_answer/2). 1857 1858call_expand_answer(Goal, Expanded) :- 1859 user:expand_answer(Goal, Expanded), 1860 !. 1861call_expand_answer(Goal, Expanded) :- 1862 toplevel_variables:expand_answer(Goal, Expanded), 1863 !. 1864call_expand_answer(Goal, Goal)