diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

reorg of predicate handling

Browse Source 
use strip_module for clearer code.
- separate dynamic predicates
- separate declarations
This commit is contained in:
Vítor Santos Costa 2015-12-15 09:04:08 +00:00
parent d2ad352f78
commit 3eda5cf68a
3 changed files with 150 additions and 250 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
pl/preddecls.yap
View File

@ -181,13 +181,19 @@ Since YAP4.3.0 multifile procedures can be static or dynamic.
**/ **/
multifile(P) :- multifile(P) :-
'$current_module'(OM), strip_module(P, OM, Pred),
'$multifile'(P, OM). '$multifile'(Pred, OM).
'$multifile'(V, _) :- var(V), !, '$multifile'(V, _) :-
var(V),
!,
'$do_error'(instantiation_error,multifile(V)). '$do_error'(instantiation_error,multifile(V)).
'$multifile'((X,Y), M) :- !, '$multifile'(X, M), '$multifile'(Y, M). '$multifile'((X,Y), M) :-
'$multifile'(Mod:PredSpec, _) :- !, !,
'$multifile'(X, M),
'$multifile'(Y, M).
'$multifile'(Mod:PredSpec, _) :-
!,
'$multifile'(PredSpec, Mod). '$multifile'(PredSpec, Mod).
'$multifile'(N//A, M) :- !, '$multifile'(N//A, M) :- !,
integer(A), integer(A),
@ -261,3 +267,32 @@ discontiguous(F) :-
'$predicate_flags'(T,Mod,F,F), '$predicate_flags'(T,Mod,F,F),
F\/0x00400000 =\= 0. 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).

185
pl/preddyns.yap
View File

@ -1,5 +1,5 @@
% The next predicates are applicable only % The next predicates are applicable only
% to dynamic code % to dynamic code
/** @file preddyns.yap */ /** @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). undefined, it is declared dynamic (see dynamic/1).
*/ */
asserta(C) :- asserta(Clause) :-
strip_module(C, Mod, NC), '$assert'(Clause, asserta, _).
'$assert'(NC,Mod,first,_,asserta(C)).
/** @pred assertz(+ _C_) is iso /** @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 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. asserting clauses for static predicates, under the restriction that the static predicate may not be live in the stacks.
*/ */
assertz(C) :- assertz(Clause) :-
strip_module(C,Mod,C1), '$assert'(Clause, assertz, _).
'$assert'(C1,Mod,last,_,assertz(C)).
/** @pred assert(+ _C_) /** @pred assert(+ _C_)
@ -49,90 +47,12 @@ deprecated, if you want to assert clauses for static procedures you
should use assert_static/1. should use assert_static/1.
*/ */
assert(C) :- assert(Clause) :-
strip_module(C,Mod,C1), '$assert'(Clause, assertz, _).
'$assert'(C1,Mod,last,_,assert(C)).
'$assert'(V,Mod,_,_,_) :- var(V), !, '$assert'(Clause, Where, R) :-
'$do_error'(instantiation_error,assert(Mod:V)). '$expand_clause'(Clause,C0,C),
'$assert'(V,Mod,_,_,_) :- var(Mod), !, '$$compile'(C, Where, C0, R).
'$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)
).
/** @pred asserta(+ _C_,- _R_) /** @pred asserta(+ _C_,- _R_)
@ -143,9 +63,8 @@ predicates. If the predicate is undefined, it will automatically be
declared dynamic. declared dynamic.
*/ */
asserta(C,R) :- asserta(Clause, Ref) :-
strip_module(C, M, C1), '$assert'(Clause, first, Ref).
'$assert'(C1,M,first,R,asserta(C,R)).
/** @pred assertz(+ _C_,- _R_) /** @pred assertz(+ _C_,- _R_)
@ -157,11 +76,8 @@ declared dynamic.
*/ */
assertz(M:C,R) :- !, assertz(Clause, Ref) :-
'$assert_dynamic'(C,M,last,R,assertz(M:C,R)). '$assert'(Clause, last, Ref).
assertz(C,R) :-
'$current_module'(M),
'$assert_dynamic'(C,M,last,R,assertz(C,R)).
/** @pred assert(+ _C_,- _R_) /** @pred assert(+ _C_,- _R_)
@ -173,14 +89,13 @@ declared dynamic.
*/ */
assert(M:C,R) :- !, assert(Clause, Ref) :-
'$assert_dynamic'(C,M,last,R,assert(M:C,R)). '$assert'(Clause, last, Ref).
assert(C,R) :-
'$current_module'(M),
'$assert_dynamic'(C,M,last,R,assert(C,R)).
'$assertz_dynamic'(X, C, C0, Mod) :- (X/\4)=:=0, !, '$assertz_dynamic'(X, C, C0, Mod) :-
(X/\4)=:=0,
!,
'$head_and_body'(C,H,B), '$head_and_body'(C,H,B),
'$assertat_d'(last,H,B,C0,Mod,_). '$assertat_d'(last,H,B,C0,Mod,_).
'$assertz_dynamic'(X,C,C0,Mod) :- '$assertz_dynamic'(X,C,C0,Mod) :-
@ -261,30 +176,20 @@ source/0 ( (see Setting the Compiler)).
*/ */
retract(M:C) :- !, retract( C ) :-
'$retract'(C,M). strip_module( C, M, H0),
retract(C) :- '$check_head_and_body'(M:H0,_M,H,B,retract(M: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)), !,
'$predicate_flags'(H, M, F, F), '$predicate_flags'(H, M, F, F),
'$retract2'(F, H,M,B,_). '$retract2'(F, H,M,B,_).
'$retract2'(F, H, M, B, R) :- '$retract2'(F, H, M, B, R) :-
F /\ 0x08000000 =:= 0x08000000, !, F /\ 0x08000000 =:= 0x08000000, !,
% '$is_log_updatable'(H, M), !, % '$is_log_updatable'(H, M), !,
'$log_update_clause'(H,M,B,R), '$log_update_clause'(H,M,B,R),
( F /\ 0x20000000 =:= 0x20000000, recorded('$mf','$mf_clause'(_,_,_,_,R),MR), erase(MR), fail ; true), ( F /\ 0x20000000 =:= 0x20000000, recorded('$mf','$mf_clause'(_,_,_,_,R),MR), erase(MR), fail ; true),
erase(R). erase(R).
'$retract2'(F, H, M, B, R) :- '$retract2'(F, H, M, B, R) :-
% '$is_dynamic'(H,M), !, % '$is_dynamic'(H,M), !,
F /\ 0x00002000 =:= 0x00002000, !, F /\ 0x00002000 =:= 0x00002000, !,
'$recordedp'(M:H,(H:-B),R), '$recordedp'(M:H,(H:-B),R),
( F /\ 0x20000000 =:= 0x20000000, recorded('$mf','$mf_clause'(_,_,_,_,MRef),MR), erase(MR), erase(MRef), fail ; true), ( F /\ 0x20000000 =:= 0x20000000, recorded('$mf','$mf_clause'(_,_,_,_,MRef),MR), erase(MR), erase(MRef), fail ; true),
@ -296,6 +201,7 @@ retract(C) :-
fail. fail.
'$retract2'(_, H,M,B,_) :- '$retract2'(_, H,M,B,_) :-
functor(H,Na,Ar), functor(H,Na,Ar),
\+ '$dynamic'(Na/Ar,M),
'$do_error'(permission_error(modify,static_procedure,Na/Ar),retract(M:(H:-B))). '$do_error'(permission_error(modify,static_procedure,Na/Ar),retract(M:(H:-B))).
/** @pred retract(+ _C_,- _R_) /** @pred retract(+ _C_,- _R_)
@ -306,31 +212,29 @@ database reference is _R_. The predicate must be dynamic.
*/ */
retract(M:C,R) :- !, retract(M:C,R) :- !,
'$retract'(C,M,R). strip_module( C, M, H0),
retract(C,R) :- '$retract'(H0, M, R).
'$current_module'(M),
'$retract'(C,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) :- '$retract'(C, M, R) :-
'$check_head_and_body'(C,H,B,retract(C,R)), db_reference(R),
db_reference(R), '$is_dynamic'(H,M), !, !,
instance(R,(H:-B)), erase(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) :- '$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), !, var(R), !,
'$retract2'(H, M, B, R). '$retract2'(H, M, B, R).
'$retract'(C,M,_) :- '$retract'(C,M,_) :-
'$fetch_predicate_indicator_from_clause'(C, PI), '$fetch_predicate_indicator_from_clause'(C, PI),
\+ '$dynamic'(Na/Ar,M),
'$do_error'(permission_error(modify,static_procedure,PI),retract(M:C)). '$do_error'(permission_error(modify,static_procedure,PI),retract(M:C)).
'$fetch_predicate_indicator_from_clause'((C :- _), Na/Ar) :- !, '$fetch_predicate_indicator_from_clause'((C :- _), Na/Ar) :- !,
functor(C, Na, Ar). functor(C, Na, Ar).
'$fetch_predicate_indicator_from_clause'(C, Na/Ar) :- '$fetch_predicate_indicator_from_clause'(C, Na/Ar) :-
functor(C, Na, Ar). functor(C, Na, Ar).
@ -440,16 +344,3 @@ dynamic_predicate(P,Sem) :-
'$bad_if_is_semantics'(Sem, Goal) :- '$bad_if_is_semantics'(Sem, Goal) :-
Sem \= immediate, Sem \= logical, !, Sem \= immediate, Sem \= logical, !,
'$do_error'(domain_error(semantics_indicator,Sem),Goal). '$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
View File

@ -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 Predicates in YAP may be dynamic or static. By default, when
consulting or reconsulting, predicates are assumed to be static: consulting or reconsulting, predicates are assumed to be static:
@ -108,8 +108,7 @@ undefined results.
*/ */
assert_static(C) :- assert_static(C) :-
strip_module(C, Mod, C1), '$assert'(C , assertz_static, _ ).
'$assert_static'(C1, Mod,last,_,assert_static(C)).
/** @pred asserta_static(: _C_) /** @pred asserta_static(: _C_)
@ -118,9 +117,8 @@ Adds clause _C_ as the first clause for a static procedure.
*/ */
asserta_static(C) :- asserta_static(CI) :-
strip_module(C, Mod, C1), '$assert'(C , asserta_static, _ ).
'$assert_static'(C1,Mod,first,_,asserta_static(C)).
/** @pred assertz_static(: _C_) /** @pred assertz_static(: _C_)
@ -139,29 +137,8 @@ static predicates, if source mode was on when they were compiled:
*/ */
assertz_static(C) :- assertz_static(CI) :-
strip_module(C, Mod, C1), '$assert'(C , assertz_static, _ ).
'$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).
/** @pred clause(+ _H_, _B_) is iso /** @pred clause(+ _H_, _B_) is iso
@ -177,7 +154,8 @@ This predicate is applicable to static procedures compiled with
*/ */
clause(V0,Q) :- clause(V0,Q) :-
strip_module(V0, M, V), '$yap_strip_module'(V0, M, V),
must_be_of_type( callable, V ),
'$clause'(V,M,Q,_). '$clause'(V,M,Q,_).
/** @pred clause(+ _H_, _B_,- _R_) /** @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 to access the reference's value. Note that you may not use
erase/1 on the reference on static procedures. erase/1 on the reference on static procedures.
*/ */
clause(P,Q,R) :- var(P), !, clause(P,Q,R) :-
'$current_module'(M), '$instance_module'(R,M0), !,
'$clause'(P,M,Q,R). 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) :- 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'(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) :- '$clause'(P,M,Q,R) :-
'$is_exo'(P, M), !, '$is_exo'(P, M), !,
Q = true, Q = true,
@ -461,7 +435,7 @@ stash_predicate(P0) :-
'$stash_predicate2'(PredDesc, M) :- '$stash_predicate2'(PredDesc, M) :-
'$do_error'(type_error(predicate_indicator,PredDesc),stash_predicate(M:PredDesc)). '$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`, Make predicate _Pred_ invisible to `current_predicate/2`,
`listing`, and friends. `listing`, and friends.
@ -534,8 +508,8 @@ predicate_property(Pred,Prop) :-
'$predicate_property2'(Pred,Prop,M0) :- '$predicate_property2'(Pred,Prop,M0) :-
var(Pred), !, var(Pred), !,
(M = M0 ; (M = M0 ;
M = prolog ; M0 \= prolog, M = prolog ;
M = user), % prolog and user modules are automatically incorporate in every other module M0 \= user, M = user), % prolog and user modules are automatically incorporate in every other module
'$generate_all_preds_from_mod'(Pred, SourceMod, M), '$generate_all_preds_from_mod'(Pred, SourceMod, M),
'$predicate_property'(Pred,SourceMod,M,Prop). '$predicate_property'(Pred,SourceMod,M,Prop).
'$predicate_property2'(M:Pred,Prop,_) :- !, '$predicate_property2'(M:Pred,Prop,_) :- !,
@ -544,7 +518,7 @@ predicate_property(Pred,Prop) :-
'$pred_exists'(Pred,Mod), !, '$pred_exists'(Pred,Mod), !,
'$predicate_property'(Pred,Mod,Mod,Prop). '$predicate_property'(Pred,Mod,Mod,Prop).
'$predicate_property2'(Pred,Prop,Mod) :- '$predicate_property2'(Pred,Prop,Mod) :-
'$imported_predicate'(Pred, Mod, NPred, M), '$get_undefined_pred'(Pred, Mod, NPred, M),
( (
Prop = imported_from(M) Prop = imported_from(M)
; ;
@ -553,7 +527,7 @@ predicate_property(Pred,Prop) :-
). ).
'$generate_all_preds_from_mod'(Pred, M, M) :- '$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) :- '$generate_all_preds_from_mod'(Pred, SourceMod, Mod) :-
recorded('$import','$import'(SourceMod, Mod, Orig, Pred,_,_),_), recorded('$import','$import'(SourceMod, Mod, Orig, Pred,_,_),_),
'$pred_exists'(Orig, SourceMod). '$pred_exists'(Orig, SourceMod).
@ -573,7 +547,7 @@ predicate_property(Pred,Prop) :-
\+ '$undefined'(P,M). \+ '$undefined'(P,M).
'$predicate_property'(P,M,_,meta_predicate(Q)) :- '$predicate_property'(P,M,_,meta_predicate(Q)) :-
functor(P,Na,Ar), functor(P,Na,Ar),
'$meta_predicate'(Na,M,Ar,Q). prolog:'$meta_predicate'(Na,M,Ar,Q).
'$predicate_property'(P,M,_,multifile) :- '$predicate_property'(P,M,_,multifile) :-
'$is_multifile'(P,M). '$is_multifile'(P,M).
'$predicate_property'(P,M,_,public) :- '$predicate_property'(P,M,_,public) :-