diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

cyclic_term/1

Browse Source
This commit is contained in:
Vitor Santos Costa 2019-02-04 01:08:18 +00:00
parent 208438f0d0
commit 7045b6ef36
5 changed files with 339 additions and 551 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

463
C/terms.c
View File

@ -158,10 +158,10 @@ typedef struct non_single_struct_t {
if (to_visit + 32 >= to_visit_max) { \ if (to_visit + 32 >= to_visit_max) { \
goto aux_overflow; \ goto aux_overflow; \
} \ } \
LIST0; \
ptd0 = RepPair(d0); \ ptd0 = RepPair(d0); \
LIST0; \
if (*ptd0 == TermFreeTerm) \ if (*ptd0 == TermFreeTerm) \
goto restart; \ goto restart; \
to_visit->pt0 = pt0; \ to_visit->pt0 = pt0; \
to_visit->pt0_end = pt0_end; \ to_visit->pt0_end = pt0_end; \
to_visit->ptd0 = ptd0; \ to_visit->ptd0 = ptd0; \
@ -180,39 +180,38 @@ typedef struct non_single_struct_t {
ap2 = RepAppl(d0); \ ap2 = RepAppl(d0); \
f = (Functor)(*ap2); \ f = (Functor)(*ap2); \
\ \
if (IsExtensionFunctor(f) || IsAtomTerm((CELL)f)) { \
\
goto restart; \
} \
STRUCT0; \
if (to_visit + 32 >= to_visit_max) { \ if (to_visit + 32 >= to_visit_max) { \
goto aux_overflow; \ goto aux_overflow; \
} \ } \
STRUCT0; \
if (IsExtensionFunctor(f) || IsAtomTerm((CELL)f)) { \
\
goto restart; \
} \
to_visit->pt0 = pt0; \ to_visit->pt0 = pt0; \
to_visit->pt0_end = pt0_end; \ to_visit->pt0_end = pt0_end; \
to_visit->ptd0 = ap2; \ to_visit->ptd0 = ap2; \
to_visit->d0 = (CELL)f; \ to_visit->d0 = (CELL)f; \
to_visit++; \ to_visit++; \
\ \
*ap2 = TermNil; \ *ap2 = TermNil; \
d0 = ArityOfFunctor(f); \ d0 = ArityOfFunctor(f); \
pt0 = ap2; \ pt0 = ap2; \
pt0_end = ap2 + d0; \ pt0_end = ap2 + d0; \
goto restart;\ goto restart; \
} else { \ } else { \
PRIMI0; \ PRIMI0; \
goto restart; } \ goto restart; \
} \
} \ } \
derefa_body(d0, ptd0, var_in_term_unk, var_in_term_nvar); derefa_body(d0, ptd0, var_in_term_unk, var_in_term_nvar);
#define WALK_COMPLEX_TERM() WALK_COMPLEX_TERM__({}, {}, {}) #define WALK_COMPLEX_TERM() WALK_COMPLEX_TERM__({}, {}, {})
#define END_WALK() \ #define END_WALK() }
}
#define def_aux_overflow() \
#define def_aux_overflow() \ aux_overflow : { \
aux_overflow : { \
size_t d1 = to_visit - to_visit0; \ size_t d1 = to_visit - to_visit0; \
size_t d2 = to_visit_max - to_visit0; \ size_t d2 = to_visit_max - to_visit0; \
to_visit0 = \ to_visit0 = \
@ -220,13 +219,12 @@ typedef struct non_single_struct_t {
to_visit = to_visit0 + d1; \ to_visit = to_visit0 + d1; \
to_visit_max = to_visit0 + (d2 + 128); \ to_visit_max = to_visit0 + (d2 + 128); \
pt0--; \ pt0--; \
} \ } \
goto restart; goto restart;
#define def_trail_overflow() \ #define def_trail_overflow() \
trail_overflow : { \ trail_overflow : { \
pop_text_stack(lvl); \ pop_text_stack(lvl); \
LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; \ LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; \
LOCAL_Error_Size = (TR - TR0) * sizeof(tr_fr_ptr *); \ LOCAL_Error_Size = (TR - TR0) * sizeof(tr_fr_ptr *); \
clean_tr(TR0 PASS_REGS); \ clean_tr(TR0 PASS_REGS); \
@ -249,6 +247,139 @@ typedef struct non_single_struct_t {
return false; \ return false; \
} }
#define CYC_LIST \
if (*ptd0 == TermFreeTerm) { \
while (to_visit > to_visit0) { \
to_visit--; \
CELL *ptd0 = to_visit->ptd0; \
*ptd0 = to_visit->d0; \
} \
pop_text_stack(lvl); \
return true; \
}
#define CYC_APPL \
if (IsAtomTerm((CELL)f)) { \
while (to_visit > to_visit0) { \
to_visit--; \
CELL *ptd0 = to_visit->ptd0; \
*ptd0 = to_visit->d0; \
} \
pop_text_stack(lvl); \
return true; \
}
/**
@brief routine to locate all variables in a term, and its applications */
static Term cyclic_complex_term(register CELL *pt0,
register CELL *pt0_end USES_REGS) {
WALK_COMPLEX_TERM__(CYC_LIST, CYC_APPL, {});
/* leave an empty slot to fill in later */
END_WALK();
/* Do we still have compound terms to visit */
if (to_visit > to_visit0) {
to_visit--;
pt0 = to_visit->pt0;
pt0_end = to_visit->pt0_end;
CELL *ptd0 = to_visit->ptd0;
*ptd0 = to_visit->d0;
goto restart;
}
pop_text_stack(lvl);
return false;
def_aux_overflow();
}
bool Yap_IsCyclicTerm(Term t USES_REGS) {
if (IsVarTerm(t)) {
return false;
} else if (IsPrimitiveTerm(t)) {
return false;
} else {
return cyclic_complex_term(&(t)-1, &(t)PASS_REGS);
}
}
/** @pred cyclic_term( + _T_ )
Succeeds if the graph representation of the term has loops. Say,
the representation of a term `X` that obeys the equation `X=[X]`
term has a loop from the list to its head.
*/
static Int cyclic_term(USES_REGS1) /* cyclic_term(+T) */
{
return Yap_IsCyclicTerm(Deref(ARG1));
}
/**
@brief routine to locate all variables in a term, and its applications */
static bool ground_complex_term(register CELL *pt0,
register CELL *pt0_end USES_REGS) {
WALK_COMPLEX_TERM();
/* leave an empty slot to fill in later */
while (to_visit > to_visit0) {
to_visit--;
CELL *ptd0 = to_visit->ptd0;
*ptd0 = to_visit->d0;
}
pop_text_stack(lvl);
return false;
END_WALK();
/* Do we still have compound terms to visit */
if (to_visit > to_visit0) {
to_visit--;
pt0 = to_visit->pt0;
pt0_end = to_visit->pt0_end;
CELL *ptd0 = to_visit->ptd0;
*ptd0 = to_visit->d0;
goto restart;
}
pop_text_stack(lvl);
return true;
def_aux_overflow();
}
bool Yap_IsGroundTerm(Term t) {
CACHE_REGS
if (IsVarTerm(t)) {
return false;
} else if (IsPrimitiveTerm(t)) {
return true;
} else {
return ground_complex_term(&(t)-1, &(t)PASS_REGS);
}
}
/** @pred ground( _T_) is iso
Succeeds if there are no free variables in the term _T_.
*/
static Int ground(USES_REGS1) /* ground(+T) */
{
return Yap_IsGroundTerm(Deref(ARG1));
}
static Int var_in_complex_term(register CELL *pt0, register CELL *pt0_end, static Int var_in_complex_term(register CELL *pt0, register CELL *pt0_end,
Term v USES_REGS) { Term v USES_REGS) {
@ -279,7 +410,6 @@ static Int var_in_complex_term(register CELL *pt0, register CELL *pt0_end,
return false; return false;
def_aux_overflow(); def_aux_overflow();
} }
static Int var_in_term(Term v, static Int var_in_term(Term v,
@ -308,8 +438,8 @@ static Int variable_in_term(USES_REGS1) {
} }
/** /**
@brief routine to locate all variables in a term, and its applications */ * @brief routine to locate all variables in a term, and its applications.
*/
static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
Term inp USES_REGS) { Term inp USES_REGS) {
@ -364,7 +494,6 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
} else { } else {
return (inp); return (inp);
} }
def_trail_overflow(); def_trail_overflow();
def_aux_overflow(); def_aux_overflow();
@ -372,8 +501,14 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
def_global_overflow(); def_global_overflow();
} }
static Int /**
p_variables_in_term(USES_REGS1) /* variables in term t */ * @pred variables_in_term( +_T_, +_SetOfVariables_, +_ExtendedSetOfVariables_ )
*
* _SetOfVariables_ must be a list of unbound variables. If so,
* _ExtendedSetOfVariables_ will include all te variables in the union
* of `vars(_T_)` and _SetOfVariables_.
*/
static Int variables_in_term(USES_REGS1) /* variables in term t */
{ {
Term out, inp; Term out, inp;
int count; int count;
@ -617,24 +752,23 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
{ {
int lvl = push_text_stack(); int lvl = push_text_stack();
while (!IsVarTerm(inp) && IsPairTerm(inp)) { while (!IsVarTerm(inp) && IsPairTerm(inp)) {
Term t = HeadOfTerm(inp); Term t = HeadOfTerm(inp);
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
CELL *ptr = VarOfTerm(t); CELL *ptr = VarOfTerm(t);
*ptr = TermFoundVar; *ptr = TermFoundVar;
TrailTerm(TR++) = t; TrailTerm(TR++) = t;
if ((tr_fr_ptr)LOCAL_TrailTop-TR < 1024) { if ((tr_fr_ptr)LOCAL_TrailTop - TR < 1024) {
if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) {
{ pop_text_stack(lvl);
pop_text_stack(lvl); goto trail_overflow;
goto trail_overflow; }
} }
} }
inp = TailOfTerm(inp);
} }
inp = TailOfTerm(inp); pop_text_stack(lvl);
} }
pop_text_stack(lvl);
}
WALK_COMPLEX_TERM(); WALK_COMPLEX_TERM();
@ -650,8 +784,7 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
/* next make sure noone will see this as a variable again */ /* next make sure noone will see this as a variable again */
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
/* Trail overflow */ /* Trail overflow */
while (to_visit > to_visit0) while (to_visit > to_visit0) {
{
to_visit--; to_visit--;
CELL *ptd0 = to_visit->ptd0; CELL *ptd0 = to_visit->ptd0;
*ptd0 = to_visit->d0; *ptd0 = to_visit->d0;
@ -775,7 +908,6 @@ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end,
return TermNil; return TermNil;
} }
def_aux_overflow(); def_aux_overflow();
def_global_overflow(); def_global_overflow();
@ -870,8 +1002,7 @@ static Term bind_vars_in_complex_term(CELL *pt0, CELL *pt0_end,
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
/* Trail overflow */ /* Trail overflow */
if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) {
while (to_visit > to_visit0) while (to_visit > to_visit0) {
{
to_visit--; to_visit--;
CELL *ptd0 = to_visit->ptd0; CELL *ptd0 = to_visit->ptd0;
*ptd0 = to_visit->d0; *ptd0 = to_visit->d0;
@ -896,7 +1027,6 @@ static Term bind_vars_in_complex_term(CELL *pt0, CELL *pt0_end,
def_aux_overflow(); def_aux_overflow();
def_trail_overflow(); def_trail_overflow();
} }
static Int static Int
@ -995,7 +1125,6 @@ static Term non_singletons_in_complex_term(CELL *pt0, CELL *pt0_end USES_REGS) {
} }
def_aux_overflow(); def_aux_overflow();
} }
static Int p_non_singletons_in_term( static Int p_non_singletons_in_term(
@ -1019,68 +1148,6 @@ static Int p_non_singletons_in_term(
} }
} }
static Int ground_complex_term(CELL *pt0, CELL *pt0_end USES_REGS) {
WALK_COMPLEX_TERM();
/* found a variable */
while (to_visit > to_visit0) {
to_visit--;
CELL *ptd0 = to_visit->ptd0;
*ptd0 = to_visit->d0;
}
pop_text_stack(lvl);
return false;
END_WALK();
/* Do we still have compound terms to visit */
if (to_visit > to_visit0) {
to_visit--;
pt0 = to_visit->pt0;
pt0_end = to_visit->pt0_end;
CELL *ptd0 = to_visit->ptd0;
*ptd0 = to_visit->d0;
goto restart;
}
pop_text_stack(lvl);
return true;
def_aux_overflow();
}
bool Yap_IsGroundTerm(Term t) {
CACHE_REGS
while (true) {
Int out;
if (IsVarTerm(t)) {
return false;
} else if (IsPrimitiveTerm(t)) {
return true;
} else {
if ((out = ground_complex_term(&(t)-1, &(t)PASS_REGS)) >= 0) {
return out != 0;
}
if (out < 0) {
*HR++ = t;
t = *--HR;
}
}
}
}
/** @pred ground( _T_) is iso
Succeeds if there are no free variables in the term _T_.
*/
static Int p_ground(USES_REGS1) /* ground(+T) */
{
return Yap_IsGroundTerm(Deref(ARG1));
}
static Term numbervar(Int id USES_REGS) { static Term numbervar(Int id USES_REGS) {
Term ts[1]; Term ts[1];
ts[0] = MkIntegerTerm(id); ts[0] = MkIntegerTerm(id);
@ -1101,7 +1168,7 @@ static void renumbervar(Term t, Int id USES_REGS) {
#define RENUMBER_SINGLES \ #define RENUMBER_SINGLES \
if (singles && ap2 >= InitialH && ap2 < HR) { \ if (singles && ap2 >= InitialH && ap2 < HR) { \
renumbervar(d0, numbv++ PASS_REGS); \ renumbervar(d0, numbv++ PASS_REGS); \
goto restart; \ goto restart; \
} }
static Int numbervars_in_complex_term(CELL *pt0, CELL *pt0_end, Int numbv, static Int numbervars_in_complex_term(CELL *pt0, CELL *pt0_end, Int numbv,
@ -1155,7 +1222,6 @@ static Int numbervars_in_complex_term(CELL *pt0, CELL *pt0_end, Int numbv,
def_global_overflow(); def_global_overflow();
def_trail_overflow(); def_trail_overflow();
} }
Int Yap_NumberVars(Term inp, Int numbv, Int Yap_NumberVars(Term inp, Int numbv,
@ -1214,7 +1280,7 @@ static Int p_numbervars(USES_REGS1) {
Int i; \ Int i; \
if (IsIntegerTerm(t1) && ((i = IntegerOfTerm(t1)) > *maxp)) \ if (IsIntegerTerm(t1) && ((i = IntegerOfTerm(t1)) > *maxp)) \
*maxp = i; \ *maxp = i; \
goto restart; \ goto restart; \
} }
static int max_numbered_var(CELL *pt0, CELL *pt0_end, Int *maxp USES_REGS) { static int max_numbered_var(CELL *pt0, CELL *pt0_end, Int *maxp USES_REGS) {
@ -1236,7 +1302,6 @@ static int max_numbered_var(CELL *pt0, CELL *pt0_end, Int *maxp USES_REGS) {
return 0; return 0;
def_aux_overflow(); def_aux_overflow();
} }
static Int MaxNumberedVar(Term inp, UInt arity PASS_REGS) { static Int MaxNumberedVar(Term inp, UInt arity PASS_REGS) {
@ -1257,40 +1322,39 @@ static Int MaxNumberedVar(Term inp, UInt arity PASS_REGS) {
/** /**
* @pred largest_numbervar( +_Term_, -Max) * @pred largest_numbervar( +_Term_, -Max)
* *
* Unify _Max_ with the largest integer _I_ such that `$VAR(I)` is a * Unify _Max_ with the largest integer _I_ such that `$VAR(I)` is a
* sub-term of _Term_. * sub-term of _Term_.
* *
* This built-in predicate is useful if part of a term has been grounded, and * This built-in predicate is useful if part of a term has been grounded, and
* now you want to ground the full term. * now you want to ground the full term.
*/ */
static Int largest_numbervar(USES_REGS1) static Int largest_numbervar(USES_REGS1) {
{
return Yap_unify(MaxNumberedVar(Deref(ARG1), 2 PASS_REGS), ARG2); return Yap_unify(MaxNumberedVar(Deref(ARG1), 2 PASS_REGS), ARG2);
} }
static Term BREAK_LOOP(int ddep ) { static Term BREAK_LOOP(int ddep) {
Term t0 = MkIntegerTerm (ddep); Term t0 = MkIntegerTerm(ddep);
return Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("@^"), 1), 1, &t0); return Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("@^"), 1), 1, &t0);
} }
static Term UNFOLD_LOOP( Term t, Term *b, Term l) { static Term UNFOLD_LOOP(Term t, Term *b, Term l) {
Term ti = Yap_MkNewApplTerm(FunctorEq, 2); Term ti = Yap_MkNewApplTerm(FunctorEq, 2);
RepAppl(ti)[2] = t; RepAppl(ti)[2] = t;
Term o = RepAppl(ti)[1]; Term o = RepAppl(ti)[1];
HR[0] = ti; HR[0] = ti;
HR[1] = l; HR[1] = l;
*b = AbsPair(HR); *b = AbsPair(HR);
b = HR+1; b = HR + 1;
HR+=2; HR += 2;
return o; return o;
} }
static int loops_in_complex_term(CELL *pt0, CELL *pt0_end, Term *listp,
static int loops_in_complex_term(CELL *pt0, CELL *pt0_end, Term *listp, Term tail USES_REGS) { Term tail USES_REGS) {
int lvl = push_text_stack(); int lvl = push_text_stack();
struct non_single_struct_t *to_visit = Malloc( struct non_single_struct_t *to_visit = Malloc(
1024 * sizeof(struct non_single_struct_t)), 1024 * sizeof(struct non_single_struct_t)),
*to_visit0 = to_visit, *to_visit0 = to_visit,
*to_visit_max = to_visit + 1024; *to_visit_max = to_visit + 1024;
@ -1305,68 +1369,70 @@ restart:
d0 = *ptd0; d0 = *ptd0;
list_loop: list_loop:
deref_head(d0, vars_in_term_unk); deref_head(d0, vars_in_term_unk);
vars_in_term_nvar : vars_in_term_nvar:
if (IsPairTerm(d0)) { if (IsPairTerm(d0)) {
if (to_visit + 32 >= to_visit_max) { if (to_visit + 32 >= to_visit_max) {
goto aux_overflow; goto aux_overflow;
}
CELL *headp = RepPair(d0);
d0 = headp[0];
if (IsAtomTerm(d0) &&
(CELL *)AtomOfTerm(d0) >= (CELL *)to_visit0 &&
(CELL *)AtomOfTerm(d0) < (CELL *)to_visit_max) {
// LIST0;
struct non_single_struct_t *v0 = (struct non_single_struct_t *)AtomOfTerm(d0);
if (listp) {
*ptd0 = UNFOLD_LOOP(AbsPair(headp), listp, tail);
} else {
*ptd0 = BREAK_LOOP(to_visit-v0);
} }
CELL *headp = RepPair(d0);
goto restart; d0 = headp[0];
} if (IsAtomTerm(d0) && (CELL *)AtomOfTerm(d0) >= (CELL *)to_visit0 &&
to_visit->pt0 = pt0; (CELL *)AtomOfTerm(d0) < (CELL *)to_visit_max) {
to_visit->pt0_end = pt0_end; // LIST0;
to_visit->ptd0 = headp; struct non_single_struct_t *v0 =
to_visit->d0 = d0; (struct non_single_struct_t *)AtomOfTerm(d0);
*headp = MkAtomTerm((AtomEntry*)to_visit); if (listp) {
to_visit++; *ptd0 = UNFOLD_LOOP(AbsPair(headp), listp, tail);
pt0 = headp; } else {
pt0_end = pt0 + 1; *ptd0 = BREAK_LOOP(to_visit - v0);
ptd0 = pt0; }
goto list_loop;
} else if (IsApplTerm(d0)) { goto restart;
register Functor f;
register CELL *ap2;
/* store the terms to visit */
ap2 = RepAppl(d0);
f = (Functor)(*ap2);
if (IsExtensionFunctor(f)) continue;
if (IsAtomTerm((CELL)f)) {
if (listp) {
*ptd0 = UNFOLD_LOOP(AbsAppl(ap2), listp, tail);
} else {
*ptd0 = BREAK_LOOP(to_visit-(struct non_single_struct_t *)AtomOfTerm(*ap2));
} }
goto restart; } to_visit->pt0 = pt0;
// STRUCT0; to_visit->pt0_end = pt0_end;
if (to_visit + 32 >= to_visit_max) { to_visit->ptd0 = headp;
goto aux_overflow; to_visit->d0 = d0;
} *headp = MkAtomTerm((AtomEntry *)to_visit);
to_visit->pt0 = pt0; to_visit++;
to_visit->pt0_end = pt0_end; pt0 = headp;
to_visit->ptd0 = ap2; pt0_end = pt0 + 1;
to_visit->d0 = *ap2; ptd0 = pt0;
*ap2 = MkAtomTerm((AtomEntry*)to_visit); goto list_loop;
to_visit++; } else if (IsApplTerm(d0)) {
pt0 = ap2; register Functor f;
pt0_end = ap2 + (ArityOfFunctor(f)); register CELL *ap2;
} /* store the terms to visit */
ap2 = RepAppl(d0);
f = (Functor)(*ap2);
if (IsExtensionFunctor(f))
continue;
if (IsAtomTerm((CELL)f)) {
if (listp) {
*ptd0 = UNFOLD_LOOP(AbsAppl(ap2), listp, tail);
} else {
*ptd0 = BREAK_LOOP(to_visit -
(struct non_single_struct_t *)AtomOfTerm(*ap2));
}
goto restart;
}
// STRUCT0;
if (to_visit + 32 >= to_visit_max) {
goto aux_overflow;
}
to_visit->pt0 = pt0;
to_visit->pt0_end = pt0_end;
to_visit->ptd0 = ap2;
to_visit->d0 = *ap2;
*ap2 = MkAtomTerm((AtomEntry *)to_visit);
to_visit++;
pt0 = ap2;
pt0_end = ap2 + (ArityOfFunctor(f));
}
goto restart; goto restart;
derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar);
goto restart; goto restart;
@ -1379,7 +1445,7 @@ restart:
pt0_end = to_visit->pt0_end; pt0_end = to_visit->pt0_end;
CELL *ptd0 = to_visit->ptd0; CELL *ptd0 = to_visit->ptd0;
if (!IsVarTerm(*ptd0)) if (!IsVarTerm(*ptd0))
*ptd0 = to_visit->d0; *ptd0 = to_visit->d0;
goto restart; goto restart;
} }
@ -1388,7 +1454,7 @@ restart:
def_aux_overflow(); def_aux_overflow();
} }
Term Yap_CheckCycles(Term inp, UInt arity, Term *listp, Term tail USES_REGS) { Term Yap_BreakCycles(Term inp, UInt arity, Term *listp, Term tail USES_REGS) {
Term t = Deref(inp); Term t = Deref(inp);
if (IsVarTerm(t) || IsPrimitiveTerm(t)) { if (IsVarTerm(t) || IsPrimitiveTerm(t)) {
@ -1396,38 +1462,38 @@ Term Yap_CheckCycles(Term inp, UInt arity, Term *listp, Term tail USES_REGS) {
} else { } else {
Int res; Int res;
res = loops_in_complex_term((&t) - 1, &t, listp, tail PASS_REGS); res = loops_in_complex_term((&t) - 1, &t, listp, tail PASS_REGS);
if (res < 0) if (res < 0)
return -1; return -1;
return t; return t;
} }
} }
/** @pred rational_term_to_tree(? _TI_,- _TF_, ?SubTerms, ?MoreSubterms)
/** @pred rational_term_to_tree(? _TI_,- _TF_, ?SubTerms, ?MoreSubterms)
The term _TF_ is a forest representation (without cycles) for The term _TF_ is a forest representation (without cycles) for
the Prolog term _TI_. The term _TF_ is the main term. The the Prolog term _TI_. The term _TF_ is the main term. The
difference list _SubTerms_-_MoreSubterms_ stores terms of the difference list _SubTerms_-_MoreSubterms_ stores terms of the
form _V=T_, where _V_ is a new variable occuring in _TF_, and form _V=T_, where _V_ is a new variable occuring in _TF_, and
_T_ is a copy of a sub-term from _TI_. _T_ is a copy of a sub-term from _TI_.
*/ */
static Int p_break_rational(USES_REGS1) static Int p_break_rational(USES_REGS1) {
{
Term t = Yap_CopyTerm(Deref(ARG1)); Term t = Yap_CopyTerm(Deref(ARG1));
Term l = Deref(ARG4), k; Term l = Deref(ARG4), k;
if (IsVarTerm(l)) Yap_unify(l, MkVarTerm()); if (IsVarTerm(l))
return Yap_unify(Yap_CheckCycles(t, 4, &k, l PASS_REGS), ARG2) && Yap_unify(k, ARG3); Yap_unify(l, MkVarTerm());
return Yap_unify(Yap_BreakCycles(t, 4, &k, l PASS_REGS), ARG2) &&
Yap_unify(k, ARG3);
} }
void Yap_InitTermCPreds(void) { void Yap_InitTermCPreds(void) {
Yap_InitCPred("rational_term_to_tree", 4, p_break_rational, 0); Yap_InitCPred("rational_term_to_tree", 4, p_break_rational, 0);
Yap_InitCPred("term_variables", 2, p_term_variables, 0); Yap_InitCPred("term_variables", 2, p_term_variables, 0);
Yap_InitCPred("term_variables", 3, p_term_variables3, 0); Yap_InitCPred("term_variables", 3, p_term_variables3, 0);
Yap_InitCPred("$variables_in_term", 3, p_variables_in_term, 0); Yap_InitCPred("$variables_in_term", 3, variables_in_term, 0);
Yap_InitCPred("$free_variables_in_term", 3, p_free_variables_in_term, 0); Yap_InitCPred("$free_variables_in_term", 3, p_free_variables_in_term, 0);
@ -1441,7 +1507,8 @@ void Yap_InitTermCPreds(void) {
Yap_InitCPred("$non_singletons_in_term", 3, p_non_singletons_in_term, 0); Yap_InitCPred("$non_singletons_in_term", 3, p_non_singletons_in_term, 0);
Yap_InitCPred("ground", 1, p_ground, SafePredFlag); Yap_InitCPred("ground", 1, ground, SafePredFlag);
Yap_InitCPred("cyclic_term", 1, cyclic_term, SafePredFlag);
Yap_InitCPred("numbervars", 3, p_numbervars, 0); Yap_InitCPred("numbervars", 3, p_numbervars, 0);
Yap_InitCPred("largest_numbervar", 2, largest_numbervar, 0); Yap_InitCPred("largest_numbervar", 2, largest_numbervar, 0);

337
C/utilpreds.c
View File

@ -376,7 +376,6 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end,
if (copy_att_vars && GlobalIsAttachedTerm((CELL)ptd0)) { if (copy_att_vars && GlobalIsAttachedTerm((CELL)ptd0)) {
/* if unbound, call the standard copy term routine */ /* if unbound, call the standard copy term routine */
struct cp_frame *bp; struct cp_frame *bp;
CELL new;
bp = to_visit; bp = to_visit;
if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp,
@ -384,7 +383,6 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end,
goto overflow; goto overflow;
} }
to_visit = bp; to_visit = bp;
new = *ptf;
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
/* Trail overflow */ /* Trail overflow */
if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) { if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) {
@ -1019,23 +1017,6 @@ Yap_BreakTerm(Term inp, UInt arity, Term *to, Term ti USES_REGS) {
} }
static Int
p_break_rational( USES_REGS1 )
{
Term tf;
return Yap_unify(ARG2, Yap_BreakTerm(ARG1, 4, &tf, ARG4 PASS_REGS)) &&
Yap_unify(tf, ARG3);
}
static Int
p_break_rational3( USES_REGS1 )
{
Term tf;
return Yap_unify(ARG2, Yap_BreakTerm(ARG1, 4, &tf, TermNil PASS_REGS)) &&
Yap_unify(tf, ARG3);
}
/* /*
FAST EXPORT ROUTINE. Export a Prolog term to something like: FAST EXPORT ROUTINE. Export a Prolog term to something like:
@ -1602,167 +1583,6 @@ p_kill_exported_term( USES_REGS1 )
static int
expand_vts( int args USES_REGS )
{
UInt expand = LOCAL_Error_Size;
yap_error_number yap_errno = LOCAL_Error_TYPE;
LOCAL_Error_Size = 0;
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (yap_errno == RESOURCE_ERROR_TRAIL) {
/* Trail overflow */
if (!Yap_growtrail(expand, FALSE)) {
return FALSE;
}
} else if (yap_errno == RESOURCE_ERROR_AUXILIARY_STACK) {
/* Aux space overflow */
if (expand > 4*1024*1024)
expand = 4*1024*1024;
if (!Yap_ExpandPreAllocCodeSpace(expand, NULL, TRUE)) {
return FALSE;
}
} else {
if (!Yap_gcl(expand, 3, ENV, gc_P(P,CP))) {
Yap_Error(RESOURCE_ERROR_STACK, TermNil, "in term_variables");
return FALSE;
}
}
return TRUE;
}
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 = HR;
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:
while (to_visit > to_visit0) {
to_visit -= 3;
pt0 = to_visit[0];
*pt0 = (CELL)to_visit[2];
}
LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL;
LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *);
clean_tr(TR0 PASS_REGS);
Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
HR = 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 = RESOURCE_ERROR_AUXILIARY_STACK;
clean_tr(TR0 PASS_REGS);
Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
HR = InitialH;
return 0L;
}
static int static int
SizeOfExtension(Term t) SizeOfExtension(Term t)
{ {
@ -1935,157 +1755,6 @@ Yap_SizeGroundTerm(Term t, int ground)
} }
} }
static Int var_in_complex_term(register CELL *pt0,
register CELL *pt0_end,
Term v USES_REGS)
{
register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace();
register tr_fr_ptr TR0 = TR;
to_visit0 = to_visit;
loop:
while (pt0 < pt0_end) {
register CELL d0;
register CELL *ptd0;
++ pt0;
ptd0 = pt0;
d0 = *ptd0;
deref_head(d0, var_in_term_unk);
var_in_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;
continue;
} 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 = TermNil;
#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;
}
deref_body(d0, ptd0, var_in_term_unk, var_in_term_nvar);
if ((CELL)ptd0 == v) { /* we found it */
#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);
return(TRUE);
}
/* do or pt2 are unbound */
*ptd0 = TermNil;
/* next make sure noone will see this as a variable again */
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;
}
#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);
return FALSE;
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;
}
static Int
var_in_term(Term v, Term t USES_REGS) /* variables in term t */
{
if (IsVarTerm(t)) {
return(v == t);
} else if (IsPrimitiveTerm(t)) {
return(FALSE);
} else if (IsPairTerm(t)) {
return(var_in_complex_term(RepPair(t)-1,
RepPair(t)+1,v PASS_REGS));
}
else return(var_in_complex_term(RepAppl(t),
RepAppl(t)+
ArityOfFunctor(FunctorOfTerm(t)),v PASS_REGS));
}
static Int
p_var_in_term( USES_REGS1 )
{
return(var_in_term(Deref(ARG2), Deref(ARG1) PASS_REGS));
}
/* The code for TermHash was originally contributed by Gertjen Van Noor */ /* The code for TermHash was originally contributed by Gertjen Van Noor */
@ -3351,6 +3020,7 @@ numbervar(Int id USES_REGS)
return Yap_MkApplTerm(FunctorDollarVar, 1, ts); return Yap_MkApplTerm(FunctorDollarVar, 1, ts);
} }
#if 0
static Term static Term
numbervar_singleton(USES_REGS1) numbervar_singleton(USES_REGS1)
{ {
@ -3365,10 +3035,7 @@ renumbervar(Term t, Int id USES_REGS)
Term *ts = RepAppl(t); Term *ts = RepAppl(t);
ts[1] = MkIntegerTerm(id); ts[1] = MkIntegerTerm(id);
} }
#endif
extern int vsc;
int vsc;
static int static int
unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share USES_REGS) unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share USES_REGS)

6
C/write.c
View File

@ -1088,10 +1088,8 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
wglb.stream = mywrite; wglb.stream = mywrite;
wglb.Ignore_ops = flags & Ignore_ops_f; wglb.Ignore_ops = flags & Ignore_ops_f;
wglb.Write_strings = flags & BackQuote_String_f; wglb.Write_strings = flags & BackQuote_String_f;
if (!(flags & Ignore_cyclics_f)) { if (!(flags & Ignore_cyclics_f) && Yap_IsCyclicTerm(t)) {
Term t1 = Yap_CopyTerm(t); writeTerm(Yap_BreakCycles(t, 1, NULL, TermNil PASS_REGS), priority, 1, false, &wglb, &rwt);
t1 = Yap_CheckCycles(t1, 1, NULL, TermNil PASS_REGS);
writeTerm(t1, priority, 1, false, &wglb, &rwt);
} else { } else {
/* protect slots for portray */ /* protect slots for portray */
writeTerm(t, priority, 1, false, &wglb, &rwt); writeTerm(t, priority, 1, false, &wglb, &rwt);

3
H/Yapproto.h
View File

@ -445,7 +445,8 @@ bool Yap_isDirectory(const char *FileName);
extern bool Yap_Exists(const char *f); extern bool Yap_Exists(const char *f);
/* terms.c */ /* terms.c */
extern Term Yap_CheckCycles(Term inp, UInt arity, Term *listp, Term tail USES_REGS); extern bool Yap_IsCyclicTerm(Term inp USES_REGS);
extern Term Yap_BreakCycles(Term inp, UInt arity, Term *listp, Term tail USES_REGS);
extern void Yap_InitTermCPreds(void); extern void Yap_InitTermCPreds(void);
/* threads.c */ /* threads.c */

81
regression/cyclics.yap
View File

@ -1,13 +1,68 @@
:- X = [], copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). %, copy_term(X,Y), writeln('....'), writeln(X), writeln(Y).
:- X = [_A], copy_term(X,Y), writeln('....'), writeln(X), writeln(Y).
:- X = [a,_A], copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). :- initialization(main).
:- X = [X], copy_term(X,Y), writeln('....'), writeln(X), writeln(Y).
:- X = [_|X], copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). main :-
:- X= f(X), copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). main( cyclic_term(X), X).
:- X= f(X,X), copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). main :-
:- X= f(_,X), copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). writeln('-----------------------'),
:- X= f(A,A,X), copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). fail.
:- X= f(A,g(X,[A|A]),X), copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). main :-
:- X= f(X,[X,X]), copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). main( ground(X), X).
:- X= f(X,[X,g(X)]), copy_term(X,Y), writeln('....'), writeln(X), writeln(Y). main :-
:- X=f(_,X/[X]),copy_term(X,Y), writeln('....'),writeln(X),writeln(Y). writeln('-----------------------'),
fail.
main :-
main( writeln(X), X).
main.
main(G, X) :-
d(X),
m(G).
m( G ) :-
G,
!,
writeln(yes),
end.
m( G ) :-
writeln(no),
end.
d(X) :- X = [_A].
d(X) :- X = [a,_A].
d(X) :- X = [X].
d(X) :- X = [_|X].
d(X) :- X = [_,X].
d(X) :- X = [_,x].
d(X) :- X = [_,x(X)].
d(X) :- X= f(X).
d(X) :- X= f(X,X).
d(X) :- X= f(_,X).
d(X) :- X= f(A,A,X).
d(X) :- X= f(A,A,g(A)).
d(X) :- X= f(A,g(X,[A|A]),X).
d(X) :- X= f(X,[X,X]).
d(X) :- X= f(X,[X,g(X)]).
d(X) :- X= f(_,X/[X]).
d(X) :- X= f(_,A/[A]), A= f(X,[X,g(X)]).
end :- writeln('....'), fail.
a(no, no).
a(no, no).
a(yes, yes).
a(yes, no).
a(yes, no).
a( no, no).
a(yes, no).
a(yes, yes).
a(yes, yes).
a(yes, no).
a(yes, no).
a( no, no).
a(yes, no).
a(yes, yes).
a(yes, yes).
a(yes, no).
a(yes, no).