36
37:- module(check_installation,
38 [ check_installation/0,
39 check_installation/1, 40 check_config_files/0,
41 update_config_files/0,
42 test_installation/0,
43 test_installation/1 44 ]). 45:- autoload(library(apply), [maplist/2, maplist/3]). 46:- autoload(library(archive), [archive_open/3, archive_close/1]). 47:- autoload(library(lists), [append/3, member/2]). 48:- autoload(library(occurs), [sub_term/2]). 49:- autoload(library(option), [option/2, merge_options/3]). 50:- autoload(library(prolog_source), [path_segments_atom/2]). 51:- use_module(library(settings), [setting/2]). 52:- autoload(library(dcg/high_order), [sequence//2, sequence/4]). 53:- autoload(library(error), [must_be/2]). 54
55
62
85
87component(tcmalloc,
88 _{ optional:true,
89 test:test_tcmalloc,
90 url:'tcmalloc.html',
91 os:linux
92 }).
93component(gmp,
94 _{ test:current_prolog_flag(bounded, false),
95 url:'gmp.html'
96 }).
98component(library(archive), _{features:archive_features}).
99component(library(cgi), _{}).
100component(library(crypt), _{}).
101component(library(bdb), _{}).
102component(library(double_metaphone), _{}).
103component(library(editline), _{os:unix}).
104component(library(filesex), _{}).
105component(library(http/http_stream), _{}).
106component(library(json), _{}).
107component(library(http/jquery), _{features:jquery_file}).
108component(library(isub), _{}).
109component(library(janus), _{features:python_version}).
110component(library(jpl), _{}).
111component(library(memfile), _{}).
112component(library(odbc), _{}).
113component(library(pce),
114 _{pre:use_foreign_library(pce_principal:foreign(pl2xpce)),
115 url:'xpce.html'}).
116component(library(pcre), _{features:pcre_features}).
117component(library(pdt_console), _{}).
118component(library(porter_stem), _{}).
119component(library(process), _{}).
120component(library(protobufs), _{}).
122component(library(readutil), _{}).
123component(library(rlimit), _{os:unix}).
124component(library(semweb/rdf_db), _{}).
125component(library(semweb/rdf_ntriples), _{}).
126component(library(semweb/turtle), _{}).
127component(library(sgml), _{}).
128component(library(sha), _{}).
129component(library(snowball), _{}).
130component(library(socket), _{}).
131component(library(ssl), _{}).
132component(library(sweep_link), _{features:sweep_emacs_module}).
133component(library(crypto), _{}).
134component(library(syslog), _{os:unix}).
135component(library(table), _{}).
136component(library(time), _{}).
137component(library(tipc/tipc), _{os:linux}).
138component(library(unicode), _{}).
139component(library(uri), _{}).
140component(library(uuid), _{}).
141component(library(yaml), _{}).
142component(library(zlib), _{}).
143
144issue_base('http://www.swi-prolog.org/build/issues/').
145
146:- thread_local
147 issue/1. 148
149:- meta_predicate
150 run_silent(0, +). 151
166
167check_installation :-
168 print_message(informational, installation(checking)),
169 check_installation_(InstallIssues),
170 check_on_path,
171 check_config_files(ConfigIssues),
172 check_autoload,
173 maplist(print_message(warning), ConfigIssues),
174 append(InstallIssues, ConfigIssues, Issues),
175 ( Issues == []
176 -> print_message(informational, installation(perfect))
177 ; length(Issues, Count),
178 print_message(warning, installation(imperfect(Count)))
179 ).
180
188
189check_installation(Issues) :-
190 check_installation_(Issues0),
191 maplist(public_issue, Issues0, Issues).
192
193public_issue(installation(Term), Source-Issue) :-
194 functor(Term, Issue, _),
195 arg(1, Term, Properties),
196 Source = Properties.source.
197
198check_installation_(Issues) :-
199 retractall(issue(_)),
200 forall(component(Source, _Properties),
201 check_component(Source)),
202 findall(I, retract(issue(I)), Issues).
203
204check_component(Source) :-
205 component(Source, Properties),
206 !,
207 check_component(Source, Properties.put(source,Source)).
208
209check_component(_Source, Properties) :-
210 OS = Properties.get(os),
211 \+ current_os(OS),
212 !.
213check_component(Source, Properties) :-
214 compound(Source),
215 !,
216 check_source(Source, Properties).
217check_component(Feature, Properties) :-
218 print_message(informational, installation(checking(Feature))),
219 ( call(Properties.test)
220 -> print_message(informational, installation(ok))
221 ; print_issue(installation(missing(Properties)))
222 ).
223
224check_source(Source, Properties) :-
225 exists_source(Source),
226 !,
227 print_message(informational, installation(loading(Source))),
228 ( run_silent(( ( Pre = Properties.get(pre)
229 -> call(Pre)
230 ; true
231 ),
232 load_files(Source, [silent(true), if(true)])
233 ),
234 Properties.put(action, load))
235 -> test_component(Properties),
236 print_message(informational, installation(ok)),
237 check_features(Properties)
238 ; true
239 ).
240check_source(_Source, Properties) :-
241 Properties.get(optional) == true,
242 !,
243 print_message(silent,
244 installation(optional_not_found(Properties))).
245check_source(_Source, Properties) :-
246 print_issue(installation(not_found(Properties))).
247
248current_os(unix) :- current_prolog_flag(unix, true).
249current_os(windows) :- current_prolog_flag(windows, true).
250current_os(linux) :- current_prolog_flag(arch, Arch),
251 sub_atom(Arch, _, _, _, linux).
252
256
257test_component(Dict) :-
258 Test = Dict.get(test),
259 !,
260 call(Test).
261test_component(_).
262
269
270check_features(Dict) :-
271 Test = Dict.get(features),
272 !,
273 catch(Test, Error,
274 ( print_message(warning, Error),
275 fail)).
276check_features(_).
277
278
283
284run_silent(Goal, Properties) :-
285 run_collect_messages(Goal, Result, Messages),
286 ( Result == true,
287 Messages == []
288 -> true
289 ; print_issue(installation(failed(Properties, Result, Messages))),
290 fail
291 ).
292
302
303:- thread_local
304 got_message/1. 305
306run_collect_messages(Goal, Result, Messages) :-
307 setup_call_cleanup(
308 asserta((user:thread_message_hook(Term,Kind,Lines) :-
309 error_kind(Kind),
310 assertz(got_message(message(Term,Kind,Lines)))), Ref),
311 ( catch(Goal, E, true)
312 -> ( var(E)
313 -> Result0 = true
314 ; Result0 = exception(E)
315 )
316 ; Result0 = false
317 ),
318 erase(Ref)),
319 findall(Msg, retract(got_message(Msg)), Messages),
320 Result = Result0.
321
322error_kind(warning).
323error_kind(error).
324
325
326 329
331
332:- if(current_predicate(malloc_property/1)). 333test_tcmalloc :-
334 malloc_property('generic.current_allocated_bytes'(Bytes)),
335 Bytes > 1 000 000.
336:- else. 337test_tcmalloc :-
338 fail.
339:- endif. 340
344
345archive_features :-
346 tmp_file_stream(utf8, Name, Out),
347 close(Out),
348 findall(F, archive_filter(F, Name), Filters),
349 print_message(informational, installation(archive(filters, Filters))),
350 findall(F, archive_format(F, Name), Formats),
351 print_message(informational, installation(archive(formats, Formats))),
352 delete_file(Name).
353
354archive_filter(F, Name) :-
355 a_filter(F),
356 catch(archive_open(Name, A, [filter(F)]), E, true),
357 ( var(E)
358 -> archive_close(A)
359 ; true
360 ),
361 \+ subsumes_term(error(domain_error(filter, _),_), E).
362
363archive_format(F, Name) :-
364 a_format(F),
365 catch(archive_open(Name, A, [format(F)]), E, true),
366 ( var(E)
367 -> archive_close(A)
368 ; true
369 ),
370 \+ subsumes_term(error(domain_error(format, _),_), E).
371
372a_filter(bzip2).
373a_filter(compress).
374a_filter(gzip).
375a_filter(grzip).
376a_filter(lrzip).
377a_filter(lzip).
378a_filter(lzma).
379a_filter(lzop).
380a_filter(none).
381a_filter(rpm).
382a_filter(uu).
383a_filter(xz).
384
385a_format('7zip').
386a_format(ar).
387a_format(cab).
388a_format(cpio).
389a_format(empty).
390a_format(gnutar).
391a_format(iso9660).
392a_format(lha).
393a_format(mtree).
394a_format(rar).
395a_format(raw).
396a_format(tar).
397a_format(xar).
398a_format(zip).
399
401
402pcre_features :-
403 findall(X, pcre_missing(X), Missing),
404 ( Missing == []
405 -> true
406 ; print_message(warning, installation(pcre_missing(Missing)))
407 ),
408 ( re_config(compiled_widths(Widths)),
409 1 =:= Widths /\ 1
410 -> true
411 ; print_message(warning, installation(pcre_missing('8-bit support')))
412 ).
413
414pcre_missing(X) :-
415 pcre_must_have(X),
416 Term =.. [X,true],
417 \+ catch(re_config(Term), _, fail).
418
419pcre_must_have(unicode).
420
424
425jquery_file :-
426 setting(jquery:version, File),
427 ( absolute_file_name(js(File), Path, [access(read), file_errors(fail)])
428 -> print_message(informational, installation(jquery(found(Path))))
429 ; print_message(warning, installation(jquery(not_found(File))))
430 ).
431
432sweep_emacs_module :-
433 with_output_to(string(S), write_sweep_module_location),
434 split_string(S, "\n", "\n", [VersionInfo|Modules]),
435 must_be(oneof(["V 1"]), VersionInfo),
436 ( maplist(check_sweep_lib, Modules)
437 -> print_message(informational, installation(sweep(found(Modules))))
438 ; print_message(warning, installation(sweep(not_found(Modules))))
439 ).
440
441check_sweep_lib(Line) :-
442 sub_atom(Line, B, _, A, ' '),
443 sub_atom(Line, 0, B, _, Type),
444 must_be(oneof(['L', 'M']), Type),
445 sub_atom(Line, _, A, 0, Lib),
446 exists_file(Lib).
447
448python_version :-
449 py_call(sys:version, Version),
450 print_message(informational, installation(janus(Version))).
451
452
458
459check_on_path :-
460 current_prolog_flag(executable, EXEFlag),
461 prolog_to_os_filename(EXE, EXEFlag),
462 file_base_name(EXE, Prog),
463 absolute_file_name(EXE, AbsExe,
464 [ access(execute),
465 file_errors(fail)
466 ]),
467 !,
468 prolog_to_os_filename(AbsExe, OsExe),
469 ( absolute_file_name(path(Prog), OnPath,
470 [ access(execute),
471 file_errors(fail)
472 ])
473 -> ( same_file(EXE, OnPath)
474 -> true
475 ; absolute_file_name(path(Prog), OnPathAny,
476 [ access(execute),
477 file_errors(fail),
478 solutions(all)
479 ]),
480 same_file(EXE, OnPathAny)
481 -> print_message(warning, installation(not_first_on_path(OsExe, OnPath)))
482 ; print_message(warning, installation(not_same_on_path(OsExe, OnPath)))
483 )
484 ; print_message(warning, installation(not_on_path(OsExe, Prog)))
485 ).
486check_on_path.
487
488
489 492
513
514test_installation :-
515 test_installation([]).
516
517test_installation(Options) :-
518 absolute_file_name(swi(test/test),
519 TestFile,
520 [ access(read),
521 file_errors(fail),
522 file_type(prolog)
523 ]),
524 !,
525 test_installation_run(TestFile, Options).
526test_installation(_Options) :-
527 print_message(warning, installation(testing(no_installed_tests))).
528
529test_installation_run(TestFile, Options) :-
530 ( option(package(_), Options)
531 -> merge_options(Options,
532 [ core(false),
533 subdirs(false)
534 ], TestOptions)
535 ; merge_options(Options,
536 [ packages(true)
537 ], TestOptions)
538 ),
539 load_files(user:TestFile),
540 current_prolog_flag(verbose, Old),
541 setup_call_cleanup(
542 set_prolog_flag(verbose, silent),
543 user:test([], TestOptions),
544 set_prolog_flag(verbose, Old)).
545
546
547 550
551:- multifile
552 prolog:message//1. 553
554print_issue(Term) :-
555 assertz(issue(Term)),
556 print_message(warning, Term).
557
558issue_url(Properties, URL) :-
559 Local = Properties.get(url),
560 !,
561 issue_base(Base),
562 atom_concat(Base, Local, URL).
563issue_url(Properties, URL) :-
564 Properties.get(source) = library(Segments),
565 !,
566 path_segments_atom(Segments, Base),
567 file_name_extension(Base, html, URLFile),
568 issue_base(Issues),
569 atom_concat(Issues, URLFile, URL).
570
571prolog:message(installation(Message)) -->
572 message(Message).
573
574message(checking) -->
575 { current_prolog_flag(address_bits, Bits) },
576 { current_prolog_flag(arch, Arch) },
577 { current_prolog_flag(home, Home) },
578 { current_prolog_flag(cpu_count, Cores) },
579 [ 'Checking your SWI-Prolog kit for common issues ...'-[], nl, nl ],
580 [ 'Version: ~`.t~24| '-[] ], '$messages':prolog_message(version), [nl],
581 [ 'Address bits: ~`.t~24| ~d'-[Bits] ], [nl],
582 [ 'Architecture: ~`.t~24| ~w'-[Arch] ], [nl],
583 [ 'Installed at: ~`.t~24| ~w'-[Home] ], [nl],
584 [ 'Cores: ~`.t~24| ~w'-[Cores] ], [nl],
585 [ nl ].
586message(perfect) -->
587 [ nl, 'Congratulations, your kit seems sound and complete!'-[] ].
588message(imperfect(N)) -->
589 [ 'Found ~w issues.'-[N] ].
590message(checking(Feature)) -->
591 [ 'Checking ~w ...'-[Feature], flush ].
592message(missing(Properties)) -->
593 [ at_same_line, '~`.t~48| not present'-[] ],
594 details(Properties).
595message(loading(Source)) -->
596 [ 'Loading ~q ...'-[Source], flush ].
597message(ok) -->
598 [ at_same_line, '~`.t~48| ok'-[] ].
599message(optional_not_found(Properties)) -->
600 [ 'Optional ~q ~`.t~48| not present'-[Properties.source] ].
601message(not_found(Properties)) -->
602 [ '~q ~`.t~48| NOT FOUND'-[Properties.source] ],
603 details(Properties).
604message(failed(Properties, false, [])) -->
605 !,
606 [ at_same_line, '~`.t~48| FAILED'-[] ],
607 details(Properties).
608message(failed(Properties, exception(Ex0), [])) -->
609 !,
610 { strip_stack(Ex0, Ex),
611 message_to_string(Ex, Msg) },
612 [ '~w'-[Msg] ],
613 details(Properties).
614message(failed(Properties, true, Messages)) -->
615 [ at_same_line, '~`.t~48| FAILED'-[] ],
616 explain(Messages),
617 details(Properties).
618message(archive(What, Names)) -->
619 [ ' Supported ~w: '-[What] ],
620 list_names(Names).
621message(pcre_missing(Features)) -->
622 [ 'Missing libpcre features: '-[] ],
623 list_names(Features).
624message(not_first_on_path(EXE, OnPath)) -->
625 { public_executable(EXE, PublicEXE),
626 file_base_name(EXE, Prog)
627 },
628 [ 'The first ~w on '-[Prog] ], 'PATH', [ ' is ~p, while '-[OnPath], nl ],
629 [ 'this version is ~p.'-[PublicEXE] ].
630message(not_same_on_path(EXE, OnPath)) -->
631 { public_executable(EXE, PublicEXE),
632 file_base_name(EXE, Prog)
633 },
634 [ 'The ~w on '-[Prog] ], 'PATH', [ ' is ~p, while '-[OnPath], nl ],
635 [ 'this version is ~p.'-[PublicEXE] ].
636message(not_on_path(EXE, Prog)) -->
637 { public_bin_dir(EXE, Dir),
638 prolog_to_os_filename(Dir, OSDir)
639 },
640 [ 'Could not find ~w on '-[Prog] ], 'PATH', [ '. '-[], nl ],
641 [ 'You may wish to add ~p to '-[OSDir] ], 'PATH', [ '. '-[], nl ].
642message(jquery(found(Path))) -->
643 [ ' jQuery from ~w'-[Path] ].
644message(jquery(not_found(File))) -->
645 [ ' Cannot find jQuery (~w)'-[File] ].
646message(sweep(found(Paths))) -->
647 [ ' GNU-Emacs plugin loads'-[] ],
648 sequence(list_file, Paths).
649message(sweep(not_found(Paths))) -->
650 [ ' Could not find all GNU-Emacs libraries'-[] ],
651 sequence(list_file, Paths).
652message(testing(no_installed_tests)) -->
653 [ ' Runtime testing is not enabled.', nl],
654 [ ' Please recompile the system with INSTALL_TESTS enabled.' ].
655message(janus(Version)) -->
656 [ ' Python version ~w'-[Version] ].
657message(ambiguous_autoload(PI, Paths)) -->
658 [ 'The predicate ~p can be autoloaded from multiple libraries:'-[PI]],
659 sequence(list_file, Paths).
660
661public_executable(EXE, PublicProg) :-
662 file_base_name(EXE, Prog),
663 file_directory_name(EXE, ArchDir),
664 file_directory_name(ArchDir, BinDir),
665 file_directory_name(BinDir, Home),
666 file_directory_name(Home, Lib),
667 file_directory_name(Lib, Prefix),
668 atomic_list_concat([Prefix, bin, Prog], /, PublicProg),
669 exists_file(PublicProg),
670 same_file(EXE, PublicProg),
671 !.
672public_executable(EXE, EXE).
673
674public_bin_dir(EXE, Dir) :-
675 public_executable(EXE, PublicEXE),
676 file_directory_name(PublicEXE, Dir).
677
678
679
680'PATH' -->
681 { current_prolog_flag(windows, true) },
682 !,
683 [ '%PATH%'-[] ].
684'PATH' -->
685 [ '$PATH'-[] ].
686
687strip_stack(error(Error, context(prolog_stack(S), Msg)),
688 error(Error, context(_, Msg))) :-
689 nonvar(S).
690strip_stack(Error, Error).
691
692details(Properties) -->
693 { issue_url(Properties, URL), !
694 },
695 [ nl, 'See '-[], url(URL) ].
696details(_) --> [].
697
698explain(Messages) -->
699 { shared_object_error(Messages) },
700 !,
701 [nl],
702 ( { current_prolog_flag(windows, true) }
703 -> [ 'Cannot load required DLL'-[] ]
704 ; [ 'Cannot load required shared library'-[] ]
705 ).
706explain(Messages) -->
707 print_messages(Messages).
708
709shared_object_error(Messages) :-
710 sub_term(Term, Messages),
711 subsumes_term(error(shared_object(open, _Message), _), Term),
712 !.
713
714print_messages([]) --> [].
715print_messages([message(_Term, _Kind, Lines)|T]) -->
716 Lines, [nl],
717 print_messages(T).
718
719list_names([]) --> [].
720list_names([H|T]) -->
721 [ '~w'-[H] ],
722 ( {T==[]}
723 -> []
724 ; [ ', '-[] ],
725 list_names(T)
726 ).
727
728list_file(File) -->
729 [ nl, ' '-[], url(File) ].
730
731
732 735
740
741check_config_files :-
742 check_config_files(Issues),
743 maplist(print_message(warning), Issues).
744
745check_config_files(Issues) :-
746 findall(Issue, check_config_file(Issue), Issues).
747
748check_config_file(config(Id, move(Type, OldFile, NewFile))) :-
749 old_config(Type, Id, OldFile),
750 access_file(OldFile, exist),
751 \+ ( new_config(Type, Id, NewFile),
752 access_file(NewFile, exist)
753 ),
754 once(new_config(Type, Id, NewFile)).
755check_config_file(config(Id, different(Type, OldFile, NewFile))) :-
756 old_config(Type, Id, OldFile),
757 access_file(OldFile, exist),
758 new_config(Type, Id, NewFile),
759 access_file(NewFile, exist),
760 \+ same_file(OldFile, NewFile).
761
766
767update_config_files :-
768 old_config(Type, Id, OldFile),
769 access_file(OldFile, exist),
770 \+ ( new_config(Type, Id, NewFile),
771 access_file(NewFile, exist)
772 ),
773 ( new_config(Type, Id, NewFile),
774 \+ same_file(OldFile, NewFile),
775 create_parent_dir(NewFile)
776 -> catch(rename_file(OldFile, NewFile), E,
777 print_message(warning, E)),
778 print_message(informational, config(Id, moved(Type, OldFile, NewFile)))
779 ),
780 fail.
781update_config_files.
782
783old_config(file, init, File) :-
784 current_prolog_flag(windows, true),
785 win_folder(appdata, Base),
786 atom_concat(Base, '/SWI-Prolog/swipl.ini', File).
787old_config(file, init, File) :-
788 expand_file_name('~/.swiplrc', [File]).
789old_config(directory, lib, Dir) :-
790 expand_file_name('~/lib/prolog', [Dir]).
791old_config(directory, xpce, Dir) :-
792 expand_file_name('~/.xpce', [Dir]).
793old_config(directory, history, Dir) :-
794 expand_file_name('~/.swipl-dir-history', [Dir]).
795old_config(directory, pack, Dir) :-
796 ( catch(expand_file_name('~/lib/swipl/pack', [Dir]), _, fail)
797 ; absolute_file_name(swi(pack), Dir,
798 [ file_type(directory), solutions(all) ])
799 ).
800
801new_config(file, init, File) :-
802 absolute_file_name(user_app_config('init.pl'), File,
803 [ solutions(all) ]).
804new_config(directory, lib, Dir) :-
805 config_dir(user_app_config(lib), Dir).
806new_config(directory, xpce, Dir) :-
807 config_dir(user_app_config(xpce), Dir).
808new_config(directory, history, Dir) :-
809 config_dir(user_app_config('dir-history'), Dir).
810new_config(directory, pack, Dir) :-
811 config_dir([app_data(pack), swi(pack)], Dir).
812
813config_dir(Aliases, Dir) :-
814 is_list(Aliases),
815 !,
816 ( member(Alias, Aliases),
817 absolute_file_name(Alias, Dir,
818 [ file_type(directory), solutions(all) ])
819 *-> true
820 ; member(Alias, Aliases),
821 absolute_file_name(Alias, Dir,
822 [ solutions(all) ])
823 ).
824config_dir(Alias, Dir) :-
825 ( absolute_file_name(Alias, Dir,
826 [ file_type(directory), solutions(all) ])
827 *-> true
828 ; absolute_file_name(Alias, Dir,
829 [ solutions(all) ])
830 ).
831
832create_parent_dir(NewFile) :-
833 file_directory_name(NewFile, Dir),
834 create_parent_dir_(Dir).
835
836create_parent_dir_(Dir) :-
837 exists_directory(Dir),
838 '$my_file'(Dir),
839 !.
840create_parent_dir_(Dir) :-
841 file_directory_name(Dir, Parent),
842 Parent \== Dir,
843 create_parent_dir_(Parent),
844 make_directory(Dir).
845
846prolog:message(config(Id, Issue)) -->
847 [ 'Config: '-[] ],
848 config_description(Id),
849 config_issue(Issue).
850
851config_description(init) -->
852 [ '(user initialization file) '-[], nl ].
853config_description(lib) -->
854 [ '(user library) '-[], nl ].
855config_description(pack) -->
856 [ '(add-ons) '-[], nl ].
857config_description(history) -->
858 [ '(command line history) '-[], nl ].
859config_description(xpce) -->
860 [ '(gui) '-[], nl ].
861
862config_issue(move(Type, Old, New)) -->
863 [ ' found ~w "~w"'-[Type, Old], nl ],
864 [ ' new location is "~w"'-[New] ].
865config_issue(moved(Type, Old, New)) -->
866 [ ' found ~w "~w"'-[Type, Old], nl ],
867 [ ' moved to new location "~w"'-[New] ].
868config_issue(different(Type, Old, New)) -->
869 [ ' found different ~w "~w"'-[Type, Old], nl ],
870 [ ' new location is "~w"'-[New] ].
871
872 875
879
880check_autoload :-
881 findall(Name/Arity, '$in_library'(Name, Arity, _Path), PIs),
882 msort(PIs, Sorted),
883 clumped(Sorted, Clumped),
884 sort(2, >=, Clumped, ClumpedS),
885 ambiguous_autoload(ClumpedS).
886
887ambiguous_autoload([PI-N|T]) :-
888 N > 1,
889 !,
890 warn_ambiguous_autoload(PI),
891 ambiguous_autoload(T).
892ambiguous_autoload(_).
893
894warn_ambiguous_autoload(PI) :-
895 PI = Name/Arity,
896 findall(PlFile,
897 ( '$in_library'(Name, Arity, File),
898 file_name_extension(File, pl, PlFile)
899 ), PlFiles),
900 print_message(warning, installation(ambiguous_autoload(PI, PlFiles)))