1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2020, VU University Amsterdam
    7                         CWI, Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(prolog_deps,
   37          [ file_autoload_directives/3,      % +File, -Directives, +Options
   38            file_auto_import/2               % +File, +Options
   39          ]).   40:- use_module(library(apply), [convlist/3, maplist/3]).   41:- use_module(library(filesex), [copy_file/2]).   42:- use_module(library(lists), [select/3, subtract/3, append/3, member/2]).   43:- use_module(library(option), [option/2, option/3]).   44:- use_module(library(pairs), [group_pairs_by_key/2]).   45:- use_module(library(pprint), [print_term/2]).   46:- use_module(library(prolog_code), [pi_head/2]).   47:- use_module(library(prolog_source),
   48              [ file_name_on_path/2,
   49                path_segments_atom/2,
   50                prolog_open_source/2,
   51                prolog_read_source_term/4,
   52                prolog_close_source/1
   53              ]).   54:- use_module(library(prolog_xref),
   55              [ xref_source/1,
   56                xref_module/2,
   57                xref_called/4,
   58                xref_defined/3,
   59                xref_built_in/1
   60              ]).   61:- use_module(library(readutil), [read_file_to_string/3]).   62:- use_module(library(solution_sequences), [distinct/2]).   63
   64/** <module> Compute file dependencies
   65
   66This module computes  file  dependencies  for   _modules_  as  a  set of
   67directives.
   68*/
   69
   70:- multifile user:file_search_path/2.   71
   72user:file_search_path(noautoload, library(.)).
   73user:file_search_path(noautoload, library(semweb)).
   74user:file_search_path(noautoload, library(lynx)).
   75user:file_search_path(noautoload, library(tipc)).
   76user:file_search_path(noautoload, library(cql)).
   77user:file_search_path(noautoload, library(http)).
   78user:file_search_path(noautoload, library(dcg)).
   79user:file_search_path(noautoload, library(unicode)).
   80user:file_search_path(noautoload, library(clp)).
   81user:file_search_path(noautoload, library(pce(prolog/lib))).
   82
   83
   84%!  file_autoload_directives(+File, -Directives, +Options) is det.
   85%
   86%   Compute the dependencies as autoload/2 directives.  Options
   87%
   88%     - missing(+Bool)
   89%       If `true` (default `false`), only generate directives
   90%       for called predicates that are not already imported.
   91%
   92%     - directive(+Directive)
   93%       Directive to use for adding dependencies.  Defined
   94%	options are:
   95%
   96%       - use_autoload/2
   97%         (Default).  This uses use_module/2 for files that
   98%         cannot be imported using use_autoload/2.
   99%       - use_autoload/1
  100%         This uses use_module/1 for files that cannot be
  101%	  imported using use_autoload/1.
  102%       - use_module/2
  103%       - use_module/1
  104%
  105%     - update(Old)
  106%       Updated an existing set of directives.  The returned
  107%       set of Directive starts with copies of Old.  If a
  108%       member of Old is autoload/2 or use_module/2, new
  109%       dependencies are added at the end of this list.
  110%       New dependent files are added after the modified
  111%       copies of Old.  Declared dependencies are never
  112%       removed, even if no proof of usage is found.
  113%
  114%       If no directive(+Directive) option is provided a
  115%       default is determined from the given directives.
  116
  117file_autoload_directives(File, Directives, Options) :-
  118    xref_source(File),
  119    findall(Head, distinct(Head, undefined(File, Head, Options)), Missing),
  120    convlist(missing_autoload(File), Missing, Pairs),
  121    keysort(Pairs, Pairs1),
  122    group_pairs_by_key(Pairs1, Grouped),
  123    directives(Grouped, Directives, Options).
  124
  125%!  undefined(+File, -Callable, +Options)
  126%
  127%   Callable is called in File, but no   definition can be found. If
  128%   File is not a module file we   consider other files that are not
  129%   module files.
  130
  131undefined(File, Undef, Options) :-
  132    xref_module(File, _),
  133    !,
  134    xref_called_cond(File, Undef, Cond),
  135    \+ (   available(File, Undef, How, Options),
  136           How \== plain_file
  137       ),
  138    included_if_defined(Cond, Undef),
  139    Undef \= (_:_).
  140undefined(File, Undef, Options) :-
  141    xref_called_cond(File, Undef, Cond),
  142    \+ available(File, Undef, _, Options),
  143    included_if_defined(Cond, Undef),
  144    Undef \= (_:_).
  145
  146%!  included_if_defined(+Condition, +Callable) is semidet.
  147
  148included_if_defined(true, _)  :- !.
  149included_if_defined(false, _) :- !, fail.
  150included_if_defined(fail, _)  :- !, fail.
  151included_if_defined(current_predicate(Name/Arity), Callable) :-
  152    \+ functor(Callable, Name, Arity),
  153    !.
  154included_if_defined(\+ Cond, Callable) :-
  155    !,
  156    \+ included_if_defined(Cond, Callable).
  157included_if_defined((A,B), Callable) :-
  158    !,
  159    included_if_defined(A, Callable),
  160    included_if_defined(B, Callable).
  161included_if_defined((A;B), Callable) :-
  162    !,
  163    (   included_if_defined(A, Callable)
  164    ;   included_if_defined(B, Callable)
  165    ).
  166
  167xref_called_cond(Source, Callable, Cond) :-
  168    xref_called(Source, Callable, By, Cond),
  169    By \= Callable.                 % recursive calls
  170
  171%!  available(+File, +Callable, -HowDefined, +Options)
  172%
  173%   True if Callable is available in File.
  174
  175available(File, Called, How, Options) :-
  176    xref_defined(File, Called, How0),
  177    (   How0 = imported(_)
  178    ->  option(missing(true), Options)
  179    ;   true
  180    ),
  181    !,
  182    How = How0.
  183available(_, Called, How, _) :-
  184    built_in_predicate(Called),
  185    !,
  186    How = builtin.
  187available(_, Called, How, _) :-
  188    Called = _:_,
  189    defined(_, Called),
  190    !,
  191    How = module_qualified.
  192available(_, M:G, How, _) :-
  193    defined(ExportFile, G),
  194    xref_module(ExportFile, M),
  195    !,
  196    How = module_overruled.
  197available(_, Called, How, _) :-
  198    defined(ExportFile, Called),
  199    \+ xref_module(ExportFile, _),
  200    !,
  201    How == plain_file.
  202
  203%!  built_in_predicate(+Callable)
  204%
  205%   True if Callable is a built-in
  206
  207built_in_predicate(Goal) :-
  208    strip_module(Goal, _, Plain),
  209    xref_built_in(Plain).
  210
  211%!  defined(?File, ?Callable)
  212%
  213%   True if Callable is defined in File and not imported.
  214
  215defined(File, Callable) :-
  216    xref_defined(File, Callable, How),
  217    How \= imported(_).
  218
  219
  220		 /*******************************
  221		 *       GENERATE OUTPUT	*
  222		 *******************************/
  223
  224missing_autoload(Src, Head, From-Head) :-
  225    xref_defined(Src, Head, imported(From)),
  226    !.
  227missing_autoload(_Src, Head, File-Head) :-
  228    predicate_property(Head, autoload(File0)),
  229    !,
  230    (   absolute_file_name(File0, File,
  231                           [ access(read),
  232                             file_type(prolog),
  233                             file_errors(fail)
  234                           ])
  235    ->  true
  236    ;   File = File0
  237    ).
  238missing_autoload(_Src, Head, File-Head) :-
  239    noautoload(Head, File),
  240    !.
  241missing_autoload(_Src, Head, _) :-
  242    pi_head(PI, Head),
  243    print_message(warning,
  244                  error(existence_error(procedure, PI), _)),
  245    fail.
  246
  247%!  directives(+FileAndHeads, -Directives, +Options) is det.
  248%
  249%   Assemble the final set of directives. Uses the option update(Old).
  250
  251directives(FileAndHeads, Directives, Options) :-
  252    option(update(Old), Options, []),
  253    phrase(update_directives(Old, FileAndHeads, RestDeps), Directives, Rest),
  254    update_style(Old, Options, Options1),
  255    maplist(directive(Options1), RestDeps, Rest0),
  256    sort(Rest0, Rest).
  257
  258update_directives([], Deps, Deps) -->
  259    [].
  260update_directives([:-(H)|T], Deps0, Deps) -->
  261    { update_directive(H, Deps0, Deps1, Directive) },
  262    !,
  263    [ :-(Directive) ],
  264    update_directives(T, Deps1, Deps).
  265update_directives([H|T], Deps0, Deps) -->
  266    [ H ],
  267    update_directives(T, Deps0, Deps).
  268
  269update_directive(Dir0, Deps0, Deps, Dir) :-
  270    directive_file(Dir0, FileSpec),
  271    absolute_file_name(FileSpec, File,
  272                       [ file_type(prolog),
  273                         file_errors(fail),
  274                         access(read)
  275                       ]),
  276    select(DepFile-Heads, Deps0, Deps),
  277    same_dep_file(DepFile, File),
  278    !,
  279    (   Dir0 =.. [Pred,File0,Imports]
  280    ->  maplist(pi_head, PIs, Heads),
  281        subtract(PIs, Imports, New),
  282        append(Imports, New, NewImports),
  283        Dir =.. [Pred,File0,NewImports]
  284    ;   Dir = Dir0
  285    ).
  286
  287directive_file(use_module(File),   File).
  288directive_file(use_module(File,_), File).
  289directive_file(autoload(File),     File).
  290directive_file(autoload(File,_),   File).
  291
  292same_dep_file(File, File) :-
  293    !.
  294same_dep_file(Dep, _File) :-
  295    exists_file(Dep),
  296    !,
  297    fail.
  298same_dep_file(Dep, File) :-
  299    user:prolog_file_type(Ext, prolog),
  300    file_name_extension(Dep, Ext, DepFile),
  301    same_file(DepFile, File),
  302    !.
  303
  304
  305%!  update_style(+OldDirectives, +Options0, -Options)
  306%
  307%   Determine  the  directive  to  use    for   new  dependencies.  This
  308%   establishes a default based on existing dependencies.
  309
  310update_style(_Old, Options, Options) :-
  311    option(directive(_), Options),
  312    !.
  313update_style(Old, Options, [directive(autoload/2)|Options]) :-
  314    memberchk((:- autoload(_,_)), Old),
  315    !.
  316update_style(Old, Options, [directive(autoload/1)|Options]) :-
  317    memberchk((:- autoload(_)), Old),
  318    !.
  319update_style(Old, Options, [directive(use_module/2)|Options]) :-
  320    memberchk((:- use_module(_,_)), Old),
  321    !.
  322update_style(Old, Options, [directive(use_module/1)|Options]) :-
  323    memberchk((:- use_module(_)), Old),
  324    !.
  325update_style(_, Options, Options).
  326
  327
  328%!  directive(+Options, +FileAndHeads, -Directive)
  329%
  330%   Create a directive to import Heads from File.
  331
  332directive(Options, File-Heads, Directive) :-
  333    file_name_extension(File, pl, LibFile),
  334    file_name_on_path(LibFile, Lib0),
  335    segments(Lib0, Lib),
  336    maplist(pi_head, PIs, Heads),
  337    make_directive(Lib, PIs, Directive, Options).
  338
  339segments(Term0, Term) :-
  340    Term0 =.. [Alias,Atom],
  341    path_segments_atom(Segments, Atom),
  342    format(atom(Atom), '~q', [Segments]),
  343    !,
  344    Term =.. [Alias,Segments].
  345segments(FilePL, File) :-
  346    atom(FilePL),
  347    file_name_extension(File, pl, FilePL),
  348    !.
  349segments(Term, Term).
  350
  351:- multifile
  352    prolog:no_autoload_module/1.  353
  354make_directive(Lib, Import, (:- use_module(Lib, Import)), Options) :-
  355    option(directive(use_module/2), Options, use_autoload/2),
  356    !.
  357make_directive(Lib, _Import, (:- use_module(Lib)), Options) :-
  358    option(directive(use_module/1), Options, use_autoload/2),
  359    !.
  360make_directive(Lib, _Import, (:- use_module(Lib)), Options) :-
  361    option(directive(use_autoload/1), Options, use_autoload/2),
  362    prolog:no_autoload_module(Lib),
  363    !.
  364make_directive(Lib, Import, (:- use_module(Lib, Import)), _) :-
  365    prolog:no_autoload_module(Lib),
  366    !.
  367make_directive(Lib, _Import, (:- autoload(Lib)), Options) :-
  368    option(directive(use_autoload/1), Options, use_autoload/2),
  369    !.
  370make_directive(Lib, Import, (:- autoload(Lib, Import)), _).
  371
  372
  373		 /*******************************
  374		 *          NO AUTOLOAD		*
  375		 *******************************/
  376
  377:- dynamic
  378    library_index/3,                % Head x Module x Path
  379    autoload_directories/1,         % List
  380    index_checked_at/1.             % Time
  381:- volatile
  382    library_index/3,
  383    autoload_directories/1,
  384    index_checked_at/1.  385
  386noautoload(Head, File) :-
  387    functor(Head, Name, Arity),
  388    context_module(Here),
  389    '$autoload':load_library_index(Here:Name, Arity, Here:noautoload('INDEX')),
  390    library_index(Head, _, File).
  391
  392
  393		 /*******************************
  394		 *           REPLACE		*
  395		 *******************************/
  396
  397%!  file_auto_import(+File, +Options)
  398%
  399%   Update the autoload/2 directives for File. This predicate __modifies
  400%   the file in place__. Defined options are:
  401%
  402%     - backup(+Extension)
  403%       Create a backup of File using Extension.
  404
  405file_auto_import(File, Options) :-
  406    absolute_file_name(File, Path,
  407                       [ file_type(prolog),
  408                         access(read)
  409                       ]),
  410    file_autoload_directives(Path, Directives, Options),
  411    (   option(backup(Ext), Options)
  412    ->  file_name_extension(Path, Ext, Old),
  413        copy_file(Path, Old)
  414    ;   true
  415    ),
  416    Edit = _{import:Directives, done:_},
  417    (   has_import(Path)
  418    ->  edit_file(Old, Path, Edit.put(replace,true))
  419    ;   edit_file(Old, Path, Edit.put(new,true))
  420    ).
  421
  422has_import(InFile) :-
  423    setup_call_cleanup(
  424        prolog_open_source(InFile, In),
  425        (   repeat,
  426            prolog_read_source_term(In, Term, _Expanded, []),
  427            (   Term == end_of_file
  428            ->  !
  429            ;    true
  430            )
  431        ),
  432        prolog_close_source(In)),
  433    nonvar(Term),
  434    import_directive(Term),
  435    !.
  436
  437import_directive((:- use_module(_))).
  438import_directive((:- use_module(_, _))).
  439
  440%!  rewrite_term(+In, -Keep, -OutList, +Options) is semidet.
  441
  442rewrite_term(Never,_,_,_) :-
  443    never_rewrite(Never),
  444    !,
  445    fail.
  446rewrite_term(Import,false,[],Options) :-
  447    Options.done == true,
  448    !,
  449    import_directive(Import).
  450rewrite_term(In,false,Directives,Options) :-
  451    import_directive(In),
  452    !,
  453    append(Options.import, [nl], Directives),
  454    Options.done = true.
  455rewrite_term(In,true,Directives,Options) :-
  456    In = (:- module(_,_)),
  457    Options.get(new) == true,
  458    !,
  459    append(Options.import, [nl], Directives),
  460    Options.done = true.
  461
  462never_rewrite((:- use_module(_, []))).
  463
  464edit_file(InFile, OutFile, Options) :-
  465    read_file_to_string(InFile, String, []),
  466    setup_call_cleanup(
  467        prolog_open_source(InFile, In),
  468        setup_call_cleanup(
  469            open(OutFile, write, Out),
  470            rewrite(In, Out, String, Options),
  471            close(Out)),
  472        prolog_close_source(In)).
  473
  474rewrite(In, Out, String, Options) :-
  475    prolog_read_source_term(
  476        In, Term, _Expanded,
  477        [ term_position(StartPos),
  478          subterm_positions(TermPos),
  479          comments(Comments)
  480        ]),
  481    stream_position_data(char_count, StartPos, StartChar),
  482    copy_comments(Comments, StartChar, String, Out),
  483    (   Term == end_of_file
  484    ->  true
  485    ;   (   nonvar(Term),
  486            rewrite_term(Term, Keep, List, Options)
  487        ->  (   Keep == true
  488            ->  copy_term_string(TermPos, String, Out)
  489            ;   true
  490            ),
  491            forall(member(T, List),
  492                   output_term(Out, T)),
  493            (   append(_, [nl], List)
  494            ->  skip_blanks(In)
  495            ;   true
  496            )
  497        ;   copy_term_string(TermPos, String, Out)
  498        ),
  499        rewrite(In, Out, String, Options)
  500    ).
  501
  502output_term(Out, nl) :-
  503    !,
  504    nl(Out).
  505output_term(Out, Term) :-
  506    print_term(Term, [output(Out)]),
  507    format(Out, '.~n', []).
  508
  509copy_comments([Pos-H|T], StartChar, String, Out) :-
  510    stream_position_data(char_count, Pos, Start),
  511    Start < StartChar,
  512    !,
  513    string_length(H, Len),
  514    sub_string(String, Start, Len, _, Comment),
  515    End is Start+Len+1,
  516    layout_after(End, String, Layout),
  517    format(Out, '~s~s', [Comment, Layout]),
  518    copy_comments(T, StartChar, String, Out).
  519copy_comments(_, _, _, _).
  520
  521copy_term_string(TermPos, String, Out) :-
  522    arg(1, TermPos, Start),
  523    arg(2, TermPos, End),
  524    Len is End - Start,
  525    sub_string(String, Start, Len, _, TermString),
  526    End1 is End + 1,
  527    full_stop_after(End1, String, Layout),
  528    format(Out, '~s~s', [TermString, Layout]).
  529
  530layout_after(Index, String, [H|T]) :-
  531    string_code(Index, String, H),
  532    code_type(H, space),
  533    !,
  534    Index2 is Index+1,
  535    layout_after(Index2, String, T).
  536layout_after(_, _, []).
  537
  538full_stop_after(Index, String, [H|T]) :-
  539    string_code(Index, String, H),
  540    Index2 is Index+1,
  541    (   code_type(H, space)
  542    ->  !, full_stop_after(Index2, String, T)
  543    ;   H == 0'.
  544    ->  !, layout_after(Index2, String, T)
  545    ).
  546full_stop_after(_, _, []).
  547
  548skip_blanks(In) :-
  549    peek_code(In, C),
  550    code_type(C, space),
  551    !,
  552    get_code(In, _),
  553    skip_blanks(In).
  554skip_blanks(_)