clause should allow access through a reference.

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@897 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2003-10-14 20:32:08 +00:00
parent 9f6ef90e85
commit 514ef300e3
2 changed files with 27 additions and 0 deletions

View File

@ -4034,6 +4034,28 @@ p_instance(void)
} }
} }
/* instance(+Ref,?Term) */
static Int
p_instance_module(void)
{
Term t1 = Deref(ARG1);
DBRef dbr;
if (IsVarTerm(t1) || !IsDBRefTerm(t1))
return (FALSE);
dbr = DBRefOfTerm(t1);
if (dbr->Flags & LogUpdMask) {
LogUpdClause *cl = (LogUpdClause *)dbr;
if (cl->ClFlags & ErasedMask) {
return FALSE;
}
return Yap_unify(ARG2, ModuleName[cl->ClPred->ModuleOfPred]);
} else {
return Yap_unify(ARG2, ModuleName[dbr->Parent->ModuleOfDB]);
}
}
inline static int inline static int
NotActiveDB(DBRef my_dbref) NotActiveDB(DBRef my_dbref)
{ {
@ -4514,6 +4536,7 @@ Yap_InitDBPreds(void)
Yap_InitCPred("erase", 1, p_erase, SafePredFlag|SyncPredFlag); Yap_InitCPred("erase", 1, p_erase, SafePredFlag|SyncPredFlag);
Yap_InitCPred("erased", 1, p_erased, TestPredFlag | SafePredFlag|SyncPredFlag); Yap_InitCPred("erased", 1, p_erased, TestPredFlag | SafePredFlag|SyncPredFlag);
Yap_InitCPred("instance", 2, p_instance, SyncPredFlag); Yap_InitCPred("instance", 2, p_instance, SyncPredFlag);
Yap_InitCPred("$instance_module", 2, p_instance_module, SyncPredFlag);
Yap_InitCPred("eraseall", 1, p_eraseall, SafePredFlag|SyncPredFlag); Yap_InitCPred("eraseall", 1, p_eraseall, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$record_stat_source", 4, p_rcdstatp, SafePredFlag|SyncPredFlag); Yap_InitCPred("$record_stat_source", 4, p_rcdstatp, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$some_recordedp", 1, p_somercdedp, SafePredFlag|SyncPredFlag); Yap_InitCPred("$some_recordedp", 1, p_somercdedp, SafePredFlag|SyncPredFlag);

View File

@ -292,6 +292,10 @@ clause(V,Q) :-
'$clause'(P,M,Q) :- '$clause'(P,M,Q) :-
'$clause'(P,M,Q,_). '$clause'(P,M,Q,_).
clause(P,Q,R) :- db_reference(R), !,
'$instance_module'(R, M),
instance(R,T),
( T = (H :- B) -> P = M:H, Q = B ; P=M:T, Q = true).
clause(M:P,Q,R) :- !, clause(M:P,Q,R) :- !,
'$clause'(P,M,Q,R). '$clause'(P,M,Q,R).
clause(V,Q,R) :- clause(V,Q,R) :-