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 ; print_message(warning,
849 error(existence_error(library, library(Library)),
850 _)),
851 fail
852 )
853 -> set_prolog_flag(readline, Library)
854 ; set_prolog_flag(readline, false)
855 ).
856
857readline_library(true, Library) :-
858 !,
859 preferred_readline(Library).
860readline_library(false, _) :-
861 !,
862 fail.
863readline_library(Library, Library).
864
865preferred_readline(editline).
866
870
871load_setup_file(File) :-
872 catch(load_files(File,
873 [ silent(true),
874 if(not_loaded)
875 ]), error(_,_), fail).
876
877
886
887:- if(current_prolog_flag(windows,true)). 888
889setup_app :-
890 current_prolog_flag(associated_file, _),
891 !.
892setup_app :-
893 '$cmd_option_val'(win_app, true),
894 !,
895 catch(my_prolog, E, print_message(warning, E)).
896setup_app.
897
898my_prolog :-
899 win_folder(personal, MyDocs),
900 atom_concat(MyDocs, '/Prolog', PrologDir),
901 ( ensure_dir(PrologDir)
902 -> working_directory(_, PrologDir)
903 ; working_directory(_, MyDocs)
904 ).
905
906ensure_dir(Dir) :-
907 exists_directory(Dir),
908 !.
909ensure_dir(Dir) :-
910 catch(make_directory(Dir), E, (print_message(warning, E), fail)).
911
912:- elif(current_prolog_flag(apple, true)). 913use_app_settings(true). 914
915setup_app :-
916 apple_set_locale,
917 current_prolog_flag(associated_file, _),
918 !.
919setup_app :-
920 current_prolog_flag(bundle, true),
921 current_prolog_flag(executable, Exe),
922 file_base_name(Exe, 'SWI-Prolog'),
923 !,
924 setup_macos_app.
925setup_app.
926
927apple_set_locale :-
928 ( getenv('LC_CTYPE', 'UTF-8'),
929 apple_current_locale_identifier(LocaleID),
930 atom_concat(LocaleID, '.UTF-8', Locale),
931 catch(setlocale(ctype, _Old, Locale), _, fail)
932 -> setenv('LANG', Locale),
933 unsetenv('LC_CTYPE')
934 ; true
935 ).
936
937setup_macos_app :-
938 restore_working_directory,
939 !.
940setup_macos_app :-
941 expand_file_name('~/Prolog', [PrologDir]),
942 ( exists_directory(PrologDir)
943 -> true
944 ; catch(make_directory(PrologDir), MkDirError,
945 print_message(warning, MkDirError))
946 ),
947 catch(working_directory(_, PrologDir), CdError,
948 print_message(warning, CdError)),
949 !.
950setup_macos_app.
951
952:- elif(current_prolog_flag(emscripten, true)). 953setup_app.
954:- else. 955use_app_settings(true). 956
958setup_app :-
959 running_as_app,
960 restore_working_directory,
961 !.
962setup_app.
963
967
968running_as_app :-
970 current_prolog_flag(epilog, true),
971 stream_property(In, file_no(0)),
972 \+ stream_property(In, tty(true)),
973 !.
974
975:- endif. 976
977
978:- if((current_predicate(use_app_settings/1),
979 use_app_settings(true))). 980
981
982 985
986save_working_directory :-
987 working_directory(WD, WD),
988 app_settings(Settings),
989 ( Settings.get(working_directory) == WD
990 -> true
991 ; app_save_settings(Settings.put(working_directory, WD))
992 ).
993
994restore_working_directory :-
995 at_halt(save_working_directory),
996 app_settings(Settings),
997 WD = Settings.get(working_directory),
998 catch(working_directory(_, WD), _, fail),
999 !.
1000
1001 1004
1008
1009app_settings(Settings) :-
1010 app_settings_file(File),
1011 access_file(File, read),
1012 catch(setup_call_cleanup(
1013 open(File, read, In, [encoding(utf8)]),
1014 read_term(In, Settings, []),
1015 close(In)),
1016 Error,
1017 (print_message(warning, Error), fail)),
1018 !.
1019app_settings(#{}).
1020
1024
1025app_save_settings(Settings) :-
1026 app_settings_file(File),
1027 catch(setup_call_cleanup(
1028 open(File, write, Out, [encoding(utf8)]),
1029 write_term(Out, Settings,
1030 [ quoted(true),
1031 module(system), 1032 fullstop(true),
1033 nl(true)
1034 ]),
1035 close(Out)),
1036 Error,
1037 (print_message(warning, Error), fail)).
1038
1039
1040app_settings_file(File) :-
1041 absolute_file_name(user_app_config('app_settings.pl'), File,
1042 [ access(write),
1043 file_errors(fail)
1044 ]).
1045:- endif. 1046
1047 1050
1051:- '$hide'('$toplevel'/0). 1052
1056
1057'$toplevel' :-
1058 '$runtoplevel',
1059 print_message(informational, halt).
1060
1068
1069'$runtoplevel' :-
1070 current_prolog_flag(toplevel_goal, TopLevel0),
1071 toplevel_goal(TopLevel0, TopLevel),
1072 user:TopLevel.
1073
1074:- dynamic setup_done/0. 1075:- volatile setup_done/0. 1076
1077toplevel_goal(default, '$query_loop') :-
1078 !,
1079 setup_interactive.
1080toplevel_goal(prolog, '$query_loop') :-
1081 !,
1082 setup_interactive.
1083toplevel_goal(Goal, Goal).
1084
1085setup_interactive :-
1086 setup_done,
1087 !.
1088setup_interactive :-
1089 asserta(setup_done),
1090 catch(setup_backtrace, E, print_message(warning, E)),
1091 catch(setup_readline, E, print_message(warning, E)),
1092 catch(setup_history, E, print_message(warning, E)).
1093
1097
1098'$compile' :-
1099 ( catch('$compile_', E, (print_message(error, E), halt(1)))
1100 -> true
1101 ; print_message(error, error(goal_failed('$compile'), _)),
1102 halt(1)
1103 ),
1104 halt. 1105
1106'$compile_' :-
1107 '$load_system_init_file',
1108 catch(setup_colors, _, true),
1109 '$set_file_search_paths',
1110 init_debug_flags,
1111 '$run_initialization',
1112 opt_attach_packs,
1113 use_module(library(qsave)),
1114 qsave:qsave_toplevel.
1115
1119
1120'$config' :-
1121 '$load_system_init_file',
1122 '$set_file_search_paths',
1123 init_debug_flags,
1124 '$run_initialization',
1125 load_files(library(prolog_config)),
1126 ( catch(prolog_dump_runtime_variables, E,
1127 (print_message(error, E), halt(1)))
1128 -> true
1129 ; print_message(error, error(goal_failed(prolog_dump_runtime_variables),_))
1130 ).
1131
1132
1133 1136
1147
1148:- multifile
1149 prolog:repl_loop_hook/2. 1150
1156
1157prolog :-
1158 break.
1159
1160:- create_prolog_flag(toplevel_mode, backtracking, []). 1161
1168
1169'$query_loop' :-
1170 break_level(BreakLev),
1171 setup_call_cleanup(
1172 notrace(call_repl_loop_hook(begin, BreakLev, IsToplevel)),
1173 '$query_loop'(BreakLev),
1174 notrace(call_repl_loop_hook(end, BreakLev, IsToplevel))).
1175
1176call_repl_loop_hook(begin, BreakLev, IsToplevel) =>
1177 ( current_prolog_flag(toplevel_thread, IsToplevel)
1178 -> true
1179 ; IsToplevel = false
1180 ),
1181 set_prolog_flag(toplevel_thread, true),
1182 call_repl_loop_hook_(begin, BreakLev).
1183call_repl_loop_hook(end, BreakLev, IsToplevel) =>
1184 set_prolog_flag(toplevel_thread, IsToplevel),
1185 call_repl_loop_hook_(end, BreakLev).
1186
1187call_repl_loop_hook_(BeginEnd, BreakLev) :-
1188 forall(prolog:repl_loop_hook(BeginEnd, BreakLev), true).
1189
1190
1191'$query_loop'(BreakLev) :-
1192 current_prolog_flag(toplevel_mode, recursive),
1193 !,
1194 read_expanded_query(BreakLev, Query, Bindings),
1195 ( Query == end_of_file
1196 -> print_message(query, query(eof))
1197 ; '$call_no_catch'('$execute_query'(Query, Bindings, _)),
1198 ( current_prolog_flag(toplevel_mode, recursive)
1199 -> '$query_loop'(BreakLev)
1200 ; '$switch_toplevel_mode'(backtracking),
1201 '$query_loop'(BreakLev) 1202 )
1203 ).
1204'$query_loop'(BreakLev) :-
1205 repeat,
1206 read_expanded_query(BreakLev, Query, Bindings),
1207 ( Query == end_of_file
1208 -> !, print_message(query, query(eof))
1209 ; '$execute_query'(Query, Bindings, _),
1210 ( current_prolog_flag(toplevel_mode, recursive)
1211 -> !,
1212 '$switch_toplevel_mode'(recursive),
1213 '$query_loop'(BreakLev)
1214 ; fail
1215 )
1216 ).
1217
1218break_level(BreakLev) :-
1219 ( current_prolog_flag(break_level, BreakLev)
1220 -> true
1221 ; BreakLev = -1
1222 ).
1223
1224read_expanded_query(BreakLev, ExpandedQuery, ExpandedBindings) :-
1225 '$current_typein_module'(TypeIn),
1226 ( stream_property(user_input, tty(true))
1227 -> '$system_prompt'(TypeIn, BreakLev, Prompt),
1228 prompt(Old, '| ')
1229 ; Prompt = '',
1230 prompt(Old, '')
1231 ),
1232 trim_stacks,
1233 trim_heap,
1234 repeat,
1235 ( catch(read_query(Prompt, Query, Bindings),
1236 error(io_error(_,_),_), fail)
1237 -> prompt(_, Old),
1238 catch(call_expand_query(Query, ExpandedQuery,
1239 Bindings, ExpandedBindings),
1240 Error,
1241 (print_message(error, Error), fail))
1242 ; set_prolog_flag(debug_on_error, false),
1243 thread_exit(io_error)
1244 ),
1245 !.
1246
1247
1253
1254:- multifile
1255 prolog:history/2. 1256
1257:- if(current_prolog_flag(emscripten, true)). 1258read_query(_Prompt, Goal, Bindings) :-
1259 '$can_yield',
1260 !,
1261 await(query, GoalString),
1262 term_string(Goal, GoalString, [variable_names(Bindings)]).
1263:- endif. 1264read_query(Prompt, Goal, Bindings) :-
1265 prolog:history(current_input, enabled),
1266 !,
1267 read_term_with_history(
1268 Goal,
1269 [ show(h),
1270 help('!h'),
1271 no_save([trace]),
1272 prompt(Prompt),
1273 variable_names(Bindings)
1274 ]).
1275read_query(Prompt, Goal, Bindings) :-
1276 remove_history_prompt(Prompt, Prompt1),
1277 repeat, 1278 prompt1(Prompt1),
1279 read_query_line(user_input, Line),
1280 '$current_typein_module'(TypeIn),
1281 catch(read_term_from_atom(Line, Goal,
1282 [ variable_names(Bindings),
1283 module(TypeIn)
1284 ]), E,
1285 ( print_message(error, E),
1286 fail
1287 )),
1288 !.
1289
1295
1296read_query_line(Input, Line) :-
1297 stream_property(Input, error(true)),
1298 !,
1299 Line = end_of_file.
1300read_query_line(Input, Line) :-
1301 catch(read_term_as_atom(Input, Line0), Error, true),
1302 save_debug_after_read,
1303 ( var(Error)
1304 -> ( catch(term_string(Goal, Line0), error(_,_), fail),
1305 Goal = '$silent'(SilentGoal)
1306 -> Error = error(_,_),
1307 catch_with_backtrace(ignore(SilentGoal), Error,
1308 print_message(error, Error)),
1309 read_query_line(Input, Line)
1310 ; Line = Line0
1311 )
1312 ; catch(print_message(error, Error), _, true),
1313 ( Error = error(syntax_error(_),_)
1314 -> fail
1315 ; throw(Error)
1316 )
1317 ).
1318
1323
1324read_term_as_atom(In, Line) :-
1325 '$raw_read'(In, Line),
1326 ( Line == end_of_file
1327 -> true
1328 ; skip_to_nl(In)
1329 ).
1330
1335
1336skip_to_nl(In) :-
1337 repeat,
1338 peek_char(In, C),
1339 ( C == '%'
1340 -> skip(In, '\n')
1341 ; char_type(C, space)
1342 -> get_char(In, _),
1343 C == '\n'
1344 ; true
1345 ),
1346 !.
1347
1348remove_history_prompt('', '') :- !.
1349remove_history_prompt(Prompt0, Prompt) :-
1350 atom_chars(Prompt0, Chars0),
1351 clean_history_prompt_chars(Chars0, Chars1),
1352 delete_leading_blanks(Chars1, Chars),
1353 atom_chars(Prompt, Chars).
1354
1355clean_history_prompt_chars([], []).
1356clean_history_prompt_chars(['~', !|T], T) :- !.
1357clean_history_prompt_chars([H|T0], [H|T]) :-
1358 clean_history_prompt_chars(T0, T).
1359
1360delete_leading_blanks([' '|T0], T) :-
1361 !,
1362 delete_leading_blanks(T0, T).
1363delete_leading_blanks(L, L).
1364
1365
1366 1369
1382
1383save_debug_after_read :-
1384 current_prolog_flag(debug, true),
1385 !,
1386 save_debug.
1387save_debug_after_read.
1388
1389save_debug :-
1390 ( tracing,
1391 notrace
1392 -> Tracing = true
1393 ; Tracing = false
1394 ),
1395 current_prolog_flag(debug, Debugging),
1396 set_prolog_flag(debug, false),
1397 create_prolog_flag(query_debug_settings,
1398 debug(Debugging, Tracing), []).
1399
1400restore_debug :-
1401 current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)),
1402 set_prolog_flag(debug, Debugging),
1403 ( Tracing == true
1404 -> trace
1405 ; true
1406 ).
1407
1408:- initialization
1409 create_prolog_flag(query_debug_settings, debug(false, false), []). 1410
1411
1412 1415
1416'$system_prompt'(Module, BrekLev, Prompt) :-
1417 current_prolog_flag(toplevel_prompt, PAtom),
1418 atom_codes(PAtom, P0),
1419 ( Module \== user
1420 -> '$substitute'('~m', [Module, ': '], P0, P1)
1421 ; '$substitute'('~m', [], P0, P1)
1422 ),
1423 ( BrekLev > 0
1424 -> '$substitute'('~l', ['[', BrekLev, '] '], P1, P2)
1425 ; '$substitute'('~l', [], P1, P2)
1426 ),
1427 current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)),
1428 ( Tracing == true
1429 -> '$substitute'('~d', ['[trace] '], P2, P3)
1430 ; Debugging == true
1431 -> '$substitute'('~d', ['[debug] '], P2, P3)
1432 ; '$substitute'('~d', [], P2, P3)
1433 ),
1434 atom_chars(Prompt, P3).
1435
1436'$substitute'(From, T, Old, New) :-
1437 atom_codes(From, FromCodes),
1438 phrase(subst_chars(T), T0),
1439 '$append'(Pre, S0, Old),
1440 '$append'(FromCodes, Post, S0) ->
1441 '$append'(Pre, T0, S1),
1442 '$append'(S1, Post, New),
1443 !.
1444'$substitute'(_, _, Old, Old).
1445
1446subst_chars([]) -->
1447 [].
1448subst_chars([H|T]) -->
1449 { atomic(H),
1450 !,
1451 atom_codes(H, Codes)
1452 },
1453 Codes,
1454 subst_chars(T).
1455subst_chars([H|T]) -->
1456 H,
1457 subst_chars(T).
1458
1459
1460 1463
1467
1468'$execute_query'(Var, _, true) :-
1469 var(Var),
1470 !,
1471 print_message(informational, var_query(Var)).
1472'$execute_query'(Goal, Bindings, Truth) :-
1473 '$current_typein_module'(TypeIn),
1474 '$dwim_correct_goal'(TypeIn:Goal, Bindings, Corrected),
1475 !,
1476 setup_call_cleanup(
1477 '$set_source_module'(M0, TypeIn),
1478 expand_goal(Corrected, Expanded),
1479 '$set_source_module'(M0)),
1480 print_message(silent, toplevel_goal(Expanded, Bindings)),
1481 '$execute_goal2'(Expanded, Bindings, Truth).
1482'$execute_query'(_, _, false) :-
1483 notrace,
1484 print_message(query, query(no)).
1485
1486'$execute_goal2'(Goal, Bindings, true) :-
1487 restore_debug,
1488 '$current_typein_module'(TypeIn),
1489 residue_vars(TypeIn:Goal, Vars, TypeIn:Delays, Chp),
1490 deterministic(Det),
1491 ( save_debug
1492 ; restore_debug, fail
1493 ),
1494 flush_output(user_output),
1495 ( Det == true
1496 -> DetOrChp = true
1497 ; DetOrChp = Chp
1498 ),
1499 call_expand_answer(Goal, Bindings, NewBindings),
1500 ( \+ \+ write_bindings(NewBindings, Vars, Delays, DetOrChp)
1501 -> !
1502 ).
1503'$execute_goal2'(_, _, false) :-
1504 save_debug,
1505 print_message(query, query(no)).
1506
1507residue_vars(Goal, Vars, Delays, Chp) :-
1508 current_prolog_flag(toplevel_residue_vars, true),
1509 !,
1510 '$wfs_call'(call_residue_vars(stop_backtrace(Goal, Chp), Vars), Delays).
1511residue_vars(Goal, [], Delays, Chp) :-
1512 '$wfs_call'(stop_backtrace(Goal, Chp), Delays).
1513
1514stop_backtrace(Goal, Chp) :-
1515 toplevel_call(Goal),
1516 prolog_current_choice(Chp).
1517
1518toplevel_call(Goal) :-
1519 call(Goal),
1520 no_lco.
1521
1522no_lco.
1523
1537
1538write_bindings(Bindings, ResidueVars, Delays, DetOrChp) :-
1539 '$current_typein_module'(TypeIn),
1540 translate_bindings(Bindings, Bindings1, ResidueVars, TypeIn:Residuals),
1541 omit_qualifier(Delays, TypeIn, Delays1),
1542 write_bindings2(Bindings, Bindings1, Residuals, Delays1, DetOrChp).
1543
1544write_bindings2(OrgBindings, [], Residuals, Delays, _) :-
1545 current_prolog_flag(prompt_alternatives_on, groundness),
1546 !,
1547 name_vars(OrgBindings, [], t(Residuals, Delays)),
1548 print_message(query, query(yes(Delays, Residuals))).
1549write_bindings2(OrgBindings, Bindings, Residuals, Delays, true) :-
1550 current_prolog_flag(prompt_alternatives_on, determinism),
1551 !,
1552 name_vars(OrgBindings, Bindings, t(Residuals, Delays)),
1553 print_message(query, query(yes(Bindings, Delays, Residuals))).
1554write_bindings2(OrgBindings, Bindings, Residuals, Delays, Chp) :-
1555 repeat,
1556 name_vars(OrgBindings, Bindings, t(Residuals, Delays)),
1557 print_message(query, query(more(Bindings, Delays, Residuals))),
1558 get_respons(Action, Chp),
1559 ( Action == redo
1560 -> !, fail
1561 ; Action == show_again
1562 -> fail
1563 ; !,
1564 print_message(query, query(done))
1565 ).
1566
1580
1581name_vars(OrgBindings, Bindings, Term) :-
1582 current_prolog_flag(toplevel_name_variables, true),
1583 answer_flags_imply_numbervars,
1584 !,
1585 '$term_multitons'(t(Bindings,Term), Vars),
1586 bindings_var_names(OrgBindings, Bindings, VarNames),
1587 name_vars_(Vars, VarNames, 0),
1588 term_variables(t(Bindings,Term), SVars),
1589 anon_vars(SVars).
1590name_vars(_OrgBindings, _Bindings, _Term).
1591
1592name_vars_([], _, _).
1593name_vars_([H|T], Bindings, N) :-
1594 name_var(Bindings, Name, N, N1),
1595 H = '$VAR'(Name),
1596 name_vars_(T, Bindings, N1).
1597
1598anon_vars([]).
1599anon_vars(['$VAR'('_')|T]) :-
1600 anon_vars(T).
1601
1606
1607name_var(Reserved, Name, N0, N) :-
1608 between(N0, infinite, N1),
1609 I is N1//26,
1610 J is 0'A + N1 mod 26,
1611 ( I == 0
1612 -> format(atom(Name), '_~c', [J])
1613 ; format(atom(Name), '_~c~d', [J, I])
1614 ),
1615 \+ memberchk(Name, Reserved),
1616 !,
1617 N is N1+1.
1618
1625
1626bindings_var_names(OrgBindings, TransBindings, VarNames) :-
1627 phrase(bindings_var_names_(OrgBindings), VarNames0, Tail),
1628 phrase(bindings_var_names_(TransBindings), Tail, []),
1629 sort(VarNames0, VarNames).
1630
1635
1636bindings_var_names_([]) --> [].
1637bindings_var_names_([H|T]) -->
1638 binding_var_names(H),
1639 bindings_var_names_(T).
1640
1641binding_var_names(binding(Vars,_Value,_Subst)) ==>
1642 var_names(Vars).
1643binding_var_names(Name=_Value) ==>
1644 [Name].
1645
1646var_names([]) --> [].
1647var_names([H|T]) --> [H], var_names(T).
1648
1649
1654
1655answer_flags_imply_numbervars :-
1656 current_prolog_flag(answer_write_options, Options),
1657 numbervars_option(Opt),
1658 memberchk(Opt, Options),
1659 !.
1660
1661numbervars_option(portray(true)).
1662numbervars_option(portrayed(true)).
1663numbervars_option(numbervars(true)).
1664
1669
1670:- multifile
1671 residual_goal_collector/1. 1672
1673:- meta_predicate
1674 residual_goals(2). 1675
1676residual_goals(NonTerminal) :-
1677 throw(error(context_error(nodirective, residual_goals(NonTerminal)), _)).
1678
1679system:term_expansion((:- residual_goals(NonTerminal)),
1680 '$toplevel':residual_goal_collector(M2:Head)) :-
1681 \+ current_prolog_flag(xref, true),
1682 prolog_load_context(module, M),
1683 strip_module(M:NonTerminal, M2, Head),
1684 '$must_be'(callable, Head).
1685
1690
1691:- public prolog:residual_goals//0. 1692
1693prolog:residual_goals -->
1694 { findall(NT, residual_goal_collector(NT), NTL) },
1695 collect_residual_goals(NTL).
1696
1697collect_residual_goals([]) --> [].
1698collect_residual_goals([H|T]) -->
1699 ( call(H) -> [] ; [] ),
1700 collect_residual_goals(T).
1701
1702
1703
1724
1725:- public
1726 prolog:translate_bindings/5. 1727:- meta_predicate
1728 prolog:translate_bindings(+, -, +, +, :). 1729
1730prolog:translate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals) :-
1731 translate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals),
1732 name_vars(Bindings0, Bindings, t(ResVars, ResGoals, Residuals)).
1733
1735prolog:name_vars(Bindings, Term) :- name_vars([], Bindings, Term).
1736prolog:name_vars(Bindings0, Bindings, Term) :- name_vars(Bindings0, Bindings, Term).
1737
1738translate_bindings(Bindings0, Bindings, ResidueVars, Residuals) :-
1739 prolog:residual_goals(ResidueGoals, []),
1740 translate_bindings(Bindings0, Bindings, ResidueVars, ResidueGoals,
1741 Residuals).
1742
1743translate_bindings(Bindings0, Bindings, [], [], _:[]-[]) :-
1744 term_attvars(Bindings0, []),
1745 !,
1746 join_same_bindings(Bindings0, Bindings1),
1747 factorize_bindings(Bindings1, Bindings2),
1748 bind_vars(Bindings2, Bindings3),
1749 filter_bindings(Bindings3, Bindings).
1750translate_bindings(Bindings0, Bindings, ResidueVars, ResGoals0,
1751 TypeIn:Residuals-HiddenResiduals) :-
1752 project_constraints(Bindings0, ResidueVars),
1753 hidden_residuals(ResidueVars, Bindings0, HiddenResiduals0),
1754 omit_qualifiers(HiddenResiduals0, TypeIn, HiddenResiduals),
1755 copy_term(Bindings0+ResGoals0, Bindings1+ResGoals1, Residuals0),
1756 '$append'(ResGoals1, Residuals0, Residuals1),
1757 omit_qualifiers(Residuals1, TypeIn, Residuals),
1758 join_same_bindings(Bindings1, Bindings2),
1759 factorize_bindings(Bindings2, Bindings3),
1760 bind_vars(Bindings3, Bindings4),
1761 filter_bindings(Bindings4, Bindings).
1762
1763hidden_residuals(ResidueVars, Bindings, Goal) :-
1764 term_attvars(ResidueVars, Remaining),
1765 term_attvars(Bindings, QueryVars),
1766 subtract_vars(Remaining, QueryVars, HiddenVars),
1767 copy_term(HiddenVars, _, Goal).
1768
1769subtract_vars(All, Subtract, Remaining) :-
1770 sort(All, AllSorted),
1771 sort(Subtract, SubtractSorted),
1772 ord_subtract(AllSorted, SubtractSorted, Remaining).
1773
1774ord_subtract([], _Not, []).
1775ord_subtract([H1|T1], L2, Diff) :-
1776 diff21(L2, H1, T1, Diff).
1777
1778diff21([], H1, T1, [H1|T1]).
1779diff21([H2|T2], H1, T1, Diff) :-
1780 compare(Order, H1, H2),
1781 diff3(Order, H1, T1, H2, T2, Diff).
1782
1783diff12([], _H2, _T2, []).
1784diff12([H1|T1], H2, T2, Diff) :-
1785 compare(Order, H1, H2),
1786 diff3(Order, H1, T1, H2, T2, Diff).
1787
1788diff3(<, H1, T1, H2, T2, [H1|Diff]) :-
1789 diff12(T1, H2, T2, Diff).
1790diff3(=, _H1, T1, _H2, T2, Diff) :-
1791 ord_subtract(T1, T2, Diff).
1792diff3(>, H1, T1, _H2, T2, Diff) :-
1793 diff21(T2, H1, T1, Diff).
1794
1795
1800
1801project_constraints(Bindings, ResidueVars) :-
1802 !,
1803 term_attvars(Bindings, AttVars),
1804 phrase(attribute_modules(AttVars), Modules0),
1805 sort(Modules0, Modules),
1806 term_variables(Bindings, QueryVars),
1807 project_attributes(Modules, QueryVars, ResidueVars).
1808project_constraints(_, _).
1809
1810project_attributes([], _, _).
1811project_attributes([M|T], QueryVars, ResidueVars) :-
1812 ( current_predicate(M:project_attributes/2),
1813 catch(M:project_attributes(QueryVars, ResidueVars), E,
1814 print_message(error, E))
1815 -> true
1816 ; true
1817 ),
1818 project_attributes(T, QueryVars, ResidueVars).
1819
1820attribute_modules([]) --> [].
1821attribute_modules([H|T]) -->
1822 { get_attrs(H, Attrs) },
1823 attrs_modules(Attrs),
1824 attribute_modules(T).
1825
1826attrs_modules([]) --> [].
1827attrs_modules(att(Module, _, More)) -->
1828 [Module],
1829 attrs_modules(More).
1830
1831
1839
1840join_same_bindings([], []).
1841join_same_bindings([Name=V0|T0], [[Name|Names]=V|T]) :-
1842 take_same_bindings(T0, V0, V, Names, T1),
1843 join_same_bindings(T1, T).
1844
1845take_same_bindings([], Val, Val, [], []).
1846take_same_bindings([Name=V1|T0], V0, V, [Name|Names], T) :-
1847 V0 == V1,
1848 !,
1849 take_same_bindings(T0, V1, V, Names, T).
1850take_same_bindings([Pair|T0], V0, V, Names, [Pair|T]) :-
1851 take_same_bindings(T0, V0, V, Names, T).
1852
1853
1858
1859
1860omit_qualifiers([], _, []).
1861omit_qualifiers([Goal0|Goals0], TypeIn, [Goal|Goals]) :-
1862 omit_qualifier(Goal0, TypeIn, Goal),
1863 omit_qualifiers(Goals0, TypeIn, Goals).
1864
1865omit_qualifier(M:G0, TypeIn, G) :-
1866 M == TypeIn,
1867 !,
1868 omit_meta_qualifiers(G0, TypeIn, G).
1869omit_qualifier(M:G0, TypeIn, G) :-
1870 predicate_property(TypeIn:G0, imported_from(M)),
1871 \+ predicate_property(G0, transparent),
1872 !,
1873 G0 = G.
1874omit_qualifier(_:G0, _, G) :-
1875 predicate_property(G0, built_in),
1876 \+ predicate_property(G0, transparent),
1877 !,
1878 G0 = G.
1879omit_qualifier(M:G0, _, M:G) :-
1880 atom(M),
1881 !,
1882 omit_meta_qualifiers(G0, M, G).
1883omit_qualifier(G0, TypeIn, G) :-
1884 omit_meta_qualifiers(G0, TypeIn, G).
1885
1886omit_meta_qualifiers(V, _, V) :-
1887 var(V),
1888 !.
1889omit_meta_qualifiers((QA,QB), TypeIn, (A,B)) :-
1890 !,
1891 omit_qualifier(QA, TypeIn, A),
1892 omit_qualifier(QB, TypeIn, B).
1893omit_meta_qualifiers(tnot(QA), TypeIn, tnot(A)) :-
1894 !,
1895 omit_qualifier(QA, TypeIn, A).
1896omit_meta_qualifiers(freeze(V, QGoal), TypeIn, freeze(V, Goal)) :-
1897 callable(QGoal),
1898 !,
1899 omit_qualifier(QGoal, TypeIn, Goal).
1900omit_meta_qualifiers(when(Cond, QGoal), TypeIn, when(Cond, Goal)) :-
1901 callable(QGoal),
1902 !,
1903 omit_qualifier(QGoal, TypeIn, Goal).
1904omit_meta_qualifiers(G, _, G).
1905
1906
1912
1913bind_vars(Bindings0, Bindings) :-
1914 bind_query_vars(Bindings0, Bindings, SNames),
1915 bind_skel_vars(Bindings, Bindings, SNames, 1, _).
1916
1917bind_query_vars([], [], []).
1918bind_query_vars([binding(Names,Var,[Var2=Cycle])|T0],
1919 [binding(Names,Cycle,[])|T], [Name|SNames]) :-
1920 Var == Var2, 1921 !,
1922 '$last'(Names, Name),
1923 Var = '$VAR'(Name),
1924 bind_query_vars(T0, T, SNames).
1925bind_query_vars([B|T0], [B|T], AllNames) :-
1926 B = binding(Names,Var,Skel),
1927 bind_query_vars(T0, T, SNames),
1928 ( var(Var), \+ attvar(Var), Skel == []
1929 -> AllNames = [Name|SNames],
1930 '$last'(Names, Name),
1931 Var = '$VAR'(Name)
1932 ; AllNames = SNames
1933 ).
1934
1935
1936
1937bind_skel_vars([], _, _, N, N).
1938bind_skel_vars([binding(_,_,Skel)|T], Bindings, SNames, N0, N) :-
1939 bind_one_skel_vars(Skel, Bindings, SNames, N0, N1),
1940 bind_skel_vars(T, Bindings, SNames, N1, N).
1941
1958
1959bind_one_skel_vars([], _, _, N, N).
1960bind_one_skel_vars([Var=Value|T], Bindings, Names, N0, N) :-
1961 ( var(Var)
1962 -> ( '$member'(binding(Names, VVal, []), Bindings),
1963 same_term(Value, VVal)
1964 -> '$last'(Names, VName),
1965 Var = '$VAR'(VName),
1966 N2 = N0
1967 ; between(N0, infinite, N1),
1968 atom_concat('_S', N1, Name),
1969 \+ memberchk(Name, Names),
1970 !,
1971 Var = '$VAR'(Name),
1972 N2 is N1 + 1
1973 )
1974 ; N2 = N0
1975 ),
1976 bind_one_skel_vars(T, Bindings, Names, N2, N).
1977
1978
1982
1983factorize_bindings([], []).
1984factorize_bindings([Name=Value|T0], [binding(Name, Skel, Subst)|T]) :-
1985 '$factorize_term'(Value, Skel, Subst0),
1986 ( current_prolog_flag(toplevel_print_factorized, true)
1987 -> Subst = Subst0
1988 ; only_cycles(Subst0, Subst)
1989 ),
1990 factorize_bindings(T0, T).
1991
1992
1993only_cycles([], []).
1994only_cycles([B|T0], List) :-
1995 ( B = (Var=Value),
1996 Var = Value,
1997 acyclic_term(Var)
1998 -> only_cycles(T0, List)
1999 ; List = [B|T],
2000 only_cycles(T0, T)
2001 ).
2002
2003
2009
2010filter_bindings([], []).
2011filter_bindings([H0|T0], T) :-
2012 hide_vars(H0, H),
2013 ( ( arg(1, H, [])
2014 ; self_bounded(H)
2015 )
2016 -> filter_bindings(T0, T)
2017 ; T = [H|T1],
2018 filter_bindings(T0, T1)
2019 ).
2020
2021hide_vars(binding(Names0, Skel, Subst), binding(Names, Skel, Subst)) :-
2022 hide_names(Names0, Skel, Subst, Names).
2023
2024hide_names([], _, _, []).
2025hide_names([Name|T0], Skel, Subst, T) :-
2026 ( sub_atom(Name, 0, _, _, '_'),
2027 current_prolog_flag(toplevel_print_anon, false),
2028 sub_atom(Name, 1, 1, _, Next),
2029 char_type(Next, prolog_var_start)
2030 -> true
2031 ; Subst == [],
2032 Skel == '$VAR'(Name)
2033 ),
2034 !,
2035 hide_names(T0, Skel, Subst, T).
2036hide_names([Name|T0], Skel, Subst, [Name|T]) :-
2037 hide_names(T0, Skel, Subst, T).
2038
2039self_bounded(binding([Name], Value, [])) :-
2040 Value == '$VAR'(Name).
2041
2045
2046:- if(current_prolog_flag(emscripten, true)). 2047get_respons(Action, Chp) :-
2048 '$can_yield',
2049 !,
2050 repeat,
2051 await(more, CommandS),
2052 atom_string(Command, CommandS),
2053 more_action(Command, Chp, Action),
2054 ( Action == again
2055 -> print_message(query, query(action)),
2056 fail
2057 ; !
2058 ).
2059:- endif. 2060get_respons(Action, Chp) :-
2061 repeat,
2062 flush_output(user_output),
2063 get_single_char(Code),
2064 find_more_command(Code, Command, Feedback, Style),
2065 ( Style \== '-'
2066 -> print_message(query, if_tty([ansi(Style, '~w', [Feedback])]))
2067 ; true
2068 ),
2069 more_action(Command, Chp, Action),
2070 ( Action == again
2071 -> print_message(query, query(action)),
2072 fail
2073 ; !
2074 ).
2075
2076find_more_command(-1, end_of_file, 'EOF', warning) :-
2077 !.
2078find_more_command(Code, Command, Feedback, Style) :-
2079 more_command(Command, Atom, Feedback, Style),
2080 '$in_reply'(Code, Atom),
2081 !.
2082find_more_command(Code, again, '', -) :-
2083 print_message(query, no_action(Code)).
2084
2085more_command(help, '?h', '', -).
2086more_command(redo, ';nrNR \t', ';', bold).
2087more_command(trace, 'tT', '; [trace]', comment).
2088more_command(continue, 'ca\n\ryY.', '.', bold).
2089more_command(break, 'b', '', -).
2090more_command(choicepoint, '*', '', -).
2091more_command(write, 'w', '[write]', comment).
2092more_command(print, 'p', '[print]', comment).
2093more_command(depth_inc, '+', Change, comment) :-
2094 ( print_depth(Depth0)
2095 -> depth_step(Step),
2096 NewDepth is Depth0*Step,
2097 format(atom(Change), '[max_depth(~D)]', [NewDepth])
2098 ; Change = 'no max_depth'
2099 ).
2100more_command(depth_dec, '-', Change, comment) :-
2101 ( print_depth(Depth0)
2102 -> depth_step(Step),
2103 NewDepth is max(1, Depth0//Step),
2104 format(atom(Change), '[max_depth(~D)]', [NewDepth])
2105 ; Change = '[max_depth(10)]'
2106 ).
2107
2108more_action(help, _, Action) =>
2109 Action = again,
2110 print_message(help, query(help)).
2111more_action(redo, _, Action) => 2112 Action = redo.
2113more_action(trace, _, Action) =>
2114 Action = redo,
2115 trace,
2116 save_debug.
2117more_action(continue, _, Action) => 2118 Action = continue.
2119more_action(break, _, Action) =>
2120 Action = show_again,
2121 break.
2122more_action(choicepoint, Chp, Action) =>
2123 Action = show_again,
2124 print_last_chpoint(Chp).
2125more_action(end_of_file, _, Action) =>
2126 Action = show_again,
2127 halt(0).
2128more_action(again, _, Action) =>
2129 Action = again.
2130more_action(Command, _, Action),
2131 current_prolog_flag(answer_write_options, Options0),
2132 print_predicate(Command, Options0, Options) =>
2133 Action = show_again,
2134 set_prolog_flag(answer_write_options, Options).
2135
2136print_depth(Depth) :-
2137 current_prolog_flag(answer_write_options, Options),
2138 memberchk(max_depth(Depth), Options),
2139 !.
2140
2145
2146print_predicate(write, Options0, Options) :-
2147 edit_options([-portrayed(true),-portray(true)],
2148 Options0, Options).
2149print_predicate(print, Options0, Options) :-
2150 edit_options([+portrayed(true)],
2151 Options0, Options).
2152print_predicate(depth_inc, Options0, Options) :-
2153 ( '$select'(max_depth(D0), Options0, Options1)
2154 -> depth_step(Step),
2155 D is D0*Step,
2156 Options = [max_depth(D)|Options1]
2157 ; Options = Options0
2158 ).
2159print_predicate(depth_dec, Options0, Options) :-
2160 ( '$select'(max_depth(D0), Options0, Options1)
2161 -> depth_step(Step),
2162 D is max(1, D0//Step),
2163 Options = [max_depth(D)|Options1]
2164 ; D = 10,
2165 Options = [max_depth(D)|Options0]
2166 ).
2167
2168depth_step(5).
2169
2170edit_options([], Options, Options).
2171edit_options([H|T], Options0, Options) :-
2172 edit_option(H, Options0, Options1),
2173 edit_options(T, Options1, Options).
2174
2175edit_option(-Term, Options0, Options) =>
2176 ( '$select'(Term, Options0, Options)
2177 -> true
2178 ; Options = Options0
2179 ).
2180edit_option(+Term, Options0, Options) =>
2181 functor(Term, Name, 1),
2182 functor(Var, Name, 1),
2183 ( '$select'(Var, Options0, Options1)
2184 -> Options = [Term|Options1]
2185 ; Options = [Term|Options0]
2186 ).
2187
2191
2192print_last_chpoint(Chp) :-
2193 current_predicate(print_last_choice_point/0),
2194 !,
2195 print_last_chpoint_(Chp).
2196print_last_chpoint(Chp) :-
2197 use_module(library(prolog_stack), [print_last_choicepoint/2]),
2198 print_last_chpoint_(Chp).
2199
2200print_last_chpoint_(Chp) :-
2201 print_last_choicepoint(Chp, [message_level(information)]).
2202
2203
2204 2207
2208:- user:dynamic(expand_query/4). 2209:- user:multifile(expand_query/4). 2210
2211call_expand_query(Goal, Expanded, Bindings, ExpandedBindings) :-
2212 ( '$replace_toplevel_vars'(Goal, Expanded0, Bindings, ExpandedBindings0)
2213 -> true
2214 ; Expanded0 = Goal, ExpandedBindings0 = Bindings
2215 ),
2216 ( user:expand_query(Expanded0, Expanded, ExpandedBindings0, ExpandedBindings)
2217 -> true
2218 ; Expanded = Expanded0, ExpandedBindings = ExpandedBindings0
2219 ).
2220
2221
2222:- dynamic
2223 user:expand_answer/2,
2224 prolog:expand_answer/3. 2225:- multifile
2226 user:expand_answer/2,
2227 prolog:expand_answer/3. 2228
2229call_expand_answer(Goal, BindingsIn, BindingsOut) :-
2230 ( prolog:expand_answer(Goal, BindingsIn, BindingsOut)
2231 -> true
2232 ; user:expand_answer(BindingsIn, BindingsOut)
2233 -> true
2234 ; BindingsOut = BindingsIn
2235 ),
2236 '$save_toplevel_vars'(BindingsOut),
2237 !.
2238call_expand_answer(_, Bindings, Bindings)