include cyclic_term and friends.
This commit is contained in:
parent
8eede3eb73
commit
4de83f5f52
164
C/utilpreds.c
164
C/utilpreds.c
@ -2927,6 +2927,168 @@ static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end USES_R
|
||||
return -1;
|
||||
}
|
||||
|
||||
static Int finite_tree_complex_term(register CELL *pt0, register CELL *pt0_end USES_REGS)
|
||||
{
|
||||
|
||||
register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace();
|
||||
|
||||
to_visit0 = to_visit;
|
||||
loop:
|
||||
while (pt0 < pt0_end) {
|
||||
register CELL d0;
|
||||
register CELL *ptd0;
|
||||
|
||||
++pt0;
|
||||
ptd0 = pt0;
|
||||
d0 = *ptd0;
|
||||
deref_head(d0, vars_in_term_unk);
|
||||
vars_in_term_nvar:
|
||||
{
|
||||
if (d0 == TermFoundVar) {
|
||||
#ifdef RATIONAL_TREES
|
||||
while (to_visit > to_visit0) {
|
||||
to_visit -= 3;
|
||||
pt0 = to_visit[0];
|
||||
pt0_end = to_visit[1];
|
||||
*pt0 = (CELL)to_visit[2];
|
||||
}
|
||||
#endif
|
||||
return FALSE;
|
||||
}
|
||||
if (IsPairTerm(d0)) {
|
||||
if (to_visit + 1024 >= (CELL **)AuxSp) {
|
||||
goto aux_overflow;
|
||||
}
|
||||
#ifdef RATIONAL_TREES
|
||||
to_visit[0] = pt0;
|
||||
to_visit[1] = pt0_end;
|
||||
to_visit[2] = (CELL *)*pt0;
|
||||
to_visit += 3;
|
||||
*pt0 = TermFoundVar;
|
||||
#else
|
||||
if (pt0 < pt0_end) {
|
||||
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)) {
|
||||
register Functor f;
|
||||
register CELL *ap2;
|
||||
/* store the terms to visit */
|
||||
ap2 = RepAppl(d0);
|
||||
f = (Functor)(*ap2);
|
||||
|
||||
if (IsExtensionFunctor(f)) {
|
||||
continue;
|
||||
}
|
||||
if (to_visit + 1024 >= (CELL **)AuxSp) {
|
||||
goto aux_overflow;
|
||||
}
|
||||
#ifdef RATIONAL_TREES
|
||||
to_visit[0] = pt0;
|
||||
to_visit[1] = pt0_end;
|
||||
to_visit[2] = (CELL *)*pt0;
|
||||
to_visit += 3;
|
||||
*pt0 = TermFoundVar;
|
||||
#else
|
||||
/* store the terms to visit */
|
||||
if (pt0 < pt0_end) {
|
||||
to_visit[0] = pt0;
|
||||
to_visit[1] = pt0_end;
|
||||
to_visit += 2;
|
||||
}
|
||||
#endif
|
||||
d0 = ArityOfFunctor(f);
|
||||
pt0 = ap2;
|
||||
pt0_end = ap2 + d0;
|
||||
}
|
||||
continue;
|
||||
}
|
||||
|
||||
|
||||
derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar);
|
||||
continue;
|
||||
}
|
||||
/* Do we still have compound terms to visit */
|
||||
if (to_visit > to_visit0) {
|
||||
#ifdef RATIONAL_TREES
|
||||
to_visit -= 3;
|
||||
pt0 = to_visit[0];
|
||||
pt0_end = to_visit[1];
|
||||
*pt0 = (CELL)to_visit[2];
|
||||
#else
|
||||
to_visit -= 2;
|
||||
pt0 = to_visit[0];
|
||||
pt0_end = to_visit[1];
|
||||
#endif
|
||||
goto loop;
|
||||
}
|
||||
return TRUE;
|
||||
|
||||
aux_overflow:
|
||||
/* unwind stack */
|
||||
#ifdef RATIONAL_TREES
|
||||
while (to_visit > to_visit0) {
|
||||
to_visit -= 3;
|
||||
pt0 = to_visit[0];
|
||||
*pt0 = (CELL)to_visit[2];
|
||||
}
|
||||
#endif
|
||||
return -1;
|
||||
}
|
||||
|
||||
int Yap_IsAcyclicTerm(Term t)
|
||||
{
|
||||
CACHE_REGS
|
||||
while (TRUE) {
|
||||
Int out;
|
||||
|
||||
if (IsVarTerm(t)) {
|
||||
return TRUE;
|
||||
} else if (IsPrimitiveTerm(t)) {
|
||||
return TRUE;
|
||||
} else if (IsPairTerm(t)) {
|
||||
if ((out = finite_tree_complex_term(RepPair(t)-1,
|
||||
RepPair(t)+1 PASS_REGS)) >= 0) {
|
||||
return out;
|
||||
}
|
||||
} else {
|
||||
Functor fun = FunctorOfTerm(t);
|
||||
|
||||
if (IsExtensionFunctor(fun))
|
||||
return TRUE;
|
||||
else if ((out = finite_tree_complex_term(RepAppl(t),
|
||||
RepAppl(t)+
|
||||
ArityOfFunctor(fun) PASS_REGS)) >= 0) {
|
||||
return out;
|
||||
}
|
||||
}
|
||||
if (out < 0) {
|
||||
*H++ = t;
|
||||
if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) {
|
||||
Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG1, "overflow in finite_tree");
|
||||
return FALSE;
|
||||
}
|
||||
t = *--H;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_acyclic_term( USES_REGS1 ) /* finite_tree(+T) */
|
||||
{
|
||||
return Yap_IsAcyclicTerm(Deref(ARG1));
|
||||
}
|
||||
|
||||
static Int
|
||||
p_cyclic_term( USES_REGS1 ) /* finite_tree(+T) */
|
||||
{
|
||||
return !Yap_IsAcyclicTerm(Deref(ARG1));
|
||||
}
|
||||
|
||||
int Yap_IsGroundTerm(Term t)
|
||||
{
|
||||
CACHE_REGS
|
||||
@ -5191,6 +5353,8 @@ void Yap_InitUtilCPreds(void)
|
||||
Yap_InitCPred("duplicate_term", 2, p_duplicate_term, 0);
|
||||
Yap_InitCPred("copy_term_nat", 2, p_copy_term_no_delays, 0);
|
||||
Yap_InitCPred("ground", 1, p_ground, SafePredFlag);
|
||||
Yap_InitCPred("acyclic_term", 1, p_acyclic_term, SafePredFlag);
|
||||
Yap_InitCPred("cyclic_term", 1, p_cyclic_term, SafePredFlag);
|
||||
Yap_InitCPred("$variables_in_term", 3, p_variables_in_term, HiddenPredFlag);
|
||||
Yap_InitCPred("$non_singletons_in_term", 3, p_non_singletons_in_term, HiddenPredFlag);
|
||||
Yap_InitCPred("term_variables", 2, p_term_variables, 0);
|
||||
|
@ -402,6 +402,7 @@ int STD_PROTO(Yap_IsListOrPartialListTerm,(Term));
|
||||
Term STD_PROTO(Yap_CopyTermNoShare,(Term));
|
||||
int STD_PROTO(Yap_SizeGroundTerm,(Term, int));
|
||||
int STD_PROTO(Yap_IsGroundTerm,(Term));
|
||||
int STD_PROTO(Yap_IsAcyclicTerm,(Term));
|
||||
void STD_PROTO(Yap_InitUtilCPreds,(void));
|
||||
Int STD_PROTO(Yap_TermHash,(Term, Int, Int, int));
|
||||
Int STD_PROTO(Yap_NumberVars,(Term, Int, int));
|
||||
|
Reference in New Issue
Block a user