View source with raw comments or as raw
    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)  2011-2012, VU University Amsterdam
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(prolog_autoload,
   36          [ autoload/0,
   37            autoload/1                          % +Options
   38          ]).   39:- use_module(library(option)).   40:- use_module(library(error)).   41:- use_module(library(aggregate)).   42:- use_module(library(prolog_codewalk)).   43
   44:- predicate_options(autoload/1, 1,
   45                     [ verbose(boolean),
   46                       undefined(oneof([ignore,error]))
   47                     ]).

Autoload all dependencies

The autoloader is there to smoothen program development. It liberates the programmer from finding the library that defines some particular predicate and including the proper use_module/1,2 directive in the sources. This is even better at the toplevel, where just using maplist/3 is way more comfortable than first having to load library(apply). In addition, it reduces the startup time of applications by only loading the necessary bits.

Of course, there is also a price. One is that it becomes less obvious from where some predicate is loaded and thus whether you have the right definition. The second issue is that it is harder to create a stand-alone executable because this executable, without access to the development system, can no longer rely on autoloading. Finally, program analysis becomes harder because the program may be incomplete.

This library provides autoload/0 and autoload/1 to autoload all predicates that are referenced by the program. Now, this is not possible in Prolog because the language allows for constructing arbitrary goals and runtime and calling them (e.g., read(X), call(X)).

The classical version relied on the predicate_property undefined. The current version relies on code analysis of the bodies of all clauses and all initialization goals. */

   76:- thread_local
   77    autoloaded_count/1.
 autoload is det
 autoload(+Options) is det
Force all necessary autoloading to be done now. Options:
verbose(+Boolean)
If true, report on the files loaded.
undefined(+Action)
Action defines what happens if the analysis finds a definitely undefined predicate. One of ignore or error.
   91autoload :-
   92    autoload([]).
   93
   94autoload(Options) :-
   95    must_be(list, Options),
   96    statistics(cputime, T0),
   97    aggregate_all(count, source_file(_), OldFileCount),
   98    autoload(0, Iterations, Options),
   99    aggregate_all(count, source_file(_), NewFileCount),
  100    statistics(cputime, T1),
  101    Time is T1-T0,
  102    information_level(Level, Options),
  103    NewFiles is NewFileCount - OldFileCount,
  104    print_message(Level, autoload(completed(Iterations, Time, NewFiles))).
  105
  106
  107autoload(Iteration0, Iterations, Options) :-
  108    statistics(cputime, T0),
  109    autoload_step(NewFiles, NewPreds, Options),
  110    statistics(cputime, T1),
  111    Time is T1-T0,
  112    succ(Iteration0, Iteration),
  113    (   NewFiles > 0
  114    ->  information_level(Level, Options),
  115        print_message(Level, autoload(reiterate(Iteration,
  116                                                NewFiles, NewPreds, Time))),
  117        autoload(Iteration, Iterations, Options)
  118    ;   Iterations = Iteration
  119    ).
  120
  121information_level(Level, Options) :-
  122    (   option(verbose(true), Options, true)
  123    ->  Level = informational
  124    ;   Level = silent
  125    ).
 autoload_step(-NewFiles, -NewPreds, +Options) is det
Scan through the program and autoload all undefined referenced predicates.
Arguments:
NewFiles- is unified to the number of files loaded
NewPreds- is unified to the number of predicates imported using the autoloader.
  136autoload_step(NewFiles, NewPreds, Options) :-
  137    option(verbose(Verbose), Options, true),
  138    aggregate_all(count, source_file(_), OldFileCount),
  139    setup_call_cleanup(
  140        ( current_prolog_flag(autoload, OldAutoLoad),
  141          current_prolog_flag(verbose_autoload, OldVerbose),
  142          set_prolog_flag(autoload, true),
  143          set_prolog_flag(verbose_autoload, Verbose),
  144          assert_autoload_hook(Ref),
  145          asserta(autoloaded_count(0))
  146        ),
  147        prolog_walk_code(Options),
  148        ( retract(autoloaded_count(Count)),
  149          erase(Ref),
  150          set_prolog_flag(autoload, OldAutoLoad),
  151          set_prolog_flag(verbose_autoload, OldVerbose)
  152        )),
  153    aggregate_all(count, source_file(_), NewFileCount),
  154    NewPreds = Count,
  155    NewFiles is NewFileCount - OldFileCount.
  156
  157assert_autoload_hook(Ref) :-
  158    asserta((user:message_hook(autoload(Module:Name/Arity, Library), _, _) :-
  159                    autoloaded(Module:Name/Arity, Library)), Ref).
  160
  161:- public
  162    autoloaded/2.  163
  164autoloaded(_, _) :-
  165    retract(autoloaded_count(N)),
  166    succ(N, N2),
  167    asserta(autoloaded_count(N2)),
  168    fail.                                   % proceed with other hooks
  169
  170
  171                 /*******************************
  172                 *            MESSAGES          *
  173                 *******************************/
  174
  175:- multifile
  176    prolog:message//1.  177
  178prolog:message(autoload(reiterate(Iteration, NewFiles, NewPreds, Time))) -->
  179    [ 'Autoloader: iteration ~D resolved ~D predicates \c
  180          and loaded ~D files in ~3f seconds.  Restarting ...'-
  181      [Iteration, NewFiles, NewPreds, Time]
  182    ].
  183prolog:message(autoload(completed(Iterations, Time, NewFiles))) -->
  184    [ 'Autoloader: loaded ~D files in ~D iterations in ~3f seconds'-
  185      [NewFiles, Iterations, Time] ]