36
37:- module('$toplevel',
38 [ '$initialise'/0, 39 '$toplevel'/0, 40 '$compile'/0, 41 '$config'/0, 42 initialize/0, 43 version/0, 44 version/1, 45 prolog/0, 46 '$query_loop'/0, 47 '$execute_query'/3, 48 residual_goals/1, 49 (initialization)/1, 50 '$thread_init'/0, 51 (thread_initialization)/1 52 ]). 53
54
55 58
59:- dynamic prolog:version_msg/1. 60:- multifile prolog:version_msg/1. 61
66
67version :-
68 print_message(banner, welcome).
69
73
74:- multifile
75 system:term_expansion/2. 76
77system:term_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 90
97
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(_).
110
114
115:- dynamic
116 loaded_init_file/2. 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 196
197:- meta_predicate
198 initialization(0). 199
200:- '$iso'((initialization)/1). 201
208
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
222prolog:initialize_now(load_foreign_library(_),
223 'use :- use_foreign_library/1 instead').
224prolog:initialize_now(load_foreign_library(_,_),
225 'use :- use_foreign_library/2 instead').
226
227prolog:message(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'.
237
242
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 260
261:- meta_predicate
262 thread_initialization(0). 263:- dynamic
264 '$at_thread_initialization'/1. 265
269
270thread_initialization(Goal) :-
271 assert('$at_thread_initialization'(Goal)),
272 call(Goal),
273 !.
274
278
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 293
297
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 353
385
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 ).
459
466
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. 477
481
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.
492
493
497
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 524
530
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', 545 set_toplevel, 546 '$set_file_search_paths', 547 init_debug_flags,
548 setup_app,
549 start_pldoc, 550 main_thread_init.
551
557
558main_thread_init :-
559 current_prolog_flag(epilog, true),
560 thread_self(main),
561 current_prolog_flag(xpce, true),
562 exists_source(library(epilog)),
563 !,
564 setup_theme,
565 catch(setup_backtrace, E, print_message(warning, E)),
566 use_module(library(epilog)),
567 call(epilog([ init(user_thread_init),
568 main(true)
569 ])).
570main_thread_init :-
571 setup_theme,
572 user_thread_init.
573
577
578user_thread_init :-
579 opt_attach_packs,
580 argv_prolog_files(Files, ScriptMode),
581 load_init_file(ScriptMode), 582 catch(setup_colors, E, print_message(warning, E)),
583 win_associated_files(Files), 584 '$load_script_file', 585 load_associated_files(Files),
586 '$cmd_option_val'(goals, Goals), 587 ( ScriptMode == app
588 -> run_program_init, 589 run_main_init(true)
590 ; Goals == [],
591 \+ '$init_goal'(when(_), _, _) 592 -> version 593 ; run_init_goals(Goals), 594 ( load_only 595 -> version
596 ; run_program_init, 597 run_main_init(false) 598 )
599 ).
600
602
603:- multifile
604 prolog:theme/1. 605
606setup_theme :-
607 current_prolog_flag(theme, Theme),
608 exists_source(library(theme/Theme)),
609 !,
610 use_module(library(theme/Theme)).
611setup_theme.
612
616
617apply_defines :-
618 '$cmd_option_val'(defines, Defs),
619 apply_defines(Defs).
620
621apply_defines([]).
622apply_defines([H|T]) :-
623 apply_define(H),
624 apply_defines(T).
625
626apply_define(Def) :-
627 sub_atom(Def, B, _, A, '='),
628 !,
629 sub_atom(Def, 0, B, _, Flag),
630 sub_atom(Def, _, A, 0, Value0),
631 ( '$current_prolog_flag'(Flag, Value0, _Scope, Access, Type)
632 -> ( Access \== write
633 -> '$permission_error'(set, prolog_flag, Flag)
634 ; text_flag_value(Type, Value0, Value)
635 ),
636 set_prolog_flag(Flag, Value)
637 ; ( atom_number(Value0, Value)
638 -> true
639 ; Value = Value0
640 ),
641 set_defined(Flag, Value)
642 ).
643apply_define(Def) :-
644 atom_concat('no-', Flag, Def),
645 !,
646 set_user_boolean_flag(Flag, false).
647apply_define(Def) :-
648 set_user_boolean_flag(Def, true).
649
650set_user_boolean_flag(Flag, Value) :-
651 current_prolog_flag(Flag, Old),
652 !,
653 ( Old == Value
654 -> true
655 ; set_prolog_flag(Flag, Value)
656 ).
657set_user_boolean_flag(Flag, Value) :-
658 set_defined(Flag, Value).
659
660text_flag_value(integer, Text, Int) :-
661 atom_number(Text, Int),
662 !.
663text_flag_value(float, Text, Float) :-
664 atom_number(Text, Float),
665 !.
666text_flag_value(term, Text, Term) :-
667 term_string(Term, Text, []),
668 !.
669text_flag_value(_, Value, Value).
670
671set_defined(Flag, Value) :-
672 define_options(Flag, Options), !,
673 create_prolog_flag(Flag, Value, Options).
674
679
680define_options('SDL_VIDEODRIVER', []).
681define_options(_, [warn_not_accessed(true)]).
682
686
687init_optimise :-
688 current_prolog_flag(optimise, true),
689 !,
690 use_module(user:library(apply_macros)).
691init_optimise.
692
693opt_attach_packs :-
694 current_prolog_flag(packs, true),
695 !,
696 attach_packs.
697opt_attach_packs.
698
699set_toplevel :-
700 '$cmd_option_val'(toplevel, TopLevelAtom),
701 catch(term_to_atom(TopLevel, TopLevelAtom), E,
702 (print_message(error, E),
703 halt(1))),
704 create_prolog_flag(toplevel_goal, TopLevel, [type(term)]).
705
706load_only :-
707 current_prolog_flag(os_argv, OSArgv),
708 memberchk('-l', OSArgv),
709 current_prolog_flag(argv, Argv),
710 \+ memberchk('-l', Argv).
711
716
717run_init_goals([]).
718run_init_goals([H|T]) :-
719 run_init_goal(H),
720 run_init_goals(T).
721
722run_init_goal(Text) :-
723 catch(term_to_atom(Goal, Text), E,
724 ( print_message(error, init_goal_syntax(E, Text)),
725 halt(2)
726 )),
727 run_init_goal(Goal, Text).
728
732
733run_program_init :-
734 forall('$init_goal'(when(program), Goal, Ctx),
735 run_init_goal(Goal, @(Goal,Ctx))).
736
737run_main_init(_) :-
738 findall(Goal-Ctx, '$init_goal'(when(main), Goal, Ctx), Pairs),
739 '$last'(Pairs, Goal-Ctx),
740 !,
741 ( current_prolog_flag(toplevel_goal, default)
742 -> set_prolog_flag(toplevel_goal, halt)
743 ; true
744 ),
745 run_init_goal(Goal, @(Goal,Ctx)).
746run_main_init(true) :-
747 '$existence_error'(initialization, main).
748run_main_init(_).
749
750run_init_goal(Goal, Ctx) :-
751 ( catch_with_backtrace(user:Goal, E, true)
752 -> ( var(E)
753 -> true
754 ; init_goal_failed(E, Ctx)
755 )
756 ; ( current_prolog_flag(verbose, silent)
757 -> Level = silent
758 ; Level = error
759 ),
760 print_message(Level, init_goal_failed(failed, Ctx)),
761 halt(1)
762 ).
763
764init_goal_failed(E, Ctx) :-
765 print_message(error, init_goal_failed(E, Ctx)),
766 init_goal_failed(E).
767
768init_goal_failed(_) :-
769 thread_self(main),
770 !,
771 halt(2).
772init_goal_failed(_).
773
778
779init_debug_flags :-
780 Keep = [keep(true)],
781 create_prolog_flag(answer_write_options,
782 [ quoted(true), portray(true), max_depth(10),
783 spacing(next_argument)], Keep),
784 create_prolog_flag(prompt_alternatives_on, determinism, Keep),
785 create_prolog_flag(toplevel_extra_white_line, true, Keep),
786 create_prolog_flag(toplevel_print_factorized, false, Keep),
787 create_prolog_flag(print_write_options,
788 [ portray(true), quoted(true), numbervars(true) ],
789 Keep),
790 create_prolog_flag(toplevel_residue_vars, false, Keep),
791 create_prolog_flag(toplevel_list_wfs_residual_program, true, Keep),
792 '$set_debugger_write_options'(print).
793
797
798setup_backtrace :-
799 ( \+ current_prolog_flag(backtrace, false),
800 load_setup_file(library(prolog_stack))
801 -> true
802 ; true
803 ).
804
808
809setup_colors :-
810 ( \+ current_prolog_flag(color_term, false),
811 stream_property(user_input, tty(true)),
812 stream_property(user_error, tty(true)),
813 stream_property(user_output, tty(true)),
814 \+ getenv('TERM', dumb),
815 load_setup_file(user:library(ansi_term))
816 -> true
817 ; true
818 ).
819
823
824setup_history :-
825 ( \+ current_prolog_flag(save_history, false),
826 stream_property(user_input, tty(true)),
827 \+ current_prolog_flag(readline, false),
828 load_setup_file(library(prolog_history))
829 -> prolog_history(enable)
830 ; true
831 ).
832
836
837setup_readline :-
838 ( stream_property(user_input, tty(true)),
839 current_prolog_flag(tty_control, true),
840 \+ getenv('TERM', dumb),
841 ( current_prolog_flag(readline, ReadLine)
842 -> true
843 ; ReadLine = true
844 ),
845 readline_library(ReadLine, Library),
846 ( load_setup_file(library(Library))
847 -> true
848 ; current_prolog_flag(epilog, true),
849 print_message(warning,
850 error(existence_error(library, library(Library)),
851 _)),
852 fail
853 )
854 -> set_prolog_flag(readline, Library)
855 ; set_prolog_flag(readline, false)
856 ).
857
858readline_library(true, Library) :-
859 !,
860 preferred_readline(Library).
861readline_library(false, _) :-
862 !,
863 fail.
864readline_library(Library, Library).
865
866preferred_readline(editline).
867
871
872load_setup_file(File) :-
873 catch(load_files(File,
874 [ silent(true),
875 if(not_loaded)
876 ]), error(_,_), fail).
877
878
887
888:- if(current_prolog_flag(windows,true)). 889
890setup_app :-
891 current_prolog_flag(associated_file, _),
892 !.
893setup_app :-
894 '$cmd_option_val'(win_app, true),
895 !,
896 catch(my_prolog, E, print_message(warning, E)).
897setup_app.
898
899my_prolog :-
900 win_folder(personal, MyDocs),
901 atom_concat(MyDocs, '/Prolog', PrologDir),
902 ( ensure_dir(PrologDir)
903 -> working_directory(_, PrologDir)
904 ; working_directory(_, MyDocs)
905 ).
906
907ensure_dir(Dir) :-
908 exists_directory(Dir),
909 !.
910ensure_dir(Dir) :-
911 catch(make_directory(Dir), E, (print_message(warning, E), fail)).
912
913:- elif(current_prolog_flag(apple, true)). 914use_app_settings(true). 915
916setup_app :-
917 apple_set_locale,
918 current_prolog_flag(associated_file, _),
919 !.
920setup_app :-
921 current_prolog_flag(bundle, true),
922 current_prolog_flag(executable, Exe),
923 file_base_name(Exe, 'SWI-Prolog'),
924 !,
925 setup_macos_app.
926setup_app.
927
928apple_set_locale :-
929 ( getenv('LC_CTYPE', 'UTF-8'),
930 apple_current_locale_identifier(LocaleID),
931 atom_concat(LocaleID, '.UTF-8', Locale),
932 catch(setlocale(ctype, _Old, Locale), _, fail)
933 -> setenv('LANG', Locale),
934 unsetenv('LC_CTYPE')
935 ; true
936 ).
937
938setup_macos_app :-
939 restore_working_directory,
940 !.
941setup_macos_app :-
942 expand_file_name('~/Prolog', [PrologDir]),
943 ( exists_directory(PrologDir)
944 -> true
945 ; catch(make_directory(PrologDir), MkDirError,
946 print_message(warning, MkDirError))
947 ),
948 catch(working_directory(_, PrologDir), CdError,
949 print_message(warning, CdError)),
950 !.
951setup_macos_app.
952
953:- elif(current_prolog_flag(emscripten, true)). 954setup_app.
955:- else. 956use_app_settings(true). 957
959setup_app :-
960 running_as_app,
961 restore_working_directory,
962 !.
963setup_app.
964
968
969running_as_app :-
971 current_prolog_flag(epilog, true),
972 stream_property(In, file_no(0)),
973 \+ stream_property(In, tty(true)),
974 !.
975
976:- endif. 977
978
979:- if((current_predicate(use_app_settings/1),
980 use_app_settings(true))). 981
982
983 986
987save_working_directory :-
988 working_directory(WD, WD),
989 app_settings(Settings),
990 ( Settings.get(working_directory) == WD
991 -> true
992 ; app_save_settings(Settings.put(working_directory, WD))
993 ).
994
995restore_working_directory :-
996 at_halt(save_working_directory),
997 app_settings(Settings),
998 WD = Settings.get(working_directory),
999 catch(working_directory(_, WD), _, fail),
1000 !.
1001
1002 1005
1009
1010app_settings(Settings) :-
1011 app_settings_file(File),
1012 access_file(File, read),
1013 catch(setup_call_cleanup(
1014 open(File, read, In, [encoding(utf8)]),
1015 read_term(In, Settings, []),
1016 close(In)),
1017 Error,
1018 (print_message(warning, Error), fail)),
1019 !.
1020app_settings(#{}).
1021
1025
1026app_save_settings(Settings) :-
1027 app_settings_file(File),
1028 catch(setup_call_cleanup(
1029 open(File, write, Out, [encoding(utf8)]),
1030 write_term(Out, Settings,
1031 [ quoted(true),
1032 module(system), 1033 fullstop(true),
1034 nl(true)
1035 ]),
1036 close(Out)),
1037 Error,
1038 (print_message(warning, Error), fail)).
1039
1040
1041app_settings_file(File) :-
1042 absolute_file_name(user_app_config('app_settings.pl'), File,
1043 [ access(write),
1044 file_errors(fail)
1045 ]).
1046:- endif. 1047
1048 1051
1052:- '$hide'('$toplevel'/0). 1053
1057
1058'$toplevel' :-
1059 '$runtoplevel',
1060 print_message(informational, halt).
1061
1069
1070'$runtoplevel' :-
1071 current_prolog_flag(toplevel_goal, TopLevel0),
1072 toplevel_goal(TopLevel0, TopLevel),
1073 user:TopLevel.
1074
1075:- dynamic setup_done/0. 1076:- volatile setup_done/0. 1077
1078toplevel_goal(default, '$query_loop') :-
1079 !,
1080 setup_interactive.
1081toplevel_goal(prolog, '$query_loop') :-
1082 !,
1083 setup_interactive.
1084toplevel_goal(Goal, Goal).
1085
1086setup_interactive :-
1087 setup_done,
1088 !.
1089setup_interactive :-
1090 asserta(setup_done),
1091 catch(setup_backtrace, E, print_message(warning, E)),
1092 catch(setup_readline, E, print_message(warning, E)),
1093 catch(setup_history, E, print_message(warning, E)).
1094
1098
1099'$compile' :-
1100 ( catch('$compile_', E, (print_message(error, E), halt(1)))
1101 -> true
1102 ; print_message(error, error(goal_failed('$compile'), _)),
1103 halt(1)
1104 ),
1105 halt. 1106
1107'$compile_' :-
1108 '$load_system_init_file',
1109 catch(setup_colors, _, true),
1110 '$set_file_search_paths',
1111 init_debug_flags,
1112 '$run_initialization',
1113 opt_attach_packs,
1114 use_module(library(qsave)),
1115 qsave:qsave_toplevel.
1116
1120
1121'$config' :-
1122 '$load_system_init_file',
1123 '$set_file_search_paths',
1124 init_debug_flags,
1125 '$run_initialization',
1126 load_files(library(prolog_config)),
1127 ( catch(prolog_dump_runtime_variables, E,
1128 (print_message(error, E), halt(1)))
1129 -> true
1130 ; print_message(error, error(goal_failed(prolog_dump_runtime_variables),_))
1131 ).
1132
1133
1134 1137
1148
1149:- multifile
1150 prolog:repl_loop_hook/2. 1151
1157
1158prolog :-
1159 break.
1160
1161:- create_prolog_flag(toplevel_mode, backtracking, []). 1162
1169
1170'$query_loop' :-
1171 break_level(BreakLev),
1172 setup_call_cleanup(
1173 notrace(call_repl_loop_hook(begin, BreakLev, IsToplevel)),
1174 '$query_loop'(BreakLev),
1175 notrace(call_repl_loop_hook(end, BreakLev, IsToplevel))).
1176
1177call_repl_loop_hook(begin, BreakLev, IsToplevel) =>
1178 ( current_prolog_flag(toplevel_thread, IsToplevel)
1179 -> true
1180 ; IsToplevel = false
1181 ),
1182 set_prolog_flag(toplevel_thread, true),
1183 call_repl_loop_hook_(begin, BreakLev).
1184call_repl_loop_hook(end, BreakLev, IsToplevel) =>
1185 set_prolog_flag(toplevel_thread, IsToplevel),
1186 call_repl_loop_hook_(end, BreakLev).
1187
1188call_repl_loop_hook_(BeginEnd, BreakLev) :-
1189 forall(prolog:repl_loop_hook(BeginEnd, BreakLev), true).
1190
1191
1192'$query_loop'(BreakLev) :-
1193 current_prolog_flag(toplevel_mode, recursive),
1194 !,
1195 read_expanded_query(BreakLev, Query, Bindings),
1196 ( Query == end_of_file
1197 -> print_message(query, query(eof))
1198 ; '$call_no_catch'('$execute_query'(Query, Bindings, _)),
1199 ( current_prolog_flag(toplevel_mode, recursive)
1200 -> '$query_loop'(BreakLev)
1201 ; '$switch_toplevel_mode'(backtracking),
1202 '$query_loop'(BreakLev) 1203 )
1204 ).
1205'$query_loop'(BreakLev) :-
1206 repeat,
1207 read_expanded_query(BreakLev, Query, Bindings),
1208 ( Query == end_of_file
1209 -> !, print_message(query, query(eof))
1210 ; '$execute_query'(Query, Bindings, _),
1211 ( current_prolog_flag(toplevel_mode, recursive)
1212 -> !,
1213 '$switch_toplevel_mode'(recursive),
1214 '$query_loop'(BreakLev)
1215 ; fail
1216 )
1217 ).
1218
1219break_level(BreakLev) :-
1220 ( current_prolog_flag(break_level, BreakLev)
1221 -> true
1222 ; BreakLev = -1
1223 ).
1224
1225read_expanded_query(BreakLev, ExpandedQuery, ExpandedBindings) :-
1226 '$current_typein_module'(TypeIn),
1227 ( stream_property(user_input, tty(true))
1228 -> '$system_prompt'(TypeIn, BreakLev, Prompt),
1229 prompt(Old, '| ')
1230 ; Prompt = '',
1231 prompt(Old, '')
1232 ),
1233 trim_stacks,
1234 trim_heap,
1235 repeat,
1236 ( catch(read_query(Prompt, Query, Bindings),
1237 error(io_error(_,_),_), fail)
1238 -> prompt(_, Old),
1239 catch(call_expand_query(Query, ExpandedQuery,
1240 Bindings, ExpandedBindings),
1241 Error,
1242 (print_message(error, Error), fail))
1243 ; set_prolog_flag(debug_on_error, false),
1244 thread_exit(io_error)
1245 ),
1246 !.
1247
1248
1254
1255:- multifile
1256 prolog:history/2. 1257
1258:- if(current_prolog_flag(emscripten, true)). 1259read_query(_Prompt, Goal, Bindings) :-
1260 '$can_yield',
1261 !,
1262 await(query, GoalString),
1263 term_string(Goal, GoalString, [variable_names(Bindings)]).
1264:- endif. 1265read_query(Prompt, Goal, Bindings) :-
1266 prolog:history(current_input, enabled),
1267 !,
1268 read_term_with_history(
1269 Goal,
1270 [ show(h),
1271 help('!h'),
1272 no_save([trace]),
1273 prompt(Prompt),
1274 variable_names(Bindings)
1275 ]).
1276read_query(Prompt, Goal, Bindings) :-
1277 remove_history_prompt(Prompt, Prompt1),
1278 repeat, 1279 prompt1(Prompt1),
1280 read_query_line(user_input, Line),
1281 '$current_typein_module'(TypeIn),
1282 catch(read_term_from_atom(Line, Goal,
1283 [ variable_names(Bindings),
1284 module(TypeIn)
1285 ]), E,
1286 ( print_message(error, E),
1287 fail
1288 )),
1289 !.
1290
1296
1297read_query_line(Input, Line) :-
1298 stream_property(Input, error(true)),
1299 !,
1300 Line = end_of_file.
1301read_query_line(Input, Line) :-
1302 catch(read_term_as_atom(Input, Line0), Error, true),
1303 save_debug_after_read,
1304 ( var(Error)
1305 -> ( catch(term_string(Goal, Line0), error(_,_), fail),
1306 Goal = '$silent'(SilentGoal)
1307 -> Error = error(_,_),
1308 catch_with_backtrace(ignore(SilentGoal), Error,
1309 print_message(error, Error)),
1310 read_query_line(Input, Line)
1311 ; Line = Line0
1312 )
1313 ; catch(print_message(error, Error), _, true),
1314 ( Error = error(syntax_error(_),_)
1315 -> fail
1316 ; throw(Error)
1317 )
1318 ).
1319
1324
1325read_term_as_atom(In, Line) :-
1326 '$raw_read'(In, Line),
1327 ( Line == end_of_file
1328 -> true
1329 ; skip_to_nl(In)
1330 ).
1331
1336
1337skip_to_nl(In) :-
1338 repeat,
1339 peek_char(In, C),
1340 ( C == '%'
1341 -> skip(In, '\n')
1342 ; char_type(C, space)
1343 -> get_char(In, _),
1344 C == '\n'
1345 ; true
1346 ),
1347 !.
1348
1349remove_history_prompt('', '') :- !.
1350remove_history_prompt(Prompt0, Prompt) :-
1351 atom_chars(Prompt0, Chars0),
1352 clean_history_prompt_chars(Chars0, Chars1),
1353 delete_leading_blanks(Chars1, Chars),
1354 atom_chars(Prompt, Chars).
1355
1356clean_history_prompt_chars([], []).
1357clean_history_prompt_chars(['~', !|T], T) :- !.
1358clean_history_prompt_chars([H|T0], [H|T]) :-
1359 clean_history_prompt_chars(T0, T).
1360
1361delete_leading_blanks([' '|T0], T) :-
1362 !,
1363 delete_leading_blanks(T0, T).
1364delete_leading_blanks(L, L).
1365
1366
1367 1370
1383
1384save_debug_after_read :-
1385 current_prolog_flag(debug, true),
1386 !,
1387 save_debug.
1388save_debug_after_read.
1389
1390save_debug :-
1391 ( tracing,
1392 notrace
1393 -> Tracing = true
1394 ; Tracing = false
1395 ),
1396 current_prolog_flag(debug, Debugging),
1397 set_prolog_flag(debug, false),
1398 create_prolog_flag(query_debug_settings,
1399 debug(Debugging, Tracing), []).
1400
1401restore_debug :-
1402 current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)),
1403 set_prolog_flag(debug, Debugging),
1404 ( Tracing == true
1405 -> trace
1406 ; true
1407 ).
1408
1409:- initialization
1410 create_prolog_flag(query_debug_settings, debug(false, false), []). 1411
1412
1413 1416
1417'$system_prompt'(Module, BrekLev, Prompt) :-
1418 current_prolog_flag(toplevel_prompt, PAtom),
1419 atom_codes(PAtom, P0),
1420 ( Module \== user
1421 -> '$substitute'('~m', [Module, ': '], P0, P1)
1422 ; '$substitute'('~m', [], P0, P1)
1423 ),
1424 ( BrekLev > 0
1425 -> '$substitute'('~l', ['[', BrekLev, '] '], P1, P2)
1426 ; '$substitute'('~l', [], P1, P2)
1427 ),
1428 current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)),
1429 ( Tracing == true
1430 -> '$substitute'('~d', ['[trace] '], P2, P3)
1431 ; Debugging == true
1432 -> '$substitute'('~d', ['[debug] '], P2, P3)
1433 ; '$substitute'('~d', [], P2, P3)
1434 ),
1435 atom_chars(Prompt, P3).
1436
1437'$substitute'(From, T, Old, New) :-
1438 atom_codes(From, FromCodes),
1439 phrase(subst_chars(T), T0),
1440 '$append'(Pre, S0, Old),
1441 '$append'(FromCodes, Post, S0) ->
1442 '$append'(Pre, T0, S1),
1443 '$append'(S1, Post, New),
1444 !.
1445'$substitute'(_, _, Old, Old).
1446
1447subst_chars([]) -->
1448 [].
1449subst_chars([H|T]) -->
1450 { atomic(H),
1451 !,
1452 atom_codes(H, Codes)
1453 },
1454 Codes,
1455 subst_chars(T).
1456subst_chars([H|T]) -->
1457 H,
1458 subst_chars(T).
1459
1460
1461 1464
1468
1469'$execute_query'(Var, _, true) :-
1470 var(Var),
1471 !,
1472 print_message(informational, var_query(Var)).
1473'$execute_query'(Goal, Bindings, Truth) :-
1474 '$current_typein_module'(TypeIn),
1475 '$dwim_correct_goal'(TypeIn:Goal, Bindings, Corrected),
1476 !,
1477 setup_call_cleanup(
1478 '$set_source_module'(M0, TypeIn),
1479 expand_goal(Corrected, Expanded),
1480 '$set_source_module'(M0)),
1481 print_message(silent, toplevel_goal(Expanded, Bindings)),
1482 '$execute_goal2'(Expanded, Bindings, Truth).
1483'$execute_query'(_, _, false) :-
1484 notrace,
1485 print_message(query, query(no)).
1486
1487'$execute_goal2'(Goal, Bindings, true) :-
1488 restore_debug,
1489 '$current_typein_module'(TypeIn),
1490 residue_vars(TypeIn:Goal, Vars, TypeIn:Delays, Chp),
1491 deterministic(Det),
1492 ( save_debug
1493 ; restore_debug, fail
1494 ),
1495 flush_output(user_output),
1496 ( Det == true
1497 -> DetOrChp = true
1498 ; DetOrChp = Chp
1499 ),
1500 call_expand_answer(Goal, Bindings, NewBindings),
1501 ( \+ \+ write_bindings(NewBindings, Vars, Delays, DetOrChp)
1502 -> !
1503 ).
1504'$execute_goal2'(_, _, false) :-
1505 save_debug,
1506 print_message(query, query(no)).
1507
1508residue_vars(Goal, Vars, Delays, Chp) :-
1509 current_prolog_flag(toplevel_residue_vars, true),
1510 !,
1511 '$wfs_call'(call_residue_vars(stop_backtrace(Goal, Chp), Vars), Delays).
1512residue_vars(Goal, [], Delays, Chp) :-
1513 '$wfs_call'(stop_backtrace(Goal, Chp), Delays).
1514
1515stop_backtrace(Goal, Chp) :-
1516 toplevel_call(Goal),
1517 prolog_current_choice(Chp).
1518
1519toplevel_call(Goal) :-
1520 call(Goal),
1521 no_lco.
1522
1523no_lco.
1524
1538
1539write_bindings(Bindings, ResidueVars, Delays, DetOrChp) :-
1540 '$current_typein_module'(TypeIn),
1541 translate_bindings(Bindings, Bindings1, ResidueVars, TypeIn:Residuals),
1542 omit_qualifier(Delays, TypeIn, Delays1),
1543 write_bindings2(Bindings, Bindings1, Residuals, Delays1, DetOrChp).
1544
1545write_bindings2(OrgBindings, [], Residuals, Delays, _) :-
1546 current_prolog_flag(prompt_alternatives_on, groundness),
1547 !,
1548 name_vars(OrgBindings, [], t(Residuals, Delays)),
1549 print_message(query, query(yes(Delays, Residuals))).
1550write_bindings2(OrgBindings, Bindings, Residuals, Delays, true) :-
1551 current_prolog_flag(prompt_alternatives_on, determinism),
1552 !,
1553 name_vars(OrgBindings, Bindings, t(Residuals, Delays)),
1554 print_message(query, query(yes(Bindings, Delays, Residuals))).
1555write_bindings2(OrgBindings, Bindings, Residuals, Delays, Chp) :-
1556 repeat,
1557 name_vars(OrgBindings, Bindings, t(Residuals, Delays)),
1558 print_message(query, query(more(Bindings, Delays, Residuals))),
1559 get_respons(Action, Chp),
1560 ( Action == redo
1561 -> !, fail
1562 ; Action == show_again
1563 -> fail
1564 ; !,
1565 print_message(query, query(done))
1566 ).
1567
1581
1582name_vars(OrgBindings, Bindings, Term) :-
1583 current_prolog_flag(toplevel_name_variables, true),
1584 answer_flags_imply_numbervars,
1585 !,
1586 '$term_multitons'(t(Bindings,Term), Vars),
1587 bindings_var_names(OrgBindings, Bindings, VarNames),
1588 name_vars_(Vars, VarNames, 0),
1589 term_variables(t(Bindings,Term), SVars),
1590 anon_vars(SVars).
1591name_vars(_OrgBindings, _Bindings, _Term).
1592
1593name_vars_([], _, _).
1594name_vars_([H|T], Bindings, N) :-
1595 name_var(Bindings, Name, N, N1),
1596 H = '$VAR'(Name),
1597 name_vars_(T, Bindings, N1).
1598
1599anon_vars([]).
1600anon_vars(['$VAR'('_')|T]) :-
1601 anon_vars(T).
1602
1607
1608name_var(Reserved, Name, N0, N) :-
1609 between(N0, infinite, N1),
1610 I is N1//26,
1611 J is 0'A + N1 mod 26,
1612 ( I == 0
1613 -> format(atom(Name), '_~c', [J])
1614 ; format(atom(Name), '_~c~d', [J, I])
1615 ),
1616 \+ memberchk(Name, Reserved),
1617 !,
1618 N is N1+1.
1619
1626
1627bindings_var_names(OrgBindings, TransBindings, VarNames) :-
1628 phrase(bindings_var_names_(OrgBindings), VarNames0, Tail),
1629 phrase(bindings_var_names_(TransBindings), Tail, []),
1630 sort(VarNames0, VarNames).
1631
1636
1637bindings_var_names_([]) --> [].
1638bindings_var_names_([H|T]) -->
1639 binding_var_names(H),
1640 bindings_var_names_(T).
1641
1642binding_var_names(binding(Vars,_Value,_Subst)) ==>
1643 var_names(Vars).
1644binding_var_names(Name=_Value) ==>
1645 [Name].
1646
1647var_names([]) --> [].
1648var_names([H|T]) --> [H], var_names(T).
1649
1650
1655
1656answer_flags_imply_numbervars :-
1657 current_prolog_flag(answer_write_options, Options),
1658 numbervars_option(Opt),
1659 memberchk(Opt, Options),
1660 !.
1661
1662numbervars_option(portray(true)).
1663numbervars_option(portrayed(true)).
1664numbervars_option(numbervars(true)).
1665
1670
1671:- multifile
1672 residual_goal_collector/1. 1673
1674:- meta_predicate
1675 residual_goals(2). 1676
1677residual_goals(NonTerminal) :-
1678 throw(error(context_error(nodirective, residual_goals(NonTerminal)), _)).
1679
1680system:term_expansion((:- residual_goals(NonTerminal)),
1681 '$toplevel':residual_goal_collector(M2:Head)) :-
1682 \+ current_prolog_flag(xref, true),
1683 prolog_load_context(module, M),
1684 strip_module(M:NonTerminal, M2, Head),
1685 '$must_be'(callable, Head).
1686
1691
1692:- public prolog:residual_goals//0. 1693
1694prolog:residual_goals -->
1695 { findall(NT, residual_goal_collector(NT), NTL) },
1696 collect_residual_goals(NTL).
1697
1698collect_residual_goals([]) --> [].
1699collect_residual_goals([H|T]) -->
1700 ( call(H) -> [] ; [] ),
1701 collect_residual_goals(T).
1702
1703
1704
1725
1726:- public
1727 prolog:translate_bindings/5. 1728:- meta_predicate
1729 prolog:translate_bindings(+, -, +, +, :). 1730
1731prolog:translate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals) :-
1732 translate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals),
1733 name_vars(Bindings0, Bindings, t(ResVars, ResGoals, Residuals)).
1734
1736prolog:name_vars(Bindings, Term) :- name_vars([], Bindings, Term).
1737prolog:name_vars(Bindings0, Bindings, Term) :- name_vars(Bindings0, Bindings, Term).
1738
1739translate_bindings(Bindings0, Bindings, ResidueVars, Residuals) :-
1740 prolog:residual_goals(ResidueGoals, []),
1741 translate_bindings(Bindings0, Bindings, ResidueVars, ResidueGoals,
1742 Residuals).
1743
1744translate_bindings(Bindings0, Bindings, [], [], _:[]-[]) :-
1745 term_attvars(Bindings0, []),
1746 !,
1747 join_same_bindings(Bindings0, Bindings1),
1748 factorize_bindings(Bindings1, Bindings2),
1749 bind_vars(Bindings2, Bindings3),
1750 filter_bindings(Bindings3, Bindings).
1751translate_bindings(Bindings0, Bindings, ResidueVars, ResGoals0,
1752 TypeIn:Residuals-HiddenResiduals) :-
1753 project_constraints(Bindings0, ResidueVars),
1754 hidden_residuals(ResidueVars, Bindings0, HiddenResiduals0),
1755 omit_qualifiers(HiddenResiduals0, TypeIn, HiddenResiduals),
1756 copy_term(Bindings0+ResGoals0, Bindings1+ResGoals1, Residuals0),
1757 '$append'(ResGoals1, Residuals0, Residuals1),
1758 omit_qualifiers(Residuals1, TypeIn, Residuals),
1759 join_same_bindings(Bindings1, Bindings2),
1760 factorize_bindings(Bindings2, Bindings3),
1761 bind_vars(Bindings3, Bindings4),
1762 filter_bindings(Bindings4, Bindings).
1763
1764hidden_residuals(ResidueVars, Bindings, Goal) :-
1765 term_attvars(ResidueVars, Remaining),
1766 term_attvars(Bindings, QueryVars),
1767 subtract_vars(Remaining, QueryVars, HiddenVars),
1768 copy_term(HiddenVars, _, Goal).
1769
1770subtract_vars(All, Subtract, Remaining) :-
1771 sort(All, AllSorted),
1772 sort(Subtract, SubtractSorted),
1773 ord_subtract(AllSorted, SubtractSorted, Remaining).
1774
1775ord_subtract([], _Not, []).
1776ord_subtract([H1|T1], L2, Diff) :-
1777 diff21(L2, H1, T1, Diff).
1778
1779diff21([], H1, T1, [H1|T1]).
1780diff21([H2|T2], H1, T1, Diff) :-
1781 compare(Order, H1, H2),
1782 diff3(Order, H1, T1, H2, T2, Diff).
1783
1784diff12([], _H2, _T2, []).
1785diff12([H1|T1], H2, T2, Diff) :-
1786 compare(Order, H1, H2),
1787 diff3(Order, H1, T1, H2, T2, Diff).
1788
1789diff3(<, H1, T1, H2, T2, [H1|Diff]) :-
1790 diff12(T1, H2, T2, Diff).
1791diff3(=, _H1, T1, _H2, T2, Diff) :-
1792 ord_subtract(T1, T2, Diff).
1793diff3(>, H1, T1, _H2, T2, Diff) :-
1794 diff21(T2, H1, T1, Diff).
1795
1796
1801
1802project_constraints(Bindings, ResidueVars) :-
1803 !,
1804 term_attvars(Bindings, AttVars),
1805 phrase(attribute_modules(AttVars), Modules0),
1806 sort(Modules0, Modules),
1807 term_variables(Bindings, QueryVars),
1808 project_attributes(Modules, QueryVars, ResidueVars).
1809project_constraints(_, _).
1810
1811project_attributes([], _, _).
1812project_attributes([M|T], QueryVars, ResidueVars) :-
1813 ( current_predicate(M:project_attributes/2),
1814 catch(M:project_attributes(QueryVars, ResidueVars), E,
1815 print_message(error, E))
1816 -> true
1817 ; true
1818 ),
1819 project_attributes(T, QueryVars, ResidueVars).
1820
1821attribute_modules([]) --> [].
1822attribute_modules([H|T]) -->
1823 { get_attrs(H, Attrs) },
1824 attrs_modules(Attrs),
1825 attribute_modules(T).
1826
1827attrs_modules([]) --> [].
1828attrs_modules(att(Module, _, More)) -->
1829 [Module],
1830 attrs_modules(More).
1831
1832
1840
1841join_same_bindings([], []).
1842join_same_bindings([Name=V0|T0], [[Name|Names]=V|T]) :-
1843 take_same_bindings(T0, V0, V, Names, T1),
1844 join_same_bindings(T1, T).
1845
1846take_same_bindings([], Val, Val, [], []).
1847take_same_bindings([Name=V1|T0], V0, V, [Name|Names], T) :-
1848 V0 == V1,
1849 !,
1850 take_same_bindings(T0, V1, V, Names, T).
1851take_same_bindings([Pair|T0], V0, V, Names, [Pair|T]) :-
1852 take_same_bindings(T0, V0, V, Names, T).
1853
1854
1859
1860
1861omit_qualifiers([], _, []).
1862omit_qualifiers([Goal0|Goals0], TypeIn, [Goal|Goals]) :-
1863 omit_qualifier(Goal0, TypeIn, Goal),
1864 omit_qualifiers(Goals0, TypeIn, Goals).
1865
1866omit_qualifier(M:G0, TypeIn, G) :-
1867 M == TypeIn,
1868 !,
1869 omit_meta_qualifiers(G0, TypeIn, G).
1870omit_qualifier(M:G0, TypeIn, G) :-
1871 predicate_property(TypeIn:G0, imported_from(M)),
1872 \+ predicate_property(G0, transparent),
1873 !,
1874 G0 = G.
1875omit_qualifier(_:G0, _, G) :-
1876 predicate_property(G0, built_in),
1877 \+ predicate_property(G0, transparent),
1878 !,
1879 G0 = G.
1880omit_qualifier(M:G0, _, M:G) :-
1881 atom(M),
1882 !,
1883 omit_meta_qualifiers(G0, M, G).
1884omit_qualifier(G0, TypeIn, G) :-
1885 omit_meta_qualifiers(G0, TypeIn, G).
1886
1887omit_meta_qualifiers(V, _, V) :-
1888 var(V),
1889 !.
1890omit_meta_qualifiers((QA,QB), TypeIn, (A,B)) :-
1891 !,
1892 omit_qualifier(QA, TypeIn, A),
1893 omit_qualifier(QB, TypeIn, B).
1894omit_meta_qualifiers(tnot(QA), TypeIn, tnot(A)) :-
1895 !,
1896 omit_qualifier(QA, TypeIn, A).
1897omit_meta_qualifiers(freeze(V, QGoal), TypeIn, freeze(V, Goal)) :-
1898 callable(QGoal),
1899 !,
1900 omit_qualifier(QGoal, TypeIn, Goal).
1901omit_meta_qualifiers(when(Cond, QGoal), TypeIn, when(Cond, Goal)) :-
1902 callable(QGoal),
1903 !,
1904 omit_qualifier(QGoal, TypeIn, Goal).
1905omit_meta_qualifiers(G, _, G).
1906
1907
1913
1914bind_vars(Bindings0, Bindings) :-
1915 bind_query_vars(Bindings0, Bindings, SNames),
1916 bind_skel_vars(Bindings, Bindings, SNames, 1, _).
1917
1918bind_query_vars([], [], []).
1919bind_query_vars([binding(Names,Var,[Var2=Cycle])|T0],
1920 [binding(Names,Cycle,[])|T], [Name|SNames]) :-
1921 Var == Var2, 1922 !,
1923 '$last'(Names, Name),
1924 Var = '$VAR'(Name),
1925 bind_query_vars(T0, T, SNames).
1926bind_query_vars([B|T0], [B|T], AllNames) :-
1927 B = binding(Names,Var,Skel),
1928 bind_query_vars(T0, T, SNames),
1929 ( var(Var), \+ attvar(Var), Skel == []
1930 -> AllNames = [Name|SNames],
1931 '$last'(Names, Name),
1932 Var = '$VAR'(Name)
1933 ; AllNames = SNames
1934 ).
1935
1936
1937
1938bind_skel_vars([], _, _, N, N).
1939bind_skel_vars([binding(_,_,Skel)|T], Bindings, SNames, N0, N) :-
1940 bind_one_skel_vars(Skel, Bindings, SNames, N0, N1),
1941 bind_skel_vars(T, Bindings, SNames, N1, N).
1942
1959
1960bind_one_skel_vars([], _, _, N, N).
1961bind_one_skel_vars([Var=Value|T], Bindings, Names, N0, N) :-
1962 ( var(Var)
1963 -> ( '$member'(binding(Names, VVal, []), Bindings),
1964 same_term(Value, VVal)
1965 -> '$last'(Names, VName),
1966 Var = '$VAR'(VName),
1967 N2 = N0
1968 ; between(N0, infinite, N1),
1969 atom_concat('_S', N1, Name),
1970 \+ memberchk(Name, Names),
1971 !,
1972 Var = '$VAR'(Name),
1973 N2 is N1 + 1
1974 )
1975 ; N2 = N0
1976 ),
1977 bind_one_skel_vars(T, Bindings, Names, N2, N).
1978
1979
1983
1984factorize_bindings([], []).
1985factorize_bindings([Name=Value|T0], [binding(Name, Skel, Subst)|T]) :-
1986 '$factorize_term'(Value, Skel, Subst0),
1987 ( current_prolog_flag(toplevel_print_factorized, true)
1988 -> Subst = Subst0
1989 ; only_cycles(Subst0, Subst)
1990 ),
1991 factorize_bindings(T0, T).
1992
1993
1994only_cycles([], []).
1995only_cycles([B|T0], List) :-
1996 ( B = (Var=Value),
1997 Var = Value,
1998 acyclic_term(Var)
1999 -> only_cycles(T0, List)
2000 ; List = [B|T],
2001 only_cycles(T0, T)
2002 ).
2003
2004
2010
2011filter_bindings([], []).
2012filter_bindings([H0|T0], T) :-
2013 hide_vars(H0, H),
2014 ( ( arg(1, H, [])
2015 ; self_bounded(H)
2016 )
2017 -> filter_bindings(T0, T)
2018 ; T = [H|T1],
2019 filter_bindings(T0, T1)
2020 ).
2021
2022hide_vars(binding(Names0, Skel, Subst), binding(Names, Skel, Subst)) :-
2023 hide_names(Names0, Skel, Subst, Names).
2024
2025hide_names([], _, _, []).
2026hide_names([Name|T0], Skel, Subst, T) :-
2027 ( sub_atom(Name, 0, _, _, '_'),
2028 current_prolog_flag(toplevel_print_anon, false),
2029 sub_atom(Name, 1, 1, _, Next),
2030 char_type(Next, prolog_var_start)
2031 -> true
2032 ; Subst == [],
2033 Skel == '$VAR'(Name)
2034 ),
2035 !,
2036 hide_names(T0, Skel, Subst, T).
2037hide_names([Name|T0], Skel, Subst, [Name|T]) :-
2038 hide_names(T0, Skel, Subst, T).
2039
2040self_bounded(binding([Name], Value, [])) :-
2041 Value == '$VAR'(Name).
2042
2046
2047:- if(current_prolog_flag(emscripten, true)). 2048get_respons(Action, Chp) :-
2049 '$can_yield',
2050 !,
2051 repeat,
2052 await(more, CommandS),
2053 atom_string(Command, CommandS),
2054 more_action(Command, Chp, Action),
2055 ( Action == again
2056 -> print_message(query, query(action)),
2057 fail
2058 ; !
2059 ).
2060:- endif. 2061get_respons(Action, Chp) :-
2062 repeat,
2063 flush_output(user_output),
2064 get_single_char(Code),
2065 find_more_command(Code, Command, Feedback, Style),
2066 ( Style \== '-'
2067 -> print_message(query, if_tty([ansi(Style, '~w', [Feedback])]))
2068 ; true
2069 ),
2070 more_action(Command, Chp, Action),
2071 ( Action == again
2072 -> print_message(query, query(action)),
2073 fail
2074 ; !
2075 ).
2076
2077find_more_command(-1, end_of_file, 'EOF', warning) :-
2078 !.
2079find_more_command(Code, Command, Feedback, Style) :-
2080 more_command(Command, Atom, Feedback, Style),
2081 '$in_reply'(Code, Atom),
2082 !.
2083find_more_command(Code, again, '', -) :-
2084 print_message(query, no_action(Code)).
2085
2086more_command(help, '?h', '', -).
2087more_command(redo, ';nrNR \t', ';', bold).
2088more_command(trace, 'tT', '; [trace]', comment).
2089more_command(continue, 'ca\n\ryY.', '.', bold).
2090more_command(break, 'b', '', -).
2091more_command(choicepoint, '*', '', -).
2092more_command(write, 'w', '[write]', comment).
2093more_command(print, 'p', '[print]', comment).
2094more_command(depth_inc, '+', Change, comment) :-
2095 ( print_depth(Depth0)
2096 -> depth_step(Step),
2097 NewDepth is Depth0*Step,
2098 format(atom(Change), '[max_depth(~D)]', [NewDepth])
2099 ; Change = 'no max_depth'
2100 ).
2101more_command(depth_dec, '-', Change, comment) :-
2102 ( print_depth(Depth0)
2103 -> depth_step(Step),
2104 NewDepth is max(1, Depth0//Step),
2105 format(atom(Change), '[max_depth(~D)]', [NewDepth])
2106 ; Change = '[max_depth(10)]'
2107 ).
2108
2109more_action(help, _, Action) =>
2110 Action = again,
2111 print_message(help, query(help)).
2112more_action(redo, _, Action) => 2113 Action = redo.
2114more_action(trace, _, Action) =>
2115 Action = redo,
2116 trace,
2117 save_debug.
2118more_action(continue, _, Action) => 2119 Action = continue.
2120more_action(break, _, Action) =>
2121 Action = show_again,
2122 break.
2123more_action(choicepoint, Chp, Action) =>
2124 Action = show_again,
2125 print_last_chpoint(Chp).
2126more_action(end_of_file, _, Action) =>
2127 Action = show_again,
2128 halt(0).
2129more_action(again, _, Action) =>
2130 Action = again.
2131more_action(Command, _, Action),
2132 current_prolog_flag(answer_write_options, Options0),
2133 print_predicate(Command, Options0, Options) =>
2134 Action = show_again,
2135 set_prolog_flag(answer_write_options, Options).
2136
2137print_depth(Depth) :-
2138 current_prolog_flag(answer_write_options, Options),
2139 memberchk(max_depth(Depth), Options),
2140 !.
2141
2146
2147print_predicate(write, Options0, Options) :-
2148 edit_options([-portrayed(true),-portray(true)],
2149 Options0, Options).
2150print_predicate(print, Options0, Options) :-
2151 edit_options([+portrayed(true)],
2152 Options0, Options).
2153print_predicate(depth_inc, Options0, Options) :-
2154 ( '$select'(max_depth(D0), Options0, Options1)
2155 -> depth_step(Step),
2156 D is D0*Step,
2157 Options = [max_depth(D)|Options1]
2158 ; Options = Options0
2159 ).
2160print_predicate(depth_dec, Options0, Options) :-
2161 ( '$select'(max_depth(D0), Options0, Options1)
2162 -> depth_step(Step),
2163 D is max(1, D0//Step),
2164 Options = [max_depth(D)|Options1]
2165 ; D = 10,
2166 Options = [max_depth(D)|Options0]
2167 ).
2168
2169depth_step(5).
2170
2171edit_options([], Options, Options).
2172edit_options([H|T], Options0, Options) :-
2173 edit_option(H, Options0, Options1),
2174 edit_options(T, Options1, Options).
2175
2176edit_option(-Term, Options0, Options) =>
2177 ( '$select'(Term, Options0, Options)
2178 -> true
2179 ; Options = Options0
2180 ).
2181edit_option(+Term, Options0, Options) =>
2182 functor(Term, Name, 1),
2183 functor(Var, Name, 1),
2184 ( '$select'(Var, Options0, Options1)
2185 -> Options = [Term|Options1]
2186 ; Options = [Term|Options0]
2187 ).
2188
2192
2193print_last_chpoint(Chp) :-
2194 current_predicate(print_last_choice_point/0),
2195 !,
2196 print_last_chpoint_(Chp).
2197print_last_chpoint(Chp) :-
2198 use_module(library(prolog_stack), [print_last_choicepoint/2]),
2199 print_last_chpoint_(Chp).
2200
2201print_last_chpoint_(Chp) :-
2202 print_last_choicepoint(Chp, [message_level(information)]).
2203
2204
2205 2208
2209:- user:dynamic(expand_query/4). 2210:- user:multifile(expand_query/4). 2211
2212call_expand_query(Goal, Expanded, Bindings, ExpandedBindings) :-
2213 ( '$replace_toplevel_vars'(Goal, Expanded0, Bindings, ExpandedBindings0)
2214 -> true
2215 ; Expanded0 = Goal, ExpandedBindings0 = Bindings
2216 ),
2217 ( user:expand_query(Expanded0, Expanded, ExpandedBindings0, ExpandedBindings)
2218 -> true
2219 ; Expanded = Expanded0, ExpandedBindings = ExpandedBindings0
2220 ).
2221
2222
2223:- dynamic
2224 user:expand_answer/2,
2225 prolog:expand_answer/3. 2226:- multifile
2227 user:expand_answer/2,
2228 prolog:expand_answer/3. 2229
2230call_expand_answer(Goal, BindingsIn, BindingsOut) :-
2231 ( prolog:expand_answer(Goal, BindingsIn, BindingsOut)
2232 -> true
2233 ; user:expand_answer(BindingsIn, BindingsOut)
2234 -> true
2235 ; BindingsOut = BindingsIn
2236 ),
2237 '$save_toplevel_vars'(BindingsOut),
2238 !.
2239call_expand_answer(_, Bindings, Bindings)