fix search for free variables in bagof.
This commit is contained in:
Vitor Santos Costa
parent
be668f1558
commit
be5208f281
348
C/utilpreds.c
348
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);
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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_;
|
||||
|
||||
@ -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
|
||||
|
||||
Reference in New Issue
Block a user