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
parent
50c04116c8
commit
ca81e5d8ea
44
C/attvar.c
44
C/attvar.c
|
|
@ -1,19 +1,19 @@
|
|||
/*************************************************************************
|
||||
* *
|
||||
* YAP Prolog *
|
||||
* *
|
||||
* Yap Prolog was developed at NCCUP - Universidade do Porto *
|
||||
* *
|
||||
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
|
||||
* *
|
||||
**************************************************************************
|
||||
* *
|
||||
* File: attvar.c *
|
||||
* Last rev: *
|
||||
* mods: *
|
||||
* comments: YAP support for attributed vars *
|
||||
* *
|
||||
*************************************************************************/
|
||||
* *
|
||||
* YAP Prolog *
|
||||
* *
|
||||
* Yap Prolog was developed at NCCUP - Universidade do Porto *
|
||||
* *
|
||||
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
|
||||
* *
|
||||
**************************************************************************
|
||||
* *
|
||||
* File: attvar.c *
|
||||
* Last rev: *
|
||||
* mods: *
|
||||
* comments: YAP support for attributed vars *
|
||||
* *
|
||||
*************************************************************************/
|
||||
#ifdef SCCS
|
||||
static char SccsId[] = "%W% %G%";
|
||||
#endif
|
||||
|
|
@ -31,7 +31,7 @@ static char SccsId[] = "%W% %G%";
|
|||
/** @{ */
|
||||
|
||||
/** @defgroup Attribute_Variables_Builtins Implementation of Attribute
|
||||
Declarations
|
||||
Declarations
|
||||
@ingroup Attributed_Variables
|
||||
*/
|
||||
|
||||
|
|
@ -201,7 +201,7 @@ static void WakeAttVar(CELL *pt1, CELL reg2 USES_REGS) {
|
|||
|
||||
void Yap_WakeUp(CELL *pt0) {
|
||||
CACHE_REGS
|
||||
CELL d0 = *pt0;
|
||||
CELL d0 = *pt0;
|
||||
RESET_VARIABLE(pt0);
|
||||
WakeAttVar(pt0, d0 PASS_REGS);
|
||||
}
|
||||
|
|
@ -911,9 +911,9 @@ static Term AllAttVars(USES_REGS1) {
|
|||
break;
|
||||
case (CELL) FunctorBigInt: {
|
||||
Int sz = 3 +
|
||||
(sizeof(MP_INT) +
|
||||
(((MP_INT *)(pt + 2))->_mp_alloc * sizeof(mp_limb_t))) /
|
||||
sizeof(CELL);
|
||||
(sizeof(MP_INT) +
|
||||
(((MP_INT *)(pt + 2))->_mp_alloc * sizeof(mp_limb_t))) /
|
||||
sizeof(CELL);
|
||||
pt += sz;
|
||||
} break;
|
||||
case (CELL) FunctorLongInt:
|
||||
|
|
@ -965,7 +965,7 @@ static Int p_is_attvar(USES_REGS1) {
|
|||
static Int p_attvar_bound(USES_REGS1) {
|
||||
Term t = Deref(ARG1);
|
||||
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); }
|
||||
|
|
@ -1005,7 +1005,7 @@ static Int p_attvar_bound(USES_REGS1) { return FALSE; }
|
|||
|
||||
void Yap_InitAttVarPreds(void) {
|
||||
CACHE_REGS
|
||||
Term OldCurrentModule = CurrentModule;
|
||||
Term OldCurrentModule = CurrentModule;
|
||||
CurrentModule = ATTRIBUTES_MODULE;
|
||||
#ifdef COROUTINING
|
||||
GLOBAL_attas[attvars_ext].bind_op = WakeAttVar;
|
||||
|
|
|
|||
422
C/corout.c
422
C/corout.c
|
|
@ -15,7 +15,7 @@
|
|||
* *
|
||||
*************************************************************************/
|
||||
#ifdef SCCS
|
||||
static char SccsId[]="%W% %G%";
|
||||
static char SccsId[] = "%W% %G%";
|
||||
#endif
|
||||
|
||||
#include "Yap.h"
|
||||
|
|
@ -30,23 +30,20 @@ static char SccsId[]="%W% %G%";
|
|||
#ifdef COROUTINING
|
||||
|
||||
/* 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;
|
||||
while (test != TermNil) {
|
||||
if ((RepPair(test))[0] == var) return(dest);
|
||||
else test = (RepPair(test))[1];
|
||||
if ((RepPair(test))[0] == var)
|
||||
return (dest);
|
||||
else
|
||||
test = (RepPair(test))[1];
|
||||
}
|
||||
return(MkPairTerm(var,dest));
|
||||
return (MkPairTerm(var, dest));
|
||||
}
|
||||
|
||||
|
||||
/* This routine verifies whether two complex structures can unify. */
|
||||
static int can_unify_complex(register CELL *pt0,
|
||||
register CELL *pt0_end,
|
||||
register CELL *pt1,
|
||||
Term *Vars USES_REGS)
|
||||
{
|
||||
static int can_unify_complex(register CELL *pt0, register CELL *pt0_end,
|
||||
register CELL *pt1, Term *Vars USES_REGS) {
|
||||
|
||||
/* This is really just unification, folks */
|
||||
tr_fr_ptr saved_TR;
|
||||
|
|
@ -62,134 +59,139 @@ static int can_unify_complex(register CELL *pt0,
|
|||
saved_HB = HB;
|
||||
HB = HR;
|
||||
|
||||
loop:
|
||||
loop:
|
||||
while (pt0 < pt0_end) {
|
||||
register CELL d0, d1;
|
||||
++ pt0;
|
||||
++ pt1;
|
||||
++pt0;
|
||||
++pt1;
|
||||
d0 = Derefa(pt0);
|
||||
d1 = Derefa(pt1);
|
||||
if (IsVarTerm(d0)) {
|
||||
if (IsVarTerm(d1)) {
|
||||
if (d0 != d1) {
|
||||
/* we need to suspend on both variables ! */
|
||||
*Vars = AddVarIfNotThere(d0, AddVarIfNotThere(d1,*Vars PASS_REGS) PASS_REGS);
|
||||
/* bind the two variables, we would have to do that to unify
|
||||
them */
|
||||
if (d1 > d0) { /* youngest */
|
||||
/* we don't want to wake up goals */
|
||||
Bind_Global((CELL *)d1, d0);
|
||||
} else {
|
||||
Bind_Global((CELL *)d0, d1);
|
||||
}
|
||||
}
|
||||
/* continue the loop */
|
||||
continue;
|
||||
}
|
||||
else {
|
||||
/* oh no, some more variables! */
|
||||
*Vars = AddVarIfNotThere(d0, *Vars PASS_REGS);
|
||||
if (d0 != d1) {
|
||||
/* we need to suspend on both variables ! */
|
||||
*Vars = AddVarIfNotThere(d0, AddVarIfNotThere(d1, *Vars PASS_REGS)
|
||||
PASS_REGS);
|
||||
/* bind the two variables, we would have to do that to unify
|
||||
them */
|
||||
if (d1 > d0) { /* youngest */
|
||||
/* we don't want to wake up goals */
|
||||
Bind_Global_NonAtt((CELL *)d1, d0);
|
||||
} else {
|
||||
Bind_Global_NonAtt((CELL *)d0, d1);
|
||||
}
|
||||
}
|
||||
/* continue the loop */
|
||||
continue;
|
||||
} else {
|
||||
/* oh no, some more variables! */
|
||||
*Vars = AddVarIfNotThere(d0, *Vars PASS_REGS);
|
||||
}
|
||||
/* now bind it */
|
||||
Bind_Global((CELL *)d0, d1);
|
||||
Bind_Global_NonAtt((CELL *)d0, d1);
|
||||
/* continue the loop */
|
||||
} else if (IsVarTerm(d1)) {
|
||||
} else if (IsVarTerm(d1)) {
|
||||
*Vars = AddVarIfNotThere(d1, *Vars PASS_REGS);
|
||||
/* and bind it */
|
||||
Bind_Global((CELL *)d1, d0);
|
||||
Bind_Global_NonAtt((CELL *)d1, d0);
|
||||
/* continue the loop */
|
||||
} else {
|
||||
if (d0 == d1) continue;
|
||||
if (d0 == d1)
|
||||
continue;
|
||||
if (IsAtomOrIntTerm(d0) || IsAtomOrIntTerm(d1)) {
|
||||
if (d0 != d1) goto comparison_failed;
|
||||
/* else continue the loop */
|
||||
}
|
||||
else if (IsPairTerm(d0)) {
|
||||
if (!IsPairTerm(d1)) goto comparison_failed;
|
||||
if (d0 != d1)
|
||||
goto comparison_failed;
|
||||
/* else continue the loop */
|
||||
} else if (IsPairTerm(d0)) {
|
||||
if (!IsPairTerm(d1))
|
||||
goto comparison_failed;
|
||||
#ifdef RATIONAL_TREES
|
||||
to_visit[0] = pt0;
|
||||
to_visit[1] = pt0_end;
|
||||
to_visit[2] = pt1;
|
||||
to_visit[3] = (CELL *)*pt0;
|
||||
to_visit += 4;
|
||||
*pt0 = d1;
|
||||
to_visit[0] = pt0;
|
||||
to_visit[1] = pt0_end;
|
||||
to_visit[2] = pt1;
|
||||
to_visit[3] = (CELL *)*pt0;
|
||||
to_visit += 4;
|
||||
*pt0 = d1;
|
||||
#else
|
||||
/* store the terms to visit */
|
||||
if (pt0 < pt0_end) {
|
||||
to_visit[0] = pt0;
|
||||
to_visit[1] = pt0_end;
|
||||
to_visit[2] = pt1;
|
||||
to_visit += 3;
|
||||
}
|
||||
/* store the terms to visit */
|
||||
if (pt0 < pt0_end) {
|
||||
to_visit[0] = pt0;
|
||||
to_visit[1] = pt0_end;
|
||||
to_visit[2] = pt1;
|
||||
to_visit += 3;
|
||||
}
|
||||
#endif
|
||||
pt0 = RepPair(d0) - 1;
|
||||
pt0_end = RepPair(d0) + 1;
|
||||
pt1 = RepPair(d1) - 1;
|
||||
continue;
|
||||
}
|
||||
else if (IsApplTerm(d0)) {
|
||||
register Functor f;
|
||||
register CELL *ap2, *ap3;
|
||||
if (!IsApplTerm(d1)) {
|
||||
goto comparison_failed;
|
||||
} else {
|
||||
/* store the terms to visit */
|
||||
ap2 = RepAppl(d0);
|
||||
ap3 = RepAppl(d1);
|
||||
f = (Functor)(*ap2);
|
||||
/* compare functors */
|
||||
if (f != (Functor)*ap3) {
|
||||
goto comparison_failed;
|
||||
}
|
||||
if (IsExtensionFunctor(f)) {
|
||||
switch((CELL)f) {
|
||||
case (CELL)FunctorDBRef:
|
||||
if (d0 == d1) continue;
|
||||
goto comparison_failed;
|
||||
case (CELL)FunctorLongInt:
|
||||
if (ap2[1] == ap3[1]) continue;
|
||||
goto comparison_failed;
|
||||
case (CELL)FunctorDouble:
|
||||
if (FloatOfTerm(d0) == FloatOfTerm(d1)) continue;
|
||||
goto comparison_failed;
|
||||
case (CELL)FunctorString:
|
||||
if (strcmp((char *)StringOfTerm(d0), (char *)StringOfTerm(d1)) == 0) continue;
|
||||
goto comparison_failed;
|
||||
pt0 = RepPair(d0) - 1;
|
||||
pt0_end = RepPair(d0) + 1;
|
||||
pt1 = RepPair(d1) - 1;
|
||||
continue;
|
||||
} else if (IsApplTerm(d0)) {
|
||||
register Functor f;
|
||||
register CELL *ap2, *ap3;
|
||||
if (!IsApplTerm(d1)) {
|
||||
goto comparison_failed;
|
||||
} else {
|
||||
/* store the terms to visit */
|
||||
ap2 = RepAppl(d0);
|
||||
ap3 = RepAppl(d1);
|
||||
f = (Functor)(*ap2);
|
||||
/* compare functors */
|
||||
if (f != (Functor)*ap3) {
|
||||
goto comparison_failed;
|
||||
}
|
||||
if (IsExtensionFunctor(f)) {
|
||||
switch ((CELL)f) {
|
||||
case (CELL) FunctorDBRef:
|
||||
if (d0 == d1)
|
||||
continue;
|
||||
goto comparison_failed;
|
||||
case (CELL) FunctorLongInt:
|
||||
if (ap2[1] == ap3[1])
|
||||
continue;
|
||||
goto comparison_failed;
|
||||
case (CELL) FunctorDouble:
|
||||
if (FloatOfTerm(d0) == FloatOfTerm(d1))
|
||||
continue;
|
||||
goto comparison_failed;
|
||||
case (CELL) FunctorString:
|
||||
if (strcmp((char *)StringOfTerm(d0), (char *)StringOfTerm(d1)) ==
|
||||
0)
|
||||
continue;
|
||||
goto comparison_failed;
|
||||
#ifdef USE_GMP
|
||||
case (CELL)FunctorBigInt:
|
||||
if (Yap_gmp_tcmp_big_big(d0,d1) == 0) continue;
|
||||
goto comparison_failed;
|
||||
case (CELL) FunctorBigInt:
|
||||
if (Yap_gmp_tcmp_big_big(d0, d1) == 0)
|
||||
continue;
|
||||
goto comparison_failed;
|
||||
#endif /* USE_GMP */
|
||||
default:
|
||||
goto comparison_failed;
|
||||
}
|
||||
}
|
||||
default:
|
||||
goto comparison_failed;
|
||||
}
|
||||
}
|
||||
#ifdef RATIONAL_TREES
|
||||
to_visit[0] = pt0;
|
||||
to_visit[1] = pt0_end;
|
||||
to_visit[2] = pt1;
|
||||
to_visit[3] = (CELL *)*pt0;
|
||||
to_visit += 4;
|
||||
*pt0 = d1;
|
||||
to_visit[0] = pt0;
|
||||
to_visit[1] = pt0_end;
|
||||
to_visit[2] = pt1;
|
||||
to_visit[3] = (CELL *)*pt0;
|
||||
to_visit += 4;
|
||||
*pt0 = d1;
|
||||
#else
|
||||
/* store the terms to visit */
|
||||
if (pt0 < pt0_end) {
|
||||
to_visit[0] = pt0;
|
||||
to_visit[1] = pt0_end;
|
||||
to_visit[2] = pt1;
|
||||
to_visit += 3;
|
||||
}
|
||||
/* store the terms to visit */
|
||||
if (pt0 < pt0_end) {
|
||||
to_visit[0] = pt0;
|
||||
to_visit[1] = pt0_end;
|
||||
to_visit[2] = pt1;
|
||||
to_visit += 3;
|
||||
}
|
||||
#endif
|
||||
d0 = ArityOfFunctor(f);
|
||||
pt0 = ap2;
|
||||
pt0_end = ap2 + d0;
|
||||
pt1 = ap3;
|
||||
continue;
|
||||
}
|
||||
d0 = ArityOfFunctor(f);
|
||||
pt0 = ap2;
|
||||
pt0_end = ap2 + d0;
|
||||
pt1 = ap3;
|
||||
continue;
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
}
|
||||
/* Do we still have compound terms to visit */
|
||||
if (to_visit > (CELL **)to_visit_base) {
|
||||
|
|
@ -217,9 +219,9 @@ static int can_unify_complex(register CELL *pt0,
|
|||
pt1 = (CELL *)(TrailTerm(--TR));
|
||||
RESET_VARIABLE(pt1);
|
||||
}
|
||||
return(TRUE);
|
||||
return (TRUE);
|
||||
|
||||
comparison_failed:
|
||||
comparison_failed:
|
||||
/* failure */
|
||||
Yap_ReleasePreAllocCodeSpace((ADDR)to_visit);
|
||||
#ifdef RATIONAL_TREES
|
||||
|
|
@ -232,15 +234,18 @@ static int can_unify_complex(register CELL *pt0,
|
|||
}
|
||||
#endif
|
||||
/* restore B, and later HB */
|
||||
B = saved_B;
|
||||
B = saved_B;
|
||||
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! */
|
||||
return(FALSE);
|
||||
return (FALSE);
|
||||
}
|
||||
|
||||
static int
|
||||
can_unify(Term t1, Term t2, Term *Vars USES_REGS)
|
||||
{
|
||||
static int can_unify(Term t1, Term t2, Term *Vars USES_REGS) {
|
||||
t1 = Deref(t1);
|
||||
t2 = Deref(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 */
|
||||
if (IsVarTerm(t2)) {
|
||||
/* we need to suspend on both variables because otherwise
|
||||
Y = susp(_) would not wakeup susp ! */
|
||||
*Vars = MkPairTerm(t1,MkPairTerm(t2,TermNil));
|
||||
Y = susp(_) would not wakeup susp ! */
|
||||
*Vars = MkPairTerm(t1, MkPairTerm(t2, TermNil));
|
||||
return TRUE;
|
||||
} else {
|
||||
*Vars = MkPairTerm(t1,TermNil);
|
||||
*Vars = MkPairTerm(t1, TermNil);
|
||||
return TRUE;
|
||||
}
|
||||
} else if (IsVarTerm(t2)) {
|
||||
/* wait until t2 is bound */
|
||||
*Vars = MkPairTerm(t2,TermNil);
|
||||
*Vars = MkPairTerm(t2, TermNil);
|
||||
return TRUE;
|
||||
}
|
||||
/* Two standard terms at last! */
|
||||
|
|
@ -276,56 +281,59 @@ can_unify(Term t1, Term t2, Term *Vars USES_REGS)
|
|||
}
|
||||
} else if (IsPairTerm(t1)) {
|
||||
if (IsPairTerm(t2)) {
|
||||
return(can_unify_complex(RepPair(t1)-1, RepPair(t1)+1,
|
||||
RepPair(t2)-1, Vars PASS_REGS));
|
||||
} else return FALSE;
|
||||
return (can_unify_complex(RepPair(t1) - 1, RepPair(t1) + 1,
|
||||
RepPair(t2) - 1, Vars PASS_REGS));
|
||||
} else
|
||||
return FALSE;
|
||||
} else {
|
||||
Functor f = FunctorOfTerm(t1);
|
||||
if (f != FunctorOfTerm(t2))
|
||||
return FALSE;
|
||||
if (IsExtensionFunctor(f)) {
|
||||
switch((CELL)f) {
|
||||
case (CELL)FunctorDBRef:
|
||||
if (t1 == t2) return FALSE;
|
||||
return FALSE;
|
||||
case (CELL)FunctorLongInt:
|
||||
if (RepAppl(t1)[1] == RepAppl(t2)[1]) return(TRUE);
|
||||
return FALSE;
|
||||
case (CELL)FunctorString:
|
||||
if (strcmp((char *)StringOfTerm(t1), (char *)StringOfTerm(t2)) == 0) return(TRUE);
|
||||
return FALSE;
|
||||
case (CELL)FunctorDouble:
|
||||
if (FloatOfTerm(t1) == FloatOfTerm(t2)) return(TRUE);
|
||||
return FALSE;
|
||||
switch ((CELL)f) {
|
||||
case (CELL) FunctorDBRef:
|
||||
if (t1 == t2)
|
||||
return FALSE;
|
||||
return FALSE;
|
||||
case (CELL) FunctorLongInt:
|
||||
if (RepAppl(t1)[1] == RepAppl(t2)[1])
|
||||
return (TRUE);
|
||||
return FALSE;
|
||||
case (CELL) FunctorString:
|
||||
if (strcmp((char *)StringOfTerm(t1), (char *)StringOfTerm(t2)) == 0)
|
||||
return (TRUE);
|
||||
return FALSE;
|
||||
case (CELL) FunctorDouble:
|
||||
if (FloatOfTerm(t1) == FloatOfTerm(t2))
|
||||
return (TRUE);
|
||||
return FALSE;
|
||||
#ifdef USE_GMP
|
||||
case (CELL)FunctorBigInt:
|
||||
if (Yap_gmp_tcmp_big_big(t1,t2) == 0) return(TRUE);
|
||||
return(FALSE);
|
||||
case (CELL) FunctorBigInt:
|
||||
if (Yap_gmp_tcmp_big_big(t1, t2) == 0)
|
||||
return (TRUE);
|
||||
return (FALSE);
|
||||
#endif /* USE_GMP */
|
||||
default:
|
||||
return FALSE;
|
||||
return FALSE;
|
||||
}
|
||||
}
|
||||
/* Two complex terms with the same functor */
|
||||
return can_unify_complex(RepAppl(t1),
|
||||
RepAppl(t1)+ArityOfFunctor(f),
|
||||
RepAppl(t2), Vars PASS_REGS);
|
||||
return can_unify_complex(RepAppl(t1), RepAppl(t1) + ArityOfFunctor(f),
|
||||
RepAppl(t2), Vars PASS_REGS);
|
||||
}
|
||||
}
|
||||
|
||||
/* This routine verifies whether a complex has variables. */
|
||||
static int non_ground_complex(register CELL *pt0,
|
||||
register CELL *pt0_end,
|
||||
Term *Var USES_REGS)
|
||||
{
|
||||
static int non_ground_complex(register CELL *pt0, register CELL *pt0_end,
|
||||
Term *Var USES_REGS) {
|
||||
|
||||
register CELL **to_visit = (CELL **)Yap_PreAllocCodeSpace();
|
||||
CELL **to_visit_base = to_visit;
|
||||
|
||||
loop:
|
||||
loop:
|
||||
while (pt0 < pt0_end) {
|
||||
register CELL d0;
|
||||
++ pt0;
|
||||
++pt0;
|
||||
d0 = Derefa(pt0);
|
||||
if (IsVarTerm(d0)) {
|
||||
*Var = d0;
|
||||
|
|
@ -333,7 +341,7 @@ static int non_ground_complex(register CELL *pt0,
|
|||
}
|
||||
if (IsPairTerm(d0)) {
|
||||
if (to_visit + 1024 >= (CELL **)AuxSp) {
|
||||
goto aux_overflow;
|
||||
goto aux_overflow;
|
||||
}
|
||||
#ifdef RATIONAL_TREES
|
||||
to_visit[0] = pt0;
|
||||
|
|
@ -344,15 +352,14 @@ static int non_ground_complex(register CELL *pt0,
|
|||
#else
|
||||
/* store the terms to visit */
|
||||
if (pt0 < pt0_end) {
|
||||
to_visit[0] = pt0;
|
||||
to_visit[1] = pt0_end;
|
||||
to_visit += 2;
|
||||
to_visit[0] = pt0;
|
||||
to_visit[1] = pt0_end;
|
||||
to_visit += 2;
|
||||
}
|
||||
#endif
|
||||
pt0 = RepPair(d0) - 1;
|
||||
pt0_end = RepPair(d0) + 1;
|
||||
}
|
||||
else if (IsApplTerm(d0)) {
|
||||
} else if (IsApplTerm(d0)) {
|
||||
register Functor f;
|
||||
register CELL *ap2;
|
||||
|
||||
|
|
@ -361,10 +368,10 @@ static int non_ground_complex(register CELL *pt0,
|
|||
f = (Functor)(*ap2);
|
||||
|
||||
if (IsExtensionFunctor(f)) {
|
||||
continue;
|
||||
continue;
|
||||
}
|
||||
if (to_visit + 1024 >= (CELL **)AuxSp) {
|
||||
goto aux_overflow;
|
||||
goto aux_overflow;
|
||||
}
|
||||
#ifdef RATIONAL_TREES
|
||||
to_visit[0] = pt0;
|
||||
|
|
@ -375,9 +382,9 @@ static int non_ground_complex(register CELL *pt0,
|
|||
#else
|
||||
/* store the terms to visit */
|
||||
if (pt0 < pt0_end) {
|
||||
to_visit[0] = pt0;
|
||||
to_visit[1] = pt0_end;
|
||||
to_visit += 2;
|
||||
to_visit[0] = pt0;
|
||||
to_visit[1] = pt0_end;
|
||||
to_visit += 2;
|
||||
}
|
||||
#endif
|
||||
d0 = ArityOfFunctor(f);
|
||||
|
|
@ -406,7 +413,7 @@ static int non_ground_complex(register CELL *pt0,
|
|||
Yap_ReleasePreAllocCodeSpace((ADDR)to_visit);
|
||||
return FALSE;
|
||||
|
||||
var_found:
|
||||
var_found:
|
||||
/* the term is non-ground */
|
||||
Yap_ReleasePreAllocCodeSpace((ADDR)to_visit);
|
||||
#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! */
|
||||
return TRUE;
|
||||
|
||||
aux_overflow:
|
||||
aux_overflow:
|
||||
/* unwind stack */
|
||||
Yap_ReleasePreAllocCodeSpace((ADDR)to_visit);
|
||||
#ifdef RATIONAL_TREES
|
||||
|
|
@ -433,9 +440,7 @@ static int non_ground_complex(register CELL *pt0,
|
|||
return -1;
|
||||
}
|
||||
|
||||
static int
|
||||
non_ground(Term t, Term *Var USES_REGS)
|
||||
{
|
||||
static int non_ground(Term t, Term *Var USES_REGS) {
|
||||
int out = -1;
|
||||
while (out < 0) {
|
||||
t = Deref(t);
|
||||
|
|
@ -447,24 +452,24 @@ non_ground(Term t, Term *Var USES_REGS)
|
|||
if (IsPrimitiveTerm(t)) {
|
||||
return FALSE;
|
||||
} 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)
|
||||
return out;
|
||||
return out;
|
||||
} else {
|
||||
Functor f = FunctorOfTerm(t);
|
||||
if (IsExtensionFunctor(f)) {
|
||||
return FALSE;
|
||||
return FALSE;
|
||||
}
|
||||
out = non_ground_complex(RepAppl(t),
|
||||
RepAppl(t)+ArityOfFunctor(FunctorOfTerm(t)),
|
||||
Var PASS_REGS);
|
||||
RepAppl(t) + ArityOfFunctor(FunctorOfTerm(t)),
|
||||
Var PASS_REGS);
|
||||
if (out >= 0)
|
||||
return out;
|
||||
return out;
|
||||
}
|
||||
if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) {
|
||||
Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, "overflow in ground");
|
||||
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
|
||||
be bound before the terms are exactly equal */
|
||||
static Int p_can_unify( USES_REGS1 )
|
||||
{
|
||||
static Int p_can_unify(USES_REGS1) {
|
||||
#ifdef COROUTINING
|
||||
Term r = TermNil;
|
||||
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 */
|
||||
static Int p_non_ground( USES_REGS1 )
|
||||
{
|
||||
static Int p_non_ground(USES_REGS1) {
|
||||
#ifdef COROUTINING
|
||||
Term r = TermNil;
|
||||
if (!non_ground(ARG1, &r PASS_REGS))
|
||||
return(FALSE);
|
||||
return (FALSE);
|
||||
return (Yap_unify(ARG2, r));
|
||||
#else
|
||||
return(FALSE);
|
||||
return (FALSE);
|
||||
#endif
|
||||
}
|
||||
|
||||
/* 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
|
||||
return(TRUE);
|
||||
return (TRUE);
|
||||
#else
|
||||
return(FALSE);
|
||||
return (FALSE);
|
||||
#endif
|
||||
}
|
||||
|
||||
#if COROUTINING
|
||||
static Term
|
||||
ListOfWokenGoals( USES_REGS1 ) {
|
||||
static Term ListOfWokenGoals(USES_REGS1) {
|
||||
return Yap_ReadTimedVar(LOCAL_WokenGoals);
|
||||
}
|
||||
|
||||
Term
|
||||
Yap_ListOfWokenGoals(void) {
|
||||
Term Yap_ListOfWokenGoals(void) {
|
||||
CACHE_REGS
|
||||
return ListOfWokenGoals( PASS_REGS1 );
|
||||
return ListOfWokenGoals(PASS_REGS1);
|
||||
}
|
||||
#endif
|
||||
|
||||
/* return a list of awoken goals */
|
||||
static Int p_awoken_goals( USES_REGS1 )
|
||||
{
|
||||
static Int p_awoken_goals(USES_REGS1) {
|
||||
#ifdef COROUTINING
|
||||
Term WGs = Yap_ReadTimedVar(LOCAL_WokenGoals);
|
||||
if (WGs == TermNil) {
|
||||
return(FALSE);
|
||||
return (FALSE);
|
||||
}
|
||||
WGs = ListOfWokenGoals( PASS_REGS1 );
|
||||
WGs = ListOfWokenGoals(PASS_REGS1);
|
||||
Yap_UpdateTimedVar(LOCAL_WokenGoals, TermNil);
|
||||
return(Yap_unify(ARG1,WGs));
|
||||
return (Yap_unify(ARG1, WGs));
|
||||
#else
|
||||
return(FALSE);
|
||||
return (FALSE);
|
||||
#endif
|
||||
}
|
||||
|
||||
static Int
|
||||
p_yap_has_rational_trees( USES_REGS1 )
|
||||
{
|
||||
static Int p_yap_has_rational_trees(USES_REGS1) {
|
||||
#if RATIONAL_TREES
|
||||
return TRUE;
|
||||
#else
|
||||
|
|
@ -547,9 +544,7 @@ p_yap_has_rational_trees( USES_REGS1 )
|
|||
#endif
|
||||
}
|
||||
|
||||
static Int
|
||||
p_yap_has_coroutining( USES_REGS1 )
|
||||
{
|
||||
static Int p_yap_has_coroutining(USES_REGS1) {
|
||||
#if COROUTINING
|
||||
return TRUE;
|
||||
#else
|
||||
|
|
@ -557,24 +552,21 @@ p_yap_has_coroutining( USES_REGS1 )
|
|||
#endif
|
||||
}
|
||||
|
||||
void
|
||||
Yap_InitCoroutPreds( void )
|
||||
{
|
||||
void Yap_InitCoroutPreds(void) {
|
||||
#ifdef COROUTINING
|
||||
Atom at;
|
||||
PredEntry *pred;
|
||||
Atom at;
|
||||
PredEntry *pred;
|
||||
|
||||
at = AtomWakeUpGoal;
|
||||
pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 2),0));
|
||||
pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 2), 0));
|
||||
WakeUpCode = pred;
|
||||
#endif
|
||||
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("$can_unify", 3, p_can_unify, SafePredFlag);
|
||||
Yap_InitCPred("$non_ground", 2, p_non_ground, SafePredFlag);
|
||||
Yap_InitCPred("$coroutining", 0, p_coroutining, SafePredFlag);
|
||||
Yap_InitCPred("$awoken_goals", 1, p_awoken_goals, SafePredFlag);
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
Reference in New Issue