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