diff --git a/C/terms.c b/C/terms.c index 2dc49e363..6c55cb21f 100644 --- a/C/terms.c +++ b/C/terms.c @@ -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); diff --git a/C/utilpreds.c b/C/utilpreds.c index 85a763466..6da178022 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -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) diff --git a/C/write.c b/C/write.c index 82583dc9e..3da73070b 100644 --- a/C/write.c +++ b/C/write.c @@ -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); diff --git a/H/Yapproto.h b/H/Yapproto.h index 72fee8930..43293b0d2 100755 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -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 */ diff --git a/regression/cyclics.yap b/regression/cyclics.yap index cc04e8eb2..800d66d4c 100644 --- a/regression/cyclics.yap +++ b/regression/cyclics.yap @@ -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). \ No newline at end of file +%, 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).