\chapter{Modules} \label{sec:modules} A Prolog module is a collection of predicates which defines a public interface by means of a set of provided predicates and operators. Prolog modules are defined by an ISO standard. Unfortunately, the standard is considered a failure and, as far as we are aware, not implemented by any concrete Prolog implementation. The SWI-Prolog module system syntax is derived from the Quintus Prolog module system. The Quintus module system has been the starting point for the module systems of a number of mainstream Prolog systems, such as SICStus, Ciao and YAP. The underlying primitives of the SWI-Prolog module system differ from the mentioned systems. These primitives allow for multiple modules in a file, hierarchical modules, emulation of other modules interfaces, etc. This chapter motivates and describes the SWI-Prolog module system. Novices can start using the module system after reading \secref{defmodule} and \secref{import}. The primitives defined in these sections suffice for basic usage until one needs to export predicates that call or manage other predicates dynamically (e.g., use \index{call/1}\predref{call}{1}, \index{assert/1}\predref{assert}{1}, etc.). Such predicates are called \jargon{meta predicates} and are discussed in \secref{metapred}. \Secref{overrule} to \secref{moduleop} describe more advanced issues. Starting with \secref{importmodule}, we discuss more low-level aspects of the SWI-Prolog module system that are used to implement the visible module system, and can be used to build other code reuse mechanisms. \section{Why Use Modules?} \label{sec:whymodules} In classic Prolog systems, all predicates are organised in a single namespace and any predicate can call any predicate. Because each predicate in a file can be called from anywhere in the program, it becomes very hard to find the dependencies and enhance the implementation of a predicate without risking to break the overall application. This is true for any language, but even worse for Prolog due to its frequent need for `helper predicates'. A Prolog module encapsulates a set of predicates and defines an \jargon{interface}. Modules can import other modules, which makes the dependencies explicit. Given explicit dependencies and a well-defined interface, it becomes much easier to change the internal organisation of a module without breaking the overall application. Explicit dependencies can also be used by the development environment. The SWI-Prolog library \pllib{prolog_xref} can be used to analyse completeness and consistency of modules. This library is used by the built-in editor PceEmacs for syntax highlighting, jump-to-definition, etc. \section{Defining a Module} \label{sec:defmodule} Modules are normally created by loading a \jargon{module file}. A module file is a file holding a \index{module/2}\predref{module}{2} directive as its first term. The \index{module/2}\predref{module}{2} directive declares the name and the public (i.e., externally visible) predicates of the module. The rest of the file is loaded into the module. Below is an example of a module file, defining \index{reverse/2}\predref{reverse}{2} and hiding the helper predicate \index{rev/3}\predref{rev}{3}. A module can use all built-in predicates and, by default, cannot redefine system predicates. \begin{code} :- module(reverse, [reverse/2]). reverse(List1, List2) :- rev(List1, [], List2). rev([], List, List). rev([Head|List1], List2, List3) :- rev(List1, [Head|List2], List3). \end{code} \noindent The module is named \const{reverse}. Typically, the name of a module is the same as the name of the file by which it is defined without the filename extension, but this naming is not enforced. Modules are organised in a single and flat namespace and therefore module names must be chosen with some care to avoid conflicts. As we will see, typical applications of the module system rarely use the name of a module explicitly in the source text. \begin{description} \directive{module}{2}{+Module, +PublicList} This directive can only be used as the first term of a source file. It declares the file to be a \jargon{module file}, defining a module named \arg{Module}. Note that a module name is an atom. The module exports the predicates of \arg{PublicList}. \arg{PublicList} is a list of predicate indicators (name/arity or name//arity pairs) or operator declarations using the format \term{op}{Precedence, Type, Name}. Operators defined in the export list are available inside the module as well as to modules importing this module. See also \secref{operators}. Compatible to Ciao Prolog, if \arg{Module} is unbound, it is unified with the basename without extension of the file being loaded. \directive{module}{3}{+Module, +PublicList, +Dialect} Same as \index{module/2}\predref{module}{2}. The additional \arg{Dialect} argument provides a list of \jargon{language options}. Each atom in the list \arg{Dialect} is mapped to a \index{use_module/1}\predref{use_module}{1} goal as given below. See also \secref{dialect}. The third argument is supported for compatibility with the \href{http://prolog-commons.org/}{Prolog Commons project}. \begin{code} :- use_module(library(dialect/LangOption)). \end{code} \noindent \end{description} \section{Importing Predicates into a Module} \label{sec:import} Predicates can be added to a module by \jargon{importing} them from another module. Importing adds predicates to the namespace of a module. An imported predicate can be called exactly the same as a locally defined predicate, although its implementation remains part of the module in which it has been defined. Importing the predicates from another module is achieved using the directives \index{use_module/1}\predref{use_module}{1} or \index{use_module/2}\predref{use_module}{2}. Note that both directives take \arg{filename(s)} as arguments. That is, modules are imported based on their filename rather than their module name. \begin{description} \predicate{use_module}{1}{+Files} Load the file(s) specified with \arg{Files} just like \index{ensure_loaded/1}\predref{ensure_loaded}{1}. The files must all be module files. All exported predicates from the loaded files are imported into the module from which this predicate is called. This predicate is equivalent to \index{ensure_loaded/1}\predref{ensure_loaded}{1}, except that it raises an error if \arg{Files} are not module files. The imported predicates act as \jargon{weak symbols} in the module into which they are imported. This implies that a local definition of a predicate overrides (clobbers) the imported definition. If the flag \prologflag{warn_override_implicit_import} is \const{true} (default), a warning is printed. Below is an example of a module that uses library(lists), but redefines \index{flatten/2}\predref{flatten}{2}, giving it a totally different meaning: \begin{code} :- module(shapes, []). :- use_module(library(lists)). flatten(cube, square). flatten(ball, circle). \end{code} \noindent \noindent Loading the above file prints the following message: \begin{code} Warning: /home/janw/Bugs/Import/t.pl:5: Local definition of shapes:flatten/2 overrides weak import from lists \end{code} \noindent This warning can be avoided by (1) using \index{use_module/2}\predref{use_module}{2} to only import the predicates from the \const{lists} library that are actually used in the `shapes' module, (2) using the \exam{except([\index{flatten/2}\predref{flatten}{2}])} option of \index{use_module/2}\predref{use_module}{2}, (3) use \exam{:- abolish(\index{flatten/2}\predref{flatten}{2}).} before the local definition or (4) setting \prologflag{warn_override_implicit_import} to \const{false}. Globally disabling this warning is only recommended if overriding imported predicates is common as a result of design choices or the program is ported from a system that silently overrides imported predicates. Note that it is always an error to import two modules with \index{use_module/1}\predref{use_module}{1} that export the same predicate. Such conflicts must be resolved with \index{use_module/2}\predref{use_module}{2} as described above. \predicate{use_module}{2}{+File, +ImportList} Load \arg{File}, which must be a module file, and import the predicates as specified by \arg{ImportList}. \arg{ImportList} is a list of predicate indicators specifying the predicates that will be imported from the loaded module. \arg{ImportList} also allows for renaming or import-everything-except. See also the \const{import} option of \index{load_files/2}\predref{load_files}{2}. The first example below loads \index{member/2}\predref{member}{2} from the \const{lists} library and \index{append/2}\predref{append}{2} under the name \const{list_concat}, which is how this predicate is named in YAP. The second example loads all exports from library \const{option} except for \index{meta_options/3}\predref{meta_options}{3}. These renaming facilities are generally used to deal with portability issues with as few changes as possible to the actual code. See also \secref{dialect} and \secref{reexport}. \begin{code} :- use_module(library(lists), [ member/2, append/2 as list_concat ]). :- use_module(library(option), except([meta_options/3])). \end{code} \noindent \end{description} In most cases a module is imported because some of its predicates are being used. However, sometimes a module is imported for other reasons, e.g., for its declarations. In such cases it is best practice to use \index{use_module/2}\predref{use_module}{2} with empty ImportList. This distinguishes an imported module that is used, although not for its predicates, from a module that is needlessly imported. The \index{module/2}\predref{module}{2}, \index{use_module/1}\predref{use_module}{1} and \index{use_module/2}\predref{use_module}{2} directives are sufficient to partition a simple Prolog program into modules. The SWI-Prolog graphical cross-referencing tool \index{gxref/0}\predref{gxref}{0} can be used to analyse the dependencies between non-module files and propose module declarations for each file. \section{Controlled autoloading for modules} \label{sec:module-autoload} SWI-Prolog by default support \jargon{autoloading} from its standard library. Autoloading implies that when a predicate is found missing during execution the library is searched and the predicate is imported lazily using \index{use_module/2}\predref{use_module}{2}. See \secref{autoload} for details. The advantage of autoloading is that it requires less typing while it reduces the startup time and reduces the memory footprint of an application. It also allows moving old predicates or emulation thereof the module \pllib{backcomp} without affecting existing code. This procedure keeps the libraries and system clean. We make sure that there are not two modules that provide the same predicate as autoload predicate. Nevertheless, a disadvantage of this autoloader is that the dependencies of a module on the libraries are not explicit and tooling such as PceEmacs or \index{gxref/0}\predref{gxref}{0} are required to find these dependencies. Some users want explicit control over which library predicates are accessed from where, preferably by using \index{use_module/2}\predref{use_module}{2} which explicitly states which predicates are imported from which library.\footnote{Note that built-in predicates still add predicates for general use to all name spaces.} Large applications typically contain source files that are not immediately needed and often are not needed at all in many runs of the program. This can be solved by creating an application-specific autoload library, but with multiple parties providing autoloadable predicates the maintenance becomes fragile. For these two reasons we added \index{autoload/1}\predref{autoload}{1} and \index{autoload/2}\predref{autoload}{2} that behave similar to \index{use_module/[1,2]}\predref{use_module}{[1,2]}, but do not perform the actual loading. The generic autoloader now proceeds as follows if a missing predicate is encountered: \begin{enumerate} \item Check \index{autoload/2}\predref{autoload}{2} declarations. If one specifies the predicate, import it using \index{use_module/2}\predref{use_module}{2}. \item Check \index{autoload/1}\predref{autoload}{1} declarations. If the specified file is loaded, check its export list. Otherwise read the module declaration of the target file to find the exports. If the target predicate is found, import it using \index{use_module/2}\predref{use_module}{2}. \item Perform autoloading from the library if the \prologflag{autoload} is \const{true}. \end{enumerate} \begin{description} \predicate{autoload}{1}{:File} \nodescription \predicate{autoload}{2}{:File, +Imports} Declare that possibly missing predicates in the module in which this declaration occurs are to be resolved by using \index{use_module/2}\predref{use_module}{2} on \arg{File} to (possibly) load the file and make the target predicate available. The \index{autoload/2}\predref{autoload}{2} variant is tried before \index{autoload/1}\predref{autoload}{1}. It is not allowed for two \index{autoload/2}\predref{autoload}{2} declarations to provide the same predicate and it is not allowed to define a predicate provided in this way locally. See also \index{require/1}\predref{require}{1}, which allows specifying predicates for autoloading from their default location. Predicates made available using \index{autoload/2}\predref{autoload}{2} behave as defined predicates, which implies that any operation on them will perform autoloading if necessary. Notably \index{predicate_property/2}\predref{predicate_property}{2}, \index{current_predicate/1}\predref{current_predicate}{1} and \index{clause/2}\predref{clause}{2} are supported. Currently, neither the existence of \arg{File}, nor whether it actually exports the given predicates (\index{autoload/2}\predref{autoload}{2}) is verified when the file is loaded. Instead, the declarations are verified when searching for a missing predicate. If the Prolog flag \prologflag{autoload} is set to \const{false}, these declarations are interpreted as \index{use_module/[1,2]}\predref{use_module}{[1,2]}. \end{description} \section{Defining a meta-predicate} \label{sec:metapred} A meta-predicate is a predicate that calls other predicates dynamically, modifies a predicate, or reasons about properties of a predicate. Such predicates use either a compound term or a \jargon{predicate indicator} to describe the predicate they address, e.g., \exam{assert(name(jan))} or \exam{abolish(\index{name/1}\predref{name}{1})}. With modules, this simple schema no longer works as each module defines its own mapping from name+arity to predicate. This is resolved by wrapping the original description in a term \bnfmeta{module}:\bnfmeta{term}, e.g., \exam{assert(person:name(jan))} or \exam{abolish(\index{person:name/1}\qpredref{person}{name}{1})}. Of course, when calling \index{assert/1}\predref{assert}{1} from inside a module, we expect to assert to a predicate local to this module. In other words, we do not wish to provide this \functor{\Smodule}{2} wrapper by hand. The \index{meta_predicate/1}\predref{meta_predicate}{1} directive tells the compiler that certain arguments are terms that will be used to look up a predicate and thus need to be wrapped (qualified) with \bnfmeta{module}:\bnfmeta{term}, unless they are already wrapped. In the example below, we use this to define \index{maplist/3}\predref{maplist}{3} inside a module. The argument `2' in the meta_predicate declaration means that the argument is module-sensitive and refers to a predicate with an arity that is two more than the term that is passed in. The compiler only distinguishes the values 0..9 and \chr{\Smodule}, which denote module-sensitive arguments, from \chr{\Splus}, \chr{\Sminus} and \chr{\Squest}, which denote \jargon{modes}. The values 0..9 are used by the \jargon{cross-referencer} and syntax highlighting. Note that the helper predicate \nopredref{maplist_}{3} does not need to be declared as a meta-predicate because the \index{maplist/3}\predref{maplist}{3} wrapper already ensures that \arg{Goal} is qualified as \bnfmeta{module}:\arg{Goal}. See the description of \index{meta_predicate/1}\predref{meta_predicate}{1} for details. \begin{code} :- module(maplist, [maplist/3]). :- meta_predicate maplist(2, ?, ?). %% maplist(:Goal, +List1, ?List2) % % True if Goal can successfully be applied to all % successive pairs of elements from List1 and List2. maplist(Goal, L1, L2) :- maplist_(L1, L2, Goal). maplist_([], [], _). maplist_([H0|T0], [H|T], Goal) :- call(Goal, H0, H), maplist_(T0, T, Goal). \end{code} \noindent \begin{description} \prefixop{meta_predicate}{+Head, \ldots} Define the predicates referenced by the comma-separated list \arg{Head} as \jargon{meta-predicates}. Each argument of each head is a \jargon{meta argument specifier}. Defined specifiers are given below. Only 0..9, \chr{\Smodule}, \chr{\Shat} and \const{\Sidiv} are interpreted; the mode declarations \chr{\Splus}, \chr{\Sminus}, \chr{\Stimes} and \chr{\Squest} are ignored. \begin{description} \termitem{0..9}{} The argument is a term that is used to reference a predicate with $N$ more arguments than the given argument term. For example: \exam{call(0)} or \exam{maplist(1, +)}. \termitem{\Smodule}{} The argument is module-sensitive, but does not directly refer to a predicate. For example: \exam{consult(:)}. \termitem{\Shat}{} This extension is used to denote the possibly \verb$^$-annotated goal of \index{setof/3}\predref{setof}{3}, \index{bagof/3}\predref{bagof}{3}, \index{aggregate/3}\predref{aggregate}{3} and \index{aggregate/4}\predref{aggregate}{4}. It is processed similar to `0', but leaving the \chr{\Shat}/2 intact. \termitem{\Sidiv}{} The argument is a DCG body. See \index{phrase/3}\predref{phrase}{3}. \termitem{\Sminus}{} \termitem{\Squest}{} \termitem{\Stimes}{} \termitem{\Splus}{} All these have the same semantics, declaring the argument to be not module sensitive. The \chr{\Stimes} notation is an alias for \chr{\Squest} for compatibility with e.g., Logtalk. The specific mode has merely documentation value. See \secref{argmode} for details. \end{description} Each argument that is module-sensitive (i.e., marked 0..9, \chr{\Smodule} or \chr{\Shat}) is qualified with the context module of the caller if it is not already qualified. The implementation ensures that the argument is passed as \bnfmeta{module}:\bnfmeta{term}, where \bnfmeta{module} is an atom denoting the name of a module and \bnfmeta{term} itself is not a \functor{\Smodule}{2} term where the first argument is an atom. Below is a simple declaration and a number of queries. \begin{code} :- meta_predicate meta(0, +). meta(Module:Term, _Arg) :- format('Module=~w, Term = ~q~n', [Module, Term]). \end{code} \noindent \begin{code} ?- meta(test, x). Module=user, Term = test ?- meta(m1:test, x). Module=m1, Term = test ?- m2:meta(test, x). Module=m2, Term = test ?- m1:meta(m2:test, x). Module=m2, Term = test ?- meta(m1:m2:test, x). Module=m2, Term = test ?- meta(m1:42:test, x). Module=42, Term = test \end{code} \noindent The \index{meta_predicate/1}\predref{meta_predicate}{1} declaration is the portable mechanism for defining meta-predicates and replaces the old SWI-Prolog specific mechanism provided by the deprecated predicates \index{module_transparent/1}\predref{module_transparent}{1}, \index{context_module/1}\predref{context_module}{1} and \index{strip_module/3}\predref{strip_module}{3}. See also \secref{modulecompat}. \end{description} \section{Overruling Module Boundaries} \label{sec:overrule} The module system described so far is sufficient to distribute programs over multiple modules. There are, however, cases in which we would like to be able to overrule this schema and explicitly call a predicate in some module or assert explicitly into some module. Calling in a particular module is useful for debugging from the user's top level or to access multiple implementations of the same interface that reside in multiple modules. Accessing the same interface from multiple modules cannot be achieved using importing because importing a predicate with the same name and arity from two modules results in a name conflict. Asserting in a different module can be used to create models dynamically in a new module. See \secref{dynamic-modules}. Direct addressing of modules is achieved using a \functor{\Smodule}{2} explicitly in a program and relies on the module qualification mechanism described in \secref{metapred}. Here are a few examples: \begin{code} ?- assert(world:done). % asserts done/0 into module world ?- world:asserta(done). % the same ?- world:done. % calls done/0 in module world \end{code} \noindent Note that the second example is the same due to the Prolog flag \prologflag{colon_sets_calling_context}. The system predicate \index{asserta/1}\predref{asserta}{1} is called in the module \const{world}, which is possible because system predicates are \jargon{visible} in all modules. At the same time, the \jargon{calling context} is set to \const{world}. Because meta arguments are qualified with the calling context, the resulting call is the same as the first example. \subsection{Explicit manipulation of the calling context} \label{sec:set-calling-context} Quintus' derived module systems have no means to separate the lookup module (for finding predicates) from the calling context (for qualifying meta arguments). Some other Prolog implementations (e.g., ECLiPSe and IF/Prolog) distinguish these operations, using \functor{@}{2} for setting the calling context of a goal. This is provided by SWI-Prolog, currently mainly to support compatibility layers. \begin{description} \predicate{@}{2}{:Goal, +Module} Execute \arg{Goal}, setting the calling context to \arg{Module}. Setting the calling context affects meta-predicates, for which meta arguments are qualified with \arg{Module} and transparent predicates (see \index{module_transparent/1}\predref{module_transparent}{1}). It has no implications for other predicates. For example, the code \exam{asserta(done)@world} is the same as \exam{asserta(world:done)}. Unlike in \exam{world:asserta(done)}, \index{asserta/1}\predref{asserta}{1} is resolved in the current module rather than the module \const{world}. This makes no difference for system predicates, but usually does make a difference for user predicates. Not that SWI-Prolog does not define \chr{@} as an operator. Some systems define this construct using \exam{op(900, xfx, @)}. \end{description} \section{Interacting with modules from the top level} \label{sec:mtoplevel} Debugging often requires interaction with predicates that reside in modules: running them, setting spy points on them, etc. This can be achieved using the \bnfmeta{module}:\bnfmeta{term} construct explicitly as described above. In SWI-Prolog, you may also wish to omit the module qualification. Setting a spy point (\index{spy/1}\predref{spy}{1}) on a plain predicate sets a spy point on any predicate with that name in any module. Editing (\index{edit/1}\predref{edit}{1}) or calling an unqualified predicate invokes the DWIM (Do What I Mean) mechanism, which generally suggests the correct qualified query. Mainly for compatibility, we provide \index{module/1}\predref{module}{1} to switch the module with which the interactive top level interacts: \begin{description} \predicate{module}{1}{+Module} The call \exam{module(\arg{Module})} may be used to switch the default working module for the interactive top level (see \index{prolog/0}\predref{prolog}{0}). This may be used when debugging a module. The example below lists the clauses of \index{file_of_label/2}\predref{file_of_label}{2} in the module \const{tex}. \begin{code} 1 ?- module(tex). true. tex: 2 ?- listing(file_of_label/2). ... \end{code} \noindent \end{description} \section{Composing modules from other modules} \label{sec:reexport} The predicates in this section are intended to create new modules from the content of other modules. Below is an example to define a \emph{composite} module. The example exports all public predicates of \const{module_1}, \const{module_2} and \const{module_3}, \index{pred/1}\predref{pred}{1} from \const{module_4}, all predicates from \const{module_5} except \index{do_not_use/1}\predref{do_not_use}{1} and all predicates from \const{module_6} while renaming \index{pred/1}\predref{pred}{1} into \index{mypred/1}\predref{mypred}{1}. \begin{code} :- module(my_composite, []). :- reexport([ module_1, module_2, module_3 ]). :- reexport(module_4, [ pred/1 ]). :- reexport(module_5, except([do_not_use/1])). :- reexport(module_6, except([pred/1 as mypred])). \end{code} \noindent \begin{description} \predicate{reexport}{1}{+Files} Load and import predicates as \index{use_module/1}\predref{use_module}{1} and re-export all imported predicates. The reexport declarations must immediately follow the module declaration. \predicate{reexport}{2}{+File, +Import} Import from \arg{File} as \index{use_module/2}\predref{use_module}{2} and re-export the imported predicates. The reexport declarations must immediately follow the module declaration. \end{description} \section{Operators and modules} \label{sec:moduleop} Operators (\secref{operators}) are local to modules, where the initial table behaves as if it is copied from the module \const{user} (see \secref{resmodules}). A specific operator can be disabled inside a module using \exam{:- op(0, Type, Name)}. Inheritance from the public table can be restored using \exam{:- op(-1, Type, Name)}. In addition to using the \index{op/3}\predref{op}{3} directive, operators can be declared in the \index{module/2}\predref{module}{2} directive as shown below. Such operator declarations are visible inside the module, and importing such a module makes the operators visible in the target module. Exporting operators is typically used by modules that implement sub-languages such as chr (see \chapref{chr}). The example below is copied from the library \pllib{clpfd}. \begin{code} :- module(clpfd, [ op(760, yfx, #<==>), op(750, xfy, #==>), op(750, yfx, #<==), op(740, yfx, #\/), ... (#<==>)/2, (#==>)/2, (#<==)/2, (#\/)/2, ... ]). \end{code} \noindent \section{Dynamic importing using import modules} \label{sec:importmodule} Until now we discussed the public module interface that is, at least to some extent, portable between Prolog implementations with a module system that is derived from Quintus Prolog. The remainder of this chapter describes the underlying mechanisms that can be used to emulate other module systems or implement other code-reuse mechanisms. In addition to built-in predicates, imported predicates and locally defined predicates, SWI-Prolog modules can also call predicates from its \jargon{import modules}. Each module has a (possibly empty) list of import modules. In the default setup, each new module has a single import module, which is \const{user} for all normal user modules and \const{system} for all system library modules. Module \const{user} imports from \const{system} where all built-in predicates reside. These special modules are described in more detail in \secref{resmodules}. In general, the import relations between modules form an acyclic directed graph. The import relation affects the following mechanisms: \begin{description} \item [Predicate visibility] When looking for a specific predicate definition the system starts in the target module. If the predicate is undefined there it walks the module import relations depth-first left-to-right searching for a module that defines the predicate. The first encountered definition is used. Note that using the default setup this means it searches the \const{user} and \const{system} modules (in that order). \item [Operators] Operators are also searched through the import relations. System operators are defined in the module \const{system}. The user may define operators in \const{user} to make them globally visible for compatibility with e.g., SICStus Prolog that has no local operators. Normally operators are defined in a module and, when applicable, exported using the \index{module/2}\predref{module}{2} module header. \item [The \prologflag{unknown} flag] This flag controls the response to encountering an undefined predicate in the target module. \item [Term and goal expansion] The hooks \index{term_expansion/2}\predref{term_expansion}{2} and \index{goal_expansion/2}\predref{goal_expansion}{2} (see \secref{progtransform}) are \jargon{chained} over the import modules that define these hooks. This implies we collect all modules that provide definitions for these hook predicates by traversing the import module relation depth-first and left-to-right. Next, we perform the transformations in a \jargon{pipeline}, starting at the target module. \end{description} The list of import modules for a specific module can be manipulated and queried using the following predicates, as well as using \index{set_module/1}\predref{set_module}{1}. \begin{description} \predicate[nondet]{import_module}{2}{+Module, -Import} True if \arg{Module} inherits directly from \arg{Import}. All normal modules only import from \const{user}, which imports from \const{system}. The predicates \index{add_import_module/3}\predref{add_import_module}{3} and \index{delete_import_module/2}\predref{delete_import_module}{2} can be used to manipulate the import list. See also \index{default_module/2}\predref{default_module}{2}. \predicate[multi]{default_module}{2}{+Module, -Default} True if predicates and operators in \arg{Default} are visible in \arg{Module}. Modules are returned in the same search order used for predicates and operators. That is, \arg{Default} is first unified with \arg{Module}, followed by the depth-first transitive closure of \index{import_module/2}\predref{import_module}{2}. \predicate{add_import_module}{3}{+Module, +Import, +StartOrEnd} If \arg{Import} is not already an import module for \arg{Module}, add it to this list at the \const{start} or \const{end} depending on \arg{StartOrEnd}. See also \index{import_module/2}\predref{import_module}{2} and \index{delete_import_module/2}\predref{delete_import_module}{2}. \predicate{delete_import_module}{2}{+Module, +Import} Delete \arg{Import} from the list of import modules for \arg{Module}. Fails silently if \arg{Import} is not in the list. \end{description} \section{Reserved Modules and using the `user' module} \label{sec:resmodules} As mentioned above, SWI-Prolog contains two special modules. The first one is the module \const{system}. This module contains all built-in predicates. Module \const{system} has no import module, i.e., is a \jargon{root} of the module graph. The second special module is the module \const{user}. This module forms the initial working space of the user. Initially it is empty.\footnote{Unfortunately some \jargon{hooks} are traditionally defined in the user module}. The import module of module \const{user} is \const{system}, making all built-in predicates available. All normal application modules import from the module \const{user}. This implies they can use all predicates imported into \const{user} without explicitly importing them. If an application loads all modules from the \const{user} module using \index{use_module/1}\predref{use_module}{1}, one achieves a scoping system similar to the C-language, where every module can access all exported predicates without any special precautions. All \jargon{library} modules (see \index{module_property/2}\predref{module_property}{2}) import directly from \const{system}. Library modules are modules loaded from the SWI-Prolog installation. As they import from \const{system}, the functionality of a library is not affected by operator or predicate definitions in the \const{user} module. \section{An alternative import/export interface} \label{sec:altmoduleapi} The \index{use_module/1}\predref{use_module}{1} predicate from \secref{import} defines import and export relations based on the filename from which a module is loaded. If modules are created differently, such as by asserting predicates into a new module as described in \secref{dynamic-modules}, this interface cannot be used. The interface below provides for import/export from modules that are not created using a module file. \begin{description} \predicate{export}{1}{+PredicateIndicator, \ldots} Add predicates to the public list of the context module. This implies the predicate will be imported into another module if this module is imported with \index{use_module/[1,2]}\predref{use_module}{[1,2]}. Note that predicates are normally exported using the directive \index{module/2}\predref{module}{2}. \index{export/1}\predref{export}{1} is meant to handle export from dynamically created modules. \predicate{import}{1}{+PredicateIndicator, \ldots} Import predicates \arg{PredicateIndicator} into the current context module. \arg{PredicateIndicator} must specify the source module using the \mbox{\bnfmeta{module}:\bnfmeta{pi}} construct. Note that predicates are normally imported using one of the directives \index{use_module/[1,2]}\predref{use_module}{[1,2]}. The \index{import/1}\predref{import}{1} alternative is meant for handling imports into dynamically created modules. See also \index{export/1}\predref{export}{1} and \index{export_list/2}\predref{export_list}{2}. \end{description} \section{Dynamic Modules} \label{sec:dynamic-modules} So far, we discussed modules that were created by loading a module file. These modules have been introduced to facilitate the development of large applications. The modules are fully defined at load-time of the application and normally will not change during execution. Having the notion of a set of predicates as a self-contained world can be attractive for other purposes as well. For example, assume an application that can reason about multiple worlds. It is attractive to store the data of a particular world in a module, so we extract information from a world simply by invoking goals in this world. Dynamic modules can easily be created. Any built-in predicate that tries to locate a predicate in a specific module will create this module as a side-effect if it did not yet exist. For example: \begin{code} ?- assert(world_a:consistent), set_prolog_flag(world_a:unknown, fail). \end{code} \noindent These calls create a module called `world_a' and make the call `world_a:consistent' succeed. Undefined predicates will not raise an exception for this module (see \prologflag{unknown}). Import and export from a dynamically created world can be achieved using \index{import/1}\predref{import}{1} and \index{export/1}\predref{export}{1} or by specifying the import module as described in \secref{importmodule}. \begin{code} ?- world_b:export(solve/2). % exports solve/2 from world_b ?- world_c:import(world_b:solve/2). % and import it to world_c \end{code} \noindent \section{Transparent predicates: definition and context module} \label{sec:ctxmodule} \textit{The `module-transparent' mechanism is still underlying the actual implementation. Direct usage by programmers is deprecated. Please use \index{meta_predicate/1}\predref{meta_predicate}{1} to deal with meta-predicates.} The qualification of module-sensitive arguments described in \secref{metapred} is realised using \jargon{transparent} predicates. It is now deprecated to use this mechanism directly. However, studying the underlying mechanism helps to understand SWI-Prolog's modules. In some respect, the transparent mechanism is more powerful than meta-predicate declarations. Each predicate of the program is assigned a module, called its \jargon{definition module}. The definition module of a predicate is always the module in which the predicate was originally defined. Each active goal in the Prolog system has a \jargon{context module} assigned to it. The context module is used to find predicates for a Prolog term. By default, the context module is the definition module of the predicate running the goal. For transparent predicates, however, this is the context module of the goal inherited from the parent goal. Below, we implement \index{maplist/3}\predref{maplist}{3} using the transparent mechanism. The code of \index{maplist/3}\predref{maplist}{3} and \nopredref{maplist_}{3} is the same as in \secref{metapred}, but now we must declare both the main predicate and the helper as transparent to avoid changing the context module when calling the helper. \begin{code} :- module(maplist, maplist/3). :- module_transparent maplist/3, maplist_/3. maplist(Goal, L1, L2) :- maplist_(L1, L2, G). maplist_([], [], _). maplist_([H0|T0], [H|T], Goal) :- call(Goal, H0, H), maplist_(T0, T, Goal). \end{code} \noindent Note that \emph{any} call that translates terms into predicates is subject to the transparent mechanism, not just the terms passed to module-sensitive arguments. For example, the module below counts the number of unique atoms returned as bindings for a variable. It works as expected. If we use the directive \exam{:- module_transparent \index{count_atom_results/3}\predref{count_atom_results}{3}.} instead, \index{atom_result/2}\predref{atom_result}{2} is called wrongly in the module \emph{calling} \nopredref{count_atom_results}{3}. This can be solved using \index{strip_module/3}\predref{strip_module}{3} to create a qualified goal and a non-transparent helper predicate that is defined in the same module. \begin{code} :- module(count_atom_results, [ count_atom_results/3 ]). :- meta_predicate count_atom_results(-,0,-). count_atom_results(A, Goal, Count) :- setof(A, atom_result(A, Goal), As), !, length(As, Count). count_atom_results(_, _, 0). atom_result(Var, Goal) :- call(Goal), atom(Var). \end{code} \noindent The following predicates support the module-transparent interface: \begin{description} \directive{module_transparent}{1}{+Preds} \arg{Preds} is a comma-separated list of name/arity pairs (like \index{dynamic/1}\predref{dynamic}{1}). Each goal associated with a transparent-declared predicate will inherit the \jargon{context module} from its parent goal. \predicate{context_module}{1}{-Module} Unify \arg{Module} with the context module of the current goal. \index{context_module/1}\predref{context_module}{1} itself is, of course, transparent. \predicate{strip_module}{3}{+Term, -Module, -Plain} Used in module-transparent predicates or meta-predicates to extract the referenced module and plain term. If \arg{Term} is a module-qualified term, i.e.\ of the format \arg{Module}:\arg{Plain}, \arg{Module} and \arg{Plain} are unified to these values. Otherwise, \arg{Plain} is unified to \arg{Term} and \arg{Module} to the context module. \end{description} \section{Module properties} \label{sec:manipmodule} The following predicates can be used to query the module system for reflexive programming: \begin{description} \predicate[nondet]{current_module}{1}{?Module} True if \arg{Module} is a currently defined module. This predicate enumerates all modules, whether loaded from a file or created dynamically. Note that modules cannot be destroyed in the current version of SWI-Prolog. \predicate{module_property}{2}{?Module, ?Property} True if \arg{Property} is a property of \arg{Module}. Defined properties are: \begin{description} \termitem{class}{-Class} True when \arg{Class} is the class of the module. Defined classes are \begin{description} \termitem{user}{} Default for user-defined modules. \termitem{system}{} Module \const{system} and modules from \metafile{\bnfmeta{home}/boot}. \termitem{library}{} Other modules from the system directories. \termitem{temporary}{} Module is temporary. \termitem{test}{} Modules that create tests. \termitem{development}{} Modules that only support the development environment. \end{description} \termitem{file}{?File} True if \arg{Module} was loaded from \arg{File}. \termitem{line_count}{-Line} True if \arg{Module} was loaded from the N-th line of file. \termitem{exports}{-ListOfPredicateIndicators} True if \arg{Module} exports the given predicates. Predicate indicators are in canonical form (i.e., always using name/arity and never the DCG form name//arity). Future versions may also use the DCG form. See also \index{predicate_property/2}\predref{predicate_property}{2}. Succeeds with an empty list if the module exports no predicates. \termitem{exported_operators}{-ListOfOperators} True if \arg{Module} exports the given operators. Each exported operator is represented as a term \term{op}{Pri,Assoc,Name}. Succeeds with an empty list if the module exports no operators. \termitem{size}{-Bytes} Total size in bytes used to represent the module. This includes the module itself, its (hash) tables and the summed size of all predicates defined in this module. See also the \term{size}{Bytes} property in \index{predicate_property/2}\predref{predicate_property}{2}. \termitem{program_size}{-Bytes} Memory (in bytes) used for storing the predicates of this module. This figure includes the predicate header and clauses. \termitem{program_space}{-Bytes} If present, this number limits the \const{program_size}. See \index{set_module/1}\predref{set_module}{1}. \termitem{last_modified_generation}{-Generation} Integer expression the last database generation where a clause was added or removed from a predicate that is implemented in this module. See also \index{predicate_property/2}\predref{predicate_property}{2}. \end{description} \predicate{set_module}{1}{:Property} Modify properties of the module. Currently, the following properties may be modified: \begin{description} \termitem{base}{+Base} Set the default import module of the current module to \arg{Module}. Typically, \arg{Module} is one of \const{user} or \const{system}. See \secref{importmodule}. \termitem{class}{+Class} Set the class of the module. See \index{module_property/2}\predref{module_property}{2}. \termitem{program_space}{+Bytes} Maximum amount of memory used to store the predicates defined inside the module. Raises a permission error if the current usage is above the requested limit. Setting the limit to 0 (zero) removes the limit. An attempt to assert clauses that causes the limit to be exceeded causes a \term{resource_error}{program_space} exception. See \index{assertz/1}\predref{assertz}{1} and \index{module_property/2}\predref{module_property}{2}. \end{description} \end{description} \section{Compatibility of the Module System} \label{sec:modulecompat} The SWI-Prolog module system is largely derived from the Quintus Prolog module system, which is also adopted by SICStus, Ciao and YAP. Originally, the mechanism for defining meta-predicates in SWI-Prolog was based on the \index{module_transparent/1}\predref{module_transparent}{1} directive and \index{strip_module/3}\predref{strip_module}{3}. Since 5.7.4 it supports the de-facto standard \index{meta_predicate/1}\predref{meta_predicate}{1} directive for implementing meta-predicates, providing much better compatibility. The support for the \index{meta_predicate/1}\predref{meta_predicate}{1} mechanism, however, is considerably different. On most systems, the \emph{caller} of a meta-predicate is compiled differently to provide the required \bnfmeta{module}:\bnfmeta{term} qualification. This implies that the meta-declaration must be available to the compiler when compiling code that calls a meta-predicate. In practice, this implies that other systems pose the following restrictions on meta-predicates: \begin{itemize} \item Modules that provide meta-predicates for a module to be compiled must be loaded explicitly by that module. \item The meta-predicate directives of exported predicates must follow the \index{module/2}\predref{module}{2} directive immediately. \item After changing a meta-declaration, all modules that \emph{call} the modified predicates need to be recompiled. \end{itemize} In SWI-Prolog, meta-predicates are also \jargon{module-transparent}, and qualifying the module-sensitive arguments is done inside the meta-predicate. As a result, the caller need not be aware that it is calling a meta-predicate and none of the above restrictions hold for SWI-Prolog. However, code that aims at portability must obey the above rules. Other differences are listed below. \begin{itemize} \item If a module does not define a predicate, it is searched for in the \jargon{import modules}. By default, the import module of any user-defined module is the \const{user} module. In turn, the \const{user} module imports from the module \const{system} that provides all built-in predicates. The auto-import hierarchy can be changed using \index{add_import_module/3}\predref{add_import_module}{3} and \index{delete_import_module/2}\predref{delete_import_module}{2}. This mechanism can be used to realise a simple object-oriented system or a hierarchical module system. \item Operator declarations are local to a module and may be exported. In Quintus and SICStus all operators are global. YAP and Ciao also use local operators. SWI-Prolog provides global operator declarations from within a module by explicitly qualifying the operator name with the \const{user} module. I.e., operators are inherited from the \jargon{import modules} (see above). \begin{code} :- op(precedence, type, user:(operatorname)). \end{code} \noindent \end{itemize}