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    PlExt \== qlf,
  357    atom_concat('*.', PlExt, Pattern).
  358
  359plfile_in_dir(Dir, Base, PlBase, File) :-
  360    file_name_extension(Base, pl, PlBase),
  361    atomic_list_concat([Dir, '/', PlBase], File).
  362
  363pattern_files([], _, []).
  364pattern_files([H|T], DirS, Files) :-
  365    atom_concat(DirS, H, P0),
  366    expand_file_name(P0, Files0),
  367    '$append'(Files0, Rest, Files),
  368    pattern_files(T, DirS, Rest).
  369
  370library_index_out_of_date(Index, _Files) :-
  371    \+ exists_file(Index),
  372    !.
  373library_index_out_of_date(Index, Files) :-
  374    time_file(Index, IndexTime),
  375    (   time_file('.', DotTime),
  376        DotTime > IndexTime
  377    ;   '$member'(File, Files),
  378        time_file(File, FileTime),
  379        FileTime > IndexTime
  380    ),
  381    !.
  382
  383
  384do_make_library_index(Index, Dir, Files) :-
  385    ensure_slash(Dir, DirS),
  386    '$stage_file'(Index, StagedIndex),
  387    setup_call_catcher_cleanup(
  388        open(StagedIndex, write, Out),
  389        ( print_message(informational, make(library_index(Dir))),
  390          index_header(Out),
  391          index_files(Files, DirS, Out)
  392        ),
  393        Catcher,
  394        install_index(Out, Catcher, StagedIndex, Index)).
  395
  396install_index(Out, Catcher, StagedIndex, Index) :-
  397    catch(close(Out), Error, true),
  398    (   silent
  399    ->  OnError = silent
  400    ;   OnError = error
  401    ),
  402    (   var(Error)
  403    ->  TheCatcher = Catcher
  404    ;   TheCatcher = exception(Error)
  405    ),
  406    '$install_staged_file'(TheCatcher, StagedIndex, Index, OnError).
  407
  408%!  index_files(+Files, +Directory, +Out:stream) is det.
  409%
  410%   Write index for Files in Directory to the stream Out.
  411
  412index_files([], _, _).
  413index_files([File|Files], DirS, Fd) :-
  414    catch(setup_call_cleanup(
  415              open(File, read, In),
  416              read(In, Term),
  417              close(In)),
  418          E, print_message(warning, E)),
  419    (   Term = (:- module(Module, Public)),
  420        is_list(Public)
  421    ->  atom_concat(DirS, Local, File),
  422        file_name_extension(Base, _, Local),
  423        forall(public_predicate(Public, Name/Arity),
  424               format(Fd, 'index((~k), ~k, ~k, ~k).~n',
  425                      [Name, Arity, Module, Base]))
  426    ;   true
  427    ),
  428    index_files(Files, DirS, Fd).
  429
  430public_predicate(Public, PI) :-
  431    '$member'(PI0, Public),
  432    canonical_pi(PI0, PI).
  433
  434canonical_pi(Var, _) :-
  435    var(Var), !, fail.
  436canonical_pi(Name/Arity, Name/Arity).
  437canonical_pi(Name//A0,   Name/Arity) :-
  438    Arity is A0 + 2.
  439
  440
  441index_header(Fd):-
  442    format(Fd, '/*  Creator: make/0~n~n', []),
  443    format(Fd, '    Purpose: Provide index for autoload~n', []),
  444    format(Fd, '*/~n~n', []).
  445
  446
  447                 /*******************************
  448                 *            EXTENDING         *
  449                 *******************************/
  450
  451%!  autoload_path(+Path) is det.
  452%
  453%   Add Path to the libraries that are  used by the autoloader. This
  454%   extends the search  path  =autoload=   and  reloads  the library
  455%   index.  For example:
  456%
  457%     ==
  458%     :- autoload_path(library(http)).
  459%     ==
  460%
  461%   If this call appears as a directive,  it is term-expanded into a
  462%   clause  for  user:file_search_path/2  and  a  directive  calling
  463%   reload_library_index/0. This keeps source information and allows
  464%   for removing this directive.
  465
  466autoload_path(Alias) :-
  467    (   user:file_search_path(autoload, Alias)
  468    ->  true
  469    ;   assertz(user:file_search_path(autoload, Alias)),
  470        reload_library_index
  471    ).
  472
  473system:term_expansion((:- autoload_path(Alias)),
  474                      [ user:file_search_path(autoload, Alias),
  475                        (:- reload_library_index)
  476                      ])