yap-6.3/pl/preds.yap

/*************************************************************************
*									 *
  *	 YAP Prolog 							 *
  *									 *
*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
*									 *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
*									 *
**************************************************************************
*									 *
* File:		preds.yap						 *
* Last rev:	8/2/88							 *
* mods:									 *
* comments:	Predicate Manipulation for YAP				 *
*									 *
*************************************************************************/

/**
 * @{
 * @defgroup Database The Clausal Data Base
 * @ingroup builtins

Predicates in YAP may be dynamic or static. By default, when
consulting or reconsulting, predicates are assumed to be static:
execution is faster and the code will probably use less space.
Static predicates impose some restrictions: in general there can be no
addition or removal of  clauses for a procedure if it is being used in the
current execution.

Dynamic predicates allow programmers to change the Clausal Data Base with
the same flexibility as in C-Prolog. With dynamic predicates it is
always possible to add or remove clauses during execution and the
semantics will be the same as for C-Prolog. But the programmer should be
aware of the fact that asserting or retracting are still expensive operations,
and therefore he should try to avoid them whenever possible.

*/

:- system_module( '$_preds', [abolish/1,
        abolish/2,
        assert/1,
        assert/2,
        assert_static/1,
        asserta/1,
        asserta/2,
        asserta_static/1,
        assertz/1,
        assertz/2,
        assertz_static/1,
        clause/2,
        clause/3,
        clause_property/2,
        compile_predicates/1,
        current_key/2,
        current_predicate/1,
        current_predicate/2,
        dynamic_predicate/2,
        hide_predicate/1,
        nth_clause/3,
        predicate_erased_statistics/4,
        predicate_property/2,
        predicate_statistics/4,
        retract/1,
        retract/2,
        retractall/1,
        stash_predicate/1,
        system_predicate/1,
        system_predicate/2,
        unknown/2], ['$assert_static'/5,
        '$assertz_dynamic'/4,
        '$clause'/4,
        '$current_predicate'/4,
        '$init_preds'/0,
        '$noprofile'/2,
        '$public'/2,
        '$unknown_error'/1,
        '$unknown_warning'/1]).

:- use_system_module( '$_boot', ['$check_head_and_body'/4,
        '$check_if_reconsulted'/2,
        '$handle_throw'/3,
        '$head_and_body'/3,
        '$inform_as_reconsulted'/2]).

:- use_system_module( '$_errors', ['$do_error'/2]).

:- use_system_module( '$_init', ['$do_log_upd_clause'/6,
        '$do_log_upd_clause0'/6,
        '$do_log_upd_clause_erase'/6,
        '$do_static_clause'/5]).

:- use_system_module( '$_modules', ['$imported_pred'/4,
        '$meta_predicate'/4,
        '$module_expansion'/5]).

:- use_system_module( '$_preddecls', ['$check_multifile_pred'/3,
        '$dynamic'/2]).

:- use_system_module( '$_strict_iso', ['$check_iso_strict_clause'/1]).

/** @pred  assert_static(: _C_)


Adds clause  _C_ to a static procedure. Asserting a static clause
for a predicate while choice-points for the predicate are available has
undefined results.


*/
assert_static(C) :-
	'$assert'(C , assertz_static, _ ).

/** @pred  asserta_static(: _C_)


Adds clause  _C_ as the first clause for a static procedure.


*/
asserta_static(CI) :-
	'$assert'(C , asserta_static, _ ).


/** @pred  assertz_static(: _C_)


Adds clause  _C_ to the end of a static procedure.  Asserting a
static clause for a predicate while choice-points for the predicate are
available has undefined results.



The following predicates can be used for dynamic predicates and for
static predicates, if source mode was on when they were compiled:




*/
assertz_static(CI) :-
	'$assert'(C , assertz_static, _ ).

/** @pred  clause(+ _H_, _B_) is iso


A clause whose head matches  _H_ is searched for in the
program. Its head and body are respectively unified with  _H_ and
 _B_. If the clause is a unit clause,  _B_ is unified with
 _true_.

This predicate is applicable to static procedures compiled with
`source` active, and to all dynamic procedures.


*/
clause(V0,Q) :-
	'$yap_strip_module'(V0, M, V),
    must_be_of_type( callable, V ),
	'$clause'(V,M,Q,_).

/** @pred  clause(+ _H_, _B_,- _R_)

The same as clause/2, plus  _R_ is unified with the
reference to the clause in the database. You can use instance/2
to access the reference's value. Note that you may not use
erase/1 on the reference on static procedures.
*/
clause(P,Q,R) :-
	'$instance_module'(R,M0), !,
	instance(R,T0),
	( T0 = (H :- B) -> Q = B ; H=T0, Q = true),
    '$yap_strip_module'(P, M, T),
    '$yap_strip_module'(M0:H, M1, H1),
    (
     M == M1
    ->
     H1 = T
    ;
     M1:H1 = T
    ).
clause(V0,Q,R) :-
	'$yap_strip_module'(V0, M, V),
    must_be_of_type( callable, V ),
	'$clause'(V,M,Q,R).

'$clause'(P,M,Q,R) :-
	'$is_exo'(P, M), !,
	Q = true,
	R = '$exo_clause'(M,P),
	'$execute0'(P, M).
'$clause'(P,M,Q,R) :-
	'$is_log_updatable'(P, M), !,
	'$log_update_clause'(P,M,Q,R).
'$clause'(P,M,Q,R) :-
	'$is_source'(P, M), !,
	'$static_clause'(P,M,Q,R).
'$clause'(P,M,Q,R) :-
	'$some_recordedp'(M:P), !,
	'$recordedp'(M:P,(P:-Q),R).
'$clause'(P,M,Q,R) :-
	\+ '$undefined'(P,M),
	( '$is_system_predicate'(P,M) -> true ;
	    '$number_of_clauses'(P,M,N), N > 0 ),
	functor(P,Name,Arity),
	'$do_error'(permission_error(access,private_procedure,Name/Arity),
	      clause(M:P,Q,R)).

'$init_preds' :-
	once('$handle_throw'(_,_,_)),
	fail.
'$init_preds' :-
	once('$do_static_clause'(_,_,_,_,_)),
	fail.
'$init_preds' :-
	once('$do_log_upd_clause0'(_,_,_,_,_,_)),
	fail.
'$init_preds' :-
	once('$do_log_upd_clause'(_,_,_,_,_,_)),
	fail.
'$init_preds' :-
	once('$do_log_upd_clause_erase'(_,_,_,_,_,_)),
	fail.
'$init_preds'.

:- '$init_preds'.

/** @pred  nth_clause(+ _H_, _I_,- _R_)


Find the  _I_th clause in the predicate defining  _H_, and give
a reference to the clause. Alternatively, if the reference  _R_ is
given the head  _H_ is unified with a description of the predicate
and  _I_ is bound to its position.


*/
nth_clause(V,I,R) :-
	strip_module(V, M1, P), !,
	'$nth_clause'(P, M1, I, R).


'$nth_clause'(P,M,I,R) :-
	var(I), var(R), !,
	'$clause'(P,M,_,R),
	'$fetch_nth_clause'(P,M,I,R).
'$nth_clause'(P,M,I,R) :-
	'$fetch_nth_clause'(P,M,I,R).

/** @pred  abolish(+ _P_,+ _N_)

Completely delete the predicate with name _P_ and arity _N_. It will
remove both static and dynamic predicates. All state on the predicate,
including whether it is dynamic or static, multifile, or
meta-predicate, will be lost.
*/
abolish(N0,A) :-
	strip_module(N0, Mod, N), !,
	'$abolish'(N,A,Mod).

'$abolish'(N,A,M) :- var(N), !,
	'$do_error'(instantiation_error,abolish(M:N,A)).
'$abolish'(N,A,M) :- var(A), !,
	'$do_error'(instantiation_error,abolish(M:N,A)).
'$abolish'(N,A,M) :-
	( recorded('$predicate_defs','$predicate_defs'(N,A,M,_),R) -> erase(R) ),
	fail.
'$abolish'(N,A,M) :- functor(T,N,A),
		( '$is_dynamic'(T, M) -> '$abolishd'(T,M) ;
	      	 /* else */	      '$abolishs'(T,M) ).

/** @pred  abolish(+ _PredSpec_) is iso


Deletes the predicate given by  _PredSpec_ from the database. If
§§ _PredSpec_ is an unbound variable, delete all predicates for the
current module. The
specification must include the name and arity, and it may include module
information. Under <tt>iso</tt> language mode this built-in will only abolish
dynamic procedures. Under other modes it will abolish any procedures.


*/
abolish(X0) :-
	strip_module(X0,M,X),
	'$abolish'(X,M).

'$abolish'(X,M) :-
	current_prolog_flag(language, sicstus), !,
	'$new_abolish'(X,M).
'$abolish'(X, M) :-
	'$old_abolish'(X,M).

'$new_abolish'(V,M) :- var(V), !,
	'$abolish_all'(M).
'$new_abolish'(A,M) :- atom(A), !,
	'$abolish_all_atoms'(A,M).
'$new_abolish'(Na//Ar1, M) :-
	integer(Ar1),
	!,
	Ar is Ar1+2,
	'$new_abolish'(Na//Ar, M).
'$new_abolish'(Na/Ar, M) :-
	functor(H, Na, Ar),
	'$is_dynamic'(H, M), !,
	'$abolishd'(H, M).
'$new_abolish'(Na/Ar, M) :- % succeed for undefined procedures.
	functor(T, Na, Ar),
	'$undefined'(T, M), !.
'$new_abolish'(Na/Ar, M) :-
	'$do_error'(permission_error(modify,static_procedure,Na/Ar),abolish(M:Na/Ar)).
'$new_abolish'(T, M) :-
	'$do_error'(type_error(predicate_indicator,T),abolish(M:T)).

'$abolish_all'(M) :-
        '$current_predicate'(Na, M, S, _),
        functor(S, Na, Ar),
	'$new_abolish'(Na/Ar, M),
	fail.
'$abolish_all'(_).

'$abolish_all_atoms'(Na, M) :-
        '$current_predicate'(Na,M,S,_),
        functor(S, Na, Ar),
	'$new_abolish'(Na/Ar, M),
	fail.
'$abolish_all_atoms'(_,_).

'$check_error_in_predicate_indicator'(V, Msg) :-
	var(V), !,
	'$do_error'(instantiation_error, Msg).
'$check_error_in_predicate_indicator'(M:S, Msg) :- !,
	'$check_error_in_module'(M, Msg),
	'$check_error_in_predicate_indicator'(S, Msg).
'$check_error_in_predicate_indicator'(S, Msg) :-
	S \= _/_,
	S \= _//_, !,
	'$do_error'(type_error(predicate_indicator,S), Msg).
'$check_error_in_predicate_indicator'(Na/_, Msg) :-
	var(Na), !,
	'$do_error'(instantiation_error, Msg).
'$check_error_in_predicate_indicator'(Na/_, Msg) :-
	\+ atom(Na), !,
	'$do_error'(type_error(atom,Na), Msg).
'$check_error_in_predicate_indicator'(_/Ar, Msg) :-
	var(Ar), !,
	'$do_error'(instantiation_error, Msg).
'$check_error_in_predicate_indicator'(_/Ar, Msg) :-
	\+ integer(Ar), !,
	'$do_error'(type_error(integer,Ar), Msg).
'$check_error_in_predicate_indicator'(_/Ar, Msg) :-
	Ar < 0, !,
	'$do_error'(domain_error(not_less_than_zero,Ar), Msg).
% not yet implemented!
%'$check_error_in_predicate_indicator'(Na/Ar, Msg) :-
%	Ar < maxarity, !,
%	'$do_error'(type_error(representation_error(max_arity),Ar), Msg).

'$check_error_in_module'(M, Msg) :-
	var(M), !,
	'$do_error'(instantiation_error, Msg).
'$check_error_in_module'(M, Msg) :-
	\+ atom(M), !,
	'$do_error'(type_error(atom,M), Msg).

'$old_abolish'(V,M) :- var(V), !,
	( true -> % current_prolog_flag(language, sicstus) ->
	    '$do_error'(instantiation_error,abolish(M:V))
	;
	    '$abolish_all_old'(M)
	).
'$old_abolish'(N/A, M) :- !,
	'$abolish'(N, A, M).
'$old_abolish'(A,M) :- atom(A), !,
	( current_prolog_flag(language, iso) ->
	  '$do_error'(type_error(predicate_indicator,A),abolish(M:A))
	;
	    '$abolish_all_atoms_old'(A,M)
	).
'$old_abolish'([], _) :- !.
'$old_abolish'([H|T], M) :- !,  '$old_abolish'(H, M), '$old_abolish'(T, M).
'$old_abolish'(T, M) :-
	'$do_error'(type_error(predicate_indicator,T),abolish(M:T)).

'$abolish_all_old'(M) :-
        '$current_predicate'(Na, M, S, _),
	functor( S, Na, Ar ),
	'$abolish'(Na, Ar, M),
	fail.
'$abolish_all_old'(_).

'$abolish_all_atoms_old'(Na, M) :-
        '$current_predicate'(Na, M, S, _),
	functor(S, Na, Ar),
	'$abolish'(Na, Ar, M),
	fail.
'$abolish_all_atoms_old'(_,_).

'$abolishs'(G, M) :- '$system_predicate'(G,M), !,
	functor(G,Name,Arity),
	'$do_error'(permission_error(modify,static_procedure,Name/Arity),abolish(M:G)).
'$abolishs'(G, Module) :-
	current_prolog_flag(language, sicstus), % only do this in sicstus mode
	'$undefined'(G, Module),
	functor(G,Name,Arity),
	print_message(warning,no_match(abolish(Module:Name/Arity))).
'$abolishs'(G, M) :-
	'$is_multifile'(G,M),
	functor(G,Name,Arity),
	recorded('$mf','$mf_clause'(_,Name,Arity,M,_Ref),R),
	erase(R),
% no need	erase(Ref),
	fail.
'$abolishs'(T, M) :-
	recorded('$import','$import'(_,M,_,_,T,_,_),R),
	erase(R),
	fail.
'$abolishs'(G, M) :-
	'$purge_clauses'(G, M), fail.
'$abolishs'(_, _).

/**  @pred stash_predicate(+ _Pred_) @anchor stash_predicate
Make predicate  _Pred_ invisible to new code, and to `current_predicate/2`,
`listing`, and friends. New predicates with the same name and
functor can be declared.
 **/
stash_predicate(P0) :-
	strip_module(P0, M, P),
	'$stash_predicate2'(P, M).

'$stash_predicate2'(V, M) :- var(V), !,
	'$do_error'(instantiation_error,stash_predicate(M:V)).
'$stash_predicate2'(N/A, M) :- !,
	functor(S,N,A),
	'$stash_predicate'(S, M) .
'$stash_predicate2'(PredDesc, M) :-
	'$do_error'(type_error(predicate_indicator,PredDesc),stash_predicate(M:PredDesc)).

/** @pred hide_predicate(+ _Pred_)
Make predicate  _Pred_ invisible to `current_predicate/2`,
`listing`, and friends.

 **/
hide_predicate(P0) :-
	'$yap_strip_module'(P0, M, P),
	must_be_of_type(callable, M:P),
	'$hide_predicate'(P, M).

/** @pred  predicate_property( _P_, _Prop_) is iso


For the predicates obeying the specification  _P_ unify  _Prop_
  with a property of  _P_. These properties may be:

+ `built_in `
true for built-in predicates,

+ `dynamic`
true if the predicate is dynamic

+ `static `
true if the predicate is static

+ `meta_predicate( _M_) `
true if the predicate has a meta_predicate declaration  _M_.

+ `multifile `
true if the predicate was declared to be multifile

+ `imported_from( _Mod_) `
true if the predicate was imported from module  _Mod_.

+ `exported `
true if the predicate is exported in the current module.

+ `public`
true if the predicate is public; note that all dynamic predicates are
public.

+ `tabled `
true if the predicate is tabled; note that only static predicates can
be tabled in YAP.

+ `source (predicate_property flag) `
true if source for the predicate is available.

+ `number_of_clauses( _ClauseCount_) `
Number of clauses in the predicate definition. Always one if external
or built-in.

*/
predicate_property(Pred,Prop) :-
	strip_module(Pred, Mod, TruePred),
	'$predicate_property2'(TruePred,Prop,Mod).

'$predicate_property2'(Pred, Prop, Mod) :-
	var(Mod), !,
	'$all_current_modules'(Mod),
	'$predicate_property2'(Pred, Prop, Mod).
'$predicate_property2'(Pred,Prop,M0) :-
	var(Pred), !,
	(M = M0 ;
	 M0 \= prolog, M = prolog ;
	 M0 \= user, M = user), % prolog and user modules are automatically incorporate in every other module
	'$generate_all_preds_from_mod'(Pred, SourceMod, M),
	'$predicate_property'(Pred,SourceMod,M,Prop).
'$predicate_property2'(M:Pred,Prop,_) :- !,
	'$predicate_property2'(Pred,Prop,M).
'$predicate_property2'(Pred,Prop,Mod) :-
	'$pred_exists'(Pred,Mod), !,
	'$predicate_property'(Pred,Mod,Mod,Prop).
'$predicate_property2'(Pred,Prop,Mod) :-
    '$get_undefined_pred'(Pred, Mod, NPred, M),
	(
	 Prop = imported_from(M)
	;
	 '$predicate_property'(NPred,M,M,Prop),
	 Prop \= exported
	).

'$generate_all_preds_from_mod'(Pred, M, M) :-
	'$current_predicate'(_Na,M,Pred,_).
'$generate_all_preds_from_mod'(Pred, SourceMod, Mod) :-
	recorded('$import','$import'(SourceMod, Mod, Orig, Pred,_,_),_),
	'$pred_exists'(Orig, SourceMod).

'$predicate_property'(P,M,_,built_in) :-
	'$is_system_predicate'(P,M).
'$predicate_property'(P,M,_,source) :-
	'$predicate_flags'(P,M,F,F),
	F /\ 0x00400000 =\= 0.
'$predicate_property'(P,M,_,tabled) :-
	'$predicate_flags'(P,M,F,F),
	F /\ 0x00000040 =\= 0.
'$predicate_property'(P,M,_,dynamic) :-
	'$is_dynamic'(P,M).
'$predicate_property'(P,M,_,static) :-
	\+ '$is_dynamic'(P,M),
	\+ '$undefined'(P,M).
'$predicate_property'(P,M,_,meta_predicate(Q)) :-
	functor(P,Na,Ar),
	prolog:'$meta_predicate'(Na,M,Ar,Q).
'$predicate_property'(P,M,_,multifile) :-
	'$is_multifile'(P,M).
'$predicate_property'(P,M,_,public) :-
	'$is_public'(P,M).
'$predicate_property'(P,M,_,thread_local) :-
	'$is_thread_local'(P,M).
'$predicate_property'(P,M,M,exported) :-
	functor(P,N,A),
	once(recorded('$module','$module'(_TFN,M,_S,Publics,_L),_)),
	lists:memberchk(N/A,Publics).
'$predicate_property'(P,Mod,_,number_of_clauses(NCl)) :-
	'$number_of_clauses'(P,Mod,NCl).
'$predicate_property'(P,Mod,_,file(F)) :-
	'$owner_file'(P,Mod,F).


/**
  @pred  predicate_statistics( _P_, _NCls_, _Sz_, _IndexSz_)

Given predicate  _P_,  _NCls_ is the number of clauses for
 _P_,  _Sz_ is the amount of space taken to store those clauses
(in bytes), and  _IndexSz_ is the amount of space required to store
indices to those clauses (in bytes).
*/
predicate_statistics(V,NCls,Sz,ISz) :- var(V), !,
	'$do_error'(instantiation_error,predicate_statistics(V,NCls,Sz,ISz)).
predicate_statistics(P0,NCls,Sz,ISz) :-
	strip_module(P0, M, P),
	'$predicate_statistics'(P,M,NCls,Sz,ISz).

'$predicate_statistics'(M:P,_,NCls,Sz,ISz) :- !,
	'$predicate_statistics'(P,M,NCls,Sz,ISz).
'$predicate_statistics'(P,M,NCls,Sz,ISz) :-
	'$is_log_updatable'(P, M), !,
	'$lu_statistics'(P,NCls,Sz,ISz,M).
'$predicate_statistics'(P,M,_,_,_) :-
	'$is_system_predicate'(P,M), !, fail.
'$predicate_statistics'(P,M,_,_,_) :-
	'$undefined'(P,M), !, fail.
'$predicate_statistics'(P,M,NCls,Sz,ISz) :-
	'$static_pred_statistics'(P,M,NCls,Sz,ISz).

/** @pred  predicate_erased_statistics( _P_, _NCls_, _Sz_, _IndexSz_)


Given predicate  _P_,  _NCls_ is the number of erased clauses for
 _P_ that could not be discarded yet,  _Sz_ is the amount of space
taken to store those clauses (in bytes), and  _IndexSz_ is the amount
of space required to store indices to those clauses (in bytes).

 */
predicate_erased_statistics(P,NCls,Sz,ISz) :-
        var(P), !,
	current_predicate(_,P),
	predicate_erased_statistics(P,NCls,Sz,ISz).
predicate_erased_statistics(P0,NCls,Sz,ISz) :-
	strip_module(P0,M,P),
	'$predicate_erased_statistics'(M:P,NCls,Sz,_,ISz).

/** @pred  current_predicate( _A_, _P_)

Defines the relation:  _P_ is a currently defined predicate whose name is the atom  _A_.
*/
current_predicate(A,T0) :-
	'$yap_strip_module'(T0, M, T),
    (
     '$current_predicate'(A,M, T, user)
    ;
     '$imported_predicate'(T, M, T1, M1),
     \+ '$is_system_predicate'(T1,M1)
    ).

/** @pred  system_predicate( ?_P_ )

Defines the relation:  indicator _P_ refers to a currently defined system predicate.
*/
system_predicate(P0) :-
	'$yap_strip_module'(P0, M, P),
    (
      var(P)
    ->
      P = A/Arity,
     '$current_predicate'(A, M, T, system),
     functor(T, A, Arity),
     '$is_system_predicate'( T,  M)
    ;
      ground(P), P = A/Arity
    ->
     functor(T, A, Arity),
     '$current_predicate'(A, M, T, system),
     '$is_system_predicate'( T, M)
    ;
      ground(P), P = A//Arity2
    ->
     Arity is Arity2+2,
     functor(T, A, Arity),
     '$current_predicate'(A, M, T, system),
     '$is_system_predicate'( T, M)
    ;
     P = A/Arity
    ->
     '$current_predicate'(A, M, T, system),
     '$is_system_predicate'( T,  M),
     functor(T, A, Arity)
    ;
     P = A//Arity2
    ->
     '$current_predicate'(A, M, T, system),
     '$is_system_predicate'( T,  M),
     functor(T, A, Arity),
     Arity >= 2,
     Arity2 is Arity-2
    ;
    '$do_error'(type_error(predicate_indicator,P),
                system_predicate(P0))
    ).


/**
  @pred  current_predicate( _F_) is iso

  True if _F_ is the predicate indicator for a currently defined user or
  library predicate.The indicator  _F_ is of the form _Mod_:_Na_/_Ar_ or _Na/Ar_,
  where the atom _Mod_ is the module of the predicate,
 _Na_ is the name of the predicate, and  _Ar_ its arity.
*/
current_predicate(F0) :-
	'$yap_strip_module'(F0, M, F),
	(var(F) ->
     F = A/N,
	 current_predicate(A, M:S),
     functor(S, A, N)
	;
	 (
	  functor(F,AN,2)
	 ->
	   true
	 ;
	  '$do_error'(type_error(predicate_indicator,F0),
		      current_predicate(F0))
	 ),
	 arg(1,F,A),
	 (atom(A) -> true ;
	  var(A) -> true ;
	  '$do_error'(type_error(predicate_indicator,F0),current_predicate(F0))
	 ),
	 arg(2,F,N),
	 (integer(N) -> true ;
	  var(N) -> true ;
	  '$do_error'(type_error(predicate_indicator,F0),current_predicate(F0))
	 ),
	 ( AN == '/'
	 ->
	   current_predicate(A, M:S),
	   functor( S, A, N)
	 ;
	   AN == '//'
	 ->
	   current_predicate(A, M:S),
	   Ar2 is N+2,
	   functor( S, A, Ar2)
	 ;
	   '$do_error'(type_error(predicate_indicator,F0),current_predicate(F0))
	 )
	).


'$imported_predicate'(A, ImportingMod, A/Arity, G, Flags) :-
	'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod),
	functor(G, A, Arity),
	'$pred_exists'(G, ExportingMod),
	'$predicate_flags'(G0, ExportingMod, Flags, Flags).

/** @pred  current_key(? _A_,? _K_)


Defines the relation:  _K_ is a currently defined database key whose
name is the atom  _A_. It can be used to generate all the keys for
  the internal data-base.
*/
current_key(A,K) :-
	'$current_predicate'(A,idb,K,user).

% do nothing for now.
'$noprofile'(_, _).

'$ifunctor'(Pred,Na,Ar) :-
	(Ar > 0 ->
	    functor(Pred, Na, Ar)
	;
	     Pred = Na
	 ).


/** @pred  compile_predicates(: _ListOfNameArity_)



Compile a list of specified dynamic predicates (see dynamic/1 and
assert/1 into normal static predicates. This call tells the
Prolog environment the definition will not change anymore and further
calls to assert/1 or retract/1 on the named predicates
raise a permission error. This predicate is designed to deal with parts
of the program that is generated at runtime but does not change during
the remainder of the program execution.
 */
compile_predicates(Ps) :-
	'$current_module'(Mod),
	'$compile_predicates'(Ps, Mod, compile_predicates(Ps)).

'$compile_predicates'(V, _, Call) :-
	var(V), !,
	'$do_error'(instantiation_error,Call).
'$compile_predicates'(M:Ps, _, Call) :-
	'$compile_predicates'(Ps, M, Call).
'$compile_predicates'([], _, _).
'$compile_predicates'([P|Ps], M, Call) :-
	'$compile_predicate'(P, M, Call),
	'$compile_predicates'(Ps, M, Call).

'$compile_predicate'(P, _M, Call) :-
	var(P), !,
	'$do_error'(instantiation_error,Call).
'$compile_predicate'(M:P, _, Call) :-
	'$compile_predicate'(P, M, Call).
'$compile_predicate'(Na/Ar, Mod, _Call) :-
	functor(G, Na, Ar),
	findall((G.B),clause(Mod:G,B),Cls),
	abolish(Mod:Na,Ar),
	'$add_all'(Cls, Mod).

'$add_all'([], _).
'$add_all'((G.B).Cls, Mod) :-
	assert_static(Mod:(G:-B)),
	'$add_all'(Cls, Mod).


clause_property(ClauseRef, file(FileName)) :-
	( recorded('$mf','$mf_clause'(FileName,_Name,_Arity,_Module,ClauseRef),_R)
	-> true
	;
	instance_property(ClauseRef, 2, FileName) ).
clause_property(ClauseRef, source(FileName)) :-
	( recorded('$mf','$mf_clause'(FileName,_Name,_Arity,_Module,ClauseRef),_R)
	-> true
	;
	instance_property(ClauseRef, 2, FileName) ).
clause_property(ClauseRef, line_count(LineNumber)) :-
	instance_property(ClauseRef, 4, LineNumber),
	LineNumber > 0.
clause_property(ClauseRef, fact) :-
	instance_property(ClauseRef, 3, true).
clause_property(ClauseRef, erased) :-
	instance_property(ClauseRef, 0, true).
clause_property(ClauseRef, predicate(PredicateIndicator)) :-
	instance_property(ClauseRef, 1, PredicateIndicator).

'$set_predicate_attribute'(M:N/Ar, Flag, V) :-
	functor(P, N, Ar),
	'$set_flag'(P, M, Flag, V).


/**
@}
*/