/************************************************************************* * * * YAP Prolog * * * * Yap Prolog was developed at NCCUP - Universidade do Porto * * * * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * * * ************************************************************************** * * * File: utilpreds.c * Last rev: 4/03/88 ** mods: * comments: new utility predicates for YAP * * * *************************************************************************/ /** * @file C/terms.c * * @brief applications of the tree walker pattern. * * @addtogroup Terms * * @{ * */ #include "absmi.h" #include "YapHeap.h" #define debug_pop_text_stack(l) [ if (to_visit != to_visit0) printf("%d\n",__LINE__); pop_text_stack(l) \ } #include "attvar.h" #include "yapio.h" #ifdef HAVE_STRING_H #include "string.h" #endif #define Malloc malloc #define Realloc realloc extern int cs[10]; int cs[10]; static inline void clean_tr(tr_fr_ptr TR0 USES_REGS) { tr_fr_ptr pt0 = TR; while (pt0 != TR0) { Term p = TrailTerm(--pt0); if (IsApplTerm(p)) { CELL *pt = RepAppl(p); #ifdef FROZEN_STACKS pt[0] = TrailVal(pt0); #else pt[0] = TrailTerm(pt0 - 1); pt0--; #endif /* FROZEN_STACKS */ } else { RESET_VARIABLE(p); } } TR = TR0; } //#define CELL *pt0, *pt0_end, *ptf; //} non_singletons_t; #define IS_VISIT_MARKER \ (IsAtomTerm(d0) && AtomOfTerm(d0) >= (Atom)to_visit0 && \ AtomOfTerm(d0) <= (Atom)to_visit) #define VISIT_MARKER MkAtomTerm((Atom)to_visit) typedef struct { Term old_var; Term new_var; } * vcell; typedef struct non_single_struct_t { CELL *ptd0; CELL d0; CELL *pt0, *pt0_end, *ptf; } non_singletons_t; #define WALK_COMPLEX_TERM__(LIST0, STRUCT0, PRIMI0) \ \ int lvl = push_text_stack();\ CELL *pt0, *pt0_end; \ size_t auxsz = 1024 * sizeof(struct non_single_struct_t);\ struct non_single_struct_t *to_visit0=NULL, *to_visit,* to_visit_max;\ CELL *InitialH = HR;\ tr_fr_ptr TR0 = TR;\ reset:\ to_visit0 = Realloc(to_visit0,auxsz); \ pt0 = pt0_; pt0_end = pt0_end_; \ to_visit = to_visit0, \ to_visit_max = to_visit + auxsz/sizeof(struct non_single_struct_t);\ \ while (to_visit >= to_visit0) { \ CELL d0; \ CELL *ptd0; \ restart: \ while (pt0 < pt0_end) { \ ++pt0; \ ptd0 = pt0; \ d0 = *ptd0; \ list_loop: \ /*fprintf(stderr, "%ld at %s\n", to_visit - to_visit0, __FUNCTION__);*/ \ deref_head(d0, var_in_term_unk); \ var_in_term_nvar : { \ if (IsPairTerm(d0)) { \ if (to_visit + 32 >= to_visit_max) { \ goto aux_overflow; \ } \ ptd0 = RepPair(d0); \ d0 = ptd0[0]; \ LIST0; \ if (IS_VISIT_MARKER) \ goto restart; \ to_visit->pt0 = pt0; \ to_visit->pt0_end = pt0_end; \ to_visit->ptd0 = ptd0; \ to_visit->d0 = d0; \ to_visit++; \ *ptd0 = VISIT_MARKER; \ pt0 = ptd0; \ pt0_end = pt0 + 1; \ goto list_loop; \ } else if (IsApplTerm(d0)) { \ register Functor f; \ /* store the terms to visit */ \ ptd0 = RepAppl(d0); \ f = (Functor)(d0 = *ptd0); \ if (IsExtensionFunctor(f)) {\ continue;\ }\ \ if (to_visit + 32 >= to_visit_max) { \ goto aux_overflow; \ } \ STRUCT0; \ if (IS_VISIT_MARKER) { \ \ continue; \ } \ to_visit->pt0 = pt0; \ to_visit->pt0_end = pt0_end; \ to_visit->ptd0 = ptd0; \ to_visit->d0 = d0; \ to_visit++; \ \ *ptd0 = VISIT_MARKER; \ Term d1 = ArityOfFunctor(f); \ pt0 = ptd0; \ pt0_end = ptd0 + d1; \ continue; \ } else { \ if (IS_VISIT_MARKER) { \ \ continue; \ } \ PRIMI0; \ continue; \ } \ derefa_body(d0, ptd0, var_in_term_unk, var_in_term_nvar) #define WALK_COMPLEX_TERM() WALK_COMPLEX_TERM__({}, {}, {}) #define END_WALK() \ } \ } \ /* Do we still have compound terms to visit */ \ to_visit--; \ if (to_visit >= to_visit0) { \ pt0 = to_visit->pt0; \ pt0_end = to_visit->pt0_end; \ *to_visit->ptd0 = to_visit->d0; \ } \ } \ pop_text_stack(lvl); #define def_aux_overflow() \ aux_overflow : { \ while (to_visit > to_visit0) { \ to_visit--; \ CELL *ptd0 = to_visit->ptd0; \ *ptd0 = to_visit->d0; \ } \ clean_tr(TR0 PASS_REGS); \ auxsz += auxsz;\ goto reset; } #define def_trail_overflow() \ trail_overflow : { \ while (to_visit > to_visit0) { \ to_visit--; \ CELL *ptd0 = to_visit->ptd0; \ *ptd0 = to_visit->d0; \ } \ size_t expand = (TR - TR0) * sizeof(tr_fr_ptr *); \ clean_tr(TR0 PASS_REGS); \ HR = InitialH; \ pop_text_stack(lvl); \ /* Trail overflow */ \ if (!Yap_growtrail(expand, false)) { \ Yap_ThrowError(RESOURCE_ERROR_TRAIL, TermNil, expand);\ } \ goto reset;\ } #define def_global_overflow() \ global_overflow : { \ while (to_visit > to_visit0) { \ to_visit--; \ CELL *ptd0 = to_visit->ptd0; \ *ptd0 = to_visit->d0; \ } \ clean_tr(TR0 PASS_REGS); \ HR = InitialH; \ LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; \ size_t expand = 0L; \ if (!Yap_gcl(expand, 3, ENV, gc_P(P, CP))) { \ Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, sizeof(CELL)*(HR-H0)); \ return false;\ }\ goto reset;\ } #define CYC_LIST \ if (IS_VISIT_MARKER) { \ while (to_visit > to_visit0) { \ to_visit--; \ to_visit->ptd0[0] = to_visit->d0; \ } \ pop_text_stack(lvl); \ return true; \ } #define CYC_APPL \ if (IS_VISIT_MARKER) { \ while (to_visit > to_visit0) { \ to_visit--; \ to_visit->ptd0[0] = 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(CELL *pt0_, CELL *pt0_end_ USES_REGS) { WALK_COMPLEX_TERM__(CYC_LIST, CYC_APPL, {}); /* leave an empty slot to fill in later */ END_WALK(); return false; def_aux_overflow(); } bool Yap_IsCyclicTerm(Term t USES_REGS) { cs[2]++; 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)); } static Term BREAK_LOOP(CELL d0,struct non_single_struct_t *to_visit ) { char buf[64]; snprintf(buf, 63, "@^[" Int_FORMAT "]", to_visit-(struct non_single_struct_t*)AtomOfTerm(d0)); return MkAtomTerm(Yap_LookupAtom(buf)); } /** @brief routine to locate all variables in a term, and its applications */ static int cycles_in_complex_term( CELL *pt0_, CELL *pt0_end_ USES_REGS) { CELL *pt0, *pt0_end; int lvl = push_text_stack(); size_t auxsz = 1024 * sizeof(struct non_single_struct_t); struct non_single_struct_t *to_visit0=NULL, *to_visit, *to_visit_max; CELL *InitialH = HR; tr_fr_ptr TR0 = TR; reset: pt0 = pt0_, pt0_end = pt0_end_; to_visit0 = Realloc(to_visit0,auxsz); to_visit= to_visit0; to_visit_max = to_visit0 + auxsz/sizeof(struct non_single_struct_t); auxsz *= 2; int rc = 0; CELL *ptf; ptf = HR; HR++; while (to_visit >= to_visit0) { CELL d0; CELL *ptd0; while (pt0 < pt0_end) { ++pt0; ptd0 = pt0; d0 = *ptd0; list_loop: deref_head(d0, var_in_term_unk); var_in_term_nvar : { if (IsPairTerm(d0)) { if (to_visit + 32 >= to_visit_max) { goto aux_overflow; } ptd0 = RepPair(d0); d0 = ptd0[0]; if (IS_VISIT_MARKER) { rc++; *ptf++ = BREAK_LOOP(d0, to_visit); continue; } *ptf++ = AbsPair(HR); to_visit->pt0 = pt0; to_visit->pt0_end = pt0_end; to_visit->ptd0 = ptd0; to_visit->d0 = d0; to_visit->ptf = ptf; to_visit++; ptf = HR; HR += 2; *ptd0 = VISIT_MARKER; pt0 = ptd0; pt0_end = pt0+1; ptf = HR - 2; goto list_loop; } else if (IsApplTerm(d0)) { register Functor f; /* store the terms to visit */ ptd0 = RepAppl(d0); f = (Functor)(d0 = *ptd0); if (IsExtensionFunctor(f)) { *ptf++ = AbsAppl(ptd0); continue; } if (IS_VISIT_MARKER) { rc++; *ptf++ = BREAK_LOOP(d0, to_visit); continue; } if (to_visit + 32 >= to_visit_max) { goto aux_overflow; } *ptf++ = AbsAppl(HR); to_visit->pt0 = pt0; to_visit->pt0_end = pt0_end; to_visit->ptd0 = ptd0; to_visit->d0 = d0; to_visit->ptf = ptf; to_visit++; *ptd0 = VISIT_MARKER; *HR++ = (CELL)f; ptf = HR; Term d1 = ArityOfFunctor(f); pt0 = ptd0; pt0_end = ptd0 + (d1); HR+=d1; continue; } else { if (IS_VISIT_MARKER) { rc++; *ptf++ = BREAK_LOOP(d0, to_visit); continue; } *ptf++ = d0; continue; } derefa_body(d0, ptd0, var_in_term_unk, var_in_term_nvar); *ptf++ = d0; } } /* Do we still have compound terms to visit */ to_visit--; if (to_visit >= to_visit0) { pt0 = to_visit->pt0; pt0_end = to_visit->pt0_end; ptf = to_visit->ptf; *to_visit->ptd0 = to_visit->d0; } } pop_text_stack(lvl); return rc; def_aux_overflow(); } Term Yap_CyclesInTerm(Term t USES_REGS) { cs[3]++; t = Deref(t); if (IsVarTerm(t)) { return t; } else if (IsPrimitiveTerm(t)) { return t; } else { CELL *Hi = HR; if ( cycles_in_complex_term(&(t)-1, &(t)PASS_REGS) >0) { return Hi[0]; } else { HR = Hi; return t; } } } /** @pred cycles_in_term( + _T_ ) Succeeds if the graph representation of the term has markers in every loop. 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 cycles_in_term(USES_REGS1) /* cyclic_term(+T) */ { return Yap_CyclesInTerm(Deref(ARG1)); } /** @brief routine to locate all variables in a term, and its applications */ static bool ground_complex_term(CELL * pt0_, 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 */ 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(CELL *pt0_, CELL *pt0_end_ , Term v USES_REGS) { WALK_COMPLEX_TERM(); if ((CELL)ptd0 == v) { /* we found it */ /* Do we still have compound terms to visit */ while (to_visit > to_visit0) { to_visit--; CELL *ptd0 = to_visit->ptd0; *ptd0 = to_visit->d0; } pop_text_stack(lvl); return true; } goto restart; END_WALK(); if (to_visit > to_visit0) { to_visit--; CELL *ptd0 = to_visit->ptd0; *ptd0 = to_visit->d0; pt0 = to_visit->pt0; pt0_end = to_visit->pt0_end; } pop_text_stack(lvl); return false; def_aux_overflow(); } static Int var_in_term( Term v, Term t USES_REGS) /* variables in term t */ { must_be_variable(v); t = Deref(t); if (IsVarTerm(t)) { return (v == t); } else if (IsPrimitiveTerm(t)) { return (false); } return (var_in_complex_term(&(t)-1, &(t), v PASS_REGS)); } /** @pred variable_in_term(? _Term_,? _Var_) Succeed if the second argument _Var_ is a variable and occurs in term _Term_. */ static Int variable_in_term(USES_REGS1) { return var_in_term(Deref(ARG2), Deref(ARG1) PASS_REGS); } /** * @brief routine to locate all variables in a term, and its applications. */ static Term vars_in_complex_term(CELL *pt0_, CELL *pt0_end_ , Term inp USES_REGS) { Int count=0; while (!IsVarTerm(inp) && IsPairTerm(inp)) { Term t = HeadOfTerm(inp); if (IsVarTerm(t)) { CELL *ptr = VarOfTerm(t); *ptr = TermFoundVar; TrailTerm(TR++) = t; count++; if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { clean_tr(TR - count PASS_REGS); if (!Yap_growtrail(count * sizeof(tr_fr_ptr *), false)) { return false; } } } inp = TailOfTerm(inp); } CELL output = AbsPair(HR); WALK_COMPLEX_TERM(); /* do or pt2 are unbound */ if (HR + 1024 > ASP) { goto global_overflow; } HR[1] = AbsPair(HR + 2); HR += 2; HR[-2] = (CELL)ptd0; /* next make sure noone will see this as a variable again */ if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { /* Trail overflow */ goto trail_overflow; } TrailTerm(TR++) = (CELL)ptd0; *ptd0 = TermFoundVar; END_WALK(); clean_tr(TR0-count PASS_REGS); pop_text_stack(lvl); if (HR != InitialH) { /* close the list */ Term t2 = Deref(inp); if (IsVarTerm(t2)) { RESET_VARIABLE(HR - 1); Yap_unify((CELL)(HR - 1), t2); } else { HR[-1] = t2; /* don't need to trail */ } return (output); } else { return (inp); } def_trail_overflow(); def_aux_overflow(); def_global_overflow(); } /** * @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; inp = Deref(ARG2); Term t = Deref(ARG1); out = vars_in_complex_term(&(t)-1, &(t), inp PASS_REGS); return Yap_unify(ARG3, out); } /** @pred term_variables(? _Term_, - _Variables_, +_ExternalVars_) is iso Unify the difference list between _Variables_ and _ExternaVars_ with the list of all variables of term _Term_. The variables occur in the order of their first appearance when traversing the term depth-first, left-to-right. */ static Int term_variables3( USES_REGS1) /* variables in term t */ { Term out; cs[0]++; Term t = Deref(ARG1); if (IsVarTerm(t)) { Term out = Yap_MkNewPairTerm(); return Yap_unify(t, HeadOfTerm(out)) && Yap_unify(ARG3, TailOfTerm(out)) && Yap_unify(out, ARG2); } else if (IsPrimitiveTerm(t)) { return Yap_unify(ARG2, ARG3); } else { out = vars_in_complex_term(&(t)-1, &(t), ARG3 PASS_REGS); } return Yap_unify(ARG2, out); } /** * Exports a nil-terminated list with all the variables in a term. * @param[t] the term * @param[arity] the arity of the calling predicate (required for exact * garbage collection). * @param[USES_REGS] threading */ Term Yap_TermVariables( Term t, UInt arity USES_REGS) /* variables in term t */ { Term out; t = Deref(t); if (IsVarTerm(t)) { return MkPairTerm(t, TermNil); } else if (IsPrimitiveTerm(t)) { return TermNil; } else { out = vars_in_complex_term(&(t)-1, &(t), TermNil PASS_REGS); } return out; } static Term Yap_TermAddVariables( Term t, Term vs USES_REGS) /* variables in term t */ { Term out; t = Deref(t); if (IsVarTerm(t)) { return MkPairTerm(t, TermNil); } else if (IsPrimitiveTerm(t)) { return TermNil; } else { out = vars_in_complex_term(&(t)-1, &(t), vs PASS_REGS); } return out; } /** @pred term_variables(? _Term_, - _Variables_) is iso Unify _Variables_ with the list of all variables of term _Term_. The variables occur in the order of their first appearance when traversing the term depth-first, left-to-right. */ static Int term_variables( USES_REGS1) /* variables in term t */ { Term out; if (!Yap_IsListOrPartialListTerm(ARG2)) { Yap_ThrowError(TYPE_ERROR_LIST, ARG2, "term_variables/2"); return false; } Term t = Deref(ARG1); out = vars_in_complex_term(&(t)-1, &(t), TermNil PASS_REGS); return Yap_unify(ARG2, out); } /** routine to locate attributed variables */ typedef struct att_rec { CELL *beg, *end; CELL oval; } att_rec_t; static Term attvars_in_complex_term( CELL *pt0_, CELL *pt0_end_ , Term inp USES_REGS) { CELL output = inp; WALK_COMPLEX_TERM(); if (IsAttVar(ptd0)) { /* do or pt2 are unbound */ attvar_record *a0 = RepAttVar(ptd0); d0 = *ptd0; /* leave an empty slot to fill in later */ if (HR + 1024 > ASP) { goto global_overflow; } output = MkPairTerm((CELL) & (a0->Done), output); /* store the terms to visit */ if (to_visit + 32 >= to_visit_max) { goto aux_overflow; } TrailTerm(TR++) = a0->Done; a0->Done=TermNil; if ((tr_fr_ptr)LOCAL_TrailTop - TR < 1024) { if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { goto trail_overflow; } pop_text_stack(lvl); } pt0_end = &a0->Atts; pt0 = pt0_end - 1; } END_WALK(); clean_tr(TR0 PASS_REGS); pop_text_stack(lvl); /*fprintf(stderr,"<%ld at %s\n", d0, __FUNCTION__)*/; return output; def_aux_overflow(); def_global_overflow(); def_trail_overflow(); } /** @pred term_attvars(+ _Term_,- _AttVars_) _AttVars_ is a list of all attributed variables in _Term_ and its attributes. I.e., term_attvars/2 works recursively through attributes. This predicate is Cycle-safe. */ static Int term_attvars(USES_REGS1) /* variables in term t */ { Term out; Term t = Deref(ARG1); if (IsPrimitiveTerm(t)) { return Yap_unify(TermNil, ARG2); } else { out = attvars_in_complex_term(&(t)-1, &(t), TermNil PASS_REGS); } return Yap_unify(ARG2, out); } /** @brief output the difference between variables in _T_ and variables in * some list. */ static Term new_vars_in_complex_term( CELL *pt0_, CELL *pt0_end_ , Term inp USES_REGS) { Int n=0; CELL output = TermNil; { tr_fr_ptr myTR0 = TR; int lvl = push_text_stack(); while (!IsVarTerm(inp) && IsPairTerm(inp)) { Term t = HeadOfTerm(inp); if (IsVarTerm(t)) { n++; TrailTerm(TR++) = t; *VarOfTerm(t) = TermFoundVar; if ((tr_fr_ptr)LOCAL_TrailTop - TR < 1024) { if (!Yap_growtrail(n * sizeof(tr_fr_ptr *), true)) { goto trail_overflow; } } } inp = TailOfTerm(inp); } pop_text_stack(lvl); } WALK_COMPLEX_TERM(); output = MkPairTerm((CELL)ptd0, output); TrailTerm(TR++) = *ptd0; *ptd0 = TermFoundVar; if ((tr_fr_ptr)LOCAL_TrailTop - TR < 1024) { goto trail_overflow; } /* leave an empty slot to fill in later */ if (HR + 1024 > ASP) { goto global_overflow; } END_WALK(); clean_tr(TR0-n PASS_REGS); pop_text_stack(lvl); return output; def_aux_overflow(); def_trail_overflow(); def_global_overflow(); } /** @pred new_variables_in_term(+_CurrentVariables_, ? _Term_, -_Variables_) Unify _Variables_ with the list of all variables of term _Term_ that do not occur in _CurrentVariables_. The variables occur in the order of their first appearance when traversing the term depth-first, left-to-right. */ static Int p_new_variables_in_term( USES_REGS1) /* variables within term t */ { Term out; Term t = Deref(ARG2); if (IsPrimitiveTerm(t)) out = TermNil; else { out = new_vars_in_complex_term(&(t)-1, &(t), Deref(ARG1) PASS_REGS); } return Yap_unify(ARG3, out); } #define FOUND_VAR() \ if (d0 == TermFoundVar) { \ /* leave an empty slot to fill in later */ \ if (HR + 1024 > ASP) { \ goto global_overflow; \ } \ HR[1] = AbsPair(HR + 2); \ HR += 2; \ HR[-2] = (CELL)ptd0; \ *ptd0 = TermNil; \ } static Term vars_within_complex_term( CELL *pt0_, CELL *pt0_end_, Term inp USES_REGS) { Int n=0; CELL output = AbsPair(HR); while (!IsVarTerm(inp) && IsPairTerm(inp)) { tr_fr_ptr myTR0; Term t = HeadOfTerm(inp); if (IsVarTerm(t)) { CELL *ptr = VarOfTerm(t); *ptr = TermFoundVar; n++; TrailTerm(TR++) = t; if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { Yap_growtrail(2*n * sizeof(tr_fr_ptr *), true); } } inp = TailOfTerm(inp); } WALK_COMPLEX_TERM__({}, {}, FOUND_VAR()); goto restart; END_WALK(); clean_tr(TR0-n PASS_REGS); pop_text_stack(lvl); if (HR != InitialH) { HR[-1] = TermNil; return output; } else { return TermNil; } def_aux_overflow(); def_global_overflow(); } /** @pred variables_within_term(+_CurrentVariables_, ? _Term_, -_Variables_) Unify _Variables_ with the list of all variables of term _Term_ that *also* occur in _CurrentVariables_. The variables occur in the order of their first appearance when traversing the term depth-first, left-to-right. This predicate performs the opposite of new_variables_in_term/3. */ static Int p_variables_within_term(USES_REGS1) /* variables within term t */ { Term out; Term t = Deref(ARG2); if (IsPrimitiveTerm(t)) out = TermNil; else { out = vars_within_complex_term(&(t)-1, &(t), Deref(ARG1) PASS_REGS); } return Yap_unify(ARG3, out); } /* variables within term t */ static Int free_variables_in_term( USES_REGS1) { Term out; Term t, t0; Term found_module = 0L; Term bounds = TermNil; t = t0 = Deref(ARG1); Int delta = 0; while (!IsVarTerm(t) && IsApplTerm(t)) { Functor f = FunctorOfTerm(t); if (f == FunctorHat) { bounds = MkPairTerm(ArgOfTerm(1,t),bounds); } else if (f == FunctorModule) { found_module = ArgOfTerm(1, t); } else if (f == FunctorCall) { t = ArgOfTerm(1, t); } else if (f == FunctorExecuteInMod) { found_module = ArgOfTerm(2, t); t = ArgOfTerm(1, t); } else { break; } t = ArgOfTerm(2, t); } if (IsPrimitiveTerm(t)) out = TermNil; else { out = new_vars_in_complex_term(&(t)-1, &(t), Yap_TermVariables(bounds, 3) PASS_REGS); } if (found_module && t != t0) { Term ts[2]; ts[0] = found_module; ts[1] = t; t = Yap_MkApplTerm(FunctorModule, 2, ts); } return Yap_unify(ARG2, t) && Yap_unify(ARG3, out); } #define FOUND_VAR_AGAIN() \ if (d0 == TermFoundVar) \ { \ HR[0] = (CELL)ptd0; \ HR[1] = AbsPair(HR + 2); \ HR += 2; \ *ptd0 = TermRefoundVar; \ } static Term non_singletons_in_complex_term(CELL * pt0_, CELL * pt0_end_ USES_REGS) { WALK_COMPLEX_TERM__({}, {}, FOUND_VAR_AGAIN()); /* 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) { goto trail_overflow; } TrailTerm(TR++) = (CELL)ptd0; END_WALK(); clean_tr(TR0 PASS_REGS); pop_text_stack(lvl); if (HR != InitialH) { /* close the list */ HR[-1] = Deref(ARG2); return AbsPair(InitialH); } else { return ARG2; } def_aux_overflow(); def_trail_overflow(); } static Int p_non_singletons_in_term( USES_REGS1) /* non_singletons in term t */ { Term t; Term out; t = Deref(ARG1); if (IsVarTerm(t)) { out = ARG2; } else if (IsPrimitiveTerm(t)) { out = ARG2; } else { out = non_singletons_in_complex_term(&(t)-1, &(t)PASS_REGS); } return Yap_unify(ARG3,out); } static Term numbervar(Int me USES_REGS) { Term ts[1]; ts[0] = MkIntegerTerm(me); return Yap_MkApplTerm(FunctorDollarVar, 1, ts); } static Term numbervar_singleton(USES_REGS1) { Term ts[1]; ts[0] = MkIntegerTerm(-1); return Yap_MkApplTerm(FunctorDollarVar, 1, ts); } static void renumbervar(Term t, Int me USES_REGS) { Term *ts = RepAppl(t); ts[1] = MkIntegerTerm(me); } #define RENUMBER_SINGLES \ if (singles) { \ renumbervar(d0, numbv++ PASS_REGS); \ goto restart; \ } static Int numbervars_in_complex_term(CELL * pt0_, CELL * pt0_end_, Int numbv, int singles USES_REGS) { WALK_COMPLEX_TERM__({}, {}, {}); if (IsAttVar(pt0)) continue; /* do or pt2 are unbound */ if (singles) d0 = numbervar_singleton(PASS_REGS1); else d0 = numbervar(numbv++ PASS_REGS); /* leave an empty slot to fill in later */ if (HR + 1024 > ASP) { goto global_overflow; } /* next make sure noone will see this as a variable again */ YapBind(ptd0, d0); END_WALK(); pop_text_stack(lvl); return numbv; def_aux_overflow(); def_global_overflow(); } Int Yap_NumberVars(Term inp, Int numbv, bool handle_singles) /* * numbervariables in term t */ { CACHE_REGS Int out; Term t; t = Deref(inp); if (IsPrimitiveTerm(t)) { return numbv; } else { out = numbervars_in_complex_term(&(t)-1, &(t), numbv, handle_singles PASS_REGS); } return out; } /** @pred numbervars( _T_,+ _N1_,- _Nn_) Instantiates each variable in term _T_ to a term of the form: `$VAR( _I_)`, with _I_ increasing from _N1_ to _Nn_. */ static Int p_numbervars(USES_REGS1) { Term t2 = Deref(ARG2); Int out; if (IsVarTerm(t2)) { Yap_Error(INSTANTIATION_ERROR, t2, "numbervars/3"); return false; } if (!IsIntegerTerm(t2)) { Yap_Error(TYPE_ERROR_INTEGER, t2, "numbervars/3"); return (false); } if ((out = Yap_NumberVars(ARG1, IntegerOfTerm(t2), false)) < 0) return false; return Yap_unify(ARG3, MkIntegerTerm(out)); } #define MAX_NUMBERED \ if (FunctorOfTerm(d0) == FunctorDollarVar) { \ Term t1 = ArgOfTerm(1, d0); \ Int i; \ if (IsIntegerTerm(t1) && ((i = IntegerOfTerm(t1)) > *maxp)) \ *maxp = i; \ goto restart; \ } static int max_numbered_var(CELL * pt0_, CELL * pt0_end_, Int * maxp USES_REGS) { WALK_COMPLEX_TERM__({}, MAX_NUMBERED, {}); 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; } prune(B PASS_REGS); pop_text_stack(lvl); return 0; def_aux_overflow(); } static Int MaxNumberedVar(Term inp, UInt arity PASS_REGS) { Term t = Deref(inp); if (IsPrimitiveTerm(t)) { return MkIntegerTerm(0); } else { Int res; Int max; res = max_numbered_var(&t - 1, &t, &max PASS_REGS) - 1; if (res < 0) return -1; return MkIntegerTerm(max); } } /** * @pred largest_numbervar( +_Term_, -Max) * * 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) { return Yap_unify(MaxNumberedVar(Deref(ARG1), 2 PASS_REGS), ARG2); } static Term UNFOLD_LOOP(Term t, Term * b) { Term os[2], o; os[0] = o = MkVarTerm(); os[1] = t; Term ti = Yap_MkApplTerm(FunctorEq, 2, os), t0 = *b; *b = MkPairTerm(ti, t0); return o; } typedef struct block_connector { CELL * parent; //> index in the array; Term source; //> source; CELL *copy; //> copy; CELL header; //> backup of first word of the source data; CELL reference; //> term used to refer the copy. } cl_connector; static Int t_ref(cl_connector *d, cl_connector * q, Int *mep, Int max) { if ( d >= q && d < q+max) { *mep = d-q; return true; } return false; //&& d->source == (void *; } static Int create_entry(Term t, Int i, Int j, cl_connector * q, Int max) { Term ref, h, *s, *ostart; ssize_t n; // fprintf(stderr,"[%ld,%ld]/%ld, %lx\n",i,j,max,t); restart: // first time, create a new term if (IsVarTerm(t)) { return -1; } if (IsPairTerm(t)) { Int me; s = RepPair(t); h = s[0]; if (IsAtomTerm(h) && t_ref((cl_connector *)AtomOfTerm(h), q, &me, max)) { return me; } n = 2; ostart = HR; ref = AbsPair(ostart); HR += 2; } else if (IsApplTerm(t)) { Int me; h = (CELL)FunctorOfTerm(t); if (IsExtensionFunctor((Functor)h)) { return -1; } if (IsAtomTerm(h) && t_ref((cl_connector*)AtomOfTerm(h),q,&me,max)) { return me; } n = ArityOfFunctor((Functor)h); s = RepAppl(t); ostart = HR; ref = AbsAppl(ostart); *ostart++ = s[0]; HR=ostart+n; } else { Int me; if (IsAtomTerm(t) && t_ref((cl_connector*)AtomOfTerm(t),q,&me,max)) { t = q[me].source; goto restart; } else { return -1; } } q[max].header = h; q[max].parent = q[i].copy+j; q[i].copy[j] = ref; q[max].source = t; q[max].copy = ostart; q[max].reference = ref; s[0] = MkAtomTerm((void*)(q+max)); return max+1; } Int cp_link(Term t, Int i, Int j, cl_connector * q, Int max, CELL * tailp) { Int me; t = Deref(t); if ((me = create_entry(t, i, j, q, max)) < max) { if (me < 0) { q[i].copy[j] = t; return max; } Term ref = q[me].reference; if (IsVarTerm(ref)) { q[i].copy[j] = ref; // fprintf(stderr," - %p\n", ref); } else { Term v = UNFOLD_LOOP(ref, tailp); q[i].copy[j] = v; if (me) q[me].parent[0] = v; q[me].reference = v; } return max; } return me; } Term Yap_BreakCycles(Term inp, UInt arity, Term * listp USES_REGS) { int lvl = push_text_stack(); Term t = Deref(inp); ssize_t qsize = 2048, qlen = 0; cl_connector *q = Malloc(qsize * sizeof(cl_connector)); Term *s; Int i = 0; HB = HR; qlen = 0; Term t0 = MkPairTerm(t, TermNil); q[0].copy = HR; HR+=2; if (IsVarTerm(t) || IsPrimitiveTerm(t)) { return t; } else { // initialization qlen = create_entry(Deref(t0), i, 0, q, qlen); while(icp_h; return HeadOfTerm( q[0].reference ); } /** @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_. */ static Int rational_term_to_tree(USES_REGS1) { Term t = Deref(ARG1); Term l = Deref(ARG4); if (IsVarTerm(l)) Yap_unify(l, MkVarTerm()); return Yap_unify(Yap_BreakCycles(t, 4, &l PASS_REGS), ARG2) && Yap_unify(l, ARG3); } void Yap_InitTermCPreds(void) { Yap_InitCPred("cycles_in_term", 2, cycles_in_term, 0); Yap_InitCPred("term_variables", 2, term_variables, 0); Yap_InitCPred("term_variables", 3, term_variables3, 0); Yap_InitCPred("$variables_in_term", 3, variables_in_term, 0); Yap_InitCPred("$free_variables_in_term", 3, free_variables_in_term, 0); Yap_InitCPred("free_variables_in_term", 3, free_variables_in_term, 0); Yap_InitCPred("term_attvars", 2, term_attvars, 0); CurrentModule = TERMS_MODULE; Yap_InitCPred("variable_in_term", 2, variable_in_term, 0); Yap_InitCPred("variables_within_term", 3, p_variables_within_term, 0); Yap_InitCPred("new_variables_in_term", 3, p_new_variables_in_term, 0); CurrentModule = PROLOG_MODULE; Yap_InitCPred("rational_term_to_tree", 4, rational_term_to_tree, 0); Yap_InitCPred("$non_singletons_in_term", 3, p_non_singletons_in_term, 0); 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); } //@}