reorg of predicate handling
use strip_module for clearer code. - separate dynamic predicates - separate declarations
This commit is contained in:
Vítor Santos Costa
parent
d2ad352f78
commit
3eda5cf68a
@ -181,13 +181,19 @@ Since YAP4.3.0 multifile procedures can be static or dynamic.
|
||||
|
||||
**/
|
||||
multifile(P) :-
|
||||
'$current_module'(OM),
|
||||
'$multifile'(P, OM).
|
||||
strip_module(P, OM, Pred),
|
||||
'$multifile'(Pred, OM).
|
||||
|
||||
'$multifile'(V, _) :- var(V), !,
|
||||
'$multifile'(V, _) :-
|
||||
var(V),
|
||||
!,
|
||||
'$do_error'(instantiation_error,multifile(V)).
|
||||
'$multifile'((X,Y), M) :- !, '$multifile'(X, M), '$multifile'(Y, M).
|
||||
'$multifile'(Mod:PredSpec, _) :- !,
|
||||
'$multifile'((X,Y), M) :-
|
||||
!,
|
||||
'$multifile'(X, M),
|
||||
'$multifile'(Y, M).
|
||||
'$multifile'(Mod:PredSpec, _) :-
|
||||
!,
|
||||
'$multifile'(PredSpec, Mod).
|
||||
'$multifile'(N//A, M) :- !,
|
||||
integer(A),
|
||||
@ -197,7 +203,7 @@ multifile(P) :-
|
||||
'$add_multifile'(N,A,M),
|
||||
fail.
|
||||
'$multifile'(N/A, M) :-
|
||||
functor(S,N,A),
|
||||
functor(S,N,A),
|
||||
'$is_multifile'(S, M), !.
|
||||
'$multifile'(N/A, M) :- !,
|
||||
'$new_multifile'(N,A,M).
|
||||
@ -261,3 +267,32 @@ discontiguous(F) :-
|
||||
'$predicate_flags'(T,Mod,F,F),
|
||||
F\/0x00400000 =\= 0.
|
||||
|
||||
/**
|
||||
@pred module_transparent( + _Preds_ ) is directive
|
||||
_Preds_ is a list of predicates that can access the calling context.
|
||||
|
||||
This predicate was implemented to achieve compatibility with the older
|
||||
module expansion system in SWI-Prolog. Please use meta_predicate/1 for
|
||||
new code.
|
||||
|
||||
_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 caller.
|
||||
|
||||
*/
|
||||
:- 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)),
|
||||
'$predicate_flags'(P, M, Fl, Fl),
|
||||
NFlags is Fl \/ 0x200004,
|
||||
'$pre_dicate_flags'(P, M, Fl, NFlags).
|
||||
|
||||
267
pl/preddyns.yap
267
pl/preddyns.yap
@ -1,5 +1,5 @@
|
||||
% The next predicates are applicable only
|
||||
% to dynamic code
|
||||
% The next predicates are applicable only
|
||||
% to dynamic code
|
||||
|
||||
/** @file preddyns.yap */
|
||||
|
||||
@ -18,9 +18,8 @@ Adds clause _C_ to the beginning of the program. If the predicate is
|
||||
undefined, it is declared dynamic (see dynamic/1).
|
||||
|
||||
*/
|
||||
asserta(C) :-
|
||||
strip_module(C, Mod, NC),
|
||||
'$assert'(NC,Mod,first,_,asserta(C)).
|
||||
asserta(Clause) :-
|
||||
'$assert'(Clause, asserta, _).
|
||||
|
||||
/** @pred assertz(+ _C_) is iso
|
||||
|
||||
@ -32,9 +31,8 @@ Most Prolog systems only allow asserting clauses for dynamic
|
||||
predicates. This is also as specified in the ISO standard. YAP also allows
|
||||
asserting clauses for static predicates, under the restriction that the static predicate may not be live in the stacks.
|
||||
*/
|
||||
assertz(C) :-
|
||||
strip_module(C,Mod,C1),
|
||||
'$assert'(C1,Mod,last,_,assertz(C)).
|
||||
assertz(Clause) :-
|
||||
'$assert'(Clause, assertz, _).
|
||||
|
||||
/** @pred assert(+ _C_)
|
||||
|
||||
@ -49,90 +47,12 @@ deprecated, if you want to assert clauses for static procedures you
|
||||
should use assert_static/1.
|
||||
|
||||
*/
|
||||
assert(C) :-
|
||||
strip_module(C,Mod,C1),
|
||||
'$assert'(C1,Mod,last,_,assert(C)).
|
||||
assert(Clause) :-
|
||||
'$assert'(Clause, assertz, _).
|
||||
|
||||
'$assert'(V,Mod,_,_,_) :- var(V), !,
|
||||
'$do_error'(instantiation_error,assert(Mod:V)).
|
||||
'$assert'(V,Mod,_,_,_) :- var(Mod), !,
|
||||
'$do_error'(instantiation_error,assert(Mod:V)).
|
||||
'$assert'(I,Mod,_,_,_) :- number(I), !,
|
||||
'$do_error'(type_error(callable,I),assert(Mod:I)).
|
||||
'$assert'(M:C,_,Where,R,P) :- !,
|
||||
strip_module(M:C, M1, C1),
|
||||
'$assert'(C1,M1,Where,R,P).
|
||||
'$assert'((H:-G),M,Where,R,P) :- !,
|
||||
'$assert_clause'(H, G, M, Where, R, P).
|
||||
'$assert'(H,M,Where,R,_) :-
|
||||
'$assert_fact'(H, M, Where, R).
|
||||
|
||||
'$assert_fact'(H,Mod,Where,R) :-
|
||||
functor(H, Na, Ar),
|
||||
( '$undefined'(H,Mod) ->
|
||||
'$dynamic'(Na/Ar, Mod)
|
||||
;
|
||||
true
|
||||
),
|
||||
( '$is_log_updatable'(H, Mod) ->
|
||||
'$compile_dynamic'(H, Where, H, Mod, R)
|
||||
;
|
||||
'$is_dynamic'(H, Mod) ->
|
||||
'$assertat_d'(Where, H, true, H, Mod, R)
|
||||
;
|
||||
% try asserting as static, see what happens
|
||||
Where = last ->
|
||||
assert_static(Mod:H)
|
||||
;
|
||||
asserta_static(Mod:H)
|
||||
).
|
||||
|
||||
'$assert_clause'(H, _, _, _, _, P) :-
|
||||
var(H), !,
|
||||
'$do_error'(instantiation_error,P).
|
||||
'$assert_clause'(M:C, G, MG, Where, R, P) :-
|
||||
!,
|
||||
strip_module(M:C, M1, C1),
|
||||
'$assert_clause2'(C1, MG:G, M1, Where, R, P).
|
||||
'$assert_clause'(H1, B1, Mod, Where, R, P) :-
|
||||
'$expand_clause'((H1 :- B1),C0,C,Mod,Mod),
|
||||
'$check_head_and_body'(C,H,B,P),
|
||||
( '$is_log_updatable'(H, Mod) ->
|
||||
'$compile_dynamic'((H :- B), Where, C0, Mod, R)
|
||||
;
|
||||
'$is_dynamic'(H, Mod) ->
|
||||
'$assertat_d'(Where, H, B, C0, Mod, R)
|
||||
;
|
||||
Where = last
|
||||
->
|
||||
assert_static(Mod:(H :- B))
|
||||
;
|
||||
asserta_static(Mod:(H :- B))
|
||||
).
|
||||
|
||||
'$assert_clause2'(HI,BI,Mod,Where,R,P) :-
|
||||
'$expand_clause'((HI :- BI),C0,C,Mod,HM),
|
||||
'$assert_clause3'(C0,C,HM,Where,R,P).
|
||||
|
||||
'$assert_clause3'(C0,C,Mod,Where,R,P) :-
|
||||
'$check_head_and_body'(C,H,B,P),
|
||||
( '$is_log_updatable'(H, Mod) ->
|
||||
'$compile_dynamic'((H :- B), Where, C0, Mod, R)
|
||||
;
|
||||
'$is_dynamic'(H, Mod) ->
|
||||
'$assertat_d'(Where, H, B, C0, Mod, R)
|
||||
;
|
||||
'$undefined'(H,Mod) ->
|
||||
functor(H, Na, Ar),
|
||||
dynamic(Mod:Na/Ar),
|
||||
'$assert_clause3'(C0,C,Mod,Where,R,P)
|
||||
;
|
||||
current_prolog_flag(language, sicstus) -> % I can assert over static facts in YAP mode
|
||||
'$assert1'(Where,C,C0,Mod,H)
|
||||
;
|
||||
functor(H, Na, Ar),
|
||||
'$do_error'(permission_error(modify,static_procedure,Na/Ar),P)
|
||||
).
|
||||
'$assert'(Clause, Where, R) :-
|
||||
'$expand_clause'(Clause,C0,C),
|
||||
'$$compile'(C, Where, C0, R).
|
||||
|
||||
/** @pred asserta(+ _C_,- _R_)
|
||||
|
||||
@ -143,9 +63,8 @@ predicates. If the predicate is undefined, it will automatically be
|
||||
declared dynamic.
|
||||
|
||||
*/
|
||||
asserta(C,R) :-
|
||||
strip_module(C, M, C1),
|
||||
'$assert'(C1,M,first,R,asserta(C,R)).
|
||||
asserta(Clause, Ref) :-
|
||||
'$assert'(Clause, first, Ref).
|
||||
|
||||
/** @pred assertz(+ _C_,- _R_)
|
||||
|
||||
@ -157,11 +76,8 @@ declared dynamic.
|
||||
|
||||
|
||||
*/
|
||||
assertz(M:C,R) :- !,
|
||||
'$assert_dynamic'(C,M,last,R,assertz(M:C,R)).
|
||||
assertz(C,R) :-
|
||||
'$current_module'(M),
|
||||
'$assert_dynamic'(C,M,last,R,assertz(C,R)).
|
||||
assertz(Clause, Ref) :-
|
||||
'$assert'(Clause, last, Ref).
|
||||
|
||||
/** @pred assert(+ _C_,- _R_)
|
||||
|
||||
@ -173,27 +89,26 @@ declared dynamic.
|
||||
|
||||
|
||||
*/
|
||||
assert(M:C,R) :- !,
|
||||
'$assert_dynamic'(C,M,last,R,assert(M:C,R)).
|
||||
assert(C,R) :-
|
||||
'$current_module'(M),
|
||||
'$assert_dynamic'(C,M,last,R,assert(C,R)).
|
||||
assert(Clause, Ref) :-
|
||||
'$assert'(Clause, last, Ref).
|
||||
|
||||
|
||||
'$assertz_dynamic'(X, C, C0, Mod) :- (X/\4)=:=0, !,
|
||||
'$head_and_body'(C,H,B),
|
||||
'$assertat_d'(last,H,B,C0,Mod,_).
|
||||
'$assertz_dynamic'(X, C, C0, Mod) :-
|
||||
(X/\4)=:=0,
|
||||
!,
|
||||
'$head_and_body'(C,H,B),
|
||||
'$assertat_d'(last,H,B,C0,Mod,_).
|
||||
'$assertz_dynamic'(X,C,C0,Mod) :-
|
||||
'$head_and_body'(C,H,B),
|
||||
functor(H,N,A),
|
||||
('$check_if_reconsulted'(N,A) ->
|
||||
true
|
||||
;
|
||||
(X/\8)=:=0 ->
|
||||
'$inform_as_reconsulted'(N,A),
|
||||
'$remove_all_d_clauses'(H,Mod)
|
||||
;
|
||||
true
|
||||
true
|
||||
;
|
||||
(X/\8)=:=0 ->
|
||||
'$inform_as_reconsulted'(N,A),
|
||||
'$remove_all_d_clauses'(H,Mod)
|
||||
;
|
||||
true
|
||||
),
|
||||
'$assertat_d'(last,H,B,C0,Mod,_).
|
||||
|
||||
@ -216,39 +131,39 @@ assert(C,R) :-
|
||||
|
||||
'$assertat_d'(first,Head,Body,C0,Mod,R) :- !,
|
||||
'$compile_dynamic'((Head:-Body), first, C0, Mod, CR),
|
||||
( get_value('$abol',true)
|
||||
->
|
||||
'$predicate_flags'(Head,Mod,Fl,Fl),
|
||||
( Fl /\ 0x20000000 =\= 0 -> '$check_multifile_pred'(Head,Mod,Fl) ; true )
|
||||
;
|
||||
true
|
||||
),
|
||||
( get_value('$abol',true)
|
||||
->
|
||||
'$predicate_flags'(Head,Mod,Fl,Fl),
|
||||
( Fl /\ 0x20000000 =\= 0 -> '$check_multifile_pred'(Head,Mod,Fl) ; true )
|
||||
;
|
||||
true
|
||||
),
|
||||
'$head_and_body'(C0, H0, B0),
|
||||
'$recordap'(Mod:Head,(H0 :- B0),R,CR),
|
||||
( '$is_multifile'(Head, Mod) ->
|
||||
source_location(F, _),
|
||||
functor(H0, Na, Ar),
|
||||
recorda('$multifile_dynamic'(_,_,_), '$mf'(Na,Ar,Mod,F,R), _)
|
||||
source_location(F, _),
|
||||
functor(H0, Na, Ar),
|
||||
recorda('$multifile_dynamic'(_,_,_), '$mf'(Na,Ar,Mod,F,R), _)
|
||||
;
|
||||
true
|
||||
true
|
||||
).
|
||||
'$assertat_d'(last,Head,Body,C0,Mod,R) :-
|
||||
'$compile_dynamic'((Head:-Body), last, C0, Mod, CR),
|
||||
( get_value('$abol',true)
|
||||
->
|
||||
'$predicate_flags'(Head,Mod,Fl,Fl),
|
||||
( Fl /\ 0x20000000 =\= 0 -> '$check_multifile_pred'(Head,Mod,Fl) ; true )
|
||||
;
|
||||
true
|
||||
),
|
||||
( get_value('$abol',true)
|
||||
->
|
||||
'$predicate_flags'(Head,Mod,Fl,Fl),
|
||||
( Fl /\ 0x20000000 =\= 0 -> '$check_multifile_pred'(Head,Mod,Fl) ; true )
|
||||
;
|
||||
true
|
||||
),
|
||||
'$head_and_body'(C0, H0, B0),
|
||||
'$recordzp'(Mod:Head,(H0 :- B0),R,CR),
|
||||
( '$is_multifile'(H0, Mod) ->
|
||||
source_location(F, _),
|
||||
functor(H0, Na, Ar),
|
||||
recordz('$multifile_dynamic'(_,_,_), '$mf'(Na,Ar,Mod,F,R), _)
|
||||
source_location(F, _),
|
||||
functor(H0, Na, Ar),
|
||||
recordz('$multifile_dynamic'(_,_,_), '$mf'(Na,Ar,Mod,F,R), _)
|
||||
;
|
||||
true
|
||||
true
|
||||
).
|
||||
|
||||
/** @pred retract(+ _C_) is iso
|
||||
@ -261,30 +176,20 @@ source/0 ( (see Setting the Compiler)).
|
||||
|
||||
|
||||
*/
|
||||
retract(M:C) :- !,
|
||||
'$retract'(C,M).
|
||||
retract(C) :-
|
||||
'$current_module'(M),
|
||||
'$retract'(C,M).
|
||||
|
||||
|
||||
'$retract'(V,_) :- var(V), !,
|
||||
'$do_error'(instantiation_error,retract(V)).
|
||||
'$retract'(M:C,_) :- !,
|
||||
'$retract'(C,M).
|
||||
'$retract'(C,M) :-
|
||||
'$check_head_and_body'(C,H,B,retract(M:C)), !,
|
||||
retract( C ) :-
|
||||
strip_module( C, M, H0),
|
||||
'$check_head_and_body'(M:H0,_M,H,B,retract(M:C)),
|
||||
'$predicate_flags'(H, M, F, F),
|
||||
'$retract2'(F, H,M,B,_).
|
||||
|
||||
'$retract2'(F, H, M, B, R) :-
|
||||
F /\ 0x08000000 =:= 0x08000000, !,
|
||||
% '$is_log_updatable'(H, M), !,
|
||||
% '$is_log_updatable'(H, M), !,
|
||||
'$log_update_clause'(H,M,B,R),
|
||||
( F /\ 0x20000000 =:= 0x20000000, recorded('$mf','$mf_clause'(_,_,_,_,R),MR), erase(MR), fail ; true),
|
||||
erase(R).
|
||||
'$retract2'(F, H, M, B, R) :-
|
||||
% '$is_dynamic'(H,M), !,
|
||||
% '$is_dynamic'(H,M), !,
|
||||
F /\ 0x00002000 =:= 0x00002000, !,
|
||||
'$recordedp'(M:H,(H:-B),R),
|
||||
( F /\ 0x20000000 =:= 0x20000000, recorded('$mf','$mf_clause'(_,_,_,_,MRef),MR), erase(MR), erase(MRef), fail ; true),
|
||||
@ -296,6 +201,7 @@ retract(C) :-
|
||||
fail.
|
||||
'$retract2'(_, H,M,B,_) :-
|
||||
functor(H,Na,Ar),
|
||||
\+ '$dynamic'(Na/Ar,M),
|
||||
'$do_error'(permission_error(modify,static_procedure,Na/Ar),retract(M:(H:-B))).
|
||||
|
||||
/** @pred retract(+ _C_,- _R_)
|
||||
@ -306,31 +212,29 @@ database reference is _R_. The predicate must be dynamic.
|
||||
|
||||
|
||||
|
||||
*/
|
||||
*/
|
||||
retract(M:C,R) :- !,
|
||||
'$retract'(C,M,R).
|
||||
retract(C,R) :-
|
||||
'$current_module'(M),
|
||||
'$retract'(C,M,R).
|
||||
strip_module( C, M, H0),
|
||||
'$retract'(H0, M, R).
|
||||
|
||||
'$retract'(V,M,R) :- var(V), !,
|
||||
'$do_error'(instantiation_error,retract(M:V,R)).
|
||||
'$retract'(M:C,_,R) :- !,
|
||||
'$retract'(C,M,R).
|
||||
'$retract'(C, M, R) :-
|
||||
'$check_head_and_body'(C,H,B,retract(C,R)),
|
||||
db_reference(R), '$is_dynamic'(H,M), !,
|
||||
instance(R,(H:-B)), erase(R).
|
||||
db_reference(R),
|
||||
!,
|
||||
'$is_dynamic'(H,M),
|
||||
'$check_head_and_body'(M:C,_M,H,B,retract(C,R)),
|
||||
instance(R,(H:-B)),
|
||||
erase(R).
|
||||
'$retract'(C,M,R) :-
|
||||
'$check_head_and_body'(C,H,B,retract(C,R)),
|
||||
'$check_head_and_body'(C,_M,H,B,retract(C,R)),
|
||||
var(R), !,
|
||||
'$retract2'(H, M, B, R).
|
||||
'$retract'(C,M,_) :-
|
||||
'$fetch_predicate_indicator_from_clause'(C, PI),
|
||||
\+ '$dynamic'(Na/Ar,M),
|
||||
'$do_error'(permission_error(modify,static_procedure,PI),retract(M:C)).
|
||||
|
||||
'$fetch_predicate_indicator_from_clause'((C :- _), Na/Ar) :- !,
|
||||
functor(C, Na, Ar).
|
||||
functor(C, Na, Ar).
|
||||
'$fetch_predicate_indicator_from_clause'(C, Na/Ar) :-
|
||||
functor(C, Na, Ar).
|
||||
|
||||
@ -354,25 +258,25 @@ retractall(V) :-
|
||||
'$retractall'(V,M).
|
||||
'$retractall'(T,M) :-
|
||||
(
|
||||
'$is_log_updatable'(T, M) ->
|
||||
'$is_log_updatable'(T, M) ->
|
||||
( '$is_multifile'(T, M) ->
|
||||
'$retractall_lu_mf'(T,M)
|
||||
;
|
||||
'$retractall_lu'(T,M)
|
||||
)
|
||||
;
|
||||
\+ callable(T) ->
|
||||
'$do_error'(type_error(callable,T),retractall(T))
|
||||
\+ callable(T) ->
|
||||
'$do_error'(type_error(callable,T),retractall(T))
|
||||
;
|
||||
'$undefined'(T,M) ->
|
||||
functor(T,Na,Ar),
|
||||
'$dynamic'(Na/Ar,M), !
|
||||
'$undefined'(T,M) ->
|
||||
functor(T,Na,Ar),
|
||||
'$dynamic'(Na/Ar,M), !
|
||||
;
|
||||
'$is_dynamic'(T,M) ->
|
||||
'$erase_all_clauses_for_dynamic'(T, M)
|
||||
'$is_dynamic'(T,M) ->
|
||||
'$erase_all_clauses_for_dynamic'(T, M)
|
||||
;
|
||||
functor(T,Na,Ar),
|
||||
'$do_error'(permission_error(modify,static_procedure,Na/Ar),retractall(T))
|
||||
functor(T,Na,Ar),
|
||||
'$do_error'(permission_error(modify,static_procedure,Na/Ar),retractall(T))
|
||||
).
|
||||
|
||||
'$retractall_lu'(T,M) :-
|
||||
@ -440,16 +344,3 @@ dynamic_predicate(P,Sem) :-
|
||||
'$bad_if_is_semantics'(Sem, Goal) :-
|
||||
Sem \= immediate, Sem \= logical, !,
|
||||
'$do_error'(domain_error(semantics_indicator,Sem),Goal).
|
||||
|
||||
|
||||
'$expand_clause'((H:-B),C1,C2,Mod,HM) :- !,
|
||||
strip_module(Mod:H, HM, H1),
|
||||
% Mod has scope over the full clause
|
||||
'$module_expansion'((H1:-B), C1, C2, HM, Mod, Mod),
|
||||
( get_value('$strict_iso',on) ->
|
||||
'$check_iso_strict_clause'(C1)
|
||||
;
|
||||
true
|
||||
).
|
||||
'$expand_clause'(H,H1,H1,Mod,HM) :-
|
||||
strip_module(Mod:H, HM, H1).
|
||||
|
||||
86
pl/preds.yap
86
pl/preds.yap
@ -16,9 +16,9 @@
|
||||
*************************************************************************/
|
||||
|
||||
/**
|
||||
* @defgroup Database Using the Clausal Data Base
|
||||
* @ingroup builtins
|
||||
* @{
|
||||
* @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:
|
||||
@ -108,8 +108,7 @@ undefined results.
|
||||
|
||||
*/
|
||||
assert_static(C) :-
|
||||
strip_module(C, Mod, C1),
|
||||
'$assert_static'(C1, Mod,last,_,assert_static(C)).
|
||||
'$assert'(C , assertz_static, _ ).
|
||||
|
||||
/** @pred asserta_static(: _C_)
|
||||
|
||||
@ -118,9 +117,8 @@ Adds clause _C_ as the first clause for a static procedure.
|
||||
|
||||
|
||||
*/
|
||||
asserta_static(C) :-
|
||||
strip_module(C, Mod, C1),
|
||||
'$assert_static'(C1,Mod,first,_,asserta_static(C)).
|
||||
asserta_static(CI) :-
|
||||
'$assert'(C , asserta_static, _ ).
|
||||
|
||||
|
||||
/** @pred assertz_static(: _C_)
|
||||
@ -139,29 +137,8 @@ static predicates, if source mode was on when they were compiled:
|
||||
|
||||
|
||||
*/
|
||||
assertz_static(C) :-
|
||||
strip_module(C, Mod, C1),
|
||||
'$assert_static'(C1,Mod,last,_,assertz_static(C)).
|
||||
|
||||
'$assert_static'(V,M,_,_,_) :- var(V), !,
|
||||
'$do_error'(instantiation_error,assert(M:V)).
|
||||
'$assert_static'((H:-_G),_M1,_Where,_R,P) :-
|
||||
var(H), !, '$do_error'(instantiation_error,P).
|
||||
'$assert_static'(CI,Mod,Where,R,P) :-
|
||||
'$expand_clause'(CI,C0,C,Mod, HM),
|
||||
'$check_head_and_body'(C,H,B,P),
|
||||
( '$is_dynamic'(H, HM) ->
|
||||
'$do_error'(permission_error(modify,dynamic_procedure,HM:Na/Ar),P)
|
||||
;
|
||||
'$undefined'(H,HM), get_value('$full_iso',true) ->
|
||||
functor(H,Na,Ar), '$dynamic'(Na/Ar, HM), '$assertat_d'(Where,H,B,C0,HM,R)
|
||||
;
|
||||
'$assert1'(Where,C,C0,HM,H)
|
||||
).
|
||||
|
||||
|
||||
'$assert1'(last,C,C0,Mod,_) :- '$compile'(C,0,C0,Mod).
|
||||
'$assert1'(first,C,C0,Mod,_) :- '$compile'(C,2,C0,Mod).
|
||||
assertz_static(CI) :-
|
||||
'$assert'(C , assertz_static, _ ).
|
||||
|
||||
/** @pred clause(+ _H_, _B_) is iso
|
||||
|
||||
@ -177,7 +154,8 @@ This predicate is applicable to static procedures compiled with
|
||||
|
||||
*/
|
||||
clause(V0,Q) :-
|
||||
strip_module(V0, M, V),
|
||||
'$yap_strip_module'(V0, M, V),
|
||||
must_be_of_type( callable, V ),
|
||||
'$clause'(V,M,Q,_).
|
||||
|
||||
/** @pred clause(+ _H_, _B_,- _R_)
|
||||
@ -187,28 +165,24 @@ 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) :- var(P), !,
|
||||
'$current_module'(M),
|
||||
'$clause'(P,M,Q,R).
|
||||
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) :-
|
||||
strip_module(V0, M, V),
|
||||
'$yap_strip_module'(V0, M, V),
|
||||
must_be_of_type( callable, V ),
|
||||
'$clause'(V,M,Q,R).
|
||||
|
||||
'$clause'(P,M,Q,R) :-
|
||||
'$instance_module'(R,M0), !,
|
||||
M0 = M,
|
||||
instance(R,T),
|
||||
( T = (H :- B) -> P = H, Q = B ; P=T, Q = true).
|
||||
'$clause'(V,M,Q,R) :- var(V), !,
|
||||
'$do_error'(instantiation_error,clause(M:V,Q,R)).
|
||||
'$clause'(C,M,Q,R) :-
|
||||
number(C), !,
|
||||
'$do_error'(type_error(callable,C),clause(M:C,Q,R)).
|
||||
'$clause'(C,M,Q,R) :-
|
||||
db_reference(C), !,
|
||||
'$do_error'(type_error(callable,C),clause(M:R,Q,R)).
|
||||
'$clause'(M:P,_,Q,R) :- !,
|
||||
'$clause'(P,M,Q,R).
|
||||
'$clause'(P,M,Q,R) :-
|
||||
'$is_exo'(P, M), !,
|
||||
Q = true,
|
||||
@ -461,7 +435,7 @@ stash_predicate(P0) :-
|
||||
'$stash_predicate2'(PredDesc, M) :-
|
||||
'$do_error'(type_error(predicate_indicator,PredDesc),stash_predicate(M:PredDesc)).
|
||||
|
||||
/** @pred @pred hide_predicate(+ _Pred_)
|
||||
/** @pred hide_predicate(+ _Pred_)
|
||||
Make predicate _Pred_ invisible to `current_predicate/2`,
|
||||
`listing`, and friends.
|
||||
|
||||
@ -534,8 +508,8 @@ predicate_property(Pred,Prop) :-
|
||||
'$predicate_property2'(Pred,Prop,M0) :-
|
||||
var(Pred), !,
|
||||
(M = M0 ;
|
||||
M = prolog ;
|
||||
M = user), % prolog and user modules are automatically incorporate in every other module
|
||||
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,_) :- !,
|
||||
@ -544,7 +518,7 @@ predicate_property(Pred,Prop) :-
|
||||
'$pred_exists'(Pred,Mod), !,
|
||||
'$predicate_property'(Pred,Mod,Mod,Prop).
|
||||
'$predicate_property2'(Pred,Prop,Mod) :-
|
||||
'$imported_predicate'(Pred, Mod, NPred, M),
|
||||
'$get_undefined_pred'(Pred, Mod, NPred, M),
|
||||
(
|
||||
Prop = imported_from(M)
|
||||
;
|
||||
@ -553,7 +527,7 @@ predicate_property(Pred,Prop) :-
|
||||
).
|
||||
|
||||
'$generate_all_preds_from_mod'(Pred, M, M) :-
|
||||
'$current_predicate'(_Na,M,Pred,user).
|
||||
'$current_predicate'(_Na,M,Pred,_).
|
||||
'$generate_all_preds_from_mod'(Pred, SourceMod, Mod) :-
|
||||
recorded('$import','$import'(SourceMod, Mod, Orig, Pred,_,_),_),
|
||||
'$pred_exists'(Orig, SourceMod).
|
||||
@ -573,7 +547,7 @@ predicate_property(Pred,Prop) :-
|
||||
\+ '$undefined'(P,M).
|
||||
'$predicate_property'(P,M,_,meta_predicate(Q)) :-
|
||||
functor(P,Na,Ar),
|
||||
'$meta_predicate'(Na,M,Ar,Q).
|
||||
prolog:'$meta_predicate'(Na,M,Ar,Q).
|
||||
'$predicate_property'(P,M,_,multifile) :-
|
||||
'$is_multifile'(P,M).
|
||||
'$predicate_property'(P,M,_,public) :-
|
||||
|
||||
Reference in New Issue
Block a user