2001-04-09 20:54:03 +01:00
|
|
|
/*************************************************************************
|
2019-01-07 14:59:08 +00:00
|
|
|
* *
|
|
|
|
* 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 *
|
|
|
|
* *
|
|
|
|
*************************************************************************/
|
2001-04-09 20:54:03 +01:00
|
|
|
#ifdef SCCS
|
2018-11-06 22:49:11 +00:00
|
|
|
static char SccsId[] = "@(#)utilpreds.c 1.3";
|
2001-04-09 20:54:03 +01:00
|
|
|
#endif
|
2017-04-13 21:42:34 +01:00
|
|
|
/**
|
2019-01-07 14:59:08 +00:00
|
|
|
* @file utilpreds.c
|
|
|
|
*
|
2017-04-13 21:42:34 +01:00
|
|
|
* @addtogroup Terms
|
2014-09-11 20:06:57 +01:00
|
|
|
|
|
|
|
*/
|
2018-11-04 10:55:58 +00:00
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
#include "absmi.h"
|
2009-10-23 14:22:17 +01:00
|
|
|
#include "YapHeap.h"
|
2018-11-04 10:55:58 +00:00
|
|
|
#include "yapio.h"
|
2018-11-06 22:49:11 +00:00
|
|
|
#include "attvar.h"
|
2008-08-06 18:32:22 +01:00
|
|
|
#ifdef HAVE_STRING_H
|
|
|
|
#include "string.h"
|
|
|
|
#endif
|
2001-04-09 20:54:03 +01:00
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
|
2001-04-09 20:54:03 +01:00
|
|
|
typedef struct {
|
2019-01-07 14:59:08 +00:00
|
|
|
Term old_var;
|
|
|
|
Term new_var;
|
2018-11-06 22:49:11 +00:00
|
|
|
} *vcell;
|
|
|
|
|
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
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);\
|
|
|
|
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 = TermNil;\
|
|
|
|
pt0_end = pt0 + 1;\
|
|
|
|
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;\
|
|
|
|
}\
|
|
|
|
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;\
|
|
|
|
}\
|
2019-01-21 01:11:42 +00:00
|
|
|
pop_text_stack(lvl);\
|
2019-01-07 14:59:08 +00:00
|
|
|
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; }
|
|
|
|
|
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
static Int p_non_singletons_in_term( USES_REGS1);
|
|
|
|
static CELL non_singletons_in_complex_term(CELL *, CELL * CACHE_TYPE);
|
|
|
|
static Int p_variables_in_term( USES_REGS1 );
|
|
|
|
static Int ground_complex_term(CELL *, CELL * CACHE_TYPE);
|
|
|
|
static Int p_ground( USES_REGS1 );
|
|
|
|
static Int p_copy_term( USES_REGS1 );
|
|
|
|
static Int var_in_complex_term(CELL *, CELL *, Term CACHE_TYPE);
|
2019-01-07 14:59:08 +00:00
|
|
|
static int copy_complex_term(CELL *, CELL *, int, int, CELL *, CELL * CACHE_TYPE);
|
|
|
|
static CELL vars_in_complex_term(CELL *, CELL *, Term CACHE_TYPE);
|
2001-04-09 20:54:03 +01:00
|
|
|
|
|
|
|
#ifdef DEBUG
|
2018-11-06 22:49:11 +00:00
|
|
|
static Int p_force_trail_expansion( USES_REGS1 );
|
2001-04-09 20:54:03 +01:00
|
|
|
#endif /* DEBUG */
|
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
static inline void
|
|
|
|
clean_tr(tr_fr_ptr TR0 USES_REGS) {
|
2001-04-09 20:54:03 +01:00
|
|
|
if (TR != TR0) {
|
|
|
|
do {
|
|
|
|
Term p = TrailTerm(--TR);
|
2004-04-20 23:08:57 +01:00
|
|
|
RESET_VARIABLE(p);
|
2001-04-09 20:54:03 +01:00
|
|
|
} while (TR != TR0);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
static inline void
|
|
|
|
clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) {
|
2004-06-16 15:10:20 +01:00
|
|
|
if (TR != TR0) {
|
|
|
|
tr_fr_ptr pt = TR0;
|
|
|
|
|
|
|
|
do {
|
|
|
|
Term p = TrailTerm(pt++);
|
2010-03-12 08:24:58 +00:00
|
|
|
RESET_VARIABLE(p);
|
2004-06-16 15:10:20 +01:00
|
|
|
} while (pt != TR);
|
|
|
|
TR = TR0;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
static int
|
|
|
|
copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, CELL *HLow USES_REGS)
|
|
|
|
{
|
2001-04-09 20:54:03 +01:00
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
struct cp_frame *to_visit0, *to_visit = (struct cp_frame *)Yap_PreAllocCodeSpace() ;
|
2001-04-09 20:54:03 +01:00
|
|
|
CELL *HB0 = HB;
|
2004-04-19 18:06:51 +01:00
|
|
|
tr_fr_ptr TR0 = TR;
|
2007-09-21 14:52:52 +01:00
|
|
|
int ground = TRUE;
|
|
|
|
|
2018-08-15 01:29:20 +01:00
|
|
|
HB = HR;
|
2004-01-23 02:23:51 +00:00
|
|
|
to_visit0 = to_visit;
|
2018-11-06 22:49:11 +00:00
|
|
|
loop:
|
2001-04-09 20:54:03 +01:00
|
|
|
while (pt0 < pt0_end) {
|
|
|
|
register CELL d0;
|
|
|
|
register CELL *ptd0;
|
2018-11-06 22:49:11 +00:00
|
|
|
++ pt0;
|
2001-04-09 20:54:03 +01:00
|
|
|
ptd0 = pt0;
|
|
|
|
d0 = *ptd0;
|
|
|
|
deref_head(d0, copy_term_unk);
|
2018-11-06 22:49:11 +00:00
|
|
|
copy_term_nvar:
|
|
|
|
{
|
|
|
|
if (IsPairTerm(d0)) {
|
|
|
|
CELL *ap2 = RepPair(d0);
|
|
|
|
if (ap2 >= HB && ap2 < HR) {
|
|
|
|
/* If this is newer than the current term, just reuse */
|
|
|
|
*ptf++ = d0;
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
*ptf = AbsPair(HR);
|
|
|
|
ptf++;
|
|
|
|
if (to_visit+1 >= (struct cp_frame *)AuxSp) {
|
|
|
|
goto heap_overflow;
|
|
|
|
}
|
|
|
|
to_visit->start_cp = pt0;
|
|
|
|
to_visit->end_cp = pt0_end;
|
|
|
|
to_visit->to = ptf;
|
|
|
|
to_visit->oldv = *pt0;
|
|
|
|
to_visit->ground = ground;
|
|
|
|
/* fool the system into thinking we had a variable there */
|
|
|
|
*pt0 = AbsPair(HR);
|
|
|
|
to_visit ++;
|
2019-01-07 14:59:08 +00:00
|
|
|
ground = true;
|
2018-11-06 22:49:11 +00:00
|
|
|
pt0 = ap2 - 1;
|
|
|
|
pt0_end = ap2 + 1;
|
|
|
|
ptf = HR;
|
|
|
|
HR += 2;
|
|
|
|
if (HR > ASP - 2048) {
|
|
|
|
goto overflow;
|
|
|
|
}
|
|
|
|
} else if (IsApplTerm(d0)) {
|
|
|
|
register Functor f;
|
|
|
|
register CELL *ap2;
|
|
|
|
/* store the terms to visit */
|
|
|
|
ap2 = RepAppl(d0);
|
|
|
|
if (ap2 >= HB && ap2 <= HR) {
|
|
|
|
/* If this is newer than the current term, just reuse */
|
|
|
|
*ptf++ = d0;
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
f = (Functor)(*ap2);
|
|
|
|
|
|
|
|
if (IsExtensionFunctor(f)) {
|
2011-04-14 18:51:11 +01:00
|
|
|
#if MULTIPLE_STACKS
|
2018-11-06 22:49:11 +00:00
|
|
|
if (f == FunctorDBRef) {
|
|
|
|
DBRef entryref = DBRefOfTerm(d0);
|
|
|
|
if (entryref->Flags & LogUpdMask) {
|
|
|
|
LogUpdClause *luclause = (LogUpdClause *)entryref;
|
|
|
|
PELOCK(100,luclause->ClPred);
|
|
|
|
UNLOCK(luclause->ClPred->PELock);
|
|
|
|
} else {
|
|
|
|
LOCK(entryref->lock);
|
|
|
|
TRAIL_REF(entryref); /* So that fail will erase it */
|
|
|
|
INC_DBREF_COUNT(entryref);
|
|
|
|
UNLOCK(entryref->lock);
|
|
|
|
}
|
|
|
|
*ptf++ = d0; /* you can just copy other extensions. */
|
|
|
|
} else
|
2008-05-11 00:24:13 +01:00
|
|
|
#endif
|
2019-01-07 14:59:08 +00:00
|
|
|
if (!share) {
|
|
|
|
UInt sz;
|
|
|
|
|
|
|
|
*ptf++ = AbsAppl(HR); /* you can just copy other extensions. */
|
|
|
|
/* make sure to copy floats */
|
|
|
|
if (f== FunctorDouble) {
|
|
|
|
sz = sizeof(Float)/sizeof(CELL)+2;
|
|
|
|
} else if (f== FunctorLongInt) {
|
|
|
|
sz = 3;
|
|
|
|
} else if (f== FunctorString) {
|
|
|
|
sz = 3+ap2[1];
|
|
|
|
} else {
|
|
|
|
CELL *pt = ap2+1;
|
|
|
|
sz = 2+sizeof(MP_INT)+(((MP_INT *)(pt+1))->_mp_alloc*sizeof(mp_limb_t));
|
|
|
|
}
|
|
|
|
if (HR+sz > ASP - 2048) {
|
|
|
|
goto overflow;
|
|
|
|
}
|
|
|
|
memmove((void *)HR, (void *)ap2, sz*sizeof(CELL));
|
|
|
|
HR += sz;
|
2018-11-06 22:49:11 +00:00
|
|
|
} else {
|
2019-01-07 14:59:08 +00:00
|
|
|
*ptf++ = d0; /* you can just copy other extensions. */
|
2018-11-06 22:49:11 +00:00
|
|
|
}
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
*ptf = AbsAppl(HR);
|
|
|
|
ptf++;
|
|
|
|
/* store the terms to visit */
|
|
|
|
if (to_visit+1 >= (struct cp_frame *)AuxSp) {
|
|
|
|
goto heap_overflow;
|
|
|
|
}
|
|
|
|
to_visit->start_cp = pt0;
|
|
|
|
to_visit->end_cp = pt0_end;
|
|
|
|
to_visit->to = ptf;
|
|
|
|
to_visit->oldv = *pt0;
|
|
|
|
to_visit->ground = ground;
|
|
|
|
/* fool the system into thinking we had a variable there */
|
|
|
|
*pt0 = AbsAppl(HR);
|
|
|
|
to_visit ++;
|
|
|
|
ground = (f != FunctorMutable);
|
|
|
|
d0 = ArityOfFunctor(f);
|
|
|
|
pt0 = ap2;
|
|
|
|
pt0_end = ap2 + d0;
|
|
|
|
/* store the functor for the new term */
|
|
|
|
HR[0] = (CELL)f;
|
|
|
|
ptf = HR+1;
|
|
|
|
HR += 1+d0;
|
|
|
|
if (HR > ASP - 2048) {
|
|
|
|
goto overflow;
|
|
|
|
}
|
|
|
|
} else {
|
|
|
|
/* just copy atoms or integers */
|
|
|
|
*ptf++ = d0;
|
2001-04-09 20:54:03 +01:00
|
|
|
}
|
2018-11-06 22:49:11 +00:00
|
|
|
continue;
|
2001-04-09 20:54:03 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar);
|
2007-09-21 14:52:52 +01:00
|
|
|
ground = FALSE;
|
2017-04-13 21:42:34 +01:00
|
|
|
if (ptd0 >= HLow && ptd0 < HR) {
|
2001-04-09 20:54:03 +01:00
|
|
|
/* we have already found this cell */
|
2018-11-06 22:49:11 +00:00
|
|
|
*ptf++ = (CELL) ptd0;
|
2017-04-13 21:42:34 +01:00
|
|
|
} else
|
2001-04-09 20:54:03 +01:00
|
|
|
#if COROUTINING
|
2018-11-06 22:49:11 +00:00
|
|
|
if (newattvs && IsAttachedTerm((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, ptf PASS_REGS)) {
|
|
|
|
goto overflow;
|
|
|
|
}
|
|
|
|
to_visit = bp;
|
|
|
|
new = *ptf;
|
|
|
|
Bind_NonAtt(ptd0, new);
|
|
|
|
ptf++;
|
|
|
|
} else {
|
2001-04-09 20:54:03 +01:00
|
|
|
#endif
|
2018-11-06 22:49:11 +00:00
|
|
|
/* first time we met this term */
|
|
|
|
RESET_VARIABLE(ptf);
|
|
|
|
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
|
|
|
|
/* Trail overflow */
|
|
|
|
if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) {
|
|
|
|
goto trail_overflow;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
Bind_NonAtt(ptd0, (CELL)ptf);
|
|
|
|
ptf++;
|
2019-01-07 14:59:08 +00:00
|
|
|
}
|
2001-04-09 20:54:03 +01:00
|
|
|
}
|
|
|
|
/* Do we still have compound terms to visit */
|
2004-01-23 02:23:51 +00:00
|
|
|
if (to_visit > to_visit0) {
|
2018-11-06 22:49:11 +00:00
|
|
|
to_visit --;
|
2007-09-21 14:52:52 +01:00
|
|
|
if (ground && share) {
|
|
|
|
CELL old = to_visit->oldv;
|
2018-11-06 22:49:11 +00:00
|
|
|
CELL *newp = to_visit->to-1;
|
2007-09-21 14:52:52 +01:00
|
|
|
CELL new = *newp;
|
|
|
|
|
|
|
|
*newp = old;
|
|
|
|
if (IsApplTerm(new))
|
2018-11-06 22:49:11 +00:00
|
|
|
HR = RepAppl(new);
|
2007-09-21 14:52:52 +01:00
|
|
|
else
|
2018-11-06 22:49:11 +00:00
|
|
|
HR = RepPair(new);
|
2007-09-21 14:52:52 +01:00
|
|
|
}
|
|
|
|
pt0 = to_visit->start_cp;
|
|
|
|
pt0_end = to_visit->end_cp;
|
|
|
|
ptf = to_visit->to;
|
|
|
|
*pt0 = to_visit->oldv;
|
|
|
|
ground = (ground && to_visit->ground);
|
2001-04-09 20:54:03 +01:00
|
|
|
goto loop;
|
|
|
|
}
|
|
|
|
|
|
|
|
/* restore our nice, friendly, term to its original state */
|
2011-03-07 16:02:55 +00:00
|
|
|
clean_dirty_tr(TR0 PASS_REGS);
|
2010-03-15 14:17:30 +00:00
|
|
|
HB = HB0;
|
2007-09-21 14:52:52 +01:00
|
|
|
return ground;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
overflow:
|
2001-04-09 20:54:03 +01:00
|
|
|
/* oops, we're in trouble */
|
2014-01-19 21:15:05 +00:00
|
|
|
HR = HLow;
|
2001-04-09 20:54:03 +01:00
|
|
|
/* we've done it */
|
|
|
|
/* restore our nice, friendly, term to its original state */
|
|
|
|
HB = HB0;
|
2004-01-23 02:23:51 +00:00
|
|
|
while (to_visit > to_visit0) {
|
2018-11-06 22:49:11 +00:00
|
|
|
to_visit --;
|
2007-09-21 14:52:52 +01:00
|
|
|
pt0 = to_visit->start_cp;
|
|
|
|
pt0_end = to_visit->end_cp;
|
|
|
|
ptf = to_visit->to;
|
|
|
|
*pt0 = to_visit->oldv;
|
2001-04-09 20:54:03 +01:00
|
|
|
}
|
2004-09-07 21:20:12 +01:00
|
|
|
reset_trail(TR0);
|
2010-03-15 14:17:30 +00:00
|
|
|
/* follow chain of multi-assigned variables */
|
2004-09-07 21:20:12 +01:00
|
|
|
return -1;
|
2002-04-08 23:10:14 +01:00
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
trail_overflow:
|
2007-03-27 14:48:51 +01:00
|
|
|
/* oops, we're in trouble */
|
2014-01-19 21:15:05 +00:00
|
|
|
HR = HLow;
|
2007-03-27 14:48:51 +01:00
|
|
|
/* we've done it */
|
|
|
|
/* restore our nice, friendly, term to its original state */
|
|
|
|
HB = HB0;
|
|
|
|
while (to_visit > to_visit0) {
|
2018-11-06 22:49:11 +00:00
|
|
|
to_visit --;
|
2007-09-21 14:52:52 +01:00
|
|
|
pt0 = to_visit->start_cp;
|
|
|
|
pt0_end = to_visit->end_cp;
|
|
|
|
ptf = to_visit->to;
|
|
|
|
*pt0 = to_visit->oldv;
|
2007-03-27 14:48:51 +01:00
|
|
|
}
|
|
|
|
{
|
2018-11-06 22:49:11 +00:00
|
|
|
tr_fr_ptr oTR = TR;
|
2007-03-27 14:48:51 +01:00
|
|
|
reset_trail(TR0);
|
2018-11-06 22:49:11 +00:00
|
|
|
if (!Yap_growtrail((oTR-TR0)*sizeof(tr_fr_ptr *), TRUE)) {
|
2007-03-27 14:48:51 +01:00
|
|
|
return -4;
|
|
|
|
}
|
|
|
|
return -2;
|
|
|
|
}
|
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
heap_overflow:
|
2002-04-08 23:10:14 +01:00
|
|
|
/* oops, we're in trouble */
|
2014-01-19 21:15:05 +00:00
|
|
|
HR = HLow;
|
2002-04-08 23:10:14 +01:00
|
|
|
/* we've done it */
|
|
|
|
/* restore our nice, friendly, term to its original state */
|
|
|
|
HB = HB0;
|
2004-01-23 02:23:51 +00:00
|
|
|
while (to_visit > to_visit0) {
|
2018-11-06 22:49:11 +00:00
|
|
|
to_visit --;
|
2007-09-21 14:52:52 +01:00
|
|
|
pt0 = to_visit->start_cp;
|
|
|
|
pt0_end = to_visit->end_cp;
|
|
|
|
ptf = to_visit->to;
|
|
|
|
*pt0 = to_visit->oldv;
|
2002-04-08 23:10:14 +01:00
|
|
|
}
|
2004-09-09 21:00:59 +01:00
|
|
|
reset_trail(TR0);
|
2018-11-06 22:49:11 +00:00
|
|
|
LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0;
|
2007-03-27 14:48:51 +01:00
|
|
|
return -3;
|
2019-01-07 14:59:08 +00:00
|
|
|
}
|
2007-03-27 14:48:51 +01:00
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
|
|
|
|
static Term
|
|
|
|
handle_cp_overflow(int res, tr_fr_ptr TR0, UInt arity, Term t)
|
|
|
|
{
|
2011-03-07 16:02:55 +00:00
|
|
|
CACHE_REGS
|
2019-01-07 14:59:08 +00:00
|
|
|
XREGS[arity+1] = t;
|
2018-11-06 22:49:11 +00:00
|
|
|
switch(res) {
|
2007-03-27 14:48:51 +01:00
|
|
|
case -1:
|
2018-11-06 22:49:11 +00:00
|
|
|
if (!Yap_gcl((ASP-HR)*sizeof(CELL), arity+1, ENV, gc_P(P,CP))) {
|
2018-08-15 01:29:20 +01:00
|
|
|
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
|
2007-03-27 14:48:51 +01:00
|
|
|
return 0L;
|
|
|
|
}
|
2018-11-06 22:49:11 +00:00
|
|
|
return Deref(XREGS[arity+1]);
|
2007-03-27 14:48:51 +01:00
|
|
|
case -2:
|
2018-11-06 22:49:11 +00:00
|
|
|
return Deref(XREGS[arity+1]);
|
|
|
|
case -3:
|
|
|
|
{
|
|
|
|
UInt size = LOCAL_Error_Size;
|
|
|
|
LOCAL_Error_Size = 0L;
|
|
|
|
if (size > 4*1024*1024)
|
|
|
|
size = 4*1024*1024;
|
|
|
|
if (!Yap_ExpandPreAllocCodeSpace(size, NULL, TRUE)) {
|
|
|
|
Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, TermNil, LOCAL_ErrorMessage);
|
|
|
|
return 0L;
|
|
|
|
}
|
2007-03-27 14:48:51 +01:00
|
|
|
}
|
2018-11-06 22:49:11 +00:00
|
|
|
return Deref(XREGS[arity+1]);
|
2009-05-05 03:26:47 +01:00
|
|
|
case -4:
|
2018-11-06 22:49:11 +00:00
|
|
|
if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), FALSE)) {
|
2015-09-25 10:57:26 +01:00
|
|
|
Yap_Error(RESOURCE_ERROR_TRAIL, TermNil, LOCAL_ErrorMessage);
|
2009-05-05 03:26:47 +01:00
|
|
|
return 0L;
|
|
|
|
}
|
2018-11-06 22:49:11 +00:00
|
|
|
return Deref(XREGS[arity+1]);
|
2007-03-27 14:48:51 +01:00
|
|
|
default:
|
|
|
|
return 0L;
|
|
|
|
}
|
2001-04-09 20:54:03 +01:00
|
|
|
}
|
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
static Term
|
|
|
|
CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) {
|
2001-04-09 20:54:03 +01:00
|
|
|
Term t = Deref(inp);
|
2009-05-05 03:26:47 +01:00
|
|
|
tr_fr_ptr TR0 = TR;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
|
|
|
if (IsVarTerm(t)) {
|
|
|
|
#if COROUTINING
|
2007-09-21 14:52:52 +01:00
|
|
|
if (newattvs && IsAttachedTerm(t)) {
|
2001-12-11 03:34:03 +00:00
|
|
|
CELL *Hi;
|
2002-04-08 23:10:14 +01:00
|
|
|
int res;
|
2001-12-11 03:34:03 +00:00
|
|
|
restart_attached:
|
|
|
|
|
2014-01-19 21:15:05 +00:00
|
|
|
*HR = t;
|
2018-11-06 22:49:11 +00:00
|
|
|
Hi = HR+1;
|
2014-01-19 21:15:05 +00:00
|
|
|
HR += 2;
|
2018-11-06 22:49:11 +00:00
|
|
|
if ((res = copy_complex_term(Hi-2, Hi-1, share, newattvs, Hi, Hi PASS_REGS)) < 0) {
|
|
|
|
HR = Hi-1;
|
|
|
|
if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
|
|
|
|
return FALSE;
|
|
|
|
goto restart_attached;
|
2001-04-09 20:54:03 +01:00
|
|
|
}
|
2005-10-30 01:32:55 +01:00
|
|
|
return Hi[0];
|
2001-04-09 20:54:03 +01:00
|
|
|
}
|
|
|
|
#endif
|
2005-10-30 01:32:55 +01:00
|
|
|
return MkVarTerm();
|
2001-04-09 20:54:03 +01:00
|
|
|
} else if (IsPrimitiveTerm(t)) {
|
2005-10-30 01:32:55 +01:00
|
|
|
return t;
|
2001-04-09 20:54:03 +01:00
|
|
|
} else if (IsPairTerm(t)) {
|
|
|
|
Term tf;
|
|
|
|
CELL *ap;
|
|
|
|
CELL *Hi;
|
|
|
|
|
|
|
|
restart_list:
|
|
|
|
ap = RepPair(t);
|
2014-01-19 21:15:05 +00:00
|
|
|
Hi = HR;
|
|
|
|
tf = AbsPair(HR);
|
|
|
|
HR += 2;
|
2002-04-08 23:10:14 +01:00
|
|
|
{
|
|
|
|
int res;
|
2018-11-06 22:49:11 +00:00
|
|
|
if ((res = copy_complex_term(ap-1, ap+1, share, newattvs, Hi, Hi PASS_REGS)) < 0) {
|
|
|
|
HR = Hi;
|
|
|
|
if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
|
|
|
|
return FALSE;
|
|
|
|
goto restart_list;
|
2009-06-17 20:43:24 +01:00
|
|
|
} else if (res && share) {
|
2018-11-06 22:49:11 +00:00
|
|
|
HR = Hi;
|
|
|
|
return t;
|
2002-04-08 23:10:14 +01:00
|
|
|
}
|
2001-04-09 20:54:03 +01:00
|
|
|
}
|
2005-10-30 01:32:55 +01:00
|
|
|
return tf;
|
2001-04-09 20:54:03 +01:00
|
|
|
} else {
|
|
|
|
Functor f = FunctorOfTerm(t);
|
|
|
|
Term tf;
|
|
|
|
CELL *HB0;
|
|
|
|
CELL *ap;
|
|
|
|
|
|
|
|
restart_appl:
|
|
|
|
f = FunctorOfTerm(t);
|
2014-01-19 21:15:05 +00:00
|
|
|
HB0 = HR;
|
2001-04-09 20:54:03 +01:00
|
|
|
ap = RepAppl(t);
|
2014-01-19 21:15:05 +00:00
|
|
|
tf = AbsAppl(HR);
|
|
|
|
HR[0] = (CELL)f;
|
2018-11-06 22:49:11 +00:00
|
|
|
HR += 1+ArityOfFunctor(f);
|
|
|
|
if (HR > ASP-128) {
|
2014-01-19 21:15:05 +00:00
|
|
|
HR = HB0;
|
2018-11-06 22:49:11 +00:00
|
|
|
if ((t = handle_cp_overflow(-1, TR0, arity, t))== 0L)
|
|
|
|
return FALSE;
|
2006-12-27 01:32:38 +00:00
|
|
|
goto restart_appl;
|
|
|
|
} else {
|
2002-04-08 23:10:14 +01:00
|
|
|
int res;
|
2004-12-16 05:57:32 +00:00
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
if ((res = copy_complex_term(ap, ap+ArityOfFunctor(f), share, newattvs, HB0+1, HB0 PASS_REGS)) < 0) {
|
|
|
|
HR = HB0;
|
|
|
|
if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
|
|
|
|
return FALSE;
|
|
|
|
goto restart_appl;
|
2009-06-17 20:43:24 +01:00
|
|
|
} else if (res && share && FunctorOfTerm(t) != FunctorMutable) {
|
2018-11-06 22:49:11 +00:00
|
|
|
HR = HB0;
|
|
|
|
return t;
|
2002-04-08 23:10:14 +01:00
|
|
|
}
|
2001-04-09 20:54:03 +01:00
|
|
|
}
|
2005-10-30 01:32:55 +01:00
|
|
|
return tf;
|
2001-04-09 20:54:03 +01:00
|
|
|
}
|
|
|
|
}
|
2017-04-13 21:42:34 +01:00
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
Term
|
|
|
|
Yap_CopyTerm(Term inp) {
|
2011-03-07 16:02:55 +00:00
|
|
|
CACHE_REGS
|
2019-01-07 14:59:08 +00:00
|
|
|
return CopyTerm(inp, 0, TRUE, TRUE PASS_REGS);
|
2002-11-11 17:38:10 +00:00
|
|
|
}
|
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
Term
|
|
|
|
Yap_CopyTermNoShare(Term inp) {
|
2011-03-07 16:02:55 +00:00
|
|
|
CACHE_REGS
|
2019-01-07 14:59:08 +00:00
|
|
|
return CopyTerm(inp, 0, FALSE, FALSE PASS_REGS);
|
2008-08-06 18:32:22 +01:00
|
|
|
}
|
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
static Int
|
|
|
|
p_copy_term( USES_REGS1 ) /* copy term t to a new instance */
|
2001-04-09 20:54:03 +01:00
|
|
|
{
|
2017-04-13 21:42:34 +01:00
|
|
|
Term t = CopyTerm(ARG1, 2, TRUE, TRUE PASS_REGS);
|
2004-12-16 05:57:32 +00:00
|
|
|
if (t == 0L)
|
|
|
|
return FALSE;
|
|
|
|
/* be careful, there may be a stack shift here */
|
2018-11-06 22:49:11 +00:00
|
|
|
return Yap_unify(ARG2,t);
|
2001-04-09 20:54:03 +01:00
|
|
|
}
|
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
static Int
|
|
|
|
p_duplicate_term( USES_REGS1 ) /* copy term t to a new instance */
|
2001-04-09 20:54:03 +01:00
|
|
|
{
|
2017-04-13 21:42:34 +01:00
|
|
|
Term t = CopyTerm(ARG1, 2, FALSE, TRUE PASS_REGS);
|
2007-09-21 14:52:52 +01:00
|
|
|
if (t == 0L)
|
|
|
|
return FALSE;
|
|
|
|
/* be careful, there may be a stack shift here */
|
2018-11-06 22:49:11 +00:00
|
|
|
return Yap_unify(ARG2,t);
|
2001-04-09 20:54:03 +01:00
|
|
|
}
|
|
|
|
|
2017-04-13 21:42:34 +01:00
|
|
|
static Int
|
2018-11-06 22:49:11 +00:00
|
|
|
p_copy_term_no_delays( USES_REGS1 ) /* copy term t to a new instance */
|
2001-04-09 20:54:03 +01:00
|
|
|
{
|
2011-03-07 16:02:55 +00:00
|
|
|
Term t = CopyTerm(ARG1, 2, TRUE, FALSE PASS_REGS);
|
2005-02-18 21:34:02 +00:00
|
|
|
if (t == 0L) {
|
2004-12-16 05:57:32 +00:00
|
|
|
return FALSE;
|
2005-02-18 21:34:02 +00:00
|
|
|
}
|
2004-12-16 05:57:32 +00:00
|
|
|
/* be careful, there may be a stack shift here */
|
2018-11-06 22:49:11 +00:00
|
|
|
return(Yap_unify(ARG2,t));
|
2001-04-09 20:54:03 +01:00
|
|
|
}
|
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
|
|
|
|
|
2018-08-15 01:29:20 +01:00
|
|
|
typedef struct bp_frame {
|
|
|
|
CELL *start_cp;
|
|
|
|
CELL *end_cp;
|
|
|
|
CELL *to;
|
|
|
|
CELL *oldp;
|
|
|
|
CELL oldv;
|
|
|
|
} bp_frame_t;
|
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
|
|
|
|
|
2010-11-01 20:11:28 +00:00
|
|
|
typedef struct copy_frame {
|
|
|
|
CELL *start_cp;
|
|
|
|
CELL *end_cp;
|
|
|
|
CELL *to;
|
|
|
|
} copy_frame_t;
|
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
static Term
|
|
|
|
add_to_list( Term inp, Term v, Term t PASS_REGS)
|
|
|
|
{
|
2018-08-15 01:29:20 +01:00
|
|
|
Term ta[2];
|
2014-02-02 21:45:47 +00:00
|
|
|
|
|
|
|
ta[0] = v;
|
|
|
|
ta[1] = t;
|
2018-11-06 22:49:11 +00:00
|
|
|
return MkPairTerm(Yap_MkApplTerm( FunctorEq, 2, ta ), inp);
|
2014-02-02 21:45:47 +00:00
|
|
|
}
|
2018-11-05 01:24:08 +00:00
|
|
|
|
2014-02-02 21:45:47 +00:00
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
static int
|
|
|
|
break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Term vin,CELL *HLow USES_REGS)
|
|
|
|
{
|
|
|
|
|
|
|
|
struct bp_frame *to_visit0, *to_visit = (struct bp_frame *)Yap_PreAllocCodeSpace() ;
|
2018-08-15 01:29:20 +01:00
|
|
|
CELL *HB0 = HB;
|
|
|
|
tr_fr_ptr TR0 = TR;
|
|
|
|
|
|
|
|
HB = HR;
|
|
|
|
to_visit0 = to_visit;
|
2019-01-07 14:59:08 +00:00
|
|
|
loop:
|
2018-08-15 01:29:20 +01:00
|
|
|
while (pt0 < pt0_end) {
|
|
|
|
register CELL d0;
|
|
|
|
register CELL *ptd0;
|
2018-11-06 22:49:11 +00:00
|
|
|
++ pt0;
|
2018-08-15 01:29:20 +01:00
|
|
|
ptd0 = pt0;
|
|
|
|
d0 = *ptd0;
|
|
|
|
deref_head(d0, copy_term_unk);
|
2018-11-06 22:49:11 +00:00
|
|
|
copy_term_nvar:
|
|
|
|
{
|
|
|
|
if (IsPairTerm(d0)) {
|
|
|
|
CELL *ap2 = RepPair(d0);
|
2019-01-21 01:11:42 +00:00
|
|
|
//fprintf(stderr, "%d \n", RepPair(ap2[0])- ptf);
|
2018-11-06 22:49:11 +00:00
|
|
|
if (IsVarTerm(ap2[0]) && IN_BETWEEN(HB, (ap2[0]),HR)) {
|
|
|
|
Term v = MkVarTerm();
|
|
|
|
*ptf = v;
|
|
|
|
vin = add_to_list(vin, (CELL)(ptf), AbsPair(ptf) );
|
|
|
|
ptf++;
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
if (to_visit+1 >= (struct bp_frame *)AuxSp) {
|
|
|
|
goto heap_overflow;
|
|
|
|
}
|
|
|
|
*ptf++ = (CELL)(HR);
|
|
|
|
to_visit->start_cp = pt0;
|
|
|
|
to_visit->end_cp = pt0_end;
|
|
|
|
to_visit->to = ptf;
|
|
|
|
to_visit->oldp = ap2;
|
|
|
|
d0 = to_visit->oldv = ap2[0];
|
|
|
|
/* fool the system into thinking we had a variable there */
|
|
|
|
to_visit ++;
|
|
|
|
pt0 = ap2;
|
|
|
|
pt0_end = ap2 + 1;
|
|
|
|
ptf = HR;
|
|
|
|
*ap2 = AbsPair(HR);
|
|
|
|
HR += 2;
|
|
|
|
if (HR > ASP - 2048) {
|
|
|
|
goto overflow;
|
|
|
|
}
|
|
|
|
if (IsVarTerm(d0) && d0 == (CELL)ap2) {
|
|
|
|
RESET_VARIABLE(ptf);
|
|
|
|
ptf++;
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
d0 = Deref(d0);
|
|
|
|
if (!IsVarTerm(d0)) {
|
|
|
|
goto copy_term_nvar;
|
|
|
|
} else {
|
|
|
|
*ptf++ = d0;
|
|
|
|
}
|
|
|
|
continue;
|
|
|
|
} else if (IsApplTerm(d0)) {
|
|
|
|
register Functor f;
|
|
|
|
register CELL *ap2;
|
|
|
|
/* store the terms to visit */
|
|
|
|
ap2 = RepAppl(d0)+1;
|
|
|
|
f = (Functor)(ap2[-1]);
|
|
|
|
if (IsExtensionFunctor(f)) {
|
2019-01-07 14:59:08 +00:00
|
|
|
*ptf++ = d0; /* you can just copy other extensions. */
|
2018-11-06 22:49:11 +00:00
|
|
|
continue;
|
|
|
|
}
|
|
|
|
if (IsApplTerm(ap2[0]) && IN_BETWEEN(HB, RepAppl(ap2[0]),HR)) {
|
|
|
|
RESET_VARIABLE(ptf);
|
|
|
|
vin = add_to_list(vin, (CELL)ptf, ap2[0] );
|
|
|
|
ptf++;
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
|
|
|
|
arity_t arity = ArityOfFunctor(f);
|
|
|
|
if (to_visit+1 >= (struct bp_frame *)AuxSp) {
|
|
|
|
goto heap_overflow;
|
|
|
|
}
|
|
|
|
*ptf++ = AbsAppl(HR);
|
|
|
|
to_visit->start_cp = pt0;
|
|
|
|
to_visit->end_cp = pt0_end;
|
|
|
|
to_visit->to = ptf;
|
|
|
|
to_visit->oldp = ap2;
|
|
|
|
d0 = to_visit->oldv = ap2[0];
|
|
|
|
/* fool the system into thinking we had a variable there */
|
|
|
|
to_visit ++;
|
|
|
|
pt0 = ap2;
|
|
|
|
pt0_end = ap2 + (arity-1);
|
|
|
|
ptf = HR;
|
|
|
|
if (HR > ASP - 2048) {
|
|
|
|
goto overflow;
|
|
|
|
}
|
|
|
|
*ptf++ =(CELL)f;
|
|
|
|
*ap2 = AbsAppl(HR);
|
|
|
|
HR += (arity+1);
|
|
|
|
if (IsVarTerm(d0) && d0 == (CELL)(ap2)) {
|
|
|
|
RESET_VARIABLE(ptf);
|
|
|
|
ptf++;
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
d0 = Deref(d0);
|
|
|
|
if (!IsVarTerm(d0)) {
|
|
|
|
goto copy_term_nvar;
|
|
|
|
} else {
|
|
|
|
*ptf++ = d0;
|
|
|
|
}
|
|
|
|
continue;
|
2018-08-15 01:29:20 +01:00
|
|
|
} else {
|
2018-11-06 22:49:11 +00:00
|
|
|
/* just copy atoms or integers */
|
|
|
|
*ptf++ = d0;
|
2018-08-15 01:29:20 +01:00
|
|
|
}
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
|
|
|
|
derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar);
|
2018-11-06 22:49:11 +00:00
|
|
|
*ptf++ = (CELL) ptd0;
|
2018-08-15 01:29:20 +01:00
|
|
|
}
|
|
|
|
/* Do we still have compound terms to visit */
|
|
|
|
if (to_visit > to_visit0) {
|
2018-11-06 22:49:11 +00:00
|
|
|
to_visit --;
|
2018-08-15 01:29:20 +01:00
|
|
|
*to_visit->oldp = to_visit->oldv;
|
|
|
|
ptf = to_visit->to;
|
|
|
|
pt0 = to_visit->start_cp;
|
|
|
|
pt0_end = to_visit->end_cp;
|
|
|
|
goto loop;
|
|
|
|
}
|
|
|
|
|
|
|
|
/* restore our nice, friendly, term to its original state */
|
|
|
|
HB = HB0;
|
|
|
|
*vout = vin;
|
|
|
|
return true;
|
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
overflow:
|
2018-08-15 01:29:20 +01:00
|
|
|
/* oops, we're in trouble */
|
|
|
|
HR = HLow;
|
|
|
|
/* we've done it */
|
|
|
|
/* restore our nice, friendly, term to its original state */
|
|
|
|
HB = HB0;
|
|
|
|
#ifdef RATIONAL_TREES
|
|
|
|
while (to_visit > to_visit0) {
|
2018-11-06 22:49:11 +00:00
|
|
|
to_visit --;
|
2018-08-15 01:29:20 +01:00
|
|
|
pt0 = to_visit->start_cp;
|
|
|
|
pt0_end = to_visit->end_cp;
|
|
|
|
ptf = to_visit->to;
|
|
|
|
*to_visit->oldp = to_visit->oldv;
|
|
|
|
}
|
|
|
|
#endif
|
|
|
|
reset_trail(TR0);
|
|
|
|
/* follow chain of multi-assigned variables */
|
|
|
|
return -1;
|
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
heap_overflow:
|
2018-08-15 01:29:20 +01:00
|
|
|
/* oops, we're in trouble */
|
|
|
|
HR = HLow;
|
|
|
|
/* we've done it */
|
|
|
|
/* restore our nice, friendly, term to its original state */
|
|
|
|
HB = HB0;
|
|
|
|
#ifdef RATIONAL_TREES
|
|
|
|
while (to_visit > to_visit0) {
|
2018-11-06 22:49:11 +00:00
|
|
|
to_visit --;
|
2018-08-15 01:29:20 +01:00
|
|
|
pt0 = to_visit->start_cp;
|
|
|
|
pt0_end = to_visit->end_cp;
|
|
|
|
ptf = to_visit->to;
|
|
|
|
*to_visit->oldp = to_visit->oldv;
|
|
|
|
}
|
|
|
|
#endif
|
|
|
|
reset_trail(TR0);
|
2018-11-06 22:49:11 +00:00
|
|
|
LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0;
|
2018-08-15 01:29:20 +01:00
|
|
|
return -3;
|
|
|
|
}
|
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
Term
|
2018-11-06 22:49:11 +00:00
|
|
|
Yap_BreakRational(Term inp, UInt arity, Term *to, Term ti USES_REGS) {
|
2018-08-15 01:29:20 +01:00
|
|
|
Term t = Deref(inp);
|
|
|
|
Term tii = ti;
|
|
|
|
tr_fr_ptr TR0 = TR;
|
|
|
|
|
|
|
|
if (IsVarTerm(t)) {
|
|
|
|
*to = ti;
|
|
|
|
return t;
|
|
|
|
} else if (IsPrimitiveTerm(t)) {
|
2019-01-07 14:59:08 +00:00
|
|
|
*to = ti;
|
2018-08-15 01:29:20 +01:00
|
|
|
return t;
|
|
|
|
} else if (IsPairTerm(t)) {
|
|
|
|
CELL *ap;
|
|
|
|
CELL *Hi;
|
|
|
|
|
|
|
|
restart_list:
|
|
|
|
ap = RepPair(t);
|
|
|
|
Hi = HR;
|
|
|
|
HR += 2;
|
|
|
|
{
|
|
|
|
Int res;
|
2018-11-06 22:49:11 +00:00
|
|
|
if ((res = break_rationals_complex_term(ap-1, ap+1, Hi, to, ti, Hi PASS_REGS)) < 0) {
|
|
|
|
HR = Hi;
|
|
|
|
if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
|
|
|
|
return FALSE;
|
|
|
|
goto restart_list;
|
2018-08-15 01:29:20 +01:00
|
|
|
} else if (*to == tii) {
|
2018-11-06 22:49:11 +00:00
|
|
|
HR = Hi;
|
|
|
|
return t;
|
2018-08-15 01:29:20 +01:00
|
|
|
} else {
|
2018-11-06 22:49:11 +00:00
|
|
|
return AbsPair(Hi);
|
2018-08-15 01:29:20 +01:00
|
|
|
}
|
|
|
|
}
|
|
|
|
} else {
|
|
|
|
Functor f;
|
|
|
|
CELL *HB0;
|
|
|
|
CELL *ap;
|
|
|
|
|
|
|
|
restart_appl:
|
|
|
|
f = FunctorOfTerm(t);
|
|
|
|
if (IsExtensionFunctor(f)) {
|
|
|
|
*to = ti;
|
|
|
|
return t;
|
|
|
|
}
|
|
|
|
HB0 = HR;
|
|
|
|
ap = RepAppl(t);
|
|
|
|
HR[0] = (CELL)f;
|
|
|
|
arity = ArityOfFunctor(f);
|
|
|
|
HR += 1+arity;
|
2018-11-08 02:33:36 +00:00
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
{
|
2018-11-08 02:33:36 +00:00
|
|
|
Int res;
|
|
|
|
if ((res = break_rationals_complex_term(ap, ap+(arity), HB0+1, to, ti, HB0 PASS_REGS)) < 0) {
|
|
|
|
HR = HB0;
|
|
|
|
if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
|
|
|
|
return FALSE;
|
|
|
|
goto restart_appl;
|
|
|
|
} else if (*to == ti) {
|
|
|
|
HR = HB0;
|
|
|
|
return t;
|
|
|
|
} else {
|
|
|
|
return AbsAppl(HB0);
|
2018-05-15 12:36:18 +01:00
|
|
|
}
|
2011-11-02 22:44:08 +00:00
|
|
|
}
|
2018-11-08 02:33:36 +00:00
|
|
|
}
|
|
|
|
}
|
2018-11-06 22:49:11 +00:00
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
static int
|
2018-11-08 02:33:36 +00:00
|
|
|
break_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term oi, CELL *HLow USES_REGS)
|
|
|
|
{
|
2018-11-05 01:24:08 +00:00
|
|
|
|
2018-11-08 02:33:36 +00:00
|
|
|
struct copy_frame *to_visit0, *to_visit = (struct copy_frame *)Yap_PreAllocCodeSpace();
|
|
|
|
CELL *HB0 = HB;
|
|
|
|
tr_fr_ptr TR0 = TR;
|
|
|
|
CELL new = 0L;
|
|
|
|
|
|
|
|
HB = HLow;
|
|
|
|
to_visit0 = to_visit;
|
|
|
|
loop:
|
|
|
|
while (pt0 < pt0_end) {
|
|
|
|
register CELL d0;
|
|
|
|
register CELL *ptd0;
|
|
|
|
++ pt0;
|
|
|
|
ptd0 = pt0;
|
|
|
|
d0 = *ptd0;
|
|
|
|
if (new) {
|
|
|
|
/* mark cell as pointing to new copy */
|
|
|
|
/* we can only mark after reading the value of the first argument */
|
|
|
|
MaBind(pt0, new);
|
|
|
|
new = 0L;
|
2011-11-02 22:44:08 +00:00
|
|
|
}
|
2018-11-08 02:33:36 +00:00
|
|
|
deref_head(d0, break_rationals_unk);
|
|
|
|
break_rationals_nvar:
|
|
|
|
{
|
|
|
|
CELL first;
|
|
|
|
CELL *newp;
|
|
|
|
if (IsPairTerm(d0)) {
|
|
|
|
CELL *ap2 = RepPair(d0);
|
|
|
|
|
|
|
|
if (IsVarTerm(first = *ap2) && (newp = (CELL*)first) && newp >= HB && newp < HR) {
|
|
|
|
// found a marked term:
|
|
|
|
found_term:
|
|
|
|
if (!IsVarTerm(*newp)) {
|
|
|
|
Term v = (CELL)newp, t = *newp;
|
|
|
|
RESET_VARIABLE(newp);
|
|
|
|
oi = add_to_list( oi, v, t PASS_REGS);
|
|
|
|
}
|
|
|
|
*ptf++ = (CELL)newp;
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
new = (CELL)ptf;
|
|
|
|
*ptf++ = AbsPair(HR);
|
|
|
|
if (pt0 < pt0_end) {
|
|
|
|
if (to_visit+1 >= (struct copy_frame *)AuxSp) {
|
|
|
|
goto heap_overflow;
|
|
|
|
}
|
|
|
|
to_visit->start_cp = pt0;
|
|
|
|
to_visit->end_cp = pt0_end;
|
|
|
|
to_visit->to = ptf;
|
|
|
|
to_visit ++;
|
|
|
|
}
|
|
|
|
pt0 = ap2 - 1;
|
|
|
|
pt0_end = ap2 + 1;
|
|
|
|
ptf = HR;
|
|
|
|
HR += 2;
|
|
|
|
if (HR > ASP - 2048) {
|
|
|
|
goto overflow;
|
|
|
|
}
|
|
|
|
} else if (IsApplTerm(d0)) {
|
|
|
|
register Functor f;
|
|
|
|
register CELL *ap2;
|
|
|
|
/* store the terms to visit */
|
|
|
|
ap2 = RepAppl(d0);
|
|
|
|
f = (Functor)(*ap2);
|
|
|
|
if (IsExtensionFunctor(f)) {
|
|
|
|
*ptf++ = d0; /* you can just share extensions, what about DB? */
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
if (IsVarTerm(first = ap2[1]) && (newp = (CELL*)first) && newp >= HB && newp < HR) {
|
|
|
|
goto found_term;
|
|
|
|
}
|
|
|
|
// new
|
|
|
|
/* store the terms to visit */
|
|
|
|
new = (CELL)ptf;
|
|
|
|
*ptf++ = AbsAppl(HR);
|
|
|
|
if (pt0 < pt0_end) {
|
|
|
|
if (to_visit+1 >= (struct copy_frame *)AuxSp) {
|
|
|
|
goto heap_overflow;
|
|
|
|
}
|
|
|
|
to_visit->start_cp = pt0;
|
|
|
|
to_visit->end_cp = pt0_end;
|
|
|
|
to_visit->to = ptf;
|
|
|
|
to_visit ++;
|
|
|
|
}
|
|
|
|
d0 = ArityOfFunctor(f);
|
|
|
|
pt0 = ap2;
|
|
|
|
pt0_end = ap2 + d0;
|
|
|
|
/* store the functor for the new term */
|
|
|
|
HR[0] = (CELL)f;
|
|
|
|
ptf = HR+1;
|
|
|
|
HR += 1+d0;
|
|
|
|
if (HR > ASP - 2048) {
|
|
|
|
goto overflow;
|
|
|
|
}
|
|
|
|
} else {
|
|
|
|
/* just copy atoms or integers */
|
|
|
|
*ptf++ = d0;
|
2018-08-15 01:29:20 +01:00
|
|
|
}
|
2018-11-08 02:33:36 +00:00
|
|
|
continue;
|
2018-08-15 01:29:20 +01:00
|
|
|
}
|
2012-04-23 15:50:01 +01:00
|
|
|
|
2018-11-08 02:33:36 +00:00
|
|
|
derefa_body(d0, ptd0, break_rationals_unk, break_rationals_nvar);
|
|
|
|
*ptf++ = d0;
|
2011-11-02 22:44:08 +00:00
|
|
|
}
|
|
|
|
/* Do we still have compound terms to visit */
|
|
|
|
if (to_visit > to_visit0) {
|
2018-11-06 22:49:11 +00:00
|
|
|
to_visit --;
|
2018-11-08 02:33:36 +00:00
|
|
|
pt0 = to_visit->start_cp;
|
|
|
|
pt0_end = to_visit->end_cp;
|
|
|
|
ptf = to_visit->to;
|
2011-11-02 22:44:08 +00:00
|
|
|
goto loop;
|
|
|
|
}
|
|
|
|
|
2018-11-08 02:33:36 +00:00
|
|
|
/* restore our nice, friendly, term to its original state */
|
|
|
|
HB = HB0;
|
|
|
|
reset_trail(TR0);
|
|
|
|
*of = oi;
|
|
|
|
return TRUE;
|
2011-11-02 22:44:08 +00:00
|
|
|
|
2018-11-08 02:33:36 +00:00
|
|
|
overflow:
|
|
|
|
/* oops, we're in trouble */
|
|
|
|
HR = HLow;
|
|
|
|
/* we've done it */
|
|
|
|
/* restore our nice, friendly, term to its original state */
|
|
|
|
HB = HB0;
|
2011-11-02 22:44:08 +00:00
|
|
|
while (to_visit > to_visit0) {
|
2018-11-08 02:33:36 +00:00
|
|
|
to_visit --;
|
|
|
|
pt0 = to_visit->start_cp;
|
|
|
|
pt0_end = to_visit->end_cp;
|
|
|
|
ptf = to_visit->to;
|
2011-11-02 22:44:08 +00:00
|
|
|
}
|
2018-11-08 02:33:36 +00:00
|
|
|
reset_trail(TR0);
|
|
|
|
/* follow chain of multi-assigned variables */
|
|
|
|
return -1;
|
2017-04-13 21:42:34 +01:00
|
|
|
|
2018-11-08 02:33:36 +00:00
|
|
|
heap_overflow:
|
|
|
|
/* oops, we're in trouble */
|
|
|
|
HR = HLow;
|
|
|
|
/* we've done it */
|
|
|
|
/* restore our nice, friendly, term to its original state */
|
|
|
|
HB = HB0;
|
2011-11-02 22:44:08 +00:00
|
|
|
while (to_visit > to_visit0) {
|
2018-11-06 22:49:11 +00:00
|
|
|
to_visit --;
|
2018-11-08 02:33:36 +00:00
|
|
|
pt0 = to_visit->start_cp;
|
|
|
|
pt0_end = to_visit->end_cp;
|
|
|
|
ptf = to_visit->to;
|
2018-08-15 01:29:20 +01:00
|
|
|
}
|
2018-11-08 02:33:36 +00:00
|
|
|
reset_trail(TR0);
|
|
|
|
LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0;
|
|
|
|
return -3;
|
2018-08-15 01:29:20 +01:00
|
|
|
}
|
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
Term
|
2018-11-08 02:33:36 +00:00
|
|
|
Yap_BreakTerm(Term inp, UInt arity, Term *to, Term ti USES_REGS) {
|
|
|
|
Term t = Deref(inp);
|
|
|
|
tr_fr_ptr TR0 = TR;
|
2017-04-13 21:42:34 +01:00
|
|
|
|
2011-11-02 22:44:08 +00:00
|
|
|
if (IsVarTerm(t)) {
|
2018-11-08 02:33:36 +00:00
|
|
|
*to = ti;
|
|
|
|
return t;
|
|
|
|
} else if (IsPrimitiveTerm(t)) {
|
|
|
|
*to = ti;
|
|
|
|
return t;
|
|
|
|
} else {
|
|
|
|
CELL *ap;
|
|
|
|
CELL *Hi = HR;
|
2011-11-02 22:44:08 +00:00
|
|
|
|
2018-11-08 02:33:36 +00:00
|
|
|
restart_term:
|
|
|
|
ap = &t;
|
|
|
|
Hi = HR++;
|
|
|
|
{
|
|
|
|
int res;
|
|
|
|
|
|
|
|
if ((res = break_complex_term(ap-1, ap, Hi, to, ti, Hi PASS_REGS)) < 0) {
|
|
|
|
HR = Hi;
|
|
|
|
if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
|
|
|
|
return FALSE;
|
|
|
|
goto restart_term;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
return Hi[0];
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
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);
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
/*
|
2019-01-07 14:59:08 +00:00
|
|
|
FAST EXPORT ROUTINE. Export a Prolog term to something like:
|
2018-11-08 02:33:36 +00:00
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
CELL 0: offset for start of term
|
|
|
|
CELL 1: size of actual term (to be copied to stack)
|
|
|
|
CELL 2: the original term (just for reference)
|
2018-11-08 02:33:36 +00:00
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
Atoms and functors:
|
|
|
|
- atoms are either:
|
|
|
|
0 and a char *string
|
|
|
|
-1 and a wchar_t *string
|
|
|
|
- functors are a CELL with arity and a string.
|
2018-11-08 02:33:36 +00:00
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
Compiled Term.
|
2018-11-08 02:33:36 +00:00
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
*/
|
2018-11-08 02:33:36 +00:00
|
|
|
|
|
|
|
static inline
|
|
|
|
CELL *CellDifH(CELL *hptr, CELL *hlow)
|
|
|
|
{
|
|
|
|
return (CELL *)((char *)hptr-(char *)hlow);
|
|
|
|
}
|
|
|
|
|
|
|
|
#define AdjustSizeAtom(X) (((CELL)(X)+(8-1)) & ~(8-1))
|
|
|
|
|
|
|
|
static inline
|
|
|
|
CELL *AdjustSize(CELL *x, char *buf)
|
|
|
|
{
|
|
|
|
UInt offset = (char *)x-buf;
|
|
|
|
return (CELL*)(buf+AdjustSizeAtom(offset));
|
|
|
|
}
|
|
|
|
|
|
|
|
/* export an atom from the symbol table to a buffer */
|
|
|
|
static inline
|
|
|
|
Atom export_atom(Atom at, char **hpp, char *buf, size_t len)
|
|
|
|
{
|
|
|
|
char *ptr, *p0;
|
|
|
|
size_t sz;
|
|
|
|
|
|
|
|
ptr = *hpp;
|
|
|
|
ptr = (char *)AdjustSize((CELL*)ptr, buf);
|
|
|
|
|
|
|
|
p0 = ptr;
|
|
|
|
*ptr++ = 0;
|
|
|
|
sz = strlen(RepAtom(at)->StrOfAE);
|
|
|
|
if (sz + 1 >= len)
|
|
|
|
return (Atom)NULL;
|
|
|
|
strcpy(ptr, RepAtom(at)->StrOfAE);
|
|
|
|
*hpp = ptr+(sz+1);
|
|
|
|
return (Atom)(p0-buf);
|
|
|
|
}
|
|
|
|
|
|
|
|
/* place a buffer: first arity then the atom */
|
|
|
|
static inline
|
|
|
|
Functor export_functor(Functor f, char **hpp, char *buf, size_t len)
|
|
|
|
{
|
|
|
|
CELL *hptr = AdjustSize((CELL *)*hpp, buf);
|
|
|
|
UInt arity = ArityOfFunctor(f);
|
|
|
|
if (2*sizeof(CELL) >= len)
|
|
|
|
return NULL;
|
|
|
|
hptr[0] = arity;
|
|
|
|
*hpp = (char *)(hptr+1);
|
|
|
|
if (!export_atom(NameOfFunctor(f), hpp, buf, len))
|
|
|
|
return NULL;
|
|
|
|
/* increment so that it cannot be mistaken with a functor on the stack,
|
|
|
|
(increment is used as a tag ........01
|
|
|
|
*/
|
|
|
|
return (Functor)(((char *)hptr-buf)+1);
|
|
|
|
}
|
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
#define export_derefa_body(D,A,LabelUnk,LabelNonVar) \
|
|
|
|
do { \
|
|
|
|
if ((CELL *)(D) < CellDifH(HR,HLow)) { (A) = (CELL *)(D); break; } \
|
|
|
|
(A) = (CELL *)(D); \
|
|
|
|
(D) = *(CELL *)(D); \
|
|
|
|
if(!IsVarTerm(D)) goto LabelNonVar; \
|
|
|
|
LabelUnk: ; \
|
|
|
|
} while (Unsigned(A) != (D))
|
2018-11-08 02:33:36 +00:00
|
|
|
|
|
|
|
|
|
|
|
static int
|
|
|
|
export_term_to_buffer(Term inpt, char *buf, char *bptr, CELL *t0 , CELL *tf, size_t len)
|
|
|
|
{
|
|
|
|
char *td = bptr;
|
|
|
|
CELL *bf = (CELL *)buf;
|
|
|
|
if (buf + len < (char *)((CELL *)td + (tf-t0))) {
|
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
memmove((void *)td, (void *)t0, (tf-t0)* sizeof(CELL));
|
|
|
|
bf[0] = (td-buf);
|
|
|
|
bf[1] = (tf-t0);
|
|
|
|
bf[2] = inpt;
|
|
|
|
return bf[0]+sizeof(CELL)*bf[1];
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
static size_t
|
|
|
|
export_complex_term(Term tf, CELL *pt0, CELL *pt0_end, char * buf, size_t len0, int newattvs, CELL *ptf, CELL *HLow USES_REGS)
|
|
|
|
{
|
|
|
|
struct cp_frame *to_visit0, *to_visit = (struct cp_frame *)Yap_PreAllocCodeSpace();
|
|
|
|
CELL *HB0 = HB;
|
|
|
|
tr_fr_ptr TR0 = TR;
|
|
|
|
int ground = TRUE;
|
|
|
|
char *bptr = buf+ 3*sizeof(CELL);
|
|
|
|
size_t len = len0;
|
|
|
|
|
|
|
|
HB = HLow;
|
|
|
|
to_visit0 = to_visit;
|
|
|
|
loop:
|
|
|
|
while (pt0 < pt0_end) {
|
|
|
|
register CELL d0;
|
|
|
|
register CELL *ptd0;
|
|
|
|
++ pt0;
|
|
|
|
ptd0 = pt0;
|
|
|
|
d0 = *ptd0;
|
|
|
|
deref_head(d0, export_term_unk);
|
|
|
|
export_term_nvar:
|
|
|
|
{
|
|
|
|
if (IsPairTerm(d0)) {
|
|
|
|
CELL *ap2 = RepPair(d0);
|
|
|
|
if (ap2 < CellDifH(HR,HLow)) {
|
|
|
|
/* If this is newer than the current term, just reuse */
|
|
|
|
*ptf++ = d0;
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
*ptf = AbsPair(CellDifH(HR,HLow));
|
|
|
|
ptf++;
|
|
|
|
#ifdef RATIONAL_TREES
|
|
|
|
if (to_visit+1 >= (struct cp_frame *)AuxSp) {
|
|
|
|
goto heap_overflow;
|
|
|
|
}
|
|
|
|
to_visit->start_cp = pt0;
|
|
|
|
to_visit->end_cp = pt0_end;
|
|
|
|
to_visit->to = ptf;
|
|
|
|
to_visit->oldv = *pt0;
|
|
|
|
to_visit->ground = ground;
|
|
|
|
/* fool the system into thinking we had a variable there */
|
|
|
|
*pt0 = AbsPair(CellDifH(HR,HLow));
|
|
|
|
to_visit ++;
|
|
|
|
#else
|
|
|
|
if (pt0 < pt0_end) {
|
|
|
|
if (to_visit+1 >= (struct cp_frame *)AuxSp) {
|
|
|
|
goto heap_overflow;
|
|
|
|
}
|
|
|
|
to_visit->start_cp = pt0;
|
|
|
|
to_visit->end_cp = pt0_end;
|
|
|
|
to_visit->to = ptf;
|
|
|
|
to_visit->ground = ground;
|
|
|
|
to_visit ++;
|
|
|
|
}
|
|
|
|
#endif
|
|
|
|
pt0 = ap2 - 1;
|
|
|
|
pt0_end = ap2 + 1;
|
|
|
|
ptf = HR;
|
|
|
|
HR += 2;
|
|
|
|
if (HR > ASP - 2048) {
|
|
|
|
goto overflow;
|
|
|
|
}
|
|
|
|
} else if (IsApplTerm(d0)) {
|
|
|
|
register Functor f;
|
|
|
|
register CELL *ap2;
|
|
|
|
/* store the terms to visit */
|
|
|
|
ap2 = RepAppl(d0);
|
|
|
|
if (ap2 < CellDifH(HR,HLow)) {
|
|
|
|
/* If this is newer than the current term, just reuse */
|
|
|
|
*ptf++ = d0;
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
f = (Functor)(*ap2);
|
|
|
|
|
|
|
|
*ptf++ = AbsAppl(CellDifH(HR,HLow));
|
|
|
|
if (IsExtensionFunctor(f)) {
|
|
|
|
UInt sz;
|
|
|
|
|
|
|
|
/* make sure to export floats */
|
|
|
|
if (f== FunctorDouble) {
|
|
|
|
sz = sizeof(Float)/sizeof(CELL)+2;
|
|
|
|
} else if (f== FunctorLongInt) {
|
|
|
|
sz = 3;
|
|
|
|
} else if (f== FunctorString) {
|
|
|
|
sz = 3+ap2[1];
|
|
|
|
} else {
|
|
|
|
CELL *pt = ap2+1;
|
|
|
|
sz = 2+sizeof(MP_INT)+(((MP_INT *)(pt+1))->_mp_alloc*sizeof(mp_limb_t));
|
|
|
|
}
|
|
|
|
if (HR+sz > ASP - 2048) {
|
|
|
|
goto overflow;
|
|
|
|
}
|
|
|
|
memmove((void *)HR, (void *)ap2, sz*sizeof(CELL));
|
|
|
|
HR += sz;
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
/* store the terms to visit */
|
|
|
|
#ifdef RATIONAL_TREES
|
|
|
|
if (to_visit+1 >= (struct cp_frame *)AuxSp) {
|
|
|
|
goto heap_overflow;
|
|
|
|
}
|
|
|
|
to_visit->start_cp = pt0;
|
|
|
|
to_visit->end_cp = pt0_end;
|
|
|
|
to_visit->to = ptf;
|
|
|
|
to_visit->oldv = *pt0;
|
|
|
|
to_visit->ground = ground;
|
|
|
|
/* fool the system into thinking we had a variable there */
|
|
|
|
*pt0 = AbsAppl(HR);
|
|
|
|
to_visit ++;
|
|
|
|
#else
|
|
|
|
if (pt0 < pt0_end) {
|
|
|
|
if (to_visit+1 >= (struct cp_frame *)AuxSp) {
|
|
|
|
goto heap_overflow;
|
|
|
|
}
|
|
|
|
to_visit->start_cp = pt0;
|
|
|
|
to_visit->end_cp = pt0_end;
|
|
|
|
to_visit->to = ptf;
|
|
|
|
to_visit->ground = ground;
|
|
|
|
to_visit ++;
|
|
|
|
}
|
|
|
|
#endif
|
|
|
|
ground = (f != FunctorMutable);
|
|
|
|
d0 = ArityOfFunctor(f);
|
|
|
|
pt0 = ap2;
|
|
|
|
pt0_end = ap2 + d0;
|
|
|
|
/* store the functor for the new term */
|
|
|
|
ptf = HR+1;
|
|
|
|
HR += 1+d0;
|
|
|
|
if (HR > ASP - 2048) {
|
|
|
|
goto overflow;
|
|
|
|
}
|
|
|
|
ptf[-1] = (CELL)export_functor(f, &bptr, buf, len);
|
|
|
|
len = len0 - (bptr-buf);
|
|
|
|
if (HR > ASP - 2048) {
|
|
|
|
goto overflow;
|
|
|
|
}
|
|
|
|
} else {
|
|
|
|
if (IsAtomTerm(d0)) {
|
|
|
|
*ptf = MkAtomTerm(export_atom(AtomOfTerm(d0), &bptr, buf, len));
|
|
|
|
ptf++;
|
|
|
|
len = len0 - (bptr-buf);
|
|
|
|
} else {
|
|
|
|
*ptf++ = d0;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
|
|
|
|
export_derefa_body(d0, ptd0, export_term_unk, export_term_nvar);
|
|
|
|
ground = FALSE;
|
|
|
|
if (ptd0 < CellDifH(HR,HLow)) {
|
|
|
|
/* we have already found this cell */
|
|
|
|
*ptf++ = (CELL) ptd0;
|
|
|
|
} else {
|
|
|
|
#if COROUTINING
|
|
|
|
if (newattvs && IsAttachedTerm((CELL)ptd0) && FALSE) {
|
|
|
|
/* if unbound, call the standard export term routine */
|
|
|
|
struct cp_frame *bp;
|
|
|
|
|
|
|
|
CELL new;
|
|
|
|
|
|
|
|
bp = to_visit;
|
|
|
|
if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, ptf PASS_REGS)) {
|
|
|
|
goto overflow;
|
|
|
|
}
|
|
|
|
to_visit = bp;
|
|
|
|
new = *ptf;
|
|
|
|
Bind_NonAtt(ptd0, new);
|
|
|
|
ptf++;
|
|
|
|
} else {
|
|
|
|
#endif
|
|
|
|
/* first time we met this term */
|
|
|
|
*ptf = (CELL)CellDifH(ptf,HLow);
|
|
|
|
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
|
|
|
|
/* Trail overflow */
|
|
|
|
if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) {
|
|
|
|
goto trail_overflow;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
Bind_NonAtt(ptd0, (CELL)ptf);
|
|
|
|
ptf++;
|
|
|
|
#ifdef COROUTINING
|
|
|
|
}
|
|
|
|
#endif
|
|
|
|
}
|
|
|
|
}
|
|
|
|
/* Do we still have compound terms to visit */
|
|
|
|
if (to_visit > to_visit0) {
|
|
|
|
to_visit --;
|
|
|
|
pt0 = to_visit->start_cp;
|
|
|
|
pt0_end = to_visit->end_cp;
|
|
|
|
ptf = to_visit->to;
|
|
|
|
#ifdef RATIONAL_TREES
|
|
|
|
*pt0 = to_visit->oldv;
|
|
|
|
#endif
|
|
|
|
ground = (ground && to_visit->ground);
|
|
|
|
goto loop;
|
|
|
|
}
|
|
|
|
|
|
|
|
/* restore our nice, friendly, term to its original state */
|
|
|
|
clean_dirty_tr(TR0 PASS_REGS);
|
|
|
|
HB = HB0;
|
|
|
|
return export_term_to_buffer(tf, buf, bptr, HLow, HR, len0);
|
|
|
|
|
|
|
|
overflow:
|
|
|
|
/* oops, we're in trouble */
|
|
|
|
HR = HLow;
|
|
|
|
/* we've done it */
|
|
|
|
/* restore our nice, friendly, term to its original state */
|
|
|
|
HB = HB0;
|
|
|
|
#ifdef RATIONAL_TREES
|
|
|
|
while (to_visit > to_visit0) {
|
|
|
|
to_visit --;
|
|
|
|
pt0 = to_visit->start_cp;
|
|
|
|
pt0_end = to_visit->end_cp;
|
|
|
|
ptf = to_visit->to;
|
|
|
|
*pt0 = to_visit->oldv;
|
|
|
|
}
|
|
|
|
#endif
|
|
|
|
reset_trail(TR0);
|
|
|
|
/* follow chain of multi-assigned variables */
|
|
|
|
return -1;
|
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
trail_overflow:
|
2018-11-08 02:33:36 +00:00
|
|
|
/* oops, we're in trouble */
|
|
|
|
HR = HLow;
|
|
|
|
/* we've done it */
|
|
|
|
/* restore our nice, friendly, term to its original state */
|
|
|
|
HB = HB0;
|
|
|
|
#ifdef RATIONAL_TREES
|
|
|
|
while (to_visit > to_visit0) {
|
|
|
|
to_visit --;
|
|
|
|
pt0 = to_visit->start_cp;
|
|
|
|
pt0_end = to_visit->end_cp;
|
|
|
|
ptf = to_visit->to;
|
|
|
|
*pt0 = to_visit->oldv;
|
|
|
|
}
|
|
|
|
#endif
|
|
|
|
{
|
|
|
|
tr_fr_ptr oTR = TR;
|
|
|
|
reset_trail(TR0);
|
|
|
|
if (!Yap_growtrail((oTR-TR0)*sizeof(tr_fr_ptr *), TRUE)) {
|
|
|
|
return -4;
|
|
|
|
}
|
|
|
|
return -2;
|
|
|
|
}
|
|
|
|
|
|
|
|
heap_overflow:
|
|
|
|
/* oops, we're in trouble */
|
|
|
|
HR = HLow;
|
|
|
|
/* we've done it */
|
|
|
|
/* restore our nice, friendly, term to its original state */
|
|
|
|
HB = HB0;
|
|
|
|
#ifdef RATIONAL_TREES
|
|
|
|
while (to_visit > to_visit0) {
|
|
|
|
to_visit --;
|
|
|
|
pt0 = to_visit->start_cp;
|
|
|
|
pt0_end = to_visit->end_cp;
|
|
|
|
ptf = to_visit->to;
|
|
|
|
*pt0 = to_visit->oldv;
|
|
|
|
}
|
|
|
|
#endif
|
|
|
|
reset_trail(TR0);
|
|
|
|
LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0;
|
|
|
|
return -3;
|
|
|
|
}
|
|
|
|
|
|
|
|
static size_t
|
|
|
|
ExportTerm(Term inp, char * buf, size_t len, UInt arity, int newattvs USES_REGS) {
|
|
|
|
Term t = Deref(inp);
|
|
|
|
tr_fr_ptr TR0 = TR;
|
|
|
|
size_t res = 0;
|
|
|
|
CELL *Hi = HR;
|
|
|
|
|
|
|
|
do {
|
|
|
|
if (IsVarTerm(t) || IsIntTerm(t)) {
|
|
|
|
return export_term_to_buffer(t, buf, buf+ 3*sizeof(CELL), &inp, &inp, len);
|
|
|
|
}
|
|
|
|
if (IsAtomTerm(t)) {
|
|
|
|
Atom at = AtomOfTerm(t);
|
|
|
|
char *b = buf+3*sizeof(CELL);
|
|
|
|
export_atom(at, &b, b, len-3*sizeof(CELL));
|
|
|
|
return export_term_to_buffer(t, buf, b, &inp, &inp, len);
|
|
|
|
}
|
|
|
|
if ((Int)res < 0) {
|
|
|
|
HR = Hi;
|
|
|
|
TR = TR0;
|
|
|
|
if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
|
|
|
|
return res;
|
|
|
|
}
|
|
|
|
Hi = HR;
|
|
|
|
TR0 = TR;
|
|
|
|
res = export_complex_term(inp, &t-1, &t, buf, len, newattvs, Hi, Hi PASS_REGS);
|
|
|
|
} while ((Int)res < 0);
|
|
|
|
return res;
|
|
|
|
}
|
|
|
|
|
|
|
|
size_t
|
|
|
|
Yap_ExportTerm(Term inp, char * buf, size_t len, UInt arity) {
|
|
|
|
CACHE_REGS
|
2019-01-07 14:59:08 +00:00
|
|
|
return ExportTerm(inp, buf, len, arity, TRUE PASS_REGS);
|
2018-11-08 02:33:36 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
static CELL *
|
|
|
|
ShiftPtr(CELL t, char *base)
|
|
|
|
{
|
|
|
|
return (CELL *)(base+t);
|
|
|
|
}
|
|
|
|
|
|
|
|
static Atom
|
|
|
|
addAtom(Atom t, char *buf)
|
|
|
|
{
|
|
|
|
char *s = buf+(UInt)t;
|
|
|
|
|
|
|
|
if (!*s) {
|
|
|
|
return Yap_LookupAtom(s+1);
|
|
|
|
}
|
2019-01-07 14:59:08 +00:00
|
|
|
return NULL;
|
2018-11-08 02:33:36 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
static UInt
|
|
|
|
FetchFunctor(CELL *pt, char *buf)
|
|
|
|
{
|
|
|
|
CELL *ptr = (CELL *)(buf+(*pt-1));
|
|
|
|
// do arity first
|
|
|
|
UInt arity = *ptr++;
|
|
|
|
Atom name, at;
|
|
|
|
// and then an atom
|
|
|
|
ptr = AdjustSize(ptr, buf);
|
|
|
|
name = (Atom)((char *)ptr-buf);
|
|
|
|
at = addAtom(name, buf);
|
|
|
|
*pt = (CELL)Yap_MkFunctor(at, arity);
|
|
|
|
return arity;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
static CELL *import_compound(CELL *hp, char *abase, char *buf, CELL *amax);
|
|
|
|
static CELL *import_pair(CELL *hp, char *abase, char *buf, CELL *amax);
|
|
|
|
|
|
|
|
static CELL *
|
|
|
|
import_arg(CELL *hp, char *abase, char *buf, CELL *amax)
|
|
|
|
{
|
|
|
|
Term t = *hp;
|
|
|
|
if (IsVarTerm(t)) {
|
|
|
|
hp[0] = (CELL)ShiftPtr(t, abase);
|
|
|
|
} else if (IsAtomTerm(t)) {
|
|
|
|
hp[0] = MkAtomTerm(addAtom(AtomOfTerm(t), buf));
|
|
|
|
} else if (IsPairTerm(t)) {
|
|
|
|
CELL *newp = ShiftPtr((CELL)RepPair(t), abase);
|
|
|
|
hp[0] = AbsPair(newp);
|
|
|
|
if (newp > amax) {
|
|
|
|
amax = import_pair(newp, abase, buf, newp);
|
|
|
|
}
|
|
|
|
} else if (IsApplTerm(t)) {
|
|
|
|
CELL *newp = ShiftPtr((CELL)RepAppl(t), abase);
|
|
|
|
hp[0] = AbsAppl(newp);
|
|
|
|
if (newp > amax) {
|
|
|
|
amax = import_compound(newp, abase, buf, newp);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
return amax;
|
|
|
|
}
|
|
|
|
|
|
|
|
static CELL *
|
|
|
|
import_compound(CELL *hp, char *abase, char *buf, CELL *amax)
|
|
|
|
{
|
|
|
|
Functor f = (Functor)*hp;
|
|
|
|
UInt ar, i;
|
|
|
|
|
|
|
|
if (!((CELL)f & 1) && IsExtensionFunctor(f))
|
|
|
|
return amax;
|
|
|
|
ar = FetchFunctor(hp, buf);
|
|
|
|
for (i=1; i<=ar; i++) {
|
|
|
|
amax = import_arg(hp+i, abase, buf, amax);
|
|
|
|
}
|
|
|
|
return amax;
|
|
|
|
}
|
|
|
|
|
|
|
|
static CELL *
|
|
|
|
import_pair(CELL *hp, char *abase, char *buf, CELL *amax)
|
|
|
|
{
|
|
|
|
amax = import_arg(hp, abase, buf, amax);
|
|
|
|
amax = import_arg(hp+1, abase, buf, amax);
|
|
|
|
return amax;
|
|
|
|
}
|
|
|
|
|
|
|
|
Term
|
|
|
|
Yap_ImportTerm(char * buf) {
|
|
|
|
CACHE_REGS
|
2019-01-07 14:59:08 +00:00
|
|
|
CELL *bc = (CELL *)buf;
|
2018-11-08 02:33:36 +00:00
|
|
|
size_t sz = bc[1];
|
|
|
|
Term tinp, tret;
|
|
|
|
tinp = bc[2];
|
|
|
|
if (IsVarTerm(tinp))
|
|
|
|
return MkVarTerm();
|
|
|
|
else if (IsIntTerm(tinp))
|
|
|
|
return tinp;
|
|
|
|
else if (IsAtomTerm(tinp)) {
|
|
|
|
tret = MkAtomTerm(addAtom(NULL,(char *)(bc+3)));
|
|
|
|
return tret;
|
|
|
|
}
|
|
|
|
// call the gc/stack shifter mechanism
|
|
|
|
// if not enough stack available
|
|
|
|
while (HR + sz > ASP - 4096) {
|
|
|
|
if (!Yap_gcl( (sz+4096)*sizeof(CELL), PP->ArityOfPE, ENV, gc_P(P,CP))) {
|
|
|
|
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
|
|
|
|
return 0L;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
memmove(HR, buf+bc[0], sizeof(CELL)*sz);
|
|
|
|
if (IsApplTerm(tinp)) {
|
|
|
|
tret = AbsAppl(HR);
|
|
|
|
import_compound(HR, (char *)HR, buf, HR);
|
|
|
|
} else {
|
|
|
|
tret = AbsPair(HR);
|
|
|
|
import_pair(HR, (char *)HR, buf, HR);
|
|
|
|
}
|
|
|
|
HR += sz;
|
|
|
|
return tret;
|
|
|
|
}
|
|
|
|
|
|
|
|
size_t
|
|
|
|
Yap_SizeOfExportedTerm(char * buf) {
|
|
|
|
CELL *bc = (CELL *)buf;
|
|
|
|
|
|
|
|
return bc[0]+bc[1]*sizeof(CELL);
|
|
|
|
}
|
|
|
|
|
|
|
|
static Int
|
|
|
|
p_export_term( USES_REGS1 )
|
|
|
|
{
|
|
|
|
size_t sz = 4096, osz;
|
|
|
|
char *export_buf;
|
|
|
|
do {
|
|
|
|
export_buf = malloc(sz);
|
|
|
|
if (!export_buf)
|
|
|
|
return FALSE;
|
|
|
|
if (!(osz = Yap_ExportTerm(ARG1, export_buf, sz, 1))) {
|
|
|
|
sz += 4096;
|
|
|
|
free(export_buf);
|
|
|
|
}
|
|
|
|
} while (!osz);
|
|
|
|
return Yap_unify(ARG3,MkIntegerTerm(osz)) &&
|
|
|
|
Yap_unify(ARG2, MkIntegerTerm((Int)export_buf));
|
|
|
|
}
|
|
|
|
|
|
|
|
static Int
|
|
|
|
p_import_term( USES_REGS1 )
|
|
|
|
{
|
|
|
|
char *export_buf = (char *)IntegerOfTerm(Deref(ARG1));
|
|
|
|
if (!export_buf)
|
|
|
|
return FALSE;
|
|
|
|
Int out = Yap_unify(ARG2,Yap_ImportTerm(export_buf));
|
|
|
|
return out;
|
|
|
|
}
|
|
|
|
|
|
|
|
static Int
|
|
|
|
p_kill_exported_term( USES_REGS1 )
|
|
|
|
{
|
|
|
|
char *export_buf = (char *)IntegerOfTerm(Deref(ARG1));
|
|
|
|
if (!export_buf)
|
|
|
|
return FALSE;
|
|
|
|
free(export_buf);
|
|
|
|
return TRUE;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS)
|
|
|
|
{
|
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
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;
|
2018-11-08 02:33:36 +00:00
|
|
|
CELL *InitialH = HR;
|
|
|
|
CELL output = AbsPair(HR);
|
|
|
|
|
|
|
|
loop:
|
|
|
|
while (pt0 < pt0_end) {
|
|
|
|
register CELL d0;
|
|
|
|
register CELL *ptd0;
|
2019-01-07 14:59:08 +00:00
|
|
|
restart:
|
2018-11-08 02:33:36 +00:00
|
|
|
++ pt0;
|
|
|
|
ptd0 = pt0;
|
|
|
|
d0 = *ptd0;
|
2019-01-07 14:59:08 +00:00
|
|
|
list_loop:
|
2018-11-08 02:33:36 +00:00
|
|
|
deref_head(d0, vars_in_term_unk);
|
|
|
|
vars_in_term_nvar:
|
2019-01-07 14:59:08 +00:00
|
|
|
WALK_COMPLEX_TERM();
|
|
|
|
continue ;
|
2018-11-08 02:33:36 +00:00
|
|
|
|
|
|
|
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) {
|
2019-01-07 14:59:08 +00:00
|
|
|
to_visit--;
|
|
|
|
|
|
|
|
pt0 = to_visit->pt0;
|
|
|
|
pt0_end = to_visit->pt0_end;
|
|
|
|
CELL *ptd0 = to_visit->ptd0;
|
|
|
|
*ptd0 = to_visit->d0;
|
2018-11-08 02:33:36 +00:00
|
|
|
goto loop;
|
2019-01-07 14:59:08 +00:00
|
|
|
}
|
2018-11-08 02:33:36 +00:00
|
|
|
|
|
|
|
clean_tr(TR0 PASS_REGS);
|
2019-01-07 14:59:08 +00:00
|
|
|
pop_text_stack(lvl);
|
|
|
|
|
2018-11-08 02:33:36 +00:00
|
|
|
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);
|
|
|
|
}
|
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
def_trail_overflow();
|
|
|
|
def_aux_overflow();
|
|
|
|
def_global_overflow();
|
2018-11-08 02:33:36 +00:00
|
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
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 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);
|
|
|
|
if (IsVarTerm(t)) {
|
|
|
|
out = AbsPair(HR);
|
|
|
|
HR += 2;
|
|
|
|
RESET_VARIABLE(HR-2);
|
|
|
|
RESET_VARIABLE(HR-1);
|
|
|
|
Yap_unify((CELL)(HR-2),ARG1);
|
|
|
|
Yap_unify((CELL)(HR-1),ARG2);
|
|
|
|
} else if (IsPrimitiveTerm(t))
|
|
|
|
out = ARG2;
|
|
|
|
else if (IsPairTerm(t)) {
|
|
|
|
out = vars_in_complex_term(RepPair(t)-1,
|
|
|
|
RepPair(t)+1, ARG2 PASS_REGS);
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
Functor f = FunctorOfTerm(t);
|
|
|
|
out = vars_in_complex_term(RepAppl(t),
|
|
|
|
RepAppl(t)+
|
|
|
|
ArityOfFunctor(f), 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);
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
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);
|
|
|
|
if (IsVarTerm(t)) {
|
|
|
|
Term out = Yap_MkNewPairTerm();
|
|
|
|
return
|
|
|
|
Yap_unify(t,HeadOfTerm(out)) &&
|
|
|
|
Yap_unify(TermNil, TailOfTerm(out)) &&
|
|
|
|
Yap_unify(out, ARG2);
|
|
|
|
} else if (IsPrimitiveTerm(t)) {
|
|
|
|
return Yap_unify(TermNil, ARG2);
|
|
|
|
} else if (IsPairTerm(t)) {
|
|
|
|
out = vars_in_complex_term(RepPair(t)-1,
|
|
|
|
RepPair(t)+1, TermNil PASS_REGS);
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
Functor f = FunctorOfTerm(t);
|
|
|
|
out = vars_in_complex_term(RepAppl(t),
|
|
|
|
RepAppl(t)+
|
|
|
|
ArityOfFunctor(f), TermNil 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;
|
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
do {
|
2018-11-08 02:33:36 +00:00
|
|
|
t = Deref(t);
|
|
|
|
if (IsVarTerm(t)) {
|
|
|
|
return MkPairTerm(t, TermNil);
|
|
|
|
} else if (IsPrimitiveTerm(t)) {
|
|
|
|
return TermNil;
|
|
|
|
} else if (IsPairTerm(t)) {
|
|
|
|
out = vars_in_complex_term(RepPair(t)-1,
|
|
|
|
RepPair(t)+1, TermNil PASS_REGS);
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
Functor f = FunctorOfTerm(t);
|
|
|
|
out = vars_in_complex_term(RepAppl(t),
|
|
|
|
RepAppl(t)+
|
|
|
|
ArityOfFunctor(f), TermNil PASS_REGS);
|
|
|
|
}
|
|
|
|
if (out == 0L) {
|
|
|
|
if (!expand_vts( arity PASS_REGS ))
|
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
} while (out == 0L);
|
|
|
|
return out;
|
|
|
|
}
|
|
|
|
|
|
|
|
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();
|
2019-01-07 14:59:08 +00:00
|
|
|
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;
|
2018-11-08 02:33:36 +00:00
|
|
|
CELL *InitialH = HR;
|
|
|
|
CELL output = AbsPair(HR);
|
|
|
|
|
|
|
|
restart:
|
2019-01-07 14:59:08 +00:00
|
|
|
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;
|
2018-11-08 02:33:36 +00:00
|
|
|
}
|
2019-01-07 14:59:08 +00:00
|
|
|
HR[1] = AbsPair(HR+2);
|
|
|
|
HR += 2;
|
|
|
|
HR[-2] = (CELL)&(a0->Done);
|
2018-11-08 02:33:36 +00:00
|
|
|
/* store the terms to visit */
|
|
|
|
if (to_visit + 32 >= to_visit_max) {
|
|
|
|
goto aux_overflow;
|
|
|
|
}
|
2019-01-07 14:59:08 +00:00
|
|
|
ptd0 = (CELL*)a0;
|
|
|
|
to_visit->pt0 = pt0;
|
|
|
|
to_visit->pt0_end = pt0_end;
|
|
|
|
to_visit->d0 = *ptd0;
|
|
|
|
to_visit->ptd0 = ptd0;
|
2018-11-08 02:33:36 +00:00
|
|
|
to_visit ++;
|
2019-01-07 14:59:08 +00:00
|
|
|
*ptd0 = TermNil;
|
|
|
|
pt0 = ptd0;
|
|
|
|
pt0_end = &RepAttVar(ptd0)->Atts;
|
2018-11-08 02:33:36 +00:00
|
|
|
}
|
|
|
|
}
|
2019-01-07 14:59:08 +00:00
|
|
|
/* 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;
|
2018-11-08 02:33:36 +00:00
|
|
|
}
|
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
|
2018-11-08 02:33:36 +00:00
|
|
|
clean_tr(TR0 PASS_REGS);
|
2019-01-07 14:59:08 +00:00
|
|
|
pop_text_stack(lvl);
|
2018-11-08 02:33:36 +00:00
|
|
|
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);
|
|
|
|
}
|
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
def_aux_overflow();
|
|
|
|
def_global_overflow();
|
2018-11-08 02:33:36 +00:00
|
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
static Int
|
|
|
|
p_term_attvars( USES_REGS1 ) /* variables in term t */
|
|
|
|
{
|
|
|
|
Term out;
|
|
|
|
|
|
|
|
do {
|
|
|
|
Term t = Deref(ARG1);
|
|
|
|
if (IsVarTerm(t)) {
|
|
|
|
out = attvars_in_complex_term(VarOfTerm(t)-1,
|
|
|
|
VarOfTerm(t)+1, TermNil PASS_REGS);
|
|
|
|
} else if (IsPrimitiveTerm(t)) {
|
|
|
|
return Yap_unify(TermNil, ARG2);
|
|
|
|
} else if (IsPairTerm(t)) {
|
|
|
|
out = attvars_in_complex_term(RepPair(t)-1,
|
2019-01-07 14:59:08 +00:00
|
|
|
RepPair(t)+1, TermNil PASS_REGS);
|
2018-11-08 02:33:36 +00:00
|
|
|
}
|
|
|
|
else {
|
|
|
|
Functor f = FunctorOfTerm(t);
|
|
|
|
if (IsExtensionFunctor(f))
|
|
|
|
return Yap_unify(TermNil, ARG2);
|
|
|
|
out = attvars_in_complex_term(RepAppl(t),
|
2019-01-07 14:59:08 +00:00
|
|
|
RepAppl(t)+
|
|
|
|
ArityOfFunctor(f), TermNil PASS_REGS);
|
2018-11-08 02:33:36 +00:00
|
|
|
}
|
|
|
|
if (out == 0L) {
|
|
|
|
if (!expand_vts( 3 PASS_REGS ))
|
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
} while (out == 0L);
|
|
|
|
return Yap_unify(ARG2,out);
|
|
|
|
}
|
|
|
|
|
|
|
|
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 if (IsPairTerm(t)) {
|
|
|
|
out = vars_in_complex_term(RepPair(t)-1,
|
|
|
|
RepPair(t)+1, ARG3 PASS_REGS);
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
Functor f = FunctorOfTerm(t);
|
|
|
|
out = vars_in_complex_term(RepAppl(t),
|
|
|
|
RepAppl(t)+
|
|
|
|
ArityOfFunctor(f), ARG3 PASS_REGS);
|
|
|
|
}
|
|
|
|
if (out == 0L) {
|
|
|
|
if (!expand_vts( 3 PASS_REGS ))
|
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
} while (out == 0L);
|
|
|
|
|
|
|
|
return Yap_unify(ARG2,out);
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS)
|
|
|
|
{
|
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
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;
|
2018-11-08 02:33:36 +00:00
|
|
|
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);
|
|
|
|
}
|
2019-01-07 14:59:08 +00:00
|
|
|
restart:
|
2018-11-08 02:33:36 +00:00
|
|
|
while (pt0 < pt0_end) {
|
|
|
|
register CELL d0;
|
|
|
|
register CELL *ptd0;
|
|
|
|
++ pt0;
|
|
|
|
ptd0 = pt0;
|
|
|
|
d0 = *ptd0;
|
2019-01-07 14:59:08 +00:00
|
|
|
list_loop:
|
2018-11-08 02:33:36 +00:00
|
|
|
deref_head(d0, vars_within_term_unk);
|
|
|
|
vars_within_term_nvar:
|
|
|
|
{
|
2019-01-07 14:59:08 +00:00
|
|
|
WALK_COMPLEX_TERM()
|
|
|
|
else if (d0 == TermFoundVar) {
|
2018-11-08 02:33:36 +00:00
|
|
|
/* 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;
|
|
|
|
}
|
|
|
|
}
|
2019-01-07 14:59:08 +00:00
|
|
|
continue;
|
2018-11-08 02:33:36 +00:00
|
|
|
|
|
|
|
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) {
|
2019-01-07 14:59:08 +00:00
|
|
|
to_visit--;
|
|
|
|
|
|
|
|
pt0 = to_visit->pt0;
|
|
|
|
pt0_end = to_visit->pt0_end;
|
|
|
|
CELL *ptd0 = to_visit->ptd0;
|
|
|
|
*ptd0 = to_visit->d0;
|
|
|
|
goto restart;
|
2018-11-08 02:33:36 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
clean_tr(TR0 PASS_REGS);
|
2019-01-07 14:59:08 +00:00
|
|
|
pop_text_stack(lvl);
|
2018-11-08 02:33:36 +00:00
|
|
|
if (HR != InitialH) {
|
|
|
|
HR[-1] = TermNil;
|
|
|
|
return output;
|
|
|
|
} else {
|
|
|
|
return TermNil;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
def_trail_overflow();
|
|
|
|
def_aux_overflow();
|
|
|
|
def_global_overflow();
|
2018-11-08 02:33:36 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
static Int
|
|
|
|
p_variables_within_term( USES_REGS1 ) /* variables within term t */
|
|
|
|
{
|
|
|
|
Term out;
|
|
|
|
|
|
|
|
do {
|
|
|
|
Term t = Deref(ARG2);
|
|
|
|
if (IsVarTerm(t)) {
|
|
|
|
out = vars_within_complex_term(VarOfTerm(t)-1,
|
|
|
|
VarOfTerm(t), Deref(ARG1) PASS_REGS);
|
|
|
|
|
|
|
|
} else if (IsPrimitiveTerm(t))
|
|
|
|
out = TermNil;
|
|
|
|
else if (IsPairTerm(t)) {
|
|
|
|
out = vars_within_complex_term(RepPair(t)-1,
|
|
|
|
RepPair(t)+1, Deref(ARG1) PASS_REGS);
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
Functor f = FunctorOfTerm(t);
|
|
|
|
out = vars_within_complex_term(RepAppl(t),
|
2019-01-07 14:59:08 +00:00
|
|
|
RepAppl(t)+
|
2018-11-08 02:33:36 +00:00
|
|
|
ArityOfFunctor(f), 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 new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS)
|
|
|
|
{
|
2019-01-07 14:59:08 +00:00
|
|
|
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;
|
2018-11-08 02:33:36 +00:00
|
|
|
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);
|
|
|
|
}
|
2019-01-07 14:59:08 +00:00
|
|
|
restart:
|
2018-11-08 02:33:36 +00:00
|
|
|
while (pt0 < pt0_end) {
|
|
|
|
register CELL d0;
|
|
|
|
register CELL *ptd0;
|
|
|
|
++ pt0;
|
|
|
|
ptd0 = pt0;
|
|
|
|
d0 = *ptd0;
|
2019-01-07 14:59:08 +00:00
|
|
|
list_loop:
|
2018-11-08 02:33:36 +00:00
|
|
|
deref_head(d0, vars_within_term_unk);
|
|
|
|
vars_within_term_nvar:
|
|
|
|
{
|
2019-01-07 14:59:08 +00:00
|
|
|
WALK_COMPLEX_TERM();
|
|
|
|
|
2018-11-08 02:33:36 +00:00
|
|
|
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) {
|
2019-01-07 14:59:08 +00:00
|
|
|
to_visit--;
|
|
|
|
|
|
|
|
pt0 = to_visit->pt0;
|
|
|
|
pt0_end = to_visit->pt0_end;
|
|
|
|
CELL *ptd0 = to_visit->ptd0;
|
|
|
|
*ptd0 = to_visit->d0;
|
|
|
|
goto restart;
|
2018-11-08 02:33:36 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
clean_tr(TR0 PASS_REGS);
|
2019-01-07 14:59:08 +00:00
|
|
|
pop_text_stack(lvl);
|
2018-11-08 02:33:36 +00:00
|
|
|
if (HR != InitialH) {
|
|
|
|
HR[-1] = TermNil;
|
|
|
|
return output;
|
|
|
|
} else {
|
|
|
|
return TermNil;
|
|
|
|
}
|
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
def_trail_overflow();
|
|
|
|
def_aux_overflow();
|
|
|
|
def_global_overflow();
|
2018-11-08 02:33:36 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
static Int
|
|
|
|
p_new_variables_in_term( USES_REGS1 ) /* variables within term t */
|
|
|
|
{
|
|
|
|
Term out;
|
|
|
|
|
|
|
|
do {
|
|
|
|
Term t = Deref(ARG2);
|
|
|
|
if (IsVarTerm(t)) {
|
|
|
|
out = new_vars_in_complex_term(VarOfTerm(t)-1,
|
|
|
|
VarOfTerm(t), Deref(ARG1) PASS_REGS);
|
|
|
|
|
|
|
|
} else if (IsPrimitiveTerm(t))
|
|
|
|
out = TermNil;
|
|
|
|
else if (IsPairTerm(t)) {
|
|
|
|
out = new_vars_in_complex_term(RepPair(t)-1,
|
|
|
|
RepPair(t)+1, Deref(ARG1) PASS_REGS);
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
Functor f = FunctorOfTerm(t);
|
|
|
|
out = new_vars_in_complex_term(RepAppl(t),
|
2019-01-07 14:59:08 +00:00
|
|
|
RepAppl(t)+
|
|
|
|
ArityOfFunctor(f), Deref(ARG1) PASS_REGS);
|
2018-11-08 02:33:36 +00:00
|
|
|
}
|
|
|
|
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)
|
|
|
|
{
|
2019-01-07 14:59:08 +00:00
|
|
|
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;
|
2018-11-08 02:33:36 +00:00
|
|
|
CELL *InitialH = HR;
|
|
|
|
*HR++ = MkAtomTerm(AtomDollar);
|
|
|
|
|
|
|
|
to_visit0 = to_visit;
|
2019-01-07 14:59:08 +00:00
|
|
|
restart:
|
2018-11-08 02:33:36 +00:00
|
|
|
while (pt0 < pt0_end) {
|
|
|
|
register CELL d0;
|
|
|
|
register CELL *ptd0;
|
|
|
|
++ pt0;
|
|
|
|
ptd0 = pt0;
|
|
|
|
d0 = *ptd0;
|
2019-01-07 14:59:08 +00:00
|
|
|
list_loop:
|
2018-11-08 02:33:36 +00:00
|
|
|
deref_head(d0, vars_within_term_unk);
|
|
|
|
vars_within_term_nvar:
|
|
|
|
{
|
2019-01-07 14:59:08 +00:00
|
|
|
WALK_COMPLEX_TERM()
|
|
|
|
continue;
|
2018-11-08 02:33:36 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
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[0] = (CELL)ptd0;
|
|
|
|
HR ++;
|
|
|
|
/* 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) {
|
2019-01-07 14:59:08 +00:00
|
|
|
to_visit--;
|
|
|
|
|
|
|
|
pt0 = to_visit->pt0;
|
|
|
|
pt0_end = to_visit->pt0_end;
|
|
|
|
CELL *ptd0 = to_visit->ptd0;
|
|
|
|
*ptd0 = to_visit->d0;
|
|
|
|
goto restart;
|
2018-11-08 02:33:36 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
clean_tr(TR0 PASS_REGS);
|
2019-01-07 14:59:08 +00:00
|
|
|
pop_text_stack(lvl);
|
|
|
|
if (HR > InitialH+1) {
|
2018-11-08 02:33:36 +00:00
|
|
|
InitialH[0] = (CELL)Yap_MkFunctor(AtomDollar, (HR-InitialH)-1);
|
|
|
|
return AbsAppl(InitialH);
|
|
|
|
} else {
|
|
|
|
return MkAtomTerm(AtomDollar);
|
|
|
|
}
|
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
|
|
|
|
def_trail_overflow();
|
|
|
|
def_aux_overflow();
|
|
|
|
def_global_overflow();
|
2018-11-08 02:33:36 +00:00
|
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
static Term bind_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, tr_fr_ptr TR0 USES_REGS)
|
|
|
|
{
|
2019-01-07 14:59:08 +00:00
|
|
|
register CELL **to_visit0,
|
|
|
|
**to_visit = (CELL **)Yap_PreAllocCodeSpace();
|
2018-11-08 02:33:36 +00:00
|
|
|
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),
|
2019-01-07 14:59:08 +00:00
|
|
|
RepAppl(t)+1, TR0 PASS_REGS);
|
2018-11-08 02:33:36 +00:00
|
|
|
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 (IsVarTerm(t)) {
|
|
|
|
out = free_vars_in_complex_term(VarOfTerm(t)-1,
|
|
|
|
VarOfTerm(t), TR0 PASS_REGS);
|
|
|
|
|
|
|
|
} else if (IsPrimitiveTerm(t))
|
|
|
|
out = TermNil;
|
|
|
|
else if (IsPairTerm(t)) {
|
|
|
|
out = free_vars_in_complex_term(RepPair(t)-1,
|
|
|
|
RepPair(t)+1, TR0 PASS_REGS);
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
Functor f = FunctorOfTerm(t);
|
|
|
|
out = free_vars_in_complex_term(RepAppl(t),
|
2019-01-07 14:59:08 +00:00
|
|
|
RepAppl(t)+
|
2018-11-08 02:33:36 +00:00
|
|
|
ArityOfFunctor(f), 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)
|
|
|
|
{
|
2019-01-07 14:59:08 +00:00
|
|
|
int lvl = push_text_stack();
|
2018-11-08 02:33:36 +00:00
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
struct non_single_struct_t *to_visit0,
|
|
|
|
*to_visit = Malloc(1024*sizeof( struct non_single_struct_t)),
|
|
|
|
*to_visit_max;
|
2018-11-08 02:33:36 +00:00
|
|
|
register tr_fr_ptr TR0 = TR;
|
|
|
|
CELL *InitialH = HR;
|
|
|
|
CELL output = AbsPair(HR);
|
|
|
|
|
|
|
|
to_visit0 = to_visit;
|
2019-01-07 14:59:08 +00:00
|
|
|
to_visit_max = to_visit0+1024;
|
|
|
|
restart:
|
2018-11-08 02:33:36 +00:00
|
|
|
while (pt0 < pt0_end) {
|
|
|
|
register CELL d0;
|
|
|
|
register CELL *ptd0;
|
|
|
|
++ pt0;
|
|
|
|
ptd0 = pt0;
|
|
|
|
d0 = *ptd0;
|
2019-01-07 14:59:08 +00:00
|
|
|
list_loop:
|
2018-11-08 02:33:36 +00:00
|
|
|
deref_head(d0, vars_in_term_unk);
|
|
|
|
vars_in_term_nvar:
|
|
|
|
{
|
2019-01-07 14:59:08 +00:00
|
|
|
WALK_COMPLEX_TERM()
|
|
|
|
else if (d0 == TermFoundVar) {
|
2018-11-08 02:33:36 +00:00
|
|
|
CELL *pt2 = pt0;
|
|
|
|
while(IsVarTerm(*pt2))
|
|
|
|
pt2 = (CELL *)(*pt2);
|
2019-01-07 14:59:08 +00:00
|
|
|
HR[1] = AbsPair(HR+2);
|
|
|
|
HR[0] = (CELL)pt2;
|
2018-11-08 02:33:36 +00:00
|
|
|
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) {
|
2019-01-07 14:59:08 +00:00
|
|
|
to_visit--;
|
|
|
|
|
|
|
|
pt0 = to_visit->pt0;
|
|
|
|
pt0_end = to_visit->pt0_end;
|
|
|
|
CELL *ptd0 = to_visit->ptd0;
|
|
|
|
*ptd0 = to_visit->d0;
|
|
|
|
goto restart;
|
2018-11-08 02:33:36 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
clean_tr(TR0 PASS_REGS);
|
2019-01-07 14:59:08 +00:00
|
|
|
pop_text_stack(lvl);
|
2018-11-08 02:33:36 +00:00
|
|
|
if (HR != InitialH) {
|
2019-01-07 14:59:08 +00:00
|
|
|
/* close the list */
|
2018-11-14 09:35:24 +00:00
|
|
|
HR[-1] = Deref(ARG2);
|
2018-11-08 02:33:36 +00:00
|
|
|
return output;
|
|
|
|
} else {
|
|
|
|
return ARG2;
|
|
|
|
}
|
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
def_aux_overflow();
|
2018-11-08 02:33:36 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
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 if (IsPairTerm(t)) {
|
|
|
|
out = non_singletons_in_complex_term(RepPair(t)-1,
|
|
|
|
RepPair(t)+1 PASS_REGS);
|
|
|
|
} else {
|
|
|
|
out = non_singletons_in_complex_term(RepAppl(t),
|
|
|
|
RepAppl(t)+
|
|
|
|
ArityOfFunctor(FunctorOfTerm(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)
|
|
|
|
{
|
2019-01-07 14:59:08 +00:00
|
|
|
int lvl = push_text_stack();
|
2018-11-08 02:33:36 +00:00
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
struct non_single_struct_t *to_visit0,
|
|
|
|
*to_visit = Malloc(1024*sizeof( struct non_single_struct_t)),
|
|
|
|
*to_visit_max;
|
2018-11-08 02:33:36 +00:00
|
|
|
|
|
|
|
to_visit0 = to_visit;
|
2019-01-07 14:59:08 +00:00
|
|
|
to_visit_max = to_visit0+1024;
|
|
|
|
restart:
|
2018-11-08 02:33:36 +00:00
|
|
|
while (pt0 < pt0_end) {
|
|
|
|
register CELL d0;
|
|
|
|
register CELL *ptd0;
|
|
|
|
|
|
|
|
++pt0;
|
|
|
|
ptd0 = pt0;
|
|
|
|
d0 = *ptd0;
|
2019-01-07 14:59:08 +00:00
|
|
|
list_loop:
|
2018-11-08 02:33:36 +00:00
|
|
|
deref_head(d0, vars_in_term_unk);
|
|
|
|
vars_in_term_nvar:
|
2019-01-07 14:59:08 +00:00
|
|
|
WALK_COMPLEX_TERM();
|
|
|
|
continue;
|
2018-11-08 02:33:36 +00:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar);
|
|
|
|
while (to_visit > to_visit0) {
|
2019-01-07 14:59:08 +00:00
|
|
|
to_visit --;
|
|
|
|
CELL *ptd0 = to_visit->ptd0;
|
|
|
|
*ptd0 = to_visit->d0;
|
2018-11-08 02:33:36 +00:00
|
|
|
}
|
2019-01-21 01:11:42 +00:00
|
|
|
pop_text_stack(lvl);
|
|
|
|
return false;
|
2018-11-08 02:33:36 +00:00
|
|
|
}
|
|
|
|
/* Do we still have compound terms to visit */
|
|
|
|
if (to_visit > to_visit0) {
|
2019-01-07 14:59:08 +00:00
|
|
|
to_visit--;
|
|
|
|
|
|
|
|
pt0 = to_visit->pt0;
|
|
|
|
pt0_end = to_visit->pt0_end;
|
|
|
|
CELL *ptd0 = to_visit->ptd0;
|
|
|
|
*ptd0 = to_visit->d0;
|
|
|
|
goto restart;
|
2018-11-08 02:33:36 +00:00
|
|
|
}
|
2019-01-07 14:59:08 +00:00
|
|
|
pop_text_stack(lvl);
|
2019-01-21 01:11:42 +00:00
|
|
|
return true;
|
2018-11-08 02:33:36 +00:00
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
def_aux_overflow();
|
|
|
|
}
|
2018-11-08 02:33:36 +00:00
|
|
|
|
|
|
|
bool Yap_IsGroundTerm(Term t)
|
|
|
|
{
|
|
|
|
CACHE_REGS
|
2019-01-07 14:59:08 +00:00
|
|
|
while (TRUE) {
|
|
|
|
Int out;
|
2018-11-08 02:33:36 +00:00
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
if (IsVarTerm(t)) {
|
|
|
|
return FALSE;
|
|
|
|
} else if (IsPrimitiveTerm(t)) {
|
2018-11-08 02:33:36 +00:00
|
|
|
return TRUE;
|
2019-01-07 14:59:08 +00:00
|
|
|
} else if (IsPairTerm(t)) {
|
|
|
|
if ((out =ground_complex_term(RepPair(t)-1,
|
|
|
|
RepPair(t)+1 PASS_REGS)) >= 0) {
|
|
|
|
return out != 0;
|
|
|
|
}
|
|
|
|
} else {
|
|
|
|
Functor fun = FunctorOfTerm(t);
|
|
|
|
|
|
|
|
if (IsExtensionFunctor(fun))
|
|
|
|
return TRUE;
|
|
|
|
else if ((out = ground_complex_term(RepAppl(t),
|
|
|
|
RepAppl(t)+
|
|
|
|
ArityOfFunctor(fun) PASS_REGS)) >= 0) {
|
|
|
|
return out != 0;
|
|
|
|
}
|
2018-11-08 02:33:36 +00:00
|
|
|
}
|
2019-01-07 14:59:08 +00:00
|
|
|
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;
|
2018-11-08 02:33:36 +00:00
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
static Int
|
|
|
|
p_ground( USES_REGS1 ) /* ground(+T) */
|
|
|
|
{
|
|
|
|
return Yap_IsGroundTerm(Deref(ARG1));
|
|
|
|
}
|
|
|
|
|
|
|
|
static int
|
|
|
|
SizeOfExtension(Term t)
|
|
|
|
{
|
|
|
|
Functor f = FunctorOfTerm(t);
|
|
|
|
if (f== FunctorDouble) {
|
|
|
|
return 2 + sizeof(Float)/sizeof(CELL);
|
|
|
|
}
|
|
|
|
if (f== FunctorString) {
|
|
|
|
return 3 + RepAppl(t)[1];
|
|
|
|
}
|
|
|
|
if (f== FunctorLongInt) {
|
|
|
|
return 2 + sizeof(Float)/sizeof(CELL);
|
|
|
|
}
|
|
|
|
if (f== FunctorDBRef) {
|
|
|
|
return 0;
|
|
|
|
}
|
|
|
|
if (f== FunctorBigInt) {
|
|
|
|
CELL *pt = RepAppl(t)+2;
|
|
|
|
return 3+sizeof(MP_INT)+(((MP_INT *)(pt))->_mp_alloc*sizeof(mp_limb_t));
|
|
|
|
}
|
|
|
|
return 0;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
static Int sz_ground_complex_term(register CELL *pt0, register CELL *pt0_end, int ground USES_REGS)
|
|
|
|
{
|
|
|
|
|
|
|
|
register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace();
|
|
|
|
Int sz = 0;
|
|
|
|
|
|
|
|
to_visit0 = to_visit;
|
|
|
|
loop:
|
|
|
|
while (pt0 < pt0_end) {
|
|
|
|
register CELL d0;
|
|
|
|
register CELL *ptd0;
|
|
|
|
|
|
|
|
++pt0;
|
|
|
|
ptd0 = pt0;
|
|
|
|
d0 = *ptd0;
|
|
|
|
deref_head(d0, vars_in_term_unk);
|
|
|
|
vars_in_term_nvar:
|
|
|
|
{
|
|
|
|
if (IsPairTerm(d0)) {
|
|
|
|
sz += 2;
|
|
|
|
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)) {
|
|
|
|
sz += SizeOfExtension(d0);
|
|
|
|
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);
|
|
|
|
sz += (1+d0);
|
|
|
|
pt0 = ap2;
|
|
|
|
pt0_end = ap2 + d0;
|
|
|
|
}
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar);
|
|
|
|
if (!ground)
|
|
|
|
continue;
|
|
|
|
#ifdef RATIONAL_TREES
|
|
|
|
while (to_visit > to_visit0) {
|
|
|
|
to_visit -= 3;
|
|
|
|
pt0 = to_visit[0];
|
|
|
|
pt0_end = to_visit[1];
|
|
|
|
*pt0 = (CELL)to_visit[2];
|
|
|
|
}
|
|
|
|
#endif
|
|
|
|
return 0;
|
|
|
|
}
|
|
|
|
/* 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;
|
|
|
|
}
|
|
|
|
return sz;
|
|
|
|
|
|
|
|
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;
|
|
|
|
}
|
|
|
|
|
|
|
|
int
|
|
|
|
Yap_SizeGroundTerm(Term t, int ground)
|
|
|
|
{
|
|
|
|
CACHE_REGS
|
2019-01-07 14:59:08 +00:00
|
|
|
if (IsVarTerm(t)) {
|
|
|
|
if (!ground)
|
|
|
|
return 1;
|
|
|
|
return 0;
|
|
|
|
} else if (IsPrimitiveTerm(t)) {
|
2018-11-08 02:33:36 +00:00
|
|
|
return 1;
|
2019-01-07 14:59:08 +00:00
|
|
|
} else if (IsPairTerm(t)) {
|
|
|
|
int sz = sz_ground_complex_term(RepPair(t)-1, RepPair(t)+1, ground PASS_REGS);
|
|
|
|
if (sz <= 0)
|
|
|
|
return sz;
|
|
|
|
return sz+2;
|
|
|
|
} else {
|
|
|
|
int sz = 0;
|
|
|
|
Functor fun = FunctorOfTerm(t);
|
|
|
|
|
|
|
|
if (IsExtensionFunctor(fun))
|
|
|
|
return 1+ SizeOfExtension(t);
|
|
|
|
|
|
|
|
sz = sz_ground_complex_term(RepAppl(t),
|
|
|
|
RepAppl(t)+
|
|
|
|
ArityOfFunctor(fun),
|
|
|
|
ground PASS_REGS);
|
|
|
|
if (sz <= 0)
|
|
|
|
return sz;
|
|
|
|
return 1+ArityOfFunctor(fun)+sz;
|
|
|
|
}
|
2018-11-08 02:33:36 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
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 */
|
|
|
|
|
|
|
|
/* This code with max_depth == -1 will loop for infinite trees */
|
|
|
|
|
|
|
|
|
|
|
|
//-----------------------------------------------------------------------------
|
|
|
|
// MurmurHash2, by Austin Appleby
|
|
|
|
|
|
|
|
// Note - This code makes a few assumptions about how your machine behaves -
|
|
|
|
|
|
|
|
// 1. We can read a 4-byte value from any address without crashing
|
|
|
|
// 2. sizeof(int) == 4
|
|
|
|
|
|
|
|
// And it has a few limitations -
|
|
|
|
|
|
|
|
// 1. It will not work incrementally.
|
2019-01-07 14:59:08 +00:00
|
|
|
// 2. It will not produce the same results on litle-endian and big-endian
|
2018-11-08 02:33:36 +00:00
|
|
|
// machines.
|
|
|
|
|
|
|
|
static unsigned int
|
|
|
|
MurmurHashNeutral2 ( const void * key, int len, unsigned int seed )
|
|
|
|
{
|
2019-01-07 14:59:08 +00:00
|
|
|
const unsigned int m = 0x5bd1e995;
|
|
|
|
const int r = 24;
|
2018-11-08 02:33:36 +00:00
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
unsigned int h = seed ^ len;
|
2018-11-08 02:33:36 +00:00
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
const unsigned char * data = (const unsigned char *)key;
|
2018-11-08 02:33:36 +00:00
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
while(len >= 4)
|
|
|
|
{
|
|
|
|
unsigned int k;
|
2018-11-08 02:33:36 +00:00
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
k = data[0];
|
|
|
|
k |= data[1] << 8;
|
|
|
|
k |= data[2] << 16;
|
|
|
|
k |= data[3] << 24;
|
2018-11-08 02:33:36 +00:00
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
k *= m;
|
|
|
|
k ^= k >> r;
|
|
|
|
k *= m;
|
2018-11-08 02:33:36 +00:00
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
h *= m;
|
|
|
|
h ^= k;
|
2018-11-08 02:33:36 +00:00
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
data += 4;
|
|
|
|
len -= 4;
|
|
|
|
}
|
2018-11-08 02:33:36 +00:00
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
switch(len)
|
|
|
|
{
|
|
|
|
case 3: h ^= data[2] << 16;
|
|
|
|
case 2: h ^= data[1] << 8;
|
|
|
|
case 1: h ^= data[0];
|
|
|
|
h *= m;
|
|
|
|
};
|
2018-11-08 02:33:36 +00:00
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
h ^= h >> 13;
|
|
|
|
h *= m;
|
|
|
|
h ^= h >> 15;
|
2018-11-08 02:33:36 +00:00
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
return h;
|
2018-11-08 02:33:36 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
static CELL *
|
|
|
|
addAtomToHash(CELL *st, Atom at)
|
|
|
|
{
|
|
|
|
unsigned int len;
|
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
char *c = RepAtom(at)->StrOfAE;
|
|
|
|
int ulen = strlen(c);
|
|
|
|
/* fix hashing over empty atom */
|
|
|
|
if (!ulen) {
|
|
|
|
return st;
|
|
|
|
}
|
|
|
|
if (ulen % CellSize == 0) {
|
|
|
|
len = ulen/CellSize;
|
|
|
|
} else {
|
|
|
|
len = ulen/CellSize;
|
|
|
|
len++;
|
|
|
|
}
|
|
|
|
st[len-1] = 0L;
|
|
|
|
strncpy((char *)st, c, ulen);
|
2018-11-08 02:33:36 +00:00
|
|
|
return st+len;
|
|
|
|
}
|
|
|
|
|
|
|
|
typedef struct visited {
|
|
|
|
CELL *start;
|
|
|
|
CELL *end;
|
|
|
|
CELL old;
|
|
|
|
UInt vdepth;
|
|
|
|
} visited_t;
|
|
|
|
|
|
|
|
static CELL *
|
|
|
|
hash_complex_term(register CELL *pt0,
|
|
|
|
register CELL *pt0_end,
|
|
|
|
Int depth,
|
|
|
|
CELL *st,
|
|
|
|
int variant USES_REGS)
|
|
|
|
{
|
|
|
|
register visited_t *to_visit0, *to_visit = (visited_t *)Yap_PreAllocCodeSpace();
|
|
|
|
|
|
|
|
to_visit0 = to_visit;
|
|
|
|
loop:
|
|
|
|
while (pt0 < pt0_end) {
|
|
|
|
register CELL d0;
|
|
|
|
register CELL *ptd0;
|
|
|
|
++ pt0;
|
|
|
|
ptd0 = pt0;
|
|
|
|
d0 = *ptd0;
|
|
|
|
deref_head(d0, hash_complex_unk);
|
|
|
|
hash_complex_nvar:
|
|
|
|
{
|
|
|
|
if (st + 1024 >= ASP) {
|
|
|
|
goto global_overflow;
|
|
|
|
}
|
|
|
|
if (IsAtomOrIntTerm(d0)) {
|
|
|
|
if (d0 != TermFoundVar) {
|
|
|
|
if (IsAtomTerm(d0)) {
|
|
|
|
st = addAtomToHash(st, AtomOfTerm(d0));
|
|
|
|
} else {
|
|
|
|
*st++ = IntOfTerm(d0);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
continue;
|
|
|
|
} else if (IsPairTerm(d0)) {
|
|
|
|
st = addAtomToHash(st, AtomDot);
|
|
|
|
if (depth == 1)
|
|
|
|
continue;
|
|
|
|
if (to_visit + 256 >= (visited_t *)AuxSp) {
|
|
|
|
goto aux_overflow;
|
|
|
|
}
|
|
|
|
to_visit->start = pt0;
|
|
|
|
to_visit->end = pt0_end;
|
|
|
|
to_visit->old = *pt0;
|
|
|
|
to_visit->vdepth = depth;
|
|
|
|
to_visit++;
|
|
|
|
depth--;
|
|
|
|
*pt0 = TermFoundVar;
|
|
|
|
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)) {
|
|
|
|
CELL fc = (CELL)f;
|
|
|
|
|
|
|
|
switch(fc) {
|
|
|
|
|
|
|
|
case (CELL)FunctorDBRef:
|
|
|
|
*st++ = fc;
|
|
|
|
break;
|
|
|
|
case (CELL)FunctorLongInt:
|
|
|
|
*st++ = LongIntOfTerm(d0);
|
|
|
|
break;
|
|
|
|
case (CELL)FunctorString:
|
|
|
|
memmove(st, RepAppl(d0), (3+RepAppl(d0)[1])*sizeof(CELL));
|
|
|
|
st += 3+RepAppl(d0)[1];
|
|
|
|
break;
|
|
|
|
#ifdef USE_GMP
|
|
|
|
case (CELL)FunctorBigInt:
|
|
|
|
{
|
|
|
|
CELL *pt = RepAppl(d0);
|
|
|
|
Int sz =
|
|
|
|
sizeof(MP_INT)+1+
|
|
|
|
(((MP_INT *)(pt+2))->_mp_alloc*sizeof(mp_limb_t));
|
|
|
|
|
|
|
|
if (st + (1024 + sz/CellSize) >= ASP) {
|
|
|
|
goto global_overflow;
|
|
|
|
}
|
|
|
|
/* then the actual number */
|
|
|
|
memmove((void *)(st+1), (void *)(pt+1), sz);
|
|
|
|
st = st+sz/CellSize;
|
|
|
|
}
|
|
|
|
break;
|
|
|
|
#endif
|
|
|
|
case (CELL)FunctorDouble:
|
|
|
|
{
|
|
|
|
CELL *pt = RepAppl(d0);
|
|
|
|
*st++ = pt[1];
|
|
|
|
#if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
|
|
|
|
*st++ = pt[2];
|
|
|
|
#endif
|
|
|
|
break;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
st = addAtomToHash(st, NameOfFunctor(f));
|
|
|
|
if (depth == 1)
|
|
|
|
continue;
|
|
|
|
if (to_visit + 1024 >= (visited_t *)AuxSp) {
|
|
|
|
goto aux_overflow;
|
|
|
|
}
|
|
|
|
to_visit->start = pt0;
|
|
|
|
to_visit->end = pt0_end;
|
|
|
|
to_visit->old = *pt0;
|
|
|
|
to_visit->vdepth = depth;
|
|
|
|
to_visit++;
|
|
|
|
depth--;
|
|
|
|
*pt0 = TermFoundVar;
|
|
|
|
d0 = ArityOfFunctor(f);
|
|
|
|
pt0 = ap2;
|
|
|
|
pt0_end = ap2 + d0;
|
|
|
|
}
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
deref_body(d0, ptd0, hash_complex_unk, hash_complex_nvar);
|
|
|
|
if (!variant)
|
|
|
|
return NULL;
|
|
|
|
else
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
/* Do we still have compound terms to visit */
|
|
|
|
if (to_visit > to_visit0) {
|
|
|
|
to_visit--;
|
|
|
|
pt0 = to_visit->start;
|
|
|
|
pt0_end = to_visit->end;
|
|
|
|
*pt0 = to_visit->old;
|
|
|
|
depth = to_visit->vdepth;
|
|
|
|
goto loop;
|
|
|
|
}
|
|
|
|
return st;
|
|
|
|
|
|
|
|
aux_overflow:
|
|
|
|
/* unwind stack */
|
|
|
|
while (to_visit > to_visit0) {
|
|
|
|
to_visit --;
|
|
|
|
pt0 = to_visit->start;
|
|
|
|
*pt0 = to_visit->old;
|
|
|
|
}
|
|
|
|
return (CELL *)-1;
|
|
|
|
|
|
|
|
global_overflow:
|
|
|
|
/* unwind stack */
|
|
|
|
while (to_visit > to_visit0) {
|
|
|
|
to_visit --;
|
|
|
|
pt0 = to_visit->start;
|
|
|
|
*pt0 = to_visit->old;
|
|
|
|
}
|
|
|
|
return (CELL *) -2;
|
|
|
|
}
|
|
|
|
|
|
|
|
Int
|
|
|
|
Yap_TermHash(Term t, Int size, Int depth, int variant)
|
|
|
|
{
|
|
|
|
CACHE_REGS
|
2019-01-07 14:59:08 +00:00
|
|
|
unsigned int i1;
|
2018-11-08 02:33:36 +00:00
|
|
|
Term t1 = Deref(t);
|
|
|
|
|
|
|
|
while (TRUE) {
|
|
|
|
CELL *ar = hash_complex_term(&t1-1, &t1, depth, HR, FALSE PASS_REGS);
|
|
|
|
if (ar == (CELL *)-1) {
|
|
|
|
if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) {
|
|
|
|
Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, "overflow in term_hash");
|
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
t1 = Deref(ARG1);
|
|
|
|
} else if(ar == (CELL *)-2) {
|
|
|
|
if (!Yap_gcl((ASP-HR)*sizeof(CELL), 0, ENV, gc_P(P,CP))) {
|
|
|
|
Yap_Error(RESOURCE_ERROR_STACK, TermNil, "in term_hash");
|
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
t1 = Deref(ARG1);
|
|
|
|
} else if (ar == NULL) {
|
|
|
|
return FALSE;
|
|
|
|
} else {
|
|
|
|
i1 = MurmurHashNeutral2((const void *)HR, CellSize*(ar-HR),0x1a3be34a);
|
|
|
|
break;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
/* got the seed and hash from SWI-Prolog */
|
|
|
|
return i1 % size;
|
|
|
|
}
|
|
|
|
|
|
|
|
static Int
|
|
|
|
p_term_hash( USES_REGS1 )
|
|
|
|
{
|
|
|
|
unsigned int i1;
|
|
|
|
Term t1 = Deref(ARG1);
|
|
|
|
Term t2 = Deref(ARG2);
|
|
|
|
Term t3 = Deref(ARG3);
|
|
|
|
Term result;
|
|
|
|
Int size, depth;
|
|
|
|
|
|
|
|
if (IsVarTerm(t2)) {
|
|
|
|
Yap_Error(INSTANTIATION_ERROR,t2,"term_hash/4");
|
|
|
|
return(FALSE);
|
|
|
|
}
|
|
|
|
if (!IsIntegerTerm(t2)) {
|
|
|
|
Yap_Error(TYPE_ERROR_INTEGER,t2,"term_hash/4");
|
|
|
|
return(FALSE);
|
|
|
|
}
|
|
|
|
depth = IntegerOfTerm(t2);
|
|
|
|
if (depth == 0) {
|
|
|
|
if (IsVarTerm(t1)) return(TRUE);
|
|
|
|
return(Yap_unify(ARG4,MkIntTerm(0)));
|
|
|
|
}
|
|
|
|
if (IsVarTerm(t3)) {
|
|
|
|
Yap_Error(INSTANTIATION_ERROR,t3,"term_hash/4");
|
|
|
|
return(FALSE);
|
|
|
|
}
|
|
|
|
if (!IsIntegerTerm(t3)) {
|
|
|
|
Yap_Error(TYPE_ERROR_INTEGER,t3,"term_hash/4");
|
|
|
|
return(FALSE);
|
|
|
|
}
|
|
|
|
size = IntegerOfTerm(t3);
|
|
|
|
while (TRUE) {
|
|
|
|
CELL *ar = hash_complex_term(&t1-1, &t1, depth, HR, FALSE PASS_REGS);
|
|
|
|
if (ar == (CELL *)-1) {
|
|
|
|
if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) {
|
|
|
|
Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, "overflow in term_hash");
|
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
t1 = Deref(ARG1);
|
|
|
|
} else if(ar == (CELL *)-2) {
|
|
|
|
if (!Yap_gcl((ASP-HR)*sizeof(CELL), 4, ENV, gc_P(P,CP))) {
|
|
|
|
Yap_Error(RESOURCE_ERROR_STACK, TermNil, "in term_hash");
|
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
t1 = Deref(ARG1);
|
|
|
|
} else if (ar == NULL) {
|
|
|
|
return FALSE;
|
|
|
|
} else {
|
|
|
|
i1 = MurmurHashNeutral2((const void *)HR, CellSize*(ar-HR),0x1a3be34a);
|
|
|
|
break;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
/* got the seed and hash from SWI-Prolog */
|
|
|
|
result = MkIntegerTerm(i1 % size);
|
|
|
|
return Yap_unify(ARG4,result);
|
|
|
|
}
|
|
|
|
|
|
|
|
static Int
|
|
|
|
p_instantiated_term_hash( USES_REGS1 )
|
|
|
|
{
|
|
|
|
unsigned int i1;
|
|
|
|
Term t1 = Deref(ARG1);
|
|
|
|
Term t2 = Deref(ARG2);
|
|
|
|
Term t3 = Deref(ARG3);
|
|
|
|
Term result;
|
|
|
|
Int size, depth;
|
|
|
|
|
|
|
|
if (IsVarTerm(t2)) {
|
|
|
|
Yap_Error(INSTANTIATION_ERROR,t2,"term_hash/4");
|
|
|
|
return(FALSE);
|
|
|
|
}
|
|
|
|
if (!IsIntegerTerm(t2)) {
|
|
|
|
Yap_Error(TYPE_ERROR_INTEGER,t2,"term_hash/4");
|
|
|
|
return(FALSE);
|
|
|
|
}
|
|
|
|
depth = IntegerOfTerm(t2);
|
|
|
|
if (depth == 0) {
|
|
|
|
if (IsVarTerm(t1)) return(TRUE);
|
|
|
|
return(Yap_unify(ARG4,MkIntTerm(0)));
|
|
|
|
}
|
|
|
|
if (IsVarTerm(t3)) {
|
|
|
|
Yap_Error(INSTANTIATION_ERROR,t3,"term_hash/4");
|
|
|
|
return(FALSE);
|
|
|
|
}
|
|
|
|
if (!IsIntegerTerm(t3)) {
|
|
|
|
Yap_Error(TYPE_ERROR_INTEGER,t3,"term_hash/4");
|
|
|
|
return(FALSE);
|
|
|
|
}
|
|
|
|
size = IntegerOfTerm(t3);
|
|
|
|
while (TRUE) {
|
|
|
|
CELL *ar = hash_complex_term(&t1-1, &t1, depth, HR, TRUE PASS_REGS);
|
|
|
|
if (ar == (CELL *)-1) {
|
|
|
|
if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) {
|
|
|
|
Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, "overflow in term_hash");
|
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
t1 = Deref(ARG1);
|
|
|
|
} else if(ar == (CELL *)-2) {
|
|
|
|
if (!Yap_gcl((ASP-HR)*sizeof(CELL), 4, ENV, gc_P(P,CP))) {
|
|
|
|
Yap_Error(RESOURCE_ERROR_STACK, TermNil, "in term_hash");
|
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
t1 = Deref(ARG1);
|
|
|
|
} else if (ar == NULL) {
|
|
|
|
return FALSE;
|
|
|
|
} else {
|
|
|
|
i1 = MurmurHashNeutral2((const void *)HR, CellSize*(ar-HR),0x1a3be34a);
|
|
|
|
break;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
/* got the seed and hash from SWI-Prolog */
|
|
|
|
result = MkIntegerTerm(i1 % size);
|
|
|
|
return Yap_unify(ARG4,result);
|
|
|
|
}
|
|
|
|
|
|
|
|
static int variant_complex(register CELL *pt0, register CELL *pt0_end, register
|
2019-01-07 14:59:08 +00:00
|
|
|
CELL *pt1 USES_REGS)
|
2018-11-08 02:33:36 +00:00
|
|
|
{
|
|
|
|
tr_fr_ptr OLDTR = TR;
|
|
|
|
register CELL **to_visit = (CELL **)ASP;
|
|
|
|
/* make sure that unification always forces trailing */
|
|
|
|
HBREG = HR;
|
|
|
|
|
|
|
|
|
|
|
|
loop:
|
|
|
|
while (pt0 < pt0_end) {
|
|
|
|
register CELL d0, d1;
|
|
|
|
++ pt0;
|
|
|
|
++ pt1;
|
|
|
|
d0 = Derefa(pt0);
|
|
|
|
d1 = Derefa(pt1);
|
|
|
|
if (IsVarTerm(d0)) {
|
|
|
|
if (IsVarTerm(d1)) {
|
|
|
|
CELL *pt0 = VarOfTerm(d0);
|
|
|
|
CELL *pt1 = VarOfTerm(d1);
|
|
|
|
if (pt0 >= HBREG || pt1 >= HBREG) {
|
|
|
|
/* one of the variables has been found before */
|
|
|
|
if (VarOfTerm(d0)+1 == VarOfTerm(d1)) continue;
|
|
|
|
goto fail;
|
|
|
|
} else {
|
|
|
|
/* two new occurrences of the same variable */
|
|
|
|
Term n0 = MkVarTerm(), n1 = MkVarTerm();
|
|
|
|
Bind_Global(VarOfTerm(d0), n0);
|
|
|
|
Bind_Global(VarOfTerm(d1), n1);
|
|
|
|
}
|
|
|
|
continue;
|
|
|
|
} else {
|
|
|
|
goto fail;
|
|
|
|
}
|
|
|
|
} else if (IsVarTerm(d1)) {
|
|
|
|
goto fail;
|
|
|
|
} else {
|
|
|
|
if (d0 == d1) continue;
|
|
|
|
else if (IsAtomOrIntTerm(d0)) {
|
|
|
|
goto fail;
|
|
|
|
} else if (IsPairTerm(d0)) {
|
|
|
|
if (!IsPairTerm(d1)) {
|
|
|
|
goto fail;
|
|
|
|
}
|
|
|
|
#ifdef RATIONAL_TREES
|
|
|
|
/* now link the two structures so that no one else will */
|
|
|
|
/* come here */
|
|
|
|
to_visit -= 4;
|
|
|
|
if ((CELL *)to_visit < HR+1024)
|
|
|
|
goto out_of_stack;
|
|
|
|
to_visit[0] = pt0;
|
|
|
|
to_visit[1] = pt0_end;
|
|
|
|
to_visit[2] = pt1;
|
|
|
|
to_visit[3] = (CELL *)*pt0;
|
|
|
|
*pt0 = d1;
|
|
|
|
#else
|
|
|
|
/* store the terms to visit */
|
|
|
|
if (pt0 < pt0_end) {
|
|
|
|
to_visit -= 3;
|
|
|
|
if ((CELL *)to_visit < HR+1024)
|
|
|
|
goto out_of_stack;
|
|
|
|
to_visit[0] = pt0;
|
|
|
|
to_visit[1] = pt0_end;
|
|
|
|
to_visit[2] = pt1;
|
|
|
|
}
|
|
|
|
#endif
|
|
|
|
pt0 = RepPair(d0) - 1;
|
|
|
|
pt0_end = RepPair(d0) + 1;
|
|
|
|
pt1 = RepPair(d1) - 1;
|
|
|
|
continue;
|
|
|
|
} else if (IsApplTerm(d0)) {
|
|
|
|
register Functor f;
|
|
|
|
register CELL *ap2, *ap3;
|
|
|
|
if (!IsApplTerm(d1)) {
|
|
|
|
goto fail;
|
|
|
|
} else {
|
|
|
|
/* store the terms to visit */
|
|
|
|
Functor f2;
|
|
|
|
ap2 = RepAppl(d0);
|
|
|
|
ap3 = RepAppl(d1);
|
|
|
|
f = (Functor)(*ap2);
|
|
|
|
f2 = (Functor)(*ap3);
|
|
|
|
if (f != f2)
|
|
|
|
goto fail;
|
|
|
|
if (IsExtensionFunctor(f)) {
|
|
|
|
if (!unify_extension(f, d0, ap2, d1))
|
|
|
|
goto fail;
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
#ifdef RATIONAL_TREES
|
2019-01-07 14:59:08 +00:00
|
|
|
/* now link the two structures so that no one else will */
|
|
|
|
/* come here */
|
|
|
|
to_visit -= 4;
|
|
|
|
if ((CELL *)to_visit < HR+1024)
|
|
|
|
goto out_of_stack;
|
|
|
|
to_visit[0] = pt0;
|
|
|
|
to_visit[1] = pt0_end;
|
|
|
|
to_visit[2] = pt1;
|
|
|
|
to_visit[3] = (CELL *)*pt0;
|
|
|
|
*pt0 = d1;
|
2018-11-08 02:33:36 +00:00
|
|
|
#else
|
|
|
|
/* store the terms to visit */
|
|
|
|
if (pt0 < pt0_end) {
|
|
|
|
to_visit -= 3;
|
|
|
|
if ((CELL *)to_visit < HR+1024)
|
|
|
|
goto out_of_stack;
|
|
|
|
to_visit[0] = pt0;
|
|
|
|
to_visit[1] = pt0_end;
|
|
|
|
to_visit[2] = pt1;
|
|
|
|
}
|
|
|
|
#endif
|
|
|
|
d0 = ArityOfFunctor(f);
|
|
|
|
pt0 = ap2;
|
|
|
|
pt0_end = ap2 + d0;
|
|
|
|
pt1 = ap3;
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
/* Do we still have compound terms to visit */
|
|
|
|
if (to_visit < (CELL **)ASP) {
|
|
|
|
#ifdef RATIONAL_TREES
|
|
|
|
pt0 = to_visit[0];
|
|
|
|
pt0_end = to_visit[1];
|
|
|
|
pt1 = to_visit[2];
|
|
|
|
*pt0 = (CELL)to_visit[3];
|
|
|
|
to_visit += 4;
|
|
|
|
#else
|
|
|
|
pt0 = to_visit[0];
|
|
|
|
pt0_end = to_visit[1];
|
|
|
|
pt1 = to_visit[2];
|
|
|
|
to_visit += 3;
|
|
|
|
#endif
|
|
|
|
goto loop;
|
|
|
|
}
|
|
|
|
|
|
|
|
HR = HBREG;
|
|
|
|
/* untrail all bindings made by variant */
|
|
|
|
while (TR != (tr_fr_ptr)OLDTR) {
|
|
|
|
CELL *pt1 = (CELL *) TrailTerm(--TR);
|
|
|
|
RESET_VARIABLE(pt1);
|
|
|
|
}
|
|
|
|
HBREG = B->cp_h;
|
|
|
|
return TRUE;
|
|
|
|
|
|
|
|
out_of_stack:
|
|
|
|
HR = HBREG;
|
|
|
|
/* untrail all bindings made by variant */
|
|
|
|
#ifdef RATIONAL_TREES
|
|
|
|
while (to_visit < (CELL **)ASP) {
|
|
|
|
pt0 = to_visit[0];
|
|
|
|
pt0_end = to_visit[1];
|
|
|
|
pt1 = to_visit[2];
|
|
|
|
*pt0 = (CELL)to_visit[3];
|
|
|
|
to_visit += 4;
|
|
|
|
}
|
|
|
|
#endif
|
|
|
|
while (TR != (tr_fr_ptr)OLDTR) {
|
|
|
|
CELL *pt1 = (CELL *) TrailTerm(--TR);
|
|
|
|
RESET_VARIABLE(pt1);
|
|
|
|
}
|
|
|
|
HBREG = B->cp_h;
|
|
|
|
return -1;
|
|
|
|
|
|
|
|
|
|
|
|
fail:
|
|
|
|
/* failure */
|
|
|
|
HR = HBREG;
|
|
|
|
#ifdef RATIONAL_TREES
|
|
|
|
while (to_visit < (CELL **)ASP) {
|
|
|
|
pt0 = to_visit[0];
|
|
|
|
pt0_end = to_visit[1];
|
|
|
|
pt1 = to_visit[2];
|
|
|
|
*pt0 = (CELL)to_visit[3];
|
|
|
|
to_visit += 4;
|
|
|
|
}
|
|
|
|
#endif
|
|
|
|
/* untrail all bindings made by variant */
|
|
|
|
while (TR != (tr_fr_ptr)OLDTR) {
|
|
|
|
CELL *pt1 = (CELL *) TrailTerm(--TR);
|
|
|
|
RESET_VARIABLE(pt1);
|
|
|
|
}
|
|
|
|
HBREG = B->cp_h;
|
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
|
|
|
|
static bool
|
|
|
|
is_variant(Term t1, Term t2, int parity USES_REGS)
|
|
|
|
{
|
|
|
|
int out;
|
|
|
|
|
|
|
|
if (t1 == t2)
|
|
|
|
return true;
|
|
|
|
if (IsVarTerm(t1)) {
|
|
|
|
if (IsVarTerm(t2))
|
|
|
|
return true;
|
|
|
|
return false;
|
|
|
|
} else if (IsVarTerm(t2))
|
|
|
|
return false;
|
|
|
|
if (IsAtomOrIntTerm(t1)) {
|
|
|
|
return(t1 == t2);
|
|
|
|
}
|
|
|
|
if (IsPairTerm(t1)) {
|
|
|
|
if (IsPairTerm(t2)) {
|
|
|
|
out = variant_complex(RepPair(t1)-1,
|
|
|
|
RepPair(t1)+1,
|
|
|
|
RepPair(t2)-1 PASS_REGS);
|
|
|
|
if (out < 0) goto error;
|
|
|
|
return out != 0;
|
|
|
|
}
|
|
|
|
else return false;
|
|
|
|
}
|
|
|
|
if (!IsApplTerm(t2)) {
|
|
|
|
return false;
|
|
|
|
} else {
|
|
|
|
Functor f1 = FunctorOfTerm(t1);
|
|
|
|
|
|
|
|
if (f1 != FunctorOfTerm(t2)) return(FALSE);
|
|
|
|
if (IsExtensionFunctor(f1)) {
|
|
|
|
return(unify_extension(f1, t1, RepAppl(t1), t2));
|
|
|
|
}
|
|
|
|
out = variant_complex(RepAppl(t1),
|
|
|
|
RepAppl(t1)+ArityOfFunctor(f1),
|
|
|
|
RepAppl(t2) PASS_REGS);
|
|
|
|
if (out < 0) goto error;
|
|
|
|
return out != 0;
|
|
|
|
}
|
|
|
|
error:
|
|
|
|
if (out == -1) {
|
|
|
|
if (!Yap_gcl((ASP-HR)*sizeof(CELL), parity, ENV, gc_P(P,CP))) {
|
|
|
|
Yap_Error(RESOURCE_ERROR_STACK, TermNil, "in variant");
|
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
return is_variant(t1, t2, parity PASS_REGS);
|
|
|
|
}
|
|
|
|
return false;
|
|
|
|
}
|
|
|
|
|
|
|
|
bool
|
|
|
|
Yap_Variant(Term t1, Term t2)
|
|
|
|
{
|
|
|
|
CACHE_REGS
|
2019-01-07 14:59:08 +00:00
|
|
|
return is_variant(t1, t2, 0 PASS_REGS);
|
2018-11-08 02:33:36 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
static Int
|
|
|
|
p_variant( USES_REGS1 ) /* variant terms t1 and t2 */
|
|
|
|
{
|
|
|
|
return is_variant(Deref(ARG1), Deref(ARG2), 2 PASS_REGS);
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
static int subsumes_complex(register CELL *pt0, register CELL *pt0_end, register
|
2019-01-07 14:59:08 +00:00
|
|
|
CELL *pt1 USES_REGS)
|
2018-11-08 02:33:36 +00:00
|
|
|
{
|
|
|
|
register CELL **to_visit = (CELL **)ASP;
|
|
|
|
tr_fr_ptr OLDTR = TR, new_tr;
|
|
|
|
UInt write_mode = TRUE;
|
|
|
|
|
|
|
|
|
|
|
|
HBREG = HR;
|
|
|
|
loop:
|
|
|
|
while (pt0 < pt0_end) {
|
|
|
|
register CELL d0, d1;
|
|
|
|
Int our_write_mode = write_mode;
|
|
|
|
|
|
|
|
++ pt0;
|
|
|
|
++ pt1;
|
|
|
|
/* this is a version of Derefa that checks whether we are trying to
|
|
|
|
do something evil */
|
|
|
|
{
|
|
|
|
CELL *npt0 = pt0;
|
|
|
|
|
|
|
|
restart_d0:
|
|
|
|
if (npt0 >= HBREG) {
|
|
|
|
our_write_mode = FALSE;
|
|
|
|
}
|
|
|
|
d0 = *npt0;
|
|
|
|
if (IsVarTerm(d0) &&
|
|
|
|
d0 != (CELL)npt0
|
|
|
|
) {
|
|
|
|
npt0 = (CELL *)d0;
|
|
|
|
goto restart_d0;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
{
|
|
|
|
CELL *npt1 = pt1;
|
|
|
|
|
|
|
|
restart_d1:
|
|
|
|
d1 = *npt1;
|
|
|
|
if (IsVarTerm(d1)
|
|
|
|
&& d1 != (CELL)npt1
|
|
|
|
) {
|
|
|
|
/* never dereference through a variable from the left-side */
|
|
|
|
if (npt1 >= HBREG) {
|
|
|
|
goto fail;
|
|
|
|
} else {
|
|
|
|
npt1 = (CELL *)d1;
|
|
|
|
goto restart_d1;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
if (IsVarTerm(d0)) {
|
|
|
|
if (our_write_mode) {
|
|
|
|
/* generate a new binding */
|
|
|
|
CELL *pt0 = VarOfTerm(d0);
|
|
|
|
Term new = MkVarTerm();
|
|
|
|
|
|
|
|
Bind_Global(pt0, new);
|
|
|
|
if (d0 != d1) { /* avoid loops */
|
|
|
|
Bind_Global(VarOfTerm(new), d1);
|
|
|
|
if (Yap_rational_tree_loop(VarOfTerm(new)-1,VarOfTerm(new),(CELL **)AuxSp,(CELL **)AuxBase))
|
|
|
|
goto fail;
|
|
|
|
}
|
|
|
|
} else {
|
|
|
|
if (d0 == d1) continue;
|
|
|
|
goto fail;
|
|
|
|
}
|
|
|
|
continue;
|
|
|
|
} else if (IsVarTerm(d1)) {
|
|
|
|
goto fail;
|
|
|
|
} else {
|
|
|
|
if (d0 == d1) continue;
|
|
|
|
else if (IsAtomOrIntTerm(d0)) {
|
|
|
|
goto fail;
|
|
|
|
} else if (IsPairTerm(d0)) {
|
|
|
|
if (!IsPairTerm(d1)) {
|
|
|
|
goto fail;
|
|
|
|
}
|
|
|
|
#ifdef RATIONAL_TREES
|
|
|
|
/* now link the two structures so that no one else will */
|
|
|
|
/* come here */
|
|
|
|
to_visit -= 5;
|
|
|
|
to_visit[0] = pt0;
|
|
|
|
to_visit[1] = pt0_end;
|
|
|
|
to_visit[2] = pt1;
|
|
|
|
to_visit[3] = (CELL *)*pt0;
|
|
|
|
to_visit[4] = (CELL *)write_mode;
|
|
|
|
*pt0 = d1;
|
|
|
|
#else
|
|
|
|
/* store the terms to visit */
|
|
|
|
if (pt0 < pt0_end) {
|
|
|
|
to_visit -= 4;
|
|
|
|
to_visit[0] = pt0;
|
|
|
|
to_visit[1] = pt0_end;
|
|
|
|
to_visit[2] = pt1;
|
|
|
|
to_visit[3] = (CELL *)write_mode;
|
|
|
|
}
|
|
|
|
#endif
|
|
|
|
write_mode = our_write_mode;
|
|
|
|
pt0 = RepPair(d0) - 1;
|
|
|
|
pt0_end = RepPair(d0) + 1;
|
|
|
|
pt1 = RepPair(d1) - 1;
|
|
|
|
continue;
|
|
|
|
} else if (IsApplTerm(d0)) {
|
|
|
|
register Functor f;
|
|
|
|
register CELL *ap2, *ap3;
|
|
|
|
if (!IsApplTerm(d1)) {
|
|
|
|
goto fail;
|
|
|
|
} else {
|
|
|
|
/* store the terms to visit */
|
|
|
|
Functor f2;
|
|
|
|
ap2 = RepAppl(d0);
|
|
|
|
ap3 = RepAppl(d1);
|
|
|
|
f = (Functor)(*ap2);
|
|
|
|
f2 = (Functor)(*ap3);
|
|
|
|
if (f != f2)
|
|
|
|
goto fail;
|
|
|
|
if (IsExtensionFunctor(f)) {
|
|
|
|
if (!unify_extension(f, d0, ap2, d1))
|
|
|
|
goto fail;
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
#ifdef RATIONAL_TREES
|
|
|
|
/* now link the two structures so that no one else will */
|
|
|
|
/* come here */
|
|
|
|
to_visit -= 5;
|
|
|
|
to_visit[0] = pt0;
|
|
|
|
to_visit[1] = pt0_end;
|
|
|
|
to_visit[2] = pt1;
|
|
|
|
to_visit[3] = (CELL *)*pt0;
|
|
|
|
to_visit[4] = (CELL *)write_mode;
|
|
|
|
*pt0 = d1;
|
|
|
|
#else
|
|
|
|
/* store the terms to visit */
|
|
|
|
if (pt0 < pt0_end) {
|
|
|
|
to_visit -= 4;
|
|
|
|
to_visit[0] = pt0;
|
|
|
|
to_visit[1] = pt0_end;
|
|
|
|
to_visit[2] = pt1;
|
|
|
|
to_visit[3] = (CELL *)write_mode;
|
|
|
|
}
|
|
|
|
#endif
|
|
|
|
write_mode = our_write_mode;
|
|
|
|
d0 = ArityOfFunctor(f);
|
|
|
|
pt0 = ap2;
|
|
|
|
pt0_end = ap2 + d0;
|
|
|
|
pt1 = ap3;
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
/* Do we still have compound terms to visit */
|
|
|
|
if (to_visit < (CELL **)ASP) {
|
|
|
|
#ifdef RATIONAL_TREES
|
|
|
|
pt0 = to_visit[0];
|
|
|
|
pt0_end = to_visit[1];
|
|
|
|
pt1 = to_visit[2];
|
|
|
|
*pt0 = (CELL)to_visit[3];
|
|
|
|
write_mode = (Int)to_visit[ 4];
|
|
|
|
to_visit += 5;
|
|
|
|
#else
|
|
|
|
pt0 = to_visit[0];
|
|
|
|
pt0_end = to_visit[1];
|
|
|
|
pt1 = to_visit[2];
|
|
|
|
write_mode = (UInt)to_visit[3];
|
|
|
|
to_visit += 4;
|
|
|
|
#endif
|
|
|
|
goto loop;
|
|
|
|
}
|
|
|
|
|
|
|
|
HR = HBREG;
|
|
|
|
/* get rid of intermediate variables */
|
|
|
|
new_tr = TR;
|
|
|
|
while (TR != OLDTR) {
|
|
|
|
/* cell we bound */
|
|
|
|
CELL *pt1 = (CELL *) TrailTerm(--TR);
|
|
|
|
/* cell we created */
|
|
|
|
CELL *npt1 = (CELL *)*pt1;
|
|
|
|
/* shorten the chain */
|
|
|
|
if (IsVarTerm(*pt1) && IsUnboundVar(pt1)) {
|
|
|
|
RESET_VARIABLE(pt1);
|
|
|
|
} else {
|
|
|
|
*pt1 = *npt1;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
TR = new_tr;
|
|
|
|
HBREG = B->cp_h;
|
|
|
|
return TRUE;
|
|
|
|
|
|
|
|
fail:
|
|
|
|
HR = HBREG;
|
|
|
|
#ifdef RATIONAL_TREES
|
|
|
|
while (to_visit < (CELL **)ASP) {
|
|
|
|
pt0 = to_visit[0];
|
|
|
|
pt0_end = to_visit[1];
|
|
|
|
pt1 = to_visit[2];
|
|
|
|
*pt0 = (CELL)to_visit[3];
|
|
|
|
to_visit += 5;
|
|
|
|
}
|
|
|
|
#endif
|
|
|
|
/* untrail all bindings made by variant */
|
|
|
|
while (TR != (tr_fr_ptr)OLDTR) {
|
|
|
|
CELL *pt1 = (CELL *) TrailTerm(--TR);
|
|
|
|
RESET_VARIABLE(pt1);
|
|
|
|
}
|
|
|
|
HBREG = B->cp_h;
|
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
|
|
|
|
static Int
|
|
|
|
p_subsumes( USES_REGS1 ) /* subsumes terms t1 and t2 */
|
|
|
|
{
|
|
|
|
Term t1 = Deref(ARG1);
|
|
|
|
Term t2 = Deref(ARG2);
|
|
|
|
|
|
|
|
if (t1 == t2)
|
|
|
|
return (TRUE);
|
|
|
|
if (IsVarTerm(t1)) {
|
|
|
|
YapBind(VarOfTerm(t1), t2);
|
|
|
|
if (Yap_rational_tree_loop(VarOfTerm(t1)-1,VarOfTerm(t1),(CELL **)AuxSp,(CELL **)AuxBase))
|
|
|
|
return FALSE;
|
|
|
|
return TRUE;
|
|
|
|
} else if (IsVarTerm(t2))
|
|
|
|
return(FALSE);
|
|
|
|
if (IsAtomOrIntTerm(t1)) {
|
|
|
|
return(t1 == t2);
|
|
|
|
}
|
|
|
|
if (IsPairTerm(t1)) {
|
|
|
|
if (IsPairTerm(t2)) {
|
|
|
|
return(subsumes_complex(RepPair(t1)-1,
|
2019-01-07 14:59:08 +00:00
|
|
|
RepPair(t1)+1,
|
|
|
|
RepPair(t2)-1 PASS_REGS));
|
2018-11-08 02:33:36 +00:00
|
|
|
}
|
|
|
|
else return (FALSE);
|
|
|
|
} else {
|
|
|
|
Functor f1;
|
|
|
|
|
|
|
|
if (!IsApplTerm(t2)) return(FALSE);
|
|
|
|
f1 = FunctorOfTerm(t1);
|
|
|
|
if (f1 != FunctorOfTerm(t2))
|
|
|
|
return(FALSE);
|
|
|
|
if (IsExtensionFunctor(f1)) {
|
|
|
|
return(unify_extension(f1, t1, RepAppl(t1), t2));
|
|
|
|
}
|
|
|
|
return(subsumes_complex(RepAppl(t1),
|
2019-01-07 14:59:08 +00:00
|
|
|
RepAppl(t1)+ArityOfFunctor(f1),
|
|
|
|
RepAppl(t2) PASS_REGS));
|
2018-11-08 02:33:36 +00:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
static int term_subsumer_complex(register CELL *pt0, register CELL *pt0_end, register
|
|
|
|
CELL *pt1, CELL *npt USES_REGS)
|
|
|
|
{
|
|
|
|
register CELL **to_visit = (CELL **)ASP;
|
|
|
|
tr_fr_ptr OLDTR = TR;
|
|
|
|
int out;
|
|
|
|
CELL *bindings = NULL, *tbindings = NULL;
|
|
|
|
HB = HR;
|
|
|
|
|
|
|
|
loop:
|
|
|
|
while (pt0 < pt0_end) {
|
|
|
|
register CELL d0, d1;
|
|
|
|
|
|
|
|
++ pt0;
|
|
|
|
++ pt1;
|
|
|
|
d0 = Derefa(pt0);
|
|
|
|
d1 = Derefa(pt1);
|
|
|
|
if (d0 == d1) {
|
|
|
|
*npt++ = d0;
|
|
|
|
continue;
|
|
|
|
} else if (IsVarTerm(d0)) {
|
|
|
|
CELL *match, *omatch = NULL;
|
|
|
|
|
|
|
|
match = VarOfTerm(d0);
|
|
|
|
if (match >= HB) {
|
|
|
|
while (match >= HB) {
|
|
|
|
/* chained to a sequence */
|
|
|
|
if (Yap_eq(d1, match[1]) ) {
|
|
|
|
*npt++ = match[2];
|
|
|
|
break;
|
|
|
|
}
|
|
|
|
omatch = match;
|
|
|
|
match = (CELL *)match[3];
|
|
|
|
}
|
|
|
|
/* found a match */
|
|
|
|
if (match >= HB)
|
|
|
|
continue;
|
|
|
|
/* could not find a match, add to end of chain */
|
|
|
|
RESET_VARIABLE(HR); /* key */
|
|
|
|
HR[1] = d1; /* comparison value */
|
|
|
|
HR[2] = (CELL)npt; /* new value */
|
|
|
|
HR[3] = (CELL)match; /* end of chain points back to first cell */
|
|
|
|
omatch[3] = (CELL)HR;
|
|
|
|
HR+=4;
|
|
|
|
RESET_VARIABLE(npt);
|
|
|
|
npt++;
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
|
|
|
|
goto trail_overflow;
|
|
|
|
}
|
|
|
|
RESET_VARIABLE(HR);
|
|
|
|
HR[1] = d1;
|
|
|
|
HR[2] = (CELL)npt;
|
|
|
|
HR[3] = d0;
|
|
|
|
YapBind(VarOfTerm(d0), (CELL)HR);
|
|
|
|
HR+=4;
|
|
|
|
RESET_VARIABLE(npt);
|
|
|
|
npt++;
|
|
|
|
continue;
|
|
|
|
} else if (IsPairTerm(d0) && IsPairTerm(d1)) {
|
|
|
|
CELL *match = bindings;
|
|
|
|
|
|
|
|
while (match) {
|
|
|
|
if (match[0] == d0 && match[1] == d1) {
|
|
|
|
*npt++ = match[2];
|
|
|
|
break;
|
|
|
|
}
|
|
|
|
match = (CELL *)match[3];
|
|
|
|
}
|
|
|
|
if (match) {
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
if (bindings) {
|
|
|
|
*tbindings = (CELL)HR;
|
|
|
|
} else {
|
|
|
|
bindings = HR;
|
|
|
|
}
|
|
|
|
HR[0] = d0;
|
|
|
|
HR[1] = d1;
|
|
|
|
HR[2] = AbsPair(HR+4);
|
|
|
|
HR[3] = (CELL)NULL;
|
|
|
|
tbindings = HR+3;
|
|
|
|
HR+=4;
|
|
|
|
*npt++ = AbsPair(HR);
|
|
|
|
#ifdef RATIONAL_TREES
|
|
|
|
/* now link the two structures so that no one else will */
|
|
|
|
/* come here */
|
|
|
|
to_visit -= 5;
|
|
|
|
to_visit[0] = pt0;
|
|
|
|
to_visit[1] = pt0_end;
|
|
|
|
to_visit[2] = pt1;
|
|
|
|
to_visit[3] = tbindings;
|
|
|
|
to_visit[4] = npt;
|
|
|
|
#else
|
|
|
|
/* store the terms to visit */
|
|
|
|
if (pt0 < pt0_end) {
|
|
|
|
to_visit -= 4;
|
|
|
|
to_visit[0] = pt0;
|
|
|
|
to_visit[1] = pt0_end;
|
|
|
|
to_visit[2] = pt1;
|
|
|
|
to_visit[3] = npt;
|
|
|
|
}
|
|
|
|
#endif
|
|
|
|
pt0 = RepPair(d0) - 1;
|
|
|
|
pt0_end = RepPair(d0) + 1;
|
|
|
|
pt1 = RepPair(d1) - 1;
|
|
|
|
npt = HR;
|
|
|
|
HR += 2;
|
|
|
|
if (HR > (CELL *)to_visit -1024)
|
|
|
|
goto stack_overflow;
|
|
|
|
continue;
|
|
|
|
} else if (IsApplTerm(d0) && IsApplTerm(d1)) {
|
|
|
|
CELL *ap2 = RepAppl(d0);
|
|
|
|
CELL *ap3 = RepAppl(d1);
|
|
|
|
Functor f = (Functor)(*ap2);
|
|
|
|
Functor f2 = (Functor)(*ap3);
|
|
|
|
if (f == f2) {
|
|
|
|
CELL *match = bindings;
|
|
|
|
|
|
|
|
if (IsExtensionFunctor(f)) {
|
|
|
|
if (unify_extension(f, d0, ap2, d1)) {
|
|
|
|
*npt++ = d0;
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
while (match) {
|
|
|
|
if (match[0] == d0 && match[1] == d1) {
|
|
|
|
*npt++ = match[2];
|
|
|
|
break;
|
|
|
|
}
|
|
|
|
match = (CELL *)match[3];
|
|
|
|
}
|
|
|
|
if (match) {
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
if (bindings) {
|
|
|
|
*tbindings = (CELL)HR;
|
|
|
|
} else {
|
|
|
|
bindings = HR;
|
|
|
|
}
|
|
|
|
HR[0] = d0;
|
|
|
|
HR[1] = d1;
|
|
|
|
HR[2] = AbsAppl(HR+4);
|
|
|
|
HR[3] = (CELL)NULL;
|
|
|
|
tbindings = HR+3;
|
|
|
|
HR+=4;
|
|
|
|
*npt++ = AbsAppl(HR);
|
|
|
|
#ifdef RATIONAL_TREES
|
|
|
|
/* now link the two structures so that no one else will */
|
|
|
|
/* come here */
|
|
|
|
to_visit -= 5;
|
|
|
|
to_visit[0] = pt0;
|
|
|
|
to_visit[1] = pt0_end;
|
|
|
|
to_visit[2] = pt1;
|
|
|
|
to_visit[3] = tbindings;
|
|
|
|
to_visit[4] = npt;
|
|
|
|
#else
|
|
|
|
/* store the terms to visit */
|
|
|
|
if (pt0 < pt0_end) {
|
|
|
|
to_visit -= 4;
|
|
|
|
to_visit[0] = pt0;
|
|
|
|
to_visit[1] = pt0_end;
|
|
|
|
to_visit[2] = pt1;
|
|
|
|
to_visit[3] = npt;
|
|
|
|
}
|
|
|
|
#endif
|
|
|
|
d0 = ArityOfFunctor(f);
|
|
|
|
pt0 = ap2;
|
|
|
|
pt0_end = ap2 + d0;
|
|
|
|
pt1 = ap3;
|
|
|
|
npt = HR;
|
|
|
|
*npt++ = (CELL)f;
|
|
|
|
HR += d0;
|
|
|
|
if (HR > (CELL *)to_visit -1024)
|
|
|
|
goto stack_overflow;
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
RESET_VARIABLE(npt);
|
|
|
|
npt++;
|
|
|
|
}
|
|
|
|
/* Do we still have compound terms to visit */
|
|
|
|
if (to_visit < (CELL **)ASP) {
|
|
|
|
#ifdef RATIONAL_TREES
|
|
|
|
pt0 = to_visit[0];
|
|
|
|
pt0_end = to_visit[1];
|
|
|
|
pt1 = to_visit[2];
|
|
|
|
tbindings = to_visit[3];
|
|
|
|
npt = to_visit[ 4];
|
|
|
|
if (!tbindings) {
|
|
|
|
bindings = NULL;
|
|
|
|
}
|
|
|
|
to_visit += 5;
|
|
|
|
#else
|
|
|
|
pt0 = to_visit[0];
|
|
|
|
pt0_end = to_visit[1];
|
|
|
|
pt1 = to_visit[2];
|
|
|
|
npt = to_visit[3];
|
|
|
|
to_visit += 4;
|
|
|
|
#endif
|
|
|
|
goto loop;
|
|
|
|
}
|
|
|
|
out = 1;
|
|
|
|
|
|
|
|
complete:
|
|
|
|
/* get rid of intermediate variables */
|
|
|
|
while (TR != OLDTR) {
|
|
|
|
CELL *pt1 = (CELL *) TrailTerm(--TR);
|
|
|
|
RESET_VARIABLE(pt1);
|
|
|
|
}
|
|
|
|
HBREG = B->cp_h;
|
|
|
|
return out;
|
|
|
|
|
|
|
|
stack_overflow:
|
|
|
|
out = -1;
|
|
|
|
goto complete;
|
|
|
|
|
|
|
|
trail_overflow:
|
|
|
|
out = -2;
|
|
|
|
goto complete;
|
|
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
static Int
|
|
|
|
p_term_subsumer( USES_REGS1 ) /* term_subsumer terms t1 and t2 */
|
|
|
|
{
|
|
|
|
int out = 0;
|
|
|
|
|
|
|
|
while (out != 1) {
|
|
|
|
Term t1 = Deref(ARG1);
|
|
|
|
Term t2 = Deref(ARG2);
|
|
|
|
CELL *oldH = HR;
|
|
|
|
|
|
|
|
if (t1 == t2)
|
|
|
|
return Yap_unify(ARG3,t1);
|
|
|
|
if (IsPairTerm(t1) && IsPairTerm(t2)) {
|
|
|
|
Term tf = AbsAppl(HR);
|
|
|
|
HR += 2;
|
|
|
|
HB = HR;
|
|
|
|
if ((out = term_subsumer_complex(RepPair(t1)-1,
|
|
|
|
RepPair(t1)+1,
|
|
|
|
RepPair(t2)-1, HR-2 PASS_REGS)) > 0) {
|
|
|
|
HB = B->cp_h;
|
|
|
|
return Yap_unify(ARG3,tf);
|
|
|
|
}
|
2019-01-07 14:59:08 +00:00
|
|
|
} else if (IsApplTerm(t1) && IsApplTerm(t2)) {
|
2018-11-08 02:33:36 +00:00
|
|
|
Functor f1;
|
|
|
|
|
|
|
|
if ((f1 = FunctorOfTerm(t1)) == FunctorOfTerm(t2)) {
|
|
|
|
if (IsExtensionFunctor(f1)) {
|
|
|
|
if (unify_extension(f1, t1, RepAppl(t1), t2)) {
|
|
|
|
return Yap_unify(ARG3,t1);
|
|
|
|
}
|
|
|
|
} else {
|
|
|
|
Term tf = AbsAppl(HR);
|
|
|
|
UInt ar = ArityOfFunctor(f1);
|
|
|
|
HR[0] = (CELL)f1;
|
|
|
|
HR += 1+ar;
|
|
|
|
HB = HR;
|
|
|
|
if ((out = term_subsumer_complex(RepAppl(t1),
|
|
|
|
RepAppl(t1)+ArityOfFunctor(f1),
|
|
|
|
RepAppl(t2), HR-ar PASS_REGS)) > 0) {
|
|
|
|
HB = B->cp_h;
|
|
|
|
return Yap_unify(ARG3,tf);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
HB = B->cp_h;
|
|
|
|
if (out == 0) {
|
|
|
|
return Yap_unify(ARG3, MkVarTerm());
|
|
|
|
} else {
|
|
|
|
HR = oldH;
|
|
|
|
if (out == -1) {
|
|
|
|
if (!Yap_gcl((ASP-HR)*sizeof(CELL), 0, ENV, gc_P(P,CP))) {
|
|
|
|
Yap_Error(RESOURCE_ERROR_STACK, TermNil, "in term_subsumer");
|
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
} else {
|
|
|
|
/* Trail overflow */
|
|
|
|
if (!Yap_growtrail(0, FALSE)) {
|
|
|
|
Yap_Error(RESOURCE_ERROR_TRAIL, TermNil, "in term_subsumer");
|
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
|
|
|
|
#ifdef DEBUG
|
|
|
|
static Int
|
|
|
|
p_force_trail_expansion( USES_REGS1 )
|
|
|
|
{
|
|
|
|
Int i = IntOfTerm(Deref(ARG1))*1024, j = 0;
|
|
|
|
tr_fr_ptr OTR = TR;
|
|
|
|
|
|
|
|
for (j = 0; j < i; j++) {
|
|
|
|
TrailTerm(TR) = 0;
|
|
|
|
TR++;
|
|
|
|
}
|
|
|
|
TR = OTR;
|
|
|
|
|
|
|
|
return(TRUE);
|
|
|
|
}
|
|
|
|
|
|
|
|
static Int
|
|
|
|
camacho_dum( USES_REGS1 )
|
|
|
|
{
|
|
|
|
Term t1, t2;
|
|
|
|
int max = 3;
|
|
|
|
|
|
|
|
/* build output list */
|
|
|
|
|
|
|
|
t1 = TermNil;
|
|
|
|
t2 = MkPairTerm(MkIntegerTerm(max), t1);
|
|
|
|
|
|
|
|
return(Yap_unify(t2, ARG1));
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
#endif /* DEBUG */
|
|
|
|
|
|
|
|
bool
|
|
|
|
Yap_IsListTerm(Term t)
|
|
|
|
{
|
|
|
|
Term *tailp;
|
|
|
|
Yap_SkipList(&t, &tailp);
|
|
|
|
return *tailp == TermNil;
|
|
|
|
}
|
|
|
|
|
|
|
|
static Int
|
|
|
|
p_is_list( USES_REGS1 )
|
|
|
|
{
|
|
|
|
return Yap_IsListTerm(Deref(ARG1));
|
|
|
|
}
|
|
|
|
|
|
|
|
bool
|
|
|
|
Yap_IsListOrPartialListTerm(Term t)
|
|
|
|
{
|
|
|
|
Term *tailp, tail;
|
|
|
|
Yap_SkipList(&t, &tailp);
|
|
|
|
tail = *tailp;
|
|
|
|
return tail == TermNil || IsVarTerm(tail);
|
|
|
|
}
|
|
|
|
|
|
|
|
static Int
|
|
|
|
p_is_list_or_partial_list( USES_REGS1 )
|
|
|
|
{
|
|
|
|
return Yap_IsListOrPartialListTerm(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);
|
|
|
|
}
|
|
|
|
|
|
|
|
extern int vsc;
|
|
|
|
|
|
|
|
int vsc;
|
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
#define RENUMBER_SINGLES\
|
|
|
|
if (singles && ap2 >= InitialH && ap2 < HR) {\
|
|
|
|
renumbervar(d0, numbv++ PASS_REGS);\
|
|
|
|
continue;\
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2018-11-08 02:33:36 +00:00
|
|
|
static Int numbervars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Int numbv, int singles USES_REGS)
|
|
|
|
{
|
|
|
|
|
2019-01-21 01:11:42 +00:00
|
|
|
|
2018-11-08 02:33:36 +00:00
|
|
|
int lvl = push_text_stack();
|
2019-01-07 14:59:08 +00:00
|
|
|
|
|
|
|
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;
|
2018-11-08 02:33:36 +00:00
|
|
|
register tr_fr_ptr TR0 = TR;
|
|
|
|
CELL *InitialH = HR;
|
|
|
|
|
|
|
|
to_visit0 = to_visit;
|
2019-01-07 14:59:08 +00:00
|
|
|
to_visit_max = to_visit0+1024;
|
|
|
|
restart:
|
2018-11-08 02:33:36 +00:00
|
|
|
while (pt0 < pt0_end) {
|
|
|
|
register CELL d0;
|
|
|
|
register CELL *ptd0;
|
|
|
|
++ pt0;
|
|
|
|
ptd0 = pt0;
|
|
|
|
d0 = *ptd0;
|
2019-01-07 14:59:08 +00:00
|
|
|
list_loop:
|
2018-11-08 02:33:36 +00:00
|
|
|
deref_head(d0, vars_in_term_unk);
|
|
|
|
vars_in_term_nvar:
|
|
|
|
{
|
2019-01-07 14:59:08 +00:00
|
|
|
WALK_COMPLEX_TERM__({},RENUMBER_SINGLES);
|
|
|
|
|
2018-11-08 02:33:36 +00:00
|
|
|
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) {
|
2019-01-07 14:59:08 +00:00
|
|
|
to_visit--;
|
|
|
|
|
|
|
|
pt0 = to_visit->pt0;
|
|
|
|
pt0_end = to_visit->pt0_end;
|
|
|
|
CELL *ptd0 = to_visit->ptd0;
|
|
|
|
*ptd0 = to_visit->d0;
|
|
|
|
goto restart;
|
2018-11-08 02:33:36 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
prune(B PASS_REGS);
|
|
|
|
pop_text_stack(lvl);
|
|
|
|
return numbv;
|
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
def_trail_overflow();
|
|
|
|
def_aux_overflow();
|
|
|
|
def_global_overflow();
|
2018-11-08 02:33:36 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
Int
|
|
|
|
Yap_NumberVars( Term inp, Int numbv, bool handle_singles ) /*
|
2019-01-07 14:59:08 +00:00
|
|
|
* numbervariables in term t */
|
2018-11-08 02:33:36 +00:00
|
|
|
{
|
|
|
|
CACHE_REGS
|
2019-01-07 14:59:08 +00:00
|
|
|
Int out;
|
2018-11-08 02:33:36 +00:00
|
|
|
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),
|
2019-01-07 14:59:08 +00:00
|
|
|
RepAppl(t)+
|
2018-11-08 02:33:36 +00:00
|
|
|
ArityOfFunctor(f), numbv, handle_singles PASS_REGS);
|
2011-11-02 22:44:08 +00:00
|
|
|
}
|
2015-10-08 13:29:47 +01:00
|
|
|
if (out < numbv) {
|
2018-11-06 22:49:11 +00:00
|
|
|
if (!expand_vts( 3 PASS_REGS ))
|
2011-11-02 22:44:08 +00:00
|
|
|
return FALSE;
|
|
|
|
goto restart;
|
|
|
|
}
|
|
|
|
return out;
|
|
|
|
}
|
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
static Int
|
|
|
|
p_numbervars( USES_REGS1 )
|
|
|
|
{
|
2011-11-02 22:44:08 +00:00
|
|
|
Term t2 = Deref(ARG2);
|
|
|
|
Int out;
|
|
|
|
|
|
|
|
if (IsVarTerm(t2)) {
|
2018-11-06 22:49:11 +00:00
|
|
|
Yap_Error(INSTANTIATION_ERROR,t2,"numbervars/3");
|
2011-11-02 22:44:08 +00:00
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
if (!IsIntegerTerm(t2)) {
|
2018-11-06 22:49:11 +00:00
|
|
|
Yap_Error(TYPE_ERROR_INTEGER,t2,"term_hash/4");
|
|
|
|
return(FALSE);
|
2011-11-02 22:44:08 +00:00
|
|
|
}
|
2012-03-14 22:10:21 +00:00
|
|
|
if ((out = Yap_NumberVars(ARG1, IntegerOfTerm(t2), FALSE)) < 0)
|
2011-11-02 22:44:08 +00:00
|
|
|
return FALSE;
|
|
|
|
return Yap_unify(ARG3, MkIntegerTerm(out));
|
|
|
|
}
|
2010-11-01 20:11:28 +00:00
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
static int
|
|
|
|
unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share USES_REGS)
|
|
|
|
{
|
2011-11-02 22:44:08 +00:00
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
struct cp_frame *to_visit0, *to_visit = (struct cp_frame *)Yap_PreAllocCodeSpace();
|
2010-11-01 20:11:28 +00:00
|
|
|
CELL *HB0 = HB;
|
|
|
|
tr_fr_ptr TR0 = TR;
|
2011-11-04 09:28:33 +00:00
|
|
|
int ground = share;
|
2011-11-02 22:44:08 +00:00
|
|
|
Int max = -1;
|
2010-11-01 20:11:28 +00:00
|
|
|
|
2019-01-21 01:11:42 +00:00
|
|
|
int lvl = push_text_stack();
|
2010-11-01 20:11:28 +00:00
|
|
|
HB = HLow;
|
|
|
|
to_visit0 = to_visit;
|
2018-11-06 22:49:11 +00:00
|
|
|
loop:
|
2010-11-01 20:11:28 +00:00
|
|
|
while (pt0 < pt0_end) {
|
|
|
|
register CELL d0;
|
|
|
|
register CELL *ptd0;
|
2018-11-06 22:49:11 +00:00
|
|
|
++ pt0;
|
2010-11-01 20:11:28 +00:00
|
|
|
ptd0 = pt0;
|
|
|
|
d0 = *ptd0;
|
2011-11-02 22:44:08 +00:00
|
|
|
deref_head(d0, unnumber_term_unk);
|
2018-11-06 22:49:11 +00:00
|
|
|
unnumber_term_nvar:
|
|
|
|
{
|
|
|
|
if (IsPairTerm(d0)) {
|
|
|
|
CELL *ap2 = RepPair(d0);
|
|
|
|
if (ap2 >= HB && ap2 < HR) {
|
|
|
|
/* If this is newer than the current term, just reuse */
|
|
|
|
*ptf++ = d0;
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
*ptf = AbsPair(HR);
|
|
|
|
ptf++;
|
|
|
|
if (to_visit+1 >= (struct cp_frame *)AuxSp) {
|
|
|
|
goto heap_overflow;
|
|
|
|
}
|
|
|
|
to_visit->start_cp = pt0;
|
|
|
|
to_visit->end_cp = pt0_end;
|
|
|
|
to_visit->to = ptf;
|
|
|
|
to_visit->oldv = *pt0;
|
|
|
|
to_visit->ground = ground;
|
|
|
|
/* fool the system into thinking we had a variable there */
|
|
|
|
*pt0 = AbsPair(HR);
|
|
|
|
to_visit ++;
|
|
|
|
ground = share;
|
|
|
|
pt0 = ap2 - 1;
|
|
|
|
pt0_end = ap2 + 1;
|
|
|
|
ptf = HR;
|
|
|
|
HR += 2;
|
|
|
|
if (HR > ASP - 2048) {
|
|
|
|
goto overflow;
|
|
|
|
}
|
|
|
|
} else if (IsApplTerm(d0)) {
|
|
|
|
register Functor f;
|
|
|
|
register CELL *ap2;
|
|
|
|
/* store the terms to visit */
|
|
|
|
ap2 = RepAppl(d0);
|
|
|
|
if (ap2 >= HB && ap2 <= HR) {
|
|
|
|
/* If this is newer than the current term, just reuse */
|
|
|
|
*ptf++ = d0;
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
f = (Functor)(*ap2);
|
|
|
|
|
|
|
|
if (IsExtensionFunctor(f)) {
|
|
|
|
*ptf++ = d0; /* you can just unnumber other extensions. */
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
if (f == FunctorDollarVar) {
|
|
|
|
Int id = IntegerOfTerm(ap2[1]);
|
|
|
|
ground = FALSE;
|
|
|
|
if (id < -1) {
|
2019-01-21 01:11:42 +00:00
|
|
|
pop_text_stack(lvl);
|
2018-11-06 22:49:11 +00:00
|
|
|
Yap_Error(RESOURCE_ERROR_STACK, TermNil, "unnumber vars cannot cope with VAR(-%d)", id);
|
|
|
|
return 0L;
|
|
|
|
}
|
|
|
|
if (id <= max) {
|
|
|
|
if (ASP-(max+1) <= HR) {
|
|
|
|
goto overflow;
|
|
|
|
}
|
|
|
|
/* we found this before? */
|
|
|
|
if (ASP[-id-1])
|
|
|
|
*ptf++ = ASP[-id-1];
|
|
|
|
else {
|
|
|
|
RESET_VARIABLE(ptf);
|
|
|
|
ASP[-id-1] = (CELL)ptf;
|
|
|
|
ptf++;
|
|
|
|
}
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
/* alloc more space */
|
|
|
|
if (ASP-(id+1) <= HR) {
|
|
|
|
goto overflow;
|
|
|
|
}
|
|
|
|
while (id > max) {
|
|
|
|
ASP[-(id+1)] = 0L;
|
|
|
|
max++;
|
|
|
|
}
|
|
|
|
/* new variable */
|
|
|
|
RESET_VARIABLE(ptf);
|
|
|
|
ASP[-(id+1)] = (CELL)ptf;
|
|
|
|
ptf++;
|
|
|
|
continue;
|
|
|
|
}
|
|
|
|
*ptf = AbsAppl(HR);
|
|
|
|
ptf++;
|
|
|
|
/* store the terms to visit */
|
|
|
|
if (to_visit+1 >= (struct cp_frame *)AuxSp) {
|
|
|
|
goto heap_overflow;
|
|
|
|
}
|
|
|
|
to_visit->start_cp = pt0;
|
|
|
|
to_visit->end_cp = pt0_end;
|
|
|
|
to_visit->to = ptf;
|
|
|
|
to_visit->oldv = *pt0;
|
|
|
|
to_visit->ground = ground;
|
|
|
|
/* fool the system into thinking we had a variable there */
|
|
|
|
*pt0 = AbsAppl(HR);
|
|
|
|
to_visit ++;
|
|
|
|
ground = (f != FunctorMutable) && share;
|
|
|
|
d0 = ArityOfFunctor(f);
|
|
|
|
pt0 = ap2;
|
|
|
|
pt0_end = ap2 + d0;
|
|
|
|
/* store the functor for the new term */
|
|
|
|
HR[0] = (CELL)f;
|
|
|
|
ptf = HR+1;
|
|
|
|
HR += 1+d0;
|
|
|
|
if (HR > ASP - 2048) {
|
|
|
|
goto overflow;
|
|
|
|
}
|
|
|
|
} else {
|
|
|
|
/* just unnumber atoms or integers */
|
|
|
|
*ptf++ = d0;
|
2011-11-02 22:44:08 +00:00
|
|
|
}
|
2018-11-06 22:49:11 +00:00
|
|
|
continue;
|
2010-11-01 20:11:28 +00:00
|
|
|
}
|
|
|
|
|
2011-11-02 22:44:08 +00:00
|
|
|
derefa_body(d0, ptd0, unnumber_term_unk, unnumber_term_nvar);
|
2011-11-04 09:28:33 +00:00
|
|
|
/* this should never happen ? */
|
2011-11-02 22:44:08 +00:00
|
|
|
ground = FALSE;
|
2018-11-06 22:49:11 +00:00
|
|
|
*ptf++ = (CELL) ptd0;
|
2010-11-01 20:11:28 +00:00
|
|
|
}
|
|
|
|
/* Do we still have compound terms to visit */
|
|
|
|
if (to_visit > to_visit0) {
|
2018-11-06 22:49:11 +00:00
|
|
|
to_visit --;
|
2011-11-02 22:44:08 +00:00
|
|
|
if (ground) {
|
|
|
|
CELL old = to_visit->oldv;
|
2018-11-06 22:49:11 +00:00
|
|
|
CELL *newp = to_visit->to-1;
|
2011-11-02 22:44:08 +00:00
|
|
|
CELL new = *newp;
|
|
|
|
|
|
|
|
*newp = old;
|
|
|
|
if (IsApplTerm(new))
|
2018-11-06 22:49:11 +00:00
|
|
|
HR = RepAppl(new);
|
2011-11-02 22:44:08 +00:00
|
|
|
else
|
2018-11-06 22:49:11 +00:00
|
|
|
HR = RepPair(new);
|
2011-11-02 22:44:08 +00:00
|
|
|
}
|
2010-11-01 20:11:28 +00:00
|
|
|
pt0 = to_visit->start_cp;
|
|
|
|
pt0_end = to_visit->end_cp;
|
|
|
|
ptf = to_visit->to;
|
2011-11-02 22:44:08 +00:00
|
|
|
#ifdef RATIONAL_TREES
|
|
|
|
*pt0 = to_visit->oldv;
|
|
|
|
#endif
|
|
|
|
ground = (ground && to_visit->ground);
|
2010-11-01 20:11:28 +00:00
|
|
|
goto loop;
|
|
|
|
}
|
|
|
|
|
|
|
|
/* restore our nice, friendly, term to its original state */
|
2011-11-02 22:44:08 +00:00
|
|
|
clean_dirty_tr(TR0 PASS_REGS);
|
2010-11-01 20:11:28 +00:00
|
|
|
HB = HB0;
|
2019-01-21 01:11:42 +00:00
|
|
|
pop_text_stack(lvl);
|
2011-11-02 22:44:08 +00:00
|
|
|
return ground;
|
2010-11-01 20:11:28 +00:00
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
overflow:
|
2010-11-01 20:11:28 +00:00
|
|
|
/* oops, we're in trouble */
|
2014-01-19 21:15:05 +00:00
|
|
|
HR = HLow;
|
2010-11-01 20:11:28 +00:00
|
|
|
/* we've done it */
|
|
|
|
/* restore our nice, friendly, term to its original state */
|
|
|
|
HB = HB0;
|
|
|
|
while (to_visit > to_visit0) {
|
2018-11-06 22:49:11 +00:00
|
|
|
to_visit --;
|
2010-11-01 20:11:28 +00:00
|
|
|
pt0 = to_visit->start_cp;
|
|
|
|
pt0_end = to_visit->end_cp;
|
|
|
|
ptf = to_visit->to;
|
2011-11-02 22:44:08 +00:00
|
|
|
*pt0 = to_visit->oldv;
|
2010-11-01 20:11:28 +00:00
|
|
|
}
|
|
|
|
reset_trail(TR0);
|
|
|
|
/* follow chain of multi-assigned variables */
|
2019-01-21 01:11:42 +00:00
|
|
|
pop_text_stack(lvl);
|
2010-11-01 20:11:28 +00:00
|
|
|
return -1;
|
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
heap_overflow:
|
2010-11-01 20:11:28 +00:00
|
|
|
/* oops, we're in trouble */
|
2014-01-19 21:15:05 +00:00
|
|
|
HR = HLow;
|
2010-11-01 20:11:28 +00:00
|
|
|
/* we've done it */
|
|
|
|
/* restore our nice, friendly, term to its original state */
|
|
|
|
HB = HB0;
|
|
|
|
while (to_visit > to_visit0) {
|
2018-11-06 22:49:11 +00:00
|
|
|
to_visit --;
|
2010-11-01 20:11:28 +00:00
|
|
|
pt0 = to_visit->start_cp;
|
|
|
|
pt0_end = to_visit->end_cp;
|
|
|
|
ptf = to_visit->to;
|
2011-11-02 22:44:08 +00:00
|
|
|
*pt0 = to_visit->oldv;
|
2010-11-01 20:11:28 +00:00
|
|
|
}
|
|
|
|
reset_trail(TR0);
|
2018-11-06 22:49:11 +00:00
|
|
|
LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0;
|
2019-01-21 01:11:42 +00:00
|
|
|
pop_text_stack(lvl);
|
2010-11-01 20:11:28 +00:00
|
|
|
return -3;
|
|
|
|
}
|
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
|
|
|
|
static Term
|
|
|
|
UnnumberTerm(Term inp, UInt arity, int share USES_REGS) {
|
2010-11-01 20:11:28 +00:00
|
|
|
Term t = Deref(inp);
|
|
|
|
tr_fr_ptr TR0 = TR;
|
|
|
|
|
|
|
|
if (IsVarTerm(t)) {
|
2011-11-02 22:44:08 +00:00
|
|
|
return inp;
|
2010-11-01 20:11:28 +00:00
|
|
|
} else if (IsPrimitiveTerm(t)) {
|
|
|
|
return t;
|
2011-11-02 22:44:08 +00:00
|
|
|
} else if (IsPairTerm(t)) {
|
|
|
|
Term tf;
|
2010-11-01 20:11:28 +00:00
|
|
|
CELL *ap;
|
2011-11-02 22:44:08 +00:00
|
|
|
CELL *Hi;
|
|
|
|
|
|
|
|
restart_list:
|
|
|
|
ap = RepPair(t);
|
2014-01-19 21:15:05 +00:00
|
|
|
Hi = HR;
|
|
|
|
tf = AbsPair(HR);
|
|
|
|
HR += 2;
|
2011-11-02 22:44:08 +00:00
|
|
|
{
|
|
|
|
int res;
|
2018-11-06 22:49:11 +00:00
|
|
|
if ((res = unnumber_complex_term(ap-1, ap+1, Hi, Hi, share PASS_REGS)) < 0) {
|
|
|
|
HR = Hi;
|
|
|
|
if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
|
|
|
|
return FALSE;
|
|
|
|
goto restart_list;
|
2011-11-02 22:44:08 +00:00
|
|
|
} else if (res) {
|
2018-11-06 22:49:11 +00:00
|
|
|
HR = Hi;
|
|
|
|
return t;
|
2011-11-02 22:44:08 +00:00
|
|
|
}
|
|
|
|
}
|
|
|
|
return tf;
|
|
|
|
} else {
|
|
|
|
Functor f = FunctorOfTerm(t);
|
|
|
|
Term tf;
|
|
|
|
CELL *HB0;
|
|
|
|
CELL *ap;
|
|
|
|
|
|
|
|
restart_appl:
|
|
|
|
f = FunctorOfTerm(t);
|
2014-01-19 21:15:05 +00:00
|
|
|
HB0 = HR;
|
2011-11-02 22:44:08 +00:00
|
|
|
ap = RepAppl(t);
|
2014-01-19 21:15:05 +00:00
|
|
|
tf = AbsAppl(HR);
|
|
|
|
HR[0] = (CELL)f;
|
2018-11-06 22:49:11 +00:00
|
|
|
HR += 1+ArityOfFunctor(f);
|
|
|
|
if (HR > ASP-128) {
|
2014-01-19 21:15:05 +00:00
|
|
|
HR = HB0;
|
2018-11-06 22:49:11 +00:00
|
|
|
if ((t = handle_cp_overflow(-1, TR0, arity, t))== 0L)
|
|
|
|
return FALSE;
|
2011-11-02 22:44:08 +00:00
|
|
|
goto restart_appl;
|
|
|
|
} else {
|
|
|
|
int res;
|
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
if ((res = unnumber_complex_term(ap, ap+ArityOfFunctor(f), HB0+1, HB0, share PASS_REGS)) < 0) {
|
|
|
|
HR = HB0;
|
|
|
|
if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
|
|
|
|
return FALSE;
|
|
|
|
goto restart_appl;
|
2011-11-02 22:44:08 +00:00
|
|
|
} else if (res && FunctorOfTerm(t) != FunctorMutable) {
|
2018-11-06 22:49:11 +00:00
|
|
|
HR = HB0;
|
|
|
|
return t;
|
2011-11-02 22:44:08 +00:00
|
|
|
}
|
|
|
|
}
|
|
|
|
return tf;
|
|
|
|
}
|
|
|
|
}
|
2017-04-13 21:42:34 +01:00
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
Term
|
|
|
|
Yap_UnNumberTerm(Term inp, int share) {
|
2011-11-02 22:44:08 +00:00
|
|
|
CACHE_REGS
|
2019-01-07 14:59:08 +00:00
|
|
|
return UnnumberTerm(inp, 0, share PASS_REGS);
|
2011-11-02 22:44:08 +00:00
|
|
|
}
|
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
static Int
|
|
|
|
p_unnumbervars( USES_REGS1 ) {
|
2011-11-04 09:28:33 +00:00
|
|
|
/* this should be a standard Prolog term, so we allow sharing? */
|
2011-11-16 14:59:28 +00:00
|
|
|
return Yap_unify(UnnumberTerm(ARG1, 2, FALSE PASS_REGS), ARG2);
|
2011-11-02 22:44:08 +00:00
|
|
|
}
|
2009-04-24 16:31:53 +01:00
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
Int
|
|
|
|
Yap_SkipList(Term *l, Term **tailp)
|
|
|
|
{
|
2012-01-09 23:28:31 +00:00
|
|
|
Int length = 0;
|
|
|
|
Term *s; /* slow */
|
2018-11-06 22:49:11 +00:00
|
|
|
Term v; /* temporary */
|
2012-01-09 23:28:31 +00:00
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
do_derefa(v,l,derefa_unk,derefa_nonvar);
|
2012-01-09 23:28:31 +00:00
|
|
|
s = l;
|
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
if ( IsPairTerm(*l) )
|
2019-01-07 14:59:08 +00:00
|
|
|
{ intptr_t power = 1, lam = 0;
|
|
|
|
do
|
|
|
|
{ if ( power == lam )
|
|
|
|
{ s = l;
|
|
|
|
power *= 2;
|
|
|
|
lam = 0;
|
|
|
|
}
|
|
|
|
lam++;
|
|
|
|
length++;
|
|
|
|
l = RepPair(*l)+1;
|
|
|
|
do_derefa(v,l,derefa2_unk,derefa2_nonvar);
|
|
|
|
} while ( *l != *s && IsPairTerm(*l) );
|
|
|
|
}
|
2012-01-09 23:28:31 +00:00
|
|
|
*tailp = l;
|
|
|
|
|
|
|
|
return length;
|
|
|
|
}
|
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
|
|
|
|
static Int
|
|
|
|
p_skip_list( USES_REGS1 ) {
|
2012-01-09 23:28:31 +00:00
|
|
|
Term *tail;
|
2018-11-06 22:49:11 +00:00
|
|
|
Int len = Yap_SkipList(XREGS+2, &tail);
|
2012-09-27 22:32:50 +01:00
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
return Yap_unify(MkIntegerTerm(len), ARG1) &&
|
|
|
|
Yap_unify(*tail, ARG3);
|
2012-01-09 23:28:31 +00:00
|
|
|
}
|
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
static Int
|
|
|
|
p_skip_list4( USES_REGS1 ) {
|
2012-09-27 22:32:50 +01:00
|
|
|
Term *tail;
|
2012-10-03 09:22:27 +01:00
|
|
|
Int len, len1 = -1;
|
|
|
|
Term t2 = Deref(ARG2), t;
|
2012-09-27 22:32:50 +01:00
|
|
|
|
|
|
|
if (!IsVarTerm(t2)) {
|
|
|
|
if (!IsIntegerTerm(t2)) {
|
|
|
|
Yap_Error(TYPE_ERROR_INTEGER, t2, "length/2");
|
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
if ((len1 = IntegerOfTerm(t2)) < 0) {
|
|
|
|
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2, "length/2");
|
|
|
|
return FALSE;
|
|
|
|
}
|
|
|
|
}
|
2012-10-03 09:22:27 +01:00
|
|
|
/* we need len here */
|
2018-11-06 22:49:11 +00:00
|
|
|
len = Yap_SkipList(XREGS+1, &tail);
|
2012-10-03 09:22:27 +01:00
|
|
|
t = *tail;
|
2012-09-27 22:32:50 +01:00
|
|
|
/* don't set M0 if full list, just check M */
|
|
|
|
if (t == TermNil) {
|
2012-10-03 09:22:27 +01:00
|
|
|
if (len1 >= 0) { /* ARG2 was bound */
|
2018-11-06 22:49:11 +00:00
|
|
|
return
|
|
|
|
len1 == len &&
|
|
|
|
Yap_unify(t, ARG4);
|
2012-10-03 09:22:27 +01:00
|
|
|
} else {
|
|
|
|
return Yap_unify_constant(ARG4, TermNil) &&
|
2018-11-06 22:49:11 +00:00
|
|
|
Yap_unify_constant(ARG2, MkIntegerTerm(len));
|
2012-10-03 09:22:27 +01:00
|
|
|
}
|
2012-09-27 22:32:50 +01:00
|
|
|
}
|
2018-11-06 22:49:11 +00:00
|
|
|
return Yap_unify(MkIntegerTerm(len), ARG3) &&
|
|
|
|
Yap_unify(t, ARG4);
|
2012-09-27 22:32:50 +01:00
|
|
|
}
|
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
static Int
|
|
|
|
p_free_arguments( USES_REGS1 )
|
|
|
|
{
|
2013-06-07 15:26:21 +01:00
|
|
|
Term t = Deref(ARG1);
|
|
|
|
if (IsVarTerm(t))
|
|
|
|
return FALSE;
|
|
|
|
if (IsAtomTerm(t) || IsIntTerm(t))
|
|
|
|
return TRUE;
|
|
|
|
if (IsPairTerm(t)) {
|
|
|
|
Term th = HeadOfTerm(t);
|
|
|
|
Term tl = TailOfTerm(t);
|
|
|
|
return IsVarTerm(th) && IsVarTerm(tl) && th != tl;
|
|
|
|
} else {
|
|
|
|
Functor f = FunctorOfTerm(t);
|
|
|
|
UInt i, ar;
|
|
|
|
Int ret = TRUE;
|
2017-04-13 21:42:34 +01:00
|
|
|
|
2013-06-07 15:26:21 +01:00
|
|
|
if (IsExtensionFunctor(f))
|
|
|
|
return TRUE;
|
|
|
|
ar = ArityOfFunctor(f);
|
2018-11-06 22:49:11 +00:00
|
|
|
for (i = 1 ; i <= ar; i++) {
|
2013-06-07 15:26:21 +01:00
|
|
|
Term ta = ArgOfTerm(i, t);
|
|
|
|
Int j;
|
|
|
|
|
|
|
|
ret = IsVarTerm(ta);
|
2018-11-06 22:49:11 +00:00
|
|
|
if (!ret) break;
|
2013-06-07 15:26:21 +01:00
|
|
|
/* stupid quadractic algorithm, but needs no testing for overflows */
|
2018-11-06 22:49:11 +00:00
|
|
|
for (j = 1 ; j < i; j++) {
|
|
|
|
ret = ArgOfTerm(j, t) != ta;
|
|
|
|
if (!ret) break;
|
2013-06-07 15:26:21 +01:00
|
|
|
}
|
2018-11-06 22:49:11 +00:00
|
|
|
if (!ret) break;
|
2013-06-07 15:26:21 +01:00
|
|
|
}
|
|
|
|
return ret;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
static Int
|
|
|
|
p_freshen_variables( USES_REGS1 )
|
|
|
|
{
|
2013-09-28 12:04:52 +01:00
|
|
|
Term t = Deref(ARG1);
|
|
|
|
Functor f = FunctorOfTerm(t);
|
|
|
|
UInt arity = ArityOfFunctor(f), i;
|
|
|
|
Term tn = Yap_MkNewApplTerm(f, arity);
|
2018-11-06 22:49:11 +00:00
|
|
|
CELL *src = RepAppl(t)+1;
|
|
|
|
CELL *targ = RepAppl(tn)+1;
|
|
|
|
for (i=0; i< arity; i++) {
|
2013-09-28 12:04:52 +01:00
|
|
|
RESET_VARIABLE(targ);
|
|
|
|
*VarOfTerm(*src) = (CELL)targ;
|
|
|
|
targ++;
|
|
|
|
src++;
|
|
|
|
}
|
|
|
|
return TRUE;
|
|
|
|
}
|
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
static Int
|
|
|
|
p_reset_variables( USES_REGS1 )
|
|
|
|
{
|
2013-09-28 12:04:52 +01:00
|
|
|
Term t = Deref(ARG1);
|
|
|
|
Functor f = FunctorOfTerm(t);
|
|
|
|
UInt arity = ArityOfFunctor(f), i;
|
2018-11-06 22:49:11 +00:00
|
|
|
CELL *src = RepAppl(t)+1;
|
2013-09-28 12:04:52 +01:00
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
for (i=0; i< arity; i++) {
|
2013-09-28 12:04:52 +01:00
|
|
|
RESET_VARIABLE(VarOfTerm(*src));
|
|
|
|
src++;
|
|
|
|
}
|
|
|
|
return TRUE;
|
|
|
|
}
|
|
|
|
|
2018-11-06 22:49:11 +00:00
|
|
|
void Yap_InitUtilCPreds(void)
|
|
|
|
{
|
2011-03-07 16:02:55 +00:00
|
|
|
CACHE_REGS
|
2019-01-07 14:59:08 +00:00
|
|
|
Term cm = CurrentModule;
|
2002-11-18 18:18:05 +00:00
|
|
|
Yap_InitCPred("copy_term", 2, p_copy_term, 0);
|
2019-01-07 14:59:08 +00:00
|
|
|
/** @pred copy_term(? _TI_,- _TF_) is iso
|
2014-09-11 20:06:57 +01:00
|
|
|
|
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
Term _TF_ is a variant of the original term _TI_, such that for
|
|
|
|
each variable _V_ in the term _TI_ there is a new variable _V'_
|
|
|
|
in term _TF_. Notice that:
|
2014-09-11 20:06:57 +01:00
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
+ suspended goals and attributes for attributed variables in _TI_ are also duplicated;
|
|
|
|
+ ground terms are shared between the new and the old term.
|
2014-09-11 20:06:57 +01:00
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
If you do not want any sharing to occur please use
|
|
|
|
duplicate_term/2.
|
2014-09-11 20:06:57 +01:00
|
|
|
|
2017-04-13 21:42:34 +01:00
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
*/
|
2007-09-21 14:52:52 +01:00
|
|
|
Yap_InitCPred("duplicate_term", 2, p_duplicate_term, 0);
|
2019-01-07 14:59:08 +00:00
|
|
|
/** @pred duplicate_term(? _TI_,- _TF_)
|
2014-09-11 20:06:57 +01:00
|
|
|
|
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
Term _TF_ is a variant of the original term _TI_, such that
|
|
|
|
for each variable _V_ in the term _TI_ there is a new variable
|
|
|
|
_V'_ in term _TF_, and the two terms do not share any
|
|
|
|
structure. All suspended goals and attributes for attributed variables
|
|
|
|
in _TI_ are also duplicated.
|
2014-09-11 20:06:57 +01:00
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
Also refer to copy_term/2.
|
2014-09-11 20:06:57 +01:00
|
|
|
|
2017-04-13 21:42:34 +01:00
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
*/
|
2005-10-30 01:32:55 +01:00
|
|
|
Yap_InitCPred("copy_term_nat", 2, p_copy_term_no_delays, 0);
|
2019-01-07 14:59:08 +00:00
|
|
|
/** @pred copy_term_nat(? _TI_,- _TF_)
|
2014-09-11 20:06:57 +01:00
|
|
|
|
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
As copy_term/2. Attributes however, are <em>not</em> copied but replaced
|
|
|
|
by fresh variables.
|
2014-09-11 20:06:57 +01:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
*/
|
2002-11-18 18:18:05 +00:00
|
|
|
Yap_InitCPred("ground", 1, p_ground, SafePredFlag);
|
2019-01-07 14:59:08 +00:00
|
|
|
/** @pred ground( _T_) is iso
|
2014-09-11 20:06:57 +01:00
|
|
|
|
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
Succeeds if there are no free variables in the term _T_.
|
2014-09-11 20:06:57 +01:00
|
|
|
|
2017-04-13 21:42:34 +01:00
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
*/
|
2012-10-19 18:10:48 +01:00
|
|
|
Yap_InitCPred("$variables_in_term", 3, p_variables_in_term, 0);
|
2013-01-14 22:46:06 +00:00
|
|
|
Yap_InitCPred("$free_variables_in_term", 3, p_free_variables_in_term, 0);
|
2012-10-19 18:10:48 +01:00
|
|
|
Yap_InitCPred("$non_singletons_in_term", 3, p_non_singletons_in_term, 0);
|
2006-03-30 02:11:10 +01:00
|
|
|
Yap_InitCPred("term_variables", 2, p_term_variables, 0);
|
2019-01-07 14:59:08 +00:00
|
|
|
/** @pred term_variables(? _Term_, - _Variables_) is iso
|
2014-09-11 20:06:57 +01:00
|
|
|
|
|
|
|
|
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
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.
|
2014-09-11 20:06:57 +01:00
|
|
|
|
2017-04-13 21:42:34 +01:00
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
*/
|
2006-03-30 02:11:10 +01:00
|
|
|
Yap_InitCPred("term_variables", 3, p_term_variables3, 0);
|
2010-03-12 08:49:12 +00:00
|
|
|
Yap_InitCPred("term_attvars", 2, p_term_attvars, 0);
|
2019-01-07 14:59:08 +00:00
|
|
|
/** @pred term_attvars(+ _Term_,- _AttVars_)
|
2014-09-11 20:06:57 +01:00
|
|
|
|
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
_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.
|
2014-09-11 20:06:57 +01:00
|
|
|
|
2017-04-13 21:42:34 +01:00
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
*/
|
2018-11-06 22:49:11 +00:00
|
|
|
Yap_InitCPred("is_list", 1, p_is_list, SafePredFlag|TestPredFlag);
|
|
|
|
Yap_InitCPred("$is_list_or_partial_list", 1, p_is_list_or_partial_list, SafePredFlag|TestPredFlag);
|
2014-02-02 21:45:47 +00:00
|
|
|
Yap_InitCPred("rational_term_to_tree", 4, p_break_rational, 0);
|
2019-01-07 14:59:08 +00:00
|
|
|
/** @pred rational_term_to_tree(? _TI_,- _TF_, ?SubTerms, ?MoreSubterms)
|
2014-09-11 20:06:57 +01:00
|
|
|
|
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
The term _TF_ is a forest representation (without cycles and repeated
|
|
|
|
terms) 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_.
|
2014-09-11 20:06:57 +01:00
|
|
|
|
2017-04-13 21:42:34 +01:00
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
*/
|
2014-02-02 21:45:47 +00:00
|
|
|
Yap_InitCPred("term_factorized", 3, p_break_rational3, 0);
|
2019-01-07 14:59:08 +00:00
|
|
|
/** @pred term_factorized(? _TI_,- _TF_, ?SubTerms)
|
2014-09-11 20:06:57 +01:00
|
|
|
|
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
Similar to rational_term_to_tree/4, but _SubTerms_ is a proper list.
|
2014-09-11 20:06:57 +01:00
|
|
|
|
2017-04-13 21:42:34 +01:00
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
*/
|
2009-11-23 10:10:14 +00:00
|
|
|
Yap_InitCPred("=@=", 2, p_variant, 0);
|
2011-11-02 22:44:08 +00:00
|
|
|
Yap_InitCPred("numbervars", 3, p_numbervars, 0);
|
2019-01-07 14:59:08 +00:00
|
|
|
/** @pred numbervars( _T_,+ _N1_,- _Nn_)
|
2014-09-11 20:06:57 +01:00
|
|
|
|
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
Instantiates each variable in term _T_ to a term of the form:
|
|
|
|
`$VAR( _I_)`, with _I_ increasing from _N1_ to _Nn_.
|
2014-09-11 20:06:57 +01:00
|
|
|
|
2017-04-13 21:42:34 +01:00
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
*/
|
2011-11-02 22:44:08 +00:00
|
|
|
Yap_InitCPred("unnumbervars", 2, p_unnumbervars, 0);
|
2019-01-07 14:59:08 +00:00
|
|
|
/** @pred unnumbervars( _T_,+ _NT_)
|
2014-09-11 20:06:57 +01:00
|
|
|
|
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
Replace every `$VAR( _I_)` by a free variable.
|
2014-09-11 20:06:57 +01:00
|
|
|
|
2017-04-13 21:42:34 +01:00
|
|
|
|
2019-01-07 14:59:08 +00:00
|
|
|
*/
|
2012-01-09 23:28:31 +00:00
|
|
|
/* use this carefully */
|
2018-11-06 22:49:11 +00:00
|
|
|
Yap_InitCPred("$skip_list", 3, p_skip_list, SafePredFlag|TestPredFlag);
|
|
|
|
Yap_InitCPred("$skip_list", 4, p_skip_list4, SafePredFlag|TestPredFlag);
|
2013-06-07 15:26:21 +01:00
|
|
|
Yap_InitCPred("$free_arguments", 1, p_free_arguments, TestPredFlag);
|
2008-08-12 02:27:23 +01:00
|
|
|
CurrentModule = TERMS_MODULE;
|
2011-07-06 22:26:53 +01:00
|
|
|
Yap_InitCPred("variable_in_term", 2, p_var_in_term, 0);
|
|
|
|
Yap_InitCPred("term_hash", 4, p_term_hash, 0);
|
|
|
|
Yap_InitCPred("instantiated_term_hash", 4, p_instantiated_term_hash, 0);
|
2004-10-06 17:55:48 +01:00
|
|
|
Yap_InitCPred("variant", 2, p_variant, 0);
|
2010-07-21 00:09:24 +01:00
|
|
|
Yap_InitCPred("subsumes", 2, p_subsumes, 0);
|
2012-05-14 15:04:19 +01:00
|
|
|
Yap_InitCPred("term_subsumer", 3, p_term_subsumer, 0);
|
2010-07-21 00:09:24 +01:00
|
|
|
Yap_InitCPred("variables_within_term", 3, p_variables_within_term, 0);
|
|
|
|
Yap_InitCPred("new_variables_in_term", 3, p_new_variables_in_term, 0);
|
2012-02-05 11:20:30 +00:00
|
|
|
Yap_InitCPred("export_term", 3, p_export_term, 0);
|
2012-02-05 11:57:03 +00:00
|
|
|
Yap_InitCPred("kill_exported_term", 1, p_kill_exported_term, SafePredFlag);
|
|
|
|
Yap_InitCPred("import_term", 2, p_import_term, 0);
|
2013-09-28 12:04:52 +01:00
|
|
|
Yap_InitCPred("freshen_variables", 1, p_freshen_variables, 0);
|
|
|
|
Yap_InitCPred("reset_variables", 1, p_reset_variables, 0);
|
2004-05-13 21:54:58 +01:00
|
|
|
CurrentModule = cm;
|
2001-04-09 20:54:03 +01:00
|
|
|
#ifdef DEBUG
|
2018-11-06 22:49:11 +00:00
|
|
|
Yap_InitCPred("$force_trail_expansion", 1, p_force_trail_expansion, SafePredFlag);
|
2002-11-18 18:18:05 +00:00
|
|
|
Yap_InitCPred("dum", 1, camacho_dum, SafePredFlag);
|
2001-04-09 20:54:03 +01:00
|
|
|
#endif
|
|
|
|
}
|