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

283
C/terms.c
View File

@ -158,8 +158,8 @@ 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; \
@ -180,14 +180,14 @@ typedef struct non_single_struct_t {
ap2 = RepAppl(d0); \ ap2 = RepAppl(d0); \
f = (Functor)(*ap2); \ f = (Functor)(*ap2); \
\ \
if (to_visit + 32 >= to_visit_max) { \
goto aux_overflow; \
} \
STRUCT0; \
if (IsExtensionFunctor(f) || IsAtomTerm((CELL)f)) { \ if (IsExtensionFunctor(f) || IsAtomTerm((CELL)f)) { \
\ \
goto restart; \ goto restart; \
} \ } \
STRUCT0; \
if (to_visit + 32 >= to_visit_max) { \
goto aux_overflow; \
} \
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; \
@ -201,15 +201,14 @@ typedef struct non_single_struct_t {
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 : { \
@ -223,7 +222,6 @@ typedef struct non_single_struct_t {
} \ } \
goto restart; goto restart;
#define def_trail_overflow() \ #define def_trail_overflow() \
trail_overflow : { \ trail_overflow : { \
pop_text_stack(lvl); \ pop_text_stack(lvl); \
@ -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;
@ -624,8 +759,7 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
*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;
} }
@ -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);
@ -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,
@ -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) {
@ -1263,8 +1328,7 @@ static Int MaxNumberedVar(Term inp, UInt arity PASS_REGS) {
* 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);
} }
@ -1285,8 +1349,8 @@ static Term UNFOLD_LOOP( Term t, Term *b, Term l) {
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(
@ -1313,11 +1377,11 @@ restart:
CELL *headp = RepPair(d0); CELL *headp = RepPair(d0);
d0 = headp[0]; d0 = headp[0];
if (IsAtomTerm(d0) && if (IsAtomTerm(d0) && (CELL *)AtomOfTerm(d0) >= (CELL *)to_visit0 &&
(CELL *)AtomOfTerm(d0) >= (CELL *)to_visit0 &&
(CELL *)AtomOfTerm(d0) < (CELL *)to_visit_max) { (CELL *)AtomOfTerm(d0) < (CELL *)to_visit_max) {
// LIST0; // LIST0;
struct non_single_struct_t *v0 = (struct non_single_struct_t *)AtomOfTerm(d0); struct non_single_struct_t *v0 =
(struct non_single_struct_t *)AtomOfTerm(d0);
if (listp) { if (listp) {
*ptd0 = UNFOLD_LOOP(AbsPair(headp), listp, tail); *ptd0 = UNFOLD_LOOP(AbsPair(headp), listp, tail);
} else { } else {
@ -1342,15 +1406,18 @@ restart:
/* store the terms to visit */ /* store the terms to visit */
ap2 = RepAppl(d0); ap2 = RepAppl(d0);
f = (Functor)(*ap2); f = (Functor)(*ap2);
if (IsExtensionFunctor(f)) continue; if (IsExtensionFunctor(f))
continue;
if (IsAtomTerm((CELL)f)) { if (IsAtomTerm((CELL)f)) {
if (listp) { if (listp) {
*ptd0 = UNFOLD_LOOP(AbsAppl(ap2), listp, tail); *ptd0 = UNFOLD_LOOP(AbsAppl(ap2), listp, tail);
} else { } else {
*ptd0 = BREAK_LOOP(to_visit-(struct non_single_struct_t *)AtomOfTerm(*ap2)); *ptd0 = BREAK_LOOP(to_visit -
(struct non_single_struct_t *)AtomOfTerm(*ap2));
}
goto restart;
} }
goto restart; }
// STRUCT0; // STRUCT0;
if (to_visit + 32 >= to_visit_max) { if (to_visit + 32 >= to_visit_max) {
goto aux_overflow; goto aux_overflow;
@ -1366,7 +1433,6 @@ restart:
} }
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;
@ -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)) {
@ -1403,7 +1469,6 @@ Term Yap_CheckCycles(Term inp, UInt arity, Term *listp, Term tail USES_REGS) {
} }
} }
/** @pred rational_term_to_tree(? _TI_,- _TF_, ?SubTerms, ?MoreSubterms) /** @pred rational_term_to_tree(? _TI_,- _TF_, ?SubTerms, ?MoreSubterms)
@ -1415,19 +1480,20 @@ Term Yap_CheckCycles(Term inp, UInt arity, Term *listp, Term tail USES_REGS) {
*/ */
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).