get rid of broken $clause/3: fixes listing of dynamic predicates.
This commit is contained in:
Vitor Santos Costa
parent
0d64daa393
commit
f46ff06f38
112
C/cdmgr.c
112
C/cdmgr.c
@ -4626,116 +4626,6 @@ p_continue_log_update_clause_erase(void)
|
||||
return fetch_next_lu_clause_erase(pe, ipc, Deref(ARG3), ARG4, ARG5, B->cp_cp, FALSE);
|
||||
}
|
||||
|
||||
static Int
|
||||
fetch_next_lu_clause0(PredEntry *pe, yamop *i_code, Term th, Term tb, yamop *cp_ptr, int first_time)
|
||||
{
|
||||
LogUpdClause *cl;
|
||||
Term Terms[3];
|
||||
|
||||
Terms[0] = th;
|
||||
Terms[1] = tb;
|
||||
Terms[2] = TermNil;
|
||||
cl = Yap_FollowIndexingCode(pe, i_code, Terms, NEXTOP(PredLogUpdClause0->CodeOfPred,Otapl), cp_ptr);
|
||||
th = Terms[0];
|
||||
tb = Terms[1];
|
||||
/* don't do this!! I might have stored a choice-point and changed ASP
|
||||
Yap_RecoverSlots(2);
|
||||
*/
|
||||
if (cl == NULL) {
|
||||
UNLOCK(pe->PELock);
|
||||
return FALSE;
|
||||
}
|
||||
if (cl->ClFlags & FactMask) {
|
||||
UNLOCK(pe->PELock);
|
||||
if (!Yap_unify(tb, MkAtomTerm(AtomTrue)))
|
||||
return FALSE;
|
||||
if (pe->ArityOfPE) {
|
||||
Functor f = FunctorOfTerm(th);
|
||||
UInt arity = ArityOfFunctor(f), i;
|
||||
CELL *pt = RepAppl(th)+1;
|
||||
|
||||
for (i=0; i<arity; i++) {
|
||||
XREGS[i+1] = pt[i];
|
||||
}
|
||||
/* don't need no ENV */
|
||||
if (first_time &&
|
||||
P->opc != EXECUTE_CPRED_OP_CODE) {
|
||||
CP = P;
|
||||
ENV = YENV;
|
||||
YENV = ASP;
|
||||
YENV[E_CB] = (CELL) B;
|
||||
}
|
||||
P = cl->ClCode;
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
PP = pe;
|
||||
#endif
|
||||
} else {
|
||||
/* we don't actually need to execute code */
|
||||
UNLOCK(pe->PELock);
|
||||
}
|
||||
return TRUE;
|
||||
} else {
|
||||
Term t;
|
||||
|
||||
UNLOCK(pe->PELock);
|
||||
while ((t = Yap_FetchTermFromDB(cl->ClSource)) == 0L) {
|
||||
if (first_time) {
|
||||
if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) {
|
||||
Yap_Error_TYPE = YAP_NO_ERROR;
|
||||
if (!Yap_growglobal(NULL)) {
|
||||
Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage);
|
||||
return FALSE;
|
||||
}
|
||||
} else {
|
||||
Yap_Error_TYPE = YAP_NO_ERROR;
|
||||
if (!Yap_gcl(Yap_Error_Size, 4, ENV, gc_P(P,CP))) {
|
||||
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
|
||||
return FALSE;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
if (!Yap_gcl(Yap_Error_Size, 5, ENV, CP)) {
|
||||
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
|
||||
return FALSE;
|
||||
}
|
||||
}
|
||||
}
|
||||
return(Yap_unify(th, ArgOfTerm(1,t)) &&
|
||||
Yap_unify(tb, ArgOfTerm(2,t)));
|
||||
}
|
||||
}
|
||||
|
||||
static Int /* $hidden_predicate(P) */
|
||||
p_log_update_clause0(void)
|
||||
{
|
||||
PredEntry *pe;
|
||||
Term t1 = Deref(ARG1);
|
||||
Int ret;
|
||||
yamop *new_cp;
|
||||
|
||||
if (P->opc == EXECUTE_CPRED_OP_CODE) {
|
||||
new_cp = CP;
|
||||
} else {
|
||||
new_cp = P;
|
||||
}
|
||||
pe = get_pred(t1, Deref(ARG2), "clause/3");
|
||||
if (pe == NULL || EndOfPAEntr(pe))
|
||||
return FALSE;
|
||||
LOCK(pe->PELock);
|
||||
ret = fetch_next_lu_clause0(pe, pe->CodeOfPred, t1, ARG3, new_cp, TRUE);
|
||||
return ret;
|
||||
}
|
||||
|
||||
static Int /* $hidden_predicate(P) */
|
||||
p_continue_log_update_clause0(void)
|
||||
{
|
||||
PredEntry *pe = (PredEntry *)IntegerOfTerm(Deref(ARG1));
|
||||
yamop *ipc = (yamop *)IntegerOfTerm(ARG2);
|
||||
|
||||
LOCK(pe->PELock);
|
||||
return fetch_next_lu_clause0(pe, ipc, Deref(ARG3), ARG4, B->cp_cp, FALSE);
|
||||
}
|
||||
|
||||
static void
|
||||
adjust_cl_timestamp(LogUpdClause *cl, UInt *arp, UInt *base)
|
||||
{
|
||||
@ -5662,8 +5552,6 @@ Yap_InitCdMgr(void)
|
||||
Yap_InitCPred("$continue_log_update_clause", 5, p_continue_log_update_clause, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$log_update_clause_erase", 4, p_log_update_clause_erase, SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$continue_log_update_clause_erase", 5, p_continue_log_update_clause_erase, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$log_update_clause", 3, p_log_update_clause0, SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$continue_log_update_clause", 4, p_continue_log_update_clause0, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$static_clause", 4, p_static_clause, SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$continue_static_clause", 5, p_continue_static_clause, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$static_pred_statistics", 5, p_static_pred_statistics, SyncPredFlag|HiddenPredFlag);
|
||||
|
||||
@ -474,7 +474,7 @@ debugging :-
|
||||
F /\ 0x18402000 =\= 0, !, % dynamic procedure, logical semantics, user-C, or source
|
||||
% use the interpreter
|
||||
CP is '$last_choice_pt',
|
||||
'$clause'(G, M, Cl),
|
||||
'$clause'(G, M, Cl, _),
|
||||
( '$do_spy'(Cl, M, CP, CalledFromDebugger) ; InRedo = true ).
|
||||
'$spycall'(G, M, CalledFromDebugger, InRedo) :-
|
||||
'$undefined'(G, M), !,
|
||||
|
||||
@ -59,7 +59,7 @@ listing(V) :-
|
||||
'$flags'(Pred,M,Flags,Flags),
|
||||
% has to be dynamic, source, or log update.
|
||||
Flags /\ 0x08402000 =\= 0,
|
||||
'$clause'(Pred, M, Body),
|
||||
'$clause'(Pred, M, Body, _),
|
||||
'$portray_clause'(Stream,(Pred:-Body)),
|
||||
fail.
|
||||
|
||||
|
||||
14
pl/preds.yap
14
pl/preds.yap
@ -262,20 +262,6 @@ clause(V,Q) :-
|
||||
'$current_module'(M),
|
||||
'$clause'(V,M,Q,_).
|
||||
|
||||
'$clause'(V,M,Q) :- var(V), !,
|
||||
'$do_error'(instantiation_error,M:clause(V,Q)).
|
||||
'$clause'(C,M,Q) :- number(C), !,
|
||||
'$do_error'(type_error(callable,C),M:clause(C,Q)).
|
||||
'$clause'(R,M,Q) :- db_reference(R), !,
|
||||
'$do_error'(type_error(callable,R),M:clause(R,Q)).
|
||||
'$clause'(M:P,_,Q) :- !,
|
||||
'$clause'(P,M,Q).
|
||||
'$clause'(P,M,Q) :-
|
||||
'$is_log_updatable'(P, M), !,
|
||||
'$log_update_clause'(P,M,Q).
|
||||
'$clause'(P,M,Q) :-
|
||||
'$clause'(P,M,Q,_).
|
||||
|
||||
clause(P,Q,R) :- var(P), !,
|
||||
'$current_module'(M),
|
||||
'$clause'(P,M,Q,R).
|
||||
|
||||
Reference in New Issue
Block a user