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                      ]).