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) { \
goto aux_overflow; \
} \
LIST0; \
ptd0 = RepPair(d0); \
LIST0; \
if (*ptd0 == TermFreeTerm) \
goto restart; \
goto restart; \
to_visit->pt0 = pt0; \
to_visit->pt0_end = pt0_end; \
to_visit->ptd0 = ptd0; \
@ -180,39 +180,38 @@ typedef struct non_single_struct_t {
ap2 = RepAppl(d0); \
f = (Functor)(*ap2); \
\
if (IsExtensionFunctor(f) || IsAtomTerm((CELL)f)) { \
\
goto restart; \
} \
STRUCT0; \
if (to_visit + 32 >= to_visit_max) { \
goto aux_overflow; \
} \
STRUCT0; \
if (IsExtensionFunctor(f) || IsAtomTerm((CELL)f)) { \
\
goto restart; \
} \
to_visit->pt0 = pt0; \
to_visit->pt0_end = pt0_end; \
to_visit->ptd0 = ap2; \
to_visit->d0 = (CELL)f; \
to_visit->d0 = (CELL)f; \
to_visit++; \
\
*ap2 = TermNil; \
d0 = ArityOfFunctor(f); \
pt0 = ap2; \
pt0_end = ap2 + d0; \
goto restart;\
} else { \
PRIMI0; \
goto restart; } \
goto restart; \
} else { \
PRIMI0; \
goto restart; \
} \
} \
derefa_body(d0, ptd0, var_in_term_unk, var_in_term_nvar);
#define WALK_COMPLEX_TERM() WALK_COMPLEX_TERM__({}, {}, {})
#define END_WALK() \
}
#define END_WALK() }
#define def_aux_overflow() \
aux_overflow : { \
#define def_aux_overflow() \
aux_overflow : { \
size_t d1 = to_visit - to_visit0; \
size_t d2 = to_visit_max - to_visit0; \
to_visit0 = \
@ -220,13 +219,12 @@ typedef struct non_single_struct_t {
to_visit = to_visit0 + d1; \
to_visit_max = to_visit0 + (d2 + 128); \
pt0--; \
} \
} \
goto restart;
#define def_trail_overflow() \
trail_overflow : { \
pop_text_stack(lvl); \
pop_text_stack(lvl); \
LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; \
LOCAL_Error_Size = (TR - TR0) * sizeof(tr_fr_ptr *); \
clean_tr(TR0 PASS_REGS); \
@ -249,6 +247,139 @@ typedef struct non_single_struct_t {
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,
Term v USES_REGS) {
@ -279,7 +410,6 @@ static Int var_in_complex_term(register CELL *pt0, register CELL *pt0_end,
return false;
def_aux_overflow();
}
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,
Term inp USES_REGS) {
@ -364,7 +494,6 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
} else {
return (inp);
}
def_trail_overflow();
def_aux_overflow();
@ -372,8 +501,14 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
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;
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();
while (!IsVarTerm(inp) && IsPairTerm(inp)) {
Term t = HeadOfTerm(inp);
if (IsVarTerm(t)) {
CELL *ptr = VarOfTerm(t);
*ptr = TermFoundVar;
TrailTerm(TR++) = t;
if ((tr_fr_ptr)LOCAL_TrailTop-TR < 1024) {
if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true))
{
pop_text_stack(lvl);
goto trail_overflow;
while (!IsVarTerm(inp) && IsPairTerm(inp)) {
Term t = HeadOfTerm(inp);
if (IsVarTerm(t)) {
CELL *ptr = VarOfTerm(t);
*ptr = TermFoundVar;
TrailTerm(TR++) = t;
if ((tr_fr_ptr)LOCAL_TrailTop - TR < 1024) {
if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) {
pop_text_stack(lvl);
goto trail_overflow;
}
}
}
inp = TailOfTerm(inp);
}
inp = TailOfTerm(inp);
pop_text_stack(lvl);
}
pop_text_stack(lvl);
}
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 */
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
/* Trail overflow */
while (to_visit > to_visit0)
{
while (to_visit > to_visit0) {
to_visit--;
CELL *ptd0 = to_visit->ptd0;
*ptd0 = to_visit->d0;
@ -775,7 +908,6 @@ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end,
return TermNil;
}
def_aux_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) {
/* Trail overflow */
if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) {
while (to_visit > to_visit0)
{
while (to_visit > to_visit0) {
to_visit--;
CELL *ptd0 = to_visit->ptd0;
*ptd0 = to_visit->d0;
@ -896,7 +1027,6 @@ static Term bind_vars_in_complex_term(CELL *pt0, CELL *pt0_end,
def_aux_overflow();
def_trail_overflow();
}
static Int
@ -995,7 +1125,6 @@ static Term non_singletons_in_complex_term(CELL *pt0, CELL *pt0_end USES_REGS) {
}
def_aux_overflow();
}
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) {
Term ts[1];
ts[0] = MkIntegerTerm(id);
@ -1101,7 +1168,7 @@ static void renumbervar(Term t, Int id USES_REGS) {
#define RENUMBER_SINGLES \
if (singles && ap2 >= InitialH && ap2 < HR) { \
renumbervar(d0, numbv++ PASS_REGS); \
goto restart; \
goto restart; \
}
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_trail_overflow();
}
Int Yap_NumberVars(Term inp, Int numbv,
@ -1214,7 +1280,7 @@ static Int p_numbervars(USES_REGS1) {
Int i; \
if (IsIntegerTerm(t1) && ((i = IntegerOfTerm(t1)) > *maxp)) \
*maxp = i; \
goto restart; \
goto restart; \
}
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;
def_aux_overflow();
}
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)
*
* 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_.
*
* This built-in predicate is useful if part of a term has been grounded, and
* 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);
}
static Term BREAK_LOOP(int ddep ) {
Term t0 = MkIntegerTerm (ddep);
static Term BREAK_LOOP(int ddep) {
Term t0 = MkIntegerTerm(ddep);
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);
RepAppl(ti)[2] = t;
Term o = RepAppl(ti)[1];
HR[0] = ti;
HR[1] = l;
*b = AbsPair(HR);
b = HR+1;
HR+=2;
b = HR + 1;
HR += 2;
return o;
}
static int loops_in_complex_term(CELL *pt0, CELL *pt0_end, Term *listp, Term tail USES_REGS) {
static int loops_in_complex_term(CELL *pt0, CELL *pt0_end, Term *listp,
Term tail USES_REGS) {
int lvl = push_text_stack();
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_visit_max = to_visit + 1024;
@ -1305,68 +1369,70 @@ restart:
d0 = *ptd0;
list_loop:
deref_head(d0, vars_in_term_unk);
vars_in_term_nvar :
if (IsPairTerm(d0)) {
if (to_visit + 32 >= to_visit_max) {
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);
vars_in_term_nvar:
if (IsPairTerm(d0)) {
if (to_visit + 32 >= to_visit_max) {
goto aux_overflow;
}
CELL *headp = RepPair(d0);
goto restart;
}
to_visit->pt0 = pt0;
to_visit->pt0_end = pt0_end;
to_visit->ptd0 = headp;
to_visit->d0 = d0;
*headp = MkAtomTerm((AtomEntry*)to_visit);
to_visit++;
pt0 = headp;
pt0_end = pt0 + 1;
ptd0 = pt0;
goto list_loop;
} 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 (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));
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);
}
goto restart;
}
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));
}
to_visit->pt0 = pt0;
to_visit->pt0_end = pt0_end;
to_visit->ptd0 = headp;
to_visit->d0 = d0;
*headp = MkAtomTerm((AtomEntry *)to_visit);
to_visit++;
pt0 = headp;
pt0_end = pt0 + 1;
ptd0 = pt0;
goto list_loop;
} 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 (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;
derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar);
goto restart;
@ -1379,7 +1445,7 @@ restart:
pt0_end = to_visit->pt0_end;
CELL *ptd0 = to_visit->ptd0;
if (!IsVarTerm(*ptd0))
*ptd0 = to_visit->d0;
*ptd0 = to_visit->d0;
goto restart;
}
@ -1388,7 +1454,7 @@ restart:
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);
if (IsVarTerm(t) || IsPrimitiveTerm(t)) {
@ -1396,38 +1462,38 @@ Term Yap_CheckCycles(Term inp, UInt arity, Term *listp, Term tail USES_REGS) {
} else {
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)
return -1;
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 Prolog term _TI_. The term _TF_ is the main term. The
difference list _SubTerms_-_MoreSubterms_ stores terms of the
form _V=T_, where _V_ is a new variable occuring in _TF_, and
_T_ is a copy of a sub-term from _TI_.
The term _TF_ is a forest representation (without cycles) for
the Prolog term _TI_. The term _TF_ is the main term. The
difference list _SubTerms_-_MoreSubterms_ stores terms of the
form _V=T_, where _V_ is a new variable occuring in _TF_, and
_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 l = Deref(ARG4), k;
if (IsVarTerm(l)) Yap_unify(l, MkVarTerm());
return Yap_unify(Yap_CheckCycles(t, 4, &k, l PASS_REGS), ARG2) && Yap_unify(k, ARG3);
if (IsVarTerm(l))
Yap_unify(l, MkVarTerm());
return Yap_unify(Yap_BreakCycles(t, 4, &k, l PASS_REGS), ARG2) &&
Yap_unify(k, ARG3);
}
void Yap_InitTermCPreds(void) {
Yap_InitCPred("rational_term_to_tree", 4, p_break_rational, 0);
Yap_InitCPred("term_variables", 2, p_term_variables, 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);
@ -1441,7 +1507,8 @@ void Yap_InitTermCPreds(void) {
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("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 unbound, call the standard copy term routine */
struct cp_frame *bp;
CELL new;
bp = to_visit;
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;
}
to_visit = bp;
new = *ptf;
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
/* Trail overflow */
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:
@ -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
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 */
@ -3351,6 +3020,7 @@ numbervar(Int id USES_REGS)
return Yap_MkApplTerm(FunctorDollarVar, 1, ts);
}
#if 0
static Term
numbervar_singleton(USES_REGS1)
{
@ -3365,10 +3035,7 @@ renumbervar(Term t, Int id USES_REGS)
Term *ts = RepAppl(t);
ts[1] = MkIntegerTerm(id);
}
extern int vsc;
int vsc;
#endif
static int
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.Ignore_ops = flags & Ignore_ops_f;
wglb.Write_strings = flags & BackQuote_String_f;
if (!(flags & Ignore_cyclics_f)) {
Term t1 = Yap_CopyTerm(t);
t1 = Yap_CheckCycles(t1, 1, NULL, TermNil PASS_REGS);
writeTerm(t1, priority, 1, false, &wglb, &rwt);
if (!(flags & Ignore_cyclics_f) && Yap_IsCyclicTerm(t)) {
writeTerm(Yap_BreakCycles(t, 1, NULL, TermNil PASS_REGS), priority, 1, false, &wglb, &rwt);
} else {
/* protect slots for portray */
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);
/* 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);
/* threads.c */

81
regression/cyclics.yap
View File

@ -1,13 +1,68 @@
:- X = [], 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).
:- X = [X], copy_term(X,Y), writeln('....'), writeln(X), writeln(Y).
:- X = [_|X], copy_term(X,Y), writeln('....'), writeln(X), writeln(Y).
:- X= f(X), copy_term(X,Y), writeln('....'), writeln(X), writeln(Y).
:- X= f(X,X), copy_term(X,Y), writeln('....'), writeln(X), writeln(Y).
:- X= f(_,X), copy_term(X,Y), writeln('....'), writeln(X), writeln(Y).
:- X= f(A,A,X), copy_term(X,Y), writeln('....'), writeln(X), writeln(Y).
:- X= f(A,g(X,[A|A]),X), copy_term(X,Y), writeln('....'), writeln(X), writeln(Y).
:- X= f(X,[X,X]), copy_term(X,Y), writeln('....'), writeln(X), writeln(Y).
:- X= f(X,[X,g(X)]), copy_term(X,Y), writeln('....'), writeln(X), writeln(Y).
:- X=f(_,X/[X]),copy_term(X,Y), writeln('....'),writeln(X),writeln(Y).
%, copy_term(X,Y), writeln('....'), writeln(X), writeln(Y).
:- initialization(main).
main :-
main( cyclic_term(X), X).
main :-
writeln('-----------------------'),
fail.
main :-
main( ground(X), X).
main :-
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).