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-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_autoload,
   37          [ autoload_all/0,
   38            autoload_all/1                      % +Options
   39          ]).   40:- use_module(library(check), []).      % uses :- public predicates
   41
   42:- autoload(library(aggregate),[aggregate_all/3]).   43:- autoload(library(error),[must_be/2,existence_error/2]).   44:- autoload(library(option),[option/2,option/3]).   45:- autoload(library(prolog_codewalk),[prolog_walk_code/1]).   46
   47:- predicate_options(autoload_all/1, 1,
   48                     [ verbose(boolean),
   49                       undefined(oneof([ignore,error]))
   50                     ]).

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.

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

The implementation relies on code analysis of the bodies of all clauses and all initialization goals.

As of SWI-Prolog 8.1.22 the system provides autoload/1,2 directives that mitigate the possible ambiguity. */

   80:- thread_local
   81    autoloaded_count/1.
 autoload_all is det
 autoload_all(+Options) is det
Force all necessary autoloading to be done now. This sets the Prolog flag autoload to false, resolving explicit autoloading and then finds all undefined references to autoloadable predicates and load the library files that define these predicates.

Options:

verbose(+Boolean)
If true (default false), report on the files loaded.
undefined(+Action)
Action defines what happens if the analysis finds a definitely undefined predicate. One of ignore or error. Default is ignore.
  100autoload_all :-
  101    autoload_all([]).
  102
  103autoload_all(Options) :-
  104    set_prolog_flag(autoload, false),
  105    must_be(list, Options),
  106    statistics(cputime, T0),
  107    aggregate_all(count, source_file(_), OldFileCount),
  108    call_cleanup(
  109        autoload(0, Iterations, Options),
  110        check:collect_undef(Undef)),
  111    aggregate_all(count, source_file(_), NewFileCount),
  112    statistics(cputime, T1),
  113    Time is T1-T0,
  114    information_level(Level, Options),
  115    NewFiles is NewFileCount - OldFileCount,
  116    print_message(Level, autoload(completed(Iterations, Time, NewFiles))),
  117    report_undefined(Undef).
  118
  119autoload(Iteration0, Iterations, Options) :-
  120    statistics(cputime, T0),
  121    autoload_step(NewFiles, NewPreds, Options),
  122    statistics(cputime, T1),
  123    Time is T1-T0,
  124    succ(Iteration0, Iteration),
  125    (   NewFiles > 0
  126    ->  information_level(Level, Options),
  127        print_message(Level, autoload(reiterate(Iteration,
  128                                                NewFiles, NewPreds, Time))),
  129        autoload(Iteration, Iterations, Options)
  130    ;   Iterations = Iteration
  131    ).
  132
  133information_level(Level, Options) :-
  134    (   option(verbose(true), Options)
  135    ->  Level = informational
  136    ;   Level = silent
  137    ).
 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.
  148autoload_step(NewFiles, NewPreds, Options) :-
  149    option(verbose(Verbose), Options, false),
  150    walk_options(Options, WalkOptions),
  151    aggregate_all(count, source_file(_), OldFileCount),
  152    setup_call_cleanup(
  153        ( current_prolog_flag(autoload, OldAutoLoad),
  154          current_prolog_flag(verbose_autoload, OldVerbose),
  155          set_prolog_flag(autoload, true),
  156          set_prolog_flag(verbose_autoload, Verbose),
  157          assert_autoload_hook(Ref),
  158          asserta(autoloaded_count(0))
  159        ),
  160        prolog_walk_code(WalkOptions),
  161        ( retract(autoloaded_count(Count)),
  162          erase(Ref),
  163          set_prolog_flag(autoload, OldAutoLoad),
  164          set_prolog_flag(verbose_autoload, OldVerbose)
  165        )),
  166    aggregate_all(count, source_file(_), NewFileCount),
  167    NewPreds = Count,
  168    NewFiles is NewFileCount - OldFileCount.
  169
  170assert_autoload_hook(Ref) :-
  171    asserta((user:message_hook(autoload(Module:Name/Arity, Library), _, _) :-
  172                    autoloaded(Module:Name/Arity, Library)), Ref).
  173
  174:- public
  175    autoloaded/2.  176
  177autoloaded(_, _) :-
  178    retract(autoloaded_count(N)),
  179    succ(N, N2),
  180    asserta(autoloaded_count(N2)),
  181    fail.                                   % proceed with other hooks
 walk_options(+AutoloadOptions, -WalkOptions) is det
Construct the option list for the code walker. If we see an undefined predicate, we must collect these rather than printing them or immediately terminating with an exception. This reuses code from library(check).
  190walk_options([], []).
  191walk_options([verbose(V)|T0], [verbose(V)|T]) :-
  192    !,
  193    walk_options(T0, T).
  194walk_options([undefined(error)|T0],
  195             [ undefined(trace),
  196               on_trace(check:found_undef)
  197             | T
  198             ]) :-
  199    !,
  200    walk_options(T0, T).
  201walk_options([_|T0], T) :-
  202    walk_options(T0, T).
 report_undefined(+Undefined) is det
  209report_undefined([]) :-
  210    !.
  211report_undefined(Grouped) :-
  212    existence_error(procedures, Grouped).
  213
  214
  215                 /*******************************
  216                 *            MESSAGES          *
  217                 *******************************/
  218
  219:- multifile
  220    prolog:message//1,
  221    prolog:error_message//1.  222
  223prolog:message(autoload(reiterate(Iteration, NewFiles, NewPreds, Time))) -->
  224    [ 'Autoloader: iteration ~D resolved ~D predicates \c
  225          and loaded ~D files in ~3f seconds.  Restarting ...'-
  226      [Iteration, NewPreds, NewFiles, Time]
  227    ].
  228prolog:message(autoload(completed(Iterations, Time, NewFiles))) -->
  229    [ 'Autoloader: loaded ~D files in ~D iterations in ~3f seconds'-
  230      [NewFiles, Iterations, Time] ].
  231
  232prolog:error_message(existence_error(procedures, Grouped)) -->
  233    prolog:message(check(undefined_procedures, Grouped))