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

more fixes for nth_clause

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@942 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2003-12-02 00:36:27 +00:00
parent fd1bc58cde
commit 8dc293eba4
2 changed files with 88 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

85
C/cdmgr.c
View File

@ -2505,12 +2505,68 @@ clause_was_found(PredEntry *pp, Atom *pat, UInt *parity) {
}
}
static void
code_in_pred_info(PredEntry *pp, Atom *pat, UInt *parity) {
*parity = pp->ArityOfPE;
if (pp->ArityOfPE) {
*pat = NameOfFunctor(pp->FunctorOfPred);
} else {
*pat = (Atom)(pp->FunctorOfPred);
}
}
static int
code_in_pred_lu_index(LogUpdIndex *icl, yamop *codeptr) {
LogUpdIndex *cicl;
if (IN_BLOCK(codeptr,icl,Yap_SizeOfBlock((CODEADDR)icl))) {
return TRUE;
}
cicl = icl->ChildIndex;
while (cicl != NULL) {
if (code_in_pred_lu_index(cicl, codeptr))
return TRUE;
cicl = cicl->SiblingIndex;
}
return FALSE;
}
static int
code_in_pred_s_index(StaticIndex *icl, yamop *codeptr) {
StaticIndex *cicl;
if (IN_BLOCK(codeptr,icl,Yap_SizeOfBlock((CODEADDR)icl))) {
return TRUE;
}
cicl = icl->ChildIndex;
while (cicl != NULL) {
if (code_in_pred_s_index(cicl, codeptr))
return TRUE;
cicl = cicl->SiblingIndex;
}
return FALSE;
}
static Int
code_in_pred(PredEntry *pp, Atom *pat, UInt *parity, yamop *codeptr) {
yamop *clcode;
int i = 1;
READ_LOCK(pp->PRWLock);
/* check if the codeptr comes from the indexing code */
if (pp->PredFlags & IndexedPredFlag) {
if (pp->PredFlags & LogUpdatePredFlag) {
if (code_in_pred_lu_index(ClauseCodeToLogUpdIndex(pp->cs.p_code.TrueCodeOfPred), codeptr)) {
code_in_pred_info(pp, pat, parity);
READ_UNLOCK(pp->PRWLock);
return -1;
}
} else {
if (code_in_pred_s_index(ClauseCodeToStaticIndex(pp->cs.p_code.TrueCodeOfPred), codeptr)) {
code_in_pred_info(pp, pat, parity);
READ_UNLOCK(pp->PRWLock);
return -1;
}
}
}
clcode = pp->cs.p_code.FirstClause;
if (clcode != NULL) {
char *code_end;
@ -2523,18 +2579,6 @@ code_in_pred(PredEntry *pp, Atom *pat, UInt *parity, yamop *codeptr) {
StaticClause *cl = ClauseCodeToStaticClause(pp->cs.p_code.TrueCodeOfPred);
code_end = (char *)cl + Yap_SizeOfBlock((CODEADDR)cl);
}
/* check if the codeptr comes from the indexing code */
if ((pp->PredFlags & IndexedPredFlag) &&
IN_BLOCK(codeptr,pp->cs.p_code.TrueCodeOfPred,Yap_SizeOfBlock((CODEADDR)(ClauseCodeToStaticIndex(pp->cs.p_code.TrueCodeOfPred))))) {
*parity = pp->ArityOfPE;
if (pp->ArityOfPE) {
*pat = NameOfFunctor(pp->FunctorOfPred);
} else {
*pat = (Atom)(pp->FunctorOfPred);
}
READ_UNLOCK(pp->PRWLock);
return(-1);
}
if (pp->PredFlags & LogUpdatePredFlag) {
LogUpdClause *cl = ClauseCodeToLogUpdClause(clcode);
do {
@ -2609,19 +2653,32 @@ Yap_PredForCode(yamop *codeptr, Atom *pat, UInt *parity, SMALLUNSGN *pmodule) {
static Int
p_pred_for_code(void) {
yamop *codeptr = (yamop *)IntegerOfTerm(Deref(ARG1));
yamop *codeptr;
Atom at;
UInt arity;
SMALLUNSGN module;
Int cl;
Term t = Deref(ARG1);
if (IsVarTerm(t)) {
return FALSE;
} else if (IsIntegerTerm(t)) {
codeptr = (yamop *)IntegerOfTerm(t);
} else if (IsDBRefTerm(t)) {
codeptr = (yamop *)DBRefOfTerm(t);
} else {
return FALSE;
}
cl = PredForCode(codeptr, &at, &arity, &module);
if (cl == 0) return(Yap_unify(ARG5,MkIntegerTerm(cl)));
if (cl == 0) {
return(Yap_unify(ARG5,MkIntTerm(0)));
} else {
return(Yap_unify(ARG2,MkAtomTerm(at)) &&
Yap_unify(ARG3,MkIntegerTerm(arity)) &&
Yap_unify(ARG4,ModuleName[module]) &&
Yap_unify(ARG5,MkIntegerTerm(cl)));
}
}
static Int
p_is_profiled(void)

19
pl/preds.yap
View File

@ -353,9 +353,7 @@ clause(V,Q,R) :-
:- '$do_static_clause'(_,_,_,_,_), !.
nth_clause(P,I,R) :- nonvar(R), !,
'$nth_instancep'(P,I,R).
nth_clause(V,I,R) :- var(V), !,
nth_clause(V,I,R) :- var(V), var(R), !,
'$do_error'(instantiation_error,M:nth_clause(V,I,R)).
nth_clause(M:V,I,R) :- !,
'$nth_clause'(V,M,I,R).
@ -364,14 +362,16 @@ nth_clause(V,I,R) :-
'$nth_clause'(V,M,I,R).
'$nth_clause'(V,M,I,R) :- var(V), !,
'$nth_clause'(V,M,I,R) :- var(V), var(R), !,
'$do_error'(instantiation_error,M:nth_clause(V,I,R)).
'$nth_clause'(P1,_,I,R) :- nonvar(P1), P1 = M:P, !,
'$nth_clause'(P,M,I,R).
'$nth_clause'(P,M,I,R) :- nonvar(R), !,
'$nth_clause_ref'(P,M,I,R).
'$nth_clause'(C,M,I,R) :- number(C), !,
'$do_error'(type_error(callable,C),M:nth_clause(C,I,R)).
'$nth_clause'(R,M,I,R) :- db_reference(R), !,
'$do_error'(type_error(callable,R),M:nth_clause(R,I,R)).
'$nth_clause'(M:P,_,I,R) :- !,
'$nth_clause'(P,M,I,R).
'$nth_clause'(P,M,I,R) :-
( '$is_log_updatable'(P,M) ; '$is_source'(P,M) ), !,
'$p_nth_clause'(P,M,I,R).
@ -385,6 +385,13 @@ nth_clause(V,I,R) :-
'$do_error'(permission_error(access,private_procedure,Name/Arity),
nth_clause(M:P,I,R)).
'$nth_clause_ref'(Cl,M,I,R) :-
'$pred_for_code'(R, At, Ar, M1, I), I > 0, !,
instance(R, Cl),
M1 = M.
'$nth_clause_ref'(P,M,I,R) :-
'$nth_instancep'(M:P,I,R).
retract(M:C) :- !,
'$retract'(C,M).
retract(C) :-