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

use unification, not wakeup, to verify if two terms are unifiable. Fixes Ulrich Neumerkel #306 

Also renitent
This commit is contained in:
Vítor Santos Costa 2015-11-09 11:25:55 +00:00
parent 50c04116c8
commit ca81e5d8ea
2 changed files with 229 additions and 237 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
C/attvar.c
View File

@ -1,19 +1,19 @@
/************************************************************************* /*************************************************************************
* * * *
* YAP Prolog * * YAP Prolog *
* * * *
* Yap Prolog was developed at NCCUP - Universidade do Porto * * Yap Prolog was developed at NCCUP - Universidade do Porto *
* * * *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* * * *
************************************************************************** **************************************************************************
* * * *
* File: attvar.c * * File: attvar.c *
* Last rev: * * Last rev: *
* mods: * * mods: *
* comments: YAP support for attributed vars * * comments: YAP support for attributed vars *
* * * *
*************************************************************************/ *************************************************************************/
#ifdef SCCS #ifdef SCCS
static char SccsId[] = "%W% %G%"; static char SccsId[] = "%W% %G%";
#endif #endif
@ -31,7 +31,7 @@ static char SccsId[] = "%W% %G%";
/** @{ */ /** @{ */
/** @defgroup Attribute_Variables_Builtins Implementation of Attribute /** @defgroup Attribute_Variables_Builtins Implementation of Attribute
Declarations Declarations
@ingroup Attributed_Variables @ingroup Attributed_Variables
*/ */
@ -201,7 +201,7 @@ static void WakeAttVar(CELL *pt1, CELL reg2 USES_REGS) {
void Yap_WakeUp(CELL *pt0) { void Yap_WakeUp(CELL *pt0) {
CACHE_REGS CACHE_REGS
CELL d0 = *pt0; CELL d0 = *pt0;
RESET_VARIABLE(pt0); RESET_VARIABLE(pt0);
WakeAttVar(pt0, d0 PASS_REGS); WakeAttVar(pt0, d0 PASS_REGS);
} }
@ -911,9 +911,9 @@ static Term AllAttVars(USES_REGS1) {
break; break;
case (CELL) FunctorBigInt: { case (CELL) FunctorBigInt: {
Int sz = 3 + Int sz = 3 +
(sizeof(MP_INT) + (sizeof(MP_INT) +
(((MP_INT *)(pt + 2))->_mp_alloc * sizeof(mp_limb_t))) / (((MP_INT *)(pt + 2))->_mp_alloc * sizeof(mp_limb_t))) /
sizeof(CELL); sizeof(CELL);
pt += sz; pt += sz;
} break; } break;
case (CELL) FunctorLongInt: case (CELL) FunctorLongInt:
@ -965,7 +965,7 @@ static Int p_is_attvar(USES_REGS1) {
static Int p_attvar_bound(USES_REGS1) { static Int p_attvar_bound(USES_REGS1) {
Term t = Deref(ARG1); Term t = Deref(ARG1);
return IsVarTerm(t) && IsAttachedTerm(t) && return IsVarTerm(t) && IsAttachedTerm(t) &&
!IsUnboundVar(&(RepAttVar(VarOfTerm(t))->Done)); !IsUnboundVar(&(RepAttVar(VarOfTerm(t))->Done));
} }
static Int p_void_term(USES_REGS1) { return Yap_unify(ARG1, TermVoidAtt); } static Int p_void_term(USES_REGS1) { return Yap_unify(ARG1, TermVoidAtt); }
@ -1005,7 +1005,7 @@ static Int p_attvar_bound(USES_REGS1) { return FALSE; }
void Yap_InitAttVarPreds(void) { void Yap_InitAttVarPreds(void) {
CACHE_REGS CACHE_REGS
Term OldCurrentModule = CurrentModule; Term OldCurrentModule = CurrentModule;
CurrentModule = ATTRIBUTES_MODULE; CurrentModule = ATTRIBUTES_MODULE;
#ifdef COROUTINING #ifdef COROUTINING
GLOBAL_attas[attvars_ext].bind_op = WakeAttVar; GLOBAL_attas[attvars_ext].bind_op = WakeAttVar;

422
C/corout.c
View File

@ -15,7 +15,7 @@
* * * *
*************************************************************************/ *************************************************************************/
#ifdef SCCS #ifdef SCCS
static char SccsId[]="%W% %G%"; static char SccsId[] = "%W% %G%";
#endif #endif
#include "Yap.h" #include "Yap.h"
@ -30,23 +30,20 @@ static char SccsId[]="%W% %G%";
#ifdef COROUTINING #ifdef COROUTINING
/* check if variable was there */ /* check if variable was there */
static Term AddVarIfNotThere(Term var , Term dest USES_REGS) static Term AddVarIfNotThere(Term var, Term dest USES_REGS) {
{
Term test = dest; Term test = dest;
while (test != TermNil) { while (test != TermNil) {
if ((RepPair(test))[0] == var) return(dest); if ((RepPair(test))[0] == var)
else test = (RepPair(test))[1]; return (dest);
else
test = (RepPair(test))[1];
} }
return(MkPairTerm(var,dest)); return (MkPairTerm(var, dest));
} }
/* This routine verifies whether two complex structures can unify. */ /* This routine verifies whether two complex structures can unify. */
static int can_unify_complex(register CELL *pt0, static int can_unify_complex(register CELL *pt0, register CELL *pt0_end,
register CELL *pt0_end, register CELL *pt1, Term *Vars USES_REGS) {
register CELL *pt1,
Term *Vars USES_REGS)
{
/* This is really just unification, folks */ /* This is really just unification, folks */
tr_fr_ptr saved_TR; tr_fr_ptr saved_TR;
@ -62,134 +59,139 @@ static int can_unify_complex(register CELL *pt0,
saved_HB = HB; saved_HB = HB;
HB = HR; HB = HR;
loop: loop:
while (pt0 < pt0_end) { while (pt0 < pt0_end) {
register CELL d0, d1; register CELL d0, d1;
++ pt0; ++pt0;
++ pt1; ++pt1;
d0 = Derefa(pt0); d0 = Derefa(pt0);
d1 = Derefa(pt1); d1 = Derefa(pt1);
if (IsVarTerm(d0)) { if (IsVarTerm(d0)) {
if (IsVarTerm(d1)) { if (IsVarTerm(d1)) {
if (d0 != d1) { if (d0 != d1) {
/* we need to suspend on both variables ! */ /* we need to suspend on both variables ! */
*Vars = AddVarIfNotThere(d0, AddVarIfNotThere(d1,*Vars PASS_REGS) PASS_REGS); *Vars = AddVarIfNotThere(d0, AddVarIfNotThere(d1, *Vars PASS_REGS)
/* bind the two variables, we would have to do that to unify PASS_REGS);
them */ /* bind the two variables, we would have to do that to unify
if (d1 > d0) { /* youngest */ them */
/* we don't want to wake up goals */ if (d1 > d0) { /* youngest */
Bind_Global((CELL *)d1, d0); /* we don't want to wake up goals */
} else { Bind_Global_NonAtt((CELL *)d1, d0);
Bind_Global((CELL *)d0, d1); } else {
} Bind_Global_NonAtt((CELL *)d0, d1);
} }
/* continue the loop */ }
continue; /* continue the loop */
} continue;
else { } else {
/* oh no, some more variables! */ /* oh no, some more variables! */
*Vars = AddVarIfNotThere(d0, *Vars PASS_REGS); *Vars = AddVarIfNotThere(d0, *Vars PASS_REGS);
} }
/* now bind it */ /* now bind it */
Bind_Global((CELL *)d0, d1); Bind_Global_NonAtt((CELL *)d0, d1);
/* continue the loop */ /* continue the loop */
} else if (IsVarTerm(d1)) { } else if (IsVarTerm(d1)) {
*Vars = AddVarIfNotThere(d1, *Vars PASS_REGS); *Vars = AddVarIfNotThere(d1, *Vars PASS_REGS);
/* and bind it */ /* and bind it */
Bind_Global((CELL *)d1, d0); Bind_Global_NonAtt((CELL *)d1, d0);
/* continue the loop */ /* continue the loop */
} else { } else {
if (d0 == d1) continue; if (d0 == d1)
continue;
if (IsAtomOrIntTerm(d0) || IsAtomOrIntTerm(d1)) { if (IsAtomOrIntTerm(d0) || IsAtomOrIntTerm(d1)) {
if (d0 != d1) goto comparison_failed; if (d0 != d1)
/* else continue the loop */ goto comparison_failed;
} /* else continue the loop */
else if (IsPairTerm(d0)) { } else if (IsPairTerm(d0)) {
if (!IsPairTerm(d1)) goto comparison_failed; if (!IsPairTerm(d1))
goto comparison_failed;
#ifdef RATIONAL_TREES #ifdef RATIONAL_TREES
to_visit[0] = pt0; to_visit[0] = pt0;
to_visit[1] = pt0_end; to_visit[1] = pt0_end;
to_visit[2] = pt1; to_visit[2] = pt1;
to_visit[3] = (CELL *)*pt0; to_visit[3] = (CELL *)*pt0;
to_visit += 4; to_visit += 4;
*pt0 = d1; *pt0 = d1;
#else #else
/* store the terms to visit */ /* store the terms to visit */
if (pt0 < pt0_end) { if (pt0 < pt0_end) {
to_visit[0] = pt0; to_visit[0] = pt0;
to_visit[1] = pt0_end; to_visit[1] = pt0_end;
to_visit[2] = pt1; to_visit[2] = pt1;
to_visit += 3; to_visit += 3;
} }
#endif #endif
pt0 = RepPair(d0) - 1; pt0 = RepPair(d0) - 1;
pt0_end = RepPair(d0) + 1; pt0_end = RepPair(d0) + 1;
pt1 = RepPair(d1) - 1; pt1 = RepPair(d1) - 1;
continue; continue;
} } else if (IsApplTerm(d0)) {
else if (IsApplTerm(d0)) { register Functor f;
register Functor f; register CELL *ap2, *ap3;
register CELL *ap2, *ap3; if (!IsApplTerm(d1)) {
if (!IsApplTerm(d1)) { goto comparison_failed;
goto comparison_failed; } else {
} else { /* store the terms to visit */
/* store the terms to visit */ ap2 = RepAppl(d0);
ap2 = RepAppl(d0); ap3 = RepAppl(d1);
ap3 = RepAppl(d1); f = (Functor)(*ap2);
f = (Functor)(*ap2); /* compare functors */
/* compare functors */ if (f != (Functor)*ap3) {
if (f != (Functor)*ap3) { goto comparison_failed;
goto comparison_failed; }
} if (IsExtensionFunctor(f)) {
if (IsExtensionFunctor(f)) { switch ((CELL)f) {
switch((CELL)f) { case (CELL) FunctorDBRef:
case (CELL)FunctorDBRef: if (d0 == d1)
if (d0 == d1) continue; continue;
goto comparison_failed; goto comparison_failed;
case (CELL)FunctorLongInt: case (CELL) FunctorLongInt:
if (ap2[1] == ap3[1]) continue; if (ap2[1] == ap3[1])
goto comparison_failed; continue;
case (CELL)FunctorDouble: goto comparison_failed;
if (FloatOfTerm(d0) == FloatOfTerm(d1)) continue; case (CELL) FunctorDouble:
goto comparison_failed; if (FloatOfTerm(d0) == FloatOfTerm(d1))
case (CELL)FunctorString: continue;
if (strcmp((char *)StringOfTerm(d0), (char *)StringOfTerm(d1)) == 0) continue; goto comparison_failed;
goto comparison_failed; case (CELL) FunctorString:
if (strcmp((char *)StringOfTerm(d0), (char *)StringOfTerm(d1)) ==
0)
continue;
goto comparison_failed;
#ifdef USE_GMP #ifdef USE_GMP
case (CELL)FunctorBigInt: case (CELL) FunctorBigInt:
if (Yap_gmp_tcmp_big_big(d0,d1) == 0) continue; if (Yap_gmp_tcmp_big_big(d0, d1) == 0)
goto comparison_failed; continue;
goto comparison_failed;
#endif /* USE_GMP */ #endif /* USE_GMP */
default: default:
goto comparison_failed; goto comparison_failed;
} }
} }
#ifdef RATIONAL_TREES #ifdef RATIONAL_TREES
to_visit[0] = pt0; to_visit[0] = pt0;
to_visit[1] = pt0_end; to_visit[1] = pt0_end;
to_visit[2] = pt1; to_visit[2] = pt1;
to_visit[3] = (CELL *)*pt0; to_visit[3] = (CELL *)*pt0;
to_visit += 4; to_visit += 4;
*pt0 = d1; *pt0 = d1;
#else #else
/* store the terms to visit */ /* store the terms to visit */
if (pt0 < pt0_end) { if (pt0 < pt0_end) {
to_visit[0] = pt0; to_visit[0] = pt0;
to_visit[1] = pt0_end; to_visit[1] = pt0_end;
to_visit[2] = pt1; to_visit[2] = pt1;
to_visit += 3; to_visit += 3;
} }
#endif #endif
d0 = ArityOfFunctor(f); d0 = ArityOfFunctor(f);
pt0 = ap2; pt0 = ap2;
pt0_end = ap2 + d0; pt0_end = ap2 + d0;
pt1 = ap3; pt1 = ap3;
continue; continue;
} }
} }
} }
} }
/* Do we still have compound terms to visit */ /* Do we still have compound terms to visit */
if (to_visit > (CELL **)to_visit_base) { if (to_visit > (CELL **)to_visit_base) {
@ -217,9 +219,9 @@ static int can_unify_complex(register CELL *pt0,
pt1 = (CELL *)(TrailTerm(--TR)); pt1 = (CELL *)(TrailTerm(--TR));
RESET_VARIABLE(pt1); RESET_VARIABLE(pt1);
} }
return(TRUE); return (TRUE);
comparison_failed: comparison_failed:
/* failure */ /* failure */
Yap_ReleasePreAllocCodeSpace((ADDR)to_visit); Yap_ReleasePreAllocCodeSpace((ADDR)to_visit);
#ifdef RATIONAL_TREES #ifdef RATIONAL_TREES
@ -232,15 +234,18 @@ static int can_unify_complex(register CELL *pt0,
} }
#endif #endif
/* restore B, and later HB */ /* restore B, and later HB */
B = saved_B; B = saved_B;
HB = saved_HB; HB = saved_HB;
/* untrail all bindings made by IUnify */
while (TR != saved_TR) {
pt1 = (CELL *)(TrailTerm(--TR));
RESET_VARIABLE(pt1);
}
/* the system will take care of TR for me, no need to worry here! */ /* the system will take care of TR for me, no need to worry here! */
return(FALSE); return (FALSE);
} }
static int static int can_unify(Term t1, Term t2, Term *Vars USES_REGS) {
can_unify(Term t1, Term t2, Term *Vars USES_REGS)
{
t1 = Deref(t1); t1 = Deref(t1);
t2 = Deref(t2); t2 = Deref(t2);
if (t1 == t2) { if (t1 == t2) {
@ -251,16 +256,16 @@ can_unify(Term t1, Term t2, Term *Vars USES_REGS)
/* we know for sure they can't be different */ /* we know for sure they can't be different */
if (IsVarTerm(t2)) { if (IsVarTerm(t2)) {
/* we need to suspend on both variables because otherwise /* we need to suspend on both variables because otherwise
Y = susp(_) would not wakeup susp ! */ Y = susp(_) would not wakeup susp ! */
*Vars = MkPairTerm(t1,MkPairTerm(t2,TermNil)); *Vars = MkPairTerm(t1, MkPairTerm(t2, TermNil));
return TRUE; return TRUE;
} else { } else {
*Vars = MkPairTerm(t1,TermNil); *Vars = MkPairTerm(t1, TermNil);
return TRUE; return TRUE;
} }
} else if (IsVarTerm(t2)) { } else if (IsVarTerm(t2)) {
/* wait until t2 is bound */ /* wait until t2 is bound */
*Vars = MkPairTerm(t2,TermNil); *Vars = MkPairTerm(t2, TermNil);
return TRUE; return TRUE;
} }
/* Two standard terms at last! */ /* Two standard terms at last! */
@ -276,56 +281,59 @@ can_unify(Term t1, Term t2, Term *Vars USES_REGS)
} }
} else if (IsPairTerm(t1)) { } else if (IsPairTerm(t1)) {
if (IsPairTerm(t2)) { if (IsPairTerm(t2)) {
return(can_unify_complex(RepPair(t1)-1, RepPair(t1)+1, return (can_unify_complex(RepPair(t1) - 1, RepPair(t1) + 1,
RepPair(t2)-1, Vars PASS_REGS)); RepPair(t2) - 1, Vars PASS_REGS));
} else return FALSE; } else
return FALSE;
} else { } else {
Functor f = FunctorOfTerm(t1); Functor f = FunctorOfTerm(t1);
if (f != FunctorOfTerm(t2)) if (f != FunctorOfTerm(t2))
return FALSE; return FALSE;
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
switch((CELL)f) { switch ((CELL)f) {
case (CELL)FunctorDBRef: case (CELL) FunctorDBRef:
if (t1 == t2) return FALSE; if (t1 == t2)
return FALSE; return FALSE;
case (CELL)FunctorLongInt: return FALSE;
if (RepAppl(t1)[1] == RepAppl(t2)[1]) return(TRUE); case (CELL) FunctorLongInt:
return FALSE; if (RepAppl(t1)[1] == RepAppl(t2)[1])
case (CELL)FunctorString: return (TRUE);
if (strcmp((char *)StringOfTerm(t1), (char *)StringOfTerm(t2)) == 0) return(TRUE); return FALSE;
return FALSE; case (CELL) FunctorString:
case (CELL)FunctorDouble: if (strcmp((char *)StringOfTerm(t1), (char *)StringOfTerm(t2)) == 0)
if (FloatOfTerm(t1) == FloatOfTerm(t2)) return(TRUE); return (TRUE);
return FALSE; return FALSE;
case (CELL) FunctorDouble:
if (FloatOfTerm(t1) == FloatOfTerm(t2))
return (TRUE);
return FALSE;
#ifdef USE_GMP #ifdef USE_GMP
case (CELL)FunctorBigInt: case (CELL) FunctorBigInt:
if (Yap_gmp_tcmp_big_big(t1,t2) == 0) return(TRUE); if (Yap_gmp_tcmp_big_big(t1, t2) == 0)
return(FALSE); return (TRUE);
return (FALSE);
#endif /* USE_GMP */ #endif /* USE_GMP */
default: default:
return FALSE; return FALSE;
} }
} }
/* Two complex terms with the same functor */ /* Two complex terms with the same functor */
return can_unify_complex(RepAppl(t1), return can_unify_complex(RepAppl(t1), RepAppl(t1) + ArityOfFunctor(f),
RepAppl(t1)+ArityOfFunctor(f), RepAppl(t2), Vars PASS_REGS);
RepAppl(t2), Vars PASS_REGS);
} }
} }
/* This routine verifies whether a complex has variables. */ /* This routine verifies whether a complex has variables. */
static int non_ground_complex(register CELL *pt0, static int non_ground_complex(register CELL *pt0, register CELL *pt0_end,
register CELL *pt0_end, Term *Var USES_REGS) {
Term *Var USES_REGS)
{
register CELL **to_visit = (CELL **)Yap_PreAllocCodeSpace(); register CELL **to_visit = (CELL **)Yap_PreAllocCodeSpace();
CELL **to_visit_base = to_visit; CELL **to_visit_base = to_visit;
loop: loop:
while (pt0 < pt0_end) { while (pt0 < pt0_end) {
register CELL d0; register CELL d0;
++ pt0; ++pt0;
d0 = Derefa(pt0); d0 = Derefa(pt0);
if (IsVarTerm(d0)) { if (IsVarTerm(d0)) {
*Var = d0; *Var = d0;
@ -333,7 +341,7 @@ static int non_ground_complex(register CELL *pt0,
} }
if (IsPairTerm(d0)) { if (IsPairTerm(d0)) {
if (to_visit + 1024 >= (CELL **)AuxSp) { if (to_visit + 1024 >= (CELL **)AuxSp) {
goto aux_overflow; goto aux_overflow;
} }
#ifdef RATIONAL_TREES #ifdef RATIONAL_TREES
to_visit[0] = pt0; to_visit[0] = pt0;
@ -344,15 +352,14 @@ static int non_ground_complex(register CELL *pt0,
#else #else
/* store the terms to visit */ /* store the terms to visit */
if (pt0 < pt0_end) { if (pt0 < pt0_end) {
to_visit[0] = pt0; to_visit[0] = pt0;
to_visit[1] = pt0_end; to_visit[1] = pt0_end;
to_visit += 2; to_visit += 2;
} }
#endif #endif
pt0 = RepPair(d0) - 1; pt0 = RepPair(d0) - 1;
pt0_end = RepPair(d0) + 1; pt0_end = RepPair(d0) + 1;
} } else if (IsApplTerm(d0)) {
else if (IsApplTerm(d0)) {
register Functor f; register Functor f;
register CELL *ap2; register CELL *ap2;
@ -361,10 +368,10 @@ static int non_ground_complex(register CELL *pt0,
f = (Functor)(*ap2); f = (Functor)(*ap2);
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
continue; continue;
} }
if (to_visit + 1024 >= (CELL **)AuxSp) { if (to_visit + 1024 >= (CELL **)AuxSp) {
goto aux_overflow; goto aux_overflow;
} }
#ifdef RATIONAL_TREES #ifdef RATIONAL_TREES
to_visit[0] = pt0; to_visit[0] = pt0;
@ -375,9 +382,9 @@ static int non_ground_complex(register CELL *pt0,
#else #else
/* store the terms to visit */ /* store the terms to visit */
if (pt0 < pt0_end) { if (pt0 < pt0_end) {
to_visit[0] = pt0; to_visit[0] = pt0;
to_visit[1] = pt0_end; to_visit[1] = pt0_end;
to_visit += 2; to_visit += 2;
} }
#endif #endif
d0 = ArityOfFunctor(f); d0 = ArityOfFunctor(f);
@ -406,7 +413,7 @@ static int non_ground_complex(register CELL *pt0,
Yap_ReleasePreAllocCodeSpace((ADDR)to_visit); Yap_ReleasePreAllocCodeSpace((ADDR)to_visit);
return FALSE; return FALSE;
var_found: var_found:
/* the term is non-ground */ /* the term is non-ground */
Yap_ReleasePreAllocCodeSpace((ADDR)to_visit); Yap_ReleasePreAllocCodeSpace((ADDR)to_visit);
#ifdef RATIONAL_TREES #ifdef RATIONAL_TREES
@ -420,7 +427,7 @@ static int non_ground_complex(register CELL *pt0,
/* the system will take care of TR for me, no need to worry here! */ /* the system will take care of TR for me, no need to worry here! */
return TRUE; return TRUE;
aux_overflow: aux_overflow:
/* unwind stack */ /* unwind stack */
Yap_ReleasePreAllocCodeSpace((ADDR)to_visit); Yap_ReleasePreAllocCodeSpace((ADDR)to_visit);
#ifdef RATIONAL_TREES #ifdef RATIONAL_TREES
@ -433,9 +440,7 @@ static int non_ground_complex(register CELL *pt0,
return -1; return -1;
} }
static int static int non_ground(Term t, Term *Var USES_REGS) {
non_ground(Term t, Term *Var USES_REGS)
{
int out = -1; int out = -1;
while (out < 0) { while (out < 0) {
t = Deref(t); t = Deref(t);
@ -447,24 +452,24 @@ non_ground(Term t, Term *Var USES_REGS)
if (IsPrimitiveTerm(t)) { if (IsPrimitiveTerm(t)) {
return FALSE; return FALSE;
} else if (IsPairTerm(t)) { } else if (IsPairTerm(t)) {
out = non_ground_complex(RepPair(t)-1, RepPair(t)+1, Var PASS_REGS); out = non_ground_complex(RepPair(t) - 1, RepPair(t) + 1, Var PASS_REGS);
if (out >= 0) if (out >= 0)
return out; return out;
} else { } else {
Functor f = FunctorOfTerm(t); Functor f = FunctorOfTerm(t);
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
return FALSE; return FALSE;
} }
out = non_ground_complex(RepAppl(t), out = non_ground_complex(RepAppl(t),
RepAppl(t)+ArityOfFunctor(FunctorOfTerm(t)), RepAppl(t) + ArityOfFunctor(FunctorOfTerm(t)),
Var PASS_REGS); Var PASS_REGS);
if (out >= 0) if (out >= 0)
return out; return out;
} }
if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) { if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) {
Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, "overflow in ground"); Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, "overflow in ground");
return FALSE; return FALSE;
} }
} }
return FALSE; return FALSE;
} }
@ -473,8 +478,7 @@ non_ground(Term t, Term *Var USES_REGS)
/* check whether the two terms unify and return what variables should /* check whether the two terms unify and return what variables should
be bound before the terms are exactly equal */ be bound before the terms are exactly equal */
static Int p_can_unify( USES_REGS1 ) static Int p_can_unify(USES_REGS1) {
{
#ifdef COROUTINING #ifdef COROUTINING
Term r = TermNil; Term r = TermNil;
if (!can_unify(ARG1, ARG2, &r PASS_REGS)) if (!can_unify(ARG1, ARG2, &r PASS_REGS))
@ -486,60 +490,53 @@ static Int p_can_unify( USES_REGS1 )
} }
/* if the term is not ground return a variable in the term */ /* if the term is not ground return a variable in the term */
static Int p_non_ground( USES_REGS1 ) static Int p_non_ground(USES_REGS1) {
{
#ifdef COROUTINING #ifdef COROUTINING
Term r = TermNil; Term r = TermNil;
if (!non_ground(ARG1, &r PASS_REGS)) if (!non_ground(ARG1, &r PASS_REGS))
return(FALSE); return (FALSE);
return (Yap_unify(ARG2, r)); return (Yap_unify(ARG2, r));
#else #else
return(FALSE); return (FALSE);
#endif #endif
} }
/* if the term is not ground return a variable in the term */ /* if the term is not ground return a variable in the term */
static Int p_coroutining( USES_REGS1 ) static Int p_coroutining(USES_REGS1) {
{
#ifdef COROUTINING #ifdef COROUTINING
return(TRUE); return (TRUE);
#else #else
return(FALSE); return (FALSE);
#endif #endif
} }
#if COROUTINING #if COROUTINING
static Term static Term ListOfWokenGoals(USES_REGS1) {
ListOfWokenGoals( USES_REGS1 ) {
return Yap_ReadTimedVar(LOCAL_WokenGoals); return Yap_ReadTimedVar(LOCAL_WokenGoals);
} }
Term Term Yap_ListOfWokenGoals(void) {
Yap_ListOfWokenGoals(void) {
CACHE_REGS CACHE_REGS
return ListOfWokenGoals( PASS_REGS1 ); return ListOfWokenGoals(PASS_REGS1);
} }
#endif #endif
/* return a list of awoken goals */ /* return a list of awoken goals */
static Int p_awoken_goals( USES_REGS1 ) static Int p_awoken_goals(USES_REGS1) {
{
#ifdef COROUTINING #ifdef COROUTINING
Term WGs = Yap_ReadTimedVar(LOCAL_WokenGoals); Term WGs = Yap_ReadTimedVar(LOCAL_WokenGoals);
if (WGs == TermNil) { if (WGs == TermNil) {
return(FALSE); return (FALSE);
} }
WGs = ListOfWokenGoals( PASS_REGS1 ); WGs = ListOfWokenGoals(PASS_REGS1);
Yap_UpdateTimedVar(LOCAL_WokenGoals, TermNil); Yap_UpdateTimedVar(LOCAL_WokenGoals, TermNil);
return(Yap_unify(ARG1,WGs)); return (Yap_unify(ARG1, WGs));
#else #else
return(FALSE); return (FALSE);
#endif #endif
} }
static Int static Int p_yap_has_rational_trees(USES_REGS1) {
p_yap_has_rational_trees( USES_REGS1 )
{
#if RATIONAL_TREES #if RATIONAL_TREES
return TRUE; return TRUE;
#else #else
@ -547,9 +544,7 @@ p_yap_has_rational_trees( USES_REGS1 )
#endif #endif
} }
static Int static Int p_yap_has_coroutining(USES_REGS1) {
p_yap_has_coroutining( USES_REGS1 )
{
#if COROUTINING #if COROUTINING
return TRUE; return TRUE;
#else #else
@ -557,24 +552,21 @@ p_yap_has_coroutining( USES_REGS1 )
#endif #endif
} }
void void Yap_InitCoroutPreds(void) {
Yap_InitCoroutPreds( void )
{
#ifdef COROUTINING #ifdef COROUTINING
Atom at; Atom at;
PredEntry *pred; PredEntry *pred;
at = AtomWakeUpGoal; at = AtomWakeUpGoal;
pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 2),0)); pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 2), 0));
WakeUpCode = pred; WakeUpCode = pred;
#endif #endif
Yap_InitAttVarPreds(); Yap_InitAttVarPreds();
Yap_InitCPred("$yap_has_rational_trees", 0, p_yap_has_rational_trees, SafePredFlag); Yap_InitCPred("$yap_has_rational_trees", 0, p_yap_has_rational_trees,
SafePredFlag);
Yap_InitCPred("$yap_has_coroutining", 0, p_yap_has_coroutining, SafePredFlag); Yap_InitCPred("$yap_has_coroutining", 0, p_yap_has_coroutining, SafePredFlag);
Yap_InitCPred("$can_unify", 3, p_can_unify, SafePredFlag); Yap_InitCPred("$can_unify", 3, p_can_unify, SafePredFlag);
Yap_InitCPred("$non_ground", 2, p_non_ground, SafePredFlag); Yap_InitCPred("$non_ground", 2, p_non_ground, SafePredFlag);
Yap_InitCPred("$coroutining", 0, p_coroutining, SafePredFlag); Yap_InitCPred("$coroutining", 0, p_coroutining, SafePredFlag);
Yap_InitCPred("$awoken_goals", 1, p_awoken_goals, SafePredFlag); Yap_InitCPred("$awoken_goals", 1, p_awoken_goals, SafePredFlag);
} }