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