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-2017, University of Amsterdam 7 VU University Amsterdam 8 All rights reserved. 9 10 Redistribution and use in source and binary forms, with or without 11 modification, are permitted provided that the following conditions 12 are met: 13 14 1. Redistributions of source code must retain the above copyright 15 notice, this list of conditions and the following disclaimer. 16 17 2. Redistributions in binary form must reproduce the above copyright 18 notice, this list of conditions and the following disclaimer in 19 the documentation and/or other materials provided with the 20 distribution. 21 22 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 23 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 24 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 25 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 26 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 27 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 28 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 29 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 30 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 31 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 32 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 33 POSSIBILITY OF SUCH DAMAGE. 34*/ 35 36:- module('$toplevel', 37 [ '$initialise'/0, % start Prolog 38 '$toplevel'/0, % Prolog top-level (re-entrant) 39 '$compile'/0, % `-c' toplevel 40 '$config'/0, % --dump-runtime-variables toplevel 41 initialize/0, % Run program initialization 42 version/0, % Write initial banner 43 version/1, % Add message to the banner 44 prolog/0, % user toplevel predicate 45 '$query_loop'/0, % toplevel predicate 46 residual_goals/1, % +Callable 47 (initialization)/1, % initialization goal (directive) 48 '$thread_init'/0, % initialise thread 49 (thread_initialization)/1 % thread initialization goal 50 ]). 51 52 53 /******************************* 54 * FILE_SEARCH_PATH * 55 *******************************/ 56 57:- multifile user:file_search_path/2. 58 59user:file_search_path(app_data, PrologAppData) :- 60 ( current_prolog_flag(windows, true) 61 -> catch(win_folder(appdata, AppData), _, fail), 62 atom_concat(AppData, '/SWI-Prolog', PrologAppData), 63 ( exists_directory(PrologAppData) 64 -> true 65 ; catch(make_directory(PrologAppData), _, fail) 66 ) 67 ; catch(expand_file_name('~/lib/swipl', [PrologAppData]), _, fail) 68 ). 69user:file_search_path(app_preferences, Preferences) :- 70 ( current_prolog_flag(windows, true) 71 -> Preferences = app_data('.') 72 ; catch(expand_file_name(~, [UserHome]), _, fail) 73 -> Preferences = UserHome 74 ). 75user:file_search_path(user_profile, app_preferences('.')). 76 77 78 /******************************* 79 * VERSION BANNER * 80 *******************************/ 81 82:- dynamic 83 prolog:version_msg/1.
90version :-
91 print_message(banner, welcome).
97:- multifile 98 system:term_expansion/2. 99 100systemterm_expansion((:- version(Message)), 101 prolog:version_msg(Message)). 102 103version(Message) :- 104 ( prolog:version_msg(Message) 105 -> true 106 ; assertz(prolog:version_msg(Message)) 107 ). 108 109 110 /******************************** 111 * INITIALISATION * 112 *********************************/ 113 114% note: loaded_init_file/2 is used by prolog_load_context/2 to 115% confirm we are loading a script. 116 117:- dynamic 118 loaded_init_file/2. % already loaded init files 119 120'$load_init_file'(none) :- !. 121'$load_init_file'(Base) :- 122 loaded_init_file(Base, _), 123 !. 124'$load_init_file'(InitFile) :- 125 exists_file(InitFile), 126 !, 127 ensure_loaded(user:InitFile). 128'$load_init_file'(Base) :- 129 absolute_file_name(user_profile(Base), InitFile, 130 [ access(read), 131 file_errors(fail) 132 ]), 133 asserta(loaded_init_file(Base, InitFile)), 134 load_files(user:InitFile, 135 [ scope_settings(false) 136 ]). 137'$load_init_file'(_). 138 139'$load_system_init_file' :- 140 loaded_init_file(system, _), 141 !. 142'$load_system_init_file' :- 143 '$cmd_option_val'(system_init_file, Base), 144 Base \== none, 145 current_prolog_flag(home, Home), 146 file_name_extension(Base, rc, Name), 147 atomic_list_concat([Home, '/', Name], File), 148 absolute_file_name(File, Path, 149 [ file_type(prolog), 150 access(read), 151 file_errors(fail) 152 ]), 153 asserta(loaded_init_file(system, Path)), 154 load_files(user:Path, 155 [ silent(true), 156 scope_settings(false) 157 ]), 158 !. 159'$load_system_init_file'. 160 161'$load_script_file' :- 162 loaded_init_file(script, _), 163 !. 164'$load_script_file' :- 165 '$cmd_option_val'(script_file, OsFiles), 166 load_script_files(OsFiles). 167 168load_script_files([]). 169load_script_files([OsFile|More]) :- 170 prolog_to_os_filename(File, OsFile), 171 ( absolute_file_name(File, Path, 172 [ file_type(prolog), 173 access(read), 174 file_errors(fail) 175 ]) 176 -> asserta(loaded_init_file(script, Path)), 177 load_files(user:Path, []), 178 load_files(More) 179 ; throw(error(existence_error(script_file, File), _)) 180 ). 181 182 183 /******************************* 184 * AT_INITIALISATION * 185 *******************************/ 186 187:- meta_predicate 188 initialization( ). 189 190:- '$iso'((initialization)/1).
199initialization(Goal) :- 200 Goal = _:G, 201 prolog:initialize_now(G, Use), 202 !, 203 print_message(warning, initialize_now(G, Use)), 204 initialization(Goal, now). 205initialization(Goal) :- 206 initialization(Goal, after_load). 207 208:- multifile 209 prolog:initialize_now/2, 210 prolog:message//1. 211 212prologinitialize_now(load_foreign_library(_), 213 'use :- use_foreign_library/1 instead'). 214prologinitialize_now(load_foreign_library(_,_), 215 'use :- use_foreign_library/2 instead'). 216 217prologmessage(initialize_now(Goal, Use)) --> 218 [ 'Initialization goal ~p will be executed'-[Goal],nl, 219 'immediately for backward compatibility reasons', nl, 220 '~w'-[Use] 221 ]. 222 223'$run_initialization' :- 224 '$run_initialization'(_, []), 225 '$thread_init'.
:- initialization(Goal, program).
. Stop
with an exception if a goal fails or raises an exception.232initialize :- 233 forall('$init_goal'(when(program), Goal, Ctx), 234 run_initialize(Goal, Ctx)). 235 236run_initialize(Goal, Ctx) :- 237 ( catch(Goal, E, true), 238 ( var(E) 239 -> true 240 ; throw(error(initialization_error(E, Goal, Ctx), _)) 241 ) 242 ; throw(error(initialization_error(failed, Goal, Ctx), _)) 243 ). 244 245 246 /******************************* 247 * THREAD INITIALIZATION * 248 *******************************/ 249 250:- meta_predicate 251 thread_initialization( ). 252:- dynamic 253 '$at_thread_initialization'/1.
259thread_initialization(Goal) :- 260 assert('$at_thread_initialization'(Goal)), 261 call(Goal), 262 !. 263 264'$thread_init' :- 265 ( '$at_thread_initialization'(Goal), 266 ( call(Goal) 267 -> fail 268 ; fail 269 ) 270 ; true 271 ). 272 273 274 /******************************* 275 * FILE SEARCH PATH (-p) * 276 *******************************/
282'$set_file_search_paths' :- 283 '$cmd_option_val'(search_paths, Paths), 284 ( '$member'(Path, Paths), 285 atom_chars(Path, Chars), 286 ( phrase('$search_path'(Name, Aliases), Chars) 287 -> '$reverse'(Aliases, Aliases1), 288 forall('$member'(Alias, Aliases1), 289 asserta(user:file_search_path(Name, Alias))) 290 ; print_message(error, commandline_arg_type(p, Path)) 291 ), 292 fail ; true 293 ). 294 295'$search_path'(Name, Aliases) --> 296 '$string'(NameChars), 297 [=], 298 !, 299 {atom_chars(Name, NameChars)}, 300 '$search_aliases'(Aliases). 301 302'$search_aliases'([Alias|More]) --> 303 '$string'(AliasChars), 304 path_sep, 305 !, 306 { '$make_alias'(AliasChars, Alias) }, 307 '$search_aliases'(More). 308'$search_aliases'([Alias]) --> 309 '$string'(AliasChars), 310 '$eos', 311 !, 312 { '$make_alias'(AliasChars, Alias) }. 313 314path_sep --> 315 { current_prolog_flag(windows, true) 316 }, 317 !, 318 [;]. 319path_sep --> 320 [:]. 321 322'$string'([]) --> []. 323'$string'([H|T]) --> [H], '$string'(T). 324 325'$eos'([], []). 326 327'$make_alias'(Chars, Alias) :- 328 catch(term_to_atom(Alias, Chars), _, fail), 329 ( atom(Alias) 330 ; functor(Alias, F, 1), 331 F \== / 332 ), 333 !. 334'$make_alias'(Chars, Alias) :- 335 atom_chars(Alias, Chars). 336 337 338 /******************************* 339 * LOADING ASSIOCIATED FILES * 340 *******************************/
argv
, extracting the leading directory and
files.347argv_files(Files) :- 348 current_prolog_flag(argv, Argv), 349 no_option_files(Argv, Argv1, Files), 350 ( Argv1 \== Argv 351 -> set_prolog_flag(argv, Argv1) 352 ; true 353 ). 354 355no_option_files([--|Argv], Argv, []) :- !. 356no_option_files([OsScript|Argv], Argv, [Script]) :- 357 prolog_to_os_filename(Script, OsScript), 358 access_file(Script, read), 359 catch(setup_call_cleanup( 360 open(Script, read, In), 361 ( get_char(In, '#'), 362 get_char(In, '!') 363 ), 364 close(In)), 365 _, fail), 366 !. 367no_option_files([OsFile|Argv0], Argv, [File|T]) :- 368 file_name_extension(_, Ext, OsFile), 369 user:prolog_file_type(Ext, prolog), 370 !, 371 prolog_to_os_filename(File, OsFile), 372 no_option_files(Argv0, Argv, T). 373no_option_files(Argv, Argv, []). 374 375clean_argv :- 376 ( current_prolog_flag(argv, [--|Argv]) 377 -> set_prolog_flag(argv, Argv) 378 ; true 379 ).
388associated_files([]) :- 389 current_prolog_flag(saved_program_class, runtime), 390 !, 391 clean_argv. 392associated_files(Files) :- 393 '$set_prolog_file_extension', 394 argv_files(Files), 395 ( Files = [File|_] 396 -> absolute_file_name(File, AbsFile), 397 set_prolog_flag(associated_file, AbsFile), 398 set_working_directory(File), 399 set_window_title(Files) 400 ; true 401 ).
console_menu
,
which is set by swipl-win[.exe].411set_working_directory(File) :- 412 current_prolog_flag(console_menu, true), 413 access_file(File, read), 414 !, 415 file_directory_name(File, Dir), 416 working_directory(_, Dir). 417set_working_directory(_). 418 419set_window_title([File|More]) :- 420 current_predicate(system:window_title/2), 421 !, 422 ( More == [] 423 -> Extra = [] 424 ; Extra = ['...'] 425 ), 426 atomic_list_concat(['SWI-Prolog --', File | Extra], ' ', Title), 427 system:window_title(_, Title). 428set_window_title(_).
--pldoc[=port]
is given, load the PlDoc
system.436start_pldoc :- 437 '$cmd_option_val'(pldoc_server, Server), 438 ( Server == '' 439 -> call((doc_server(_), doc_browser)) 440 ; catch(atom_number(Server, Port), _, fail) 441 -> call(doc_server(Port)) 442 ; print_message(error, option_usage(pldoc)), 443 halt(1) 444 ). 445start_pldoc.
452load_associated_files(Files) :- 453 ( '$member'(File, Files), 454 load_files(user:File, [expand(false)]), 455 fail 456 ; true 457 ). 458 459hkey('HKEY_CURRENT_USER/Software/SWI/Prolog'). 460hkey('HKEY_LOCAL_MACHINE/Software/SWI/Prolog'). 461 462'$set_prolog_file_extension' :- 463 current_prolog_flag(windows, true), 464 hkey(Key), 465 catch(win_registry_get_value(Key, fileExtension, Ext0), 466 _, fail), 467 !, 468 ( atom_concat('.', Ext, Ext0) 469 -> true 470 ; Ext = Ext0 471 ), 472 ( user:prolog_file_type(Ext, prolog) 473 -> true 474 ; asserta(user:prolog_file_type(Ext, prolog)) 475 ). 476'$set_prolog_file_extension'. 477 478 479 /******************************** 480 * TOPLEVEL GOALS * 481 *********************************/
489'$initialise' :- 490 catch(initialise_prolog, E, initialise_error(E)). 491 492initialise_error('$aborted') :- !. 493initialise_error(E) :- 494 print_message(error, initialization_exception(E)), 495 fail. 496 497initialise_prolog :- 498 '$clean_history', 499 '$run_initialization', 500 '$load_system_init_file', 501 set_toplevel, 502 associated_files(Files), 503 '$set_file_search_paths', 504 init_debug_flags, 505 start_pldoc, 506 attach_packs, 507 '$cmd_option_val'(init_file, OsFile), 508 prolog_to_os_filename(File, OsFile), 509 '$load_init_file'(File), 510 catch(setup_colors, E, print_message(warning, E)), 511 '$load_script_file', 512 load_associated_files(Files), 513 '$cmd_option_val'(goals, Goals), 514 ( Goals == [], 515 \+ '$init_goal'(when(_), _, _) 516 -> version % default interactive run 517 ; run_init_goals(Goals), 518 ( load_only 519 -> version 520 ; run_program_init, 521 run_main_init 522 ) 523 ). 524 525set_toplevel :- 526 '$cmd_option_val'(toplevel, TopLevelAtom), 527 catch(term_to_atom(TopLevel, TopLevelAtom), E, 528 (print_message(error, E), 529 halt(1))), 530 create_prolog_flag(toplevel_goal, TopLevel, [type(term)]). 531 532load_only :- 533 current_prolog_flag(os_argv, OSArgv), 534 memberchk('-l', OSArgv), 535 current_prolog_flag(argv, Argv), 536 \+ memberchk('-l', Argv).
543run_init_goals([]). 544run_init_goals([H|T]) :- 545 run_init_goal(H), 546 run_init_goals(T). 547 548run_init_goal(Text) :- 549 catch(term_to_atom(Goal, Text), E, 550 ( print_message(error, init_goal_syntax(E, Text)), 551 halt(2) 552 )), 553 run_init_goal(Goal, Text).
559run_program_init :- 560 forall('$init_goal'(when(program), Goal, Ctx), 561 run_init_goal(Goal, @(Goal,Ctx))). 562 563run_main_init :- 564 findall(Goal-Ctx, '$init_goal'(when(main), Goal, Ctx), Pairs), 565 '$last'(Pairs, Goal-Ctx), 566 !, 567 ( current_prolog_flag(toplevel_goal, default) 568 -> set_prolog_flag(toplevel_goal, halt) 569 ; true 570 ), 571 run_init_goal(Goal, @(Goal,Ctx)). 572run_main_init. 573 574run_init_goal(Goal, Ctx) :- 575 ( catch_with_backtrace(user:Goal, E, true) 576 -> ( var(E) 577 -> true 578 ; print_message(error, init_goal_failed(E, Ctx)), 579 halt(2) 580 ) 581 ; ( current_prolog_flag(verbose, silent) 582 -> Level = silent 583 ; Level = error 584 ), 585 print_message(Level, init_goal_failed(failed, Ctx)), 586 halt(1) 587 ).
594init_debug_flags :-
595 once(print_predicate(_, [print], PrintOptions)),
596 create_prolog_flag(answer_write_options, PrintOptions, []),
597 create_prolog_flag(prompt_alternatives_on, determinism, []),
598 create_prolog_flag(toplevel_extra_white_line, true, []),
599 create_prolog_flag(toplevel_print_factorized, false, []),
600 create_prolog_flag(print_write_options,
601 [ portray(true), quoted(true), numbervars(true) ],
602 []),
603 create_prolog_flag(toplevel_residue_vars, false, []),
604 '$set_debugger_write_options'(print).
610setup_backtrace :-
611 ( \+ current_prolog_flag(backtrace, false),
612 load_setup_file(library(prolog_stack))
613 -> true
614 ; true
615 ).
621setup_colors :-
622 ( \+ current_prolog_flag(color_term, false),
623 stream_property(user_input, tty(true)),
624 stream_property(user_error, tty(true)),
625 stream_property(user_output, tty(true)),
626 load_setup_file(user:library(ansi_term))
627 -> true
628 ; true
629 ).
635setup_history :-
636 ( \+ current_prolog_flag(save_history, false),
637 stream_property(user_input, tty(true)),
638 \+ current_prolog_flag(readline, false),
639 load_setup_file(library(prolog_history))
640 -> prolog_history(enable)
641 ; true
642 ),
643 set_default_history,
644 '$load_history'.
650setup_readline :- 651 ( current_prolog_flag(readline, swipl_win) 652 -> true 653 ; stream_property(user_input, tty(true)), 654 current_prolog_flag(tty_control, true), 655 \+ getenv('TERM', dumb), 656 ( current_prolog_flag(readline, ReadLine) 657 -> true 658 ; ReadLine = true 659 ), 660 readline_library(ReadLine, Library), 661 load_setup_file(library(Library)) 662 -> set_prolog_flag(readline, Library) 663 ; set_prolog_flag(readline, false) 664 ). 665 666readline_library(true, Library) :- 667 !, 668 preferred_readline(Library). 669readline_library(false, _) :- 670 !, 671 fail. 672readline_library(Library, Library). 673 674preferred_readline(editline). 675preferred_readline(readline).
681load_setup_file(File) :- 682 catch(load_files(File, 683 [ silent(true), 684 if(not_loaded) 685 ]), _, fail). 686 687 688:- '$hide'('$toplevel'/0). % avoid in the GUI stacktrace
694'$toplevel' :-
695 '$runtoplevel',
696 print_message(informational, halt).
default
and prolog
both
start the interactive toplevel, where prolog
implies the user gave
-t prolog
.
706'$runtoplevel' :- 707 current_prolog_flag(toplevel_goal, TopLevel0), 708 toplevel_goal(TopLevel0, TopLevel), 709 user:TopLevel. 710 711:- dynamic setup_done/0. 712:- volatile setup_done/0. 713 714toplevel_goal(default, '$query_loop') :- 715 !, 716 setup_interactive. 717toplevel_goal(prolog, '$query_loop') :- 718 !, 719 setup_interactive. 720toplevel_goal(Goal, Goal). 721 722setup_interactive :- 723 setup_done, 724 !. 725setup_interactive :- 726 asserta(setup_done), 727 catch(setup_backtrace, E, print_message(warning, E)), 728 catch(setup_readline, E, print_message(warning, E)), 729 catch(setup_history, E, print_message(warning, E)).
735'$compile' :-
736 '$load_system_init_file',
737 '$set_file_search_paths',
738 init_debug_flags,
739 '$run_initialization',
740 attach_packs,
741 use_module(library(qsave)),
742 catch(qsave:qsave_toplevel, E, (print_message(error, E), halt(1))).
748'$config' :- 749 '$load_system_init_file', 750 '$set_file_search_paths', 751 init_debug_flags, 752 '$run_initialization', 753 load_files(library(prolog_config)), 754 ( catch(prolog_dump_runtime_variables, E, 755 (print_message(error, E), halt(1))) 756 -> true 757 ; print_message(error, error(goal_failed(prolog_dump_runtime_variables),_)) 758 ). 759 760 761 /******************************** 762 * USER INTERACTIVE LOOP * 763 *********************************/
771prolog :- 772 break. 773 774:- create_prolog_flag(toplevel_mode, backtracking, []).
query_loop()
. This ensures that unhandled
exceptions are really unhandled (in Prolog).783'$query_loop' :- 784 current_prolog_flag(toplevel_mode, recursive), 785 !, 786 break_level(Level), 787 read_expanded_query(Level, Query, Bindings), 788 ( Query == end_of_file 789 -> print_message(query, query(eof)) 790 ; '$call_no_catch'('$execute'(Query, Bindings)), 791 ( current_prolog_flag(toplevel_mode, recursive) 792 -> '$query_loop' 793 ; '$switch_toplevel_mode'(backtracking), 794 '$query_loop' % Maybe throw('$switch_toplevel_mode')? 795 ) 796 ). 797'$query_loop' :- 798 break_level(BreakLev), 799 repeat, 800 read_expanded_query(BreakLev, Query, Bindings), 801 ( Query == end_of_file 802 -> !, print_message(query, query(eof)) 803 ; '$execute'(Query, Bindings), 804 ( current_prolog_flag(toplevel_mode, recursive) 805 -> !, 806 '$switch_toplevel_mode'(recursive), 807 '$query_loop' 808 ; fail 809 ) 810 ). 811 812break_level(BreakLev) :- 813 ( current_prolog_flag(break_level, BreakLev) 814 -> true 815 ; BreakLev = -1 816 ). 817 818read_expanded_query(BreakLev, ExpandedQuery, ExpandedBindings) :- 819 '$current_typein_module'(TypeIn), 820 ( stream_property(user_input, tty(true)) 821 -> '$system_prompt'(TypeIn, BreakLev, Prompt), 822 prompt(Old, '| ') 823 ; Prompt = '', 824 prompt(Old, '') 825 ), 826 trim_stacks, 827 repeat, 828 read_query(Prompt, Query, Bindings), 829 prompt(_, Old), 830 catch(call_expand_query(Query, ExpandedQuery, 831 Bindings, ExpandedBindings), 832 Error, 833 (print_message(error, Error), fail)), 834 !.
843read_query(Prompt, Goal, Bindings) :- 844 current_prolog_flag(history, N), 845 integer(N), N > 0, 846 !, 847 read_history(h, '!h', 848 [trace, end_of_file], 849 Prompt, Goal, Bindings). 850read_query(Prompt, Goal, Bindings) :- 851 remove_history_prompt(Prompt, Prompt1), 852 repeat, % over syntax errors 853 prompt1(Prompt1), 854 read_query_line(user_input, Line), 855 '$save_history_line'(Line), % save raw line (edit syntax errors) 856 '$current_typein_module'(TypeIn), 857 catch(read_term_from_atom(Line, Goal, 858 [ variable_names(Bindings), 859 module(TypeIn) 860 ]), E, 861 ( print_message(error, E), 862 fail 863 )), 864 !, 865 '$save_history_event'(Line). % save event (no syntax errors)
869read_query_line(Input, Line) :-
870 catch(read_term_as_atom(Input, Line), Error, true),
871 save_debug_after_read,
872 ( var(Error)
873 -> true
874 ; Error = error(syntax_error(_),_)
875 -> print_message(error, Error),
876 fail
877 ; print_message(error, Error),
878 throw(Error)
879 ).
886read_term_as_atom(In, Line) :-
887 '$raw_read'(In, Line),
888 ( Line == end_of_file
889 -> true
890 ; skip_to_nl(In)
891 ).
898skip_to_nl(In) :- 899 repeat, 900 peek_char(In, C), 901 ( C == '%' 902 -> skip(In, '\n') 903 ; char_type(C, space) 904 -> get_char(In, _), 905 C == '\n' 906 ; true 907 ), 908 !. 909 910remove_history_prompt('', '') :- !. 911remove_history_prompt(Prompt0, Prompt) :- 912 atom_chars(Prompt0, Chars0), 913 clean_history_prompt_chars(Chars0, Chars1), 914 delete_leading_blanks(Chars1, Chars), 915 atom_chars(Prompt, Chars). 916 917clean_history_prompt_chars([], []). 918clean_history_prompt_chars(['~', !|T], T) :- !. 919clean_history_prompt_chars([H|T0], [H|T]) :- 920 clean_history_prompt_chars(T0, T). 921 922delete_leading_blanks([' '|T0], T) :- 923 !, 924 delete_leading_blanks(T0, T). 925delete_leading_blanks(L, L).
934set_default_history :- 935 current_prolog_flag(history, _), 936 !. 937set_default_history :- 938 ( ( \+ current_prolog_flag(readline, false) 939 ; current_prolog_flag(emacs_inferior_process, true) 940 ) 941 -> create_prolog_flag(history, 0, []) 942 ; create_prolog_flag(history, 25, []) 943 ). 944 945 946 /******************************* 947 * TOPLEVEL DEBUG * 948 *******************************/
thread_signal(main, gdebug)
963save_debug_after_read :- 964 current_prolog_flag(debug, true), 965 !, 966 save_debug. 967save_debug_after_read. 968 969save_debug :- 970 ( tracing, 971 notrace 972 -> Tracing = true 973 ; Tracing = false 974 ), 975 current_prolog_flag(debug, Debugging), 976 set_prolog_flag(debug, false), 977 create_prolog_flag(query_debug_settings, 978 debug(Debugging, Tracing), []). 979 980restore_debug :- 981 current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)), 982 set_prolog_flag(debug, Debugging), 983 ( Tracing == true 984 -> trace 985 ; true 986 ). 987 988:- initialization 989 create_prolog_flag(query_debug_settings, debug(false, false), []). 990 991 992 /******************************** 993 * PROMPTING * 994 ********************************/ 995 996'$system_prompt'(Module, BrekLev, Prompt) :- 997 current_prolog_flag(toplevel_prompt, PAtom), 998 atom_codes(PAtom, P0), 999 ( Module \== user 1000 -> '$substitute'('~m', [Module, ': '], P0, P1) 1001 ; '$substitute'('~m', [], P0, P1) 1002 ), 1003 ( BrekLev > 0 1004 -> '$substitute'('~l', ['[', BrekLev, '] '], P1, P2) 1005 ; '$substitute'('~l', [], P1, P2) 1006 ), 1007 current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)), 1008 ( Tracing == true 1009 -> '$substitute'('~d', ['[trace] '], P2, P3) 1010 ; Debugging == true 1011 -> '$substitute'('~d', ['[debug] '], P2, P3) 1012 ; '$substitute'('~d', [], P2, P3) 1013 ), 1014 atom_chars(Prompt, P3). 1015 1016'$substitute'(From, T, Old, New) :- 1017 atom_codes(From, FromCodes), 1018 phrase(subst_chars(T), T0), 1019 '$append'(Pre, S0, Old), 1020 '$append'(FromCodes, Post, S0) -> 1021 '$append'(Pre, T0, S1), 1022 '$append'(S1, Post, New), 1023 !. 1024'$substitute'(_, _, Old, Old). 1025 1026subst_chars([]) --> 1027 []. 1028subst_chars([H|T]) --> 1029 { atomic(H), 1030 !, 1031 atom_codes(H, Codes) 1032 }, 1033 , 1034 subst_chars(T). 1035subst_chars([H|T]) --> 1036 , 1037 subst_chars(T). 1038 1039 1040 /******************************** 1041 * EXECUTION * 1042 ********************************/
1048'$execute'(Var, _) :- 1049 var(Var), 1050 !, 1051 print_message(informational, var_query(Var)). 1052'$execute'(Goal, Bindings) :- 1053 '$current_typein_module'(TypeIn), 1054 '$dwim_correct_goal'(TypeIn:Goal, Bindings, Corrected), 1055 !, 1056 setup_call_cleanup( 1057 '$set_source_module'(M0, TypeIn), 1058 expand_goal(Corrected, Expanded), 1059 '$set_source_module'(M0)), 1060 print_message(silent, toplevel_goal(Expanded, Bindings)), 1061 '$execute_goal2'(Expanded, Bindings). 1062'$execute'(_, _) :- 1063 notrace, 1064 print_message(query, query(no)). 1065 1066'$execute_goal2'(Goal, Bindings) :- 1067 restore_debug, 1068 residue_vars(Goal, Vars), 1069 deterministic(Det), 1070 ( save_debug 1071 ; restore_debug, fail 1072 ), 1073 flush_output(user_output), 1074 call_expand_answer(Bindings, NewBindings), 1075 ( \+ \+ write_bindings(NewBindings, Vars, Det) 1076 -> ! 1077 ). 1078'$execute_goal2'(_, _) :- 1079 save_debug, 1080 print_message(query, query(no)). 1081 1082residue_vars(Goal, Vars) :- 1083 current_prolog_flag(toplevel_residue_vars, true), 1084 !, 1085 call_residue_vars(Goal, Vars). 1086residue_vars(Goal, []) :- 1087 toplevel_call(Goal). 1088 1089toplevel_call(Goal) :- 1090 call(Goal), 1091 no_lco. 1092 1093no_lco.
groundness
gives the classical behaviour,
determinism
is considered more adequate and informative.
Succeeds if the user accepts the answer and fails otherwise.
1108write_bindings(Bindings, ResidueVars, Det) :- 1109 '$current_typein_module'(TypeIn), 1110 translate_bindings(Bindings, Bindings1, ResidueVars, TypeIn:Residuals), 1111 write_bindings2(Bindings1, Residuals, Det). 1112 1113write_bindings2([], Residuals, _) :- 1114 current_prolog_flag(prompt_alternatives_on, groundness), 1115 !, 1116 print_message(query, query(yes(Residuals))). 1117write_bindings2(Bindings, Residuals, true) :- 1118 current_prolog_flag(prompt_alternatives_on, determinism), 1119 !, 1120 print_message(query, query(yes(Bindings, Residuals))). 1121write_bindings2(Bindings, Residuals, _Det) :- 1122 repeat, 1123 print_message(query, query(more(Bindings, Residuals))), 1124 get_respons(Action), 1125 ( Action == redo 1126 -> !, fail 1127 ; Action == show_again 1128 -> fail 1129 ; !, 1130 print_message(query, query(done)) 1131 ).
1138:- multifile 1139 residual_goal_collector/1. 1140 1141:- meta_predicate 1142 residual_goals( ). 1143 1144residual_goals(NonTerminal) :- 1145 throw(error(context_error(nodirective, residual_goals(NonTerminal)), _)). 1146 1147systemterm_expansion((:- residual_goals(NonTerminal)), 1148 '$toplevel':residual_goal_collector(M2:Head)) :- 1149 prolog_load_context(module, M), 1150 strip_module(M:NonTerminal, M2, Head), 1151 '$must_be'(callable, Head).
1158:- public prolog:residual_goals//0. 1159 1160prolog:residual_goals --> 1161 { findall(NT, residual_goal_collector(NT), NTL) }, 1162 collect_residual_goals(NTL). 1163 1164collect_residual_goals([]) --> []. 1165collect_residual_goals([H|T]) --> 1166 ( call(H) -> [] ; [] ), 1167 collect_residual_goals(T).
1192:- public 1193 prolog:translate_bindings/5. 1194:- meta_predicate 1195 prolog:translate_bindings( , , , , ). 1196 1197prologtranslate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals) :- 1198 translate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals). 1199 1200translate_bindings(Bindings0, Bindings, ResidueVars, Residuals) :- 1201 prolog:residual_goals(ResidueGoals, []), 1202 translate_bindings(Bindings0, Bindings, ResidueVars, ResidueGoals, 1203 Residuals). 1204 1205translate_bindings(Bindings0, Bindings, [], [], _:[]-[]) :- 1206 term_attvars(Bindings0, []), 1207 !, 1208 join_same_bindings(Bindings0, Bindings1), 1209 factorize_bindings(Bindings1, Bindings2), 1210 bind_vars(Bindings2, Bindings3), 1211 filter_bindings(Bindings3, Bindings). 1212translate_bindings(Bindings0, Bindings, ResidueVars, ResGoals0, 1213 TypeIn:Residuals-HiddenResiduals) :- 1214 project_constraints(Bindings0, ResidueVars), 1215 hidden_residuals(ResidueVars, Bindings0, HiddenResiduals0), 1216 omit_qualifiers(HiddenResiduals0, TypeIn, HiddenResiduals), 1217 copy_term(Bindings0+ResGoals0, Bindings1+ResGoals1, Residuals0), 1218 '$append'(ResGoals1, Residuals0, Residuals1), 1219 omit_qualifiers(Residuals1, TypeIn, Residuals), 1220 join_same_bindings(Bindings1, Bindings2), 1221 factorize_bindings(Bindings2, Bindings3), 1222 bind_vars(Bindings3, Bindings4), 1223 filter_bindings(Bindings4, Bindings). 1224 ResidueVars, Bindings, Goal) (:- 1226 term_attvars(ResidueVars, Remaining), 1227 term_attvars(Bindings, QueryVars), 1228 subtract_vars(Remaining, QueryVars, HiddenVars), 1229 copy_term(HiddenVars, _, Goal). 1230 1231subtract_vars(All, Subtract, Remaining) :- 1232 sort(All, AllSorted), 1233 sort(Subtract, SubtractSorted), 1234 ord_subtract(AllSorted, SubtractSorted, Remaining). 1235 1236ord_subtract([], _Not, []). 1237ord_subtract([H1|T1], L2, Diff) :- 1238 diff21(L2, H1, T1, Diff). 1239 1240diff21([], H1, T1, [H1|T1]). 1241diff21([H2|T2], H1, T1, Diff) :- 1242 compare(Order, H1, H2), 1243 diff3(Order, H1, T1, H2, T2, Diff). 1244 1245diff12([], _H2, _T2, []). 1246diff12([H1|T1], H2, T2, Diff) :- 1247 compare(Order, H1, H2), 1248 diff3(Order, H1, T1, H2, T2, Diff). 1249 1250diff3(<, H1, T1, H2, T2, [H1|Diff]) :- 1251 diff12(T1, H2, T2, Diff). 1252diff3(=, _H1, T1, _H2, T2, Diff) :- 1253 ord_subtract(T1, T2, Diff). 1254diff3(>, H1, T1, _H2, T2, Diff) :- 1255 diff21(T2, H1, T1, Diff).
toplevel_residue_vars
is set to project
.1263project_constraints(Bindings, ResidueVars) :- 1264 !, 1265 term_attvars(Bindings, AttVars), 1266 phrase(attribute_modules(AttVars), Modules0), 1267 sort(Modules0, Modules), 1268 term_variables(Bindings, QueryVars), 1269 project_attributes(Modules, QueryVars, ResidueVars). 1270project_constraints(_, _). 1271 1272project_attributes([], _, _). 1273project_attributes([M|T], QueryVars, ResidueVars) :- 1274 ( current_predicate(M:project_attributes/2), 1275 catch(M:project_attributes(QueryVars, ResidueVars), E, 1276 print_message(error, E)) 1277 -> true 1278 ; true 1279 ), 1280 project_attributes(T, QueryVars, ResidueVars). 1281 1282attribute_modules([]) --> []. 1283attribute_modules([H|T]) --> 1284 { get_attrs(H, Attrs) }, 1285 attrs_modules(Attrs), 1286 attribute_modules(T). 1287 1288attrs_modules([]) --> []. 1289attrs_modules(att(Module, _, More)) --> 1290 [Module], 1291 attrs_modules(More).
1302join_same_bindings([], []). 1303join_same_bindings([Name=V0|T0], [[Name|Names]=V|T]) :- 1304 take_same_bindings(T0, V0, V, Names, T1), 1305 join_same_bindings(T1, T). 1306 1307take_same_bindings([], Val, Val, [], []). 1308take_same_bindings([Name=V1|T0], V0, V, [Name|Names], T) :- 1309 V0 == V1, 1310 !, 1311 take_same_bindings(T0, V1, V, Names, T). 1312take_same_bindings([Pair|T0], V0, V, Names, [Pair|T]) :- 1313 take_same_bindings(T0, V0, V, Names, T).
1322omit_qualifiers([], _, []). 1323omit_qualifiers([Goal0|Goals0], TypeIn, [Goal|Goals]) :- 1324 omit_qualifier(Goal0, TypeIn, Goal), 1325 omit_qualifiers(Goals0, TypeIn, Goals). 1326 1327omit_qualifier(M:G0, TypeIn, G) :- 1328 M == TypeIn, 1329 !, 1330 omit_meta_qualifiers(G0, TypeIn, G). 1331omit_qualifier(M:G0, TypeIn, G) :- 1332 predicate_property(TypeIn:G0, imported_from(M)), 1333 \+ predicate_property(G0, transparent), 1334 !, 1335 G0 = G. 1336omit_qualifier(_:G0, _, G) :- 1337 predicate_property(G0, built_in), 1338 \+ predicate_property(G0, transparent), 1339 !, 1340 G0 = G. 1341omit_qualifier(M:G0, _, M:G) :- 1342 atom(M), 1343 !, 1344 omit_meta_qualifiers(G0, M, G). 1345omit_qualifier(G0, TypeIn, G) :- 1346 omit_meta_qualifiers(G0, TypeIn, G). 1347 1348omit_meta_qualifiers(V, _, V) :- 1349 var(V), 1350 !. 1351omit_meta_qualifiers((QA,QB), TypeIn, (A,B)) :- 1352 !, 1353 omit_qualifier(QA, TypeIn, A), 1354 omit_qualifier(QB, TypeIn, B). 1355omit_meta_qualifiers(freeze(V, QGoal), TypeIn, freeze(V, Goal)) :- 1356 callable(QGoal), 1357 !, 1358 omit_qualifier(QGoal, TypeIn, Goal). 1359omit_meta_qualifiers(when(Cond, QGoal), TypeIn, when(Cond, Goal)) :- 1360 callable(QGoal), 1361 !, 1362 omit_qualifier(QGoal, TypeIn, Goal). 1363omit_meta_qualifiers(G, _, G).
1372bind_vars(Bindings0, Bindings) :- 1373 bind_query_vars(Bindings0, Bindings, SNames), 1374 bind_skel_vars(Bindings, Bindings, SNames, 1, _). 1375 1376bind_query_vars([], [], []). 1377bind_query_vars([binding(Names,Var,[Var2=Cycle])|T0], 1378 [binding(Names,Cycle,[])|T], [Name|SNames]) :- 1379 Var == Var2, % also implies var(Var) 1380 !, 1381 '$last'(Names, Name), 1382 Var = '$VAR'(Name), 1383 bind_query_vars(T0, T, SNames). 1384bind_query_vars([B|T0], [B|T], AllNames) :- 1385 B = binding(Names,Var,Skel), 1386 bind_query_vars(T0, T, SNames), 1387 ( var(Var), \+ attvar(Var), Skel == [] 1388 -> AllNames = [Name|SNames], 1389 '$last'(Names, Name), 1390 Var = '$VAR'(Name) 1391 ; AllNames = SNames 1392 ). 1393 1394 1395 1396bind_skel_vars([], _, _, N, N). 1397bind_skel_vars([binding(_,_,Skel)|T], Bindings, SNames, N0, N) :- 1398 bind_one_skel_vars(Skel, Bindings, SNames, N0, N1), 1399 bind_skel_vars(T, Bindings, SNames, N1, N).
1418bind_one_skel_vars([], _, _, N, N). 1419bind_one_skel_vars([Var=Value|T], Bindings, Names, N0, N) :- 1420 ( var(Var) 1421 -> ( '$member'(binding(Names, VVal, []), Bindings), 1422 same_term(Value, VVal) 1423 -> '$last'(Names, VName), 1424 Var = '$VAR'(VName), 1425 N2 = N0 1426 ; between(N0, infinite, N1), 1427 atom_concat('_S', N1, Name), 1428 \+ memberchk(Name, Names), 1429 !, 1430 Var = '$VAR'(Name), 1431 N2 is N1 + 1 1432 ) 1433 ; N2 = N0 1434 ), 1435 bind_one_skel_vars(T, Bindings, Names, N2, N).
1442factorize_bindings([], []). 1443factorize_bindings([Name=Value|T0], [binding(Name, Skel, Subst)|T]) :- 1444 '$factorize_term'(Value, Skel, Subst0), 1445 ( current_prolog_flag(toplevel_print_factorized, true) 1446 -> Subst = Subst0 1447 ; only_cycles(Subst0, Subst) 1448 ), 1449 factorize_bindings(T0, T). 1450 1451 1452only_cycles([], []). 1453only_cycles([B|T0], List) :- 1454 ( B = (Var=Value), 1455 Var = Value, 1456 acyclic_term(Var) 1457 -> only_cycles(T0, List) 1458 ; List = [B|T], 1459 only_cycles(T0, T) 1460 ).
1469filter_bindings([], []). 1470filter_bindings([H0|T0], T) :- 1471 hide_vars(H0, H), 1472 ( ( arg(1, H, []) 1473 ; self_bounded(H) 1474 ) 1475 -> filter_bindings(T0, T) 1476 ; T = [H|T1], 1477 filter_bindings(T0, T1) 1478 ). 1479 1480hide_vars(binding(Names0, Skel, Subst), binding(Names, Skel, Subst)) :- 1481 hide_names(Names0, Skel, Subst, Names). 1482 1483hide_names([], _, _, []). 1484hide_names([Name|T0], Skel, Subst, T) :- 1485 ( sub_atom(Name, 0, _, _, '_'), 1486 current_prolog_flag(toplevel_print_anon, false), 1487 sub_atom(Name, 1, 1, _, Next), 1488 char_type(Next, prolog_var_start) 1489 -> true 1490 ; Subst == [], 1491 Skel == '$VAR'(Name) 1492 ), 1493 !, 1494 hide_names(T0, Skel, Subst, T). 1495hide_names([Name|T0], Skel, Subst, [Name|T]) :- 1496 hide_names(T0, Skel, Subst, T). 1497 1498self_bounded(binding([Name], Value, [])) :- 1499 Value == '$VAR'(Name).
1505get_respons(Action) :- 1506 repeat, 1507 flush_output(user_output), 1508 get_single_char(Char), 1509 answer_respons(Char, Action), 1510 ( Action == again 1511 -> print_message(query, query(action)), 1512 fail 1513 ; ! 1514 ). 1515 1516answer_respons(Char, again) :- 1517 '$in_reply'(Char, '?h'), 1518 !, 1519 print_message(help, query(help)). 1520answer_respons(Char, redo) :- 1521 '$in_reply'(Char, ';nrNR \t'), 1522 !, 1523 print_message(query, if_tty([ansi(bold, ';', [])])). 1524answer_respons(Char, redo) :- 1525 '$in_reply'(Char, 'tT'), 1526 !, 1527 trace, 1528 save_debug, 1529 print_message(query, if_tty([ansi(bold, '; [trace]', [])])). 1530answer_respons(Char, continue) :- 1531 '$in_reply'(Char, 'ca\n\ryY.'), 1532 !, 1533 print_message(query, if_tty([ansi(bold, '.', [])])). 1534answer_respons(0'b, show_again) :- 1535 !, 1536 break. 1537answer_respons(Char, show_again) :- 1538 print_predicate(Char, Pred, Options), 1539 !, 1540 print_message(query, if_tty(['~w'-[Pred]])), 1541 set_prolog_flag(answer_write_options, Options). 1542answer_respons(-1, show_again) :- 1543 !, 1544 print_message(query, halt('EOF')), 1545 halt(0). 1546answer_respons(Char, again) :- 1547 print_message(query, no_action(Char)). 1548 1549print_predicate(0'w, [write], [ quoted(true), 1550 spacing(next_argument) 1551 ]). 1552print_predicate(0'p, [print], [ quoted(true), 1553 portray(true), 1554 max_depth(10), 1555 spacing(next_argument) 1556 ]). 1557 1558 1559 /******************************* 1560 * EXPANSION * 1561 *******************************/ 1562 1563:- user:dynamic(expand_query/4). 1564:- user:multifile(expand_query/4). 1565 1566call_expand_query(Goal, Expanded, Bindings, ExpandedBindings) :- 1567 user:expand_query(Goal, Expanded, Bindings, ExpandedBindings), 1568 !. 1569call_expand_query(Goal, Expanded, Bindings, ExpandedBindings) :- 1570 toplevel_variables:expand_query(Goal, Expanded, Bindings, ExpandedBindings), 1571 !. 1572call_expand_query(Goal, Goal, Bindings, Bindings). 1573 1574 1575:- user:dynamic(expand_answer/2). 1576:- user:multifile(expand_answer/2). 1577 1578call_expand_answer(Goal, Expanded) :- 1579 user:expand_answer(Goal, Expanded), 1580 !. 1581call_expand_answer(Goal, Expanded) :- 1582 toplevel_variables:expand_answer(Goal, Expanded), 1583 !. 1584call_expand_answer(Goal, Goal)