From 4de83f5f521083221073076741acdbe1043079e5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= <vsc@dcc.fc.up.pt>
Date: Tue, 2 Oct 2012 15:14:41 +0100
Subject: [PATCH] include cyclic_term and friends.

---
 C/utilpreds.c | 164 ++++++++++++++++++++++++++++++++++++++++++++++++++
 H/Yapproto.h  |   1 +
 2 files changed, 165 insertions(+)

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));