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-2026, 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.558:- if(current_prolog_flag(threads, true)). 559main_thread_init :- 560 current_prolog_flag(epilog, true), 561 thread_self(main), 562 current_prolog_flag(xpce, true), 563 exists_source(library(epilog)), 564 !, 565 setup_theme, 566 catch(setup_backtrace, E, print_message(warning, E)), 567 use_module(library(epilog)), 568 set_thread(main, class(system)), 569 call(epilog([ init(user_thread_init), 570 main(true) 571 ])). 572main_thread_init :- 573 set_thread(main, class(console)), 574 setup_theme, 575 user_thread_init. 576:- else. 577main_thread_init :- 578 setup_theme, 579 user_thread_init. 580:- endif.
587user_thread_init :-
588 opt_attach_packs,
589 argv_prolog_files(Files, ScriptMode),
590 load_init_file(ScriptMode), % -f file
591 catch(setup_colors, E, print_message(warning, E)),
592 win_associated_files(Files), % swipl-win: cd and update title
593 '$load_script_file', % -s file (may be repeated)
594 load_associated_files(Files),
595 '$cmd_option_val'(goals, Goals), % -g goal (may be repeated)
596 ( ScriptMode == app
597 -> run_program_init, % initialization(Goal, program)
598 run_main_init(true)
599 ; Goals == [],
600 \+ '$init_goal'(when(_), _, _) % no -g or -t or initialization(program)
601 -> version % default interactive run
602 ; run_init_goals(Goals), % run -g goals
603 ( load_only % used -l to load
604 -> version
605 ; run_program_init, % initialization(Goal, program)
606 run_main_init(false) % initialization(Goal, main)
607 )
608 ).612:- multifile 613 prolog:theme/1. 614 615setup_theme :- 616 current_prolog_flag(theme, Theme), 617 exists_source(library(theme/Theme)), 618 !, 619 use_module(library(theme/Theme)). 620setup_theme.
626apply_defines :- 627 '$cmd_option_val'(defines, Defs), 628 apply_defines(Defs). 629 630apply_defines([]). 631apply_defines([H|T]) :- 632 apply_define(H), 633 apply_defines(T). 634 635apply_define(Def) :- 636 sub_atom(Def, B, _, A, '='), 637 !, 638 sub_atom(Def, 0, B, _, Flag), 639 sub_atom(Def, _, A, 0, Value0), 640 ( '$current_prolog_flag'(Flag, Value0, _Scope, Access, Type) 641 -> ( Access \== write 642 -> '$permission_error'(set, prolog_flag, Flag) 643 ; text_flag_value(Type, Value0, Value) 644 ), 645 set_prolog_flag(Flag, Value) 646 ; ( atom_number(Value0, Value) 647 -> true 648 ; Value = Value0 649 ), 650 set_defined(Flag, Value) 651 ). 652apply_define(Def) :- 653 atom_concat('no-', Flag, Def), 654 !, 655 set_user_boolean_flag(Flag, false). 656apply_define(Def) :- 657 set_user_boolean_flag(Def, true). 658 659set_user_boolean_flag(Flag, Value) :- 660 current_prolog_flag(Flag, Old), 661 !, 662 ( Old == Value 663 -> true 664 ; set_prolog_flag(Flag, Value) 665 ). 666set_user_boolean_flag(Flag, Value) :- 667 set_defined(Flag, Value). 668 669text_flag_value(integer, Text, Int) :- 670 atom_number(Text, Int), 671 !. 672text_flag_value(float, Text, Float) :- 673 atom_number(Text, Float), 674 !. 675text_flag_value(term, Text, Term) :- 676 term_string(Term, Text, []), 677 !. 678text_flag_value(_, Value, Value). 679 680set_defined(Flag, Value) :- 681 define_options(Flag, Options), !, 682 create_prolog_flag(Flag, Value, Options).
689define_options('SDL_VIDEODRIVER', []). 690define_options(_, [warn_not_accessed(true)]).
-O is effective.696init_optimise :- 697 current_prolog_flag(optimise, true), 698 !, 699 use_module(user:library(apply_macros)). 700init_optimise. 701 702opt_attach_packs :- 703 current_prolog_flag(packs, true), 704 !, 705 attach_packs. 706opt_attach_packs. 707 708set_toplevel :- 709 '$cmd_option_val'(toplevel, TopLevelAtom), 710 catch(term_to_atom(TopLevel, TopLevelAtom), E, 711 (print_message(error, E), 712 halt(1))), 713 create_prolog_flag(toplevel_goal, TopLevel, [type(term)]). 714 715load_only :- 716 current_prolog_flag(os_argv, OSArgv), 717 memberchk('-l', OSArgv), 718 current_prolog_flag(argv, Argv), 719 \+ memberchk('-l', Argv).
726run_init_goals([]). 727run_init_goals([H|T]) :- 728 run_init_goal(H), 729 run_init_goals(T). 730 731run_init_goal(Text) :- 732 catch(term_to_atom(Goal, Text), E, 733 ( print_message(error, init_goal_syntax(E, Text)), 734 halt(2) 735 )), 736 run_init_goal(Goal, Text).
742run_program_init :- 743 forall('$init_goal'(when(program), Goal, Ctx), 744 run_init_goal(Goal, @(Goal,Ctx))). 745 746run_main_init(_) :- 747 findall(Goal-Ctx, '$init_goal'(when(main), Goal, Ctx), Pairs), 748 '$last'(Pairs, Goal-Ctx), 749 !, 750 ( current_prolog_flag(toplevel_goal, default) 751 -> set_prolog_flag(toplevel_goal, halt) 752 ; true 753 ), 754 run_init_goal(Goal, @(Goal,Ctx)). 755run_main_init(true) :- 756 '$existence_error'(initialization, main). 757run_main_init(_). 758 759run_init_goal(Goal, Ctx) :- 760 ( catch_with_backtrace(user:Goal, E, true) 761 -> ( var(E) 762 -> true 763 ; init_goal_failed(E, Ctx) 764 ) 765 ; ( current_prolog_flag(verbose, silent) 766 -> Level = silent 767 ; Level = error 768 ), 769 print_message(Level, init_goal_failed(failed, Ctx)), 770 halt(1) 771 ). 772 773init_goal_failed(E, Ctx) :- 774 print_message(error, init_goal_failed(E, Ctx)), 775 init_goal_failed(E). 776 777init_goal_failed(_) :- 778 thread_self(main), 779 !, 780 halt(2). 781init_goal_failed(_).
788init_debug_flags :-
789 Keep = [keep(true)],
790 create_prolog_flag(answer_write_options,
791 [ quoted(true), portray(true), max_depth(10),
792 spacing(next_argument)], Keep),
793 create_prolog_flag(prompt_alternatives_on, determinism, Keep),
794 create_prolog_flag(toplevel_extra_white_line, true, Keep),
795 create_prolog_flag(toplevel_print_factorized, false, Keep),
796 create_prolog_flag(print_write_options,
797 [ portray(true), quoted(true), numbervars(true) ],
798 Keep),
799 create_prolog_flag(toplevel_residue_vars, false, Keep),
800 create_prolog_flag(toplevel_list_wfs_residual_program, true, Keep),
801 '$set_debugger_write_options'(print).
807setup_backtrace :-
808 ( \+ current_prolog_flag(backtrace, false),
809 load_setup_file(library(prolog_stack))
810 -> true
811 ; true
812 ).
818setup_colors :-
819 ( \+ current_prolog_flag(color_term, false),
820 stream_property(user_input, tty(true)),
821 stream_property(user_error, tty(true)),
822 stream_property(user_output, tty(true)),
823 \+ getenv('TERM', dumb),
824 load_setup_file(user:library(ansi_term))
825 -> true
826 ; true
827 ).
833setup_history :-
834 ( \+ current_prolog_flag(save_history, false),
835 stream_property(user_input, tty(true)),
836 \+ current_prolog_flag(readline, false),
837 load_setup_file(library(prolog_history))
838 -> prolog_history(enable)
839 ; true
840 ).846setup_readline :- 847 ( stream_property(user_input, tty(true)), 848 current_prolog_flag(tty_control, true), 849 \+ getenv('TERM', dumb), 850 ( current_prolog_flag(readline, ReadLine) 851 -> true 852 ; ReadLine = true 853 ), 854 readline_library(ReadLine, Library), 855 ( load_setup_file(library(Library)) 856 -> true 857 ; current_prolog_flag(epilog, true), 858 print_message(warning, 859 error(existence_error(library, library(Library)), 860 _)), 861 fail 862 ) 863 -> set_prolog_flag(readline, Library) 864 ; set_prolog_flag(readline, false) 865 ). 866 867readline_library(true, Library) :- 868 !, 869 preferred_readline(Library). 870readline_library(false, _) :- 871 !, 872 fail. 873readline_library(Library, Library). 874 875preferred_readline(editline).
881load_setup_file(File) :-
882 catch(load_files(File,
883 [ silent(true),
884 if(not_loaded)
885 ]), error(_,_), fail).897:- if(current_prolog_flag(windows,true)). 898 899setup_app :- 900 current_prolog_flag(associated_file, _), 901 !. 902setup_app :- 903 '$cmd_option_val'(win_app, true), 904 !, 905 catch(my_prolog, E, print_message(warning, E)). 906setup_app. 907 908my_prolog :- 909 win_folder(personal, MyDocs), 910 atom_concat(MyDocs, '/Prolog', PrologDir), 911 ( ensure_dir(PrologDir) 912 -> working_directory(_, PrologDir) 913 ; working_directory(_, MyDocs) 914 ). 915 916ensure_dir(Dir) :- 917 exists_directory(Dir), 918 !. 919ensure_dir(Dir) :- 920 catch(make_directory(Dir), E, (print_message(warning, E), fail)). 921 922:- elif(current_prolog_flag(apple, true)). 923use_app_settings(true). % Indicate we need app settings 924 925setup_app :- 926 apple_set_locale, 927 current_prolog_flag(associated_file, _), 928 !. 929setup_app :- 930 current_prolog_flag(bundle, true), 931 current_prolog_flag(epilog, true), 932 getenv('__CFBundleIdentifier', _), 933 !, 934 setup_macos_app. 935setup_app. 936 937apple_set_locale :- 938 ( getenv('LC_CTYPE', 'UTF-8'), 939 apple_current_locale_identifier(LocaleID), 940 atom_concat(LocaleID, '.UTF-8', Locale), 941 catch(setlocale(ctype, _Old, Locale), _, fail) 942 -> setenv('LANG', Locale), 943 unsetenv('LC_CTYPE') 944 ; true 945 ). 946 947setup_macos_app :- 948 restore_working_directory, 949 !. 950setup_macos_app :- 951 expand_file_name('~/Prolog', [PrologDir]), 952 ( exists_directory(PrologDir) 953 -> true 954 ; catch(make_directory(PrologDir), MkDirError, 955 print_message(warning, MkDirError)) 956 ), 957 catch(working_directory(_, PrologDir), CdError, 958 print_message(warning, CdError)), 959 !. 960setup_macos_app. 961 962:- elif(current_prolog_flag(emscripten, true)). 963setup_app. 964:- else. 965use_app_settings(true). % Indicate we need app settings 966 967% Other (Unix-like) platforms. 968setup_app :- 969 running_as_app, 970 restore_working_directory, 971 !. 972setup_app.
978running_as_app :- 979% getenv('FLATPAK_SANDBOX_DIR', _), 980 current_prolog_flag(epilog, true), 981 stream_property(In, file_no(0)), 982 \+ stream_property(In, tty(true)), 983 !. 984 985:- endif. 986 987 988:- if((current_predicate(use_app_settings/1), 989 use_app_settings(true))). 990 991 992 /******************************* 993 * APP WORKING DIRECTORY * 994 *******************************/ 995 996save_working_directory :- 997 working_directory(WD, WD), 998 app_settings(Settings), 999 ( Settings.get(working_directory) == WD 1000 -> true 1001 ; app_save_settings(Settings.put(working_directory, WD)) 1002 ). 1003 1004restore_working_directory :- 1005 at_halt(save_working_directory), 1006 app_settings(Settings), 1007 WD = Settings.get(working_directory), 1008 catch(working_directory(_, WD), _, fail), 1009 !. 1010 1011 /******************************* 1012 * SETTINGS * 1013 *******************************/
1019app_settings(Settings) :- 1020 app_settings_file(File), 1021 access_file(File, read), 1022 catch(setup_call_cleanup( 1023 open(File, read, In, [encoding(utf8)]), 1024 read_term(In, Settings, []), 1025 close(In)), 1026 Error, 1027 (print_message(warning, Error), fail)), 1028 !. 1029app_settings(#{}).
1035app_save_settings(Settings) :- 1036 app_settings_file(File), 1037 catch(setup_call_cleanup( 1038 open(File, write, Out, [encoding(utf8)]), 1039 write_term(Out, Settings, 1040 [ quoted(true), 1041 module(system), % default operators 1042 fullstop(true), 1043 nl(true) 1044 ]), 1045 close(Out)), 1046 Error, 1047 (print_message(warning, Error), fail)). 1048 1049 1050app_settings_file(File) :- 1051 absolute_file_name(user_app_config('app_settings.pl'), File, 1052 [ access(write), 1053 file_errors(fail) 1054 ]). 1055:- endif.% app_settings 1056 1057 /******************************* 1058 * TOPLEVEL * 1059 *******************************/ 1060 1061:- '$hide'('$toplevel'/0). % avoid in the GUI stacktrace
1067'$toplevel' :-
1068 '$runtoplevel',
1069 print_message(informational, halt).default and prolog both
start the interactive toplevel, where prolog implies the user gave
-t prolog.
1079'$runtoplevel' :- 1080 current_prolog_flag(toplevel_goal, TopLevel0), 1081 toplevel_goal(TopLevel0, TopLevel), 1082 user:TopLevel. 1083 1084:- dynamic setup_done/0. 1085:- volatile setup_done/0. 1086 1087toplevel_goal(default, '$query_loop') :- 1088 !, 1089 setup_interactive. 1090toplevel_goal(prolog, '$query_loop') :- 1091 !, 1092 setup_interactive. 1093toplevel_goal(Goal, Goal). 1094 1095setup_interactive :- 1096 setup_done, 1097 !. 1098setup_interactive :- 1099 asserta(setup_done), 1100 catch(setup_backtrace, E, print_message(warning, E)), 1101 catch(setup_readline, E, print_message(warning, E)), 1102 catch(setup_history, E, print_message(warning, E)).
1108'$compile' :- 1109 ( catch('$compile_', E, (print_message(error, E), halt(1))) 1110 -> true 1111 ; print_message(error, error(goal_failed('$compile'), _)), 1112 halt(1) 1113 ), 1114 halt. % set exit code 1115 1116'$compile_' :- 1117 '$load_system_init_file', 1118 catch(setup_colors, _, true), 1119 '$set_file_search_paths', 1120 init_debug_flags, 1121 '$run_initialization', 1122 opt_attach_packs, 1123 use_module(library(qsave)), 1124 qsave:qsave_toplevel.
1130'$config' :- 1131 '$load_system_init_file', 1132 '$set_file_search_paths', 1133 init_debug_flags, 1134 '$run_initialization', 1135 load_files(library(prolog_config)), 1136 ( catch(prolog_dump_runtime_variables, E, 1137 (print_message(error, E), halt(1))) 1138 -> true 1139 ; print_message(error, error(goal_failed(prolog_dump_runtime_variables),_)) 1140 ). 1141 1142 1143 /******************************** 1144 * USER INTERACTIVE LOOP * 1145 *********************************/
forall(prolog:repl_loop_hook(BeginEnd, BreakLevel), true)
1158:- multifile
1159 prolog:repl_loop_hook/2.1167prolog :- 1168 break. 1169 1170:- create_prolog_flag(toplevel_mode, backtracking, []).
query_loop(). This ensures that unhandled
exceptions are really unhandled (in Prolog).1179'$query_loop' :- 1180 break_level(BreakLev), 1181 setup_call_cleanup( 1182 notrace(call_repl_loop_hook(begin, BreakLev, IsToplevel)), 1183 '$query_loop'(BreakLev), 1184 notrace(call_repl_loop_hook(end, BreakLev, IsToplevel))). 1185 1186call_repl_loop_hook(begin, BreakLev, IsToplevel) => 1187 ( current_prolog_flag(toplevel_thread, IsToplevel) 1188 -> true 1189 ; IsToplevel = false 1190 ), 1191 set_prolog_flag(toplevel_thread, true), 1192 call_repl_loop_hook_(begin, BreakLev). 1193call_repl_loop_hook(end, BreakLev, IsToplevel) => 1194 set_prolog_flag(toplevel_thread, IsToplevel), 1195 call_repl_loop_hook_(end, BreakLev). 1196 1197call_repl_loop_hook_(BeginEnd, BreakLev) :- 1198 forall(prolog:repl_loop_hook(BeginEnd, BreakLev), true). 1199 1200 1201'$query_loop'(BreakLev) :- 1202 current_prolog_flag(toplevel_mode, recursive), 1203 !, 1204 read_expanded_query(BreakLev, Query, Bindings), 1205 ( Query == end_of_file 1206 -> print_message(query, query(eof)) 1207 ; '$call_no_catch'('$execute_query'(Query, Bindings, _)), 1208 ( current_prolog_flag(toplevel_mode, recursive) 1209 -> '$query_loop'(BreakLev) 1210 ; '$switch_toplevel_mode'(backtracking), 1211 '$query_loop'(BreakLev) % Maybe throw('$switch_toplevel_mode')? 1212 ) 1213 ). 1214'$query_loop'(BreakLev) :- 1215 repeat, 1216 read_expanded_query(BreakLev, Query, Bindings), 1217 ( Query == end_of_file 1218 -> !, print_message(query, query(eof)) 1219 ; '$execute_query'(Query, Bindings, _), 1220 ( current_prolog_flag(toplevel_mode, recursive) 1221 -> !, 1222 '$switch_toplevel_mode'(recursive), 1223 '$query_loop'(BreakLev) 1224 ; fail 1225 ) 1226 ). 1227 1228break_level(BreakLev) :- 1229 ( current_prolog_flag(break_level, BreakLev) 1230 -> true 1231 ; BreakLev = -1 1232 ). 1233 1234read_expanded_query(BreakLev, ExpandedQuery, ExpandedBindings) :- 1235 '$current_typein_module'(TypeIn), 1236 ( stream_property(user_input, tty(true)) 1237 -> '$system_prompt'(TypeIn, BreakLev, Prompt), 1238 prompt(Old, '| ') 1239 ; Prompt = '', 1240 prompt(Old, '') 1241 ), 1242 trim_stacks, 1243 trim_heap, 1244 repeat, 1245 ( catch(read_query(Prompt, Query, Bindings), 1246 error(io_error(_,_),_), fail) 1247 -> prompt(_, Old), 1248 catch(call_expand_query(Query, ExpandedQuery, 1249 Bindings, ExpandedBindings), 1250 Error, 1251 (print_message(error, Error), fail)) 1252 ; set_prolog_flag(debug_on_error, false), 1253 thread_exit(io_error) 1254 ), 1255 !.
1264:- multifile 1265 prolog:history/2. 1266 1267:- if(current_prolog_flag(emscripten, true)). 1268read_query(_Prompt, Goal, Bindings) :- 1269 '$can_yield', 1270 !, 1271 await(query, GoalString), 1272 term_string(Goal, GoalString, [variable_names(Bindings)]). 1273:- endif. 1274read_query(Prompt, Goal, Bindings) :- 1275 prolog:history(current_input, enabled), 1276 !, 1277 read_term_with_history( 1278 Goal, 1279 [ show(h), 1280 help('!h'), 1281 no_save([trace]), 1282 prompt(Prompt), 1283 variable_names(Bindings) 1284 ]). 1285read_query(Prompt, Goal, Bindings) :- 1286 remove_history_prompt(Prompt, Prompt1), 1287 repeat, % over syntax errors 1288 prompt1(Prompt1), 1289 read_query_line(user_input, Line), 1290 '$current_typein_module'(TypeIn), 1291 catch(read_term_from_atom(Line, Goal, 1292 [ variable_names(Bindings), 1293 module(TypeIn), 1294 blob(resolve) 1295 ]), E, 1296 ( print_message(error, E), 1297 fail 1298 )), 1299 !.
user and read the next query. This supports injecting
goals in some GNU-Emacs modes.1307read_query_line(Input, Line) :- 1308 stream_property(Input, error(true)), 1309 !, 1310 Line = end_of_file. 1311read_query_line(Input, Line) :- 1312 catch(read_term_as_atom(Input, Line0), Error, true), 1313 save_debug_after_read, 1314 ( var(Error) 1315 -> ( catch(term_string(Goal, Line0), error(_,_), fail), 1316 Goal = '$silent'(SilentGoal) 1317 -> Error = error(_,_), 1318 catch_with_backtrace(ignore(SilentGoal), Error, 1319 print_message(error, Error)), 1320 read_query_line(Input, Line) 1321 ; Line = Line0 1322 ) 1323 ; catch(print_message(error, Error), _, true), 1324 ( Error = error(syntax_error(_),_) 1325 -> fail 1326 ; throw(Error) 1327 ) 1328 ).
1335read_term_as_atom(In, Line) :-
1336 '$raw_read'(In, Line),
1337 ( Line == end_of_file
1338 -> true
1339 ; skip_to_nl(In)
1340 ).1347skip_to_nl(In) :- 1348 repeat, 1349 peek_char(In, C), 1350 ( C == '%' 1351 -> skip(In, '\n') 1352 ; char_type(C, space) 1353 -> get_char(In, _), 1354 C == '\n' 1355 ; true 1356 ), 1357 !. 1358 1359remove_history_prompt('', '') :- !. 1360remove_history_prompt(Prompt0, Prompt) :- 1361 atom_chars(Prompt0, Chars0), 1362 clean_history_prompt_chars(Chars0, Chars1), 1363 delete_leading_blanks(Chars1, Chars), 1364 atom_chars(Prompt, Chars). 1365 1366clean_history_prompt_chars([], []). 1367clean_history_prompt_chars(['~', !|T], T) :- !. 1368clean_history_prompt_chars([H|T0], [H|T]) :- 1369 clean_history_prompt_chars(T0, T). 1370 1371delete_leading_blanks([' '|T0], T) :- 1372 !, 1373 delete_leading_blanks(T0, T). 1374delete_leading_blanks(L, L). 1375 1376 1377 /******************************* 1378 * TOPLEVEL DEBUG * 1379 *******************************/
thread_signal(main, gdebug)
1394save_debug_after_read :- 1395 current_prolog_flag(debug, true), 1396 !, 1397 save_debug. 1398save_debug_after_read. 1399 1400save_debug :- 1401 ( tracing, 1402 notrace 1403 -> Tracing = true 1404 ; Tracing = false 1405 ), 1406 current_prolog_flag(debug, Debugging), 1407 set_prolog_flag(debug, false), 1408 create_prolog_flag(query_debug_settings, 1409 debug(Debugging, Tracing), []). 1410 1411restore_debug :- 1412 current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)), 1413 set_prolog_flag(debug, Debugging), 1414 ( Tracing == true 1415 -> trace 1416 ; true 1417 ). 1418 1419:- initialization 1420 create_prolog_flag(query_debug_settings, debug(false, false), []). 1421 1422 1423 /******************************** 1424 * PROMPTING * 1425 ********************************/ 1426 1427'$system_prompt'(Module, BrekLev, Prompt) :- 1428 current_prolog_flag(toplevel_prompt, PAtom), 1429 atom_codes(PAtom, P0), 1430 ( Module \== user 1431 -> '$substitute'('~m', [Module, ': '], P0, P1) 1432 ; '$substitute'('~m', [], P0, P1) 1433 ), 1434 ( BrekLev > 0 1435 -> '$substitute'('~l', ['[', BrekLev, '] '], P1, P2) 1436 ; '$substitute'('~l', [], P1, P2) 1437 ), 1438 current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)), 1439 ( Tracing == true 1440 -> '$substitute'('~d', ['[trace] '], P2, P3) 1441 ; Debugging == true 1442 -> '$substitute'('~d', ['[debug] '], P2, P3) 1443 ; '$substitute'('~d', [], P2, P3) 1444 ), 1445 atom_chars(Prompt, P3). 1446 1447'$substitute'(From, T, Old, New) :- 1448 atom_codes(From, FromCodes), 1449 phrase(subst_chars(T), T0), 1450 '$append'(Pre, S0, Old), 1451 '$append'(FromCodes, Post, S0) -> 1452 '$append'(Pre, T0, S1), 1453 '$append'(S1, Post, New), 1454 !. 1455'$substitute'(_, _, Old, Old). 1456 1457subst_chars([]) --> 1458 []. 1459subst_chars([H|T]) --> 1460 { atomic(H), 1461 !, 1462 atom_codes(H, Codes) 1463 }, 1464 , 1465 subst_chars(T). 1466subst_chars([H|T]) --> 1467 , 1468 subst_chars(T). 1469 1470 1471 /******************************** 1472 * EXECUTION * 1473 ********************************/
1479'$execute_query'(Var, _, true) :- 1480 var(Var), 1481 !, 1482 print_message(informational, var_query(Var)). 1483'$execute_query'(Goal, Bindings, Truth) :- 1484 '$current_typein_module'(TypeIn), 1485 '$dwim_correct_goal'(TypeIn:Goal, Bindings, Corrected), 1486 !, 1487 setup_call_cleanup( 1488 '$set_source_module'(M0, TypeIn), 1489 expand_goal(Corrected, Expanded), 1490 '$set_source_module'(M0)), 1491 print_message(silent, toplevel_goal(Expanded, Bindings)), 1492 '$execute_goal2'(Expanded, Bindings, Truth). 1493'$execute_query'(_, _, false) :- 1494 notrace, 1495 print_message(query, query(no)). 1496 1497'$execute_goal2'(Goal, Bindings, true) :- 1498 restore_debug, 1499 '$current_typein_module'(TypeIn), 1500 residue_vars(TypeIn:Goal, Vars, TypeIn:Delays, Chp), 1501 deterministic(Det), 1502 ( save_debug 1503 ; restore_debug, fail 1504 ), 1505 flush_output(user_output), 1506 ( Det == true 1507 -> DetOrChp = true 1508 ; DetOrChp = Chp 1509 ), 1510 call_expand_answer(Goal, Bindings, NewBindings), 1511 ( \+ \+ write_bindings(NewBindings, Vars, Delays, DetOrChp) 1512 -> ! 1513 ). 1514'$execute_goal2'(_, _, false) :- 1515 save_debug, 1516 print_message(query, query(no)). 1517 1518residue_vars(Goal, Vars, Delays, Chp) :- 1519 current_prolog_flag(toplevel_residue_vars, true), 1520 !, 1521 '$wfs_call'(call_residue_vars(stop_backtrace(Goal, Chp), Vars), Delays). 1522residue_vars(Goal, [], Delays, Chp) :- 1523 '$wfs_call'(stop_backtrace(Goal, Chp), Delays). 1524 1525stop_backtrace(Goal, Chp) :- 1526 toplevel_call(Goal), 1527 prolog_current_choice(Chp). 1528 1529toplevel_call(Goal) :- 1530 call(Goal), 1531 no_lco. 1532 1533no_lco.
groundness gives the classical behaviour,
determinism is considered more adequate and informative.
Succeeds if the user accepts the answer and fails otherwise.
1549write_bindings(Bindings, ResidueVars, Delays, DetOrChp) :- 1550 '$current_typein_module'(TypeIn), 1551 translate_bindings(Bindings, Bindings1, ResidueVars, TypeIn:Residuals), 1552 omit_qualifier(Delays, TypeIn, Delays1), 1553 write_bindings2(Bindings, Bindings1, Residuals, Delays1, DetOrChp). 1554 1555write_bindings2(OrgBindings, [], Residuals, Delays, _) :- 1556 current_prolog_flag(prompt_alternatives_on, groundness), 1557 !, 1558 name_vars(OrgBindings, [], t(Residuals, Delays)), 1559 print_message(query, query(yes(Delays, Residuals))). 1560write_bindings2(OrgBindings, Bindings, Residuals, Delays, true) :- 1561 current_prolog_flag(prompt_alternatives_on, determinism), 1562 !, 1563 name_vars(OrgBindings, Bindings, t(Residuals, Delays)), 1564 print_message(query, query(yes(Bindings, Delays, Residuals))). 1565write_bindings2(OrgBindings, Bindings, Residuals, Delays, Chp) :- 1566 repeat, 1567 name_vars(OrgBindings, Bindings, t(Residuals, Delays)), 1568 print_message(query, query(more(Bindings, Delays, Residuals))), 1569 get_respons(Action, Chp), 1570 ( Action == redo 1571 -> !, fail 1572 ; Action == show_again 1573 -> fail 1574 ; !, 1575 print_message(query, query(done)) 1576 ).
_[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)
1592name_vars(OrgBindings, Bindings, Term) :- 1593 current_prolog_flag(toplevel_name_variables, true), 1594 answer_flags_imply_numbervars, 1595 !, 1596 '$term_multitons'(t(Bindings,Term), Vars), 1597 bindings_var_names(OrgBindings, Bindings, VarNames), 1598 name_vars_(Vars, VarNames, 0), 1599 term_variables(t(Bindings,Term), SVars), 1600 anon_vars(SVars). 1601name_vars(_OrgBindings, _Bindings, _Term). 1602 1603name_vars_([], _, _). 1604name_vars_([H|T], Bindings, N) :- 1605 name_var(Bindings, Name, N, N1), 1606 H = '$VAR'(Name), 1607 name_vars_(T, Bindings, N1). 1608 1609anon_vars([]). 1610anon_vars(['$VAR'('_')|T]) :- 1611 anon_vars(T).
1618name_var(Reserved, Name, N0, N) :-
1619 between(N0, infinite, N1),
1620 I is N1//26,
1621 J is 0'A + N1 mod 26,
1622 ( I == 0
1623 -> format(atom(Name), '_~c', [J])
1624 ; format(atom(Name), '_~c~d', [J, I])
1625 ),
1626 \+ memberchk(Name, Reserved),
1627 !,
1628 N is N1+1.
1637bindings_var_names(OrgBindings, TransBindings, VarNames) :-
1638 phrase(bindings_var_names_(OrgBindings), VarNames0, Tail),
1639 phrase(bindings_var_names_(TransBindings), Tail, []),
1640 sort(VarNames0, VarNames).1647bindings_var_names_([]) --> []. 1648bindings_var_names_([H|T]) --> 1649 binding_var_names(H), 1650 bindings_var_names_(T). 1651 1652binding_var_names(binding(Vars,_Value,_Subst)) ==> 1653 var_names(Vars). 1654binding_var_names(Name=_Value) ==> 1655 [Name]. 1656 1657var_names([]) --> []. 1658var_names([H|T]) --> [H], var_names(T).
1666answer_flags_imply_numbervars :- 1667 current_prolog_flag(answer_write_options, Options), 1668 numbervars_option(Opt), 1669 '$option'(Opt, Options), 1670 !. 1671 1672numbervars_option(portray(true)). 1673numbervars_option(portrayed(true)). 1674numbervars_option(numbervars(true)).
1681:- multifile 1682 residual_goal_collector/1. 1683 1684:- meta_predicate 1685 residual_goals(). 1686 1687residual_goals(NonTerminal) :- 1688 throw(error(context_error(nodirective, residual_goals(NonTerminal)), _)). 1689 1690systemterm_expansion((:- residual_goals(NonTerminal)), 1691 '$toplevel':residual_goal_collector(M2:Head)) :- 1692 \+ current_prolog_flag(xref, true), 1693 prolog_load_context(module, M), 1694 strip_module(M:NonTerminal, M2, Head), 1695 '$must_be'(callable, Head).
1702:- public prolog:residual_goals//0. 1703 1704prolog:residual_goals --> 1705 { findall(NT, residual_goal_collector(NT), NTL) }, 1706 collect_residual_goals(NTL). 1707 1708collect_residual_goals([]) --> []. 1709collect_residual_goals([H|T]) --> 1710 ( call(H) -> [] ; [] ), 1711 collect_residual_goals(T).
1736:- public 1737 prolog:translate_bindings/5. 1738:- meta_predicate 1739 prolog:translate_bindings(, , , , ). 1740 1741prologtranslate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals) :- 1742 translate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals), 1743 name_vars(Bindings0, Bindings, t(ResVars, ResGoals, Residuals)). 1744 1745% should not be required. 1746prologname_vars(Bindings, Term) :- name_vars([], Bindings, Term). 1747prologname_vars(Bindings0, Bindings, Term) :- name_vars(Bindings0, Bindings, Term). 1748 1749translate_bindings(Bindings0, Bindings, ResidueVars, Residuals) :- 1750 prolog:residual_goals(ResidueGoals, []), 1751 translate_bindings(Bindings0, Bindings, ResidueVars, ResidueGoals, 1752 Residuals). 1753 1754translate_bindings(Bindings0, Bindings, [], [], _:[]-[]) :- 1755 term_attvars(Bindings0, []), 1756 !, 1757 join_same_bindings(Bindings0, Bindings1), 1758 factorize_bindings(Bindings1, Bindings2), 1759 bind_vars(Bindings2, Bindings3), 1760 filter_bindings(Bindings3, Bindings). 1761translate_bindings(Bindings0, Bindings, ResidueVars, ResGoals0, 1762 TypeIn:Residuals-HiddenResiduals) :- 1763 project_constraints(Bindings0, ResidueVars), 1764 hidden_residuals(ResidueVars, Bindings0, HiddenResiduals0), 1765 omit_qualifiers(HiddenResiduals0, TypeIn, HiddenResiduals), 1766 copy_term(Bindings0+ResGoals0, Bindings1+ResGoals1, Residuals0), 1767 '$append'(ResGoals1, Residuals0, Residuals1), 1768 omit_qualifiers(Residuals1, TypeIn, Residuals), 1769 join_same_bindings(Bindings1, Bindings2), 1770 factorize_bindings(Bindings2, Bindings3), 1771 bind_vars(Bindings3, Bindings4), 1772 filter_bindings(Bindings4, Bindings). 1773 (ResidueVars, Bindings, Goal) :- 1775 term_attvars(ResidueVars, Remaining), 1776 term_attvars(Bindings, QueryVars), 1777 subtract_vars(Remaining, QueryVars, HiddenVars), 1778 copy_term(HiddenVars, _, Goal). 1779 1780subtract_vars(All, Subtract, Remaining) :- 1781 sort(All, AllSorted), 1782 sort(Subtract, SubtractSorted), 1783 ord_subtract(AllSorted, SubtractSorted, Remaining). 1784 1785ord_subtract([], _Not, []). 1786ord_subtract([H1|T1], L2, Diff) :- 1787 diff21(L2, H1, T1, Diff). 1788 1789diff21([], H1, T1, [H1|T1]). 1790diff21([H2|T2], H1, T1, Diff) :- 1791 compare(Order, H1, H2), 1792 diff3(Order, H1, T1, H2, T2, Diff). 1793 1794diff12([], _H2, _T2, []). 1795diff12([H1|T1], H2, T2, Diff) :- 1796 compare(Order, H1, H2), 1797 diff3(Order, H1, T1, H2, T2, Diff). 1798 1799diff3(<, H1, T1, H2, T2, [H1|Diff]) :- 1800 diff12(T1, H2, T2, Diff). 1801diff3(=, _H1, T1, _H2, T2, Diff) :- 1802 ord_subtract(T1, T2, Diff). 1803diff3(>, H1, T1, _H2, T2, Diff) :- 1804 diff21(T2, H1, T1, Diff).
toplevel_residue_vars is set to project.1812project_constraints(Bindings, ResidueVars) :- 1813 !, 1814 term_attvars(Bindings, AttVars), 1815 phrase(attribute_modules(AttVars), Modules0), 1816 sort(Modules0, Modules), 1817 term_variables(Bindings, QueryVars), 1818 project_attributes(Modules, QueryVars, ResidueVars). 1819project_constraints(_, _). 1820 1821project_attributes([], _, _). 1822project_attributes([M|T], QueryVars, ResidueVars) :- 1823 ( current_predicate(M:project_attributes/2), 1824 catch(M:project_attributes(QueryVars, ResidueVars), E, 1825 print_message(error, E)) 1826 -> true 1827 ; true 1828 ), 1829 project_attributes(T, QueryVars, ResidueVars). 1830 1831attribute_modules([]) --> []. 1832attribute_modules([H|T]) --> 1833 { get_attrs(H, Attrs) }, 1834 attrs_modules(Attrs), 1835 attribute_modules(T). 1836 1837attrs_modules([]) --> []. 1838attrs_modules(att(Module, _, More)) --> 1839 [Module], 1840 attrs_modules(More).
1851join_same_bindings([], []). 1852join_same_bindings([Name=V0|T0], [[Name|Names]=V|T]) :- 1853 take_same_bindings(T0, V0, V, Names, T1), 1854 join_same_bindings(T1, T). 1855 1856take_same_bindings([], Val, Val, [], []). 1857take_same_bindings([Name=V1|T0], V0, V, [Name|Names], T) :- 1858 V0 == V1, 1859 !, 1860 take_same_bindings(T0, V1, V, Names, T). 1861take_same_bindings([Pair|T0], V0, V, Names, [Pair|T]) :- 1862 take_same_bindings(T0, V0, V, Names, T).
1871omit_qualifiers([], _, []). 1872omit_qualifiers([Goal0|Goals0], TypeIn, [Goal|Goals]) :- 1873 omit_qualifier(Goal0, TypeIn, Goal), 1874 omit_qualifiers(Goals0, TypeIn, Goals). 1875 1876omit_qualifier(M:G0, TypeIn, G) :- 1877 M == TypeIn, 1878 !, 1879 omit_meta_qualifiers(G0, TypeIn, G). 1880omit_qualifier(M:G0, TypeIn, G) :- 1881 predicate_property(TypeIn:G0, imported_from(M)), 1882 \+ predicate_property(G0, transparent), 1883 !, 1884 G0 = G. 1885omit_qualifier(_:G0, _, G) :- 1886 predicate_property(G0, built_in), 1887 \+ predicate_property(G0, transparent), 1888 !, 1889 G0 = G. 1890omit_qualifier(M:G0, _, M:G) :- 1891 atom(M), 1892 !, 1893 omit_meta_qualifiers(G0, M, G). 1894omit_qualifier(G0, TypeIn, G) :- 1895 omit_meta_qualifiers(G0, TypeIn, G). 1896 1897omit_meta_qualifiers(V, _, V) :- 1898 var(V), 1899 !. 1900omit_meta_qualifiers((QA,QB), TypeIn, (A,B)) :- 1901 !, 1902 omit_qualifier(QA, TypeIn, A), 1903 omit_qualifier(QB, TypeIn, B). 1904omit_meta_qualifiers(tnot(QA), TypeIn, tnot(A)) :- 1905 !, 1906 omit_qualifier(QA, TypeIn, A). 1907omit_meta_qualifiers(freeze(V, QGoal), TypeIn, freeze(V, Goal)) :- 1908 callable(QGoal), 1909 !, 1910 omit_qualifier(QGoal, TypeIn, Goal). 1911omit_meta_qualifiers(when(Cond, QGoal), TypeIn, when(Cond, Goal)) :- 1912 callable(QGoal), 1913 !, 1914 omit_qualifier(QGoal, TypeIn, Goal). 1915omit_meta_qualifiers(G, _, G).
1924bind_vars(Bindings0, Bindings) :- 1925 bind_query_vars(Bindings0, Bindings, SNames), 1926 bind_skel_vars(Bindings, Bindings, SNames, 1, _). 1927 1928bind_query_vars([], [], []). 1929bind_query_vars([binding(Names,Var,[Var2=Cycle])|T0], 1930 [binding(Names,Cycle,[])|T], [Name|SNames]) :- 1931 Var == Var2, % also implies var(Var) 1932 !, 1933 '$last'(Names, Name), 1934 Var = '$VAR'(Name), 1935 bind_query_vars(T0, T, SNames). 1936bind_query_vars([B|T0], [B|T], AllNames) :- 1937 B = binding(Names,Var,Skel), 1938 bind_query_vars(T0, T, SNames), 1939 ( var(Var), \+ attvar(Var), Skel == [] 1940 -> AllNames = [Name|SNames], 1941 '$last'(Names, Name), 1942 Var = '$VAR'(Name) 1943 ; AllNames = SNames 1944 ). 1945 1946 1947 1948bind_skel_vars([], _, _, N, N). 1949bind_skel_vars([binding(_,_,Skel)|T], Bindings, SNames, N0, N) :- 1950 bind_one_skel_vars(Skel, Bindings, SNames, N0, N1), 1951 bind_skel_vars(T, Bindings, SNames, N1, N).
1970bind_one_skel_vars([], _, _, N, N). 1971bind_one_skel_vars([Var=Value|T], Bindings, Names, N0, N) :- 1972 ( var(Var) 1973 -> ( '$member'(binding(Names, VVal, []), Bindings), 1974 same_term(Value, VVal) 1975 -> '$last'(Names, VName), 1976 Var = '$VAR'(VName), 1977 N2 = N0 1978 ; between(N0, infinite, N1), 1979 atom_concat('_S', N1, Name), 1980 \+ memberchk(Name, Names), 1981 !, 1982 Var = '$VAR'(Name), 1983 N2 is N1 + 1 1984 ) 1985 ; N2 = N0 1986 ), 1987 bind_one_skel_vars(T, Bindings, Names, N2, N).
1994factorize_bindings([], []). 1995factorize_bindings([Name=Value|T0], [binding(Name, Skel, Subst)|T]) :- 1996 '$factorize_term'(Value, Skel, Subst0), 1997 ( current_prolog_flag(toplevel_print_factorized, true) 1998 -> Subst = Subst0 1999 ; only_cycles(Subst0, Subst) 2000 ), 2001 factorize_bindings(T0, T). 2002 2003 2004only_cycles([], []). 2005only_cycles([B|T0], List) :- 2006 ( B = (Var=Value), 2007 Var = Value, 2008 acyclic_term(Var) 2009 -> only_cycles(T0, List) 2010 ; List = [B|T], 2011 only_cycles(T0, T) 2012 ).
2021filter_bindings([], []). 2022filter_bindings([H0|T0], T) :- 2023 hide_vars(H0, H), 2024 ( ( arg(1, H, []) 2025 ; self_bounded(H) 2026 ) 2027 -> filter_bindings(T0, T) 2028 ; T = [H|T1], 2029 filter_bindings(T0, T1) 2030 ). 2031 2032hide_vars(binding(Names0, Skel, Subst), binding(Names, Skel, Subst)) :- 2033 hide_names(Names0, Skel, Subst, Names). 2034 2035hide_names([], _, _, []). 2036hide_names([Name|T0], Skel, Subst, T) :- 2037 ( sub_atom(Name, 0, _, _, '_'), 2038 current_prolog_flag(toplevel_print_anon, false), 2039 sub_atom(Name, 1, 1, _, Next), 2040 char_type(Next, prolog_var_start) 2041 -> true 2042 ; Subst == [], 2043 Skel == '$VAR'(Name) 2044 ), 2045 !, 2046 hide_names(T0, Skel, Subst, T). 2047hide_names([Name|T0], Skel, Subst, [Name|T]) :- 2048 hide_names(T0, Skel, Subst, T). 2049 2050self_bounded(binding([Name], Value, [])) :- 2051 Value == '$VAR'(Name).
2057:- if(current_prolog_flag(emscripten, true)). 2058get_respons(Action, Chp) :- 2059 '$can_yield', 2060 !, 2061 repeat, 2062 await(more, CommandS), 2063 atom_string(Command, CommandS), 2064 more_action(Command, Chp, Action), 2065 ( Action == again 2066 -> print_message(query, query(action)), 2067 fail 2068 ; ! 2069 ). 2070:- endif. 2071get_respons(Action, Chp) :- 2072 repeat, 2073 flush_output(user_output), 2074 get_single_char(Code), 2075 find_more_command(Code, Command, Feedback, Style), 2076 ( Style \== '-' 2077 -> print_message(query, if_tty([ansi(Style, '~w', [Feedback])])) 2078 ; true 2079 ), 2080 more_action(Command, Chp, Action), 2081 ( Action == again 2082 -> print_message(query, query(action)), 2083 fail 2084 ; ! 2085 ). 2086 2087find_more_command(-1, end_of_file, 'EOF', warning) :- 2088 !. 2089find_more_command(Code, Command, Feedback, Style) :- 2090 more_command(Command, Atom, Feedback, Style), 2091 '$in_reply'(Code, Atom), 2092 !. 2093find_more_command(Code, again, '', -) :- 2094 print_message(query, no_action(Code)). 2095 2096more_command(help, '?h', '', -). 2097more_command(redo, ';nrNR \t', ';', bold). 2098more_command(trace, 'tT', '; [trace]', comment). 2099more_command(continue, 'ca\n\ryY.', '.', bold). 2100more_command(break, 'b', '', -). 2101more_command(choicepoint, '*', '', -). 2102more_command(write, 'w', '[write]', comment). 2103more_command(print, 'p', '[print]', comment). 2104more_command(depth_inc, '+', Change, comment) :- 2105 ( print_depth(Depth0) 2106 -> depth_step(Step), 2107 NewDepth is Depth0*Step, 2108 format(atom(Change), '[max_depth(~D)]', [NewDepth]) 2109 ; Change = 'no max_depth' 2110 ). 2111more_command(depth_dec, '-', Change, comment) :- 2112 ( print_depth(Depth0) 2113 -> depth_step(Step), 2114 NewDepth is max(1, Depth0//Step), 2115 format(atom(Change), '[max_depth(~D)]', [NewDepth]) 2116 ; Change = '[max_depth(10)]' 2117 ). 2118 2119more_action(help, _, Action) => 2120 Action = again, 2121 print_message(help, query(help)). 2122more_action(redo, _, Action) => % Next 2123 Action = redo. 2124more_action(trace, _, Action) => 2125 Action = redo, 2126 trace, 2127 save_debug. 2128more_action(continue, _, Action) => % Stop 2129 Action = continue. 2130more_action(break, _, Action) => 2131 Action = show_again, 2132 break. 2133more_action(choicepoint, Chp, Action) => 2134 Action = show_again, 2135 print_last_chpoint(Chp). 2136more_action(end_of_file, _, Action) => 2137 Action = show_again, 2138 halt(0). 2139more_action(again, _, Action) => 2140 Action = again. 2141more_action(Command, _, Action), 2142 current_prolog_flag(answer_write_options, Options0), 2143 print_predicate(Command, Options0, Options) => 2144 Action = show_again, 2145 set_prolog_flag(answer_write_options, Options). 2146 2147print_depth(Depth) :- 2148 current_prolog_flag(answer_write_options, Options), 2149 '$option'(max_depth(Depth), Options), 2150 !.
answer_write_options value according to the user
command.2157print_predicate(write, Options0, Options) :- 2158 edit_options([-portrayed(true),-portray(true)], 2159 Options0, Options). 2160print_predicate(print, Options0, Options) :- 2161 edit_options([+portrayed(true)], 2162 Options0, Options). 2163print_predicate(depth_inc, Options0, Options) :- 2164 ( '$select'(max_depth(D0), Options0, Options1) 2165 -> depth_step(Step), 2166 D is D0*Step, 2167 Options = [max_depth(D)|Options1] 2168 ; Options = Options0 2169 ). 2170print_predicate(depth_dec, Options0, Options) :- 2171 ( '$select'(max_depth(D0), Options0, Options1) 2172 -> depth_step(Step), 2173 D is max(1, D0//Step), 2174 Options = [max_depth(D)|Options1] 2175 ; D = 10, 2176 Options = [max_depth(D)|Options0] 2177 ). 2178 2179depth_step(5). 2180 2181edit_options([], Options, Options). 2182edit_options([H|T], Options0, Options) :- 2183 edit_option(H, Options0, Options1), 2184 edit_options(T, Options1, Options). 2185 2186edit_option(-Term, Options0, Options) => 2187 ( '$select'(Term, Options0, Options) 2188 -> true 2189 ; Options = Options0 2190 ). 2191edit_option(+Term, Options0, Options) => 2192 functor(Term, Name, 1), 2193 functor(Var, Name, 1), 2194 ( '$select'(Var, Options0, Options1) 2195 -> Options = [Term|Options1] 2196 ; Options = [Term|Options0] 2197 ).
2203print_last_chpoint(Chp) :- 2204 current_predicate(print_last_choice_point/0), 2205 !, 2206 print_last_chpoint_(Chp). 2207print_last_chpoint(Chp) :- 2208 use_module(library(prolog_stack), [print_last_choicepoint/2]), 2209 print_last_chpoint_(Chp). 2210 2211print_last_chpoint_(Chp) :- 2212 print_last_choicepoint(Chp, [message_level(information)]). 2213 2214 2215 /******************************* 2216 * EXPANSION * 2217 *******************************/ 2218 2219:- user:dynamic(expand_query/4). 2220:- user:multifile(expand_query/4). 2221 2222call_expand_query(Goal, Expanded, Bindings, ExpandedBindings) :- 2223 ( '$replace_toplevel_vars'(Goal, Expanded0, Bindings, ExpandedBindings0) 2224 -> true 2225 ; Expanded0 = Goal, ExpandedBindings0 = Bindings 2226 ), 2227 ( user:expand_query(Expanded0, Expanded, ExpandedBindings0, ExpandedBindings) 2228 -> true 2229 ; Expanded = Expanded0, ExpandedBindings = ExpandedBindings0 2230 ). 2231 2232 2233:- dynamic 2234 user:expand_answer/2, 2235 prolog:expand_answer/3. 2236:- multifile 2237 user:expand_answer/2, 2238 prolog:expand_answer/3. 2239 2240call_expand_answer(Goal, BindingsIn, BindingsOut) :- 2241 ( prolog:expand_answer(Goal, BindingsIn, BindingsOut) 2242 -> true 2243 ; user:expand_answer(BindingsIn, BindingsOut) 2244 -> true 2245 ; BindingsOut = BindingsIn 2246 ), 2247 '$save_toplevel_vars'(BindingsOut), 2248 !. 2249call_expand_answer(_, Bindings, Bindings)