This commit is contained in:
Vitor Santos Costa 2019-02-27 15:54:20 +00:00
parent facf7ae8cd
commit 8d30742d8f
5 changed files with 35 additions and 54 deletions

View File

@ -120,48 +120,7 @@ bool Yap_Consulting(USES_REGS1) {
* assertz are supported for static predicates no database predicates are * assertz are supported for static predicates no database predicates are
* supportted for fast predicates * supportted for fast predicates
*/ */
PredEntry *Yap_get_pred(Term t, Term tmod, const char *pname) { 1
Term t0 = t;
restart:
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t0, pname);
return NULL;
} else if (IsAtomTerm(t)) {
PredEntry *ap = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t), tmod));
return ap;
} else if (IsIntegerTerm(t) && tmod == IDB_MODULE) {
return Yap_FindLUIntKey(IntegerOfTerm(t));
} else if (IsPairTerm(t)) {
t = Yap_MkApplTerm(FunctorCsult, 1, &t);
goto restart;
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
if (IsExtensionFunctor(fun)) {
Yap_Error(TYPE_ERROR_CALLABLE, Yap_PredicateIndicator(t, tmod), pname);
return NULL;
}
if (fun == FunctorModule) {
Term tmod = ArgOfTerm(1, t);
if (IsVarTerm(tmod)) {
Yap_Error(INSTANTIATION_ERROR, t0, pname);
return NULL;
}
if (!IsAtomTerm(tmod)) {
Yap_Error(TYPE_ERROR_ATOM, t0, pname);
return NULL;
}
t = ArgOfTerm(2, t);
goto restart;
}
PredEntry *ap = RepPredProp(Yap_GetPredPropByFunc(fun, tmod));
return ap;
} else {
Yap_Error(TYPE_ERROR_CALLABLE, t0, pname);
}
return NULL;
}
/** Look for a predicate with same functor as t, /** Look for a predicate with same functor as t,
create a new one of it cannot find it. create a new one of it cannot find it.
*/ */
@ -179,7 +138,7 @@ restart:
} else if (IsApplTerm(t)) { } else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t); Functor fun = FunctorOfTerm(t);
if (IsExtensionFunctor(fun)) { if (IsExtensionFunctor(fun)) {
Yap_Error(TYPE_ERROR_CALLABLE, Yap_PredicateIndicator(t, tmod), pname); Yap_Error(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, tmod), pname);
return NULL; return NULL;
} }
if (fun == FunctorModule) { if (fun == FunctorModule) {
@ -349,7 +308,7 @@ static void split_megaclause(PredEntry *ap) {
mcl = ClauseCodeToMegaClause(ap->cs.p_code.FirstClause); mcl = ClauseCodeToMegaClause(ap->cs.p_code.FirstClause);
if (mcl->ClFlags & ExoMask) { if (mcl->ClFlags & ExoMask) {
Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, Yap_PredicateIndicator(CurrentModule,ap), Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, Yap_PredicateToIndicator(ap),
"while deleting clause from exo predicate %s/%d\n", "while deleting clause from exo predicate %s/%d\n",
RepAtom(NameOfFunctor(ap->FunctorOfPred))->StrOfAE, RepAtom(NameOfFunctor(ap->FunctorOfPred))->StrOfAE,
ap->ArityOfPE); ap->ArityOfPE);
@ -1468,7 +1427,7 @@ static yamop *addcl_permission_error(const char *file, const char *function,
int lineno, PredEntry *ap, int lineno, PredEntry *ap,
int in_use) { int in_use) {
CACHE_REGS CACHE_REGS
Term culprit = Yap_PredicateIndicator(CurrentModule, ap); Term culprit = Yap_PredicateToIndicator( ap);
return in_use return in_use
? (ap->ArityOfPE == 0 ? (ap->ArityOfPE == 0
? Yap_Error__(false, file, function, lineno, ? Yap_Error__(false, file, function, lineno,
@ -2185,7 +2144,7 @@ static Int p_purge_clauses(USES_REGS1) { /* '$purge_clauses'(+Func) */
PELOCK(21, pred); PELOCK(21, pred);
if (pred->PredFlags & StandardPredFlag) { if (pred->PredFlags & StandardPredFlag) {
UNLOCKPE(33, pred); UNLOCKPE(33, pred);
Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, Yap_PredicateIndicator(CurrentModule, pred), "assert/1"); Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, Yap_PredicateToIndicator(pred), "assert/1");
return (FALSE); return (FALSE);
} }
purge_clauses(pred); purge_clauses(pred);
@ -4102,7 +4061,7 @@ static Int
| TabledPredFlag | TabledPredFlag
#endif /* TABLING */ #endif /* TABLING */
)) { )) {
Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, Yap_PredicateIndicator(CurrentModule, ap), Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, Yap_PredicateToIndicator(ap),
"dbload_get_space/4"); "dbload_get_space/4");
return FALSE; return FALSE;
} }

View File

@ -151,7 +151,7 @@ Term Yap_ExecuteCallMetaCall(Term g, Term mod) {
return Yap_MkApplTerm(PredMetaCall->FunctorOfPred, 4, ts); return Yap_MkApplTerm(PredMetaCall->FunctorOfPred, 4, ts);
} }
Term Yap_PredicateIndicator(Term t, Term mod) { Term Yap_TermToIndicator(Term t, Term mod) {
CACHE_REGS CACHE_REGS
// generate predicate indicator in this case // generate predicate indicator in this case
Term ti[2]; Term ti[2];
@ -175,6 +175,27 @@ Term Yap_PredicateIndicator(Term t, Term mod) {
return t; return t;
} }
Term Yap_PredicateToIndicator(PredEntry *pe) {
CACHE_REGS
// generate predicate indicator in this case
Term ti[2];
if (pe->ArityOfPE) {
ti[0] = MkAtomTerm(NameOfFunctor(pe->FunctorOfPred));
ti[1] = MkIntegerTerm(ArityOfFunctor(pe->FunctorOfPred));
} else {
ti[0] = t;
ti[1] = MkIntTerm(0);
}
t = Yap_MkApplTerm(FunctorSlash, 2, ti);
Term mod
if (mod != TermUser and mod!= TermProlog) {
ti[0] = mod;
ti[1] = t;
return Yap_MkApplTerm(FunctorModule, 2, ti);
}
return t;
}
static bool CallError(yap_error_number err, Term t, Term mod USES_REGS) { static bool CallError(yap_error_number err, Term t, Term mod USES_REGS) {
if (isoLanguageFlag()) { if (isoLanguageFlag()) {
return (CallMetaCall(t, mod PASS_REGS)); return (CallMetaCall(t, mod PASS_REGS));
@ -280,9 +301,9 @@ restart:
} else if (IsIntegerTerm(t) && tmod == IDB_MODULE) { } else if (IsIntegerTerm(t) && tmod == IDB_MODULE) {
return Yap_FindLUIntKey(IntegerOfTerm(t)); return Yap_FindLUIntKey(IntegerOfTerm(t));
} else if (IsApplTerm(t)) { } else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t); Functor fun = pe->FunctorOfPred;
if (IsExtensionFunctor(fun)) { if (IsExtensionFunctor(fun)) {
Yap_Error(TYPE_ERROR_CALLABLE, Yap_PredicateIndicator(t, tmod), pname); Yap_Error(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, tmod), pname);
return NULL; return NULL;
} }
if (fun == FunctorModule) { if (fun == FunctorModule) {
@ -1897,7 +1918,7 @@ Term Yap_RunTopGoal(Term t, bool handle_errors) {
pt = RepAppl(t) + 1; pt = RepAppl(t) + 1;
arity = ArityOfFunctor(f); arity = ArityOfFunctor(f);
} else { } else {
Yap_Error(TYPE_ERROR_CALLABLE, Yap_PredicateIndicator(t, tmod), "call/1"); Yap_Error(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, tmod), "call/1");
LOCAL_PrologMode &= ~TopGoalMode; LOCAL_PrologMode &= ~TopGoalMode;
return (FALSE); return (FALSE);
} }

View File

@ -4152,7 +4152,7 @@ restart_index:
} }
#if DEBUG #if DEBUG
if (GLOBAL_Option['i' - 'a' + 1]) { if (GLOBAL_Option['i' - 'a' + 1]) {
Yap_DebugWriteIndicator(ap); Yap_DebugWritexozoIndicator(ap);
} }
#endif #endif
if ((labp = expand_index(&cint)) == NULL) { if ((labp = expand_index(&cint)) == NULL) {

View File

@ -434,7 +434,7 @@ vxu `on` consider `$` a lower case character.
*/ */
YAP_FLAG(PROFILING_FLAG, "profiling", true, booleanFlag, "false", NULL), YAP_FLAG(PROFILING_FLAG, "profiling", true, booleanFlag, "false", NULL),
/**< `prompt_alternatives_on(atom, /**< ` pt_alternatives_on(atom,
changeable) ` changeable) `
SWI-Compatible option, determines prompting for alternatives in the Prolog SWI-Compatible option, determines prompting for alternatives in the Prolog

View File

@ -212,7 +212,8 @@ extern void Yap_PrepGoal(UInt, CELL *, choiceptr USES_REGS);
extern bool Yap_execute_pred(struct pred_entry *ppe, CELL *pt, extern bool Yap_execute_pred(struct pred_entry *ppe, CELL *pt,
bool pass_exception USES_REGS); bool pass_exception USES_REGS);
extern int Yap_dogc(int extra_args, Term *tp USES_REGS); extern int Yap_dogc(int extra_args, Term *tp USES_REGS);
extern Term Yap_PredicateIndicator(Term t, Term mod); extern Term Yap_PredicateToIndicator(struct pred_entry *pe);
extern Term Yap_TermToIndicator(Term t, Term mod);
extern bool Yap_Execute(Term t USES_REGS); extern bool Yap_Execute(Term t USES_REGS);
/* exo.c */ /* exo.c */