diff --git a/C/cdmgr.c b/C/cdmgr.c index d7cefa454..f0165550d 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -120,48 +120,7 @@ bool Yap_Consulting(USES_REGS1) { * assertz are supported for static predicates no database predicates are * supportted for fast predicates */ -PredEntry *Yap_get_pred(Term t, Term tmod, const char *pname) { - 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; -} - +1 /** Look for a predicate with same functor as t, create a new one of it cannot find it. */ @@ -179,7 +138,7 @@ restart: } else if (IsApplTerm(t)) { Functor fun = FunctorOfTerm(t); 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; } if (fun == FunctorModule) { @@ -349,7 +308,7 @@ static void split_megaclause(PredEntry *ap) { mcl = ClauseCodeToMegaClause(ap->cs.p_code.FirstClause); 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", RepAtom(NameOfFunctor(ap->FunctorOfPred))->StrOfAE, ap->ArityOfPE); @@ -1468,7 +1427,7 @@ static yamop *addcl_permission_error(const char *file, const char *function, int lineno, PredEntry *ap, int in_use) { CACHE_REGS - Term culprit = Yap_PredicateIndicator(CurrentModule, ap); + Term culprit = Yap_PredicateToIndicator( ap); return in_use ? (ap->ArityOfPE == 0 ? Yap_Error__(false, file, function, lineno, @@ -2185,7 +2144,7 @@ static Int p_purge_clauses(USES_REGS1) { /* '$purge_clauses'(+Func) */ PELOCK(21, pred); if (pred->PredFlags & StandardPredFlag) { 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); } purge_clauses(pred); @@ -4102,7 +4061,7 @@ static Int | TabledPredFlag #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"); return FALSE; } diff --git a/C/exec.c b/C/exec.c index 38caee798..de5cc31b0 100755 --- a/C/exec.c +++ b/C/exec.c @@ -151,7 +151,7 @@ Term Yap_ExecuteCallMetaCall(Term g, Term mod) { return Yap_MkApplTerm(PredMetaCall->FunctorOfPred, 4, ts); } -Term Yap_PredicateIndicator(Term t, Term mod) { +Term Yap_TermToIndicator(Term t, Term mod) { CACHE_REGS // generate predicate indicator in this case Term ti[2]; @@ -175,6 +175,27 @@ Term Yap_PredicateIndicator(Term t, Term mod) { 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) { if (isoLanguageFlag()) { return (CallMetaCall(t, mod PASS_REGS)); @@ -280,9 +301,9 @@ restart: } else if (IsIntegerTerm(t) && tmod == IDB_MODULE) { return Yap_FindLUIntKey(IntegerOfTerm(t)); } else if (IsApplTerm(t)) { - Functor fun = FunctorOfTerm(t); + Functor fun = pe->FunctorOfPred; 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; } if (fun == FunctorModule) { @@ -1897,7 +1918,7 @@ Term Yap_RunTopGoal(Term t, bool handle_errors) { pt = RepAppl(t) + 1; arity = ArityOfFunctor(f); } 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; return (FALSE); } diff --git a/C/index.c b/C/index.c index 03e9d41b0..0ae420a6f 100755 --- a/C/index.c +++ b/C/index.c @@ -4152,7 +4152,7 @@ restart_index: } #if DEBUG if (GLOBAL_Option['i' - 'a' + 1]) { - Yap_DebugWriteIndicator(ap); + Yap_DebugWritexozoIndicator(ap); } #endif if ((labp = expand_index(&cint)) == NULL) { diff --git a/H/YapGFlagInfo.h b/H/YapGFlagInfo.h index 83d8d7aa3..73cc33054 100644 --- a/H/YapGFlagInfo.h +++ b/H/YapGFlagInfo.h @@ -434,7 +434,7 @@ vxu `on` consider `$` a lower case character. */ YAP_FLAG(PROFILING_FLAG, "profiling", true, booleanFlag, "false", NULL), - /**< `prompt_alternatives_on(atom, + /**< ` pt_alternatives_on(atom, changeable) ` SWI-Compatible option, determines prompting for alternatives in the Prolog diff --git a/H/Yapproto.h b/H/Yapproto.h index 309e9eaa7..1d2a87302 100755 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -212,7 +212,8 @@ extern void Yap_PrepGoal(UInt, CELL *, choiceptr USES_REGS); extern bool Yap_execute_pred(struct pred_entry *ppe, CELL *pt, bool pass_exception 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); /* exo.c */