1535 lines
34 KiB
C
1535 lines
34 KiB
C
/*************************************************************************
|
|
* *
|
|
* 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 *
|
|
* *
|
|
*************************************************************************/
|
|
#ifdef SCCS
|
|
static char SccsId[] = "@(#)utilpreds.c 1.3";
|
|
#endif
|
|
/**
|
|
* @file C/terms.c
|
|
*
|
|
* @brief applications of the tree walker pattern.
|
|
*
|
|
* @addtogroup Terms
|
|
* @{
|
|
*/
|
|
|
|
#include "absmi.h"
|
|
#include "YapHeap.h"
|
|
#include "yapio.h"
|
|
#include "attvar.h"
|
|
#ifdef HAVE_STRING_H
|
|
#include "string.h"
|
|
#endif
|
|
|
|
|
|
|
|
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 inline void
|
|
clean_tr(tr_fr_ptr TR0 USES_REGS) {
|
|
if (TR != TR0) {
|
|
do {
|
|
Term p = TrailTerm(--TR);
|
|
RESET_VARIABLE(p);
|
|
} while (TR != TR0);
|
|
}
|
|
}
|
|
|
|
static inline void
|
|
clean_dirty_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;
|
|
}
|
|
|
|
/// @brief recover original term while fixing direct refs.
|
|
///
|
|
/// @param USES_REGS
|
|
///
|
|
static inline void
|
|
clean_complex_tr(tr_fr_ptr TR0 USES_REGS) {
|
|
tr_fr_ptr pt0 = TR;
|
|
while (pt0 != TR0) {
|
|
Term p = TrailTerm(--pt0);
|
|
if (IsApplTerm(p)) {
|
|
/// pt: points to the address of the new term we may want to fix.
|
|
CELL *pt = RepAppl(p);
|
|
if (pt >= HB && pt < HR) { /// is it new?
|
|
Term v = pt[0];
|
|
if (IsApplTerm(v)) {
|
|
/// yes, more than a single ref
|
|
*pt = (CELL)RepAppl(v);
|
|
}
|
|
#ifndef FROZEN_STACKS
|
|
pt0 --;
|
|
#endif /* FROZEN_STACKS */
|
|
continue;
|
|
}
|
|
#ifdef FROZEN_STACKS
|
|
pt[0] = TrailVal(pt0);
|
|
#else
|
|
pt[0] = TrailTerm(pt0 - 1);
|
|
pt0 --;
|
|
#endif /* FROZEN_STACKS */
|
|
} else {
|
|
RESET_VARIABLE(p);
|
|
}
|
|
}
|
|
TR = TR0;
|
|
}
|
|
|
|
typedef struct {
|
|
Term old_var;
|
|
Term new_var;
|
|
} *vcell;
|
|
|
|
|
|
typedef struct non_single_struct_t {
|
|
CELL *ptd0;
|
|
CELL d0;
|
|
CELL *pt0, *pt0_end;
|
|
} non_singletons_t;
|
|
|
|
#define WALK_COMPLEX_TERM__(LIST0, STRUCT0) \
|
|
if (IsPairTerm(d0)) { \
|
|
if (to_visit + 32 >= to_visit_max) { \
|
|
goto aux_overflow; \
|
|
} \
|
|
LIST0; \
|
|
ptd0 = RepPair(d0); \
|
|
if (*ptd0 == TermFreeTerm) continue; \
|
|
to_visit->pt0 = pt0; \
|
|
to_visit->pt0_end = pt0_end; \
|
|
to_visit->ptd0 = ptd0; \
|
|
to_visit->d0 = *ptd0; \
|
|
to_visit ++; \
|
|
d0 = ptd0[0]; \
|
|
pt0 = ptd0; \
|
|
*ptd0 = TermFreeTerm; \
|
|
pt0_end = pt0 + 1; \
|
|
if (pt0 <= pt0_end) \
|
|
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) || \
|
|
IsAtomTerm((CELL)f)) { \
|
|
\
|
|
continue; \
|
|
} \
|
|
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; \
|
|
to_visit ++; \
|
|
\
|
|
*ap2 = TermNil; \
|
|
d0 = ArityOfFunctor(f); \
|
|
pt0 = ap2; \
|
|
pt0_end = ap2 + d0; \
|
|
}
|
|
|
|
#define WALK_COMPLEX_TERM() WALK_COMPLEX_TERM__({}, {})
|
|
|
|
#define def_trail_overflow() \
|
|
trail_overflow:{ \
|
|
while (to_visit > to_visit0) { \
|
|
to_visit --; \
|
|
CELL *ptd0 = to_visit->ptd0; \
|
|
*ptd0 = to_visit->d0; \
|
|
} \
|
|
pop_text_stack(lvl); \
|
|
LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; \
|
|
LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); \
|
|
clean_tr(TR0 PASS_REGS); \
|
|
HR = InitialH; \
|
|
return 0L; \
|
|
}
|
|
|
|
#define def_aux_overflow() \
|
|
aux_overflow:{ \
|
|
size_t d1 = to_visit-to_visit0; \
|
|
size_t d2 = to_visit_max-to_visit0; \
|
|
to_visit0 = Realloc(to_visit0,(d2+128)*sizeof(struct non_single_struct_t)); \
|
|
to_visit = to_visit0+d1; \
|
|
to_visit_max = to_visit0+(d2+128); \
|
|
pt0--; \
|
|
goto restart; \
|
|
}
|
|
|
|
#define def_global_overflow() \
|
|
global_overflow:{ \
|
|
while (to_visit > to_visit0) { \
|
|
to_visit --; \
|
|
CELL *ptd0 = to_visit->ptd0; \
|
|
*ptd0 = to_visit->d0; \
|
|
} \
|
|
pop_text_stack(lvl); \
|
|
clean_tr(TR0 PASS_REGS); \
|
|
HR = InitialH; \
|
|
LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; \
|
|
LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); \
|
|
return false; }
|
|
|
|
static Int var_in_complex_term(register CELL *pt0,
|
|
register CELL *pt0_end,
|
|
Term v USES_REGS)
|
|
{
|
|
|
|
int lvl = push_text_stack();
|
|
|
|
struct non_single_struct_t
|
|
*to_visit = Malloc(1024*sizeof( struct non_single_struct_t)),
|
|
*to_visit0 = to_visit,
|
|
*to_visit_max = to_visit+1024;
|
|
|
|
while (pt0 < pt0_end) {
|
|
register CELL d0;
|
|
register CELL *ptd0;
|
|
restart:
|
|
++ pt0;
|
|
ptd0 = pt0;
|
|
d0 = *ptd0;
|
|
list_loop:
|
|
deref_head(d0, var_in_term_unk);
|
|
var_in_term_nvar:
|
|
{
|
|
WALK_COMPLEX_TERM();
|
|
continue;
|
|
}
|
|
deref_body(d0, ptd0, var_in_term_unk, var_in_term_nvar);
|
|
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;
|
|
}
|
|
}
|
|
|
|
pop_text_stack(lvl);
|
|
return false;
|
|
|
|
def_aux_overflow();
|
|
}
|
|
|
|
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));
|
|
}
|
|
|
|
/**
|
|
@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)
|
|
{
|
|
|
|
int lvl = push_text_stack();
|
|
|
|
struct non_single_struct_t
|
|
*to_visit = Malloc(1024*sizeof( struct non_single_struct_t)),
|
|
*to_visit0 = to_visit,
|
|
*to_visit_max = to_visit+1024;
|
|
register tr_fr_ptr TR0 = TR;
|
|
CELL *InitialH = HR;
|
|
CELL output = AbsPair(HR);
|
|
|
|
loop:
|
|
while (pt0 < pt0_end) {
|
|
register CELL d0;
|
|
register CELL *ptd0;
|
|
restart:
|
|
|
|
++ pt0;
|
|
ptd0 = pt0;
|
|
d0 = *ptd0;
|
|
list_loop:
|
|
deref_head(d0, vars_in_term_unk);
|
|
vars_in_term_nvar:
|
|
|
|
WALK_COMPLEX_TERM();
|
|
continue ;
|
|
|
|
derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar);
|
|
/* do or pt2 are unbound */
|
|
*ptd0 = TermNil;
|
|
/* 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;
|
|
/* 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) {
|
|
to_visit--;
|
|
|
|
pt0 = to_visit->pt0;
|
|
pt0_end = to_visit->pt0_end;
|
|
CELL *ptd0 = to_visit->ptd0;
|
|
*ptd0 = to_visit->d0;
|
|
goto loop;
|
|
}
|
|
|
|
|
|
clean_tr(TR0 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),inp);
|
|
} else {
|
|
HR[-1] = t2; /* don't need to trail */
|
|
}
|
|
return(output);
|
|
} else {
|
|
return(inp);
|
|
}
|
|
|
|
def_trail_overflow();
|
|
def_aux_overflow();
|
|
def_global_overflow();
|
|
|
|
}
|
|
|
|
|
|
static Int
|
|
p_variables_in_term( USES_REGS1 ) /* variables in term t */
|
|
{
|
|
Term out, inp;
|
|
int count;
|
|
|
|
|
|
restart:
|
|
count = 0;
|
|
inp = Deref(ARG2);
|
|
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;
|
|
}
|
|
goto restart;
|
|
}
|
|
}
|
|
inp = TailOfTerm(inp);
|
|
}
|
|
do {
|
|
Term t = Deref(ARG1);
|
|
out = vars_in_complex_term(&(t)-1,
|
|
&(t),
|
|
ARG2 PASS_REGS);
|
|
if (out == 0L) {
|
|
if (!expand_vts( 3 PASS_REGS ))
|
|
return FALSE;
|
|
}
|
|
} while (out == 0L);
|
|
clean_tr(TR-count 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
|
|
p_term_variables3( USES_REGS1 ) /* variables in term t */
|
|
{
|
|
Term out;
|
|
|
|
do {
|
|
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);
|
|
}
|
|
if (out == 0L) {
|
|
if (!expand_vts( 3 PASS_REGS ))
|
|
return FALSE;
|
|
}
|
|
} while (out == 0L);
|
|
|
|
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;
|
|
|
|
do {
|
|
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);
|
|
}
|
|
if (out == 0L) {
|
|
if (!expand_vts( arity PASS_REGS ))
|
|
return FALSE;
|
|
}
|
|
} while (out == 0L);
|
|
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
|
|
p_term_variables( USES_REGS1 ) /* variables in term t */
|
|
{
|
|
Term out;
|
|
|
|
if (!Yap_IsListOrPartialListTerm(ARG2)) {
|
|
Yap_Error(TYPE_ERROR_LIST,ARG2,"term_variables/2");
|
|
return FALSE;
|
|
}
|
|
|
|
do {
|
|
Term t = Deref(ARG1);
|
|
|
|
out = vars_in_complex_term(&(t)-1,
|
|
&(t), TermNil PASS_REGS);
|
|
if (out == 0L) {
|
|
if (!expand_vts( 3 PASS_REGS ))
|
|
return FALSE;
|
|
}
|
|
} while (out == 0L);
|
|
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(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS)
|
|
{
|
|
int lvl = push_text_stack();
|
|
struct non_single_struct_t
|
|
*to_visit = Malloc(1024*sizeof( struct non_single_struct_t)),
|
|
*to_visit0 = to_visit,
|
|
*to_visit_max = to_visit+1024;
|
|
register tr_fr_ptr TR0 = TR;
|
|
CELL *InitialH = HR;
|
|
CELL output = AbsPair(HR);
|
|
|
|
restart:
|
|
while (pt0 < pt0_end) {
|
|
register CELL d0;
|
|
register CELL *ptd0;
|
|
++ pt0;
|
|
ptd0 = pt0;
|
|
d0 = *ptd0;
|
|
list_loop:
|
|
deref_head(d0, attvars_in_term_unk);
|
|
attvars_in_term_nvar:
|
|
{
|
|
WALK_COMPLEX_TERM();
|
|
continue;
|
|
}
|
|
|
|
|
|
derefa_body(d0, ptd0, attvars_in_term_unk, attvars_in_term_nvar);
|
|
if (IsAttVar(ptd0)) {
|
|
/* do or pt2 are unbound */
|
|
attvar_record *a0 = RepAttVar(ptd0);
|
|
if (a0->AttFunc ==(Functor) TermNil) continue;
|
|
/* 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)&(a0->Done);
|
|
/* store the terms to visit */
|
|
if (to_visit + 32 >= to_visit_max) {
|
|
goto aux_overflow;
|
|
}
|
|
ptd0 = (CELL*)a0;
|
|
to_visit->pt0 = pt0;
|
|
to_visit->pt0_end = pt0_end;
|
|
to_visit->d0 = *ptd0;
|
|
to_visit->ptd0 = ptd0;
|
|
to_visit ++;
|
|
*ptd0 = TermNil;
|
|
pt0_end = &RepAttVar(ptd0)->Atts;
|
|
pt0 = pt0_end-1;
|
|
}
|
|
}
|
|
/* 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;
|
|
}
|
|
|
|
|
|
clean_tr(TR0 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_aux_overflow();
|
|
def_global_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
|
|
p_term_attvars( USES_REGS1 ) /* variables in term t */
|
|
{
|
|
Term out;
|
|
|
|
do {
|
|
Term t = Deref(ARG1);
|
|
if (IsPrimitiveTerm(t)) {
|
|
return Yap_unify(TermNil, ARG2);
|
|
} else {
|
|
out = attvars_in_complex_term(&(t)-1,
|
|
&(t), TermNil PASS_REGS);
|
|
}
|
|
if (out == 0L) {
|
|
if (!expand_vts( 3 PASS_REGS ))
|
|
return false;
|
|
}
|
|
} while (out == 0L);
|
|
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(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS)
|
|
{
|
|
int lvl = push_text_stack();
|
|
|
|
struct non_single_struct_t
|
|
*to_visit = Malloc(1024*sizeof( struct non_single_struct_t)),
|
|
*to_visit0 = to_visit,
|
|
*to_visit_max = to_visit+1024;
|
|
register tr_fr_ptr TR0 = TR;
|
|
CELL *InitialH = HR;
|
|
CELL output = AbsPair(HR);
|
|
|
|
to_visit0 = to_visit;
|
|
while (!IsVarTerm(inp) && IsPairTerm(inp)) {
|
|
Term t = HeadOfTerm(inp);
|
|
if (IsVarTerm(t)) {
|
|
CELL *ptr = VarOfTerm(t);
|
|
*ptr = TermFoundVar;
|
|
TrailTerm(TR++) = t;
|
|
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
|
|
if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) {
|
|
goto trail_overflow;
|
|
}
|
|
}
|
|
}
|
|
inp = TailOfTerm(inp);
|
|
}
|
|
restart:
|
|
while (pt0 < pt0_end) {
|
|
register CELL d0;
|
|
register CELL *ptd0;
|
|
++ pt0;
|
|
ptd0 = pt0;
|
|
d0 = *ptd0;
|
|
list_loop:
|
|
deref_head(d0, vars_within_term_unk);
|
|
vars_within_term_nvar:
|
|
{
|
|
WALK_COMPLEX_TERM();
|
|
|
|
continue;
|
|
}
|
|
|
|
derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar);
|
|
/* do or pt2 are unbound */
|
|
*ptd0 = TermNil;
|
|
/* 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;
|
|
/* 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) {
|
|
to_visit--;
|
|
|
|
pt0 = to_visit->pt0;
|
|
pt0_end = to_visit->pt0_end;
|
|
CELL *ptd0 = to_visit->ptd0;
|
|
*ptd0 = to_visit->d0;
|
|
goto restart;
|
|
}
|
|
|
|
clean_tr(TR0 PASS_REGS);
|
|
pop_text_stack(lvl);
|
|
if (HR != InitialH) {
|
|
HR[-1] = TermNil;
|
|
return output;
|
|
} else {
|
|
return TermNil;
|
|
}
|
|
|
|
def_trail_overflow();
|
|
def_aux_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;
|
|
|
|
do {
|
|
Term t = Deref(ARG2);
|
|
if (IsPrimitiveTerm(t))
|
|
out = TermNil;
|
|
else {
|
|
out = new_vars_in_complex_term(&(t)-1,
|
|
&(t), Deref(ARG1) PASS_REGS);
|
|
}
|
|
if (out == 0L) {
|
|
if (!expand_vts( 3 PASS_REGS ))
|
|
return FALSE;
|
|
}
|
|
} while (out == 0L);
|
|
return Yap_unify(ARG3,out);
|
|
}
|
|
|
|
|
|
static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS)
|
|
{
|
|
|
|
int lvl = push_text_stack();
|
|
|
|
struct non_single_struct_t
|
|
*to_visit = Malloc(1024*sizeof( struct non_single_struct_t)),
|
|
*to_visit0 = to_visit,
|
|
*to_visit_max = to_visit+1024;
|
|
register tr_fr_ptr TR0 = TR;
|
|
CELL *InitialH = HR;
|
|
CELL output = AbsPair(HR);
|
|
|
|
to_visit0 = to_visit;
|
|
while (!IsVarTerm(inp) && IsPairTerm(inp)) {
|
|
Term t = HeadOfTerm(inp);
|
|
if (IsVarTerm(t)) {
|
|
CELL *ptr = VarOfTerm(t);
|
|
*ptr = TermFoundVar;
|
|
TrailTerm(TR++) = t;
|
|
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
|
|
if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) {
|
|
goto trail_overflow;
|
|
}
|
|
}
|
|
}
|
|
inp = TailOfTerm(inp);
|
|
}
|
|
restart:
|
|
while (pt0 < pt0_end) {
|
|
register CELL d0;
|
|
register CELL *ptd0;
|
|
++ pt0;
|
|
ptd0 = pt0;
|
|
d0 = *ptd0;
|
|
list_loop:
|
|
deref_head(d0, vars_within_term_unk);
|
|
vars_within_term_nvar:
|
|
{
|
|
WALK_COMPLEX_TERM()
|
|
else 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;
|
|
}
|
|
}
|
|
continue;
|
|
|
|
derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar);
|
|
}
|
|
/* 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;
|
|
}
|
|
|
|
clean_tr(TR0 PASS_REGS);
|
|
pop_text_stack(lvl);
|
|
if (HR != InitialH) {
|
|
HR[-1] = TermNil;
|
|
return output;
|
|
} else {
|
|
return TermNil;
|
|
}
|
|
|
|
|
|
def_trail_overflow();
|
|
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;
|
|
|
|
do {
|
|
Term t = Deref(ARG2);
|
|
if (IsPrimitiveTerm(t))
|
|
out = TermNil;
|
|
else {
|
|
out = vars_within_complex_term(&(t)-1,
|
|
&(t), Deref(ARG1) PASS_REGS);
|
|
}
|
|
if (out == 0L) {
|
|
if (!expand_vts( 3 PASS_REGS ))
|
|
return FALSE;
|
|
}
|
|
} while (out == 0L);
|
|
return Yap_unify(ARG3,out);
|
|
}
|
|
|
|
|
|
static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, tr_fr_ptr TR0 USES_REGS)
|
|
{
|
|
int lvl = push_text_stack();
|
|
|
|
struct non_single_struct_t
|
|
*to_visit = Malloc(1024*sizeof( struct non_single_struct_t)),
|
|
*to_visit0 = to_visit,
|
|
*to_visit_max = to_visit+1024;
|
|
Term o = TermNil;
|
|
CELL *InitialH = HR;
|
|
to_visit0 = to_visit;
|
|
restart:
|
|
while (pt0 < pt0_end) {
|
|
register CELL d0;
|
|
register CELL *ptd0;
|
|
++ pt0;
|
|
ptd0 = pt0;
|
|
d0 = *ptd0;
|
|
list_loop:
|
|
deref_head(d0, vars_within_term_unk);
|
|
vars_within_term_nvar:
|
|
{
|
|
WALK_COMPLEX_TERM();
|
|
continue;
|
|
}
|
|
|
|
derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar);
|
|
/* do or pt2 are unbound */
|
|
*ptd0 = TermNil;
|
|
/* leave an empty slot to fill in later */
|
|
if (HR+1024 > ASP) {
|
|
o = TermNil;
|
|
goto global_overflow;
|
|
}
|
|
HR[0] = (CELL)ptd0;
|
|
HR[1] = o;
|
|
o = AbsPair(HR);
|
|
HR += 2;
|
|
/* 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) {
|
|
to_visit--;
|
|
|
|
pt0 = to_visit->pt0;
|
|
pt0_end = to_visit->pt0_end;
|
|
CELL *ptd0 = to_visit->ptd0;
|
|
*ptd0 = to_visit->d0;
|
|
goto restart;
|
|
}
|
|
|
|
clean_tr(TR0 PASS_REGS);
|
|
pop_text_stack(lvl);
|
|
return o;
|
|
|
|
|
|
def_trail_overflow();
|
|
def_aux_overflow();
|
|
def_global_overflow();
|
|
|
|
}
|
|
|
|
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:
|
|
#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_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
|
|
p_free_variables_in_term( USES_REGS1 ) /* variables within term t */
|
|
{
|
|
Term out;
|
|
Term t, t0;
|
|
Term found_module = 0L;
|
|
|
|
do {
|
|
tr_fr_ptr TR0 = TR;
|
|
|
|
t = t0 = Deref(ARG1);
|
|
while (!IsVarTerm(t) && IsApplTerm(t)) {
|
|
Functor f = FunctorOfTerm(t);
|
|
if (f == FunctorHat) {
|
|
out = bind_vars_in_complex_term(RepAppl(t),
|
|
RepAppl(t)+1, TR0 PASS_REGS);
|
|
if (out == 0L) {
|
|
goto trail_overflow;
|
|
}
|
|
} else if (f == FunctorModule) {
|
|
found_module = ArgOfTerm(1, t);
|
|
} else if (f == FunctorCall) {
|
|
t = ArgOfTerm(1, t);
|
|
continue;
|
|
} else if (f == FunctorExecuteInMod) {
|
|
found_module = ArgOfTerm(2, t);
|
|
t = ArgOfTerm(1, t);
|
|
continue;
|
|
} else {
|
|
break;
|
|
}
|
|
t = ArgOfTerm(2,t);
|
|
}
|
|
if (IsPrimitiveTerm(t))
|
|
out = TermNil;
|
|
else {
|
|
out = free_vars_in_complex_term(&(t)-1,
|
|
&(t), TR0 PASS_REGS);
|
|
}
|
|
if (out == 0L) {
|
|
trail_overflow:
|
|
if (!expand_vts( 3 PASS_REGS ))
|
|
return FALSE;
|
|
}
|
|
} while (out == 0L);
|
|
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);
|
|
}
|
|
|
|
|
|
|
|
static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt0_end USES_REGS)
|
|
{
|
|
int lvl = push_text_stack();
|
|
|
|
struct non_single_struct_t *to_visit0,
|
|
*to_visit = Malloc(1024*sizeof( struct non_single_struct_t)),
|
|
*to_visit_max;
|
|
register tr_fr_ptr TR0 = TR;
|
|
CELL *InitialH = HR;
|
|
CELL output = AbsPair(HR);
|
|
|
|
to_visit0 = to_visit;
|
|
to_visit_max = to_visit0+1024;
|
|
restart:
|
|
while (pt0 < pt0_end) {
|
|
register CELL d0;
|
|
register CELL *ptd0;
|
|
++ pt0;
|
|
ptd0 = pt0;
|
|
d0 = *ptd0;
|
|
list_loop:
|
|
deref_head(d0, vars_in_term_unk);
|
|
vars_in_term_nvar:
|
|
{
|
|
WALK_COMPLEX_TERM()
|
|
else if (d0 == TermFoundVar) {
|
|
CELL *pt2 = pt0;
|
|
while(IsVarTerm(*pt2))
|
|
pt2 = (CELL *)(*pt2);
|
|
HR[1] = AbsPair(HR+2);
|
|
HR[0] = (CELL)pt2;
|
|
HR += 2;
|
|
*pt2 = TermRefoundVar;
|
|
}
|
|
continue;
|
|
}
|
|
|
|
|
|
derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar);
|
|
/* do or pt2 are unbound */
|
|
*ptd0 = TermFoundVar;
|
|
/* next make sure we can recover the variable again */
|
|
TrailTerm(TR++) = (CELL)ptd0;
|
|
}
|
|
/* 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;
|
|
}
|
|
|
|
clean_tr(TR0 PASS_REGS);
|
|
pop_text_stack(lvl);
|
|
if (HR != InitialH) {
|
|
/* close the list */
|
|
HR[-1] = Deref(ARG2);
|
|
return output;
|
|
} else {
|
|
return ARG2;
|
|
}
|
|
|
|
def_aux_overflow();
|
|
}
|
|
|
|
static Int
|
|
p_non_singletons_in_term( USES_REGS1 ) /* non_singletons in term t */
|
|
{
|
|
Term t;
|
|
Term out;
|
|
|
|
while (TRUE) {
|
|
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);
|
|
}
|
|
if (out != 0L) {
|
|
return Yap_unify(ARG3,out);
|
|
} else {
|
|
if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) {
|
|
Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, "overflow in singletons");
|
|
return FALSE;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end USES_REGS)
|
|
{
|
|
int lvl = push_text_stack();
|
|
|
|
struct non_single_struct_t *to_visit0,
|
|
*to_visit = Malloc(1024*sizeof( struct non_single_struct_t)),
|
|
*to_visit_max;
|
|
|
|
to_visit0 = to_visit;
|
|
to_visit_max = to_visit0+1024;
|
|
restart:
|
|
while (pt0 < pt0_end) {
|
|
register CELL d0;
|
|
register CELL *ptd0;
|
|
|
|
++pt0;
|
|
ptd0 = pt0;
|
|
d0 = *ptd0;
|
|
list_loop:
|
|
deref_head(d0, vars_in_term_unk);
|
|
vars_in_term_nvar:
|
|
WALK_COMPLEX_TERM();
|
|
continue;
|
|
|
|
|
|
|
|
derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar);
|
|
while (to_visit > to_visit0) {
|
|
to_visit --;
|
|
CELL *ptd0 = to_visit->ptd0;
|
|
*ptd0 = to_visit->d0;
|
|
}
|
|
pop_text_stack(lvl);
|
|
return false;
|
|
}
|
|
/* 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;
|
|
if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) {
|
|
Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, "overflow in ground");
|
|
return false;
|
|
}
|
|
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);
|
|
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 id USES_REGS)
|
|
{
|
|
Term *ts = RepAppl(t);
|
|
ts[1] = MkIntegerTerm(id);
|
|
}
|
|
|
|
#define RENUMBER_SINGLES \
|
|
if (singles && ap2 >= InitialH && ap2 < HR) { \
|
|
renumbervar(d0, numbv++ PASS_REGS); \
|
|
continue; \
|
|
}
|
|
|
|
|
|
static Int numbervars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Int numbv, int singles USES_REGS)
|
|
{
|
|
|
|
|
|
int lvl = push_text_stack();
|
|
|
|
struct non_single_struct_t
|
|
*to_visit = Malloc(1024*sizeof( struct non_single_struct_t)),
|
|
*to_visit0 = to_visit,
|
|
*to_visit_max = to_visit+1024;
|
|
register tr_fr_ptr TR0 = TR;
|
|
CELL *InitialH = HR;
|
|
|
|
to_visit0 = to_visit;
|
|
to_visit_max = to_visit0+1024;
|
|
restart:
|
|
while (pt0 < pt0_end) {
|
|
register CELL d0;
|
|
register CELL *ptd0;
|
|
++ pt0;
|
|
ptd0 = pt0;
|
|
d0 = *ptd0;
|
|
list_loop:
|
|
deref_head(d0, vars_in_term_unk);
|
|
vars_in_term_nvar:
|
|
{
|
|
WALK_COMPLEX_TERM__({},RENUMBER_SINGLES);
|
|
|
|
continue;
|
|
}
|
|
|
|
|
|
derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar);
|
|
/* do or pt2 are unbound */
|
|
if (singles)
|
|
*ptd0 = numbervar_singleton( PASS_REGS1 );
|
|
else
|
|
*ptd0 = 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 */
|
|
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
|
|
/* Trail overflow */
|
|
if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) {
|
|
goto trail_overflow;
|
|
}
|
|
}
|
|
|
|
#if defined(TABLING) || defined(YAPOR_SBA)
|
|
TrailVal(TR) = (CELL)ptd0;
|
|
#endif
|
|
TrailTerm(TR++) = (CELL)ptd0;
|
|
}
|
|
/* 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;
|
|
}
|
|
|
|
prune(B PASS_REGS);
|
|
pop_text_stack(lvl);
|
|
return numbv;
|
|
|
|
def_trail_overflow();
|
|
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;
|
|
|
|
restart:
|
|
t = Deref(inp);
|
|
if (IsVarTerm(t)) {
|
|
CELL *ptd0 = VarOfTerm(t);
|
|
TrailTerm(TR++) = (CELL)ptd0;
|
|
if (handle_singles) {
|
|
*ptd0 = numbervar_singleton( PASS_REGS1 );
|
|
return numbv;
|
|
} else {
|
|
*ptd0 = numbervar(numbv PASS_REGS);
|
|
return numbv+1;
|
|
}
|
|
} else if (IsPrimitiveTerm(t)) {
|
|
return numbv;
|
|
} else if (IsPairTerm(t)) {
|
|
out = numbervars_in_complex_term(RepPair(t)-1,
|
|
RepPair(t)+1, numbv, handle_singles PASS_REGS);
|
|
} else {
|
|
Functor f = FunctorOfTerm(t);
|
|
|
|
out = numbervars_in_complex_term(RepAppl(t),
|
|
RepAppl(t)+
|
|
ArityOfFunctor(f), numbv, handle_singles PASS_REGS);
|
|
}
|
|
if (out < numbv) {
|
|
if (!expand_vts( 3 PASS_REGS ))
|
|
return FALSE;
|
|
goto restart;
|
|
}
|
|
}
|
|
|
|
/** @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));
|
|
}
|
|
|
|
void Yap_InitTermCPreds(void)
|
|
{
|
|
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("$free_variables_in_term", 3, p_free_variables_in_term, 0);
|
|
|
|
Yap_InitCPred("term_attvars", 2, p_term_attvars, 0);
|
|
|
|
CurrentModule = TERMS_MODULE;
|
|
Yap_InitCPred("variable_in_term", 2, p_var_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("$non_singletons_in_term", 3, p_non_singletons_in_term, 0);
|
|
|
|
Yap_InitCPred("ground", 1, p_ground, SafePredFlag);
|
|
|
|
Yap_InitCPred("numbervars", 3, p_numbervars, 0);
|
|
}
|
|
|