improv meta-calls
This commit is contained in:
parent
c78f3e085a
commit
7d66aa5d01
@ -1623,7 +1623,7 @@ static int run_emulator(USES_REGS1) {
|
||||
return out;
|
||||
}
|
||||
|
||||
X_API bool YAP_EnterGoal(PredEntry *pe, yhandle_t ptr, YAP_dogoalinfo *dgi) {
|
||||
X_API bool YAP_EnterGoal(PredEntry *pe, CELL *ptr, YAP_dogoalinfo *dgi) {
|
||||
CACHE_REGS
|
||||
bool out;
|
||||
|
||||
@ -1634,7 +1634,7 @@ X_API bool YAP_EnterGoal(PredEntry *pe, yhandle_t ptr, YAP_dogoalinfo *dgi) {
|
||||
dgi->CurSlot = LOCAL_CurSlot;
|
||||
// ensure our current ENV receives current P.
|
||||
|
||||
Yap_PrepGoal(pe->ArityOfPE, Yap_AddressFromSlot(ptr), B PASS_REGS);
|
||||
Yap_PrepGoal(pe->ArityOfPE, nullptr, B PASS_REGS);
|
||||
P = pe->CodeOfPred;
|
||||
// __android_log_print(ANDROID_LOG_INFO, "YAP ", "ap=%p %d %x %x args=%x,%x
|
||||
// slot=%d", pe, pe->CodeOfPred->opc, FAILCODE, Deref(ARG1), Deref(ARG2),
|
||||
@ -1679,7 +1679,7 @@ X_API bool YAP_RetryGoal(YAP_dogoalinfo *dgi) {
|
||||
return out;
|
||||
}
|
||||
|
||||
X_API bool YAP_LeaveGoal(int backtrack, YAP_dogoalinfo *dgi) {
|
||||
X_API bool YAP_LeaveGoal(bool backtrack, YAP_dogoalinfo *dgi) {
|
||||
CACHE_REGS
|
||||
choiceptr myB;
|
||||
|
||||
|
106
C/exec.c
106
C/exec.c
@ -209,6 +209,66 @@ static Int save_env_b(USES_REGS1) {
|
||||
return true;
|
||||
}
|
||||
|
||||
/** Look for a predicate with same functor as t,
|
||||
create a new one of it cannot find it.
|
||||
*/
|
||||
static PredEntry *new_pred(Term t, Term tmod, char *pname) {
|
||||
Term t0 = t;
|
||||
|
||||
restart:
|
||||
if (IsVarTerm(t)) {
|
||||
Yap_Error(INSTANTIATION_ERROR, t0, pname);
|
||||
return NULL;
|
||||
} else if (IsAtomTerm(t)) {
|
||||
return RepPredProp(PredPropByAtom(AtomOfTerm(t), tmod));
|
||||
} else if (IsIntegerTerm(t) && tmod == IDB_MODULE) {
|
||||
return Yap_FindLUIntKey(IntegerOfTerm(t));
|
||||
} 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;
|
||||
}
|
||||
return RepPredProp(PredPropByFunc(fun, tmod));
|
||||
} else
|
||||
return NULL;
|
||||
}
|
||||
|
||||
static bool CommaCall(Term t, Term mod) {
|
||||
PredEntry *pen;
|
||||
arity_t i;
|
||||
if (IsVarTerm(t) || (pen = new_pred(t, mod, "_,_")))
|
||||
return false;
|
||||
for (i = 0; i < pen->ArityOfPE; i++) {
|
||||
YENV[-EnvSizeInCells - i] = XREGS[i + 1];
|
||||
}
|
||||
YENV[E_CB] = (CELL)B;
|
||||
YENV[E_CP] = (CELL)P;
|
||||
YENV[E_E] = (CELL)ENV;
|
||||
YENV[E_DEPTH] = DEPTH;
|
||||
|
||||
ASP = YENV - (EnvSizeInCells + i);
|
||||
ENV = YENV;
|
||||
YENV = ASP;
|
||||
if ((P = pen->MetaEntryOfPred) == NULL) {
|
||||
P = Yap_InitCommaContinuation(pen);
|
||||
}
|
||||
return P == NULL;
|
||||
}
|
||||
|
||||
inline static bool do_execute(Term t, Term mod USES_REGS) {
|
||||
Term t0 = t;
|
||||
t = Yap_YapStripModule(t, &mod);
|
||||
@ -220,14 +280,28 @@ inline static bool do_execute(Term t, Term mod USES_REGS) {
|
||||
}
|
||||
if (IsVarTerm(t) || IsVarTerm(mod)) {
|
||||
return CallError(INSTANTIATION_ERROR, t0, mod PASS_REGS);
|
||||
} else if (IsApplTerm(t)) {
|
||||
}
|
||||
if (IsApplTerm(t)) {
|
||||
register Functor f = FunctorOfTerm(t);
|
||||
register CELL *pt;
|
||||
PredEntry *pen;
|
||||
unsigned int i, arity;
|
||||
|
||||
f = FunctorOfTerm(t);
|
||||
if (IsExtensionFunctor(f)) {
|
||||
if (f == FunctorComma && false) {
|
||||
Term t2 = ArgOfTerm(2, t);
|
||||
if (IsVarTerm(t2))
|
||||
return CallMetaCall(t, mod PASS_REGS);
|
||||
if (!CommaCall(t2, mod))
|
||||
return CallMetaCall(t, mod PASS_REGS);
|
||||
Term t1 = ArgOfTerm(1, t);
|
||||
|
||||
t = t1;
|
||||
pen = new_pred(t, mod, "_,_");
|
||||
if (pen == NULL || (arity = pen->ArityOfPE) == 0) {
|
||||
return do_execute(t, mod);
|
||||
}
|
||||
} else if (IsExtensionFunctor(f)) {
|
||||
return CallError(TYPE_ERROR_CALLABLE, t, mod PASS_REGS);
|
||||
}
|
||||
arity = ArityOfFunctor(f);
|
||||
@ -237,9 +311,6 @@ inline static bool do_execute(Term t, Term mod USES_REGS) {
|
||||
pen = RepPredProp(PredPropByFunc(f, mod));
|
||||
/* You thought we would be over by now */
|
||||
/* but no meta calls require special preprocessing */
|
||||
if (pen->PredFlags & MetaPredFlag) {
|
||||
return CallMetaCall(t, mod PASS_REGS);
|
||||
}
|
||||
/* now let us do what we wanted to do from the beginning !! */
|
||||
/* I cannot use the standard macro here because
|
||||
otherwise I would dereference the argument and
|
||||
@ -249,7 +320,7 @@ inline static bool do_execute(Term t, Term mod USES_REGS) {
|
||||
#if YAPOR_SBA
|
||||
Term d0 = *pt++;
|
||||
if (d0 == 0)
|
||||
` XREGS[i] = (CELL)(pt - 1);
|
||||
XREGS[i] = (CELL)(pt - 1);
|
||||
else
|
||||
XREGS[i] = d0;
|
||||
#else
|
||||
@ -257,8 +328,9 @@ inline static bool do_execute(Term t, Term mod USES_REGS) {
|
||||
XREGS[i] = *pt++;
|
||||
#endif
|
||||
}
|
||||
return (CallPredicate(pen, B, pen->CodeOfPred PASS_REGS));
|
||||
} else if (IsAtomTerm(t)) {
|
||||
return CallPredicate(pen, B, pen->CodeOfPred PASS_REGS);
|
||||
}
|
||||
if (IsAtomTerm(t)) {
|
||||
PredEntry *pe;
|
||||
Atom a = AtomOfTerm(t);
|
||||
|
||||
@ -271,12 +343,8 @@ inline static bool do_execute(Term t, Term mod USES_REGS) {
|
||||
/* call may not define new system predicates!! */
|
||||
pe = RepPredProp(PredPropByAtom(a, mod));
|
||||
return (CallPredicate(pe, B, pe->CodeOfPred PASS_REGS));
|
||||
} else if (IsIntTerm(t)) {
|
||||
return CallError(TYPE_ERROR_CALLABLE, t, mod PASS_REGS);
|
||||
} else {
|
||||
/* Is Pair Term */
|
||||
return (CallMetaCall(t, mod PASS_REGS));
|
||||
}
|
||||
return CallMetaCall(t, mod PASS_REGS);
|
||||
}
|
||||
|
||||
static Term copy_execn_to_heap(Functor f, CELL *pt, unsigned int n,
|
||||
@ -1133,6 +1201,7 @@ static Int execute0(USES_REGS1) { /* '$execute0'(Goal,Mod) */
|
||||
if (Yap_has_a_signal() && !LOCAL_InterruptsDisabled) {
|
||||
return EnterCreepMode(t, mod PASS_REGS);
|
||||
}
|
||||
t = Yap_YapStripModule(t, &mod);
|
||||
restart_exec:
|
||||
if (IsVarTerm(t)) {
|
||||
Yap_Error(INSTANTIATION_ERROR, ARG3, "call/1");
|
||||
@ -1407,7 +1476,7 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
|
||||
return out;
|
||||
}
|
||||
|
||||
void Yap_PrepGoal(UInt arity, CELL *pt, choiceptr saved_b USES_REGS) {
|
||||
void Yap_PrepGoal(arity_t arity, CELL *pt, choiceptr saved_b USES_REGS) {
|
||||
/* create an initial pseudo environment so that when garbage
|
||||
collection is going up in the environment chain it doesn't get
|
||||
confused */
|
||||
@ -1526,7 +1595,7 @@ void Yap_fail_all(choiceptr bb USES_REGS) {
|
||||
P = saved_p;
|
||||
}
|
||||
|
||||
bool Yap_execute_pred( PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) {
|
||||
bool Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) {
|
||||
yamop *saved_p, *saved_cp;
|
||||
yamop *CodeAdr;
|
||||
bool out;
|
||||
@ -2004,13 +2073,18 @@ static Int jump_env(USES_REGS1) {
|
||||
if (IsVarTerm(t)) {
|
||||
Yap_Error(INSTANTIATION_ERROR, t, "throw ball must be bound");
|
||||
return false;
|
||||
} else if (IsApplTerm(t) && FunctorOfTerm(t) == FunctorError) {
|
||||
Yap_find_prolog_culprit(PASS_REGS1);
|
||||
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
|
||||
} else {
|
||||
LOCAL_Error_TYPE = THROW_EVENT;
|
||||
}
|
||||
LOCAL_ActiveError.prologPredName = NULL;
|
||||
Yap_PutException(t);
|
||||
bool out = JumpToEnv(PASS_REGS1);
|
||||
if (B != NULL && P == FAILCODE && B->cp_ap == NOCODE &&
|
||||
LCL0 - (CELL *)B > LOCAL_CBorder) {
|
||||
// we're failing up to the top layer
|
||||
LOCAL_Error_TYPE = THROW_EVENT;
|
||||
}
|
||||
return out;
|
||||
}
|
||||
|
@ -23,7 +23,7 @@
|
||||
/* original goal */
|
||||
d0 = ENV_YREG[-EnvSizeInCells-1];
|
||||
/* predicate we had used */
|
||||
pen = RepPredProp((Prop)IntegerOfTerm(ENV_YREG[-EnvSizeInCells-2]));
|
||||
pen = RepPredProp(AddressOfTerm(ENV_YREG[-EnvSizeInCells-2]));
|
||||
/* current module at the time */
|
||||
mod = ENV_YREG[-EnvSizeInCells-3];
|
||||
/* set YREG */
|
||||
|
Reference in New Issue
Block a user