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)  1985-2012, University of Amsterdam
    7                              VU University 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('$autoload',
   37          [ '$find_library'/5,
   38            '$in_library'/3,
   39            '$define_predicate'/1,
   40            '$update_library_index'/0,
   41            make_library_index/1,
   42            make_library_index/2,
   43            reload_library_index/0,
   44            autoload_path/1
   45          ]).   46
   47:- dynamic
   48    library_index/3,                % Head x Module x Path
   49    autoload_directories/1,         % List
   50    index_checked_at/1.             % Time
   51:- volatile
   52    library_index/3,
   53    autoload_directories/1,
   54    index_checked_at/1.   55
   56user:file_search_path(autoload, library(.)).
   57
   58
   59%!  '$find_library'(+Module, +Name, +Arity, -LoadModule, -Library) is semidet.
   60%
   61%   Locate a predicate in the library. Name   and arity are the name
   62%   and arity of  the  predicate  searched   for.  `Module'  is  the
   63%   preferred target module. The return  values   are  the full path
   64%   name (excluding extension) of the library and module declared in
   65%   that file.
   66
   67'$find_library'(Module, Name, Arity, LoadModule, Library) :-
   68    load_library_index(Name, Arity),
   69    functor(Head, Name, Arity),
   70    (   library_index(Head, Module, Library),
   71        LoadModule = Module
   72    ;   library_index(Head, LoadModule, Library)
   73    ),
   74    !.
   75
   76%!  '$in_library'(+Name, +Arity, -Path) is semidet.
   77%!  '$in_library'(-Name, -Arity, -Path) is nondet.
   78%
   79%   Is true if Name/Arity is in the autoload libraries.
   80
   81'$in_library'(Name, Arity, Path) :-
   82    atom(Name), integer(Arity),
   83    !,
   84    load_library_index(Name, Arity),
   85    functor(Head, Name, Arity),
   86    library_index(Head, _, Path).
   87'$in_library'(Name, Arity, Path) :-
   88    load_library_index(Name, Arity),
   89    library_index(Head, _, Path),
   90    functor(Head, Name, Arity).
   91
   92%!  '$define_predicate'(:Head)
   93%
   94%   Make sure PredInd can be called. First  test if the predicate is
   95%   defined. If not, invoke the autoloader.
   96
   97:- meta_predicate
   98    '$define_predicate'(:).   99
  100'$define_predicate'(Head) :-
  101    '$defined_predicate'(Head),
  102    !.
  103'$define_predicate'(Term) :-
  104    Term = Module:Head,
  105    (   compound(Head)
  106    ->  compound_name_arity(Head, Name, Arity)
  107    ;   Name = Head, Arity = 0
  108    ),
  109    '$undefined_procedure'(Module, Name, Arity, retry).
  110
  111
  112                /********************************
  113                *          UPDATE INDEX         *
  114                ********************************/
  115
  116:- thread_local
  117    silent/0.  118
  119%!  '$update_library_index'
  120%
  121%   Called from make/0 to update the index   of the library for each
  122%   library directory that has a writable   index.  Note that in the
  123%   Windows  version  access_file/2  is  mostly   bogus.  We  assert
  124%   silent/0 to suppress error messages.
  125
  126'$update_library_index' :-
  127    setof(Dir, writable_indexed_directory(Dir), Dirs),
  128    !,
  129    setup_call_cleanup(
  130        asserta(silent, Ref),
  131        guarded_make_library_index(Dirs),
  132        erase(Ref)),
  133    (   flag('$modified_index', true, false)
  134    ->  reload_library_index
  135    ;   true
  136    ).
  137'$update_library_index'.
  138
  139guarded_make_library_index([]).
  140guarded_make_library_index([Dir|Dirs]) :-
  141    (   catch(make_library_index(Dir), E,
  142              print_message(error, E))
  143    ->  true
  144    ;   print_message(warning, goal_failed(make_library_index(Dir)))
  145    ),
  146    guarded_make_library_index(Dirs).
  147
  148%!  writable_indexed_directory(-Dir) is nondet.
  149%
  150%   True when Dir is an indexed   library  directory with a writable
  151%   index, i.e., an index that can be updated.
  152
  153writable_indexed_directory(Dir) :-
  154    index_file_name(IndexFile, [access([read,write])]),
  155    file_directory_name(IndexFile, Dir).
  156writable_indexed_directory(Dir) :-
  157    absolute_file_name(library('MKINDEX'),
  158                       [ file_type(prolog),
  159                         access(read),
  160                         solutions(all),
  161                         file_errors(fail)
  162                       ], MkIndexFile),
  163    file_directory_name(MkIndexFile, Dir),
  164    plfile_in_dir(Dir, 'INDEX', _, IndexFile),
  165    access_file(IndexFile, write).
  166
  167
  168                /********************************
  169                *           LOAD INDEX          *
  170                ********************************/
  171
  172%!  reload_library_index
  173%
  174%   Reload the index on the next call
  175
  176reload_library_index :-
  177    with_mutex('$autoload', clear_library_index).
  178
  179clear_library_index :-
  180    retractall(library_index(_, _, _)),
  181    retractall(autoload_directories(_)),
  182    retractall(index_checked_at(_)).
  183
  184
  185%!  load_library_index(?Name, ?Arity) is det.
  186%
  187%   Try to find Name/Arity  in  the   library.  If  the predicate is
  188%   there, we are happy. If not, we  check whether the set of loaded
  189%   libraries has changed and if so we reload the index.
  190
  191load_library_index(Name, Arity) :-
  192    atom(Name), integer(Arity),
  193    functor(Head, Name, Arity),
  194    library_index(Head, _, _),
  195    !.
  196load_library_index(_, _) :-
  197    notrace(with_mutex('$autoload', load_library_index_p)).
  198
  199load_library_index_p :-
  200    index_checked_at(Time),
  201    get_time(Now),
  202    Now-Time < 60,
  203    !.
  204load_library_index_p :-
  205    findall(Index, index_file_name(Index, [access(read)]), List0),
  206    list_set(List0, List),
  207    retractall(index_checked_at(_)),
  208    get_time(Now),
  209    assert(index_checked_at(Now)),
  210    (   autoload_directories(List)
  211    ->  true
  212    ;   retractall(library_index(_, _, _)),
  213        retractall(autoload_directories(_)),
  214        read_index(List),
  215        assert(autoload_directories(List))
  216    ).
  217
  218list_set([], R) :-                      % == list_to_set/2 from library(lists)
  219    closel(R).
  220list_set([H|T], R) :-
  221    memberchk(H, R),
  222    !,
  223    list_set(T, R).
  224
  225closel([]) :- !.
  226closel([_|T]) :-
  227    closel(T).
  228
  229
  230%!  index_file_name(-IndexFile, +Options) is nondet.
  231%
  232%   True if IndexFile is an autoload   index file. Options is passed
  233%   to  absolute_file_name/3.  This  predicate   searches  the  path
  234%   =autoload=.
  235%
  236%   @see file_search_path/2.
  237
  238index_file_name(IndexFile, Options) :-
  239    absolute_file_name(autoload('INDEX'),
  240                       IndexFile,
  241                       [ file_type(prolog),
  242                         solutions(all),
  243                         file_errors(fail)
  244                       | Options
  245                       ]).
  246
  247read_index([]) :- !.
  248read_index([H|T]) :-
  249    !,
  250    read_index(H),
  251    read_index(T).
  252read_index(Index) :-
  253    print_message(silent, autoload(read_index(Dir))),
  254    file_directory_name(Index, Dir),
  255    setup_call_cleanup(
  256        '$push_input_context'(autoload_index),
  257        setup_call_cleanup(
  258            open(Index, read, In),
  259            read_index_from_stream(Dir, In),
  260            close(In)),
  261        '$pop_input_context').
  262
  263read_index_from_stream(Dir, In) :-
  264    repeat,
  265        read(In, Term),
  266        assert_index(Term, Dir),
  267    !.
  268
  269assert_index(end_of_file, _) :- !.
  270assert_index(index(Name, Arity, Module, File), Dir) :-
  271    !,
  272    functor(Head, Name, Arity),
  273    atomic_list_concat([Dir, '/', File], Path),
  274    assertz(library_index(Head, Module, Path)),
  275    fail.
  276assert_index(Term, Dir) :-
  277    print_message(error, illegal_autoload_index(Dir, Term)),
  278    fail.
  279
  280
  281                /********************************
  282                *       CREATE INDEX.pl         *
  283                ********************************/
  284
  285%!  make_library_index(+Dir) is det.
  286%
  287%   Create an index for autoloading  from   the  directory  Dir. The
  288%   index  file  is  called  INDEX.pl.  In    Dir  contains  a  file
  289%   MKINDEX.pl, this file is loaded and we  assume that the index is
  290%   created by directives that appearin   this  file. Otherwise, all
  291%   source  files  are  scanned  for  their  module-header  and  all
  292%   exported predicates are added to the autoload index.
  293%
  294%   @see make_library_index/2
  295
  296make_library_index(Dir0) :-
  297    forall(absolute_file_name(Dir0, Dir,
  298                              [ expand(true),
  299                                file_type(directory),
  300                                file_errors(fail),
  301                                solutions(all)
  302                              ]),
  303           make_library_index2(Dir)).
  304
  305make_library_index2(Dir) :-
  306    plfile_in_dir(Dir, 'MKINDEX', MkIndex, AbsMkIndex),
  307    access_file(AbsMkIndex, read),
  308    !,
  309    setup_call_cleanup(
  310        working_directory(OldDir, Dir),
  311        load_files(user:MkIndex, [silent(true)]),
  312        working_directory(_, OldDir)).
  313make_library_index2(Dir) :-
  314    findall(Pattern, source_file_pattern(Pattern), PatternList),
  315    make_library_index2(Dir, PatternList).
  316
  317%!  make_library_index(+Dir, +Patterns:list(atom)) is det.
  318%
  319%   Create an autoload index INDEX.pl for  Dir by scanning all files
  320%   that match any of the file-patterns in Patterns. Typically, this
  321%   appears as a directive in MKINDEX.pl.  For example:
  322%
  323%     ==
  324%     :- make_library_index(., ['*.pl']).
  325%     ==
  326%
  327%   @see make_library_index/1.
  328
  329make_library_index(Dir0, Patterns) :-
  330    forall(absolute_file_name(Dir0, Dir,
  331                              [ expand(true),
  332                                file_type(directory),
  333                                file_errors(fail),
  334                                solutions(all)
  335                              ]),
  336           make_library_index2(Dir, Patterns)).
  337
  338make_library_index2(Dir, Patterns) :-
  339    plfile_in_dir(Dir, 'INDEX', _Index, AbsIndex),
  340    ensure_slash(Dir, DirS),
  341    pattern_files(Patterns, DirS, Files),
  342    (   library_index_out_of_date(AbsIndex, Files)
  343    ->  do_make_library_index(AbsIndex, DirS, Files),
  344        flag('$modified_index', _, true)
  345    ;   true
  346    ).
  347
  348ensure_slash(Dir, DirS) :-
  349    (   sub_atom(Dir, _, _, 0, /)
  350    ->  DirS = Dir
  351    ;   atom_concat(Dir, /, DirS)
  352    ).
  353
  354source_file_pattern(Pattern) :-
  355    user:prolog_file_type(PlExt, prolog),
  356    atom_concat('*.', PlExt, Pattern).
  357
  358plfile_in_dir(Dir, Base, PlBase, File) :-
  359    file_name_extension(Base, pl, PlBase),
  360    atomic_list_concat([Dir, '/', PlBase], File).
  361
  362pattern_files([], _, []).
  363pattern_files([H|T], DirS, Files) :-
  364    atom_concat(DirS, H, P0),
  365    expand_file_name(P0, Files0),
  366    '$append'(Files0, Rest, Files),
  367    pattern_files(T, DirS, Rest).
  368
  369library_index_out_of_date(Index, _Files) :-
  370    \+ exists_file(Index),
  371    !.
  372library_index_out_of_date(Index, Files) :-
  373    time_file(Index, IndexTime),
  374    (   time_file('.', DotTime),
  375        DotTime > IndexTime
  376    ;   '$member'(File, Files),
  377        time_file(File, FileTime),
  378        FileTime > IndexTime
  379    ),
  380    !.
  381
  382
  383do_make_library_index(Index, Dir, Files) :-
  384    ensure_slash(Dir, DirS),
  385    catch(setup_call_cleanup(
  386              open(Index, write, Fd),
  387              ( print_message(informational, make(library_index(Dir))),
  388                index_header(Fd),
  389                index_files(Files, DirS, Fd)
  390              ),
  391              close(Fd)),
  392          E, index_error(E)).
  393
  394index_error(E) :-
  395    silent,
  396    E = error(permission_error(open, source_sink, _)),
  397    !.
  398index_error(E) :-
  399    print_message(error, E).
  400
  401
  402index_files([], _, _).
  403index_files([File|Files], DirS, Fd) :-
  404    catch(setup_call_cleanup(
  405              open(File, read, In),
  406              read(In, Term),
  407              close(In)),
  408          E, print_message(warning, E)),
  409    (   Term = (:- module(Module, Public)),
  410        is_list(Public)
  411    ->  atom_concat(DirS, Local, File),
  412        file_name_extension(Base, _, Local),
  413        forall(public_predicate(Public, Name/Arity),
  414               format(Fd, 'index((~k), ~k, ~k, ~k).~n',
  415                      [Name, Arity, Module, Base]))
  416    ;   true
  417    ),
  418    index_files(Files, DirS, Fd).
  419
  420public_predicate(Public, PI) :-
  421    '$member'(PI0, Public),
  422    canonical_pi(PI0, PI).
  423
  424canonical_pi(Var, _) :-
  425    var(Var), !, fail.
  426canonical_pi(Name/Arity, Name/Arity).
  427canonical_pi(Name//A0,   Name/Arity) :-
  428    Arity is A0 + 2.
  429
  430
  431index_header(Fd):-
  432    format(Fd, '/*  Creator: make/0~n~n', []),
  433    format(Fd, '    Purpose: Provide index for autoload~n', []),
  434    format(Fd, '*/~n~n', []).
  435
  436
  437                 /*******************************
  438                 *            EXTENDING         *
  439                 *******************************/
  440
  441%!  autoload_path(+Path) is det.
  442%
  443%   Add Path to the libraries that are  used by the autoloader. This
  444%   extends the search  path  =autoload=   and  reloads  the library
  445%   index.  For example:
  446%
  447%     ==
  448%     :- autoload_path(library(http)).
  449%     ==
  450%
  451%   If this call appears as a directive,  it is term-expanded into a
  452%   clause  for  user:file_search_path/2  and  a  directive  calling
  453%   reload_library_index/0. This keeps source information and allows
  454%   for removing this directive.
  455
  456autoload_path(Alias) :-
  457    (   user:file_search_path(autoload, Alias)
  458    ->  true
  459    ;   assertz(user:file_search_path(autoload, Alias)),
  460        reload_library_index
  461    ).
  462
  463system:term_expansion((:- autoload_path(Alias)),
  464                      [ user:file_search_path(autoload, Alias),
  465                        (:- reload_library_index)
  466                      ])