fix search for free variables in bagof.

C/utilpreds.c

@@ -2657,6 +2657,353 @@ p_new_variables_in_term( USES_REGS1 )	/* variables within term t		 */
   return Yap_unify(ARG3,out);
 }
 
+static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, tr_fr_ptr TR0 USES_REGS)
+{
+  register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace();
+  CELL *InitialH = H;
+  *H++ = MkAtomTerm(AtomDollar);
+
+  to_visit0 = to_visit;
+ loop:
+  while (pt0 < pt0_end) {
+    register CELL d0;
+    register CELL *ptd0;
+    ++ pt0;
+    ptd0 = pt0;
+    d0 = *ptd0;
+    deref_head(d0, vars_within_term_unk);
+  vars_within_term_nvar:
+    {
+      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 = TermNil;
+#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;
+	}
+	/* store the terms to visit */
+	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 = TermNil;
+#else
+	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_within_term_unk, vars_within_term_nvar);
+    /* do or pt2 are unbound  */
+    *ptd0 = TermNil;
+    /* leave an empty slot to fill in later */
+    if (H+1024 > ASP) {
+      goto global_overflow;
+    }
+    H[0] =  (CELL)ptd0;
+    H ++;
+    /* next make sure noone will see this as a variable again */ 
+    if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
+      /* Trail overflow */
+      if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) {
+	goto trail_overflow;
+      }
+    }
+    TrailTerm(TR++) = (CELL)ptd0;
+  }
+  /* 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;
+  }
+
+  clean_tr(TR0 PASS_REGS);
+  Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
+  if (H != InitialH+1) {
+    InitialH[0] = (CELL)Yap_MkFunctor(AtomDollar, (H-InitialH)-1);
+    return AbsAppl(InitialH);
+  } else {
+    return MkAtomTerm(AtomDollar);
+  }
+
+ trail_overflow:
+#ifdef RATIONAL_TREES
+  while (to_visit > to_visit0) {
+    to_visit -= 3;
+    pt0 = to_visit[0];
+    *pt0 = (CELL)to_visit[2];
+  }
+#endif
+  LOCAL_Error_TYPE = OUT_OF_TRAIL_ERROR;
+  LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *);
+  clean_tr(TR0 PASS_REGS);
+  Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
+  H = InitialH;
+  return 0L;
+  
+ aux_overflow:
+  LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **);
+#ifdef RATIONAL_TREES
+  while (to_visit > to_visit0) {
+    to_visit -= 3;
+    pt0 = to_visit[0];
+    *pt0 = (CELL)to_visit[2];
+  }
+#endif
+  LOCAL_Error_TYPE = OUT_OF_AUXSPACE_ERROR;
+  clean_tr(TR0 PASS_REGS);
+  Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
+  H = InitialH;
+  return 0L;
+  
+ global_overflow:
+#ifdef RATIONAL_TREES
+  while (to_visit > to_visit0) {
+    to_visit -= 3;
+    pt0 = to_visit[0];
+    *pt0 = (CELL)to_visit[2];
+  }
+#endif
+  clean_tr(TR0 PASS_REGS);
+  Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
+  H = InitialH;
+  LOCAL_Error_TYPE = OUT_OF_STACK_ERROR;
+  LOCAL_Error_Size = (ASP-H)*sizeof(CELL);
+  return 0L;
+  
+}
+
+static Term bind_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, tr_fr_ptr TR0 USES_REGS)
+{
+  register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace();
+  CELL *InitialH = H;
+
+  to_visit0 = to_visit;
+ loop:
+  while (pt0 < pt0_end) {
+    register CELL d0;
+    register CELL *ptd0;
+    ++ pt0;
+    ptd0 = pt0;
+    d0 = *ptd0;
+    deref_head(d0, vars_within_term_unk);
+  vars_within_term_nvar:
+    {
+      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 = TermNil;
+#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;
+	}
+	/* store the terms to visit */
+	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 = TermNil;
+#else
+	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_within_term_unk, vars_within_term_nvar);
+    /* do or pt2 are unbound  */
+    *ptd0 = TermFoundVar;
+    /* next make sure noone will see this as a variable again */ 
+    if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
+      /* Trail overflow */
+      if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) {
+	goto trail_overflow;
+      }
+    }
+    TrailTerm(TR++) = (CELL)ptd0;
+  }
+  /* 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;
+  }
+
+  Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
+  return TermNil;
+
+ trail_overflow:
+#ifdef RATIONAL_TREES
+  while (to_visit > to_visit0) {
+    to_visit -= 3;
+    pt0 = to_visit[0];
+    *pt0 = (CELL)to_visit[2];
+  }
+#endif
+  LOCAL_Error_TYPE = OUT_OF_TRAIL_ERROR;
+  LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *);
+  clean_tr(TR0 PASS_REGS);
+  Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
+  H = InitialH;
+  return 0L;
+  
+ aux_overflow:
+  LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **);
+#ifdef RATIONAL_TREES
+  while (to_visit > to_visit0) {
+    to_visit -= 3;
+    pt0 = to_visit[0];
+    *pt0 = (CELL)to_visit[2];
+  }
+#endif
+  LOCAL_Error_TYPE = OUT_OF_AUXSPACE_ERROR;
+  clean_tr(TR0 PASS_REGS);
+  Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
+  H = InitialH;
+  return 0L;
+  
+}
+
+static Int 
+p_free_variables_in_term( USES_REGS1 )	/* variables within term t		 */
+{
+  Term out;
+  Term t, t0;
+  Term found_module = 0L;
+
+  do {
+    tr_fr_ptr TR0 = TR; 
+
+    t = t0 = Deref(ARG1);
+    while (!IsVarTerm(t) && IsApplTerm(t)) {
+      Functor f = FunctorOfTerm(t);
+      if (f == FunctorHat) {
+	out = bind_vars_in_complex_term(RepAppl(t),
+			     RepAppl(t)+1, TR0 PASS_REGS);
+	if (out == 0L) {
+	  goto trail_overflow;
+	}
+      } else if (f == FunctorModule) {
+	found_module = ArgOfTerm(1, t);
+      } else {
+	break;
+      }
+      t = ArgOfTerm(2,t);
+    }
+    if (IsVarTerm(t)) {
+      out = free_vars_in_complex_term(VarOfTerm(t)-1,
+				      VarOfTerm(t), TR0 PASS_REGS);
+
+    }  else if (IsPrimitiveTerm(t)) 
+      out = TermNil;
+    else if (IsPairTerm(t)) {
+      out = free_vars_in_complex_term(RepPair(t)-1,
+				      RepPair(t)+1, TR0 PASS_REGS);
+    }
+    else {
+      Functor f = FunctorOfTerm(t);
+      out = free_vars_in_complex_term(RepAppl(t),
+			     RepAppl(t)+
+				      ArityOfFunctor(f), TR0 PASS_REGS);
+    }
+    if (out == 0L) {
+    trail_overflow:
+      if (!expand_vts( 3 PASS_REGS ))
+	return FALSE;
+    }
+  } while (out == 0L);
+  if (found_module && t!=t0) {
+    Term ts[2];
+    ts[0] = found_module;
+    ts[1] = t;
+    t = Yap_MkApplTerm(FunctorModule, 2, ts);
+  }
+  return
+    Yap_unify(ARG2, t) &&
+    Yap_unify(ARG3,out);
+}
+
 static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt0_end USES_REGS)
 {
 
@@ -5196,6 +5543,7 @@ void Yap_InitUtilCPreds(void)
   Yap_InitCPred("copy_term_nat", 2, p_copy_term_no_delays, 0);
   Yap_InitCPred("ground", 1, p_ground, SafePredFlag);
   Yap_InitCPred("$variables_in_term", 3, p_variables_in_term, 0);
+  Yap_InitCPred("$free_variables_in_term", 3, p_free_variables_in_term, 0);
   Yap_InitCPred("$non_singletons_in_term", 3, p_non_singletons_in_term, 0);
   Yap_InitCPred("term_variables", 2, p_term_variables, 0);
   Yap_InitCPred("term_variables", 3, p_term_variables3, 0);

H/iatoms.h

@@ -74,6 +74,7 @@
   AtomDefault = Yap_LookupAtom("default");
   AtomDevNull = Yap_LookupAtom("/dev/null");
   AtomDiff = Yap_LookupAtom("\\=");
+  AtomDollar = Yap_FullLookupAtom("$");
   AtomDoLogUpdClause = Yap_FullLookupAtom("$do_log_upd_clause");
   AtomDoLogUpdClause0 = Yap_FullLookupAtom("$do_log_upd_clause0");
   AtomDoLogUpdClauseErase = Yap_FullLookupAtom("$do_log_upd_clause_erase");
@@ -127,6 +128,7 @@
   AtomGlobalSp = Yap_LookupAtom("global_sp");
   AtomGlobalTrie = Yap_LookupAtom("global_trie");
   AtomGoalExpansion = Yap_LookupAtom("goal_expansion");
+  AtomHat = Yap_LookupAtom("^");
   AtomHERE = Yap_LookupAtom("\n   <====HERE====>  \n");
   AtomHandleThrow = Yap_FullLookupAtom("$handle_throw");
   AtomHeap = Yap_LookupAtom("heap");
@@ -390,6 +392,7 @@
   FunctorGoalExpansion2 = Yap_MkFunctor(AtomGoalExpansion,2);
   FunctorGoalExpansion = Yap_MkFunctor(AtomGoalExpansion,3);
   FunctorHandleThrow = Yap_MkFunctor(AtomHandleThrow,3);
+  FunctorHat = Yap_MkFunctor(AtomHat,2);
   FunctorId = Yap_MkFunctor(AtomId,1);
   FunctorIs = Yap_MkFunctor(AtomIs,2);
   FunctorLastExecuteWithin = Yap_MkFunctor(AtomLastExecuteWithin,1);

H/ratoms.h

@@ -74,6 +74,7 @@
   AtomDefault = AtomAdjust(AtomDefault);
   AtomDevNull = AtomAdjust(AtomDevNull);
   AtomDiff = AtomAdjust(AtomDiff);
+  AtomDollar = AtomAdjust(AtomDollar);
   AtomDoLogUpdClause = AtomAdjust(AtomDoLogUpdClause);
   AtomDoLogUpdClause0 = AtomAdjust(AtomDoLogUpdClause0);
   AtomDoLogUpdClauseErase = AtomAdjust(AtomDoLogUpdClauseErase);
@@ -127,6 +128,7 @@
   AtomGlobalSp = AtomAdjust(AtomGlobalSp);
   AtomGlobalTrie = AtomAdjust(AtomGlobalTrie);
   AtomGoalExpansion = AtomAdjust(AtomGoalExpansion);
+  AtomHat = AtomAdjust(AtomHat);
   AtomHERE = AtomAdjust(AtomHERE);
   AtomHandleThrow = AtomAdjust(AtomHandleThrow);
   AtomHeap = AtomAdjust(AtomHeap);
@@ -390,6 +392,7 @@
   FunctorGoalExpansion2 = FuncAdjust(FunctorGoalExpansion2);
   FunctorGoalExpansion = FuncAdjust(FunctorGoalExpansion);
   FunctorHandleThrow = FuncAdjust(FunctorHandleThrow);
+  FunctorHat = FuncAdjust(FunctorHat);
   FunctorId = FuncAdjust(FunctorId);
   FunctorIs = FuncAdjust(FunctorIs);
   FunctorLastExecuteWithin = FuncAdjust(FunctorLastExecuteWithin);

H/tatoms.h

@@ -146,6 +146,8 @@
 #define AtomDevNull Yap_heap_regs->AtomDevNull_
   Atom AtomDiff_;
 #define AtomDiff Yap_heap_regs->AtomDiff_
+  Atom AtomDollar_;
+#define AtomDollar Yap_heap_regs->AtomDollar_
   Atom AtomDoLogUpdClause_;
 #define AtomDoLogUpdClause Yap_heap_regs->AtomDoLogUpdClause_
   Atom AtomDoLogUpdClause0_;
@@ -252,6 +254,8 @@
 #define AtomGlobalTrie Yap_heap_regs->AtomGlobalTrie_
   Atom AtomGoalExpansion_;
 #define AtomGoalExpansion Yap_heap_regs->AtomGoalExpansion_
+  Atom AtomHat_;
+#define AtomHat Yap_heap_regs->AtomHat_
   Atom AtomHERE_;
 #define AtomHERE Yap_heap_regs->AtomHERE_
   Atom AtomHandleThrow_;
@@ -778,6 +782,8 @@
 #define FunctorGoalExpansion Yap_heap_regs->FunctorGoalExpansion_
   Functor FunctorHandleThrow_;
 #define FunctorHandleThrow Yap_heap_regs->FunctorHandleThrow_
+  Functor FunctorHat_;
+#define FunctorHat Yap_heap_regs->FunctorHat_
   Functor FunctorId_;
 #define FunctorId Yap_heap_regs->FunctorId_
   Functor FunctorIs_;

misc/ATOMS

@@ -79,6 +79,7 @@ A	Dec10			N	"dec10"
 A	Default			N	"default"
 A	DevNull			N	"/dev/null"
 A	Diff			N	"\\="
+A	Dollar			F	"$"
 A	DoLogUpdClause		F	"$do_log_upd_clause"
 A	DoLogUpdClause0		F	"$do_log_upd_clause0"
 A	DoLogUpdClauseErase	F	"$do_log_upd_clause_erase"
@@ -132,6 +133,7 @@ A	GetworkSeq		F	"$getwork_seq"
 A	GlobalSp		N	"global_sp"
 A	GlobalTrie		N	"global_trie"
 A	GoalExpansion		N	"goal_expansion"
+A	Hat			N	"^"
 A	HERE			N	"\n   <====HERE====>  \n"
 A	HandleThrow		F	"$handle_throw"
 A	Heap			N	"heap"
@@ -395,6 +397,7 @@ F	GeneratePredInfo	GeneratePredInfo	4
 F	GoalExpansion2		GoalExpansion	2
 F	GoalExpansion		GoalExpansion	3
 F	HandleThrow		HandleThrow	3
+F	Hat			Hat		2
 F	Id			Id		1
 F	Is			Is		2
 F	LastExecuteWithin	LastExecuteWithin	1