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 initialize/0, % Run program initialization 41 version/0, % Write initial banner 42 version/1, % Add message to the banner 43 prolog/0, % user toplevel predicate 44 '$query_loop'/0, % toplevel predicate 45 residual_goals/1, % +Callable 46 (initialization)/1, % initialization goal (directive) 47 '$thread_init'/0, % initialise thread 48 (thread_initialization)/1 % thread initialization goal 49 ]). 50 51 52 /******************************* 53 * FILE_SEARCH_PATH * 54 *******************************/ 55 56:- multifile user:file_search_path/2. 57 58user:file_search_path(user_profile, app_preferences('.')). 59:- if(current_prolog_flag(windows, true)). 60user:file_search_path(app_preferences, app_data('.')). 61user:file_search_path(app_data, PrologAppData) :- 62 current_prolog_flag(windows, true), 63 catch(win_folder(appdata, AppData), _, fail), 64 atom_concat(AppData, '/SWI-Prolog', PrologAppData), 65 ( exists_directory(PrologAppData) 66 -> true 67 ; catch(make_directory(PrologAppData), _, fail) 68 ). 69:- else. 70user:file_search_path(app_data, UserLibDir) :- 71 catch(expand_file_name('~/lib/swipl', [UserLibDir]), _, fail). 72:- endif. 73user:file_search_path(app_preferences, UserHome) :- 74 catch(expand_file_name(~, [UserHome]), _, fail). 75 76 77 /******************************* 78 * VERSION BANNER * 79 *******************************/ 80 81:- dynamic 82 prolog:version_msg/1.
89version :-
90 print_message(banner, welcome).
96:- multifile 97 system:term_expansion/2. 98 99systemterm_expansion((:- version(Message)), 100 prolog:version_msg(Message)). 101 102version(Message) :- 103 ( prolog:version_msg(Message) 104 -> true 105 ; assertz(prolog:version_msg(Message)) 106 ). 107 108 109 /******************************** 110 * INITIALISATION * 111 *********************************/ 112 113% note: loaded_init_file/2 is used by prolog_load_context/2 to 114% confirm we are loading a script. 115 116:- dynamic 117 loaded_init_file/2. % already loaded init files 118 119'$load_init_file'(none) :- !. 120'$load_init_file'(Base) :- 121 loaded_init_file(Base, _), 122 !. 123'$load_init_file'(InitFile) :- 124 exists_file(InitFile), 125 !, 126 ensure_loaded(user:InitFile). 127'$load_init_file'(Base) :- 128 absolute_file_name(user_profile(Base), InitFile, 129 [ access(read), 130 file_errors(fail) 131 ]), 132 asserta(loaded_init_file(Base, InitFile)), 133 load_files(user:InitFile, 134 [ scope_settings(false) 135 ]). 136'$load_init_file'(_). 137 138'$load_system_init_file' :- 139 loaded_init_file(system, _), 140 !. 141'$load_system_init_file' :- 142 '$cmd_option_val'(system_init_file, Base), 143 Base \== none, 144 current_prolog_flag(home, Home), 145 file_name_extension(Base, rc, Name), 146 atomic_list_concat([Home, '/', Name], File), 147 absolute_file_name(File, Path, 148 [ file_type(prolog), 149 access(read), 150 file_errors(fail) 151 ]), 152 asserta(loaded_init_file(system, Path)), 153 load_files(user:Path, 154 [ silent(true), 155 scope_settings(false) 156 ]), 157 !. 158'$load_system_init_file'. 159 160'$load_script_file' :- 161 loaded_init_file(script, _), 162 !. 163'$load_script_file' :- 164 '$cmd_option_val'(script_file, OsFiles), 165 load_script_files(OsFiles). 166 167load_script_files([]). 168load_script_files([OsFile|More]) :- 169 prolog_to_os_filename(File, OsFile), 170 ( absolute_file_name(File, Path, 171 [ file_type(prolog), 172 access(read), 173 file_errors(fail) 174 ]) 175 -> asserta(loaded_init_file(script, Path)), 176 load_files(user:Path, []), 177 load_files(More) 178 ; throw(error(existence_error(script_file, File), _)) 179 ). 180 181 182 /******************************* 183 * AT_INITIALISATION * 184 *******************************/ 185 186:- meta_predicate 187 initialization( ). 188 189:- '$iso'((initialization)/1).
198initialization(Goal) :- 199 Goal = _:G, 200 prolog:initialize_now(G, Use), 201 !, 202 print_message(warning, initialize_now(G, Use)), 203 initialization(, now). 204initialization(Goal) :- 205 initialization(, after_load). 206 207:- multifile 208 prolog:initialize_now/2, 209 prolog:message//1. 210 211prologinitialize_now(load_foreign_library(_), 212 'use :- use_foreign_library/1 instead'). 213prologinitialize_now(load_foreign_library(_,_), 214 'use :- use_foreign_library/2 instead'). 215 216prologmessage(initialize_now(Goal, Use)) --> 217 [ 'Initialization goal ~p will be executed'-[Goal],nl, 218 'immediately for backward compatibility reasons', nl, 219 '~w'-[Use] 220 ]. 221 222'$run_initialization' :- 223 '$run_initialization'(_, []), 224 '$thread_init'.
:- initialization(Goal, program).
. Stop
with an exception if a goal fails or raises an exception.231initialize :- 232 forall('$init_goal'(when(program), Goal, Ctx), 233 run_initialize(Goal, Ctx)). 234 235run_initialize(Goal, Ctx) :- 236 ( catch(, E, true), 237 ( var(E) 238 -> true 239 ; throw(error(initialization_error(E, Goal, Ctx), _)) 240 ) 241 ; throw(error(initialization_error(failed, Goal, Ctx), _)) 242 ). 243 244 245 /******************************* 246 * THREAD INITIALIZATION * 247 *******************************/ 248 249:- meta_predicate 250 thread_initialization( ). 251:- dynamic 252 '$at_thread_initialization'/1.
258thread_initialization(Goal) :- 259 assert('$at_thread_initialization'(Goal)), 260 call(), 261 !. 262 263'$thread_init' :- 264 ( '$at_thread_initialization'(Goal), 265 ( call() 266 -> fail 267 ; fail 268 ) 269 ; true 270 ). 271 272 273 /******************************* 274 * FILE SEARCH PATH (-p) * 275 *******************************/
281'$set_file_search_paths' :- 282 '$cmd_option_val'(search_paths, Paths), 283 ( '$member'(Path, Paths), 284 atom_chars(Path, Chars), 285 ( phrase('$search_path'(Name, Aliases), Chars) 286 -> '$reverse'(Aliases, Aliases1), 287 forall('$member'(Alias, Aliases1), 288 asserta(user:file_search_path(Name, Alias))) 289 ; print_message(error, commandline_arg_type(p, Path)) 290 ), 291 fail ; true 292 ). 293 294'$search_path'(Name, Aliases) --> 295 '$string'(NameChars), 296 [=], 297 !, 298 {atom_chars(Name, NameChars)}, 299 '$search_aliases'(Aliases). 300 301'$search_aliases'([Alias|More]) --> 302 '$string'(AliasChars), 303 path_sep, 304 !, 305 { '$make_alias'(AliasChars, Alias) }, 306 '$search_aliases'(More). 307'$search_aliases'([Alias]) --> 308 '$string'(AliasChars), 309 '$eos', 310 !, 311 { '$make_alias'(AliasChars, Alias) }. 312 313path_sep --> 314 { current_prolog_flag(windows, true) 315 }, 316 !, 317 [;]. 318path_sep --> 319 [:]. 320 321'$string'([]) --> []. 322'$string'([H|T]) --> [H], '$string'(T). 323 324'$eos'([], []). 325 326'$make_alias'(Chars, Alias) :- 327 catch(term_to_atom(Alias, Chars), _, fail), 328 ( atom(Alias) 329 ; functor(Alias, F, 1), 330 F \== / 331 ), 332 !. 333'$make_alias'(Chars, Alias) :- 334 atom_chars(Alias, Chars). 335 336 337 /******************************* 338 * LOADING ASSIOCIATED FILES * 339 *******************************/
argv
, extracting the leading directory and
files.346argv_files(Files) :- 347 current_prolog_flag(argv, Argv), 348 no_option_files(Argv, Argv1, Files), 349 ( Argv1 \== Argv 350 -> set_prolog_flag(argv, Argv1) 351 ; true 352 ). 353 354no_option_files([--|Argv], Argv, []) :- !. 355no_option_files([OsScript|Argv], Argv, [Script]) :- 356 prolog_to_os_filename(Script, OsScript), 357 access_file(Script, read), 358 catch(setup_call_cleanup( 359 open(Script, read, In), 360 ( get_char(In, '#'), 361 get_char(In, '!') 362 ), 363 close(In)), 364 _, fail), 365 !. 366no_option_files([OsFile|Argv0], Argv, [File|T]) :- 367 file_name_extension(_, Ext, OsFile), 368 user:prolog_file_type(Ext, prolog), 369 !, 370 prolog_to_os_filename(File, OsFile), 371 no_option_files(Argv0, Argv, T). 372no_option_files(Argv, Argv, []). 373 374clean_argv :- 375 ( current_prolog_flag(argv, [--|Argv]) 376 -> set_prolog_flag(argv, Argv) 377 ; true 378 ).
387associated_files([]) :- 388 current_prolog_flag(saved_program_class, runtime), 389 !, 390 clean_argv. 391associated_files(Files) :- 392 '$set_prolog_file_extension', 393 argv_files(Files), 394 ( Files = [File|_] 395 -> absolute_file_name(File, AbsFile), 396 set_prolog_flag(associated_file, AbsFile), 397 set_working_directory(File), 398 set_window_title(Files) 399 ; true 400 ).
console_menu
,
which is set by swipl-win[.exe].410set_working_directory(File) :- 411 current_prolog_flag(console_menu, true), 412 access_file(File, read), 413 !, 414 file_directory_name(File, Dir), 415 working_directory(_, Dir). 416set_working_directory(_). 417 418set_window_title([File|More]) :- 419 current_predicate(system:window_title/2), 420 !, 421 ( More == [] 422 -> Extra = [] 423 ; Extra = ['...'] 424 ), 425 atomic_list_concat(['SWI-Prolog --', File | Extra], ' ', Title), 426 system:window_title(_, Title). 427set_window_title(_).
--pldoc[=port]
is given, load the PlDoc
system.435start_pldoc :- 436 '$cmd_option_val'(pldoc_server, Server), 437 ( Server == '' 438 -> call((doc_server(_), doc_browser)) 439 ; catch(atom_number(Server, Port), _, fail) 440 -> call(doc_server(Port)) 441 ; print_message(error, option_usage(pldoc)), 442 halt(1) 443 ). 444start_pldoc.
451load_associated_files(Files) :- 452 ( '$member'(File, Files), 453 load_files(user:File, [expand(false)]), 454 fail 455 ; true 456 ). 457 458:- if(current_predicate(system:win_registry_get_value/3)). 459hkey('HKEY_CURRENT_USER/Software/SWI/Prolog'). 460hkey('HKEY_LOCAL_MACHINE/Software/SWI/Prolog'). 461 462'$set_prolog_file_extension' :- 463 hkey(Key), 464 catch(win_registry_get_value(Key, fileExtension, Ext0), 465 _, fail), 466 !, 467 ( atom_concat('.', Ext, Ext0) 468 -> true 469 ; Ext = Ext0 470 ), 471 ( user:prolog_file_type(Ext, prolog) 472 -> true 473 ; asserta(user:prolog_file_type(Ext, prolog)) 474 ). 475:- endif. 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 set_toplevel, 500 associated_files(Files), 501 '$set_file_search_paths', 502 init_debug_flags, 503 '$run_initialization', 504 '$load_system_init_file', 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 '$load_script_file', 511 load_associated_files(Files), 512 '$cmd_option_val'(goals, Goals), 513 ( Goals == [], 514 \+ '$init_goal'(when(_), _, _) 515 -> version % default interactive run 516 ; run_init_goals(Goals), 517 ( load_only 518 -> version 519 ; run_program_init, 520 run_main_init 521 ) 522 ). 523 524set_toplevel :- 525 '$cmd_option_val'(toplevel, TopLevelAtom), 526 catch(term_to_atom(TopLevel, TopLevelAtom), E, 527 (print_message(error, E), 528 halt(1))), 529 create_prolog_flag(toplevel_goal, TopLevel, [type(term)]). 530 531load_only :- 532 current_prolog_flag(os_argv, OSArgv), 533 memberchk('-l', OSArgv), 534 current_prolog_flag(argv, Argv), 535 \+ memberchk('-l', Argv).
542run_init_goals([]). 543run_init_goals([H|T]) :- 544 run_init_goal(H), 545 run_init_goals(T). 546 547run_init_goal(Text) :- 548 catch(term_to_atom(Goal, Text), E, 549 ( print_message(error, init_goal_syntax(E, Text)), 550 halt(2) 551 )), 552 run_init_goal(Goal, Text).
558run_program_init :- 559 forall('$init_goal'(when(program), Goal, Ctx), 560 run_init_goal(Goal, @(Goal,Ctx))). 561 562run_main_init :- 563 findall(Goal-Ctx, '$init_goal'(when(main), Goal, Ctx), Pairs), 564 '$last'(Pairs, Goal-Ctx), 565 !, 566 ( current_prolog_flag(toplevel_goal, default) 567 -> set_prolog_flag(toplevel_goal, halt) 568 ; true 569 ), 570 run_init_goal(Goal, @(Goal,Ctx)). 571run_main_init. 572 573run_init_goal(Goal, Ctx) :- 574 ( catch(user:Goal, E, true) 575 -> ( var(E) 576 -> true 577 ; print_message(error, init_goal_failed(E, Ctx)), 578 halt(2) 579 ) 580 ; ( current_prolog_flag(verbose, silent) 581 -> Level = silent 582 ; Level = error 583 ), 584 print_message(Level, init_goal_failed(failed, Ctx)), 585 halt(1) 586 ).
593init_debug_flags :-
594 once(print_predicate(_, [print], PrintOptions)),
595 create_prolog_flag(answer_write_options, PrintOptions, []),
596 create_prolog_flag(prompt_alternatives_on, determinism, []),
597 create_prolog_flag(toplevel_extra_white_line, true, []),
598 create_prolog_flag(toplevel_print_factorized, false, []),
599 create_prolog_flag(print_write_options,
600 [ portray(true), quoted(true), numbervars(true) ],
601 []),
602 create_prolog_flag(toplevel_residue_vars, false, []),
603 '$set_debugger_write_options'(print).
609setup_backtrace :-
610 ( \+ current_prolog_flag(backtrace, false),
611 load_setup_file(library(prolog_stack))
612 -> true
613 ; true
614 ).
620setup_colors :-
621 ( stream_property(user_input, tty(true)),
622 stream_property(user_error, tty(true)),
623 stream_property(user_output, tty(true)),
624 \+ current_prolog_flag(color_term, false),
625 load_setup_file(user:library(ansi_term))
626 -> true
627 ; true
628 ).
634setup_history :-
635 ( \+ current_prolog_flag(save_history, false),
636 stream_property(user_input, tty(true)),
637 \+ current_prolog_flag(readline, false),
638 load_setup_file(library(prolog_history))
639 -> prolog_history(enable)
640 ; true
641 ),
642 set_default_history,
643 '$load_history'.
649setup_readline :- 650 ( current_prolog_flag(readline, swipl_win) 651 -> true 652 ; stream_property(user_input, tty(true)), 653 current_prolog_flag(tty_control, true), 654 \+ getenv('TERM', dumb), 655 ( current_prolog_flag(readline, ReadLine) 656 -> true 657 ; ReadLine = true 658 ), 659 readline_library(ReadLine, Library), 660 load_setup_file(library(Library)) 661 -> set_prolog_flag(readline, Library) 662 ; set_prolog_flag(readline, false) 663 ). 664 665readline_library(true, Library) :- 666 !, 667 preferred_readline(Library). 668readline_library(false, _) :- 669 !, 670 fail. 671readline_library(Library, Library). 672 673preferred_readline(editline). 674preferred_readline(readline).
680load_setup_file(File) :- 681 catch(load_files(File, 682 [ silent(true), 683 if(not_loaded) 684 ]), _, fail). 685 686 687:- '$hide'('$toplevel'/0). % avoid in the GUI stacktrace
693'$toplevel' :-
694 '$runtoplevel',
695 print_message(informational, halt).
default
and prolog
both
start the interactive toplevel, where prolog
implies the user gave
-t prolog
.
705'$runtoplevel' :- 706 current_prolog_flag(toplevel_goal, TopLevel0), 707 toplevel_goal(TopLevel0, TopLevel), 708 user:TopLevel. 709 710:- dynamic setup_done/0. 711:- volatile setup_done/0. 712 713toplevel_goal(default, '$query_loop') :- 714 !, 715 setup_interactive. 716toplevel_goal(prolog, '$query_loop') :- 717 !, 718 setup_interactive. 719toplevel_goal(Goal, Goal). 720 721setup_interactive :- 722 setup_done, 723 !. 724setup_interactive :- 725 asserta(setup_done), 726 catch(setup_backtrace, E, print_message(warning, E)), 727 catch(setup_colors, 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 '$set_file_search_paths', 737 init_debug_flags, 738 '$run_initialization', 739 catch('$compile_wic', E, (print_message(error, E), halt(1))). 740 741 742 /******************************** 743 * USER INTERACTIVE LOOP * 744 *********************************/
752prolog :- 753 break. 754 755:- create_prolog_flag(toplevel_mode, backtracking, []).
query_loop()
. This ensures that unhandled
exceptions are really unhandled (in Prolog).764'$query_loop' :- 765 current_prolog_flag(toplevel_mode, recursive), 766 !, 767 break_level(Level), 768 read_expanded_query(Level, Query, Bindings), 769 ( Query == end_of_file 770 -> print_message(query, query(eof)) 771 ; '$call_no_catch'('$execute'(Query, Bindings)), 772 ( current_prolog_flag(toplevel_mode, recursive) 773 -> '$query_loop' 774 ; '$switch_toplevel_mode'(backtracking), 775 '$query_loop' % Maybe throw('$switch_toplevel_mode')? 776 ) 777 ). 778'$query_loop' :- 779 break_level(BreakLev), 780 repeat, 781 read_expanded_query(BreakLev, Query, Bindings), 782 ( Query == end_of_file 783 -> !, print_message(query, query(eof)) 784 ; '$execute'(Query, Bindings), 785 ( current_prolog_flag(toplevel_mode, recursive) 786 -> !, 787 '$switch_toplevel_mode'(recursive), 788 '$query_loop' 789 ; fail 790 ) 791 ). 792 793break_level(BreakLev) :- 794 ( current_prolog_flag(break_level, BreakLev) 795 -> true 796 ; BreakLev = -1 797 ). 798 799read_expanded_query(BreakLev, ExpandedQuery, ExpandedBindings) :- 800 '$current_typein_module'(TypeIn), 801 ( stream_property(user_input, tty(true)) 802 -> '$system_prompt'(TypeIn, BreakLev, Prompt), 803 prompt(Old, '| ') 804 ; Prompt = '', 805 prompt(Old, '') 806 ), 807 trim_stacks, 808 repeat, 809 read_query(Prompt, Query, Bindings), 810 prompt(_, Old), 811 catch(call_expand_query(Query, ExpandedQuery, 812 Bindings, ExpandedBindings), 813 Error, 814 (print_message(error, Error), fail)), 815 !.
824read_query(Prompt, Goal, Bindings) :- 825 current_prolog_flag(history, N), 826 integer(N), N > 0, 827 !, 828 read_history(h, '!h', 829 [trace, end_of_file], 830 Prompt, Goal, Bindings). 831read_query(Prompt, Goal, Bindings) :- 832 remove_history_prompt(Prompt, Prompt1), 833 repeat, % over syntax errors 834 prompt1(Prompt1), 835 read_query_line(user_input, Line), 836 '$save_history_line'(Line), % save raw line (edit syntax errors) 837 '$current_typein_module'(TypeIn), 838 catch(read_term_from_atom(Line, Goal, 839 [ variable_names(Bindings), 840 module(TypeIn) 841 ]), E, 842 ( print_message(error, E), 843 fail 844 )), 845 !, 846 '$save_history_event'(Line). % save event (no syntax errors)
850read_query_line(Input, Line) :-
851 catch(read_term_as_atom(Input, Line), Error, true),
852 save_debug_after_read,
853 ( var(Error)
854 -> true
855 ; Error = error(syntax_error(_),_)
856 -> print_message(error, Error),
857 fail
858 ; print_message(error, Error),
859 throw(Error)
860 ).
867read_term_as_atom(In, Line) :-
868 '$raw_read'(In, Line),
869 ( Line == end_of_file
870 -> true
871 ; skip_to_nl(In)
872 ).
879skip_to_nl(In) :- 880 repeat, 881 peek_char(In, C), 882 ( C == '%' 883 -> skip(In, '\n') 884 ; char_type(C, space) 885 -> get_char(In, _), 886 C == '\n' 887 ; true 888 ), 889 !. 890 891remove_history_prompt('', '') :- !. 892remove_history_prompt(Prompt0, Prompt) :- 893 atom_chars(Prompt0, Chars0), 894 clean_history_prompt_chars(Chars0, Chars1), 895 delete_leading_blanks(Chars1, Chars), 896 atom_chars(Prompt, Chars). 897 898clean_history_prompt_chars([], []). 899clean_history_prompt_chars(['~', !|T], T) :- !. 900clean_history_prompt_chars([H|T0], [H|T]) :- 901 clean_history_prompt_chars(T0, T). 902 903delete_leading_blanks([' '|T0], T) :- 904 !, 905 delete_leading_blanks(T0, T). 906delete_leading_blanks(L, L).
915set_default_history :- 916 current_prolog_flag(history, _), 917 !. 918set_default_history :- 919 ( ( \+ current_prolog_flag(readline, false) 920 ; current_prolog_flag(emacs_inferior_process, true) 921 ) 922 -> create_prolog_flag(history, 0, []) 923 ; create_prolog_flag(history, 25, []) 924 ). 925 926 927 /******************************* 928 * TOPLEVEL DEBUG * 929 *******************************/
thread_signal(main, gdebug)
944save_debug_after_read :- 945 current_prolog_flag(debug, true), 946 !, 947 save_debug. 948save_debug_after_read. 949 950save_debug :- 951 ( tracing, 952 notrace 953 -> Tracing = true 954 ; Tracing = false 955 ), 956 current_prolog_flag(debug, Debugging), 957 set_prolog_flag(debug, false), 958 create_prolog_flag(query_debug_settings, 959 debug(Debugging, Tracing), []). 960 961restore_debug :- 962 current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)), 963 set_prolog_flag(debug, Debugging), 964 ( Tracing == true 965 -> trace 966 ; true 967 ). 968 969:- initialization 970 create_prolog_flag(query_debug_settings, debug(false, false), []). 971 972 973 /******************************** 974 * PROMPTING * 975 ********************************/ 976 977'$system_prompt'(Module, BrekLev, Prompt) :- 978 current_prolog_flag(toplevel_prompt, PAtom), 979 atom_codes(PAtom, P0), 980 ( Module \== user 981 -> '$substitute'('~m', [Module, ': '], P0, P1) 982 ; '$substitute'('~m', [], P0, P1) 983 ), 984 ( BrekLev > 0 985 -> '$substitute'('~l', ['[', BrekLev, '] '], P1, P2) 986 ; '$substitute'('~l', [], P1, P2) 987 ), 988 current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)), 989 ( Tracing == true 990 -> '$substitute'('~d', ['[trace] '], P2, P3) 991 ; Debugging == true 992 -> '$substitute'('~d', ['[debug] '], P2, P3) 993 ; '$substitute'('~d', [], P2, P3) 994 ), 995 atom_chars(Prompt, P3). 996 997'$substitute'(From, T, Old, New) :- 998 atom_codes(From, FromCodes), 999 phrase(subst_chars(T), T0), 1000 '$append'(Pre, S0, Old), 1001 '$append'(FromCodes, Post, S0) -> 1002 '$append'(Pre, T0, S1), 1003 '$append'(S1, Post, New), 1004 !. 1005'$substitute'(_, _, Old, Old). 1006 1007subst_chars([]) --> 1008 []. 1009subst_chars([H|T]) --> 1010 { atomic(H), 1011 !, 1012 atom_codes(H, Codes) 1013 }, 1014 , 1015 subst_chars(T). 1016subst_chars([H|T]) --> 1017 , 1018 subst_chars(T). 1019 1020 1021 /******************************** 1022 * EXECUTION * 1023 ********************************/
1029'$execute'(Var, _) :- 1030 var(Var), 1031 !, 1032 print_message(informational, var_query(Var)). 1033'$execute'(Goal, Bindings) :- 1034 '$current_typein_module'(TypeIn), 1035 '$dwim_correct_goal'(TypeIn:Goal, Bindings, Corrected), 1036 !, 1037 setup_call_cleanup( 1038 '$set_source_module'(M0, TypeIn), 1039 expand_goal(Corrected, Expanded), 1040 '$set_source_module'(M0)), 1041 print_message(silent, toplevel_goal(Expanded, Bindings)), 1042 '$execute_goal2'(Expanded, Bindings). 1043'$execute'(_, _) :- 1044 notrace, 1045 print_message(query, query(no)). 1046 1047'$execute_goal2'(Goal, Bindings) :- 1048 restore_debug, 1049 residue_vars(Goal, Vars), 1050 deterministic(Det), 1051 ( save_debug 1052 ; restore_debug, fail 1053 ), 1054 flush_output(user_output), 1055 call_expand_answer(Bindings, NewBindings), 1056 ( \+ \+ write_bindings(NewBindings, Vars, Det) 1057 -> ! 1058 ). 1059'$execute_goal2'(_, _) :- 1060 save_debug, 1061 print_message(query, query(no)). 1062 1063residue_vars(Goal, Vars) :- 1064 current_prolog_flag(toplevel_residue_vars, true), 1065 !, 1066 call_residue_vars(, Vars). 1067residue_vars(Goal, []) :- 1068 toplevel_call(Goal). 1069 1070toplevel_call(Goal) :- 1071 call(), 1072 no_lco. 1073 1074no_lco.
groundness
gives the classical behaviour,
determinism
is considered more adequate and informative.
Succeeds if the user accepts the answer and fails otherwise.
1089write_bindings(Bindings, ResidueVars, Det) :- 1090 '$current_typein_module'(TypeIn), 1091 translate_bindings(Bindings, Bindings1, ResidueVars, TypeIn:Residuals), 1092 write_bindings2(Bindings1, Residuals, Det). 1093 1094write_bindings2([], Residuals, _) :- 1095 current_prolog_flag(prompt_alternatives_on, groundness), 1096 !, 1097 print_message(query, query(yes(Residuals))). 1098write_bindings2(Bindings, Residuals, true) :- 1099 current_prolog_flag(prompt_alternatives_on, determinism), 1100 !, 1101 print_message(query, query(yes(Bindings, Residuals))). 1102write_bindings2(Bindings, Residuals, _Det) :- 1103 repeat, 1104 print_message(query, query(more(Bindings, Residuals))), 1105 get_respons(Action), 1106 ( Action == redo 1107 -> !, fail 1108 ; Action == show_again 1109 -> fail 1110 ; !, 1111 print_message(query, query(done)) 1112 ).
1119:- multifile 1120 residual_goal_collector/1. 1121 1122:- meta_predicate 1123 residual_goals( ). 1124 1125residual_goals(NonTerminal) :- 1126 throw(error(context_error(nodirective, residual_goals(NonTerminal)), _)). 1127 1128systemterm_expansion((:- residual_goals(NonTerminal)), 1129 '$toplevel':residual_goal_collector(M2:Head)) :- 1130 prolog_load_context(module, M), 1131 strip_module(M:NonTerminal, M2, Head), 1132 '$must_be'(callable, Head).
1139:- public prolog:residual_goals//0. 1140 1141prolog:residual_goals --> 1142 { findall(NT, residual_goal_collector(NT), NTL) }, 1143 collect_residual_goals(NTL). 1144 1145collect_residual_goals([]) --> []. 1146collect_residual_goals([H|T]) --> 1147 ( call(H) -> [] ; [] ), 1148 collect_residual_goals(T).
1173:- public 1174 prolog:translate_bindings/5. 1175:- meta_predicate 1176 prolog:translate_bindings( , , , , ). 1177 1178prologtranslate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals) :- 1179 translate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals). 1180 1181translate_bindings(Bindings0, Bindings, ResidueVars, Residuals) :- 1182 prolog:residual_goals(ResidueGoals, []), 1183 translate_bindings(Bindings0, Bindings, ResidueVars, ResidueGoals, 1184 Residuals). 1185 1186translate_bindings(Bindings0, Bindings, [], [], _:[]-[]) :- 1187 term_attvars(Bindings0, []), 1188 !, 1189 join_same_bindings(Bindings0, Bindings1), 1190 factorize_bindings(Bindings1, Bindings2), 1191 bind_vars(Bindings2, Bindings3), 1192 filter_bindings(Bindings3, Bindings). 1193translate_bindings(Bindings0, Bindings, ResidueVars, ResGoals0, 1194 TypeIn:Residuals-HiddenResiduals) :- 1195 project_constraints(Bindings0, ResidueVars), 1196 hidden_residuals(ResidueVars, Bindings0, HiddenResiduals0), 1197 omit_qualifiers(HiddenResiduals0, TypeIn, HiddenResiduals), 1198 copy_term(Bindings0+ResGoals0, Bindings1+ResGoals1, Residuals0), 1199 '$append'(ResGoals1, Residuals0, Residuals1), 1200 omit_qualifiers(Residuals1, TypeIn, Residuals), 1201 join_same_bindings(Bindings1, Bindings2), 1202 factorize_bindings(Bindings2, Bindings3), 1203 bind_vars(Bindings3, Bindings4), 1204 filter_bindings(Bindings4, Bindings). 1205 ResidueVars, Bindings, Goal) (:- 1207 term_attvars(ResidueVars, Remaining), 1208 term_attvars(Bindings, QueryVars), 1209 subtract_vars(Remaining, QueryVars, HiddenVars), 1210 copy_term(HiddenVars, _, Goal). 1211 1212subtract_vars(All, Subtract, Remaining) :- 1213 sort(All, AllSorted), 1214 sort(Subtract, SubtractSorted), 1215 ord_subtract(AllSorted, SubtractSorted, Remaining). 1216 1217ord_subtract([], _Not, []). 1218ord_subtract([H1|T1], L2, Diff) :- 1219 diff21(L2, H1, T1, Diff). 1220 1221diff21([], H1, T1, [H1|T1]). 1222diff21([H2|T2], H1, T1, Diff) :- 1223 compare(Order, H1, H2), 1224 diff3(Order, H1, T1, H2, T2, Diff). 1225 1226diff12([], _H2, _T2, []). 1227diff12([H1|T1], H2, T2, Diff) :- 1228 compare(Order, H1, H2), 1229 diff3(Order, H1, T1, H2, T2, Diff). 1230 1231diff3(<, H1, T1, H2, T2, [H1|Diff]) :- 1232 diff12(T1, H2, T2, Diff). 1233diff3(=, _H1, T1, _H2, T2, Diff) :- 1234 ord_subtract(T1, T2, Diff). 1235diff3(>, H1, T1, _H2, T2, Diff) :- 1236 diff21(T2, H1, T1, Diff).
toplevel_residue_vars
is set to project
.1244project_constraints(Bindings, ResidueVars) :- 1245 !, 1246 term_attvars(Bindings, AttVars), 1247 phrase(attribute_modules(AttVars), Modules0), 1248 sort(Modules0, Modules), 1249 term_variables(Bindings, QueryVars), 1250 project_attributes(Modules, QueryVars, ResidueVars). 1251project_constraints(_, _). 1252 1253project_attributes([], _, _). 1254project_attributes([M|T], QueryVars, ResidueVars) :- 1255 ( current_predicate(M:project_attributes/2), 1256 catch(M:project_attributes(QueryVars, ResidueVars), E, 1257 print_message(error, E)) 1258 -> true 1259 ; true 1260 ), 1261 project_attributes(T, QueryVars, ResidueVars). 1262 1263attribute_modules([]) --> []. 1264attribute_modules([H|T]) --> 1265 { get_attrs(H, Attrs) }, 1266 attrs_modules(Attrs), 1267 attribute_modules(T). 1268 1269attrs_modules([]) --> []. 1270attrs_modules(att(Module, _, More)) --> 1271 [Module], 1272 attrs_modules(More).
1283join_same_bindings([], []). 1284join_same_bindings([Name=V0|T0], [[Name|Names]=V|T]) :- 1285 take_same_bindings(T0, V0, V, Names, T1), 1286 join_same_bindings(T1, T). 1287 1288take_same_bindings([], Val, Val, [], []). 1289take_same_bindings([Name=V1|T0], V0, V, [Name|Names], T) :- 1290 V0 == V1, 1291 !, 1292 take_same_bindings(T0, V1, V, Names, T). 1293take_same_bindings([Pair|T0], V0, V, Names, [Pair|T]) :- 1294 take_same_bindings(T0, V0, V, Names, T).
1303omit_qualifiers([], _, []). 1304omit_qualifiers([Goal0|Goals0], TypeIn, [Goal|Goals]) :- 1305 omit_qualifier(Goal0, TypeIn, Goal), 1306 omit_qualifiers(Goals0, TypeIn, Goals). 1307 1308omit_qualifier(M:G0, TypeIn, G) :- 1309 M == TypeIn, 1310 !, 1311 omit_meta_qualifiers(G0, TypeIn, G). 1312omit_qualifier(M:G0, TypeIn, G) :- 1313 predicate_property(TypeIn:G0, imported_from(M)), 1314 \+ predicate_property(G0, transparent), 1315 !, 1316 G0 = G. 1317omit_qualifier(_:G0, _, G) :- 1318 predicate_property(G0, built_in), 1319 \+ predicate_property(G0, transparent), 1320 !, 1321 G0 = G. 1322omit_qualifier(M:G0, _, M:G) :- 1323 atom(M), 1324 !, 1325 omit_meta_qualifiers(G0, M, G). 1326omit_qualifier(G0, TypeIn, G) :- 1327 omit_meta_qualifiers(G0, TypeIn, G). 1328 1329omit_meta_qualifiers(V, _, V) :- 1330 var(V), 1331 !. 1332omit_meta_qualifiers((QA,QB), TypeIn, (A,B)) :- 1333 !, 1334 omit_qualifier(QA, TypeIn, A), 1335 omit_qualifier(QB, TypeIn, B). 1336omit_meta_qualifiers(freeze(V, QGoal), TypeIn, freeze(V, Goal)) :- 1337 callable(QGoal), 1338 !, 1339 omit_qualifier(QGoal, TypeIn, Goal). 1340omit_meta_qualifiers(when(Cond, QGoal), TypeIn, when(Cond, Goal)) :- 1341 callable(QGoal), 1342 !, 1343 omit_qualifier(QGoal, TypeIn, Goal). 1344omit_meta_qualifiers(G, _, G).
1353bind_vars(Bindings0, Bindings) :- 1354 bind_query_vars(Bindings0, Bindings, SNames), 1355 bind_skel_vars(Bindings, Bindings, SNames, 1, _). 1356 1357bind_query_vars([], [], []). 1358bind_query_vars([binding(Names,Var,[Var2=Cycle])|T0], 1359 [binding(Names,Cycle,[])|T], [Name|SNames]) :- 1360 Var == Var2, % also implies var(Var) 1361 !, 1362 '$last'(Names, Name), 1363 Var = '$VAR'(Name), 1364 bind_query_vars(T0, T, SNames). 1365bind_query_vars([B|T0], [B|T], AllNames) :- 1366 B = binding(Names,Var,Skel), 1367 bind_query_vars(T0, T, SNames), 1368 ( var(Var), \+ attvar(Var), Skel == [] 1369 -> AllNames = [Name|SNames], 1370 '$last'(Names, Name), 1371 Var = '$VAR'(Name) 1372 ; AllNames = SNames 1373 ). 1374 1375 1376 1377bind_skel_vars([], _, _, N, N). 1378bind_skel_vars([binding(_,_,Skel)|T], Bindings, SNames, N0, N) :- 1379 bind_one_skel_vars(Skel, Bindings, SNames, N0, N1), 1380 bind_skel_vars(T, Bindings, SNames, N1, N).
1399bind_one_skel_vars([], _, _, N, N). 1400bind_one_skel_vars([Var=Value|T], Bindings, Names, N0, N) :- 1401 ( var(Var) 1402 -> ( '$member'(binding(Names, VVal, []), Bindings), 1403 same_term(Value, VVal) 1404 -> '$last'(Names, VName), 1405 Var = '$VAR'(VName), 1406 N2 = N0 1407 ; between(N0, infinite, N1), 1408 atom_concat('_S', N1, Name), 1409 \+ memberchk(Name, Names), 1410 !, 1411 Var = '$VAR'(Name), 1412 N2 is N1 + 1 1413 ) 1414 ; N2 = N0 1415 ), 1416 bind_one_skel_vars(T, Bindings, Names, N2, N).
1423factorize_bindings([], []). 1424factorize_bindings([Name=Value|T0], [binding(Name, Skel, Subst)|T]) :- 1425 '$factorize_term'(Value, Skel, Subst0), 1426 ( current_prolog_flag(toplevel_print_factorized, true) 1427 -> Subst = Subst0 1428 ; only_cycles(Subst0, Subst) 1429 ), 1430 factorize_bindings(T0, T). 1431 1432 1433only_cycles([], []). 1434only_cycles([B|T0], List) :- 1435 ( B = (Var=Value), 1436 Var = Value, 1437 acyclic_term(Var) 1438 -> only_cycles(T0, List) 1439 ; List = [B|T], 1440 only_cycles(T0, T) 1441 ).
1450filter_bindings([], []). 1451filter_bindings([H0|T0], T) :- 1452 hide_vars(H0, H), 1453 ( ( arg(1, H, []) 1454 ; self_bounded(H) 1455 ) 1456 -> filter_bindings(T0, T) 1457 ; T = [H|T1], 1458 filter_bindings(T0, T1) 1459 ). 1460 1461hide_vars(binding(Names0, Skel, Subst), binding(Names, Skel, Subst)) :- 1462 hide_names(Names0, Skel, Subst, Names). 1463 1464hide_names([], _, _, []). 1465hide_names([Name|T0], Skel, Subst, T) :- 1466 ( sub_atom(Name, 0, _, _, '_'), 1467 current_prolog_flag(toplevel_print_anon, false), 1468 sub_atom(Name, 1, 1, _, Next), 1469 char_type(Next, prolog_var_start) 1470 -> true 1471 ; Subst == [], 1472 Skel == '$VAR'(Name) 1473 ), 1474 !, 1475 hide_names(T0, Skel, Subst, T). 1476hide_names([Name|T0], Skel, Subst, [Name|T]) :- 1477 hide_names(T0, Skel, Subst, T). 1478 1479self_bounded(binding([Name], Value, [])) :- 1480 Value == '$VAR'(Name).
1486get_respons(Action) :- 1487 repeat, 1488 flush_output(user_output), 1489 get_single_char(Char), 1490 answer_respons(Char, Action), 1491 ( Action == again 1492 -> print_message(query, query(action)), 1493 fail 1494 ; ! 1495 ). 1496 1497answer_respons(Char, again) :- 1498 '$in_reply'(Char, '?h'), 1499 !, 1500 print_message(help, query(help)). 1501answer_respons(Char, redo) :- 1502 '$in_reply'(Char, ';nrNR \t'), 1503 !, 1504 print_message(query, if_tty([ansi(bold, ';', [])])). 1505answer_respons(Char, redo) :- 1506 '$in_reply'(Char, 'tT'), 1507 !, 1508 trace, 1509 save_debug, 1510 print_message(query, if_tty([ansi(bold, '; [trace]', [])])). 1511answer_respons(Char, continue) :- 1512 '$in_reply'(Char, 'ca\n\ryY.'), 1513 !, 1514 print_message(query, if_tty([ansi(bold, '.', [])])). 1515answer_respons(0'b, show_again) :- 1516 !, 1517 break. 1518answer_respons(Char, show_again) :- 1519 print_predicate(Char, Pred, Options), 1520 !, 1521 print_message(query, if_tty(['~w'-[Pred]])), 1522 set_prolog_flag(answer_write_options, Options). 1523answer_respons(-1, show_again) :- 1524 !, 1525 print_message(query, halt('EOF')), 1526 halt(0). 1527answer_respons(Char, again) :- 1528 print_message(query, no_action(Char)). 1529 1530print_predicate(0'w, [write], [ quoted(true), 1531 spacing(next_argument) 1532 ]). 1533print_predicate(0'p, [print], [ quoted(true), 1534 portray(true), 1535 max_depth(10), 1536 spacing(next_argument) 1537 ]). 1538 1539 1540 /******************************* 1541 * EXPANSION * 1542 *******************************/ 1543 1544:- user:dynamic(expand_query/4). 1545:- user:multifile(expand_query/4). 1546 1547call_expand_query(Goal, Expanded, Bindings, ExpandedBindings) :- 1548 user:expand_query(Goal, Expanded, Bindings, ExpandedBindings), 1549 !. 1550call_expand_query(Goal, Expanded, Bindings, ExpandedBindings) :- 1551 toplevel_variables:expand_query(Goal, Expanded, Bindings, ExpandedBindings), 1552 !. 1553call_expand_query(Goal, Goal, Bindings, Bindings). 1554 1555 1556:- user:dynamic(expand_answer/2). 1557:- user:multifile(expand_answer/2). 1558 1559call_expand_answer(Goal, Expanded) :- 1560 user:expand_answer(Goal, Expanded), 1561 !. 1562call_expand_answer(Goal, Expanded) :- 1563 toplevel_variables:expand_answer(Goal, Expanded), 1564 !. 1565call_expand_answer(Goal, Goal)