1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 1985-2025, University of Amsterdam 7 VU University Amsterdam 8 SWI-Prolog Solutions b.v. 9 All rights reserved. 10 11 Redistribution and use in source and binary forms, with or without 12 modification, are permitted provided that the following conditions 13 are met: 14 15 1. Redistributions of source code must retain the above copyright 16 notice, this list of conditions and the following disclaimer. 17 18 2. Redistributions in binary form must reproduce the above copyright 19 notice, this list of conditions and the following disclaimer in 20 the documentation and/or other materials provided with the 21 distribution. 22 23 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 24 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 25 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 26 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 27 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 28 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 29 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 30 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 31 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 32 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 33 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 34 POSSIBILITY OF SUCH DAMAGE. 35*/ 36 37:- module('$toplevel', 38 [ '$initialise'/0, % start Prolog 39 '$toplevel'/0, % Prolog top-level (re-entrant) 40 '$compile'/0, % `-c' toplevel 41 '$config'/0, % --dump-runtime-variables toplevel 42 initialize/0, % Run program initialization 43 version/0, % Write initial banner 44 version/1, % Add message to the banner 45 prolog/0, % user toplevel predicate 46 '$query_loop'/0, % toplevel predicate 47 '$execute_query'/3, % +Query, +Bindings, -Truth 48 residual_goals/1, % +Callable 49 (initialization)/1, % initialization goal (directive) 50 '$thread_init'/0, % initialise thread 51 (thread_initialization)/1 % thread initialization goal 52 ]). 53 54 55 /******************************* 56 * VERSION BANNER * 57 *******************************/ 58 59:- dynamic prolog:version_msg/1. 60:- multifile prolog:version_msg/1.
67version :-
68 print_message(banner, welcome).74:- multifile 75 system:term_expansion/2. 76 77systemterm_expansion((:- version(Message)), 78 prolog:version_msg(Message)). 79 80version(Message) :- 81 ( prolog:version_msg(Message) 82 -> true 83 ; assertz(prolog:version_msg(Message)) 84 ). 85 86 87 /******************************** 88 * INITIALISATION * 89 *********************************/
swipl -f
file or simply using swipl. In the first case we search the
file both directly and over the alias user_app_config. In the
latter case we only use the alias.98load_init_file(_) :- 99 '$cmd_option_val'(init_file, OsFile), 100 !, 101 prolog_to_os_filename(File, OsFile), 102 load_init_file(File, explicit). 103load_init_file(prolog) :- 104 !, 105 load_init_file('init.pl', implicit). 106load_init_file(none) :- 107 !, 108 load_init_file('init.pl', implicit). 109load_init_file(_).
115:- dynamic 116 loaded_init_file/2. % already loaded init files 117 118load_init_file(none, _) :- !. 119load_init_file(Base, _) :- 120 loaded_init_file(Base, _), 121 !. 122load_init_file(InitFile, explicit) :- 123 exists_file(InitFile), 124 !, 125 ensure_loaded(user:InitFile). 126load_init_file(Base, _) :- 127 absolute_file_name(user_app_config(Base), InitFile, 128 [ access(read), 129 file_errors(fail) 130 ]), 131 !, 132 asserta(loaded_init_file(Base, InitFile)), 133 load_files(user:InitFile, 134 [ scope_settings(false) 135 ]). 136load_init_file('init.pl', implicit) :- 137 ( current_prolog_flag(windows, true), 138 absolute_file_name(user_profile('swipl.ini'), InitFile, 139 [ access(read), 140 file_errors(fail) 141 ]) 142 ; expand_file_name('~/.swiplrc', [InitFile]), 143 exists_file(InitFile) 144 ), 145 !, 146 print_message(warning, backcomp(init_file_moved(InitFile))). 147load_init_file(_, _). 148 149'$load_system_init_file' :- 150 loaded_init_file(system, _), 151 !. 152'$load_system_init_file' :- 153 '$cmd_option_val'(system_init_file, Base), 154 Base \== none, 155 current_prolog_flag(home, Home), 156 file_name_extension(Base, rc, Name), 157 atomic_list_concat([Home, '/', Name], File), 158 absolute_file_name(File, Path, 159 [ file_type(prolog), 160 access(read), 161 file_errors(fail) 162 ]), 163 asserta(loaded_init_file(system, Path)), 164 load_files(user:Path, 165 [ silent(true), 166 scope_settings(false) 167 ]), 168 !. 169'$load_system_init_file'. 170 171'$load_script_file' :- 172 loaded_init_file(script, _), 173 !. 174'$load_script_file' :- 175 '$cmd_option_val'(script_file, OsFiles), 176 load_script_files(OsFiles). 177 178load_script_files([]). 179load_script_files([OsFile|More]) :- 180 prolog_to_os_filename(File, OsFile), 181 ( absolute_file_name(File, Path, 182 [ file_type(prolog), 183 access(read), 184 file_errors(fail) 185 ]) 186 -> asserta(loaded_init_file(script, Path)), 187 load_files(user:Path), 188 load_files(user:More) 189 ; throw(error(existence_error(script_file, File), _)) 190 ). 191 192 193 /******************************* 194 * AT_INITIALISATION * 195 *******************************/ 196 197:- meta_predicate 198 initialization(). 199 200:- '$iso'((initialization)/1).
209initialization(Goal) :- 210 Goal = _:G, 211 prolog:initialize_now(G, Use), 212 !, 213 print_message(warning, initialize_now(G, Use)), 214 initialization(Goal, now). 215initialization(Goal) :- 216 initialization(Goal, after_load). 217 218:- multifile 219 prolog:initialize_now/2, 220 prolog:message//1. 221 222prologinitialize_now(load_foreign_library(_), 223 'use :- use_foreign_library/1 instead'). 224prologinitialize_now(load_foreign_library(_,_), 225 'use :- use_foreign_library/2 instead'). 226 227prologmessage(initialize_now(Goal, Use)) --> 228 [ 'Initialization goal ~p will be executed'-[Goal],nl, 229 'immediately for backward compatibility reasons', nl, 230 '~w'-[Use] 231 ]. 232 233'$run_initialization' :- 234 '$set_prolog_file_extension', 235 '$run_initialization'(_, []), 236 '$thread_init'.
:- initialization(Goal, program).. Stop
with an exception if a goal fails or raises an exception.243initialize :- 244 forall('$init_goal'(when(program), Goal, Ctx), 245 run_initialize(Goal, Ctx)). 246 247run_initialize(Goal, Ctx) :- 248 ( catch(Goal, E, true), 249 ( var(E) 250 -> true 251 ; throw(error(initialization_error(E, Goal, Ctx), _)) 252 ) 253 ; throw(error(initialization_error(failed, Goal, Ctx), _)) 254 ). 255 256 257 /******************************* 258 * THREAD INITIALIZATION * 259 *******************************/ 260 261:- meta_predicate 262 thread_initialization(). 263:- dynamic 264 '$at_thread_initialization'/1.
270thread_initialization(Goal) :-
271 assert('$at_thread_initialization'(Goal)),
272 call(Goal),
273 !.start_thread() from pl-thread.c before the thread's goal.279'$thread_init' :- 280 set_prolog_flag(toplevel_thread, false), 281 ( '$at_thread_initialization'(Goal), 282 ( call(Goal) 283 -> fail 284 ; fail 285 ) 286 ; true 287 ). 288 289 290 /******************************* 291 * FILE SEARCH PATH (-p) * 292 *******************************/
298'$set_file_search_paths' :- 299 '$cmd_option_val'(search_paths, Paths), 300 ( '$member'(Path, Paths), 301 atom_chars(Path, Chars), 302 ( phrase('$search_path'(Name, Aliases), Chars) 303 -> '$reverse'(Aliases, Aliases1), 304 forall('$member'(Alias, Aliases1), 305 asserta(user:file_search_path(Name, Alias))) 306 ; print_message(error, commandline_arg_type(p, Path)) 307 ), 308 fail ; true 309 ). 310 311'$search_path'(Name, Aliases) --> 312 '$string'(NameChars), 313 [=], 314 !, 315 {atom_chars(Name, NameChars)}, 316 '$search_aliases'(Aliases). 317 318'$search_aliases'([Alias|More]) --> 319 '$string'(AliasChars), 320 path_sep, 321 !, 322 { '$make_alias'(AliasChars, Alias) }, 323 '$search_aliases'(More). 324'$search_aliases'([Alias]) --> 325 '$string'(AliasChars), 326 '$eos', 327 !, 328 { '$make_alias'(AliasChars, Alias) }. 329 330path_sep --> 331 { current_prolog_flag(path_sep, Sep) }, 332 [Sep]. 333 334'$string'([]) --> []. 335'$string'([H|T]) --> [H], '$string'(T). 336 337'$eos'([], []). 338 339'$make_alias'(Chars, Alias) :- 340 catch(term_to_atom(Alias, Chars), _, fail), 341 ( atom(Alias) 342 ; functor(Alias, F, 1), 343 F \== / 344 ), 345 !. 346'$make_alias'(Chars, Alias) :- 347 atom_chars(Alias, Chars). 348 349 350 /******************************* 351 * LOADING ASSIOCIATED FILES * 352 *******************************/
argv, extracting the leading script files.
This is called after the C based parser removed Prolog options such
as -q, -f none, etc. These options are available through
'$cmd_option_val'/2.
Our task is to update the Prolog flag argv and return a list of
the files to be loaded. The rules are:
-- all remaining options must go to argvsearch(name) as Prolog file,
make this the content of Files and pass the remainder as
options to argv.386argv_prolog_files([], exe) :- 387 current_prolog_flag(saved_program_class, runtime), 388 !, 389 clean_argv. 390argv_prolog_files(Files, ScriptMode) :- 391 current_prolog_flag(argv, Argv), 392 no_option_files(Argv, Argv1, Files, ScriptMode), 393 ( ( nonvar(ScriptMode) 394 ; Argv1 == [] 395 ) 396 -> ( Argv1 \== Argv 397 -> set_prolog_flag(argv, Argv1) 398 ; true 399 ) 400 ; '$usage', 401 halt(1) 402 ). 403 404no_option_files([--|Argv], Argv, [], ScriptMode) :- 405 !, 406 ( ScriptMode = none 407 -> true 408 ; true 409 ). 410no_option_files([Opt|_], _, _, ScriptMode) :- 411 var(ScriptMode), 412 sub_atom(Opt, 0, _, _, '-'), 413 !, 414 '$usage', 415 halt(1). 416no_option_files([OsFile|Argv0], Argv, [File|T], ScriptMode) :- 417 file_name_extension(_, Ext, OsFile), 418 user:prolog_file_type(Ext, prolog), 419 !, 420 ScriptMode = prolog, 421 prolog_to_os_filename(File, OsFile), 422 no_option_files(Argv0, Argv, T, ScriptMode). 423no_option_files([OsScript|Argv], Argv, [Script], ScriptMode) :- 424 var(ScriptMode), 425 !, 426 prolog_to_os_filename(PlScript, OsScript), 427 ( exists_file(PlScript) 428 -> Script = PlScript, 429 ScriptMode = script 430 ; cli_script(OsScript, Script) 431 -> ScriptMode = app, 432 set_prolog_flag(app_name, OsScript) 433 ; '$existence_error'(file, PlScript) 434 ). 435no_option_files(Argv, Argv, [], ScriptMode) :- 436 ( ScriptMode = none 437 -> true 438 ; true 439 ). 440 441cli_script(CLI, Script) :- 442 ( sub_atom(CLI, Pre, _, Post, ':') 443 -> sub_atom(CLI, 0, Pre, _, SearchPath), 444 sub_atom(CLI, _, Post, 0, Base), 445 Spec =.. [SearchPath, Base] 446 ; Spec = app(CLI) 447 ), 448 absolute_file_name(Spec, Script, 449 [ file_type(prolog), 450 access(exist), 451 file_errors(fail) 452 ]). 453 454clean_argv :- 455 ( current_prolog_flag(argv, [--|Argv]) 456 -> set_prolog_flag(argv, Argv) 457 ; true 458 ).
467win_associated_files(Files) :- 468 ( Files = [File|_] 469 -> absolute_file_name(File, AbsFile), 470 set_prolog_flag(associated_file, AbsFile), 471 forall(prolog:set_app_file_config(Files), true) 472 ; true 473 ). 474 475:- multifile 476 prolog:set_app_file_config/1. % +Files
--pldoc[=port] is given, load the PlDoc system.482start_pldoc :- 483 '$cmd_option_val'(pldoc_server, Server), 484 ( Server == '' 485 -> call((doc_server(_), doc_browser)) 486 ; catch(atom_number(Server, Port), _, fail) 487 -> call(doc_server(Port)) 488 ; print_message(error, option_usage(pldoc)), 489 halt(1) 490 ). 491start_pldoc.
498load_associated_files(Files) :- 499 load_files(user:Files). 500 501hkey('HKEY_CURRENT_USER/Software/SWI/Prolog'). 502hkey('HKEY_LOCAL_MACHINE/Software/SWI/Prolog'). 503 504'$set_prolog_file_extension' :- 505 current_prolog_flag(windows, true), 506 hkey(Key), 507 catch(win_registry_get_value(Key, fileExtension, Ext0), 508 _, fail), 509 !, 510 ( atom_concat('.', Ext, Ext0) 511 -> true 512 ; Ext = Ext0 513 ), 514 ( user:prolog_file_type(Ext, prolog) 515 -> true 516 ; asserta(user:prolog_file_type(Ext, prolog)) 517 ). 518'$set_prolog_file_extension'. 519 520 521 /******************************** 522 * TOPLEVEL GOALS * 523 *********************************/
531'$initialise' :- 532 catch(initialise_prolog, E, initialise_error(E)). 533 534initialise_error(unwind(abort)) :- !. 535initialise_error(unwind(halt(_))) :- !. 536initialise_error(E) :- 537 print_message(error, initialization_exception(E)), 538 fail. 539 540initialise_prolog :- 541 apply_defines, 542 init_optimise, 543 '$run_initialization', 544 '$load_system_init_file', % -F file 545 set_toplevel, % set `toplevel_goal` flag from -t 546 '$set_file_search_paths', % handle -p alias=dir[:dir]* 547 init_debug_flags, 548 setup_app, 549 start_pldoc, % handle --pldoc[=port] 550 main_thread_init.
epilog is set and
xpce is around, create an epilog window and complete the user part
of the initialization in the epilog thread.558main_thread_init :- 559 current_prolog_flag(epilog, true), 560 thread_self(main), 561 current_prolog_flag(xpce, true), 562 exists_source(library(epilog)), 563 !, 564 setup_theme, 565 catch(setup_backtrace, E, print_message(warning, E)), 566 use_module(library(epilog)), 567 call(epilog([ init(user_thread_init), 568 main(true) 569 ])). 570main_thread_init :- 571 setup_theme, 572 user_thread_init.
578user_thread_init :-
579 opt_attach_packs,
580 argv_prolog_files(Files, ScriptMode),
581 load_init_file(ScriptMode), % -f file
582 catch(setup_colors, E, print_message(warning, E)),
583 win_associated_files(Files), % swipl-win: cd and update title
584 '$load_script_file', % -s file (may be repeated)
585 load_associated_files(Files),
586 '$cmd_option_val'(goals, Goals), % -g goal (may be repeated)
587 ( ScriptMode == app
588 -> run_program_init, % initialization(Goal, program)
589 run_main_init(true)
590 ; Goals == [],
591 \+ '$init_goal'(when(_), _, _) % no -g or -t or initialization(program)
592 -> version % default interactive run
593 ; run_init_goals(Goals), % run -g goals
594 ( load_only % used -l to load
595 -> version
596 ; run_program_init, % initialization(Goal, program)
597 run_main_init(false) % initialization(Goal, main)
598 )
599 ).603:- multifile 604 prolog:theme/1. 605 606setup_theme :- 607 current_prolog_flag(theme, Theme), 608 exists_source(library(theme/Theme)), 609 !, 610 use_module(library(theme/Theme)). 611setup_theme.
617apply_defines :- 618 '$cmd_option_val'(defines, Defs), 619 apply_defines(Defs). 620 621apply_defines([]). 622apply_defines([H|T]) :- 623 apply_define(H), 624 apply_defines(T). 625 626apply_define(Def) :- 627 sub_atom(Def, B, _, A, '='), 628 !, 629 sub_atom(Def, 0, B, _, Flag), 630 sub_atom(Def, _, A, 0, Value0), 631 ( '$current_prolog_flag'(Flag, Value0, _Scope, Access, Type) 632 -> ( Access \== write 633 -> '$permission_error'(set, prolog_flag, Flag) 634 ; text_flag_value(Type, Value0, Value) 635 ), 636 set_prolog_flag(Flag, Value) 637 ; ( atom_number(Value0, Value) 638 -> true 639 ; Value = Value0 640 ), 641 set_defined(Flag, Value) 642 ). 643apply_define(Def) :- 644 atom_concat('no-', Flag, Def), 645 !, 646 set_user_boolean_flag(Flag, false). 647apply_define(Def) :- 648 set_user_boolean_flag(Def, true). 649 650set_user_boolean_flag(Flag, Value) :- 651 current_prolog_flag(Flag, Old), 652 !, 653 ( Old == Value 654 -> true 655 ; set_prolog_flag(Flag, Value) 656 ). 657set_user_boolean_flag(Flag, Value) :- 658 set_defined(Flag, Value). 659 660text_flag_value(integer, Text, Int) :- 661 atom_number(Text, Int), 662 !. 663text_flag_value(float, Text, Float) :- 664 atom_number(Text, Float), 665 !. 666text_flag_value(term, Text, Term) :- 667 term_string(Term, Text, []), 668 !. 669text_flag_value(_, Value, Value). 670 671set_defined(Flag, Value) :- 672 define_options(Flag, Options), !, 673 create_prolog_flag(Flag, Value, Options).
680define_options('SDL_VIDEODRIVER', []). 681define_options(_, [warn_not_accessed(true)]).
-O is effective.687init_optimise :- 688 current_prolog_flag(optimise, true), 689 !, 690 use_module(user:library(apply_macros)). 691init_optimise. 692 693opt_attach_packs :- 694 current_prolog_flag(packs, true), 695 !, 696 attach_packs. 697opt_attach_packs. 698 699set_toplevel :- 700 '$cmd_option_val'(toplevel, TopLevelAtom), 701 catch(term_to_atom(TopLevel, TopLevelAtom), E, 702 (print_message(error, E), 703 halt(1))), 704 create_prolog_flag(toplevel_goal, TopLevel, [type(term)]). 705 706load_only :- 707 current_prolog_flag(os_argv, OSArgv), 708 memberchk('-l', OSArgv), 709 current_prolog_flag(argv, Argv), 710 \+ memberchk('-l', Argv).
717run_init_goals([]). 718run_init_goals([H|T]) :- 719 run_init_goal(H), 720 run_init_goals(T). 721 722run_init_goal(Text) :- 723 catch(term_to_atom(Goal, Text), E, 724 ( print_message(error, init_goal_syntax(E, Text)), 725 halt(2) 726 )), 727 run_init_goal(Goal, Text).
733run_program_init :- 734 forall('$init_goal'(when(program), Goal, Ctx), 735 run_init_goal(Goal, @(Goal,Ctx))). 736 737run_main_init(_) :- 738 findall(Goal-Ctx, '$init_goal'(when(main), Goal, Ctx), Pairs), 739 '$last'(Pairs, Goal-Ctx), 740 !, 741 ( current_prolog_flag(toplevel_goal, default) 742 -> set_prolog_flag(toplevel_goal, halt) 743 ; true 744 ), 745 run_init_goal(Goal, @(Goal,Ctx)). 746run_main_init(true) :- 747 '$existence_error'(initialization, main). 748run_main_init(_). 749 750run_init_goal(Goal, Ctx) :- 751 ( catch_with_backtrace(user:Goal, E, true) 752 -> ( var(E) 753 -> true 754 ; init_goal_failed(E, Ctx) 755 ) 756 ; ( current_prolog_flag(verbose, silent) 757 -> Level = silent 758 ; Level = error 759 ), 760 print_message(Level, init_goal_failed(failed, Ctx)), 761 halt(1) 762 ). 763 764init_goal_failed(E, Ctx) :- 765 print_message(error, init_goal_failed(E, Ctx)), 766 init_goal_failed(E). 767 768init_goal_failed(_) :- 769 thread_self(main), 770 !, 771 halt(2). 772init_goal_failed(_).
779init_debug_flags :-
780 Keep = [keep(true)],
781 create_prolog_flag(answer_write_options,
782 [ quoted(true), portray(true), max_depth(10),
783 spacing(next_argument)], Keep),
784 create_prolog_flag(prompt_alternatives_on, determinism, Keep),
785 create_prolog_flag(toplevel_extra_white_line, true, Keep),
786 create_prolog_flag(toplevel_print_factorized, false, Keep),
787 create_prolog_flag(print_write_options,
788 [ portray(true), quoted(true), numbervars(true) ],
789 Keep),
790 create_prolog_flag(toplevel_residue_vars, false, Keep),
791 create_prolog_flag(toplevel_list_wfs_residual_program, true, Keep),
792 '$set_debugger_write_options'(print).
798setup_backtrace :-
799 ( \+ current_prolog_flag(backtrace, false),
800 load_setup_file(library(prolog_stack))
801 -> true
802 ; true
803 ).
809setup_colors :-
810 ( \+ current_prolog_flag(color_term, false),
811 stream_property(user_input, tty(true)),
812 stream_property(user_error, tty(true)),
813 stream_property(user_output, tty(true)),
814 \+ getenv('TERM', dumb),
815 load_setup_file(user:library(ansi_term))
816 -> true
817 ; true
818 ).
824setup_history :-
825 ( \+ current_prolog_flag(save_history, false),
826 stream_property(user_input, tty(true)),
827 \+ current_prolog_flag(readline, false),
828 load_setup_file(library(prolog_history))
829 -> prolog_history(enable)
830 ; true
831 ).837setup_readline :- 838 ( stream_property(user_input, tty(true)), 839 current_prolog_flag(tty_control, true), 840 \+ getenv('TERM', dumb), 841 ( current_prolog_flag(readline, ReadLine) 842 -> true 843 ; ReadLine = true 844 ), 845 readline_library(ReadLine, Library), 846 ( load_setup_file(library(Library)) 847 -> true 848 ; print_message(warning, 849 error(existence_error(library, library(Library)), 850 _)), 851 fail 852 ) 853 -> set_prolog_flag(readline, Library) 854 ; set_prolog_flag(readline, false) 855 ). 856 857readline_library(true, Library) :- 858 !, 859 preferred_readline(Library). 860readline_library(false, _) :- 861 !, 862 fail. 863readline_library(Library, Library). 864 865preferred_readline(editline).
871load_setup_file(File) :-
872 catch(load_files(File,
873 [ silent(true),
874 if(not_loaded)
875 ]), error(_,_), fail).887:- if(current_prolog_flag(windows,true)). 888 889setup_app :- 890 current_prolog_flag(associated_file, _), 891 !. 892setup_app :- 893 '$cmd_option_val'(win_app, true), 894 !, 895 catch(my_prolog, E, print_message(warning, E)). 896setup_app. 897 898my_prolog :- 899 win_folder(personal, MyDocs), 900 atom_concat(MyDocs, '/Prolog', PrologDir), 901 ( ensure_dir(PrologDir) 902 -> working_directory(_, PrologDir) 903 ; working_directory(_, MyDocs) 904 ). 905 906ensure_dir(Dir) :- 907 exists_directory(Dir), 908 !. 909ensure_dir(Dir) :- 910 catch(make_directory(Dir), E, (print_message(warning, E), fail)). 911 912:- elif(current_prolog_flag(apple, true)). 913use_app_settings(true). % Indicate we need app settings 914 915setup_app :- 916 apple_set_locale, 917 current_prolog_flag(associated_file, _), 918 !. 919setup_app :- 920 current_prolog_flag(bundle, true), 921 current_prolog_flag(executable, Exe), 922 file_base_name(Exe, 'SWI-Prolog'), 923 !, 924 setup_macos_app. 925setup_app. 926 927apple_set_locale :- 928 ( getenv('LC_CTYPE', 'UTF-8'), 929 apple_current_locale_identifier(LocaleID), 930 atom_concat(LocaleID, '.UTF-8', Locale), 931 catch(setlocale(ctype, _Old, Locale), _, fail) 932 -> setenv('LANG', Locale), 933 unsetenv('LC_CTYPE') 934 ; true 935 ). 936 937setup_macos_app :- 938 restore_working_directory, 939 !. 940setup_macos_app :- 941 expand_file_name('~/Prolog', [PrologDir]), 942 ( exists_directory(PrologDir) 943 -> true 944 ; catch(make_directory(PrologDir), MkDirError, 945 print_message(warning, MkDirError)) 946 ), 947 catch(working_directory(_, PrologDir), CdError, 948 print_message(warning, CdError)), 949 !. 950setup_macos_app. 951 952:- elif(current_prolog_flag(emscripten, true)). 953setup_app. 954:- else. 955use_app_settings(true). % Indicate we need app settings 956 957% Other (Unix-like) platforms. 958setup_app :- 959 running_as_app, 960 restore_working_directory, 961 !. 962setup_app.
968running_as_app :- 969% getenv('FLATPAK_SANDBOX_DIR', _), 970 current_prolog_flag(epilog, true), 971 stream_property(In, file_no(0)), 972 \+ stream_property(In, tty(true)), 973 !. 974 975:- endif. 976 977 978:- if((current_predicate(use_app_settings/1), 979 use_app_settings(true))). 980 981 982 /******************************* 983 * APP WORKING DIRECTORY * 984 *******************************/ 985 986save_working_directory :- 987 working_directory(WD, WD), 988 app_settings(Settings), 989 ( Settings.get(working_directory) == WD 990 -> true 991 ; app_save_settings(Settings.put(working_directory, WD)) 992 ). 993 994restore_working_directory :- 995 at_halt(save_working_directory), 996 app_settings(Settings), 997 WD = Settings.get(working_directory), 998 catch(working_directory(_, WD), _, fail), 999 !. 1000 1001 /******************************* 1002 * SETTINGS * 1003 *******************************/
1009app_settings(Settings) :- 1010 app_settings_file(File), 1011 access_file(File, read), 1012 catch(setup_call_cleanup( 1013 open(File, read, In, [encoding(utf8)]), 1014 read_term(In, Settings, []), 1015 close(In)), 1016 Error, 1017 (print_message(warning, Error), fail)), 1018 !. 1019app_settings(#{}).
1025app_save_settings(Settings) :- 1026 app_settings_file(File), 1027 catch(setup_call_cleanup( 1028 open(File, write, Out, [encoding(utf8)]), 1029 write_term(Out, Settings, 1030 [ quoted(true), 1031 module(system), % default operators 1032 fullstop(true), 1033 nl(true) 1034 ]), 1035 close(Out)), 1036 Error, 1037 (print_message(warning, Error), fail)). 1038 1039 1040app_settings_file(File) :- 1041 absolute_file_name(user_app_config('app_settings.pl'), File, 1042 [ access(write), 1043 file_errors(fail) 1044 ]). 1045:- endif.% app_settings 1046 1047 /******************************* 1048 * TOPLEVEL * 1049 *******************************/ 1050 1051:- '$hide'('$toplevel'/0). % avoid in the GUI stacktrace
1057'$toplevel' :-
1058 '$runtoplevel',
1059 print_message(informational, halt).default and prolog both
start the interactive toplevel, where prolog implies the user gave
-t prolog.
1069'$runtoplevel' :- 1070 current_prolog_flag(toplevel_goal, TopLevel0), 1071 toplevel_goal(TopLevel0, TopLevel), 1072 user:TopLevel. 1073 1074:- dynamic setup_done/0. 1075:- volatile setup_done/0. 1076 1077toplevel_goal(default, '$query_loop') :- 1078 !, 1079 setup_interactive. 1080toplevel_goal(prolog, '$query_loop') :- 1081 !, 1082 setup_interactive. 1083toplevel_goal(Goal, Goal). 1084 1085setup_interactive :- 1086 setup_done, 1087 !. 1088setup_interactive :- 1089 asserta(setup_done), 1090 catch(setup_backtrace, E, print_message(warning, E)), 1091 catch(setup_readline, E, print_message(warning, E)), 1092 catch(setup_history, E, print_message(warning, E)).
1098'$compile' :- 1099 ( catch('$compile_', E, (print_message(error, E), halt(1))) 1100 -> true 1101 ; print_message(error, error(goal_failed('$compile'), _)), 1102 halt(1) 1103 ), 1104 halt. % set exit code 1105 1106'$compile_' :- 1107 '$load_system_init_file', 1108 catch(setup_colors, _, true), 1109 '$set_file_search_paths', 1110 init_debug_flags, 1111 '$run_initialization', 1112 opt_attach_packs, 1113 use_module(library(qsave)), 1114 qsave:qsave_toplevel.
1120'$config' :- 1121 '$load_system_init_file', 1122 '$set_file_search_paths', 1123 init_debug_flags, 1124 '$run_initialization', 1125 load_files(library(prolog_config)), 1126 ( catch(prolog_dump_runtime_variables, E, 1127 (print_message(error, E), halt(1))) 1128 -> true 1129 ; print_message(error, error(goal_failed(prolog_dump_runtime_variables),_)) 1130 ). 1131 1132 1133 /******************************** 1134 * USER INTERACTIVE LOOP * 1135 *********************************/
forall(prolog:repl_loop_hook(BeginEnd, BreakLevel), true)
1148:- multifile
1149 prolog:repl_loop_hook/2.1157prolog :- 1158 break. 1159 1160:- create_prolog_flag(toplevel_mode, backtracking, []).
query_loop(). This ensures that unhandled
exceptions are really unhandled (in Prolog).1169'$query_loop' :- 1170 break_level(BreakLev), 1171 setup_call_cleanup( 1172 notrace(call_repl_loop_hook(begin, BreakLev, IsToplevel)), 1173 '$query_loop'(BreakLev), 1174 notrace(call_repl_loop_hook(end, BreakLev, IsToplevel))). 1175 1176call_repl_loop_hook(begin, BreakLev, IsToplevel) => 1177 ( current_prolog_flag(toplevel_thread, IsToplevel) 1178 -> true 1179 ; IsToplevel = false 1180 ), 1181 set_prolog_flag(toplevel_thread, true), 1182 call_repl_loop_hook_(begin, BreakLev). 1183call_repl_loop_hook(end, BreakLev, IsToplevel) => 1184 set_prolog_flag(toplevel_thread, IsToplevel), 1185 call_repl_loop_hook_(end, BreakLev). 1186 1187call_repl_loop_hook_(BeginEnd, BreakLev) :- 1188 forall(prolog:repl_loop_hook(BeginEnd, BreakLev), true). 1189 1190 1191'$query_loop'(BreakLev) :- 1192 current_prolog_flag(toplevel_mode, recursive), 1193 !, 1194 read_expanded_query(BreakLev, Query, Bindings), 1195 ( Query == end_of_file 1196 -> print_message(query, query(eof)) 1197 ; '$call_no_catch'('$execute_query'(Query, Bindings, _)), 1198 ( current_prolog_flag(toplevel_mode, recursive) 1199 -> '$query_loop'(BreakLev) 1200 ; '$switch_toplevel_mode'(backtracking), 1201 '$query_loop'(BreakLev) % Maybe throw('$switch_toplevel_mode')? 1202 ) 1203 ). 1204'$query_loop'(BreakLev) :- 1205 repeat, 1206 read_expanded_query(BreakLev, Query, Bindings), 1207 ( Query == end_of_file 1208 -> !, print_message(query, query(eof)) 1209 ; '$execute_query'(Query, Bindings, _), 1210 ( current_prolog_flag(toplevel_mode, recursive) 1211 -> !, 1212 '$switch_toplevel_mode'(recursive), 1213 '$query_loop'(BreakLev) 1214 ; fail 1215 ) 1216 ). 1217 1218break_level(BreakLev) :- 1219 ( current_prolog_flag(break_level, BreakLev) 1220 -> true 1221 ; BreakLev = -1 1222 ). 1223 1224read_expanded_query(BreakLev, ExpandedQuery, ExpandedBindings) :- 1225 '$current_typein_module'(TypeIn), 1226 ( stream_property(user_input, tty(true)) 1227 -> '$system_prompt'(TypeIn, BreakLev, Prompt), 1228 prompt(Old, '| ') 1229 ; Prompt = '', 1230 prompt(Old, '') 1231 ), 1232 trim_stacks, 1233 trim_heap, 1234 repeat, 1235 ( catch(read_query(Prompt, Query, Bindings), 1236 error(io_error(_,_),_), fail) 1237 -> prompt(_, Old), 1238 catch(call_expand_query(Query, ExpandedQuery, 1239 Bindings, ExpandedBindings), 1240 Error, 1241 (print_message(error, Error), fail)) 1242 ; set_prolog_flag(debug_on_error, false), 1243 thread_exit(io_error) 1244 ), 1245 !.
1254:- multifile 1255 prolog:history/2. 1256 1257:- if(current_prolog_flag(emscripten, true)). 1258read_query(_Prompt, Goal, Bindings) :- 1259 '$can_yield', 1260 !, 1261 await(query, GoalString), 1262 term_string(Goal, GoalString, [variable_names(Bindings)]). 1263:- endif. 1264read_query(Prompt, Goal, Bindings) :- 1265 prolog:history(current_input, enabled), 1266 !, 1267 read_term_with_history( 1268 Goal, 1269 [ show(h), 1270 help('!h'), 1271 no_save([trace]), 1272 prompt(Prompt), 1273 variable_names(Bindings) 1274 ]). 1275read_query(Prompt, Goal, Bindings) :- 1276 remove_history_prompt(Prompt, Prompt1), 1277 repeat, % over syntax errors 1278 prompt1(Prompt1), 1279 read_query_line(user_input, Line), 1280 '$current_typein_module'(TypeIn), 1281 catch(read_term_from_atom(Line, Goal, 1282 [ variable_names(Bindings), 1283 module(TypeIn) 1284 ]), E, 1285 ( print_message(error, E), 1286 fail 1287 )), 1288 !.
user and read the next query. This supports injecting
goals in some GNU-Emacs modes.1296read_query_line(Input, Line) :- 1297 stream_property(Input, error(true)), 1298 !, 1299 Line = end_of_file. 1300read_query_line(Input, Line) :- 1301 catch(read_term_as_atom(Input, Line0), Error, true), 1302 save_debug_after_read, 1303 ( var(Error) 1304 -> ( catch(term_string(Goal, Line0), error(_,_), fail), 1305 Goal = '$silent'(SilentGoal) 1306 -> Error = error(_,_), 1307 catch_with_backtrace(ignore(SilentGoal), Error, 1308 print_message(error, Error)), 1309 read_query_line(Input, Line) 1310 ; Line = Line0 1311 ) 1312 ; catch(print_message(error, Error), _, true), 1313 ( Error = error(syntax_error(_),_) 1314 -> fail 1315 ; throw(Error) 1316 ) 1317 ).
1324read_term_as_atom(In, Line) :-
1325 '$raw_read'(In, Line),
1326 ( Line == end_of_file
1327 -> true
1328 ; skip_to_nl(In)
1329 ).1336skip_to_nl(In) :- 1337 repeat, 1338 peek_char(In, C), 1339 ( C == '%' 1340 -> skip(In, '\n') 1341 ; char_type(C, space) 1342 -> get_char(In, _), 1343 C == '\n' 1344 ; true 1345 ), 1346 !. 1347 1348remove_history_prompt('', '') :- !. 1349remove_history_prompt(Prompt0, Prompt) :- 1350 atom_chars(Prompt0, Chars0), 1351 clean_history_prompt_chars(Chars0, Chars1), 1352 delete_leading_blanks(Chars1, Chars), 1353 atom_chars(Prompt, Chars). 1354 1355clean_history_prompt_chars([], []). 1356clean_history_prompt_chars(['~', !|T], T) :- !. 1357clean_history_prompt_chars([H|T0], [H|T]) :- 1358 clean_history_prompt_chars(T0, T). 1359 1360delete_leading_blanks([' '|T0], T) :- 1361 !, 1362 delete_leading_blanks(T0, T). 1363delete_leading_blanks(L, L). 1364 1365 1366 /******************************* 1367 * TOPLEVEL DEBUG * 1368 *******************************/
thread_signal(main, gdebug)
1383save_debug_after_read :- 1384 current_prolog_flag(debug, true), 1385 !, 1386 save_debug. 1387save_debug_after_read. 1388 1389save_debug :- 1390 ( tracing, 1391 notrace 1392 -> Tracing = true 1393 ; Tracing = false 1394 ), 1395 current_prolog_flag(debug, Debugging), 1396 set_prolog_flag(debug, false), 1397 create_prolog_flag(query_debug_settings, 1398 debug(Debugging, Tracing), []). 1399 1400restore_debug :- 1401 current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)), 1402 set_prolog_flag(debug, Debugging), 1403 ( Tracing == true 1404 -> trace 1405 ; true 1406 ). 1407 1408:- initialization 1409 create_prolog_flag(query_debug_settings, debug(false, false), []). 1410 1411 1412 /******************************** 1413 * PROMPTING * 1414 ********************************/ 1415 1416'$system_prompt'(Module, BrekLev, Prompt) :- 1417 current_prolog_flag(toplevel_prompt, PAtom), 1418 atom_codes(PAtom, P0), 1419 ( Module \== user 1420 -> '$substitute'('~m', [Module, ': '], P0, P1) 1421 ; '$substitute'('~m', [], P0, P1) 1422 ), 1423 ( BrekLev > 0 1424 -> '$substitute'('~l', ['[', BrekLev, '] '], P1, P2) 1425 ; '$substitute'('~l', [], P1, P2) 1426 ), 1427 current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)), 1428 ( Tracing == true 1429 -> '$substitute'('~d', ['[trace] '], P2, P3) 1430 ; Debugging == true 1431 -> '$substitute'('~d', ['[debug] '], P2, P3) 1432 ; '$substitute'('~d', [], P2, P3) 1433 ), 1434 atom_chars(Prompt, P3). 1435 1436'$substitute'(From, T, Old, New) :- 1437 atom_codes(From, FromCodes), 1438 phrase(subst_chars(T), T0), 1439 '$append'(Pre, S0, Old), 1440 '$append'(FromCodes, Post, S0) -> 1441 '$append'(Pre, T0, S1), 1442 '$append'(S1, Post, New), 1443 !. 1444'$substitute'(_, _, Old, Old). 1445 1446subst_chars([]) --> 1447 []. 1448subst_chars([H|T]) --> 1449 { atomic(H), 1450 !, 1451 atom_codes(H, Codes) 1452 }, 1453 , 1454 subst_chars(T). 1455subst_chars([H|T]) --> 1456 , 1457 subst_chars(T). 1458 1459 1460 /******************************** 1461 * EXECUTION * 1462 ********************************/
1468'$execute_query'(Var, _, true) :- 1469 var(Var), 1470 !, 1471 print_message(informational, var_query(Var)). 1472'$execute_query'(Goal, Bindings, Truth) :- 1473 '$current_typein_module'(TypeIn), 1474 '$dwim_correct_goal'(TypeIn:Goal, Bindings, Corrected), 1475 !, 1476 setup_call_cleanup( 1477 '$set_source_module'(M0, TypeIn), 1478 expand_goal(Corrected, Expanded), 1479 '$set_source_module'(M0)), 1480 print_message(silent, toplevel_goal(Expanded, Bindings)), 1481 '$execute_goal2'(Expanded, Bindings, Truth). 1482'$execute_query'(_, _, false) :- 1483 notrace, 1484 print_message(query, query(no)). 1485 1486'$execute_goal2'(Goal, Bindings, true) :- 1487 restore_debug, 1488 '$current_typein_module'(TypeIn), 1489 residue_vars(TypeIn:Goal, Vars, TypeIn:Delays, Chp), 1490 deterministic(Det), 1491 ( save_debug 1492 ; restore_debug, fail 1493 ), 1494 flush_output(user_output), 1495 ( Det == true 1496 -> DetOrChp = true 1497 ; DetOrChp = Chp 1498 ), 1499 call_expand_answer(Goal, Bindings, NewBindings), 1500 ( \+ \+ write_bindings(NewBindings, Vars, Delays, DetOrChp) 1501 -> ! 1502 ). 1503'$execute_goal2'(_, _, false) :- 1504 save_debug, 1505 print_message(query, query(no)). 1506 1507residue_vars(Goal, Vars, Delays, Chp) :- 1508 current_prolog_flag(toplevel_residue_vars, true), 1509 !, 1510 '$wfs_call'(call_residue_vars(stop_backtrace(Goal, Chp), Vars), Delays). 1511residue_vars(Goal, [], Delays, Chp) :- 1512 '$wfs_call'(stop_backtrace(Goal, Chp), Delays). 1513 1514stop_backtrace(Goal, Chp) :- 1515 toplevel_call(Goal), 1516 prolog_current_choice(Chp). 1517 1518toplevel_call(Goal) :- 1519 call(Goal), 1520 no_lco. 1521 1522no_lco.
groundness gives the classical behaviour,
determinism is considered more adequate and informative.
Succeeds if the user accepts the answer and fails otherwise.
1538write_bindings(Bindings, ResidueVars, Delays, DetOrChp) :- 1539 '$current_typein_module'(TypeIn), 1540 translate_bindings(Bindings, Bindings1, ResidueVars, TypeIn:Residuals), 1541 omit_qualifier(Delays, TypeIn, Delays1), 1542 write_bindings2(Bindings, Bindings1, Residuals, Delays1, DetOrChp). 1543 1544write_bindings2(OrgBindings, [], Residuals, Delays, _) :- 1545 current_prolog_flag(prompt_alternatives_on, groundness), 1546 !, 1547 name_vars(OrgBindings, [], t(Residuals, Delays)), 1548 print_message(query, query(yes(Delays, Residuals))). 1549write_bindings2(OrgBindings, Bindings, Residuals, Delays, true) :- 1550 current_prolog_flag(prompt_alternatives_on, determinism), 1551 !, 1552 name_vars(OrgBindings, Bindings, t(Residuals, Delays)), 1553 print_message(query, query(yes(Bindings, Delays, Residuals))). 1554write_bindings2(OrgBindings, Bindings, Residuals, Delays, Chp) :- 1555 repeat, 1556 name_vars(OrgBindings, Bindings, t(Residuals, Delays)), 1557 print_message(query, query(more(Bindings, Delays, Residuals))), 1558 get_respons(Action, Chp), 1559 ( Action == redo 1560 -> !, fail 1561 ; Action == show_again 1562 -> fail 1563 ; !, 1564 print_message(query, query(done)) 1565 ).
_[A-Z][0-9]* to all variables in Term, that do not
have a name due to Bindings. Singleton variables in Term are named
_. The behavior depends on these Prolog flags:
true, else name_vars/3 is a no-op.
Variables are named by unifying them to '$VAR'(Name)
1581name_vars(OrgBindings, Bindings, Term) :- 1582 current_prolog_flag(toplevel_name_variables, true), 1583 answer_flags_imply_numbervars, 1584 !, 1585 '$term_multitons'(t(Bindings,Term), Vars), 1586 bindings_var_names(OrgBindings, Bindings, VarNames), 1587 name_vars_(Vars, VarNames, 0), 1588 term_variables(t(Bindings,Term), SVars), 1589 anon_vars(SVars). 1590name_vars(_OrgBindings, _Bindings, _Term). 1591 1592name_vars_([], _, _). 1593name_vars_([H|T], Bindings, N) :- 1594 name_var(Bindings, Name, N, N1), 1595 H = '$VAR'(Name), 1596 name_vars_(T, Bindings, N1). 1597 1598anon_vars([]). 1599anon_vars(['$VAR'('_')|T]) :- 1600 anon_vars(T).
1607name_var(Reserved, Name, N0, N) :-
1608 between(N0, infinite, N1),
1609 I is N1//26,
1610 J is 0'A + N1 mod 26,
1611 ( I == 0
1612 -> format(atom(Name), '_~c', [J])
1613 ; format(atom(Name), '_~c~d', [J, I])
1614 ),
1615 \+ memberchk(Name, Reserved),
1616 !,
1617 N is N1+1.
1626bindings_var_names(OrgBindings, TransBindings, VarNames) :-
1627 phrase(bindings_var_names_(OrgBindings), VarNames0, Tail),
1628 phrase(bindings_var_names_(TransBindings), Tail, []),
1629 sort(VarNames0, VarNames).1636bindings_var_names_([]) --> []. 1637bindings_var_names_([H|T]) --> 1638 binding_var_names(H), 1639 bindings_var_names_(T). 1640 1641binding_var_names(binding(Vars,_Value,_Subst)) ==> 1642 var_names(Vars). 1643binding_var_names(Name=_Value) ==> 1644 [Name]. 1645 1646var_names([]) --> []. 1647var_names([H|T]) --> [H], var_names(T).
1655answer_flags_imply_numbervars :- 1656 current_prolog_flag(answer_write_options, Options), 1657 numbervars_option(Opt), 1658 memberchk(Opt, Options), 1659 !. 1660 1661numbervars_option(portray(true)). 1662numbervars_option(portrayed(true)). 1663numbervars_option(numbervars(true)).
1670:- multifile 1671 residual_goal_collector/1. 1672 1673:- meta_predicate 1674 residual_goals(). 1675 1676residual_goals(NonTerminal) :- 1677 throw(error(context_error(nodirective, residual_goals(NonTerminal)), _)). 1678 1679systemterm_expansion((:- residual_goals(NonTerminal)), 1680 '$toplevel':residual_goal_collector(M2:Head)) :- 1681 \+ current_prolog_flag(xref, true), 1682 prolog_load_context(module, M), 1683 strip_module(M:NonTerminal, M2, Head), 1684 '$must_be'(callable, Head).
1691:- public prolog:residual_goals//0. 1692 1693prolog:residual_goals --> 1694 { findall(NT, residual_goal_collector(NT), NTL) }, 1695 collect_residual_goals(NTL). 1696 1697collect_residual_goals([]) --> []. 1698collect_residual_goals([H|T]) --> 1699 ( call(H) -> [] ; [] ), 1700 collect_residual_goals(T).
1725:- public 1726 prolog:translate_bindings/5. 1727:- meta_predicate 1728 prolog:translate_bindings(, , , , ). 1729 1730prologtranslate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals) :- 1731 translate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals), 1732 name_vars(Bindings0, Bindings, t(ResVars, ResGoals, Residuals)). 1733 1734% should not be required. 1735prologname_vars(Bindings, Term) :- name_vars([], Bindings, Term). 1736prologname_vars(Bindings0, Bindings, Term) :- name_vars(Bindings0, Bindings, Term). 1737 1738translate_bindings(Bindings0, Bindings, ResidueVars, Residuals) :- 1739 prolog:residual_goals(ResidueGoals, []), 1740 translate_bindings(Bindings0, Bindings, ResidueVars, ResidueGoals, 1741 Residuals). 1742 1743translate_bindings(Bindings0, Bindings, [], [], _:[]-[]) :- 1744 term_attvars(Bindings0, []), 1745 !, 1746 join_same_bindings(Bindings0, Bindings1), 1747 factorize_bindings(Bindings1, Bindings2), 1748 bind_vars(Bindings2, Bindings3), 1749 filter_bindings(Bindings3, Bindings). 1750translate_bindings(Bindings0, Bindings, ResidueVars, ResGoals0, 1751 TypeIn:Residuals-HiddenResiduals) :- 1752 project_constraints(Bindings0, ResidueVars), 1753 hidden_residuals(ResidueVars, Bindings0, HiddenResiduals0), 1754 omit_qualifiers(HiddenResiduals0, TypeIn, HiddenResiduals), 1755 copy_term(Bindings0+ResGoals0, Bindings1+ResGoals1, Residuals0), 1756 '$append'(ResGoals1, Residuals0, Residuals1), 1757 omit_qualifiers(Residuals1, TypeIn, Residuals), 1758 join_same_bindings(Bindings1, Bindings2), 1759 factorize_bindings(Bindings2, Bindings3), 1760 bind_vars(Bindings3, Bindings4), 1761 filter_bindings(Bindings4, Bindings). 1762 (ResidueVars, Bindings, Goal) :- 1764 term_attvars(ResidueVars, Remaining), 1765 term_attvars(Bindings, QueryVars), 1766 subtract_vars(Remaining, QueryVars, HiddenVars), 1767 copy_term(HiddenVars, _, Goal). 1768 1769subtract_vars(All, Subtract, Remaining) :- 1770 sort(All, AllSorted), 1771 sort(Subtract, SubtractSorted), 1772 ord_subtract(AllSorted, SubtractSorted, Remaining). 1773 1774ord_subtract([], _Not, []). 1775ord_subtract([H1|T1], L2, Diff) :- 1776 diff21(L2, H1, T1, Diff). 1777 1778diff21([], H1, T1, [H1|T1]). 1779diff21([H2|T2], H1, T1, Diff) :- 1780 compare(Order, H1, H2), 1781 diff3(Order, H1, T1, H2, T2, Diff). 1782 1783diff12([], _H2, _T2, []). 1784diff12([H1|T1], H2, T2, Diff) :- 1785 compare(Order, H1, H2), 1786 diff3(Order, H1, T1, H2, T2, Diff). 1787 1788diff3(<, H1, T1, H2, T2, [H1|Diff]) :- 1789 diff12(T1, H2, T2, Diff). 1790diff3(=, _H1, T1, _H2, T2, Diff) :- 1791 ord_subtract(T1, T2, Diff). 1792diff3(>, H1, T1, _H2, T2, Diff) :- 1793 diff21(T2, H1, T1, Diff).
toplevel_residue_vars is set to project.1801project_constraints(Bindings, ResidueVars) :- 1802 !, 1803 term_attvars(Bindings, AttVars), 1804 phrase(attribute_modules(AttVars), Modules0), 1805 sort(Modules0, Modules), 1806 term_variables(Bindings, QueryVars), 1807 project_attributes(Modules, QueryVars, ResidueVars). 1808project_constraints(_, _). 1809 1810project_attributes([], _, _). 1811project_attributes([M|T], QueryVars, ResidueVars) :- 1812 ( current_predicate(M:project_attributes/2), 1813 catch(M:project_attributes(QueryVars, ResidueVars), E, 1814 print_message(error, E)) 1815 -> true 1816 ; true 1817 ), 1818 project_attributes(T, QueryVars, ResidueVars). 1819 1820attribute_modules([]) --> []. 1821attribute_modules([H|T]) --> 1822 { get_attrs(H, Attrs) }, 1823 attrs_modules(Attrs), 1824 attribute_modules(T). 1825 1826attrs_modules([]) --> []. 1827attrs_modules(att(Module, _, More)) --> 1828 [Module], 1829 attrs_modules(More).
1840join_same_bindings([], []). 1841join_same_bindings([Name=V0|T0], [[Name|Names]=V|T]) :- 1842 take_same_bindings(T0, V0, V, Names, T1), 1843 join_same_bindings(T1, T). 1844 1845take_same_bindings([], Val, Val, [], []). 1846take_same_bindings([Name=V1|T0], V0, V, [Name|Names], T) :- 1847 V0 == V1, 1848 !, 1849 take_same_bindings(T0, V1, V, Names, T). 1850take_same_bindings([Pair|T0], V0, V, Names, [Pair|T]) :- 1851 take_same_bindings(T0, V0, V, Names, T).
1860omit_qualifiers([], _, []). 1861omit_qualifiers([Goal0|Goals0], TypeIn, [Goal|Goals]) :- 1862 omit_qualifier(Goal0, TypeIn, Goal), 1863 omit_qualifiers(Goals0, TypeIn, Goals). 1864 1865omit_qualifier(M:G0, TypeIn, G) :- 1866 M == TypeIn, 1867 !, 1868 omit_meta_qualifiers(G0, TypeIn, G). 1869omit_qualifier(M:G0, TypeIn, G) :- 1870 predicate_property(TypeIn:G0, imported_from(M)), 1871 \+ predicate_property(G0, transparent), 1872 !, 1873 G0 = G. 1874omit_qualifier(_:G0, _, G) :- 1875 predicate_property(G0, built_in), 1876 \+ predicate_property(G0, transparent), 1877 !, 1878 G0 = G. 1879omit_qualifier(M:G0, _, M:G) :- 1880 atom(M), 1881 !, 1882 omit_meta_qualifiers(G0, M, G). 1883omit_qualifier(G0, TypeIn, G) :- 1884 omit_meta_qualifiers(G0, TypeIn, G). 1885 1886omit_meta_qualifiers(V, _, V) :- 1887 var(V), 1888 !. 1889omit_meta_qualifiers((QA,QB), TypeIn, (A,B)) :- 1890 !, 1891 omit_qualifier(QA, TypeIn, A), 1892 omit_qualifier(QB, TypeIn, B). 1893omit_meta_qualifiers(tnot(QA), TypeIn, tnot(A)) :- 1894 !, 1895 omit_qualifier(QA, TypeIn, A). 1896omit_meta_qualifiers(freeze(V, QGoal), TypeIn, freeze(V, Goal)) :- 1897 callable(QGoal), 1898 !, 1899 omit_qualifier(QGoal, TypeIn, Goal). 1900omit_meta_qualifiers(when(Cond, QGoal), TypeIn, when(Cond, Goal)) :- 1901 callable(QGoal), 1902 !, 1903 omit_qualifier(QGoal, TypeIn, Goal). 1904omit_meta_qualifiers(G, _, G).
1913bind_vars(Bindings0, Bindings) :- 1914 bind_query_vars(Bindings0, Bindings, SNames), 1915 bind_skel_vars(Bindings, Bindings, SNames, 1, _). 1916 1917bind_query_vars([], [], []). 1918bind_query_vars([binding(Names,Var,[Var2=Cycle])|T0], 1919 [binding(Names,Cycle,[])|T], [Name|SNames]) :- 1920 Var == Var2, % also implies var(Var) 1921 !, 1922 '$last'(Names, Name), 1923 Var = '$VAR'(Name), 1924 bind_query_vars(T0, T, SNames). 1925bind_query_vars([B|T0], [B|T], AllNames) :- 1926 B = binding(Names,Var,Skel), 1927 bind_query_vars(T0, T, SNames), 1928 ( var(Var), \+ attvar(Var), Skel == [] 1929 -> AllNames = [Name|SNames], 1930 '$last'(Names, Name), 1931 Var = '$VAR'(Name) 1932 ; AllNames = SNames 1933 ). 1934 1935 1936 1937bind_skel_vars([], _, _, N, N). 1938bind_skel_vars([binding(_,_,Skel)|T], Bindings, SNames, N0, N) :- 1939 bind_one_skel_vars(Skel, Bindings, SNames, N0, N1), 1940 bind_skel_vars(T, Bindings, SNames, N1, N).
1959bind_one_skel_vars([], _, _, N, N). 1960bind_one_skel_vars([Var=Value|T], Bindings, Names, N0, N) :- 1961 ( var(Var) 1962 -> ( '$member'(binding(Names, VVal, []), Bindings), 1963 same_term(Value, VVal) 1964 -> '$last'(Names, VName), 1965 Var = '$VAR'(VName), 1966 N2 = N0 1967 ; between(N0, infinite, N1), 1968 atom_concat('_S', N1, Name), 1969 \+ memberchk(Name, Names), 1970 !, 1971 Var = '$VAR'(Name), 1972 N2 is N1 + 1 1973 ) 1974 ; N2 = N0 1975 ), 1976 bind_one_skel_vars(T, Bindings, Names, N2, N).
1983factorize_bindings([], []). 1984factorize_bindings([Name=Value|T0], [binding(Name, Skel, Subst)|T]) :- 1985 '$factorize_term'(Value, Skel, Subst0), 1986 ( current_prolog_flag(toplevel_print_factorized, true) 1987 -> Subst = Subst0 1988 ; only_cycles(Subst0, Subst) 1989 ), 1990 factorize_bindings(T0, T). 1991 1992 1993only_cycles([], []). 1994only_cycles([B|T0], List) :- 1995 ( B = (Var=Value), 1996 Var = Value, 1997 acyclic_term(Var) 1998 -> only_cycles(T0, List) 1999 ; List = [B|T], 2000 only_cycles(T0, T) 2001 ).
2010filter_bindings([], []). 2011filter_bindings([H0|T0], T) :- 2012 hide_vars(H0, H), 2013 ( ( arg(1, H, []) 2014 ; self_bounded(H) 2015 ) 2016 -> filter_bindings(T0, T) 2017 ; T = [H|T1], 2018 filter_bindings(T0, T1) 2019 ). 2020 2021hide_vars(binding(Names0, Skel, Subst), binding(Names, Skel, Subst)) :- 2022 hide_names(Names0, Skel, Subst, Names). 2023 2024hide_names([], _, _, []). 2025hide_names([Name|T0], Skel, Subst, T) :- 2026 ( sub_atom(Name, 0, _, _, '_'), 2027 current_prolog_flag(toplevel_print_anon, false), 2028 sub_atom(Name, 1, 1, _, Next), 2029 char_type(Next, prolog_var_start) 2030 -> true 2031 ; Subst == [], 2032 Skel == '$VAR'(Name) 2033 ), 2034 !, 2035 hide_names(T0, Skel, Subst, T). 2036hide_names([Name|T0], Skel, Subst, [Name|T]) :- 2037 hide_names(T0, Skel, Subst, T). 2038 2039self_bounded(binding([Name], Value, [])) :- 2040 Value == '$VAR'(Name).
2046:- if(current_prolog_flag(emscripten, true)). 2047get_respons(Action, Chp) :- 2048 '$can_yield', 2049 !, 2050 repeat, 2051 await(more, CommandS), 2052 atom_string(Command, CommandS), 2053 more_action(Command, Chp, Action), 2054 ( Action == again 2055 -> print_message(query, query(action)), 2056 fail 2057 ; ! 2058 ). 2059:- endif. 2060get_respons(Action, Chp) :- 2061 repeat, 2062 flush_output(user_output), 2063 get_single_char(Code), 2064 find_more_command(Code, Command, Feedback, Style), 2065 ( Style \== '-' 2066 -> print_message(query, if_tty([ansi(Style, '~w', [Feedback])])) 2067 ; true 2068 ), 2069 more_action(Command, Chp, Action), 2070 ( Action == again 2071 -> print_message(query, query(action)), 2072 fail 2073 ; ! 2074 ). 2075 2076find_more_command(-1, end_of_file, 'EOF', warning) :- 2077 !. 2078find_more_command(Code, Command, Feedback, Style) :- 2079 more_command(Command, Atom, Feedback, Style), 2080 '$in_reply'(Code, Atom), 2081 !. 2082find_more_command(Code, again, '', -) :- 2083 print_message(query, no_action(Code)). 2084 2085more_command(help, '?h', '', -). 2086more_command(redo, ';nrNR \t', ';', bold). 2087more_command(trace, 'tT', '; [trace]', comment). 2088more_command(continue, 'ca\n\ryY.', '.', bold). 2089more_command(break, 'b', '', -). 2090more_command(choicepoint, '*', '', -). 2091more_command(write, 'w', '[write]', comment). 2092more_command(print, 'p', '[print]', comment). 2093more_command(depth_inc, '+', Change, comment) :- 2094 ( print_depth(Depth0) 2095 -> depth_step(Step), 2096 NewDepth is Depth0*Step, 2097 format(atom(Change), '[max_depth(~D)]', [NewDepth]) 2098 ; Change = 'no max_depth' 2099 ). 2100more_command(depth_dec, '-', Change, comment) :- 2101 ( print_depth(Depth0) 2102 -> depth_step(Step), 2103 NewDepth is max(1, Depth0//Step), 2104 format(atom(Change), '[max_depth(~D)]', [NewDepth]) 2105 ; Change = '[max_depth(10)]' 2106 ). 2107 2108more_action(help, _, Action) => 2109 Action = again, 2110 print_message(help, query(help)). 2111more_action(redo, _, Action) => % Next 2112 Action = redo. 2113more_action(trace, _, Action) => 2114 Action = redo, 2115 trace, 2116 save_debug. 2117more_action(continue, _, Action) => % Stop 2118 Action = continue. 2119more_action(break, _, Action) => 2120 Action = show_again, 2121 break. 2122more_action(choicepoint, Chp, Action) => 2123 Action = show_again, 2124 print_last_chpoint(Chp). 2125more_action(end_of_file, _, Action) => 2126 Action = show_again, 2127 halt(0). 2128more_action(again, _, Action) => 2129 Action = again. 2130more_action(Command, _, Action), 2131 current_prolog_flag(answer_write_options, Options0), 2132 print_predicate(Command, Options0, Options) => 2133 Action = show_again, 2134 set_prolog_flag(answer_write_options, Options). 2135 2136print_depth(Depth) :- 2137 current_prolog_flag(answer_write_options, Options), 2138 memberchk(max_depth(Depth), Options), 2139 !.
answer_write_options value according to the user
command.2146print_predicate(write, Options0, Options) :- 2147 edit_options([-portrayed(true),-portray(true)], 2148 Options0, Options). 2149print_predicate(print, Options0, Options) :- 2150 edit_options([+portrayed(true)], 2151 Options0, Options). 2152print_predicate(depth_inc, Options0, Options) :- 2153 ( '$select'(max_depth(D0), Options0, Options1) 2154 -> depth_step(Step), 2155 D is D0*Step, 2156 Options = [max_depth(D)|Options1] 2157 ; Options = Options0 2158 ). 2159print_predicate(depth_dec, Options0, Options) :- 2160 ( '$select'(max_depth(D0), Options0, Options1) 2161 -> depth_step(Step), 2162 D is max(1, D0//Step), 2163 Options = [max_depth(D)|Options1] 2164 ; D = 10, 2165 Options = [max_depth(D)|Options0] 2166 ). 2167 2168depth_step(5). 2169 2170edit_options([], Options, Options). 2171edit_options([H|T], Options0, Options) :- 2172 edit_option(H, Options0, Options1), 2173 edit_options(T, Options1, Options). 2174 2175edit_option(-Term, Options0, Options) => 2176 ( '$select'(Term, Options0, Options) 2177 -> true 2178 ; Options = Options0 2179 ). 2180edit_option(+Term, Options0, Options) => 2181 functor(Term, Name, 1), 2182 functor(Var, Name, 1), 2183 ( '$select'(Var, Options0, Options1) 2184 -> Options = [Term|Options1] 2185 ; Options = [Term|Options0] 2186 ).
2192print_last_chpoint(Chp) :- 2193 current_predicate(print_last_choice_point/0), 2194 !, 2195 print_last_chpoint_(Chp). 2196print_last_chpoint(Chp) :- 2197 use_module(library(prolog_stack), [print_last_choicepoint/2]), 2198 print_last_chpoint_(Chp). 2199 2200print_last_chpoint_(Chp) :- 2201 print_last_choicepoint(Chp, [message_level(information)]). 2202 2203 2204 /******************************* 2205 * EXPANSION * 2206 *******************************/ 2207 2208:- user:dynamic(expand_query/4). 2209:- user:multifile(expand_query/4). 2210 2211call_expand_query(Goal, Expanded, Bindings, ExpandedBindings) :- 2212 ( '$replace_toplevel_vars'(Goal, Expanded0, Bindings, ExpandedBindings0) 2213 -> true 2214 ; Expanded0 = Goal, ExpandedBindings0 = Bindings 2215 ), 2216 ( user:expand_query(Expanded0, Expanded, ExpandedBindings0, ExpandedBindings) 2217 -> true 2218 ; Expanded = Expanded0, ExpandedBindings = ExpandedBindings0 2219 ). 2220 2221 2222:- dynamic 2223 user:expand_answer/2, 2224 prolog:expand_answer/3. 2225:- multifile 2226 user:expand_answer/2, 2227 prolog:expand_answer/3. 2228 2229call_expand_answer(Goal, BindingsIn, BindingsOut) :- 2230 ( prolog:expand_answer(Goal, BindingsIn, BindingsOut) 2231 -> true 2232 ; user:expand_answer(BindingsIn, BindingsOut) 2233 -> true 2234 ; BindingsOut = BindingsIn 2235 ), 2236 '$save_toplevel_vars'(BindingsOut), 2237 !. 2238call_expand_answer(_, Bindings, Bindings)