diff --git a/C/utilpreds.c b/C/utilpreds.c index 1c507f6dc..3c533e671 100644 --- a/C/utilpreds.c +++ b/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); diff --git a/H/Yapproto.h b/H/Yapproto.h index 0d23006ed..7cdf160c2 100644 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -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));