From be5208f28168c35adca8dd45ba8dde854d6e7b85 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 14 Jan 2013 22:46:06 +0000 Subject: [PATCH] fix search for free variables in bagof. --- C/utilpreds.c | 348 ++++++++++++++++++++++++++++++++++++++++++++++++++ H/iatoms.h | 3 + H/ratoms.h | 3 + H/tatoms.h | 6 + misc/ATOMS | 3 + 5 files changed, 363 insertions(+) diff --git a/C/utilpreds.c b/C/utilpreds.c index ed3b891c1..2c5777f9a 100644 --- a/C/utilpreds.c +++ b/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); diff --git a/H/iatoms.h b/H/iatoms.h index d1f1db115..6e0bc29a1 100644 --- a/H/iatoms.h +++ b/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); diff --git a/H/ratoms.h b/H/ratoms.h index eceae68a3..012907290 100644 --- a/H/ratoms.h +++ b/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); diff --git a/H/tatoms.h b/H/tatoms.h index ecc2f5d6d..622db3179 100644 --- a/H/tatoms.h +++ b/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_; diff --git a/misc/ATOMS b/misc/ATOMS index 06eb8b509..8629a3f32 100644 --- a/misc/ATOMS +++ b/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