2001-04-09 20:54:03 +01:00
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: modules.pl *
* Last rev: *
* mods: *
* comments: module support *
* *
*************************************************************************/
2014-04-09 12:39:29 +01:00
2014-07-17 18:19:38 +01:00
/**
2014-07-27 01:14:15 +01:00
\defgroup YAPModules The YAP Module system
2014-07-17 18:19:38 +01:00
2014-09-11 20:06:57 +01:00
@ingroup YAPLoading
2014-07-17 18:19:38 +01:00
The YAP module system is based on the Quintus/SISCtus module
system. In this design, modules are named collections of predicates,
and all predicates belong to a single module. Predicates are only
visible within a module, or _private_ to that module, but the module
will most often will also define a list of predicates that are
_exported_, that is, visible to other modules.
The main predicates in the module system are:
* module/2 associates a source file to a module. It has two arguments: the name of the new module, and a list of predicates exported by the module.
2014-07-27 01:14:15 +01:00
* use_module/1 and use_module/2 can be used to load a module. They take as first argument the source file for the module. Whereas use_module/1 loads all exported predicates, use_module/2 only takes the ones given by the second argument.
2014-07-17 18:19:38 +01:00
YAP pre-defines a number of modules. Most system predicates belong to
the module `prolog`. Predicates from the module `prolog` are
automatically visible to every module. The `system` module was
introduced for SWI-Prolog compatibility, and in YAP mostly acts as an
alias to `prolog`.
YAP is always associated to a module, the current <em>source
module</em> or <em>type-in module</em>. By default, all predicates
read-in and all calls to a goal will be made to predicates visible to
the current source module, Initially, the source module for YAP is the
module `user`. Thus Prolog programs that do not define modules will
operate within the `user` module. In this case, all predicates will be
visible to all source files.
YAP also includes a number of libraries and packages, most of them
defining their own modules. Note that there is no system mechanism to
avoid clashes between module names, so it is up to the programmer to
carefully choose the names for her own program modules.
The main mechanism to change the current type-in module is by using
the module/2 declaration.This declaration sets the source module when
it starts consulting a file, and resets it at the end. One can set
the type-in module permanently by using the built-in `module/1`.
\subsection Explicit Naming
The module system allows one to _explicitly_ specify the source mode for
a clause by prefixing a clause with its module, say:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
user:(a :- b).
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
it is also possible to type
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
user:a :- user:b.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
both formulations describe the same clause, independently of the
current type-in module.
In fact, it is sufficient to specify the source mode for the clause's
head:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
user:a :- b.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if the current type-in module is `m`, the clause could also be written as:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
user:a :- m:b.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The compiler rewrites the source clauses to ensure that explicit calls
are respected, and that implicit calls are made to the current source
module.
A goal should refer to a predicate visible within the current type-in
module. Thus, if a goal appears in a text file with a module
declaration, the goal refers to that module's context (but see the
initialization/1 directive for more details).
Again, one can override this rule by prefixing a goal with a module to
be consulted. The following query:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
?- nasa:launch(apollo,13).
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
invokes the goal `launch(apollo,13)` as if the current source
module was `nasa`.
YAP and other Prolog systems allow the module prefix to see all
predicates visible in the module, including predicates private to the
module. This rule allows maximum flexibility, but it also breaks
encapsulation and should be used with care. The ciao language proposes
a different approach to this problem, see \cite .
Modules are not always associated with a source-file. They
may range over several files, by using the
`include`directive. Moreover, they may not be associated to any source
file. As an example,
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
?- assert( nasa:launch(apollo,13) ).
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
will create a module `nasa`, if does not already exist. In fact it is
sufficient to call a predicate from a module to implicitly create the
module. Hence after this call:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
?- nasa:launch(apollo,13).
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
there will be a `nasa`module in the system, even if nasa:launch/2 is
not at all defined.
\{
**/
2014-04-09 12:39:29 +01:00
:- system_module( '$_modules', [abolish_module/1,
add_import_module/3,
current_module/1,
current_module/2,
delete_import_module/2,
expand_goal/2,
export/1,
export_list/2,
export_resource/1,
import_module/2,
ls_imports/0,
module/1,
module_property/2,
set_base_module/1,
source_module/1,
use_module/1,
2014-07-27 01:43:16 +01:00
use_module/2,
use_module/3], ['$add_to_imports'/3,
2014-04-09 12:39:29 +01:00
'$clean_cuts'/2,
'$convert_for_export'/7,
'$do_import'/3,
'$extend_exports'/3,
'$get_undefined_pred'/4,
'$imported_pred'/4,
'$meta_expansion'/6,
'$meta_predicate'/2,
'$meta_predicate'/4,
'$module'/3,
'$module'/4,
2014-10-05 23:53:05 +01:00
'$module_expansion'/6,
2014-04-09 12:39:29 +01:00
'$module_transparent'/2,
'$module_transparent'/4]).
:- use_system_module( '$_arith', ['$c_built_in'/3]).
:- use_system_module( '$_consult', ['$lf_opt'/3,
'$load_files'/3]).
:- use_system_module( '$_debug', ['$skipeol'/1]).
:- use_system_module( '$_errors', ['$do_error'/2]).
:- use_system_module( '$_eval', ['$full_clause_optimisation'/4]).
2001-04-09 20:54:03 +01:00
2014-04-06 17:05:17 +01:00
:- '$purge_clauses'(module(_,_), prolog).
:- '$purge_clauses'('$module'(_,_), prolog).
:- '$purge_clauses'(use_module(_), prolog).
:- '$purge_clauses'(use_module(_,_), prolog).
%
% start using default definition of module.
%
2014-07-17 18:19:38 +01:00
/**
\pred use_module( +Files ) is directive
loads a module file
This predicate loads the file specified by _Files_, importing all
their public predicates into the current type-in module. It is
implemented as if by:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
2014-04-06 17:05:17 +01:00
use_module(F) :-
2014-07-17 18:19:38 +01:00
load_files(F, [if(not_loaded),must_be_module(true)]).
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Notice that _Files_ may be a single file, or a list with a number
files. The _Files_ are loaded in YAP only once, even if they have been
updated meanwhile. YAP should also verify whether the files actually
define modules. Please consult load_files/3 for other options when
loading a file.
Predicate name clashes between two different modules may arise, either
when trying to import predicates that are also defined in the current
type-in module, or by trying to import the same predicate from two
different modules.
In the first case, the local predicate is considered to have priority
and use_module/1 simply gives a warning. As an example, if the file
`a.pl` contains:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
:- module( a, [a/1] ).
:- use_module(b).
a(1).
2014-07-27 01:14:15 +01:00
a(X) :- b(X).
2014-07-17 18:19:38 +01:00
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
and the file `b.pl` contains:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
:- module( b, [a/1,b/1] ).
a(2).
b(1).
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
YAP will execute as follows:
2014-07-27 01:14:15 +01:00
2014-07-17 18:19:38 +01:00
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
2014-07-27 01:14:15 +01:00
?- [a].
% consulting .../a.pl...
% consulting .../b.pl...
% consulted .../b.pl in module b, 0 msec 0 bytes
% consulted .../a.pl in module a, 1 msec 0 bytes
2014-07-17 18:19:38 +01:00
true.
?- a(X).
2014-07-27 01:14:15 +01:00
X = 1 ? ;
2014-07-17 18:19:38 +01:00
X = 1.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The example shows that the query `a(X)`has a single answer, the one
defined in `a.pl`. Calls to `a(X)`succeed in the top-level, because
the module `a` was loaded into `user`. On the other hand, `b(X)`is not
exported by `a.pl`, and is not available to calls, although it can be
accessed as a predicate in the module 'a' by using the `:` operator.
Next, consider the three files `c.pl`, `d1.pl`, and `d2.pl`:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
% c.pl
:- module( c, [a/1] ).
:- use_module([d1, d2]).
a(X) :-
b(X).
a(X) :-
c(X).
a(X) :-
d(X).
% d1.pl
:- module( d1, [b/1,c/1] ).
b(2).
c(3).
% d2.pl
:- module( d2, [b/1,d/1] ).
b(1).
d(4).
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The result is as follows:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
./yap -l c
YAP 6.3.4 (x86_64-darwin13.3.0): Tue Jul 15 10:42:11 CDT 2014
ERROR!!
2014-07-27 01:14:15 +01:00
at line 3 in o/d2.pl,
PERMISSION ERROR- loading .../c.pl: modules d1 and d2 both define b/1
2014-07-17 18:19:38 +01:00
?- a(X).
X = 2 ? ;
ERROR!!
EXISTENCE ERROR- procedure c/1 is undefined, called from context prolog:$user_call/2
Goal was c:c(_131290)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2014-07-27 01:14:15 +01:00
The state of the module system after this error is undefined.
2014-07-17 18:19:38 +01:00
**/
2014-07-27 01:14:15 +01:00
2014-07-17 18:19:38 +01:00
use_module(F) :- '$load_files'(F,
2014-07-27 01:14:15 +01:00
[if(not_loaded),must_be_module(true)], use_module(F)).
2014-07-17 18:19:38 +01:00
2014-04-06 17:05:17 +01:00
2014-07-17 18:19:38 +01:00
/**
\pred use_module(+Files, +Imports)
loads a module file but only imports the named predicates
2014-07-27 01:43:16 +01:00
2014-07-17 18:19:38 +01:00
This predicate loads the file specified by _Files_, importing their
public predicates specified by _Imports_ into the current type-in
module. It is implemented as if by:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
use_module(Files, Imports) :-
load_files(Files, [if(not_loaded),must_be_module(true),imports(Imports)]).
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The _Imports_ argument may be use to specify which predicates one
wants to load. It can also be used to give the predicates a different name. As an example,
the graphs library is implemented on top of the red-black trees library, and some predicates are just aliases:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
:- use_module(library(rbtrees), [
rb_min/3 as min_assoc,
rb_max/3 as max_assoc,
2014-07-27 01:14:15 +01:00
2014-07-17 18:19:38 +01:00
...]).
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Unfortunately it is still not possible to change argument order.
**/
2014-04-06 17:05:17 +01:00
use_module(F,Is) :-
'$load_files'(F, [if(not_loaded),must_be_module(true),imports(Is)], use_module(F,Is)).
2014-07-17 18:19:38 +01:00
/**
\pred module(+M) is det
set the type-in module
Defines _M_ to be the current working or type-in module. All files
which are not bound to a module are assumed to belong to the working
module (also referred to as type-in module). To compile a non-module
file into a module which is not the working one, prefix the file name
with the module name, in the form ` _Module_: _File_`, when
loading the file.
**/
module(N) :-
var(N),
'$do_error'(instantiation_error,module(N)).
module(N) :-
atom(N), !,
% set it as current module.
'$current_module'(_,N).
module(N) :-
'$do_error'(type_error(atom,N),module(N)).
/**
\pred module(+ Module:atom, +ExportList:list) is directive
define a new module
This directive defines the file where it appears as a _module file_;
it must be the first declaration in the file. _Module_ must be an
atom specifying the module name; _ExportList_ must be a list
containing the module's public predicates specification, in the form
2014-07-27 01:14:15 +01:00
`[predicate_name/arity,...]`. The _ExportList_ can include
2014-07-17 18:19:38 +01:00
operator declarations for operators that are exported by the module.
2014-07-27 01:14:15 +01:00
The public predicates of a module file can be made accessible to other
files through loading the source file, using the directives
2014-07-17 18:19:38 +01:00
use_module/1 or use_module/2,
ensure_loaded/1 and the predicates
consult/1 or reconsult/1. The
non-public predicates of a module file are not supposed to be visible
to other modules; they can, however, be accessed by prefixing the module
name with the `:/2` operator.
**/
'$module_dec'(N, Ps) :-
source_location(F, _),
2014-09-22 18:13:35 +01:00
b_getval( '$source_file', F0 ),
'$add_module_on_file'(N, F, F0, Ps),
2014-07-17 18:19:38 +01:00
'$current_module'(_,N).
2004-02-13 13:31:44 +00:00
'$module'(_,N,P) :-
2001-04-09 20:54:03 +01:00
'$module_dec'(N,P).
2014-07-17 18:19:38 +01:00
/**
2014-07-27 01:14:15 +01:00
\pred module(+ M:atom,+ L:list ) is directive
the current file defines module _M_ with exports _L_. The list may include
2014-09-22 18:13:35 +01:00
+ predicate indicators
2014-07-27 01:14:15 +01:00
+ operator definitions that look like calls to op/3.
The list _L_ may include predicates imported from other modules. If
you want to fully reexport a module, or a sub-set, also consider reexport/1.
2014-07-17 18:19:38 +01:00
Similar to module/2, this directive defines the file where it
appears in as a module file; it must be the first declaration in the file.
_M_ must be an atom specifying the module name; _L_ must be a
list containing the module's public predicates specification, in the
form `[predicate_name/arity,...]`.
The last argument _Options_ must be a list of options, which can be:
+ <b>filename</b>
the filename for a module to import into the current module.
+ <b>library( +File )</b>
a library file to import into the current module.
+ <b>hide( +Opt)</b>
if _Opt_ is `false`, keep source code for current module, if `true`, disable.
+ <b>export(+PredicateIndicator )</b>
Add predicates to the public list of the context module. This implies
2014-07-27 01:14:15 +01:00
the predicate will be imported into another module if this module
is imported with use_module/1 and use_module/2.
2014-07-17 18:19:38 +01:00
+ <b>export_list(? _Mod_,? _ListOfPredicateIndicator_)</b>
The list _ListOfPredicateIndicator_ contains all predicates
2014-07-27 01:14:15 +01:00
exported by module _Mod_
2014-07-17 18:19:38 +01:00
Note that predicates are normally exported using the directive
`module/2`. The `export/1` argumwnt is meant to allow export from
dynamically created modules. The directive argument may also be a list
of predicates.
**/
2001-04-19 18:12:18 +01:00
'$module'(O,N,P,Opts) :- !,
'$module'(O,N,P),
'$process_module_decls_options'(Opts,module(Opts,N,P)).
'$process_module_decls_options'(Var,Mod) :-
2005-07-06 16:51:01 +01:00
var(Var), !,
2002-09-09 18:40:12 +01:00
'$do_error'(instantiation_error,Mod).
2005-07-06 16:51:01 +01:00
'$process_module_decls_options'([],_) :- !.
'$process_module_decls_options'([H|L],M) :- !,
2001-04-19 18:12:18 +01:00
'$process_module_decls_option'(H,M),
'$process_module_decls_options'(L,M).
'$process_module_decls_options'(T,M) :-
2002-09-09 18:40:12 +01:00
'$do_error'(type_error(list,T),M).
2001-04-19 18:12:18 +01:00
'$process_module_decls_option'(Var,M) :-
var(Var),
2002-09-09 18:40:12 +01:00
'$do_error'(instantiation_error,M).
2014-08-20 15:09:20 +01:00
'$process_module_decls_option'(At,M) :-
2005-07-06 16:51:01 +01:00
atom(At), !,
2014-08-20 15:09:20 +01:00
use_module(M:At).
'$process_module_decls_option'(library(L),M) :- !,
use_module(M:library(L)).
2005-07-06 16:51:01 +01:00
'$process_module_decls_option'(hidden(Bool),M) :- !,
2001-04-19 18:12:18 +01:00
'$process_hidden_module'(Bool, M).
'$process_module_decls_option'(Opt,M) :-
2002-09-09 18:40:12 +01:00
'$do_error'(domain_error(module_decl_options,Opt),M).
2001-04-19 18:12:18 +01:00
'$process_hidden_module'(TNew,M) :-
'$convert_true_off_mod3'(TNew, New, M),
source_mode(Old, New),
'$prepare_restore_hidden'(Old,New).
2013-11-08 08:24:06 +00:00
'$convert_true_off_mod3'(true, off, _) :- !.
'$convert_true_off_mod3'(false, on, _) :- !.
2001-04-19 18:12:18 +01:00
'$convert_true_off_mod3'(X, _, M) :-
2002-09-09 18:40:12 +01:00
'$do_error'(domain_error(module_decl_options,hidden(X)),M).
2001-04-19 18:12:18 +01:00
'$prepare_restore_hidden'(Old,Old) :- !.
'$prepare_restore_hidden'(Old,New) :-
2003-08-27 14:37:10 +01:00
recorda('$system_initialisation', source_mode(New,Old), _).
2001-04-19 18:12:18 +01:00
2014-09-22 18:13:35 +01:00
'$add_module_on_file'(DonorMod, DonorF, SourceF, Exports) :-
2014-10-07 01:35:41 +01:00
recorded('$module','$module'(OtherF, DonorMod, _, _, _),R),
2014-07-17 18:19:38 +01:00
% the module has been found, are we reconsulting?
(
DonorF \= OtherF
->
2014-10-07 01:35:41 +01:00
'$do_error'(permission_error(module,redefined,DonorMod, OtherF, DonorF),module(DonorMod,Exports))
2014-07-17 18:19:38 +01:00
;
2014-09-22 18:13:35 +01:00
recorded('$module','$module'(DonorF,DonorMod, SourceF, _, _), R),
2014-07-17 18:19:38 +01:00
erase( R ),
fail
).
2014-09-22 18:13:35 +01:00
'$add_module_on_file'(DonorM, DonorF, SourceF, Exports) :-
2014-07-17 18:19:38 +01:00
'$current_module'( HostM ),
2014-09-22 18:13:35 +01:00
( recorded('$module','$module'( HostF, HostM, _, _, _),_) -> true ; HostF = user_input ),
2014-07-17 18:19:38 +01:00
% first build the initial export tablee
'$convert_for_export'(all, Exports, DonorM, HostM, TranslationTab, AllExports0, load_files),
sort( AllExports0, AllExports ),
( source_location(_, Line) -> true ; Line = 0 ),
2014-08-23 20:47:40 +01:00
'$add_to_imports'(TranslationTab, DonorM, DonorM), % insert ops, at least for now
2014-07-17 18:19:38 +01:00
% last, export everything to the host: if the loading crashed you didn't actually do
% no evil.
2014-09-22 18:13:35 +01:00
recorda('$module','$module'(DonorF,DonorM,SourceF, AllExports, Line),_).
2014-07-17 18:19:38 +01:00
'$extend_exports'(HostF, Exports, DonorF ) :-
2014-09-25 08:50:26 +01:00
( recorded('$module','$module'( DonorF, DonorM, _,DonorExports, _),_) -> true ; DonorF = user_input ),
( recorded('$module','$module'( HostF, HostM, SourceF, _, _),_) -> true ; HostF = user_input ),
2014-09-22 18:13:35 +01:00
recorded('$module','$module'(HostF, HostM, _, AllExports, _Line), R), erase(R),
2014-10-07 01:35:41 +01:00
'$convert_for_export'(Exports, DonorExports, DonorM, HostM, _TranslationTab, AllReExports, reexport(DonorF, Exports)),
2014-07-17 18:19:38 +01:00
lists:append( AllReExports, AllExports, Everything0 ),
sort( Everything0, Everything ),
( source_location(_, Line) -> true ; Line = 0 ),
2014-09-22 18:13:35 +01:00
recorda('$module','$module'(HostF,HostM,SourceF, Everything, Line),_).
2004-02-13 13:31:44 +00:00
2013-11-08 00:02:38 +00:00
'$module_produced by'(M, M0, N, K) :-
2007-12-05 12:17:25 +00:00
recorded('$import','$import'(M,M0,_,_,N,K),_), !.
2013-11-08 00:02:38 +00:00
'$module_produced by'(M, M0, N, K) :-
2007-12-05 12:17:25 +00:00
recorded('$import','$import'(MI,M0,G1,_,N,K),_),
functor(G1, N1, K1),
'$module_produced by'(M,MI,N1,K1).
2005-10-28 18:38:50 +01:00
2001-04-09 20:54:03 +01:00
2014-07-27 01:14:15 +01:00
/** \pred current_module( ? Mod:atom) is nondet
: _Mod_ is any user-visible module.
2014-09-11 20:06:57 +01:00
*/
/** @pred current_module( _M_)
Succeeds if _M_ are defined modules. A module is defined as soon as some
predicate defined in the module is loaded, as soon as a goal in the
module is called, or as soon as it becomes the current type-in module.
2014-07-27 01:14:15 +01:00
*/
current_module(Mod) :-
'$all_current_modules'(Mod),
\+ '$system_module'(Mod).
/** \pred current_module( ? Mod:atom, ? File : file ) is nondet
: _Mod_ is any user-visible module and _File_ its source file, or `user` if none exists.
*/
2014-09-11 20:06:57 +01:00
/** @pred current_module( _M_, _F_)
Succeeds if _M_ are current modules associated to the file _F_.
*/
2014-07-27 01:14:15 +01:00
current_module(Mod,TFN) :-
'$all_current_modules'(Mod),
2014-09-22 18:13:35 +01:00
( recorded('$module','$module'(TFN,Mod,_,_Publics, _),_) -> true ; TFN = user ).
2014-07-27 01:14:15 +01:00
/** \pred source_module( - Mod:atom ) is nondet
: _Mod_ is the current read-in or source module.
*/
source_module(Mod) :-
'$current_module'(Mod).
2014-10-05 23:53:05 +01:00
% expand module names in a clause (interface predicate).
2008-07-23 00:34:50 +01:00
% A1: Input Clause
% A2: Output Class to Compiler (lives in module HM)
% A3: Output Class to clause/2 and listing (lives in module HM)
%
% modules:
% A4: module for body of clause (this is the one used in looking up predicates)
% A5: context module (this is the current context
% A6: head module (this is the one used in compiling and accessing).
%
2008-08-06 01:56:11 +01:00
%
2014-10-05 23:53:05 +01:00
'$module_expansion'(H, H, H, _HM, _BM, _SM) :- var(H), !.
'$module_expansion'((H:-B), (H:-B1), (H:-BOO), HM, BM, SM) :- !,
2014-10-12 11:00:45 +01:00
'$is_mt'(HM, H, SM, B, IB, NSM),
2014-10-05 23:53:05 +01:00
'$module_u_vars'(H,UVars,HM), % collect head variables in
2001-04-09 20:54:03 +01:00
% expanded positions
2014-10-12 11:00:45 +01:00
'$expand_modules'(IB, B1, BO, HM, BM, NSM, UVars),
('$full_clause_optimisation'(H, NSM, BO, BOO) ->
2009-03-10 16:24:26 +00:00
true
;
BO = BOO
).
2008-07-23 00:34:50 +01:00
% do not expand bodyless clauses.
2014-10-05 23:53:05 +01:00
'$module_expansion'(H,H,H,_,_,_).
2001-04-09 20:54:03 +01:00
2001-05-28 20:54:53 +01:00
'$trace_module'(X) :-
2001-04-09 20:54:03 +01:00
telling(F),
tell('P0:debug'),
write(X),nl,
tell(F), fail.
2001-10-30 16:42:05 +00:00
'$trace_module'(_).
2001-04-09 20:54:03 +01:00
2001-05-28 20:54:53 +01:00
'$trace_module'(X,Y) :- X==Y, !.
'$trace_module'(X,Y) :-
2001-04-09 20:54:03 +01:00
telling(F),
tell('~/.dbg.modules'),
write('***************'), nl,
portray_clause(X),
portray_clause(Y),
tell(F),fail.
2001-10-30 16:42:05 +00:00
'$trace_module'(_,_).
2001-04-09 20:54:03 +01:00
% expand module names in a body
2001-05-28 20:54:53 +01:00
% args are:
% goals to expand
% code to pass to listing
2008-07-23 00:34:50 +01:00
% code to pass to compiler
% current module for looking up preds M
2014-07-16 17:54:59 +01:00
% source module SM
2008-07-23 00:34:50 +01:00
% head module HM
%
% to understand the differences, you can consider:
%
% a:(d:b(X) :- g:c(X), d(X), user:hello(X)).
%
% when we process meta-predicate c, HM=d, DM=a, BM=a, M=g and we should get:
%
% d:b(X) :- g:c(g:X), a:d(X), user:hello(X).
%
% on the other hand,
%
% a:(d:b(X) :- c(X), d(X), d:e(X)).
%
% will give
%
% d:b(X) :- a:c(a:X), a:d(X), e(X).
%
%
2014-10-07 01:35:41 +01:00
% head variab'$expand_modules'(M:G,G1,GO,HM,_M,_SM,HVars)les.
2008-07-23 00:34:50 +01:00
% goals or arguments/sub-arguments?
% I cannot use call here because of format/3
2014-07-16 17:54:59 +01:00
% modules:
% A4: module for body of clause (this is the one used in looking up predicates)
% A5: context module (this is the current context
% A6: head module (this is the one used in compiling and accessing).
%
%
2014-10-11 12:45:54 +01:00
%'$expand_modules'(V,NG,NG,_,_,SM,HVars):-l writeln(V), fail.
2014-10-05 23:53:05 +01:00
'$expand_modules'(V,NG,NG,_,_,SM,HVars) :-
2008-07-23 00:34:50 +01:00
var(V), !,
( '$not_in_vars'(V,HVars)
->
2014-10-11 12:45:54 +01:00
NG = call(SM:V),
( atom(SM) -> NGO = '$execute_in_mod'(V,SM) ; NGO = NG )
2008-07-23 00:34:50 +01:00
;
NG = call(V)
).
2014-10-11 12:45:54 +01:00
'$expand_modules'(depth_bound_call(G,D),
depth_bound_call(G1,D),
('$set_depth_limit_for_next_call'(D),GO),
HM,BM,SM,HVars) :-
'$expand_modules'(G,G1,GO,HM,BM,SM,HVars),
'$composed_built_in'(GO), !.
2014-10-05 23:53:05 +01:00
'$expand_modules'((A,B),(A1,B1),(AO,BO),HM,BM,SM,HVars) :- !,
'$expand_modules'(A,A1,AO,HM,BM,SM,HVars),
'$expand_modules'(B,B1,BO,HM,BM,SM,HVars).
'$expand_modules'((A;B),(A1;B1),(AO;BO),HM,BM,SM,HVars) :- var(A), !,
'$expand_modules'(A,A1,AO,HM,BM,SM,HVars),
'$expand_modules'(B,B1,BO,HM,BM,SM,HVars).
'$expand_modules'((A*->B;C),(A1*->B1;C1),(yap_hacks:current_choicepoint(DCP),AO,yap_hacks:cut_at(DCP),BO; CO),HM,BM,SM,HVars) :- !,
'$expand_modules'(A,A1,AOO,HM,BM,SM,HVars),
2008-02-12 17:03:59 +00:00
'$clean_cuts'(AOO, AO),
2014-10-05 23:53:05 +01:00
'$expand_modules'(B,B1,BO,HM,BM,SM,HVars),
'$expand_modules'(C,C1,CO,HM,BM,SM,HVars).
'$expand_modules'((A;B),(A1;B1),(AO;BO),HM,BM,SM,HVars) :- !,
'$expand_modules'(A,A1,AO,HM,BM,SM,HVars),
'$expand_modules'(B,B1,BO,HM,BM,SM,HVars).
'$expand_modules'((A|B),(A1|B1),(AO|BO),HM,BM,SM,HVars) :- !,
'$expand_modules'(A,A1,AO,HM,BM,SM,HVars),
'$expand_modules'(B,B1,BO,HM,BM,SM,HVars).
'$expand_modules'((A->B),(A1->B1),(AO->BO),HM,BM,SM,HVars) :- !,
'$expand_modules'(A,A1,AOO,HM,BM,SM,HVars),
2008-02-12 17:03:59 +00:00
'$clean_cuts'(AOO, AO),
2014-10-05 23:53:05 +01:00
'$expand_modules'(B,B1,BO,HM,BM,SM,HVars).
2014-10-11 12:45:54 +01:00
'$expand_modules'(\+G,\+G,A\=B,_HM,_BM,_SM,_HVars) :-
nonvar(G),
G = (A = B),
!.
'$expand_modules'(\+A,\+A1,(AO-> false;true),HM,BM,SM,HVars) :- !,
2014-10-05 23:53:05 +01:00
'$expand_modules'(A,A1,AO,HM,BM,SM,HVars).
2014-10-11 12:45:54 +01:00
'$expand_modules'(once(A),once(A1),
(yap_hacks:current_choice_point(CP),AO,'$$cut_by'(CP)),HM,BM,SM,HVars) :- !,
'$expand_modules'(A,A1,AO0,HM,BM,SM,HVars),
'$clean_cuts'(AO0, CP, AO).
'$expand_modules'(ignore(A),ignore(A1),
(AO -> true ; true),HM,BM,SM,HVars) :- !,
'$expand_modules'(A,A1,AO0,HM,BM,SM,HVars),
'$clean_cuts'(AO0, AO).
'$expand_modules'(forall(A,B),forall(A1,B1),
((AO, ( BO-> false ; true)) -> false ; true),HM,BM,SM,HVars) :- !,
'$expand_modules'(A,A1,AO0,HM,BM,SM,HVars),
'$expand_modules'(B,B1,BO,HM,BM,SM,HVars),
'$clean_cuts'(AO0, AO).
'$expand_modules'(not(A),not(A1),(AO -> fail; true),HM,BM,SM,HVars) :- !,
2014-10-05 23:53:05 +01:00
'$expand_modules'(A,A1,AO,HM,BM,SM,HVars).
2014-10-11 12:45:54 +01:00
'$expand_modules'(if(A,B,C),if(A1,B1,C1),
2014-10-11 14:07:34 +01:00
(yap_hacks:current_choicepoint(DCP),AO,yap_hacks:cut_at(DCP),BO; CO),HM,BM,SM,HVars) :- !,
2014-10-11 12:45:54 +01:00
'$expand_modules'(A,A1,AO0,HM,BM,SM,HVars),
'$expand_modules'(B,B1,BO,HM,BM,SM,HVars),
'$expand_modules'(C,C1,CO,HM,BM,SM,HVars),
'$clean_cuts'(AO0, DCP, AO).
'$expand_modules'((A*->B;C),(A1*->B1;C1),
2014-10-11 14:07:34 +01:00
(yap_hacks:current_choicepoint(DCP),AO,yap_hacks:cut_at(DCP),BO; CO),HM,BM,SM,HVars) :- !,
2014-10-11 12:45:54 +01:00
'$expand_modules'(A,A1,AO0,HM,BM,SM,HVars),
'$expand_modules'(B,B1,BO,HM,BM,SM,HVars),
'$expand_modules'(C,C1,CO,HM,BM,SM,HVars),
'$clean_cuts'(AO0, DCP, AO).
'$expand_modules'((A*->B),(A1*->B1),
2014-10-11 14:07:34 +01:00
(yap_hacks:current_choicepoint(DCP),AO,BO),HM,BM,SM,HVars) :- !,
2014-10-11 12:45:54 +01:00
'$expand_modules'(A,A1,AO0,HM,BM,SM,HVars),
2014-10-11 21:56:55 +01:00
'$expand_modules'(B,B1,BO,HM,BM,SM,HVars),
2014-10-11 12:45:54 +01:00
'$clean_cuts'(AO0, DCP, AO).
2014-10-05 23:53:05 +01:00
'$expand_modules'(true,true,true,_,_,_,_) :- !.
'$expand_modules'(fail,fail,fail,_,_,_,_) :- !.
'$expand_modules'(false,false,false,_,_,_,_) :- !.
2001-04-09 20:54:03 +01:00
% if I don't know what the module is, I cannot do anything to the goal,
% so I just put a call for later on.
2014-10-05 23:53:05 +01:00
'$expand_modules'(M:G,call(M:G),'$execute_wo_mod'(G,M),_,_,_,_) :- var(M), !.
'$expand_modules'(M:G,G1,GO,HM,_M,_SM,HVars) :- !,
'$expand_modules'(G,G1,GO,HM,M,M,HVars).
'$expand_modules'(G, G1, GO, HM, BM, SM, HVars) :-
2010-02-28 22:25:54 +00:00
% is this imported from some other module M1?
2014-10-05 23:53:05 +01:00
'$imported_pred'(G, BM, GG, M1),
2010-02-28 22:25:54 +00:00
!,
2014-10-05 23:53:05 +01:00
'$expand_modules'(GG, G1, GO, HM, M1, SM, HVars).
'$expand_modules'(G, G1, GO, HM, BM, SM, HVars) :-
'$meta_expansion'(G, HM, BM, SM, GI, HVars), !,
'$complete_goal_expansion'(GI, HM, BM, SM, G1, GO, HVars).
'$expand_modules'(G, G1, GO, HM, BM, SM, HVars) :-
'$complete_goal_expansion'(G, HM, BM, SM, G1, GO, HVars).
2010-02-28 22:25:54 +00:00
2010-03-01 22:30:31 +00:00
expand_goal(G, G) :-
var(G), !.
2010-02-28 22:25:54 +00:00
expand_goal(M:G, M:NG) :-
2014-07-16 17:54:59 +01:00
'$do_expand'(G, M, prolog, [], NG), !.
2010-03-01 22:30:31 +00:00
expand_goal(G, NG) :-
'$current_module'(Mod),
2014-07-16 17:54:59 +01:00
'$do_expand'(G, Mod, prolog, [], NG), !.
2010-02-28 22:25:54 +00:00
expand_goal(G, G).
2014-10-05 23:53:05 +01:00
'$do_expand'(G, _HM, _BM, _SM, _, G) :- var(G), !.
'$do_expand'(M:G, HM, _BM, _SM, HVars, M:GI) :- !,
2014-10-02 14:57:50 +01:00
nonvar(M),
2014-10-05 23:53:05 +01:00
'$do_expand'(G, HM, M, M, HVars, GI).
2014-10-07 01:35:41 +01:00
'$do_expand'(G, _HM, _BM, SM, _HVars, GI) :-
2010-03-01 22:30:31 +00:00
(
2014-10-05 23:53:05 +01:00
'$pred_exists'(goal_expansion(G,GI), SM),
call(SM:goal_expansion(G, GI))
2009-05-25 01:18:52 +01:00
->
2010-03-01 22:30:31 +00:00
true
2010-04-22 12:16:37 +01:00
;
2011-02-15 15:51:12 +00:00
'$pred_exists'(goal_expansion(G,GI), system),
2010-12-14 12:39:24 +00:00
system:goal_expansion(G, GI)
2010-04-22 12:16:37 +01:00
->
true
2009-05-25 01:18:52 +01:00
;
2014-10-05 23:53:05 +01:00
user:goal_expansion(G, SM, GI)
2010-03-01 22:30:31 +00:00
->
true
2009-05-25 01:18:52 +01:00
;
user:goal_expansion(G, GI)
2010-12-13 22:03:54 +00:00
), !.
2014-10-05 23:53:05 +01:00
'$do_expand'(G, HM, BM, SM, HVars, NG) :-
'$is_metapredicate'(G,BM), !,
2010-12-14 12:39:24 +00:00
functor(G, Name, Arity),
2014-10-05 23:53:05 +01:00
prolog:'$meta_predicate'(Name,BM,Arity,PredDef),
2010-12-14 12:39:24 +00:00
G =.. [Name|GArgs],
PredDef =.. [Name|GDefs],
2014-10-05 23:53:05 +01:00
'$expand_args'(GArgs, HM, BM, SM, GDefs, HVars, NGArgs),
2010-12-14 12:39:24 +00:00
NG =.. [Name|NGArgs].
2014-10-05 23:53:05 +01:00
'$expand_args'([], _, _, _, [], _, []).
'$expand_args'([A|GArgs], HM, BM, SM, [0|GDefs], HVars, [NA|NGArgs]) :-
'$do_expand'(A, HM, BM, SM, HVars, NA), !,
'$expand_args'(GArgs, HM, BM, SM, GDefs, HVars, NGArgs).
'$expand_args'([A|GArgs], HM, BM, SM, [_|GDefs], HVars, [A|NGArgs]) :-
'$expand_args'(GArgs, HM, BM, SM, GDefs, HVars, NGArgs).
2008-07-23 00:34:50 +01:00
% args are:
% goal to expand
% current module for looking up pred
2014-07-16 17:54:59 +01:00
% current module from head of clause
2014-10-05 23:53:05 +01:00
% context module
2014-07-16 17:54:59 +01:00
% :- module(m, []). o:p :- n:(g, l).
2014-10-05 23:53:05 +01:00
% would be o, n, m.
2008-07-23 00:34:50 +01:00
% goal to pass to listing
% goal to pass to compiler
% head variables.
2014-10-05 23:53:05 +01:00
'$complete_goal_expansion'(G, HM, BM, SM, G1, GO, HVars) :-
2010-04-20 23:14:15 +01:00
% '$pred_goal_expansion_on',
2014-10-05 23:53:05 +01:00
'$do_expand'(G, HM, BM, SM, HVars, GI),
2010-04-20 23:14:15 +01:00
GI \== G, !,
2014-10-05 23:53:05 +01:00
'$expand_modules'(GI, G1, GO, HM, BM, SM, HVars).
2014-10-11 21:56:55 +01:00
'$complete_goal_expansion'(G, HM, BM, SM, G1, G2, _HVars) :-
2014-10-07 01:35:41 +01:00
'$all_system_predicate'(G, BM, BM0), !,
2008-07-23 00:34:50 +01:00
% make built-in processing transparent.
2014-10-11 12:45:54 +01:00
'$match_mod'(G, HM, BM0, SM, G1),
'$c_built_in'(G1, SM, G2).
2014-10-05 23:53:05 +01:00
'$complete_goal_expansion'(G, HM, BM, SM, NG, NG, _) :-
2014-10-07 01:35:41 +01:00
'$match_mod'(G, HM, BM, SM, NG).
2008-07-23 00:34:50 +01:00
%'$match_mod'(G, GMod, GMod, NG) :- !,
% NG = G.
2014-07-16 17:54:59 +01:00
'$match_mod'(G, _, M, _, G) :-
nonvar(G),
'$system_predicate'(G,prolog),
% \+ '$is_metapredicate'(G, prolog),
2014-10-07 01:35:41 +01:00
\+ '$is_multifile'(G,M),
2014-07-16 17:54:59 +01:00
!. % prolog: needs no module info.
2008-07-23 00:34:50 +01:00
% same module as head, and body goal (I cannot get rid of qualifier before
% meta-call.
2014-10-07 01:35:41 +01:00
'$match_mod'(G, HMod, BM, _HM, G) :- HMod == BM, !.
'$match_mod'(G, _, GMod, _, GMod:G).
2001-04-09 20:54:03 +01:00
2008-03-13 14:38:02 +00:00
% be careful here not to generate an undefined exception.
2007-12-05 12:17:25 +00:00
'$imported_pred'(G, ImportingMod, G0, ExportingMod) :-
2008-03-13 14:38:02 +00:00
'$enter_undefp',
2001-11-15 00:01:43 +00:00
'$undefined'(G, ImportingMod),
2009-12-04 11:00:13 +00:00
'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod),
2008-03-13 14:38:02 +00:00
ExportingMod \= ImportingMod, !,
'$exit_undefp'.
2013-11-08 00:02:38 +00:00
'$imported_pred'(_G, _ImportingMod, _, _) :-
2008-03-13 14:38:02 +00:00
'$exit_undefp',
fail.
2001-04-09 20:54:03 +01:00
2014-11-25 12:03:48 +00:00
% This predicate should be bidirectional: both
% a consumer and a generator.
2009-12-04 11:00:13 +00:00
'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod) :-
recorded('$import','$import'(ExportingModI,ImportingMod,G0I,G,_,_),_),
2014-11-25 12:03:48 +00:00
'$continue_imported'(ExportingMod, ExportingModI, G0, G0I).
2010-04-22 12:16:37 +01:00
% SWI builtin
2013-11-08 00:02:38 +00:00
'$get_undefined_pred'(G, _ImportingMod, G0, ExportingMod) :-
2010-04-22 12:16:37 +01:00
recorded('$dialect',Dialect,_),
Dialect \= yap,
functor(G, Name, Arity),
call(Dialect:index(Name,Arity,ExportingModI,_)), !,
2014-11-25 12:03:48 +00:00
'$continue_imported'(ExportingMod, ExportingModI, G0, G).
% autoload
2010-04-22 12:16:37 +01:00
'$get_undefined_pred'(G, _ImportingMod, G0, ExportingMod) :-
2013-10-30 09:41:45 +00:00
yap_flag(autoload, V),
V = true,
2014-11-25 12:03:48 +00:00
'$autoloader_find_predicate'(G,ExportingModI),
2013-10-30 09:41:45 +00:00
'$continue_imported'(ExportingMod, ExportingModI, G0, G).
2014-11-25 12:03:48 +00:00
% parent module mechanism
2009-12-04 11:00:13 +00:00
'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod) :-
prolog:'$parent_module'(ImportingMod,ExportingModI),
'$continue_imported'(ExportingMod, ExportingModI, G0, G).
2013-10-30 09:41:45 +00:00
'$autoloader_find_predicate'(G,ExportingModI) :-
'$nb_getval'('$autoloader_set', true, fail), !,
autoloader:find_predicate(G,ExportingModI).
'$autoloader_find_predicate'(G,ExportingModI) :-
2013-11-10 10:58:09 +00:00
'$exit_undefp',
2013-10-30 09:41:45 +00:00
yap_flag(autoload, false),
load_files([library(autoloader),
autoloader:library('INDEX'),
swi:library('dialect/swi/INDEX')],
2013-11-10 11:18:00 +00:00
[autoload(true),if(not_loaded)]),
2013-10-30 09:41:45 +00:00
nb_setval('$autoloader_set', true),
yap_flag(autoload, true),
2013-11-10 10:58:09 +00:00
'$enter_undefp',
2013-10-30 09:41:45 +00:00
autoloader:find_predicate(G,ExportingModI).
2009-12-04 11:00:13 +00:00
'$continue_imported'(Mod,Mod,Pred,Pred) :-
\+ '$undefined'(Pred, Mod), !.
2009-12-03 16:33:44 +00:00
'$continue_imported'(FM,Mod,FPred,Pred) :-
recorded('$import','$import'(IM,Mod,IPred,Pred,_,_),_), !,
'$continue_imported'(FM, IM, FPred, IPred).
2009-12-04 11:00:13 +00:00
'$continue_imported'(FM,Mod,FPred,Pred) :-
prolog:'$parent_module'(Mod,IM),
'$continue_imported'(FM, IM, FPred, Pred).
2009-12-03 16:33:44 +00:00
2014-07-27 01:14:15 +01:00
/**
2001-05-28 20:54:53 +01:00
2014-07-27 01:14:15 +01:00
\defgroup YAPMetaPredicates Using Meta-Calls with Modules
\ingroup YAPModules
2001-04-09 20:54:03 +01:00
2014-07-27 01:14:15 +01:00
@{
2001-04-09 20:54:03 +01:00
2014-07-27 01:14:15 +01:00
\pred meta_predicate(_G1_,...., _Gn) is directive
2014-07-17 18:19:38 +01:00
Declares that this predicate manipulates references to predicates.
Each _Gi_ is a mode specification.
If the argument is `:`, it does not refer directly to a predicate
but must be module expanded. If the argument is an integer, the argument
is a goal or a closure and must be expanded. Otherwise, the argument is
not expanded. Note that the system already includes declarations for all
built-ins.
For example, the declaration for call/1 and setof/3 are:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
:- meta_predicate call(0), setof(?,0,?).
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2014-07-27 01:14:15 +01:00
meta_predicate declaration
implemented by asserting $meta_predicate(SourceModule,Functor,Arity,Declaration)
2014-07-17 18:19:38 +01:00
*/
2014-07-27 01:14:15 +01:00
% directive now meta_predicate Ps :- $meta_predicate(Ps).
2005-10-18 18:04:43 +01:00
:- dynamic('$meta_predicate'/4).
2001-11-15 00:01:43 +00:00
2005-02-08 04:05:39 +00:00
:- multifile '$meta_predicate'/4.
2009-06-05 08:54:25 +01:00
'$meta_predicate'(P, M) :-
var(P),
'$do_error'(instantiation_error,module(M)).
2003-08-27 14:37:10 +01:00
'$meta_predicate'((P,Ps), M) :- !,
2001-11-15 00:01:43 +00:00
'$meta_predicate'(P, M),
'$meta_predicate'(Ps, M).
'$meta_predicate'(M:D, _) :- !,
'$meta_predicate'(D, M).
'$meta_predicate'(P, M1) :-
2003-12-27 00:38:53 +00:00
'$install_meta_predicate'(P, M1).
'$install_meta_predicate'(P, M1) :-
2001-04-09 20:54:03 +01:00
functor(P,F,N),
( M1 = prolog -> M = _ ; M1 = M),
2010-12-14 12:39:24 +00:00
( retractall(prolog:'$meta_predicate'(F,M,N,_)), fail ; true),
2003-01-08 16:45:35 +00:00
asserta(prolog:'$meta_predicate'(F,M,N,P)),
2001-11-15 00:01:43 +00:00
'$flags'(P, M1, Fl, Fl),
2001-04-09 20:54:03 +01:00
NFlags is Fl \/ 0x200000,
2001-11-15 00:01:43 +00:00
'$flags'(P, M1, Fl, NFlags).
2001-04-09 20:54:03 +01:00
% return list of vars in expanded positions on the head of a clause.
%
% these variables should not be expanded by meta-calls in the body of the goal.
%
2001-11-15 00:01:43 +00:00
'$module_u_vars'(H,UVars,M) :-
2001-04-09 20:54:03 +01:00
functor(H,F,N),
2002-12-03 06:06:24 +00:00
'$meta_predicate'(F,M,N,D), !,
2001-04-09 20:54:03 +01:00
'$module_u_vars'(N,D,H,UVars).
2001-11-15 00:01:43 +00:00
'$module_u_vars'(_,[],_).
2001-04-09 20:54:03 +01:00
'$module_u_vars'(0,_,_,[]) :- !.
2014-02-09 10:47:44 +00:00
'$module_u_vars'(I,D,H,LF) :-
2001-04-09 20:54:03 +01:00
arg(I,D,X), ( X=':' ; integer(X)),
2014-02-09 10:47:44 +00:00
arg(I,H,A), '$uvar'(A, LF, L), !,
2001-04-09 20:54:03 +01:00
I1 is I-1,
'$module_u_vars'(I1,D,H,L).
2001-04-19 18:12:18 +01:00
'$module_u_vars'(I,D,H,L) :-
2001-04-09 20:54:03 +01:00
I1 is I-1,
'$module_u_vars'(I1,D,H,L).
2014-02-09 10:47:44 +00:00
'$uvar'(Y, [Y|L], L) :- var(Y), !.
% support all/3
'$uvar'(same( G, _), LF, L) :-
'$uvar'(G, LF, L).
2014-02-19 00:04:26 +00:00
'$uvar'('^'( _, G), LF, L) :-
'$uvar'(G, LF, L).
2014-02-09 10:47:44 +00:00
2001-04-09 20:54:03 +01:00
% expand arguments of a meta-predicate
% $meta_expansion(ModuleWhereDefined,CurrentModule,Goal,ExpandedGoal,MetaVariables)
2014-02-09 10:47:44 +00:00
2014-10-05 23:53:05 +01:00
'$meta_expansion'(G, HM, BM, SM, G1,HVars) :-
2001-04-09 20:54:03 +01:00
functor(G,F,N),
2014-10-05 23:53:05 +01:00
'$meta_predicate'(F,BM,N,D), !, % we're in an argument
% format(user_error,'[ ~w (~a, ~a, ~a)',[G, HM, BM, SM]),
2001-04-09 20:54:03 +01:00
functor(G1,F,N),
2014-10-05 23:53:05 +01:00
'$meta_expansion_loop'(N, D, G, G1, HVars, HM, BM, SM).
% format(user_error,' gives ~w]~n',[G1]).
2001-04-09 20:54:03 +01:00
2014-07-16 17:54:59 +01:00
2001-04-09 20:54:03 +01:00
% expand argument
2008-07-23 00:34:50 +01:00
'$meta_expansion_loop'(0,_,_,_,_,_,_,_) :- !.
2014-10-05 23:53:05 +01:00
'$meta_expansion_loop'(I,D,G,NG,HVars, HM, BM, SM) :-
arg(I,D,X),
(X==':' -> true ; integer(X)),
2014-02-09 10:47:44 +00:00
arg(I,G,A),
'$should_expand'(A,HVars),
2008-07-23 00:34:50 +01:00
!,
2014-02-09 10:47:44 +00:00
( X ==0 ->
2014-03-18 17:24:20 +00:00
'$values'('$c_arith',Old, false),
2014-10-05 23:53:05 +01:00
'$meta_expansion0'(A, HM, BM, SM, NA, HVars),
2014-03-18 17:24:20 +00:00
'$values'('$c_arith', _False, Old)
2014-02-09 10:47:44 +00:00
;
2014-10-05 23:53:05 +01:00
NA = SM:A
2014-02-09 10:47:44 +00:00
),
arg(I,NG,NA),
2001-04-09 20:54:03 +01:00
I1 is I-1,
2014-10-05 23:53:05 +01:00
'$meta_expansion_loop'(I1, D, G, NG, HVars, HM, BM, SM).
2014-10-07 01:35:41 +01:00
'$meta_expansion_loop'(I, D, G, NG, HVars, HM, BM, SM) :-
2001-04-09 20:54:03 +01:00
arg(I,G,A),
2008-07-23 00:34:50 +01:00
arg(I,NG,A),
2001-04-09 20:54:03 +01:00
I1 is I-1,
2014-10-05 23:53:05 +01:00
'$meta_expansion_loop'(I1, D, G, NG, HVars, HM, BM, SM).
2001-04-09 20:54:03 +01:00
2014-10-05 23:53:05 +01:00
'$meta_expansion0'(G, _HM, _BM, SM, SM:G, _HVars) :-
var(G), !.
2014-10-07 10:13:31 +01:00
'$meta_expansion0'(M:G, _HM, _BM, _SM, G1, _HVars) :-
2014-07-16 17:54:59 +01:00
var(M), !,
2014-10-07 01:35:41 +01:00
G1 = '$execute_wo_mod'(G,M).
2014-07-16 17:54:59 +01:00
% support for all/3
2014-10-05 23:53:05 +01:00
'$meta_expansion0'(same(G, P), HM, BM, SM, same(G1, P),HVars) :- !,
2014-10-07 01:35:41 +01:00
'$meta_expansion0'(G, HM, BM, SM, G1,HVars).
'$meta_expansion0'(G, _HM, _BM, SM, M1:G1,_HVars) :-
2014-10-05 23:53:05 +01:00
strip_module(SM:G,M1,G1).
2014-07-16 17:54:59 +01:00
2001-04-09 20:54:03 +01:00
% check if an argument should be expanded
2014-02-09 10:47:44 +00:00
'$should_expand'(V,HVars) :- var(V), !, '$not_in_vars'(V,HVars).
'$should_expand'(_:_,_) :- !, fail.
'$should_expand'(_,_).
2001-04-09 20:54:03 +01:00
2001-10-30 16:42:05 +00:00
'$not_in_vars'(_,[]).
'$not_in_vars'(V,[X|L]) :- X\==V, '$not_in_vars'(V,L).
2001-04-09 20:54:03 +01:00
2014-07-27 01:14:15 +01:00
/*
\pred module_transparent( + _Preds_ ) is directive
_Preds_ is a list of predicates that can access the calling context.
2001-04-09 20:54:03 +01:00
2014-07-27 01:14:15 +01:00
_Preds_ is a comma separated sequence of name/arity predicate
indicators (like in dynamic/1). Each goal associated with a
transparent declared predicate will inherit the context module from
its parent goal.
2001-04-09 20:54:03 +01:00
2014-07-27 01:14:15 +01:00
*/
:- dynamic('$module_transparent'/4).
'$module_transparent'((P,Ps), M) :- !,
'$module_transparent'(P, M),
'$module_transparent'(Ps, M).
'$module_transparent'(M:D, _) :- !,
'$module_transparent'(D, M).
'$module_transparent'(F/N, M) :-
'$module_transparent'(F,M,N,_), !.
'$module_transparent'(F/N, M) :-
functor(P,F,N),
asserta(prolog:'$module_transparent'(F,M,N,P)),
'$flags'(P, M, Fl, Fl),
NFlags is Fl \/ 0x200004,
'$flags'(P, M, Fl, NFlags).
2014-10-12 11:00:45 +01:00
%% handle module transparent predicates by defining a
%% new context module.
'$is_mt'(M, H, _, B, (context_module(CM),B), CM) :-
2014-07-27 01:14:15 +01:00
'$module_transparent'(_, M, _, H), !.
2014-10-12 11:00:45 +01:00
'$is_mt'(_M, _H, CM, B, B, CM).
2001-04-09 20:54:03 +01:00
2003-12-27 00:38:53 +00:00
% comma has its own problems.
2014-08-04 15:45:30 +01:00
:- '$install_meta_predicate'(','(0,0), prolog).
2003-12-27 00:38:53 +00:00
2014-09-11 20:06:57 +01:00
2001-04-09 20:54:03 +01:00
:- meta_predicate
abolish(:),
abolish(:,+),
2010-04-22 20:45:57 +01:00
all(?,0,-),
2001-04-09 20:54:03 +01:00
assert(:),
assert(:,+),
2002-05-21 05:18:15 +01:00
assert_static(:),
2001-04-09 20:54:03 +01:00
asserta(:),
asserta(:,+),
2002-05-21 05:18:15 +01:00
asserta_static(:),
2001-04-09 20:54:03 +01:00
assertz(:),
assertz(:,+),
2002-05-21 05:18:15 +01:00
assertz_static(:),
2012-12-02 13:18:29 +00:00
at_halt(0),
2010-04-22 20:45:57 +01:00
bagof(?,0,-),
2002-03-17 15:25:30 +00:00
bb_get(:,-),
bb_put(:,+),
bb_delete(:,?),
bb_update(:,?,?),
2010-04-22 20:45:57 +01:00
call(0),
call(1,?),
call(2,?,?),
call(3,?,?,?),
call_with_args(0),
call_with_args(1,?),
call_with_args(2,?,?),
call_with_args(3,?,?,?),
call_with_args(4,?,?,?,?),
call_with_args(5,?,?,?,?,?),
call_with_args(6,?,?,?,?,?,?),
call_with_args(7,?,?,?,?,?,?,?),
call_with_args(8,?,?,?,?,?,?,?,?),
call_with_args(9,?,?,?,?,?,?,?,?,?),
call_cleanup(0,0),
call_cleanup(0,?,0),
call_residue(0,?),
call_residue_vars(0,?),
2010-12-01 19:30:58 +00:00
call_shared_object_function(:,+),
2010-04-22 20:45:57 +01:00
catch(0,?,0),
2001-04-09 20:54:03 +01:00
clause(:,?),
clause(:,?,?),
2001-05-28 20:54:53 +01:00
compile(:),
consult(:),
2001-04-09 20:54:03 +01:00
current_predicate(:),
current_predicate(?,:),
2013-01-15 11:18:09 +00:00
db_files(:),
2010-04-22 20:45:57 +01:00
depth_bound_call(0,+),
2005-11-05 23:56:10 +00:00
discontiguous(:),
2001-05-28 20:54:53 +01:00
ensure_loaded(:),
2013-01-15 11:18:09 +00:00
exo_files(:),
2010-04-22 20:45:57 +01:00
findall(?,0,-),
findall(?,0,-,?),
forall(0,0),
format(+,:),
format(+,+,:),
freeze(?,0),
2002-08-14 17:00:54 +01:00
hide_predicate(:),
2010-04-22 20:45:57 +01:00
if(0,0,0),
ignore(0),
incore(0),
2005-11-05 23:56:10 +00:00
multifile(:),
2001-04-09 20:54:03 +01:00
nospy(:),
2010-04-22 20:45:57 +01:00
not(0),
2014-03-06 02:09:48 +00:00
notrace(0),
2010-04-22 20:45:57 +01:00
once(0),
phrase(2,?),
phrase(2,?,+),
2002-03-17 15:25:30 +00:00
predicate_property(:,?),
2003-11-12 12:33:31 +00:00
predicate_statistics(:,-,-,-),
2010-04-22 20:45:57 +01:00
on_exception(+,0,0),
2012-06-26 10:09:10 +01:00
qsave_program(+,:),
2002-03-17 15:25:30 +00:00
reconsult(:),
2001-04-09 20:54:03 +01:00
retract(:),
retract(:,?),
retractall(:),
2001-05-28 20:54:53 +01:00
reconsult(:),
2010-04-22 20:45:57 +01:00
setof(?,0,-),
setup_call_cleanup(0,0,0),
setup_call_catcher_cleanup(0,0,?,0),
2001-04-09 20:54:03 +01:00
spy(:),
2012-11-25 23:36:43 +00:00
stash_predicate(:),
2002-01-16 20:18:28 +00:00
use_module(:),
use_module(:,?),
use_module(?,:,?),
2010-04-22 20:45:57 +01:00
when(+,0),
with_mutex(+,0),
with_output_to(?,0),
2014-07-27 01:43:16 +01:00
'->'(0 , 0),
'*->'(0 , 0),
';'(0 , 0),
','(0 , 0),
2010-04-22 20:45:57 +01:00
^(+,0),
2012-03-23 15:00:58 +00:00
{}(0,?,?),
','(2,2,?,?),
;(2,2,?,?),
'|'(2,2,?,?),
->(2,2,?,?),
\+(2,?,?),
2014-07-27 01:43:16 +01:00
\+( 0 ).
2001-04-09 20:54:03 +01:00
2014-07-27 01:14:15 +01:00
/**
@}
@{
\defgroup YAPDynamicYAPModules Dynamic Modules
\ingroup YAPModules
YAP (in the footsteps of SWI-Prolog) allows to create modules that
are not bound to files. One application is in Inductive Logic Programming,
where dynamic modules can be used to represent training examples. YAP now include
built-ins to create a module. manipulate its interface, and eventually abolish the
module, releasing all the data therein.
*/
/**
\pred declare_module(+Module, +Super, +File, +Line, +Redefine) is det
declare explicitely a module
Start a new (source-)module _Module_ that inherits all exports from
_Super_. The module is as if defined in file _File_ and _Line_ and if _Redefine_
holds true may
be associated to a new file.
\param[in] _Module_ is the name of the module to declare
\param[in] _MSuper_ is the name of the context module. Use `prolog`or `system`
if you do not need a context.
\param[in] _File_ is the canonical name of the file from which the module is loaded
\param[in] Line is the line-number of the :- module/2 directive.
\param[in] If _Redefine_ `true`, allow associating the module to a new file
*/
'$declare_module'(Name, _Super, Context, _File, _Line) :-
add_import_module(Name, Context, start).
/**
\pred abolish_module( + Mod) is det
get rid of a module and of all predicates included in the module.
*/
2006-04-05 01:16:55 +01:00
abolish_module(Mod) :-
2014-09-22 18:13:35 +01:00
recorded('$module','$module'(_,Mod,_,_,_),R), erase(R),
2006-04-05 01:16:55 +01:00
fail.
abolish_module(Mod) :-
2013-11-26 09:40:00 +00:00
recorded('$import','$import'(Mod,_,_,_,_,_),R), erase(R),
2006-04-05 01:16:55 +01:00
fail.
2008-06-02 18:20:28 +01:00
abolish_module(Mod) :-
2014-11-25 12:03:48 +00:00
'$current_predicate'(Na,Mod,S,_),
functor(S, Na, Ar),
2008-06-02 18:20:28 +01:00
abolish(Mod:Na/Ar),
fail.
2006-04-05 01:16:55 +01:00
abolish_module(_).
2007-12-05 12:17:25 +00:00
2012-10-22 10:18:26 +01:00
export(Resource) :-
var(Resource),
'$do_error'(instantiation_error,export(Resource)).
export([]) :- !.
export([Resource| Resources]) :- !,
export_resource(Resource),
export(Resources).
export(Resource) :-
export_resource(Resource).
export_resource(Resource) :-
2014-07-17 18:19:38 +01:00
var(Resource), !,
2012-10-22 10:18:26 +01:00
'$do_error'(instantiation_error,export(Resource)).
export_resource(P) :-
P = F/N, atom(F), number(N), N >= 0, !,
2012-02-14 09:54:56 +00:00
'$current_module'(Mod),
2014-09-22 18:13:35 +01:00
( recorded('$module','$module'(File,Mod,SourceF,ExportedPreds,Line),R) ->
2012-10-22 15:04:52 +01:00
erase(R),
2014-09-25 08:50:26 +01:00
recorda('$module','$module'(File,Mod,SourceF,[P|ExportedPreds],Line),_)
2012-10-22 15:04:52 +01:00
; prolog_load_context(file, File) ->
2014-09-22 18:13:35 +01:00
recorda('$module','$module'(File,Mod,SourceF,[P],Line),_)
; recorda('$module','$module'(user_input,Mod,user_input,[P],1),_)
2012-02-14 09:54:56 +00:00
).
2012-10-22 10:18:26 +01:00
export_resource(P0) :-
P0 = F//N, atom(F), number(N), N >= 0, !,
2012-02-14 09:54:56 +00:00
N1 is N+2, P = F/N1,
'$current_module'(Mod),
2014-09-22 18:13:35 +01:00
( recorded('$module','$module'(File,Mod,SourceF,ExportedPreds,Line),R) ->
2012-10-22 15:04:52 +01:00
erase(R),
2014-09-22 18:13:35 +01:00
recorda('$module','$module'(File,Mod,SourceF,[P|ExportedPreds],Line ),_)
2012-10-22 15:04:52 +01:00
; prolog_load_context(file, File) ->
2014-09-22 18:13:35 +01:00
recorda('$module','$module'(File,Mod,SourceF,[P],Line),_)
; recorda('$module','$module'(user_input,Mod,user_input,[P],1),_)
2012-02-14 09:54:56 +00:00
).
2012-10-22 10:18:26 +01:00
export_resource(op(Prio,Assoc,Name)) :- !,
2012-02-14 09:54:56 +00:00
op(Prio,Assoc,prolog:Name).
2012-10-22 10:18:26 +01:00
export_resource(Resource) :-
'$do_error'(type_error(predicate_indicator,Resource),export(Resource)).
2012-02-14 09:54:56 +00:00
export_list(Module, List) :-
2014-09-22 18:13:35 +01:00
recorded('$module','$module'(_,Module,_,List,_),_).
2012-02-14 09:54:56 +00:00
2013-11-17 21:41:41 +00:00
'$convert_for_export'(all, Exports, _Module, _ContextModule, Tab, MyExports, _) :-
'$simple_conversion'(Exports, Tab, MyExports).
2013-11-08 08:24:06 +00:00
'$convert_for_export'([], Exports, Module, ContextModule, Tab, MyExports, Goal) :-
'$clean_conversion'([], Exports, Module, ContextModule, Tab, MyExports, Goal).
2013-11-08 00:02:38 +00:00
'$convert_for_export'([P1|Ps], Exports, Module, ContextModule, Tab, MyExports, Goal) :-
'$clean_conversion'([P1|Ps], Exports, Module, ContextModule, Tab, MyExports, Goal).
'$convert_for_export'(except(Excepts), Exports, Module, ContextModule, Tab, MyExports, Goal) :-
'$neg_conversion'(Excepts, Exports, Module, ContextModule, MyExports, Goal),
2013-11-17 21:41:41 +00:00
'$simple_conversion'(MyExports, Tab, _).
2013-11-08 00:02:38 +00:00
2013-11-17 21:41:41 +00:00
'$simple_conversion'([], [], []).
'$simple_conversion'([F/N|Exports], [F/N-F/N|Tab], [F/N|E]) :-
'$simple_conversion'(Exports, Tab, E).
2013-11-18 12:56:00 +00:00
'$simple_conversion'([F//N|Exports], [F/N2-F/N2|Tab], [F/N2|E]) :-
2013-11-08 00:02:38 +00:00
N2 is N+1,
2013-11-17 21:41:41 +00:00
'$simple_conversion'(Exports, Tab, E).
'$simple_conversion'([F/N as NF|Exports], [F/N-NF/N|Tab], [NF/N|E]) :-
'$simple_conversion'(Exports, Tab, E).
2014-10-07 01:35:41 +01:00
'$simple_conversion'([F//N as NF|Exports], [F/N2-NF/N2|Tab], [NF/N2|E]) :-
2013-11-08 00:02:38 +00:00
N2 is N+1,
2013-11-17 21:41:41 +00:00
'$simple_conversion'(Exports, Tab, E).
'$simple_conversion'([op(Prio,Assoc,Name)|Exports], [op(Prio,Assoc,Name)|Tab], [op(Prio,Assoc,Name)|E]) :-
'$simple_conversion'(Exports, Tab, E).
2013-11-08 00:02:38 +00:00
'$clean_conversion'([], _, _, _, [], [], _).
'$clean_conversion'([(N1/A1 as N2)|Ps], List, Module, ContextModule, [N1/A1-N2/A1|Tab], [N2/A1|MyExports], Goal) :- !,
( lists:memberchk(N1/A1, List)
->
2014-02-14 20:26:09 +00:00
true
2013-11-08 00:02:38 +00:00
;
2014-10-07 01:35:41 +01:00
'$bad_export'((N1/A1 as N2), Module, ContextModule)
2014-02-14 20:26:09 +00:00
),
'$clean_conversion'(Ps, List, Module, ContextModule, Tab, MyExports, Goal).
2013-11-08 00:02:38 +00:00
'$clean_conversion'([N1/A1|Ps], List, Module, ContextModule, [N1/A1-N1/A1|Tab], [N1/A1|MyExports], Goal) :- !,
2007-12-05 12:17:25 +00:00
(
2013-11-08 00:02:38 +00:00
lists:memberchk(N1/A1, List)
2007-12-05 12:17:25 +00:00
->
2014-02-14 20:26:09 +00:00
true
2007-12-05 12:17:25 +00:00
;
2013-11-08 00:02:38 +00:00
'$bad_export'(N1/A1, Module, ContextModule)
2014-02-14 20:26:09 +00:00
),
'$clean_conversion'(Ps, List, Module, ContextModule, Tab, MyExports, Goal).
2013-11-17 21:41:41 +00:00
'$clean_conversion'([N1//A1|Ps], List, Module, ContextModule, [N1/A2-N1/A2|Tab], [N1/A2|MyExports], Goal) :- !,
2013-11-08 00:02:38 +00:00
A2 is A1+2,
(
lists:memberchk(N1/A2, List)
->
2014-02-14 20:26:09 +00:00
true
2013-11-08 00:02:38 +00:00
;
'$bad_export'(N1//A1, Module, ContextModule)
2014-02-14 20:26:09 +00:00
),
'$clean_conversion'(Ps, List, Module, ContextModule, Tab, MyExports, Goal).
2013-11-17 21:41:41 +00:00
'$clean_conversion'([N1//A1 as N2|Ps], List, Module, ContextModule, [N2/A2-N1/A2|Tab], [N2/A2|MyExports], Goal) :- !,
A2 is A1+2,
(
lists:memberchk(N2/A2, List)
->
2014-02-14 20:26:09 +00:00
true
2013-11-17 21:41:41 +00:00
;
'$bad_export'((N1//A1 as A2), Module, ContextModule)
2014-02-14 20:26:09 +00:00
),
'$clean_conversion'(Ps, List, Module, ContextModule, Tab, MyExports, Goal).
2013-11-08 00:02:38 +00:00
'$clean_conversion'([op(Prio,Assoc,Name)|Ps], List, Module, ContextModule, [op(Prio,Assoc,Name)|Tab], [op(Prio,Assoc,Name)|MyExports], Goal) :- !,
(
lists:memberchk(op(Prio,Assoc,Name), List)
->
2014-02-14 20:26:09 +00:00
true
2013-11-08 00:02:38 +00:00
;
2014-02-14 20:26:09 +00:00
'$bad_export'(op(Prio,Assoc,Name), Module, ContextModule)
),
'$clean_conversion'(Ps, List, Module, ContextModule, Tab, MyExports, Goal).
2013-11-08 00:02:38 +00:00
'$clean_conversion'([P|_], _List, _, _, _, _, Goal) :-
'$do_error'(domain_error(module_export_predicates,P), Goal).
'$bad_export'(_, _Module, _ContextModule) :- !.
'$bad_export'(Name/Arity, Module, ContextModule) :-
functor(P, Name, Arity),
predicate_property(Module:P, _), !,
print_message(warning, declaration(Name/Arity, Module, ContextModule, private)).
'$bad_export'(Name//Arity, Module, ContextModule) :-
Arity2 is Arity+2,
functor(P, Name, Arity2),
predicate_property(Module:P, _), !,
print_message(warning, declaration(Name/Arity, Module, ContextModule, private)).
'$bad_export'(Indicator, Module, ContextModule) :- !,
print_message(warning, declaration( Indicator, Module, ContextModule, undefined)).
'$neg_conversion'([], Exports, _, _, Exports, _).
'$neg_conversion'([N1/A1|Ps], List, Module, ContextModule, MyExports, Goal) :- !,
(
lists:delete(List, N1/A1, RList)
->
'$neg_conversion'(Ps, RList, Module, ContextModule, MyExports, Goal)
;
'$bad_export'(N1/A1, Module, ContextModule)
).
'$neg_conversion'([N1//A1|Ps], List, Module, ContextModule, MyExports, Goal) :- !,
A2 is A1+2,
(
lists:delete(List, N1/A2, RList)
->
'$neg_conversion'(Ps, RList, Module, ContextModule, MyExports, Goal)
;
'$bad_export'(N1//A1, Module, ContextModule)
).
'$neg_conversion'([op(Prio,Assoc,Name)|Ps], List, Module, ContextModule, MyExports, Goal) :- !,
(
lists:delete(List, op(Prio,Assoc,Name), RList)
->
'$neg_conversion'(Ps, RList, Module, ContextModule, MyExports, Goal)
;
'$bad_export'(op(Prio,Assoc,Name), Module, ContextModule)
).
'$clean_conversion'([P|_], _List, _, _, _, Goal) :-
'$do_error'(domain_error(module_export_predicates,P), Goal).
2014-07-17 18:19:38 +01:00
2007-12-05 12:17:25 +00:00
'$add_to_imports'([], _, _).
2013-11-08 00:02:38 +00:00
% no need to import from the actual module
'$add_to_imports'([T|Tab], Module, ContextModule) :-
'$do_import'(T, Module, ContextModule),
'$add_to_imports'(Tab, Module, ContextModule).
'$do_import'(op(Prio,Assoc,Name), _Mod, ContextMod) :-
op(Prio,Assoc,ContextMod:Name).
'$do_import'(N0/K0-N0/K0, Mod, Mod) :- !.
'$do_import'(_N/K-N1/K, _Mod, ContextMod) :-
2014-09-22 18:13:35 +01:00
recorded('$module','$module'(_F, ContextMod, _SourceF, MyExports,_),_),
2013-11-08 00:02:38 +00:00
once(lists:member(N1/K, MyExports)),
functor(S, N1, K),
% reexport predicates if they are undefined in the current module.
\+ '$undefined'(S,ContextMod), !.
'$do_import'( N/K-N1/K, Mod, ContextMod) :-
functor(G,N,K),
'$follow_import_chain'(Mod,G,M0,G0),
2014-10-09 10:47:41 +01:00
G0=..[_N0|Args],
2007-12-05 12:17:25 +00:00
G1=..[N1|Args],
2013-11-08 00:02:38 +00:00
( '$check_import'(M0,ContextMod,N1,K) ->
( ContextMod = user ->
2013-11-26 09:40:00 +00:00
( recordzifnot('$import','$import'(M0,user,G0,G1,N1,K),_) -> true ; true)
2013-11-08 00:02:38 +00:00
;
2013-11-26 09:40:00 +00:00
( recordaifnot('$import','$import'(M0,ContextMod,G0,G1,N1,K),_) -> true ; true )
2013-11-08 00:02:38 +00:00
)
;
true
).
'$follow_import_chain'(M,G,M0,G0) :-
recorded('$import','$import'(M1,M,G1,G,_,_),_), M \= M1, !,
'$follow_import_chain'(M1,G1,M0,G0).
'$follow_import_chain'(M,G,M,G).
% trying to import Mod:N/K into ContextM
'$check_import'(Mod, ContextM, N, K) :-
recorded('$import','$import'(MI, ContextM, _, _, N,K),_R),
% dereference MI to M1, in order to find who
% is actually generating
( '$module_produced by'(M1, MI, N, K) -> true ; MI = M1 ),
2014-07-17 18:19:38 +01:00
( '$module_produced by'(M2, Mod, N, K) -> true ; Mod = M2 ),
2013-11-08 00:02:38 +00:00
M2 \= M1, !,
b_getval('$lf_status', TOpts),
'$lf_opt'(redefine_module, TOpts, Action),
2014-10-07 01:35:41 +01:00
'$redefine_action'(Action, M1, M2, Mod, ContextM, N/K).
2013-11-08 00:02:38 +00:00
'$check_import'(_,_,_,_).
2014-07-17 18:19:38 +01:00
'$redefine_action'(ask, M1, M2, M, _, N/K) :-
2013-11-08 00:02:38 +00:00
stream_property(user_input,tty(true)), !,
format(user_error,'NAME CLASH: ~w was already imported to module ~w;~n',[M1:N/K,M2]),
format(user_error,' Do you want to import it from ~w ? [y, n, e or h] ',M),
'$mod_scan'(C),
2014-08-20 14:08:21 +01:00
( C == e -> halt(1) ;
C == y ).
2014-07-17 18:19:38 +01:00
'$redefine_action'(true, M1, _, _, _, _) :- !,
2014-09-22 18:13:35 +01:00
recorded('$module','$module'(F, M1, _, _MyExports,_Line),_),
2013-11-08 00:02:38 +00:00
unload_file(F).
2014-10-07 01:35:41 +01:00
'$redefine_action'(false, M1, M2, _M, ContextM, N/K) :-
2014-09-22 18:13:35 +01:00
recorded('$module','$module'(F, ContextM, _, _MyExports,_Line),_),
2014-07-17 18:19:38 +01:00
'$current_module'(_, M2),
'$do_error'(permission_error(import,M1:N/K,redefined,M2),F).
2008-02-12 17:03:59 +00:00
2014-08-20 14:08:21 +01:00
'$mod_scan'(C) :-
get_char(C),
'$skipeol'(C),
(C == y -> true; C == n).
2008-02-12 17:03:59 +00:00
% I assume the clause has been processed, so the
% var case is long gone! Yes :)
'$clean_cuts'(G,(yap_hacks:current_choicepoint(DCP),NG)) :-
'$conj_has_cuts'(G,DCP,NG,OK), OK == ok, !.
'$clean_cuts'(G,G).
2014-10-11 12:45:54 +01:00
'$clean_cuts'(G,DCP,NG) :-
'$conj_has_cuts'(G,DCP,NG,OK), OK == ok, !.
'$clean_cuts'(G,_,G).
2010-12-03 15:14:00 +00:00
'$conj_has_cuts'(V,_,V, _) :- var(V), !.
2008-02-12 17:03:59 +00:00
'$conj_has_cuts'(!,DCP,'$$cut_by'(DCP), ok) :- !.
'$conj_has_cuts'((G1,G2),DCP,(NG1,NG2), OK) :- !,
'$conj_has_cuts'(G1, DCP, NG1, OK),
'$conj_has_cuts'(G2, DCP, NG2, OK).
'$conj_has_cuts'((G1;G2),DCP,(NG1;NG2), OK) :- !,
'$conj_has_cuts'(G1, DCP, NG1, OK),
'$conj_has_cuts'(G2, DCP, NG2, OK).
'$conj_has_cuts'((G1->G2),DCP,(G1;NG2), OK) :- !,
% G1: the system must have done it already
'$conj_has_cuts'(G2, DCP, NG2, OK).
'$conj_has_cuts'((G1*->G2),DCP,(G1;NG2), OK) :- !,
% G1: the system must have done it already
'$conj_has_cuts'(G2, DCP, NG2, OK).
'$conj_has_cuts'(if(G1,G2,G3),DCP,if(G1,NG2,NG3), OK) :- !,
% G1: the system must have done it already
'$conj_has_cuts'(G2, DCP, NG2, OK),
'$conj_has_cuts'(G3, DCP, NG3, OK).
'$conj_has_cuts'(G,_,G, _).
2014-07-27 01:14:15 +01:00
/**
set_base_module( +ExportingModule ) is det
All exported predicates from _ExportingModule_ are automatically available to the
current source module.
This built-in was introduced by SWI-Prolog. In YAP, by default, modules only
inherit from `prolog`. This extension allows predicates in the current
module (see module/2 and module/1) to inherit from `user` or other modules.
*/
2009-12-04 11:00:13 +00:00
set_base_module(ExportingModule) :-
var(ExportingModule),
'$do_error'(instantiation_error,set_base_module(ExportingModule)).
set_base_module(ExportingModule) :-
atom(ExportingModule), !,
'$current_module'(Mod),
2013-11-08 00:02:38 +00:00
retractall(prolg:'$parent_module'(Mod,_)),
2009-12-04 11:00:13 +00:00
asserta(prolog:'$parent_module'(Mod,ExportingModule)).
set_base_module(ExportingModule) :-
'$do_error'(type_error(atom,ExportingModule),set_base_module(ExportingModule)).
2014-07-27 01:14:15 +01:00
/**
import_module( +ImportingModule, +ExportingModule ) is det
All exported predicates from _ExportingModule_ are automatically available to the
source module _ImportModule_.
This innovation was introduced by SWI-Prolog. By default, modules only
inherit from `prolog`. This extension allows predicates in any module
to inherit from `user`oe other modules.
*/
2009-12-04 11:00:13 +00:00
import_module(Mod, ImportModule) :-
var(Mod),
'$do_error'(instantiation_error,import_module(Mod, ImportModule)).
import_module(Mod, ImportModule) :-
atom(Mod), !,
prolog:'$parent_module'(Mod,ImportModule).
import_module(Mod, EM) :-
'$do_error'(type_error(atom,Mod),import_module(Mod, EM)).
2014-11-02 12:10:32 +00:00
/** add_import_module( + _Module_, + _ImportModule_ , +_Pos_) is det
Add all exports in _ImportModule_ as available to _Module_.
All exported predicates from _ExportModule_ are made available to the
source module _ImportModule_. If _Position_ is bound to `start` the
module _ImportModule_ is tried first, if _Position_ is bound to `end`,
the module is consulted last.
*/
2009-12-04 11:00:13 +00:00
add_import_module(Mod, ImportModule, Pos) :-
var(Mod),
'$do_error'(instantiation_error,add_import_module(Mod, ImportModule, Pos)).
add_import_module(Mod, ImportModule, Pos) :-
var(Pos),
'$do_error'(instantiation_error,add_import_module(Mod, ImportModule, Pos)).
add_import_module(Mod, ImportModule, start) :-
atom(Mod), !,
retractall(prolog:'$parent_module'(Mod,ImportModule)),
asserta(prolog:'$parent_module'(Mod,ImportModule)).
add_import_module(Mod, ImportModule, end) :-
atom(Mod), !,
retractall(prolog:'$parent_module'(Mod,ImportModule)),
assertz(prolog:'$parent_module'(Mod,ImportModule)).
add_import_module(Mod, ImportModule, Pos) :-
\+ atom(Mod), !,
'$do_error'(type_error(atom,Mod),add_import_module(Mod, ImportModule, Pos)).
add_import_module(Mod, ImportModule, Pos) :-
'$do_error'(domain_error(start_end,Pos),add_import_module(Mod, ImportModule, Pos)).
2009-12-04 21:32:36 +00:00
2014-11-02 12:10:32 +00:00
/** delete_import_module( + _ExportModule_, + _ImportModule_ ) is det
Exports in _ImportModule_ are no longer available to _Module_.
All exported predicates from _ExportModule_ are discarded from the
ones used vy the source module _ImportModule_.
*/
2009-12-04 21:32:36 +00:00
delete_import_module(Mod, ImportModule) :-
var(Mod),
'$do_error'(instantiation_error,delete_import_module(Mod, ImportModule)).
delete_import_module(Mod, ImportModule) :-
var(ImportModule),
'$do_error'(instantiation_error,delete_import_module(Mod, ImportModule)).
delete_import_module(Mod, ImportModule) :-
atom(Mod),
atom(ImportModule), !,
retractall(prolog:'$parent_module'(Mod,ImportModule)).
delete_import_module(Mod, ImportModule) :-
\+ atom(Mod), !,
'$do_error'(type_error(atom,Mod),delete_import_module(Mod, ImportModule)).
delete_import_module(Mod, ImportModule) :-
'$do_error'(type_error(atom,ImportModule),delete_import_module(Mod, ImportModule)).
2011-06-14 09:04:03 +01:00
'$set_source_module'(Source0, SourceF) :-
prolog_load_context(module, Source0), !,
module(SourceF).
'$set_source_module'(Source0, SourceF) :-
current_module(Source0, SourceF).
2014-11-02 12:10:32 +00:00
/** module_property( + _Module_, ? _Property_ ) is nondet
Enumerate non-deterministically the main properties of _Module_ .
Reports the following properties of _Module_:
+ `class`( ?_Class_ ): whether it is a `system`, `library`, or `user` module.
+ `line_count`(?_Ls_): number of lines in source file.
+ `file`(?_F_): source file for _Module_.
+ `exports`(-Es): list of all predicate symbols and
operator symbols exported or re-exported by this module.
*/
2014-06-16 15:00:04 +01:00
module_property(Mod, class(L)) :-
'$module_class'(Mod, L).
2013-11-25 15:50:57 +00:00
module_property(Mod, line_count(L)) :-
2014-09-22 18:13:35 +01:00
recorded('$module','$module'(_F,Mod,_,_,L),_).
2011-06-14 09:04:03 +01:00
module_property(Mod, file(F)) :-
2014-09-22 18:13:35 +01:00
recorded('$module','$module'(F,Mod,_,_,_),_).
2011-06-14 09:04:03 +01:00
module_property(Mod, exports(Es)) :-
2014-09-22 18:13:35 +01:00
recorded('$module','$module'(_,Mod,_,Es,_),_).
2011-06-14 09:04:03 +01:00
2014-06-17 15:06:23 +01:00
'$module_class'(Mod, system) :- '$system_module'( Mod ).
'$module_class'(Mod, library) :- '$library_module'( Mod ).
'$module_class'(Mod, user) :- '$user_module'( Mod ).
'$module_class'(_, temporary) :- fail.
'$module_class'(_, test) :- fail.
'$module_class'(_, development) :- fail.
2014-06-16 15:00:04 +01:00
'$library_module'(M1) :-
2014-09-22 18:13:35 +01:00
recorded('$module','$module'(F, M1, _, _MyExports,_Line),_),
2014-06-17 15:06:23 +01:00
user:library_directory(D),
2014-06-16 15:00:04 +01:00
sub_atom(F, 0, _, _, D).
2014-06-17 15:06:23 +01:00
'$user_module'( Mod ) :-
\+ '$library_module'( Mod),
\+ '$system_module'( Mod).
2014-06-16 15:00:04 +01:00
2013-11-08 00:02:38 +00:00
ls_imports :-
recorded('$import','$import'(M0,M,G0,G,_N,_K),_R),
numbervars(G0+G, 0, _),
format('~a:~w <- ~a:~w~n', [M, G, M0, G0]),
fail.
ls_imports.
2014-06-20 11:13:39 +01:00
'$system_module'('$swi').
'$system_module'('$win_menu').
'$system_module'('prolog').
'$system_module'('system').
'$system_module'('$attributes').
2014-09-25 08:50:26 +01:00
unload_module(Mod) :-
clause( '$meta_predicate'(_F,Mod,_N,_P), _, R),
erase(R),
fail.
unload_module(Mod) :-
recorded('$multifile_defs','$defined'(_FileName,_Name,_Arity,Mod), R),
erase(R),
fail.
unload_module(Mod) :-
recorded( '$foreign', Mod:_Foreign, R),
erase(R),
fail.
% remove imported modules
unload_module(Mod) :-
setof( M, recorded('$import',_G0^_G^_N^_K^_R^'$import'(Mod,M,_G0,_G,_N,_K),_R), Ms),
2014-10-07 01:35:41 +01:00
recorded('$module','$module'( _, Mod, _, _, Exports), _),
2014-09-25 08:50:26 +01:00
lists:member(M, Ms),
current_op(X, Y, M:Op),
lists:member( op(X, Y, Op), Exports ),
op(X, 0, M:Op),
fail.
unload_module(Mod) :-
2014-10-07 01:35:41 +01:00
recorded('$module','$module'( _, Mod, _, _, Exports), _),
lists:member( op(X, _Y, Op), Exports ),
2014-09-25 08:50:26 +01:00
op(X, 0, Mod:Op),
fail.
unload_module(Mod) :-
current_predicate(Mod:P),
abolish(P),
fail.
unload_module(Mod) :-
recorded('$import','$import'(Mod,_M,_G0,_G,_N,_K),R),
erase(R),
fail.
unload_module(Mod) :-
recorded('$module','$module'( _, Mod, _, _, _), R),
erase(R),
fail.
2014-07-17 18:19:38 +01:00
/**
2014-07-27 01:14:15 +01:00
@}
@}
2014-07-17 18:19:38 +01:00
**/